Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/sxrx50.mac
There is 1 other file named sxrx50.mac in the archive. Click here to see a list.
00100	COMMENT * SIMULA specification;
00200	OPTIONS(/E:QUICK,sxrx50);
00300	INTEGER PROCEDURE sxrx50(w); INTEGER w;
00400	COMMENT Converts bits 4-35 of W to a RADIX50 identifier expressed
00500	in SIXBIT code (Length=6).
00600	Example: Octal 123456701234 is converted to SIXBIT "OQ5H%3".
00700	Bits 0-3 are ignored.
00800	;
00900	
01000	!*;! MACRO-10 code !*;!
01100	
01200		TITLE	sxrx50
01300		ENTRY	sxrx50
01400		SUBTTL	SIMULA utility, Lars Enderin June 1978
01500	
01600	;!*** Copyright 1978 by the Swedish Defence Research Institute. ***
01700	;!*** Copying is allowed.					***
01800	
01900	
02000		sall
02100		search	simmac,simmcr,simrpa
02200		macinit
02300	
02400		;! Local definitions ;!
02500	
02600		result==<w==XWAC1>
02700	
02800		xp==XIAC
02900	
03000	sxrx50:	PROC
03100		EXCH XWAC1,(XTAC)
03200		L	X0,w
03300		TLZ	X0,(74B5)	;! Clear code bits
03400		SETZ	result,
03500		L xp,[POINT 6,result,35]
03600		LOOP	;! Convert to SIXBIT in result, last character first
03700			IDIVI	X0,50
03800			IF	;! Space
03900				JUMPN X1,FALSE
04000			THEN
04100			ELSE
04200				IF	;! Digit
04300					CAILE	X1,12
04400					GOTO FALSE
04500				THEN 	;! Add '0'-1
04600					ADDI X1,'0'-1
04700				ELSE
04800				IF	;! Letter
04900					CAILE X1,44
05000					GOTO FALSE
05100				THEN	ADDI X1,'A'-13
05200				ELSE
05300					L X1,[EXP '.','$','%']-45(X1)
05400				FI	FI
05500				DPB X1,xp
05600			FI
05700			CAML xp,[307777,,-1]
05800			 GOTO FALSE
05900			ADD xp,[060000,,0]
06000		AS
06100			GOTO TRUE
06200		SA
06300		IF JUMPE result,FALSE
06400		THEN
06500			WHILE
06600				TLNE result,(77B5)
06700				GOTO FALSE
06800			DO
06900				LSH result,6
07000			OD
07100		FI
07200		EXCH XWAC1,(XTAC)
07300		RET
07400		EPROC
07500		LIT
07600		END;