Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

; UPD ID= 1516 on 1/30/84 at 6:20 PM by HOFFMAN                         
TITLE	LBLERR FOR LIBOL - LIBOL MODULE TO HANDLE $ERROR CALLS
SUBTTL	D. WRIGHT

	SEARCH COPYRT
	SALL

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

COPYRIGHT (C) 1979, 1982, 1986 BY DIGITAL EQUIPMENT CORPORATION

;***** V12B *****
;WHO	DATE		COMMENT
;MJC	11-FEB-86	[1155] Add error for ENQ quota exceeded error
;JSM	16-JUN-83	[1071] ZERO OUT FS.EN BEFORE ASSEMBLING ERROR NUMBER FOR F-S 2
;RLF	15-FEB-83	[1053] Change error message to "File is busy".
;LEM	 8-Apr-82	[1017] Reset ERRNUM when retrying to open a busy RMS file.

SEARCH	COMUNI		;GET COMMON SYMBOLS, MACROS
IFN TOPS20, SEARCH	MONSYM,MACSYM
IFE TOPS20, SEARCH	UUOSYM,MACTEN
SEARCH	LBLPRM		;GET LIBOL PARAMETERS
SEARCH	FTDEFS		;AND FILE-TABLE DEFINITIONS

SALL
HISEG
	.COPYRIGHT		;Put standard copyright statement in REL file

T1=1		;NOT DEFINED IN COMUNI YET
T2=2
T3=3
T4=4
P1=5		;PERM. AC (SAVED ACROSS SUBROUTINES)
P2=6
P3=7
P4=10
C=11
FT=12		;FILE TABLE PTR (PERM)
FTL=13
FLG=14
ARG=16
PP=17

;THE FOLLOWING ARE DEFINED IN RMSIO ALSO, FOR NOW.. [12B]
LF%FNA==1B32		;ASCII FILE NAME AVAILABLE FOR TYPING
LF%INP==1B33		;FILE IS OPEN FOR INPUT
LF%OUT==1B34		;FILE IS OPEN FOR OUTPUT
LF%IO==1B35		;FILE IS OPEN FOR I-O (ALL 3 BITS ON)
UP%ERR==0		;ERROR USE PROCEDURE
UP%OER==1		;FILENAME OPEN USE PROCEDURE

;VERBS TO BE DEFINED IN COMUNI IN V13
VB.PTR:	POINT	4,T1,3		;BYTE POINTER TO GET VERB VALUE
				;WHEN T1 IS LOADED UP WITH @BS.AGL
V%OPEN==1		;OPEN
V%CLOS==2		;CLOSE
V%READ==3		;READ
V%WRIT==4		;WRITE
V%RWRT==5		;REWRITE
V%DELT==6		;DELETE
V%STRT==7		;START
V%ACPT==10		;ACCEPT
V%DPLY==11		;DISPLAY
V%OPS5==12		;OPEN RMS FOR OPTION 5

;TABLE OF VALUES TO ADD TO FS.EN, INDEXED BY THE ABOVE NUMBER
ENADDT:	0		;NO 0 VERB
	^D100000000	;OPEN
	^D200000000	;CLOSE
	^D600000000	;READ
	^D300000000	;WRITE
	^D400000000	;REWRITE
	^D500000000	;DELETE
	^D900000000	;START

;OPEN BITS (DEFINED IN LBLPRM IN V13)
OPN%IN==1B9	;FILE BEING OPENED FOR INPUT
OPN%OU==1B10	;FILE BEING OPENED FOR OUTPUT
OPN%IO==1B11	;FILE BEING OPENED FOR I-O (ALL 3 BITS ON)

SUBTTL	MACROS, OPDEFS

DEFINE TYPE (ADDR),<
IFN TOPS20,<
	HRROI	T1,ADDR
	PSOUT%
>;END IFN TOPS20
IFE TOPS20,<
	OUTSTR	ADDR
>
>;END DEFINE TYPE

DEFINE $TYPT1,<
IFN TOPS20, PBOUT%		;TYPE IT
IFE TOPS20, OUTCHR T1		;TYPE IT
>;END DEFINE $TYPT1

CRLF:	ASCIZ/
/			;A CRLF

SUBTTL	INTERFACE TO OTHER LIBOL MODULES

ENTRY	LBLERR		;ROUTINE TO DO THE LIBOL ERROR
ENTRY	SETEFS		;SET ERROR FILE-STATUS ITEMS, IF ANY
ENTRY	SETFS		;SET FIRST FILE-STATUS ITEM, IF ANY
ENTRY	CHKUSE		;CHECK FOR A USE PROCEDURE
ENTRY	RMSERP		;RMS ERROR REPORT

EXTERN	ER.PC		;PC WHEN LBLERR CALLED
EXTERN	ER.MCL		;MONITOR CALL NUMBER THAT CAUSED THE ERROR
EXTERN	ER.FLG		;FLAGS,, ERROR-NUMBER
EXTERN	ER.HIJ		;"HIJ" OF THE 10-DIGIT ERROR NUMBER
EXTERN	ER.RBG		;RMS BUG ERROR CODE
			; UNLESS CD=0
IFN TOPS20,<
EXTERN	ER.JSE		;JSYS ERROR
>
IFE TOPS20,<
EXTERN	ER.E10		;TOPS10 ERROR CODE
>
FT.RMS:	POINT 1,F.RMS(FT),7	;RMS BIT IN FILE-TABLE
FT.PPN:	POINT 18,F.RPPN(FT),35	;ADDR OF USER-NUMBER
FT.RUP:	POINT 18,F.REUP(FT),35	;ADDRESS OF ERROR USE PROCEDURE
FT.UPO:	POINT 1,F.WOUP(FT),6	;=1 IF ERROR USE PROCEDURE FOR OPEN

BP%SEV:	POINT 3,ER.FLG,2	;ERROR SEVERITY CODE
BP%FNM:	POINT 1,ER.FLG,17	;"FILENAME WANTED" BIT
BP%BRN:	POINT 1,ER.FLG,16	;"BLOCK#, REC# WANTED" BIT
IFN TOPS20,<
BP%JSE:	POINT 1,ER.FLG,15	;"JSYS ERROR AVAILABLE" BIT
>
IFE TOPS20,<
BP%E10:	POINT 1,ER.FLG,15	;"TOPS10 ERROR AVAILABLE" BIT
>
BP%ENO:	POINT 12,ER.FLG,35	;ERROR NUMBER 1 THRU 999
BP%IVB: POINT 1,ER.FLG,14	; This error is from an I-O verb
BP%OER:	POINT 1,ER.FLG,13	; Filename on OPEN error

SUBTTL	LBLERR ENTRY

;THIS ROUTINE IS CALLED VIA THE $ERROR MACRO, WHICH EXPANDS AS
; FOLLOWS:
;
;	MOVE	T2,[FLAGS+SEVERITY,,ERROR-NUMBER]
;	MOVEI	T3,MONCAL	;MONITOR-CALL CODE, IF GIVEN
;	JSP	T1,LBLERR
;	JRST	RETURN-ADDR

LBLERR:	MOVEM	T1,ER.PC	;SAVE ERROR PC
	MOVEM	T2,ER.FLG	;SAVE FLAGS, ERR-NUM
	MOVEM	T3,ER.MCL	;SAVE MONITOR CALL CODE

;CHECK TO SEE IF A USE PROCEDURE WILL BE CALLED
	LDB	T1,BP%SEV	;GET SEVERITY
	CAIE	T1,SV.FAT	;IF NOT "FATAL",
	 JRST	LBLER0		; DON'T INVOKE A "USE" PROCEDURE

	LDB	T1,BP%FNM	;IS THIS A FILE ERROR?
	JUMPE	T1,LBLER0	; NO, DON'T DO A "USE" PROCEDURE

	LDB	T1,BP%OER	;CHECK FOR OPEN ERROR
	JUMPE	T1,LBLEOP	;No, don't check for that one.
	MOVEI	T1,UP%OER	;Check for filename OPEN use procedure
	PUSHJ	PP,CHKUSE	;..
	  CAIA			;None
	JRST	LBLECU		;Got one, use that!
LBLEOP:	MOVEI	T1,UP%ERR	;CHECK FOR ERROR USE PROCEDURE
	PUSHJ	PP,CHKUSE	;IS THERE ONE?
	 JRST	LBLER0		;NO USE PROCEDURE, TYPE ERROR MESSAGE
;	JRST	LBLECU		;Libol error procedure, not OPEN use procedure

;CALL THE USE PROCEDURE SUPPLIED BY THE USER
LBLECU:	PUSH	PP,T1		;SAVE ADDRESS..
	MOVEI	T1,^D30		;SET FILE-STATUS TO 30 FOR ALL
	MOVEM	T1,FS.FS	; ERROR-USE PROCEDURES
	PUSHJ	PP,SETFS	;SET USER-SUPPLIED VARIABLE (IF ANY)
	PUSHJ	PP,SETEFS	;SET ERROR-STATUS WORDS, IF ANY
	POP	PP,T1		;RESTORE ADDRESS OF USE PROCEDURE
	PUSH	PP,FT		;SAVE FILE-TABLE PTR
	PUSH	PP,FTL
	PUSHJ	PP,(T1)		;CALL ERROR USE PROCEDURE
				;WARNING: THIS MAY SMASH ALL ACS EXCEPT PP
	POP	PP,FTL
	POP	PP,FT		;;RESTORE FILE-TABLE PTR

;CHECK THE IGNORE FLAG.
;THE ERROR IS IGNORED IF THE USER SPECIFIED AN IGNORE FLAG VALUE OF NON-ZERO.
	SKIPE	T1,F.WPAC(FT)	;DID USER SUPPLY AN IGNORE-FLAG VARIABLE?
	SKIPN	T1,(T1)		; AND IS IT SET NON-ZERO?
	 JRST	LBLER0		;NOT BOTH TRUE, GO TO ERROR MESSAGE AND KILL

;IGNORE THE ERROR!  (GO BACK TO RETURN ADDRESS)
	HRRZ	T1,ER.PC	;GET PC
	JRST	(T1)		;RETURN THERE

SUBTTL	LBLERR - ERROR TYPEOUT

;HERE IF WE MUST TYPE THE ERROR OUT FOR HIM.
; EITHER:
;	1) NO ERROR USE PROCEDURE IS AVAILABLE.
;	2) ONE HAS BEEN CALLED, AND THE USER DID NOT SET THE "IGNORE" FLAG.

;V12B: ONLY RMS ERRORS WILL USE THE NEW MACRO. ERRORS START AT ^D500,
;  SO WE WILL SAVE SPACE BY TEMPORARILY ALLOCATING MESSAGES STARTING AT 500.

LBLER0:	PUSHJ	PP,OUTBF.##	;OUTPUT THE TTY BUFFER, GO INTO
				; IMMEDIATE OUTPUT MODE
	TYPE	CRLF		;TYPE A CRLF
	LDB	T1,BP%SEV	;GET SEVERITY
	MOVEI	T2,[ASCIZ/?LBL/] ;ASSUME FATAL
	CAIN	T1,SV.WRN	;JUST A WARNING?
	 MOVEI	T2,[ASCIZ/%LBL/] ;YES
	CAIN	T1,SV.INF	;INFORMATIONAL?
	 MOVEI	T2,[ASCIZ/[LBL/] ;YES
	TYPE	<(T2)>		;TYPE THE HEADER PART
IFN TOPS20,<
	MOVEI	T1,.PRIOU	;TO PRIMARY OUTPUT
	LDB	T2,BP%ENO	; GET ERROR MESSAGE NUMBER
	MOVX	T3,3B17!NO%ZRO!^D10 ;TYPE 3 DIGITS, WITH LEADING 0'S
	NOUT%			;TYPE THE ERROR NUMBER
	 ERJMP	.+1		;ONLY ERRORS ARE BUGS (IMPOSSIBLE!)
>;END IFN TOPS20
IFE TOPS20,<
	LDB	T2,BP%ENO	; GET ERROR MESSAGE NUMBER
	IDIVI	T2,^D100	;GET HUNDREDS
	ADDI	T2,"0"		;MAKE ASCII
	OUTCHR	T2		;TYPE HUNDREDS
	IDIVI	T3,^D10		;GET TENS & ONES
	ADDI	T3,"0"		;MAKE ASCII
	OUTCHR	T3
	ADDI	T4,"0"
	OUTCHR	T4
>;END IFE TOPS20
	TYPE	[ASCIZ/ /]	;TYPE A SPACE BEFORE THE TEXT

;TYPE THE MAIN MESSAGE TEXT

	LDB	T2,BP%ENO	;GET ERROR NUMBER AGAIN

;AN ERROR NUMBER OF ZERO INDICATES AN INTERNAL LIBOL ERROR
	JUMPE	T2,[TYPE [ASCIZ/Internal LIBOL error/]
			JRST LBLER1]
	SUBI	T2,^D500	;[V12B] GET REAL INDEX INTO TABLE
	TYPE	@ER500(T2)	;[V12B] TYPE THE ERROR TEXT
	LDB	T2,BP%SEV	;GET SEVERITY
	CAIE	T2,SV.INF	; INFORMATIONAL?
	 JRST	LBLER1		;NO
	TYPE	<[ASCIZ/]
/]>				;FINISH THAT LINE
	JRST	LBLE1A		;AND SKIP CRLF
LBLER1:	TYPE	CRLF		;TYPE A CRLF

LBLE1A:
IFN TOPS20,<
;TYPE JSYS ERROR IF HE WANTS IT
	LDB	T1,BP%JSE	;"JSYS ERROR WANTED" BIT
	JUMPE	T1,LBLE1B	;JUMP IF NOT SPECIFIED
	TYPE	[ASCIZ/ TOPS20 JSYS error: /]
	HRRZ	T2,ER.JSE	;GET ERROR CODE
	PUSHJ	PP,TOCT		;TYPE OCTAL NUMBER
	TYPE	[ASCIZ/ = /]
	MOVEI	T1,.PRIOU	;;TYPE IT
	HRRZ	T2,ER.JSE	;GET ERROR CODE
	HRLI	T2,.FHSLF	;MY PROCESS
	SETZ	T3,		;ALL OF IT
	ERSTR%			;TYPE IT
	 JRST	[TYPE [ASCIZ/* Undefined error number */]
		JRST .+1]
	JFCL			;(IMPOSSIBLE)
	TYPE	CRLF		;TYPE CRLF
>;END IFN TOPS20
IFE TOPS20,<		;TYPE TOPS10 ERROR CODE IF HE WANTS IT
	LDB	T1,BP%E10	;"TOPS10 ERROR WANTED" BIT
	JUMPE	T1,LBLE1B	;NOT SPECIFIED
	TYPE	[ASCIZ/ TOPS10 UUO error: /]
	HRRZ	T2,ER.E10	;GET ERROR CODE
	TYPE	@ET0(T2)	;TYPE THE ERROR TEXT
	TYPE	CRLF		;AND A CRLF
>;END IFE TOPS20

;TYPE LIBOL ERROR NUMBER
LBLE1B:	TYPE	[ASCIZ/ LIBOL error number: /]
	SKIPN	FS.EN		;ALREADY SET UP?
	 PUSHJ	PP,SETEN	;NO, SET IT UP

	MOVE	T1,@BS.AGL##	;GET CONTENTS OF BASE OF ARG LIST TO GET VERB
	LDB	T1,VB.PTR	;GET VERB
	MOVE	T2,ENADDT(T1)	;GET NUMBER TO ADD
	IDIV	T2,[^D100000000] ;GET NUMBER OF THE VERB
	PUSHJ	PP,TWODIG	;;PRINT TWO DIGITS
	MOVE	T2,ER.MCL	;GET CD = MONITOR CALL CODE
	PUSHJ	PP,TWODIG	;PRINT 'EM

;ROUTINE GETFTP GETS FILE-TYPE CODE IN T2, ISAM BLOCK TYPE (IF ANY) IN T3
	PUSHJ	PP,GETFTP	;GET TYPE OF FILE BEING ACCESSED
	PUSHJ	PP,TWODIG	;PRINT IT
	MOVEI	T1,"0"(T3)	;GET THE ASCII DIGIT IN T1
	$TYPT1
	MOVEI	T1,"."		;DELIMIT LAST THING.
	$TYPT1
	LDB	T1,BP%ENO	;GET ERROR NUMBER
	SKIPE	ER.MCL		;CD=0?
	 HRRZ	T1,ER.HIJ	;NO, GET USER-SUPPLIED NUMBER
	IDIVI	T1,^D100	;GET T1=H
	IDIVI	T2,^D10		;GET T2=I, T3=J
	ADDI	T1,"0"		;MAKE ASCII DIGIT
IFN TOPS20,<
	PBOUT%
	MOVEI	T1,"0"(T2)
	PBOUT%
	MOVEI	T1,"0"(T3)
	PBOUT%
>
IFE TOPS20,<
	OUTCHR	T1
	ADDI	T2,"0"
	OUTCHR	T2
	ADDI	T3,"0"
	OUTCHR	T3
>
	TYPE	CRLF		;FINISH WITH CRLF

;TYPE FILENAME IF HE WANTS THAT
LBLER2:	LDB	T1,BP%FNM	;GET "FILENAME WANTED" BIT
	JUMPE	T1,LBLER3	;JUMP IF NOT WANTED
	TYPE	[ASCIZ/ File: /]
	MOVEI	T4,^D30		;30 CHARS MAX
	MOVE	T3,[POINT 6,(FT)] ;POINT AT FILENAME
LBLFER:	ILDB	T1,T3		;GET CHAR
	CAIE	T1,0		;TERMINATE ON A SPACE
	SOJGE	T4,LBLFR1	;OR SATISFIED CHARACTER COUNT
	JRST	LBLFR2
LBLFR1:	ADDI	T1,40		;CONVERT TO ASCII
	$TYPT1			;TYPE CHARACTER IN T1
	JRST	LBLFER		;LOOP

;TYPE ASCII NAME OR VALUE-OF-ID
LBLFR2:	LDB	T1,FT.RMS	;IS THIS AN RMS FILE?
	JUMPE	T1,LBLFR3	;JUMP IF NO
	SKIPN	T3,D.RMSP(FT)	;IS AN RMS-BLOCK SET UP?
	 JRST	LBLFR3		;NO
	MOVE	T1,D.F1(FT)	;GET FLAGS RMS HAS SET
	TXNN	T1,LF%FNA	;SKIP IF FILENAME IN ASCII IS AVAILABLE
	 JRST	LBLFR3		;NO
	TYPE	[ASCIZ/: /]
	TYPE	<.RCFNM(T3)>	;TYPE THE FILENAME STRING
	JRST	LBLFR4		;DONE, TYPE CRLF

;TYPE FROM VALUE OF ID
LBLFR3:	SKIPN	T3,F.WVID(FT)	;BP TO VALUE OF ID
	 JRST	LBLFR4		;EXIT IF NO VID.
	TYPE	<[ASCIZ/: [/]>
	MOVEI	T4,^D9		;NINE CHARACTERS
LBLF3A:	ILDB	T1,T3		;GET NEXT CHARACTER
	TLNN	T3,100		;SKIP IF ASCII
	ADDI	T1,40		;CONVERT SIXBIT TO ASCII
	TLNN	T3,600		; EBCDIC?
	LDB	T1,IPT971##	;YES, CONVERT CHAR IN T1
	$TYPT1			;TYPE IT
	SOJG	T4,LBLF3A	;DO ALL 9 CHARACTERS
	MOVEI	T1,"]"		;END WITH CLOSING SQUARE BRACKET
	$TYPT1

;TYPE OUT VALUE OF USER-NUMBER IF SUPPLIED
	LDB	T1,FT.PPN	;GET ADDRESS OF USER-NUMBER
	JUMPE	T1,LBLFR4	;EXIT IF NONE GIVEN

	PUSH	PP,(T1)		;SAVE VALUE
	TYPE	<[ASCIZ/    User-number: [/]>
	HLRZ	T2,(PP)		;GET LH
	PUSHJ	PP,TOCT		;TYPE OCTAL
	MOVEI	T1,","
	$TYPT1
	HRRZ	T2,(PP)		;GET RH
	PUSHJ	PP,TOCT		;TYPE OCTAL
	MOVEI	T1,"]"
	$TYPT1
	POP	PP,T2		;FIX STACK, PUT PPN IN T2
;FOR TOPS20:
;WE COULD TRANSLATE, BUT DON'T BOTHER.
;THE USER CAN DO A "TRANSLATE" COMMAND.

LBLFR4:	TYPE	CRLF		;EXIT
	JRST	LBLER3

;TYPE BLOCK #, REC # IF HE WANTS THAT
LBLER3:	LDB	T1,BP%BRN	;GET "BLOCK#, REC# WANTED" BIT
	JUMPE	T1,LBLER4	;JUMP IF NOT WANTED
	TYPE	[ASCIZ/ Block #: /]
	TYPE	[ASCIZ/Record #: /]
	TYPE	CRLF

;ALL DONE WITH ERROR PRINTING , RETURN TO USER OR GO TO KILL
LBLER4:	LDB	T1,BP%SEV	;GET SEVERITY
	CAIE	T1,SV.WRN	;IF WARNING,
	CAIN	T1,SV.INF	; OR INFORMATIONAL,
	 JRST	@ER.PC		;RETURN TO USER
	JRST	KILL.##		;FINISH OFF ERROR PROCESSING

SUBTTL	ERROR PRINT SUBROUTINES

;ROUTINE TO PRINT TWO DIGITS AND A "."
; T2/ NUMBER TO PRINT
TWODIG:	MOVE	T1,T2
	IDIVI	T1,^D10		;T1=A, T2=B
IFN TOPS20,<
	ADDI	T1,"0"		;MAKE ASCII CHARACTER
	PBOUT%
	MOVEI	T1,"0"(T2)
	PBOUT%
	MOVEI	T1,"."
	PBOUT%
>
IFE TOPS20,<
	ADDI	T1,"0"
	ADDI	T2,"0"
	OUTCHR	T1
	OUTCHR	T2
	OUTCHR	["."]		;OUTPUT A DOT
>
	POPJ	PP,


;ROUTINE TO PRINT OCTAL NUMBER IN T2
TOCT:
IFN TOPS20,<
	MOVEI	T3,^D8
	MOVEI	T1,.PRIOU
	NOUT%
	 JFCL
	POPJ	PP,
>;END IFN TOPS20
IFE TOPS20,<
	IDIVI	T2,^D8
	HRLM	T3,(PP)
	SKIPE	T2
	PUSHJ	PP,TOCT
	HLRZ	T1,(PP)		;GET DIGIT BACK
	ADDI	T1,"0"		;;MAKE IT ASCII
	OUTCHR	T1		;TYPE DIGIT
	POPJ	PP,		;RECURSE
>;END IFE TOPS20

SUBTTL	CHKUSE - CHECK FOR USE PROCEDURE

;CALL:	MOVEI	T1,UP%XXX	;TYPE OF USE PROCEDURE DESIRED
;	PUSHJ	PP,CHKUSE
;	<HERE IF NO USE PROCEDURE OF THAT TYPE>
;	<HERE IF YES, WITH ADDRESS IN T1>

CHKUSE:	CAIN	T1,UP%ERR	;ERROR USE PROCEDURE?
	 JRST	CHKUS1		;YES
	CAIN	T1,UP%OER	;FILENAME OPEN USE PROCEDURE?
	 JRST	CHKUSO		;YES
	$ERROR	(0,SV.FAT)	;INTERNAL LIBOL ERROR
CHKUS1:	LDB	T1,FT.RUP	;GET ADDR OF ERROR USE PROCEDURE
	JUMPE	T1,CHKUS2	;JUMP IF NONE
	LDB	T2,FT.UPO	;BUT IF IT WAS FOR OPEN,
	JUMPN	T2,CHKUS2	; IT'S NOT THE ONE
	AOS	(PP)		;SKIP RETURN WITH ADDRESS IN T1
CPOPJ:	POPJ	PP,

;CHECK FOR GENERAL (NON-FILE SPECIFIC) USE PROCEDURE.
; LOOKS FOR INPUT, OUTPUT, IO, EXTEND DEPENDING ON HOW THE FILE WAS OPENED.
CHKUS2:	HRRZ	FLG,D.F1(FT)	;GET LIBOL FILE FLAGS
	TXNE	FLG,LF%INP!LF%OUT	;FILE OPEN?
	 JRST	[MOVEI T1,0	;ASSUME FOR INPUT
		TXNE FLG,LF%OUT	;;OUTPUT?
		MOVEI  T1,5	;YES, GET THIS OFFSET
		TXNE FLG,LF%IO	;I-O?
		MOVEI T1,^D10	;YES, GET THIS OFFSET
		JRST	CHKUS3] ;HAVE MAJOR OFFSET

;FILE WAS NOT OPEN
;IF THIS IS AN OPEN STATEMENT, CHECK THE ARGLIST TO SEE
;  HOW THE FILE IS BEING OPENED, AND USE THAT KIND OF USE PROCEDURE
	MOVE	T2,BS.AGL	;TO SEE WHAT KIND OF STATEMENT THIS IS
	MOVE	T1,(T2)		;GET FIRST WORD IN T1
	LDB	T1,VB.PTR	;GET VERB TYPE
	CAIE	T1,V%OPEN	;OPEN?
	 POPJ	PP,		;NO, FILE NOT OPEN NOR BEING OPENED
	MOVE	T2,(T2)		;GET FIRST WORD IN T2
	SETZ	T1,		;T1 WILL BE OFFSET
	TXNE	T2,OPN%IN	;FILE BEING OPENED FOR INPUT?
	 JRST	[TXNE T2,OPN%IO ;YES, I/O ALSO?
		MOVEI T1,^D10	;YES, OPEN I-O
		JRST CHKUS3]	;NO, JUST INPUT, USE T1=0
	TXNN	T2,OPN%OU	;OPEN FOR OUTPUT?
	 POPJ	PP,		;NO, CONFUSION HERE..
	MOVEI	T1,5		;GET "OPEN FOR OUTPUT" OFFSET

;FILE WAS OPEN, WE HAVE T1= MAJOR OFFSET INTO USES
CHKUS3:	HRRZ	T2,USES.##	;GET ADDRESS OF USE TABLE
	JUMPE	T2,CPOPJ	;NO USE PROCEDURE, RETURN
	ADD	T2,T1		;ADD OFFSET
	HRRZ	T1,(T2)		;GET THE TAG
	JUMPE	T1,CPOPJ	;NONE, SORRY
	AOS	(PP)		;GOT ONE, SKIP RETURN WITH ADDR IN T1
	POPJ	PP,		;RETURN

;Here to check for FILENAME on OPEN error use procedure.
CHKUSO:	LDB	T1,FT.RUP	;GET ADDR OF ERROR USE PROCEDURE
	JUMPE	T1,CPOPJ	;JUMP IF NONE
	LDB	T2,FT.UPO	; MAKE SURE THE "ON OPEN" BIT IS SET
	JUMPE	T2,CPOPJ	;IT'S NOT THE ONE
	AOS	(PP)		;GOT IT, SKIP RETURN WITH ADDRESS IN T1
	POPJ	PP,

SUBTTL	RMSERP - TYPE RMS UNEXPECTED ERRORS OUT

;CALLED WITH STS IN P1, STV IN P2
RMSERP:	CAMN	P1,ER.RBG	;RMS BUG?
	 POPJ	PP,		;YES, RMS ALREADY TYPED INFO
	TYPE	[ASCIZ/?Unexpected RMS error, STS= /]
	MOVE	T2,P1		;TYPE STATUS IN OCTAL
	PUSHJ	PP,TOCT
	TYPE	[ASCIZ/, STV= /]
	MOVE	T2,P2
	PUSHJ	PP,TOCT
IFN TOPS20,<
;IF STV COULD BE A JSYS ERROR CODE, TYPE IT OUT
	CAIL	P2,600000
	CAILE	P2,677777	;SEE IF WITHIN RANGE
	 JRST	RMSER1		;NO
	TYPE	[ASCIZ/,
 JSYS error code = '/]
	MOVEI	T1,.PRIOU	;;TYPE IT
	HRRZ	T2,P2		;GET ERROR CODE
	HRLI	T2,.FHSLF	;MY PROCESS
	SETZ	T3,		;ALL OF IT
	ERSTR%			;TYPE IT
	 JRST	[TYPE [ASCIZ/* Undefined error number */]
		JRST .+1]
	JFCL			;(IMPOSSIBLE)
	MOVEI	T1,"'"		;END QUOTE
	$TYPT1			;TYPE IT
>;END IFN TOPS20
RMSER1:	TYPE	CRLF
	POPJ	PP,

SUBTTL	SETFS - SET FILE STATUS WORD

;  This routine is called every time the FILE-STATUS changes, to
;update the user-supplied symbol, if any.
;
;Call:	FS.FS/  file status to set (a 2-digit number)
;	PUSHJ	PP,SETFS
;	<return here always>

SETFS:	SKIPN	T1,F.WPFS(FT)	;GET FILE-STATUS POINTER
	 POPJ	PP,		;DONE IF NO POINTER
	MOVE	AC0,FS.FS##	;GET FILE-STATUS
	PUSH	PP,P1		;SAVE P1
	PUSH	PP,P2		;SAVE OTHER PERM ACS
	PUSH	PP,P3
	PUSH	PP,P4
	PUSH	PP,FTL
	PUSH	PP,FLG
	PUSH	PP,FT
	PUSHJ	PP,IGCNVT##	;MOVE IT TO DATA-ITEM
	POP	PP,FT
	POP	PP,FLG
	POP	PP,FTL
	POP	PP,P4
	POP	PP,P3
	POP	PP,P2
	POP	PP,P1		;RESTORE P1
	POPJ	PP,		;DONE, RETURN

SUBTTL	SETEFS - SET ERROR FILE-STATUS WORDS

; This routine is called prior to invoking an I/O ERROR USE procedure
;to set up the user-supplied FILE-STATUS items with all the information
;he needs to do intelligent things in the error procedure.

SETEFS:	PUSH	PP,P1		;SAVE P1
	PUSH	PP,P2		;SAVE OTHER PERM ACS
	PUSH	PP,P3
	PUSH	PP,P4
	PUSH	PP,FTL
	PUSH	PP,FLG
	PUSH	PP,FT		;FT IS AT 0(PP)
	SKIPN	T1,F.WPEN(FT)	; GET ERROR-NUMBER POINTER
	 JRST	SETEF1		;NO POINTER
	PUSHJ	PP,SETEN	;SETUP FS.EN
	MOVE	T1,F.WPEN(FT)	;GET PTR AGAIN
	MOVE	AC0,FS.EN##	;GET ERROR-NUMBER
	PUSHJ	PP,IGCNVT##	;MOVE IT TO DATA-ITEM

	MOVE	FT,(PP)	 	;GET FT FROM STACK
	SKIPN	T1,F.WPAC(FT)	; GET ACTION-CODE POINTER
	 JRST	SETEF1		;DONE IF NO POINTER
	SETZM	(T1)		;ZERO THE ACTION CODE

	SKIPN	T2,F.WPID(FT)	;GET VALUE-OF-ID POINTER
	 JRST	SETEF1		;NO POINTER, DONE
	MOVE	T1,F.WVID(FT)	;GET REAL VID POINTER
	LDB	T3,[POINT 2,T1,11] ;GET INPUT BYTE SIZE
	LDB	T4,[POINT 2,T2,11] ;GET OUTPUT BYTE SIZE
	TLZ	T2,7700		;ZERO BYTE FIELD
	MOVEI	16,1		;SETUP PARAMETER WORD
	PUSHJ	PP,@IGTAB2##-1(T3)	;MOVE IT TO DATA ITEM

	MOVE	FT,(PP)		;RESTORE FT FROM STACK
	SKIPN	T1,F.WPBN(FT)	;BLOCK-NUMBER POINTER
	 JRST	SETEF1		;NONE, RETURN
	MOVE	T2,FS.BN##	;GET BLOCK-NUMBER
	MOVEM	T2,(T1)		;MOVE IT TO DATA-ITEM

	SKIPN	T1,F.WPRN(FT)	;RECORD-NUMBER POINTER
	 JRST	SETEF1		;NONE, RETURN
	MOVE	T2,FS.RN##
	MOVEM	T2,(T1)		;MOVE IT TO DATA-ITEM

	SKIPN	T2,F.WPFN(FT)	;POINTER TO FILE-NAME
	 JRST	SETEF1		;NONE
	HRRI	T1,F.WFNM(FT)	;ADDRESS OF FILE-NAME
	HRLI	T1,(POINT 6,)	;IN SIXBIT
	LDB	T4,[POINT 2,T2,11] ;GET OUTPUT BYTE SIZE
	TLZ	T2,7700		;ZERO BYTE FIELD
	MOVEI	16,1		;SETUP PARAMETER WORD
	PUSHJ	PP,@IGTAB4##-1(T4)	;MOVE IT TO DATA-ITEM

	MOVE	FT,(PP)		;GET FT AGAIN
	SKIPN	T1,F.WPFT(FT)	;FILE-TABLE PTR WANTED?
	 JRST	SETEF1		;NO
	MOVEM	FT,(T1)		;YES, SAVE IT

;DONE-- RESTORE SAVED ACS
SETEF1:	POP	PP,FT
	POP	PP,FLG
	POP	PP,FTL
	POP	PP,P4
	POP	PP,P3
	POP	PP,P2
	POP	PP,P1		;RESTORE P1
	POPJ	PP,		;DONE, RETURN

SUBTTL	SETEN - SETUP FS.EN BECAUSE THE USER WANTS IT

;ASSUMES: FT POINTS TO FILE-TABLE OF CURRENT FILE
;	BS.AGL IS THE BASE OF THE ARG LIST FOR THIS I/O VERB.

SETEN:				;[M1071]
	SETZM	FS.EN##		;[1071]
	LDB	T1,BP%IVB	;IS THIS AN I-O VERB? [M1071]
	JUMPE	T1,SETEN1	;NO, ARGLIST IS NOT RELEVANT
	MOVE	T1,@BS.AGL##	;GET CONTENTS OF BASE OF ARG LIST TO GET VERB
	LDB	T1,VB.PTR	;GET VERB
	CAIN	T1,V%OPS5	;IS THIS RMS I-O?
	MOVEI	T1,1		;LET IT HAVE OPEN'S INDEX FOR ERROR.
	MOVE	T1,ENADDT(T1)	;GET NUMBER TO ADD
	MOVEM	T1,FS.EN	;[1017] STORE VERB TYPE
SETEN1:	LDB	T1,BP%ENO	; GET ERROR MESSAGE NUMBER
	SKIPE	ER.MCL		;CD=0?
	 HRRZ	T1,ER.HIJ	;NO, GET USER-SUPPLIED NUMBER
	ADDM	T1,FS.EN	; ADD IT IN
	MOVE	T1,ER.MCL	;GET CD = MONITOR CALL CODE
	IMULI	T1,^D100000	;SHIFT TO PROPER PLACE
	ADDM	T1,FS.EN	; ADD IT IN
	POPJ	PP,

SUBTTL	GETFTP - GET FILE-TYPE CODE IN T2, ISAM-BLOCK TYPE IN T3

GETFTP:	SETZB	2,3		;FOR AN RMS FILE..
	POPJ	PP,		;DONE, RETURN

SUBTTL	THE ERROR MESSAGES

DEFINE EE(NUM,TEXT),<
ER'NUM:	[ASCIZ\TEXT\]
>

;[V12B] STARTING AT ERROR 500
EE 500,<RMS-SYSTEM failure> ;catch-all for many RMS funnies
EE 501,<Attempt to DELETE or REWRITE and file not open for I-O>
EE 502,<Attempt to REWRITE and file not open for I-O>
EE 503,<Not enough free memory to OPEN file>
EE 504,<Another file that shares same area is open>
EE 505,<Attempt to READ and file not open for INPUT or I-O>
EE 506,<Attempt to change secondary key value in RMS file
        that does not allow that>
EE 507,<File parameters do not match program parameters>
EE 508,<File not found>
EE 509,<Cannot OPEN file: already open>
EE 510,<Cannot OPEN file: it has been closed with LOCK>
;;;;; ** TEMP MESSAGE UNTIL V13 ** ;;;;;;
EE 511,<Cannot OPEN file in an overlay>
EE 512,<Cannot CLOSE file: it is not open>
EE 513,<Attempt to WRITE and file not open for OUTPUT or I-O or EXTEND>
EE 514,<Attempt to START and file not open for INPUT or I-O>
EE 515,<Attempt to WRITE indexed file seq. access mode
        and file not open for OUTPUT>
EE 516,<REWRITE in seq. access file was not immediately proceeded
        by a successful READ.>
EE 517,<DELETE in file with access sequential not immediately preceeded
        by a successful READ.>
EE 518,<Cannot READ sequentially: previous READ failed>
EE 519,<File is not a valid RMS file type>
EE 520,<File is busy.>
EE 521,<Cannot OPEN file: System protection violation.>
EE 522,<Attempt to change record size on REWRITE.>
EE 523,<Primary key in RMS indexed file allows duplicates;
	this is contrary to the COBOL language standard.>	;no longer used
EE 524,<File Organization improperly set, Compiler Error.>
EE 525,<Optional Sequential Input File not Present, Proceeding Without It...>
EE 526,<Simultaneous Update of RMS files requires APPLY BASIC-LOCKING.>
EE 527,<Attempt to write zero-length ASCII STREAM record. Ignored.>
EE 528,<Simultaneous Update with Retain cannot be used for Sequential Files>
EE 529,<Attempt to use START verb when file is opened for Simultaneous Update> ;[1162] obsolete
EE 530,<Simultaneous Update requires RMS Version 2, Version 1 has been loaded>
EE 531,<Attempting to use RMS V2 features with RMS V1 loaded in OTS>
EE 532,<DELETE or REWRITE with APPLY BASIC-LOCKING not preceeded by a
	 successful READ.>
EE 533,<Size of data record in file is greater than format of data record in
	program.>
EE 534,<TOPS-20 ENQ lock quota exceeded> ;[1155]
EE 535,<Attempt to execute START verb within scope of RETAIN and FREE statements> ;[1162]

SUBTTL	TOPS10 ADDITIONAL ERROR VALUES

IFE TOPS20,<

DEFINE E10(NUM,TEXT),<
ET'NUM:	[ASCIZ\TEXT\]
>

E10 0,<Invalid project/programmer number>
E10 1,<Device not available>
E10 2,<No such device>
E10 3,<SFD not found>

>;END IFE TOPS20

END