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;