Google
 

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