.TITLE	RSUFCS
	.IDENT	/V7.04/

;*****************************************************************
;
;	RSUFCS
;
;	THIS MODULE CONTAINS FCS ERROR PROCESSING ROUTINES.
;
;	FOR USE WITH ACCOUNTING SYSTEM VERSION 7.
;
;	STEVE THOMPSON
;	SCHOOL OF CHEMICAL ENGINEERING
;	OLIN HALL
;	CORNELL UNIVERSITY
;	ITHACA NY 14853
;
;	REVISION HISTORY
;	----------------
;
;	SMT812	 5-APR-82	CHANGED COMMAND NAME FROM RPT TO RSU
;
;	SMT814	12-APR-82	LOWER CASE MESSAGES FOR RSX-11M V4.0
;
;	SMT821	23-APR-82	CHANGED ENTRY POINT NAMES OF ACCOUNTING
;				SUPPORT ROUTINES (SEE MODIFY.TXT)
;
;	SMT851	22-JUL-83	ADDED RSX-11M V4.1 SUPPORT
;
;******************************************************************

	.MCALL	OPNS$R, CLOSE$, QIOW$,  DIR$
	.MCALL	FDBDF$,FDRC$A,FDOP$A
	.MCALL	FDOF$L, NBOF$L

	FDOF$L		; DEFINE FILE DESCRIPTOR BLOCK OFFSETS LOCALLY
	NBOF$L		; DEFINE FILENAME BLOCK OFFSETS LOCALLY

QIOSYM:	FDBDF$			; FDB FOR I/O MESSAGE TEXT FILE
	FDRC$A	FD.RWM		; BLOCK I/O OPERATIONS
	FDOP$A	5,QIODSP,,FO.RD,FA.ENB!FA.DLK

QIODSP:	.WORD	QMSDSZ,QMSDEV	; DATASET DESCRIPTOR, LB:[1,2]QIOSYM.MSG
	.WORD	QMSUSZ,QMSUFD	;
	.WORD	QMSNSZ,QMSNAM	;

	.NLIST	BEX

QMSDEV:	.ASCII	/LB0:/
QMSDSZ=.-QMSDEV

QMSUFD:	.ASCII	/[1,2]/
QMSUSZ=.-QMSUFD

QMSNAM:	.ASCII	/QIOSYM.MSG/
QMSNSZ=.-QMSNAM

;
; TEXT MESSAGES
;

	.IIF DF AA$V40 ! AA$V41, .ENABL LC

FCSERR:	.ASCIZ	/ FCS error #/
DIRERR:	.ASCIZ	/ Directive error #/
UFDERR:	.ASCIZ	/ - Directory file open failure/
SEPAR:	.ASCIZ	/ - /

;
; DPB FOR MESSAGE FILE I/O
;

	.EVEN

MSQIO:	QIOW$	IO.RVB,5,1,,,,<0,512.,,0,0>

;+
; *** $FCSEP
;
;	THIS ROUTINE TAKES AN FCS ERROR CODE AND PRINTS OUT A MESSAGE
;	OF THE FORM:
;
;	RSU -- <FILESPEC> - <FCS ERROR TEXT>
;
;	OR:
;
;	RSU -- <FILESPEC> -- FCS ERROR #NN.
;
;	OR:
;
;	RSU -- <FILESPEC> -- DIRECTIVE ERROR #NN.
;
;	THE SECOND FORM IS USED IF THE FCS ERROR TEXT FILE LB:[1,2]QIOSYM.MSG
;	CANNOT BE ACCESSED FOR ANY REASON.
;	DIRECTIVE ERROR CODES CAN ALSO BE PROCESSED BY THIS ROUTINE, SINCE THE
;	MESSAGE TEXT IS KEPT IN THE SAME FILE. IF THE ERROR CODE ORIGINATED
;	WITHIN FCS, BYTE OFFSET F.ERR+1 IS ZERO. IF THE ERROR CODE WAS
;	FROM A DIRECTIVE, F.ERR+1 IS NON-ZERO. IN BOTH CASES, F.ERR CONTAINS
;	THE ERROR CODE.
;
;	INPUT:
;		R0	FDB ADDRESS CONTAINING ERROR CODE AT OFFSET F.ERR
;
;-

$FCSEP::TSTB	F.ERR(R0)	; FCS OR DIRECTIVE ERROR?
	BNE	10$		; IF NE YES
	RETURN			; ELSE JUST RETURN TO CALLER

;
; DETERMINE DEVICE NAME AND UNIT NUMBER
;

10$:	CLR	MSQIO+Q.IOPL	; SHOW NO DYNAMIC MEMORY IN USE BY ERROR
				; PROCESSOR
	MOV	R0,R5		; COPY FDB ADDRESS TO R5
	MOV	#OUTBUF,R0	; GET ADDRESS OF OUTPUT BUFFER
	MOVB	F.FNB+N.DVNM(R5),(R0)+   ; INSERT DEVICE SPECIFICATION
	MOVB	F.FNB+N.DVNM+1(R5),(R0)+ ; WE USE TWO MOVB'S BECAUSE THE
					 ; BUFFER AT R0 MAY NOT BE WORD
					 ; ALIGNED
	MOV	F.FNB+N.UNIT(R5),R1 ; GET DEVICE UNIT NUMBER
	CALL	OC.TAL		; CONVERT TO OCTAL
	MOVB	#COLON,(R0)+	; AND INSERT THE DEVICE/UIC SEPARATOR

;
; DETERMINE UFD
;

	MOV	<F.FNB+N.DID+4>(R5),R3 ; DIRECTORY ACCESS FAILURE?
	BEQ	101$		; IF EQ NO
	CALL	FM.UIC		; YES, FORMAT UFD NAME
	MOVSTR	#UFDERR		; INSERT REST OF MESSAGE TEXT
	JMP	40$		; PRINT MESSAGE AND RETURN
101$:	MOV	F.DSPT(R5),R4	; GET ADDRESS OF DATASET DESCRIPTOR
	BEQ	12$		; IF EQ NONE, SO USE DEFAULT UIC
	CMP	(R4)+,(R4)+	; POINT TO DIRECTORY SPECIFICATION
	MOV	(R4)+,R2	; GET SIZE OF DIRECTORY SPECIFICATION
	BEQ	12$		; IF EQ USE CURRENT DEFAULT IN $$FSR2
	MOV	(R4)+,R1	; GET ADDRESS OF DIRECTORY SPECIFICATION
	BEQ	12$		; JUST IN CASE
11$:	CALL	CO.PY		; COPY IT INTO THE MESSAGE
	BR	14$		; MOVE ON TO THE NAME SPECIFICATION
12$:	CALL	.RDFDR		; READ DEFAULT DIRECTORY STRING DESCRIPTOR
	MOV	R1,R3		; COPY SIZE OF IT TO R3
	MOV	R2,R1		; COPY ADDRESS OF STRING TO R1
	BEQ	13$		; IF EQ THERE ISN'T ONE
	MOV	R3,R2		; COPY SIZE OF STRING BACK TO R2
	BNE	11$		; AND INSERT IT IN MESSAGE IF NOT NULL
13$:	CALL	.RDFUI		; READ DEFAULT UIC
	MOV	R1,R3		; COPY IT TO R3
	CALL	FM.UIC		; AND FORMAT AS [G,M]

;
; ADD NAME, TYPE AND VERSION TO MESSAGE
;

14$:	ADD	#<F.FNB+N.FNAM>,R5 ; POINT R5 TO FILENAME SECTION
	CALL	R50.TA		; CONVERT FILENAME TO ASCII
	CALL	R50.TA		;
	CALL	R50.TA		;
	MOVB	#DPT,(R0)+	; INSERT NAME/TYPE SEPARATOR
	CALL	R50.TA		; CONVERT FILETYPE TO RADIX-50
	MOV	(R5)+,R1	; GET VERSION NUMBER
	BEQ	15$		; IF EQ IT IS ZERO SO SKIP FORMATTING IT
	MOVB	#';,(R0)+	; INSERT TYPE/VERSION SEPARATOR
	CALL	OC.TAL		; AND CONVERT THE VERSION NUMBER TO OCTAL

;
; ADD TEXT OF ERROR MESSAGE
;

15$:	MOVSTR	#SEPAR		; INSERT " - "
	SUB	#<F.FNB+N.FNAM+10.>,R5 ; POINT R5 BACK TO FDB
	MOV	R0,-(SP)	; SAVE CURRENT BUFFER POINTER

;
; ALLOCATE DYNAMIC MEMORY FOR MESSAGE FILE I/O
;

	MOV	#512.,R1	; SET SIZE OF BUFFER TO ALLOCATE
	CALL	CORE		; ALLOCATE A MESSAGE BLOCK
	BCS	20$		; IF CS, NO CAN DO
	MOV	R0,MSQIO+Q.IOPL	; SAVE ALLOCATED BUFFER ADDRESS

;
; OPEN MESSAGE FILE
;

	OPNS$R	#QIOSYM		; OPEN MESSAGE FILE
	BCC	30$		; IF CC WE MADE IT
20$:	MOV	(SP)+,R0	; RESTORE BUFFER POINTER
	MOV	#FCSERR,R1	; ASSUME IT WAS AN FCS ERROR
	TSTB	F.ERR+1(R5)	; WAS IT AN FCS ERROR?
	BEQ	22$		; IF EQ YES
	MOV	#DIRERR,R1	; ELSE IT WAS A DIRECTIVE ERROR
22$:	CALL	MV.STR		; INSERT "XXX ERROR" TEXT
	MOVB	F.ERR(R5),R1	; GET FCS OR DIRECTIVE ERROR CODE
	CLR	R2		; SET FOR NO LEADING ZEROES
	CALL	$CBDSG		; FORMAT AS SIGNED DECIMAL
	MOVB	#DPT,(R0)+	; TERMINATE WITH A PERIOD
	BR	40$		; CONTINUE IN COMMON CODE

;
; READ TEXT OF ERROR MESSAGE FROM MESSAGE FILE
;

30$:	MOVB	F.ERR(R5),R1	; GET ERROR CODE
	NEG	R1		; MAKE IT POSITIVE
	MOV	R1,R2		; AND COPY IT
	DEC	R2		; CALCULATE NUMBER OF BLOCK WITHIN MESSAGE
	ASR	R2		; ...FILE THAT CONTAINS THE TEXT.
	ASR	R2		; ...(EIGHT MESSAGES PER BLOCK)
	ASR	R2		;
	INC	R2		;
	TSTB	F.ERR+1(R5)	; DIRECTIVE ERROR?
	BEQ	34$		; IF EQ NO
	ADD	#16.,R2		; YES, ADD REQUIRED BIAS FOR MSG IN FILE
34$:	MOV	R2,MSQIO+Q.IOPL+10 ; SET UP VIRTUAL BLOCK NUMBER
	DIR$	#MSQIO		; READ IN THE MESSAGE TEXT
	BCS	20$		; IF CS ERROR, DISPLAY FCS NUMBER
	DEC	R1		; CALCULATE MESSAGE OFFSET IN BLOCK
	BIC	#177770,R1	;
	SWAB	R1		; CONVERT TO BYTE OFFSET (MULTIPLY BY 64.)
	ASR	R1		;
	ASR	R1		;
	ADD	MSQIO+Q.IOPL,R1	; POINT TO MESSAGE TEXT
	MOV	(SP)+,R0	; RESTORE BUFFER ADDRESS
	CALL	MV.STR		; INSERT FCS ERROR TEXT IN BUFFER

;
; RELEASE MESSAGE BUFFER TO DYNAMIC MEMORY REGION
;

40$:	MOV	MSQIO+Q.IOPL,R2	; GET ADDRESS OF BLOCK TO DEALLOCATE
	BEQ	50$		; IF EQ, NO BLOCK IN USE
	MOV	R0,-(SP)	; SAVE CURRENT BUFFER POSITION
	MOV	#FREEHD,R0	; SET FREE MEMORY LISTHEAD ADDRESS
	MOV	#512.,R1	; SET SIZE OF BLOCK
	CALL	$RLCB		; RELEASE CORE BLOCK
	MOV	(SP)+,R0	; RESTORE CURRENT BUFFER POSITION
50$:	SUB	#OUTBUF,R0	; CALCULATE MESSAGE LENGTH
	MOV	#OUTBUF,TIDPB+Q.IOPL ; SET UP MESSAGE PARAMETERS IN DPB
	MOV	R0,TIDPB+Q.IOPL+2 ;
	DIR$	#TIDPB		; PRINT THE MESSAGE
	CLOSE$	#QIOSYM		; MAKE SURE THE MESSAGE FILE IS CLOSED
	RETURN			; AND RETURN TO CALLER

	.END