Google
 

Trailing-Edge - PDP-10 Archives - BB-H506D-SM_1983 - 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 V12B
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, 1981 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
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

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