Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/idrx50.mac
There is 1 other file named idrx50.mac in the archive. Click here to see a list.
00100	COMMENT * SIMULA specification;
00200	OPTIONS(/E:CODE,idrx50);
00300	TEXT PROCEDURE idrx50(w); INTEGER w;
00400	COMMENT Converts bits 4-35 of W to a RADIX50 identifier text (Length=6).
00500	Bits 0-3 are 1) stored in idrx50.Main.Sub(1,1) directly,
00600	2) Converted to octal (after appending 2 zero bits to the right) in
00700	idrx50.Main.Sub(2,3), where the last char is blank.
00800	The following relation holds:
00900		idrx50.Main.Sub(5,6) == idrx50.
01000	Example: Octal 123456701234 is converted to "?10 OQ5H%3",
01100	where ? stands for Char(8r10//4) = Char(2) (=^B).
01200	;
01300	
01400	!*;! MACRO-10 code !*;!
01500	
01600		TITLE	idrx50
01700		ENTRY	idrx50
01800		SUBTTL	SIMULA utility, Lars Enderin April 1976
01900	
02000	;!*** Copyright 1976 by the Swedish Defence Research Institute. ***
02100	;!*** Copying is allowed.					***
02200	
02300	
02400		sall
02500		search	simmac,simmcr,simrpa
02600		macinit
02700	
02800		;! Local definitions ;!
02900	
03000		result==2
03100		w==4
03200	
03300		xp==XWAC3
03400		n==XWAC4
03500		xa==XWAC5
03600		xb==XWAC6
03700	
03800	idrx50:	PROC
03900		LI	XWAC1,1+3+6	;! Blanks(1+3+6)
04000		EXEC	TXBL
04100		Z
04200		MOVSI	xp,(POINT 7,0)	;! Byte pointer to first text byte
04300		HRRI	xp,2(XWAC1)
04400		SETZB	X0,X1
04500		LDB	X0,[POINT 4,w(XCB),3]
04600		IDPB	X0,xp
04700		LSHC	X0,-1
04800		ADDI	X0,"0"
04900		IDPB	X0,xp
05000		SETZ	X0,
05100		LSHC	X0,3
05200		ADDI	X0,"0"
05300		IDPB	X0,xp
05400		IBP	xp
05500		L	X1,w(XCB)
05600		TLZ	X1,(74B5)	;! Clear code bits
05700		SETZ	xb,
05800		LI	n,6
05900		LOOP	;! Convert to "SIXBIT" in xb, last character first
06000			IDIVI	X1,50
06100			LSH	xb,6
06200			ADDI	xb,(X2)
06300		AS
06400			SOJG	n,TRUE
06500		SA
06600		LI	n,6
06700		LOOP	;! Take out char's, convert to ASCII
06800			SETZ	xa,
06900			ROTC	xa,-6
07000			IF	;! Null
07100				JUMPN	xa,FALSE
07200			THEN	;! Space
07300				LI	xa," "
07400			ELSE
07500			ROT	xa,6
07600			IF	;! Digit
07700				CAILE	xa,12
07800				GOTO	FALSE
07900			THEN 	;! Add "0"-1
08000				ADDI	xa,"0"-1
08100			ELSE
08200			IF	;! Letter
08300				CAILE	xa,44
08400				GOTO	FALSE
08500			THEN	ADDI	xa,"A"-13
08600			ELSE
08700				L	xa,[EXP ".","$","%"]-45(xa)
08800			FI	FI	FI
08900			IDPB	xa,xp
09000		AS
09100			SOJG	n,TRUE
09200		SA
09300		HRLI	XWAC1,4	;! Offset = 4
09400		HRLI	XWAC2,6	;! Length=6, Pos=1
09500		STD	XWAC1,result(XCB)
09600		BRANCH	CSEP
09700		EPROC
09800		LIT
09900		END;