Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/16/sadeb.mac
There is 1 other file named sadeb.mac in the archive. Click here to see a list.
	SUBTTL	POOL DUMP ROUTINES

	COMMENT;

AUTHOR:	REIDAR KARLSSON

VERSION:1

PURPOSE:  TO SUPPLY ROUTINES IN TEST VERSION TO DUMP THE WHOLE STORAGE POOL,
	A RECORD IN THE POOL OR THE SEQUENCING SET IN A FORM EASY TO READ.
	ROUTINES TO FACILITATE DUMP AND TEST OUTPUT ON SYSOUT IS ALSO
	SUPPLIED.

CONTENTS:	.SAPD	pool dump routine
		SAPDRE	record dump routine
		.SQSDU	routine to dump the SQS
		SAPDCO	output a character on SYSOUT
		SAPDTO	output an ASCII string on SYSOUT
		SAPDOI	outimage


	;




	SEARCH	SIMMAC,SIMMCR,SIMRPA

	RTITLE (SADEB)

	IFE QDEBUG,<END>

	SALL
	MACINIT


	TWOSEG
	RELOC	400K



	INTERN	SAPDCO,SAPDOI,SAPDTO
	EXTERN	.IOOG,SAGCOO,SAGCOD,SAGCLE

	XTOP=	X5
	XCUR=	X6
	XZPR=	X11
	XLEN=	X12


	OPDEF	DUP	[PUSHJ	17,.SAPD]
	OPDEF	DUR	[PUSHJ	17,SAPDRE]
	OPDEF	OUTOCT	[PUSHJ	17,SAGCOO]
	OPDEF	OUTDEC	[PUSHJ	17,SAGCOD]
	OPDEF	FINI	[GOTO	SAPDFI]
	OPDEF	DUSQS	[PUSHJ	17,.SQSDU]
	OPDEF	LENGTH	[JSP	X0,SAGCLE]

	DEFINE	DUFIS(F)		;DUMP FIELD(S) F
<	IRP F	<	
			LF	X1,F(XCUR)
			IF
				JUMPE	X1,FALSE
			THEN
				RTEXT(F'	)
				OUTOCT
			FI
		>
>

	DEFINE	DUGP(Y,N)		;DUMP N LOCATIONS STARTING WITH Y(XLOW)
<	RTEXT (Y'	)
	SETLOW(X16)
	L	X1,Y(XLOW)
	OUTOCT
	IFNB	<N>,<	LI	X3,N
			LI	X4,1+Y(XLOW)
			WHILE
				SOJLE	X3,FALSE
			DO
				L	X1,(X4)
				IF
					JUMPE	X1,FALSE
				THEN
					RTEXT(	)
					OUTOCT
				FI
				AOJ	X4,
			OD
		>
>
	SUBTTL	.SAPD	(Pool dump routine)

	COMMENT;

PURPOSE:	TO DUMP THE STORAGE POOL IN A FORM EASY TO READ
		 AND SUPPLY A ROUTINE (SAPDRE) THAT COULD BE USED
		 TO DUMP A SINGLE POOL RECORD


ENTRIES:	.SAPD	TO DUMP THE WHOLE POOL
		SAPDRE	TO DUMP A RECORD IN THE POOL


INPUT ARG.:	.SAPD	YSABOT(XLOW) POINTS TO THE BOTTOM OF THE POOL
			YSATOP(XLOW) POINTS TO THE TOP OF THE POOL
		SAPDRE	XCUR =X6 POINTS TO THE RECORD START

CALL FORMAT:	EXEC	.SAPD		OPDEF	DUP
		EXEC	SAPDRE		OPDEF	DUR

USED SUBROUTINES:	SAGCOO, SAGCOD, SAGCLE

	;



.SAPD:			;POOL DUMP
	PROC
	SAVE	<X0,XCUR,X16,XTOP>
	LOWADR(X16)
	L	X0,YSASW(XLOW)
	RRTEXT(	POOL DUMP)
	RTEXT(=================================)
	EXEC	SAPDGL		;GLOBAL POINTERS
	L	XCUR,YSABOT(XLOW)
	L	XTOP,YSATOP(XLOW)
	WHILE
		CAIL	XCUR,(XTOP)
		GOTO	FALSE
	DO
		;DUMP RECORDS IN THE STORAGE POOL

		DUR
		LENGTH
		ADD	XCUR,XLEN
	OD
	L	X0,YSASW(XLOW)
	RTEXT	(======	Pool dump ready!  ======)
	RETURN
	EPROC



SAPDGL:		;DUMP GLOBAL POINTERS OF INTEREST FOR GARBAGE COLLECTOR
	PROC
	SAVE	<XCUR,X3,X4,X0,X1,X2>
	LOWADR(X16)
	L	X0,YSASW(XLOW)
	RRTEXT(Current block at )
		;FIND CURRENT BLOCK ADDRESS
	L	X3,XCB
	CAIL	X3,400K
	L	X3,XCB+YSASAV(XLOW)
	L	X1,X3
	OUTOCT
		;FIND THE OUTERMOST BLOCK ADDRESS
	LF	XCUR,ZDRZPB(X3)
	RRTEXT(Outermost block:)
	DUR
	L	X0,YSASW(XLOW)
	RRTEXT(======	Global pointers ======)
	DUGP	(YTXZTV)
	DUGP	(YOBJAD,<QOBJAD+QNGP>)
	DUGP	(YIOCHT,20)
	RETURN
	EPROC




	DEFINE	X(A)	<IRP A,<GOTO	A'DU	>>


SAPDRE:			;RECORD DUMP
	PROC
	SAVE	<X0,X1,X2,X3,X4,X7,XCUR,XZPR,XLEN>
	LOWADR(X1)
	L	X0,YSASW(XLOW)
	RRTEXT	(======	)
	LF	X1,ZDNTYP(XCUR)
	JUMPL	X1,ZDNDU
	CAILE	X1,QZYS
	GOTO	ZDNDU
	GOTO	.+1(X1)		;BRANCH ON ZDNTYP
	TYPZDN			;GENERATE JUMP TABLE
SAPDFI:	RETURN			;COMMON RETURN
	EPROC




ZDNDU:		RFAIL	WRONG POINTER IN XCUR (SAPDRE)	

ZBIDU:	TEXT	(ZBI)
	EXEC	SAPD1
	EXEC	SAPD2
	EXEC	SAPD3
	RRTEXT	(Variable locations)
	LI	X4,2
	EXEC	SAPD4
	FINI


ZPBDU:	TEXT	(ZPB)
	GOTO	ZPBCLD

ZCLDU:	TEXT	(ZCL)
ZPBCLD:	LF	XZPR,ZBIZPR(XCUR)
	LOOP			;SEARCH FOR ZCPGCI \= 0 IN PREFIX CHAIN
		LF	X1,ZCPGCI(XZPR)
	AS
		JUMPN	X1,FALSE
		LF	X7,ZCPZCP(XZPR)
		JUMPE	X7,FALSE
		L	XZPR,X7
		GOTO	TRUE
	SA
	GOTO	.+1(X1)		;BRANCH ON ZCPGCI
	SYSCLASS		;GENERATE JUMP TABLE
SUSIDU:	TEXT	( Simulation)
	GOTO	CLPBDU
SUPSDU:	TEXT	( Process)
	GOTO	CLPBDU
SSLGDU:	TEXT	( Linkage)
	GOTO	CLPBDU
IOFIDU:	TEXT	( File object)
	GOTO	CLPBDU

ZBPDU:	TEXT	(ZBP)
CLPBDU:	EXEC	SAPD1
	EXEC	SAPD2
	LF	XZPR,ZBIZPR(XCUR)
	EXCH	XZPR,XCUR
	DUFIS	(ZPCDEC)
	LF	X4,ZPCDEC(XCUR)
;	EXEC	SAPD5	;CAN BE USED IF JFCL,LINENR IS GENERATED IN M2LN

	LF	X3,ZPCNRP(XCUR)
	IF
		JUMPLE	X3,FALSE
	THEN
		RRTEXT	(Formal parameter descriptors)
		RTEXT	(Type	Mode	Kind	Offset)
		LI	X4,OFFSET(ZPCZFP)(XCUR)
		SETZ	X7,
		LOOP
			RTEXT	
			LF	X1,ZTDTYP(X4)
			CAIN	X1,QREF
			SETO	X7,
			OUTOCT
			TEXT	(	)
			LF	X1,ZFPMOD(X4)
			OUTOCT
			TEXT	(	)
			LF	X1,ZPDKND(X4)
			CAIN	X1,QARRAY
			SETZ	X7,
			OUTOCT
			TEXT	(	)
			LF	X1,ZFPOFS(X4)
			OUTOCT
			IF
				JUMPE	X7,FALSE
			THEN
				SETZ	X7,
				TEXT	(	ZFRZPR	)
				LF	X1,ZFRZPR(X4)
				OUTOCT
				AOJ	X4,
			FI
		AS
			AOJ	X4,
			SOJG	X3,TRUE
		SA
	FI
	L	XCUR,XZPR		;RESTORE XCUR
	EXEC	SAPD3
	RRTEXT	(Parameter and variable locations)
	LI	X4,2
	EXEC	SAPD4
	FINI


ZARDU:	TEXT	(ZAR)
	EXEC	SAPD1
	DUFIS	(<ZARBAD,ZARTYP,ZARSUB,ZARZPR>)
	RRTEXT	(Subscript bounds)
	LF	X3,ZARSUB(XCUR)
	LI	X4,1+OFFSET(ZARTYP)(XCUR)
	WHILE
		SOJL	X3,FALSE
	DO
		RTEXT	(Low:	)
		L	X1,(X4)
		OUTOCT
		RTEXT	(Upp:	)
		L	X1,1(X4)
		OUTOCT
		ADDI	X4,2
	OD
	RRTEXT	(Dope vector)
	LF	X3,ZARSUB(XCUR)
	SOJ	X3,
	WHILE
		SOJL	X3,FALSE
	DO
		RTEXT	
		L	X1,(X4)
		OUTOCT
		AOJ	X4,
	OD
REPEAT 0,<
	RRTEXT	(Array elements)
	SUB	X4,XCUR
	EXEC	SAPD4
	>
	FINI



ZACDU:	TEXT	(ZAC)
	EXEC	SAPD1
	DUFIS	(<ZACNAC,ZACZAM>)
	RRTEXT	(Saved accumulator values)
	LI	X4,OFFSET(ZACSVA)
	EXEC	SAPD4
	FINI


ZTEDU:	TEXT	(ZTE)
	EXEC	SAPD1
	DUFIS	(ZTECLN)
	RRTEXT	(Text:	)
	LF	XLEN,ZTELEN(XCUR)
	CAILE	XLEN,20
	LI	XLEN,20
	ADDI	XLEN,(XCUR)
	L	X3,(XLEN)
	SETZM	(XLEN)
	LI	X2,OFFSET(ZTECHR)(XCUR)
	IFONA	SWGCT2
	OUTSTR	(X2)
	IFONA	SWGCT3
	EXEC	SAPDTO
	ST	X3,(XLEN)
	FINI


ZTTDU:	TEXT	(ZTT)
	EXEC	SAPD1
	RRTEXT	(Text variable)
	LI	X4,OFFSET(ZTTSP)
	EXEC	SAPD4
	FINI


ZERDU:
	TEXT	(ZER)
	EXEC	SAPD1
	DUFIS	(<ZERZEV,ZERZER>)
	LF	XLEN,ZERLEN(XCUR)
	ADD	XLEN,XCUR
	L	X7,XCUR			;SAVE XCUR
	LI	XCUR,OFFSET(ZERZV1)(XCUR)
	WHILE
		CAIL	XCUR,(XLEN)
		GOTO	FALSE
	DO
		RRTEXT	(ZEV at )
		L	X1,XCUR
		OUTOCT
		DUFIS	(<ZEVZBL,ZEVZPS,ZEVZLL,ZEVZRL,ZEVZER,ZEVZCH,ZEVTIM>)
		ADDI	XCUR,ZEV%S
	OD
	L	XCUR,X7			;RESTORE XCUR
	FINI


ZDRDU:	TEXT	(ZDR)
	EXEC	SAPD1
	DUFIS	(ZDRZAC)
	RRTEXT	(Thunk save areas FOR return addresses and display vector elements)
	LI	X4,2
	EXEC	SAPD4
	EXCH	XCUR,XLEN
	DUFIS	(<ZDRZBI,ZDRARE>)
	LF	X4,ZDRARE(XCUR)
;	EXEC	SAPD5	;CAN BE USED IF JFCL,LINENR IS GENERATED IN M2LN
	EXCH	XCUR,XLEN		;RESTORE XCUR
	FINI


ZYSDU:	TEXT	(ZYS)
	EXEC	SAPD1
	RRTEXT	(Contents)
	LI	X4,OFFSET(ZYSINF)
	EXEC	SAPD4
	FINI



ZXBDU:	TEXT	(ZXB)
	EXEC	SAPD1
	DUFIS	(<ZXBARG,ZXBP2,ZXBFIL,ZXBEXT,ZXBPRT,ZXBLNG,ZXBLEN,ZXBALC>)
	FINI


SAPD1:
		;WRITE ADDRESS AND LENGTH OF RECORD +ZDNCND AND ZDNLNK
	TEXT	( at )
	L	X1,XCUR
	OUTOCT
	TEXT	( length )
	STACK	X0
	LENGTH
	UNSTK	X0
	L	X1,XLEN
	OUTOCT
	TEXT	(  ======)
	DUFIS	(<ZDNCND,ZDNLNK>)
	RETURN


SAPD2:
	DUFIS	(<ZBIBNM,ZBIZPR>)
	RETURN


SAPD3:		;DUMP MAPS
	LF	XZPR,ZBIZPR(XCUR)
	LF	XZPR,ZPRMAP(XZPR)
	IF
		JUMPE	XZPR,FALSE
	THEN
		RRTEXT	(Maps of variables)
		LF	X1,ZBIBNM(XCUR)
		ASH	X1,2			;*4 = *ZMP%S
		ADDI	XZPR,(X1)
		EXCH	XCUR,XZPR
		LOOP
			RTEXT	
			DUFIS	(<ZMPZMP,ZMPNOV,ZMPDOV>)
			DUFIS	(<ZMPNRV,ZMPDRV,ZMPNTX,ZMPDTX>)
			LF	XCUR,ZMPZMP(XCUR)
		AS
			JUMPN	XCUR,TRUE
		SA
		L	XCUR,XZPR		;RESTORE XCUR
	FI
	RETURN



SAPD4:		;DUMP THE AREA STARTING AT OFFSET (X4) FROM (XCUR)
		; TO THE END OF THE RECORD
	RTEXT	(Offset	    Contents)
	STACK	X0
	LENGTH
	UNSTK	X0
	ADD	XLEN,XCUR
	ADD	X4,XCUR
	WHILE
		CAIL	X4,(XLEN)
		GOTO	FALSE
	DO
		L	X1,(X4)
		IF
			JUMPE	X1,FALSE
		THEN
			RTEXT
			L	X1,X4
			SUB	X1,XCUR
			OUTOCT
			TEXT	(:	)
			HLRZ	X1,(X4)
			OUTOCT
			TEXT	(	)
			HRRZ	X1,(X4)
			OUTOCT
		FI
		AOJ	X4,
	OD
	RETURN

SAPD5:	LI	X3,50
	LOOP
		;FIND THE LINE SYMBOL JFCL,, LINENR IN FRONT OF ZPCDEC

		HLRZ	X1,(X4)
		IF
			CAIE	X1,(JFCL)
			GOTO	FALSE
		THEN
			TEXT	( line )
			HRRZ	X1,(X4)
			OUTDEC
			SETZ	X3,
		FI
	AS
		SOJ	X4,
		SOJGE	X3,TRUE
	SA
	RETURN



	SUBTTL	DUMP OF SEQUENCING SET


	OPDEF EVDUMP	[PUSHJ	17,SQSEVD]

	DEFINE	SUCCESSOR(X)	<
		IFDIF	<X>,<XWAC1>,<L	XWAC1,X>
		LF	XTAC,ZEVZBL(XWAC1)
		LF	XSAC,ZEVZRL(XWAC1)
		IF
			JUMPE	XSAC,FALSE
			CAMN	XSAC,XWAC1
			GOTO	FALSE
		THEN
			LF	XTAC,ZEVZRL(XTAC)
			WHILE
				LF	XWAC1,ZEVZLL(XTAC)
				JUMPE	XWAC1,FALSE
			DO
				L	XTAC,XWAC1
			OD
		FI
	>

.SQSDU:	PROC
	SAVE	<X0,XSAC,XTAC,XWAC1,XWAC2>
	LOWADR(XSAC)
	L	X0,YSASW(XLOW)
	XCT	YSULEV(XLOW)
	LF	XWAC1,ZSUFT(XSAC)
	RRTEXT	(	SQS dump)
	RTEXT	(=========================================)
	WHILE
		JUMPE	XWAC1,FALSE
		LF	XWAC2,ZEVZPS(XWAC1)
		CAIN	XWAC2,NONE
		GOTO	FALSE
	DO
		EVDUMP
		SUCCESSOR(XWAC1)
		L	XWAC1,XTAC
	OD
	RTEXT	(End of SQS dump)
	RTEXT
	RETURN
	EPROC



SQSEVD:	RTEXT(Process at )
	L	X1,XWAC2
	OUTOCT
	TEXT	(EVTIME= )
	LF	X1,ZEVTIME(XWAC1)
	OUTOCT
	RTEXT	(	ZEVZBL -ZLL -ZRL: )
	LF	X1,ZEVZBL(XWAC1)
	OUTOCT
	TEXT	(	)
	LF	X1,ZEVZLL(XWAC1)
	OUTOCT
	TEXT	(	)
	LF	X1,ZEVZRL(XWAC1)
	OUTOCT
	RETURN


	SUBTTL	ROUTINES USED FOR DUMP ON SYSOUT

SAPDCO:
		;PUT THE CHARACTER IN CHAR INTO THE LOCAL IMAGE USED FOR
		; LOG AND DUMP ON SYSOUT

	PROC	<CHAR>
	SAVE	<X0,X1>
	LOWADR(X1)
	L	X0,CHAR
	IDPB	X0,YSAIBP(XLOW)
	AOS	YSAILC(XLOW)
	RETURN
	EPROC




SAPDTO:
		;PUT A ASCIZ STRING STARTING AT (X2) INTO THE LOCAL IMAGE
		; USED FOR LOG AND DUMP OUTPUT ON SYSOUT. WHEN A 'CR' IS FOUND
		; OUTPUT THE LOCAL IMAGE ON SYSOUT (SAPDOI)

	PROC
	SAVE	<X0,X16>
	LOWADR(X16)
	HRLI	X2,440700		;POINT	7,STRING,
	LOOP
		ILDB	X0,X2
		CAIN	X0,15		;'CR'
		EXEC	SAPDOI		;OUTIMAGE
	AS
		CAIE	X0,15		;IGNORE 'CR'
		CAIN	X0,12		;IGNORE 'LF'
		GOTO	TRUE
		JUMPE	X0,FALSE	;END OF STRING
		IDPB	X0,YSAIBP(XLOW)
		AOS	YSAILC(XLOW)
		GOTO	TRUE
	SA
	RETURN
	EPROC



SAPDOI:
		;OUTPUT THE LOCAL IMAGE ON SYSOUT AND REINITIATE
		; TEXT RECORD AND BYTE POINTER
	PROC
	SAVE	<X0,X1,X2,XWAC1,X5,X6>
	SETLOW(X16)
	L	XWAC1,YSYSOU(XLOW)
	LD	X5,YSAIMP(XLOW)

		;LET TEMPORARY OUTIMAGE WORK ON LOCAL IMAGE BY CHANGING
		; THE IMAGE TEXT REFERENCE IN THE FILE OBJECT FOR SYSOUT

	EXCH	X5,OFFSET(ZFIIMG)(XWAC1)
	EXCH	X6,OFFSET(ZFIICP)(XWAC1)
	EXEC	.IOOG			;OUTIMAGE
	EXCH	X5,OFFSET(ZFIIMG)(XWAC1)
	EXCH	X6,OFFSET(ZFIICP)(XWAC1)

	LI	XWAC1,OFFSET(ZTECHR)(X5)
	HRLI	XWAC1,440700
	ST	XWAC1,YSAIBP(XLOW)		;REINITIATE LOCAL IMAGE BYTE POINTER
	SETZM	(XWAC1)
	HRLS	XWAC1
	LI	X1,1(XWAC1)
	BLT	XWAC1,^D13(X1)		;CLEAR LOCAL IMAGE
	HLLZS	YSAILC(XLOW)		;CLEAR ZTVCP IN YSAILC
	RETURN
	EPROC
	SUBTTL	USEFUL OPDEF'S

	DUP=:DUP
	DUR=:DUR
	OUTOCT=:OUTOCT
	OUTDEC=:OUTDEC
	FINI=:FINI
	DUSQS=:DUSQS
	LENGTH=:LENGTH
	SUBTTL	LITERALS
	LIT
	END