.TITLE	ERRORS - ERROR HANDLING FOR TECOIO

	.IDENT	"X0210"

;
; COPYRIGHT (C) 1976 BY DIGITAL EQUIPMENT CORPORATION,
; MAYNARD, MASSACHUSETTS
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
; SINGLE  COMPUTER  SYSTEM AND MAY BE COPIED ONLY WITH THE IN-
; CLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS  SOFTWARE,  OR
; ANY  OTHER  COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE
; MADE AVAILABLE TO ANY OTHER PERSON EXCEPT FOR  USE  ON  SUCH
; SYSTEM  AND TO ONE WHO AGREES TO THESE LICENSE TERMS.  TITLE
; TO AND OWNERSHIP OF THE SOFTWARE SHALL AT ALL  TIMES  REMAIN
; IN DIGITAL.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITH-
; OUT  NOTICE  AND  SHOULD NOT BE CONSTRUED AS A COMMITMENT BY
; DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY  FOR
; THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT WHICH IS
; NOT SUPPLIED BY DIGITAL.
;
; ANDREW C. GOLDSTEIN  27-SEP-77  20:33

.SBTTL	ERROR REPORT ROUTINE

;+
;
; *** ALLERR	ERROR REPORT ROUTINE
;
; THIS ROUTINE IS CALLED WHENEVER TECO IS ABOUT TO REPORT AN ERROR. THE
; ROUTINE UNCONDITIONALLY CLEARS ANY INDIRECT FILE AND FLUSHES ANY TYPE
; AHEAD. IF THE EXIT ON ERROR FLAG IS SET, IT EXITS.
;
; INPUTS:
;
;	R0 = RAD-50 ERROR CODE
;
; OUTPUTS:
;
; ALL REGISTERS PRESERVED
;
;-

	.PSECT	CODE,RO

ALLERR::CLR	CCLFLG		; THROW AWAY CCL COMMAND LINE IF INIT FAILS
				; CLEAN OUT NON-STANDARD ET FLAGS
	BIC	#ET.IMG!ET.NCH!ET.CCO!ET.CKE!ET.CC,ETYPE(R5)
	CALL	INDCL1		; CLOSE THE INDIRECT COMMAND FILE
	BIT	#ET.EXI,ETYPE(R5) ; SEE IF EXIT ON ERROR REQUESTED
	BNE	10$		; BRANCH IF YES
	RETURN			; IF NOT, PRINT MESSAGE AND PROCEED

10$:	CALL	@(SP)+		; USE COROUTINE LINKAGE TO PRINT MESSAGE
	JMP	EXERR		; AND THEN EXIT

.SBTTL	ERROR EXIT ROUTINE

;+
;
; *** - ERRORX	ERROR EXIT
;
; THIS ROUTINE IS CALLED BY THE ERROR MACRO TO RETURN A 3 CHAR
; RADIX-50 ERROR CODE AND A POINTER TO AN ERROR MESSAGE STRING.
;
;	CALL:	JSR	R4,ERRORX
;		<RAD-50 CODE>
;		<ASCIZ ERROR MESSAGE>
;
; THIS ROUTINE RETURNS TO THE CALLING PROGRAM.
;
;-

ERRORX::
	MOV	STACK,SP	; CLEAN OFF THE STACK
	MOV	(R4)+,SR0(SP)	; PUT RAD-50 CODE IN R0 FOR RETURN
	MOV	(R4),SR2(SP)	; GET POINTER TO MESSAGE
	SEC			; INDICATE ERROR
	RETURN

.SBTTL	SYSTEM ERROR RETURN HANDLERS

;
; FILENAME OF MESSAGE FILE TO INTERPRET I/O ERROR CODES
;
FILEN:	.ASCII	"LB:[1,2]QIOSYM.MSG"
FILEL	= .-FILEN

	.EVEN

MSGFIL:	.WORD	FILEL		; STRING DESCRIPTOR OF FILE NAME
	.WORD	FILEN


;+
;
; *** - SYSERR	DIRECTIVE ERROR EXIT
;
; *** - IOSERR	DEVICE HANDLER ERROR EXIT
;
; *** - FDBERR	FCS ERROR EXIT
;
; *** - FDBERR	FCS FILE PROCESSING ERROR EXIT
;
; THESE ROUTINES INTERPRET ERROR CODES FROM ALL SYSTEM ROUTINES.
; IN GENERAL, A STANDARD RAD-50 ERROR CODE IS PRODUCED BY
; CONVERTING THE ERROR NUMBER TO THREE ASCII DIGITS.
; IF TECOIO IS ASSEMBLED TO INCLUDE MESSAGES,
; MO IS CALLED TO OBTAIN THE SYSTEM'S ERROR MESSAGE.
;
; ENTRY IS MADE WITH BRANCH OR JUMP
;
; ALL ROUTINES RETURN TO THE CALLING PROGRAM.
;
;-

	.PSECT	CODE,RO

SYSERR::
	MOV	@#$DSW,R1	; GET ERROR CODE
	SUB	#128.,R1	; CONVERT TO DIRECTIVE ERROR OFFSET
	BR	ERRCOM		; AND RETURN ERROR TO USER

; ENTRY FOR HANDLER ERRORS

IOSERR::
	MOVB	IOSTAT,R1	; PICK UP ERROR CODE
	BR	ERRCOM

; ENTRY FOR FCS ERRORS AND COMMON CODE

FDBERR::
	MOVB	F.ERR(R0),R1	; GET ERROR CODE FROM FDB
	TSTB	F.ERR+1(R0)	; CHECK DIRECTIVE ERROR INDICATOR
	BGE	ERRCOM
	SUB	#128.,R1	; ADJUST ERROR CODE FOR DIRECTIVE

; COMMON I/O ERROR CODE

ERRCOM:	MOV	STACK,SP	; RESTORE THE STACK POINTER
	MOV	R1,R4		; SAVE NEGATIVE ERROR CODE
	NEG	R1		; MAKE ERROR CODE POSITIVE
	MOV	PC,R2		; NON-0 TO PRODUCE LEADING ZEROES
	BIC	#^C177,R1	; REDUCE TO BASIC CODE AGAIN
	CMPB	R1,#-IE.NSF	; SEE IF ERROR WAS NO SUCH FILE
	BNE	10$		; BRANCH IF NO
	MOV	#FNFERR,R1	; YES - USE SPECIAL CODE "FNF"
	BR	20$		; SO TECO CAN RECOGNIZE IT

10$:	MOV	#STRING,R0	; POINT TO STRING BUFFER
	CALL	$CBDMG		; PUT IN DECIMAL ERROR NUMBER
	SUB	#3,R0		; BACK UP 3 CHARACTERS WORTH
	CALL	$CAT5		; CONVERT TO RAD-50
20$:	MOV	R1,SR0(SP)	; STORE IN R0 SAVE FOR RETURN
	MOV	SAVR5,R5	; RECOVER R5
	CMP	EHELP(R5),#1	; CHECK THE HELP LEVEL
	BEQ	NOMO		; DON'T BOTHER TO CALL MO
				; IF HE'S NOT GOING TO USE IT
	MOV	R4,R1		; ERROR CODE TO R1
	MOV	#STRING+4,R0	; ADDRESS TO STORE TEXT IN R0
	CALL	.FCSER		; TRANSLATE ERROR CODE TO MESSAGE
	MOV	#STRING+4,R0	; GET ADDRESS OF STRING
	MOV	R0,SR2(SP)	; RETURN ADDRESS OF MESSAGE

30$:	INC	R0		; BUMP TO NEXT CHARACTER (SKIPPING FIRST)
	MOVB	(R0),R1		; PICK UP THE CHARACTER
	BEQ	ERRX		; ZERO IS END
	CMPB	R1,#'A		; CHECK FOR UPPER CASE ALPHABETIC
	BLO	30$		; BRANCH IF NOT
	CMPB	R1,#'Z
	BHI	30$		; ALSO NOT
	BISB	#40,(R0)	; MAKE ALPHAS LOWER CASE
	BR	30$

NOMO:	CLR	SR2(SP)		; RETURN NO STRING ADDRESS
ERRX:	SEC			; INDICATE ERROR
	RETURN



	.END