Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/comp/p1dump.mac
There are 2 other files named p1dump.mac in the archive. Click here to see a list.
COMMENT;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

AUTHOR:		CLAES WIHLBORG
UPDATE:		4	[176]
PURPOSE:	TO LIST THE INTERMEDIATE FILE DF1 AND IC1
		AND TO TRACE SCANNER OUTPUT

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


	SALL
	SEARCH	SIMMC1,SIMMAC
	CTITLE	P1DUMP (DEBUG ROUTINE)

IFE QDEBUG,< END >

	INTERN	P1INIT,P1DUMP,LSTRAC

	EXTERN	ZSE1,ZSE2
	EXTERN	YJOB,YLSVAL,YMAXFX
	EXTERN	Y15BUF,YBRBUF
	EXTERN	P1PAGE,P1LINE,P1TAB,P1HEAD,P1Z
	EXTERN	T1AB,O1SETB
	EXTERN	YBHIC2
	EXTERN	YELIC1,YBHIC1
	EXTERN	YELDF1,YBHDF1
	EXTERN	YBHDEB,YELDEB

	TWOSEG
	RELOC	400000
	MACINIT

	XTYP=15
	XP=14
	XPP=13
	XBREAK=12

	QTAB=11
	SUBTTL	MACRO DEFINITIONS
IF1,<
DEFINE	TXARR(TEXT)<
	IRP TEXT,<
		X=0
		IRPC TEXT,<X=X+1>
		IFG X-5,<PRINTX TO LONG IN ARRAY: TEXT>
		IFE X-1,<ASCII/TEXT    />
		IFE X-2,<ASCII/TEXT   />
		IFE X-3,<ASCII/TEXT  />
		IFE X-4,<ASCII/TEXT />
		IFE X-5,<ASCII/TEXT/>
	>
>

DEFINE	ERROR(TXT)<
GOTO	[
	OUTSTR	[ASCIZ/
DUMP ERROR: TXT/]
	BRANCH	T1AB
	]
>

GETQUE A,H

DEFINE	SYM(NAM,VAL,NO,FJUTT)<
	REPEAT VAL-QSYM-1,<Z>
	QSYM=VAL
	TXARR(NAM)
	IFG NO,<AINQ NO,VAL>
>
DEFINE	NEWPAGE<PUSHJ	XPDP,.NEWPAGE>
DEFINE	NEWLINE<PUSHJ	XPDP,.NEWLINE>

DEFINE	PUTC(ACC)<
	SOSGE	YBHDEB+2
	EXEC	.OUT
	IDPB	ACC,YBHDEB+1
>

DEFINE	PUTCHAR(CHAR)<
	LI	CHAR
	PUTC
>

DEFINE	PUTTEXT(TXT)<
	XXX==0
IRPC TXT,<XXX==XXX+1>
IFN XXX,<	EXEC	.PUTT,<<[[ASCIZ/TXT/]]>>>
>

DEFINE	PUTID(ACC)<
	EXEC	.PUTID,ACC
>

DEFINE	PUTTAR(ACC,ARR)<
	L	X1,ARR(ACC)
	EXEC	.PUTTAR
>

DEFINE	PUTOCTAL(ACC,WL)<
	EXEC	.PUTOCTAL,<ACC,[WL]>
>

DEFINE	PUTDECIMAL(ACC,WL)<
	EXEC	.PUTDEC,<ACC,[WL]>
>

DEFINE	TAB(N<1>)<
	LI	X1,QTAB
REPEAT N,<PUTC	X1>
>

DEFINE	SPACE(N<1>)<
	LI	X1,40
REPEAT N,<PUTC	X1>
>

DEFINE	PUTBIN(TXT,FIELD)<
	IF	IFOFF	FIELD(XP)
		GOTO	FALSE
	THEN
		PUTTEXT(TXT)
	FI
>

DEFINE	PUTOF(TXT,FIELD,WL)<
	PUTTEXT(TXT)
	LF	X1,FIELD(XP)
	PUTOCTAL(X1,WL)
>

DEFINE	PUTOFZ(TXT,FIELD,WL)<
	LF	X1,FIELD(XP)
	IF	JUMPE	X1,FALSE
	THEN
		PUTTEXT(TXT)
		PUTOCTAL(X1,WL)
	FI
>

DEFINE	PUTDF(TXT,FIELD,WL)<
	PUTTEXT(TXT)
	LF	X1,FIELD(XP)
	PUTDECIMAL(X1,WL)
>

DEFINE	PUTTF(TXT,FIELD,ARR)<
	PUTTEXT(TXT)
	LF	X1,FIELD(XP)
	PUTTAR(X1,ARR)
>
DEFINE	MOPEN(FILE)<
	IF
		SKIPN	YEL'FILE
		GOTO	FALSE
	THEN	;FILE ON DISK
		OPEN	QCHIC2,[14
				SIXBIT/DSK/
				YBHIC2,,YBHIC2]
		ERROR(OPEN FILE)
		LD	1,YEL'FILE
		LD	3,YEL'FILE+2
		LOOKUP	QCHIC2,1
		ERROR(LOOKUP FILE)
		L	YBH'FILE+1
		ST	YBHIC2+1
		L	X7,[2,,Y15BUF]
		EXCH	X7,YBRBUF
		EXEC	O1SETB
		ST	X0,YBHIC2
		ST	X7,YBRBUF
		SETZM	YBHIC2+2
	ELSE	;FILE IN CORE
		LD	YBH'FILE+1
		STD	YBHIC2+1
	FI
>

DEFINE	MCLOSE(FILE)<
	SKIPE	YEL'FILE
	CLOSE	QCHIC2,
>

DEFINE	GETBYTE(ACC)<
	SOSGE	YBHIC2+2
	EXEC	.IN
	ILDB	ACC,YBHIC2+1
>

DEFINE	GETWORD<
	GETBYTE
	PUSH	XPP,
>

>;END OF IF1
	SUBTTL	LOCAL TEXT ARRAYS

QTYP:	TXARR(<UNDEF,INT,REAL,LREAL,CHAR,BOOL,TEXT,REF,LABEL,NOTYP,RLREA>)
QKND:	TXARR(<UNDEF,SIMP,ARRAY,PROC,CLASS>)
QMOD:	TXARR(<DECL,VALUE,NAME,REFER,VIRT,SPARE,HDN,NHDN>)	;[40]
HTYP:	TXARR(<FOR,RBLK,UBLK,PROCB,PBLK,CLASB,INSPE>)
	QSYM=-1
SYMBT:	SYMB(3,1,SYM)
SYMBV:	REPEAT AQSIZE,<
		AOUTQ QSYM1,QSYM2
		XWD QSYM1,QSYM2
	>
SYMBE:	;END OF SYMBV
	SUBTTL	WRITE SUBROUTINE

OUTOP:
	LI	'DEB'
	HLL	YJOB
	ST	YELDEB
	MOVSI	'LST'
	ST	YELDEB+1
	CLEAR	YELDEB+2
	CLEAR	YELDEB+3
	IF	ENTER	QCHDEB,YELDEB
		GOTO	FALSE
	THEN
		LI	700
		HRLM	YBHDEB+1
		OUT	QCHDEB,
		RETURN
	FI
	ERROR(ENTER DEB.LST)

.OUT:	OUT	QCHDEB,
	SOSGE	YBHDEB+2
	ERROR(OUT DEB.LST)
	RETURN

OUTCL:
	IF	SKIPE	P1PAGE
		GOTO	FALSE
	THEN	;NOTHING OUTPUTTED
		LI	0,0
		RENAME	QCHDEB,0
		ERROR(RENAME DEB.LST)
	ELSE
		NEWLINE
	FI
	CLOSE	QCHDEB,
	RETURN
	SUBTTL	MISC. SUBROUTINES

.IN:	SKIPN	YBHIC2
	ERROR(EOF IN CORE FILE)
	IN	QCHIC2,
	SOSGE	YBHIC2+2
	ERROR(EOF IN DISK FILE)
	RETURN

.NEWPAGE:
	PROC
	PUTCHAR QFF
	PUTTEXT(<
>)
	EXEC	.PUTT,P1HEAD
	TAB	2
	PUTTEXT(PAGE: )
	AOS	P1PAGE
	PUTDEC(P1PAGE,2)
	LI	64
	ST	P1LINE
	NEWLINE
	RETURN
	EPROC

.NEWLINE:
	PROC
	SOSGE	P1LINE
	NEWPAGE
	LI	14
	ST	P1TAB
	PUTTEXT(<
>)
	RETURN
	EPROC
.PUTT:
	PROC	TXT
	SAVE	<X1,X2>
	L	X1,TXT
	HRLI	X1,440700
	WHILE
		ILDB	X2,X1
		JUMPE	X2,FALSE
	DO
		PUTC	X2
	OD
	RETURN
	EPROC

.PUTTAR:
	PROC
	SAVE	X2
	LI	X2,5
	LOOP
		LSHC	X0,7
		PUTC	X0
	AS
		SOJG	X2,TRUE
	SA
	RETURN
	EPROC

.PUTID:
	PROC	IDX
	SAVE	<X1,X2,X3,X4>
	L	X4,IDX
	L	X2,YZSE1(X4)
	EXEC	.PUTSIX
	L	X2,YZSE2(X4)
	EXEC	.PUTSIX
	RETURN
	EPROC

.PUTSIX:
	PROC
	IF	JUMPN	X2,FALSE
	THEN	;SHORT NAME
		AOS	P1TAB
		RETURN
	FI
	LI	X3,6
	LOOP
		LI	X1,0
		LSHC	X1,6
		ADDI	X1,40
		PUTC	X1
	AS
		SOJG	X3,TRUE
	SA
	RETURN
	EPROC
.PUTOCT:
	PROC	<ARG,WL>
	SAVE	<X1,X2,X3,X4>
	LI	X4,10
	GOTO	.PUTN
	EPROC
.PUTDEC:
	PROC	<ARG,WL>
	SAVE	<X1,X2,X3,X4>
	LI	X4,12
.PUTN:
	L	X0,ARG
	L	X3,WL
	LOOP
		IDIV	X0,X4
		LSHC	X1,-4
	AS
		SOJG	X3,TRUE
	SA
	L	X3,WL
	LOOP
		LI	X1,0
		LSHC	X1,4
		ADDI	X1,60
		PUTC	X1
	AS
		SOJG	X3,TRUE
	SA
	RETURN
	EPROC
.ZH:	PROC
	PUTTAR(XTYP,HTYP)
	PUTOF( SOL:,ZHESOL,2)
	PUTTEXT( DLV:-)
	LF	X1,ZHEDLV(XP)
	MOVN	X1,X1
	TLZ	X1,-1
	PUTOCTAL(X1,2)
	PUTOF( EBL:,ZHEEBL,2)
	PUTOF( LEN:,ZHELEN,2)
	PUTOF( BNM:,ZHEBNM,3)
	PUTOF( FIX:,ZHEFIX,4)
	RETURN
	EPROC
.ZQU:	PROC
	GETWORD
	GETWORD
	GETWORD
	PUTOCTAL(XBREAK,4)
	ADDI	XBREAK,4
	PUTTEXT( ZQU )
	LF	X1,ZQULID(XP)
	PUTID	X1
	PUTTF( ,ZQUTYP,QTYP)
	PUTTF( ,ZQUKND,QKND)
	PUTTF( ,ZQUMOD,QMOD)
	PUTOF( IND:,ZQUIND,6)
	IF	IFOFF	ZQUSYS(XP)
		GOTO	FALSE
	THEN	;SYSTEM ELEMENT
		PUTTEXT( SYSTEM-ELEMENT)
		PUTOFZ( NAC:,ZQUNAC,1)
		PUTOFZ( SNR:,ZQUSNR,2)
		PUTBIN( GB,ZQUGB)
		PUTBIN( IO,ZQUIO)
		PUTBIN( PR,ZQUPR)
	ELSE
		PUTDF( LNE:,ZQULNE,5)
		PUTOFZ( NSB:,ZQUNSB,2)
		PUTBIN( IVA,ZQUIVA)	;[40]
		PUTBIN( PROT,ZQUPTD)	;[40]
		PUTBIN( EXT,ZQUEXT)
		PUTBIN( GLOB,ZQUGLO)
	FI
	PUTBIN( LONG,ZQULO)
	LF	X1,ZQUQID(XP)
	IF	JUMPE	X1,FALSE
	THEN
		PUTTEXT( QID:)
		PUTID	X1
	FI
	RETURN
	EPROC
.ZHE:	PROC
	GETWORD
	LF	XTYP,ZHETYP(XP)
	IF	CAIE	XTYP,QQUACH
		GOTO	FALSE
	THEN
		PUTTEXT(     ZHE QUACH LID:)
		LF	X1,ZHELID(XP)
		PUTID	X1
		PUTTEXT( OID:)
		LF	X1,ZHEOID(XP)
		PUTID	X1
		PUTTEXT( UNR:)
		HLRZ	X1,1(XP)
		PUTOCTAL(X1,6)
		HRRZ	X1,1(XP)
		PUTOCTAL(X1,6)
	ELSE
		NEWLINE
		LI	XBREAK,2
		PUTTEXT(0000 ZHE )
		EXEC	.ZH
	FI
	RETURN
	EPROC
.ZHB:	PROC
	GETWORD
	GETWORD
	GETWORD
	GETWORD
	LF	XTYP,ZHETYP(XP)
	CAIN	XTYP,QINSPE
	LI	XBREAK,0
	CAIN	XTYP,QINSPE
	NEWLINE
	PUTOCTAL(XBREAK,4)
	PUTTEXT( ZHB )
	EXEC	.ZH
	ADDI	XBREAK,5
	PUTOFZ( ZQU:,ZHBZQU,4)
	PUTOFZ( NRP:,ZHBNRP,2)
	PUTOFZ( VRT:,ZHBVRT,2)
	PUTOFZ( SBL:,ZHBSBL,2)
	PUTOFZ( STD:,ZHBSTD,2)
	IF	CAIE	XTYP,QPROCB
		GOTO	FALSE
	THEN
		PUTOFZ( MFO:,ZHBMFO,1)	;[40]
		PUTBIN( NCK,ZHBNCK)
	ELSE
		PUTBIN( UPF,ZHBUPF)
		PUTBIN( BLV,ZHBBLV)
		PUTBIN( LOC,ZHBLOC)
		PUTBIN( KDP,ZHBKDP)
	FI
	IF	IFOFF	ZHBEXT(XP)
		GOTO	FALSE
	THEN
		NEWLINE
		PUTTEXT(		EXTERNAL  UNR:)
		HLRZ	X1,4(XP)
		PUTOCTAL(X1,6)
		HRRZ	X1,4(XP)
		PUTOCTAL(X1,6)
	FI
	RETURN
	EPROC
	SUBTTL	SUBROUTINE DFDUMP

DFDUMP:
	PROC
	SAVE	X1MASK
	LI	[ASCIZ/	DUMP OF FILE DF1/]
	ST	P1HEAD
	NEWPAGE
	MOPEN(DF1)
	LI	XBREAK,0
	LI	XP,P1Z
	LOOP
		NEWLINE
		LI	XPP,-1(XP)
		GETWORD
		LF	XTYP,ZDETYP(XP)
		IF
			CAIE	XTYP,1B<QZQU+^D33>
			GOTO	FALSE
		THEN	EXEC	.ZQU
		ELSE
		IF
			CAIE	XTYP,1B<QZHB+^D33>
			GOTO	FALSE
		THEN	EXEC	.ZHB
		ELSE
		IF
			CAIE	XTYP,1B<QZHE+^D33>
			GOTO	FALSE
		THEN	EXEC	.ZHE
		ELSE
			PUTTEXT(***** ILLEGAL ZDE-TYP *****)
		FI FI FI
	AS
		SKIPE	1(XP)
		GOTO	TRUE
		CAIE	XTYP,QRBLOCK
		GOTO	TRUE
		HRRZ	(XP)	;[176]
		JUMPN	TRUE	;[176]
	SA
	NEWLINE
	NEWLINE
	WHILE
		GETBYTE	X1
		JUMPE	X1,FALSE
	DO	;OUTPUT ZQQ-RECORDS
		NEWLINE
		PUTTEXT(     ZQQ FIX:)
		PUTOCTAL(X1,4)
		PUTTEXT(  UNR:)
		GETBYTE	X1
		HLRZ	X2,X1
		PUTOCTAL(X2,6)
		HRRZ	X2,X1
		PUTOCTAL(X2,6)
	OD
	NEWLINE
	NEWLINE
	PUTTEXT(YMAXFX:)
	PUTOCTAL(YMAXFX,5)
	MCLOSE(DF1)
	RETURN
	EPROC
	SUBTTL	SUBROUTINE ICDUMP

ICDUMP:
	PROC
	SAVE	X1MASK
	LI	[ASCIZ/	DUMP OF FILE IC1/]
	ST	P1HEAD
	NEWPAGE
	MOPEN(IC1)
	LI	X15,-1
	NEWLINE
	LOOP
		GETBYTE	X13
		IF	CAIL	X13,QLOWID
			GOTO	FALSE	;IF ID OR LINE
		THEN			;SYMBOL
			LI	X14,0
			LI	X1,SYMBE-SYMBV-1
			LOOP
				HRRZ	X2,SYMBV(X1)
				CAMN	X13,X2
				HLRZ	X14,SYMBV(X1)
			AS
				SOJGE	X1,TRUE
			SA
			CAML	X14,P1TAB
			NEWLINE
			MOVN	X14
			ADDM	,P1TAB
			SOS	P1TAB
			PUTTEXT(<	%>)
			PUTTAR(X13,SYMBT)
			WHILE
				SOJL	X14,FALSE
			DO
				TAB
				GETBYTE	X1
				PUTOCTAL(X1,6)
			OD
		ELSE			;ID OR LINE
			LI	X14,2
			IF	TRZE	X13,400000
				GOTO	FALSE
			THEN		;ID
				CAMLE	X14,P1TAB
				NEWLINE
				MOVN	X14
				ADDM	P1TAB
				TAB
				PUTID	X13
			ELSE		;LINE SYMBOL
				IF	CAMN	X13,X15
					GOTO	FALSE
				THEN	;NEW LINE
					NEWLINE
					LI	X15,(X13)
					LI	X14,3
				ELSE	;OLD LINE
					CAMLE	X14,P1TAB
					NEWLINE
					TAB
				FI
				MOVN	X14
				ADDM	P1TAB
				GETBYTE	X1
				IF
					TRZE	X1,400K
					GOTO	FALSE
				THEN
					PUTTEXT(%LINE=)
				ELSE
					PUTTEXT(%DLIN=)
				FI
				PUTDEC(X13,5)
				IF	JUMPE	X1,FALSE
				THEN
					PUTCHAR	":"
					PUTDEC(X1,2)
				FI
				GETBYTE
			FI
		FI
	AS
		CAIE	X13,%EPROG
		GOTO	TRUE
	SA
	MCLOSE(IC1)
	RETURN
	EPROC
	SUBTTL	SUBROUTINE LSTRAC

LSTRAC:
	PROC
	SAVE	<X1,X2,X3>
	IF	CAIL	X1NXT,QLOWID
		GOTO	FALSE
	THEN		;SYMBOL
		LI	X2,1
		CAIN	X1NXT,%CONC
		LI	X2,2
		CAIN	X1NXT,%CONLR
		LI	X2,5
		CAIN	X1NXT,%CONT
		LI	X2,3
		CAIE	X1NXT,%CONI
		CAIN	X1NXT,%CONR
		LI	X2,3
		CAMLE	X2,P1TAB
		NEWLINE
		MOVN	X2
		ADDM	P1TAB
		PUTCHAR	"%"
		PUTTAR(X1NXT,SYMBT)
		TAB
		IF	CAIGE	X2,3
			GOTO	FALSE
		THEN
			HLRZ	X1,YLSVAL
			PUTOCTAL(X1,6)
			TAB
		FI
		IF	CAIGE	X2,2
			GOTO	FALSE
		THEN
			HRRZ	X1,YLSVAL
			PUTOCTAL(X1,6)
			TAB
		FI
		IF	CAIE	X2,5
			GOTO	FALSE
		THEN
			HLR	X1,YLSVAL+1
			PUTOCTAL(X1,6)
			TAB
			HRR	X1,YLSVAL+1
			PUTOCTAL(X1,6)
			TAB
		FI
	ELSE
		LI	X2,2
		CAMLE	X2,P1TAB
		NEWLINE
		MOVN	X2
		ADDM	P1TAB
		PUTID	X1NXT
		TAB
	FI
	RETURN
	EPROC
	SUBTTL	SUBROUTINE P1INIT

P1INIT:
	EXEC	OUTOP
	LI	[ASCIZ/	TRACE OF LS OUTPUT/]
	ST	P1HEAD
	RETURN
	SUBTTL	MAIN PROGRAM

P1DUMP:
	IFONA	DMPDF1
	EXEC	DFDUMP
	IFONA	DMPIC1
	EXEC	ICDUMP
	EXEC	OUTCL

	EXEC	O1DBOP##
	L	X4,YSHNID##
	LI	X4,-2000(X4)
	CAIN	X4,-1
	RETURN
	L	X1,[XWD 30000,1777]
	LOOP
		ADDI	X1,1
		L	X2,YZSE1(X1)
		L	X3,YZSE2(X1)
		EXEC	O1DB6##,<X1,X2,X3>
	AS
		SOJGE	X4,TRUE
	SA

	RETURN
	LIT
	END