Google
 

Trailing-Edge - PDP-10 Archives - BB-H506E-SM - cobol/source/rmsio.mac
There are 20 other files named rmsio.mac in the archive. Click here to see a list.
; UPD ID= 3551 on 5/14/81 at 4:48 PM by WRIGHT                          
TITLE	RMSIO FOR LIBOL V12C
SUBTTL	D. WRIGHT

	SEARCH	COPYRT
	SALL

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1979, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

;EDITS
;NAME	DATE		COMMENT
;JEH	13-APR-84	[1116] Reset file status before retrying file open
;JEH	18-JUL-83	[1073] Add $ERASE call if CLOSE WITH DELETE
;SMI	14-OCT-82	[1046] Fix CHECKPOINT with RMS files for DELETE, and
;				REWRITE.
;JSM	18-OCT-82	[1045] Use $MESSAGE in RMSGET as first RMS-20 call to
;				initialize RMS-20 global data symbols.
;RLF	08-OCT-82	[1044] Space fill record area
;RJD	21-APR-82	[1020] Test for CHECKPOINT with RMS files
;RJD	29-APR-82	[1022] Deallocate memory if OPEN fails



SEARCH	LBLPRM		;GET LIBOL PARAMETERS

;GET APPROPRIATE SYSTEM SYMBOLS
;Note: The monitor symbol universal files must be searched before
;COMUNI to avoid conflicts with LOAD and STORE macros

IFN TOPS20,	SEARCH	MONSYM,MACSYM
IFE TOPS20,	SEARCH	UUOSYM,MACTEN

SEARCH	COMUNI		;GET COMMON SYMBOLS, MACROS
SEARCH	FTDEFS		;FILE-TABLE DEFINITIONS
SEARCH	RMSINT		;AND RMS SYMBOLS

SALL
HISEG


	.COPYRIGHT		;Put COPYRIGHT statement in .REL file.

;****** MAGIC NUMBERS FIXED IN NEXT VERSION OF RMSINT ********
	BA$OVH==6		;HEADER WORDS IN A BUCKET
	BA$WPU==^D512		; WORDS PER BUCKET UNIT
;*************************************************************

T0=0
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
;RMS ENTRY POINTS
ENTRY	OP.MIX		;OPEN RMS INDEXED FILE
ENTRY	CL.MIX		;CLOSE RMS INDEXED FILE
ENTRY	WT.MIR		;WRITE- RMS INDEXED RANDOM
ENTRY	WT.MIS		;WRITE- RMS INDEXED SEQUENTIAL
ENTRY	RD.MIR		;READ- RMS INDEXED RANDOM
ENTRY	RD.MIS		;READ- RMS INDEXED SEQUENTIAL
ENTRY	DL.MIR		;DELETE RMS INDEXED (RANDOM ACCESS)
ENTRY	DL.MIS		;DELETE RMS INDEXED (SEQUENTIAL ACCESS)
ENTRY	RW.MIR		;REWRITE- RMS INDEXED (RANDOM ACCESS)
ENTRY	RW.MIS		;REWRITE- RMS INDEXED (SEQUENTIAL ACCESS)
ENTRY	ST.MEQ		;START- RMS EQUAL
ENTRY	ST.MGT		;START- RMS GREATER THAN
ENTRY	ST.MNL		;START- RMS NOT LESS THAN

;ROUTINES CALLED BY OTHER PARTS OF LIBOL:
ENTRY	RMSGET		;GET RMS IN CORE AND TELL IT WHERE THE CORE MANAGER IS

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

OPDEF	PJRST	[JRST]
SUBTTL	EXTERNAL ROUTINES AND SYMBOLS

;ROUTINES IN LBLERR:
EXTERN	LBLERR		;THE ERROR ROUTINE
EXTERN	SETFS		;SET FILE-STATUS FROM FS.FS
EXTERN	SETEFS		;SET ERROR-FILE-STATUS VARIABLES
EXTERN	CHKUSE		;CHECK FOR USE PROCEDURE
EXTERN	RMSERP		;RMS-ERROR REPORT FOR UNEXPECTED ERRORS

;CONVERSION ROUTINES:
EXTERN	C.D6D7,C.D7D6,C.D6D9,C.D9D6,C.D7D9,C.D9D7

;IN LILOWS:
EXTERN	CVPRM.		;2-WORD BLOCK TO HOLD CONVERSION PARAMETERS
EXTERN	FS.ZRO,FS.IF,FS.FS
IFN TOPS20,<
EXTERN	ER.JSE		;JSYS ERROR CODE STORED FOR $ERROR PROCESSING
>
IFE TOPS20,<
EXTERN	ER.E10		;TOPS10 ERROR CODE STORED FOR $ERROR PROCESSING
>
EXTERN	ER.RBG		;RMS BUG ERROR CODE
SUBTTL	DEFINITIONS (SHARED WITH CBLIO)

F.RAD==3	;FUNCT. FUNCTION TO RETURN CORE AT ADDRESS
F.PAG==15	;FUNCT. FUNCTION TO GET CORE ON PAGE BOUNDARY

;FLAGS FOR OLD V12B STYLE THINGS, IN F.WFLG
DDMASC==400000		;DEVICE DATA MODE IS ASCII
DDMEBC==100000		;DEVICE DATA MODE IS EBCDIC
OPNIN==20000		;FILE IS OPEN FOR INPUT
OPNOUT==10000		;FILE IS OPEN FOR OUTPUT

;SOME V12B THINGS THAT WILL BE COMPLETELY DIFFERENT IN V13
FT.BBL:	POINT 1,F.WBLC(FT),6	;FILE IS IN OVERLAY
FT.BLF:	POINT 1,D.LF(FT),16	;LOCKED
FT.MRS:	POINT 12,F.WMRS(FT),17	;MAX RECORD SIZE (CHARACTERS)
FT.PPN: POINT 18,F.RPPN(FT),35	;ADDRESS OF USER-NUMBER
FT.DIO:	POINT 1,F.WDIO(FT),5	;DEFERRED OUTPUT BIT
FT.CKP:	POINT 1,F.CKP(FT),9	;CHECKPOINT OUTPUT
FT.CRC: POINT 8,F.CRC(FT),17	;[1020] CHECKPOINT RECORD COUNT
FT.NAB:	POINT 6,F.WNAB(FT),5	;NUMBER OF ALTERNATE BUFFERS

;FOR CALLS TO CHKUSE:
UP%ERR==0		;CHECK FOR ERROR USE PROCEDURE
UP%OER==1		;FILENAME OPEN USE PROCEDURE

IFE TOPS20,<
;PAGE THAT RMS USES FOR ITS GLOBAL STORAGE
	.RGLBP==572	;AND THE NEXT ONE, TOO..
>;END IFE TOPS20


;RANDOM FLAG DEFINITIONS THAT FOR V13 WILL BE DEFINED IN FTDEFS

CF%CNV==1B18		;CONVERSION REQUIRED
LF%FNA==1B32		;FILENAME IS IN ASCII
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)
SUBTTL	PROTOTYPE RMS STRUCTURES

;HA HA  THE RMS PEOPLE MADE THIS NECESSARY.

;PROTOTYPE FAB:
PRFAB:	FAB$B
	FAB$E
PRFABL==.-PRFAB		;LENGTH OF PROTOTYPE FAB

;PROTOTYPE RAB:
PRRAB:	RAB$B
	RAB$E
PRRABL==.-PRRAB		;LENGTH OF PROTOTYPE RAB

;PROTOTYPE XAB:
PRXAB:	XAB$B	KEY
	X$FLG	XB$CHG	;DEFAULT IS TO ALLOW KEYS TO CHANGE
	XAB$E
PRXABL==.-PRXAB		;LENGTH OF PROTOTYPE XAB
SUBTTL	SETIO - ROUTINE TO SETUP FOR I/O

;CALLED BY EVERY I/O ENTRY POINT

SETIO:	MOVEM	ARG,BS.AGL##	;SAVE BASE OF ARG LIST
	HRRZ	FT,(ARG)	;GET FILE-TABLE ADDRESS
	HLLZ	FLG,(ARG)	;GET ARG-LIST FLAGS
	SKIPE	FTL,D.RMSP(FT)	;GET LIBOL FILE-TABLE ADDRESS
				;IF THIS IS AN OPEN, IT WILL SKIP UNLESS
				; THE FILE IS ALREADY OPEN.  ALL OTHER
				; VERBS WILL NOT SKIP HERE.
	 HRR	FLG,D.F1(FT)	;GET LIBOL FILE FLAGS

;ZERO THE ERROR STATUS WORDS
	MOVE	T1,[FS.ZRO,,FS.FS] ;ZERO THE ERROR STATUS WORDS
	BLT	T1,FS.IF
	POPJ	PP,		;RETURN
SUBTTL	RMSGET - GET RMS, AND SET IT UP

;THIS ROUTINE WILL ONLY BE USED FOR LIBOL 12B. V13 DOESN'T NEED
; ANY SUCH THING.

;CALL:	PUSHJ	PP,RMSGET
;	<RETURN HERE>, OR IF ERRORS, GO TO KILL
;	USES AC1-AC4

IFN TOPS20,<
RMSNMP:	POINT 7,[ASCIZ/SYS:RMSCOB.EXE/]	;SPECIAL EXE FILE FOR RMS
>;END IFN TOPS20

IFE TOPS20,<
RMSNMP:	SIXBIT	/SYS/
	SIXBIT	/RMSCOB/
	SIXBIT	/EXE/
	0
	0		;PROJ,,PROG
	RMS.FP,,RMS.LP	;WHICH PAGES OF RMSCOB.EXE TO MERGE
>;END IFE TOPS20

RMSGET:	MOVEI	T1,ER$BUG	;GET RMS "BUG" ERROR CODE
	MOVEM	T1,ER.RBG	;TELL LBLERR
IFN TOPS20,<
	SKIPE	SLRSW.##	;WAS PROGRAM COMPILED WITH /R?
	 JRST	RMSGSR		;YES, JUST FIND ENTRY VECTOR
	MOVX	T1,GJ%OLD!GJ%SHT
	MOVE	T2,RMSNMP
	GTJFN%
	 ERJMP	RGETE1		;?NO RMS
	PUSH	PP,T1		;SAVE THE JFN
	MOVEI	T1,.FHSLF	;SAVE ENTRY VECTOR INFO
	GEVEC%			; (GET% SMASHES IT)
	PUSH	PP,T2		;SAVE THE INFO
	MOVE	T1,-1(PP)	;GET BACK JFN
	HRLI	T1,.FHSLF	;READ INTO SAME FORK
	TXO	T1,GT%NOV	;DON'T OVERLAY EXISTING PAGES!
	GET%
	 ERJMP	RGETE2		;FAILED
	MOVEI	T1,.FHSLF	;GET RMS'S ENTRY VECTOR
	GEVEC%
	MOVE	T4,T2		;SAVE IN T4
	POP	PP,T2		;ENTRY VECTOR INFO
	MOVEI	T1,.FHSLF
	SEVEC%			;SET IT BACK TO WHAT IT WAS
	POP	PP,(PP)		;FORGET JFN, DON'T CARE ANYMORE

;TELL SYSTEM THAT WE HAVE AN RMS ENTRY VECTOR
	SKIPA	T2,T4		;ENTRY VECTOR WORD
RMSGSR:	MOVE	T2,[RMS.EV##]	;GET RMS'S ENTRY VECTOR WORD
	JUMPE	T2,RSBADV	;BAD ENTRY VECTOR
	HRRZ	T1,T2		;Get address of start of entry vector
	MOVE	T1,2(T1)	;Get version number word
	MOVEM	T1,RMSVR.##	;Save it incase LIBOL wants to print it
	MOVEI	T1,.FHSLF	;SET MY FORK'S
	SDVEC%			;RMS ENTRY VECTOR

;DISABLE TRAPS FOR REFS OF NON-EX PAGE
; SO PA1050 DOESN'T BOMB OUT RMS
	MOVEI	T1,.FHSLF
	MOVX	T2,1B<.ICNXP>
	DIC%
	$MESSAGE		;[1045] TURN ON RMS-20 INTERNAL MESSAGE
				;[1045] REPORTING AND ALSO INITIALIZE THE
				;[1045] AREA FOR RMS-20 GLOBAL DATA SYMBOLS.
	POPJ	PP,		;RETURN
>;END IFN TOPS20

IFE TOPS20,<
;TOPS10 - READ IN RMS
	SKIPE	SLRSW.##	;SKIP IF NOT /R
	 POPJ	PP,		;EVERYTHING TAKEN CARE OF

;SAVE ACS OVER MERGE. UUO CALL
	MOVE	T1,[T1,,ACSAV0##]
	BLT	T1,ACSAV0+16	;SAVE ACS THRU PP

;See if RMS is already part of the OTS
	MOVE	T1,[.PAGCA,,RMS.FP]
	PAGE.	T1,		;Get access info for page
	  HALT			;Should never fail
	JUMPL	T1,RMSMRG	;Does not exist yet
	MOVE	T1,RMS.FP*1000+.JBHNM
	CAMN	T1,['RMSCOB']	;Is it what we expected?
	JRST	RMSGOT		;Yes, we already have RMS
RMSMRG:	MOVEI	T1,RMSNMP	;POINT TO NAME BLOCK
	MERGE.	T1,		;MERGE IN RMS
	 HALT	.		;TYPE MONITOR ERROR MESSAGE AND DIE
RMSGOT:	MOVE	T1,[ACSAV0,,T1]
	BLT	T1,PP		;RESTORE ACS

;Save version number of RMS for LIBOL error printing
	HLRZ	T1,RMSNMP+5	;Get starting page number
	LSH	T1,^D9		;Shift to make address
	MOVE	T1,4(T1)	;Get version number from EXE file
	MOVEM	T1,RMSVR.##	;Save RMS version number

;DO THE PAGE. UUO TO CREATE THE PAGES THAT RMS NEEDS
	MOVE	T1,[.PAGCD,,[EXP 2
			EXP .RGLBP
			EXP .RGLBP+1]]
	PAGE.	T1,		;CREATE THE PAGES FOR RMS GLOBAL STORAGE
	 JRST	PGUFAI		;;FAILED, GO COMPLAIN
	POPJ	PP,		;ALL OK, RETURN


PGUFAI:	TYPE	[ASCIZ/?PAGE. UUO FAILED -- CANNOT SET UP RMS STORAGE
/]
	JRST	KILL.##		;GO BOMB OUT PROGRAM
>;END IFE TOPS20
;STORE POINTER TO THIS BLOCK IN RMS ENTRY VECTOR
;RSEBLK:	EXP	FUNCT.##	;ADDRESS OF FUNCT. ROUTINE
;ERRORS GETTING RMS
IFN TOPS20,<
;GTJFN FAILED
RGETE1:	TYPE	[ASCIZ/? /]
	HRRZ	T1,RMSNMP	;GET NAME
	TYPE	<(T1)>		;TYPE IT
	TYPE	[ASCIZ/ is not accessible/]
	JRST	RSFAIL		;SAY "RMS-SYSTEM FAILURE"

;THE "GET" FAILED
RGETE2:	TYPE	[ASCIZ/? /]
	POP	PP,(PP)		;FORGET ENTRY VECTOR INFO
	MOVEI	T1,.FHSLF	;GET THE ERROR
	GETER%
	CAMN	T2,[.FHSLF,,GETX3] ;TRYNG TO OVERLAY EXISTING PAGES?
	 JRST	RGETE3		;YES
	TYPE	[ASCIZ/Can't GET /]
	HRRZ	T1,RMSNMP	;GET ADDR OF THE ASCIZ NAME
	TYPE	<(T1)>		;TYPE NAME
	TYPE	[ASCIZ/: /]
	PUSHJ	PP,LSTFER	;TYPE LAST ERROR IN THIS FORK
RSFAIL:	$ERROR	(E.500,SV.KIL)	;RMS-SYSTEM FAILURE

RGETE3:	TYPE	[ASCIZ/?Can't GET RMS: Program too big/]
	JRST	RSFAIL		;RMS-SYSTEM FAILURE ERROR

RSBADV:	TYPE	[ASCIZ/RMS entry vector is invalid -- RMS not loaded?/]
	JRST	RSFAIL		;GO DIE OFF
>;END IFN TOPS20
IFN TOPS20,<

SUBTTL	LSTFER - ROUTINE TO TYPE LAST ERROR IN THIS FORK

;CALL:	PUSHJ	PP,LSTFER
;	<RETURN HERE ALWAYS>

LSTFER:	MOVEI	T1,.PRIOU	;OUTPUT TO TERMINAL
	HRLOI	T2,.FHSLF	;LAST ERROR IN THIS FORK
	SETZ	T3,		;ALL OF THE TEXT
	ERSTR%
	 JFCL
	  JFCL
	POPJ	PP,		;RETURN
>;END IFN TOPS20

;SAVE AC ROUTINE.
;THIS SAVES ALL THE IMPORTANT ACS USED BY RMSIO.

SVPACS:	EXCH	P1,(PP)		;SAVE P1,GET CALLER PC
	HRLI	P1,(PP)		;GET ADDRESS WHERE P1 IS SAVED
	PUSH	PP,FLG		;SAVE FLAGS
	PUSH	PP,FT		;SAVE FILE-TABLE PTR
	PUSH	PP,FTL		;SAVE OTHER FILE-TABLE PTR
	PUSHJ	PP,SAVJMP	;STACK NEW RETURN PC AND JUMP
	 SOS	-4(PP)		;NON-SKIP RETURN, COMPENSATE CPOPJ1
	POP	PP,FTL		;RESTORE FTL
	POP	PP,FT		;RESTORE FT
	POP	PP,FLG		;RESTORE FLG
	POP	PP,P1		;RESTORE P1
	AOS	(PP)		;INCREMENT PC
	POPJ	PP,		;RETURN

;THE FOLLOWING INSTRUCTION RESTORES P1 AND DISPATCHES TO THE CALLER.
SAVJMP:	JRA	P1,(P1)		;RETURN TO CALLER
SUBTTL	OP.MIX -- OPEN RMS INDEXED FILE

;CALL:
;	MOVEI	16,ARGLIST
;	PUSHJ	PP,OP.MIX
;	<RETURN>

;ARGUMENT FORMAT:
;
;ARGLIST:	FLAG-BITS,,FILTAB-ADDR
;		0,,ADDR-OF-KEY-INFO
;
;FLAG-BITS:
	OPN%IN==1B9		;OPEN FOR INPUT
	OPN%OU==1B10		;OPEN FOR OUTPUT
	OPN%IO==1B11		;OPEN FOR I-O
				; ALL BITS 9-11 ON FOR OPEN I-O
;NO REWIND, OPEN EXTEND, OPEN REVERSED NOT SUPPORTED

;KEY INFORMATION:
;	OCT	NUMBER OF KEYS
;	(2 WORDS FOR EACH KEY, AS FOLLOWS):
;	XWD  BYTE POSITION,,KEY SIZE
;	XWD  FLAGS,,DATATYPE
;
;  WHERE FLAGS ARE:
	KI%DUP==1B0		;DUPLICATE KEYS ALLOWED
;
;AND DATATYPE VALUES ARE:
;	SIXBIT=0, ASCII=1, EBCDIC=2

;NO REWIND, OPEN EXTEND, OPEN REVERSED NOT SUPPORTED.

OP.MIX:	PUSHJ	PP,SETIO	;SETUP FOR I/O
	LDB	T0,FT.CRC	;[1020] IS THERE CHECKPOINTING?
	JUMPE	T0,.+2		;[1020] NO
	MOVEM	T0,D.CRC(FT)	;[1020] YES, INITIALIZE RECORD COUNT

;CAN'T OPEN FILE FROM OVERLAY
	LDB	T1,FT.BBL
	JUMPE	T1,OPEOVL

;CAN'T OPEN FILE IF ALREADY OPEN
	TXNE	FLG,LF%INP!LF%OUT ;IS THE FILE OPEN?
	 JRST	OPEALO		;YES, ERROR

;CAN'T OPEN FILE IF IT IS "LOCKED"
	LDB	T1,FT.BLF
	JUMPN	T1,OPELCK


;FALL TO NEXT PAGE IF EVERYTHING OK SO FAR
;CHECK FOR FILES THAT SHARE THE SAME BUFFER. NONE OF THEM
; MAY BE OPEN AT THIS POINT.
	HLRZ	T4,F.LSBA(FT)	;FILTAB THAT SHARES THE SAME BUFFER
OP.M0A:	JUMPE	T4,OP.MX0	;JUMP IF NO ONE SHARES
	CAIN	T4,(FT)		;HAVE WE CHECKED ALL "SBA" FILES?
	 JRST	OP.MX0		;YES

	LDB	T1,[POINT 1,F.RMS(T4),7] ;RMS BIT FOR THIS FILE
	JUMPN	T1,OP.SA1	; JUMP IF THIS SBA FILE IS AN RMS FILE

; NON-RMS, V12B FILES:
	HLL	T4,F.WFLG(T4)	;GET THE FLAGS
	TLNE	T4,OPNIN!OPNOUT	;SKIP IF ANY FILES ARE NOT OPEN
	 JRST	OP.M0B		;GIVE ERROR
	JRST	OP.SA2
; END OF NON-RMS, V12B FILES

; RMS FILES ONLY FOR V12B, THIS CODE WILL BE VALID FOR ALL V13 FILES
OP.SA1:	HRR	T1,D.F1(T4)	;GET V13 STYLE FLAGS FOR THIS FILE
	TXNE	T1,LF%INP!LF%OUT	;IS THIS FILE OPEN?
	 JRST	OP.M0B		;YES, GIVE ERROR
; END OF RMS CODE

OP.SA2:	HLRZ	T4,F.LSBA(T4)	;GET NEXT "SBA" FILTAB
	JRST	OP.M0A		;LOOP

;** ERROR: ANOTHER FILE THAT SHARES THE SAME BUFFER IS ALREADY OPEN
OP.M0B:	$ERROR	(E.504,SV.KIL,MT.FIL)

;** ERROR: FILE CANNOT BE OPENED: ALREADY OPEN
OPEALO:	$ERROR	(E.509,SV.KIL,MT.FIL)

;** ERROR: FILE IS LOCKED
OPELCK:	$ERROR	(E.510,SV.KIL,MT.FIL)

;** ERROR: CAN'T OPEN FILE IN OVERLAY  (TEMP ERROR)
OPEOVL:	$ERROR	(E.511,SV.KIL,MT.FIL)
;HERE IF OPEN IS GOING OK SO FAR.
;SEE IF CONVERSION REQUIRED. IF YES, SET UP AN ALTERNATE RECORD
; AREA AND KEY BUFFER.
;NOTE: FROM HERE UNTIL AFTER FUNCT. IS CALLED,
;	WE WILL USE TEMPORARY VARIABLES ON THE STACK.
;	0(PP) = # WORDS NEEDED FOR CONVERSION RECORD BUFFER
;	-1(PP) = # WORDS NEEDED FOR CONVERSION KEY BUFFER

OP.MX0:	PUSH	PP,[0]		; SET # WORDS NEEDED FOR CONVERSION
	PUSH	PP,[0]		; BUFFERS
	MOVE	T3,F.WFLG(FT)	;GET FLAGS
;** CHANGE IN V13:
	LDB	T1,[POINT 3,T3,14] ;GET INTERNAL RECORDING MODE
	LDB	T2,[POINT 3,T3,2] ;GET EXTERNAL RECORDING MODE
	CAMN	T1,T2		;THE SAME?
	 JRST	OP.M0C		;YES

;Conversion is required.
;  Find the size of the largest key, and reserve some words
;for the conversion key buffer.
;  Then reserve as many words as we need to store the converted record.
	MOVX	T1,CF%CNV	;NOTE "CONVERSION REQUIRED"
	IORM	T1,D.F1(FT)
	TXO	FLG,CF%CNV	;NOTE CONVERSION REQUIRED

;SET T4= # BYTES/WORD FOR THIS RECORDING MODE
	MOVE	T3,F.WFLG(FT)	;GET COMPILER FLAGS
	MOVEI	T4,6		; ASSUME SIX BYTES PER WORD
	TLNE	T3,DDMASC	; IS IT ASCII?
	 MOVEI	T4,5		;YES, FIVE BYTES PER WORD
	TLNE	T3,DDMEBC	; IS IT EBCDIC?
	 MOVEI	T4,4		;YES, FOUR BYTES PER WORD

;FIND T1=SIZE OF LARGEST KEY
	HRRZ	T3,BS.AGL	;LOOK AT THE KEY INFO
	HRRZ	T3,1(T3)	;SO WE CAN FIND THE LARGEST KEY
	MOVE	T2,(T3)		;T2= NUMBER OF KEYS
	ADDI	T3,1		;T3 POINTS TO FIRST 2-WORD KEY BLOCK
	SETZ	T1,		;ANYTHING IS BIGGER THAN THIS
OP.M0E:	HRRZ	T0,(T3)		;GET SIZE OF THIS KEY
	CAILE	T0,(T1)		;SKIP IF NO BIGGER THAN ANOTHER KEY
	HRRZ	T1,T0		;USE THIS ONE
	ADDI	T3,2		;BUMP UP TO NEXT KEY INFO BLOCK
	SOJG	T2,OP.M0E	;LOOP FOR ALL KEYS
	ADDI	T1,-1(T4)	;FIND # WORDS NEEDED
	IDIV	T1,T4
	MOVEM	T1,-1(PP)	;STORE ON THE STACK

;GET T1= # WORDS NEEDED FOR THE RECORD
	LDB	T1,FT.MRS	;GET MAX RECORD SIZE
	ADDI	T1,-1(T4)
	IDIV	T1,T4		;GET # WORDS NEEDED
	MOVEM	T1,0(PP)	;STORE ON THE STACK

;GET CORE FOR RMS-TYPE BLOCKS:  FAB, RAB, AND KEY XAB'S.
; GET T1:= # WORDS NEEDED, STORE IN FUN.A2
OP.M0C:	MOVEI	T1,.RCLEN	;NEED A CONTROL-BLOCK
	ADDI	T1,FA$LNG	; AND A FAB
	ADDI	T1,RA$LNG	; AND A RAB

;FIND # OF KEYS, PUT IN T2
	HRRZ	T3,BS.AGL	;LOOK AT BASE OF ARG LIST
	HRRZ	T3,1(T3)	;GET ADDR OF KEY INFO
	MOVE	T2,(T3)		;FIRST WORD = # OF KEYS
	IMULI	T2,XA$LNG	; NEED THIS MANY WORDS FOR EACH KEY
	ADD	T1,T2		;ADD TO NUMBER OF WORDS NEEDED
	ADD	T1,(PP)		;ADD NUMBER OF WORDS NEEDED FOR
	ADD	T1,-1(PP)	; CONVERSION BUFFERS

	MOVEM	T1,FUN.A2	;** STORE # WORDS NEEDED **

	MOVEI	ARG,1+[-5,,0
			XWD 0,FUN.A0##
			XWD 0,[ASCIZ/LBL/]
			XWD 0,FUN.ST##
			XWD 0,FUN.A1##
			XWD 0,FUN.A2##]
	MOVEI	T1,F.PAG	;FUNCTION WE WANT
	MOVEM	T1,FUN.A0##	;STORE FUNCTION
	SETZM	FUN.ST##	;CLEAR STATUS
	SETZM	FUN.A1##	; AND ADDRESS RETURNED
	PUSHJ	PP,FUNCT.##	;CALL FUNCT. ROUTINE
	POP	PP,T4		;RESTORE # WORDS USED FOR CONVERSION BUFFERS
	POP	PP,T3		;KEY BUFFER
	SKIPE	FUN.ST##	;STATUS MUST BE 0...
	 JRST	MNCR		; ? NOPE - NO CORE AVAILABLE

;STORE POINTER TO CONTROL-BLOCK IN THE FILE-TABLE
	HRRZ	FTL,FUN.A1##	;GET ADDRESS OF CORE WE GOT
	MOVEM	FTL,D.RMSP(FT)	; SAVE ADDR OF RMS CONTROL-BLOCK

;FTL:= ADDR OF CONTROL BLOCK.

;STORE # WORDS OF MEMORY WE JUST OBTAINED IN THE CONTROL BLOCK
	MOVE	T1,FUN.A2##	;(IT'S STILL HERE)
	MOVEM	T1,.RCMEM(FTL)

; STORE ADDR OF FAB, RAB, AND FIRST XAB IN THE CONTROL BLOCK
	MOVEI	T1,.RCLEN(FTL)	;ADDR OF FAB
	MOVEM	T1,.RCFAB(FTL)	;STORE ADDR OF FAB
	ADDI	T1,FA$LNG
	MOVEM	T1,.RCRAB(FTL)	;ADDR OF THE RAB
	ADDI	T1,RA$LNG
	TXNN	FLG,CF%CNV	;SKIP IF CONVERSION REQUIRED
	 JRST	OP.M0D		;NO
	MOVEM	T1,.RCCRB(FTL)	;CONVERSION RECORD BUFFER
	ADD	T1,T4		;ADD # WORDS NEEDED FOR RECORD BUFFER
	MOVEM	T1,.RCCKB(FTL)	;CONVERSION KEY BUFFER
	ADD	T1,T3		;ADD # WORDS NEEDED FOR KEY BUFFER


;MAKING SURE TO PRESERVE T1 FOR OP.M0D, WE WILL NOW
; GET THE ADDRESSES OF THE CONVERSION ROUTINES, AND STORE THEM
; IN .RCCRS:
	MOVE	T0,F.WFLG(FT)	;GET COMPILER FLAGS
	LDB	T2,[POINT 2,T0,14] ;INTERNAL RECORDING MODE..
	LDB	T3,[POINT 2,T0,2] ;EXTERNAL RECORDING MODE..
	XCT	GETCRF(T2)	;GET "FROM" ROUTINE
	HRLM	T4,.RCCRS(FTL)	;STORE IN LH(.RCCRS)
	EXCH	T2,T3		;NOW GET THE REVERSE ROUTINE
	XCT	GETCRF(T2)
	HRRM	T4,.RCCRS(FTL)	;STORE IN RH(.RCCRS)
	JRST	OP.M0D		;GO ON
;XCT TABLE
GETCRF:	HRRZ	T4,CV.A(T3)	;GET ASCII TO .. ROUTINE
	HRRZ	T4,CV.E(T3)	;GET EBCDIC TO.. ROUTINE
	HRRZ	T4,CV.S(T3)	;GET SIXBIT TO.. ROUTINE

;CONVERSION TABLES.
CV.A:	0		;7-7 NO CONVERSION
	C.D7D9		;7-9
	C.D7D6		;7-6
CV.E:	C.D9D7		;9-7
	0		;9-9 NO CONVERSION
	C.D9D6		;9-6
CV.S:	C.D6D7		;6-7
	C.D6D9		;6-9
	0		;6-6 NO CONVERSION

;COME HERE IF FUNCT. FAILED TRYING TO GET CORE FOR THE OPEN
MNCR:	MOVEI	T1,^D30		;SET FILE-STATUS TO
	MOVEM	T1,FS.FS	; "PERMANENT ERROR"
	PUSHJ	PP,SETFS
	$ERROR	(E.503,SV.FAT,MT.FIL,MNCR1)	;NOT ENOUGH CORE TO OPEN FILE

;ERROR HAS BEEN TRAPPED BY THE USER, NOW HE WANTS TO "IGNORE" IT
MNCR1:	POPJ	PP,		;** RETURN FROM OPEN **
;Come here with T1 = address where we will put the first XAB.
; Conversion buffers have been allocated if necessary.

OP.M0D:	MOVEM	T1,.RCXAB(FTL)	;ADDR OF THE FIRST XAB

;Now setup the RMS structures. (the assigned space is
;empty at this point).

;Start with the prototypes.
	HRLZI	T1,PRFAB	;FROM PROTOTYPE FAB
	HRR	T1,.RCFAB(FTL)	; TO REAL FAB
	HRRZI	T2,PRFABL-1(T1)	;COPY ALL OF PROTOTYPE
	BLT	T1,(T2)

	HRLZI	T1,PRRAB	;FROM PROTOTYPE RAB
	HRR	T1,.RCRAB(FTL)	; TO REAL RAB
	HRRZI	T2,PRRABL-1(T1)	;COPY ALL OF PROTOTYPE
	BLT	T1,(T2)

;MAKE RAB POINT TO THE FAB.
	MOVE	T3,.RCRAB(FTL)	;T3 POINTS TO RAB
	MOVE	T1,.RCFAB(FTL)	;T1 POINTS TO FAB
	$STORE	T1,FAB,(T3)

;STORE INFO INTO THE XAB'S.
	HRRZ	T3,BS.AGL	;LOOK AT BASE OF ARG LIST
	HRRZ	T3,1(T3)	;GET ADDR OF KEY INFO
	MOVEM	T3,.RCKIN(FTL)	;SAVE IT FOR OTHER OPERATIONS
	MOVE	T4,(T3)		;T4:= FIRST WORD = # OF KEYS
	MOVN	T4,T4		;GET -N
	HRLZ	T4,T4		;GET -N,,0
	MOVE	T2,.RCXAB(FTL)	;T2= ADDR OF FIRST XAB
	ADDI	T3,1		;T3 POINTS TO FIRST 2-WORD KEY BLOCK

;HERE WITH T2= ADDRESS OF XAB
;	RH(T4)= NUMBER OF THIS KEY
;	T3= ADDRESS OF THIS KEY BLOCK
OP.MX1:	HRLZI	T1,PRXAB	;COPY A PROTOTYPE XAB
	HRR	T1,T2
	BLT	T1,PRXABL-1(T2)	;COPY WHOLE PROTOTYPE
	HRRZ	T1,T4		;;THE NUMBER OF THIS KEY
	$STORE	T1,REF,(T2)	;STORE IN REF FIELD
	TXNE	FLG,OPN%IN	;IF OPEN FOR INPUT OR I/O
	 JRST	OP.MX3		;DON'T HAVE TO SET IT UP
	HLRZ	T1,(T3)		;GET POSITION OF THE KEY
	$STORE	T1,POS,(T2)	;STORE IN XAB
	HRRZ	T1,(T3)		;GET SIZE OF THE KEY
	$STORE	T1,SIZ,(T2)	;STORE IN XAB
;
; THE DATATYPE PASSED IN THE KEY BUFFER IS NOT USED. IT IS ASSUMED
; TO BE THE SAME AS THE INTERNAL RECORDING MODE. WE WILL TELL RMS
; THAT THE DATATYPE IS THE SAME AS THE EXTERNAL RECORDING MODE.
	MOVE	T0,F.WFLG(FT)	;GET COMPILER FT FLAGS
	MOVEI	T1,XB$SIX	;ASSUME SIXBIT
	TLNE	T0,DDMASC	; IF ASCII,
	 MOVEI	T1,XB$STG	;GET ASCII DATATYPE
	TLNE	T0,DDMEBC	; IF EBCDIC,
	 MOVEI	T1,XB$EBC	;GET EBCDIC DATATYPE
	$STORE	T1,DTP,(T2)	;STORE IN XAB

;STORE KEY-SPECIFIC FLAGS
	$FETCH	T1,FLG,(T2)	;GET INITIAL FLAGS
	PUSH	PP,T2		;SAVE AN AC FOR A SEC..
	HLLZ	T2,1(T3)	;GET FLAGS FOR THIS KEY
	TXNE	T2,KI%DUP	;DUPLICATES ALLOWED?
	TXO	T1,XB$DUP	; YES, SET FLAG
	POP	PP,T2		;RESTORE T2
	$STORE	T1,FLG,(T2)	;STORE THE FLAGS

OP.MX3:	AOBJP	T4,OP.MX2	;JUMP IF NO MORE KEYS
	ADDI	T3,2		;BUMP TO NEXT KEY INFO BLOCK
	MOVEI	T1,XA$LNG(T2)	;ADDR OF NEXT XAB
	$STORE	T1,NXT,(T2)	;STORE IN THIS XAB
	MOVE	T2,T1		;GO BACK WITH T2= NEXT XAB
	JRST	OP.MX1		;LOOP FOR ALL KEYS

;HERE WHEN ALL KEY XAB'S HAVE BEEN CREATED
OP.MX2:	MOVE	T2,.RCXAB(FTL)	;T2 POINTS TO FIRST XAB
	$FETCH	T1,FLG,(T2)	;GET THE FLAGS
	TXZ	T1,XB$CHG	; VALUES MAY NOT CHANGE FOR PRIMARY KEY
	$STORE	T1,FLG,(T2)	; (THIS GETS RID OF DEFAULT XB$CHG)

;*** SETUP THE FAB ***
; MOST OF THE INFORMATION IS IN THE NORMAL FILE-TABLE.
	MOVE	T4,.RCFAB(FTL)	;T4 POINTS TO THE FAB

;FILE ACCESS DESIRED
	SETZ	T1,		;T1 WILL LIST THE OPERATIONS WE WANT TO DO
;IF OPEN FOR INPUT, NO BITS WILL BE SET IN "FAC".
	TXNE	FLG,OPN%OU	;OPEN FOR OUTPUT?
	TXO	T1,FB$PUT	;"PUT" ACCESS
	TXNE	FLG,OPN%IO	;OPEN FOR I-O?
	TXO	T1,FB$DEL!FB$UPD ;YES, ALSO ALLOW 'DELETE' AND 'UPDATE'
	$STORE	T1,FAC,(T4)	;STORE ACCESS WANTED

;OTHERS ACCESS
	SETZ	T1,		;ALWAYS SET TO 0 FOR V12B
	$STORE	T1,SHR,(T4)	;STORE OTHERS ACCESS

;FILE NAME
; RMS WANTS THIS IN ASCIZ.
	PUSHJ	PP,PICKFN	;CONVERT VALUE-OF-ID TO RMS FILENAME
	 JRST	RFNFER		;ERROR, GO RECOVER FROM FNF ERROR
	TXO	FLG,LF%FNA	;"FILENAME IS OK TO TYPE NOW"
	HRRM	FLG,D.F1(FT)	; REMEMBER THAT
	MOVE	T4,.RCFAB(FTL)	;GET PTR TO FAB AGAIN

;FILE ORGANIZATION
; THIS IS RETURNED TO US IF OPEN FOR INPUT OR I/O

	MOVEI	T1,FB$IDX	;*** WE ONLY DO INDEXED FILES FOR NOW
	$STORE	T1,ORG,(T4)

;*** RECORD ATTRIBUTES -- ALL ZERO FOR INDEXED FILES ***

;FILE OPTIONS
	LDB	T1,FT.DIO	;DEFERRED WRITE
	SKIPE	T1		;SKIP IF USER DIDN'T SPECIFY "DEFERRED WRITE"
	MOVEI	T1,FB$DFW	; SET THE BIT
	$STORE	T1,FOP,(T4)	;IN "FILE-OPTIONS"

;XAB ADDRESS
	MOVE	T1,.RCXAB(FTL)
	$STORE	T1,XAB,(T4)

;	** Leave maximum record size (MRS) at zero **
;	This allows a file to be created and then later
;	 the record size increased.

;BYTE SIZE
	MOVE	T0,F.WFLG(FT)	;GET COMPILER FLAGS
	LDB	T1,[POINT 2,T0,2]	;GET DEVICE DATA MODE
	MOVE	T2,[7
		    9
		    6](T1)	;GET BYTE SIZE DEPENDING ON MODE
	$STORE	T2,BSZ,(T4)

;T1 STILL CONTAINS THE MODE..

;BUCKET SIZE
	MOVE	T2,[5
		    4
		    6](T1)	;GET BYTES/WORD DEPENDING ON MODE
	LDB	T1,FT.MRS	;GET MAXIMUM RECORD SIZE
	IDIV	T1,T2		;GET T1=# WORDS, T2=REMAINDER
	SKIPE	T2		;ROUND UP
	ADDI	T1,1
	ADDI	T1,BA$OVH	;# HEADER WORDS PER BUCKET
	IDIVI	T1,BA$WPU	;GET # BUCKET UNITS NEEDED
	SKIPE	T2
	ADDI	T1,1		;ROUND UP
	$STORE	T1,BKS,(T4)

;SPACE FILL THE RECORD AREA
	MOVE	T0,F.WFLG(FT)	;[1044] GET FLAGS
	LDB	T3,[POINT 2,T0,2]
	MOVE	T2,[5
		    4
		    6](T3)	;[1044] BYTE/WORD IN T2
	LDB	T1,FT.MRS	;[1044] MAX RECORD SIZE
	IDIV	T1,T2		;[1044] # OF WORDS
	SKIPE	T2		;[1044] ROUND UP IF
	ADDI	T1,1		;[1044] ANY REMAINDER
	LDB	T3,[POINT 2,T0,14];[1044] INTERNAL DATA MODE
	MOVE	T0,SPCTLE(T3)	;[1044] GET SPACE
	MOVE	T2,F.RREC(FT)	;[1044] GET RECORD PTR
	MOVEM	T0,(T2)		;[1044] FILL FIRST LOC WITH SPACE
	HRLI	T0,(T2)		;[1044] THE FROM ADR
	HRRI	T0,1(T2)	;[1044] THE TO ADR
	ADDI	T1,-1(T2)	;[1044] THE UNTIL ADR
	BLT	T0,(T1)		;[1044] FILL WITH SPACES
	MOVE	T0,F.WFLG(FT)	;[1066] RESTORE SWITCH AC.

;RECORD FORMAT
	MOVEI	T1,FB$VAR	;VARIABLE LENGTH FORMAT
	$STORE	T1,RFM,(T4)

;SETUP SOME THINGS IN THE RAB, SINCE WE KNOW WHERE THE RECORD IS.
	MOVE	T2,.RCRAB(FTL)	;POINT TO THE RAB
	HRRZ	T1,F.RREC(FT)	;POINT TO RECORD
	TXNE	FLG,CF%CNV	;IF CONVERSION REQUIRED,
	 HRRZ	T1,.RCCRB(FTL)	;POINT TO CONVERTED RECORD BUFFER
	$STORE	T1,UBF,(T2)	;TELL RMS WHERE RECORD AREA IS
	$STORE	T1,RBF,(T2)	;. .
	HRRZ	T1,.RCCKB(FTL)	;GET KEY BUFFER IF CONVERSION REQUIRED.
	TXNE	FLG,CF%CNV	;IF WE MADE A KEY BUFFER ADDRESS,
	$STORE	T1,KBF,(T2)	;TELL RMS WHERE IT IS

;TELL RMS HOW MANY BUFFERS IT WILL NEED (1 PAGE EACH).
; WE WILL LET IT USE 1 BUFFER FOR EACH KEY, PLUS THREE.
; (ASK ANWAR FOR DETAILS)

;FIND # OF KEYS
	HRRZ	T3,BS.AGL	;BASE OF ARG LIST
	HRRZ	T3,1(T3)	;GET ADDRESS OF KEY INFO
	MOVE	T1,(T3)		;T1:=FIRST WORD = # OF KEYS
	ADDI	T1,3		;GET # KEYS + 3
	LDB	T3,FT.NAB	; GET NUMBER HE SPECIFIED
	JUMPE	T3,ORABS1	;JUMP IF HE DIDN'T SPECIFY ANY
;IN COBOL-74, HE HAS SPECIFIED THE ABSOLUTE # OF BUFFERS
; (IN COBOL-68, THIS IS # ALTERNATE (ADDITIONAL) BUFFERS)
	MOVEI	T1,0		;WE MIGHT HAVE TO LET RMS DECIDE
	CAIN	T3,77		;DID HE SAY A NUMBER LESS THAN 1?
	 JRST	ORABS1		;YES, LET RMS DECIDE
	CAIL	T3,3		;MUST BE AT LEAST THREE
	MOVE	T1,T3		;OK, USE THE NUMBER HE SPECIFIED
ORABS1:	$STORE	T1,MBF,(T2)	;TELL RMS

;SETUP BYTE PTR TO THE USER'S RECORD IN THE RMS CONTROL BLOCK.
; (THIS WILL DEFINITELY BE NEEDED FOR CONVERSION, AT LEAST).
	HRRZ	T1,F.RREC(FT)	;POINT TO RECORD
	MOVE	T2,F.WFLG(FT)	;GET COMPILER FLAGS
	LDB	T2,[POINT 2,T2,14] ;GET INTERNAL REC. MODE.
				;0= ASCII, 1=EBCDIC, 2=SIXBIT
	HRL	T1,[(POINT 7,)
		(POINT 9,)
		(POINT 6,)](T2)	;GET LH OF BYTE PTR.
	MOVEM	T1,.RCBPR(FTL)	;STORE BYTE PTR TO RECORD.

;CALL RMS. IF OPEN OUTPUT, DO A $CREATE.
;	IF OPEN INPUT, DO A $OPEN
;	IF OPEN I-O, DO A $OPEN
	TXNE	FLG,OPN%IO	;OPEN I-O?
	 JRST	OP.MXA		;YES
	TXNE	FLG,OPN%IN	;OPEN INPUT?
	 JRST	OP.MXB		;YES

;OPEN OUTPUT
OP.MXC:	MOVE	T2,.RCFAB(FTL)	;POINT TO FAB
	$FETCH	T1,FOP,(T2)	;GET FOP BITS NOW
	IORI	T1,FB$SUP	;SET SUPERCEDE MODE
	$STORE	T1,FOP,(T2)
	$CREATE	<(T2)>,OPCER	;** DO THE CREATE **
	SKIPE	FS.FS		;DID WE SET FILE-STATUS TO NON-ZERO?
	 POPJ	PP,		;YES, * RETURN FROM OPEN *
	PUSHJ	PP,DOCONN	;DO THE CONNECT
	SKIPE	FS.FS		;DID WE SET FILE-STATUS TO NON-ZERO?
	 POPJ	PP,		;YES, CONNECT ERROR RECOVERED, FILE IS CLOSED
	TXO	FLG,LF%OUT	;FILE IS NOW OPEN FOR OUTPUT
	HRRM	FLG,D.F1(FT)	;SET IN FILE-TABLE
	PUSHJ	PP,SETFS	;SET THE FILE-STATUS TO 00
	JRST	OPNDON		;DONE

;ERROR RETURN FROM $CREATE
OPCER:	MOVE	T2,.RCFAB(FTL)	;ADDR OF THE FAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	CAIN	T1,ER$COF	;RMS CAN'T OPEN FILE?
	 JRST	OPCER1		;YES, SAY WHY
	CAIN	T1,ER$FNF	;FILE-NOT-FOUND ERROR
	 JRST	OPOFNF		;YES
	CAIN	T1,ER$PRV	;PROTECTION VIOLATION?
	 JRST	OPOPRV		;YES
	TYPE	[ASCIZ/
?LIBOL: Error on $CREATE
/]

;RMS-SYSTEM FAILURES, THE FAB HAS THE ERROR STUFF IN IT
RSFAIF:	MOVE	T2,.RCFAB(FTL)	;POINT TO FAB
RSFAI1:	$FETCH	P1,STS,(T2)	;STS IN P1
	$FETCH	P2,STV,(T2)	;STV IN P2
	PUSHJ	PP,RMSERP	;REPORT RMS ERROR
RSFAI2:	$ERROR	(E.500,SV.KIL,MT.FIL) ;ERROR 500 WITH FILENAME

;RMS-SYSTEM FAILURES, THE RAB HAS THE ERROR STUFF IN IT
RSFAIR:	MOVE	T2,.RCRAB(FTL)	;POINT TO RAB
	JRST	RSFAI1

OPCER1:	TYPE	[ASCIZ/
?RMS can't create file
/]
	JRST	RSFAIF		;ERROR WITH FILENAME

;OPEN I-O
OP.MXA:	MOVE	T2,.RCFAB(FTL)	;POINT TO FAB
	$OPEN	<(T2)>,OPOER	;** DO THE OPEN **
	 TRNA			;NORMAL RETURN
	  JRST	OP.MXA		;TRY-AGAIN RETURN
	SKIPE	FS.FS		;DID WE SET FILE-STATUS NON-ZERO?
	 POPJ	PP,		;Yes, ** ERROR IGNORED, return from OPEN **
	PUSHJ	PP,CHKOPF	;CHECK PARAMETERS RETURNED TO US
	PUSHJ	PP,CHKPRK	;Check primary key dup flag
	SKIPE	FS.FS		;Error 507 or 523 given and user ignored it?
	 JRST	OPMXAI		;Yes
	PUSHJ	PP,DOCONN	;DO THE CONNECT
	SKIPE	FS.FS		;FILE STATUS NON-ZERO?
	 POPJ	PP,		;YES, CONNECT FAILED, RETURN
OPMXAJ:	TXO	FLG,LF%INP!LF%OUT!LF%IO ;FILE IS OPEN FOR IO
	HRRM	FLG,D.F1(FT)	;SET IN FILE-TABLE
	PUSHJ	PP,SETFS	;SET THE FILE-STATUS TO 00
	JRST	OPNDON		;DONE

OPMXAI:	PUSH	PP,FS.FS	;Save file-status word
	SETZM	FS.FS		;To test it..
	PUSHJ	PP,DOCONN	;Try to do connect
	SKIPN	FS.FS		;Did connect fail?
	 JRST	[POP PP,FS.FS	;No, restore file-status of "PERM error"
		JRST OPMXAJ]	;Go set "FILE is open" bits and return
	POP	PP,(PP)		;Return newest set file-status
	JRST	OPMXAJ		;Remember file is open, though

;RMS $OPEN ERROR COMES HERE
OPOER:	MOVE	T2,.RCFAB(FTL)	;ADDR OF THE FAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	CAIN	T1,ER$FNF	;FILE NOT FOUND?
	 JRST	OPOFNF		;YES
	CAIN	T1,ER$COF	;RMS CAN'T OPEN FILE?
	 JRST	OPOER1		;SAY WHY
	CAIN	T1,ER$FLK	;FILE ALREADY LOCKED (BY SOME OTHER JOB)
	 JRST	OPOFLK		;YES
	CAIN	T1,ER$PRV	;PROTECTION VIOLATION?
	 JRST	OPOPRV		;YES
	TYPE	[ASCIZ/
?LIBOL: Error on $OPEN
/]
	JRST	RSFAIF		;RMS-SYSTEM FAILURE

;FILE NOT FOUND - ERROR FOR $OPEN OR $CREATE
OPOFNF:	$FETCH	T1,STV,(T2)	;FETCH THE JSYS ERROR CODE
IFN TOPS20,<
	MOVEM	T1,ER.JSE	;STORE FOR ERROR PRINTOUT
	$ERROR	(E.508,SV.FAT,MT.FIL!MT.JSE,RFNFER)
>;END IFN TOPS20
IFE TOPS20,<
	SETO	T2,		;INCASE ONE DOESN'T MATCH
	CAIN	T1,ERIPP%
	 MOVEI	T2,0		;GET TOPS10 ERROR CODE
	CAIN	T1,ERDNA%
	 MOVEI	T2,1
	CAIN	T1,ERNSD%
	 MOVEI	T2,2
	CAIN	T1,ERSNF%
	 MOVEI	T2,3
	JUMPL	T2,OPOFN1	;NO ADDITIONAL STATUS WE CAN USE
	MOVEM	T2,ER.E10	;SAVE TOPS10 ERROR CODE
	$ERROR	(E.508,SV.FAT,MT.FIL!MT.E10,RFNFER)

OPOFN1:	$ERROR	(E.508,SV.FAT,MT.FIL,RFNFER)
>;END IFE TOPS20

OPOER1:	TYPE	[ASCIZ/
?Can't open file
/]
	JRST	RSFAIF		;RMS-SYSTEM FAILURE

;PROTECTION VIOLATION - THIS IS SIMILAR TO "FILE NOT FOUND"
;  FROM USER'S POINT OF VIEW
;GO TO "RFNFER" IF HE WANTS TO TRAP THE ERROR - IT WILL CLEAR CORE
; AND RETURN FROM THE "OPEN" STATEMENT

OPOPRV:	$ERROR	(E.521,SV.FAT,MT.FIL,RFNFER)

;Here if file is already locked - probably someone else has the file
; open for I-O
OPOFLK:	$ERROR	(E.520,SV.FAT,MT.FIL!MT.OER,OPOFL1)

;Ignore OPEN error for "file is busy"
OPOFL1:	MOVEI	T1,UP%OER	;Check for filename OPEN
	PUSHJ	PP,CHKUSE	;Skip if that special case.
;[D1022]	 POPJ	PP,		;No, regular error
	 PJRST	RFNFER		;[1022] Jump to routine to release core
	SETZM	FS.FS		;[1116] Clear the file status
	PUSHJ	PP,SETFS	;[1116] Set it in the appropriate locations
	AOS	(PP)		;GIVE A TRY-AGAIN RETURN
	POPJ	PP,		;RETURN..

;OPEN INPUT
OP.MXB:	MOVE	T2,.RCFAB(FTL)	;POINT TO FAB
	$OPEN	<(T2)>,OPOER	;** DO THE OPEN **
	 TRNA			;NORMAL RETURN
	  JRST	OP.MXB		;TRY-AGAIN RETURN
	SKIPE	FS.FS		;DID WE SET FILE-STATUS NON-ZERO?
	 POPJ	PP,		;YES, ERROR IGNORED. * RETURN FROM OPEN *
	PUSHJ	PP,CHKOPF	;CHECK PARAMETERS RETURNED TO US
	PUSHJ	PP,CHKPRK	;Check primary key dup flag
	SKIPE	FS.FS		;Error 507 or 523 happen?
	 JRST	OPMXBI		;Yes
	PUSHJ	PP,DOCONN	;DO THE CONNECT
	SKIPE	FS.FS		;FILE-STATUS SET NON-ZERO?
	 POPJ	PP,		;YES, ERROR IGNORED, * RETURN FROM OPEN *
OPMXBJ:	TXO	FLG,LF%INP	;FILE IS NOW OPEN FOR INPUT
	HRRM	FLG,D.F1(FT)	;STORE UPDATED FLAGS
	PUSHJ	PP,SETFS	;SET THE FILE-STATUS TO 00
	JRST	OPNDON		;DONE

OPMXBI:	PUSH	PP,FS.FS	;Save file-status word
	SETZM	FS.FS		;To test it..
	PUSHJ	PP,DOCONN	;Try to do connect
	SKIPN	FS.FS		;Did connect fail?
	 JRST	[POP PP,FS.FS	;No, restore file-status of "PERM error"
		JRST OPMXBJ]	;Go set "FILE is open" bits and return
	POP	PP,(PP)		;Return newest set file-status
	JRST	OPMXBJ		;Remember file is open, though

;HERE WHEN OPEN IS DONE (RMS $CREATE/$OPEN AND $CONNECT)
OPNDON:	POPJ	PP,		;SUCCESS, RETURN


;COME HERE IF USER WANTS TO RECOVER FROM "FILE NOT FOUND" TYPE ERROR
;  THE FILE IS NOT OPENED, WE MUST RELEASE THE CORE WE GOT AND RETURN
;  FROM THE OPEN STATEMENT
RFNFER:	PUSHJ	PP,ROPCOR	;RELEASE CORE FROM THE OPEN
	POPJ	PP,		; RETURN FROM OPEN, OR OPOER ERROR ROUTINE

SPCTLE:	ASCII /     /		;[1044] ASCII SPACES
	BYTE (9) 100,100,100,100	;[1044] EBCDIC
	SIXBIT /      /		;[1044] SIXBIT
;CHKOPF: Routine to check parameters of the file we just opened
;Called after $OPEN returned successfully
;  RMS has stored the parameters it found in the prologue of the
;file in the FAB and XAB's we gave it.
;
;Inputs:
;	FTL points to RMS file table
;Call:
;	PUSHJ	PP,CHKOPF
;	<return here if no error or error ignored>
;	Doesn't return if user doesn't trap the error
;Uses T1-T4
;
;Notes:
;1)  If we are opening a file that was created with more keys
;    than we specified, no error will be generated.  (this is a feature!)
;2)  If the file organization is wrong, error 519 is given. This
;    may be trapped (and ignored) by a USE procedure.
;3)  If anything else is wrong, error 507 will be generated, which
;    may be trapped by a USE procedure. If there is no USE procedure,
;    a specific error message will be printed.
;4)  Skips if there was no error, or an error was ignored and the
;    file was left open.

;FTL POINTS TO THE RMS-CONTROL BLOCK
CHKOPF:	MOVE	T2,.RCFAB(FTL)	;GET PTR TO FAB RETURNED

;MAKE SURE FILE ORGANIZATION IS INDEXED
	$FETCH	T1,ORG,(T2)	;GET FILE ORGANIZATION
	CAIE	T1,FB$IDX	;MUST BE INDEXED
	 JRST	ERORG		;?WRONG ORGANIZATION

;CHECK MAX RECORD SIZE
	$FETCH	T1,MRS,(T2)	;Get file's value
	JUMPE	T1,CHKOP0	;Zero means unlimited.
	LDB	T3,FT.MRS	;GET program max record size
	CAMGE	T1,T3		;Skip if user will be able to write
				; a record.
	 JRST	CKFE0		;NO, COMPLAIN

;CHECK THE KEY INFORMATION
CHKOP0:	HRRZ	T3,.RCKIN(FTL)	;GET ADDRESS OF KEY INFO
	MOVE	T4,(T3)		;T4= # OF KEYS
	MOVN	T4,T4
	HRLZ	T4,T4		;GET -N,,0
	MOVE	T2,.RCXAB(FTL)	;T2= ADDRESS OF FIRST XAB
	ADDI	T3,1		;T3 POINTS TO FIRST 2-WORD BLOCK


;HERE WITH T2= ADDRESS OF XAB
;	RH(T4)= NUMBER OF THIS KEY (0 thru n)
;	T3= ADDRESS OF THIS KEY BLOCK
CHKOP1:	PUSH	PP,T4		;SAVE KEY NUMBER
	HLRZ	T4,(T3)		;T4= POSITION OF THE KEY
	$FETCH	T1,POS,(T2)	;GET POSITION RETURNED
	CAME	T1,T4		;DO THEY MATCH?
	 JRST	[POP PP,T4	;NO, GIVE ERROR
		JRST CKFE1]
	HRRZ	T4,(T3)		;GET SIZE OF THE KEY IN PROGRAM
	$FETCH	T1,SIZ,(T2)	;GET SIZE OF KEY IN THE FILE
	CAME	T1,T4		;BETTER MATCH..
	 JRST	[POP PP,T4	;;NO, ERROR
		JRST CKFE2]
	$FETCH	T1,DTP,(T2)	;GET DATATYPE OF THE KEY
	MOVE	T0,F.WFLG(FT)	;GET COMPILER FT FLAGS
	MOVEI	T4,XB$SIX	;ASSUME SIXBIT
	TLNE	T0,DDMASC	; IF ASCII,
	 MOVEI	T4,XB$STG	;GET ASCII DATATYPE
	TLNE	T0,DDMEBC	; IF EBCDIC,
	 MOVEI	T4,XB$EBC	;GET EBCDIC DATATYPE
	CAME	T1,T4		;DOES PROGRAM DATATYPE MATCH FILE'S?
	 JRST	[POP PP,T4	;NO, GIVE ERROR
		JRST CKFE3]
	HRRZ	T1,(PP)		;Get this key number
	JUMPE	T1,CHKOP2	;If primary key, don't check dup flag yet
	$FETCH	T1,FLG,(T2)	;GET FLAGS
	HLLZ	T4,1(T3)	;GET FLAGS FOR THIS KEY
	TXNE	T1,XB$DUP	;DOES FILE SAY "DUPS ALLOWED" FOR THIS KEY?
	 JRST	[TXNE T4,KI%DUP ;YES, IS DUPLICATES ALLOWED IN PROGRAM?
		JRST CHKOP2	;YES, ALL OK
		POP	PP,T4	;NO, GIVE ERROR
		JRST	CKFE4]
	TXNN	T4,KI%DUP	;NO DUPS ALLOWED IN FILE, IN PROGRAM?
	JRST	CHKOP2		;ALL OK
	POP	PP,T4		;NO, GIVE ERROR
	JRST	CKFE4

;ALL OK
CHKOP2:	POP	PP,T4		;RESTORE KEY AOBJN PTR.
	AOBJP	T4,CPOPJ	;Return if done all keys
	ADDI	T3,2		;BUMP TO NEXT KEY INFO BLOCK
	$FETCH	T2,NXT,(T2)	;FETCH ADDRESS OF NEXT XAB
	JRST	CHKOP1		;AND LOOP
;CHKOPF ROUTINE (CONT'D)

;COME HERE WITH MINOR ERROR MESSAGE NUMBER IN T1
CKFEEP:	PUSH	PP,T1		;SAVE
	MOVEI	T1,^D30		;SET FILE-STATUS TO 30
	MOVEM	T1,FS.FS
	PUSHJ	PP,SETFS	;SO USER CAN SEE THAT THERE WAS A PROBLEM
	MOVEI	T1,UP%ERR	;CHECK FOR ERROR USE PROCEDURE
	PUSHJ	PP,CHKUSE
	 JRST	CKFEE1		;NONE
	POP	PP,T1		;Fix stack
	$ERROR	(E.507,SV.FAT,MT.FIL,CPOPJ) ;LET HIM TRAP IT

;HERE IF NO USE PROCEDURE. TYPE MESSAGE AND BOMB HIM OUT
CKFEE1:	TYPE	[ASCIZ/
?LBLEOO Error on OPEN: /]
	POP	PP,T1		;GET MESSAGE NUMBER (MINOR)
	TYPE	@CKERS(T1)	;TYPE MESSAGE
	$ERROR	(E.507,SV.KIL,MT.FIL)	;GIVE FATAL ERROR
;CHKOPF errors that could happen
CKERS:	[ASCIZ/Maximum record size of program is larger than file's/] ;0
	[ASCIZ/Key position in program differs from file's/] ;1
	[ASCIZ/Key length of program differs from file's/] ;2
	[ASCIZ/Datatype of key in program differs from file's/] ;3
	[ASCIZ/Key flags specified in program differ from file's key flags/] ;4
NMCERS==.-CKERS		;NUMBER OF ERROR MESSAGES

;DEFINE ERROR MESSAGE ROUTINES FOR THE MINOR ERRORS
DEFINE CKFEE(NN),<
CKFE'NN: MOVEI	T1,NN		;GET MINOR ERROR NUMBER
	JRST	CKFEEP		;AND REPORT ERROR
>

%NN==0		;INDEX FOR THE REPEAT..

REPEAT NMCERS,<
CKFEE(\%NN)
%NN==%NN+1
>

;ERROR - WRONG ORGANIZATION
ERORG:	MOVEI	T1,^D30		;SET FILE-STATUS TO 30
	MOVEM	T1,FS.FS
	PUSHJ	PP,SETFS	;SO USER CAN SEE THAT THERE WAS A PROBLEM
	$ERROR	(E.519,SV.FAT,MT.FIL,ERORGR)	;GIVE TRAPPABLE ERROR

;HERE IF USER WANTS TO IGNORE THE ERROR
; SET FLAGS SAYING THAT THE FILE IS OPEN, then call CLOSE.
ERORGR:	TXO	FLG,LF%INP	;"FILE IS OPEN FOR INPUT"
	HRRM	FLG,D.F1(FT)	;STORED UPDATED FLAGS
	MOVE	T1,BS.AGL	;GET BASE OF OPEN ARG LIST
	MOVE	T1,(T1)		;GET FILE-TABLE & FLAGS
	TLZ	T1,-1		; JUST GET FILE-TABLE ADDR
	PUSH	PP,T1		;SAVE ON STACK
	MOVEI	ARG,(PP)	;POINT TO ARG ON STACK
	PUSHJ	PP,CL.MIX	;CLOSE THE FILE
	POP	PP,(PP)		;FIX STACK
	POPJ	PP,		;RETURN
;CHKPRK - Check open file primary key duplicates flag

;* Sigh * COBOL is a bitch.
;  This routine checks the XAB returned by RMS to see if the file
;we just opened (for INPUT or I-O) has the "duplicates allowed"
;bit set for the primary key. If so, the assumptions made by
;the COBOL standard do not apply, since COBOL does not ever
;allow duplicates in the primary key. So LIBOL will generate an
;error code.
;   However, many users will probably want to read or update their
;RMS files which were defined this way with COBOL programs. Instead
;of simply bombing out their programs, we have decided to let them
;trap this condition and continue with the file opened if they want.
;The error code will be "523", and file status will be set to 30.

;Inputs:
;	FTL points to RMS file table
;Call:
;	PUSHJ	PP,CHKPRK
;	<here if no error or error ignored by user>
;	Doesn't return if error and he didn't trap it

CHKPRK:	MOVE	T2,.RCXAB(FTL)	;T2:= addr of first XAB returned
	$FETCH	T1,FLG,(T2)	;Get flags
	TXNN	T1,XB$DUP	;Duplicates allowed?
	 POPJ	PP,		;No, return
	MOVEI	T1,^D30		;"Permanent error"
	MOVEM	T1,FS.FS
	PUSHJ	PP,SETFS	;Set user's file-status word
	$ERROR	(E.523,SV.FAT,MT.FIL,CPOPJ) ;Give error, let him trap it
;DOCONN - ROUTINE TO DO A $CONNECT

;CALLED AFTER THE $OPEN OR $CREATE WAS SUCCESSFUL
;IF IT FAILS, $ERROR IS CALLED AND FILE STATUS SET TO 30
;IF THE ERROR IS TRAPPABLE, A USE PROCEDURE IS CALLED.
;
;IF ERROR HAPPENS AND THE USER TRAPPED IT, MEMORY IS CLEANED
;UP AND THE FILE IS CLOSED.
;
DOCONN:	MOVE	T2,.RCRAB(FTL)	;POINT TO THE RAB
	$CONNECT <(T2)>,CONERR	;DO IT
	POPJ	PP,		; RETURN

;CONNECT FAILED
CONERR:	MOVE	T2,.RCRAB(FTL)	;ADDR OF THE FAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	CAIN	T1,ER$DME	;DYNAMIC MEMORY EXHAUSTED
	 JRST	CONDME		;YES
	TYPE	[ASCIZ/
?LIBOL: $CONNECT failed
/]
	JRST	RSFAIR		;RMS-SYSTEM FAILURE

;DYNAMIC MEMORY EXHAUSED, LET USER TRAP THIS IF HE WANTS
; (This will most likely happen in $CONNECT)
CONDME:	MOVEI	T1,^D30		;SET FILE-STATUS
	MOVEM	T1,FS.FS	; "PERMANENT ERROR"
	PUSHJ	PP,SETFS	;SET IT
	$ERROR	(E.503,SV.FAT,MT.FIL,CONDM1)

;HERE IF THE ERROR RETURNS (HE TRAPPED IT AND WANTS TO IGNORE IT).
;CLEAN UP AND RETURN TO USER
CONDM1:	MOVE	T2,.RCFAB(FTL)	;T2 POINTS TO FAB
	$CLOSE	<(T2)>,CONDM2	;** CLOSE THE FILE **
	PUSHJ	PP,ROPCOR	;RELEASE THE CORE
	POPJ	PP,		;AND RETURN

CONDM2:	TYPE	[ASCIZ/?$CLOSE failed trying to recover from $CONNECT error
/]
	JRST	RSFAIF		;FAB HAS ERROR STUFF IN IT
;PICKFN - PICKUP FILENAME FROM VALUE-OF-ID AND STORE IT IN
; THE RMS FAB.
;ACS T1-T4 ARE SMASHED.

PICKFN:	MOVEI	T1,.RCFNM(FTL)	;STORE THE FILENAME ADDRESS
	$STORE	T1,FNA,(T4)	; IN THE FIELD
	MOVSI	T4,(POINT 7,)	;MAKE T4= BYTE PTR TO OUTPUT STRING
	HRR	T4,T1

;FIRST STORE DEVICE NAME
	HRRZ	T1,F.WDNM(FT)	;GET ADDR OF DEVICE NAME
	HRLI	T1,(POINT 6,)	;MAKE BYTE PTR TO IT
	MOVEI	T2,6		;MAXIMUM OF 6 CHARACTERS
PICKF0:	ILDB	C,T1		;GET A CHAR OF DEVICE NAME
	JUMPE	C,PICKF1	;NULL IS DONE
	ADDI	C,40		;MAKE IT ASCII
	IDPB	C,T4		;STORE ON STRING
	SOJG	T2,PICKF0	;.. FOR ALL CHARS IN DEVICE NAME
PICKF1:	MOVEI	C,":"		;COLON TO DELIMIT DEVICE NAME
	IDPB	C,T4		;PUT THAT ON STRING

IFN TOPS20,<			;CHECK FOR USER-NUMBER, IF HE SUPPLIED ONE,
				; TRANSLATE TO DIRECTORY STRING OVERWRITING
				; THE DEVICE NAME IN ASCII STRING.
	LDB	T1,FT.PPN	;T1= ADDRESS OF USER-NUMBER
	JUMPE	T1,PCKF1A	;JUMP IF NO USER-NUMBER
	MOVE	T2,T4		;PUT NULL ON END OF DEVICE STRING
	SETZ	T3,
	IDPB	T3,T2
	MOVE	T2,(T1)		;FETCH PPN
	MOVEI	T1,.RCFNM(FTL)	;POINT TO FILENAME
	HRLI	T1,(POINT 7,)
	MOVE	T3,T1		;FROM..
	PPNST%			;TRANSLATE PPN TO STRING..
	 ERJMP	PCKF1B		;ERROR
	MOVE	T4,T1		;GET UPDATED PTR
PCKF1A:
>;END IFN TOPS20
;NOW THE FILE NAME
	MOVE	T1,F.WVID(FT)	;T1:=BYTE PTR TO VALUE OF ID
	LDB	T2,[POINT 6,T1,11] ;T2= BYTE SIZE

;OLD STYLE (BEFORE V13) VID IS 9 CHARS LONG.
	MOVEI	T3,6		;GET SIX CHARS OF NAME
PICKF2:	ILDB	C,T1		;GET A CHAR
	CAIN	T2,6		;SIXBIT?
	ADDI	C,40		;YES, CONVERT TO ASCIZ
	CAIN	T2,9		;EBCDIC
	LDB	C,PTR.97##	; YES, CONVERT TO ASCII
	CAIG	C," "		;SPACE OR NULL OR CONTROL CHAR?
	 JRST	PICKF3		;YES, THAT'S THE END
	IDPB	C,T4		;STORE IN PTR
	SOJN	T3,PICKF2
PICKF3:	MOVEI	C,"."		;TO DELIMIT FILE NAME
	IDPB	C,T4
	SOJLE	T3,.+3		;SKIP BLANKS TO EXTENSION
	IBP	T1
	JRST	.-2
	MOVEI	T3,3		;3 CHARS OF EXTENSION
PICKF4:	ILDB	C,T1
	CAIN	T2,6		;SIXBIT?
	ADDI	C,40		;YES, CONVERT TO ASCII
	CAIN	T2,9		;EBCDIC?
	LDB	C,PTR.97##	; YES, CONVERT TO ASCII
	CAIN	C," "		;DONE EXT?
	 JRST	PICKF5		;YES
	IDPB	C,T4		;STORE IN PTR
	SOJN	T3,PICKF4	;LOOP
PICKF5:
IFE TOPS20,<			;APPEND USER-NUMBER AS A [P,PN] IF GIVEN
	LDB	T1,FT.PPN	;T1= ADDRESS OF USER-NUMBER
	JUMPE	T1,PCKF5D	;HE DIDN'T SUPPLY ONE
	MOVEI	T2,"["		;START PPN
	IDPB	T2,T4
	HLRZ	T1,(T1)		;GET PROJECT NUMBER
	PUSHJ	PP,T4OCT	;APPEND TO T4 THE OCTAL NUMBER
	MOVEI	T2,","		;TO SEPARATE PROJ AND PROG
	IDPB	T2,T4
	LDB	T1,FT.PPN	;GET ADDR OF PPN AGAIN
	HRRZ	T1,(T1)		;GET PROGRAMMER NUMBER
	PUSHJ	PP,T4OCT	;APPEND TO STRING
	MOVEI	T2,"]"		;TO END PPN
	IDPB	T2,T4
PCKF5D:
>;END IFE TOPS20
	SETZ	C,		;NULL TO END STRING
	IDPB	C,T4
	JRST	CPOPJ1		;DONE, RETURN SUCCESSFUL

IFE TOPS20,<			;APPEND OCTAL NUMBER IN T1 TO STRING IN T4
T4OCT:	IDIVI	T1,8		;DIVIDE BY RADIX
	HRLM	T2,(PP)		;STORE DIGIT
	SKIPE	T1		;ALL DONE?
	PUSHJ	PP,T4OCT	;NO, RECURSE
	HLRZ	T1,(PP)		;GET BACK DIGIT
	ADDI	T1,"0"		;MAKE ASCII
	IDPB	T1,T4		;STORE
	POPJ	PP,		;UNWIND
>;END IFE TOPS20

;HERE IF ERROR TRYING TO TRANSLATE PPN
IFN TOPS20,<
PCKF1B:	MOVEI	T1,.FHSLF	;GET JSYS ERROR
	GETER%
	MOVEM	T2,ER.JSE	;SAVE JSYS ERROR MNENOMIC

;GIVE "FILE-NOT-FOUND" LIBOL ERROR
	$ERROR	(E.508,SV.FAT,MT.FIL!MT.JSE,CPOPJ)

>;END IFN TOPS20
SUBTTL	CL.MIX - CLOSE RMS INDEXED FILE

;ARGLIST:	FLAG-BITS,,FILTAB-ADDR
;
; WHERE FLAG-BITS ARE:
	CLS%CF==1B12		;CLOSE FILE = 0
	CLS%LK==1B13		;LOCK, LOCKED FILES MAY NOT BE REOPENED
	CLS%DL==1B14		;CLOSE WITH DELETE

;THE FOLLOWING ARE NOT SUPPORTED:
; END-OF-FILE LABEL, END-OF-VOLUME LABEL, BEGINNING-OF-VOLUME LABEL,
; CLOSE REEL, NO REWIND, UNLOAD.

CL.MIX:	PUSHJ	PP,SETIO	;SETUP FOR IO
	TXNN	FLG,LF%INP+LF%OUT	;SKIP IF FILE WAS OPEN
	 JRST	CLMER1		;NO, GIVE ERROR
	TXNE	FLG,CLS%LK	;CLOSE WITH LOCK?
	 PUSHJ	PP,[SETO T1,	;YES, SET THE FLAG
		DPB T1,FT.BLF
		POPJ PP,]	;CONTINUE CLOSE CODE

;HERE IF OK TO CLOSE FILE
	MOVE	T2,.RCFAB(FTL)	;T2 POINTS TO FAB
	$CLOSE	<(T2)>,RCLSER	;** CLOSE THE FILE **

	TXNN	FLG,CLS%DL	;[1073] CLOSE WITH DELETE?
	 JRST	CL.AFT		;[1073] NO
	MOVE	T2,.RCFAB(FTL)	;[1073] YES, POINT AT FAB
	$ERASE	<(T2)>,RCLSER	;[1073] ** DELETE THE FILE **

;CLOSE WAS SUCCESSFUL. RELEASE THE CORE.
CL.AFT:	PUSHJ	PP,ROPCOR	;[1073] * RELEASE CORE FROM OPEN *
	PUSHJ	PP,SETFS	;SET FILE-STATUS TO 00
	POPJ	PP,		;ALL DONE, RETURN TO USER

;CLOSE WAS UNSUCCESSFUL. REPORT THE ERROR
;** NOTE: IF THIS IS CHANGED TO RECOVER, WE MUST CHANGE FILE'S
; STATE TO BE "UNF" (UNLESS IT WAS "ATE": THEN IT REMAINS "ATE")

RCLSER:	TYPE	[ASCIZ/
?LIBOL: $CLOSE failed
/]
	JRST	RSFAIF		;RMS-SYSTEM FAILURE

;FILE WAS NOT OPEN
CLMER1:	$ERROR	(E.512,SV.KIL,MT.FIL)	;FILE WAS NOT OPEN
;ROPCOR routine: Release core obtained at OPEN time
;This is called by OPEN (incase errors happen) or CLOSE (normal case)
;with FTL and FT set up. This routine gets rid of the FTL block.
;If the core cannot be released, this causes a fatal LIBOL error,
; else it will return .+1

ROPCOR:	MOVEM	FTL,FUN.A1##	;ARG1= ADDRESS
	MOVE	T1,.RCMEM(FTL)	;ARG2= SIZE
	MOVEM	T1,FUN.A2##	;      OF BLOCK TO RETURN
	MOVEI	ARG,1+[-5,,0
			XWD 0,FUN.A0##
			XWD 0,[ASCIZ/LBL/]
			XWD 0,FUN.ST##
			XWD 0,FUN.A1##
			XWD 0,FUN.A2##]
	MOVEI	T1,F.RAD	;FUNCTION WE WANT
	MOVEM	T1,FUN.A0##	;STORE FUNCTION
	SETZM	FUN.ST##	;CLEAR STATUS
	PUSHJ	PP,FUNCT.##	;CALL FUNCT. ROUTINE
	SETZM	D.RMSP(FT)	;CLEAR POINTER TO THE RMS CONTROL BLOCK
	SKIPE	T1,FUN.ST	;STATUS NON-ZERO?
	 JRST	CRCOR		;?CAN'T RELEASE CORE

	TXZ	FLG,LF%INP+LF%OUT+LF%IO ;NOT OPENED ANY MORE
	TXZ	FLG,CF%CNV+LF%FNA	;CLEAR TEMP FLAGS
	HRRM	FLG,D.F1(FT)	;SAVE UPDATED FLAGS
	POPJ	PP,		;RETURN

CRCOR:	TYPE	[ASCIZ/
?LIBOL: Couldn't release core from the RMS OPEN/]
	JRST	RSFAI2		;*** FIX ***
SUBTTL	RMS WRITE ENTRY POINTS

;ARG FORMAT:
;ARG-ADDR:	FLAG-BITS,,FILTAB-ADDR
;		WRT-REC-LENGTH,,KEY-BUFFER-ADDRESS
;
;FLAGS-BITS:
	WT%NIK==1B9		;NO "INVALID KEY" CLAUSE GIVEN
				; "USE PROCEDURE" INSTEAD

;HERE WHEN THE ACCESS MODE OF THE FILE IS RANDOM OR DYNAMIC
WT.MIR:	PUSHJ	PP,WTSET	;SETUP TO DO "WRITE"
	MOVE	T2,.RCRAB(FTL)	;POINT TO THE RAB FOR THIS FILE
	MOVEI	T1,RB$KEY	;SIGNAL KEYED ACCESS
	$STORE	T1,RAC,(T2)	; FOR RANDOM READ

;ADDRESS OF RECORD WAS ALREADY STORED BY "OPEN".
;STORE SIZE OF RECORD
WRTMI1:	MOVE	T1,BS.AGL	;SIZE OF RECORD TO WRITE IS HERE
	HLRZ	T1,1(T1)	; IN THE ARG LIST
	$STORE	T1,RSZ,(T2)
	PUSH	PP,T2		;[1020] SAVE THE RAB FOR FLUSH

;;;READY TO DO THE $PUT ;;;
	$PUT	<(T2)>,PUTERR	;** DO THE PUT **
	PUSHJ	PP,CHKSDP	;CHECK FOR SUCCESSFUL RETURN, BUT DUPLICATE KEY
	POP	PP,T2		;[1020] RESTORE THE RAB
	MOVE	T1,FS.FS	;GET FILE STATUS
;[D1020]	CAIL	T1,^D10		;SEE IF SOME KIND OF AT-END/INVALID KEY
;[D1020]	CAILE	T1,^D29
	CAIG	T1,^D9		;[1020] SEE IF SOME KIND OF AT-END/INVALID KEY
	JRST	CHKPT		;[1020]	
	CAIG	T1,^D29		;[1020]
	JRST	CPOPJ1		;[1020]
CHKPT:	LDB	T0,FT.CRC	;[1020] CHECKPOINTING?
	JUMPE	T0,CHKPT1	;[1020] NO
	SOSE	D.CRC(FT)	;[1020] DECREMENT COUNT - TIME TO OUTPUT?
	JRST	CHKPT1		;[1020] NOT YET
	LDB	T0,FT.CRC	;[1020] GET COUNT
	MOVEM	T0,D.CRC(FT)	;[1020] RESET COUNT
	$FLUSH	<(T2)>,FSHERR	;[1020] WRITE REC TO DISK
CHKPT1:				;[1020]
	 PJRST	SETFS		;SET FILE-STATUS, AND GIVE NORMAL RETURN
FSHERR:	TYPE	[ASCIZ/
?LIBOL:	$FLUSH  failed
/]				;[1020] RETURN ERROR MESSAGE
	JRST	RSFAIR		;[1020] RMS SYSTEM ERROR
CPOPJ1:	AOS	(PP)		;GIVE SKIP RETURN
CPOPJ:	POPJ	PP,		;FOR "INVALID KEY"

;ERROR ON $PUT
PUTERR:	MOVE	T2,.RCRAB(FTL)	;ADDR OF THE RAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
;	CAIN	T1,ER$CHG	;KEY CANNOT BE CHANGED?
;	 JRST	PUTERC		;YES, GIVE ERROR
	CAIN	T1,ER$DUP	;DUPLICATE KEY?
	 JRST	PUTERD		;YES
;	CAIN	T1,ER$REX	;RECORD ALREADY EXISTS?
;	 JRST	PUTERD		;YES, "DUPLICATE KEY"
	CAIN	T1,ER$SEQ	;OUT OF SEQUENCE?
	 JRST	SEQERR		;YES, RETURN STATUS
	TYPE	[ASCIZ/
?LIBOL: $PUT failed
/]
	JRST	RSFAIR		;RMS SYSTEM ERROR


PUTERD:	MOVEI	T1,^D22		;DUPLICATE KEY, ERROR 22
	JRST	PUTERI

SEQERR:	MOVEI	T1,^D21		;SEQUENCE ERROR, ERROR 21

PUTERI:	MOVEM	T1,FS.FS	;STORE IN FILE-STATUS WORD
	PUSHJ	PP,SETFS	;SET IT
	POPJ	PP,		;RETURN

;HERE WHEN THE ACCESS MODE OF THE FILE IS SEQUENTIAL
WT.MIS:	PUSHJ	PP,WTSET	;SETUP TO DO "WRITE"

;THIS HAS RETURNED IF FILE WAS OPEN FOR OUTPUT OR I-O.
; BUT ONLY "OUTPUT" IS ALLOWED WHEN ACCESS MODE IS SEQUENTIAL.
	TXNE	FLG,LF%IO	;SKIP IF NOT I-O
	 JRST	WTMSE0		;OPEN I-O, ILLEGAL

;THE STANDARD SAYS WE ARE SUPPOSED TO MAKE SURE THAT THE
; KEY BEING WRITTEN IS NOT LE THE LAST KEY THAT WAS WRITTEN,
; AND IF IT WAS, GIVE AN "INVALID KEY".
; LUCKILY, RMS RETURNS A UNIQUE ERROR CODE (ER$SEQ) FOR THIS CONDITION.

	MOVE	T2,.RCRAB(FTL)	;T2 POINTS TO THE RAB FOR THIS FILE
	MOVEI	T1,RB$SEQ	;SEQUENTIAL ACCESS
	$STORE	T1,RAC,(T2)	;STORE IT
	JRST	WRTMI1		;JOIN COMMON WRITE CODE

;"Attempt to WRITE indexed file / seq access mode not OPEN for OUTPUT"
WTMSE0:	$ERROR	(E.515,SV.KIL,MT.FIL)
;ROUTINE TO SETUP TO DO "WRITE"
; DOESN'T RETURN IF ERRORS
WTSET:	PUSHJ	PP,SETIO	;SETUP FOR IO
	TXNN	FLG,LF%OUT	;SKIP IF OPEN FOR OUTPUT FOR I-O
	 JRST	WTSETE		;FILE NOT OPEN FOR OUTPUT OR I-O
	MOVE	T1,.RCSTE(FTL)	;GET FILE'S STATE
	CAIN	T1,RC.SUR	;IF SUCCESSFUL READ WAS JUST DONE,
	 MOVEI	T1,RC.UNF	; SET STATE TO "UNDEFINED"
	MOVEM	T1,.RCSTE(FTL)	;STORE NEW STATE
	MOVE	T2,.RCRAB(FTL)	;POINT TO RAB
	MOVEI	T1,RB$LOA	;ALWAYS USE LOAD PERCENTAGES
	MOVE	T0,D.CRC(FT)	;[1020]] IF TIME TO CHECKPOINT
	CAIE	T0,1		;[1020]] DON'T TURN ON WRITE BEHIND
	TXO	T1,RB$WBH	; AND WRITE BEHIND
	$STORE	T1,ROP,(T2)	; NEXT REC. PTR SHOULD BE UNAFFECTED.
	TXNN	FLG,CF%CNV	;SKIP IF CONVERSION REQUIRED
	POPJ	PP,		;NO, JUST RETURN

;COPY RECORD AREA TO BUFFER ADDRESS
;ENTER HERE FROM "RWST" CODE
COPRCB:	MOVE	T1,.RCBPR(FTL)	;FROM
	MOVEM	T1,CVPRM.	; SAVE PARAMETER
	HRRZ	T1,.RCCRB(FTL)	;TO
	HRLI	T1,440000	;GET STARTING BP.
	HRRZ	T2,BS.AGL	;POINT TO BASE OF ARG LIST
	HLRZ	T2,1(T2)	;GET REC LENGTH
	DPB	T2,[POINT 12,T1,17] ;STORE LENGTH
	MOVEM	T1,CVPRM.+1	; SAVE 2ND PARAMETER

	PUSHJ	PP,SVPACS	;SAVE ALL PERMANENT ACS
	MOVEI	ARG,CVPRM.	;POINT TO PARAMS
	HLRZ	T1,.RCCRS(FTL)	;CONVERT FROM RECORD
	PUSHJ	PP,(T1)		;CALL ROUTINE
	POPJ	PP,		;ALL OK, RETURN

;"Attempt to WRITE and file not open for OUTPUT"
WTSETE:	$ERROR	(E.513,SV.KIL,MT.FIL)
SUBTTL	RMS READ ENTRY POINTS

;ARG FORMAT:
;ARG-ADDR:	FLAG-BITS,,FILTAB-ADDR
;		[XWD KEY# OF REF,,ADDR OF KEY BUFFER] ;IF RANDOM READ

; WHERE FLAG-BITS ARE:
	RD%NXT==1B9		;READ NEXT RECORD
	RD%KYR==1B10		;KEY REFERENCE SPECIFIED
	RD%NER==1B11		;NO ERROR RETURN - DO "USE" PROCEDURE

;RD.MIR: READ RANDOMLY
RD.MIR:	PUSHJ	PP,RDSET	;SETUP FOR READ
	TXNE	FLG,CF%CNV	;IF CONVERSION REQUIRED,
	 PUSHJ	PP,RKBSET	;SETUP KEY BUFFER

;LOOKS GOOD. DO AN INDEXED-FILE RANDOM READ.
	MOVE	T2,.RCRAB(FTL)	;POINT TO RAB

;SET KEY BUFFER ADDRESS
	HRRZ	T1,BS.AGL	;GET BASE OF ARG LIST
	HRRZ	T1,1(T1)	; FETCH ADDRESS OF KEY BUFFER
	TXNE	FLG,CF%CNV	;UNLESS CONVERSION REQUIRED,
	 HRRZ	T1,.RCCKB(FTL)	; THEN GET CONVERTED KEY BUFFER
	$STORE	T1,KBF,(T2)	; TELL RMS WHERE KEY IS

;SET "KEY OF REFERENCE"
	SETZ	T1,		;ASSUME PRIMARY KEY
	TXNN	FLG,RD%KYR	;WAS ANY SPECIFIED?
	 JRST	RD.MI2		;NO, USE 0
	HRRZ	T1,BS.AGL	;GET BASE OF ARG LIST
	HLRZ	T1,1(T1)	;GET T1= WHICH KEY
RD.MI2:	$STORE	T1,KRF,(T2)	;STORE "KEY OF REFERENCE"
	MOVEM	T1,.RCKRF(FTL)	;AND REMEMBER WHICH KEY IT IS

;SET "KEY BUFFER SIZE"
	HRRZ	T3,.RCKIN(FTL)	;POINT TO KEY INFO
	LSH	T1,1		;EACH IS TWO WORDS LONG
	ADDI	T3,1(T1)	;POINT TO APPROPRIATE KEY-INFO BLOCK
	HRRZ	T1,0(T3)	;GET KEY SIZE
	$STORE	T1,KSZ,(T2)	;STORE SIZE OF KEY BLOCK

;SET "USER BUFFER SIZE"
	LDB	T1,FT.MRS	;GET MAXIMUM RECORD SIZE
	$STORE	T1,USZ,(T2)

;SET "ACCESS MODE = RANDOM"
	MOVEI	T1,RB$KEY	;KEYED ACCESS
	$STORE	T1,RAC,(T2)

;SET RECORD OPTIONS TO JUST "SET NEXT REC PTR"
	MOVEI	T1,RB$NRP
	$STORE	T1,ROP,(T2)

;;;; ALL READY TO DO THE $GET ;;;
	$GET	<(T2)>,RDRERR	;DO IT
	MOVE	T1,FS.FS	;GET FILE-STATUS
	JUMPE	T1,RDDOK	;OK
	CAIN	T1,^D23		;INVALID KEY?
	 AOS	(PP)		;YES, RETURN .+2
	POPJ	PP,		;RETURN

;HERE IF THE $GET WAS SUCCESSFUL. WE WILL RETURN .+1 TO USER,
; AFTER CONVERTING THE RECORD BACK TO THE INTERNAL MODE.
RDDOK:	PUSHJ	PP,SETFS	;SET FILE-STATUS TO 00
	TXNE	FLG,CF%CNV	;IF CONVERSION REQUIRED,
	 PUSHJ	PP,RDCVB	; GO DO IT
	MOVEI	T1,RC.SUR	;SUCCESSFUL READ JUST DONE.
	MOVEM	T1,.RCSTE(FTL)	;SAVE STATE

;RETURN # OF CHARACTERS READ
	MOVE	T2,.RCRAB(FTL)	;POINT TO RAB
	$FETCH	T1,RSZ,(T2)	;GET # CHARACTERS READ
	MOVEM	T1,D.CLRR(FT)	;[V12B] STORE IN FILE TABLE
	POPJ	PP,		;RETURN .+1 TO USER

;RANDOM READ FAILED
RDRERR:	MOVE	T1,.RCSTE(FTL)	;GET STATE OF FILE
	CAIN	T1,RC.SUR	; "SUCCESSFUL READ DONE"?
	 MOVEI	T1,RC.UNF	;NOT ANY MORE!
	MOVEM	T1,.RCSTE(FTL)	;SAVE NEW STATE
	MOVE	T2,.RCRAB(FTL)	;ADDR OF THE RAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	CAIN	T1,ER$RNF	;RECORD NOT FOUND?
	 JRST	RDRIVK		;YES, RETURN "INVALID KEY"
	TYPE	[ASCIZ/
?LIBOL: $GET failed
/]
	JRST	RSFAIR		;RMS-SYSTEM FAILURE

RDRIVK:	MOVEI	T1,^D23		;FILE STATUS TO SET
	MOVEM	T1,FS.FS	;PUT HERE
	PUSHJ	PP,SETFS	;SET THE STATUS
	TXNE	FLG,RD%NER	;NO INVALID KEY CLAUSE PROVIDED?
	PUSHJ	PP,SETEFS	; YEAH, GO SET THE ERROR-STATUS VARIABLES
	POPJ	PP,

;RD.MIS: READ SEQUENTIALLY
RD.MIS:	PUSHJ	PP,RDSET	;SETUP FOR READ

;GIVE ERROR IF FILE IS ALREADY "AT END"
	MOVE	T1,.RCSTE(FTL)	;GET STATE OF FILE
	CAIN	T1,RC.ATE	; IF "AT END",
	 JRST	RDMSE1		;GIVE ERROR

;LOOKS GOOD. DO AN INDEXED-FILE SEQUENTIAL READ.
	MOVE	T2,.RCRAB(FTL)	;POINT TO RAB

;SET THE CURRENT KEY OF REFERENCE
	MOVE	T1,.RCKRF(FTL)	;THIS IS USUALLY 0 FOR PRIMARY KEY
	$STORE	T1,KRF,(T2)

;SET RECORD BUFFER ADDRESS
	HRRZ	T1,F.RREC(FT)	;POINT TO RECORD
	TXNE	FLG,CF%CNV	;UNLESS CONVERSION REQUIRED,
	 HRRZ	T1,.RCCRB(FTL)	;THEN READ RECORD INTO INTERMEDIATE BUFFER
	$STORE	T1,UBF,(T2)	;TELL RMS WHERE RECORD AREA IS

;SET "USER BUFFER SIZE"
	LDB	T1,FT.MRS	;GET MAXIMUM RECORD SIZE
	$STORE	T1,USZ,(T2)

;SET "ACCESS MODE = SEQUENTIAL"
	MOVEI	T1,RB$SEQ	;SEQUENTIAL ACCESS
	$STORE	T1,RAC,(T2)

;SET "READ AHEAD" BIT , GAMBLING THAT THE USER WILL BE PROCESSING
; THE FILE SEQUENTIALLY FOR A WHILE
	MOVEI	T1,RB$RAH	;READ AHEAD
	$STORE	T1,ROP,(T2)

;;;; ALL READY TO DO THE $GET ;;;
	$GET	<(T2)>,RDSERR	;DO IT
	MOVE	T1,FS.FS	;GET FILE-STATUS NOW
	JUMPE	T1,RDDOK	;JUMP TO CONVERT BACK IF NECESSARY
	CAIN	T1,^D10		; AT END?
	 AOS	(PP)		;YES, TAKE "AT END" PATH
	POPJ	PP,		;.. OR RETURN SUCCESS

;READ IN SEQUENTIAL MODE FAILED. THIS SHOULD ONLY HAPPEN ON EOF.
RDSERR:	MOVE	T2,.RCRAB(FTL)	;GET ADDRESS OF RAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	CAIN	T1,ER$EOF	;END OF FILE REACHED?
	 JRST	RDEOF		;YES
	MOVE	T1,.RCSTE(FTL)	;GET STATE OF FILE
	CAIN	T1,RC.SUR	; "SUCCESSFUL READ DONE"?
	 MOVEI	T1,RC.UNF	;NOT ANY MORE!
	MOVEM	T1,.RCSTE(FTL)	;SAVE NEW STATE
	TYPE	[ASCIZ/
?RMS SEQ READ FAILED
/]
	JRST	RSFAIR		;RMS-SYSTEM FAILURE

RDEOF:	MOVEI	T1,^D10		;SET FILE STATUS TO 10
	MOVEM	T1,FS.FS	;SET UP THE STATUS WORD
	PUSHJ	PP,SETFS	;STORE INTO USER VARIABLE, IF ANY
	TXNE	FLG,RD%NER	;SKIP IF "AT END" CLAUSE PROVIDED
	 PUSHJ	PP,SETEFS	;GO SET THE ERROR-STATUS VARIABLES
	MOVEI	T1,RC.ATE	;"FILE IS AT END"
	MOVEM	T1,.RCSTE(FTL)	;SAVE STATE
	POPJ	PP,		;RETURN TO RMS

;ERROR: ATTEMPT TO READ SEQUENTIALLY, BUT FILE IS ALREADY AT END
RDMSE1:	$ERROR	(E.518,SV.KIL,MT.FIL)
SUBTTL	READ- SETUP ROUTINES

RDSET:	PUSHJ	PP,SETIO	;SETUP FOR DOING IO
	TXNN	FLG,LF%INP	;SKIP IF OPEN FOR INPUT
	 JRST	RDSTE1		;NO--GIVE ERROR
	POPJ	PP,		;DONE, RETURN

;FILE WAS NOT OPEN FOR INPUT
RDSTE1:	$ERROR	(E.505,SV.KIL,MT.FIL)
SUBTTL	READ- RECORD CONVERSION ROUTINE

;COPY RECORD READ FROM CONVERTED BUFFER TO REAL BUFFER
RDCVB:	MOVE	T1,F.WFLG(FT)	;GET FT FLAGS

;** CHANGE IN V13:
	LDB	T1,[POINT 2,T1,2] ;GET DEVICE DATA MODE
	HRL	T2,[(POINT 7,)
		(POINT 9,)
		(POINT 6,)](T1) ;GET PART OF B.P.
	HRR	T2,.RCCRB(FTL)	;GET ADDRESS PART
	MOVEM	T2,CVPRM.	;;SAVE 1ST PARAMETER
	MOVE	T2,.RCBPR(FTL)	;START 2ND PARAMTER - BP TO RECORD
	LDB	T1,FT.MRS	;GET MAXIMUM RECORD SIZE
	DPB	T1,[POINT 12,T2,17] ;STORE IN PARAM
	MOVEM	T2,CVPRM.+1	;STORE 2ND PARAMETER
	PUSHJ	PP,SVPACS	;SAVE PERM ACS
	MOVEI	ARG,CVPRM.	;POINT TO PARAMS
	HRRZ	T1,.RCCRS(FTL)	;GET ROUTINE TO CONVERT TO RECORD
	PUSHJ	PP,(T1)		;CALL IT
	POPJ	PP,		;DONE, RETURN
SUBTTL	RKBSET - COPY KEY BUFFER TO TEMP CONVERTED AREA

;COPY KEY BUFFER TO CONVERTED KEY BUFFER
;THIS ROUTINE IS CALLED WHEN DOING KEYED ACCESS.
; IT EXPECTS THAT ARG-LIST+1 IS
;	XWD	KEY-OF-REFERENCE,,KEY-BUFFER-ADDRESS

RKBSET:	HRRZ	T1,BS.AGL	;GET BASE OF ARG LIST
	HLRZ	T1,1(T1)	;GET KEY OF REFERENCE
	HRRZ	T3,.RCKIN(FTL)	;POINT TO KEY INFO
	LSH	T1,1		;EACH IS TWO WORDS LONG
	ADDI	T3,1(T1)	;POINT TO APPROPRIATE KEY-INFO BLOCK
	HRRZ	T1,0(T3)	;GET KEY SIZE

;ENTER HERE WHEN THE KEY SIZE IS IN T1
RKBST1:	HRRZ	T4,.RCCKB(FTL)	;POINT TO CONVERTED KEY BUFFER
	HRLI	T4,440000	;LH = BYTE RESIDUE
	DPB	T1,[POINT 12,T4,17] ;STORE IN REST OF PARAM
	MOVEM	T4,CVPRM.+1	;SAVE PARAM+1

	MOVE	T1,.RCBPR(FTL)	;GET BP TO RECORD
	HRRZ	T2,BS.AGL	;REPLACE RECORD ADDR WITH KEY BUFFER ADDR
	HRR	T1,1(T2)
	MOVEM	T1,CVPRM.	;SAVE PARAM+0

	PUSHJ	PP,SVPACS	;SAVE PERM ACS.
	MOVEI	ARG,CVPRM.	;ARGUMENTS TO CONVERSION ROUTINE ARE HERE
	HLRZ	T1,.RCCRS(FTL)	;GET A ROUTINE TO CONVERT FROM KEY BUFFER MODE.
	PUSHJ	PP,(T1)		;;CALL IT
	POPJ	PP,		;RETURN
SUBTTL	RMS DELETE - INDEXED FILE

;ARG FORMAT:
;ARG-ADDR:	FLAG-BITS,,FILTAB-ADDR
;ARG-ADDR+1:	[PRIMARY KEY BUFFER ADDRESS] ;RANDOM DELETE ONLY

;FLAGS-BITS:
	DL%NIK==1B9		;NO INVALID KEY CLAUSE GIVEN
				; "USE PROCEDURE" INSTEAD

DL.MIR:	PUSHJ	PP,DLST		;START DELETE, RETURN IF OK
	MOVE	T1,.RCSTE(FTL)	;GET FILE'S STATE
	CAIN	T1,RC.SUR	;IF SUCCESSFUL READ WAS JUST DONE,
	 MOVEI	T1,RC.UNF	; SET STATE TO "UNDEFINED"
	MOVEM	T1,.RCSTE(FTL)	;STORE NEW STATE

;DO A $FIND TO POSITION TO THE RECORD
	PUSHJ	PP,FNDIT
	 JRST	DLMIRE		;?CAN'T FIND THAT RECORD

;NOW DELETE THE RECORD
	MOVE	T2,.RCRAB(FTL)	;POINT TO RAB AGAIN
	JRST	DLGO		;GO DO THE $DELETE

;HERE IF THE FIND FAILED
DLMIRE:	JRST	CPOPJ1		;RETURN "INVALID KEY"

DL.MIS:	PUSHJ	PP,DLST		;START DELETE, RETURN IF OK

; THE LAST I-O MUST HAVE BEEN A SUCCESSFUL READ STMT.
	MOVE	T1,.RCSTE(FTL)	;GET FILE'S STATE
	CAIE	T1,RC.SUR	; SKIP IF SUCCESSFUL READ WAS JUST DONE
	 JRST	DLMSE2		;NO, GIVE ERROR
	MOVEI	T1,RC.UNF	;SET NEW STATE TO "UNDEFINED"
	MOVEM	T1,.RCSTE(FTL)

; WE WILL DELETE THE RECORD READ.
DLGO:	MOVE	T2,.RCRAB(FTL)	;POINT TO RAB
	MOVEI	T1,RB$WBH	;ONLY WRITE BEHIND
	$STORE	T1,ROP,(T2)	;STORE RECORD OPTIONS
	PUSH	PP,T2		;[1046] SAVE RAB
	$DELETE	<(T2)>,DELSER	;SEQ. DELETE ERROR
	POP	PP,T2		;[1046] RESTORE RAB
	LDB	T0,FT.CRC	;[1046] CHECKPOINTINT ?
	JUMPE	DLG1		;[1046] NO
	SOSE	D.CRC(FT)	;[1046] DECREMENT COUNT, TIME TO OUTPUT ?
	JRST	DLG1		;[1046] NOT YET
	LDB	T0,FT.CRC	;[1046] GET COUNT
	MOVEM	T0,D.CRC(FT)	;[1046] RESET IT
	$FLUSH	<(T2)>,FSHERR	;[1046] WRITE RECORD (S) TO DSK
DLG1:	PUSHJ	PP,SETFS	;[1046] SET FILE-STATUS TO 0
	POPJ	PP,		;AND RETURN TO USER PROG.

DELSER:	MOVE	T2,.RCRAB(FTL)	;ADDR OF THE RAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	TYPE	[ASCIZ/
?$DELETE failed
/]
	JRST	RSFAIR		;RMS-SYSTEM FAILURE

;"DELETE of seq. access file was not immediately proceeded
; by a successful READ"
DLMSE2:	$ERROR	(E.517,SV.KIL,MT.FIL)
SUBTTL	RMS REWRITE ENTRY POINTS

;ARG FORMAT:
;ARG-ADDR:	FLAG-BITS,,FILTAB-ADDR
;ARG-ADDR+1:	REWRITE RECORD LENGTH,,KEY-BUFFER-ADDRESS

;FLAG-BITS:
	RW.NIK==1B9		;NO "INVALID KEY" CLAUSE GIVEN

RW.MIR:	PUSHJ	PP,RWST		;START REWRITE
	MOVE	T1,.RCSTE(FTL)	;GET FILE'S STATE
	CAIN	T1,RC.SUR	;IF SUCCESSFUL READ WAS JUST DONE,
	 MOVEI	T1,RC.UNF	; SET STATE TO "UNDEFINED"
	MOVEM	T1,.RCSTE(FTL)	;STORE NEW STATE
	PUSHJ	PP,FNDIT	;FIND THE RECORD
	 JRST	RWMIRE		;?CAN'T FIND THE KEY

;NOW UPDATE THE RECORD
RWGO:	MOVE	T2,.RCRAB(FTL)	;POINT TO RAB

;ADDRESS OF RECORD - ALREADY SETUP BY OPEN

;SIZE OF RECORD -- FROM ARG LIST.
	MOVE	T1,BS.AGL
	HLRZ	T1,1(T1)	;GET SIZE OF RECORD
	$STORE	T1,RSZ,(T2)	;STORE IT
	PUSH	PP,T2		;[1046] SAVE RAB
;RECORD ACCESS OPTIONS ARE LEFT AT "0" (FNDIT SET THEM)
	$UPDATE	<(T2)>,UPDERR	;** DO THE UPDATE **
	PUSHJ	PP,CHKSDP	;CHECK FOR SUCCESSFUL RETURN, BUT DUPLICATE KEY
	POP	PP,T2		;[1046] RESTORE RAB
	MOVE	T1,FS.FS	;GET FILE-STATUS
	CAIL	T1,^D20
	CAILE	T1,^D29		;SOME KIND OF INVALID KEY?
	 JRST	UPDOK		;NO
	JRST	CPOPJ1		;YES, RETURN "INVALID KEY"

UPDOK:	LDB	T0,FT.CRC	;[1046] CHECKPOINTING ?
	JUMPE	UPDO1		;[1046] NO
	SOSE	D.CRC(FT)	;[1046] DECREMENT COUNT - TIME TO OUTPUT ?
	JRST	UPDO1		;[1046] NOT YET
	LDB	T0,FT.CRC	;[1046] GET COUNT
	MOVEM	T0,D.CRC(FT)	;[1046] RESET COUNT
	$FLUSH	<(T2)>,FSHERR	;[1046] UPDATE DISK
UPDO1:	PUSHJ	PP,SETFS	;SET FILE-STATUS WORD
	POPJ	PP,		;AND RETURN SUCCESSFULLY

UPDERR:	MOVE	T2,.RCRAB(FTL)	;POINT TO RAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	CAIN	T1,ER$DUP	;DUPLICATE KEY?
	 JRST	UPDERK		;YES
	CAIN	T1,ER$CHG	;KEYS CANNOT BE CHANGED?
	 JRST	UPDERC		;YES
	CAIN	T1,ER$RSZ	;ATTEMPT TO CHANGE RECORD SIZE?
	 JRST	UPDERS		; FATAL ERROR FOR USER
	TYPE	[ASCIZ/
?LIBOL: $UPDATE failed
/]
	JRST	RSFAIR

;DUPLICATE KEY ERROR ON UPDATE
UPDERK:	MOVEI	T1,^D22		;SET FILE-STATUS
	MOVEM	T1,FS.FS
	PUSHJ	PP,SETFS
	POPJ	PP,		;AND RETURN

;KEYS CANNOT BE CHANGED BY UPDATE
;LOOK AT STV TO SEE WHICH KEY CAUSED THE PROBLEM
UPDERC:	$FETCH	T1,STV,(T2)	;GET KEY NUMBER
	JUMPE	T1,RWMISE	;PRIMARY KEY: READ SEQ FAILURE
	$ERROR	(E.506,SV.FAT,MT.FIL,CPOPJ)	;"ATTEMPT TO CHANGE KEY VALUE"

;*** ERROR: USER ATTEMPTED TO CHANGE RECORD SIZE.
UPDERS:	$ERROR	(E.522,SV.KIL,MT.FIL)

;HERE IF THE FIND FAILED
RWMIRE:	JRST	CPOPJ1		;RETURN "INVALID KEY"

RW.MIS:	PUSHJ	PP,RWST		;START REWRITE

;CHECK HERE TO SEE IF LAST OPERATION WAS A SUCCESSFUL READ
	MOVE	T1,.RCSTE(FTL)	;GET FILE'S STATE
	CAIE	T1,RC.SUR	; SKIP IF SUCCESSFUL READ WAS JUST DONE
	 JRST	RWMSE2		;NO, GIVE ERROR
	MOVEI	T1,RC.UNF	;SET NEW STATE TO "UNDEFINED"
	MOVEM	T1,.RCSTE(FTL)

	MOVE	T2,.RCRAB(FTL)	;POINT TO RAB
	MOVEI	T1,RB$SEQ	;SIGNAL SEQUENTIAL ACCESS
	$STORE	T1,RAC,(T2)
	MOVEI	T1,RB$WBH	;ONLY WRITE BEHIND
	$STORE	T1,ROP,(T2)	;STORE RECORD OPTIONS
	JRST	RWGO		;GO DO REWRITE

;HERE IF WE TRIED TO CHANGE THE PRIMARY KEY
;THIS IS AN INVALID KEY CONDITION
RWMISE:	MOVEI	T1,^D21		;FILE-STATUS VALUE
	MOVEM	T1,FS.FS	;STORE IT
	PJRST	SETFS		;TELL USER PROGRAM, RETURN FROM UPDERR

;"SEQ MODE REWRITE WAS NOT IMMEDIATELY PROCEEDED BY A SUCCESSFUL READ"
RWMSE2:	$ERROR	(E.516,SV.KIL,MT.FIL)	;GIVE KILL ERROR
;ROUTINE TO FIND A RECORD
; CALLED FROM RANDOM DELETE OR REWRITE.
;THIS ROUTINE SKIPS IF THE $FIND WAS SUCCESSFUL
;IT EXPECTS TO FIND THE KEY BUFFER ADDRESS IN RH(ARG-LIST + 1)

FNDIT:	MOVE	T2,.RCRAB(FTL)	;MAKE T2 POINT TO THE RAB
	MOVEI	T1,RB$KEY	;SIGNAL KEYED ACCESS
	$STORE	T1,RAC,(T2)

;SET KEY OF REFERENCE TO THE PRIMARY KEY
	MOVEI	T1,0
	$STORE	T1,KRF,(T2)

;SET SIZE OF KEY
	HRRZ	T4,.RCKIN(FTL)	;POINT TO KEY INFO
	HRRZ	T4,1(T4)	;GET SIZE OF PRIMARY KEY IN BYTES
	$STORE	T4,KSZ,(T2)

;SET KEY BUFFER ADDRESS
	TXNE	FLG,CF%CNV	;CONVERSION REQUIRED?
	 JRST	FNDIT1		;YES
	MOVE	T1,BS.AGL	;GET BASE OF ARG LIST
	HRRZ	T1,1(T1)	;GET KEY BUFFER ADDRESS
	$STORE	T1,KBF,(T2)	;TELL RMS
	JRST	FNDIT2		;GO ON

;CONVERT THE KEY FROM @RH( ARG-LIST + 1) TO THE KEY BUFFER
FNDIT1:	MOVE	T1,T4		;GET KEY SIZE
	PUSHJ	PP,RKBST1	; CONVERT THE KEY
	MOVE	T2,.RCRAB(FTL)	;RESTORE T2

;TELL FIND WE WANT KEY=
FNDIT2:	MOVEI	T1,0		;NO ALTERNATE OPTIONS
	$STORE	T1,ROP,(T2)

;** DO IT **
	$FIND	<(T2)>,FNDITE	;** START = RECORD **
	MOVE	T2,.RCRAB(FTL)
	MOVE	T1,FS.FS	;GET STATUS
	JUMPE	T1,CPOPJ1	;SKIP RETURN IF OK
	POPJ	PP,		;ERROR RETURN
;HERE IF $FIND FAILED TRYING TO POSITION TO THE RECORD.
; THIS IS PROBABLY A "RECORD NOT FOUND" = INVALID KEY ERROR
FNDITE:	MOVE	T2,.RCRAB(FTL)	;ADDR OF THE RAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	CAIN	T1,ER$RNF	;RECORD NOT FOUND?
	 JRST	FNDITF		;YES, SET "INVALID KEY/NO RECORD"
	TYPE	[ASCIZ/
?LIBOL: $FIND failed for REWRITE or DELETE
/]
	JRST	RSFAIR
FNDITF:	MOVEI	T1,^D23		;SET "INVALID KEY - RECORD NOT FOUND"
	MOVEM	T1,FS.FS
	JRST	SETFS		;SET IT AND RETURN
;ROUTINE TO CHECK FOR DUPLICATE KEY WRITTEN (WRITE OR REWRITE).
;; IT LOOKS AT THE STS RETURNED IN THE RAB, AND CHECKS FOR "SU$DUP".
; IF THAT SUCCESS CODE IS GIVEN, SET FS.FS TO 02.

CHKSDP:	MOVE	T2,.RCRAB(FTL)	;POINT TO RAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	CAIE	T1,SU$DUP	; SUCCESSFUL, BUT DUPLICATE KEYS?
	 POPJ	PP,		;NO, LEAVE FS.FS ALONE.
	MOVEI	T1,02		;PUT 02 IN FS.FS
	MOVEM	T1,FS.FS
	POPJ	PP,		;AND RETURN
;ROUTINE TO START REWRITE
; ONLY RETURNS IF THINGS ARE OK
RWST:	PUSHJ	PP,SETIO	;SETUP FOR IO
	TXNN	FLG,LF%IO	;SKIP IF OPEN FOR IO
	 JRST	RWENIO		;NOT OPEN IO, COMPLAIN
	TXNN	FLG,CF%CNV	;SKIP IF RECORD NEEDS CONVERTING
	POPJ	PP,		;ALL OK, RETURN

;COPY RECORD AREA TO BUFFER ADDRESS
;LH (ARG-LIST+1) IS THE LENGTH OF THE RECORD TO WRITE
	JRST	COPRCB		;GO DO IT LIKE "WRITE" DOES

;ROUTINE TO START DELETE
; ONLY RETURNS IF THINGS ARE OK
DLST:	PUSHJ	PP,SETIO	;SETUP FOR IO
	TXNN	FLG,LF%IO	;SKIP IF OPEN FOR IO
	 JRST	DLENIO		;NOT OPEN IO, COMPLAIN
	POPJ	PP,		;RETURN

RWENIO:	$ERROR	(E.502,SV.KIL,MT.FIL)

DLENIO:	$ERROR	(E.501,SV.KIL,MT.FIL)
SUBTTL	RMS START ENTRY POINTS

;ARG FORMAT:
;ARG-ADDR:	FLAG-BITS,,FILTAB-ADDR
;ARG-ADDR+1:	KEY OF REF,,KEY BUFFER ADDRESS
;ARG-ADDR+2:	[LENGTH OF APPROXIMATE KEY]
;
; WHERE START FLAG-BITS ARE DEFINED AS:
;
	STA%EQ==3B13		;EQUAL TO (IF 0)
	STA%NL==1B12		;NOT LESS THAN
	STA%GT==1B13		;GREATER THAN
	STA%AK==1B14		;START WITH APPROXIMATE KEY
	STA%NI==1B15		;NO "INVALID KEY" CLAUSE GIVEN
				; "USE PROCEDURE" INSTEAD

;IF STA%AK IS 0, THEN ARG-ADDR+2 IS NOT USED

ST.MEQ:	PUSHJ	PP,STAST	;START "START"
	MOVEI	T1,RB$NRP	;SET NEXT RECORD PTR
	$STORE	T1,ROP,(T2)	;STORE
	JRST	ST.GO		;ALL DONE, GO

ST.MGT:	PUSHJ	PP,STAST	;START "START"
	MOVEI	T1,RB$KGT!RB$NRP	;GREATER THAN
	$STORE	T1,ROP,(T2)	;STORE
	JRST	ST.GO		;AND GO

ST.MNL:	PUSHJ	PP,STAST	;START "START"
	MOVEI	T1,RB$KGE!RB$NRP	;GREATER OR EQUAL
	$STORE	T1,ROP,(T2)	;STORE

ST.GO:	$FIND	<(T2)>,FNDERR	;** DO THE FIND **
	MOVE	T1,FS.FS	;GET STATUS
	JUMPE	T1,FNDOK	;RETURN OK IF ZERO
	CAIL	T1,^D20		;SOME KIND OF INVALID KEY?
	CAILE	T1,^D29
	 POPJ	PP,		;NO, AN IGNORED ERROR
	AOS	(PP)		;INVALID KEY RETURN
	POPJ	PP,

FNDOK:	PUSHJ	PP,SETFS	;SET FILE-STATUS TO ZERO
	MOVEI	T1,RC.UNF	;SET FILE'S STATE TO "UNDEFINED"
	MOVEM	T1,.RCSTE(FTL)	; (THIS CLEARS "AT END" IF SET)
	POPJ	PP,		;NORMAL RETURN

;RMS-ERROR ROUTINE IF $FIND FAILED
FNDERR:	MOVE	T2,.RCRAB(FTL)	;ADDR OF THE RAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	CAIN	T1,ER$RNF	;RECORD NOT FOUND?
	 JRST	FNDE23		;YES, SET "INVALID KEY/NO RECORD"
	TYPE	[ASCIZ/
?$FIND FAILED
/]
	JRST	RSFAIR

FNDE23:	MOVEI	T1,^D23		;SET FILE-STATUS
	MOVEM	T1,FS.FS
	PUSHJ	PP,SETFS	;FOR "INVALID KEY"
	POPJ	PP,		;AND RETURN
;ROUTINE TO SETUP FOR DOING A "START". RETURNS ONLY IF EVERYTHING
; IS OK, WITH ACS SET UP.

STAST:	PUSHJ	PP,SETIO	;SETUP FOR IO
	TXNN	FLG,LF%INP	;SKIP IF OPEN FOR INPUT OR I-O
	 JRST	STASE1		;NO, GIVE ERROR
	MOVE	T1,.RCSTE(FTL)	;GET FILE'S STATE
	CAIN	T1,RC.SUR	; WAS LAST THING A SUCCESSFUL READ?
	 MOVEI	T1,RC.UNF	;YES, SET NEW STATE TO "UNDEFINED"
	MOVEM	T1,.RCSTE(FTL)	;SAVE UPDATED STATE

	MOVE	T2,.RCRAB(FTL)	;T2 POINTS TO RAB
	MOVEI	T1,RB$KEY	;SIGNAL KEYED ACCESS
	$STORE	T1,RAC,(T2)

;STORE KEY OF REFERENCE, AND KEY BUFFER ADDRESS
	MOVE	T1,BS.AGL	;GET BASE OF ARG LIST
	HLRZ	T3,1(T1)	;GET KEY OF REFERENCE FROM ARG LIST
	$STORE	T3,KRF,(T2)	;TELL RMS
	MOVEM	T3,.RCKRF(FTL)	;REMEMBER THE KEY OF REFERENCE
	TXNN	FLG,CF%CNV	;IS CONVERSION REQUIRED?
	 JRST	STAS1		;NO, SKIP THIS
	HRRZ	T3,.RCCKB(FTL)	; USE CONVERTED BUFFER ADDRESS
	$STORE	T3,KBF,(T2)	;TELL RMS

;SET T1= SIZE OF KEY TO MOVE,  THEN CALL RKBST1 TO MOVE IT
	TXNE	FLG,STA%AK	;START WITH APPROX. KEY?
	 JRST	STAS0		;YES, USE KEY SIZE GIVEN
	PUSHJ	PP,RKBSET	;MOVE WHOLE KEY
	MOVE	T2,.RCRAB(FTL)	;RESTORE T2
	JRST	STAS2		;GO ON

;MOVE # CHARS NEEDED FOR APPROX. KEY
STAS0:	MOVE	T1,BS.AGL	;POINT TO ARG LIST
	MOVE	T1,2(T1)	;GET SIZE OF KEY PASSED IN ARG LIST
	PUSHJ	PP,RKBST1	;MOVE THE KEY TO KEY BUFFER
	MOVE	T2,.RCRAB(FTL)	;;RESTORE T2
	JRST	STAS2		;GO ON

;NO CONVERSION REQUIRED
STAS1:	HRRZ	T3,1(T1)	;GET KEY BUFFER ADDRESS FROM ARG LIST
	$STORE	T3,KBF,(T2)	;TELL RMS

;FALL INTO STAS2
;HERE WHEN KEY HAS BEEN MOVED AND CONVERTED AS NECESSARY.
;STORE SIZE OF KEY IN THE RAB
STAS2:	TXNE	FLG,STA%AK	;APPROXIMATE KEY?
	 JRST	STAS3		;YES, USE SIZE IN ARG LIST
	HRRZ	T4,.RCKIN(FTL)	;POINT TO KEY INFO
	HRRZ	T3,BS.AGL	;GET KEY OF REF.
	HLRZ	T3,1(T3)	; INTO T3
	LSH	T3,1		;EACH IS TWO WORDS
	ADDI	T4,1(T3)	;POINT TO APPROPRIATE KEY-INFO BLOCK
	HRRZ	T1,(T4)		;GET KEY SIZE
	$STORE	T1,KSZ,(T2)	;STORE SIZE OF KEY BLOCK
	POPJ	PP,		;RETURN OK

STAS3:	MOVE	T1,BS.AGL	;POINT TO ARG LIST
	MOVE	T1,2(T1)	;GET SIZE OF KEY PASSED IN ARG LIST
	$STORE	T1,KSZ,(T2)	;STORE SIZE OF KEY BLOCK
	POPJ	PP,		;AND RETURN

;HERE TO GIVE ERROR BECAUSE "START" WAS CALLED AND FILE
; WAS NOT OPEN FOR INPUT OR I-O
STASE1:	$ERROR	(E.514,SV.KIL,MT.FIL)

END