.TITLE	EXT -- MACRO 11 ERROR EXTRACTOR
	.ENABL	LC
;
;	  ********   ********    *******   **     **  **     **
;	  *********  *********  *********  **     **  **     **
;	  **     **  **     **  **     **  **     **  ***    **
;	  **     **  **     **  **     **  **     **  ****   **
;	  ********   *********  **     **  **     **  ** **  **
;	  ********   ********   **     **  **  *  **  **  ** **
;	  **     **  **  **     **     **  ** *** **  **   ****
;	  **     **  **   **    **     **  **** ****  **    ***
;	  *********  **    **   *********  ***   ***  **     **
;	  ********   **     **   *******   **     **  **     **
;	
;	
;	  ********    *******   **     **  *********  ********   **
;	  *********  *********  **     **  *********  *********  **
;	  **     **  **     **  **     **  **         **     **  **
;	  **     **  **     **  **     **  **         **     **  **
;	  ********   **     **  **     **  *****      *********  **
;	  ********   **     **  **     **  *****      ********   **
;	  **     **  **     **  **     **  **         **  **     **
;	  **     **  **     **   **   **   **         **   **    **
;	  *********  *********    *****    *********  **    **   **
;	  ********    *******      ***     *********  **     **  **
;	
;	
;	
;	
;		    *   *   **    **   ***    **     *   * 
;		    ** **  *  *  *  *  *  *  *  *   **  ** 
;		    * * *  ****  *     ***   *  *    *   * 
;	  	    *   *  *  *  *  *  *  *  *  *    *   * 
;	  	    *   *  *  *   **   *  *   **    *** ***
;
;
;
;
;			Brown Boveri Nederland b.v.
;			afd. industriele automatisering
;			postbus 301, 3000 AH  Rotterdam
;			telefoon: 010-178911
;
;			Auteur	: J.H.HAMAKERS
;			Account : 1,24
;			File	: EXT.MAC
;			Datum	: 24-MAR-82
;			Gewijz	: 14-Oct-86
			.ident	/JHA02b/

;
; Edited:
;	14-Oct-83	V02A	JHA02	Exit with status
;	14-Oct-86	V02b	JHA03	Skip blank line
;
;
; Macro calls to the system
;
	.MCALL	EXST$S	,QIOW$S	,GTIM$S					;JHA02
	.MCALL	FCSMC$	,GET$R	,PRINT$
	.MCALL	GCMLB$	,GCML$
	.MCALL	CSI$	,CSI$1	,CSI$2
	FCSMC$
;
; Macro calls to BBNMAC.MAC
;
	.MCALL	POP	,PUSH
;
; Logical units
;
	LSTLUN	= 1
	EXTLUN	= 2
	CSILUN	= 5
	MSGLUN	= 6
;
; Other definitions
;
	OFFSET	= 128.		; OFFSET IN MESSAGE FILE
	MAXDPT	= 1		; NESTING DEPTH @
;
	RECL=LSTFDB+F.NRBD	; RECORD LENGTH


	.SBTTL	FCS DATA PIECE
;
	.NLIST	BEX		;
;
	FSRSZ$	3		; MAX. 3 FILES OPEN AT SAME TIME
;
	.SBTTL	COMMAND LINE BLOCK
;
GCMBLK:	GCMLB$	MAXDPT,EXT,,CSILUN
;
	.SBTTL	INTERPRETER BLOCK
;
	CSI$
;
CSIBLK:	.BLKB	C.SIZE
;
;
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
	.SBTTL	FILE CONTROL BLOCK FOR .EXT
;
EXTFDB:	FDBDF$							;
	FDAT$A	R.VAR,FD.CR					;
	FDOP$A	EXTLUN,EXTDSD,EXTDFB,FO.WRT,FA.ENB!FA.DLK	;
;
EXTDFB:	NMBLK$	,EXT,,SY,0	; DEFAULTS
;
EXTDSD:	.BLKW	6		; EXT DESCRIPTOR
;
EXTDV:	.ASCII	/TI0:/		; DEFAULT DEVICE FOR NO FILESPEC.
EXTDVL	=.-EXTDV		;
	.EVEN			;
;
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
	.SBTTL	FILE CONTROL BLOCK FOR .LST
;
LSTFDB:	FDBDF$							;
	FDRC$A	,LINBUF,LNBUFL					;
	FDOP$A	LSTLUN,LSTDSD,LSTDFB,FO.RD			;
;
LSTDFB:	NMBLK$	,LST,,SY,0	; DEFAULTS
;
LSTDSD:	.BLKW	6		; LST DESCRIPTOR
;
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
	.SBTTL	FILE CONTROL BLOCK FOR ERROR MESSAGES
;
MSGFDB:	FDBDF$							;
	FDRC$A	FD.RAN						;
	FDOP$A	MSGLUN,MSGDSD,,FO.RD				;
;
MSGDSD:	MSGDVL,MSGDV,MSGDRL,MSGDR,MSGFLL,MSGFL	; DATA SET DESCR.
;
MSGDV:	.ASCII	/LB0:/		;
MSGDVL	=.-MSGDV		;
	.EVEN			;
MSGDR:	.ASCII  /[1,2]/		;
MSGDRL	=.-MSGDR		;
	.EVEN			;
MSGFL:	.ASCII  /QIOSYM.MSG/	;
MSGFLL	=.-MSGFL		;
	.EVEN			;

	.SBTTL	MESSAGES
;
MSG1:	.ASCII	/EXT -- Indirect file open or read error/
MSL1	=.-MSG1
MSG2:	.ASCII	/EXT -- Syntax error/
MSL2	=.-MSG2
MSG3:	.ASCII	/EXT -- No switch allowed/
MSL3	=.-MSG3
MSG4:	.ASCII	/EXT -- Too many input specifiers/
MSL4	=.-MSG4
MSG5:	.ASCII	/EXT -- Input specifier missing/
MSL5	=.-MSG5
MSG6:	.ASCII	/EXT -- Too many output specifiers/
MSL6	=.-MSG6
MSG8:	.ASCII	/EXT -- No wildcards allowed/
MSL8	=.-MSG8
MSG9:	.ASCII	/EXT -- No input filename specified/
MSL9	=.-MSG9
MSGU:	.ASCII	/EXT -- Error occurded, LB:[1,2]QIOSYM.MSG read error/
MSLU	=.-MSGU
MSGM:	.ASCII	/EXT -- Undefined references : /
MSGMT:	.BLKB	8.
MSGE:	.ASCII	/EXT -- Errors detected : /
MSGET:	.BLKB	6.
MSLE	=.-MSGE
MSGC:	.ASCII	<15><12><12>
MSLC	=.-MSGC
MSGX:	.ASCII	/EXT -- /
MSGXT:	.BLKB	64.			; ERROR TEXT
MSLX	=.-MSGX				;
	.EVEN				;
;
STACK:	0				; INITIAL STACKPOINTER
NOEXT:	0				; NO EXT SPECIFIER
NONAME:	0				; NO EXT NAME
LSTSIZ:	0				; SIZE OF LST NAME
LINBUF:	.BLKB	134.			; LINE BUFFER
LNBUFL	=.-LINBUF			;
	.EVEN				;
;
SAVBUF:	.BLKB	134.			; SAVE BUFFER FOR RECORDS
	.EVEN				;
SAVLEN:	0				; LENGTH OF SAVED RECORD
DEFDEV: 0				; DEFAULT DEVICE FLAG
URCNT:	0				; UNDEF. REF. COUNT
EXSTA:	EX$SUC				; Exit status			;JHA02

START:	FINIT$				; INIT FSR
	MOV	SP,STACK		; SAVE INITIAL STACK VALUE
	MOV	#6,R1			; +
	MOV	#EXTDSD,R2		;  CLEAR
	MOV	#LSTDSD,R3		;
10$:	CLR	(R2)			;    JUNK
	CLR	(R3)			;
	SOB	R1,10$			;     FROM
	CLR	NOEXT			;
	CLR	NONAME			;    PREVIOUS RUNS
	CLR	DEFDEV			;
	CLR	URCNT			; -
;
	.SBTTL	COMMANDLINE FETCH
;
	GCML$	#GCMBLK			; GET COMMANDLINE
	BCC	CSISYN			; OK ? YES: => CSISYN
	CMPB	GCMBLK+G.ERR,#GE.EOF	; END OF FILE
	BNE	20$			;  NO: => 20$
	JMP	EXIT			; EXIT
;
; Indirect file open or read error
;
20$:
	MOV	#MSG1,R1		; ADDR. OF MESSAGE
	MOV	#MSL1,R2		; LENGTH OF MESSAGE
	MOV	#EX$SEV,EXSTA		; Severe status			;JHA02
	JMP	ERROR			; => ERROR
;
	.SBTTL	CSI SYNTAX TEST
;
CSISYN:
	MOV	#EX$SEV,EXSTA		; Severe status			;JHA02
	MOV	GCMBLK+G.CMLD+2,CSIBLK+C.CMLD+2
					; COPY BUFFER ADDRESS
	MOV	GCMBLK+G.CMLD  ,CSIBLK+C.CMLD
					; COPY BUFFER LENGTH
	CSI$1	#CSIBLK			; TEST SYNTAX
	BCC	GETEXT			; OK ? YES: => GETEXT
;
; Syntax error
;
	MOV	#MSG2,R1		; MESSAGE ADDRESS
	MOV	#MSL2,R2		; MESSAGE LENGTH
	JMP	ERROR			; => ERROR

	.SBTTL	GET EXT SPECIFIER
;
GETEXT:
	CSI$2	#CSIBLK,OUTPUT		; GET EXT SPECIFIER
	BCC	10$			; OK ? YES: => 10$
;
; Illegal switch
;
	MOV	#MSG3,R1		; MESSAGE ADDRESS
	MOV	#MSL3,R2		; MESSAGE LENGTH
	JMP	ERROR			; => ERROR
10$:
	BITB	#CS.MOR,CSIBLK+C.STAT	; MORE FILES SPECIFIED ?
	BEQ	20$			;  NO: => 20$
;
; Too many output specifiers
;
	MOV	#MSG6,R1		; MESSAGE ADDRESS
	MOV	#MSL6,R2		; MESSAGE LENGTH
	JMP	ERROR			; ERROR
20$:
	BITB	#CS.WLD,CSIBLK+C.STAT	; WILDCARDS USED ?
	BEQ	30$			;  NO: => 30$
;
; No wildcards allowed
;
	MOV	#MSG8,R1		; MESSAGE ADDRESS
	MOV	#MSL8,R2		; MESSAGE LENGTH
	JMP	ERROR			; => ERROR
30$:
	BITB	#CS.NMF!CS.DIF!CS.DVF,CSIBLK+C.STAT
					; SOMETHING SPECIFIED ?
	BNE	50$			;  YES: => 50$
40$:	INC	NOEXT			; SET NOEXT FLAG
	MOV	#EXTDV ,EXTDSD+2	; DEFAULT DEVICE
	MOV	#EXTDVL,EXTDSD		;   FOR NO FILESPEC 
	INC	DEFDEV			;
	BR	GETLST			; => GETLST
50$:
	BITB	#CS.NMF,CSIBLK+C.STAT	; FILENAME SPECIFIED ?
	BNE	60$			;  NO: => 60$
	INC	NONAME			; SET NONAME FLAG
	BR	70$			; => 70$
60$:
	MOV	CSIBLK+C.FILD+2,EXTDSD+12 ; COPY ADDRESS AND
	MOV	CSIBLK+C.FILD  ,EXTDSD+10 ;    LENGTH OF FILENAME
70$:
	MOV	CSIBLK+C.DIRD+2,EXTDSD+6  ; COPY ADDRESS AND
	MOV	CSIBLK+C.DIRD  ,EXTDSD+4  ;    LENGTH OF DIRECTORY
	MOV	CSIBLK+C.DEVD+2,EXTDSD+2  ; COPY ADDRESS AND
	MOV	CSIBLK+C.DEVD  ,EXTDSD    ;    LENGTH OF DEVICE

	.SBTTL	GET LST SPECIFIER
;
GETLST:
	CSI$2	#CSIBLK,INPUT		; GET LST SPECIFIER
	BCC	10$			; OK ? YES: => 10$
;
; Illegal switch
;
	MOV	#MSG3,R1		; MESSAGE ADDRESS
	MOV	#MSL3,R2		; MEGGASE LENGTH
	JMP	ERROR			; => ERROR
10$:
	BITB	#CS.MOR,CSIBLK+C.STAT	; MORE SPECIFIERS ?
	BEQ	20$			;  NO: => 20$
;
; Too many input specifiers
;
	MOV	#MSG4,R1		; MESSAGE ADDRESS
	MOV	#MSL4,R2		; MESSAGE LENGTH
	JMP	ERROR			; => ERROR
20$:
	BITB	#CS.WLD,CSIBLK+C.STAT	; WILDCARDS USED ?
	BEQ	30$			;  NO: => 30$
;
; No wildcards allowed
;
	MOV	#MSG8,R1		; MESSAGE ADDRESS
	MOV	#MSL8,R2		; MESSAGE LENGTH
	JMP	ERROR			; => ERROR
30$:
	BITB	#CS.NMF!CS.DIF!CS.DVF,CSIBLK+C.STAT
					; SOMETHING SPECIFIED ?
	BNE	50$			;  YES: => 50$
	TST	NOEXT			; ALSO NO EXT ?
	BEQ	40$			;  NO: => 40$
	MOV	#EX$SUC,EXSTA		; Success status		;JHA02
	JMP	START			; PROMPT AGAIN
40$:
	MOV	EXTDSD+12,LSTDSD+12 ; COPY ADDRESS AND
	MOV	EXTDSD+10,LSTDSD+10 ;    LENGTH OF FILENAME
	MOV	EXTDSD+6 ,LSTDSD+6  ; COPY ADDRESS AND
	MOV	EXTDSD+4 ,LSTDSD+4  ;    LENGTH OF DIRECTORY
	MOV	EXTDSD+2 ,LSTDSD+2  ; COPY ADDRESS AND
	MOV	EXTDSD   ,LSTDSD    ;    LENGTH OF DEVICE
	MOV	#EXTDV ,EXTDSD+2	; DEFAULT DEVICE EXT
	MOV	#EXTDVL,EXTDSD		;   FOR NO FILESPEC 
	INC	DEFDEV			;
	BR	OPEN			;
50$:
	BITB	#CS.NMF,CSIBLK+C.STAT	; FILENAME SPECIFIED ?
	BNE	70$			;  YES: => 70$
	TST	NOEXT			; ALSO NO EXT ?
	BNE	60$			;  YES: => 60$
	TST	NONAME			; OR NO NAME ?
	BEQ	70$			;  NO: => 70$
60$:
;
; No file name specified
;
	MOV	#MSG9,R1		; MESSAGE ADDRESS
	MOV	#MSL9,R2		; MESSAGE LENGTH
	JMP	ERROR			; => ERROR
70$:
	MOV	CSIBLK+C.FILD+2,LSTDSD+12 ; COPY ADDRESS AND
	MOV	CSIBLK+C.FILD  ,LSTDSD+10 ;    LENGTH OF FILENAME
	MOV	CSIBLK+C.DIRD+2,LSTDSD+6  ; COPY ADDRESS AND
	MOV	CSIBLK+C.DIRD  ,LSTDSD+4  ;    LENGTH OF DIRECTORY
	MOV	CSIBLK+C.DEVD+2,LSTDSD+2  ; COPY ADDRESS AND
	MOV	CSIBLK+C.DEVD  ,LSTDSD    ;    LENGTH OF DEVICE
;
; SKIP EXT. FOR DEFAULTNAME
;
	MOV	CSIBLK+C.FILD+2,R0	; COPY ADDRESS
	CMPB	(R0),#'.		; IS IT A "." ?
	BNE	80$			;  NO : => 80$
;
; No input filename specified
;
	MOV	#MSG9,R1		; MESSAGE ADDRESS
	MOV	#MSL9,R2		; MESSAGE LENGTH
	JMP	ERROR			; => ERROR
80$:
	TST	NONAME			; NO EXT NAME ?
	BEQ	110$			;  NO: => 110$
	MOV	CSIBLK+C.FILD,R1	; LENGTH OF FILENAME
	MOV	CSIBLK+C.FILD,LSTSIZ	; LENGTH OF FILENAME
	CLR	R2			; CLEAR COUNT
90$:	CMPB	(R0)+,#'.		; IS IT A "." ?
	BEQ	100$			;  YES => 100$
	INC	R2			; INC COUNT
	SOB	R1,90$			; NO => 90$
100$:
	MOV	LSTDSD+12,EXTDSD+12	; ADDR OF LSTFILE
	MOV	R2       ,EXTDSD+10	; SIZE OF LSTFILE
110$:

	.SBTTL	OPEN FILES
;
OPEN:
	OPEN$R	#LSTFDB,,,,,,FCSER	; OPEN INPUT FILE
	OPEN$W	#EXTFDB,,,,,,FCSER	; OPEN EXT FILE
	MOV	#EX$SUC,EXSTA		; Success status		;JHA02

	.SBTTL	ALGORITHM
;
	BR	30$			; SKIP U-REF PART
;
10$:	CMP	#12.,R4			; RECORD LENGTH 12. ?
	BNE	30$			;  NO: => 30$
	CMP	#"  ,(R1)		; 2 SPACES ?
	BNE	30$			;  N0: => 30$
	CMP	(R1)+,(R1)		; 2 SPACES ?
	BNE	30$			;   N0: => 30$
	TST	URCNT			; DID WE HAVE AN UNDEF. REF. ?
	BNE	20$			;  YES: => 20$
	PUSH	<R1,R4>			; SAVE ADDR. AND LENGTH
	MOV	#MSGC,R1		; OUTPUT A CR,LF
	MOV	#MSLC,R4		;  BEFORE THE FIRST
	CALL	PUT			;   UNDEF. REFERENCE
	POP	<R4,R1>			; UNSAVE LENGTH AND ADDR.
20$:	INC	URCNT			; SAY WE FOUND AN UNDEF. REF.
	MOV	#EX$ERR,EXSTA		; Error status			;JHA02
	SUB	#4,R4			; MAKE RECORD LENGTH 10.	;JHA03
	CALL	PUT			; GET IT OUT
30$:
	CALL	GET			; GET A RECORD
	CMP	LSTFDB+F.FNB+N.FTYP,#^RMAP ; INPUT .MAP ?
	BEQ	10$			;   YES: => 10$
	CMPB	(R1),#14		; IS IT A <FF> ?
	BNE	50$			;  YES: => 50$
	CALL	GET			; GET THE NEXT
	MOV	R1,R2			; SAVE R1
	.IRPC	Q,<SYMBOL TABLE>	; IS
		CMPB	#''Q,(R1)+	;   IT
		BNE	40$		;      THE
	.ENDR				;   SYMBOL TABLE ?
	BR	60$			;  YES: => 60$
40$:
	.IRPC	Q,<Symbol table>	; IS
		CMPB	#''Q,(R2)+	;   IT
		BNE	30$		;      THE
	.ENDR				;   SYMBOL TABLE V4.1 up ?
	BR	60$			;  YES: => 60$
50$:
	CMPB	(R1),#40		; IS IT A <SPACE> ?
	BLE	30$			;  LOWER OS SAME: => 30$
	CALL	PUT			; FOUND AN ERROR: GET IT OUT
	BR	30$			; NEXT ONE
60$:
	CALL	GET			; GET NEXT ONE
	MOV	R1,R2			; SAVE R1
	.IRPC	Q,<ERRORS DETECTED>	; ERRORS
		CMPB	#''Q,(R1)+	;   DETECTED?
		BNE	70$		;    NO: => 70$
	.ENDR				;
70$:
	MOV	R2,R1			; UNSAVE R1
	.IRPC	Q,<Errors detected>	; ERRORS
		CMPB	#''Q,(R1)+	;   DETECTED V4.1 ?
		BNE	60$		;    NO: => 60$
	.ENDR				;
	MOV	#MSGET,R2		; R2 = MESSAGE ADDR.
	MOV	R1,R5			; CALCULATE
	SUB	#LINBUF,R5		;   PENDING 
	SUB	R5,R4			;    CHARACTERS
	MOV	#6.,R5			; R5 = COUNTER
80$:
	TST	R4			; ANY CHARS. REMAINING ?
	BEQ	90$			;  NO: => 90$
	CMPB	(R1),#'0		; NUMBER ?
	BLT	90$			;
	CMPB	(R1),#'9		;
	BGT	90$			;
	CMPB	(R1),#'0		; Is it a zero ?		;JHA02
	BEQ	85$			;  Yes: => 85$			;JHA02
	MOV	#EX$ERR,EXSTA		; Error status			;JHA02
85$:									;JHA02
	MOVB	(R1)+,(R2)+		; COPY NUMBER
	BR	100$			;
90$:	CLRB	(R2)+			; NO NUMBER => CLEAR THE BYTE
	INC	R1			; POINT TO NEXT CHARACTER
100$:
	TST	R4			; ANY CHARS. REMAINING ? 
	BEQ	110$			;  NO: => 110$
	DEC	R4			; DECREMENT CHAR. COUNT
110$:	SOB	R5,80$			; DO IT 6 x
	TST	DEFDEV			; DEFAULT DEVICE ?
	BNE	120$			;  YES: => 120$
	MOV	#MSGC,R1		; COPY ADDRESS
	MOV	#MSLC,R4		;  AND LENGTH
	CALL	PUT			;
	MOV	#MSGE,R1		; COPY ADDRESS
	MOV	#MSLE,R4		;  AND LENGTH
	CALL	PUT			;
	MOV	#MSGC,R1		; COPY ADDRESS
	MOV	#MSLC,R4		;  AND LENGTH
	CALL	PUT			;
120$:

	.SBTTL	FINISHING
;
END:
	CMP	LSTFDB+F.FNB+N.FTYP,#^RMAP ; INPUT .MAP?
	BNE	20$			;  NO: => 20$
	MOV	#MSGMT,R0		; R0 = ADDRESS
	MOV	URCNT,R1		; R1 = COUNT
	CLR	R2			; SUPPRESS ZERO'S
	CALL	$CBDMG			; CONVERT
	MOVB	#15,(R0)+		; ADD <CR>
	SUB	#MSGM,R0		; CALCULATE LENGTH
	MOV	R0,R4			; R4 = LENGTH
	TST	DEFDEV			; DEFAULT DEVICE ?
	BNE	10$			;  YES: => 10$
	PUSH	R4			; SAVE LENGTH
	MOV	#MSGC,R1		; COPY ADDRESS
	MOV	#MSLC,R4		;  AND LENGTH
	CALL	PUT			;
	MOV	#MSGM,R1		; COPY ADDRESS
	MOV	(SP),R4			;  AND LENGTH
	CALL	PUT			;
	MOV	#MSGC,R1		; COPY ADDRESS
	MOV	#MSLC,R4		;  AND LENGTH
	CALL	PUT			;
	POP	R4			; UNSAVE LENGTH
10$:	MOV	#MSGM,R1		; ADDRESS OF MESSAGE
	MOV	R4,R2			; LENGTH OF MESSAGE
	BR	30$			; => 30$
20$:
	MOV	#MSGE,R1		; ADDRESS OF MESSAGE
	MOV	#MSLE,R2		; LENGTH OF MESSAGE
;
; USE ERROR ROUTINE TO GIVE THE MESSAGE AND RESTART THE PROGRAM.
;
30$:
	JMP	ERROR
;
EXIT:	EXST$S	EXSTA			; Exit with status		;JHA02

	.SBTTL	SUBROUTINE GET
;
; READ INPUT FILE
;
GET:	MOV	#LINBUF,R1		; R1 = INPUT BUFFER
	CLRB	(R1)			; CLEAR FIRST CHARACTER
	GET$	#LSTFDB			; GET THE RECORD
	BCC	30$			; OK ? YES: => 30$
	CMPB	#IE.EOF,LSTFDB+F.ERR	; EOF ?
	BEQ	10$			;  YES: => 10$
	JMP	FCSER			; OTHER ERROR
10$:	CMP	LSTFDB+F.FNB+N.FTYP,#^RMAP ; INPUT .MAP ?
	BEQ	20$			;     YES: => 20$
	JMP	FCSER			; EOF
20$:	MOV	#END,(SP)		; CHANGE RETURN ADDRESS
	BR	40$			; => 40$
30$:	MOV	RECL,R4			; R4 = RECORD LENGTH
40$:	RETURN

	.SBTTL	SUBROUTINE PUT
;
;	WRITE TO OUTPUT FILE
;
PUT:	TST	R4			; WE DON'T PUT EMPTY ONES
	BEQ	10$			;
	PUT$	#EXTFDB,R1,R4,FCSER	; THERE YOU GO
10$:	RETURN				;

	.SBTTL	FCS/DIRECTIVE ERROR HANDLING
;
DRERR:	MOVB	(R0),R1			; ERROR CODE
	MOVB	#-1,R2			; DSW ERROR
	BR	COMMON			; => COMMON
;
FCSER:	MOVB	F.ERR(R0),R1		; ERROR CODE
	MOVB	F.ERR+1(R0),R2		; ERROR IDENT
	OPEN$R	#MSGFDB,,,,,,ER		; OPEN QIOSYM.MSG
;
COMMON:	NEG	R1			; MAKE IT POSITIVE
	TSTB	R2			; I/O - ERROR ?
	BEQ	10$			;  YES: => 10$
	ADD	#OFFSET,R1		; TAKE OFFSET TO DSW - CODES
10$:	
	MOV	#EX$SEV,EXSTA		; Severe status			;JHA02
	GET$R	#MSGFDB,#MSGXT,#64.,R1,#0,ER ; GET RECORD
	CLOSE$	#MSGFDB			; CLOSE FILE
	MOV	#MSGX,R1		; MESSAGE ADDRES
	MOV	#MSLX,R2		; MESSAGE LENGTH
	BR	ERROR			; ERROR
ER:
	MOV	#MSGU,R1		; MESSAGE ADDRES
	MOV	#MSLU,R2		; MESSAGE LENGTH
ERROR:
;
; CLOSE ALL FILES EVEN WHEN THEY WERE NOT OPEN TO ENSURE CORRECT HANDLING
; 
	CLOSE$	#EXTFDB			;
	CLOSE$	#LSTFDB			;
;
; SET STACK BACK TO INITIAL VALUE
;
	MOV	STACK,SP		; RESET STACK
;
; QUE MESSAGE
;
	QIOW$S	#IO.WVB,#CSILUN,#1,,,,<R1,R2,#40>
	JMP	START			;

	.END	START