.TITLE	EXP -- Pascal error extractor
	.ENABL	LC
;
;	  ********   ********    *******   **     **  **     **
;	  *********  *********  *********  **     **  **     **
;	  **     **  **     **  **     **  **     **  ***    **
;	  **     **  **     **  **     **  **     **  ****   **
;	  ********   *********  **     **  **     **  ** **  **
;	  ********   ********   **     **  **  *  **  **  ** **
;	  **     **  **  **     **     **  ** *** **  **   ****
;	  **     **  **   **    **     **  **** ****  **    ***
;	  *********  **    **   *********  ***   ***  **     **
;	  ********   **     **   *******   **     **  **     **
;	
;	
;	  ********    *******   **     **  *********  ********   **
;	  *********  *********  **     **  *********  *********  **
;	  **     **  **     **  **     **  **         **     **  **
;	  **     **  **     **  **     **  **         **     **  **
;	  ********   **     **  **     **  *****      *********  **
;	  ********   **     **  **     **  *****      ********   **
;	  **     **  **     **  **     **  **         **  **     **
;	  **     **  **     **   **   **   **         **   **    **
;	  *********  *********    *****    *********  **    **   **
;	  ********    *******      ***     *********  **     **  **
;	
;	
;	
;	
;		    *   *   **    **   ***    **     *   * 
;		    ** **  *  *  *  *  *  *  *  *   **  ** 
;		    * * *  ****  *     ***   *  *    *   * 
;	  	    *   *  *  *  *  *  *  *  *  *    *   * 
;	  	    *   *  *  *   **   *  *   **    *** ***
;
;
;
;
;			Brown Boveri Nederland b.v.
;			afd. industriele automatisering
;			postbus 301, 3000 AH  Rotterdam
;			telefoon: 010-180280
;
;			Auteur	: J.H.HAMAKERS
;			Account : 1,24
;			File	: EXP.MAC
;			Datum	: 24-MAR-82
;			Gewijz.	: 22-Oct-85
			.ident	/JHA03B/

;
; Edited:
;
;	8-Jun-84	JHA01	Display keywords for Pascal-M
;      23-May-85	JHA02	Addapted to DEC pascal
;      22-Oct-86	JHA03	Put summary line in file and dsiplay
;				Pascal-M keywords
;
; Macro calls to the system
;
	.MCALL	EXST$S	,QIOW$S	,GTIM$S		
	.MCALL	FCSMC$	,GET$R	,PRINT$
	.MCALL	GCMLB$	,GCML$
	.MCALL	CSI$	,CSI$1	,CSI$2
	FCSMC$
;
; Macro calls to BBNMAC.MAC
;
	.MCALL	POP   	,PUSH	,ASCDEF
;
; Logical units
;
	LSTLUN	= 1
	EXPLUN	= 2
	CSILUN	= 5
	MSGLUN	= 6
;
; Other definitions
;
	OFFSET	= 128.		; OFFSET IN MESSAGE FILE
	MAXDPT	= 1		; NESTING DEPTH @
;
	ASCDEF			; ASCII DEFINITIONS
	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,EXP,,CSILUN

;
	.SBTTL	INTERPRETER BLOCK
;
	CSI$
;
CSIBLK:	.BLKB	C.SIZE
;
;
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
	.SBTTL	FILE CONTROL BLOCK FOR .EXP
;
EXPFDB:	FDBDF$							;
	FDAT$A	R.VAR,FD.CR					;
	FDOP$A	EXPLUN,EXPDSD,EXPDFB,FO.WRT,FA.ENB!FA.DLK	;
;
EXPDFB:	NMBLK$	,EXP,,SY,0	; DEFAULTS
;
EXPDSD:	.BLKW	6		; EXP DESCRIPTOR
;
EXPDV:	.ASCII	/TI0:/		; DEFAULT DEVICE FOR NO FILESPEC.
EXPDVL	=.-EXPDV		;
	.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	/EXP -- Indirect file open or read error/
MSL1	=.-MSG1
MSG2:	.ASCII	/EXP -- Syntax error/
MSL2	=.-MSG2
MSG3:	.ASCII	/EXP -- Illegal switch/
MSL3	=.-MSG3
MSG4:	.ASCII	/EXP -- Too many input specifiers/
MSL4	=.-MSG4
MSG5:	.ASCII	/EXP -- Input specifier missing/
MSL5	=.-MSG5
MSG6:	.ASCII	/EXP -- Too many output specifiers/
MSL6	=.-MSG6
MSG8:	.ASCII	/EXP -- No wildcards allowed/
MSL8	=.-MSG8
MSG9:	.ASCII	/EXP -- No input filename specified/
MSL9	=.-MSG9
MSGU:	.ASCII	/EXP -- Error occurded, LB:[1,2]QIOSYM.MSG read error/
MSLU	=.-MSGU
MSGE:	.ASCII	<CR><LF>
	.ASCII	/EXP -- Lines containing errors  : /
MSDE:	.BLKB	8.
	.ASCII	<LF>
MSLE	=.-MSGE
MSGE1:	.ASCII	<CR><LF>
	.ASCII	/EXP -- Errors detected  : /
MSDE1:	.BLKB	8.
	.ASCII	<LF>
MSLE1	=.-MSGE1
MSGC:	.ASCII	<CR><LF><LF>
MSLC	=.-MSGC
MSGX:	.ASCII	/EXP -- /
MSGXT:	.BLKB	64.		; ERROR TEXT
MSLX	=.-MSGX
	.EVEN

ERRCNT:	0				;
STACK:	0				; INITIAL STACK POINTER
NOEXP:	0				;
NONAME:	0				;
LSTSIZ:	0				;
LINBUF:	.BLKB	134.			;
LNBUFL	=.-LINBUF			;
	.EVEN				;
;			
SAVBUF:	.BLKB	134.			; SAVE BUFFER
	.EVEN				;
SAVBF2:	.BLKB	134.			; SAVE BUFFER			;JHA02
	.EVEN				;				;JHA02
SAVLEN:	0				;
SAVLN2:	0				;				;JHA02
DEFDEV: 0				;
EXSTA:	EX$SUC				; Exit status	
PCLM:	0				; Type of pascal flag
PCLR:	0				; Type of pascal flag		;JHA02

START:	FINIT$				; INIT FSR
	MOV	SP,STACK		; SAVE INITIAL STACK VALUE
	MOV	#6,R1			; +
	MOV	#EXPDSD,R2		;  CLEAR
	MOV	#LSTDSD,R3		;
10$:	CLR	(R2)			;     JUNK
	CLR	(R3)			;
	SOB	R1,10$			;      FROM
	CLR	NOEXP			;
	CLR	NONAME			;       PREVIOUS RUNS
	CLR	DEFDEV			; 
;
	.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	
	JMP	ERROR			; => ERROR
;
	.SBTTL	CSI SYNTAX TEST
;
CSISYN:
	MOV	#EX$SEV,EXSTA		; Severe status	
	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	GETEXP			; OK ? YES: => GETEXP
;
; Syntax error
;
	MOV	#MSG2,R1		; MESSAGE ADDRESS
	MOV	#MSL2,R2		; MESSAGE LENGTH
	JMP	ERROR			; => ERROR

	.SBTTL	GET EXP SPECIFIER
;
GETEXP:
	CSI$2	#CSIBLK,OUTPUT		; GET EXP 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	NOEXP			; SET NOEXP FLAG
	MOV	#EXPDV ,EXPDSD+2	; DEFAULT DEVICE
	MOV	#EXPDVL,EXPDSD		;   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,EXPDSD+12 ; COPY ADDRESS AND
	MOV	CSIBLK+C.FILD  ,EXPDSD+10 ;    LENGTH OF FILENAME
70$:
	MOV	CSIBLK+C.DIRD+2,EXPDSD+6  ; COPY ADDRESS AND
	MOV	CSIBLK+C.DIRD  ,EXPDSD+4  ;    LENGTH OF DIRECTORY
	MOV	CSIBLK+C.DEVD+2,EXPDSD+2  ; COPY ADDRESS AND
	MOV	CSIBLK+C.DEVD  ,EXPDSD    ;    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	NOEXP			; ALSO NO EXP ?
	BEQ	40$			;  NO: => 40$
	MOV	#EX$SUC,EXSTA		; Succes status	
	JMP	START			; PROMPT AGAIN
40$:
	MOV	EXPDSD+12,LSTDSD+12 ; COPY ADDRESS AND
	MOV	EXPDSD+10,LSTDSD+10 ;    LENGTH OF FILENAME
	MOV	EXPDSD+6 ,LSTDSD+6  ; COPY ADDRESS AND
	MOV	EXPDSD+4 ,LSTDSD+4  ;    LENGTH OF DIRECTORY
	MOV	EXPDSD+2 ,LSTDSD+2  ; COPY ADDRESS AND
	MOV	EXPDSD   ,LSTDSD    ;    LENGTH OF DEVICE
	MOV	#EXPDV ,EXPDSD+2	; DEFAULT DEVICE EXP
	MOV	#EXPDVL,EXPDSD		;   FOR NO FILESPEC 
	INC	DEFDEV			;
	BR	OPEN			;
50$:
	BITB	#CS.NMF,CSIBLK+C.STAT	; FILENAME SPECIFIED ?
	BNE	70$			;  YES: => 70$
	TST	NOEXP			; ALSO NO EXP ?
	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 EXP. 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 EXP 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,EXPDSD+12	; ADDR OF LSTFILE
	MOV	R2       ,EXPDSD+10	; SIZE OF LSTFILE
110$:

	.SBTTL	OPEN FILES
;
OPEN:
	OPEN$R	#LSTFDB,,,,,,FCSER	; OPEN INPUT FILE
	OPEN$W	#EXPFDB,,,,,,FCSER	; OPEN EXP FILE
	MOV	#EX$SUC,EXSTA		; Succes status	

	.SBTTL	ALGORITHM
;
	CLR	PCLM			; No Pascal-M
	CLR	PCLR			; No Pascal-R			;JHA02
	CLR	ERRCNT			;				;JHA02
10$:
	CALL	GET			; Get record
	MOV	R1,R5			; Save R1
	.IRPC	Q,<PASCAL-M>		; Search
		CMPB	#''Q,(R1)+	;   for "PASCAL-M"
		BNE	30$		; Next
	.ENDR
	INC 	PCLM			; We have Pascal-M
20$:									;JHA01
	CALL	GET			; +				;JHA01
	CMPB	#' ,(R1)		;  Skip				;JHA01
	BNE	20$			;    heading  -			;JHA01
	BR	60$			; => 60$			;JHA01
30$:
	MOV	R5,R1			; Unsave R1
	.IRPC	Q,<PASCAL  P>		; Search
		CMPB	#''Q,(R1)+	;   For "PASCAL  PDP"
		BNE	40$		; Next				;JHA02
	.ENDR
	BR	50$			;				;JHA02
40$:									;JHA02
	MOV	R5,R1			; Unsave R1			;JHA02
	.IRPC	Q,<PDP-11 P>	; Search			;JHA02
		CMPB	#''Q,(R1)+	;   For "PDP-11 PASCAL"		;JHA02
		BNE	10$		; Next				;JHA02
	.ENDR								;JHA02
	INC	PCLR			; We have PASCAL rsx dec	;JHA02
50$:
	CALL	GET			; Get record
60$:									;JHA01
	CMP	R4,#3			; At least 3 chr ?
	BLO	50$			;  No: => 50$
;
	CMPB	1(R1),#'*		; 2nd Char "*" ?
	BNE	110$			;  No: => 110$
;
; Found error
;
	TST	PCLR			; Pascal r			;JHA02
	BEQ	80$			;  No :=> 80$			;JHA02
	CMPB	(R1),#'*		; 1st Char "*" ?		;JHA02
	BEQ	70$			;  Yes :=> 70$			;JHA02
	CALL	PUT			;				;JHA02
	JMP	190$			;				;JHA02
70$:
	INC	ERRCNT			; Increment error counter	;JHA02
	TST	PCLR			;				;JHA02
	BMI	100$			;				;JHA02
	NEG	PCLR			;				;JHA02
	PUSH	<R1,R4>			; Save current record		;JHA02
	MOV	#SAVBF2,R1		; Output			;JHA02
	MOV	SAVLN2,R4		;  saved			;JHA02
	CALL	PUT			;   record			;JHA02
	BR	90$			;				;JHA02
80$:
	PUSH	<R1,R4>			; Save current record
	INC	ERRCNT			; Increment error counter
90$:
	MOV	#SAVBUF,R1		; Output
	MOV	SAVLEN,R4		;  saved
	CALL	PUT			;   record
	POP	<R4,R1>			; Unsave
100$:									;JHA02
	CALL	PUT			; Put record
	BR	50$			; Next
110$:
	TST	PCLR			; Pacsal R ?			;JHA02
	BEQ	130$			;  no => 130$			;JHA02
	BPL	115$			;				;JHA02
	NEG	PCLR			;				;JHA02
115$:
	PUSH	<R1,R4>			; Save current record
	MOV	#SAVBUF,R1		;				;JHA02
	MOV	#SAVBF2,R2		;   Save the old one		;JHA02
	MOV	SAVLEN,R4		;				;JHA02
	MOV	R4,SAVLN2		;				;JHA02
	BEQ	125$			;				;JHA02
120$:									;JHA02
	MOVB	(R1)+,(R2)+		; 				;JHA02
	SOB	R4,120$			;				;JHA02
125$:
	POP	<R4,R1>			; Unsave
130$:									;JHA02
	MOV	R4,SAVLEN		; +
	MOV	R1,R5			; 
	MOV	#SAVBUF,R2		;  Save the record
140$:	MOVB	(R1)+,(R2)+		; 
	SOB	R4,140$			; -
;
	MOV	SAVLEN,R4		;
	MOV	R5,R1			; UNSAVE R1
	TST	PCLM			; Pascal-M ?
	BNE	160$			;  Yes: => 160$
	TST	PCLR			; Pascal-R ?			;JHA02
	BNE	50$			;  Yes: => 50$			;JHA02
;
; Part for Pascal RSX old
;
	MOV	R1,R5			; Save R1
	.IRPC	Q,<PAS >		; SEARCH
		CMPB	#''Q,(R1)+	;   FOR "PAS "
		BNE	150$		; NEXT
	.ENDR				;
	TST	ERRCNT			; Update
	BEQ	190$			;  the
	DEC	ERRCNT			;   error
	BR	190$			;    count
150$:
;
; Part for output of CRL
;
	MOV	R5,R1			; Unsave R1
	.IRPC	Q,<CRL>			; SEARCH
		CMPB	#''Q,(R1)+	;   FOR "CRL "
		BNE	50$		; NEXT
	.ENDR				;
	BR	190$			;
160$:
;
; Part for pascal-M
;
	MOV	R5,R1			; UNSAVE R1
;	CMPB	#' ,(R1) 		;				;JHA01
;	BNE	50$							;JHA01
	CMPB	1(R1),#'0		;
	BLO	50$			;
	CMPB	1(R1),#'9		;
	BHI	50$
	TST	ERRCNT			;				;JHA01
	BEQ	190$			;				;JHA01
170$:									;JHA01
	CALL	GET							;JHA01
	CMPB	#'K,1(R1)		;				;JHA01
	BNE	170$			;				;JHA01
	CALL	PUT			;				;JHA01
	CALL	GET			;				;JHA03
	CALL	PUT			;				;JHA03
180$:
	CALL	GET			;				;JHA01
	CMP	R4,#3			;				;JHA01
	BLO	190$			;				;JHA01
	CALL	PUT			;				;JHA01
	BR	180$			;				;JHA01
190$:
	TST	ERRCNT			;
	BEQ	200$			;
	MOV	#EX$ERR,EXSTA		; Error status
200$:
	MOV	#MSDE,R0		; ASCII buffer
	TST	PCLR			;				;JHA02
	BEQ	210$			;				;JHA02
	MOV	#MSDE1,R0		; ASCII buffer			;JHA02
210$:									;JHA02
	MOV	ERRCNT,R1		; ERRORS
	MOV	#23012,R2		; Parms.
	CALL	$CBTA			;
	TST	PCLR			;				;JHA02
	BEQ	220$			;				;JHA02
	TST	DEFDEV			; Default device ?		;JHA03
	BNE	1$			;  Yes : => 1$			;JHA03
	MOV	#MSGE1,R1		; ADDR. OF MESSAGE		;JHA03
	MOV	#MSLE1,R4		; LENGTH OF MESSAGE		;JHA03
	CALL	PUT			;				;JHA03
1$:
	MOV	#MSGE1,R1		; ADDR. OF MESSAGE		;JHA02
	MOV	#MSLE1,R2		; LENGTH OF MESSAGE		;JHA02
	JMP	ERROR							;JHA02
220$:
	TST	DEFDEV			; Default device ?		;JHA03
	BNE	2$			;  Yes : => 2$			;JHA03
	MOV	#MSGE,R1		; ADDR. OF MESSAGE		;JHA03
	MOV	#MSLE,R4		; LENGTH OF MESSAGE		;JHA03
	CALL	PUT			;				;JHA03
2$:
	MOV	#MSGE,R1		; ADDR. OF MESSAGE
	MOV	#MSLE,R2		; LENGTH OF MESSAGE
	JMP	ERROR		

	.SBTTL	FINISHING
;
END:
;
; USE ERROR ROUTINE TO GIVE THE MESSAGE AND RESTART THE PROGRAM.
;
	MOV	#MSGC,R1		; ADDR. OF MESSAGE
	MOV	#MSLC,R2		; LENGTH OF MESSAGE
	JMP	ERROR		
;
EXIT:	EXST$S	EXSTA			; Exit with status
;

	.SBTTL	SUBROUTINE GET
;
; READ INPUT FILE
;
GET:	MOV	#LINBUF,R1		; R1 = INPUT BUFFER
	CLRB	(R1)			; CLEAR FIRST CHARACTER
	GET$	#LSTFDB			; GET THE RECORD
	BCC	20$			; OK ? YES: => 20$
	JMP	FCSER			; OTHER ERROR
20$:	MOV	RECL,R4			; R4 = RECORD LENGTH
	RETURN				;

	.SBTTL	SUBROUTINE PUT
;
;	WRITE TO OUTPUT FILE
;
PUT:	TST	R4			; WE DON'T PUT EMPTY ONES
	BEQ	10$			;
	PUT$	#EXPFDB,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	
	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$	#EXPFDB			;
	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