Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/maint/sutatr.mac
There is 1 other file named sutatr.mac in the archive. Click here to see a list.
TITLE SUTATR
SEARCH SIMMAC,SIMRPA
SALL
MACINIT
X17=17
DEFINE LINE<EXEC .LINE>
DEFINE PAGE<EXEC .PAGE>
DEFINE PSIX<EXEC .PSIX>
DEFINE PDEC<EXEC .PDEC>
DEFINE POCT<EXEC .POCT>
DEFINE RX50<EXEC .RX50>
DEFINE GET(AC)<
SOSGE BH+2
EXEC .IN
ILDB AC,BH+1
>
DEFINE TEXT(T)<OUTSTR [ASCIZ/T/]>
DEFINE PUT(R,F,L,T)<
TEXT( F:)
LF X11,R'F(,1)
LI X10,L
P'T
>
DEFINE PAS(A)<EXEC .PAS,<A>>
SUTATR::PROC
LL1: L X17,[IOWD 10,STK]
LINE
CLEARO
CLRBFI
TEXT(<FILE: >)
L X3,[POINT 6,LBLOCK]
SETZM LBLOCK
WHILE
INCHWL
CAIGE " "
GOTO FALSE
DO
CAILE 140
TRZ " "
SUBI 40
IDPB X3
OD
MOVSI 'ATR'
ST LBLOCK+1
SETZM LBLOCK+3
OPEN [13
'DSK '
0,,BH]
HALT
LOOKUP LBLOCK
GOTO [LINE
TEXT(File not found)
LINE
GOTO LL1
]
SETZM BH+2
PAGE
LINE
EXEC .IN
AOS BH+2
L X1,BH+1
TLNN X1,400000 ;Next word if ptr not of form
ADDI X1,1 ;[44xxxx,,y]
L (X1) ;First word of data
HLRZ ;Loader block type
IF ;Entry block
CAIE 4
THEN ;Take care of new format
GOTO FALSE
GET X1
LI X3,-1(X1)
GET X1
TEXT(SIMULA NAME: )
RX50
TEXT( )
WHILE
SOJL X3,FALSE
DO
GET X1
OD
L X1,BH+1
HLRZ (X1)
TLNN X1,400000
HLRZ 1(X1)
IF ;NAME block
CAIE 6
GOTO FALSE
THEN
GET X1
LI X3,-1(X1)
GET X1
TEXT(MODULE NAME: )
RX50
TEXT( )
WHILE
SOJL X3,FALSE
DO
GET X1
OD
FI
GET X1
HLRZ X1
IF ;Not a proper comment block now
JUMPE X1,TRUE
JUMPE FALSE
THEN ;Error
LINE
TEXT(Wrong file format)
LINE
GOTO LL1
FI
FI
TEXT(HEADER: )
RX50
SETZM LEVEL
LINE
LL2:
GET X1
IF
JUMPE X1,FALSE
THEN ;ZQU OR ZHB
LINE
LF ,ZDETYP(,1)
IF
CAIE ZQU%V
GOTO FALSE
THEN ;ZQU
LF X4,ZQUTYP(,1)
LF X5,ZQUKND(,1)
LF X6,ZQUMOD(,1)
L X11,LEVEL
LI X10,2
PDEC
TEXT( ZQU TYP:)
PAS TATYP(4)
TEXT( KND:)
PAS TAKND(5)
TEXT( MOD:)
PAS TAMOD(6)
GET X2
PUT(ZQU,NSB,2,DEC)
PUT(ZQU,IND,6,OCT)
TEXT( LID:)
PSIX
IF
CAIN X4,QLABEL
CAIE X5,QSIMPLE
GOTO FALSE
CAIE X6,QDECLARED
GOTO FALSE
THEN ;LAB ATR
TEXT( ENT:)
RX50
GET
ELSE
TEXT( QID:)
PSIX
FI
GOTO LL2
FI
;ZHB
AOS X11,LEVEL
LI X10,2
PDEC
TEXT( ZHB TYP:)
LF X2,ZHETYP(,X1)
PAS TAZHE(2)
IFONA ZHENOI(1)
TEXT( NOI)
PUT(ZHE,SOL,2,OCT)
TEXT( DLV:-)
LFE X11,ZHEDLV(,X1)
MOVN X11,X11
LI X10,2
POCT
GET X2
PUT(ZHE,EBL,2,OCT)
PUT(ZHE,LEN,4,OCT)
PUT(ZHE,BNM,3,OCT)
GET
GET X4
PUT(ZHB,NRP,2,DEC)
PUT(ZHB,VRT,2,DEC)
PUT(ZHB,SBL,2,OCT)
PUT(ZHB,STD,2,OCT)
PUT(ZHB,SZD,2,OCT)
ANDI X4,37
L X11,X4
LI X10,2
TEXT( FLG:)
POCT
TEXT( ENT:)
RX50
GOTO LL2
FI
SOSE LEVEL
GOTO LL2
WHILE
GET X1
JUMPE X1,FALSE
DO
LINE
TEXT( QUACH UNR:)
RX50
TEXT( LID:)
PSIX
OD
CLOSE
GOTO LL1
EPROC
.POCT: PROC
LI X14,(X10)
LOOP
LSHC X11,-3
AS
SOJG X14,TRUE
SA
LOOP
LI X11,0
LSHC X11,3
ADDI X11,60
OUTCHR X11
AS
SOJG X10,TRUE
SA
RETURN
EPROC
.PDEC: PROC
LI X14,(X10)
LOOP
IDIVI X11,12
LSHC X12,-4
AS
SOJG X14,TRUE
SA
LOOP
LI X12,0
LSHC X12,4
ADDI X12,60
OUTCHR X12
AS
SOJG X10,TRUE
SA
RETURN
EPROC
.PAS: PROC TXT
SAVE <1,2>
L X1,TXT
LI X2,0
OUTSTR X1
RETURN
EPROC
.RX50: PROC
SAVE <1,2,3,4>
GET X1
LI X4,6
LOOP
IDIVI X1,50
LSHC X2,-6
AS
SOJG X4,TRUE
SA
LI X4,6
LOOP
LI X2,0
LSHC X2,6
ADDI X2,57
CAILE X2,"9"
ADDI X2,7
CAILE X2,"Z"
SUBI X2,70
CAIN X2,57
LI X2," "
OUTCHR X2
AS
SOJG X4,TRUE
SA
RETURN
EPROC
.PSIX: PROC
SAVE <1,2,3>
EXEC .PSIX1
EXEC .PSIX1
RETURN
EPROC
.PSIX1: PROC
GET X2
LI X3,6
LOOP
LI X1,0
LSHC X1,6
ADDI X1,40
OUTCHR X1
AS
SOJG X3,TRUE
SA
RETURN
EPROC
.IN: PROC
IN
SOSGE BH+2
HALT
RETURN
EPROC
.PAGE: PROC
LI ^D50
ST LINES
OUTCHR [14]
RETURN
EPROC
.LINE: PROC
SOSGE LINES
PAGE
TEXT(<
>)
RETURN
EPROC
STK:BLOCK 12
TATYP:ASCII/UNDEFINTEGREAL LREALCHAR BOOL TEXT REF LABELNOTYP/
TAKND:ASCII/UNDEFSIMPLARRAYPROC CLASS/
TAMOD:ASCII/DECL VALUENAME REFERVIRT /
TAZHE:ASCII/FOR RBL UBL PROCBPBL CLASBINS /
LEVEL:Z
BH: BLOCK 3
LBLOCK:BLOCK 4
LINES:Z
LIT
END SUTATR