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;