Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/cobscn.mac
There are 8 other files named cobscn.mac in the archive. Click here to see a list.
; UPD ID= 1518 on 2/2/84 at 3:33 PM by RMEYERS                          
TITLE	COBSCN - The COBOL-20 Specific Command Scanner
SUBTTL	David M. Nixon

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1986


	ENTRY	COBOL


	SUBTTL	Revision History

Comment \

***** Begin Revision History *****
;MJC	15-JAN-86	[1625] Set up .JBREN to proint to COBLAR:
;MJC	21-JUN-85	[1601] Remove FORTRAN edit numbers
\
	SEARCH	P
	SEARCH	JOBDAT,MONSYM,MACSYM


	ENTRY	RESTRT		;Restart compilation (REENTER)
	ENTRY	REDO		;Restart compilation (START)

;Globals defined in CMND20
	EXTERN	CNTIDX
	EXTERN	SRCIDX
	EXTERN	SRCFIL
	EXTERN	CMD		;COMND% JSYS in CMND20
	EXTERN	USRERR		;Command not completed
	EXTERN	MONERR		;Error return
	EXTERN	SCANSW		;Read SWITCH.INI
	EXTERN	CONFIRM		;COMND% function to confirm a command
	EXTERN	ATMBUF		;Atom buffer for COMND% JSYS
	EXTERN	STATE		;COMND% JSYS state block
	EXTERN	GETDEF		;Get the default filename
	EXTERN	CJFNBK
	EXTERN	CMDSOU
	EXTERN	DEFFIL
	EXTERN	ERRPFX
	EXTERN	JOBNUM
	EXTERN	LSTTYP
	EXTERN	SRCGJB
	EXTERN	BINGJB
	EXTERN	LSTGJB
	EXTERN	FLAG10		;-1 if TOPS-10 style command
	EXTERN	.HELP		;Handle TOPS-10 /H command
	EXTERN	.ECHOOP		;/ECHO-OPTION switch action
	EXTERN	.NEW		;/Z = Get back to TOPS-20 scanner
	EXTERN	.NOOPTION	;/NOOPTION switch action
	EXTERN	.OPTION		;/OPTION: switch action
	EXTERN	.COBSW		;-1 to signal called bt Cobol
	EXTERN	.OLDSW		;Use TOPS-10 style command scanner

;Global defined in COBOLA
	EXTERN	COBOLA		;Entry point to phase "A"
	EXTERN	SETIMP		;Clear the impure area

;Globals used by CMND20
	INTERN	COMSW,OCOMSW
	INTERN	DOCOMPILE
	INTERN	INITFL
	INTERN	PROMPT		;Language prompt string
	INTERN	PRANAM		;Process arg name used by EXEC
	INTERN	PRBFIL		;File name used for CCL command
	INTERN	DEFOFL		;Default output file name
	INTERN	LNGWPF		;Warning prefix
	INTERN	LNGFPF		;Fatal prefix
	INTERN	LNGCMD		;Command error message
	INTERN	LNGPSC		;...
	INTERN	HLPSTR		;HELP file on device HLP:
	INTERN	HLPSYS		;HELP file on device SYS:
	INTERN	LNGNAM		;Name of compiler
	INTERN	LNGTYP		;Default type of source file
	INTERN	ONFLG		;The flags that must be turned on
	INTERN	OFFFLG		;The flags that must be turned off
	INTERN	SONFLG		;Holds ON flags from command line during SWITCH.INI processing.
	INTERN	SOFFLG		;Holds OFF flags from command line during SWITCH.INI processing.
	INTERN	.NOLIST
;Globals used by rest of the compiler
	INTERN	ASYSAV
	INTERN	ASYCNT
	INTERN	IOWLIT
	INTERN	LIBSPC
	INTERN	LIBOSP
	INTERN	NORELS
	INTERN	NXTFIL		;Opens next source file for compiler
	INTERN	OPNLIB		;Open the library file for the compiler
	INTERN	OPNLIT		;Open the literal file for the compiler
	INTERN	OPNOVR		;Open overlay file for segmentation
	INTERN	PUTAS1,PUTAS2,PUTAS3
	INTERN	PUTGEN
	INTERN	PUTGN1
	INTERN	PUTBIN
	INTERN	PUTLST
	INTERN	RITASY	;Write last partial buffers of AS1, AS2, and AS3 files
	INTERN	RITNAM
	INTERN	RITERA
	INTERN	RITCPY
	INTERN	RITCRF
	INTERN	RITLIT	;Write out LITFIL buffer
	INTERN	RITOVD		;Write out the directory of the overlay file
	INTERN	GETSRB	;GET NEXT SOURCE BUFFER
	INTERN	GETGEN	;GET TWO WORDS
	INTERN	SETGEN	;SET UP GENFIL FOR INPUT
	INTERN	SETNAM
	INTERN	SETSEG	;SET UP GENFIL TO READ NEXT SECTION
	INTERN	GETASY	;GET A WORD
	INTERN	SETASY	;SET UP ASYFIL FOR INPUT
	INTERN	SETAS2	;Set up to create a new AS2 file for optimizer
	INTERN	RENAS2	;Rename AS2 file back
	INTERN	GETCPY	;GET A WORD
	INTERN	SETCPY	;SET UP CPYFIL FOR INPUT
	INTERN	GETCRF
	INTERN	SETCRF
	INTERN	GETERA	;GET A WORD
	INTERN	SETERA	;SET UP ERAFIL FOR INPUT
	INTERN	GETLIT
	INTERN	SETLIT	;Set up LITFIL for input
	INTERN	SFPLIB	;Set file pointer of library file
	INTERN	GETLBA	;Get library buffer
	INTERN	CLSAS1	;CLOSE AS1FIL
	INTERN	CLSAS2
	INTERN	CLSAS3
	INTERN	CLSERA
	INTERN	CLSCPY
	INTERN	CLSCRF
	INTERN	CLSGEN
	INTERN	CLSLIB
	INTERN	CLSLIT
	INTERN	CLZSRC
	INTERN	CLZBIN
	INTERN	CLZLST
	INTERN	CLZLIB
	INTERN	DELALL	;DELETE ALL TEMP FILES
	INTERN	RITSF1,RITSF2,RITSF3	;Write out buffer
	INTERN	SETSF1,SETSF2,SETSF3
	INTERN	CLSSF1,CLSSF2,CLSSF3
	INTERN	GETSF1,GETSF2,GETSF3	;Read next buffer
	INTERN	OPNSF1,OPNSF2,OPNSF3
	INTERN	OPNSF		;Get a JFN for CREF temp files
	INTERN	DELSF		;Delete the CREF temp files

	INTERN	OPNDMP		;Open dump file from COBOLK
	INTERN	DMPOUT		;Write a character to the dump file
	INTERN	CLZDMP		;Close the dump file and release JFN
	INTERN	SETTFI		;Open any of the temp files for input in COBOLK
	INTERN	GETTFI		;Read the above temp file

IFN DBMS,<
	INTERN	OPNDBC		;Open DBC file for input
	INTERN	OPNDBD		;Open DB1 file for input
	INTERN	PUTDBC		;Write to DBC file
	INTERN	PUTDBD		;Write to DB1 file
	INTERN	SETDBS		;Open DBC for input
	INTERN	DBGTF.		;Open DB1 for input
	INTERN	GETDBS		;Get next input buffer of DBMS INVOKE file
	INTERN	CLSDBC		;Close DBC file but keep JFN
	INTERN	CLSDBD		;Close DB1 file but keep JFN
	INTERN	CLZDBS		;Close DBC or DB1 file and don't release JFN

	INTERN	DBCPTR		;Initial buffer address and size
	INTERN	DBDPTR		;Initial buffer address and size
>
	EXTERN	CCLSW		;Contains 0 or 1, the start address offset used
				; to start COBOL

	EXTERN	OJPPSZ		;Size of OTS pushdown stack set by /STACK:
	EXTERN	AS7482		;ANSI standard either 74 or 82
	EXTERN	COBXSW		;Same for COBOLG
	EXTERN	ABRTSW		;-1 if /ABORT seen
	EXTERN	CREFSW		;-1 if /CREF seen
	EXTERN	DEBSW		;-1 if /DEBUG seen
	EXTERN	DEFDSP		;Default display mode, either 6,7 or 9
	EXTERN	OPTSW		;-1 if /OPTIMIZE seen
	EXTERN	PRODSW		;-1 if /PRODUCTION-MODE seen
	EXTERN	QUIKSW		;-1 if /QUICK-MODE seen
	EXTERN	SLASHJ		;-1 if main program switch seen
	EXTERN	SUBPRG		;-1 if subprogram switch seen
	EXTERN	SEENRU		;-1 if /U seen, +1 if /R seen
	EXTERN	RENSW		;-1 if /R seen
	EXTERN	FLGSW		;FIPS flagger mask
IFN DEBUG,<
	EXTERN	CORESW		;Holds /TRACE: and /KILL: masks
	EXTERN	TRACFL
>
	EXTERN	GENWRD
	EXTERN	PROGST
	EXTERN	PROLOC
	EXTERN	KILL

	SALL

	CMDTRC==0		;Turn on tracing
	BUFSIZ==^D96		;Length (words) of command line buffer
	ATMBLN==^D34		;Length (words) of atom buffer
	MAXFILES==^D20		;Maximum number of sources files in one command
	TMPLEN==200		;Length of the PRARG block
	TAKLEN==^D10		;Nesting depth of TAKE files


	TWOSEG	%HISEG

	.COPYRIGHT		;Put standard copyright statement in REL file
;AC'S USED BY COMMAND SCANNER

	F==0		;Known as FLGREG by the compiler.
	SW==0		;Used as a flag register by rest of the compiler.
	R0==0		;Used by DBMS code
	T1==1		;TEMP
	T2==2		; ..
	T3==3		; ..
	T4==4		; ..
	T5==5		; ..
	T6==6		; ..
	P1==7		;PRESERVED AC
	P2==10		; ..
	P3==11		; ..
	P4==12		;
	P5==13		;
	P6==14		;
	VREG=15		;BLIS10 VALUE RETURN REG
;	FREG=16		;BLIS10 FRAME POINTER
	SREG=17		;BLIS10 STACK POINTER


	OPDEF	PJRST	[JRST]	;PUSHJ and POPJ
	OPDEF	NOOP	[TRN]	;Fastest No-op in machine
	.NODDT	PJRST,NOOP

DEFINE	TRACE(S)<
	IFN	CMDTRC,<
	   PUSH   SREG,T1
	   HRROI  T1,[ASCIZ \
Got to 'S
\]
	   PSOUT%
	   POP	  SREG,T1>
>

	FRMTTY==0		;Command input comes from terminal
	FRMPRA==1		;Command input comes from PRARGs
	FRMTAK==2		;Command input comes from /TAKE file
	FRMSWI==3		;Command input comes from SWITCH.INI
	FRMTEN==4		;Command input is under TOPS-10 compatibility
	SUBTTL	Flag Mask Definitions

;Global flags are in LHS of SW. Do not change these values they are defined in P.MAC.
;The RHS of SW if used during command scanning to hold useful flags.

;Flags that correspond to switch setting are stored in ONFLG and OFFFLG.
;The RHS of ONFLG is the same as the RHS of SW for convenience.
;The flags in ONFLG and OFFFLG are converted to LHS of SW or full word switches
;just before compilation starts.

;Flag word offsets
$F==0			;Flags to put in SW or separate full words
$FC==1			;Flags to put in CORESW
$FD==2			;Flags to put in DEFDSP
$FX==3			;Flags to put in COBXSW
$FL==4			;Flags to put in FLGSW (flagger switches)
$FS==5			;Stack size

NUMFLGS==6			;Length of switch block

;Flags in ONFLG+$F and OFFFLG+$F
SW.ABO==1B0		;Abort (exit) on fatal errors
SW.AFS==1B1		;ANSI-FORMAT (card sequenced)
SW.CRF==1B2		;CREF wanted
SW.ERA==1B3		;Print errors on terminal
SW.NOC==1B4		;Don't list library file in listing
SW.MAC==1B6		;/MACHINE-CODE wanted
SW.MAP==1B7		;Data map wanted
SW.MAI==1B8		;Main progran
SW.SUB==1B9		;Sub-program
SW.OPT==1B10		;Optimize
SW.PRD==1B11		;Production mode
SW.QIK==1B12		;Quick mode
SW.OCS==1B13		;Only Check Syntax
SW.ONE==1B14		;One-seg
SW.TWO==1B15		;Two-seg

RELFLG==1B22		;REL file wanted
LSTFLG==1B25		;LIST file wanted
TTYINP==1B30		;INPUT DEVICE IS A TTY


;Values in ONFLG+$FD and OFFFLG+$FD
;%US.D6==1		;DISPLAY-6 (defined in P.MAC)
;%US.D7==2		;DISPLAY-7 (defined in P.MAC)
;%US.EB==3		;DISPLAY-9 (defined in P.MAC)

;Flags in ONFLG+$FX and OFFFLG+$FX
SW.A82==SW.A82		;1B16	;ANS-82 syntax wanted (defined in INTERM)
SW.A74==SW.A74		;1B17	;ANS-74 syntax wanted (defined in INTERM)
	SUBTTL	Low Segment Data Area

	LOC	124		;[1625] Point at .JBREN

	EXP	COBLAR		;[1625] Set up the REENTER address

	RELOC 0


APRSV1:	BLOCK	1
APRSV2:	BLOCK	1
APRSV3:	BLOCK	1



LIBTYP:	BLOCK	ATMBLN		;Holds user's typescript of value to /LIBRARY
	
COBSTK:	BLOCK	1		;Used to restore the stack pointer

ONFLG:	BLOCK	NUMFLGS		;The flags that must be turned on
OFFFLG:	BLOCK	NUMFLGS		;The flags that must be turned off
SONFLG:	BLOCK	NUMFLGS		;Holds ON flags from command line
				;during SWITCH.INI processing.
SOFFLG:	BLOCK	NUMFLGS		;Holds OFF flags from command line
				;during SWITCH.INI processing.

XJBFF:	BLOCK	1		; Holds .JBFF across compiles
XJBREL:	BLOCK	1		; Holds .JBREL across compiles

DEFINE IOLIST (A,B,C,D,E)<
EXTERN	A'JFN,A'BH
>
IOFILE

DEFINE IOLIST (A,B,C,D,E)<	A'BLN==B
A'BFR:	BLOCK	A'BLN>
IOFILE


TMPGJB:	BLOCK	.GJJFN+1	;Default GTJFN block for temp files
LIBGJB:	BLOCK	.GJJFN+1	;Default GTJFN block for LIBRARY files
TMPSPC:	BLOCK	2		;Temp file name
ASCJOB:	BLOCK	1		;ASCII job number right justified

ASYSAV:	BLOCK	1		;Save JFN of AS1FIL during phase G
ASYCNT:	BLOCK	1		;Which ASY phase G is currently working on
NORELSW:	BLOCK	1		;-1 if REL file is not to be produced
LIBSPC:	BLOCK	^D40		;CPYLIB filespec
LIBOSP:	BLOCK	^D40		;Old CPYLIB filespec
IOWLIT:	BLOCK	2		;IOWD for dump mode write of LITFIL

	RELOC	400000
	SUBTTL	Constants

PROMPT:	ASCIZ \COBOL>\		;Prompt pointer
PRANAM:	'NCO'			;Process arg name used by EXEC

PRBFIL:	ASCIZ	\/TAKE:000NCO.TMP;T
\	
DEFOFL:	ASCIZ	/COBOL-OUTPUT/
LNGFPF:	ASCIZ	/?CBL/		;Fatal prefix
LNGWPF:	ASCIZ	/%CBL/		;Warning prefix
LNGCMD:	ASCIZ	/CBLCMD /	;Command error message
LNGPSC:	ASCIZ	/CBLCMD "+", switch, or confirm required -- /
HLPSTR:	ASCIZ	/HLP:COBOL.HLP/	;HELP string on HLP:
HLPSYS:	ASCIZ	/SYS:COBOL.HLP/	;HELP string on SYS:
LNGNAM:	ASCIZ	/COBOL/		;Name of compiler
LNGTYP:	ASCIZ	/CBL/		;Default type of source file
	SUBTTL	Start up code

	$COPYRIGHT		;Put standard copyright statement into EXE file
COBOL:	JRST	COMTTY		;Normal entry point
	JRST	COMDSK		;CCL entry point
	JRST	COBLAR		;Restart

;Here to go to COBOLA to continue compilation after command scanning.

RETCOB:	MOVEM	PP,COBSTK	;Store pointer
	JRST	COBOLA		;And go to COBOLA

;Restart due to START console command

REDO:	SETZ	SW,

;Restart due to REENTER console command.
;Also used by COBOLG, COBOLK, and QUITS.

RESTRT:	TSWF	FECOM		;Any more commands?
	HALTF%			;No
	AND	SW,[EXP FDSKC]	;Turn off all flags except CCL flag
	MOVE	PP,COBSTK	;Restore stack pointer
	POPJ	PP,		;Return to scanner

;Set up to get commands from disk

COMDSK:	MOVX	SW,FDSKC	;Clear flags, set "commands from disk"
	MOVEI	TA,1
	MOVEM	TA,CCLSW
	JRST	COBLAS

COMTTY:	SETZB	SW,CCLSW##	;Clear flags and signal normal entry point

;Start a new compilation

COBLAR:	TSWF	FDSKC		;INPUT COMMAND FROM TTY?
	JRST	COBLAS		;NO
COBLAS:	RESET%
	GETNM			; Get the name of the program
	MOVE	T2,T1		; Private name is name returned by GETNM%
	MOVE	T1,[SIXBIT \COBOL\] ;System name
	SETSN%			;Let's tell the Monitor!
	 NOOP			;Failure return, we don't care!
	SETOM	.COBSW		;Signal called by Cobol
	MOVEI	T1,.LNSJB	;Job-wide logical name
	HRROI	T2,[ASCIZ /COBOL-SCANNER/]
	MOVE	T3,[POINT 7,.OLDSW]
	LNMST%
	  JRST	NOLNM		;No logical name
	MOVE	T3,.OLDSW	;Get name
	SETZM	.OLDSW		;Assume off
	CAME	T3,[ASCIZ /OLD/]
	CAMN	T3,[ASCIZ /old/]
	SETOM	.OLDSW		;Use TOPS-10 command scanner
NOLNM:	MOVEI	T1,.FHSLF	;This process's compatibility vector
	SETO	T2,		;Do not allow UUOs
	SCVEC%
	MOVE	PP,[SPSIZE##,,SPLIST##-1]	;Set up stack
	PUSHJ	PP,APRINI	;Initialize interupt system

;Save initial values of .JBFF and .JBREL
	MOVE	T1,.JBFF	; Save value of .JBFF across compile
	MOVE	T2,.JBREL	; Save value of .JBREL across compile
	DMOVEM	T1,XJBFF	;

;Zero all of free memory between .JBFF and .JBREL just to be sure
	CAIG	T1,(T2)
	SETZM	(T1)
	AOS	T1
	HRL	T1,.JBFF
	CAMLE	T2,.JBFF
	BLT	T1,(T2)
	PUSHJ	PP,SETIMP	;Initialize Cobol specific stuff
	JRST	CMND20##	;Continue in language independant code
	SUBTTL TRAP handling routines

;
;	Subroutine to initialize for 'APR' trapping
;

; SET UP TRAPS FOR
;
; TOPS-10	TOPS-20
; AP.POV	.ICPOV		PUSHDOWN OVERFLOW
; AP.NXM	.ICNXP		NON-EXISTENT MEMORY
; AP.ILM	.ICIRD 		MEMORY PROTECTION VIOLATION
;		.ICIWR		(READ & WRITE)
;
APRINI:
	MOVEI	T1, .FHSLF	; OWN FORK
	CIS%			; CLEAR INTERUPT SYSTEM
	MOVE	T2, [LEVTAB,,CHNTAB] ; ADDR OF LEVEL TAB & CHAN TAB
	SIR%			; SET INTERUPT ADDRESSES
	EIR%			; ENABLE INTERUPT SYSTEM

	MOVE	T2, .JBREL	; END OF CORE (REFERENCES PG 0)
	ORI	T2, 777		; END OF PAGE-IFY
	MOVEI	T3, 1777	; START AT END OF PAGE 1
APR.1:	CAMLE	T3, T2		; DONE YET?
	 JRST	APR.2		; YES, ACTIVATE INTERUPTS
	SKIP	(T3)		; NO, REFERENCE THIS PAGE
	ADDI	T3, 1000	; BUMP UP 1 PAGE
	JRST	APR.1

APR.2:	MOVE	T2,[CHNMSK]	; ARM PROPER CHANNELS
	AIC%			; ENABLE INTERUPT CHANNELS
	POPJ	SREG,		;

;  Blocks for TOPS-20 interupt system
;   Note: all interupts happen at level 1

LEVTAB:	LEV1PC			; ADDR OF LEVEL 1 PC
	LEV2PC			; ADDR OF LEVEL 2 PC
	LEV3PC			; ADDR OF LEVEL 3 PC

	RELOC			; TO THE LOWSEG

LEV1PC:	BLOCK	1		; LEVEL 1 PC
LEV2PC:	BLOCK	1		; LEVEL 2 PC
LEV3PC:	BLOCK	1		; LEVEL 3 PC

	RELOC			; BACK TO PURE STORAGE

CHNMSK==1B<.ICPOV>!1B<.ICIRD>!1B<.ICIWR>!1B<.ICNXP> ; CHANNEL MASK

CHNTAB:	PHASE	0		; *** BEWARE! ***

; The value of  "." is  now the  current offset  into the  table
; instead of .-CHNTAB so you  are allways <n>-. words away  from
; entry <n> instead of <n>-<.-CHNTAB>

	BLOCK	.ICPOV-.	;  (0-8)
	1,,POVTRP		;  (9) PDL OVERFLOW

	BLOCK	.ICILI-.	; (10-14)
	1,,ILITRP		; (15) ILL INST
	1,,IRDTRP		; (16) ILL MEM READ
	1,,IWRTRP		; (17) ILL MEM WRITE

	BLOCK	.ICNXP-.	;  (18-21)
	1,,NXPTRP		;  (22) NON-EXISTENT PAGE

	BLOCK	^D35-.		;  (23-35)
	DEPHASE			;  *** END OF PHASE 0 ***
	SUBTTL	CORE UUO Simulation Routines
; NEW  /PLB
; Simulate CORE UUO for TOPS-20
CORUUO::
	PUSH	SREG, T1
	PUSH	SREG, T2
	MOVEI	T1, %HISEG	;GET HI-SEGMENT ORIGIN
	CAMG	T1, -3(P)	;LARGER THEN REQUESTED CORE BREAK?
	 PUSHJ	SREG, CORERR	;'FRAID SO

	MOVEI	T1, .FHSLF	;THIS PROCESS
	MOVEI	T2, 1B<.ICNXP>	;NON-EXISTENT PAGE TRAP
	DIC%			;DEACTIVATE

	MOVE	T2, -3(P)	;GET DESIRED LOW SEGMENT BREAK
	ORI	T2, 777		;END-OF-PAGE-IFY
	MOVE	T1, .JBREL	;GET CURRENT END OF CORE

	CAMG	T2, T1		;CUTTING BACK????
	 JRST	CORE.1		;YES

	AOJ	T1,		;BUMP UP FROM END OF LAST PAGE
	SETZM	(T1)		;ZERO FIRST WORD
	HRL	T1, T1		;PREPARE FOR BLT
	BLT	T1, (T2)	;SMEAR THE ZEROS

CORE.1:	MOVEM	T2, .JBREL	;STORE AS NEW END

	MOVEI	T1, .FHSLF	;OUR FORK
	MOVEI	T2, 1B<.ICNXP>	;NXP INTERUPT CONDITION
	AIC%			;ACTIVATE CHANNEL

	POP	SREG, T2
	POP	SREG, T1
	POPJ	SREG,

; Core UUO failure routine is low segment resident (called from
; CORMAN and GETCOR).

CORERR::			;HERE WHEN CORE UUO FAILS
	DMOVEM	T1,APRSV1	;STORE T1, T2
	MOVEM	T3,APRSV3	; STORE T3
	SOS	T1,0(P)		;WHERE WERE WE CALLED FROM
	HRRZM	T1,.JBTPC	;STORE ADDRESS
	HRROI	T2,[ASCIZ \?CBLUCE User Core Exceeded\]	;LOCATE MESSAGE
	JRST	APRTR4		;FINISH MESSAGE
	SUBTTL	Misc. Error Utility Routines

;APR TRAP ROUTINE

NXPTRP:	DMOVEM	T1, APRSV1	; SAVE REGS T1 & T2
	MOVEI	T1, .FHSLF	; US
	GTRPW%			; GET TRAP WORD
	JUMPE	T1, NXP.0	; NO ERROR ?
	HRRZ	T2,T1		;Get location
	CAMG	T2,.JBREL	;Under top of low seg?
	JRST	NOTRAP		;Yes, return to user
	CAIGE	T2,%HISEG	;In high seg?
	JRST	NXP.1		;No, give error for sure
	HRRZ	T2,.JBHRL	;Get top of high seg
	CAIGE	T2,(T1)		;Is it above top?
	JRST	NXP.1		;Yes, give error
NOTRAP:	DMOVE	T1, APRSV1	; GET REGS BACK
	DEBRK%			; RETURN FROM TRAP
				; FALL THRU ON ERROR
	DMOVEM	T1, APRSV1	; SAVE REGS T1 & T2
NXP.0:	HRROI	T2,[ASCIZ \Unknown trap error\]
	JRST	ICEERR		;Report it

NXP.1:	HRROI	T2, [ASCIZ \Illegal Memory Reference\] ; GENERIC NXM
	TLNE	T1, (PF%WRT)	; PAGE FAIL ON WRITE?
	HRROI	T2, [ASCIZ \Non-existent memory write\]
	JRST	ICEERR		;Report it

ILITRP:	DMOVEM	T1, APRSV1	;Save regs T1 & T2
	HRROI	T2, [ASCIZ \Illegal instruction\]
	JRST	ICEERR		;Report it

IRDTRP:	DMOVEM	T1, APRSV1	;Save regs T1 & T2
	HRROI	T2, [ASCIZ \Illegal memory read\]
	JRST	ICEERR		;Report it

IWRTRP:	DMOVEM	T1, APRSV1	;Save regs T1 & T2
	HRROI	T2, [ASCIZ \Illegal memory write\]
	JRST	ICEERR		;Report it

POVTRP:	DMOVEM	T1, APRSV1	;Save regs T1 & T2
	HRROI	T2,[ASCIZ \Stack exhausted\] ;PDL OVERFLOW

ICEERR:	MOVEM	T3, APRSV3	;Save T3 also
	HRROI	T1,[ASCIZ \
?CBLICE	Internal Compiler Error
?\]
	PSOUT%
APRTR4:	HRRO	T1,T2		;GET ERROR STRING
	PSOUT%
	HRROI	T1,[ASCIZ \ at location \]
	PSOUT%

	MOVEI	T1,.PRIOU	;TO TERMINAL
	HRRZ	T2,LEV1PC	;TRAP PC
	MOVE	T3,[NO%OOV!NO%LFL!NO%ZRO!FLD(6,NO%COL)!10] ;LPAD W/ ZERO , SIX OITS
	NOUT%
	 NOOP			;OVERFLOW?

	HRROI	T1,[ASCIZ \ in Phase \]
	PSOUT%

	MOVE	T1,PHASEN##	;Get phase #
	PBOUT%
	HRROI	T1,CRLF
	PSOUT%

APRTR2:	DMOVE	T1,APRSV1	; RESTORE REGS
	MOVE	T3,APRSV3	; FOR CRASH
	JRST	KILL

CRLF:	ASCIZ	/
/

	SUBTTL	Initialize the Flag Areas

INITFL:	SETZM	ONFLG		;Clear the first word of flags
	MOVE	T1,[XWD ONFLG,ONFLG+1]	;Clear "must be ON or OFF" flags
	BLT	T1,ONFLG+2*NUMFLGS-1
	POPJ	PP,
	SUBTTL	DOCOMPILE -- Call the COBOL Compiler

DOCOMPILE:
	PUSH	SREG,P1		;Save old value of P1
	PUSH	SREG,P2		;Save old value of P2

	MOVE	T1,[ONFLG,,SONFLG]	;Move command line flags to save area
	BLT	T1,SONFLG+2*NUMFLGS-1
	MOVE	T1,[ONFLG,,ONFLG+1]
	SETZM	ONFLG		;Clear "must be ON" and "must be OFF" flags
	BLT	T1,ONFLG+2*NUMFLGS-1
	PUSHJ	SREG,SCANSW	;Get switches for SWITCH.INI

;Resolve the switch settings

	MOVE	T1,DEFFLG	;Get the default value of switch words
	SKIPE	FLAG10		;Was command scanned as a TOPS-10 command?
	IOR	T1,DEF10	;Yes, add in -10 defaults
	ANDCM	T1,OFFFLG	;Turn off flags that must be off
	IOR	T1,ONFLG	;Turn on flags that must be on
	ANDCM	T1,SOFFLG	;Turn off flags that must be off
	IOR	T1,SONFLG	;Turn on flags that must be on
	MOVEM	T1,ONFLG	;Store final on state

	SKIPN	T2,SONFLG+$FS	;Get stack size from command line
	MOVE	T2,ONFLG+$FS	;Or from SWITCH.INI
	MOVEM	T2,OJPPSZ	;Save it

	SKIPN	T2,SONFLG+$FX	;Get which ANSI standard from command line
	MOVE	T2,ONFLG+$FX	;Or from SWITCH.INI
	IORM	T2,COBXSW	;Save it
	TXNE	T2,SW.A74	;Want ANS-74?
	SETOM	AS7482		;Yes
	TXNE	T2,SW.A82	;Want ANS-8x?
	AOS	AS7482		;Yes

	SKIPN	T2,SONFLG+$FD	;Get default display mode from command line
	MOVE	T2,ONFLG+$FD	;Or from SWITCH.INI
	MOVEM	T2,DEFDSP	;Save it

	SKIPN	T2,SONFLG+$FL	;Get FIPS flagger bits from command line
	MOVE	T2,ONFLG+$FL	;Or from SWITCH.INI
	JUMPE	T2,SET$FC	;No flags to set
	TLNE	T2,-1		;Is it flags we don't want?
	JRST	[HLRZ	T2,T2		;Yes, get in RHS first
		TRNE	T2,%LV.L	;Now turn on all included FIPS flags
		TROA	T2,%LV.LI	;Low implies Low-intermediate etc.
		TRNE	T2,%LV.LI
		TROA	T2,%LV.HI
		TRNE	T2,%LV.HI
		TRO	T2,%LV.H
		SETCAM	T2,FLGSW	;Compliment it
		JRST	SET$FC]
	TRNE	T2,%LV.H	;Now turn all included FIPS flags
	TROA	T2,%LV.HI	;High implies High-intermediate etc.
	TRNE	T2,%LV.HI
	TRO	T2,%LV.LI
	TRO	T2,%LV.L	;Always turn on Low-level
	MOVEM	T2,FLGSW	;Save it

SET$FC:
IFN DEBUG,<
	MOVE	T2,SONFLG+$FC	;Get /KILL and /TRACE masks from command line
	TLNN	T2,-1		;/KILL seen?
	HLL	T2,ONFLG+$FL	;No get from SWITCH.INI
	TRNN	T2,-1		;/TRACE seen?
	HRR	T2,ONFLG+$FL	;No get from SWITCH.INI
	MOVEM	T2,CORESW	;Save it
	TRNE	T2,-1		;Want tracing?
	SETOM	TRACFL		;Yes
>

;Now turn on or off the approprite bits in LHS of SW and set the full word switches.

	HRR	SW,T1		;Set bits in SW to speed up testing
	TXO	SW,FTERA+FREENT	;Default is two-seg code and list errors
	TXNN	T1,SW.ERA	;Want to print errors?
	TXZ	SW,FTERA	;No
	TXNE	T1,SW.CRF	;Seen /CREF?
	SETOM	CREFSW		;Yes, turn on CREF switch
	TXNE	T1,SW.AFS	;/ANSI-FORMAT seen?
	TXO	SW,FSEQ		;Yes, turn on sequence # switch
	TXNE	T1,SW.NOC	;Don't want library listed?
	SETOM	NOCPYL##	;Yes, set the flag
	TXNE	T1,SW.MAC	;Want macro expansion?
	TXO	SW,FOBJEC	;Yes, turn on permanent switch
	TXNE	T1,SW.MAI	;Main program switch seen?
	SETOM	SLASHJ		;Yes, generate start address no matter what
	TXNE	T1,SW.SUB	;Sub-program switch seen?
	SETOM	SUBPRG		;Yes, do not generate start address
	TXNE	T1,SW.MAP	;Want Data Division map?
	TXO	SW,FMAP		;Yes, turn on Data Division map wanted
	TXNE	T1,SW.OCS	;Syntax check only?
	TXO	SW,FFATAL	;Yes, prevent code generation
	TXNE	T1,SW.ONE	;Explicit one-seg wanted?
	JRST	[SWOFF	FREENT		;Turn off /TWOSEG
		SETOM	SEENRU		;Set flag to -1
		JRST	.+1]
	TXNE	T1,SW.TWO	;Explicit two-seg wanted?
	JRST	[SETOM	RENSW##		;Set flag for COBOLG, leave FREENT on
		AOS	SEENRU##	;Set flag to +1
		JRST	.+1]
	TXNE	T1,SW.OPT!SW.QIK	;Want to optimize code?
	SETOM	OPTSW		;Yes
	TXNE	T1,SW.PRD!SW.QIK	;Want production mode code?
	SETOM	PRODSW		;Yes
	TXNE	T1,SW.QIK	;Want benchmark speed code?
	SETOM	QUIKSW		;Yes, no bounds checking etc
	TXNE	T1,SW.ABO	;/ABORT seen?
	SETOM	ABRTSW		;Yes
	TXNE	T1,SW.OCS	;Is /SYNTAX specified?
	TXZ	SW,RELFLG	;Yes--Turn off /OBJECT flag
	TXNN	SW,LSTFLG	;Listing wanted?
	TXO	SW,FNOLST	;No, turn on nolist flag
	TXNN	SW,RELFLG	;Want REL FILE?
	SETOM	NORELSW		;No

;Now open the Rel and List files, also the scratch files
	PUSHJ	SREG,OPNSCR	;Open the initial scratch files
	TXNN	F,RELFLG	;Is a object file required?
	JRST	RELOBJ		;No--See if an object file JFN must be released
	SKIPL	T1,BINJFN	;Do we have an object file JFN?
	 JRST	OPNOBJ		;Yes--Now ready to open file

	HRRZI	T1,BINGJB	;Get pointer to arg block for GTJFN
	HRROI	T2,DEFFIL	;The default name block will be the filespec
	GTJFN%			;Get a JFN on the object file
	 ERJMP	MONERR		;
	HRRZM	T1,BINJFN	;Store JFN of object file

OPNOBJ:	MOVX	T2,OF%WR	;Open file for writing, ASCII 36 bit bytes
	OPENF%
	 ERJMP	MONERR		;Problems
	JRST	GETLST

RELOBJ:	SKIPGE	T1,BINJFN	;Get JFN of object file
	 JRST	GETLST		;No JFN of object file
	RLJFN%			;Release JFN
	 ERJMP	MONERR
	SETOM	BINJFN		;Mark JFN as released

GETLST:	 TXNN	SW,LSTFLG	;Is any list file specified?
	  SKIPGE T1,LSTJFN	;Get JFN of list file
	   JRST	GETL2		;No JFN for list file
	RLJFN%			;Release JFN
	 ERJMP	MONERR
	SETOM	LSTJFN		;Mark list file as having no JFN

GETL2:	TXNN	SW,LSTFLG	;Is list flag set?
	 JRST	GETLIB		;Yes--Don't have to get a list file JFN
	SKIPL	T1,LSTJFN	;Do we have an listing file JFN?
	 JRST	OPNLST		;Yes--Now ready to open list file

	HRRZI	T1,LSTGJB	;Set up for GTJFN%
	SKIPE	LSTTYP		;Does the original typescript from /LIST exist?
	 SKIPA	T2,[POINT 7,LSTTYP] ;Yes--Use it as filespec
	  HRROI	T2,DEFFIL	;No--Use default file as filespec
	GTJFN%			;Get list file JFN
	 ERJMP	MONERR
	HRRZM	T1,LSTJFN	;Store list file JFN

OPNLST:	MOVX	T2,FLD(7,OF%BSZ)+OF%WR ;Open file for writing, 7 bit bytes
	OPENF%
	 ERJMP	MONERR		;Problems

	SKIPE	CREFSW		;Seen /CREF?
	PUSHJ	PP,OPNCRF	;Yes, open CRF temp file
	MOVE	T1,LSTJFN	;Get JFN of list file
	DVCHR%			;Get characteristics of listing file
	LDB	T1,[POINTR(T1,DV%TYP)] ;Get device type
	CAIE	T1,.DVTTY	;Is it a terminal?
	 JRST	GETLIB		;No--Don't need to do anything
	HRRZ	P1,T3		;Save number of job that owns the terminal
	GJINF%			;Get this job's job number
	CAMN	P1,T4		;Are the job numbers the same?
	 TXO	SW,FLTTY	;Yes--Set the list file goes to our TTY flag

GETLIB:	SKIPG	T1,LIBJFN	;Any library file?
	JRST	LDSOU		;No
	DVCHR%			;Get characteristics
	LDB	T1,[POINTR(T1,DV%TYP)]
	CAIE	T1,.DVDSK	;Must be a disk
	JRST	NOTDSK		;So give error
	MOVE	T1,LIBJFN
	MOVX	T2,OF%RD	;Read 36 bits
	OPENF%
	  ERJMP	MONERR
	SETZM	LIBBH+1		;Force buffer setup on first read
	SETZM	LIBBH+2

LDSOU:
	SETOM	CNTIDX		;No source file is currently open
	PUSHJ	SREG,NXTFIL	;Open the first source file
	 HALTF%			;Error return--can not happen!
	SKIPN	CCLSW		;Was COBOL entered at CCL start address
	 JRST	CALCBL		;No--Load list file entry in CHNLTBL
	HRROI	T1,[ASCIZ \COBOL:	\] ; No square bracket
	PSOUT%			;Tell the user who we are
REPEAT 0,<			;This is done by COBOLB
	HRROI	T1,ATMBUF
	PSOUT%			;Print name of first source file
	HRROI	T1,[ASCIZ \
\]				; No square bracket
	PSOUT%
>

CALCBL:	PUSHJ	P,RETCOB	;Call COBOLA back

	PUSHJ	SREG,CLZALL	;Close all files

	DMOVE	T1,XJBFF	; Restore value of .JBFF
	MOVEM	T1,.JBFF	;
	MOVEM	T2,.JBREL	; Restore value of .JBREL

	SKIPE	ABRTSW##	;Was /ABORT specified?
	 TXNN	SW,FFATAL	;Yes, was there fatal errors during compile?
	  JRST	RETCOM		;No--Return from this compilation

	HRROI	T1,[ASCIZ \[Exit due to /ABORT]
\]
	PSOUT%
	HALTF%

RETCOM:	PUSHJ	PP,SETIMP	;Clear the impure area of compiler
	POP	SREG,P2		;Restore P2
	POP	SREG,P1		;Restore P1
	POPJ	SREG,		;Return


DEF10:	EXP	LSTFLG		;TOPS-10 default is to generate LST file

DEFFLG:
IFE DEBUG,<
	EXP	RELFLG!SW.ERA	;Default is to generate REL file and print errors
>
IFN DEBUG,<
	EXP	RELFLG!SW.ERA!LSTFLG!SW.MAC	;Plus listing with macro-code
>
SUBTTL	SWITCH ACTION ROUTINES

.ABORT:
	TRACE	<.ABORT>
	MOVX	T1,SW.ABO	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET

.ANSI:
	TRACE	<.ANSI:>
	MOVX	T1,SW.AFS	;Flag that says card sequenced input
	IORM	T1,ONFLG	;Turn on the card seq flag
	ANDCAM	T1,OFFFLG	;Turn off the no card seq flag
	JRST	OKRET

.C74:
	TRACE	<.C74>
	MOVX	T1,SW.A74	;Get flag
	JRST	.C748x

.C8x:
	TRACE	<.C8X>
	MOVX	T1,SW.A82	;Get flag
.C748x:	IORM	T1,ONFLG+$FX
	ANDCAM	T1,OFFFLG+$FX
	TXC	T1,SW.A74!SW.A82	;Do reverse for opposite switch
	ANDCAM	T1,ONFLG+$FX
	IORM	T1,OFFFLG+$FX
	JRST	OKRET

.CROSS:
	TRACE	<.CROSS>
	MOVX	T1,SW.CRF!LSTFLG	;Get the flags
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET


.DEBUG:
	TRACE	<.DEBUG>
	SETOM	DEBSW
	JRST	OKRET

.DISP9:
	TRACE	<.DISP9>
	HRROI	T1,%US.EB	;Turn on EBCDIC mode
	MOVEM	T1,ONFLG+$FD	;In flags that must be on
	JRST	OKRET

.DISPLAY:
	TRACE	<.DISPLAY:>
	MOVEI	T2,DIS.KY	;Look for a keyword (single letter only)
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return, command not completed

	HRRO	T1,(T2)		;Get mode flag
	MOVEM	T1,ONFLG+$FD	;Turn on flags that must be on
	JRST	OKRET
.ERRORS:
	TRACE	<.ERRORS>
	MOVX	T1,SW.ERA	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET

.FLAGA:
	TRACE	<.FLAGA:>
	HRROS	OFFFLG+$FL	;Turn off all FLAG-IF flags
	MOVEI	T2,FLG.K1	;Look for a keyword
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return, command not completed

	SETZ	VREG,		;Assume that nothing unusual happens

	CAIN	T3,FLG.K1	;Was a keyword found?
	 PJRST	PRSFLA		;Yes--go process keyword
	CAIE	T3,FLG.K3	;Was a open paren found?
	JRST	USRERR		;No, something wrong

GETFLA:	MOVEI	T2,FLG.K2	;Look for only a keyword
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	PUSHJ	SREG,PRSFLA	;Process this keyword

	HRROI	T4,[ASCIZ \CBLCMD Comma or ")" required -- \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	MOVEI	T2,COMMA.	;Look for a "," or a ")"
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRROI	T4,[ASCIZ \CBLCMD \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	CAIN	T3,COMMA.	;Was a comma found?
	 JRST	GETFLA		;Yes--get next keyword
	JRST	OKRET		;Signal that next switch was not scanned

PRSFLA:	HRRZ	T2,(T2)		;Get keyword mask
	IORM	T2,ONFLG+$FL	;Turn on flags that must be on
	POPJ	SREG,		;Return

.FLAGI:
	TRACE	<.FLAGI:>
	HLLOS	OFFFLG+$FL	;Turn off all FLAG-ALLBUT flags
	MOVEI	T2,FLG.K1	;Look for a keyword
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return, command not completed

	SETZ	VREG,		;Assume that nothing unusual happens

	CAIN	T3,FLG.K1	;Was a keyword found?
	 PJRST	PRSFLI		;Yes--go process keyword
	CAIE	T3,FLG.K3	;Was a open paren found?
	JRST	USRERR		;No, something wrong

GETFLI:	MOVEI	T2,FLG.K2	;Look for only a keyword
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	PUSHJ	SREG,PRSFLI	;Process this keyword

	HRROI	T4,[ASCIZ \CBLCMD Comma or ")" required -- \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	MOVEI	T2,COMMA.	;Look for a "," or a ")"
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRROI	T4,[ASCIZ \CBLCMD \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	CAIN	T3,COMMA.	;Was a comma found?
	 JRST	GETFLI		;Yes--get next keyword
	JRST	OKRET		;Signal that next switch was not scanned

PRSFLI:	HRLZ	T2,(T2)		;Get keyword mask into LHS
	IORM	T2,ONFLG+$FL	;Turn on flags that must be on
	POPJ	SREG,		;Return

;Here for old TOPS-10 /Y switch

.FLAGY:
	TRACE	<.FLAGY:>
	SKIPN	.OLDSW		;Old style scanner?
	JRST	.FLAGA		;No, just lazy typist
	MOVEI	T2,YSW.K1	;Look for a keyword
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return, command not completed

	SETZ	VREG,		;Assume that nothing unusual happens
	CAIN	T3,YSW.K2	;Was a hyphen found?
	JRST	.FLAGZ		;Yes, this is /FLAG-IF:
	HRROS	OFFFLG+$FL	;Turn off all /FLAG-IF flags
	CAIE	T3,YSW.K1	;Was a keyword found?
	JRST	USRERR		;No, something wrong
	PUSHJ	SREG,PRSFLY	;Yes, go process keyword

GETFLY:	MOVEI	T2,YSW.K3	;Look for another letter, or end of switch
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIE	T3,YSW.K3	;Did we find a letter?
	POPJ	SREG,		;No, switch is finished
	PUSHJ	SREG,PRSFLY	;Process this keyword
	JRST	GETFLY		;Get next letter

	HRROI	T4,[ASCIZ \CBLCMD Comma or ")" required -- \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	MOVEI	T2,COMMA.	;Look for a "," or a ")"
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRROI	T4,[ASCIZ \CBLCMD \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	CAIN	T3,COMMA.	;Was a comma found?
	 JRST	GETFLA		;Yes--get next keyword
	JRST	OKRET		;Signal that next switch was not scanned

PRSFLY:	HRRZ	T2,(T2)		;Get keyword mask
	IORM	T2,ONFLG+$FL	;Turn on flags that must be on
	POPJ	SREG,		;Return

.FLAGZ:	HLLOS	OFFFLG+$FL	;Turn off all FLAG-ALLBUT flags
GETFLZ:	MOVEI	T2,YSW.K3	;Look for another letter, or end of switch
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	CAIE	T3,YSW.K3	;Did we find a letter?
	POPJ	SREG,		;No, switch is finished
	PUSHJ	SREG,PRSFLY	;Process this keyword
	JRST	GETFLZ

PRSFLZ:	HRLZ	T2,(T2)		;Get keyword mask
	IORM	T2,ONFLG+$FL	;Turn on flags that must be on
	POPJ	SREG,		;Return
.LIBRARY:
	TRACE	<.LIBRARY:>
	SKIPG	T1,LIBJFN	;Get the possibly old library file JFN
	 JRST	NEWLIB		;If no old JFN, then try and get new JFN
	RLJFN%			;Release old JFN
	 ERJMP	MONERR
	SETOM	LIBJFN		;Mark JFN as unused

	MOVE	T1,STATE+.CMFLG	;Get flags returned by the COMND% JSYS
	TXNN	T1,CM%SWT	;Was switch terminated with a colon?
	 JRST	OKRET		;No--return

NEWLIB:	MOVX	T1,GJ%OLD+GJ%XTN
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device

	HRROI	T1,[ASCIZ \LIBARY\]
	MOVEM	T1,CJFNBK+.GJNAM ;Set default name

	HRROI	T1,[ASCIZ \LIB\] ;Default extension is .LIB
	MOVEM	T1,CJFNBK+.GJEXT ;Set default extension

	MOVEI	T2,LBFIL	;Look for a filename
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRRZM	T2,LIBJFN	;Store the new library file JFN

LIBCPY:	MOVE	T1,[POINT 7,ATMBUF]
	MOVE	T2,[POINT 7,LIBTYP]
LIBLP:	ILDB	T3,T1		;Copy what the user typed . . .
	IDPB	T3,T2		;. . . into the area to hold his typescript
	JUMPN	T3,LIBLP	;Copy until null byte is found

	JRST	OKRET		;Get next switch

LBFIL:	FLDDB.	(.CMFIL,CM%SDH,,<filespec of library file>)
.LIST:
	TRACE	<.LIST:>
	MOVX	T1,LSTFLG	;Get flag that says a list file is being made
	IORM	T1,ONFLG	;Turn on flag that says a list file is made
	ANDCAM	T1,OFFFLG	;Turn off the no list file flag

	HLRZ	T1,CMDSOU	;Get source from which this switch came
	CAIN	T1,FRMSWI	;Did this switch come from SWITCH.INI
	 JRST	OKRET		;Yes--Return since /LIST in SWITCH.INI can
				;not take a value.

	MOVE	T1,STATE+.CMFLG	;Get flags returnd by the COMND% JSYS
	TXNN	T1,CM%SWT	;Was switch terminated with a colon?
	 JRST	OKRET		;No--return

	SKIPG	T1,LSTJFN	;Get the possibly old listing file JFN
	 JRST	NEWLST		;If no old JFN, then try and get new JFN
	RLJFN%			;Release old JFN
	 ERJMP	MONERR
	SETOM	LSTJFN		;Mark JFN as unused

NEWLST:	MOVX	T1,GJ%FOU+GJ%XTN
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device

	PUSHJ	SREG,GETDEF	;Get default filename text into DEFFIL
	HRROI	T1,DEFFIL	;Get pointer to default text
	MOVEM	T1,CJFNBK+.GJNAM ;Set default name

	HRROI	T1,[ASCIZ \LST\] ;Default extension is .LST
	MOVEM	T1,CJFNBK+.GJEXT ;Set default extension

	MOVEI	T2,LFIL		;Look for a filename
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRRZM	T2,LSTJFN	;Store the new listing file JFN

LSTCPY:	MOVE	T1,[POINT 7,ATMBUF]
	MOVE	T2,[POINT 7,LSTTYP]
LSTLP:	ILDB	T3,T1		;Copy what the user typed . . .
	IDPB	T3,T2		;. . . into the area to hold his typescript
	JUMPN	T3,LSTLP	;Copy until null byte is found

	JRST	OKRET		;Get next switch

LFIL:	FLDDB.	(.CMFIL,CM%SDH,,<filespec of list file>)
.MACHINE:
	TRACE	<.MACHINE>
	MOVX	T1,SW.MAC	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET

.MAIN:
	TRACE	<.MAIN>
	MOVE	T1,ONFLG	;Get flags
	TXNE	T1,SW.SUB	;Have we already seen /SUB?
	JRST	BADIJ		;GIVE ERROR MESSAGE
	MOVX	T1,SW.MAI	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET

BADIJ:	HRROI	T1,[ASCIZ \?Switches /MAIN-PROGRAM and /SUBPROGRAM are mutually exclusive.\]
	PSOUT%
	POPJ	PP,

.MAP:
	TRACE	<.MAP>
	MOVX	T1,SW.MAP	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET

.NOABORT:
	TRACE	<.NOABORT>
	MOVX	T1,SW.ABO	;Get the flag
	ANDCAM	T1,ONFLG	;Turn off flags that must be off
	IORM	T1,OFFFLG	;Turn on flags that must be on
	JRST	OKRET

.NOCOPY:
	TRACE	<.NOCOPY>
	MOVX	T1,SW.NOC	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET

.NOCROSS:
	TRACE	<.NOCROSS>
	MOVX	T1,SW.CRF	;Get the flags
	ANDCAM	T1,ONFLG	;Turn off flags that must be off
	IORM	T1,OFFFLG	;Turn on flags that must be on
	JRST	OKRET

.NOERRORS:
	TRACE	<.NOERRORS>
	MOVX	T1,SW.ERA	;Get the flag
	ANDCAM	T1,ONFLG	;Turn off flags that must be off
	IORM	T1,OFFFLG	;Turn on flags that must be on
	JRST	OKRET

.NOOBJECT:
	TRACE	<.NOOBJECT>
	MOVX	T1,RELFLG	;Get the flag
	ANDCAM	T1,ONFLG	;Turn off flags that must be off
	IORM	T1,OFFFLG	;Turn on flags that must be on
	JRST	OKRET

.NOSYNTAX:
	TRACE	<.NOSYNTAX>
	MOVX	T1,SW.OCS	;Get the flag
	ANDCAM	T1,ONFLG	;Turn off flags that must be off
	IORM	T1,OFFFLG	;Turn on flags that must be on
	JRST	OKRET

.NODEBUG:
	TRACE	<.NODEBUG>
	SETZM	DEBSW		;Turn off debugging module
	JRST	OKRET		;Go get next switch


.NOLIST:
	TRACE	<.NOLIST>
	MOVX	T1,LSTFLG	;Get flag that says a list file is being made
	ANDCAM	T1,ONFLG	;Turn off flag that says a list file is made
	IORM	T1,OFFFLG	;Turn on the no list file flag
	TXZ	SW,FOBJEC!FMAP	;Turn of possible list type flags
	JRST	.NOCROSS	;No cref either


.NOMACHINE:
	TRACE	<.NOMACHINE>
	MOVX	T1,SW.MAC	;Get the flag
	ANDCAM	T1,ONFLG	;Turn off flags that must be off
	IORM	T1,OFFFLG	;Turn on flags that must be on
	JRST	OKRET


.NOPTIMIZE:
	TRACE	<.NOPTIMIZE>
	MOVX	T1,SW.OPT	;Get the flag
	ANDCAM	T1,ONFLG	;Turn off flags that must be off
	IORM	T1,OFFFLG	;Turn on flags that must be on
	JRST	OKRET
.OBJECT:
	TRACE	<.OBJECT:>
	MOVX	T1,RELFLG	;Get flag that says a .REL file is being made
	IORM	T1,ONFLG	;Turn on flag that says a .REL file is made
	ANDCAM	T1,OFFFLG	;Turn off the no .REL file flag
	HLRZ	T1,CMDSOU	;Get source from which this switch came
	CAIN	T1,FRMSWI	;Did this switch come from SWITCH.INI
	 JRST	OKRET		;Yes--Return since /OBJECT doesn't take a
				;value in SWITCH.INI

	MOVE	T1,STATE+.CMFLG	;Get flags returned by the COMND% JSYS
	TXNN	T1,CM%SWT	;Was switch terminated with a colon?
	 JRST	OKRET		;No--return

	SKIPGE	T1,BINJFN	;Get the possibly old object file JFN
	 JRST	NEWOBJ		;If no old JFN, then try and get new object JFN
	RLJFN%			;Release old JFN
	 ERJMP	MONERR
	SETOM	BINJFN

NEWOBJ:	MOVX	T1,GJ%FOU+GJ%XTN
	MOVEM	T1,CJFNBK+.GJGEN ;Set default flags

	HRROI	T1,[ASCIZ \DSK\]
	MOVEM	T1,CJFNBK+.GJDEV ;Set default device

	PUSHJ	SREG,GETDEF	;Get default filename into DEFFIL
	HRROI	T1,DEFFIL	;Get pointer to default filename
	MOVEM	T1,CJFNBK+.GJNAM ;Set default name

	HRROI	T1,[ASCIZ \REL\]
	MOVEM	T1,CJFNBK+.GJEXT ;Set default extension

	MOVEI	T2,OBFIL	;Look for a filename
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRRZM	T2,BINJFN	;Store the new object file JFN

	JRST	OKRET		;Get next switch


OBFIL:	FLDDB.	(.CMFIL,CM%SDH,,<filespec of object file>)
.ONESEG:
	TRACE	<.ONESEG>
	MOVE	T1,ONFLG	;Get switches that are on
	TXNE	T1,SW.TWO	;Have we already seen /TWO?
	JRST	BADRU		;Yes, give error message
	MOVX	T1,SW.ONE	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET

BADRU:	HRROI	T1,[ASCIZ \?Switches /TWO-SEGMENT and /ONE-SEGMENT are mutually exclusive.\]
	PSOUT%
	POPJ	PP,

.OPTIMIZE:
	TRACE	<.OPTIMIZE>
	MOVX	T1,SW.OPT	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
OKRET:	SETZ	VREG,		;Signal that next switch has not been scanned
	POPJ	SREG,		;Get next switch

.PROD:
	TRACE	<.PROD>
	MOVX	T1,SW.PRD	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET


.QUICK:
	TRACE	<.QUICK>
	MOVX	T1,SW.QIK	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET
.REWIND:
	TRACE	<.REWIND>
	HRROI	T1,[ASCIZ \?/W is not supported.
\]
	PSOUT%
	POPJ	PP,

.STACK:
	TRACE	<.STACK>
	MOVEI	T2,[FLDDB.(.CMNUM,CM%SDH,^D8,<octal number>)] ;Look for a number
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed
	MOVEM	T2,ONFLG+$FS	;Store size
	JRST	OKRET		;Get next switch


.SYNTAX:
	TRACE	<.SYNTAX>
	MOVX	T1,SW.OCS	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET


.SUBPROGRAM:
	TRACE	<SUBPROGRAM>
	MOVE	T1,ONFLG	;Get flags
	TXNE	T1,SW.MAI	;Have we already seen /MAIN?
	JRST	BADIJ		;Yes, give error
	MOVX	T1,SW.SUB	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET
.TWOSEG:
	TRACE	<.TWOSEG>
	MOVE	T1,ONFLG	;Get switches that are on
	TXNE	T1,SW.ONE	;Have we already seen /ONE?
	JRST	BADRU		;Yes, give error message
	MOVX	T1,SW.TWO	;Get the flag
	IORM	T1,ONFLG	;Turn on flags that must be on
	ANDCAM	T1,OFFFLG	;Turn off flags that must be off
	JRST	OKRET

.VERSION:
	TRACE	<.VERSION>
	MOVEI	T2,VER.KY	;Look for 74 or 8x
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return, command not completed
	HRLZ	T1,(T2)		;Get flag
	JRST	.C748x		;Store in memory
IFN DEBUG,<

.KILL:
	TRACE	<.KILL:>
	MOVEI	T2,KIL.KY	;Look for a keyword (single letter only)
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return, command not completed

	HRLZ	T2,(T2)		;Get keyword mask
	HLLM	T2,ONFLG+$FC	;Turn on flags that must be on
	JRST	OKRET


.RANGE:
	TRACE	<.RANGE>
	MOVEI	T2,[FLDDB.(.CMNUM,CM%SDH,^D10,<initial decimal line number>)] ;Look for a number
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed
	MOVEM	T2,TRCLN1##	;Store starting line number
	MOVEI	T2,[FLDDB. (.CMCMA)]
	PUSHJ	SREG,CMD	;Parse a comma
	 JRST	USRERR		;EOF return, command not completed
	MOVEI	T2,[FLDDB.(.CMNUM,CM%SDH,^D10,<final decimal line number>)] ;Look for a number
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed
	MOVEM	T2,TRCLN2##	;Store ending line number
	JRST	OKRET		;Get next switch
.TRACE:
	TRACE	<.TRACE>
	MOVEI	T2,TR.K1	;Look for a keyword, "(", or confirm
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return, command not completed

	SETZ	VREG,		;Assume that nothing unusual happens

	CAIN	T3,TR.K1	;Was a keyword found?
	 PJRST	PRSTR1		;Yes--go process keyword
	CAIN	T3,TR.K3	;Was a open paren found?
	 JRST	GETTR1		;Yes--go get a list of keywords

	MOVEI	T1,TRACEA	;Use default of /TRACE:ALL
	HRRM	T1,ONFLG+$FC	;Store results

	CAIN	T3,COMPSW	;Was a switch found?
	 SKIPA	VREG,[-1]	;Yes--Signal that next switch has been scanned
	  MOVEI	VREG,1		;Must have a carriage return--signal confirm
	POPJ	SREG,		;Return

GETTR1:	MOVEI	T2,TR.K2	;Look for only a keyword
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	PUSHJ	SREG,PRSTR1	;Process this keyword

	HRROI	T4,[ASCIZ \CBLCMD Comma or ")" required -- \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	MOVEI	T2,COMMA.	;Look for a "," or a ")"
	PUSHJ	SREG,CMD	;Do COMND% JSYS
	 JRST	USRERR		;EOF return--command not completed

	HRROI	T4,[ASCIZ \CBLCMD \]
	MOVEM	T4,ERRPFX	;Store error message prefix

	CAIN	T3,COMMA.	;Was a comma found?
	 JRST	GETTR1		;Yes--get next keyword
	JRST	OKRET		;Signal that next switch was not scanned

PRSTR1:	HRRZ	T2,(T2)		;Get keyword mask
	HRRM	T2,ONFLG+$FC	;Turn on flags that must be on
	POPJ	SREG,		;Return
>
	SUBTTL	Function block for the COMND% JSYS
	ABBRIV==CM%FW ! CM%INV ! CM%ABR
	INVIS==CM%FW ! CM%INV

	DEFINE	TBL(STRING,FLAGS,ACTION)<
	IFE	FLAGS, <XWD [ASCIZ \'STRING\],ACTION>
	IFN	FLAGS, <XWD [EXP   FLAGS
			    ASCIZ \'STRING\],ACTION>
>

IFE DEBUG,<DEFINE DTBL(STRING,FLAGS,ACTION)<>>
IFN DEBUG,<SYN TBL,DTBL>

COMPSW:	FLDDB. (.CMSWI,0,COMSW,<a compilation switch,>,,CONFIRM)


COMMA.:	FLDDB.	(.CMCMA,CM%SDH,,<"," or ")">,,LEFTP)

LEFTP:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \)\]>)

VER.KY:	FLDDB.	(.CMKEY,0,VERTBL,<compiler standard,>)

DIS.KY:	FLDDB.	(.CMKEY,0,DISTBL,<default display mode,>)

FLG.K1:	FLDDB.	(.CMKEY,0,FLGTBL,<a flagger option,>,,FLG.K3)
FLG.K2:	FLDDB.	(.CMKEY,0,FLGTBL)
FLG.K3:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \(\]>,<"(" followed by a list of flagger options>)

YSW.K1:	FLDDB.	(.CMKEY,0,YSWTBL,<a flagger option,>,,YSW.K3)
YSW.K2:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \-\]>,<"-" followed by a list of flagger options>)
YSW.K3:	FLDDB.	(.CMKEY,0,YSWTBL)

IFN DEBUG,<
TR.K1:	FLDDB.	(.CMKEY,0,TRATBL,<a trace option,>,,TR.K3)
TR.K2:	FLDDB.	(.CMKEY,0,TRATBL)
TR.K3:	FLDDB.	(.CMTOK,CM%SDH,<POINT 7,[ASCIZ \(\]>,<"(" followed by a list of trace options>)

KIL.KY:	FLDDB.	(.CMKEY,0,KILTBL,<after compiler phase,>)
>
	SUBTTL	Compilation Switch Table

COMSW:	XWD	COMSWL,COMSWL			;Count of number of entries
	TBL	<A>,INVIS,[.MACHINE]		;/A=/MAC in TOPS-10 command scanner
	TBL	<ABORT>,,[.ABORT]
	TBL	<ANSI-FORMAT>,,[.ANSI]
	TBL	<BINARY:>,,[.OBJECT]
	TBL	<C>,ABBRIV,XXC			;/C in TOPS-10 command scanner
	TBL	<C74>,,[.C74]
	TBL	<C8>,,[.C8X]
	TBL	<CR>,ABBRIV,XXC
	TBL	<CREF>,INVIS,[.CROSS]
	TBL	<CRO>,ABBRIV,XXC
	TBL	<CROS>,ABBRIV,XXC
	TBL	<CROSS>,ABBRIV,XXC
XXC:	TBL	<CROSS-REFERENCE>,,[.CROSS]
	TBL	<CROSSREFERENCE>,INVIS,[.CROSS]
	TBL	<D>,INVIS,[.STACK]		;/D=/STACK in TOPS-10 command scanner
	TBL	<DEBUG>,,[.DEBUG]
	TBL	<DISPLAY:>,,[.DISPLAY]
	TBL	<E>,INVIS,[.SYNTAX]		;/E=/SYNTAX in TOPS-10 command scanner
	TBL	<ECHO-OPTION>,,[.ECHOOP]
	TBL	<ERRORS>,,[.ERRORS]
	TBL	<FLAG-ALLBUT:>,,[.FLAGA]
	TBL	<FLAG-IF:>,,[.FLAGI]
;;	TBL	<G>,INVIS,[.NOCOPY]		;/G =/NOCOPY in TOPS-10 command scanner
	TBL	<I>,INVIS,[.SUBPROGRAM]		;/I=/SUBPROG in TOPS-10 command scanner
	TBL	<J>,INVIS,[.MAIN]		;/J=/MAINPROG in TOPS-10 command scanner
	DTBL	<KILL:>,,[.KILL]
	TBL	<L>,ABBRIV,XXLIB		;/L=/LIB in TOPS-10 command scanner
	TBL	<LI>,ABBRIV,XXL
XXLIB:	TBL	<LIBRARY:>,,[.LIBRARY]
XXL:	TBL	<LISTING:>,,[.LIST]
	TBL	<M>,ABBRIV,XXMAP		;/M=/MAP in TOPS-10 command scanner
	TBL	<MA>,ABBRIV,XXM
	TBL	<MAC>,ABBRIV,XXM
XXM:	TBL	<MACHINE-CODE>,,[.MACHINE]
	TBL	<MACRO>,INVIS,[.MACHINE]
	TBL	<MAIN-PROGRAM>,,[.MAIN]
XXMAP:	TBL	<MAP>,,[.MAP]
	TBL	<N>,INVIS,[.NOERRORS]		;/N=/NOERRORS in TOPS-10 command scanner
	TBL	<NOABORT>,,[.NOABORT]
	TBL	<NOBINARY>,,[.NOOBJECT]
	TBL	<NOC>,ABBRIV,XXNOC
;;	TBL	<NOCOPY>,,[.NOCOPY]
	TBL	<NOCR>,ABBRIV,XXNOC
	TBL	<NOCREF>,INVIS,[.NOCROSS]
	TBL	<NOCRO>,ABBRIV,XXNOC
	TBL	<NOCROS>,ABBRIV,XXNOC
	TBL	<NOCROSS>,ABBRIV,XXNOC
XXNOC:	TBL	<NOCROSS-REFERENCE>,,[.NOCROSS]
	TBL	<NOCROSSREFERENCE>,INVIS,[.NOCROSS]
	TBL	<NODEBUG>,,[.NODEBUG]
	TBL	<NOERRORS>,,[.NOERRORS]
	TBL	<NOLISTING>,,[.NOLIST]
	TBL	<NOM>,ABBRIV,XXNOM
	TBL	<NOMA>,ABBRIV,XXNOM
	TBL	<NOMAC>,ABBRIV,XXNOM
XXNOM:	TBL	<NOMACHINE-CODE>,,[.NOMACHINE]
	TBL	<NOMACRO>,INVIS,[.NOMACHINE]
	TBL	<NOOBJECT>,INVIS,[.NOOBJECT]
	TBL	<NOOPT>,ABBRIV,XXNOOPT
	TBL	<NOOPTIMIZE>,,[.NOPTIMIZE]
XXNOOPT:TBL	<NOOPTION>,,[.NOOPTION]
	TBL	<NOS>,ABBRIV,XXNOS
XXNOS:	TBL	<NOSYNTAX>,,[.NOSYNTAX]
	TBL	<O>,ABBRIV,XXOP			;/O=/OPT in TOPS-10 command scanner
	TBL	<OBJECT:>,INVIS,[.OBJECT]
	TBL	<ONE-SEGMENT>,,[.ONESEG]
	TBL	<OP>,ABBRIV,XXOP
	TBL	<OPT>,ABBRIV,XXOP
XXOP:	TBL	<OPTIMIZE>,,[.OPTIMIZE]
	TBL	<OPTION:>,,[.OPTION]
	TBL	<PRODUCTION-MODE>,,[.PROD]	;/P in TOPS-10 command scanner
	TBL	<QUICK-MODE>,,[.QUICK]		;/Q in TOPS-10 command scanner
	TBL	<R>,INVIS,[.TWOSEG]		;/R=/TWO-SEG in TOPS-10 command scanner
	DTBL	<RANGE:>,,[.RANGE]		;Line number range for /TRACE
;	TBL	<REWIND>,,[.REWIND]
	TBL	<S>,INVIS,[.ANSI]		;/S=/ANSI-FORMAT in TOPS-10 command scanner
	TBL	<STACK:>,,[.STACK]
	TBL	<SUBPROGRAM>,,[.SUBPROGRAM]
	TBL	<SYNTAX>,,[.SYNTAX]
	DTBL	<T>,ABBRIV,XXTR			;/T=/TRACE in TOPS-10 command scanner
XXTR:	DTBL	<TRACE:>,,[.TRACE]
	TBL	<TWO-SEGMENT>,,[.TWOSEG]
	TBL	<U>,INVIS,[.ONESEG]		;/U=/ONE-SEG in TOPS-10 command scanner
XXV:	TBL	<VERSION:>,,[EXP .VERSION]		;/V=/VERSION in TOPS-10 commans scanner
	TBL	<W>,INVIS,[.REWIND]		;/W=/REWIND in TOPS-10 command scanner
	TBL	<X>,INVIS,[.DISP9]		;/X=/DISPLAY:9 in TOPS-10 command scanner
	TBL	<Y:>,INVIS,[.FLAGY]		;/Y=/FLAG-ALLBUT in TOPS-10 command scaner
	COMSWL==.-COMSW-1
	SUBTTL	Compilation Switch Table for TOPS-10 only

OCOMSW:	XWD	OCMSWL,OCMSWL		;Count of number of entries
	TBL	<A>,,[.MACHINE]		;/A=/MAC in TOPS-10 command scanner
	TBL	<B>,,[.DEBUG]		;/B=/DEBUG in TOPS-10 command scanner
	TBL	<C>,,[.CROSS]		;/C in TOPS-10 command scanner
	TBL	<D>,,[.STACK]		;/D=/STACK in TOPS-10 command scanner
	TBL	<E>,,[.SYNTAX]		;/E=/SYNTAX in TOPS-10 command scanner
	DTBL	<F:>,,[.KILL]		;/F =/K near enough
;;	TBL	<G>,,[.NOCOPY]		;/G =/NOCOPY in TOPS-10 command scanner
	TBL	<H>,,[.HELP]		;/H = HELP verb in TOPS-10 command scanner
	TBL	<I>,,[.SUBPROGRAM]	;/I=/SUBPROG in TOPS-10 command scanner
	TBL	<J>,,[.MAIN]		;/J=/MAINPROG in TOPS-10 command scanner
	DTBL	<K:>,,[.KILL]		;/K
	TBL	<L>,,[.LIBRARY]		;/L=/LIB in TOPS-10 command scanner
	TBL	<M>,,[.MAP]		;/M=/MAP in TOPS-10 command scanner
	TBL	<N>,,[.NOERRORS]	;/N=/NOERRORS in TOPS-10 command scanner
	TBL	<O>,,[.OPTIMIZE]	;/O=/OPT in TOPS-10 command scanner
	TBL	<P>,,[.PROD]		;/P in TOPS-10 command scanner
	TBL	<Q>,,[.QUICK]		;/Q in TOPS-10 command scanner
	TBL	<R>,,[.TWOSEG]		;/R=/TWO-SEG in TOPS-10 command scanner
	TBL	<S>,,[.ANSI]		;/S=/ANSI-FORMAT in TOPS-10 command scanner
	DTBL	<T>,,[.TRACE]		;/T=/TRACE in TOPS-10 command scanner
	TBL	<U>,,[.ONESEG]		;/U=/ONE-SEG in TOPS-10 command scanner
	TBL	<V:>,,[EXP .VERSION]	;/V=/VERSION in TOPS-10 commans scanner
	TBL	<W>,,[.REWIND]		;/W=/REWIND in TOPS-10 command scanner
	TBL	<X>,,[.DISP9]		;/X=/DISPLAY:9 in TOPS-10 command scanner
	TBL	<Y:>,,[.FLAGY]		;/Y=/FLAG-* in TOPS-10 command scaner
	TBL	<Z>,,[.NEW]		;/Z = Get back to TOPS-20 command scanner
	OCMSWL==.-OCOMSW-1
SUBTTL	Switch tables

VERTBL:	XWD	2,2
	TBL	<74>,,<(SW.A74)>
	TBL	<8x>,,<(SW.A82)>

DISTBL:	XWD	3,3
	TBL	<6>,,%US.D6
	TBL	<7>,,%US.D7
	TBL	<9>,,%US.EB

FLGTBL:	XWD	FLGLEN,FLGLEN
	TBL	<1>,INVIS,FLG.L
	TBL	<2>,INVIS,FLG.LI
	TBL	<3>,INVIS,FLG.HI
	TBL	<4>,INVIS,FLG.H
	TBL	<68-COBOL>,,%LV.68
	TBL	<8x-COBOL>,,%LV.8
	TBL	<DBMS-SYNTAX>,,%LV.DB
FLG.HI:	TBL	<HIGH-INTERMEDIATE-LEVEL>,,%LV.HI
FLG.H:	TBL	<HIGH-LEVEL>,,%LV.H
	TBL	<IBM-COMPATIBILITY>,,%LV.IB
FLG.LI:	TBL	<LOW-INTERMEDIATE-LEVEL>,,%LV.LI
FLG.L:	TBL	<LOW-LEVEL>,,%LV.L
	TBL	<NON-STANDARD-SYNTAX>,,%LV.NS
	TBL	<REPORT-WRITER-SYNTAX>,,%LV.RP
	TBL	<VAX-COMPATIBILITY>,,%LV.VX
	FLGLEN==.-FLGTBL-1

YSWTBL:	XWD	YSWLEN,YSWLEN
	TBL	<1>,,%LV.L
	TBL	<2>,,%LV.LI
	TBL	<3>,,%LV.HI
	TBL	<4>,,%LV.H
	TBL	<6>,,%LV.68
	TBL	<8>,,%LV.8
	TBL	<D>,,%LV.DB
	TBL	<I>,,%LV.IB
	TBL	<N>,,%LV.NS
	TBL	<R>,,%LV.RP
	TBL	<V>,,%LV.VX
	YSWLEN==.-YSWTBL-1
SUBTTL	DEBUG Options, /KILL: /TRACE:

KILTBL:	XWD	KILLEN,KILLEN
	DTBL	<A>,,%KILLA
	DTBL	<B>,,%KILLB
	DTBL	<C>,,%KILLC
	DTBL	<D>,,%KILLD
	DTBL	<E>,,%KILLE
	DTBL	<F>,,%KILLF
	DTBL	<G>,,%KILLG
	KILLEN==.-KILTBL-1

TRATBL:	XWD	TRALEN,TRALEN
	DTBL	<ALL>,,TRACEA
	DTBL	<DATA-DIVISION>,,TRACED
	DTBL	<ENVIRONMENT-DIVISION>,,TRACEE
	DTBL	<IDENTIFICATION-DIVISION>,,TRACEI
	DTBL	<PROCEDURE-DIVISION>,,TRACEP
	TRALEN==.-TRATBL-1
SUBTTL	Open initial scratch files for the compiler

;Set up the long form GTJFN default blocks for input, output, temp and library files.
;Then open the scratch files that will be required later.

OPNSCR:
;Get ASCII job number

	GJINF%			;GET INFO FROM MONITOR
	MOVE	T1,T3		;GET A COPY
	IDIVI	T1,^D100
	IDIVI	T2,^D10
	LSH	T1,2*7
	LSH	T2,7
	ADD	T1,T2
	ADD	T1,T3
	ADD	T1,["000"]
	LSH	T1,2*7+1	;Left justify
	MOVEM	T1,ASCJOB	;SAVE ASCII JOB NUMBER

;Set up the default GTJFN blocks

	MOVX	T1,GJ%FOU!GJ%TMP
	MOVE	T2,[.NULIO,,.NULIO]
	DMOVEM	T1,TMPGJB
	MOVX	T1,GJ%FOU
	DMOVEM	T1,BINGJB
	DMOVEM	T1,LSTGJB
	MOVX	T1,GJ%OLD
	DMOVEM	T1,SRCGJB
	DMOVEM	T1,LIBGJB
	MOVEI	T1,[ASCIZ /DSK:/]
	HRROM	T1,SRCGJB+.GJDEV
	HRROM	T1,BINGJB+.GJDEV
	HRROM	T1,LSTGJB+.GJDEV
	HRROM	T1,TMPGJB+.GJDEV
	HRROM	T1,LIBGJB+.GJDEV
	HRROI	T1,TMPSPC	;File name is stored here
	HRROI	T2,[ASCIZ /TMP/]
	DMOVEM	T1,TMPGJB+.GJNAM
	HRROI	T1,[ASCIZ /LIBARY/]
	HRROI	T2,[ASCIZ /LIB/]
	DMOVEM	T1,LIBGJB+.GJNAM
	HRROI	T2,[ASCIZ /REL/]
	MOVEM	T2,BINGJB+.GJEXT
	HRROI	T2,[ASCIZ /LST/]
	MOVEM	T2,LSTGJB+.GJEXT
	HRROI	T2,[ASCIZ /CBL/]
	MOVEM	T2,SRCGJB+.GJEXT
	MOVE	T1,ASCJOB	;Get job number
	MOVE	T2,[ASCIZ / ;T/]	;Finish prototype name
	DMOVEM	T1,TMPSPC
;Now open the initial temp files i.e. those always required.

	MOVE	T1,["NAM"]	;NAMTAB
	PUSHJ	PP,OPNTMP
	HRRZM	T1,NAMJFN	;Store jfn
	SETZM	NAMBH+1		;Force buffer fill on first write
	SETZM	NAMBH+2
	MOVX	T2,OF%WR	;Write 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	MOVE	T1,["ERA"]	;Error file
	PUSHJ	PP,OPNTMP
	HRRZM	T1,ERAJFN	;Store jfn
	SETZM	ERABH+1		;Force buffer fill on first write
	SETZM	ERABH+2
	MOVX	T2,OF%WR	;Write 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	MOVE	T1,["GEN"]	;GENFIL
	PUSHJ	PP,OPNTMP
	HRRZM	T1,GENJFN	;Store jfn
	SETZM	GENBH+1		;Force buffer fill on first write
	SETZM	GENBH+2
	MOVX	T2,OF%WR	;Write 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	MOVE	T1,["CPY"]	;CPYFIL copy of source
	PUSHJ	PP,OPNTMP
	HRRZM	T1,CPYJFN	;Store jfn
	SETZM	CPYBH+1		;Force buffer fill on first write
	SETZM	CPYBH+2
	MOVX	T2,OF%WR	;Write 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	MOVE	T1,["AS1"]	;ASCII name right justified
	PUSHJ	PP,OPNTMP	;Get JFN
	HRRZM	T1,AS1JFN	;Store jfn
	SETZM	AS1BH+1		;Force buffer fill on first write
	SETZM	AS1BH+2
	MOVX	T2,OF%WR	;Write 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	MOVE	T1,["AS2"]	;ASCII name right justified
	PUSHJ	PP,OPNTMP	;Get JFN
	HRRZM	T1,AS2JFN	;Store jfn
	SETZM	AS2BH+1		;Force buffer fill on first write
	SETZM	AS2BH+2
	MOVX	T2,OF%WR	;Write 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	POPJ	PP,
	SUBTTL	Open CREF temp files when required

;Note SF3 is not OPENed yet, only the JFN is obtained.

OPNSF:	PUSH	PP,T1
	PUSH	PP,T2
	MOVE	T1,["SF1"]
	PUSHJ	PP,OPNTMP
	HRRZM	T1,SF1JFN	;Store JFN
	SETZM	SF1BH+1		;Force buffer fill on first write
	SETZM	SF1BH+2
	MOVX	T2,OF%WR	;Write 36 bits
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	MOVE	T1,["SF2"]
	PUSHJ	PP,OPNTMP
	HRRZM	T1,SF2JFN	;Store JFN
	SETZM	SF2BH+1		;Force buffer fill on first write
	SETZM	SF2BH+2
	MOVX	T2,OF%WR	;Write 36 bits
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	MOVE	T1,["SF3"]
	PUSHJ	PP,OPNTMP
	HRRZM	T1,SF3JFN	;Store JFN for when it becomes output file later
	SETZM	SF3BH+1		;Force buffer fill on first write
	SETZM	SF3BH+2
	JRST	T2RET



	SUBTTL	OPNTMP	- Open temp files for compiler

;Enter with 3 char file name right justified in T1

OPNTMP:	IDIVI	T1,200		;First 2 chars in T1, 3rd in T2
	DPB	T1,[POINT 14,TMPSPC,34]
	DPB	T2,[POINT  7,TMPSPC+1,6]
	MOVEI	T1,TMPGJB	;Point to block
	HRROI	T2,TMPSPC	;File name string
	GTJFN%
	  TRNA			;Failed
	POPJ	PP,

	MOVX	T1,GJ%OFG	;Parse only
	IORM	T1,TMPGJB	;So we can give error message
	MOVEI	T1,TMPGJB	;Point to block
	GTJFN%			;Try again
	  SETZ	T1,		;No JFN on failure
	JRST	GJFERR		;Give meaningful error message
	SUBTTL	NXTFIL -- Open Next Source File

;***********************************************************************
; This routine is called by the compiler to open the next source file.
;***********************************************************************

NXTFIL:
	AOS	T4,CNTIDX	;Get index into list of source file to open
	CAMLE	T4,SRCIDX	;Have all the files been opened?
	 POPJ	PP,		;Yes--Take failure return

	PUSH	PP,P1		;Save P1
	PUSH	PP,P2		;Save P2

	MOVE	P1,SRCFIL(T4)	;Get JFN of source file
	MOVE	T1,P1		;Get JFN of source file
	MOVEM	T1,SRCJFN	;Save it for SIN%
	DVCHR%			;Get characteristics of source file
	  ERJMP	MONERR
	LDB	T1,[POINTR(T1,DV%TYP)] ;Get device type
	CAIE	T1,.DVTTY	;Is it a terminal?
	 JRST	NOTTTY		;No--Don't need to do anything
	TXO	SW,TTYINP	;Set TTY input flag
	MOVX	T2,FLD(7,OF%BSZ)+OF%RD+OF%WR ;Byte size is 7, allow read&write
	JRST	OPNSOU		;Open the source file

NOTTTY:	TXZ	SW,TTYINP	;Clear TTY input bit
	MOVX	T2,OF%RD	;Open file for writing, ASCII 36 bit bytes
OPNSOU:	MOVE	T1,P1		;Get JFN of next source file
	OPENF%
	 ERJMP	[MOVE	T1,XJBFF	; Restore value of .JBFF
		MOVEM	T1,.JBFF	;
		MOVE	T1,XJBREL	; Restore value of .JBREL
		MOVEM	T1,.JBREL	; 
		JRST	MONERR]

	TXZ	SW,FECOM	;Clear end of command string flag

	POP	PP,P2		;Restore P2
	POP	PP,P1		;Restore P1
	AOS	(PP)
	POPJ	PP,		;Take success return
	SUBTTL	OPNLIB -- Open the CPYLIB File for the Compiler
	;SUBROUTINE TO OPEN CPYLIB FILES
	;CHECK TO SEE THAT THEY ARE DISK
	;CALL WITH
	;	LIBSPC = ASCII FILE SPEC POINTER
	;	PUSHJ	PP,OPNLIB
	;	RETURN	HERE
	;		VREG = 0 - OK


OPNLIB:	PUSH	PP,T1
	PUSH	PP,T2
	PUSH	PP,T3
	SKIPLE	LIBJFN		;IS FILE ALREADY OPEN?
	PUSHJ	PP,CLZLIB	;YES, CLOSE IT FIRST
	SKIPN	LIBSPC		;DO WE HAVE A FILE SPEC?
	JRST	DEFLIB		;NO, USE "LIBARY.LIB"
	MOVEI	T1,LIBGJB	;LONG GTJFN% BLOCK
	MOVE	T2,[POINT 7,LIBSPC]	;SPEC POINTER
	GTJFN%
	  JRST	[SETZM	LIBJFN		;Zero out JFN to trigger GETITM's rtn
		JRST	T3RET]		; to proceed without library file
	HRRZM	T1,LIBJFN	;SAVE JFN

				;CHECK FOR DSK:
	HRRZ	T1,T1		;ZERO LEFT
	DVCHR%
	 ERJMP	MONERR
	LDB	T1,[POINTR(T1,DV%TYP)] ;Get device type
	CAIE	T1,.DVDSK	;Is it a disk?
	JRST	NOTDSK		;NO
	HRRZ	T1,LIBJFN	;GET JFN AGAIN
	MOVX	T2,OF%RD	;Read, ASCII, 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	MOVEI	VREG,0		;GOOD RETURN
	MOVE	T1,[LIBSPC,,LIBOSP]
	BLT	T1,LIBOSP+^D39	;COPY SPEC FOR COMPARE
	JRST	T3RET

NOTDSK:	HRROI	T1,[ASCIZ	\?Library device must be disk
\]
	PSOUT%
	AOJA	VREG,T3RET

DEFLIB:	MOVX	T1,GJ%OLD!GJ%SHT
	HRROI	T2,[ASCIZ /LIBARY.LIB/]
	GTJFN%			;Try for default
	  JRST	[SETZM	LIBJFN		;Zero out JFN to trigger GETITM's
		JRST	T3RET]		; rtn for proceeding without .LIB file
	HRRZM	T1,LIBJFN	;Save JFN
	MOVX	T2,OF%RD	;Read, ASCII, 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	JRST	T3RET
;Set file pointer of library file
;Enter with required word in TE

SFPLIB:	PUSH	PP,T1
	PUSH	PP,T2
	MOVE	T1,LIBJFN
	MOVE	T2,TE
	SFPTR%
	  HALT			;SHOULD NEVER HAPPEN
	POP	PP,T2
	POP	PP,T1
	POPJ	PP,

;Get buffer from library file

GETLBA:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,LIBJFN	;Get JFN
	DMOVE	T2,LIBPTR	;Setup TOPS-10 style buffer header
	DMOVEM	T2,LIBBH+1	;So I/O works same way
	DMOVE	T2,LIBIOW	;Get byte pointer and size
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,LIBJFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		IMULI	T3,5		;Convert to bytes
		ADDB	T3,LIBBH+2	;Adjust count
		JRST	.+1]
	JRST	T3RET		;OK, restore
SUBTTL	OPNAS3	-- Open AS3 temp file for the compiler

OPNAS3:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	MOVE	T1,["AS3"]	;ASCII name right justified
	PUSHJ	PP,OPNTMP	;Get JFN
	HRRZM	T1,AS3JFN	;Store jfn
	SETZM	AS3BH+1		;Force buffer fill on first write
	SETZM	AS3BH+2
	MOVX	T2,OF%WR	;Write 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
JT2RET:	POP	PP,T1		;Clear stack
	JRST	T2RET
SUBTTL	OPNLIT	-- Open Literal temp file for the compiler

;NOTE, I/O is done in DUMP mode

OPNLIT:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	MOVE	T1,["LIT"]	;ASCII name right justified
	PUSHJ	PP,OPNTMP	;Get JFN
	HRRZM	T1,LITJFN	;Store jfn
	SETZM	LITBH+1		;Force buffer fill on first write
	SETZM	LITBH+2
	MOVE	T2,[FLD(.GSDMP,OF%MOD)+OF%WR]	;Write 36 bit bytes in dump mode
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	JRST	JT2RET
SUBTTL	OPNOVR	-- Open segmentation overlay file

;It uses same buffers as binary file

OPNOVR:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,BINJFN
	DVCHR%
	 ERJMP	MONERR
	LDB	T1,[POINTR(T1,DV%TYP)] ;Get device type
	MOVE	T3,[FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+JS%PAF] ;We want <dir>name for sure
	CAIN	T1,.DVDSK	;Is it a disk?
	TXO	T3,FLD(.JSAOF,JS%DIR)	;Yes, use it also
	HRROI	T1,LIBSPC	;Get string to store part of spec
	MOVE	T2,BINJFN	;Get the JFN
	JFNS%			;Get the name
	  ERJMP	MONERR
	PUSHJ	PP,PUTBN1	;Finish off binary output
	PUSHJ	PP,CLZBIN	;And release JFN
	HRROI	T1,[ASCIZ /OVR/]
	MOVEM	T1,BINGJB+.GJEXT	;Change default extension
	MOVEI	T1,BINGJB	;Default dsk:.ovr
	MOVE	T2,[POINT 7,LIBSPC]	;Rest of string
	GTJFN%
	  JRST	[MOVX	T1,GJ%OFG	;Parse only
		IORM	T1,BINGJB	;So we can give error message
		MOVEI	T1,BINGJB	;Point to block
		GTJFN%			;Try again
		  SETZ	T1,		;No JFN on failure
		JRST	GJFERR]		;Give meaningful error message
	HRRZM	T1,BINJFN	;Store jfn
	SETZM	BINBH+1		;Force buffer fill on first write
	SETZM	BINBH+2
	MOVX	T2,OF%WR	;Write 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	JRST	T3RET


;Write out the directory of the overlay file

RITOVD:	PUSH	PP,T1
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,BINJFN
	RFPTR%			;Find out where we are in file
	 JRST	MONERR
	PUSH	PP,T2		;Save it
	MOVE	T1,BINJFN
	SETZ	T2,		;Set back to first byte
	SFPTR%
	  JRST	MONERR
	MOVE	T1,BINJFN
	HRRZ	T2,LITLOC##	;Where directory is stored
	HRLI	T2,(POINT ^D36,)
	MOVNI	T3,^D256
	SOUT%
	  ERJMP	PUTERR
	MOVE	T1,BINJFN
	POP	PP,T2		;Set back to original position
	SFPTR%
	  JRST	MONERR
	JRST	T3RET
SUBTTL	OPNCRF	-- Open CREF temp file for the compiler

OPNCRF:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	MOVE	T1,["CRF"]	;ASCII name right justified
	PUSHJ	PP,OPNTMP	;Get JFN
	HRRZM	T1,CRFJFN	;Store jfn
	SETZM	CRFBH+1		;Force buffer fill on first write
	SETZM	CRFBH+2
	MOVX	T2,OF%WR	;Write 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	JRST	JT2RET
SUBTTL	OPNDMP	-- Open dump file for COBOLK

OPNDMP:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	PUSH	PP,T3
	SETZM	LIBSPC		;In case no name
	SKIPN	T2,SRCJFN##	;Get name of source file
	JRST	OPNDMZ
	HRROI	T1,LIBSPC	;Place to hold name
	MOVX	T3,FLD(.JSAOF,JS%NAM)	;We want name only
	JFNS%			;Get the name
	  ERJMP	MONERR
OPNDMZ:	MOVEI	T1,"CB"
	MOVEI	T2,"L"		;Use <jobnumber>CBL as default name
	DPB	T1,[POINT 14,TMPSPC,34]
	DPB	T2,[POINT 7,TMPSPC+1,6]
	HRROI	T1,TMPSPC
	MOVEM	T1,BINGJB+.GJNAM	;Set default name
	HRROI	T1,[ASCIZ /DMP/]
	MOVEM	T1,BINGJB+.GJEXT	;Change default extension
	MOVEI	T1,BINGJB	;Default dsk:.dmp
	MOVE	T2,[POINT 7,LIBSPC]	;Rest of string
	GTJFN%
	  JRST	[MOVX	T1,GJ%OFG	;Parse only
		IORM	T1,BINGJB	;So we can give error message
		MOVEI	T1,BINGJB	;Point to block
		GTJFN%			;Try again
		  SETZ	T1,		;No JFN on failure
		JRST	GJFERR]		;Give meaningful error message
	HRRZM	T1,DMPJFN	;Store jfn
	SETZM	DMPBH+1		;Force buffer fill on first write
	SETZM	DMPBH+2
	MOVX	T2,FLD(7,OF%BSZ)+OF%WR ;Open file for writing, 7 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	JRST	T3RET

;Write an ASCII character to the dump file

DMPOUT:	SOSG	DMPBH+2
	PUSHJ	PP,DMPO2
	SKIPN	TYPFLG##	;Typeout flag on?
	JRST	DMPO1		;No
	EXCH	T1,CH
	PBOUT%			;Yes, type char too
	EXCH	T1,CH
DMPO1:	IDPB	CH,DMPBH+1
	POPJ	PP,

DMPO2:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,DMPBH+1	;First time its zero
	SKIPLE	T3,DMPBH+2	;Partial buffer to output?
	JUMPN	T1,DMPO4	;Yes, not first time and word count positive
	DMOVE	T2,DMPPTR	;Get byte pointer and size
	DMOVEM	T2,DMPBH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,RITER1	;Just like TOPS-10 dummy output
	MOVE	T1,DMPJFN	;Get JFN
	DMOVE	T2,DMPIOW	;Get byte pointer and size
DMPO3:	SOUT%
	  ERJMP	PUTERR		;Failed
	JRST	T3RET		;OK, restore

DMPO4:	SUBI	T3,1		;Byte count is 1 behind byte pointer
	DMOVE	T1,DMPPTR	;Get byte pointer and size
	DMOVEM	T1,DMPBH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,DMPJFN	;Get JFN
	MOVE	T2,DMPIOW	;Output byte pointer
	ADD	T3,DMPIOW+1	;Output count
	JRST	DMPO3
;Read a word from temp file pointed to by TFIJFN
;Uses same buffers as CRF file

	EXTERN	TFIJFN,TFIBH
	SYN CRFPTR,TFIPTR
	SYN CRFIOW,TFIIOW

	WD==10			;Word from "GETDSK" for COBOLK

SETTFI:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	PUSHJ	PP,CLSTFI	;Close it first
	HRRZ	T1,TFIJFN
	MOVX	T2,OF%RD	;Read 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	TFIBH+1		;Set count zero so we will fill buffer on next read
	SETZM	TFIBH+2
	JRST	JT2RET

GETTFI:	SOSG	TFIBH+2
	PUSHJ	PP,GETTF1
	ILDB	WD,TFIBH+1
	AOS	(PP)		;Skip return
	POPJ	PP,

GETTF1:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,TFIJFN	;Get JFN
	DMOVE	T2,TFIPTR	;Setup TOPS-10 style buffer header
	DMOVEM	T2,TFIBH+1	;So I/O works same way
	DMOVE	T2,TFIIOW	;Get byte pointer and size
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,TFIJFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		ADDB	T3,TFIBH+2	;Adjust count
		JUMPN	T3,T3RET	;OK, got partial buffer
		POP	PP,T3		;EOF, restore accs
		POP	PP,T2
		POP	PP,T1
		POP	PP,(PP)		;Pop off top return
		POPJ	PP,]		;Return to caller's caller
	JRST	T3RET
;WRITE OUTPUT TO SCRATCH FILES

PUTAS1:	SOSG	AS1BH+2		;BUFFER FULL?
	PUSHJ	PP,PUTS1A	;YES--EMPTY IT
	IDPB	CH,AS1BH+1	;PUT WORD INTO BUFFER
	POPJ	PP,

PUTS1A:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,AS1BH+1	;First time its zero
	SKIPLE	T3,AS1BH+2	;Partial buffer to output?
	JUMPN	T1,PUTS1B	;Yes, not first time and word count positive
	DMOVE	T2,AS1PTR	;Get byte pointer and size
	DMOVEM	T2,AS1BH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,RITER1	;Just like TOPS-10 dummy output
	MOVE	T1,AS1JFN	;Get JFN
	DMOVE	T2,AS1IOW	;Get byte pointer and size
PUTS1C:	SOUT%
	  ERJMP	PUTERR		;Failed
	JRST	T3RET		;OK, restore

PUTS1B:	SUBI	T3,1		;Byte count is 1 behind byte pointer
	DMOVE	T1,AS1PTR	;Get byte pointer and size
	DMOVEM	T1,AS1BH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,AS1JFN	;Get JFN
	MOVE	T2,AS1IOW	;Output byte pointer
	ADD	T3,AS1IOW+1	;Output count
	JRST	PUTS1C		;Output it

PUTAS2:	SOSG	AS2BH+2		;BUFFER FULL?
	PUSHJ	PP,PUTS2A	;YES--EMPTY IT
	IDPB	CH,AS2BH+1	;PUT WORD INTO BUFFER
	POPJ	PP,

PUTS2A:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,AS2BH+1	;First time its zero
	SKIPLE	T3,AS2BH+2	;Partial buffer to output?
	JUMPN	T1,PUTS2B	;Yes, not first time and word count positive
	DMOVE	T2,AS2PTR	;Get byte pointer and size
	DMOVEM	T2,AS2BH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,RITER1	;Just like TOPS-10 dummy output
	MOVE	T1,AS2JFN	;Get JFN
	DMOVE	T2,AS2IOW	;Get byte pointer and size
	JRST	PUTS1C

PUTS2B:	SUBI	T3,1		;Byte count is 1 behind byte pointer
	DMOVE	T1,AS2PTR	;Get byte pointer and size
	DMOVEM	T1,AS2BH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,AS2JFN	;Get JFN
	MOVE	T2,AS2IOW	;Output byte pointer
	ADD	T3,AS2IOW+1	;Output count
	JRST	PUTS1C		;Output it

PUTAS3:	SOSG	AS3BH+2		;BUFFER FULL?
	PUSHJ	PP,PUTS3A	;YES--EMPTY IT
	IDPB	CH,AS3BH+1	;PUT WORD INTO BUFFER
	POPJ	PP,

PUTS3A:	SKIPN	AS3JFN		;Is file open?
	PUSHJ	PP,OPNAS3	;Not yet, go do it
	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,AS3BH+1	;First time its zero
	SKIPLE	T3,AS3BH+2	;Partial buffer to output?
	JUMPN	T1,PUTS3B	;Yes, not first time and word count positive
	DMOVE	T2,AS3PTR	;Get byte pointer and size
	DMOVEM	T2,AS3BH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,RITER1	;Just like TOPS-10 dummy output
	MOVE	T1,AS3JFN	;Get JFN
	DMOVE	T2,AS3IOW	;Get byte pointer and size
	JRST	PUTS1C

PUTS3B:	SUBI	T3,1		;Byte count is 1 behind byte pointer
	DMOVE	T1,AS3PTR	;Get byte pointer and size
	DMOVEM	T1,AS3BH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,AS3JFN	;Get JFN
	MOVE	T2,AS3IOW	;Output byte pointer
	ADD	T3,AS3IOW+1	;Output count
	JRST	PUTS1C		;Output it
;Write output (two words) to GENFIL

PUTGEN:	AOS	GENWRD		;BUMP WORD COUNT
	SOSG	GENBH+2		;IS BUFFER FULL?
	PUSHJ	PP,PUTGN1	;YES--GET ANOTHER BUFFER
	IDPB	TA,GENBH+1	;MOVE ONE WORD

	SOSG	GENBH+2		;IS BUFFER FULL NOW?
	PUSHJ	PP,PUTGN1	;YES--GET ANOTHER
	IDPB	TB,GENBH+1	;MOVE SECOND WORD
	POPJ	PP,

PUTGN1:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,GENBH+1	;First time its zero
	SKIPLE	T3,GENBH+2	;Partial buffer to output?
	JUMPN	T1,PUTGN2	;Yes, not first time and word count positive
	DMOVE	T2,GENPTR	;Get byte pointer and size
	DMOVEM	T2,GENBH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,RITER1	;Just like TOPS-10 dummy output
	MOVE	T1,GENJFN	;Get JFN
	DMOVE	T2,GENIOW	;Get byte pointer and size
PUTGN3:	SOUT%
	  ERJMP	PUTERR		;Failed
	JRST	T3RET		;OK, restore

PUTGN2:	SUBI	T3,1		;Byte count is 1 behind byte pointer
	DMOVE	T1,GENPTR	;Get byte pointer and size
	DMOVEM	T1,GENBH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,GENJFN	;Get JFN
	MOVE	T2,GENIOW	;Output byte pointer
	ADD	T3,GENIOW+1	;Output count
	JRST	PUTGN3		;Output it
;PUT A CHARACTER OUT ONTO LSTFIL

PUTLST:	TSWF	FNOLST		;ANY LISTING FILE?
	POPJ	PP,		;NO--RETURN

	SOSG	LSTBH+2
	PUSHJ	PP,PUTLS1
	IDPB	CH,LSTBH+1
	POPJ	PP,

;BUFFER IS FULL - WRITE IT OUT

PUTLS1:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,LSTBH+1	;First time its zero
	SKIPLE	T3,LSTBH+2	;Partial buffer to output?
	JUMPN	T1,PUTLS2	;Yes, not first time and word count positive
	DMOVE	T2,LSTPTR	;Get byte pointer and size
	DMOVEM	T2,LSTBH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,RITER1	;Just like TOPS-10 dummy output
	MOVE	T1,LSTJFN	;Get JFN
	DMOVE	T2,LSTIOW	;Get byte pointer and size
PUTLS3:	SOUT%
	  ERJMP	PUTERR		;Failed
	JRST	T3RET		;OK, restore

PUTLS2:	SUBI	T3,1		;Byte count is 1 behind byte pointer
	DMOVE	T1,LSTPTR	;Get byte pointer and size
	DMOVEM	T1,LSTBH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,LSTJFN	;Get JFN
	MOVE	T2,LSTIOW	;Output byte pointer
	ADD	T3,LSTIOW+1	;Output count
	JRST	PUTLS3		;Output it
;Write out word to binary file

PUTBIN:	SKIPN	BINJFN		;Are we writing a binary file?
	POPJ	PP,		;No, forget it

	SOSG	BINBH+2		;Yes, is the buffer full?
	PUSHJ	PP,PUTBN1	;Yes, empty it
	IDPB	CH,BINBH+1	;No, put word in buffer
	POPJ	PP,

PUTBN1:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,BINBH+1	;First time its zero
	SKIPLE	T3,BINBH+2	;Partial buffer to output?
	JUMPN	T1,PUTBN2	;Yes, not first time and word count positive
	DMOVE	T2,BINPTR	;Get byte pointer and size
	DMOVEM	T2,BINBH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,RITER1	;Just like TOPS-10 dummy output
	MOVE	T1,BINJFN	;Get JFN
	DMOVE	T2,BINIOW	;Get byte pointer and size
PUTBN3:	SOUT%
	  ERJMP	PUTERR		;Failed
	JRST	T3RET		;OK, restore

;Note, because of the way that the SOSG loop is done the count is off by one
;and we cannot tell an unused buffer from one with 1 word used by the count.
;We must look at the byte pointer to be sure. Otherwise an extra word will be written.

PUTBN2:	SUBI	T3,1		;Byte count is 1 behind byte pointer
	DMOVE	T1,BINPTR	;Get byte pointer and size
	CAMN	T1,BINBH+1	;Is the buffer really empty?
	JRST	T3RET		;Yes, see note above.
	DMOVEM	T1,BINBH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,BINJFN	;Get JFN
	MOVE	T2,BINIOW	;Output byte pointer
	ADD	T3,BINIOW+1	;Output count
	JRST	PUTBN3		;Output it
;Write out last partial files

RITASY:	PUSHJ	PP,PUTS1A	;Write out last partial buffer
	PUSHJ	PP,PUTS2A	;Write out last partial buffer
	SKIPLE	AS3JFN		;If AS3 file open
	PUSHJ	PP,PUTS3A	;Write out last partial buffer
	POPJ	PP,

;Write out NAMTAB to NAMFIL

RITNAM:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,NAMJFN	;Get JFN
	DMOVE	T2,NAMIOL##	;Byte ptr and count
	SOUT%
	  ERJMP	[HRROI	T1,[ASCIZ "%Couldn't write NAMTAB, compilation continuing without maps or object listing
"]
		PSOUT%
		SWOFF	FMAP!FOBJEC
		JRST	.+1]
	HRRZ	T1,NAMJFN
	TXO	T1,CO%NRJ	;Keep JFN
	CLOSF%
	  ERJMP	.+1
	JRST	T3RET		;OK, restore

;Read back NAMTAB

SETNAM:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	HRRZ	T1,NAMJFN	;Get JFN
	MOVX	T2,OF%RD	;Read 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	POP	PP,T1		;Clear stack
	MOVE	T1,NAMJFN	;Get JFN
	DMOVE	T2,NAMIOL##	;Byte ptr and count
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,NAMJFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		SUB	T3,NAMIOL+1	;See if we read them all
		JUMPN	T3,GETERR	;No, something wrong
		JRST	.+1]
	JRST	T3SRET		;OK skip return
;Write out a diagnostic to ERAFIL

RITERA:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,ERABH+1	;First time its zero
	SKIPLE	T3,ERABH+2	;Partial buffer to output?
	JUMPN	T1,RITERB	;Yes, not first time and word count positive
	DMOVE	T2,ERAPTR	;Get byte pointer and size
	DMOVEM	T2,ERABH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,RITER1	;Just like TOPS-10 dummy output
	MOVE	T1,ERAJFN	;Get JFN
	DMOVE	T2,ERAIOW	;Get byte pointer and size
RITERC:	SOUT%
	  ERJMP	PUTERR		;Failed
RITER1:	JRST	T3RET		;OK, restore

RITERB:	SUBI	T3,1		;Byte count is 1 behind byte pointer
	DMOVE	T1,ERAPTR	;Get byte pointer and size
	DMOVEM	T1,ERABH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,ERAJFN	;Get JFN
	MOVE	T2,ERAIOW	;Output byte pointer
	ADD	T3,ERAIOW+1	;Output count
	JRST	RITERC		;Output it
;Write out source to CPYFIL

RITCPY:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,CPYBH+1	;First time its zero
	SKIPLE	T3,CPYBH+2	;Partial buffer to output?
	JUMPN	T1,RITCP1	;Yes, not first time and word count positive
	DMOVE	T2,CPYPTR	;Get byte pointer and size
	DMOVEM	T2,CPYBH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,RITCP3	;Just like TOPS-10 dummy output
	MOVE	T1,CPYJFN	;Get JFN
	DMOVE	T2,CPYIOW	;Get byte pointer and size
RITCP2:	SOUT%
	  ERJMP	PUTERR		;Failed
RITCP3:	SETZM	CPYBFR		;Zero first word
	MOVE	T1,[CPYBFR,,CPYBFR+1]
	BLT	T1,CPYBFR+CPYBLN-1	;Zero all buffer
	JRST	T3RET		;OK, restore

RITCP1:	SOS	T2,T3		;Byte count is 1 behind byte pointer
	IDIVI	T2,5		;Get size in words
	MOVE	T3,T2		; into T3
	DMOVE	T1,CPYPTR	;Get byte pointer and size
	DMOVEM	T1,CPYBH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,CPYJFN	;Get JFN
	MOVE	T2,CPYIOW	;Output byte pointer
	ADD	T3,CPYIOW+1	;Output count
	JRST	RITCP2		;Output it
;Write out source to CRFFIL

RITCRF:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,CRFBH+1	;First time its zero
	SKIPLE	T3,CRFBH+2	;Partial buffer to output?
	JUMPN	T1,RITCR2	;Yes, not first time and word count positive
	DMOVE	T2,CRFPTR	;Get byte pointer and size
	DMOVEM	T2,CRFBH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,RITER1	;Just like TOPS-10 dummy output
	MOVE	T1,CRFJFN	;Get JFN
	DMOVE	T2,CRFIOW	;Get byte pointer and size
RITCR3:	SOUT%
	  ERJMP	PUTERR		;Failed
	JRST	T3RET		;OK, restore

RITCR2:	SUBI	T3,1		;Byte count is 1 behind byte pointer
	DMOVE	T1,CRFPTR	;Get byte pointer and size
	DMOVEM	T1,CRFBH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,CRFJFN	;Get JFN
	MOVE	T2,CRFIOW	;Output byte pointer
	ADD	T3,CRFIOW+1	;Output count
	JRST	RITCR3		;Output it
;Write out lieral table to LITFIL
;NOTE, this is different from other cases.
;Write is done in dump mode.

RITLIT:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	MOVE	T1,LITJFN	;Get JFN
	MOVEI	T2,IOWLIT	;Get IOWD
	DUMPO%
	  JRST	PUTERR		;Failed
	JRST	T2RET		;OK, restore
;Get another buffer from source file
;Gives skip return if more data in new buffer.

GETSRB:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	DMOVE	T2,SRCPTR	;Get byte pointer and size
	DMOVEM	T2,SRCBH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,SRCJFN	;Get JFN
	DMOVE	T2,SRCIOW	;Get byte pointer and size
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,SRCJFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		IMULI	T3,5		;Convert to bytes
		ADDB	T3,SRCBH+2	;Adjust count
		JUMPE	T3,EOFRET	;Return EOF as buffer is empty
		JRST	T3SRET]
T3SRET:	POP	PP,T3		;OK, restore
	POP	PP,T2
	POP	PP,T1
	AOS	(PP)
	POPJ	PP,

EOFRET:	POP	PP,T3		;Restore
	POP	PP,T2
	POP	PP,T1
	POPJ	PP,		;EOF return
GETASY:	SOSG	AS1BH+2
	PUSHJ	PP,GETASA
	ILDB	CH,AS1BH+1
	POPJ	PP,

GETASA:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,AS1JFN	;Get JFN
	DMOVE	T2,AS1PTR	;Setup TOPS-10 style buffer header
	DMOVEM	T2,AS1BH+1	;So I/O works same way
	DMOVE	T2,AS1IOW	;Get byte pointer and size
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,AS1JFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		ADDB	T3,AS1BH+2	;Adjust count
		JRST	.+1]
	JRST	T3RET		;OK, restore

;All three ASY files are read back using the same buffer area
;Not at the same time of course.

SETASY:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	HRRZ	T1,AS1JFN	;Get jfn
	MOVX	T2,OF%RD	;Read 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	AS1BH+1		;Force buffer fill on first read
	SETZM	AS1BH+2
	JRST	JT2RET

;Set up AS2 file for optimizer.
;Use name AS4 for now and later raname it back it AS2.

SETAS2:	PUSH	PP,T1
	PUSH	PP,T2
	MOVE	T1,["AS4"]	;Temp name
	PUSHJ	PP,OPNTMP
	HRRZM	T1,AS2JFN	;SAVE JFN
	SETZM	AS2BH+1		;Force buffer fill on first write
	SETZM	AS2BH+2
	MOVX	T2,OF%WR	;Write 36 bit bytes
	OPENF%
	  JRST	MONERR		;Problems
	JRST	T2RET

RENAS2:	PUSH	PP,T1
	PUSH	PP,T2
	PUSHJ	PP,CLSAS1
	PUSHJ	PP,PUTS2A	;WRITE OUT THE PARTIAL BUFFER
	PUSHJ	PP,CLSAS2
	MOVE	T1,AS2JFN	;File we want
	MOVE	T2,AS1JFN	;File spec we want
	RNAMF%
	  JRST	MONERR
	MOVEM	T2,AS2JFN	;Store new JFN
	SETZM	AS1JFN		;Clear old JFN
	JRST	T2RET
;Read a word from CPYFIL

GETCPY:	SOSG	CPYBH+2
	PUSHJ	PP,GETCPA
	ILDB	CH,CPYBH+1
	POPJ	PP,

SETCPY:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	HRRZ	T1,CPYJFN	;Get jfn
	MOVX	T2,OF%RD	;Read 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	CPYBH+1		;Force buffer fill on first read
	SETZM	CPYBH+2
	JRST	JT2RET

GETCPA:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,CPYJFN	;Get JFN
	DMOVE	T2,CPYPTR	;Setup TOPS-10 style buffer header
	DMOVEM	T2,CPYBH+1	;So I/O works same way
	DMOVE	T2,CPYIOW	;Get byte pointer and size
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,CPYJFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		IMULI	T3,5		;Convert to bytes
		ADDB	T3,CPYBH+2	;Adjust count
		JRST	.+1]
	JRST	T3RET		;OK, restore
;Open the CRF file

SETCRF:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	HRRZ	T1,CRFJFN	;Get JFN
	MOVX	T2,OF%RD	;Read 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	CRFBH+1		;Set count zero so we will fill buffer on next read
	SETZM	CRFBH+2
	JRST	JT2RET


;Read a word from CRFFIL
;Returns:
;	+1	if EOF
;	+2	if not

GETCRF:	SOSG	CRFBH+2
	PUSHJ	PP,GETCRA
	ILDB	CH,CRFBH+1
	AOS	(PP)		;Skip return if not eof
	POPJ	PP,

GETCRA:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,CRFJFN	;Get JFN
	DMOVE	T2,CRFPTR	;Setup TOPS-10 style buffer header
	DMOVEM	T2,CRFBH+1	;So I/O works same way
	DMOVE	T2,CRFIOW	;Get byte pointer and size
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,CRFJFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		ADDB	T3,CRFBH+2	;Adjust count
		SKIPN	T3		;OK
		SOS	-4(PP)		;EOF, give non-skip return
		JRST	.+1]
	JRST	T3RET		;OK, restore
;Read a word from ERAFIL

SETERA:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	HRRZ	T1,ERAJFN	;Get jfn
	MOVX	T2,OF%RD	;Read 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	ERABH+1		;Set count zero so we will fill buffer on next read
	SETZM	ERABH+2
	JRST	JT2RET

GETERA:	SOSG	ERABH+2
	PUSHJ	PP,GETER1
	ILDB	DW,ERABH+1
	POPJ	PP,

GETER1:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
GETER2:	MOVE	T1,ERAJFN	;Get JFN
	DMOVE	T2,ERAPTR	;Setup TOPS-10 style buffer header
	DMOVEM	T2,ERABH+1	;So I/O works same way
	DMOVE	T2,ERAIOW	;Get byte pointer and size
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,ERAJFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		ADDB	T3,ERABH+2	;Adjust count
		JRST	.+1]
T3RET:	POP	PP,T3		;OK, restore
T2RET:	POP	PP,T2
T1RET:	POP	PP,T1
	POPJ	PP,
;Read a word from LITFIL
;NOTE, I/O is done in DUMP mode

SETLIT:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	PUSH	PP,T3
	HRRZ	T1,LITJFN	;Get jfn
	MOVE	T2,[FLD(.GSDMP,OF%MOD)+OF%RD]	;Read 36 bit bytes in dump mode
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	LITBH+1		;Set count zero so we will fill buffer on next read
	SETZM	LITBH+2
	POP	PP,T1		;Clear stack
	JRST	T3RET		;Return

GETLIT:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	MOVE	T1,LITJFN	;Get JFN
	MOVEI	T2,IOWLIT	;Get IOWD
	DUMPI%
	  JRST	GETLT1		;Failed
	JRST	T2RET		;OK, restore

GETLT1:	PUSH	PP,T3		;Save extra acc
	MOVEI	T1,.FHSLF
	GETER%
	  NOOP
	HRRZ	T2,T2		;Error only
	MOVE	T1,LITJFN
	CAIE	T2,IOX4		;End of File?
	JRST	GETERR		;No
	JRST	T3RET		;OK?
OPNSF1:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	HRRZ	T1,SF1JFN	;Get jfn
	MOVX	T2,OF%WR	;Write 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	SF1BH+1		;Set count zero so we will fill buffer on next write
	SETZM	SF1BH+2
	JRST	JT2RET

OPNSF2:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	HRRZ	T1,SF2JFN	;Get jfn
	MOVX	T2,OF%WR	;Write 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	SF2BH+1		;Set count zero so we will fill buffer on next write
	SETZM	SF2BH+2
	JRST	JT2RET

OPNSF3:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	HRRZ	T1,SF3JFN	;Get jfn
	MOVX	T2,OF%WR	;Write 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	SF3BH+1		;Set count zero so we will fill buffer on next write
	SETZM	SF3BH+2
	JRST	JT2RET


SETSF1:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	HRRZ	T1,SF1JFN	;Get jfn
	MOVX	T2,OF%RD	;Read 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	SF1BH+1		;Set count zero so we will fill buffer on next read
	SETZM	SF1BH+2
	JRST	JT2RET


SETSF2:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	HRRZ	T1,SF2JFN	;Get jfn
	MOVX	T2,OF%RD	;Read 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	SF2BH+1		;Set count zero so we will fill buffer on next read
	SETZM	SF2BH+2
	JRST	JT2RET


SETSF3:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	HRRZ	T1,SF3JFN	;Get jfn
	MOVX	T2,OF%RD	;Read 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	SF3BH+1		;Set count zero so we will fill buffer on next read
	SETZM	SF3BH+2
	JRST	JT2RET

GETSF1:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	DMOVE	T2,SF1PTR	;Get byte pointer and size
	DMOVEM	T2,SF1BH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,SF1JFN	;Get JFN
	DMOVE	T2,SF1IOW	;Get byte pointer and size
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,SF1JFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		ADDB	T3,SF1BH+2	;Adjust count
		JRST	.+1]
	JRST	T3RET		;OK, restore

GETSF2:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	DMOVE	T2,SF2PTR	;Get byte pointer and size
	DMOVEM	T2,SF2BH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,SF2JFN	;Get JFN
	DMOVE	T2,SF2IOW	;Get byte pointer and size
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,SF2JFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		ADDB	T3,SF2BH+2	;Adjust count
		JRST	.+1]
	JRST	T3RET		;OK, restore

GETSF3:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	DMOVE	T2,SF3PTR	;Get byte pointer and size
	DMOVEM	T2,SF3BH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,SF3JFN	;Get JFN
	DMOVE	T2,SF3IOW	;Get byte pointer and size
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,SF3JFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		ADDB	T3,SF3BH+2	;Adjust count
		JRST	.+1]
	JRST	T3RET		;OK, restore
;Write out buffer to CREF file

RITSF1:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,SF1BH+1	;First time its zero
	SKIPLE	T3,SF1BH+2	;Partial buffer to output?
	JUMPN	T1,RITSFB	;Yes, not first time and word count positive
	DMOVE	T2,SF1PTR	;Get byte pointer and size
	DMOVEM	T2,SF1BH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,T3RET	;Just like TOPS-10 dummy output
	MOVE	T1,SF1JFN	;Get JFN
	DMOVE	T2,SF1IOW	;Get byte pointer and size
RITSFA:	SOUT%
	  ERJMP	PUTERR		;Failed
	JRST	T3RET		;OK, restore

RITSFB:	SUBI	T3,1		;Byte count is 1 behind byte pointer
	DMOVE	T1,SF1PTR	;Get byte pointer and size
	DMOVEM	T1,SF1BH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,SF1JFN	;Get JFN
	MOVE	T2,SF1IOW	;Output byte pointer
	ADD	T3,SF1IOW+1	;Output count
	JRST	RITSFA		;Output it

RITSF2:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,SF2BH+1	;First time its zero
	SKIPLE	T3,SF2BH+2	;Partial buffer to output?
	JUMPN	T1,RITSFC	;Yes, not first time and word count positive
	DMOVE	T2,SF2PTR	;Get byte pointer and size
	DMOVEM	T2,SF2BH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,T3RET	;Just like TOPS-10 dummy output
	MOVE	T1,SF2JFN	;Get JFN
	DMOVE	T2,SF2IOW	;Get byte pointer and size
	JRST	RITSFA		;Common output

RITSFC:	SUBI	T3,1		;Byte count is 1 behind byte pointer
	DMOVE	T1,SF2PTR	;Get byte pointer and size
	DMOVEM	T1,SF2BH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,SF2JFN	;Get JFN
	MOVE	T2,SF2IOW	;Output byte pointer
	ADD	T3,SF2IOW+1	;Output count
	JRST	RITSFA		;Output it

RITSF3:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,SF3BH+1	;First time its zero
	SKIPLE	T3,SF3BH+2	;Partial buffer to output?
	JUMPN	T1,RITSFD	;Yes, not first time and word count positive
	DMOVE	T2,SF3PTR	;Get byte pointer and size
	DMOVEM	T2,SF3BH+1	;Reset TOPS-10 style buffer header
	JUMPE	T1,T3RET	;Just like TOPS-10 dummy output
	MOVE	T1,SF3JFN	;Get JFN
	DMOVE	T2,SF3IOW	;Get byte pointer and size
	JRST	RITSFA		;Common output

RITSFD:	SUBI	T3,1		;Byte count is 1 behind byte pointer
	DMOVE	T1,SF3PTR	;Get byte pointer and size
	DMOVEM	T1,SF3BH+1	;Reset TOPS-10 style buffer header
	MOVE	T1,SF3JFN	;Get JFN
	MOVE	T2,SF3IOW	;Output byte pointer
	ADD	T3,SF3IOW+1	;Output count
	JRST	RITSFA		;Output it
GETGEN:	AOS	GENWRD		;BUMP WORD COUNTER
	SOSG	GENBH+2
	PUSHJ	PP,GETGN2
	ILDB	W1,GENBH+1
	SOSG	GENBH+2
	PUSHJ	PP,GETGN2
	ILDB	W2,GENBH+1
	POPJ	PP,

GETGN2:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,GENJFN	;Get JFN
	DMOVE	T2,GENPTR	;Setup TOPS-10 style buffer header
	DMOVEM	T2,GENBH+1	;So I/O works same way
	DMOVE	T2,GENIOW	;Get byte pointer and size
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,GENJFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		ADDB	T3,GENBH+2	;Adjust count
		JRST	.+1]
	JRST	T3RET		;OK, restore


;SET UP GENFIL FOR INPUT

SETGEN:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	PUSH	PP,T3
	HRRZ	T1,GENJFN	;Get JFN
	MOVX	T2,OF%RD	;Read 36 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	GENBH+1		;Force first read
	SETZM	GENBH+2
	POP	PP,T1		;Clear stack
	POP	PP,T3
	POP	PP,T2
	POP	PP,T1

	HLRZ	TA,PROGST
	MOVEM	TA,GENWRD
	CAIN	TA,100
	POPJ	PP,
	JRST	SETSG1
;SET UP GENFIL TO READ NEXT SECTION.
;ENTER WITH RH OF TA POINTING TO A PROTAB ENTRY

SETSEG:	ANDI	TA,77777
	ADD	TA,PROLOC
	HLRZ	TA,1(TA)
	CAMN	TA,GENWRD
	POPJ	PP,

	MOVEM	TA,GENWRD

SETSG1:	PUSH	PP,T1
	PUSH	PP,T2
	LSH	TA,1		;Convert to words
	MOVE	T1,GENJFN
	MOVE	T2,TA		;Get byte number
	TRZ	T2,177		;Set on buffer boundary
	SUBI	T2,200
	SFPTR%			;Set on buffer we want
	  JRST	MONERR
	PUSHJ	PP,GETGN2	;Read in the buffer
	ANDI	TA,177		;Get word count into buffer
	ADDM	TA,GENBH+1
	SUBI	TA,1
	MOVNS	TA
	ADDM	TA,GENBH+2
	JRST	T2RET
;CLOSE TEMP FILES BUT KEEP JFN OPEN

CLSAS1:	PUSH	PP,T1
	HRRZ	T1,AS1JFN
CLSTMP:	JUMPE	T1,CLSRET	;Not open
	TXO	T1,CO%NRJ	;Don't release JFN
	CLOSF%
	  ERJMP	.+1
CLSRET:	POP	PP,T1
	POPJ	PP,

CLSAS2:	PUSH	PP,T1
	HRRZ	T1,AS2JFN
	JRST	CLSTMP

CLSAS3:	PUSH	PP,T1
	HRRZ	T1,AS3JFN
	JRST	CLSTMP

CLSCPY:	PUSH	PP,T1
	HRRZ	T1,CPYJFN
	JRST	CLSTMP

CLSERA:	PUSH	PP,T1
	HRRZ	T1,ERAJFN
	JRST	CLSTMP

CLSCRF:	PUSH	PP,T1
	HRRZ	T1,CRFJFN
	JRST	CLSTMP

CLSGEN:	PUSH	PP,T1
	HRRZ	T1,GENJFN
	JRST	CLSTMP

CLSLIB:	PUSH	PP,T1
	HRRZ	T1,LIBJFN
	JRST	CLSTMP

CLSLIT:	PUSH	PP,T1
	HRRZ	T1,LITJFN
	JRST	CLSTMP

CLSSF1:	PUSH	PP,T1
	HRRZ	T1,SF1JFN
	JRST	CLSTMP

CLSSF2:	PUSH	PP,T1
	HRRZ	T1,SF2JFN
	JRST	CLSTMP

CLSSF3:	PUSH	PP,T1
	HRRZ	T1,SF3JFN
	JRST	CLSTMP

CLSTFI:	PUSH	PP,T1
	HRRZ	T1,TFIJFN
	JRST	CLSTMP

;CLOSE FILE AND RELEASE JFN

;Close all files in case we missed some

CLZALL:	PUSHJ	PP,CLZSRC	;Close source
	PUSHJ	PP,CLZBIN	;Rel file
	PUSHJ	PP,CLZLST	;List file
	PUSHJ	PP,CLZDMP	;Dump file
	POPJ	PP,

CLZBIN:	SKIPLE	BINJFN		;If bin file open
	PUSHJ	PP,PUTBN1	;Write out last partial buffer
	PUSH	PP,T1
	HRRZ	T1,BINJFN
IFE DEBUG,<
	TSWF	FFATAL		;If any fatal errors, don't create
	TXO	T1,CZ%ABT	; a new .REL, leave any old one
>; END DEBUG
	SETZM	BINJFN
CLZFIL:	JUMPE	T1,CLSRET	;Not open
	CLOSF%
	  ERJMP	.+1
	POP	PP,T1
	POPJ	PP,

CLZSRC:	PUSH	PP,T1
	HRRZ	T1,SRCJFN
	SETZM	SRCJFN
	JRST	CLZFIL

CLZLST:	SKIPLE	LSTJFN		;If list file open
	PUSHJ	PP,PUTLS1	;Write out last partial buffer
	PUSH	PP,T1
	HRRZ	T1,LSTJFN
	SETZM	LSTJFN
	JRST	CLZFIL

CLZDMP:	SKIPLE	DMPJFN		;If dump file open
	PUSHJ	PP,DMPO2	;Write out last partial buffer
	PUSH	PP,T1
	HRRZ	T1,DMPJFN
	SETZM	DMPJFN
	JRST	CLZFIL

CLZLIB:	PUSH	PP,T1
	HRRZ	T1,LIBJFN
	SETZM	LIBJFN
	JRST	CLZFIL

;DELETE ALL TEMP FILES AT END OF COMPILATION

DELALL:	PUSH	PP,T1
	PUSH	PP,T2
	MOVSI	T2,-LENJFN	;NO. OF JFN'S TO RELEASE
DELAL1:	SKIPN	T1,@XXXJFN(T2)
	JRST	DELAL2
	TXO	T1,CO%NRJ	;Keep JFN
	CLOSF%
	  NOOP			;Probably already closed
	HRRZ	T1,@XXXJFN(T2)
	DELF%
	  NOOP
DELAL2:	AOBJN	T2,DELAL1
	JRST	T2RET
;DELETE CREF TEMP FILES

DELSF:	PUSH	PP,T1
	PUSH	PP,T2
	MOVSI	T2,-3		;NO. OF JFN'S TO RELEASE
DELSF1:	SKIPN	T1,SFJFN##(T2)
	JRST	DELSF2
	TXO	T1,CO%NRJ	;Keep JFN
	CLOSF%
	  NOOP			;Probably already closed
	HRRZ	T1,SFJFN(T2)
	DELF%
	  NOOP
DELSF2:	AOBJN	T2,DELSF1
	JRST	T2RET
;SUBTTL	DBMS routines

IFN DBMS,<

;Used by Phase C

OPNDBC:	PUSH	PP,T1
	PUSH	PP,T2
	MOVE	T1,["DBC"]
	PUSHJ	PP,OPNTMP	;Get JFN for invoke file
	HRRZM	T1,DBCJFN	;Save it
	MOVX	T2,FLD(7,OF%BSZ)+OF%WR	;Write 7 bits
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	DBCBH+1		;Force buffer fill on first read
	SETZM	DBCBH+2
	JRST	JT2RET

;Used by Phase D

OPNDBD:	PUSH	PP,T1
	PUSH	PP,T2
	MOVE	T1,["DB1"]
	PUSHJ	PP,OPNTMP	;Get JFN for invoke file
	HRRZM	T1,DBDJFN	;Save it
	MOVX	T2,FLD(7,OF%BSZ)+OF%WR	;Write 7 bits
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	DBDBH+1		;Force buffer fill on first read
	SETZM	DBDBH+2
	JRST	JT2RET
;Routines to write the INVOKE files
;Note, that these routines are called with the count of characters written R0.
;The buffer headers are not kept current.

PUTDBC:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVN	T3,R0		;Get actual count of characters to output
	DMOVE	T1,DBCPTR	;Get byte pointer and size
	DMOVEM	T1,DBCBH+1	;Reset TOPS-10 style buffer header
	JUMPE	T3,RITER1	;Just like TOPS-10 dummy output
	MOVE	T1,DBCJFN	;Get JFN
	MOVE	T2,DBCIOW	;Output byte pointer
	SOUT%
	  ERJMP	PUTERR		;Failed
	JRST	T3RET		;OK, restore

PUTDBD:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVN	T3,R0		;Get actual count of characters to output
	DMOVE	T1,DBDPTR	;Get byte pointer and size
	DMOVEM	T1,DBDBH+1	;Reset TOPS-10 style buffer header
	JUMPE	T3,RITER1	;Just like TOPS-10 dummy output
	MOVE	T1,DBDJFN	;Get JFN
	MOVE	T2,DBDIOW	;Output byte pointer
	SOUT%
	  ERJMP	PUTERR		;Failed
	JRST	T3RET		;OK, restore
;Used by both Phase C and D to read the INVOKE files

;Both DBC and DB1 files are read back using the same buffer area
;DBC is read back during phase C and DB1 during phase D.

DBGTF.:	PUSH	PP,T1
	MOVE	T1,DBDJFN	;Get phase D file
	EXCH	T1,DBSJFN	;Put in common place
	EXCH	T1,DBDJFN	;Save DBC's JFN for delete
	TRNA

SETDBS:	PUSH	PP,T1		;Save some accs
	PUSH	PP,T2
	HRRZ	T1,DBSJFN	;Get jfn
	MOVX	T2,FLD(7,OF%BSZ)+OF%RD	;Read 7 bit bytes
	PUSH	PP,T1		;Incase of error
	OPENF%
	  JRST	OPNERR
	SETZM	DBSBH+1		;Force buffer fill on first read
	SETZM	DBSBH+2
	JRST	JT2RET

GETDBS:	PUSH	PP,T1		;Save accs
	PUSH	PP,T2
	PUSH	PP,T3
	MOVE	T1,DBSJFN	;Get JFN
	DMOVE	T2,DBSPTR	;Setup TOPS-10 style buffer header
	DMOVEM	T2,DBSBH+1	;So I/O works same way
	DMOVE	T2,DBSIOW	;Get byte pointer and size
	SIN%
	  ERJMP	[MOVEI	T1,.FHSLF
		GETER%
		  NOOP
		HRRZ	T2,T2		;Error only
		MOVE	T1,DBCJFN
		CAIE	T2,IOX4		;End of File?
		JRST	GETERR		;No
		ADDB	T3,DBCBH+2	;Adjust count
		JUMPE	T3,EOFRET	;Buffer is empty now
		JRST	T3SRET]
	JRST	T3SRET		;OK, restore

CLSDBC:	PUSH	PP,T1
	HRRZ	T1,DBCJFN
	JRST	CLSTMP

CLSDBD:	PUSH	PP,T1
	HRRZ	T1,DBDJFN
	JRST	CLSTMP

CLZDBS:	PUSH	PP,T1
	HRRZ	T1,DBSJFN
	JRST	CLSTMP		;Keep JFN so can delete tmp at end

>
SUBTTL	I/O errors

;Error from SOUT%

PUTERR:

;Error from SIN%

GETERR:

;Error from GTJFN%

GJFERR:	PUSH	PP,T1

;Error from OPENF%
;When called, the JFN has been pushed on the stack.

OPNERR:	HRROI	T1,[ASCIZ /
?/]
	PSOUT%
	MOVEI	T1,.PRIOU
	HRLOI	T2,.FHSLF
	SETZ	T3,
	ERSTR%
	  NOOP
	  NOOP
	HRROI	T1,[ASCIZ / - /]
	PSOUT%
	MOVEI	T1,.PRIOU
	POP	PP,T2
	SETZB	T3,T4
	SKIPE	T2	;Not if zero
	JFNS%
	  ERJMP	.+1
	HALTF%		;Just give up
SUBTTL	TABLE OF BUFFER POINTER AND BUFFER SIZES FOR SIN%/SOUT%

DEFINE IOLIST (A,B,C,D,E)<
A'IOW:	POINT	C,A'BFR
 IFE C-7,<	EXP	-5*B>
 IFE C-^D36,<	EXP	-B>
>

IOWPTR:!	IOFILE


;TABLE OF BUFFER POINTER AND BUFFER SIZES FOR LDB/DPB

DEFINE IOLIST (A,B,C,D,E)<
A'PTR:	POINT	D,A'BFR
 IFE D-7,<A'SIZ:	EXP	5*B>
 IFE D-^D36,<A'SIZ:	EXP	B>
>

IOPTR:!	IOFILE


;TABLE OF JFN'S

DEFINE IOLIST(A,B,C,D,E)<
 IFN E,<	EXP	A'JFN>>

XXXJFN:	IOFILE
	LENJFN==.-XXXJFN

IFN DBMS,<
SYN	DBCJFN,DBSJFN
SYN	DBCBH,DBSBH
SYN	DBCPTR,DBSPTR
SYN	DBCIOW,DBSIOW
>

	END	COBOL