.SBTTL	IDENTIFICATION
;	A-B P/N: 724470-01
;	MOD IDT: SCAN01
;	REV:	 B
;
.ENABL	LC
.REM %
	This is the body of the command line scan routine.
	In order to use it properly, it must be assembled
	with two prefix files- LB0:[11,40]F4P.MAC, and a
	file unique to the cross support product being 
	invoked.  The following equates must be given:
	  Default masks-
		OBJMKD	Object switches
		LSTMKD	Listing switches
		ERRMKD	Error list switches
		INPMKD	Input switches
	  LUN assignments-
		LUNOBJ	Object LUN
		LUNLST	List LUN
		LUNERR	Error list LUN
		LUNINP	Input LUN
		LUNTT	Command error list LUN
		LUNGCL	Command file input LUN
	  Event flag-
		EVNTFL	Common event flag for all QIO's
	  Fortran FDB characteristics-
		OBJSTA	Object file status word 1
		OBJST2			   word 2
		LSTSTA	List file status word 1
		LSTST2			 word 2
		ERRSTA	Error list file status word 1
		ERRST2			       word 2

	The following words must also be reserved:
	  Default file specification blocks-
		OBJDEF	Object file
		LSTDEF	List file
		ERRDEF	Error list file
		INPDEF	Input file

	In the command file for the task builder, the LUN's
	for the units must be assigned to devices.  Usually
	the OBJ, LST, and INP files are SY0:, and the ERR,
	TT, and GCL LUN's are TI:.


%

	.SBTTL	CREDITS
;
;	Original Author-
;
;		Greg Merrell
;		Allen-Bradley Company
;		747 Alpha Drive
;		Cleveland, Ohio 44143
;		216-449-6700
;
;
;	MODIFICATIONS-
;
;	EDIT	REV	   DATE		PROGRAMMER	REASON
;	----	---	   ----		----------	------
;		 A	04-OCT-79	G. MERRELL	AUTHOR
;	001	 B	10-OCT-79	J. HAYES	MAKE OUTPUT DIRECTORY
;							SPEC NON-STICKY.


	.SBTTL	MACRO CALL DEFINITIONS
;
	.MCALL	GCMLB$,GCML$		;Get command line
	.MCALL	CSI$,CSI$1,CSI$2	;Parse command line
	.MCALL	QIOW$,QIOW$S,DIR$	;Queue I/O
	.MCALL	MOUT$S,EXST$S		;Message and exit
	.MCALL	FDBDF$			;File definition
	.MCALL	FDAT$R,FDRC$R		;Attribute and record
	.MCALL	FDOP$R,FDBF$R		;Open and buffer
	.MCALL	OPEN$R,OPEN$W,CLOSE$	;File open/close
;
	OTSWA			;Fortran IV+ work area definitions


	.SBTTL	LOCAL MACRO DEFINITIONS
;
	.MACRO	MSG	NAM,STRING
	.ENABL	LSB
	.NCHR	$CHR,<STRING>
10$:	.ASCII	\STRING\
	.EVEN
NAM:	QIOW$	IO.WVB,LUNTT,EVNTFL,,IOSB,,<10$,$CHR,40>
	.DSABL	LSB
	.ENDM	MSG
;
	.MACRO	JCS	ARG
	BCC	.+6
	JMP	ARG
	.ENDM	JCS
;
	.MACRO	JNE	ARG
	BEQ	.+6
	JMP	ARG
	.ENDM	JNE
;
	.MACRO	JEQ	ARG
	BNE	.+6
	JMP	ARG
	.ENDM	JEQ
;
	.MACRO	CALL	ARG
	JSR	PC,ARG
	.ENDM	CALL
;
	.MACRO	RTN
	RTS	PC
	.ENDM	RTN
;
	.MACRO	PUSH	ARGS
	.IRP	$$$$,<ARGS>
	MOV	$$$$,-(SP)
	.ENDM
	.ENDM	PUSH
;
	.MACRO	POP	ARGS
	.IRP	$$$$$,<ARGS>
	MOV	(SP)+,$$$$$
	.ENDM
	.ENDM	POP
;

	.SBTTL	STORAGE ALLOCATION AND CONSTANTS
	.PSECT	$IDATA,D,RW,LCL,REL,CON
;
;	Command line buffer
;
GCLBLK:	GCMLB$	1,,,LUNGCL	;1 level of indirect
;
;	Command string interpreter storage area
;
	CSI$
CSIBLK:	.BLKB	C.SIZE
	.EVEN
;
;	Data definitions
;
IOSB:	.BLKW	2		;QIO status block
;
INPFDB:	.BLKW	1		;Hold word for the FDB pointer
				; for the input files
;
;	Default read-ahead/write-behind buffer size
;
.IIF	NDF,BUFOBJ,BUFOBJ=2
.IIF	NDF,BUFLST,BUFLST=2
.IIF	NDF,BUFERR,BUFERR=2
.IIF	NDF,BUFINP,BUFINP=2
;

	.SBTTL	STORAGE ALLOCATION AND CONSTANTS- COMMON AREAS
;
;	Switch mask hold words(named common)
;
	.PSECT	MASKS,D,RW,GBL,REL,OVR
;
OBJMKP:	.WORD	0
OBJMKS:	.WORD	0
LSTMKP:	.WORD	0
LSTMKS:	.WORD	0
ERRMKP:	.WORD	0
ERRMKS:	.WORD	0
INPMKP:	.WORD	0
INPMKS:	.WORD	0
;
;	File flags(named common)
;
	.PSECT	FLAGS,D,RW,GBL,REL,OVR
FILES:	.WORD	0		;Which files open
;
OBJOPN=	1			; Individual file open bit definitions
LSTOPN=	2
ERROPN=	4
;
MORINP:	.WORD	0		;More input files left?
;
BATCH:	.WORD	0		;Batch mode? 0= tty invoked
;
NAMFIL:	.BLKB	30.		;Currently open input filename
;

	.SBTTL	MESSAGES
	.PSECT	$IDATA,D,RW,LCL,REL,CON

	MSG	MIOERR,<Command line I/O error>
	MSG	MOPNER,<Command file open error>
	MSG	MSYNER,<Command line syntax error>
	MSG	MMDEER,<Too many nested command levels>
	MSG	MBOFER,<Command line too long>
	MSG	MEOFER,<Nested MCR/PDS command not allowed>
	MSG	MCSI1E,<Bad command line:>
	MSG	MCSI2E,<Filespec/sw parse error:>
	MSG	MWLDFN,<Wild cards not allowed>
	MSG	MXTOUT,<Too many output filespecs>
	MSG	MNOOUT,<No output files specified>
	MSG	MNOINP,<No input file specified>
	MSG	MINPOP,<Input file open error>
	MSG	MOUTOP,<Output file open error>
	MSG	MILLUN,<Invalid logical unit number(internal error)>
;
MFILEM:	.ASCII	\I/O Error code: \
MFILEE:	.BLKB	6		;storage for error code digits
	.EVEN
MUSBUF:	.BLKB	4.		;storage for message number

MFILLN=	.-MFILEM		;message length before QIOSYM msg
	.BLKB	64.		;storage for QIOMSG error message
MFILER:	QIOW$	IO.WVB,LUNTT,EVNTFL,,IOSB,,<MFILEM,MFILLN,40>

MSGFIL:	.WORD	ENDFIL-FILNAM	;file descriptor for the M$OUT macro
	.WORD	FILNAM
FILNAM:	.ASCIZ	\LB0:[1,2]QIOSYM.MSG\
ENDFIL:	.EVEN			;file to reference for the messages

DFPRMT:	.ASCII	<12>\Command: \	;default prompt if none specified

.IF	NDF	PROMPT
PROMPT=	DFPRMT
PROMPL=	.-DFPRMT
.ENDC	;NDF,PROMPT

	.EVEN

	.SBTTL	EXECUTABLE CODE
	.PSECT	$CODE1,I,RW,LCL,REL,CON
;
;	Get the command line
;
SCANR::	GCML$	#GCLBLK,#PROMPT,#PROMPL
	JCS	GCLERR
	BITB	#FD.TTY,F.RCTL(R0)	;Test if tty invoked
	BNE	10$			;yes
	INC	BATCH			;no- set the flag
10$:	CSI$1	#CSIBLK,GCLBLK+G.CMLD+2,GCLBLK+G.CMLD
	JCS	CSI1ER

	.SBTTL	INPUT FILESPEC PARSE/FILENAME SAVE
;
CSIINP:	MOV	#INPMKD,C.MKW2(R0)	;Set def .SRC switches
	CALL	NXTINP			;Open the first input file
	PUSH	R0			;Save R0
	MOV	INPFDB,R3		;Save the filename for output
	ADD	#F.FNB,R3		;Point to beginning of FNB
	MOV	#NAMFIL,R0		;R0 points to filename buffer
	BITB	#CS.DVF,C.STAT+CSIBLK	;Device given?
	BEQ	10$			; No- skip to directory
	MOV	C.DEVD+CSIBLK,R1	; Yes- get ready to copy it
	MOV	C.DEVD+2+CSIBLK,R2	;R1=cnt, R2=addr
5$:	MOVB	(R2)+,(R0)+		;Move the character
	SOB	R1,5$			;And keep going till all done
	MOVB	#':,(R0)+		;Now put on the :
10$:	BITB	#CS.DIF,C.STAT+CSIBLK	;Directory given?
	BEQ	20$			; No- skip to filename
	MOV	C.DIRD+CSIBLK,R1	; Yes- get ready to copy it
	MOV	C.DIRD+2+CSIBLK,R2	;R1=cnt, R2=addr
15$:	MOVB	(R2)+,(R0)+		;Copy the character
	SOB	R1,15$			; and loop till done
20$:	MOV	N.FNAM(R3),R1		;Get RAD50 file name
	CALL	$C5TA			; and convert to ASCII
	MOV	N.FNAM+2(R3),R1
	CALL	$C5TA
	MOV	N.FNAM+4(R3),R1
	CALL	$C5TA
25$:	CMPB	#' ,-1(R0)		;Last character=' '?
	BNE	30$			; No
	DEC	R0			; Yes- delete it
	BR	25$			;Loop to check another
30$:	MOVB	#'.,(R0)+		;Put . into filename spec
	MOV	N.FTYP(R3),R1		;Get RAD50 file type
	CALL	$C5TA			; and convert to ASCII
	MOVB	#' ,(R0)		;Terminate string with a space
	POP	R0			;Restore R0
	MOV	R3,R1			;Move filename block pointer to R1
	ADD	#N.FNAM,R1		;Get to the filename pointer
	MOV	#N.FNAM+OBJDEF,R2	;Test the OBJ NMBLK
	TST	(R2)			;Any default OBJ already spec'd?
	BNE	35$			;Yes- so don't overwrite it
	MOV	(R1)+,(R2)+		;No- so copy it
	MOV	(R1)+,(R2)+
	MOV	(R1),(R2)
	SUB	#4,R1			;And reset the pointer
35$:	MOV	#N.FNAM+LSTDEF,R2	;Now the LST NMBLK
	TST	(R2)			;Any default LST already spec'd?
	BNE	40$			;Yes- so don't overwrite it
	MOV	(R1)+,(R2)+		;No- so copy it
	MOV	(R1)+,(R2)+
	MOV	(R1),(R2)
	SUB	#4,R1			;Now reset the pointer
40$:	MOV	#N.FNAM+ERRDEF,R2	;And finally the ERR NMBLK
	TST	(R2)			;Any default ERR already spec'd?
	BNE	45$			;Yes- so don't overwrite it
	MOV	(R1)+,(R2)+		;No- so copy it
	MOV	(R1)+,(R2)+
	MOV	(R1),(R2)
45$:	BITB	#CS.EQU,C.STAT(R0)	;'=' present?
	JEQ	NOEQU			;No- use the default output files
;

	.SBTTL	OBJECT FILESPEC PARSE
;
CSIOBJ:	MOV	#OBJMKD,C.MKW2(R0)	;Set def .OBJ switches
	CALL	CLRDSD			;Clear out the FDB from INPUT
.IF	DF	OBJTBL
	CSI$2	#CSIBLK,OUTPUT,#OBJTBL	;Get .OBJ spec
.IFF
	CSI$2	#CSIBLK,OUTPUT		;Get .OBJ spec
.ENDC	;DF	OBJTBL
	JCS	CSI2ER
	BITB	#CS.NMF!CS.DIF!CS.DVF,C.STAT(R0) ;File, dev, or dir present?
	BEQ	NOOBJ			;No- no output file to be used
	BITB	#CS.WLD,C.STAT(R0)	;Wild filename?
	JNE	WILDFN			;Yes- not permitted
	CALL	OPNOBJ			;No- so open the file
NOOBJ:	MOV	C.MKW1(R0),OBJMKP	;Save the switches present
	MOV	C.MKW2(R0),OBJMKS	;And their sense
	BITB	#CS.MOR,C.STAT(R0)	;Any ',' in the command string?
	BNE	CSILST			;Yes- so handle next output filetype
	JMP	DEFLST			;No- so use the LST and ERR defaults

	.SBTTL	LISTING FILESPEC PARSE
;
CSILST:	MOV	#LSTMKD,C.MKW2(R0)	;Set def .LST switches
	CALL	CLRDSD			;Clear out the FDB from OBJECT
.IF	DF	LSTTBL
	CSI$2	#CSIBLK,OUTPUT,#LSTTBL	;Parse .LST filespec
.IFF
	CSI$2	#CSIBLK,OUTPUT		;Parse .LST filespec
.ENDC	;DF	LSTTBL
	JCS	CSI2ER
	BITB	#CS.NMF!CS.DIF!CS.DVF,C.STAT(R0) ;Any file, dev or dir?
	BEQ	NOLST			;No- therefore no list
	BITB	#CS.WLD,C.STAT(R0)	;Wild filename?
	JNE	WILDFN			;Yes- that's not legal
	CALL	OPNLST			;No- so open for write
NOLST:	MOV	C.MKW1(R0),LSTMKP	;Save the .LST switches
	MOV	C.MKW2(R0),LSTMKS
	BITB	#CS.MOR,C.STAT(R0)	;Any more output files?
	BNE	CSIERR			;Yes- go get the .ERR file
	JMP	DEFERR			;No- so use the ERR default

	.SBTTL	ERROR LIST FILESPEC PARSE
;
CSIERR:	MOV	#ERRMKD,C.MKW2(R0)	;Set def .ERR switches
	CALL	CLRDSD			;Clear out the FDB from LIST
.IF	DF	ERRTBL
	CSI$2	#CSIBLK,OUTPUT,#ERRTBL	;Parse .ERR filespec
.IFF
	CSI$2	#CSIBLK,OUTPUT		;Parse .ERR filespec
.ENDC	;DF	ERRTBL
	JCS	CSI2ER
	BITB	#CS.NMF!CS.DIF!CS.DVF,C.STAT(R0) ;Any file, dev or dir?
	BEQ	NOERR			;No- therefore no list
	BITB	#CS.WLD,C.STAT(R0)	;Wild filename?
	JNE	WILDFN			;Yes- that's not allowed
	CALL	OPNERR			;No- so open for write
NOERR:	MOV	C.MKW1(R0),ERRMKP	;Save the .ERR switches
	MOV	C.MKW2(R0),ERRMKS
	BITB	#CS.MOR,C.STAT(R0)	;Any more output files?
	JNE	XTROUT			;Yes- too many output filenames
	TST	FILES			;Any open files?
	BNE	RETURN			;Yes- ok to leave
	JMP	NOOUT			;No- then why even run it

	.SBTTL	DEFAULT OUTPUT FILESPEC PARSE
;
NOEQU:	CALL	CLRDSD			;First clear out the FDB from INPUT
	CALL	OPNOBJ			;Then open the OBJ file
	MOV	#OBJMKD,OBJMKS		; and save the flags
DEFLST:	CALL	CLRDSD			;+001 CLEAR OUT THE FDB
	CALL	OPNLST			;NOW OPEN THE LST
	MOV	#LSTMKD,LSTMKS
DEFERR:	CALL	CLRDSD			;+001 CLEAR OUT THE FDB
	CALL	OPNERR			;NOW OPEN THE ERR
	MOV	#ERRMKD,ERRMKS
;
RETURN:	RTN
;

	.SBTTL	INPUT FILESTRINGS PARSE
NXTINP::CALL	CLRDSD			;Clear the FDB from any other parse
	BITB	#CS.EQU,C.STAT+CSIBLK	;Input files only?
	BEQ	10$			;Yes
.IF	DF	INPTBL
	CSI$2	#CSIBLK,INPUT,#INPTBL	;Parse input filespecs
	BR	20$
10$:	CSI$2	#CSIBLK,OUTPUT,#INPTBL	;Parse only filespecs
.IFF
	CSI$2	#CSIBLK,INPUT		;Parse input filespecs
	BR	20$
10$:	CSI$2	#CSIBLK,OUTPUT		;Parse only filespecs
.ENDC	;DF	INPTBL
20$:	JCS	CSI2ER
	BITB	#CS.NMF,C.STAT(R0)	;Any filename?
	JEQ	NOINP			;No-error
	BITB	#CS.WLD,C.STAT(R0)	;Wild filename?
	JNE	WILDFN			;Yes- not allowed
	CALL	OPNINP			;Now open for readonly
	MOV	C.MKW1(R0),INPMKP	;Save the current switches
	MOV	C.MKW2(R0),INPMKS
	CLR	MORINP
	BITB	#CS.MOR,C.STAT(R0)	;Any more input files?
	BEQ	30$			;No
	INC	MORINP			;Yes
30$:	RTN

	.SBTTL	CSI DATA SET DESCRIPTOR CLEAR
;
CLRDSD:	MOV	#C.DSDS+CSIBLK,R1	;Point to the DSD block
	MOV	#6,R2			;Number of words to clear out
10$:	CLR	(R1)+			;Clear it
	SOB	R2,10$			; until done
	RTN


	.SBTTL	OPEN SUBROUTINES
;
;	Object file open
;
OPNOBJ:	PUSH	R0
	MOV	#LUNOBJ,R2
	CALL	$FCHNL			;Get the FFDB
	BCC	10$			;Ok?
	JMP	ILLLUN			;No- bad lun
10$:	MOV	#OBJSTA,D.STAT(R0)	;Now the fake FTN stuff
	MOV	#OBJST2,D.STA2(R0)
	ADD	#D.FDB,R0		;Get to the real FDB
	FDAT$R	,#R.VAR,#FD.CR!FD.BLK,,#-2,#-2	;Increments of 2 blocks, CRLF
	FDRC$R	,,$OTSVA+W.BFAD,$OTSVA+W.BLEN	;Fortran record buffer
	FDOP$R	,#LUNOBJ,#CSIBLK+C.DSDS,#OBJDEF,#FO.WRT
	FDBF$R	,#EVNTFL,,#BUFOBJ,#FD.WBH	;Buffer size
	OPEN$W				;And finally open it
	BCC	20$			;Open ok?
	BIC	#OBJOPN,FILES		;No- so set flag to not open
	JMP	OUOPER
20$:	BIS	#OBJOPN,FILES		;Say it's open
	POP	R0
	RTN

;
;	List file open
;
OPNLST:	PUSH	R0
	MOV	#LUNLST,R2
	CALL	$FCHNL			;Get the FFDB
	BCC	10$			;Ok?
	JMP	ILLLUN			;No- bad lun
10$:	MOV	#LSTSTA,D.STAT(R0)	;Now the fake FTN stuff
	MOV	#LSTST2,D.STA2(R0)
	ADD	#D.FDB,R0		;Get to the real FDB
	FDAT$R	,#R.VAR,#FD.CR!FD.BLK,,#-2,#-2	;Increments of 2 blocks, CRLF
	FDRC$R	,,$OTSVA+W.BFAD,$OTSVA+W.BLEN	;Fortran record buffer
	FDOP$R	,#LUNLST,#CSIBLK+C.DSDS,#LSTDEF,#FO.WRT
	FDBF$R	,#EVNTFL,,#BUFLST,#FD.WBH	;Buffer size
	OPEN$W				;And finally open it
	BCC	20$			;Open ok?
	BIC	#LSTOPN,FILES		;No- so flag it as such
	JMP	OUOPER
20$:	BIS	#LSTOPN,FILES		;Yes- say it's open
	POP	R0
	RTN

;
;	Error list file open
;
OPNERR:	PUSH	R0
	MOV	#LUNERR,R2
	CALL	$FCHNL			;Get the FFDB
	BCC	10$			;Ok?
	JMP	ILLLUN			;No- bad lun
10$:	MOV	#ERRSTA,D.STAT(R0)	;Now the fake FTN stuff
	MOV	#ERRST2,D.STA2(R0)
	ADD	#D.FDB,R0		;Get to the real FDB
	FDAT$R	,#R.VAR,#FD.CR!FD.BLK,,#-2,#-2	;Increments of 2 blks, CRLF
	FDRC$R	,,$OTSVA+W.BFAD,$OTSVA+W.BLEN	;Fortran record buffer
	FDOP$R	,#LUNERR,#CSIBLK+C.DSDS,#ERRDEF,#FO.WRT
	FDBF$R	,#EVNTFL,,#BUFERR,#FD.WBH	;Buffer size
	OPEN$W				;And open it now
	BCC	20$			;Open ok?
	BIC	#ERROPN,FILES		;No- so indicate
	JMP	OUOPER
20$:	BIS	#ERROPN,FILES		;Yes- say it's open
	POP	R0
	RTN

;
;	Input file open
;
OPNINP:	PUSH	R0			;Save the CSI pointer
	MOV	#LUNINP,R2
	CALL	$FCHNL			;Get the FFDB
	BCC	10$			;Ok?
	JMP	ILLLUN			;Report illegal LUN
10$:	MOV	#INPSTA,D.STAT(R0)	;Fudge the Fortran file stuff
	MOV	#INPST2,D.STA2(R0)
	ADD	#D.FDB,R0			;Get to the real FDB
	FDRC$R	,,$OTSVA+W.BFAD,$OTSVA+W.BLEN	;Setup the Fortran I/O buffer
					;
					; Open for readonly with the
					; name from CSI and default
					; and don't lock the file if
					; not closed.
	FDOP$R	,#LUNINP,#CSIBLK+C.DSDS,#INPDEF,#FO.RD,#FA.ENB!FA.DLK
	FDBF$R	,#EVNTFL,,#BUFINP,#FD.RAH	;Read ahead buffer size
	OPEN$R
	BCC	20$			;Open ok?
	JMP	INOPER
20$:	MOV	R0,INPFDB		;Save the FDB for the default name
	POP	R0
	RTN
;

	.SBTTL	ERROR ROUTINES
;
;	Command line errors
;
GCLERR:	MOVB	G.ERR(R0),R5		;Get error code
	CMP	#GE.IOR,R5		;I/O error?
	BNE	20$			;No
	DIR$	#MIOERR
	BR	FILERR			;Yes- tell why
20$:	CMP	#GE.OPR,R5		;Open error?
	BNE	30$			;No
	DIR$	#MOPNER
	BR	FILERR			;Yes- tell why
30$:	CMP	#GE.BIF,R5		;Syntax error in indirect file?
	BNE	40$			;No
	DIR$	#MSYNER
	JMP	ERREXT
40$:	CMP	#GE.MDE,R5		;Too many levels of indirect?
	BNE	50$			;No
	DIR$	#MMDEER
	JMP	ERREXT
50$:	CMP	#GE.RBG,R5		;Line too long?
	BNE	60$			;No
	DIR$	#MBOFER
	JMP	ERREXT
60$:	CMP	#GE.EOF,R5		;Nested PDS/MCR command?
	BEQ	70$			;Yes
	HALT				;SHOULDN'T GET HERE!
70$:	DIR$	#MEOFER
	JMP	ERREXT
;
;	Parse errors
;
CSI1ER:	DIR$	#MCSI1E			;Indicate bad command line parse
	BR	BADSTR			; and show the bad part of the line
CSI2ER:	DIR$	#MCSI2E			;Indicate bad filestring parse
BADSTR:	QIOW$S	#IO.WVB,#LUNTT,#EVNTFL,,#IOSB,,<C.FILD+2(R0),C.FILD(R0),#40>
	BR	ANYOPN
;
;	Filespec errors
;
WILDFN:	DIR$	#MWLDFN			;No wild cards allowed
	BR	ANYOPN
XTROUT:	DIR$	#MXTOUT			;Too many output files
	BR	ANYOPN
NOOUT:	DIR$	#MNOOUT			;No output files
	BR	ANYOPN
NOINP:	DIR$	#MNOINP			;= with no input files specified
	BR	ANYOPN
ILLLUN:	DIR$	#MILLUN			;File uses bad LUN- internal error
	BR	ANYOPN
INOPER:	DIR$	#MINPOP			;Open error on input file
	BR	FILERR			; Tell why
OUOPER:	DIR$	#MOUTOP			;Open error on output file

;
;	File open error
;
FILERR:	MOVB	F.ERR(R0),R5
	MOV	R5,R1			;Save error value for error message
	NEG	R5			; and complement for MO file index
	CLR	R2			;Set for decimal, ldg 0 suppress
	MOV	#MFILEE,R0
	CALL	$CBDSG			;Convert to decimal digits
	MOUT$S	#MSGFIL,,R5,CONT,USBUF,#MUSBUF,#80.
	ADD	MUSBUF+2,Q.IOPL+2+MFILER ;Add the length of the MO message
	MOV	#"  ,MUSBUF		;Blank out the MO message index
	MOV	#"  ,MUSBUF+2
	DIR$	#MFILER
;
;	Now delete any new files that were created
;
ANYOPN:	BIT	#OBJOPN,FILES		;Object file open?
	BEQ	10$			;No
	MOV	#LUNOBJ,R2
	CALL	$FCHNL
	ADD	#D.FDB,R0		;Get to the real FDB
	CALL	.DLFNB			;Delete the file
10$:	BIT	#LSTOPN,FILES		;List file open?
	BEQ	20$			;No
	MOV	#LUNLST,R2
	CALL	$FCHNL
	ADD	#D.FDB,R0		;Get to the real FDB
	CALL	.DLFNB			;And kill it
20$:	BIT	#ERROPN,FILES		;Error file open?
	BEQ	ERREXT			;No
	MOV	#LUNERR,R2
	CALL	$FCHNL
	ADD	#D.FDB,R0
	CALL	.DLFNB			;And kill this last one
ERREXT:	CLOSE$	#GCLBLK			;Close out the GCML file
EXTSEV::EXST$S	#EX$SEV			;And exit with a SEVERE ERROR status
EXTERR::EXST$S	#EX$ERR			;ERROR exit for external use
EXTWAR::EXST$S	#EX$WAR			;WARNING exit for external use
;
	.END