.TITLE  ERROR -- ERROR MESSAGE PROCESSOR
        .SBTTL  MAIN ROUTINE
	.IDENT	/1/
	.MCALL	OPEN$,GET$,PUT$,CLOSE$,MRKT$S,ALUN$S,QIO$S,WTSE$S
	.MCALL	STRMACS,IF,END,WHILE,IFB,OR,ELSE,AND
	STRMACS
	.MCALL	ERR$
	ERR$
;
;	ERR$P
;
;	ROUTINE TO PRINT AN ERROR MESSAGE.
;
;	CALLED WITH THE ADDRESS OF AN ERROR BLOCK IN R0.
;
ERR$P::
	CALL  $SAVAL			;SAVE ALL REGISTERS
	MOV  R0,R5			;GET ERROR BLOCK POINTER WHERE WE NEED
					;IT
	MOVB  #ES.SUC,E.ERR(R5) 	;INDICATE EVERYTHING OK SO FAR
	MOV  E.SUBL(R5),R4		;GET ADDRESS OF SUBSTITUTION LIST
	MOV  E.BUF(R5),R0		;GET ADDRESS OF OUTPUT BUFFER
	MOV  R0,-(SP)			;SET UP A FENCE TO KEEP
	ADD  #E.BUFS,(SP)		;BUFFER FROM OVERFLOWING
	CALL  SUBS			;PERFORM SUBSTITUTION
	IF  ,CS 			;IF ERROR
	  TST  (SP)+			;JUNK FENCE
ER1:
	  SEC				;SET ERROR FLAG
RT1:
	  RETURN			;AND RETURN
	END
	IF  E.RECN(R5),NE		;IF RECORD NUMBER SPECIFIED
	  CALL	GETREC			;GET IT
	  IF  ,CS			;ERROR
	    MOVB  #EE.GET,E.ERR(R5)	;SET ERROR CODE
	    TST  (SP)+			;JUNK FENCE
	    CALL  DUMPLN		;OUTPUT AS MUCH OF THE MESSAGE AS WE
					;COULD
	    BR	ER1			;EXIT
	  END
	END
	CALL  SUBS			;DO SUBSTITUTUION
	IF  ,CS 			;IF ERROR
	  TST  (SP)+			;JUNK FENCE
	  BR  ER1			;ERROR EXIT
	END
	TST  (SP)+			;JUNK FENCE
	CALL  DUMPLN			;DUMP THE LINE
	IF  ,CS 			;IF ERROR
	  BR  ER1			;ERROR EXIT
	END
	BR  RT1 			;RETURN
	.PAGE
        .SBTTL  DUMP OUTPUT LINE
;
;	DUMPLN
;
;	ROUTINE TO OUTPUT A LINE THROUGH THE OUTPUT FDB
;
DUMPLN:
	MOV  R0,R1			;NOTE HOW FAR WE GOT
	SUB  E.BUF(R5),R1		;CALCULATE BYTE COUNT
	MOV  E.FDB(R5),R0		;SEE IF OUTPUT FDB IS OPEN
	IF  F.BDB(R0),EQ		;?
	  OPEN$ 			;NO, OPEN IT
	  IF  ,CS			;IF ERROR
	    MOVB  #EE.OPN,E.ERR(R5)	;SHOW ERROR CODE
ER2:
	    SEC 			;SHOW CALLER THERE'S AN ERROR
RT2:
	    RETURN			;AND RETURN
	  END
	END
	PUT$  E.FDB(R5),E.BUF(R5),R1	;OUTPUT MESSAGE
	IF  ,CS
	  MOVB	#EE.PUT,E.ERR(R5)	;ERROR CODE
	  IFB  #EM.OCL,SETON,E.MODE(R5) ;IF WE SHOULD CLOSE FDB
	    CLOSE$			;CLOSE IT
	  END
	  BR  ER2			;AND EXIT
	END
	MOV  E.BUF(R5),R0		;POINT TO START OF BUFFER
	IFB  #EM.OCL,SETON,E.MODE(R5)	;IF WE ARE TO CLOSE THE FILE
	  CLOSE$  E.FDB(R5)		;CLOSE IT
	  IF  ,CS
	    BR	ER2
	  END
	END
	CLC				;SHOW ALL OK
	BR  RT2 			;RETURN
	.PAGE
        .SBTTL  PERFORM SUBSTITUTIONS
;
;	ROUTINE TO PERFORM SUBSTITUTIONS ON ONE PIECE OF TEXT
;	OF E.STRL BYTES STARTING AT E.STR. OUTPUT GOES INTO BUFFER POINTED
;	TO BY R0. R4 IS THE POINTER TO THE SUBSTITUTION LIST AND THE
;	AND THE OUTPUT BUFFER FENCE IS 2(SP)
;
SUBS:
	WHILE  E.STRL(R5),GT		;LOOP UNTIL ALL OF INPUT STRING IS GONE
	  IFB  @E.STR(R5),EQ,#'%	;IF SUBTITUTING
	    MOV  (R4)+,R1		;GET FUNTION CODE
	    IF	,LT			;IF TOO SMALL
	    OR	R1,GT,#TABEND-TABLE	;OR TOO BIG
	      MOVB  #EE.SUB,E.ERR(R5)	;YES, ERROR CODE
ER3:
	      SEC			;SHOW ERROR
RT3:
	      RETURN			;AND RETURN
	    END
	    ADD  PC,R1			;POSITION INDEPENDENT CODE TO ACCESS
	    ADD  #TABLE-.,R1		;JUMP TABLE
	    CALL  @R1			;AND CALL APPROPRIATE SUBROUTINE
	  ELSE
	    MOVB  @E.STR(R5),(R0)+	;MOVE A CHAR IN
	  END
	  INC  E.STR(R5)		;POINT TO NEXT CHARACTER
	  DEC  E.STRL(R5)		;AND COUNT DOWN
	  IF  R0,GT,2(SP)		;IF WE'VE OVERFLOWED THE BUFFER
	    CALL  DUMPLN		;DUMP THE LINE
	    IF	,CS
	      BR  ER3
	    END
	  END
	END
	CLC				;SHOW ALL OK
	BR  RT3 			;RETURN
	.PAGE
        .SBTTL  GET ERROR MESSAGE FROM A FILE
;
;	ROUTINE TO GET A RECORD FROM AN ERROR MESSAGE FILE
;
GETREC:
	MOV  R0,-(SP)			;SAVE OUTPUT BUFFER POINTER
	IF  E.FFDB(R5),EQ		;IF NO ERROR MESSAGE FDB
	  MOVB	#EE.NDB,E.ERR(R5)	;ERROR CODE
ER4:
	  MOV  (SP)+,R0 		;RE-GAIN OUTPUT BUFFER POINTER
	  MOV  E.RECN(R5),R1		;GET RECORD NUMBER
	  CLR  R2			;SUPPRESS ZEROS
	  CALL	$CBDSG			;AND CONVERT TO DECIMAL
	  SEC				;SET ERROR FLAG
RT4:
	  RETURN			;AND RETURN
	END
	MOV  E.FFDB(R5),R0		;GET FDB ADDRESS
	IF  F.BDB(R0),EQ		;IF FILE NOT OPEN
10$:
	  OPEN$ 			;OPEN IT
	  IF  ,CS			;IF ERROR
	    IFB  F.ERR(R0),EQ,#IE.LCK	;IF FILE ALREADY OPEN FOR OPEN
	      MRKT$S  #32.,#1,#2	;WAIT FOR A SECOND
	      WTSE$S  #32.		;AND THEN
	      BR  10$			;TRY AGAIN
	    END
	    MOVB  #EE.OPN,E.ERR(R5)	;ERROR CODE
	    BR	ER4			;TAKE ERROR RETURN
	  END
	END
	MOV  E.RECN(R5),F.RCNM+2(R0)	;POINT TO SPECIFIED
	GET$				;GET THE RECORD
	IF  ,CS 			;IF ERROR
	  MOVB	#EE.FCL,E.ERR(R5)	;SET ERROR CODE
	  IFB  #EM.FCL,SETON,E.MODE(R5) ;IF FDB SHOULD BE CLOSED
	    CLOSE$			;CLOSE IT
	  END
	  BR  ER4			;AND GO TO EXIT
	END
	MOV  F.NRBD+2(R0),R1		;GET BUFFER ADDRESS
	MOV  F.NRBD(R0),R2		;AND SIZE
	WHILE  ,GT			;LOOK FOR 0 BYTE
	  TSTB	(R1)+			;THERE?
	  BEQ  EL			;YES
	  DEC  R2			;DECREMENT BYTE COUNT
	END
EL:
	SUB  F.NRBD+2(R0),R1		;BYTE COUNT TO 0 BYTE
	MOV  R1,E.STRL(R5)		;PUT IN ERROR CONTROL BLOCK
	MOV  F.NRBD+2(R0),E.STR(R5)	;NOTE BUFFER ADDRESS
	IFB  #EM.FCL,SETON,E.MODE(R5)	;IF WE SHOULD CLOSE FDB
	  CLOSE$			;CLOSE IT
	  IF  ,CS			;IF ERROR
	    MOVB  #EE.FCL,E.ERR(R5)	;ERROR CODE
	    BR	ER4			;AND RETURN
	  END
	END
	MOV  (SP)+,R0			;RESTORE OUTPUT BUFFER ADDRESS
	CLC				;SHOW ALL OK
	BR  RT4 			;AND RETURN
	.PAGE
        .SBTTL  CONVERSION ROUTINE TABLE
;
;	TABLE WITH ADDRESES OF CONVERSION ROUTINES
;
TABLE:
	BR  END
	BR  DECIMAL
	BR  OCTAL
	BR  ASCII
	BR  RAD50
	BR  SPECIAL
	BR  $FNB
TABEND:
 
;	ROUTINE TO STOP SKIPPING PAST END OF SUBSTITUTION LIST
;
END:
	TST  -(R4)			;BACK UP POINTER
	RETURN				;AND RETURN
	.PAGE
        .SBTTL  CONVERSION ROUTINES
;
;	CONVERSION ROUTINES
;
SPECIAL:
	CALL  @(R4)+
	RETURN
;
;	DECIMAL:  1 PARAMETER, THE NUMBER
;
DECIMAL:
	MOV  (R4)+,R1			;GET VALUE
	CLR  R2 			;SHOW LEADING ZERO SUPPRESION
	CALL  $CBDSG			;CONVERT TO TEXT
	RETURN
;
;	OCTAL: 1 PARAMETER, THE NUMER
;
OCTAL:
	MOV  (R4)+,R1			;GET VALUE
	CLR  R2 			;SHOW LEADING ZERO SUPPRESSION
	CALL  $CBOMG			;AND CONVERT
	RETURN
;
;	ASCII:	2 PARAMETERS, THE TEXT STRING ADDRESS AND COUNT
;
ASCII:
	MOV  (R4)+,R1			;GET ADDRESS
	MOV  (R4)+,R2			;AND COUNT
	WHILE  ,GT			;WHILE >0
	  MOVB	(R1)+,(R0)+		;MOVE IT IN
	  DEC  R2			;COUNT DOWN
	END
	RETURN
;
;	RAD50:	1 PARAMTER, THE RADIX 50 WORD
;
RAD50:
	MOV  (R4)+,R1			;GET WORD
	CALL  $C5TA			;AND CONVERT TO ASCII
	RETURN
;
;	$FNB: 2 PARAMETER, THE FILE NAME BLOCK AND THE WORK LUN
;
$FNB::
	MOV  (R4)+,R3			;GET FNB ADDRESS
	MOVB  N.DVNM(R3),(R0)+		;PUT IN DEVICE
	MOVB  N.DVNM+1(R3),(R0)+	;NAME
	MOVB  N.UNIT(R3),R1		;GET UNIT NUMBER
	CLR  R2 			;SUPPRESS LEADING ZEROS
	CALL  $CBOMG			;AND CONVERT TO OCTAL
	MOVB  #':,(R0)+ 		;INSERT SEPARATOR
	MOV  (R4)+,R1			;GET LUN
	IF  ,NE 			;IF SPECIFIED
	AND  N.DID(R3),NE		;AND THERE IS A DIRECTORY ID
	  CALL	DODID			;PROCESS THE DID
	END
	MOV  N.FNAM(R3),R1		;CONVERT FILENAME TO ASCII
	CALL  $C5TA			;...
	MOV  N.FNAM+2(R3),R1		;WORD
	CALL  $C5TA			;BY
	MOV  N.FNAM+4(R3),R1		;WORD
	CALL  $C5TA			;...
	MOV  #9.,R1			;NOW STRIP
	CALL  STRIP			;UP TO 9 TRAILING BLANKS
	MOVB  #'.,(R0)+ 		;INSERT SEPARATOR
	MOV  N.FTYP(R3),R1		;GET FILE TYPE
	CALL  $C5TA			;AND CONVERT TO ASCII
	MOV  #3.,R1			;STRIP UP TO 3
	CALL  STRIP			;TRAILING BLANKS
	MOVB  #';,(R0)+ 		;MOVE IN SEPARATOR
	MOV  N.FVER(R3),R1		;GET FILE VERSION
	CLR  R2 			;SUPRESS LEADING ZEROS
	CALL  $CBOMG			;AND OUTPUT IT
	RETURN
	.PAGE
        .SBTTL  UTILITY ROUTINES
;
;	UTILITY ROUTINES
;
 
;
;	STRIP: REMOVE UP TO (R1) TRAILING BLANKS FROM BUFFER
;
STRIP:
	WHILE  ,GT			;TRAILING BLANKS
	  CMPB	#' ,-1(R0)		;STILL A BLANK?
	  IF  ,EQ			;YES
	    DEC  R0			;GO BACK ONE
	  END
	  DEC  R1			;COUNT DOWN
	END				;AND LOOP
	RETURN
;
;	CONVERT A DIRECTORY ID INTO PRITABLES
;
;	R1 CONTAINS LUN TO USE
;	R3 POINTS TO NAME BLOCK
;
DODID:
	CALL  $SAVAL			;SAVE REGISTERS
	MOVB  N.UNIT(R3),R2		;GET UNIT
	ALUN$S	R1,N.DVNM(R3),R2	;ASSIGN THE LUN TO IT
	IF  ,CS 			;IF ERROR
	  BR  DODIDR			;JUST RETURN
	END
	SUB  #4,SP			;MAKE SPACE FOR IOSB
	MOV  SP,R4			;AND NOTE IT'S ADDRESS
	SUB  #6.,SP			;MAKE SPACE FOR ATTRIBUTE CONTROL LIST
	MOV  SP,R2			;AND NOTE IT'S ADDRESS
	TST  -(SP)			;MAKE SPACE FOR OWNER UIC
	MOV  (PC)+,(R2) 		;READ 2 BYTES OF OWNER UIC
	.BYTE  -1,2			;READ FILE OWNER, 2 BYTES
	MOV  SP,2(R2)			;INTO TOP OF SDACK
	CLR  4(R2)			;AND THATS ALL
	ADD  #N.DID,R3			;POINT TO DIRECTORY ID
	QIO$S  #IO.RATT,R1,#32.,,R4,,<R3,R2> ;READ ATTRIBUTES
	IF  ,CS 			;IF ERROR
	  ADD  #12.,SP			;RESTORE SP
	  BR  DODIDR			;AND RETURN
	END
	WTSE$S	#32.			;WAIT FOR I/O TO FINISH
	IFB  (R4),LT			;IF ERROR
	  ADD  #12.,SP			;CLEAR STACK
	  BR  DODIDR			;AND RETURN
	END
	MOV  (SP),R3			;GET OWNER UIC
	MOV  R0,R2			;OUTPUT BUFFER ADDRESS
	CLR  R4 			;FLAGS
	ADD  #12.,SP			;CLEAR OFF REST OF STACK
	CALL  .PPASC			;CONVERT UIC TO ASCII
	MOV  R2,2(SP)			;UPDATE SAVED R0
DODIDR:
	RETURN
	.END