Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/rts/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