Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
cobolk.mac
There are 7 other files named cobolk.mac in the archive. Click here to see a list.
; UPD ID= 2007 on 8/21/79 at 10:19 AM by N:<NIXON>
TITLE COBOLK FOR COBOL V12
SUBTTL DUMPS FOR COBOL CRASH AL BLACKINGTON/CAM/SEB
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1979 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P
%%P==:%%P
DEBUG==:DEBUG
ONESEG==:ONESEG
;EDITS
;V10*****************
;NAME DATE COMMENTS
;ACK 13-MAR-75 COMP-3/EBCDIC IN THE DUMPS, AND CHANGE THE POSITION
; OF THE USAGE FIELD.
;********************
; EDIT 347 REMOVE HALTS. REPLACE WITH MESSAGES AND RETURNS.
; EDIT 272 REMOVE EXTRANEOUS LINPAG DEFINITION HERE. IT IS DEFINED IN PURE
TWOSEG
RELOC 400000
;ACCUMULATORS
W1=11 ;FIRST OF 2 WORDS FROM GENFIL
WD=10 ;WORD FROM "GETDSK"
CT=7 ;COUNTER
DT=6
LN=5 ;NUMBER OF LINES LEFT ON PRINTER PAGE
CH=4 ;I-O CHARACTER
MX=3 ;USED IN GETPAG
SAVNAM=2 ;SAVE NAME OF DUMP FILE
SAVELN=1 ;USED IN GETPAG
SAVEOP=0 ;SAVE OP-CODE IN DMPGEN
W2=WD
CP=CT
;I/O CHANNELS
DSK==2
DMP==3
EXTERNAL VERZUN
EXTERNAL KBUFI,KBHO,KBHI,KILLPL,KILLAC
EXTERNAL PHASEN,TOPLOC,IMPURE,KDATA,PROGID
EXTERNAL PROGID,PPSIZE,PPLIST
EXTERNAL SETFAK,FAKERA
EXTERNAL PUREC
INTERNAL COBOLK
EXTERNAL IMPURE,RESTRT
EXTERNAL SETDN ;GET A DIAGNOSTIC MESSAGE
COBOLK: JRST 1,K1 ;CONCEALED MODE PATCH
Z ; (TRYING TO KEEP ENTRANCES
JRST 1,K2 ; LOOKING THE SAME)
K1: JSP 1,SETIO ;ENTRANCE TO DUMP CORE AND FILES
JRST CORE
K2: JSP 1,SETIO ;ENTRANCE TO DUMP FILES ONLY
JRST DMPFIL
;MISCELLANEOUS
KILLPP: IOWD 20,KILLPL
TYPFLG: EXP KILLPL ;1ST PDL LOC IS TYPEOUT FLAG
LINES==^D55 ;LINES PER PAGE
;THE FOLLOWING ARE CONSTANT REFERENCED BY 'COMMON'. THEY ARE NEVER USED
; IN COBOLK, BUT ARE DEFINED HERE TO GET RID OF UNDEFINED GLOBALS AT
; RUN TIME.
INTERNAL LINPAG, MLOAD1
MLOAD1="B"
LINPAG=^D56
IFE ONESEG,< INTERN WARNW
WARNW: POPJ 17,>
;SET UP I-O DEVICES
SETIO: MOVE PP,KILLPP
MOVEI TA,0 ;INIT FLAG FOR NO TYPEOUT
PUSH PP,TA
TTCALL 3,[ASCIZ "?CATASTROPHE IN PHASE "]
TTCALL 1,PHASEN
TTCALL 3,[ASCIZ ", DUMP BEING TAKEN
"]
INIT DMP,0 ;OPEN UP DISK
SIXBIT /DSK/
XWD KBHO,0
JRST NODMP1 ;[347] CAN'T INIT THE DISK, TELL HIM.
OUTBUF DMP,2
CALLI TC,30 ;GET JOB NUMBER
MOVEI TD,3
IDIVI TC,12
ADDI TB,"0"-40
LSHC TB,-6
SOJG TD,.-3
MOVE TE,.JBREL##
MOVEM TA,(TE)
HRRM 1,(TE)
MOVE TD,SRCFIL## ;DMPFIL NAME =SRCFIL NAME
JUMPN TD,.+3 ;[347] IF NO SOURCE FILE NAME GIVE IT ONE.
MOVEI TD,(SIXBIT /CBL/) ;[347] PUT CBL INTO SECOND HALF OF NAME.
HLLM TA,TD ;[347] USE JOB NUMBER FOR FIRST HALF
MOVSI TC,(SIXBIT /DMP/) ;EXTENSION "DMP"
SETZB TB,TA
MOVEM TD,SAVNAM ;SAVE FILE NAME FOR LATER TYPE-OUT
ENTER DMP,TD
JRST NODMP2 ;[347] CAN'T ENTER FILE TELL HIM.
PUSHJ PP,PUTHDR
JRST (1)
;DUMP OUT CORE
CORE:
IFN DEBUG,<
PUSHJ PP,LSTAC
PUSHJ PP,LSTPP
PUSHJ PP,LSTTBL
MOVE TE,[POINT 7,[ASCIZ "TOPLOC = "]]
PUSHJ PP,LSTMES
MOVE TE,TOPLOC
PUSHJ PP,OCTMES
MOVEI CH,15
PUSHJ PP,DMPOUT
MOVEI CH,14
PUSHJ PP,DMPOUT
MOVEI LN,LINES
MOVEI TA,137 ;DUMP JOB DATA AREA
MOVEM TA,TOPLOC
MOVE TA,[POINT 3,17,35]
PUSHJ PP,COREGO
PUSHJ PP,CRLF
PUSHJ PP,LFONLY
NEVER==1
IFE NEVER,<
HLRZ TA,.JBSA## ;DUMP FIXED PORTION OF IMPURE AREA
SUBI TA,1
MOVEM TA,TOPLOC
MOVE TA,[POINT 3,FSTCLR##-1,35]
PUSHJ PP,COREGO
>
MOVEI CH,14
PUSHJ PP,DMPOUT
MOVEI LN,LINES
PUSHJ PP,DMPTAB
>
JRST DMPFIL
IFN DEBUG,<
COREGO: MOVEI TC,1(TA) ;LINE = ZEROES?
HRLI TC,-6
SKIPE (TC)
JRST LOOP1A
AOBJN TC,.-2
JRST LZERO
;LINE IS NOT ALL ZEROES
LOOP1A: MOVEI TB,6
MOVEI TD,1(TA)
MOVE TC,[POINT 3,TD,17]
ILDB CH,TC
ADDI CH,60
PUSHJ PP,DMPOUT
SOJG TB,.-3
PUSHJ PP,SPACE3
MOVEI TB,6
LOOP2: PUSHJ PP,OCTOUT
HRRZ TD,TA
CAMGE TD,TOPLOC
SOJG TB,LOOP2
LOOP3: MOVEI CH,15
PUSHJ PP,DMPOUT
MOVEI CH,12
PUSHJ PP,DMPOUT
CAMGE TD,TOPLOC
JRST COREGO
POPJ PP,
;LINE IS ALL ZEROES
LZERO: MOVE TE,[POINT 7,DUMPM1]
PUSHJ PP,LSTMES
MOVEI TD,1(TA)
MOVE TB,[POINT 3,TD,17]
ILDB CH,TB
ADDI CH,60
PUSHJ PP,DMPOUT
TLNE TB,770000
JRST .-4
MOVE TE,[POINT 7,DUMPM2]
PUSHJ PP,LSTMES
CAMLE TC,TOPLOC
JRST .+3
SKIPN (TC)
AOJA TC,.-3
SUBI TC,1
HRRM TC,TA
MOVE TB,[POINT 3,TC,17]
ILDB CH,TB
ADDI CH,60
PUSHJ PP,DMPOUT
TLNE TB,770000
JRST .-4
MOVE TE,[POINT 7,DUMPM3]
PUSHJ PP,LSTMES
HRRZ TD,TA
JRST LOOP3
DUMPM1: ASCIZ "
LOCATIONS "
DUMPM2: ASCIZ " THRU "
DUMPM3: ASCIZ " ARE ZEROES
"
;DUMP ALL THE TABLES
DMPTAB: MOVE TB,TBLXWD
DMPTB1: SKIPN W1,(TB)
JRST DMPTB5
MOVE W1,(W1)
HRRZ TD,.JBREL ;GET HIGHEST CORE ADDRESS
HLRE TE,W1 ;IF TABLE
MOVMS TE ; IS
ADDI TE,(W1) ; ABOVE
CAIGE TD,-1(TE) ; CORE,
JRST DMPTB5 ; FORGET IT
PUSH PP,TB
PUSH PP,1(TB)
MOVE TE,[POINT 7,[ASCIZ "****** "]]
HRRZ TA,2(TB) ;IF THERE IS NO A SPECIAL ROUTINE FOR
JUMPE TA,DMPTB2 ; THIS TABLE, DO STANDARD,
SETZM LN
PUSHJ PP,TABHDR
PUSHJ PP,(TA) ; ELSE GO TO THAT ROUTINE
JRST DMPTB4
DMPTB2: MOVEI DT,0
PUSHJ PP,TABHDR
DMPTB3: PUSHJ PP,TABLIN
JUMPL W1,DMPTB3
DMPTB4: POP PP,TE
POP PP,TB
DMPTB5: ADDI TB,TTESIZ-1
AOBJN TB,DMPTB1
MOVEI CH,14
PUSHJ PP,DMPOUT
MOVEI LN,LINES
POPJ PP,
;PUT OUT A LINE OF TABLE DATA
TABLIN: PUSH PP,W1 ;SAVE XLOC
PUSH PP,DT ;SAVE RELATIVE WORD NUMBER
MOVEI TE,0
MOVE TB,-4(PP)
MOVE TB,0(TB)
TABLN1: SKIPE 0(W1)
JRST TABLN2
ADDI DT,1
CAMN W1,1(TB)
JRST TABLN2
AOBJP W1,TABLN2
AOJA TE,TABLN1
TABLN2: CAIG TE,6
JRST TABLN3
PUSHJ PP,CRLF
MOVE TE,[POINT 7,[ASCIZ " WORDS "]]
PUSHJ PP,LSTMES
PUSH PP,DT
MOVE TE,-1(PP)
PUSHJ PP,OCTMES
MOVE TE,[POINT 7,[ASCIZ " THRU "]]
PUSHJ PP,LSTMES
POP PP,TE
MOVEM TE,(PP)
SUBI TE,1
PUSHJ PP,OCTMES
MOVE TE,[POINT 7,[ASCIZ " ARE ZEROES"]]
PUSHJ PP,LSTMES
PUSHJ PP,CRLF
PUSHJ PP,LFONLY
MOVEM W1,-1(PP)
JUMPGE W1,TABLN9
CAMN W1,1(TB)
JRST TABL10
TABLN3: POP PP,DT
POP PP,W1
MOVE TE,[POINT 3,DT,20]
TABLN4: ILDB CH,TE
ADDI CH,"0"
PUSHJ PP,DMPOUT
TLNE TE,770000
JRST TABLN4
MOVEI CH,11
PUSHJ PP,DMPOUT
MOVEI TD,6
TABLN5: ADDI DT,1
MOVE TA,[POINT 3,(W1)]
PUSHJ PP,OCTOUT
CAMN W1,1(TB)
JRST TABLN6
AOBJP W1,TABLN7
SOJG TD,TABLN5
JRST TABLN7
TABLN6: AOBJP W1,.+1
PUSHJ PP,CRLF
PUSHJ PP,LFONLY
MOVE TE,STARS
PUSHJ PP,LSTMES
PUSHJ PP,CRLF
TABLN7: PUSHJ PP,CRLF
TABLN8: JUMPG LN,CPOPJ
MOVE TE,[POINT 7,[ASCIZ "****** CONTINUATION OF "]]
MOVEI TD,-1
JRST TABHDR
TABLN9: POP PP,TE
POP PP,W1
JRST TABLN8
TABL10: POP PP,TE
POP PP,W1
JRST TABLN6
;DUMP OUT NAME TABLE
NAMTAB: SKIPN DT,NAMNXT ;IF NO NAME TABLE,
POPJ PP, ; FORGET IT
CAML DT,.JBREL##
SETZM 1(DT) ;CLEAR LOC AFTER NAMTAB
MOVEI W1,1(W1) ;GET FIRST ADDRESS
NAMT1: MOVEM W1,CURNAM ;SAVE ADDRESS OF FIRST ENTRY
MOVEI TA,^D56
NAMT2: CAILE W1,(DT)
JRST NAMT3
SKIPL TE,(W1)
TLNE TE,(3B1)
AOJA W1,NAMT2
SOJLE TA,NAMT3
AOJA W1,NAMT2
NAMT3: MOVE W2,W1
EXCH W1,CURNAM
NAMT4: MOVEI TA,(W1)
PUSHJ PP,NAMT10
MOVEI W1,(TA)
MOVEI TA,(W2)
CAILE TA,(DT)
JRST NAMT6
NAMT5: MOVEI CH,11
PUSHJ PP,DMPOUT
ADDI CP,10
CAIGE CP,^D32
JRST NAMT5
PUSHJ PP,NAMT10
MOVEI W2,(TA)
NAMT6: PUSHJ PP,CRLF
CAMGE W1,CURNAM
JRST NAMT4
MOVEI LN,0
MOVE W1,W2 ;IF
CAIL W1,(DT) ; WE ARE DONE,
POPJ PP, ; GO AWAY
;DUMP OUT NAME TABLE (CONT'D)
MOVEI CH,14
PUSHJ PP,DMPOUT
MOVE TE,[POINT 7,[ASCIZ "****** CONTINUATION OF NAMTAB ******"]]
PUSHJ PP,LSTMES
MOVEI LN,LINES
PUSHJ PP,CRLF
PUSHJ PP,CRLF
JRST NAMT1
NAMT10: HRRZ TE,NAMLOC
MOVNS TE
ADDI TE,(TA)
MOVE TD,[POINT 3,TE,20]
PUSHJ PP,DMPHW1
PUSHJ PP,SPACE3
HLRZ TE,(TA)
PUSHJ PP,DMPHW
PUSHJ PP,SPACE1
HRRZ TE,(TA)
PUSHJ PP,DMPHW
PUSHJ PP,SPACE3
NAMT9:
MOVEI TA,1(TA)
MOVE CP,(TA) ;IF THAT IS AN
CAMN CP,[-1] ; EMPTY ONE,
AOJA TA,NAMT12 ; USE <EMPTY>
HRLI TA,(POINT 6,0) ;TURN 'TA' INTO A BYTE POINTER
MOVEI CP,0
NAMT11: HRRZ CH,.JBREL ;AVOID ILL MEM REF IF NAMTAB
CAIG CH,(TA) ; HAPPENS TO END AT LAST CHAR
POPJ PP, ; IN CORE
ILDB CH,TA
TRNN CH,60
JRST NAMT13
ADDI CH,40
CAIN CH,":"
MOVEI CH,"-"
CAIN CH,";"
MOVEI CH,"."
PUSHJ PP,DMPOUT
AOJA CP,NAMT11
NAMT12: MOVE TE,[POINT 7,[ASCIZ "<EMPTY>"]]
PUSHJ PP,LSTMES
MOVEI CP,7
NAMT13: SKIPL TE,(TA)
TLNE TE,(3B1)
AOJA TA,NAMT13
POPJ PP,
>
;PRINT OUT THE VALUE TABLE (VALTAB)
IFN DEBUG,<
VALTAB: SKIPN DT,VALNXT## ;EXIT IF NO VALTAB
POPJ PP,
MOVEI W1,1(W1) ;GET START OF TABLE
MOVEI WCTR,1 ;INIT WORD COUNTER
PUSHJ PP,CRLF ;FORMAT THIS STUFF
VAL1: PUSHJ PP,CRLF
LDB TCTR,[POINT 7,(W1),6] ;GET COUNT OF CHARS
HRRZ TE,WCTR ;PRINT WORD NUMBER
PUSHJ PP,DMPHW
PUSHJ PP,SPACE3
HLRZ TE,(W1)
PUSHJ PP,DMPHW
PUSHJ PP,SPACE1 ;NOW, WE'RE READY FOR CHARS
HRRZ TE,(W1) ;GET RIGHT HALF
PUSHJ PP,DMPHW
PUSHJ PP,SPACE4
MOVE TEMP,[POINT 7,(W1),6] ;PTR TO CHARACTERS
VAL2: ILDB CH,TEMP ;GET CHARACTER
PUSHJ PP,DMPOUT ;PUT IT OUT
SOJG TCTR,VAL2 ;LOOP
ADDI W1,1(TEMP) ;UPDATE PTRS
ADDI WCTR,1(TEMP)
HRRZ TEMP2,VALNXT##
AOS TEMP2
CAML W1,TEMP2 ;IS THIS THE END?
POPJ PP,
JRST VAL1
>
IFN DEBUG,<
;DUMP OUT DATA TABLE
;DEFINE A FEW WORKING REGISTERS:
TEMP=1
WCTR=10
TCTR=15
LIMIT=6
TEMP2=0
DATAB: SKIPN DT,DATNXT
POPJ PP, ;EXIT IF NO DATA TABLE
MOVEI W1,1(W1) ;GET ADDR OF 1ST ENTRY
MOVEI WCTR,1 ;INIT WORD COUNTER
SETWRD: HRRZI TCTR,1 ;INIT TEMP COUNTER
HRRZI LIMIT,^D8 ;USUAL # OF ENTRIES PER TABLE ENTRY (+1)
PUSHJ PP,CRLF
CRLF1: PUSHJ PP,CRLF
HRRZ TE,WCTR
PUSHJ PP,DMPHW ;PRINT WPRD #
PUSHJ PP,SPACE3
HLRZ TE,(W1) ;PRINT CONTENTS OF WORD
PUSHJ PP,DMPHW
PUSHJ PP,SPACE1
HRRZ TE,(W1)
PUSHJ PP,DMPHW
PUSHJ PP,SPACE4
MOVE TEMP,(W1) ;GET WORD FROM TABLE
CAIG WCTR,7 ;IGNORE 1ST DUMMY ENTRY
JRST NOT9
PUSH PP,TEMP
PUSH PP,LIMIT
SKIPE TE,DTROUT-1(TCTR) ;SPCIAL ROUTINE FOR THIS WORD?
PUSHJ PP,(TE) ;YES, GO TO IT
POP PP,LIMIT
POP PP,TEMP
CAIE TCTR,5
JRST NOTFIV
MOVEI TE,0 ;INIT ADDEND
TLNE TEMP,(1B6) ;SUBSCRIPTED?
MOVEI TE,2 ;YES, AT LEAST 2 EXTRA WORDS
TRNE TEMP,1B26 ;EDITED PICTURE?
MOVEI TE,6 ;YES, 6 EXTRA WORDS
ADDI LIMIT,(TE) ;SET NEW MAX
NOTFIV: CAIE TCTR,^D9 ;WORD 9?
JRST NOT9
HLRZ TEMP2,TEMP
ADD LIMIT,TEMP2 ;ADD LH OF WORD 9 TO LIMIT
NOT9: AOJ WCTR,
AOJ TCTR,
AOJ W1, ;...AND ENTRY POINTER
CAME TCTR,LIMIT ;END OF TABLE ENTRY?
JRST CRLF1
HRRZ TEMP,DATNXT ;GET ADDR OF LAST ENTRY
AOJ TEMP, ;BUMP IT 1
CAML W1,TEMP ;END OF TABLE?
POPJ PP, ;YES, GO AWAY
JRST SETWRD ;START OVER AGAIN
DTROUT: EXP WORD1
EXP WORD2
EXP WORD3
EXP WORD4
EXP WORD5
EXP WORD6
EXP WORD7
EXP WORD8
EXP WORD9
EXP WORD10
EXP WORD11
EXP WORD11
EXP WORD11
EXP WORD14
EXP WORD14
EXP WORD14
EXP WORD14
EXP WORD14
EXP WORD14
DEFINE GET(TEXT),<
MOVE TE,[POINT 7,[ASCIZ "TEXT"]]
>
DEFINE PUT(TEXT),<
GET <TEXT>
PUSHJ PP,LSTMES
>
DEFINE JPUT(TEXT),<
GET <TEXT>
PJRST LSTMES
>
WORD3: TLNE TEMP,-1 ;FATHER?
JRST GOTFTH ;YES
MOVE TE,[POINT 7,[ASCIZ "NO FATHER"]]
PUSHJ PP,LSTMES
JRST GETSON
GOTFTH: HLRZ TEMP2,2(W1) ;CHECK WORD 5
TRNE TEMP2,1B26 ;FATHER OR BROTHER?
SKIPA TE,[POINT 7,[ASCIZ "FATHER IS "]]
GET <BROTHER IS >
PUSHJ PP,LSTMES
HLRZ TE,TEMP
PUSHJ PP,TABPTR
GETSON: TRNE TEMP,-1
JRST GOTSON
MOVE TE,[POINT 7,[ASCIZ ", NO SON"]]
PJRST LSTMES
GOTSON: MOVE TE,[POINT 7,[ASCIZ ", SON IS "]]
PUSHJ PP,LSTMES
HRRZ TE,TEMP
PJRST TABPTR
WORD4: MOVE TE,[POINT 7,[ASCIZ "LEVEL#="]]
PUSHJ PP,LSTMES
HLRZ TE,TEMP
TRZ TE,7777 ;ISOLATE LEVEL #
LSH TE,^D-12 ;SHIFT IT RIGHT
CAIN TE,77 ;LEVEL 77 STORED AS OCTAL 77
MOVEI TE,^D77 ;CONVERT TO DEC.
CAIN TE, 76 ;LEVEL 66 STORED AS OCTAL 76
MOVEI TE, ^D66 ;GET THE RIGHT NUMBER.
PUSHJ PP,DECMES
TLNN TEMP,7700
JRST RPWLNK
MOVE TE,[POINT 7,[ASCIZ ", BYTE-RESIDUE="]]
PUSHJ PP,LSTMES
HLRZ TE,TEMP
TRZ TE,770000
LSH TE,-6
PUSHJ PP,OCTMES
MOVE TE, [POINT 7,[ASCIZ ", "]]
PUSHJ PP, LSTMES
HLRZ TE, TEMP
ANDI TE, 17 ;ISOLATE THE USAGE.
XCT USAGE(TE) ;GET THE TEXT.
PUSHJ PP, LSTMES ;GO PRINT IT.
RPWLNK: TRNN TEMP,-1
POPJ PP,
MOVE TE,[POINT 7,[ASCIZ ",RPWTAB LINK="]]
PUSHJ PP,LSTMES
HRRZ TE,TEMP
PJRST DMPHW
TABPTR: MOVE TA,TE
TRZ TE,77777 ;ISOLATE TABLE CODE
JUMPN TE,FTH ;GO AWAY IF NAMTAB
GET <FILE >
PUSHJ PP,LSTMES
ADD TA,FILLOC
HRRZS TA
HLRZ TA,(TA) ;GET NAMTAB ENTRY
JRST W1SUB
FTH: TRZ TA,7B20 ;ISOLATE TABLE OFFSET
ADD TA,DATLOC
TLZ TA,-1
HLRZ TA,(TA)
JRST W1SUB ;PRINT NAME TABLE ENTRY
WORD2: HLRZ TE,TEMP ;ANY VALUE OR LINKAGE PTR?
JUMPE TE,WORD2B ;NO
CAIGE TE,100000 ;YES, WHICH
JRST WORD2A ;LINK PTR
PUT <VALUE LINK=>
HLRZ TE,TEMP
PUSHJ PP,DMPHW
JRST WORD2B
WORD2A: PUT <LINK PTR AT %PARAM+>
HLRZ TE,TEMP
PUSHJ PP,DECMES
WORD2B: HRRZ TE,TEMP ;ANY ADDRESS?
JUMPE TE,CPOPJ
HLRZ TE,TEMP ;PREVIOUS PRINTING?
JUMPE TE,WORD2C ;NO
PUT <, >
WORD2C: PUT <ADDRESS=BASE+>
HRRZ TE,TEMP
PJRST DMPHW
WORD5: HLRZ CH,TEMP
LSH CH,-20
AND CH,[3] ;ISOLATE CLASS DIGIT
XCT CLASS(CH) ;GET CLASS TEXT
PUSHJ PP,LSTMES
MOVE TE,[POINT 7,[ASCIZ ", "]]
PUSHJ PP,LSTMES
COMMENT \ ;THE FOLLOWING CODE DELETED 13-MAR-75 /ACK
HLRZ CH,TEMP
TRZ CH,-10 ;ISOLATE RIGHT DIGIT
XCT USAGE(CH) ;GET USAGE TEXT
PUSHJ PP,LSTMES
\
HLRZ TE,TEMP ;NUMERIC CLASS?
TRZ TE,177777
CAIE TE,200000
JRST WORD5A ;NO
MOVE TE,[POINT 7,[ASCIZ ", "]]
PUSHJ PP,LSTMES
HRRZ TE,TEMP
TRZ TE,777740
PUSH PP,TCTR
PUSHJ PP,DECMES
POP PP,TCTR
MOVE TE,[POINT 7,[ASCIZ " DEC. PLACES"]]
PUSHJ PP,LSTMES
WORD5A: AND TEMP,[17777B14+17777B30]
JUMPE TEMP,CPOPJ
PUSH PP,TCTR
MOVEI TCTR,0 ;INIT TABLE INDEX
WORD5B: JUMPE TEMP,WORD5D ;FINISHED FLAGS?
JUMPG TEMP,WORD5C ;NO, THIS FLAG ON?
SKIPN FLAG(TCTR) ;YES, ANY TEXT FOR IT?
JRST WORD5C ;NO
MOVE TE,[POINT 7,[ASCIZ ", "]]
PUSHJ PP,LSTMES
XCT FLAG(TCTR) ;GET PTR TO TEXT
PUSHJ PP,LSTMES
WORD5C: LSH TEMP,1 ;SHIFT FLAGS LEFT
AOJA TCTR,WORD5B ;BUMP INDEX
WORD5D: POP PP,TCTR ;RESTORE
POPJ PP,
;TABLE OF TEXT FOR CLASS AND USAGE BITS:
CLASS: GET <ALPHANUMERIC>
GET <ALPHABETIC>
GET <NUMERIC>
GET <NIL CLASS>
USAGE: GET <NIL USAGE>
GET <DISPLAY-6>
GET <DISPLAY-7>
GET <DISPLAY-9>
GET <1-WORD COMP>
GET <2-WORD COMP>
GET <COMP-1>
GET <INDEX>
GET <COMP-3>
FLAG: Z
Z
GET <SYNC LEFT>
GET <SYNC RIGHT>
GET <SIGNED>
GET <BWZ>
GET <SUBSCR>
GET <EDITED>
Z
GET <DEF>
GET <REF BY SUM>
GET <FAKE>
GET <REF BY SRC>
GET <SUM-CTR>
GET <JUST>
Z
Z
Z
GET <ERROR>
GET <INDEX>
GET <REDEF>
GET <PIC>
GET <FILE SEC>
GET <DATA REC>
GET <LAB REC>
GET <SYNC AT LL>
GET <PIC WDS>
GET <VAL AT HL>
GET <REDF AT HL>
GET <LINKAGE>
GET <SCALED>
WORD6: GET <EXTRN SIZE=>
PUSHJ PP,LSTMES
HLRZ TE,TEMP
PUSHJ PP,DECMES
GET <, INTRN SIZE=>
PUSHJ PP,LSTMES
HRRZ TE,TEMP
PJRST DECMES
WORD1: HLRZ TA,TEMP
PUSHJ PP,W1SUB
HRRZ TE,TEMP ;ANY SAME NAME LINK?
JUMPE TE,CPOPJ ;NO
PUT < (SAME AS >
HRRZ TE,TEMP
PUSHJ PP,DMPHW
JPUT <)>
W1SUB: TRZ TA,7B20 ;CLEAR TABLE ID (LEFT 3 BITS)
ADD TA,NAMLOC ;ADD START OF NAME TABLE
TLZ TA,-1 ;CLEAR LH
CAML TA,.JBREL ; [304] WITHIN BOUNDS?
POPJ PP, ; [304] NO-EXIT
HRRZ TE,(TA)
JUMPE TE,CPOPJ ;ANY NAME?
PJRST NAMT9 ;YES, PRINT
WORD7: TLNN TEMP,77777 ;ANY OCCURANCES?
JRST NOOCR
GET <OCCURS >
PUSHJ PP,LSTMES
HLRZ TE,TEMP
LSH TE,-3
PUSHJ PP,DECMES
GET <, >
PUSHJ PP,LSTMES
NOOCR: MOVE TE,TEMP
AND TE,[17777B28]
JUMPE TE,NOLINE
PUSH PP,TE
GET <LINE >
PUSHJ PP,LSTMES
POP PP,TE
LSH TE,-7
PUSHJ PP,DECMES
GET <, >
PUSHJ PP,LSTMES
NOLINE: AND TEMP,[177]
SKIPN TEMP
POPJ PP,
GET <CHAR >
PUSHJ PP,LSTMES
HRRZ TE,TEMP
PJRST DECMES
WORD10: JUMPE TEMP,CPOPJ ;EXIT IF ZERO
HLRZ TE,TEMP
TRZ TE,7777 ;GET PICTURE CHARACTER
JUMPE TE,NOPICT ;LEAVE IF ZERO
LDB CH,[POINT 6,TE,23]
PUSH PP,CH
GET <SIGN CHAR IS >
PUSHJ PP,LSTMES
POP PP,CH
PUSHJ PP,DMPSIX ;PRINT SIXBIT CHAR.
GET <, >
PUSHJ PP,LSTMES
NOPICT: HLRZ TE,TEMP
TRZ TE,770077 ;GET FLOAT CHAR
JUMPE TE,NOFLT
LDB CH,[POINT 6,TE,29]
PUSH PP,CH
GET <FLOAT CHAR IS >
PUSHJ PP,LSTMES
POP PP,CH
PUSHJ PP,DMPSIX
GET <, >
PUSHJ PP,LSTMES
NOFLT: MOVE TEMP2,[POINT 4,TEMP,11] ;GET PTR TO BYTES
TLZ TEMP,777700 ;CHECK FOR NON-0 BYTES
JUMPE TEMP,CPOPJ ;EXIT IF SO
MOVEI CT,6 ;SET UP CTR
WR10.B: GET <BYTES ARE: >
PUSHJ PP,LSTMES
NOFLT2: ILDB TE,TEMP2 ;GET BYTE
PUSHJ PP,OCTMES
SOJE CT,CPOPJ
GET <,>
PUSHJ PP,LSTMES ;PRINT COMMA
JRST NOFLT2
WORD11: MOVEI CT,^D9 ;9 BYTES PER WORD
MOVE TEMP2,[POINT 4,TEMP]
JUMPE TEMP,CPOPJ ;EXIT IF NO BES
JRST WR10.B
WORD8: TLNN TEMP,77777 ;HIGHER OCCURS?
JRST WORD8A ;NO
PUT <HIGHER OCCURS AT >
HLRZ TE,TEMP
PUSHJ PP,DMPHW
PUT <, >
WORD8A: TRNN TEMP,77777 ;DEPENDING ITEM?
POPJ PP,
PUT <DEPENDING ON >
HRRZ TE,TEMP
PJRST DMPHW
WORD9: TRNN TEMP,77777 ;INDEXED BY?
POPJ PP,
PUT <INDEXED BY >
HRRZ TE,TEMP
PJRST DMPHW
WORD14: SKIPN TEMP ;ANY SEARCH KEY?
JRST CPOPJ ;NO
SKIPG TEMP ;ADVANCING OR DESCENDING?
JRST W14B ;DESCENDING
PUT <ADVANCING KEY=>
JRST W14C
W14B: PUT <DESCENDING KEY=>
W14C: HRRZ TE,TEMP
PJRST DMPHW
>
;DUMP OUT ALL THE FILES
DMPFIL: INIT DSK,14
SIXBIT "DSK"
XWD 0,KBHI
JRST 4,.-3
PUTFIL: MOVEI LN,LINES ;SET LN TO # OF LINES
MOVE DT,DEVXWD ;SET DT TO TABLE OF FILE NAMES
PUTFL1: MOVE TE,(DT) ;GET NEXT FILE NAME
JUMPE TE,PUTFL2
MOVE TD,.JBREL
HLL TE,(TD)
MOVSI TD,645560
SETZB TC,TB
SETSTS DSK,0 ;CLEAR ANY ERROR FLAGS
MOVEI TA,KBUFI
MOVEM TA,.JBFF##
INBUF DSK,2
LOOKUP DSK,TE
JRST NOGOT
PUSHJ PP,GETDSK
JRST NOTANY
PUSHJ PP,@1(DT)
PUTFL2: ADDI DT,1
AOBJN DT,PUTFL1
;END OF DUMPS
TTCALL 3,[ASCIZ "PLEASE PRINT DSK:"]
MOVE TE,SAVNAM ;GET FILE NAME
PUSHJ PP,SIXTTY ;TYPE IT OUT
TTCALL 3,[ASCIZ ".DMP, AND SUBMIT
A MACHINE READABLE COPY OF THE SOURCE FILE WITH AN SPR
"]
DMPEND: CLOSE DMP,
;GET BACK TO COBOLA
MOVEI TA,"K"
MOVEM TA,PHASEN
MOVE 0,KILLAC
JRST RESTRT
NOGOT: PUSHJ PP,LSTFN
MOVE TE,[POINT 7,[ASCIZ " - NOT FOUND
"]]
NOGOTA: PUSHJ PP,LSTMES
SUBI LN,2
JRST PUTFL2
NOTANY: PUSHJ PP,LSTFN
MOVE TE,[POINT 7,[ASCIZ " - FOUND EMPTY
"]]
JRST NOGOTA
NODMP1: TTCALL 3,[ASCIZ "?CAN NOT INITIALIZE THE DISK FOR DUMP
"] ;[347]
JRST DMPEND ;[347] LET'S GET OUT OF HERE.
NODMP2: TTCALL 3,[ASCIZ "?CAN NOT OPEN DUMP FILE: "] ;[347]
MOVE TE,SAVNAM ;[347] GET FILE NAME.
PUSHJ PP,SIXTTY ;[347] TYPE IT OUT.
JRST DMPEND ;[347] LET'S GET OUT OF HERE.
;GET A PAGE OF FILE DATA
GETPAG: PUSHJ PP,LSTFNA
GTPAG0: MOVEI MX,0
MOVEM LN,SAVELN
MOVE TA,LN
IMULI TA,6
GTPAG2: MOVEM WD,KDATA(MX)
ADDI MX,1
PUSHJ PP,GETDSK
JRST PAGOUT
CAMGE MX,TA
JRST GTPAG2
PUSHJ PP,PAGOUT
JRST GTPAG0
;PRINT OUT CPYFIL IF NOT PHASE G
DMPCPY: MOVE TE,PHASEN
CAIN TE,"G"
POPJ PP,
PUSHJ PP,LSTFNA
JRST DCPY2
DCPY1: PUSHJ PP,GETDSK
JRST DCPY9
TRNN WD,1
JRST DCPY3
PUSHJ PP,EOP
DCPY2: LDB TE,CPYLN
PUSHJ PP,DECMES
MOVEI CH,11
PUSHJ PP,DMPOUT
SKIPA TA,[POINT 7,WD,20]
DCPY3: MOVE TA,[POINT 7,WD]
DCPY4: ILDB CH,TA
SKIPE CH
PUSHJ PP,DMPOUT
TLNE TA,760000
JRST DCPY4
JRST DCPY1
DCPY9: MOVEI CH,14
PUSHJ PP,DMPOUT
MOVEI LN,LINES
POPJ PP,
CPYLN: POINT 13,WD,20
IFN DEBUG,<
;DUMP GENFIL
DMPGEN: PUSHJ PP,LSTFNA
JRST DGEN1
DGEN0: PUSHJ PP,GETDSK
JRST DGEN9 ;E-O-F
DGEN1: MOVE W1,WD
MOVE TA,[POINT 3,WD]
PUSHJ PP,OCTOUT
PUSHJ PP,GETDSK
HRRZI WD,0
MOVE TA,[POINT 3,WD]
PUSHJ PP,OCTOUT
TLNE W1,1B18 ;OPERATOR?
JRST DGEN6 ;NO
;DUMP OUT GENFIL (CONT'D).
;PRINT OUT OPERATOR
LDB TE,[POINT 8,WD,35]
MOVEM TE,SAVEOP
CAIN TE,377 ;ENDIT?
JRST DGEN9A ;YES
CAILE TE,LASTOP ;NO--IN BOUNDS?
JRST DGEN3 ;NO
MOVE TE,OPTAB(TE) ;YES--GET OPERATOR MNEMONIC
PUSHJ PP,SIXMES
DGEN2: MOVE TE,[POINT 7,[ASCIZ " OPERATOR, "]]
PUSHJ PP,LSTMES
TLNE W1,177B33 ;ANY FLAGS?
JRST DGEN4 ;YES
MOVE TE,[POINT 7,[ASCIZ "NO FLAGS,"]]
PUSHJ PP,LSTMES
JRST DGEN10
DGEN3: PUSHJ PP,OCTMES
JRST DGEN2
DGEN4: MOVE TE,[POINT 7,[ASCIZ "FLAGS "]]
PUSHJ PP,LSTMES
MOVEI TA,1B27
MOVEI TB,^D9
DGEN5: MOVE TE,TB
TLNN W1,(TA)
JRST DGEN5A
PUSHJ PP,DECMES
MOVEI CH,","
PUSHJ PP,DMPOUT
DGEN5A: LSH TA,-1
CAIE TA,1B34
AOJA TB,DGEN5
JRST DGEN10
;DUMP GENFIL (CONT'D).
;PRINT OPERAND
DGEN6: TLNE W1,GNLIT ;LITERAL?
JRST DGEN7 ;YES
LDB TE,[POINT 3,WD,20]
CAIE TE,1
JRST DGEN6C
MOVE TE,[POINT 7,[ASCIZ "USAGE "]]
PUSHJ PP,LSTMES
LDB TE,[POINT 4,W1,13]
PUSHJ PP,OCTMES
MOVE TE,[POINT 7,[ASCIZ " AT "]]
PUSHJ PP,LSTMES
DGEN6C: PUSHJ PP,LSTLNK
LDB TE,[POINT 3,WD,20]
CAIE TE,1
JRST DGEN6A
MOVE TE,[POINT 7,[ASCIZ ", SYNC LEFT"]]
TLNE W1,1B23
PUSHJ PP,LSTMES
MOVE TE,[POINT 7,[ASCIZ ", SYNC RIGHT"]]
TLNE W1,1B24
PUSHJ PP,LSTMES
TLNN W1,1B25
SKIPA TE,[POINT 7,[ASCIZ ", NON-NUMERIC"]]
MOVE TE,[POINT 7,[ASCIZ ", NUMERIC"]]
PUSHJ PP,LSTMES
MOVE TE,[POINT 7,[ASCIZ ", JUST RIGHT"]]
TLNE TE,1B26
PUSHJ PP,LSTMES
LDB TA,[POINT 7,W1,15]
JUMPE TA,DGEN6A
MOVE TE,[POINT 7,[ASCIZ ", STASH "]]
PUSHJ PP,LSTMES
MOVE TE,TA
PUSHJ PP,OCTMES
DGEN6A: MOVE TE,[POINT 7,[ASCIZ ", IGNORE ERRORS"]]
TLNE WD,1B18
PUSHJ PP,LSTMES
MOVE TE,[POINT 7,[ASCIZ ", ROUNDED"]]
TLNE WD,1B19
PUSHJ PP,LSTMES
LDB TA,[POINT 6,WD,17]
JUMPE TA,DGEN6B
MOVE TE,[POINT 7,[ASCIZ ", "]]
PUSHJ PP,LSTMES
MOVE TE,TA
PUSHJ PP,DECMES
MOVE TE,[POINT 7,[ASCIZ " SUBSCRIPTS"]]
PUSHJ PP,LSTMES
DGEN6B: PUSHJ PP,EOP
JRST DGEN0
;DUMP GENFIL (CONT'D).
;DUMP LITERAL OPERAND
DGEN7: TLNN W1,GNFIGC ;FIGURATIVE CONSTANT?
JRST DGEN8 ;NO
IFN ANS68,<
MOVEI TA,GNTODY ;YES, START AT THE FRONT
>
IFN ANS74,<
MOVEI TA,GNFCS ;NO TODAY OR TALLY FOR COBOL-74
>
MOVEI TB,FCTAB
IFN ANS74,<
TLNN W1,GNTODY ;TODAY IS SPECIAL IN COBOL-74
JRST DGEN7A ;NOT
LDB TE,[POINT 2,W1,7] ;GET DAY, DATE, TIME BITS
MOVE TE,TODTAB-1(TE) ;GET CORRESPONDING NAME
PUSHJ PP,LSTMES
JRST DGEN7B
>
DGEN7A: MOVE TE,(TB)
TLNE W1,(TA)
PUSHJ PP,LSTMES
LSH TA,-1
CAIE TA,<GNALL>_-1
AOJA TB,DGEN7A
DGEN7B: PUSHJ PP,EOP
JRST DGEN0
DGEN8: TLNE W1,1B20
SKIPA TE,[POINT 7,[ASCIZ "NUMERIC"]]
MOVE TE,[POINT 7,[ASCIZ "NON-NUMERIC"]]
PUSHJ PP,LSTMES
MOVE TE,[POINT 7,[ASCIZ " LITERAL AT "]]
PUSHJ PP,LSTMES
PUSHJ PP,LSTLNK
PUSHJ PP,EOP
JRST DGEN0
>
;END OF GENFIL DUMP
DGEN9: SETZM @TYPFLG ;CLR TYPEOUT FLAG
MOVEI CH,14
PUSHJ PP,DMPOUT
MOVEI LN,LINES
POPJ PP,
DGEN9A: MOVE TE,[POINT 7,[ASCIZ "ENDIT OPERATOR
"]]
PUSHJ PP,LSTMES
JRST DGEN9
IFN DEBUG,<
;END OF GENFIL LINE
DGEN10: PUSHJ PP,EOLINE
CAIN LN,LINES
JRST DGEN0
CAIL SAVEOP,NOCR1
CAILE SAVEOP,NOCR2
SKIPA
JRST DGEN0
CAIL SAVEOP,NOCR3
CAILE SAVEOP,NOCR4
PUSHJ PP,EOP1
JRST DGEN0
>
;DUMP THE ERROR FILE
DMPERA: SETOM @TYPFLG ;SET FLAG FOR TYPEOUT OF ERAFIL
PUSHJ PP,LSTFNA
MOVE TA,SETFAK ;SET UP FAKE DIAG MESSAGE
HRRZ TB,TA
HRRI TA,FAKERA
BLT TA,FAKERA-1(TB)
JRST DMPE2
DMPE1: PUSHJ PP,GETDSK
JRST DGEN9 ;E-O-F -- QUIT
DMPE2: JUMPLE WD,DGEN9
MOVE TE,[POINT 7,[ASCIZ "DIAG #"]]
PUSHJ PP,LSTMES
LDB TE,[POINT 10,WD,35]
PUSHJ PP,DECMES
LDB TE,[POINT 10,WD,35]
CAIL TE,^D500
CAILE TE,^D550
JRST DMPE4
MOVE TE,[POINT 7,[ASCIZ " WITH ADDED DATA "]]
PUSHJ PP,LSTMES
PUSH PP,WD
PUSHJ PP,GETDSK
JRST DMPE5 ;E-O-F
PUSHJ PP,LSTLNK
DMPE3: POP PP,WD
DMPE4: MOVE TE,[POINT 7,[ASCIZ ", FROM PHASE "]]
PUSHJ PP,LSTMES
LDB CH,[POINT 3,WD,24]
ADDI CH,"A"-1
PUSHJ PP,DMPOUT
MOVEI CH,","
PUSHJ PP,DMPOUT
LDB W1,[POINT 20,WD,21]
PUSHJ PP,LNCP ;PRINT LN&CP
MOVEI CH,11
PUSHJ PP,DMPOUT
MOVE TB,WD
PUSHJ PP,SETDN
DMPE4A: ILDB CH,TE
JUMPE CH,DMPE4B
PUSHJ PP,DMPOUT
CAIE CH,12
JRST DMPE4A
SOS LN
MOVEI CH,11
PUSHJ PP,DMPOUT
PUSHJ PP,DMPOUT
PUSHJ PP,DMPOUT
JRST DMPE4A
DMPE4B: PUSHJ PP,EOP
JRST DMPE1
DMPE5: MOVE TE,[POINT 7,[ASCIZ "WHICH ISN'T HERE"]]
PUSHJ PP,LSTMES
JRST DMPE3
;PUT OUT "LINE X-Y" FOLLOWED BY A <C.R.>
EOLINE: PUSHJ PP,LNCP
;PUT OUT <C.R.>, AND PRINT HEADER IF NECESSARY
EOP: MOVEI CH,15
PUSHJ PP,DMPOUT
EOP1: MOVEI CH,12
PUSHJ PP,DMPOUT
SOJG LN,CPOPJ
MOVEI CH,14
PUSHJ PP,DMPOUT
MOVEI LN,LINES
MOVE TE,[POINT 7,[ASCIZ "****** CONTINUATION OF "]]
JRST LSTFNB
;PUT OUT <C.R.>
CRLF: MOVEI CH,15
PUSHJ PP,DMPOUT
;PUT OUT <L.F.>
LFONLY: MOVEI CH,12
PUSHJ PP,DMPOUT
SOJA LN,CPOPJ
;PUT OUT "LINE X-Y"
LNCP: MOVE TE,[POINT 7,[ASCIZ " LINE "]]
PUSHJ PP,LSTMES
LDB TE,[POINT 13,W1,28]
PUSHJ PP,DECMES
MOVEI CH,"-"
PUSHJ PP,DMPOUT
LDB TE,[POINT 7,W1,35]
JRST DECMES
;PRINT OUT ONE PAGE
PAGOUT: MOVE TB,SAVELN
SUB TB,LN
CAIL TB,(MX)
POPJ PP,
PAGO1: MOVE TA,[POINT 3,KDATA(TB)]
PUSHJ PP,OCTOUT
PUSHJ PP,SPACE4
ADD TB,SAVELN
CAIGE TB,(MX)
JRST PAGO1
MOVEI CH,15
PUSHJ PP,DMPOUT
SOJLE LN,PAGO3
MOVEI CH,12
PUSHJ PP,DMPOUT
JRST PAGOUT
PAGO3: MOVEI CH,14
PUSHJ PP,DMPOUT
MOVEI LN,LINES
POPJ PP,
IFN DEBUG,<
;LIST THE AC'S
LSTAC: MOVE TE,[POINT 7,[ASCIZ "ACCUMULATORS"]]
PUSHJ PP,LSTMES
PUSHJ PP,CRLF
PUSHJ PP,LFONLY
MOVSI TB,-6
PUSHJ PP,LSTAC1
HRLI TB,-6
PUSHJ PP,LSTAC1
HRLI TB,-4
PUSHJ PP,LSTAC1
PUSHJ PP,LFONLY
JRST LFONLY
LSTAC1: MOVE TA,[POINT 3,KILLAC(TB)]
PUSHJ PP,OCTOUT
AOBJN TB,LSTAC1
JRST CRLF
;LIST THE PUSH-DOWN LIST
LSTPP: MOVE TE,[POINT 7,[ASCIZ "PUSH-DOWN LIST"]]
PUSHJ PP,LSTMES
PUSHJ PP,CRLF
MOVE TA,[POINT 3,PPLIST]
MOVE TB,[XWD PPSIZE,PPLIST-1]
CAMN TB,KILLAC+17
JRST LSTPP3
PUSHJ PP,LFONLY
LSTPP1: MOVEI DT,6
LSTPP2: PUSHJ PP,OCTOUT
AOBJP TB,LSTPP6
CAMN TB,KILLAC+17
JRST LSTPP3
SOJG DT,LSTPP2
PUSHJ PP,CRLF
JRST LSTPP1
LSTPP3: PUSHJ PP,CRLF
MOVE TE,STARS
PUSHJ PP,LSTMES
PUSHJ PP,CRLF
LSTPP4: MOVEI DT,6
LSTPP5: PUSHJ PP,OCTOUT
AOBJP TB,LSTPP6
SOJG DT,LSTPP5
PUSHJ PP,CRLF
JRST LSTPP4
LSTPP6: PUSHJ PP,CRLF
PUSHJ PP,LFONLY
JRST LFONLY
;LIST TABLE PARAMETERS
LSTTBL: MOVE TE,[POINT 7,[ASCIZ "TABLE PARAMETERS
TABLE LOC NXT CUR"]]
PUSHJ PP,LSTMES
SUBI LN,2
PUSHJ PP,CRLF
PUSHJ PP,LFONLY
MOVE TB,TBLXWD
LSTBL1: MOVE TE,1(TB)
PUSHJ PP,SIXMES
MOVE DT,0(TB)
MOVE TA,0(DT)
PUSHJ PP,LSTBL3
MOVE TA,1(DT)
PUSHJ PP,LSTBL3
MOVE TA,2(DT)
PUSHJ PP,LSTBL4
PUSHJ PP,CRLF
ADDI TB,TTESIZ-1
AOBJN TB,LSTBL1
PUSHJ PP,LFONLY
JRST LFONLY
LSTBL3: MOVEI CH,11
PUSHJ PP,DMPOUT
HLRE TE,TA
PUSHJ PP,DECMES
MOVEI CH,","
PUSHJ PP,DMPOUT
HRRZ TE,TA
JRST OCTMES
LSTBL4: MOVEI CH,11
PUSHJ PP,DMPOUT
HLRZ TE,TA
PUSHJ PP,OCTMES
MOVEI CH,","
PUSHJ PP,DMPOUT
HRRZ TE,TA
JRST OCTMES
;PRINT OUT HEADING LINE FOR TABLE DUMPS
;ENTER WITH A GUESS AT NUMBER OF
; WORDS TO BE PRINTED, IN 'TD'.
TABHDR: CAIG LN,10
JRST TABHD1
PUSHJ PP,CRLF
PUSHJ PP,CRLF
PUSHJ PP,CRLF
PUSHJ PP,CRLF
JRST TABHD2
TABHD1: MOVEI CH,14
CAIE LN,LINES
PUSHJ PP,DMPOUT
MOVEI LN,LINES
TABHD2: PUSHJ PP,LSTMES
MOVE TE,-1(PP)
PUSHJ PP,SIXMES
MOVE TE,[POINT 7,[ASCIZ " ****** STARTS AT "]]
PUSHJ PP,LSTMES
MOVE TE,-2(PP)
HRRZ TE,@(TE)
PUSHJ PP,OCTMES
PUSHJ PP,CRLF
JRST LFONLY
>
;PUT OUT SOME SPACES ONTO DISK
SPACE4: MOVEI CH," "
PUSHJ PP,DMPOUT
SPACE3: MOVEI CH," "
PUSHJ PP,DMPOUT
MOVEI CH," "
PUSHJ PP,DMPOUT
SPACE1: MOVEI CH," "
JRST DMPOUT
;PUT OUT A SIXBIT CHARACTER ONTO DISK
DMPSIX: ADDI CH,40
;PUT OUT AN ASCII CHARACTER ONTO DISK
DMPOUT: SOSG KBHO+2
JRST DMPO2
DMPO1: SKIPE @TYPFLG ;TYPEOUT FLAG ON?
TTCALL 1,CH ;YES, TYPE CHAR TOO
IDPB CH,KBHO+1
POPJ PP,
DMPO2: OUT DMP,
JRST DMPO1 ;NO ERRORS
TTCALL 3,[ASCIZ "ERROR WHILE WRITING DUMP FILE
"]
RELEASE DMP,
RELEASE DSK,
CALLI 12
;PUT A STRING OF TEXT ONTO DUMP FILE
LSTMES: ILDB CH,TE
JUMPE CH,CPOPJ
PUSHJ PP,DMPOUT
JRST LSTMES
;PUT OUT A SIXBIT WORD ONTO TTY
SIXTTY: MOVE TD,[POINT 6,TE]
SIXTT1: ILDB CH,TD
JUMPE CH,CPOPJ
ADDI CH,40
TTCALL 1,CH
TLNE TD,770000
JRST SIXTT1
CPOPJ: POPJ PP,
;PUT OUT TE ONT DUMP FILE, IN OCTAL, AS <LH>,,<RH>.
DMPFW: MOVSS TE
PUSHJ PP, DMPHW
MOVEI CH, ","
PUSHJ PP, DMPOUT
PUSHJ PP, DMPOUT
MOVSS TE
;PUT RH OF TE ONTO DUMP FILE, IN OCTAL.
DMPHW: MOVE TD,[POINT 3,TE,17]
DMPHW1: ILDB CH,TD
ADDI CH,"0"
PUSHJ PP,DMPOUT
TLNE TD,770000
JRST DMPHW1
POPJ PP,
;PRINT OUT CONTENTS OF "TE" IN OCTAL
OCTMES: MOVE TD,[POINT 3,TE]
ILDB CH,TD
TLNE TD,770000
JUMPE CH,.-2
OCTM2: ADDI CH,"0"
PUSHJ PP,DMPOUT
TLNN TD,770000
POPJ PP,
ILDB CH,TD
JRST OCTM2
;PRINT OUT CONTENTS OF "TE" IN DECIMAL
DECMES: MOVSI TC,17B21
JUMPGE TE,DECM1
MOVEI CH,"-"
PUSHJ PP,DMPOUT
MOVMS TE
DECM1: IDIVI TE,^D10
LSHC TD,-4
JUMPN TE,DECM1
DECM2: MOVEI TD,0
LSHC TD,4
CAIN TD,17
POPJ PP,
MOVEI CH,"0"(TD)
PUSHJ PP,DMPOUT
JRST DECM2
;PRINT OUT A TABLE ADDRESS
LSTLNK: TLNN WD,1B20 ;FLOTAB?
JRST LSTLN1 ;NO
MOVE TE,[POINT 7,[ASCIZ "FLOTAB+"]]
JRST LSTLN2
LSTLN1: LDB TE,[POINT 3,WD,20]
MOVE TE,OPNTAB(TE)
LSTLN2: PUSHJ PP,LSTMES
LDB TE,[POINT 15,WD,35]
JRST OCTMES
;GET A WORD FROM A SCRATCH FILE
GETDSK: SOSG KBHI+2
JRST GETD3
GETD1: ILDB WD,KBHI+1
AOS (PP)
GETD2: POPJ PP,
GETD3: IN DSK,
JRST GETD1
GETSTS DSK,WD
TRNN WD,740000
JRST GETD2
TTCALL 3,[ASCIZ "ERROR READING SCRATCH FILE
TYPE 'CONTINUE' TO IGNORE ERROR
"]
CALLI 1,12
SETSTS DSK,0
JRST GETD3
;PRINT OUT CONTENTS OF A WORD
OCTOUT: MOVEI CT,6
ILDB CH,TA
ADDI CH,60
PUSHJ PP,DMPOUT
SOJG CT,.-3
TLNN TA,770000
JRST SPACE4
PUSHJ PP,SPACE1
JRST OCTOUT
;PRINT OUT FILE NAME AT TOP OF PAGE
LSTFNA: MOVEI CH,14
CAIE LN,LINES
PUSHJ PP,DMPOUT
MOVE TE,[POINT 7,[ASCIZ "****** "]]
LSTFNB: PUSHJ PP,LSTMES
PUSHJ PP,LSTFN
MOVE TE,[POINT 7,[ASCIZ " ******
"]]
PUSHJ PP,LSTMES
MOVEI LN,LINES-2
POPJ PP,
;PRINT OUT FILE NAME
LSTFN: MOVS TE,(DT)
HRRI TE,(SIXBIT "FIL")
;PRINT A SIXBIT WORD
SIXMES: SKIPA TD,[POINT 6,TE]
SIXM1: PUSHJ PP,DMPSIX
TLNN TD,770000
POPJ PP,
ILDB CH,TD
JUMPN CH,SIXM1
POPJ PP,
;PRINT OUT VERSION NUMBER, ETC. AT TOP OF DUMP LISTING
PUTHDR: MOVE TE,[POINT 7,[
IFN ANS68,<ASCIZ "COBOL-68 VERSION "]]>
IFN ANS74,<ASCIZ "COBOL-74 VERSION "]]>
PUSHJ PP,LSTMES
SKIPA TC,[POINT 6,VERZUN]
VERZ1: PUSHJ PP,DMPSIX
ILDB CH,TC
JUMPN CH,VERZ1
MOVE TE, [POINT 7,[ASCIZ " ["]]
PUSHJ PP, LSTMES
MOVE TE, COBSW%##
PUSHJ PP, DMPFW
MOVEI CH, "]"
PUSHJ PP, DMPOUT
MOVE TE,[POINT 7,[ASCIZ " -- DUMPED IN PHASE "]]
PUSHJ PP,LSTMES
MOVE CH,PHASEN
PUSHJ PP,DMPOUT
MOVE TE,[POINT 7,[ASCIZ " OF PROGRAM "]]
PUSHJ PP,LSTMES
MOVE TE,PROGID
PUSHJ PP,SIXMES
MOVEI LN,LINES
PUSHJ PP,EOP
JRST EOP
IFN DEBUG,<
;TABLE OF GENFIL OPERATORS
OPTAB: SIXBIT "000"
SIXBIT "MOVE"
SIXBIT "ADD"
SIXBIT "ADDTO"
SIXBIT "SUB"
SIXBIT "SUBFRM"
SIXBIT "MUL"
SIXBIT "MULBY"
SIXBIT "DIV"
SIXBIT "RESULT"
SIXBIT "REMAIN"
SIXBIT "DIVBY"
SIXBIT "DECLST"
SIXBIT "DECLEN"
SIXBIT "016"
SIXBIT "017"
SIXBIT "IF"
SIXBIT "IFC"
SIXBIT "IFT"
SIXBIT "SPIF"
SIXBIT "ELSE"
SIXBIT "025"
SIXBIT "ENDIF"
SIXBIT "027"
SIXBIT "GO"
SIXBIT "GODEP"
SIXBIT "PERF"
SIXBIT "PRFTYM"
SIXBIT "ALTER"
SIXBIT "SEARCH"
SIXBIT "SINCR"
SIXBIT "GOBACK"
SIXBIT "STOP"
SIXBIT "041"
IFN ANS68,<
SIXBIT "EXAM"
>
IFN ANS74,<
SIXBIT "INSPEC"
>
SIXBIT "SETTO"
SIXBIT "SETDN"
SIXBIT "SETUP"
SIXBIT "USING"
SIXBIT "ENTER"
SIXBIT "COMPUT"
NOCR1==.-OPTAB
SIXBIT "CADD"
SIXBIT "CSUB"
SIXBIT "CMUL"
SIXBIT "CDIV"
SIXBIT "CEXP"
SIXBIT "056"
NOCR2==.-OPTAB
SIXBIT "CEND"
SIXBIT "ACCEPT"
SIXBIT "DISPLY"
SIXBIT "OPEN"
SIXBIT "CLOSE"
SIXBIT "READ"
SIXBIT "WRITE"
SIXBIT "RERITE"
IFN ANS68,<
SIXBIT "SEEK"
>
IFN ANS74,<
SIXBIT "START"
>
NOCR3==.-OPTAB
SIXBIT "LPAREN"
SIXBIT "RPAREN"
SIXBIT "EXPR"
NOCR4==.-1-OPTAB
SIXBIT "ENDEXP"
SIXBIT "JUMPTO"
SIXBIT "075"
SIXBIT "CLREOP"
SIXBIT "ENTRY"
SIXBIT "SECNAM"
SIXBIT "PARNAM"
SIXBIT "TAGNAM"
SIXBIT "SENAM"
SIXBIT "ENDSEC"
SIXBIT "YECCH"
SIXBIT "106"
SIXBIT "COLSEQ"
SIXBIT "SORT"
SIXBIT "KEY"
SIXBIT "INPROC"
SIXBIT "OUTPRC"
SIXBIT "GIVING"
SIXBIT "USING"
SIXBIT "ENDSRT"
SIXBIT "MERGE"
SIXBIT "RELEAS"
SIXBIT "RETURN"
SIXBIT "DELETE"
SIXBIT "INIT"
SIXBIT "GENRAT"
SIXBIT "TERM"
SIXBIT "TRACE"
SIXBIT "127"
SIXBIT "CANCEL"
SIXBIT "IFDB"
SIXBIT "DISEN"
SIXBIT "ACCNT"
SIXBIT "SEND"
SIXBIT "RECEIV"
SIXBIT "SDELIM"
SIXBIT "STRNG"
SIXBIT "UDELIM"
SIXBIT "UNSDES"
SIXBIT "UNSTR"
SIXBIT "FENQ"
SIXBIT "FUNAV"
SIXBIT "EFUNAV"
SIXBIT "EFENQ"
SIXBIT "RENQ"
SIXBIT "ERENQ"
SIXBIT "ERUNAV"
SIXBIT "RDEQ"
SIXBIT "ERDEQ"
SIXBIT "ENH"
SIXBIT "METER"
SIXBIT "INSPTG"
SIXBIT "INSPRG"
LASTOP==.-OPTAB-1
>
;TABLE OF TABLE-LINK TYPES
OPNTAB: POINT 7,[ASCIZ "FILTAB+"]
POINT 7,[ASCIZ "DATAB+"]
POINT 7,[ASCIZ "CONTAB+"]
POINT 7,[ASCIZ "LITAB+"]
POINT 7,[ASCIZ "PROTAB+"]
POINT 7,[ASCIZ "EXTAB+"]
POINT 7,[ASCIZ "VALTAB+"]
POINT 7,[ASCIZ "MNETAB+"]
;TABLE OF FIGURATIVE CONSTANTS
FCTAB: POINT 7,[ASCIZ "TODAY"]
POINT 7,[ASCIZ "TALLY"]
POINT 7,[ASCIZ "SPACE"]
POINT 7,[ASCIZ "ZERO"]
POINT 7,[ASCIZ "QUOTE"]
POINT 7,[ASCIZ "HIGH-VALUE"]
POINT 7,[ASCIZ "LOW-VALUE"]
POINT 7,[ASCIZ "ALL"]
;[74] TABLE OF DATE, DAY, TIME
IFN ANS74,<
TODTAB: POINT 7,[ASCIZ "DATE"]
POINT 7,[ASCIZ "DAY"]
POINT 7,[ASCIZ "TIME"]
>
;TABLE OF DATA TABLES
DEFINE TABSET (W,X,Y,Z,A,B),<
EXTERNAL W'LOC,W'NXT,CUR'W
EXP W'LOC
SIXBIT "Z"
IFDEF Z,<XWD ^D'X,Z>
IFNDEF Z,<XWD ^D'X,0>
>
TBLPAR: TABLES;
TTESIZ==3
TBLXWD: XWD <TBLPAR-.>/TTESIZ,TBLPAR
STARS: POINT 7,[ASCIZ "********************"]
;DEVICE TABLE
DEVTAB: SIXBIT " CPY"
EXP DMPCPY
SIXBIT " ERA"
EXP DMPERA
IFN DEBUG,<
SIXBIT " GEN"
EXP DMPGEN
SIXBIT " AS1"
EXP GETPAG
SIXBIT " AS2"
EXP GETPAG
SIXBIT " AS3"
EXP GETPAG
SIXBIT " LIT"
EXP GETPAG
>
DEVXWD: XWD <DEVTAB-.>/2,DEVTAB
END COBOLK