Google
 

Trailing-Edge - PDP-10 Archives - BB-Z759A-SM - cobol-source/rmsio.mac
There are 20 other files named rmsio.mac in the archive. Click here to see a list.
; UPD ID= 1526 on 2/7/84 at 4:07 PM by HOFFMAN                          
TITLE	RMSIO FOR LIBOL 13 - LIBOL MODULE TO HANDLE RMS I/O
SUBTTL	D. WRIGHT / J. MASLANKA

	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, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION

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

RMSV2==2	;RMS V2 VERSION NO.

;EDIT HISTORY
;WHO	DATE	COMMENT

;***** V12B *****
;SMI	14-Oct-82	[1046] Fix CHECKPOINT with RMS files for DELETE and REWRITE.
;			Modified by JSM for COBOL V13 18-Nov-82.

;JSM	18-Oct-82	[1045] Use $MESSAGE in RMSGET as first RMS-20 call to
;				initialize RMS-20 global data symbols.
;RLF	 8-Oct-82	[1044] Space fill record area.
;RJD	29-Apr-82	[1022] Deallocate memory if OPEN fails.
;RJD	21-Apr-82	[1020] Test for CHECKPOINT with RMS files.
;			Modified by JSM for COBOL V13 18-Nov-82.


;NOTE: THIS MODULE DOES NOT SUPPORT THE FOLLOWING ANS 8X FILE-STATUS CODES:
;	07	OPEN/CLOSE - NO REWIND, REEL, UNIT, FOR REMOVAL
;		A TEMPORARY DIAGNOSTIC FOR THIS STATE IS GIVEN IN THE COMPILER.
;	14	SEQUENTIAL READ OF RELATIVE FILE - KEY VALUE WONT FIT IN KEY FIELD
;	36	OPEN MULTI-FILE TAPE - FILE IS ALREADY OPEN OR DOES NOT EXIST
;		SINCE MAG-TAPE IS CURRENTLY NOT ALLOWED IN RMS-20, THIS
;		CODE WILL BE COVERED BY CODE 37, WHICH INDICATES A DEVICE
;		ERROR.


;Note, parts of this routine run in a non-zero section. 
;Eventually all of it should.
;So be very careful to observe the usages of the SETSEC and RETSEC macros
;around the RMS JSYS Calls.

SEARCH	LBLPRM		;GET COBOTS 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
IFN TOPS20,<	SM%RWX==:SM%RD!SM%WR!SM%EX>	; CONVENIENCE

SEARCH	COMUNI		;GET COMMON SYMBOLS, MACROS
SEARCH	FTDEFS		;FILE-TABLE DEFINITIONS
SEARCH	RMSINT		;AND RMS SYMBOLS
;****** 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

REPEAT 0,<		;DISABLE ASCII STREAM
CRBUF:	XWD	64000,0	;CARRIAGE-RETURN

;THE FOLLOWING TABLE WAS ADAPTED FROM CBLIO, UNDER THE NAME "WADTBL"
;IT GIVES THE PRINT CONTROL CHANNEL NUMBERS FOR ASCII STREAM TEXT.

	;	CHAR		CHANNEL NUMBER

WVTTBL:	XWD	050000,0	;	8	LF
	XWD	060000,0	;	1	FF
	XWD	100000,0	;	2	DLE
	XWD	104000,0	;	3	DC1
	XWD	110000,0	;	4	DC2
	XWD	114000,0	;	5	DC3
	XWD	120000,0	;	6	DC4
	XWD	054000,0	;	7	VT
>	;END REPEAT 0
;RMS ENTRY POINTS
ENTRY	OP.MIX		;OPEN RMS FILE
ENTRY	CL.MIX		;CLOSE RMS FILE
ENTRY	WT.MIR		;WRITE- RMS RANDOM
ENTRY	WT.MIS		;WRITE- RMS SEQUENTIAL
ENTRY	WT.MSV		;WRITE RMS ASCII STREAM SEQ FOR VAR LEN RECS
ENTRY	RD.MIR		;READ- RMS RANDOM
ENTRY	RD.MIS		;READ- RMS SEQUENTIAL
ENTRY	DL.MIR		;DELETE RMS (RANDOM ACCESS)
ENTRY	DL.MIS		;DELETE RMS (SEQUENTIAL ACCESS)
ENTRY	RW.MIR		;REWRITE- RMS (RANDOM ACCESS)
ENTRY	RW.MIS		;REWRITE- RMS (SEQUENTIAL ACCESS)
ENTRY	ST.MEQ		;START- RMS EQUAL
ENTRY	ST.MGT		;START- RMS GREATER THAN
ENTRY	ST.MNL		;START- RMS NOT LESS THAN
IFN TOPS20,<
ENTRY	FA.MIR		;FAKE READ FOR SMU OPTION 1 FOR KEYED READ TO RMS FILES
ENTRY	FA.MIS		;FAKE READ FOR SMU OPTION 1 FOR SEQUENTIAL READ TO RMS FILE

INTERNAL VB.FLG		;BYTE POINTER IS ALSO USED IN LSU
>

;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
 >
>

;Macros to make sure RMS JSYSes are called from non-zero section if RMS is in a non-zero section.

DEFINE SETSEC,<
	SKIPE	RMS.SC		;;Is RMS in a non-zero section?
	SKIPE	OTS.SC		;;Yes, are we already in non-zero section?
	TRNA			;;Yes, OK
	XJRSTF	[0
		1,,.+1]		;;No, so get to section 1
>

DEFINE RETSEC,<
	SKIPN	OTS.SC		;;Want to return to section zero?
	XJRSTF	[0
		0,,.+1]		;;Yes
>
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
EXTERN	SU.RMS		;CHECKS OUT SMU OPTION 1 RECORD I-O VERBS

;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

EXTERN	SM.ARG	;TWO-WORD ARG BLOCK FOR CALL TO RMS FAKE READS
EXTERN	SM.BUF	;ADDRESS OF RMS SHADOW BUFFER FOR RMS FAKE READS
EXTERN	SM.RLN	;RECORD LENGTH IN BYTES FOR CALL TO RMS OPEN
EXTERN	SM.BN	;BUCKET NUMBER RETURNED FROM FAKE READ CALL
EXTERN	SM.BSZ	;RMS FILE BYTE SIZE FOR FAKE READS
EXTERN	SM.KBF	;RMS KEY BUFFER ADDRESS FOR FAKE READS
EXTERN	SM.KRF	;RMS INDEXED KEY OF REFERENCE NUMBER FOR FAKE READS.
		; ALSO USED ON RECORD I-O VERBS TO TRANSMIT CURRENT
		; KEY OF REFERENCE NUMBER TO LSU FOR RMS INDEXED FILES.
EXTERN	SU.T1	;SMU OPTION 1 TEMP WHICH CARRIES ADDR OF CURRENT RRT ENTRY
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

CKP.FL==1

;SOME DATA MODE SETTINGS FOR TESTING RELATED TO SETTING CF%CNV BIT
BINMOD==0
EBCMOD==1
SIXMOD==2
ASCMOD==3
ASCDDM==4	;TO HASSLE RMS / CBLIO DEV DATA MODE INCOMPATIBILITY.

;BYTE SIZES AND BYTE COUNTS PER WORD
SIXSIZ==6
ASCSIZ==7
EBCSIZ==9

SIXCT==6
ASCCT==5
EBCCT==4

;RANGE OF RECORD I-O VERB NUMBERS AS SPECIFIED IN THE FORS FOUR BITS OF
; THE FLAGS IN THE FIRST WORD OF THE CALLING ARG LIST

VB%MAX==6	;HIGHEST RECORD I-O VERB NO.
VB%MIN==3	;LOWEST RECORD I-O VERB NO.
VB%RD==VB%MIN	;IS READ VERB.
VB%WR==4	;WRITE VERB
VB%RW==5	;REWRITE VERB
VB%DL==VB%MAX	;DELETE VERB
VB%ST==7	;START VERB, THE "FUNNY" RECORD I-O VERB.

RRTKEY==3	;FOR SMU OPTION 1 REL ADDR OF KEY FIELD IN RRT ENTRY
;DEFINE THE BYTE POINTERS TO ITEMS IN THE FILE TABLE.
;THE ACTUAL DEFINITIONS ARE IN FTDEFS BUT THOSE DEFINITIONS USE ACC 16
;THESE ARE EQUIVALENT BUT USE ACC FT.
;USE THIS METHOD IN CASE THE FTDEFS DEFINITIONS CHANGE.

DEFINE FTDEF (FOO),<<FOO>&<777740,,-1>+<Z (FT)>>

FT.BBL:	FTDEF	(F%BBLC)	;FILE IS IN OVERLAY
FT.BLF:	FTDEF	(F%BLF)		;LOCKED
FT.MRS:	FTDEF	(F%BMRS)	;MAX RECORD SIZE (CHARACTERS)
FT.PPN: FTDEF	(F%BPPN)	;ADDRESS OF USER-NUMBER
FT.DIO:	FTDEF	(F%BDIO)	;DEFERRED OUTPUT BIT
FT.CKP:	FTDEF	(F%BCKP)	;CHECKPOINT OUTPUT
FT.CRC:	FTDEF	(F%BCRC)	;[1020] CHECKPOINT RECORD COUNT
FT.NAB:	FTDEF	(F%BNAB)	;NUMBER OF ALTERNATE BUFFERS
FT.ORG:	FTDEF	(F%BORG)	;FILE ORG FLAG PTR.
FT.ABL:	FTDEF	(F%APBL)	;APPLY BASIC-LOCKING FLAG
FT.NOC:	FTDEF	(F%APBL)	;FLAG FOR WRITING FUNNY <CR> FOR ASCII STREAM
SM1SLF:	FTDEF	(F%BSLF)	;SMU "SELF" BYTE FOR OPTION 1


PO.CHR:	POINT 7,(T1),35		;GET A CHARACTER TO WRITE AFTER POSITIONING
CH.CHR: POINT 3,T4,17		;GET CHANNEL CONTROL CHARACTER FROM ARG WORD 3

;FOR MANIPULATING SMU BITS

VB.FLG:	POINT 4,(ARG),3		;VERB FLAG IN %LIT00 OPERAND
VB.FL1:	POINT 4,(T4),3		;VERB FLAG IN %LIT00 OPERAND, FOR USE AT DOCONN PLUS A FEW
SM.SLF:	POINT 3,(ARG),11	;SMU "SELF" BYTE FOR OPTION 5
SM.OTH:	POINT 4,(ARG),15	;SMU "OTHER" BYTE FOR OPTION 5

;AD HOC BITS FOR TESTING SMU REQS IN BYTES FROM LEFT HALF OF ARG WORD.
SMU.RD==1B32			;READ
SMU.RW==1B33			;REWRITE
SMU.WR==1B34			;WRITE
SMU.DL==1B35			;DELETE

V.OPT5==12			;SMU OPTION 5 OPEN VERB
V.OPEN==1			;ANY OTHER OPEN VERB


;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)

;TWO FLAGS FOR OPTIONAL SEQUENTIAL FILES -- ALSO DEFINED IN CBLIO

FILOPT==200000	;FILE SPECIFIED AS OPTIONAL IN SELECT. IS IN LEFT-HAND
		; OF WORD D.F1 IN THE FILE'S FILE TABLE.
NOTPRS==400	;OPTIONAL FILE IS NOT PRESENT. SET IN LEFT-HAND OF
		; WORD F.WFLG IN THE FILE'S FILE TABLE.

	; ADVANCING / POSITIONING BITS FOR WRITING ASCII STREAM FILES
	;  THESE BITS ARE ALSO DEFINED IN CBLIO

WDVADR==40	; BIT18-35 IS THE ADDRESS OF THE ADVANCING COUNT
WDVBFR==20	; =1 IF BEFORE ADVANCING
WDVPOS==10	; POSITIONING

	;WORD NUMBERS FOR ARGUMENT LISTS, ESP ASCII STREAM WRITE ADVANCING

ADVPR0==0	;FIRST WORD -- HAS FLAGS ,, FT ADDR
ADVPR1==1	;SECOND WORD -- HAS REC LEN ,, UNUSED
ADVPR2==2	;THIRD WORD -- HAS ADV/POS PARMS ,, COUNT/ ADDR PARM
; NOTE: ONLY WRITE WITH ADVANCING FOR ASCII STREAM FILES KNOWS ABOUT THE
;  THIRD WORD.
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

	SETZM	FS.FS		;CLEAR OUT FILE-STATUS WORD
	PUSHJ	PP,SETFS	; AND USER'S F-S FIELD

;IF THE LEFTMOST FOUR BITS OF THE LEFT HALF OF THE ARG WORD IS 12 (I.E.
; V%OPS5) WE HAVE AN SMU OPTION 5 OPEN FOR I-O. THIS VALUE WAS SUBSTITUTED IN
; IOGEN FOR THE 143 OF THE GENFIL OPERATOR WHICH WAS PUT THERE BY COBOLD. 
; NOTE: 12 HAPPENS TO BE 2 * 5 OCTAL, MAKING THIS MNEMONIC EASY TO REMEMBER.
; ALSO, THE SEVEN SMU BITS AND THE UNAVAILABLE FLAG WERE PUT IN THE GENFIL
; OPERATOR BY COBOLD AND HAVE BEEN CARRIED ALONG SINCE THEN.
; WE HAVE TO CONVERT THE SMU BITS TO RMS FAC AND SHR FORM AND SAVE THEM
; ASIDE AT OPEN TIME. ALSO, WE HAVE TO SET UP THE LEFT HALF OF THE AC "FLG"
; SO THAT IT SAYS THAT WE ARE DOING AN OPEN FOR I-O, I.E. SET THE BITS
; TO 40700. WHEN WE ARE SETTING UP FAC AND SHR, WE HAVE TO BE ABLE TO GET
; BACK TO THE ORIGINAL FORM OF THE ARG SO THAT WE CAN KNOW IF WE ARE DOING
; A SMU OPEN OR NOT. NOTE: THE SEVEN SMU BITS FOR OPTION 5 DO NOT (REPEAT
; >>>> DO NOT <<<< ) GET PUT INTO WORD F.WSMU IN THE FILE'S FILE TABLE.
; SMU OPTION 5 REQUIRES THAT WE DO NOT TELL LIBOL IN ANY WAY THAT RMS
; IS DOING FILE SHARING FOR US. ONLY SMU OPTION 1 USES F.WSMU. OTHERWISE,
; F.WSMU REMAINS AT 0.

	SETZM	SMU.AG##	;INIT SMU ARG WORD
	LDB	T3,VB.FLG	;GET LEFTMOST 4 BITS OF ARG FLAGS
	CAIN	T3,V.OPT5	;SMU OPTION 5 OPEN?
	 PUSHJ	PP,STSMU5	;CONVERT SMU BITS FROM COMPILED TO RMSIO VERSION
	CAIE	T3,V.OPEN	;ANY OTHER OPEN?
	 JRST	SETIO4		; NO
	SKIPE	T3,F.WSMU(FT)	;SMU OPTION 1 OPEN?
	 PUSHJ	PP,STSMU1	; CONVERT SMU BITS FOR RMSIO OPEN

SETIO4:				;
	HLLZ	FLG,(ARG)	;GET ARG-LIST FLAGS

	CAIN	T3,V.OPT5	;TEST FOR SMU OPTION 5  OPERATOR AGAIN
	 HRLZI	FLG,40700	; IF SO, MANUFACTURE PROPER OPEN BITS FOR OP.MIX
				; I.E. OPEN FOR I-O

	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

;AT THIS POINT, WE CHECK FOR SMU OPTION 1. IF IT IS BEING DONE, THE WORD
; F.WSMU IN THE FILE TABLE CONTAINS A NON-ZERO VALUE. THE ONLY VERBS
; CHECKED NOW ARE THE RECORD I-O VERBS -- READ, WRITE, REWRITE AND
; DELETE. IF THESE TWO CONDITIONS ARE MET, WE CALL THE ROUTINE IN LSU
; WHICH CHECKS TO SEE IF THE PROPER RETAIN WAS DONE FOR THIS RECORD I-O
; VERB. IF NOT, THE LSU ROUTINE WILL CAUSE A PROGRAM FAILURE.

	SKIPN	F.WSMU(FT)	;GET SMU OPTION 1 WORD FROM FILE TABLE
	 JRST	SETIO1		; IS ZERO, NOT DOING SMU OPTION 1

	LDB	T1,VB.FLG	;GET VERB FLAG FROM ARG LIST
	CAIN	T1,VB%ST	;IS IT START VERB?
	 HRRZI	T1,VB%RD	;MAKE IT BE READ FOR PURPOSES OF SMU OPTION 1
	CAIL	T1,VB%MIN	;READ OR HIGHER?
	CAILE	T1,VB%MAX	;DELETE OR LOWER?
	 JRST	SETIO1		; NO
	TXNE	FLG,FA%FAK	;DON'T DO SU.RMS IF FAKE READ FLAG SET
	 JRST	SETIO1		;

	;NOW CHECK FOR INDEXED FILE AND GET ITS CURRENT KEY-OF-REF NO.
	; THE READ VERB CARRIES THE KEY-OF-REF NUMBER IN ITS ARG LIST 
	; BUT THE OTHERS DO NOT. WE ARE PUTTING THE NUMBER INTO SM.KRF
	; NO MATTER WHICH VERB IT IS. HOWEVER, IN SU.RMS FOR THE READ
	; VERB THE NUMBER IN THE LEFT HALF OF THE SECOND WORD OF THE ARG
	; LIST WILL BE USED INSTEAD OF THIS NUMBER.


	SETZM	SM.KRF##	;INITIALIZE THIS FIELD FOR CALL TO SU.RMS
	MOVE	T2,.RCRAB(FTL)	;GET ADDRESS OF RAB
	MOVE	T3,SM.KRF##	;AND RESET KEY OF REFERENCE TO 0
	$STORE	T3,KRF,(T2)	;IN THE RAB
				;NEXT WE GET THE CURRENT KEY OF REFERENCE
	LDB	T3,FT.ORG	;GET FILE'S ORGANIZATION FROM FILE TABLE
	CAIE	T3,IDXFIL	;IS IT INDEXED?
	 JRST	SETIO2		; FILE NOT INDEXED
	CAIN	T1,VB%RD	;CHECK FOR READ 
	TXNN	FLG,FA%KYR	; WITH KEY
	 JRST	SETIO3		;
	HLRZ	T1,KYINFO(ARG)	;  AND IF SO, GET IT FROM THE ARG LIST
	MOVEM	T1,SM.KRF##	; AND SAVE IT FOR CALL BELOW
	 JRST SETIO2		;

SETIO3:				;
	HRRZ	T2,.RCRAB(FTL)	;FILE IS INDEXED, SO WE GO AHEAD AND GET IT
	$FETCH	T1,KRF,(T2)	;
	MOVEM	T1,SM.KRF##	; AND SAVE IT FOR TRANSMISSION TO SU.RMS
SETIO2:				;
	 PUSHJ	PP,SU.RMS	;DO SMU OPTION 1 CHECKS FOR RECORD I-O VERBS

;ZERO THE ERROR STATUS WORDS

SETIO1:
	MOVE	T1,[FS.ZRO,,FS.FS] ;ZERO THE ERROR STATUS WORDS
	BLT	T1,FS.IF
	POPJ	PP,		;RETURN

;FOR SMU OPENS WE HAVE TO MASSAGE THE ARG BITS ONE BY ONE FROM COMPILE
; FORM TO RMS FAC AND SHR FORM BECAUSE THEY ARE IN REVERSE ORDER IN THE
; TWO SYSTEMS. FIRST WE HANDLE FILE ACCESS CAPABILITIES FOR SELF, AND
; THEN FOR THE OTHER. WE NEED TWO ROUTINES FOR THIS BECAUSE THE BITS ARE
; FOUND IN DIFFERENT PLACES (FOR OPTION 1 IN THE FILE TABLE WORD F.WSMU,
; AND FOR OPTION 5 IN THE CALLING ARG LIST) AND WE DO DIFFERENT THINGS
; FOR THEM. FOR OPTION 1 WE SET UP THE FAC BITS AS GIVEN AS WELL AS THE
; SMU OPTION 1 BIT FB$SMU BUT ON SHR WE ONLY GIVE FB$GET. THIS ALLOWS 
; THE FAKE RAB TO DO SHARED RETRIEVALS. FOR OPTION 5 WE SET UP BOTH FAC
; AND SHR AS GIVEN AND THAT'S ALL.

STSMU1:				;MASSAGE THE BITS FOR OPTION 1 OPEN

IFE TOPS20,<
	TYPE	[ASCIZ/
?COBLIB: Simultaneous Update with Retain and Free not allowed on RMS-10 Files
/]
	JRST	RSFAIR
>

	SETZ	T2,		;INIT A WORK AC
	LDB	T1,SM1SLF	;GET SMU OPTION 1 SELF BYTE
	PUSHJ	PP,SETSLF	; AND GO SET "SELF" BITS
	TLO	T2,FB$SMU	;SET SMU OPTION 1 CAPABILITY BIT
	TRO	T2,FB$GET	;ALLOW "OTHER" READ
	MOVEM	T2,SMU.AG##	;SAVE REFORMATTED BITS
	POPJ	PP,		; AND RETURN

STSMU5:				;MASSAGE THE BITS FOR OPTION 5 OPEN
	SETZ	T2,		;INIT A WORK AC
	LDB	T1,SM.SLF	;GET SMU SELF BYTE - IS ONLY RIGHTMOST THREE BITS
	CAIN	T1,0		;SELF WANTS TO READ ONLY?, I.E. READ REGARDLESS
	 TLO	T2,FB$NIL	;YES, SET READ REGARDLESS
	CAIE	T1,0		;TEST IT AGAIN IN OPPOSITE SENSE
	 PUSHJ	PP,SETSLF	; AND GO SET "SELF" BITS
	PUSHJ	PP,SETOTH	;GO SET "OTHER" BITS
	MOVEM	T2,SMU.AG##	;SAVE REFORMATTED BITS
	POPJ	PP,		; AND RTEURN

;		ROUTINE TO SET "SELF" BITS
SETSLF:
	TLO	T2,FB$GET	;GIVE SELF READ
	TRNE	T1,SMU.RW	;REWRITE?
	 TLO	T2,FB$UPD	; YES
	TRNE	T1,SMU.WR	;WRITE?
	 TLO	T2,FB$PUT	; YES
	TRNE	T1,SMU.DL	;DELETE?
	 TLO	T2,FB$DEL	; YES
	POPJ	PP,		;AND RETURN

;		ROUTINE TO SET "OTHER" BITS
SETOTH:
	LDB	T1,SM.OTH	;GET SMU OTHER BYTE
	TRNE	T1,SMU.RD	;OTHER CAN READ?
	 TRO	T2,FB$GET	; YES
	TRNE	T1,SMU.RW	;REWRITE?
	 TRO	T2,FB$UPD	; YES
	TRNE	T1,SMU.WR	;WRITE?
	 TRO	T2,FB$PUT	; YES
	TRNE	T1,SMU.DL	;DELETE?
	 TRO	T2,FB$DEL	; YES
	POPJ	PP,		; AND RETURN

;FATAL ERROR - EXCLUDE FILES WITH SEQUENTIAL ORGANIZATION FROM SMU OPTION 1

SM1SER:	$ERROR	(E.528,SV.KIL,MT.FIL)
;THE FOLLOWING ROUTINE DOES SOME CLEANUP FOR RECORD I-O VERBS.
; FIRST IT SETS THE FILE-STATUS NO MATTER WHAT. THIS WAS SET UP BECAUSE
; A LOT OF THE CODE DOES NOT RETURN TO THE USER IN A WAY WHICH CONSISTENTLY
; CONFORMS TO THE ANSI 74 STANDARD. THUS, IF THE USER HAS FILE-STATUS
; TO TEST AFTER EVERY RECORD I-O VERB, HE CAN PLAY SAFE FOR HIMSELF.
; BESIDES, THIS HAPPENS TO CONFORM TO THE 8X DPANS. ALSO, THE FILE I-O
; VERBS AND THE START VERB HAVE BEEN REVISED TO CALL SETFS IN ANY EVENT.
;
; SECOND IT CHECKS FOR SMU OPTION 1 WITH A RECORD I-O VERB (READ, WRITE,
; REWRITE, OR DELETE) AND IF SO IT CHECKS IF THE RECORD HAS BEEN FLAGGED
; TO BE FREED IMPLICITLY. IF SO, IT CALLS LRDEQX IN LSU TO DO THE JOB.

RCLNUP:
	PUSHJ	PP,SETFS	;FIRST SET FILE STATUS FOR CALLER
	HRRZI	T0,0		;NOW SEE IF WE ARE DOING SMU OPTION 1
	CAME	T0,F.WSMU(FT)	; IF SO, CHECK TO SEE IF WE SHOULD FREE
				;  THE CURRENT RECORD.
	 PUSHJ	PP,LRDEQX##	;GO FREE IT
	POPJ	PP,		; AND RETURN TO WRAP UP RECORD I-O VERB
SUBTTL	RMSGET - GET RMS, AND SET IT UP

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

RMSGET:	MOVEI	T1,ER$BUG	;GET RMS "BUG" ERROR CODE
	MOVEM	T1,ER.RBG	;TELL LBLERR

IFN TOPS20,<
;See if we are running version 1 or version 2 of RMS,
; easiest way is by seeing if GTJFN succeeds

	MOVX	T1,GJ%OLD+GJ%SHT		;
	HRROI	T2,[ASCIZ/SYS:XRMS.EXE/]	;
	GTJFN%					;
	 ERJMP	GETV1				;Try for version 1

;See if we are running on an extended machine.
;If so call RMS from non-zero section so as to use XRMS in its own section.

	XMOVEI	T1,.		;SEE IF WE ARE IN SECTION 0
	HLRZM	T1,OTS.SC##	;SAVE RESULT FOR RETURN TO CALLER
	TLNE	T1,-1
	JRST	RMSGT1		;NO, THEN WE MUST BE EXTENDED
	MOVE	T1,[.FHSLF,,1]	;YES, SEE IF WE CAN MAP SECTION 0 TO 1
	RSMAP%			; THIS IS A TEST FOR AN EXTENDED MACHINE
	  ERJMP	RMSGT1		;NOT AN EXTENDED MACHINE (I.E. 2020)
;Now map section 0 and 1 together.
  	AOJN	T1,RMSGT1	;ALREADY DONE (T1 NOT = -1)
	MOVSI	T1,.FHSLF	;THIS FORK IN SECT 0
	MOVE	T2,[.FHSLF,,1]	;...       IN SECT 1
	MOVX	T3,SM%RWX+1
	SMAP%			;MAP SECTIONS 0 & 1 TOGETHER
	  ERJMP	RMSGT1		;CAN'T DO IT

;NOW JUMP INTO SECTION 1 FOR REST OF RMS INITIATION
	XJRSTF	[0
		 1,,.+1]

;DISABLE TRAPS FOR REFS OF NON-EX PAGE SO PA1050 DOESN'T BOMB OUT RMS
RMSGT1:	MOVEI	T1,.FHSLF
	MOVX	T2,1B<.ICNXP>
	DIC%

	PUSHJ	PP,$$RMS	;GET RMS
	RETSEC			;IF ORIGINALLY FROM SECTION ZERO, RETURN TO IT

	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,RMSV10(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

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
IFN TOPS20,<
RMSNMP: POINT 7,[ASCIZ/SYS:RMSCOB.EXE/]	;VERSION 1 RMS
;STORE POINTER TO THIS BLOCK IN RMS ENTRY VECTOR
;RSEBLK:	EXP	FUNCT.##	;ADDRESS OF FUNCT. ROUTINE
;This code copied from RMSINI.MAC
;However it has to run in the OTS and call RMS from a non-zero section.


$$RMS::

IFN TOPS20,<

;*** The following is needed for TOPS-20 release 5, because XRMS
; is not automatically gotten in just because the JSYS was from
; an extended section.

	XMOVEI	1,.			;What section are we in?
	TLNE	1,-1			;Non-zero section?
	 PUSHJ	17,GINRMS		;Get RMS in, set entry vector

;** End of Release 5 code.

	$MESSAGE [0]		;[1045] TURN ON RMS-20 INTERNAL MESSAGE REPORTING
				;[1045] AND ALSO INCIDENTALLY INITIALIZE THE
				;[1045] AREA FOR RMS-20 GLOBAL DATA SYMBOLS.
	POPJ	17,			;OK

	HRROI	1,[ASCIZ/? Could not initialize RMS/]
	PSOUT%				;TELL USER
	HALTF%

;** More release 5 code
; We have to find a free section where RMS will go

GINRMS:	MOVE	T1,[.XSEVD,,.FHSLF]	;See if RMS has already been initialized
	XGSEV%
	JUMPE	T3,GRMS0		;None defined yet, go do it
	TXZ	T3,77B5			;Clear flags
	TLNN	T3,-1			;Must be in a non-zero section..
	 JRST	E$$BRM			;?Can't init XRMS
	POPJ	P,			;Got it, return

GRMS0:	XMOVEI	T4,.			;Get this section number
	HLRZ	T4,T4			;Start here
GRMS1:	AOS	T1,T4			;Try next section
	CAILE	T1,37			;Make sure some still left
	 JRST	E$$NFS
	HRLI	T1,.FHSLF
	RSMAP%
	 ERJMP	E$$SNA
	AOJN	T1,GRMS1		;Not free, try another
	MOVEM	T4,RMS.SC##		;Save section number

	SETZ	T1,			;Create the section
	HRLI	T2,.FHSLF
	HRR	T2,T4
	MOVX	T3,<PM%RWX!1>
	SMAP%
	 ERJMP	E$$SNA

	MOVX	T1,GT%BAS		;Set RMS block to have 
	MOVEM	T1,RMS.BK		; section number in .GBASE
	SETZM	RMS.BK+.GLOW		;Make sure
	SETZM	RMS.BK+.GHIGH		; ...

;We have created the section. GET XRMS.EXE into it.

	MOVEI	T1,.FHSLF		;Get my entry vector
	XGVEC%				;Get length in T2, addr in T3
	DMOVEM	T2,MY.EVC##		;..

	MOVX	T1,GJ%OLD+GJ%SHT	;Find XRMS.EXE
	HRROI	T2,[ASCIZ/SYS:XRMS.EXE/]
	GTJFN%
	 ERJMP	NOXRMS			;?Can't get V2 RMS
	HRRZ	T1,T1			;Get JFN
	HRLI	T1,.FHSLF		;process handle in LH
	TXO	T1,GT%ARG		;Arg address in T2
	XMOVEI	T2,RMS.BK		;Point to arg block
	GET%
	 ERJMP	E$$CGR			;?Can't
	MOVEI	T1,.FHSLF		;Find out RMS's entry vector
	XGVEC%
	MOVE	T1,RMSV20(T3)		;Get version number word
	MOVEM	T1,RMSVR.##		;Save it incase OTS wants to print it
	TXO	T3,XS%EEV		;It's an "extended" kind.
	MOVE	T1,[.XSEVD,,.FHSLF]	;RMS, this fork
	XSSEV%				;Extended set special entry vector

;Bring in DDT in that section and tell it where the symbols are

	MOVX	T1,GJ%OLD+GJ%SHT
	HRROI	T2,[ASCIZ/SYS:UDDT.EXE/]
	GTJFN%
	 ERJMP	E$$CGD
	HRRZ	T1,T1			;Get JFN
	HRLI	T1,.FHSLF		;process handle in LH
	TXO	T1,GT%ARG		;Arg address in T2
	XMOVEI	T2,RMS.BK##		;Point to arg block
	GET%
	 ERJMP	E$$CGD
	HRLZ	T1,RMS.SC		;Get
	HRRI	T1,600006		; loc 600006 of that section
	MOVE	T2,(T1)			;Get symbol word for RMS
	HRRI	T1,770001
	HRRZ	T1,(T1)			;Get address in 770001
	HRL	T1,RMS.SC		; in that section..
	MOVEM	T2,(T1)			;Store symbol table info there.

	MOVEI	T1,.FHSLF		;Now restore my entry vector
	DMOVE	T2,MY.EVC
	XSVEC%
	POPJ	17,			;Return


GETV1:	TYPE	[ASCIZ/%COBLIB: RMS V2 not found, loading RMS V1
/]	;
	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,RMSV20(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 [0] 		;[1045] TURN ON RMS-20 INTERNAL MESSAGE
				;[1045] AND ALSO INCIDENTALLY INITIAL THE
				;[1045] AREA FOR RMS-20 GLOBAL DATA SYMBOLS.

	SETZM	RMS.SC		;Mark RMS section as section 0
	SETZM	OTS.SC		;Mark OTS section as section 0

	POPJ	PP,		;Return

NOXRMS:	HRROI	1,[ASCIZ/?Can't find SYS:XRMS.EXE
/]
	PSOUT%
	HALTF%

E$$CGR:	HRROI	1,[ASCIZ/?Can't GET SYS:XRMS.EXE
/]
	PSOUT%
	HALTF%

E$$SNA:	HRROI	1,[ASCIZ/?Non-zero sections not available
/]
	PSOUT%
	HALTF%

E$$NFS:	HRROI	1,[ASCIZ/?No free sections
/]
	PSOUT%
	HALTF%

E$$BRM:	HRROI	1,[ASCIZ/?Can't init RMS in non-zero section: RMS entry vector
already set up in section zero
/]
	PSOUT%
	HALTF%

E$$CGD:	HRROI	1,[ASCIZ/?Can't get DDT in RMS's section
/]
	PSOUT%
	HALTF%

>;END IFN TOPS20
IFE TOPS20,<
SEARCH	UUOSYM
RMS$10==:600010				;RESOLVE SYMBOL REFFED IN $verb MACROS
					;(ONLY $verb FOR TOPS-10 MACRO PROGRAMS)
	SKIPE	SAVE17			;REPEAT CALL?
	POPJ	17,			;YES
	MOVEM	17,SAVE17		;BECAUSE MERGE. CLOBBERS IT
	MOVEI	17,SAVEAC		;SAVE OTHERS NOW
	BLT	17,SAVEAC+16		;DONE
	MOVEI	1,RMS.FS		;LOAD PTR TO RMS FILE SPEC
	MERGE.	1,			;GET IT
	  JRST	INIERR			;OOPS
	MOVE	1,[.PAGCD,,[EXP 2,643,644]];CREATE RMS GLOBALS AREA
	PAGE.	1,			;DO IT
	  JRST	INIERR			;OOPS
	MOVSI	17,SAVEAC		;RESTORE AC'S
	BLT	17,17			;DONE
	POPJ	17,
RMS.FS:
	SIXBIT	/SYS/
	SIXBIT	/RMS/
	SIXBIT	/EXE/
	EXP	0
	EXP	0
	XWD	600,677			;GIVE IT RANGE TO MERGE
SAVEAC:
	BLOCK	17
SAVE17:
	EXP	0
INIERR:
	OUTSTR	[ASCIZ/? Could not initialize RMS
/]
	EXIT	1,
>					;END IFE TOPS20
;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	SVNOSK(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, AND RELATIVE AND SEQUENTIAL

;THIS ROUTINE CONSISTS OF SIX PARTS:
;	(1) CHECK FOR ERRORS AND CONFLICTS OPENING THE FILE, OP.MIX - OPEPVL
;	(2) GET LOW-CORE FOR RMS IN-CORE ARG BLKS, OP.MX0 - MNCR1
;	(3) SET UP FOR RMS CALL TO OPEN / CREATE THE FILE, OP.M0D - OP.MXC
;		PICKFN - PCKF1B IS CALLED FROM THIS CODE.
;	(4) OPEN / CREATE THE FILE, OP.MXC - RFNFER
;	(5) CHECK OUT THE RESULTS OF THE CALL TO RMS, CHKOPF
;	(6) CALL RMS TO CONNECT RAB TO FILE, DOCONN - CONDM2
;ERROR HANDLING ROUTINES ARE INTERSPERSED THROUGHOUT AS APPROPRIATE

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

;ARGUMENT FORMAT:
;
;ARGLIST:	FLAG-BITS,,FILTAB-ADDR
;		0,,ADDR-OF-KEY-INFO
;***** NOTE: 2ND WORD OF ARGLIST HAS BEEN DELETED. ADDR-OF-KEY-INFO LIST
;***** CAN NOW BE FOUND IN THE FILE TABLE IN THE LEFT HALF OF THE WORD
;***** F.RMKL

;THERE ARE NOW TWO KINDS OF FLAG BITS IMPLEMENTED FOR RMS OPENS: (1) THE
;STAND-ALONE (NON-SMU) OPEN, WHICH HAS BEEN IMPLEMENTED SINCE V 12B, AND
;(2) THE SMU OPTION 5 FORM OF OPEN, WHICH ASSUMES THAT THE FILE IS TO BE
;OPENED FOR I-O AND WHOSE FLAG BITS LOOK LIKE THE FLAG BITS FOR A NON-RMS
;SMU OPTION 1 OPEN.

;
;FLAG-BITS FOR STAND-ALONE OPEN:
;	V%OPEN==1B3	LIBOL OPEN VERB FLAG - NOT RECOGNIZED BY RMSIO
	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
;OPEN NO REWIND, OPEN REVERSED NOT SUPPORTED

;FLAG-BITS FOR SMU OPTION 5 OPEN:

	V%OPS5==12		;SMU OPTION 5 OPEN
	OPN%UN==1B17		;OPEN HAS UNAVAILABLE CLAUSE

;KEY INFORMATION:
;THE KEY INFO IS POINTED TO BY THE LEFT HALF OF THE WORD F.RMKL IN THE
;FILE TABLE, AND IS IN THE "HIGH-SEG" UNDER %x: WHICH IS UNDER "START.".
;
;	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

;OPEN NO REWIND, OPEN REVERSED NOT SUPPORTED.

OP.MIX:	PUSHJ	PP,SETIO	;SETUP FOR I/O

	;FIRST CHECK FOR RMS VERSION 2 WITH SMU OPTION 1. WE CANT ACTUALLY
	; TEST FOR IT UNTIL THIS POINT BECAUSE WE DONT KNOW IF A FILE IS
	; GOING TO BE UNDER SMU OPTION 1 UNTIL IT IS ACTUALLY OPENED.

	SKIPN	F.WSMU(FT)	;DOING SMU OPTION 1?
	 JRST	OP.MIZ		; NO
	LDB	T0,[POINT 9,RMSVR.,11]	;YES, REQUIRES RMS V2 OR HIGHER
	CAIGE	T0,RMSV2	; IS IT?
	 JRST	OPERV1		;NO, FATAL ERROR
OP.MIZ:				;
	LDB	T0,FT.CRC	;[1020] IS THERE CHECKPOINTING?
	SKIPE	T0		;[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

;TEST FILE TYPE FIELD FROM FILE TABLE FLAG WORD FOR VALID ORG.
;ALL WE WANT TO SEE HERE IS IF EXACTLY ONE BIT IS SET, SO WE HAVE NO 
;HASSLE HERE. HOWEVER, THERE IS A DISCREPANCY BETWEEN LIBOL AND RMS
;REGARDING THE BIT SETTINGS FOR SEQUENTIAL AND RELATIVE FILES:
;
;		RELATIVE	  SEQUENTIAL	INDEXED
;	IN LIBOL  RANFIL==1	  SEQFIL==2	IDXFIL==4
;	IN RMS	FB$REL==2	  FB$SEQ==1	FB$IDX==3
;
;THIS DISCREPANCY WILL CAUSE US A HASSLE FURTHER DOWN WHEN WE HAVE TO
;HANDLE THE EXACT BIT SETTINGS.

	LDB	T1,FT.ORG		;GET FILE TYPE FIELD
	CAIG	T1,IDXFIL		;IDXFIL SET AND ANOTHER BIT SET?
	CAIN	T1,RANFIL!SEQFIL	;BOTH REL AND SEQ TYPES SET?
	 JRST	OPEORG		;ERROR
	JUMPE	T1,OPEORG	;ERROR, NO BITS SET

	CAIN	T1,IDXFIL	;Is this other than an index file?
	JRST	OP.MZ1		;No
	LDB	T2,[POINT 9, RMSVR.,11]	;Yes, is it RMS V2 or greater?
	CAIGE	T2,RMSV2	;
	JRST	OPEWV		;No, error

;CHECK TO MAKE SURE THAT IF SIMULTANEOUS UPDATE BEING DONE, THAT IT IS 
;OPTION 5 WITH APPLY BASIC-LOCKING.

OP.MZ1:	MOVE	T2,BS.AGL##	;GET ADDRESS OF INCOMING ARG LIST
	LDB	T1,[POINT 4,(T2),3]	; GET LEFTMOST HALF A BUCK
	CAIE	T1,V%OPS5	;SMU OPTION 5 OPEN?
	 JRST	OP.MIY		; NO
	LDB	T1,FT.ABL	;APPLY BASIC-LOCKING FLAG SET?
	 JUMPE	T1,OPESMU	; NO - ERROR

OP.MIY:

;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:	SKIPL	WANT8.##	;WANT ANS 8X FUNCT?
	 JRST	OPEAL1		; NO
	MOVEI	T0,FS%41	;SET UP FILE-STATUS FILE-ALREADY-OPEN
	MOVEM	T0,FS.FS	; AND SAVE IT
	PUSHJ	PP,SETFS	; AND MOVE IT TO USER FIELD
OPEAL1:	$ERROR	(E.509,SV.KIL,MT.FIL)

;** ERROR: FILE IS LOCKED

OPELCK:	SKIPL	WANT8.		;WANT ANS 8X FUNCT?
	 JRST	OPELC1		; NO
	MOVEI	T0,FS%38	;SET UP FILE-STATUS FILE-ALREADY-OPEN
	MOVEM	T0,FS.FS	; AND SAVE IT
	PUSHJ	PP,SETFS	; AND MOVE IT TO USER FIELD
OPELC1:	$ERROR	(E.510,SV.KIL,MT.FIL)

;** ERROR: CAN'T OPEN FILE IN OVERLAY  (TEMP ERROR)

OPEOVL:	$ERROR	(E.511,SV.KIL,MT.FIL)

;** ERROR: FILE CANT BE OPENED BECAUSE IT HAS INCORRECT ORG FIELD VALUE
;** IF THIS SHOWS UP, IT IS A COMPILER ERROR.

OPEORG:	$ERROR	(E.524,SV.KIL,MT.FIL)

;** ERROR: SIMULTANEOUS UPDATE OF RMS FILES REQUIRES APPLY BASIC LOCKING
;** COMPILER SHOULD CATCH THIS PROBLEM, IS ATTEMPT TO PLAY SAFE IF WE
;** DON'T HAVE OTHER SMU OPTIONS FOR RMS FILES.

OPESMU:	$ERROR (E.526,SV.KIL,MT.FIL)

OPERV1:	$ERROR (E.530,SV.KIL,MT.FIL)

OPEWV:	$ERROR (E.531,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:
	MOVSI	T1,(TRN)	;SET UP NULL CONVERT INSTR FOR SMU OPT 1
	MOVEM	T1,D.RCNV(FT)	;AND SAVE IT IN FILE TABLE WORD

	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
	CAIN	T2,BINMOD		;EXTERNAL MODE BINARY?
	 JRST	[CAIN	T1,SIXMOD	; AND INTERNAL MODE SIXBIT?
		  JRST	OP.M0C	;YES, NO NEED FOR CONVERSION
		 JRST	OP.M0H]	;

;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.
OP.M0H:
	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,SIXCT		; ASSUME SIX BYTES PER WORD
	TLNE	T3,DDMASC	; IS IT ASCII?
	 MOVEI	T4,ASCCT		;YES, FIVE BYTES PER WORD
	TLNE	T3,DDMEBC	; IS IT EBCDIC?
	 MOVEI	T4,EBCCT		;YES, FOUR BYTES PER WORD

;FIND T1=SIZE OF LARGEST KEY
;
;LEAVE THIS STUFF IN-LINE FOR RELATIVE FILES, WHICH DO HAVE ONE KEY.
;IT WON'T HURT SINCE WE ARE ONLY FIGURING OUT HOW MUCH CORE WE WANT FROM FUNCT.
;WE DON'T NEED IT, BUT IT ONLY COMES TO TWO WORDS PER RELATIVE FILE.
;IF A CONVERSION BUFFER IS NEEDED FOR A RELATIVE KEY, THE COMPILER BUILDS
;IT IN %PARAM.
;
	TLNE	T3,SEQFIL		;BYPASS KEY INFO PROCESSING FOR SEQ FILES
	 JRST	OP.M0J
	HLRZ	T3,F.RMKL(FT)	;GET ADDRESS OF KEY INFO TO FIND
				; 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,NXKEYB	;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. THIS APPLIES TO THE CONVERSION
;BUFFER ONLY. THE USER BUFFER HAS BEEN SET UP IN THE GENERATED CODE.

OP.M0J:
	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.
;KEY XAB'S ARE ONLY REQUIRED FOR INDEXED FILES, SO WE WILL BYPASS THE CORE
;CALCULATIONS FOR THEM.
;ALSO, IF WE ARE DOING SMU OPTION 1, WE NEED SHADOW RAB FOR FAKE READS.
;THIS WAY WE WILL BE ABLE TO DO ALL THE RETAIN / FREE I-O IN THE BUFFERS
;OF THE SHADOW RAB AND THE RECORD CURRENCY IN THE BUFFERS OF THE MAIN
;RAB WILL REMAIN UNTOUCHED.

; GET T1:= # WORDS NEEDED, STORE IN FUN.A2

OP.M0C:
	HRRZI	T1,0		;INITIALIZE T1
;FIGURE OUT MAX RECORD SIZE IN WORDS
	MOVEI	T4,SIXCT	;ASSUME SIXBIT
	MOVE	T3,F.WFLG(FT)	;GET FILE TABLE FLAG WORD
	TLNE	T3,DDMASC	;IS IT ASCII?
	 MOVEI	T4,ASCCT	; YES
	TLNE	T3,DDMEBC	;IS IT EBCDIC?
	 MOVEI	T4,EBCCT	; YES
	LDB	T1,FT.MRS	;NOW GET MAX RECORD SIZE (IN BYTES)
	ADDI	T1,-1(T4)	; AND FORCE ROUNDING UP REMAINDERS
	IDIV	T1,T4		;CALCULATE MAX RECORD SIZE IN WORDS
	MOVEM	T1,SM.RLN	; AND SAVE ASIDE FOR ARITHMETIC BELOW
	MOVEM	T1,RMS.RL##	;SAVE RECORD LENGTH FOR READ
	ADDI	T1,RA$LNG	;ADD IN LENGTH OF RAB (FOR SHADOW RAB)
	SKIPN	F.WSMU(FT)	;DOING SMU OPTION 1?
	HRRZI	T1,0		;NO, RE-INITIALIZE T1
OP.M0K:
	ADDI	T1,.RCLEN+FA$LNG+RA$LNG	;NEED A CONTROL-BLOCK, AND A FAB, AND A RAB

;FIND # OF KEYS, PUT IN T2 - FOR INDEXED FILES ONLY
	MOVE	T3,F.WFLG(FT)	;GET FLAG WORD FROM FILE TABLE
	TLNN	T3,IDXFIL		;IS FILE INDEXED?
	JRST	OP.M0F		;NO - BYPASS XAB SPACE CALCULATION
	HLRZ	T3,F.RMKL(FT)	;GET ADDRESS 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
OP.M0F:
	SKIPN	F.WSMU(FT)	;IF DOING SMU OPTION 1
	 JRST	OP.M0M		; NOT
	ADD	T1,(PP)		;ADD IN SIZE OF FAKE CONVERSION BUFFER
	ADD	T1,-1(PP)	; AND MAX KEY SIZE FOR FAKE KEY CONV BUFFER
OP.M0M:
	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

	SKIPN	F.WSMU(FT)	;DOING SMU OPTION 1?
	 JRST	OP.M0G		; NO
	MOVEM	T1,.RCFAK(FTL)	;YES -- STORE ADDRESS OF RMS SHADOW RAB
	ADDI	T1,RA$LNG	;ADD LENGTH OF RAB
	MOVEM	T1,SM.BUF	;STORE ADDRESS OF SHADOW BUFFER
	ADD	T1,SM.RLN	;ADD LENGTH OF RECORD BUFFER

OP.M0G:
	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
	SKIPN	F.WSMU(FT)	;IF DOING SMU OPTION 1
	 JRST	OP.M0L		;
	MOVEM	T1,.RCFCB(FTL)	;SET UP ADDR OF FAKE RECORD CONVERSION BUFFER
	ADD	T1,T4		; AND ADVANCE COUNT OF NUMBER OF WORDS
	MOVEM	T1,.RCFKC(FTL)	;SET UP ADDRESS OF FAKE KEY CONVERSION BUFFER
	ADD	T1,T3		; AND THE NUMBER OF WORDS REQUIRED FOR IT
OP.M0L:


;MAKING SURE TO PRESERVE T1 FOR OP.M0D, WE WILL NOW
; GET THE ADDRESSES OF THE CONVERSION ROUTINES, AND STORE THEM
; IN .RCCRS:
;WE HAVE TO BE CONCERNED WITH RECORDING MODE BINARY FOR CONVERSIONS TOO.
;THE FOLLOWING LDB'S HAVE BEEN CHANGED TO REFLECT THE COMMENT NEAR OP.MX5
;ON THIS BASIS, BINARY = 0, EBCDIC = 1, SIXBIT = 2, AND ASCII =4 AFTER
;THE LDB IS EXECUTED. BINARY WILL BE TREATED AS SIXBIT, AND ALL OF THE
;OTHER VALUES WILL BE ALTERED TO THEIR ORIGINALLY CODED VALUES BY THE
;LITTLE KROCKS BELOW THE LDB'S. IT WOULD BE BETTER TO REWRITE THE XCT
;TABLE AND THE CONVERSION TABLES TO REFLECT FOUR ENTRIES WHEN WE HAVE
;TIME. THE PURPOSE OF THIS EFFORT IS TO DO SOMETHING REASONABLE FOR THE
;GUY WHO SPECIFIES RECORDING MODE BINARY AND USES DATA MODE DISPLAY-7.
;WE WILL SEND DISPLAY-6 DATA TO HIS FILE FOR HIS DISPLAY-7 FIELDS.
;THIS IS A LOT BETTER THAN DOING NO CONVERSION AT ALL BECAUSE THE DISPLAY-7
;DATA AT THE END OF HIS RECORD WOULD BE TRUNCATED IF WE MERELY ASSUMED
;DEVICE DATA MODE SIXBIT WERE COMPATIBLE.

	MOVE	T0,F.WFLG(FT)	;GET COMPILER FLAGS
	LDB	T2,[POINT 3,T0,14] ;INTERNAL RECORDING MODE..
	CAIN	T2,BINMOD		;BINARY? SPECIFY SIXBIT
	 JRST	[MOVEI	T2,SIXMOD
		 JRST	OP.M0X]
	CAIN	T2,ASCDDM		;ASCII? MAKE 0.
	 JRST	[MOVEI	T2,BINMOD
		 JRST	OP.M0X]
OP.M0X:
	LDB	T3,[POINT 3,T0,2] ;EXTERNAL RECORDING MODE..
	CAIN	T3,BINMOD		;BINARY? SPECIFY SIXBIT
	 JRST	[MOVEI	T3,SIXMOD
		 JRST	OP.M0Y]
	CAIN	T3,ASCDDM		;ASCII? MAKE 0.
	 JRST	[MOVEI	T3,BINMOD
		 JRST	OP.M0Y]
OP.M0Y:
	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,FS%30	;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 **
;THIS SECTION SETS UP THE FAB RAB AND XAB'S FOR THE RMS OPEN / CREATE CALL
;IT CONSISTS OF FOUR PARTS: 
;	(1) COPY OVER THE PROTOTYPE zAB'S TO THIS FILE'S COMMUNICATION AREA.
;		THERE ARE SOME DEFAULT FIELD SETTINGS IN THE zAB'S
;		AND THEY ARE PRE-DEFINED TO BE THE CORRECT LENGTHS.
;	(2) SET UP THE KEY XAB'S (FOR INDEXED FILES)
;	(3) SET UP THE FAB
;	(4) SET UP THE RAB
;UPDATES TO THE RMS COMMUNICATIONS HEADER ARE INTERSPERSED THRU THIS CODE

;Come here with T1 = address where we will put the first XAB.
; Conversion buffers have been allocated if necessary.
;HOWEVER, IF THE FILE IS NOT INDEXED WE DON'T NEED THE XAB ADDRESS.

OP.M0D:	
	MOVE	T3,F.WFLG(FT)	;GET FLAG WORD FROM FILE TABLE
	TLNE	T3,IDXFIL		;IS FILE INDEXED?
				;IF NO, SKIP NEXT INSTRUCTION.
	MOVEM	T1,.RCXAB(FTL)	;ADDR OF THE FIRST XAB
	MOVE	T1,RMS.RL	;GET RECORD SIZE (IN WORDS)
	MOVEM	T1,.RCRLN(FTL)	; AND PUT IT IN THE RAB

;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)

;WE DON'T HAVE TO SET UP KEY XAB'S IF THE FILE IS NOT INDEXED
	MOVE	T3,F.WFLG(FT)	;GET FLAG WORD FROM FILE TABLE
	TLNN	T3,IDXFIL		;IS FILE INDEXED?
	JRST	OP.MX4		;NO - BYPASS XAB SETUP

;STORE INFO INTO THE XAB'S.

	HLRZ	T3,F.RMKL(FT)	;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,KYINFO	;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,KYINFO(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,NXKEYB	;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 ***
OP.MX4:
; MOST OF THE INFORMATION IS IN THE NORMAL FILE-TABLE.
	MOVE	T4,.RCFAB(FTL)	;T4 POINTS TO THE FAB

;FOR SMU OPTION 5, WE ALREADY HAVE FAC AND SHR SET UP IN SMU.AG, SO FIND
;IF WE ARE OPENING FOR SMU OPT 5 AND IF SO GO DO THE TWO MOVES. SMU
; OPTION 5 LETS RMS DO ALL OF THE LOCKING AS WELL AS THE FILE I-O.

	MOVE	T1,BS.AGL##	;GET ADDRESS OF ARG LIST
	LDB	T0,[POINT 4,(T1),3]	;GET LEFTMOST 4 BITS OF ARG WORD
	CAIN	T0,V%OPS5	; DOING SMU OPTION 5 OPEN?
	 JRST	OP.SMU		;  YES

	HLL     T0,FLGFIL(T1)	;GET FLAGS FROM ARG WORD TO TEST FOR SMU OPTION 1
				;DO THIS BEFORE T1 GETS BLOWN AWAY

;FILE ACCESS DESIRED
	SETZ	T1,		;T1 WILL LIST THE OPERATIONS WE WANT TO DO
;
;SMU OPTION 1 IS LSU-STYLE FILE AND RECORD LOCKING, AND DOES NOT USE
; RMS LOCKING AT ALL. THE FLAG FB$SU1 WHICH HAS BEEN DEFINED AND SET
; HERE FOR THE FAC WORD HAS TO BE IMPLEMENTED IN RMS.
;
	SKIPE	F.WSMU(FT)	;DOING SMU OPTION 1 OPEN?
	 JRST	OP.SMU			; GO SET UP FAC AND SHR FOR EITHER SMU

;IF OPEN FOR INPUT, NO BITS WILL BE SET IN "FAC".
	TXNE	FLG,OPN%OU	;OPEN FOR OUTPUT?
	TXO	T1,FB$PUT	;"PUT" ACCESS
;NOW WE TEST TO SEE IF A SEQUENTIAL FILE IS BEING OPENED UP FOR I-O.
; NOTE: THE FOLLOWING FIVE LINES OF CODE ARE OBSOLETE
;;;	MOVE	T0,F.WFLG(FT)	;GET FILE TABLE FLAG WORD
;;;	TLNE	T0,SEQFIL		;AND CHECK FOR SEQ FILE
;;;	 JRST	[TXNE	FLG,OPN%IO ;IF SO, TEST ARG AC FLAGS FOR OPEN I-O
;;;		 JRST	OPIOER	;IF SO AGAIN, STUFF IT TO HIM.
;;;		 JRST	OPMX4A]	;OTHERWISE, OK.
	TXNE	FLG,OPN%IO	;OPEN FOR I-O?
	TXO	T1,FB$UPD!FB$DEL 	;YES, ALSO ALLOW 'UPDATE', 'DELETE'
OPMX4A:
	$STORE	T1,FAC,(T4)	;STORE ACCESS WANTED

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

	 JRST	OP.PFN		;NEXT GO GET FILE NAME

;FOR SMU OPEN WE NOW TRANSFER THE FAC AND SHR FROM SMU.AG TO FAC + SHR

OP.SMU:
	HLRZ	T1,SMU.AG##	;GET FAC
	$STORE	T1,FAC,(T4)	; AND STORE IT

	HRRZ	T1,SMU.AG##	;GET SHR
	$STORE	T1,SHR,(T4)	; AND STORE IT
;FIGURE OUT FILE NAME. IF PRECISELY 9 CHARACTERS CONSISTING ONLY OF
; ALPHABETICS, NUMERICS AND SPACES ASSUME OLD "TOPS-10" STYLE. OTHERWISE
; ASSUME TOPS-20 STYLE. IF THE FILENAME IS BAD IN EITHER STYLE, IT WILL
; BE STOPPED AT OPEN TIME.

OP.PFN:
	MOVE	T2,F.WVID(FT)	;GET BYTE POINTER TO NAME
	LDB	T1,[POINT 06,T2,11]	;GET BYTE SIZE
	HRRZ	T3,F.SZID(FT)	;GET SIZE OF FILE NAME
	CAIE	T3,^D9		; NINE CHARACTERS?
	 JRST	OP.T20		;  NO, ASSUME TOPS-20 STYLE NAME
OP.NCH:				;
	ILDB	C,T2		;GET AN ID CHARACTER
	CAIN	T1,6		;SIXBIT?
	ADDI	C,40		;
	CAIN	T1,11		;EBCDIC?
	LDB	C,PTR.97##	;


	;THE FOLLOWING SET OF TESTS ARE VERY PEDESTRIAN BUT THEY GET THE JOB DONE.
	CAIN	C," "		; ASCII SPACE?
	 JRST	OP.PLP		;YES, GO GET NEXT CHAR
	CAIGE	C,"0"		;ANYTHING ELSE LESS THAN "0"?
	 JRST	OP.T20		; YES
	CAIG	C,"9"		;LESS THAN OR = "9"?
	 JRST	OP.PLP		; YES, ON TO NEXT CHAR
	CAIGE	C,"A"		;LESS THAN "A"?
	 JRST	OP.T20		; YES
	CAIG	C,"Z"		;LESS THAN OR = "Z"?
	 JRST	OP.PLP		; YES, ON TO NEXT CHAR
	CAIGE	C,"a"		;LESS THAN "a"?
	 JRST	OP.T20		; YES
	CAILE	C,"z"		;LESS THAN OR = "z"?
	 JRST	OP.T20		; NO
OP.PLP:				;
	SOJG	T3,OP.NCH	;SUB 1 AND IF > 0 GO PICK UP NEXT CHAR
;	JRST	OP.T10		; ALL DONE WITH LOOP - IS OLD-STYLE NAME

OP.T10:				;
	PUSHJ	PP,PICKFN	;CONVERT VALUE-OF-ID TO TOPS-10 RMS FILENAME
	 JRST	RFNFER		;ERROR, GO RECOVER FROM FNF ERROR
	JRST	OP.PNX		;IF OK, GO ON

OP.T20:				;
	CAIE	T1,7		;IS BYTESIZE 7? (IN ASCII)
	JRST	CVTVID		;NO, CONVERT IT TO ASCIZ STRING
	HRRZ	T1,F.WVID(FT)	;GET ADDRESS OF ASCIZ VALUE OF ID STRING
	$STORE	T1,FNA,(T4)	; AND STORE IT IN THE FAB FOR RMS-20
	JRST	OP.PNX		;

CVTVID:	MOVEI	T1,.RCFNM(FTL)	;
	$STORE	T1,FNA,(T4)	;STORE ADDRESS OF ASCIZ ID IN FAB
	HRRZ	T3,F.SZID(FT)	;SIZE OF NAME
	MOVSI	T4,(POINT 7,)	;BUILD BYTE POINTER TO NAME
	HRR	T4,T1		;
	MOVE	T2,F.WVID(FT)	;SOURCE BYTE POINTER
CVT.1:	ILDB	C,T2		;GET CHARACTER
	TLNE	T2,1000		;EBCDIC?
	LDB	C,PTR.97##	;
	TLNN	T2,1000		;SIXBIT?
	ADDI	C,40		;
	IDPB	C,T4		;
	SOJG	T3,CVT.1	;DECREMENT CHARACTER COUNT

OP.PNX:				;
	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
;HOWEVER, FOR CREATE WE HAVE TO FIGURE IT OUT. START OUT WITH NULL VALUE
;AND QUERY THE INDIVIDUAL BITS IN FILE ORG FIELD OF FILE TABLE FLAG WORD.
	SETZ	T1,		;ZERO IT OUT
	MOVE	T3,F.WFLG(FT)	;GET FLAG WORD FROM FILE TABLE
	TLNE	T3,IDXFIL		;INDEXED?
	MOVEI	T1,FB$IDX		;SET BIT
	TLNE	T3,RANFIL		;RELATIVE?
	MOVEI	T1,FB$REL		;SET BIT
	TLNE	T3,SEQFIL		;SEQUENTIAL?
	MOVEI	T1,FB$SEQ		;SET BIT
	$STORE	T1,ORG,(T4)		;PUT ORG IN FAB

	TLNE	T3,SEQFIL		;IS FILE SEQUENTIAL?
	SKIPN	F.WSMU(FT)		; AND ARE WE DOING SMU OPTION 1?
	SKIPA				;NO TO AT LEAST ONE OF THE ABOVE
	 JRST	SM1SER			; YES TO BOTH

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

;FILE OPTIONS -- FOR INDEXED FILES ONLY, FILE FLAG WORD STILL IN T3.
	TLNN	T3,IDXFIL		;INDEXED?
	JRST	OP.MX5		;NO. NOTE, DON'T NEED XAB ADDR EITHER
	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)

;THE FOLLOWING COMMENT DOES NOT APPLY TO RELATIVE FILES.
;WE DEAL WITH MRS FOR THEM UNDER BUCKET SIZE
;	** Leave maximum record size (MRS) at zero **
;	This allows a file to be created and then later
;	 the record size increased.

;BYTE SIZE

;THE FOLLOWING CODE INVOLVING THE MOVES OF INDEXED LITERALS HAS BEEN
;REVISED TO TRY TO REFLECT MORE CLOSELY WHAT IS SHOWN IN FTDEFS.MAC
;CONCERNING THE RUN-TIME DEVICE DATA MODE FIELD IN THE FILE TABLE FLAG
;WORD. THE LDB INSTRUCTION IS NOT COMPLETELY IN CONFORMITY WITH THE
;FIELD F%ADDM IN FTDEFS, AS THAT FIELD SHOWS A BYTE SIZE OF 4.
;THIS LDB TRUNCATES THE RIGHTMOST BIT OF THAT FIELD.
;YOU WILL NOTICE, HOWEVER, THAT RECORDING MODE BINARY IS SET UP AS SIXBIT.
;SORRY ABOUT THAT, FOLKS. IT WOULD HAVE TAKEN A LOT OF KROCKING TO MAKE
;PURE BINARY WORK ACCORDING TO THE CONCEPT, AND THE EFFECT IS THE SAME
;AS FAR AS THE USER IS CONCERNED. THE ONLY DIFFERENCE IS THAT THE BYTE
;SIZE IS SET UP AS 6 IN THE RMS FILE HEADER, AND THE BYTE COUNT IN THE
;RECORD HEADER IS GIVEN FOR SIXBIT BYTES.

OP.MX5:
	MOVE	T0,F.WFLG(FT)	;GET COMPILER FLAGS
	LDB	T1,[POINT 3,T0,2]	;GET DEVICE DATA MODE
	CAIN	T1,ASCDDM		;ASCII?
	 MOVEI	T1,ASCMOD		;YES, NORMALIZE FOR LITERAL S BELOW
; BINARY = 0; EBCDIC = 1; SIXBIT = 2; ASCII = 3
	MOVE	T2,[SIXSIZ
		    EBCSIZ
		    SIXSIZ
		    ASCSIZ](T1)	;GET BYTE SIZE DEPENDING ON MODE
;;;;; THE FOLLOWING COMMENT APPLIED TO THE WORK DONE ON INDEX FILES RE
;;;;; THE FCCTC TESTS FOR VERSION 12B
	;APPARENTLY BINARY IS NOT AN ISSUE. SUBSUME UNDER SIXBIT?
;;;;; THE ANSWER IS YES.
	$STORE	T2,BSZ,(T4)

;T1 STILL CONTAINS THE MODE..

;BUCKET SIZE
	MOVE	T2,[SIXCT
		    EBCCT
		    SIXCT
		    ASCCT](T1)	;GET BYTES/WORD DEPENDING ON MODE
	LDB	T1,FT.MRS	;GET MAXIMUM RECORD SIZE

;T0: STILL CONTAINS THE FLAG WORD FROM THE FILE TABLE, SO TEST FOR MRS ON
;RELATIVE FILE NOW, AND STORE IT IN FAB.

	TLNE	T0,RANFIL		;RELATIVE FILE?
	$STORE	T1,MRS,(T4)	;YES, PUT IT IN FAB

;DO THE REST OF THIS PARAGRAPH ONLY FOR INDEXED FILES. DON'T WORRY ABOUT
;BUCKET SIZE FOR OTHER FILE TYPES BESIDES INDEXED.

	TLNN	T0,IDXFIL		;INDEXED?
	JRST	OP.MX6

	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)

;[1044] SPACE FILL THE RECORD AREA
	MOVE	T0,F.WFLG(FT)	;[1044] GET FLAGS
	LDB	T3,[POINT 2,T0,2] ;[1044] GRAB OFF EBCDIC AND SIXBIT BITS OF 
				  ;[1044]  DEVICE DATA MODE FIELD.
	MOVE	T2,[EXP ASCCT,
			EBCCT,
			SIXCT](T3)	;[1044] GET BYTES/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] GET EBCDIC AND SIXBIT BITS OF INTERNAL DATA MODE
	MOVE	T0,SPCTLE(T3)	;[1044] GET PROPER SPACE FOR INTERNAL DATA MODE
	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)	;RESTORE FLAGS TO T0
;RECORD FORMAT
OP.MX6:
	MOVEI	T1,FB$VAR	;VARIABLE LENGTH FORMAT
	TLNN	T0,SEQFIL		;SEQENTIAL FILE?
	 JRST	OP.MX7		;NO
	$FETCH	T3,BSZ,(T4)	;GET BYTE SIZE
REPEAT 0,<		;DISABLE ASCII STREAM
	CAIN	T3,ASCSIZ		;IS IT ASCII?
	 MOVEI	T1,FB$STM		;YES, SPECIFY STREAM FILE
>	;END REPEAT 0
OP.MX7:
	$STORE	T1,RFM,(T4)
	CAIE	T3,ASCSIZ	;ALSO ZERO OUT FLAG FOR FUNNY <CR> FOR
	 JRST	OPMX7A		; ASCII STREAM FILES
	SETZ	T2,		; TAKE T2 BECAUSE IT IS ABOUT TO BE ZEROED
	DPB	T2,FT.NOC	; OUT IN ANY EVENT.
OPMX7A:

;DON'T ALLOW BUCKET SPANNING FOR RELATIVE AND SEQUENTIAL FILES EXCEPT
;FOR ASCII STREAM.

	HRRZI	T2,0		;INIT TO RECEIVE REC ATTRIB VALUES
REPEAT 0,<		;DISABLE ASCII STREAM
	CAIE	T0,IDXFIL	;INDEXED FILE?, YES - NOT APPLICABLE
	CAIN	T1,FB$STM	;ASCII STREAM FILE?
	 JRST	OP.MX9		; YES - ILLEGAL NOT TO ALLOW SPANNING
>	;END REPEAT 0
	MOVEI	T2,FB$BLK	;MAKE IT BLOCKED
OP.MX9:
	$STORE	T2,RAT,(T4)	;RECORD ATTRIBUTES INTO FAB.

;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)	;. .
	TLNE	T0,SEQFIL		;DOING SEQ FILE?
	 JRST	OP.MX8		;DON'T NEED KEY BUFFER
	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.

;FIND # OF KEYS -- ONLY FOR INDEXED FILES. 
;WE DON'T NEED A BUFFER FOR RELATIVE FILES.

OP.MX8:

	SETZ	T1,		;CLEAR T1, IN CASE WE JUMP BELOW
	TLNN	T0,IDXFIL	;NEED KEY BUFFERS ONLY FOR INDEX FILES
	JRST	ORABS0		;NOT INDEXED

	HLRZ	T3,F.RMKL(FT)	;GET ADDRESS OF KEY INFO
	MOVE	T1,(T3)		;T1:=FIRST WORD = # OF KEYS
ORABS0:
	ADDI	T1,OVHEAD	;GET # KEYS + 3
	LDB	T3,FT.NAB	; GET NUMBER HE SPECIFIED
	JUMPE	T3,ORABS1	;JUMP IF HE DIDN'T SPECIFY ANY
	MOVEI	T1,0		;WE MIGHT HAVE TO LET RMS DECIDE
	CAIL	T3,OVHEAD	;MUST BE AT LEAST THREE
	MOVE	T1,T3		;OK, USE THE NUMBER HE SPECIFIED
ORABS1:	$STORE	T1,MBF,(T2)	;TELL RMS

	TLNN	T0,RANFIL	;RELATIVE FILE?
	JRST	ORABS2		;NO
	HRRZ	T1,F.RACK(FT)	;SET UP KEY BUFFER ADDRESS
	$STORE	T1,KBF,(T2)	; AND SAVE IN RAB

ORABS2:
	SKIPN	F.WSMU(FT)	;DOING SMU OPTION 1?
	 JRST	ORABS3		; NO
;FOR SMU OPTION 1 SET UP SHADOW RAB NOW
	HRLZ	T1,.RCRAB(FTL)	;COPY OVER EXISTING REGULAR RAB SETUP
	HRR	T1,.RCFAK(FTL)	; TO SHADOW RAB AREA
	HRRZI	T2,PRRABL-1(T1)	;
	BLT	T1,(T2)		;

; AND TELL SHADOW RAB WHERE SHADOW BUFFER AND FAKE KEY CONV BUFFER ARE..
	MOVE	T2,.RCFAK(FTL)	;GET ADDRESS OF SHADOW RAB FROM CONTROL BLOCK
	HRRZ	T1,SM.BUF	;GET ADDRESS OF SHADOW BUFFER
	$STORE	T1,UBF,(T2)	; AND STORE IT IN THE SHADOW RAB AS USER BUFFER
	$STORE	T1,RBF,(T2)	;  AND RECORD BUFFER
	HRRZ	T1,.RCFKC(FTL)	;GET ADDR OF FAKE KEY BUFFER
	$STORE	T1,KBF,(T2)	; AND STORE IT IN SHADOW RAB.

ORABS3:


;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
;	IF OPEN EXTEND, DO A $CREATE WITH FB$CIF BIT SET
	TXNE	FLG,OPN%IO	;OPEN I-O?
	 JRST	OP.MXA		;YES
	TXNE	FLG,OPN%IN	;OPEN INPUT?
	 JRST	OP.MXB		;YES

;OPEN OUTPUT AND OPEN EXTEND
OP.MXC:	MOVE	T2,.RCFAB(FTL)	;POINT TO FAB
	$FETCH	T1,FOP,(T2)	;GET FOP BITS NOW
	TXNN	FLG,OPN%EX	;DOING OPEN EXTEND?
	 IORI	T1,FB$SUP		;NO, SET SUPERSEDE MODE
	TXNE	FLG,OPN%EX	;DOING OPEN EXTEND?
	 IORI	T1,FB$CIF		;YES, SET CREATE-IF-MUST BIT
	$STORE	T1,FOP,(T2)
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$CREATE	<(T2)>,OPCER	;** DO THE CREATE **
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	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:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	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/
?COBLIB: Error on Creating RMS File
/]

;RMS-SYSTEM FAILURES, THE FAB HAS THE ERROR STUFF IN IT.
;NOTE: RMS ERROR CODES CAN ALSO COME HOPPING OUT TO THE USER AT RUN TIME.
;THEY WILL BE OCTAL NUMBERS OF THE FORM 300nnn, AND THEY CAN BE LOOKED 
;UP IN THE TOPS-10/20 REFERENCE MANUAL, RMSREF.MEM.

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
	PUSHJ	PP,SETFS	;PUT F-S INTO USER'S F-S FIELD
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

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

OPCER1:	TYPE	[ASCIZ/
?COBLIB: can't create RMS file
/]
	JRST	RSFAIF		;ERROR WITH FILENAME
;OPEN I-O
OP.MXA:	MOVE	T2,.RCFAB(FTL)	;POINT TO FAB
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$OPEN	<(T2)>,OPOER	;** DO THE OPEN **
	 TRNA			;NORMAL RETURN
	  JRST	OP.MXA		;TRY-AGAIN RETURN
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVE	T1,FS.FS	;GET FILE-STATUS CODE
	CAIE	T1,FS%92	;IS IT 92 FOR FILE LOCKED BY SOMEONE ELSE?
	 JRST	OPMXAK		; NO, GO TO CHECK RETURNED PARAMETERS
	MOVE	T2,BS.AGL##	;GET POINTER TO ARG LIST
	MOVE	T1,FLGFIL(T2)	;GET ARG PASSED WHEN OP.MIX CALLED
	TXNN	T1,OPN%UN	;UNAVAILABLE FLAG SET?
	 JRST	OPMXAK		; NO, GO CHECK RETURNED PARAMETERS
	AOS	(PP)		;YES, DO SKIP RETURN TO UNAVAILABLE RETURN
	POPJ	PP,		;

OPMXAK:
	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
	SKIPE	FS.FS		;Error 507 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 I-O OR OUTPUT ERRORS COME HERE
OPOER:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	MOVE	T2,.RCFAB(FTL)	;ADDR OF THE FAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	TXNN	FLG,OPN%IO	;OPEN FOR I-O?
	 JRST	OPOER2		; NO
	CAIN	T1,ER$DEV	;DEVICE ERROR?
	 JRST	OPDVER		; YES
OPOER2:	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/
?COBLIB: Error on Opening RMS File
/]
	JRST	RSFAIF		;RMS-SYSTEM FAILURE

OPDVER:	MOVEI	T1,FS%37	;SET F-S CODE FOR DEVICE ERROR ON OPEN
	MOVEM	T1,FS.FS	;
	PUSHJ	PP,SETFS	;
	TYPE	[ASCIZ/
?Error Opening RMS File: Improper Device
/]
	JRST	RSFAIF		; AND GIVE PROGRAM FAILURE
;FILE NOT FOUND - ERROR FOR $OPEN OR $CREATE
;NOTE: IF AN OPTIONAL SEQUENTIAL FILE OPENED FOR INPUT IS NOT PRESENT,
;THE $OPEN HAS FAILED. HERE WE SHOULD WARN THE USER THAT WE ARE PROCEEDING
;WITHOUT THE FILE, THEN SET THE NOTPRS BIT, RELEASE THE CORE AND RETURN.
;IN RD.MIS FOR SEQUENTIAL READS, WE INTERCEPT THE READ AND SET THE AT-END
;BIT FOR THE FIRST ATTEMPT TO READ.

OPOFNF:
	MOVE	T1,D.F1(FT)	;GET THE FLG1 FLAG WORD FROM FILE TABLE
	TLNN	T1,FILOPT	;FILE OPTIONAL?
	 JRST	OPOFN2		;NO
	MOVE	T1,F.WFLG(FT)	;GET FILE TABLE'S FLAG WORD
	TLNE	T1,SEQFIL	;IS FILE SEQUENTIAL?
	TXNN	FLG,OPN%IN	;YES, FILE OPENED FOR INPUT?
	 JRST	OPOFN2		;NO
	TLO	T1,NOTPRS	;SET FILE-NOT-PRESENT BIT
	MOVEM	T1,F.WFLG(FT)	;UPDATE FILE TABLE FLAG WORD
	SKIPL	WANT8.		;WANT ANS 8X FUNCT?
	 JRST	OPOFN1		; NO
	MOVEI	T0,FS%35	;SET F-S FOR NON-OPT FILE NOT PRES
	HLLZ	T1,D.F1(FT)	;GET FLG1 FLAGS
	TXNE	T1,B%OPTF	;IS FILE OPTIONAL?
	 MOVEI	T0,FS%05	; YES, LET EM OFF EASY
	MOVEM	T0,FS.FS	;SAVE FILE-STATUS
	PUSH	PP,T1		;SAVE FLAGS TEMPORARILY
	PUSHJ	PP,SETFS	; AND PUT IT IN USER'S FIELD
	POP	PP,T1		;GET FLAGS BACK
	TXNE	T1,B%OPTF	;TEST FOR OPTIONAL AGAIN
	 JRST	OPOFN2		; IF NOT, SOCK IT TO THEM

;THE FOLLOWING ERROR ROUTINE RETURNS AT THE NORMAL RETURN FOLLOWING THE
; $OPEN AT OP.MXB
OPOFN1:	$ERROR	(E.525,SV.WRN,MT.FIL,RFNFER)	;AND WARN USER

OPOFN2:	MOVE	T2,.RCFAB(FTL)	;GET ADDR OF FAB AGAIN.
	$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
;IF WE ARE DOING AN OPEN WITH APPLY BASIC-LOCKING AND THERE IS AN UNAVAILABLE
;CLAUSE ON THE OPEN STMT., WE DON'T WANT THE RUN TO INCUR A FATAL ERROR
;BECAUSE THE PROGRAMMER HAS SUPPLIED THE PROPER ESCAPE HATCH.

OPOFLK:
	LDB	T1,FT.ABL	;ARE WE DOING APPLY BASIC-LOCKING?
	JUMPE	T1,OPFLKE	;NO - ERROR
	MOVE	T2,BS.AGL##	;GET POINTER TO ARG LIST
	MOVE	T1,FLGFIL(T2)	; GET ARG WORD ON ENTRY TO OP.MIX
	TXNN	T1,OPN%UN	;UNAVAILABLE CLAUSE ON OPEN?
	 JRST	OPFLKE		;NO - ERROR
	MOVEI	T1,FS%92	;SET FILE-LOCKED CODE INTO FILE-STATUS
	MOVEM	T1,FS.FS	;
	PJRST	SETFS		; ETC., AND DO NORMAL RETURN

OPFLKE:
	$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.
	 JRST	RFNFER		;[1022] Jump to routine to release memory
	AOS	(PP)		;GIVE A TRY-AGAIN RETURN
	POPJ	PP,		;RETURN..
;OPEN INPUT
OP.MXB:	MOVE	T2,.RCFAB(FTL)	;POINT TO FAB
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$OPEN	<(T2)>,OPOER	;** DO THE OPEN **
	 TRNA			;NORMAL RETURN
	  JRST	OP.MXB		;TRY-AGAIN RETURN
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	SKIPE	FS.FS		;DID WE SET FILE-STATUS NON-ZERO?
	 POPJ	PP,		;YES, ERROR IGNORED. * RETURN FROM OPEN *
	MOVE	T1,F.WFLG(FT)	;GET FILE TABLE FLAG WORD
	TLNN	T1,NOTPRS		;OPTIONAL FILE NOT PRESENT?
	 JRST	OPMXB2		; NO
	SKIPL	WANT8.		;WANT 8X FUNCT?
	 JRST	OPMXB2		; NO
	MOVEI	T0,FS%05	;SET UP FILE-STATUS NUMBER
	MOVEM	T0,FS.FS	; AND SAVE IT
	PJRST	SETFS		; AND SET IT, RETURN -- SUCCESS SORT OF

OPMXB2:	PUSHJ	PP,CHKOPF	;CHECK PARAMETERS RETURNED TO US
	SKIPE	FS.FS		;Error 507  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

;THE FOLLOWING TEST IS NOT APPLICABLE FOR V13
;
;;;;;MAKE SURE FILE ORGANIZATION IS INDEXED
;;;;;	$FETCH	T1,ORG,(T2)	;GET FILE ORGANIZATION
;;;;;	CAIE	T1,FB$IDX	;MUST BE INDEXED
;;;;;	 JRST	ERORG		;?WRONG ORGANIZATION
;
;INSTEAD, CHECK ORG FIELD IN FAB AGAINST ORG FIELD IN FILE TABLE FLAG WORD.
;TO DO THIS, WE MAP THE BITS OF THE FAB'S ORG FIELD INTO THE FORM USED
;BY THE FILE TABLE, THEN COMPARE THE RESULT OF THIS MAPPING WITH WHAT IS
;IN THE FILE TYPE FIELD OF THE FILE TABLE'S FLAG WORD.

	$FETCH	T1,ORG,(T2)	;GET FAB'S ORG FIELD
	SETZ	T0,		;CLEAR T0 TO RECEIVE BIT MAP
	CAIN	T1,FB$IDX		;TEST BITS IN T1 AND TWEAK IN T0
				;NOTE: FB$IDX = 3 !!!
	TRO	T0,IDXFIL
	CAIN	T1,FB$REL
	TRO	T0,RANFIL
	CAIN	T1,FB$SEQ
	TRO	T0,SEQFIL
	SETZ	T1,		;NOW CLEAR T1 TO RECEIVE FILE TABLE TYPE
	LDB	T1,FT.ORG		;GET THE FILE TABLE TYPE
	CAME	T0,T1		;ARE THEY THE SAME?
	 JRST	ERORG		;NO -- ERROR

;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

;ALL THE REST OF THE TESTS DEAL WITH INDEXED FILES ONLY.
;WE SHALL HAVE TO PUT IN A SEPARATE SERIES OF TESTS FOR
;	SEQUENTIAL FILES.

CHKOP0:
	$FETCH	T1,ORG,(T2)	;GET FILE'S ORG TYPE
	CAIE	FB$IDX		;CONTINUE ON IF INDEXED
	 JRST	CPOPJ		;HOP OUT OTHERWISE

;CHECK THE KEY INFORMATION
	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,KYINFO(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,NXKEYB	;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,FS%30	;SET FILE-STATUS TO 30
	SKIPGE	WANT8.		;WANT 8X FUNCT?
	 MOVEI	T1,FS%39	;SET F-S CODE FOR FILE-PROG ATTRIBUTE CONFLICT
	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,FS%30	;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
;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

;IF THE FILE HAS BEEN OPENED EXTEND, HERE WE POSITION THE RECORD POINTER (NRP)
;AT THE END
	$FETCH	T1,ROP,(T2)	;GET THE RAB RECORD OPERATION FLAGS

;NOW WE HAVE TO CHECK FOR SMU OPT 5 OPEN. FILE IS ALWAYS OPENED FOR I-O,
;SO THE FLAGS ARE USED DIFFERENTLY. SO, WE CANT GO THRU THE TEST FOR
;OPEN EXTEND
	MOVE	T4,BS.AGL##	;GET BS.AGL, WHICH POINTS AT THE ORIGINAL FLAGS
	LDB	T3,VB.FL1	;GET THE VERB FIELD OF FLAG WORD
	CAIN	T3,V.OPT5	;ARE WE DOING SMU OPTION 5 OPEN?
	 JRST	DOCON1		; YES

	TXNE	FLG,OPN%EX	;FILE OPENED FOR EXTEND?
	 IORI	T1,RB$EOF		;SET THE EOF BIT IN THE ROP FLAGS
DOCON1:
	$STORE	T1,ROP,(T2)	;RESTORE THE ROP FIELD TO THE RAB
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$CONNECT <(T2)>,CONERR	;DO IT
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED

;IF THE CONNECT IS SUCCESSFUL, WE CAN SAVE THE JFN ASIDE IN THE FILE TABLE

	MOVE	T2,.RCFAB(FTL)	;GET ADDRESS OF FAB
	$FETCH	T1,JFN,(T2)	; GET FILE'S JFN
	HRRZM	T1,D.JFN(FT)	; AND STORE IT IN FILE TABLE

;IF WE ARE DOING SMU OPTION 1 CONNECT SHADOW RAB

	SKIPN	F.WSMU(FT)	;DOING SMU OPTION 1?
	 JRST	DOCNEX		; NO
	MOVE	T2,.RCFAK(FTL)	;YES, GET ADDRESS OF SHADOW RAB
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$CONNECT <(T2)>,CONER1	; AND CONNECT IT.
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED

;THEN RETURN TO CALLING ROUTINE

DOCNEX:
	POPJ	PP,		; RETURN

;CONNECT REAL RAB FAILED
CONERR:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVE	T2,.RCRAB(FTL)	;ADDR OF THE FAB
	JRST	CONER2

;CONNECT SHADOW RAB FAILED
CONER1:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVE	T2,.RCFAK(FTL)	;ADDR OF FAKE RAB

CONER2:	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	CAIN	T1,ER$DME	;DYNAMIC MEMORY EXHAUSTED
	 JRST	CONDME		;YES
	TYPE	[ASCIZ/
?COBLIB: Failed to Connect to RMS File
/]
	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,FS%30	;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
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$CLOSE	<(T2)>,CONDM2	;** CLOSE THE FILE **
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	PUSHJ	PP,ROPCOR	;RELEASE THE CORE
	POPJ	PP,		;AND RETURN

CONDM2:
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	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. FOR TOPS-10-STYLE NAME ONLY.
;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,SIXSIZ		;SIXBIT?
	ADDI	C,40		;YES, CONVERT TO ASCIZ
	CAIN	T2,EBCSIZ		;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,SIXSIZ	;SIXBIT?
	ADDI	C,40		;YES, CONVERT TO ASCII
	CAIN	T2,EBCSIZ	;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

;IF WE ARE DEALING WITH AN OPTIONAL FILE WHICH WAS NOT PRESENT, WE MERELY
; UNSET THE NOTPRS BIT AND RETURN. THE FILE WAS NEVER ACTUALLY OPENED
; SUCCESSFULLY AND THE ALLOCATED CORE HAD ALL BEEN RETURNED.
	MOVE	T1,F.WFLG(FT)	;FIND OUT IF THE NOTPRS BIT IS ON
	TLNN	T1,NOTPRS		;
	 JRST	CL.MX1		;NO
	TLZ	T1,NOTPRS		;TURN OFF THE BIT
	MOVEM	T1,F.WFLG(FT)	;AND UPDATE THE FILE TABLE FLAG WORD
	POPJ	PP,		; AND RETURN

CL.MX1:
	TXNE	FLG,LF%INP+LF%OUT	;SKIP IF FILE WAS NOT OPEN
	 JRST	CL.MX4			;CONTINUE WITH NORMAL CLOSE
	SKIPN	F.WSMU(FT)	;IF FILE NOT OPEN AND SMU OPTION 1, SMU OPEN
				; FAILED AND WE ARE JUST SHUTTING DOWN.
				; NO NEED TO BOMB OUT USER.
	 JRST	CLMER1		;NO, GIVE ERROR
	  POPJ	PP,		;YES, RETURN TO CALLING ROUTINE
CL.MX4:
	TXNE	FLG,CLS%LK	;CLOSE WITH LOCK?
	 PUSHJ	PP,[SETO T1,	;YES, SET THE FLAG
		DPB T1,FT.BLF
		POPJ PP,]	;CONTINUE CLOSE CODE

	LDB	T1,FT.ABL	;APPLY BASIC-LOCKING IN EFFECT?
				;IF SO, WE ARE NOT GOING THRU SU.CL IN LSU
	JUMPN	T1,CL.MX2	;JUMP IF SO.

	SKIPN	F.WSMU(FT)	;FILE OPEN FOR LSU-STYLE SMU?
	 JRST	CL.MX2		; NO
	PUSH	PP,FT		;SAVE FT FTL AND FLG, WHICH GET SMASHED
	PUSH	PP,FTL		;
	PUSH	PP,FLG		; BY SU.CL
	MOVEM	FT,ARG		;WHERE SU.CL EXPECTS TO FIND IT
	PUSHJ	PP,SU.CL##	;
	POP	PP,FLG		;RESTORE FLG FTL AND FT
	POP	PP,FTL		;
	POP	PP,FT		;
	
CL.MX2:


;HERE IF OK TO CLOSE FILE
	MOVE	T2,.RCFAB(FTL)	;T2 POINTS TO FAB

REPEAT 0,<		;DISABLE ASCII STREAM
	;CHECK HERE FOR ASCII STREAM NEEDING FUNNY FINAL <CR>
	$FETCH	T1,RFM,(T2)	;GET RECORD FORMAT FROM FAB
	CAIE	T1,FB$STM	;IS IT ASCII STREAM?
	 JRST	CL.MX3		; NO
	LDB	T1,FT.NOC	;GET FUNNY <CR> FLAG
	CAIE	T1,0		;IS IT ON?
	 PUSHJ	PP,WTS.CR	; YES, PUT OUT FINAL FUNNY <CR>

CL.MX3:
	MOVE	T2,.RCFAB(FTL)	;MAKE SURE THAT T2 POINTS TO THE FAB
				;(MAY HAVE BEEN ZAPPED BY WRITING FUNNY <CR>.)
>	;END REPEAT 0
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$CLOSE	<(T2)>,RCLSER	;** CLOSE THE FILE **
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	TXNN	FLG,CLS%DL	;CLOSE WITH DELETE?
	 JRST	CL.AFT		;NO
	MOVE	T2,.RCFAB(FTL)	;T2 POINTS TO FAB
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$ERASE	<(T2)>,RCLSER	;** DELETE THE FILE **
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED

;CLOSE WAS SUCCESSFUL. RELEASE THE CORE.
CL.AFT:
	SETZM	D.JFN(FT)		;CLEAR JFN FIELD IN FILE TABLE
	PUSHJ	PP,ROPCOR	;[1073] * RELEASE CORE FROM OPEN *
	PJRST	SETFS		;SET FILE-STATUS TO 00, 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:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	TYPE	[ASCIZ/
?COBLIB: Failed to Close RMS File
/]
	JRST	RSFAIF		;RMS-SYSTEM FAILURE

;FILE WAS NOT OPEN
CLMER1:
	MOVEI	T0,FS%30	;CATCH ALL FILE-STATUS
	SKIPGE	WANT8.		;WANT ANS 8X FUNCT?
	 MOVEI	T0,FS%42	;MOVE FILE-STATUS FILE-NOT-OPEN
	MOVEM	T0,FS.FS	; AND SAVE IT
	PUSHJ	PP,SETFS	; AND MOVE IT TO USER'S FS FIELD
	$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/
?COBLIB: 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%SEQ==1B9		;SEQUENTIAL ACCESS MODE
	WT%NIK==1B11		;NO "INVALID KEY" CLAUSE GIVEN
				; "USE PROCEDURE" INSTEAD
	WT%VLR==1B19		;WRITE SEQ VAR LEN REC.

;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,RECLNG(T1)	; IN THE ARG LIST
	$STORE	T1,RSZ,(T2)

;;;READY TO DO THE $PUT ;;;
WRTMI2:	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$PUT	<(T2)>,PUTERR	;** DO THE PUT **
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	PUSHJ	PP,CHKPT	;CHECK IF DOING CHECKPOINTING FOR INDEXED FILE
	PUSHJ	PP,CHKSDP	;CHECK FOR SUCCESSFUL RETURN, BUT DUPLICATE KEY
	MOVE	T1,FS.FS	;GET FILE STATUS
	PUSHJ	PP,RCLNUP	;AND GO DO FILE STATUS AND SMU OPTION 1 CHECKING
	MOVE	T1,FS.FS	;GET FILE STATUS AGAIN
	CAIL	T1,FS%10	;SEE IF SOME KIND OF AT-END/INVALID KEY
	CAILE	T1,FS%29
	 TRNA			;YES, THERE IS
CPOPJ1:	AOS	(PP)		;GIVE SKIP RETURN - INVALID KEY
CPOPJ:	POPJ	PP,		;FOR "INVALID KEY"
				; ANYBODY WHO USES THIS CODE WITHOUT ALSO
				; USING FILE-STATUS HAS ROCKS IN HIS HEAD.

;DO CHECKPOINTING FOR INDEXED FILES IF REQUIRED

CHKPT:
	MOVE	T2,.RCRAB(FTL)	;[1020] RE-GET ADDRESS OF RAB
	$FETCH	T1,STS,(T2)	;[1020] GET STATUS CODE
	CAIL	T1,ER$AID - 1	;[1020] A SUCCESS CODE?
	 JRST	CKPTEX		;[1020] NO - BYPASS CKPT
	LDB	T0,FT.CRC	;[1020] CHECKPOINTING?
	JUMPE	T0,CKPTEX	;[1020] NO
	SOSE	D.CRC(FT)	;[1020] DECREMENT COUNT - TIME TO OUTPUT?
	 JRST	CKPTEX		;[1020] NOT YET
	MOVEM	T0,D.CRC(FT)	;[1020] RESET COUNT
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$FLUSH	<(T2)>,FSHERR	;[1020] WRITE REC TO DISK
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
CKPTEX:
	POPJ	PP,		;[1020] GIVE NORMAL RETURN

FSHERR:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	TYPE	[ASCIZ/
?COBOTS $FLUSH failed for RMS Indexed File Checkpointing
/]				;[1020] RETURN ERROR MESSAGE
	JRST	RSFAIR		;[1020] RMS SYSTEM ERROR

;ERROR ON $PUT
PUTERR:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	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"
;NOTE: KEY OUT-OF-SEQUENCE ERROR NOT IN ANS82 COBOL DRAFT STANDARD
	CAIN	T1,ER$SEQ	;OUT OF SEQUENCE?
	 JRST	SEQERR		;YES, RETURN STATUS
	CAIN	T1,ER$RLK	;RECORD LOCKED BY SOMEONE ELSE?
	 JRST	PTLKER		; YES
	CAIN	T1,ER$FAC	;SMU OPEN DOES NOT ALLOW $PUT FOR SELF?
	 JRST	PUTFAC		; YES
	SKIPL	WANT8.		;WANT ANS 8X FUNCT?
	 JRST	PUTER1		; NO
	CAIN	T1,ER$RSZ	;RECORD SIZE ERROR?
	 JRST	PTRSZE		; YES
PUTER1:	TYPE	[ASCIZ/
?COBLIB: Failed to Write to RMS File
/]
	JRST	RSFAIR		;RMS SYSTEM ERROR


PTRSZE:	MOVEI	T1,FS%44	;SET F-S CODE FOR WRONG-SIZE-RECORD
	MOVEM	T1,FS.FS	;
	PUSHJ	PP,SETFS	;
	JRST	RSFAIR		; AND GO TO PROCESS PROGRAM FAILURE FOR HARD I-O ERROR

PTLKER:	MOVEI	T1,FS%92	;RECORD LOCKED, ERROR 92
	JRST	PUTERP

PUTFAC:	MOVEI	T1,FS%94	;NOT SPEC'D ON SMU OPEN, ERROR 94
	JRST	PUTERP

PUTERD:	MOVEI	T1,FS%22	;DUPLICATE KEY, ERROR 22
	JRST	PUTERP

SEQERR:	MOVEI	T1,FS%21	;SEQUENCE ERROR, ERROR 21
;	JRST 	PUTERP

PUTERP:	MOVEM	T1,FS.FS	;STORE IN FILE-STATUS WORD
	PUSHJ	PP,RCLNUP	;SET IT
	POPJ	PP,		;RETURN
;HERE WHEN THE ACCESS MODE OF THE FILE IS SEQUENTIAL

;CALLING SEQUENCE	MOVEI	16,ADDRESS-OF-ARG-LIST
;			PUSHJ	17,WT.MIS / WT.MSV
;ARG LIST
;			FLAGS		,, FILE-TABLE-ADDRESS
;			RECORD-LENGTH	,, UNUSED BY SEQUENTIAL
;			ADV / POS PARMS ,, COUNT / ADDRESS FIELD
;

WT.MSV:				;SEQUENTIAL VAR LEN WRITE
	PUSHJ	PP,WTSET	;SET UP FOR WRITE VERB
	TXO	FLG,WT%VLR	;SET FLAG TO WRITE VARIABLE LEN REC
	JRST	WT.MI1		; JOIN COMMON CODE FOR SEQ WRITE

WT.MIS:				;ALL OTHER SEQUENTIAL WRITES
	PUSHJ	PP,WTSET	;SET UP FOR WRITE VERB
WT.MI1:

;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

;IF THE USER IS DOING SEQUENTIAL WRITES TO AN RMS RELATIVE FILE, WE ARE
;IGNORING ANY VALUE WHICH HE MAY HAVE PUT INTO THE KEY FIELD. INSTEAD,
;WE ARE TAKING THE BUCKET NUMBER RETURNED FROM THE PREVIOUS I-O VERB,
;WHATEVER THAT WAS, ADDING 1 TO IT AND USING THAT AS THE RELATIVE KEY
;VALUE OF THE NEXT RECORD ABOUT TO BE WRITTEN. THIS VALUE GOES INTO %PARAM
;FOR DISPLAY KEYS, AND THE CONVERSION ROUTINES IN THE GENERATED CODE
;WHICH FOLLOW THIS CALL CONVERT THE VALUE IN %PARAM BACK TO DISPLAY.

	MOVE	T1,F.WFLG(FT)	;GET FILE TABLE FLAG WORD
	TLNN	T1,RANFIL		;IS IT A RELATIVE FILE?
	 JRST	WT.MS1		;NO
	$FETCH	T0,BKT,(T2)	;GET THE BUCKET NO.
	$FETCH	T1,KBF,(T2)	;GET KEY BUFFER ADDRESS
	MOVEM	T0,KY.BUF(T1)		;MOVE THIS VALUE TO THE KEY BUFFER
WT.MS1:
	MOVE	T3,.RCFAB(FTL)	;GET ADDRESS OF FAB
	$FETCH	T0,RFM,(T3)	;GET ITS RECORD FORMAT
REPEAT 0,<		;DISABLE ASCII STREAM
	CAIN	T0,FB$STM		;IS FILE (ASCII) STREAM?
	  JRST	WT.STM		;YES
>	; END REPEAT 0
	 JRST	WRTMI1		;NO, JOIN COMMON WRITE CODE


;"Attempt to WRITE indexed file / seq access mode not OPEN for OUTPUT"
WTMSE0:	$ERROR	(E.515,SV.KIL,MT.FIL)
REPEAT 0,<		;DISABLE ASCII STREAM
;THE FOLLOWING CODE WRITES OUT AN ASCII STREAM RECORD USING THE ANSI-74
;COBOL FORMAT. THERE ARE TWO MAJOR FORMS OF THE FORMAT AS SET FORTH IN
;THE STANDARD: (1) BEFORE ADVANCING, AND (2) AFTER ADVANCING / AFTER
; POSITIONING / THE DEFAULT CASE. THE AFTER ADVANCING ... CASE WORKS
; GENERALLY LIKE THIS: (A) PUT OUT <CR> IF NOT POSITIONING "+", (B)
; PUT OUT ANY REQUIRED VERTICAL POSITIONING STUFF, (C) PUT OUT USER
; RECORD, AND (D) SET FUNNY <CR> FLAG TO 1 TO INDICATE THAT THE CURRENT
; RECORD DOES NOT HAVE A <CR> FOLLOWING IT. THE BEFORE ADVANCING CASE
; WORKS GENERALLY LIKE THIS: (A) CHECK THE FUNNY <CR> FLAG AND IF IT
; IS ON, PUT OUT A <CR>, (B) SET THE FUNNY <CR> FLAG TO 0, (C) PUT
; OUT THE USER RECORD, (D) PUT OUT A <CR>, AND (E) PUT OUT THE VERTICAL
; POSITIONING STUFF. NOTE: IN DOING THE CODE BELOW I HAVE TRIED TO REPRO-
; DUCE THE EFFECT WHICH CBLIO DOES FOR NON-RMS FILES. HOWEVER, THE CODE
; IS ENTIRELY DIFFERENT BECAUSE MY ANALYSIS REVEALED THAT THERE ARE
; ACTUALLY TWO SEPARATE FLOWS, RATHER THAN JUST ONE. ONE FLOW IS FOR
; WRITE BEFORE ADVANCING, AND THE OTHER IS FOR WRITE AFTER ADVANCING /
; AFTER POSITIONING / DEFAULT.
;ALSO, THE FUNNY <CR> FLAG IS SET TO 0 AT OPEN TIME AND IS CHECKED AT
;CLOSE TIME. IF IT IS ON AT CLOSE TIME A FINAL FUNNY <CR> IS WRITTEN OUT.

WT.STM:
	MOVE	T1,BS.AGL	;GET THE ADV / POS PARAM WORD
	MOVE	T1,ADVPR2(T1)	;
	TLNN	T1,WDVBFR	;BEFORE ADVANCING?
	 JRST	WT.AFT		; NO, AFTER

WT.BEF:
	LDB	T1,FT.NOC	;GET FLAG FOR WRITING FUNNY <CR>
	CAIE	T1,0		;IS IT SET?
	 PUSHJ	PP,WTS.CR	; YES, GO PUT OUT FUNNY <CR>
	SETZ	T1,		;ZERO IT OUT IN ANY EVENT
	DPB	T1,FT.NOC	; AND PUT IT BACK
	
	PUSHJ	PP,WTS.WT	;THEN WRITE OUT MAIN PART OF USER REC

	PUSHJ	PP,WTS.CR	;WRITE OUT REGULAR "AFTER ADV" <CR>
	PUSHJ	PP,WTS.VT	; AND WRITE OUT THE VERTICAL STUFF.
	 JRST	WTS.EX		;  THEN GO TO END

WT.AFT:
	TLNN	T1,WDVPOS	;TEST FOR BEFORE POSITIONING "+", WHICH
	 JRST	WTAFT1		; IS THE CASE IN WHICH ABSOLUTELY NO
				; EOL / BOL CHARACTERS ARE INCLUDED.
	LDB	T0,PO.CHR	;GET THE POSITIONING CHARACTER
	CAIN	T0,"+"		;IF IT IS "+", DON'T PUT OUT <CR>
	 JRST	WTAFT2
WTAFT1:
	PUSHJ	PP,WTS.CR	;
WTAFT2:
	PUSHJ	PP,WTS.VT	;PUT OUT THE VERTICAL POSITIONING STUFF

	PUSHJ	PP,WTS.WT	;THEN WRITE OUT MAIN PART OF USER REC

	SETO	T1,		;SET FUNNY <CR> FLAG. (WHEN THIS FLAG IS
				; SET IT MEANS THAT THE RECORD JUST WRITTEN
				; IS NOT FOLLOWED BY ANY END-OF-LINE CHAR.)
	DPB	T1,FT.NOC	; AND PUT IT BACK IN FILE TABLE
;	JRST	WTS.EX		; THEN GO TO THE END

WTS.EX:
	POPJ	PP,		;THE END -- RETURN TO CALLER
;ROUTINE TO WRITE A <CR> TO AN ASCII STREAM FILE
; THIS ROUTINE CHANGES THE RECORD BUFFER LOCATION TEMPORARILY TO THE 
; LOCATION WHERE <CR> IS DEFINED AS A CONSTANT. ALSO, THE RECORD SIZE
; IS SET TO 1 FOR THIS OCCASION. AFTER THE $PUT IS DONE THE RECORD
; BUFFER LOCATION IS CHANGED BACK TO THE ORIGINAL LOCATION SPECIFIED
; AT FILE OPEN TIME.


WTS.CR:
	MOVE	T2,.RCRAB(FTL)	;GET ADDRESS OF RAB
	$FETCH	T1,RBF,(T2)	;GET RECORD'S BUFFER ADDRESS
	PUSH	PP,T1		; AND SAVE IT ON THE STACK.
	MOVEI	T1,CRBUF	;ADDRESS OF CARRIAGE-RETURN BUFFER
	$STORE	T1,RBF,(T2)	;STORE IT IN RAB
	MOVEI	T1,1		;REC SIZE 1
	$STORE	T1,RSZ,(T2)	;STORE IT IN RAB

	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$PUT	<(T2)>,PUTERR	;** DO THE PUT ** AND THEN PLOW RIGHT ON
				;ALL ERRORS FOR THIS PUT THAT COME BACK
				;SHOULD BE +1 RETURN
	  JFCL			;BUT PLAY SAFE FOR NOW BECAUSE PUTERR CAN
				; RETURN +1 OR +2

	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	POP	PP,T1		;GET RECORD'S BUFF ADDR FROM STACK
	MOVE	T2,.RCRAB(FTL)	;GET ADDRESS OF RAB
	$STORE	T1,RBF,(T2)	;STORE RECORD'S BUFFER ADDR BACK IN RAB
	POPJ	PP,		; AND RETURN TO USER.


;ROUTINE TO WRITE OUT USER RECORD TO AN ASCII STREAM FILE
; ASSUMES RECORD'S BUFFER ADDRESS IS THE SAME AS IT WAS AT OPEN TIME.
; HOWEVER, IT TAKES THE RECORD LENGTH FROM THE USER'S SECOND ARG WORD.


WTS.WT:
	MOVE	T2,.RCRAB(FTL)	;GET ADDRESS OF RAB
	MOVE	T1,BS.AGL	;SIZE OF RECORD TO WRITE IS HERE
	HLRZ	T1,ADVPR1(T1)	; IN THE ARG LIST
	JUMPE	T1,WTS.E0	;WARN ON ZERO-LENGTH RECORD
	$STORE	T1,RSZ,(T2)	;PUT IT IN THE RAB
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$PUT	<(T2)>,PUTERR	;** DO THE PUT ** AND THEN PLOW RIGHT ON
				;ALL ERRORS FOR THIS PUT SHOULD BE +1 RETURN
	  JFCL			;BUT PLAY SAFE FOR NOW BECAUSE PUTERR CAN
				; RETURN +1 OR +2
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	POPJ	PP,		; AND RETURN TO USER.

;Attempt to write ASCII STREAM zero-length record, Ignored.
WTS.E0:	$ERROR	(E.527,SV.WRN,MT.FIL)
	POPJ	PP,		; AND RETURN


;ROUTINE TO WRITE VERTICAL POSITIONING STUFF TO AN ASCII STREAM FILE.
;THE PURPOSE OF THIS ROUTINE IS TO FIND OUT (1) WHICH ASCII PRINT CONTROL
; CHARACTER TO PUT INTO THE FILE AND (2) HOW MANY OF THEM.
; THERE ARE SEVERAL DIFERENT SITUATIONS WHICH HAVE TO BE HANDLED. (A)
; WRITE WITH ADVANCING, (B) WRITE WITH POSITIONING, AND (C) WRITE
; [DEFAULT] WHICH IS CONSIDERED TO BE WRITE AFTER ADVANCING 1. AS A 
; RESULT, THE ROUTINE IS SOMEWHAT LONG.
;
;AT THE POINT WHEN THIS ROUTINE IS CALLED, IT HAS ALREADY BEEN DETERMINED
; THAT WE HAVE TO PUT OUT A VERTICAL POSITIONING CHARACTER AND THE QUES-
; TION OF AFTER / BEFORE ADVANCING ETC. HAS ALREADY BEEN TAKEN CARE OF
; AT THE HIGHER LEVEL.  THIS PROBLEM IS RESOLVED BY LOOKING AT THE THIRD
; ARGUMENT WORD WHICH HAS BEEN PASSED TO THE CALLING ROUTINE. THIS WORD
; HAS THE FOLLOWING FIELDS OF INTEREST:
;
;	(1) BITS 12 - 14	FLAGS
;
;		12  WDVADR	VALUE IN RH OF WORD IS MOST LIKELY AN ADDRESS
;		13  WDVBFR	WRITE BEFORE - OF NO CONCERN TO THIS ROUTINE
;		14  WDVPOS	WRITE POSITIONING
;
;	(2) BITS 15 - 17	PRINT CHANNEL CONTROL CHARACTER. (SEE WVTTBL
;				IN DECLARATIONS AT TOP OF THIS FILE.)
;
;	(3) RIGHT-HALF (BITS 18 - 35)
;
;		IF WDVADR IS ON, IS ADDRESS OF DATA FIELD HOLDING COUNT 
;			OF CHARS TO BE PUT OUT, OR -1 FOR DEFAULT WRITE.
;		IF WDVADR IS OFF, IS COUNT OF CHARACTERS TO BE WRITTEN.
;			THIS COUNT CAN BE NOT = 1 FOR <LF> ONLY.
;			IF IT IS NOT = 1, ONLY ONE CHAR AT A TIME WILL
;			BE PUT OUT IN THE LOOP AT "WTSVPT" UNTIL ENOUGH
;			CHARS HAVE BEEN SENT TO THE OUTPUT FILE.
;
;
;	THE FOLLOWING AC'S ARE USED:
;
;		T4	TO CONTAIN ADDR OF ARG LIST FROM BS.AGL
;		T3	TO CONTAIN COUNT OF PRINT CONTROL CHARS TO PUT OUT
;		T2	TO CONTAIN ADDRESS OF RAB
;		T1	TO POINT TO PRINT CONTROL CHAR, AND ALSO TO MANI-
;				PULATE RECORD'S BUFFER ADDRESS.
;

WTS.VT:
		;A LITTLE HOUSEKEEPING TO PRESERVE THE RBF ADDRESS OF
		; THE USER'S RECORD AND TO SET UP THE PROPER RSZ = 1
		; FOR A VERTICAL CONTROL CHARACTER.
		;
	MOVE	T2,.RCRAB(FTL)	;GET ADDRESS OF RAB
	$FETCH	T1,RBF,(T2)	;GET RECORD'S BUFFER ADDRESS
	PUSH	PP,T1		; AND SAVE IT ON THE STACK.
	MOVEI	T1,1		;REC SIZE 1
	$STORE	T1,RSZ,(T2)	;STORE IT IN RAB

		;GET THIRD WORD OF ARG LIST AND DETERMINE ADVANCING OR
		; POSITIONING
		;
	MOVE	T4,BS.AGL	;GET ADDRESS OF ARG LIST
	MOVE	T4,ADVPR2(T4)	; GET THIRD WORD OF ARG LIST
	TLNE	T4,WDVPOS	;ARE WE DOING POSITIONING?
	 JRST	WTSPOS		; YES

		;DETERMINE IF RIGHT-HALF OF THIRD ARG WORD IS AN ADDRESS
		; OR A COUNT OR THE DEFAULT CASE.
		;
	HRRZ	T3,T4		;GET RH OF 3RD ARG WORD - MAY BE COUNT
	TLNN	T4,WDVADR	;IS IT ADDRESS OR COUNT?
	 JRST	WTSCHR		; IS COUNT
	CAIE	T3,DEFADV	;IS IT DEFAULT ADVANCING?
	 JRST	WTSADR		; NO, IS ADDRESS
	HRRZI	T3,1		;SET THE CHAR COUNT TO 1
	 JRST	WTSCHR		;

WTSADR:
	HRRZ	T3,(T3)		;GET COUNT FROM ADDRESS, I.E. %TEMP

		;NOW A SMALL PRELIMINARY TO GET THE REFERENCE TO THE
		; PROPER CONTROL CHARACTER.
		;HOWEVER, IF BOTH COUNT AND CHAR REF ARE 0, WE WANT
		; NO VERTICAL SPACING.
		;
WTSCHR:
	LDB	T1,CH.CHR	;GET ADVANCING CHANNEL CHAR
	JUMPN	T1,WTSTAB	; CHANNEL CHAR IS NOT 0
	JUMPE	T3,WTSRST	;IF COUNT IS 0, BYPASS VERT POSITIONING
	JRST	WTSTAB		; HOWEVER, IF NOT, ON TO ACCESS CHANNEL TABLE

WTSPOS:
		;DO POSITIONING, WHICH HAS MORE DETAIL RELATING TO THE
		; PRINT CONTROL CHARACTER.
		;
	HRRZI	T3,1		;ASSUME CHAR COUNT OF 1
	MOVE	T1,T4		;GET IT IN T1 FOR THE BYTE POINTER
	LDB	T1,PO.CHR	;GET POSITIONING CHAR FROM 3RD ARG WORD
	CAIL	T1,"1"		;CHAR IN RANGE 1 THRU 8 ?
	CAILE	T1,"8"		;
	 JRST	WTSPLS		; NO
	TRZ	T1,777770	;STRIP OFF "ZONE" TO CONVERT TO BINARY
	 JRST	WTSTAB		; AND ON TO CHANNEL CHAR TABLE

WTSPLS:
	CAIN	T1,"+"		;NO POSITIONING?
	 JRST	WTSRST		; YES, NO FURTHER WORK TO DO. JUST PUT BACK
				;  RBF IN RAB AND RETURN TO CALLER.
	CAIN	T1,"0"		;AFTER POS 2?
	 HRRZI	T3,2		; YES
	CAIN	T1,"-"		;AFTER POS 3?
	 HRRZI	T3,3		; YES
	SETZ	T1,		;AND SPECIFY A <LF> TO CHAN CHAR TABLE

		;AT THIS POINT THE TWO STREAMS, ADVANCING AND POSITIONING
		; COME BACK TOGETHER. T1 CONTAINS THE NUMBER OF THE ENTRY
		; THAT WE WANT IN THE PRINT CHANNEL TABLE. WE ADD THE
		; ADDRESS OF THE TABLE TO THIS VALUE AND PASS IT ON TO
		; THE RAB SO THAT RMS WILL KNOW WHERE TO FIND THE CHAR.
		;
WTSTAB:
	ADDI	T1,WVTTBL	;ADD IN ADDR OF CHAN CHAR TABLE TO POINT
				; TO PROPER CHAR.
	$STORE	T1,RBF,(T2)	;STORE ADDR OF CHAN CHAR IN RAB

		;THIS LOOP PUTS OUT THE PROPER COUNT OF PRINT CONTROL
		; CHARCTERS
		;
WTSVPT:
	MOVE	T2,.RCRAB(FTL)	;GET ADDR OF RAB FOR $PUT CALL
	PUSH	PP,T3		;SAVE COUNT AC ON STACK
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$PUT	<(T2)>,PUTERR	;** DO THE PUT ** AND THEN PLOW RIGHT ON
				;ALL ERRORS FOR THIS PUT THAT COME BACK
				;SHOULD BE +1 RETURN
	  JFCL	0		;BUT PLAY SAFE FOR NOW BECAUSE PUTERR CAN
				; RETURN +1 OR +2

	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	POP	PP,T3		;GET COUNT BACK
	SOJG	T3,WTSVPT	;GO BACK AND PUT ANOTHER CHAR IF NECESSARY


		;FINALLY, WE RESTORE THE ADDRESS OF THE USER'S RECORD
		; BUFFER TO THE RAB, AND RETURN TO THE CALLING ROUTINE.
		;
WTSRST:
	POP	PP,T1		;GET RECORD'S BUFF ADDR FROM STACK
	MOVE	T2,.RCRAB(FTL)	;GET ADDRESS OF RAB
	$STORE	T1,RBF,(T2)	;STORE RECORD'S BUFFER ADDR BACK IN RAB
	POPJ	PP,		;RETURN
> ;END REPEAT 0
;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 (OR EXTEND)
	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
	SETZ	T1,		;DON'T USE LOAD PERCENTAGE
	MOVE	T0,D.CRC(FT)	;[1020] IF TIME TO CHECKPOINT
	CAIE	T0,CKP.FL	;[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,RECLNG(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:	SKIPL	WANT8.		;WANT ANS 8X FUNCT?
	 JRST	WTSTE1		; NO
	MOVEI	T0,FS%48	;SET F-S FOR NOT OPEN FOR OUTPUT OR EXTEND
	MOVEM	T0,FS.FS	; AND SAVE ASIDE
	PUSHJ	PP,SETFS	; AND PUT IN USER'S F-S FIELD
WTSTE1:	$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
	MOVE	T2,.RCRAB(FTL)	;NEED RAB ADDR AND RKBSET DESTROYS IT
	MOVE	T0,F.WFLG(FT)	;GET COMPILER FLAGS
	SKIPGE	WANT8.		;WANT 8X FUNCT?
	TLNN	T0,NOTPRS	;OPTIONAL FILE NOT PRESENT?
	 JRST	RD.MI4		;NO
	MOVEI	T0,FS%25	;SET UP OPT-NOT-PRES F-S CODE
	MOVEM	T0,FS.FS	;
	AOS	(PP)		;SET UP RETURN TO .+2
	PJRST	SETFS		; REPORT IT TO USER AND RETURN IMMEDIATELY

RD.MI4:	TLNE	T0,RANFIL		;READING RELATIVE FILE?
	 JRST	RD.MI3		;YES, SKIP INDEX FILE STUFF
	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,KYINFO(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,KYINFO(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,KYINFO(T1)	;POINT TO APPROPRIATE KEY-INFO BLOCK
	HRRZ	T1,KY.BUF(T3)	;GET KEY SIZE
	$STORE	T1,KSZ,(T2)	;STORE SIZE OF KEY BLOCK

;SET "USER BUFFER SIZE"

RD.MI3:
	MOVE	T1,.RCRLN(FTL)	;GET RECORD LENGTH IN WORDS
	$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", BUT NOT FOR RELATIVE FILES

	SETZ	T1,		;CLEAR AN AC
;;;;; THE FOLLOWING EXCEPTION REMOVED BY RMS EDIT 303
;;;;;	TLNN	T0,RANFIL		;SKIP IF DOING RELATIVE FILE
	MOVEI	T1,RB$NRP
	$STORE	T1,ROP,(T2)

;;;; ALL READY TO DO THE $GET ;;;
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$GET	<(T2)>,RDRERR	;DO IT
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	PUSHJ	PP,CHKSDP	;CHECK FOR ALLOWABLE DUPL KEY FOUND
	MOVE	T1,FS.FS	;GET FILE-STATUS
	PUSHJ	PP,RCLNUP	;SET FILE-STATUS 
	MOVE	T1,FS.FS	;GET FILE-STATUS AGAIN
	JUMPE	T1,RDDOK	;OK
	CAIN	T1,FS%23	;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:
	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:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
;	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"

	SKIPL	WANT8.		;WANT 8X FUNCT?
	 JRST	RDRER1		; NO
	CAIN	T1,ER$RTB	;RECORD TOO BIG?
	 JRST	RDRRTB		; YES

;IF WE COME THRU HERE, WE HAVE A HARD READ FAILURE

RDRER1:	MOVEI	T1,RC.FAI	;READ-FAILED CODE
	MOVEM	T1,.RCSTE(FTL)	;SAVE IT IN RMS FILE STATE FLAG WORD

	CAIN	T1,ER$RLK	;RECORD LOCKED?
	 JRST	RDLKER		; YES - WANT NORMAL RETURN WITH FILE-STATUS 92

	TYPE	[ASCIZ/
?COBLIB: Failed to Read from RMS File
/]
	JRST	RSFAIR		;RMS-SYSTEM FAILURE

RDRRTB:	MOVEI	T0,FS%04	;SET UP FILE-STATUS CODE FOR RECORD TOO BIG
	MOVEM	T0,FS.FS	; AND SAVE IT
	JRST	RFSRPT		; AND HOP OVER F-S 23 TO REPORT F-S TO USER

RDRIVK:	MOVEI	T1,RC.INV	;FLAG INVALID KEY READ RESULT
	MOVEM	T1,.RCSTE(FTL)	; AND SAVE IT IN RMS FILE FLAG WORD
	MOVEI	T1,FS%23	;FILE STATUS TO SET
	MOVEM	T1,FS.FS	;PUT HERE
RFSRPT:	PUSHJ	PP,RCLNUP	;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
	CAIL	T1,RC.ATE	; IF "AT END",
	 JRST	RDMSE1		;GIVE ERROR
;TEST IF OPTIONAL FILE KNOWN NOT TO BE PRESENT AT OPEN TIME.
	MOVE	T1,F.WFLG(FT)	;GET FILE TABLE FLAG WORD 
	TLNN	T1,NOTPRS		;OPTIONAL FILE WHICH IS NOT PRESENT?
	 JRST	RD.MS4		;NO
	PUSHJ	PP,RDEOF		;YES, GO SET EOF ON FIRST TIME THRU
	JRST	RD.MS2		;AND GO TO TAKE "AT END" PATH

RD.MS4:

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

	MOVE	T1,F.WFLG(FT)	;GET FILE TABLE FLAG WORD
	TLNN	T1,SEQFIL		;READING SEQUENTIAL FILE?
	TLNE	T1,RANFIL		;READING RELATIVE FILE?
	JRST	RD.MS1		;YES, DON'T SET UP KEY OF REFERENCE

;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

RD.MS1:
	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"
	MOVE	T1,.RCRLN(FTL)	;GET RECORD LENGTH
	$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
;ALSO CHECK FOR ASCII STREAM AND PAD WITH BINARY ZEROES ON READ.
;THUS, THE RETURNED RECORD LOOKS LIKE ASCIZ AND COBOL DISPLAY DOES THE
; RIGHT THING WITH IT.
	MOVE	T0,F.WFLG(FT)	;GET FILE TABLE FLAG WORD
	TLNN	T0,SEQFIL		;IS FILE SEQUENTIAL?
	 JRST	RD.MS3		;NO
	MOVE	T4,.RCFAB(FTL)	;GET ADDRESS OF FAB IN ORDER TO
	$FETCH	T3,BSZ,(T4)	; FIND THE BYTE SIZE
	CAIE	T3,ASCSIZ		;IF IT IS 7-BIT BYTES, WE WILL
				; SET UP ASCII NULL AS PAD CHAR
				;(I DON'T LIKE TO LEAVE THINGS TO CHANCE)
	 JRST	RD.MS3		;NO
	MOVEI	T0,0		;YES -- SET UP PAD
	$STORE	T0,PAD,(T2)	; AND STORE IN RAB
	IORI	T1,RB$PAD		;AND SET FLAG IN ROP FLD OF RAB.
RD.MS3:
	$STORE	T1,ROP,(T2)

;;;; ALL READY TO DO THE $GET ;;;
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$GET	<(T2)>,RDSERR	;DO IT
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED

;FOR RELATIVE FILES
;IF $GET COMES BACK NORMALLY, WE HAVE TO MAKE SURE THAT THE KEY FIELD IS
;PROPERLY UPDATED. IF THE KEY FIELD IS COMP, IT IS IN THE USER RECORD BUFFER.
;HOWEVER, IF IT IS DISPLAY, A SEPARATE COMP KEY FIELD IS SET UP IN %PARAM.
;THE %PARAM FIELD MUST BE UPDATED HERE. HOWEVER, IT IS EASIER ALWAYS TO DO
;THE UPDATE HERE THAN TO DO THE CHECKING FOR WHETHER THE KEY FIELD IS IN
;%PARAM. FOR A COMP KEY FIELD THE EFFECT IS SIMPLY TO MOVE THE FIELD TO ITSELF.

	MOVE	T1,F.WFLG(FT)	;GET FILE TABLE FLAG WORD
	TLNN	T1,RANFIL		;RELATIVE FILE?
	 JRST	RD.MS2		;NO
	MOVE	T2,.RCRAB(FTL)	;GET ADDR OF RAB
	$FETCH	T0,BKT,(T2)	;GET THE CURRENT BUCKET NUMBER
	$FETCH	T1,KBF,(T2)	;GET THE ADDR OF THE KEY BUFFER
	MOVEM	T0,KY.BUF(T1)	;PUT THE KEY VALUE IN THE KEY BUFFER
	SKIPN	F.WSMU(FT)		;DOING SMU OPTION 1?
	 JRST	RD.MS2			; NO
	MOVE	T1,SU.T1##		;GET ADDR OF RRT ENTRY
	MOVEM	T0,RRTKEY(T1)		; AND PUT KEY VALUE THERE TOO
RD.MS2:

;NOW CHECK FILE STATUS STUFF.

	PUSHJ	PP,CHKSDP	;CHECK FOR ALLOWABLE DUPL KEY FOUND
	MOVE	T1,FS.FS	;GET FILE-STATUS NOW
	PUSHJ	PP,RCLNUP	; AND SET IT
	MOVE	T1,FS.FS	;GET FILE-STATUS AGAIN
	JUMPE	T1,RDDOK	;JUMP TO CONVERT BACK IF NECESSARY
	CAIN	T1,FS%10	; 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:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	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
	CAIN	T1,ER$RTB	;RECORD IN FILE > RECORD DEFINED IN PROGRAM?
	 JRST	RDSRTB		;YES
	MOVEI	T0,RC.FAI	;ANYTHING GOING THRU HERE IS A HARD READ FAILURE
	MOVEM	T0,.RCSTE(FTL)	;SAVE NEW STATE
	CAIN	T1,ER$RLK	;RECORD LOCKED?
	 JRST	RDLKER		; YES - WANT NORMAL RETURN WITH FILE-STATUS 92
	TYPE	[ASCIZ/
?COBLIB: Sequential Read of RMS File failed
/]
	JRST	RSFAIR		;RMS-SYSTEM FAILURE

RDSRTB:	$ERROR	(E.533,SV.KIL,MT.FIL)	;

RDEOF:
	MOVEI	T1,FS%10	;SET FILE STATUS TO SHOW EOF
	SKIPL	WANT8.		;WANT 8X FUNCT?
	 JRST	RDEOF1		; NO
	MOVE	T0,F.WFLG(FT)	;GET FILE TABLE FLAG WORD AGAIN
	TLNE	T0,NOTPRS	; IS FILE PRESENT?
	MOVEI	T1,FS%15	; NO, SET EOF F-S CODE
RDEOF1:	MOVEM	T1,FS.FS	;SET UP THE STATUS WORD
	PUSHJ	PP,RCLNUP	;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

;HAVE RMS ERROR RETURN SAYING RECORD IS LOCKED. THIS IS A NON-FATAL RETURN
;MESSAGE. JUST SET FILE-STATUS-1 TO 92 AND DO NORMAL RETURN TO USER. USER
;CAN THEN TEST FILE-STATUS-1 IN THE NEXT SENTENCE AND IF HE GETS A 92 AT
;THAT POINT, HE CAN BRANCH APPROPRIATELY.

RDLKER:	MOVEI	T1,FS%92	;SET ERROR CODE 92 TO BE PUT INTO FILE-STATUS-1
;	JRST	RDSERP

;SET FILE-STATUS-1 AND RETURN TO CODE FOLLOWING THE $GET.
;THAT CODE WILL DO A NON-SKIP RETURN BACK TO THE USER.

RDSERP:	MOVEM	T1,FS.FS
	PUSHJ	PP,RCLNUP
	POPJ	PP,

;ERROR: ATTEMPT TO READ SEQUENTIALLY, BUT FILE IS ALREADY AT END

RDMSE1:	SKIPL	WANT8.		;WANT 8X FUNCT?
	 JRST	RDMSE2		; NO
	MOVEI	T1,FS%16	;SET UP F-S FOR ATTEMPTED READ AFTER EOF
	MOVE	T0,.RCSTE(FTL)	;GET RMS FILE STATE WORD
	CAIE	T0,RC.ATE	;FILE ALREADY IN AT-END STATE?
	 MOVEI	T1,FS%46	; NO, SET BAD-READ-PRECEDES F-S CODE
	MOVEM	T1,FS.FS	; AND SAVE IT ASIDE
	PUSHJ	PP,SETFS	; AND REPORT IT TO USER
RDMSE2:	$ERROR	(E.518,SV.KIL,MT.FIL)
SUBTTL	READ- SETUP ROUTINES

RDSET:	PUSHJ	PP,SETIO	;SETUP FOR DOING I-O
	MOVE	T1,F.WFLG(FT)	;IS THIS AN OPTIONAL FILE WHICH IS
	TLNE	T1,NOTPRS	; NOT PRESENT?
	 POPJ	PP,		;YES - RETURN IMMEDIATELY.
				;
	SKIPE	T1,F.WSMU(FT)	;TEST FOR SMU OPTION 1 OPEN
	POPJ	PP,		;IF IT IS, WE DID OPEN FOR I-O AND THE
				; F.WSMU WORD IS NON-ZERO
				;
	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:	SKIPL	WANT8.		;WANT ANS 8X FUNCT?
	 JRST	RDSTE2		; NO
	MOVEI	T0,FS%47	;SET UP F-S FOR FILE NOT OPEN FOR INPUT OR I-O
	MOVEM	T0,FS.FS	; AND SAVE IT ASIDE
	PUSHJ	PP,SETFS	; AND PUT IT IN USER'S F-S FIELD
RDSTE2:	$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,KYINFO(T1)	;GET KEY OF REFERENCE
	HRRZ	T3,.RCKIN(FTL)	;POINT TO KEY INFO
	LSH	T1,1		;EACH IS TWO WORDS LONG
	ADDI	T3,KYINFO(T1)	;POINT TO APPROPRIATE KEY-INFO BLOCK
	HRRZ	T1,KY.BUF(T3)	;GET KEY SIZE

;ENTER HERE WHEN THE KEY SIZE IS IN T1
RKBST1:	HRRZ	T4,.RCCKB(FTL)	;POINT TO CONVERTED KEY BUFFER
	TXNE	FLG,FA%FAK	;DOING FAKE READ?
	 HRRZ	T4,.RCFKC(FTL)	; YES, GIVE ADDR OF FAKE KEY CONV BUFFER INSTEAD
	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%SEQ==1B9		;SEQUENTIAL ACCESS
	DL%NIK==1B11		;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
	LDB	T2,FT.ABL	;GET APPLY BASIC-LOCKING BIT
	CAIN	T2,1		;IS IT ON?
	JRST	DLMIR1		;YES
	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

;IF WE ARE DOING APPLY BASIC-LOCKING WE DON'T DO A PRELIMINARY FIND. 
;THE USER IS SUPPOSED TO DO THAT HIMSELF.
;DO A $FIND TO POSITION TO THE RECORD

	PUSHJ	PP,FNDIT
	 JRST	DLMIRE		;?CAN'T FIND THAT RECORD
	JRST	DLGO		;GO DO DELETE

;NOW DELETE THE RECORD
DLMIR1:
	CAIE	T1,RC.SUR	;LAST READ SUCCESSFUL?
	JRST	DLMSE1		;NO, GIVE ERROR
	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
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$DELETE	<(T2)>,DELSER	;SEQ. DELETE ERROR
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	PUSHJ	PP,CHKPT	;[1046] CHECK FOR CHECKPOINTING
	MOVE	T1,FS.FS	;GET FILE-STATUS
	PUSHJ	PP,RCLNUP	;SET FILE-STATUS 
	MOVE	T1,FS.FS	;GET FILE-STATUS AGAIN
	CAIL	T1,FS%20	;IS IT SOME FIND OF INVALID KEY?
	CAILE	T1,FS%29	;
	 JRST	DELOK		;NO, BUT OK RETURN
	 JRST	CPOPJ1		;YES - SKIP RETURN

DELOK:				;NON-SKIP RETURN TO USER
	POPJ	PP,		; RETURN TO USER PROG.

DELSER:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	MOVE	T2,.RCRAB(FTL)	;ADDR OF THE RAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	CAIN	T1,ER$RLK	;RECORD LOCKED?
	 JRST	DELELK		; YES
	CAIN	T1,ER$CUR	;NO CURRENT RECORD?
	 JRST	DELECU		; YES
	CAIN	T1,ER$FAC	;NOT ALLOWED BY SMU OPEN FOR SELF?
	 JRST	DELFAC		; YES

	TYPE	[ASCIZ/
?$DELETE failed
/]
	JRST	RSFAIR		;RMS-SYSTEM FAILURE

DELELK:	MOVEI	T1,FS%92	;ERROR CODE 92
	 JRST	DELERP
DELECU:	MOVEI	T1,FS%93	;ERROR CODE 93
	 JRST	DELERP
DELFAC:	MOVEI	T1,FS%94	;ERROR CODE 94
;	 JRST	DELERP
DELERP:			;NON-SKIP ERROR RETURN TO USER 
	MOVEM	T1,FS.FS	;SAVE ASIDE FILE-STATUS-1
	PUSHJ	PP,RCLNUP
	POPJ	PP,

;YOU MAY HAVE NOTICED THAT I WENT OUT OF MY WAY TO IMITATE THE EXISTING
;KROCKY ERROR DIAGNOSTIC PROCEDURES WHEN PUTTING IN THE NEW ONES FOR SMU
;OPTION 5. I PUT A LOT OF EFFORT INTO TRYING TO FIGURE OUT HOW TO IMPLEMENT
;A TABLE-DRIVEN PROCEDURE FOR REPORTING NON-FATAL ERROR SITUATIONS BUT I
;DECIDED THAT IT WOULD NOT BE A GOOD IDEA BECAUSE THE RMS ERROR CODES ARE
;NUMBERED IN ASCENDING ORDER TO CORRESPOND TO THEIR THREE-LETTER SUFFIX
;MNEMONIC. IN ORDER FOR A TABLE-DRIVEN PROCEDURE TO BE NON-WASTEFUL OF
;SPACE, OR AT LEAST NOT GREATLY AS IN A SPARSE TABLE, THE ERROR CODES
;WOULD HAVE TO BE NUMBERED IN SOME KIND OF FUNCTIONAL ORDER.

; DELETE with key was not preceeded by a successful READ

DLMSE1:
	SKIPL	WANT8.		;WANT 8X FUNCT?
	 JRST	DLMSE4		; NO
	MOVEI	T0,FS%96	;SET F-S CODE FOR REW/DEL NOT PREC BY READ
	MOVEM	T0,FS.FS	;
	PUSHJ	PP,SETFS	;

DLMSE4:	$ERROR	(E.532,SV.KIL,MT.FIL)	

;"DELETE of seq. access file was not immediately proceeded
; by a successful READ"

DLMSE2:	SKIPL	WANT8.		;WANT 8X FUNCT?
	 JRST	DLMSE3		; NO
	MOVEI	T0,FS%43	;SET F-S CODE FOR REW/DEL NOT PREC BY READ
	MOVEM	T0,FS.FS	;
	PUSHJ	PP,SETFS	;
DLMSE3:	$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%SEQ==1B9		;SEQUENTIAL ACCESS
	RW%NIK==1B11		;NO "INVALID KEY" CLAUSE GIVEN

RW.MIR:	PUSHJ	PP,RWST		;START REWRITE
	MOVE	T1,.RCSTE(FTL)	;GET FILE'S STATE
	LDB	T2,FT.ABL	;GET APPLY BASIC-LOCKING BIT
	CAIN	T2,1		;IS IT ON?
	JRST	RWMIR1		;YES.
	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

;IF WE ARE DOING APPLY BASIC-LOCKING WE DON'T DO A PRELIMINARY FIND. 
;THE USER IS SUPPOSED TO DO THAT HIMSELF.

	PUSHJ	PP,FNDIT	;FIND THE RECORD
	 JRST	RWMIRE		;?CAN'T FIND THE KEY
	JRST	RWGO		;GO DO REWRITE

RWMIR1:
	CAIE	T1,RC.SUR	;LAST READ SUCCESSFUL?
	 JRST	RWMSE1		;NO GIVE ERROR.

;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,RECLNG(T1)	;GET SIZE OF RECORD
	$STORE	T1,RSZ,(T2)	;STORE IT
;RECORD ACCESS OPTIONS ARE LEFT AT "0" (FNDIT SET THEM)
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$UPDATE	<(T2)>,UPDERR	;** DO THE UPDATE **
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	PUSHJ	PP,CHKSDP	;CHECK FOR SUCCESSFUL RETURN, BUT DUPLICATE KEY
	MOVE	T1,FS.FS	;GET FILE-STATUS
	PUSHJ	PP,RCLNUP	; SET FILE-STATUS WORD
	MOVE	T1,FS.FS	;GET FILE-STATUS AGAIN
	CAIL	T1,FS%20
	CAILE	T1,FS%29	;SOME KIND OF INVALID KEY?
	 JRST	UPDOK		;NO
	JRST	CPOPJ1		;YES, RETURN "INVALID KEY"

UPDOK:
	PUSHJ	PP,CHKPT	;[1046] CHECK FOR CHECKPOINTING
	POPJ	PP,		;AND RETURN SUCCESSFULLY

UPDERR:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	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$CUR	;CURRENT RECORD KNOWN?
	 JRST	UPDECU
	CAIN	T1,ER$RLK	;RECORD LOCKED?
	 JRST	UPDELK
	CAIN	T1,ER$FAC	;DELETE NOT ALLOWED FOR SELF UNDER SMU OPEN?
	 JRST	UPDFAC
	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/
?COBLIB: Failed to Rewrite to RMS File
/]
	JRST	RSFAIR

UPDECU:	MOVEI	T1,FS%92	;ERROR CODE 92 FOR CURRENT RECORD
	JRST	UPDERP
UPDELK:	MOVEI	T1,FS%93	;ERROR CODE 93 FOR RECORD LOCKED
	JRST	UPDERP
UPDFAC:	MOVEI	T1,FS%94	;ERROR CODE 94 FOR NOT ALLOWED UNDER OPEN
	JRST	UPDERP
;DUPLICATE KEY ERROR ON UPDATE
UPDERK:	MOVEI	T1,FS%22	;SET FILE-STATUS
;	JRST	UPDERP

UPDERP:
	MOVEM	T1,FS.FS
	PUSHJ	PP,RCLNUP
	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:	SKIPL	WANT8.		;WANT 8X FUNCT?
	 JRST	UPDRS1		; NO
	MOVEI	T1,FS%44	;SET BAD-RECORD-SIZE F-S CODE
	MOVEM	T1,FS.FS	;
	PUSHJ	PP,SETFS	;
UPDRS1:	$ERROR	(E.522,SV.KIL,MT.FIL)

;HERE IF THE FIND FAILED
RWMIRE:	JRST	CPOPJ1		;RETURN "INVALID KEY"
;REWRITE IN SEQUENTIAL MODE

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,FS%21	;FILE-STATUS VALUE
	MOVEM	T1,FS.FS	;STORE IT
	PUSHJ	PP,RCLNUP	;TELL USER PROGRAM, RETURN FROM UPDERR
	POPJ	PP,		; (DO IT THE USUAL WAY)

;REWRITE with key no preceeded by successful READ

RWMSE1:
	SKIPL	WANT8.		;WANT 8X FUNCT?
	 JRST	RWMSE4		; NO
	MOVEI	T0,FS%96	;SET F-S CODE REW/DEL NOT PREC BY READ
	MOVEM	T0,FS.FS	;
	PUSHJ	PP,SETFS	;
RWMSE4:	$ERROR	(E.532,SV.KIL,MT.FIL)	;GIVE ERROR

;"SEQ MODE REWRITE WAS NOT IMMEDIATELY PROCEEDED BY A SUCCESSFUL READ"

RWMSE2:	SKIPL	WANT8.		;WANT 8X FUNCT?
	 JRST	RWMSE3		; NO
	MOVEI	T0,FS%43	;SET F-S CODE FOR REW/DEL NOT PREC BY READ
	MOVEM	T0,FS.FS	;
	PUSHJ	PP,SETFS	;
RWMSE3:	$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)

;WE DON'T NEED THE KEY INFO FOR RELATIVE FILES, AS THIS IS ALL SET UP
;AT OPEN TIME, AND REMAINS CONSTANT FOR THE DURATION OF THIS OPEN.
	MOVE	T0,F.WFLG(FT)	;GET FILE TABLE FLAG WORD
	TLNE	T0,RANFIL		;RELATIVE FILE?
	 JRST	FNDIT2		;YES, GO DOWN TO ROP STUFF

;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,KYINFO(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,KYINFO(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 **
	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$FIND	<(T2)>,FNDITE	;** START = RECORD **
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVE	T2,.RCRAB(FTL)
	MOVE	T1,FS.FS	;GET FILE STATUS
	JUMPE	T1,CPOPJ1	;SKIP RETURN IF OK
	PUSHJ	PP,RCLNUP	; AND SET IT, BECAUSE WE WILL SLIDE OUT
				;  OF THE VERB CALL WITHOUT SETTING IT
				;  OTHERWISE.

	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:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	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/
?COBLIB: RMS $FIND failed for Rewrite or Delete
/]
	JRST	RSFAIR
FNDITF:	MOVEI	T1,FS%23	;SET "INVALID KEY - RECORD NOT FOUND"
	MOVEM	T1,FS.FS
	PUSHJ	PP,RCLNUP	;SET IT AND RETURN
	POPJ	PP,		; SOMEWHAT MORE CLEARLY
				;  TO VERB'S ERROR HANDLING PROCEDURE
;ROUTINE TO CHECK FOR DUPLICATE KEY WRITTEN (WRITE OR REWRITE) OR READ.
;; 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,FS%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	DLENIO		;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)

;;;;; DELETE OR REWRITE AND FILE NOT OPEN I-O

DLENIO:	SKIPL	WANT8.		;WANT ANS 8X FUNCT?
	 JRST	DLENI2		; NO
	MOVEI	T0,FS%49	;SET UP F-S FOR FILE NOT OPEN I-O
	MOVEM	T0,FS.FS	; AND SAVE ASIDE
	PUSHJ	PP,SETFS	; AND PUT IN USER'S F-S FIELD
DLENI2:	$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:	MOVE	T0,F.WFLG(FT)	;GET COMPILER FLAGS
	SKIPGE	WANT8.		;WANT 8X FUNCT?
	TLNN	T0,NOTPRS	;OPTIONAL FILE NOT PRESENT?
	 JRST	ST.GO1		;NO
	MOVEI	T0,FS%25	;SET UP OPT-NOT-PRES F-S CODE
	MOVEM	T0,FS.FS	;
	AOS	(PP)		;SET UP RETURN TO .+2
	PJRST	SETFS		;REPORT IT TO USER, AND RETURN IMMEDIATELY

ST.GO1:	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$FIND	<(T2)>,FNDERR	;** DO THE FIND **
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVE	T1,FS.FS	;GET STATUS
	PUSHJ	PP,SETFS	;SET FILE-STATUS 
	MOVE	T1,FS.FS	;GET STATUS AGAIN
	JUMPE	T1,FNDOK	;RETURN OK IF ZERO
	CAIL	T1,FS%20	;SOME KIND OF INVALID KEY?
	CAILE	T1,FS%29
	 POPJ	PP,		;NO, AN IGNORED ERROR
	AOS	(PP)		;INVALID KEY RETURN
	POPJ	PP,

FNDOK:
	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:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	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"
	CAIN	T1,ER$RLK	;RECORD LOCKED?
	 JRST	FNDELK		; YES

	TYPE	[ASCIZ/
?$FIND FAILED
/]
	JRST	RSFAIR

FNDELK:	MOVEI	T1,FS%92	;ERROR 92 FOR RECORD LOCKED
	JRST	FNDERP
FNDE23:	MOVEI	T1,FS%23	;SET FILE-STATUS, RECORD NOT FOUND
;	JRST	FNDERP

FNDERP:	MOVEM	T1,FS.FS
	PJRST	SETFS		;FOR "INVALID KEY", 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
	SKIPE	F.WSMU(FT)	;DOING SMU OPTION 1?
	 JRST	STASE2		; YES, NOT ALLOWED
	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)

;IF FILE IS RELATIVE, WE JUST RETURN IF WE GOT THIS FAR.
	MOVE	T1,F.WFLG(FT)	;GET FLAG WORD FROM FILE'S FILE TABLE
	TLNE	T1,RANFIL		;RELATIVE FILE?
	 POPJ	PP,		;YES - RETURN

;STORE KEY OF REFERENCE, AND KEY BUFFER ADDRESS
	MOVE	T1,BS.AGL	;GET BASE OF ARG LIST
	HLRZ	T3,KYINFO(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,KEYLNG(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,KYINFO(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,KYINFO(T3)	; INTO T3
	LSH	T3,1		;EACH IS TWO WORDS
	ADDI	T4,KYINFO(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,KEYLNG(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:	SKIPL	WANT8.		;WANT 8X FUNCT?
	 JRST	STASE3		; NO
	MOVEI	T1,FS%47	;SET UP F-S FOR ATTEMPTED READ WITH FILE
				; NOT OPEN FOR INPUT OR I-O
	MOVEM	T1,FS.FS	; AND SAVE IT ASIDE
	PUSHJ	PP,SETFS	; AND REPORT IT TO USER
STASE3:	$ERROR	(E.514,SV.KIL,MT.FIL)

;FATAL ERROR FOR USING START WITH SMU OPTION 1

STASE2:	$ERROR	(E.529,SV.KIL,MT.FIL)
SUBTTL	FAKE READ ENTRY POINTS FOR SMU OPTION 1 FOR RMS FILES

IFN TOPS20,<

;NOTE: A FAKE READ IS NOT A READ AND IS NOT A FIND, BUT IS IN BETWEEN.
; A FIND BRINGS NO DATA INTO THE OTS'S BUFFERS, ONLY PROVIDING THE RFA
; TO THE CURRENTLY FOUND RECORD. A READ BRINGS DATA INTO THE OTS'S
; BUFFERS, AND FROM THERE THE OTS MOVES THE DATA INTO THE USER'S WORK
; AREA. A FAKE READ BRINGS DATA INTO THE OTS'S BUFFERS, BUT THE OTS
; DOES NOT MOVE THE DATA INTO THE USER'S BUFFERS. ALSO, THE OTS DOES
; NOT UPDATE THE RFA FOR THE USER FOR A CURRENTLY FOUND RECORD.
; ALSO, A FAKE READ DOES NOT UPDATE THE USER'S FILE CURRENCEY CONTEXT AT
; RUN TIME, WHICH A REGULAR READ OR A FIND DOES DO.


;FAKE READ BY KEY
;
;CALLING SEQUENCE:
;
;	MOVEI	ARG,ARG-ADDR
;	PUSHJ	PP,FA.MIR
;
;RETURNS:	+ 1 FOR SUCCESS
;		+ 2 FOR INVALID KEY
;		PROGRAM FAILURE FOR ANY OTHER ERROR
;
;ARG FORMAT:	CONSISTS OF TWO WORDS. THE FIRST IS ALWAYS PRESENT. THE
;		SECOND IS PRESENT ONLY FOR KEYED ACCESS TO FILES.
;
;ARG-ADDR:	FLAG-BITS  ,,FILTAB-ADDR
;		KEY# OF REF,,ADDR OF KEY BUFFER
;
; WHERE FLAG-BITS ARE:		(DEFINED IN LBLPRM.MAC)
;	FA%NXT==1B9		;READ NEXT RECORD
;	FA%KYR==1B10		;KEY REFERENCE SPECIFIED
;	FA%FAK==1B11		;THIS READ IS A FAKE READ

;FA.MIR: FAKE READ RANDOMLY FOR SMU OPTION 1

FA.MIR:	PUSHJ	PP,RDSET	;SETUP FOR FAKE READ
	TXO	FLG,FA%FAK	;SET FAKE READ FLAG
	MOVE	T2,.RCFAK(FTL)	;NEED FAKE RAB ADDR AND RKBSET DESTROYS IT
	MOVE	T0,F.WFLG(FT)	;GET COMPILER FLAGS
	TLNE	T0,NOTPRS	;FILE MUST BE PRESENT FOR SMU OPTION 1
	 JRST	FANPER		; ELSE FATAL RUN-TIME ERROR
	TLNE	T0,RANFIL		;READING RELATIVE FILE?
	 JRST	FA.MI3		;YES, SKIP INDEX FILE STUFF
	TXNE	FLG,CF%CNV	;IF CONVERSION REQUIRED,
	 PUSHJ	PP,RKBSET	;SETUP KEY BUFFER

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

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

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

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

;SET "USER BUFFER SIZE"

FA.MI3:
	LDB	T1,FT.MRS	;GET MAXIMUM RECORD SIZE
	$STORE	T1,USZ,(T2)

;IF RELATIVE FILE IDENTIFY RELATIVE KEY BUFFER

	MOVE	T4,.RCFAB(FTL)	;GET FILE'S FAB
	$FETCH	T1,ORG,(T4)	;GET ITS ORGANIZATION
	CAIE	T1,FB$REL	;IS IT RELATIVE?
	 JRST	FA.MI4		; NO

	HRRZ	T1,F.RACK(FT)	;YES, GET ADDRESS OF KEY FROM FILE TABLE
	$STORE	T1,KBF,(T2)	; AND STORE IT IN THE RAB

;SET "ACCESS MODE = RANDOM"

FA.MI4:
	MOVEI	T1,RB$KEY	;KEYED ACCESS
	$STORE	T1,RAC,(T2)

;SET RECORD OPTIONS TO JUST "SET NEXT REC PTR", BUT NOT FOR RELATIVE FILES

	SETZ	T1,		;CLEAR AN AC
	MOVEI	T1,RB$NRP
	$STORE	T1,ROP,(T2)

;;;; ALL READY TO DO THE $GET ;;;
; THE PHILOSOPHY OF GET IN THIS CASE IS DIFFERENT FROM GET FOR READ.
; IF IT COMES BACK SUCCESSFULLY OR RECORD NOT FOUND, WE SIMPLY RETURN
; THE BUCKET NUMBER OR 0 TO SMU OPTION 1. IF THE RECORD WAS NOT FOUND
; RMS WILL RETURN 0 IN THE RFA WORD. IF ANY OTHER ERROR CODE IS RETURNED
; WE BLOW OFF WITH A FATAL RUN TIME MESSAGE.
;
; IN THE CASE OF A 0 RFA BEING RETURNED, WE CANNOT BE SURE OF WHAT THE
; USER'S INTENTION IS AT THIS LEVEL, SO WE SEND BACK A 0 BUCKET NUMBER
; TO THE CALLING ROUTINE IN LSU. AT THAT LEVEL, A BUCKET NUMBER OF 0
; WILL BE USED AS A CATCH-ALL BLOCK NUMBER AS IS A 0 BLOCK NUMBER NOW.
; THE PURPOSE OF THE 0 IS TO SERVE AS A DEFAULT BLOCK OR BUCKET WHEN
; IT IS NOT POSSIBLE TO LOCATE THE ACTUAL BUCKET(S) WHICH MIGHT BE
; AFFECTED BY A WRITE, ETC.

	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$GET	<(T2)>,FARERR	;DO THE GET FOR THE FAKE READ
	JRST	FARAFT		;BECAUSE FARERR RETURNS TO CALL+2
	 POPJ	PP,		;LET FAILED EXIT RETURN TO CALLER BECAUSE
				; IT IS ALREADY SET UP

FARAFT:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
				;RETURN THE BUCKET NUMBER TO SMU OPTION 1
	MOVE	T4,.RCFAB(FTL)	;GET THE FAB'S ADDRESS
	$FETCH	T3,ORG,(T4)	; AND THE FILE'S ORGANIZATION
	MOVE	T2,.RCFAK(FTL)	;GET THE FAKE RAB'S ADDRESS
	CAIE	T3,FB$IDX	;IF INDEXED FILE
	 JRST	FARAF1		; IS NOT
	$FETCH	T1,RFA,(T2)	;THE BUCKET NUMBER IS IN THE RFA FROM THE FAKE RAB
	 JRST	FARAFX		;

FARAF1:				;IS RELATIVE FILE
	$FETCH	T1,LSN,(T2)	;BUCKET NUMBER IS IN THE LINE SEQUENCE NUMBER FIELD
	ADDI	T1,1		;ADD 1 FOR FIRST BLOCK IS 1
FARAFX:				;
	HRRZM	T1,SM.BN	;RETURN BLOCK NUM TO SMU OPTION 1
	POPJ	PP,		;RETURN

;RANDOM FAKE READ FAILED

FARERR:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED

;FILE-STATUS IS NOT SUCH A BIG DEAL WITH THE FAKE READS BECAUSE SMU O
; OPTION 1 IS A DEC EXTENSION. HOWEVER, IN CASE OF A FATAL PROGRAM ERROR
; THEY MAY BE IMPORTANT, SO THEY WILL BE SET UP HERE AND IF THEY CAUSE
; A PROGRAM FAILURE THEY WILL GET BACK TO THE CALLING ROUTINE THROUGH
; DECLARATIVES.

	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	MOVE	T2,.RCFAK(FTL)	;ADDR OF THE FAKE RAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	CAIE	T1,ER$RNF	;RECORD NOT FOUND?
	 JRST	FARER1
	SETZM	SM.BN		;RETURN BLOCK NUMBER OF 0
	AOS	0(PP)		;YES- RETURN +2
	POPJ	PP,		;

FARER1:
	CAIN	T1,ER$RLK	;RECORD LOCKED? 
				; SHOULDN'T BE, IS SERIOUS PROBLEM IF LOCKED
	 JRST	FALKER		; YES - GIVE FATAL RUN-TIME ERROR

	TYPE	[ASCIZ/
?COBLIB: RMS Random Read Failed for SMU with Retain and Free
/]
	JRST	RSFAIK		;RMS-SYSTEM FAILURE

FALKER:	TYPE	[ASCIZ/
?COBLIB: Record to be Retained already Locked
/]
	JRST	RSFAIK		;RMS SYSTEM FAILURE

FANPER:	TYPE	[ASCIZ/
?COBLIB: File Must Be Present for SMU with Retain and Free
/]
	JRST	RSFAIK		;RMS SYSTEM FAILURE
;FAKE READ SEQUENTIALLY
;
;CALLING SEQUENCE:
;
;	MOVEI	ARG,ARG-ADDR
;	PUSHJ	PP,FA.MIS
;
;RETURNS:	+ 1 FOR SUCCESS
;		+ 2 FOR NO NEXT RECORD (EOF)
;		PROGRAM FAILURE FOR ANY OTHER ERROR
;
;ARG FORMAT:	CONSISTS OF ONE WORD. 
;
;ARG-ADDR:	FLAG-BITS  ,,FILTAB-ADDR
;
; WHERE FLAG-BITS ARE THE SAME AS FOR A KEYED FAKE READ

;FA.MIS: FAKE READ SEQUENTIALLY

FA.MIS:
	PUSHJ	PP,RDSET	;SETUP FOR FAKE READ
	TXO	FLG,FA%FAK	;TURN ON FAKE READ FLAG

;GIVE BUCKET NUMBER OF 0 IF FILE IS ALREADY "AT END"
	MOVE	T1,.RCSTE(FTL)	;GET STATE OF FILE
	CAIN	T1,RC.ATE	; IF "AT END",
	 JRST	FAEOF		;GO DO IT

;TEST IF OPTIONAL FILE NOT PRESENT AT OPEN TIME.
; FILE MUST BE PRESENT FOR SMU OPTION 1

	MOVE	T1,F.WFLG(FT)	;GET FILE TABLE FLAG WORD 
	TLNE	T1,NOTPRS	;OPTIONAL FILE WHICH IS NOT PRESENT?
	 JRST	FANPER		; YES, GROSS ERROR

	TLNE	T1,SEQFIL	;IS THIS A SEQUENTIAL FILE?
	 JRST	FASQER		; NOT ALLOWED FOR SMU OPTION 1, ANOTHER
				;  GROSS ERROR

;SET UP FOR INDEXED/RELATIVE-FILE SEQUENTIAL READ.

	MOVE	T2,.RCFAK(FTL)	;POINT TO FAKE RAB, NEED IT BELOW

	MOVE	T1,F.WFLG(FT)	;GET FILE TABLE FLAG WORD
	TLNE	T1,RANFIL	;DOING RELATIVE FILE?
	 JRST	FA.MS1		;YES, BYPASS SETUP FOR KEY OF REFERENCE

	MOVE	T1,.RCKRF(FTL)	;SET UP THE CURRENT KEY OF REFERENCE
	$STORE	T1,KRF,(T2)

;SET RECORD BUFFER ADDRESS

FA.MS1:
	HRRZ	T1,SM.BUF##	;GET ADDRESS OF REGULAR BUFFER FOR FAKE RAB
	TXNE	FLG,CF%CNV	;CONVERSION REQUIRED?
	 HRRZ	T1,.RCFCB(FTL)	; YES, READ RECORD INTO FAKE CONVERSION 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


	HRRZI	T1,0
	$STORE	T1,ROP,(T2)

;;;; ALL READY TO DO THE $GET ;;;

	SETSEC			;GET INTO NON-ZERO SECTION IF REQUIRED
	$GET	<(T2)>,FASERR	;DO IT
	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED


;IF THE $GET COMES BACK NORMALLY, WE HAVE TO DO ONE THING FOR RELATIVE
; FILES AND TWO THINGS FOR INDEXED FILES.
;FOR RELATIVE FILES WE HAVE TO PUT THE LSN + 1 INTO THE FIELD SM.BN TO
; RETURN IT TO THE BLKNUM ROUTINE IN LSU.
;FOR INDEXED FILES, WE HAVE TO RETURN THE KEY VALUE OF THE CURRENT
; RECORD AS WELL AS ITS RELATIVE POSITION IN THE LIST OF KEYS. SO THAT
; THESE CAN BE TABULATED IN THE RETAINED-RECORDS TABLE. FOR AN INITIAL
; READ NEXT, WE WILL ALWAYS ASSUME THE PRIMARY KEY. WE WILL LET LSU DO
; THE WORK TO CREATE THE BYTE POINTER TO MOVE THE KEY VALUE TO THE RRT.

	MOVE	T4,.RCFAB(FTL)	;GET ADDR OF FAB
	$FETCH	T3,ORG,(T4)	;GET FILE'S ORGANIZATION
	MOVE	T2,.RCFAK(FTL)	;GET ADDR OF FAKE RAB
	TRNE	T3,FB$IDX	;IF INDEXED FILE
	 JRST	FA.MS3		; YES, GO TO FINISH UP FAKE READ

;FOR RELATIVE FILE

	$FETCH	T1,LSN,(T2)	;BUCKET NUMBER IS IN THE LINE SEQUENCE NUMBER FIELD
	ADDI	T1,1		; BUMP UP THE BUCKET NUMBER FOR LSU
	HRRZM	T1,SM.BN	; PUT IT INTO SM.BN FIELD
	$FETCH	T1,RFA,(T2)	;GET RFA, WHICH IS RELATIVE KEY VALUE
	MOVEM	T1,SM.KBF	; PUT IT INTO WORD FOR KEY BUFFER
	 JRST	FA.MS2		; DONE

;NOW THE THINGS FOR INDEXED FILES ONLY.

; GET THEM FROM FAKE RAB BECAUSE WE KNOW THAT IT HAS BEEN INITIALIZED.
; IN THE CASE OF THE INITIAL RETAIN NEXT, THIS MIGHT NOT BE THE CASE.

FA.MS3:
	$FETCH	T1,RFA,(T2)	;THE BUCKET NUMBER IS IN THE RFA FROM THE FAKE RAB
	HRRZM	T1,SM.BN	; AND PUT IT INTO SM.BN FIELD
	$FETCH	T1,KRF,(T2)	;GET KEY OF REFERENCE FROM FAKE RAB
	HRRZM	T1,SM.KRF	; AND SAVE IT TO PASS BACK
	$FETCH	T1,UBF,(T2)	;GET USER RECORD BUFFER ADDRESS
	MOVEM	T1,SM.BUF	; AND SAVE IT TO PASS BACK
	$FETCH	T1,KBF,(T2)	;GET KEY BUFFER ADDRESS
	MOVEM	T1,SM.KBF	; AND SAVE IT TO PASS BACK
	$FETCH	T1,BSZ,(T4)	;GET RECORD'S BYTE SIZE FROM FAB
	MOVEM	T1,SM.BSZ	; AND SAVE IT TO PASS BACK
	 JRST	FA.MS2		; AND FINALLY, RETURN

FAEOF:			;EOF INTERLUDE
	SETZM	SM.BN		;SET THE FIELD TO 0 FOR NOT-FOUND RETURN
	AOS	0(PP)		;RETURN +2
FA.MS2:				;SUCCESSFUL RETURN
	POPJ	PP,		;.. OR RETURN SUCCESS

;FAKE READ IN SEQUENTIAL MODE FAILED. SERIOUS ERROR.

FASERR:	RETSEC			;RETURN TO SECTION ZERO IF REQUIRED
	MOVEI	T0,FS%30	;GET CATCHALL FILE-STATUS
	MOVEM	T0,FS.FS	; AND SAVE IT FOR REPORTING
	MOVE	T2,.RCFAK(FTL)	;GET ADDRESS OF FAKE RAB
	$FETCH	T1,STS,(T2)	;GET STATUS RETURNED
	CAIN	T1,ER$EOF	;END OF FILE REACHED?
	 JRST	FAEOF		;YES
	CAIN	T1,ER$RLK	;RECORD LOCKED? SHOULD NOT BE!
	 JRST	FALKER		; YES - VERY SERIOUS - MAKE FATAL

;ALL OTHER TYPES OF ERRORS ARE MADE FATAL TOO, BUT WE HAVE NOT 
; SEPARATED THEM OUT.

FASQER:
	TYPE	[ASCIZ/
?COBLIB: Fake RMS Sequential Read Failed for SMU with Retain and Free
/]
	JRST	RSFAIK		;RMS-SYSTEM FAILURE

> ;END IFN TOPS20

	END