.TITLE	ERDIR - Directive Errors
	.IDENT	/V01.00/
	.ENABL	LC
;+
; This module processes directive errors by outputing the directive error
; code ($DSW) and matching message from LB:[1,2]QIOSYM.MSG.
;
;	(taskname) -- [Exiting due to] Directive error ($dsw)
;	(directive error message from qiosym)
;	at PC (pc)
;
; Call with:	JSR PC,ERDIRX	(or ERDIRR)
; 		$DSW = Directive error code.
;
; Exit with:	ERDIRR -> Message output and return to caller (PSW/CS).
;		ERDIRX -> Message output and task exit (with error status).
;-
	.PSECT	ERR$TX,RO,D

DIRERR:	.ASCIZ	/Directive/

	.PSECT	ERR$CD,RO,I

ERDIRX::INC	(SP)		;Set to exit
ERDIR::	JSR	PC,$SAVAL	;Save all registers
	MOV	$DSW,R2		;Get the error number
	MOV	R2,-(SP)	;Save for later recall
	NEG	R2		;Convert to positive number
	ADD	#128.,R2	;Directive errors start at 129
	CALL	ERTXT		;Get the error message from QIOSYM
	MOV	(SP)+,R0	;Get error number
	MOV	#DIRERR,R1	;Get the error type message
	MOV	16(SP),R3	;Get the error PC
	CLR	R5		;Set no optional line
	CALLR	ERMSG		;Go processor the error and return

	.END
	.TITLE	ERFCS - FCS Errors
	.IDENT	/V01.00/
	.ENABL	LC
;
; This module process FCS errors by outputing a message which includes
; the FCS error code and the matching message from LB:[1,2]QIOSYM.MSG.
;
;	(taskname) -- [Exiting due to] FCS error (f.err)
;	(fcs error message from qiosym)
;	Lun: (lun number) Device: (device name) File: (filename)
;	at PC (pc)
;
; Call with:	JSR PC,ERFCSX	(or ERFCSR)
;		R0 = FDB address.
;
; Exit with:	ERFCSR -> Message output and return to caller (PSW/CS).
;		ERFCSX -> Message output and task exit (with error status).
;-
	.MCALL	GLUN$S

	.PSECT	ERR$TX,RO,D

FCSERR:	.ASCIZ	/FCS/
FCSLUN:	.ASCIZ	/Lun: /
FCSDEV:	.ASCIZ	/ Device: /
FCSFIL:	.ASCIZ	/ File: /

	.PSECT	ERR$CD,RO,I

ERFCSX::INC	(SP)		;Set to exit
ERFCS::	JSR	PC,$SAVAL	;Save all registers
	MOV	R0,R4		;Save FDB address
	MOVB	F.ERR+0(R4),R2	;Get error number
	NEG	R2		; as a positive number
	TSTB	F.ERR+1(R4)	;Is this I/O or directive error
	BEQ	1000$		; if EQ - I/O error
	ADD	#128.,R2	;Directive errors start at 129
1000$:	CALL	ERTXT		;Get the error message from QIOSYM
	MOVB	F.ERR+0(R4),R0	;Get error number
	MOV	#FCSERR,R1	;Get the error type message
	MOV	16(SP),R3	;Get the error PC
	MOV	#FCSLIN,R5	;Set the FCS optional line processor
	CALLR	ERMSG		;Go processor the error and return

;+
; This routine formats the optional line in a FCS error message to:
; 	Lun: (lun number) Device: (device name) File: (filename)
;-

FCSLIN:	MOV	#FCSLUN,R1	;Get lun message
	CALL	ERMOV		;Place in buffer
	MOVB	F.LUN(R4),R1	;Get lun number
	BIC	#177400,R1	;Only want low byte
	CLR	R2		;Set for no leading zeros
	CALL	$CBDMG		;Convert to ASCII decimal

	MOV	#FCSDEV,R1	;Get device message
	CALL	ERMOV		;Place in buffer
	MOVB	F.LUN(R4),R1	;Get the lun number
	BIC	#177400,R1	;Only want low byte
	MOV	#ERRTMP,R2	;Get the temp buffer
	GLUN$S	R1,R2		;Get the device information
	BCS	1000$		; if CS - skip on error
	MOVB	(R2)+,(R0)+	;Store device name
	MOVB	(R2)+,(R0)+	;
	MOVB	(R2),R1		;Get the unit number
	BIC	#177400,R1	;Only want low byte
	CLR	R2		;Set for no leading zeros
	CALL	$CBOMG		;Convert to ASCII octal
	MOVB	#':,(R0)+	;Store closing colon

1000$:	MOV	#FCSFIL,R1	;Get file message
	CALL	ERMOV		;Place in buffer
	ADD	#F.FNB+N.FNAM,R4;Position R4 at filename
	MOV	(R4)+,R1	;Get filename in RAD50
	CALL	$C5TA		;Convert to ASCII
	MOV	(R4)+,R1	;Get filename in RAD50
	CALL	$C5TA		;Convert to ASCII
	MOV	(R4)+,R1	;Get filename in RAD50
	CALL	$C5TA		;Convert to ASCII
	MOVB	#'.,(R0)+	;Put in extension seperator
	MOV	(R4)+,R1	;Get extension
	CALLR	$C5TA		;Convert to ASCII and return

	.END
	.TITLE	ERFTN - Fortran Interface
	.IDENT	/V01.00/
	.ENABL	LC
;+
; This module provides a Fortran interface for directive and QIO errors.
; We assume Fortran does a good enough job on FCS errors. The routines
; check for errors and call the fatal version if an error detected.
;
; Call with:	CALL ERDIRF([err1,err2,...errn])
;		CALL ERQIOF(ios,lun[,err1,err2,...errn])
;
;		errn = expected error code (any number allowed)
;		ios  = QIO I/O status
;		lun  = QIO logical unit
;
; Exit with:	Returns immediately if no error or match with expected
;		errir list. Otherwise, outputs message and exits task.
;-
	.PSECT	ERR$CD,RO,I

ERDIRF::MOV	$DSW,R1		;Was there an error
	BPL	9999$		; If PL - no, return
	MOV	(R5)+,R0	;Get number of arguments
	BEQ	2000$		; If EQ - all done

1000$:	CMP	@(R5)+,R1	;Is this a match
	BEQ	9999$		; If EQ - yes, return
	DEC	R0		;Count the argment
	BNE	1000$		; If NE - loop again
2000$:	CALLR	ERDIRX		;Output error and exit

9999$:	RETURN			;Return to caller


ERQIOF::TSTB	@2(R5)		;Was there an error
	BPL	9999$		; If PL - no, return

	MOV	(R5)+,R0	;Get number of arguments
	MOV	@(R5)+,R1	;Get the error code
	MOV	@(R5)+,R2	;Get the logical unit
	SUB	#2,R0		;Subtract required arguments
	BLE	2000$		; If LE - all done

1000$:	CMPB	@(R5)+,R1	;Is this a match
	BEQ	9999$		; If EQ - yes, return
	DEC	R0		;Count the argment
	BNE	1000$		; If NE - loop again
2000$:	MOV	R1,-(SP)	;Store error code
	MOV	R2,-(SP)	;Store logical unit
	CALLR	ERQIOX		;Output error and exit

9999$:	RETURN			;Return to caller

	.END
	.TITLE	ERLUN - Define Luns
	.IDENT	/V01.00/
;
; Declare  special lun definitions. This module must be loaded
; in the task root.
;
	.PSECT	ERR$LU,RO,D,GBL

.USLU1::			;Declare user special lun #1
ERLUN1::.WORD	0		;Use for message output
.USLU2::			;Declare user special lun #2
ERLUN2::.WORD	0		;Use for QIOSYM file I/O

	.END
	.TITLE	ERMSG - Error Processing
	.IDENT	/V01.00/
	.ENABL	LC
;+
; This routine formats and outputs error messages.
;
; Call with:	JSR PC,ERMSG
;
;		R0 = Error number  (0 if none).
;		R1 = Error type    (0 if none).
;		R2 = Error message (0 if none).
;		R3 = Error PC      (0 if none)(odd if exiting).
;		R4 = Parameter to supply to optional line routine.
;		R5 = Address of optional line routine (0 if none).
;
;		R1 and R2 are pointer to ASCIZ strings.
;
; Exit with:	Message output, task exits if PC is odd.
;-

	.MCALL	EXST$S,EXIT$S,GTSK$S,ALUN$S,QIOW$,DIR$

CR	= 15			;CARRIAGE RETURN.
LF	= 12			;LINE FEED.

	.PSECT	ERR$TX,RO,D

DSHMSG:	.ASCIZ	/ -- /
XITMSG:	.ASCIZ	/Exiting due to /
ERRMSG:	.ASCIZ	/error /
APCMSG:	.ASCIZ	/at PC /

	.PSECT	ERR$RW,RW,D

BUFFER:	.BLKB	<64.*4>+4		;Output message buffer
ERRTMP::.BLKW	18.			;Temporary buffer

MSGDPB:	QIOW$	IO.WVB,,24.,,,,<BUFFER,,0>

	.PSECT	ERR$CD,RO,I

ERMSG::	MOV	R2,-(SP)	;Save the error message
	MOV	R0,-(SP)	;Save the error number
	MOV	R1,-(SP)	;Save the error type
;
; Format the first line.
;	(taskname) -- [Exiting due to] [(error type)] ERROR [(error number)]
;
	MOV	#BUFFER,R0	;Get start of buffer
	MOVB	#CR,(R0)+	;Insert blank line
	MOVB	#LF,(R0)+	; ..
	MOVB	#LF,(R0)+	;Insert blank line
	GTSK$S	#ERRTMP		;Get the taskname
	MOV	ERRTMP+0,R1	;Get the first part of the task name
	CALL	$C5TA		;Convert to ASCII
	MOV	ERRTMP+2,R1	;Get the last  part of the task name
	CALL	$C5TA		;Convert to ASCII
	MOV	#DSHMSG,R1	;Get dashes
	CALL	ERMOV		;Move to buffer
	BIT	#1,R3		;Is this message an exit?
	BEQ	1000$		; if EQ - I think not
	MOV	#XITMSG,R1	;Say we are exiting
	CALL	ERMOV		;Move to buffer
1000$:	MOV	(SP)+,R1	;Get the error type
	BEQ	1100$		; if EQ - there is none
	CALL	ERMOV		;Move to buffer
	MOVB	#' ,(R0)+	;Place a space into buffer
1100$:	MOV	#ERRMSG,R1	;Get the word error
	CALL	ERMOV		;Move to buffer
	MOV	(SP)+,R1	;Get the error number
	BEQ	1200$		; if EQ - no error number to output
	CLR	R2		;No leading zeros
	CALL	$CBDSG		;Convert to signed decimal ascii
1200$:	MOVB	#CR,(R0)+	;Done with first line
	MOVB	#LF,(R0)+	; ...
;
; Format the second line.
;	[(error message)]
;
	MOV	(SP)+,R1	;Get message address
	BEQ	1300$		; if EQ - none
	CALL	ERMOV		;Move to buffer
	MOVB	#CR,(R0)+	;Done with second line
	MOVB	#LF,(R0)+	; ..
;
; Format the third line.
;	[(optional error line)]
;
1300$:	TST	R5		;Is there a routine
	BEQ	1400$		; if EQ - none
	CALL	(R5)		;Call said routine
	MOVB	#CR,(R0)+	;Done with third line
	MOVB	#LF,(R0)+	; ...
;
; Format the fourth line.
;	[at PC (pc)]
;
1400$:	BIT	#177776,R3	;Is there a PC?
	BEQ	1500$		; if EQ - no
	MOV	#APCMSG,R1	;Get at PC message
	CALL	ERMOV		;Move to buffer
	MOV	R3,R1		;Get PC
	BIC	#1,R1		;Make sure even
	MOV	#1,R2		;Set for leading zeros
	CALL	$CBOMG		;Convert to octal magnitude
	MOVB	#CR,(R0)+	;Done with fourth line
	MOVB	#LF,(R0)+	; ...
;
; Output the resulting message.
;
1500$:	MOVB	#LF,(R0)+		;Skip line
	SUB	#BUFFER,R0		;Get number of characters in message
	MOV	R0,MSGDPB+Q.IOPL+2	;Store in QIO DPB
	MOV	ERLUN1,R0		;Get the logical unit
	ALUN$S	R0,#"TI,#0		;Assign to user terminal
	MOV	R0,MSGDPB+Q.IOLU	;Store lun number
	DIR$	#MSGDPB			;Issue QIO

	BIT	#1,R3			;Should we exit
	BEQ	9999$			; if EQ - no, return to caller
	EXST$S	#EX$SEV			;Exit with severe error
	EXIT$S				;Exit if exit status fails

9999$:	SEC				;Set error return
	RETURN				;Return to caller

;+
; Move ASCIZ string to buffer and update buffer pointer.
;-
ERMOV::	MOVB	(R1)+,(R0)+	;Move character
	BNE	ERMOV		; if NE - continue moving
	DEC	R0		;Back up buffer pointer
	RETURN			;Return to caller

	.END
	.TITLE	ERPRG - Program Errors
	.IDENT	/V01.00/
	.ENABL	LC
;+
; This module processes program errors by outputing the supplied message.
;
;	(taskname) -- [Exiting due to] Program error
;	(error message)
;
; Call with:	MOV #ERR,-(SP)
;		JSR PC,ERPRGX	(or ERPRGR)
;
; 		ERR = error message address.
;
; Exit with:	ERPRGR -> Message output and return to caller (PSW/CS).
;		ERPRGX -> Message output and task exit (with error status).
;-
	.PSECT	ERR$TX,RO,D

PRGERR:	.ASCIZ	/Program/

	.PSECT	ERR$CD,RO,I

ERPRGX::INC	(SP)		;Set to exit
ERPRG::	MOV	#9999$,-(SP)	;Set return address
	JSR	PC,$SAVAL	;Save all registers
	CLR	R0		;Set no error number
	MOV	#PRGERR,R1	;Get the error type message
	MOV	22(SP),R2	;Get the message address
	MOV	20(SP),R3	;Get the error PC
	BIC	#177776,R3	;Only want the exiting bit
	CLR	R5		;Set there is no optional line
	CALLR	ERMSG		;Go processor the error and exit
;
; Come here after message is output and pop the user supplied argument.
;
9999$:	MOV	(SP),2(SP)	;Set return address
	TST	(SP)+		;Clean stack
	SEC			;Set error
	RETURN			;Return to caller

	.END
	.TITLE	ERQIO - QIO Errors
	.IDENT	/V01.00/
	.ENABL	LC
;+
; This module processes QIO errors by outputing the QIO status code value,
; the matching message from LB:[1,2]QIOSYM.MSG,  and an optional line with
; the logical unit number and device name.
;
;	(taskname) -- [Exiting due to] QIO error (i/o error number)
;	(i/o error message from qiosym)
;	Lun: (lun number) Device: (device name lun assigned to)
;	at PC (pc)
;
; Call with:	MOV	ERR,-(SP)
;		MOV	LUN,-(SP)
;		JSR	PC,ERQIOX (or ERQIOR)
;
; 		ERR = I/O error code.
;		LUN = Logical unit number.
;
; Exit with:	ERQIOR -> Message output and return to caller (PSW/CS).
;		ERQIOX -> Message output and task exit (with error status).
;-
	.MCALL	GLUN$S

	.PSECT	ERR$TX,RO,D

QIOERR:	.ASCIZ	/QIO/
QIOLUN:	.ASCIZ	/Lun: /
QIODEV:	.ASCIZ	/ Device: /

	.PSECT	ERR$CD,RO,I

ERQIOX::INC	(SP)		;Set to exit
ERQIO::	MOV	#9999$,-(SP)	;Set return address
	JSR	PC,$SAVAL	;Save all registers
	MOVB	22(SP),R2	;Get error number
	NEG	R2		;
	CALL	ERTXT		;Get the error message from QIOSYM
	MOVB	22(SP),R0	;Get error number
	MOV	#QIOERR,R1	;Get the error type message
	MOV	20(SP),R3	;Get the PC
	MOV	24(SP),R4	;Get the lun number
	MOV	#QIOLIN,R5	;Set the QIO optional line processor
	CALLR	ERMSG		;Go processor the error and return
;
; Clean up on return.
;
9999$:	MOV	(SP),4(SP)	;Set return addres
	ADD	#4,SP		;Clean stack
	SEC			;Set error
	RETURN			;Return to caller

;+
; This routine formats the optional line in a QIO error message. It
; outputs the logical unit and device name.
;-

QIOLIN: MOV	#QIOLUN,R1	;Get lun message
	CALL	ERMOV		;Place in buffer
	MOV	R4,R1		;Get lun number
	CLR	R2		;Set for no leading zeros
	CALL	$CBDMG		;Convert to ascii decimal
	MOV	#QIODEV,R1	;Get device message
	CALL	ERMOV		;Place in buffer
	MOV	#ERRTMP,R2	;Get a buffer
	GLUN$S	R4,R2		;Get the device information
	BCS	9999$		; if CS - skip on error
	MOVB	(R2)+,(R0)+	;Store device name
	MOVB	(R2)+,(R0)+	;
	MOVB	(R2),R1		;Get the unit number
	BIC	#177400,R1	;Only want low byte
	CLR	R2		;Set for no leading zeros
	CALL	$CBOMG		;Convert to ASCII octal
	MOVB	#':,(R0)+	;Store closing colon
9999$:	RETURN			;

	.END
	.TITLE	ERTXT - Get Error Message From QIOSYM
	.IDENT	/V01.00/
	.ENABL	LC
;+
; This routine gets a message from QIOSYM and returns a pointer to it
; to the caller. The routine uses Files-11 QIO's to avoid FCS/RMS over-
; head. QIOSYM.MSG is a file with 64. character fixed length records. the
; caller supplies the record number he desires (starting with 1).
;
; Call with:	JSR PC,ERTEXT
;		R2 = Message number in QIOSYM.
;
; Exit with:	R2 = Message address or 0 if not found.
;-
	.MCALL	NMBLK$,ALUN$S,QIOW$,DIR$

	.PSECT	ERR$RW,RW,D

QIONMB:	NMBLK$	QIOSYM,MSG,,LB,0	;File name block
DIRNMB:	NMBLK$	001002,DIR,,LB,0	;Directory name block
.	= DIRNMB+N.DID
	.WORD	-1,-1			;Set directory access
.	= DIRNMB+S.FNB

GETDIR:	QIOW$	IO.FNA,,24.,,IOSTAT,,<0,0,0,0,0,DIRNMB>
GETFIL:	QIOW$	IO.FNA,,24.,,IOSTAT,,<0,0,0,0,0,QIONMB>
ACCESS:	QIOW$	IO.ACR,,24.,,IOSTAT,,<QIONMB,0,0,0,100000,0>
READBK:	QIOW$	IO.RVB,,24.,,IOSTAT,,<BUFFER,512.,0,0,0,0>
DEAESS:	QIOW$	IO.DAC,,24.,,IOSTAT,,<QIONMB,0,0,0,0,0>

BUFFER:	.BLKB	512.			;Disk block input buffer
IOSTAT:	.BLKW	2			;I/O status buffer

	.PSECT	ERR$CD,RO,I

ERTXT::	MOV	R2,-(SP)	;Save the record number
	TST	QIONMB+N.FID	;Have we been here before?
	BNE	2000$		; if NE - yes, skip setup

	MOV	ERLUN2,R0	;Get lun to use
	ALUN$S	R0,#"LB,#0	;Assign to LB0:
	BCS	9998$		; if CS - assignment error

	MOV	#GETDIR,R1	;Get the first QIO
	MOV	#5,R2		;We know there are 5 QIO's
1000$:	MOV	R0,Q.IOLU(R1)	;Store lun number
	ADD	#Q.IOPL+12.,R1	;Advance to the next QIO
	DEC	R2		;Count till we are done
	BNE	1000$		; if ne - not done

	CALL	QIOW		;Lookup directory file
	.WORD	GETDIR		;
	BCS	9998$		; if CS - error
	MOV	#DIRNMB,R1	;Get address of directory nameblock
	MOV	#QIONMB+N.DID,R0;Get address of file name block directory id
	MOV	(R1)+,(R0)+	;Move directory id
	MOV	(R1)+,(R0)+	;
	MOV	(R1)+,(R0)+	;
	CALL	QIOW		;Lookup file
	.WORD	GETFIL		;
	BCS	9998$		; if CS - error

2000$:	CALL	QIOW		;Access file
	.WORD	ACCESS		;
	BCS	9998$		; if CS - error
	DEC	(SP)		;Correct record number to 0 base
	MOV	(SP),R2		;Save record number
	ASR	R2		;Get block number to read
	ASR	R2		;
	ASR	R2		;
	INC	R2		;Vbn start at 1
	MOV	R2,READBK+Q.IOPL+8. ;Store in dpb
	CALL	QIOW		;Read block
	.WORD	READBK		;
	ROR	R0		;Save carry for later check
	CALL	QIOW		;Deaccess file
	.WORD	DEAESS		;
	BCS	9998$		; if CS - error
	ROL	R0		;Unsave carry from read
	BCS	9998$		; if CS - error

	MOV	(SP),R2		;Get the record number again
	BIC	#177770,R2	;Get record inside block
	SWAB	R2		;This way there are less shifts
	ASR	R2		;
	ASR	R2		;
	ADD	#BUFFER,R2	;Make into real pointer
	TSTB	(R2)		;If first byte is null, no message
	BNE	9999$		; if NE - good message

9998$:	CLR	R2		;Set to no message
9999$:	TST	(SP)+		;Clean stack
	RETURN			;Return to caller

;+
; This routine issues QIO'S for ERTXT and checks for errors on return.
;-

QIOW:	MOV	@(SP),R0	;Get DPB address
	ADD	#2,(SP)		;Return to caller+2
	DIR$	R0		;Issue QIO
	BCS	9999$		; if cs - exit
	TSTB	IOSTAT		;Where we a success?
	BGT	9999$		; if GT - yes
	SEC			;Set error flag
9999$:	RETURN			;Return to caller

	.END