.NLIST	TOC,SYM
.TITLE	$ERROR
.SBTTL	ULBLIB 013	- Error message processing
.IDENT	\V01.02\
.ENABL	LC,GBL

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion 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 Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
; "You've got to know when to hold them,
;  Know when to fold them,
;  Know when to walk away,
;  Know when to run."
;	- Kenny Rogers, "The Gambler"
;
; MODIFIED BY:
;
;	Jim Williams	22-April-1982	added ASCII output option
;

;+
; $ERROR
; The Error Processor will print an RT-11 standard error message on the
; console terminal.  It will either print a system error message, or a
; message provided by the user.
;
;		+------+------+
;	R0 ->	| flag | code |
;		+------+------+
;		|-> message   |
;		|    prefix   |
;		+-------------+
;		|-> level byte|
;		+-------------+
;		|-> user error|	0 means use system table
;		|   messages  |
;		+-------------+
;		|-> RAD50     |	0 means no "variable" part to print
;		|   dev:filnam|
;		+-------------+
;		|->  abort    |
;		+-------------+
;
;
;		+-+-+-+-+-+-+-+-+
;	Flag:	|R|L|A|L L L L L|
;		+-+-+-+-+-+-+-+-+
;
;		R = 0	Abort exit
;		R = 1	RETURN exit
;
;		A = 0	10(R0) is RAD50 dev:filnam.typ
;		A = 1	10(R0) is ASCII "string"<200>
;
;		xLxLLLLL Error level letter (W E F U)
;		the "x" parts are forced 0 before use as letter
;
;	CALL	$ERROR
;
;-

.MCALL	.PRINT,	.RCTRLO

; Set up dummy error message list

MSGLST	DUMMY

ERRMSG	UNK	<Unknown error code>

MSGEND

USERRB	= 53			;User error byte
 SUCCS$	=  1			 ;Success
 WARN$	=  2			 ;Warning
 ERROR$	=  4			 ;Error
 FATAL$	= 10			 ;Fatal
 UNCON$	= 20			 ;Unconditional

.PSECT	.LIBD.

MSGTBL:	.BYTE	'W,WARN$	;Warning
	.BYTE	'E,ERROR$	;Error
	.BYTE	'F,FATAL$	;Fatal
	.BYTE	'U,UNCON$	;Unconditional abort
CRLF:	.BYTE	0,0		;End of table

.EVEN

SY$ERR::.WORD	DUMMY		;Pointer to error message pointer table

.PSECT	.LIBC.

$ERROR::
	CALL	$SAVAL		;Save all registers
	CALL	.INSER		;Install the system messages (maybe)
	MOV	R0,R2		;Copy pointer to block
	MOVB	(R0)+,R3	;Get the error message code
	BPL	10$		;Branch if it's one of his
	NEG	R3		;Make it positive
	BR	20$		;use our error messages

10$:	MOV	6(R2),R1	;Copy pointer to user's error messages
	BNE	30$		;Branch if there is one
20$:	MOV	SY$ERR,R1	;Point to our error messages
30$:	CMP	R3,(R1)+	;Error code in range?
	BLO	40$		;Branch if so
	CLR	R3		;Make it the unknown error
	CLR	10(R2)		;Clear the filename
	BR	20$		;Use our error messages

40$:	ASL	R3		;Make it a word index
	ADD	R3,R1		;Point to the address of the error message
	MOVB	(R0)+,R3	;Get the flag/level byte
	MOV	(R0)+,R5	;Copy pointer to the prefix
	BIC	#^C137,R3	;Clear out all but letter bits (uppercase it)
	MOVB	R3,@(R0)	;Put it in the error message
	.RCTRLO			;Reset CTRL/O
	.PRINT	R5		;Print the prefix
	.PRINT	@R1		; followed by the error message
	MOV	10(R2),R0	;Is there a variable to print?
	BEQ	60$		;Branch if not
	SUB	#20,SP		;We'll store the ASCII file name on the stack
	BIT	#40*400,@R2	;is it RAD50 or ASCII?
	BNE	50$		; ASCII
	MOV	SP,R1		;Copy pointer
	CALL	$FNASC		;Convert the file name to ASCII
	MOVB	#200,(R1)+	;No <CR><LF> following
	MOV	SP,R0		;Point at the string
50$:	.PRINT			; and print it
	ADD	#20,SP		;Restore the stack
60$:	.PRINT	#CRLF		;Print a carriage return/line feed
	MOV	#MSGTBL,R0	;R0 -> message level, error byte table
70$:	TSTB	@R0		;Are we done?
	BEQ	80$		;Branch if so.  Don't set anything
	CMPB	R3,(R0)+	;Is this the level?
	BNE	70$		;Branch if not
80$:	BISB	@R0,@#USERRB	;Set the bit
	TST	@R2		;Should we return to the caller?
	BPL	90$		;Branch if not
	RETURN

90$:	JMP	@12(R2)		;Go to his abort entry

.PSECT	.LIBO.,I,OVR

.INSER:	MOV	#DUMMY,SY$ERR	;Set up the error message pointer
	RETURN

.END