Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
cobol/source/cobolk.mac
There are 7 other files named cobolk.mac in the archive. Click here to see a list.
; UPD ID= 3365 on 1/29/81 at 2:04 PM by NIXON
TITLE COBOLK FOR COBOL V12C
SUBTTL DUMPS FOR COBOL CRASH AL BLACKINGTON/CAM/SEB
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
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
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
RELOC 400000
SALL
;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
;DEFINE A FEW WORKING REGISTERS:
TEMP=1
WCTR=10
TCTR=15
LIMIT=6
TEMP2=0
;I/O CHANNELS
DSK==2
DMP==3
DEFINE GET(TEXT),<
MOVE TE,[POINT 7,[ASCIZ "TEXT"]]
>
DEFINE PUT(TEXT),<
GET <TEXT>
PUSHJ PP,LSTMES
>
DEFINE JPUT(TEXT),<
GET <TEXT>
PJRST LSTMES
>
EXTERNAL VERZUN
EXTERNAL KBUFI,KBHO,KBHI,KILLPL,KILLAC
EXTERNAL PHASEN,TOPLOC,IMPURE,KDATA,PROGID
EXTERNAL PROGID,PPSIZE,PPLIST
EXTERNAL SETFAK,FAKERA
EXTERNAL PUREC
EXTERNAL IMPURE,RESTRT
EXTERNAL SETDN ;GET A DIAGNOSTIC MESSAGE
ENTRY COBOLK
$COPYRIGHT ;Put standard copyright statement in EXE file
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,FATALW
WARNW: FATALW: POPJ 17,>
;SET UP I-O DEVICES
SETIO: MOVE PP,KILLPP
MOVEI TA,0 ;INIT FLAG FOR NO TYPEOUT
PUSH PP,TA
OUTSTR [ASCIZ "?CBLBUG Catastrophe in Phase "]
OUTCHR PHASEN
OUTSTR [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,'CBL' ;[347] PUT CBL INTO SECOND HALF OF NAME.
HLLM TA,TD ;[347] USE JOB NUMBER FOR FIRST HALF
MOVSI TC,'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)
SUBTTL DUMP OUT CORE
CORE:
IFN DEBUG,<
PUSHJ PP,LSTAC
PUSHJ PP,LSTPP
PUSHJ PP,LSTTBL
PUT <TOPLOC = >
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
"
SUBTTL 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 NOT 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
PUT < words >
PUSH PP,DT
MOVE TE,-1(PP)
PUSHJ PP,OCTMES
PUT < thru >
POP PP,TE
MOVEM TE,(PP)
SUBI TE,1
PUSHJ PP,OCTMES
PUT < are zeroes>
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
GET <****** 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
SUBTTL 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
PUT <****** Continuation of NAMTAB ******>
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: PUT <<Empty>>
MOVEI CP,7
NAMT13: SKIPL TE,(TA)
TLNE TE,(3B1)
AOJA TA,NAMT13
POPJ PP,
>
SUBTTL DUMP OUT FILE TABLES
IFN DEBUG,<
FILTAB: SKIPE DT,FILNXT ;EXIT IF NO DATA TABLE
CAMN DT,FILLOC ;ALSO EXIT IF TABLE IS EMPTY
JRST FILTBX
MOVEI W1,1(W1) ;GET ADDR OF 1ST ENTRY
MOVEI WCTR,1 ;INIT WORD COUNTER
FILTB1: HRRZI TCTR,1 ;INIT TEMP COUNTER
HRRZI LIMIT,SZ.FIL+1 ;USUAL # OF ENTRIES PER TABLE ENTRY (+1)
PUSHJ PP,CRLF
FILTB2: 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
PUSH PP,TEMP
IFN ANS68,<
CAIE TCTR,5 ;FILE-LIMITS ARE SPECIAL IF THEY EXIST
JRST FILTB3 ;NO
LDB TE,[POINT 5,TEMP,4]
ADDI LIMIT,(TE) ;ADD EXTRA WORDS IN
FILTB3:>
PUSH PP,LIMIT
IFN ANS68,<
CAIL TCTR,SZ.FIL+1 ;FILE-LIMITS VALUES?
SKIPA TE,[EXP FILWZ] ;YES
>
MOVE TE,FILOUT-1(TCTR) ;GET ROUTINE FOR THIS WORD
PUSHJ PP,(TE) ;GO TO IT
POP PP,LIMIT
POP PP,TEMP
ADDI WCTR,1
ADDI TCTR,1
ADDI W1,1 ;...AND ENTRY POINTER
CAME TCTR,LIMIT ;END OF TABLE ENTRY?
JRST FILTB2
HRRZ TEMP,FILNXT ;GET ADDR OF LAST ENTRY
ADDI TEMP,1 ;BUMP IT 1
CAMGE W1,TEMP ;END OF TABLE?
JRST FILTB1 ;NO, START OVER AGAIN
POPJ PP, ;YES, GO AWAY
FILOUT: EXP WORD1 ;SAME AS DATAB
EXP FILW2
EXP FILW3
EXP FILW4
EXP FILW5
EXP FILW6
EXP FILW7
EXP FILW8
EXP FILW9
EXP FILW10
EXP FILW11
EXP FILW12
EXP FILW13
EXP FILW14
EXP FILW15
EXP FILW16
EXP FILW17
EXP FILW18
EXP FILW19
EXP FILW20
EXP FILW21
EXP FILW22
EXP FILW23
EXP FILW24
EXP FILW25
EXP FILW26
EXP FILW27
FILW2:
IFN ANS68,<
JUMPGE TEMP,FILW2A ;NO MULTIPLE REEL/UNIT BIT
PUT <MULTIPLE REEL, >
FILW2A:>
TLZ TEMP,600000
TLNN TEMP,177777
JRST WORD2C ;NO RERUN COUNT
PUT <RE-RUN COUNT=>
HLRZ TE,TEMP
PUSHJ PP,DECMES
PUT <, >
JRST WORD2C ;LIST RUN-TIME LOCATION
FILW3: TLNN TEMP,777770 ;ANY FILE BUFFER SIZE?
JRST LSLNCP ;NO
PUT <FILE BUFFER SIZE=>
LDB TE,[POINT 16,TEMP,15]
PUSHJ PP,DECMES
PUT <, >
JRST LSLNCP ;LIST LN & CP
FILW4: TLNN TEMP,777700
JRST FILW4A ;NO N-S LABELS
PUT <N-S LABEL SIZE=>
LDB TE,[POINT 12,TEMP,11]
PUSHJ PP,DECMES
TLZ TEMP,777700
JUMPE TEMP,CPOPJ
PUT <, >
FILW4A: TLNN TEMP,77
JRST FILW4B
PUT <No. of devices=>
HLRZ TE,TEMP
PUSHJ PP,DECMES
TLZ TEMP,-1
JUMPE TEMP,CPOPJ
PUT <, >
FILW4B: PUT <DEVICE=>
HRRZ TE,TEMP
PJRST LSTTAB
FILW5: TLNN TEMP,760000
JRST FILW5A
IFN ANS68,<
PUT <No. of file-limits=>
LDB TE,[POINT 5,TEMP,4]
PUSHJ PP,DECMES
>
IFN ANS74,<
PUT <File access mode=>
LDB TE,[POINT 2,TEMP,4]
XCT FAM(TE)
PUSHJ PP,LSTMES
>
PUT <, >
FILW5A: PUT <Ext. Mode=>
LDB TE,[POINT 3,TEMP,7]
XCT RECMOD(TE)
PUSHJ PP,LSTMES
PUT <, Int. Mode=>
LDB TE,[POINT 3,TEMP,10]
XCT RECMOD(TE)
PUSHJ PP,LSTMES
TLZ TEMP,777700
JUMPE TEMP,CPOPJ
TLNN TEMP,77
JRST FILW5B
PUT <, Multi-file Pos.=>
HLRZ TE,TEMP
PUSHJ PP,DECMES
FILW5B: TRNN TEMP,-1
POPJ PP,
PUT <, Link to next=>
HRRZ TE,TEMP
PJRST LSTTAB
FILW6: TLNN TEMP,140000
JRST FILW6A
PUT <Labels are >
LDB TE,[POINT 2,TEMP,3]
XCT LABELS(TE)
PUSHJ PP,LSTMES
LSH TEMP,4
JUMPE TEMP,CPOPJ
PUT <, >
FILW6A: PUSH PP,TCTR
MOVSI TCTR,-^D12
FILW6B: JUMPE TEMP,FILW6D
JUMPG TEMP,FILW6C
XCT FILFL6(TCTR)
PUSHJ PP,LSTMES
FILW6C: LSH TEMP,1
AOBJN TCTR,FILW6B
FILW6D: POP PP,TCTR
IFN ANS68,<
PUT <ACCESS MODE=>
>
IFN ANS74,<
PUT <ORGANIZATION=>
>
LDB TE,[POINT 2,TEMP,1]
XCT ORGAN(TE)
PUSHJ PP,LSTMES
LSH TEMP,2
JUMPE TEMP,CPOPJ
PUT <, Actual key=>
HLRZ TE,TEMP
PJRST LSTTAB
FILW7: TLNN TEMP,770000
JRST FILW7A
PUT <No. of buffers=>
LDB TE,[POINT 6,TEMP,5]
PUSHJ PP,DECMES
PUT <, >
TLZ TEMP,770000
FILW7A: TLNN TEMP,7777
JRST FILW7B
PUT <Max. rec size=>
HLRZ TE,TEMP
PUSHJ PP,DECMES
PUT <, >
FILW7B: HRRZS TEMP
JUMPE TEMP,FILW7C
PUT <Data record=>
HRRZ TE,TEMP
PJRST LSTTAB
FILW7C: JPUT <No data record>
FILW8:
IFN ANS74,<
TLNN TEMP,-1
JRST FILW8A
PUT <Alternate KEY=AKTTAB+>
HLRZ TE,TEMP
TRNN TEMP,-1
PJRST DMPHW
PUSHJ PP,DMPHW
PUT <, >
FILW8A:>
TRNN TEMP,-1
POPJ PP,
PUT <Same device=>
HRRZ TE,TEMP
PJRST LSTTAB
FILW9: TLNN TEMP,-1
JRST FILW9A
PUT <VALUE-OF-ID=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FILW9A: TRNN TEMP,-1
POPJ PP,
PUT <VALUE-OF-DW=>
HRRZ TE,TEMP
PJRST LSTTAB
FILW10: TLNN TEMP,-1
JRST FIL10A
PUT <SAME AREA=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL10A: TRNN TEMP,-1
POPJ PP,
PUT <ERROR USE=>
HRRZ TE,TEMP
PJRST LSTTAB
FILW11:
IFN ANS68,<
TLNN TEMP,-1
JRST FIL11A
PUT <BEFORE BEGINING REEL=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL11A: TRNN TEMP,-1
POPJ PP,
PUT <BEFORE BEGINING FILE=>
HRRZ TE,TEMP
PJRST LSTTAB
>
IFN ANS74,<
TRNN TEMP,-1
POPJ PP,
PUT <LINAGE-COUNTER=>
HRRZ TE,TEMP
PJRST LSTTAB
>
FILW12:
IFN ANS68,<
TLNN TEMP,-1
JRST FIL12A
PUT <AFTER BEGINING REEL=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL12A: TRNN TEMP,-1
POPJ PP,
PUT <AFTER BEGINING FILE=>
HRRZ TE,TEMP
PJRST LSTTAB
>
IFN ANS74,<
TLNN TEMP,-1
JRST FIL12A
PUT <LINES PER PAGE=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST DECMES
PUSHJ PP,DECMES
PUT <, >
FIL12A: TRNN TEMP,-1
POPJ PP,
PUT <WITH FOOTING AT >
HRRZ TE,TEMP
PJRST DECMES
>
FILW13:
IFN ANS68,<
TLNN TEMP,-1
JRST FIL13A
PUT <BEFORE END REEL=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL13A: TRNN TEMP,-1
POPJ PP,
PUT <BEFORE END FILE=>
HRRZ TE,TEMP
PJRST LSTTAB
>
IFN ANS74,<
TLNN TEMP,-1
JRST FIL13A
PUT <LINES AT TOP=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST DECMES
PUSHJ PP,DECMES
PUT <, >
FIL13A: TRNN TEMP,-1
POPJ PP,
PUT <LINES AT BOTTOM=>
HRRZ TE,TEMP
PJRST DECMES
>
FILW14: TLNN TEMP,-1
JRST FIL14A
IFN ANS68,<
PUT <AFTER END REEL=>
>
IFN ANS74,<
PUT <USE ON DEBUGGING=>
>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL14A: TRNN TEMP,-1
POPJ PP,
IFN ANS68,<
PUT <AFTER END FILE=>
>
IFN ANS74,<
PUT <LINAGE-COUNTER INITIALIZATION=>
>
HRRZ TE,TEMP
PJRST LSTTAB
FILW15: TLNN TEMP,-1
JRST FIL15A
PUT <SAME RECORD AREA=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL15A: TRNN TEMP,-1
POPJ PP,
PUT <LABEL RECORD=>
HRRZ TE,TEMP
PJRST LSTTAB
FILW16: PUSH PP,TCTR
MOVSI TCTR,-3
FIL16A: JUMPG TEMP,FIL16B
XCT FILF16(TCTR)
PUSHJ PP,LSTMES
FIL16B: LSH TEMP,1
AOBJN TCTR,FIL16A
TLNN TEMP,700000
JRST FIL16C ;DON'T BOTHER IF DENSITY NOT GIVEN
PUT <DENSITY=>
LDB TE,[POINT 3,TEMP,2]
XCT DENSTY(TE)
PUSHJ PP,LSTMES
PUT <, >
FIL16C: TLNN TEMP,060000
JRST FIL16D ;DON'T BOTHER IF PARITY NOT GIVEN
PUT <PARITY=>
LDB TE,[POINT 2,TEMP,4]
XCT PARITY(TE)
PUSHJ PP,LSTMES
PUT <, >
FIL16D: LSH TEMP,5
MOVSI TCTR,-6
FIL16E: JUMPG TEMP,FIL16F
XCT FILF16+3(TCTR)
PUSHJ PP,LSTMES
FIL16F: LSH TEMP,1
AOBJN TCTR,FIL16E
POP PP,TCTR
LSH TEMP,4
JUMPE TEMP,CPOPJ
PUT <ADDRESS OF RECORD=BASE+>
HLRZ TE,TEMP
PJRST DMPHW
FILW17:
IFN ANS68,<
TLNN TEMP,-1
JRST FIL17A
PUT <SYMBOLIC KEY=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL17A:>
TRNN TEMP,-1
POPJ PP,
PUT <RECORD KEY=>
HRRZ TE,TEMP
PJRST LSTTAB
FILW18:
IFN ANS74,<
TLZN TEMP,400000
JRST FIL18A
PUT <LNCP=REC, >
FIL18A:>
TLNN TEMP,037774
JRST FIL18B
PUT <BLOCKING FACTOR=>
LDB TE,[POINT 12,TEMP,15]
PUSHJ PP,DECMES
TLZ TEMP,777774
JUMPE TEMP,CPOPJ
PUT <, >
FIL18B: JUMPE TEMP,CPOPJ
JRST LSLNCP ;LIST LN & CP
FILW19: TLNN TEMP,-1
JRST FIL19A
PUT <VALUE OF PROJ-PROG=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL19A: TRNN TEMP,-1
POPJ PP,
PUT <RD LINK=RPWTAB+>
HRRZ TE,TEMP
PJRST DMPHW
FILW20: JUMPE TEMP,CPOPJ
TLNN TEMP,777000
JRST FIL20A
PUT <OWNER ACCESS=>
LDB TE,[POINT 9,TEMP,8]
PUSHJ PP,OCTMES
PUT <, >
FIL20A: TLNN TEMP,777
JRST FIL20B
PUT <OTHER ACCESS=>
LDB TE,[POINT 9,TEMP,17]
PUSHJ PP,OCTMES
PUT <, >
FIL20B: PUT <RECORDS RETAINED=>
HRRZ TE,TEMP
PJRST DECMES
FILW21: TLNN TEMP,-1
JRST FIL21A
PUT <FILE STATUS=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL21A: TRNN TEMP,-1
POPJ PP,
PUT <ERROR NUMBER=>
HRRZ TE,TEMP
PJRST LSTTAB
FILW22: TLNN TEMP,-1
JRST FIL22A
PUT <ACTION CODE=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL22A: TRNN TEMP,-1
POPJ PP,
PUT <VALUE OF ID=>
HRRZ TE,TEMP
PJRST LSTTAB
FILW23: TLNN TEMP,-1
JRST FIL23A
PUT <BLOCK NUMBER=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL23A: TRNN TEMP,-1
POPJ PP,
PUT <RECORD NUMBER=>
HRRZ TE,TEMP
PJRST LSTTAB
FILW24: TLNN TEMP,-1
JRST FIL24A
PUT <FILE NAME=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL24A: TRNN TEMP,-1
POPJ PP,
PUT <FILE TABLE=>
HRRZ TE,TEMP
PJRST LSTTAB
FILW25:
IFN ANS68,<
POPJ PP,
>
IFN ANS74,<
TLNN TEMP,-1
JRST FIL25A
PUT <CONV. REL KEY BEFORE=>
HLRZ TE,TEMP
TRNN TE,-1
PJRST LSTTAB
PUSHJ PP,LSTTAB
PUT <, >
FIL25A: TRNN TEMP,-1
POPJ PP,
PUT <CONV. REL. KEY AFTER=>
HRRZ TE,TEMP
PJRST LSTTAB
>
FILW26: TLNN TEMP,776000
JRST FIL26A
PUT <CHECKPNT COUNT=>
LDB TE,[POINT 7,TEMP,6]
PUSHJ PP,DECMES
PUT <, >
FIL26A: TLZ TEMP,777774
JUMPE TEMP,CPOPJ
PUT <FD >
JRST LSLNCP ;PUT OUT LN & CP OF FD
FILW27: PUT <FILE NUMBER=>
HLRZ TE,TEMP
PJRST DECMES
IFN ANS68,<
FILWZ: PUT <FILE LIMITS=>
HLRZ TE,TEMP
PUSHJ PP,LSTTAB
PUT < THRU >
HRRZ TE,TEMP
PJRST LSTTAB
>
FILTBX: PUSHJ PP,CRLF
PUT < Table is empty>
PJRST CRLF
IFN ANS74,<
FAM: GET <UNKNOWN>
GET <SEQUENTIAL>
GET <RANDOM>
GET <DYNAMIC>
>
RECMOD: GET <SIXBIT>
GET <BINARY>
GET <ASCII>
GET <EBCDIC>
LABELS: GET <OMITTED>
GET <STANDARD>
GET <NON-STANDARD>
GET <UNKNOWN>
ORGAN: GET <SEQUENTIAL>
IFN ANS68,<GET <RANDOM>>
IFN ANS74,<GET <RELATIVE>>
GET <INDEXED>
GET <UNKNOWN>
DENSTY: GET <UNKNOWN>
GET <200 BPI>
GET <556 BPI>
GET <800 BPI>
GET <1600 BPI>
GET <6250 BPI>
PARITY: GET <UNKNOWN>
GET <ODD>
GET <EVEN>
FILFL6: GET <INPUT ,>
GET <OUTPUT ,>
GET <I-O ,>
GET <WRITE ADV ,>
GET <DEFINED IN SD, >
GET <VAR LEN, >
GET <RE-RUN ON END, >
GET <RE-RUN ON COUNT, >
GET <FD DEF, >
GET <OPTIONAL, >
GET <POSITION, >
GET <RMS, >
FILF16: GET <DATA REC, >
GET <REC AREA, >
GET <MODE DECL., >
GET <ERR PROC, >
GET <DEFERRED, >
GET <BYTE, >
GET <CHECKPNT, >
GET <ALT REC, >
GET <KEY ERR, >
>
SUBTTL DUMP OUT DATA TABLE
IFN DEBUG,<
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,SZ.DAT+1 ;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) ;SPECIAL 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: ADDI WCTR,1
ADDI TCTR,1
ADDI W1,1 ;...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
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
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
WORD3: TLNE TEMP,-1 ;FATHER?
JRST GOTFTH ;YES
PUT <NO FATHER>
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
GET <, NO SON>
PJRST LSTMES
GOTSON: PUT <, SON IS >
HRRZ TE,TEMP
PJRST TABPTR
WORD4: PUT <LEVEL#=>
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
PUT <, BYTE-RESIDUE=>
HLRZ TE,TEMP
TRZ TE,770000
LSH TE,-6
PUSHJ PP,OCTMES
PUT <, >
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,
PUT <,RPWTAB LINK=>
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
WORD5: HLRZ CH,TEMP
LSH CH,-20
AND CH,[3] ;ISOLATE CLASS DIGIT
XCT CLASS(CH) ;GET CLASS TEXT
PUSHJ PP,LSTMES
PUT <, >
HLRZ TE,TEMP ;NUMERIC CLASS?
TRZ TE,177777
CAIE TE,200000
JRST WORD5A ;NO
PUT <, >
HRRZ TE,TEMP
TRZ TE,777740
PUSH PP,TCTR
PUSHJ PP,DECMES
POP PP,TCTR
PUT < DEC. PLACES>
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
PUT <, >
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>
GET <COMP-2>
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>
GET <SEP SIGN>
GET <LDN SIGN>
GET <DEP AT LL>
GET <ERROR>
GET <INDEX>
GET <REDEF>
GET <PIC>
GET <FILE SEC>
GET <DATA REC>
IFN ANS68,<
GET <LAB REC>
>
IFN ANS74,<
GET <DEBUG>
>
GET <SYNC AT LL>
GET <PIC WDS>
GET <VAL AT HL>
GET <REDF AT HL>
GET <LINKAGE>
GET <SCALED>
WORD6: PUT <EXTRN SIZE=>
HLRZ TE,TEMP
PUSHJ PP,DECMES
PUT <, INTRN SIZE=>
HRRZ TE,TEMP
PJRST DECMES
WORD7: TLNN TEMP,77777 ;ANY OCCURANCES?
JRST LSLNCP
PUT <OCCURS >
HLRZ TE,TEMP
LSH TE,-3
PUSHJ PP,DECMES
PUT <, >
LSLNCP: MOVE TE,TEMP
AND TE,[17777B28]
JUMPE TE,NOLINE
PUSH PP,TE
PUT <LINE >
POP PP,TE
LSH TE,-7
PUSHJ PP,DECMES
PUT <, >
NOLINE: AND TEMP,[177]
JUMPE TEMP,CPOPJ
PUT <CHAR >
HRRZ TE,TEMP
PJRST DECMES
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
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
PUT <SIGN CHAR IS >
POP PP,CH
PUSHJ PP,DMPSIX ;PRINT SIXBIT CHAR.
PUT <, >
NOPICT: HLRZ TE,TEMP
TRZ TE,770077 ;GET FLOAT CHAR
JUMPE TE,NOFLT
LDB CH,[POINT 6,TE,29]
PUSH PP,CH
PUT <FLOAT CHAR IS >
POP PP,CH
PUSHJ PP,DMPSIX
PUT <, >
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: PUT <BYTES ARE: >
NOFLT2: ILDB TE,TEMP2 ;GET BYTE
PUSHJ PP,OCTMES
SOJE CT,CPOPJ
PUT <,> ;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
WORD14: JUMPE TEMP,CPOPJ ;ANY SEARCH KEY?
JUMPL TEMP,W14B ;ADVANCING OR DESCENDING?
GET <ADVANCING KEY=>
JRST W14C
W14B: GET <DESCENDING KEY=>
W14C: PUSHJ PP,LSTMES
HRRZ TE,TEMP
PJRST DMPHW
>
SUBTTL 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
>
SUBTTL DUMP OUT ALL THE FILES
DMPFIL: INIT DSK,14
SIXBIT "DSK"
XWD 0,KBHI
HALT .-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
OUTSTR [ASCIZ "[CBLPLP Please print DSK:"]
MOVE TE,SAVNAM ;GET FILE NAME
PUSHJ PP,SIXTTY ;TYPE IT OUT
OUTSTR [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: OUTSTR [ASCIZ "?CBLCID Can not initialize the disk for dump
"] ;[347]
JRST DMPEND ;[347] LET'S GET OUT OF HERE.
NODMP2: OUTSTR [ASCIZ "?CBLCOD Can not OPEN dump file: "]
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,<
SUBTTL 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: PUT < OPERATOR, >
TLNE W1,177B33 ;ANY FLAGS?
JRST DGEN4 ;YES
PUT <NO FLAGS,>
JRST DGEN10
DGEN3: PUSHJ PP,OCTMES
JRST DGEN2
DGEN4: PUT <FLAGS >
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
PUT <USAGE >
LDB TE,[POINT 4,W1,13]
PUSHJ PP,OCTMES
PUT < AT >
DGEN6C: PUSHJ PP,LSTLNK
LDB TE,[POINT 3,WD,20]
CAIE TE,1
JRST DGEN6A
GET <, SYNC LEFT>
TLNE W1,1B23
PUSHJ PP,LSTMES
GET <, SYNC RIGHT>
TLNE W1,1B24
PUSHJ PP,LSTMES
TLNN W1,1B25
SKIPA TE,[POINT 7,[ASCIZ ", NON-NUMERIC"]]
GET <, NUMERIC>
PUSHJ PP,LSTMES
GET <, JUST RIGHT>
TLNE TE,1B26
PUSHJ PP,LSTMES
LDB TA,[POINT 7,W1,15]
JUMPE TA,DGEN6A
PUT <, STASH >
MOVE TE,TA
PUSHJ PP,OCTMES
DGEN6A: GET <, IGNORE ERRORS>
TLNE WD,1B18
PUSHJ PP,LSTMES
GET <, ROUNDED>
TLNE WD,1B19
PUSHJ PP,LSTMES
LDB TA,[POINT 6,WD,17]
JUMPE TA,DGEN6B
PUT <, >
MOVE TE,TA
PUSHJ PP,DECMES
PUT < SUBSCRIPTS>
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"]]
GET <NON-NUMERIC>
PUSHJ PP,LSTMES
PUT < LITERAL AT >
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: PUT <ENDIT OPERATOR
>
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
>
SUBTTL 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
PUT <Diag #>
LDB TE,[POINT 10,WD,35]
PUSHJ PP,DECMES
LDB TE,[POINT 10,WD,35]
CAIL TE,^D500
CAILE TE,^D550
JRST DMPE4
PUT < with added data >
PUSH PP,WD
PUSHJ PP,GETDSK
JRST DMPE5 ;E-O-F
PUSHJ PP,LSTLNK
DMPE3: POP PP,WD
DMPE4: PUT <, from phase >
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: PUT <which isn't here>
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
GET <****** 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: PUT < Line >
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: PUT <-- Accumulators -->
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
SUBTTL DUMP THE PUSH-DOWN LIST
LSTPP: PUT <-- Pushdown stack -->
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
SUBTTL DUMP TABLE PARAMETERS
LSTTBL: PUT <-- Table parameters --
Table LOC NXT CUR>
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
PUT < ****** Starts at >
MOVE TE,-2(PP)
HRRZ TE,@(TE)
PUSHJ PP,OCTMES
PUSHJ PP,CRLF
JRST LFONLY
>
SUBTTL LISTING ROUTINES
;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?
OUTCHR CH ;YES, TYPE CHAR TOO
IDPB CH,KBHO+1
POPJ PP,
DMPO2: OUT DMP,
JRST DMPO1 ;NO ERRORS
OUTSTR [ASCIZ "%CBLEWD I-O 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
OUTCHR 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
;SAME THING BUT CALLED FROM FILTAB (EXTAB IS NOT POSSIBLE ITS REALLY TAG#)
LSTTAB: PUSH PP,TE
LDB TE,[POINT 3,TE,20]
CAIN TE,CD.TAG
JRST LSTTAG ;IT IS A TAG
MOVE TE,OPNTAB(TE)
PUSHJ PP,LSTMES
POP PP,TE
ANDI TE,077777
JRST OCTMES
LSTTAG: PUT <%>
POP PP,TE
ANDI TE,077777
PUSHJ PP,DECMES
JPUT <:>
;GET A WORD FROM A SCRATCH FILE
GETDSK: SOSG KBHI+2
JRST GETD3
GETD1: ILDB WD,KBHI+1
AOS (PP)
POPJ PP,
GETD3: IN DSK,
JRST GETD1
GETSTS DSK,WD
TRNN WD,740000
POPJ PP,
OUTSTR [ASCIZ "%CBLERS I-O 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
GET <****** >
LSTFNB: PUSHJ PP,LSTMES
PUSHJ PP,LSTFN
PUT < ******
>
MOVEI LN,LINES-2
POPJ PP,
;PRINT OUT FILE NAME
LSTFN: MOVS TE,(DT)
HRRI TE,'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:
IFN ANS68,<PUT <COBOL-68 version >>
IFN ANS74,<PUT <COBOL-74 version >>
SKIPA TC,[POINT 6,VERZUN]
VERZ1: PUSHJ PP,DMPSIX
ILDB CH,TC
JUMPN CH,VERZ1
PUT < [>
MOVE TE, COBSW%##
PUSHJ PP, DMPFW
MOVEI CH, "]"
PUSHJ PP, DMPOUT
PUT < -- dumped in phase >
MOVE CH,PHASEN
PUSHJ PP,DMPOUT
PUT < of program >
MOVE TE,PROGID
PUSHJ PP,SIXMES
MOVEI LN,LINES
PUSHJ PP,EOP
JRST EOP
IFN DEBUG,<
SUBTTL 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 "IFU"
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 "NO-OP"
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"
SIXBIT "CBPHAS"
SIXBIT "SUPPRS"
LASTOP==.-OPTAB-1
>
SUBTTL 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,C),<
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