Google
 

Trailing-Edge - PDP-10 Archives - BB-H506D-SM_1983 - cobol/source/lsu.mac
There are 14 other files named lsu.mac in the archive. Click here to see a list.
; UPD ID= 3573 on 6/9/81 at 5:13 PM by MAYBERRY                         
TITLE	LSU FOR LIBOL
SUBTTL	LIBOL'S SIMULTANEOUS UPDATE PACKAGE.



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1981 BY DIGITAL EQUIPMENT CORPORATION


;REVISION HISTORY:

;V12 *****

; WTK	01-Nov-80	;[654] Supplement ENQ/DEQ error return message.
; HAM	03-Oct-80	;[650] Make CNTRY external.
; HAM	21-MAR-79	;[565] FIX LFENQ. CALL TO C.OPEN, FLAG TO SHOW IT'S DONE
; HAM	16-JAN-79	;[550] FIX NULL CONVERSION IN LRDEQ
; EHM	12-SEP-78	;[534] FIX EOF FOR LOW-VALUES READ OF ISAM FILES
; EHM	23-JUN-78	;[532] FIX ILLEGAL INSTRUCTION

;V10 *****

; DW-EM	27-FEB-78	;[524] FIX RETAIN/READ OF COMP ISAM KEYS
;	13-SEP-76	; [456] FIX RANDOM BLOCK NUMBER CALCULATION SO
;			CORRECT BLOCK NUMBER GETS UPDATED WHEN IT SHOULD
;	02-SEP-76	; [455] FIX KEY OF 0 READ OF RANDOM FILES WITH
;			MISSING RECORDS, REQUIRES CHANGE TO COMUNI
;	16-AUG-76	; [447] FIX LOW-VALUES SIMUL UPDATE READS OF
;			ISAM FILES WHEN IN-CORE MODE AND RECORDING MODE
;			ARE DIFFERENT
;	11-AUG-76	; [446] FIX LOW-VALUES SIMUL UPDATE READS OF
;			ISAM FILES SO END OF FILE DOES NOT GIVE ATTEMPT
;			TO READ RECORD NOT RETAINED ERROR
;	11-AUG-76	; [445] FIX LOW-VALUES SIMUL UPDATE READS OF
;			ISAM FILE WITH DISPLAY NUMERIC KEYS
;SSC	2-AUG-76	ADD TEST FOR ALREADY RETAINED DBMS RESOURCES
;	27-JUL-76	; [443] SET UP AP SO LREDQX WORKS FOR ISAM FREES
;	01-JUN-76	; [437] SET UP FOUR TABLES AND INITIALIZE COUNT PROPERLY FOR RANDOM FILES.
			;	PATCH IN CBLIO ALSO.

;	05-APR-76	; [434] FIX SIMULTANEOUS UPDATE FOR UNAVAILABLE CLAUSE
;	16-MAY-75	/GPS	CREATION.

;*****

	SALL
	HISEG


	SEARCH	LBLPRM
	SEARCH	FTDEFS
	IFN LSTATS,<
	SEARCH	METUNV		;LSTATS METER DEFINITIONS
	>
IFN TOPS20,<
	SEARCH	MONSYM,MACSYM
>
IFE TOPS20,<
	SEARCH	UUOSYM,MACTEN
>

DEFINE TYPE(ADDR),<
 IFN TOPS20,<
	HRROI	1,ADDR
	PSOUT%
 >
 IFE TOPS20,<
	OUTSTR	ADDR
 >
>;END DEFINE TYPE
;	THE LIBOL SIMULTANEOUS UPDATE PACKAGE: LRENQ, LRDEQ, LFENQ,
;					       SU.RD, SU.RW, SU.WR,
;					       SU.DL, AND SU.CL
;
;
;
;	THIS PACKAGE IMPLEMENTS IN LIBOL THE COBOL SIMULTANEOUS UPDATE
;	FEATURE.
;
;
;	LRENQ: LIBOL RECORD ENQUEUE
;
;
;	THE FOLLOWING PROCEDURE, LRENQ, IS CALLED BY THE COBOL OBJECT
;	PROGRAM ONCE FOR THE EXECUTION OF EACH RETAIN STATEMENT.
;
;	LRENQ EXPECTS TO FIND IN AC16 THE ADDRESS OF AN ARGUMENT LIST,
;	STRUCTURED AS FOLLOWS:
;
;	WORD 1: RH = NUMBER OF RECORDS TO BE RETAINED (N)
;	        LH = 0 => USER DID NOT SUPPLY AN UNAVAILABLE STATEMENT
;	        LH = 1 => USER SUPPLIED AN UNAVAILABLE STATEMENT
;
;	WORD 2: BITS 0-8: 147
;	        BIT 9: SET IF USER INTENDS TO READ
;		BIT 10: SET IF USER INTENDS TO REWRITE
;		BIT 11: SET IF USER INTENDS TO WRITE
;		BIT 12: SET IF USER INTENDS TO DELETE
;		BIT 13: SET IF USER SPECIFIED UNTIL FREED
;		BIT 14: SET IF USER SPECIFIED A RECORD IDENTIFIER
;			(AS OPPOSED TO IMPLICITLY DESIGNATING THE
;			CURRENT RECORD. IF THIS BIT IS SET, THE NEXT
;			WORD DESIGNATES THE RECORD; OTHERWISE THE NEXT 
;			WORD DESIGNATES THE NEXT RECORD TO BE RETAINED
;			AND HAS THE SAME FORMAT AS THIS ONE.)
;		BIT 15: (COBOL-74 ONLY): "RETAIN NEXT RECORD..."
;		BITS 16-17: NOT USED
;		RH = FILE TABLE LOCATION FOR THE FILE CONTAINING THIS 
;			RECORD.
;
;	WORD 3: (IF BIT 14 OF PRECEDING WORD = 1)
;	
;		BITS 0-8: 0
;		BITS 9-12: TYPE (SEE BELOW)
;		BITS 13-35: FULL ADDRESS, USING I,X AND Y
;		
;		TYPE = 2 => ADDRESS IS ADDRESS OF A ONE WORD 
;			    COMPUTATIONAL ITEM (INTEGER)
;
;		TYPE = 11 (BASE 8) => ADDRESS IS ADDRESS OF A TWO WORD
;				      COMPUTATIONAL ITEM (INTEGER)
;
;		TYPE = 4 MEANS ADDRESS IS ADDRESS OF A ONE WORD
;			    COMPUTATIONAL-1 ITEM (FLOATING POINT)
;
;		TYPE = 15 (BASE 8) => MEANS ADDRESS IS ADDRESS OF A TWO
;			              WORD DESCRIPTOR OF A DISPLAY-6,
;				      DISPLAY-7 OR DISPLAY-8 ITEM; THE 
;				      DESCRIPTOR HAS THE FOLLOWING 
;				      FORMAT:
;
;			WORD 1: A BYTE POINTER TO THE IDENTIFIER OR
;				LITERAL
;
;			WORD 2: BIT 0 = 1 => ITEM IS NUMERIC
;				BIT 1 = 1 => ITEM IS SIGNED
;				BIT 2 = 1 => ITEM IS A FIGURATIVE 
;					     CONSTANT
;				BIT 3 = 1 => ITEM IS A LITERAL
;				BITS 4-11 ARE NOT USED
;				BIT 12 = 1 IF P OCCURS IN THE ITEM'S 
;					PICTURE
;				BITS 13-17 CONTAIN THE NUMBER OF DECIMAL
;					PLACES CONTAINED IN THE ITEM
;				BITS 18-35 CONTAIN THE SIZE OF THE ITEM
;					IN BYTES
;
;	(THE PATTERN OF WORDS 2 AND 3 IS REPEATED UNTIL N IS EXHAUSTED)
;
;
;	THE FOLLOWING RESTRICTIONS APPLY TO THE USER SUPPLIED RECORD
;	IDENTIFIERS:
;
;	(1) FOR SEQUENTIAL FILES, THE RECORD IDENTIFIER MUST BE TYPE 2
;	    (A ONE WORD COMPUTATIONAL ITEM).
;
;	(2) FOR RANDOM FILES, THE RECORD IDENTIFIER MUST BE TYPE 2
;	    (A ONE WORD COMPUTATIONAL ITEM).
;
;	(3) FOR INDEXED FILES, THE RECORD IDENTIFIER MUST AGREE WITH
;	    THE RECORD KEY DEFINED FOR THE FILE IN CLASS, USAGE, SIZE,
;	    AND NUMBER OF DECIMAL PLACES. IT MAY NOT BE A LITERAL
;	    OR FIGURATIVE CONSTAND, EXCEPT LOW-VALUES.
; 
;
;
;	AN IMPORTANT ASSUMPTION MADE BY THIS ROUTINE IS THAT THE
;	ABOVE RESTRICTIONS WERE CHECKED AT COMPILE TIME


;	THIS PROCEDURE USES A DATA STRUCTURE CALLED THE RETAINED
;	RECORDS TABLE. THE FORMAT OF THIS TABLE IS AS FOLLOWS:
;
;	WORD 1: THE MISCELLANEOUS WORD (0)
;
;		BITS 0-2: QUEUEING TECHNIQUE (QT)
;		BITS 3-8: ENQUEUEING FLAGS (EF)
;		BIT 9: F BIT (SET TO INDICATE THIS ENTRY SHOULD BE
;			       FREED)
;		BITS 10-17: THE INCREMENT TO THE NEXT ENTRY,
;			   IN WORDS (INE)
;		BITS 18-35: LOCATION OF THE FILE TABLE OR 0, 
;			    INDICATING THE RECORD HAS BEEN FREED.
;
;
;	WORD 2: BLOCK NUMBER
;
;	WORDS 3-N: KEY
;
;
;	THE VALUES FOR QUEUEING TECHNIQUE (QT) ARE:
;
;		0: NO QUEUEING
;		1: SHARED
;		2: EXCLUSIVE
;		3: INDEX-EXCLUSIVE
;		4: SHARED, BUT COVERED BY ANOTHER ITEM'S INDEX-EXCLUSIVE
;		5: EXCLUSIVE, BUT COVERED BY ANOTHER ITEM'S
;		   INDEX-EXCLUSIVE
;		7: RANDOM RECORD RETAINED WITH KEY OF 0, FILE IS EXCLUSIVE
;
;
;	THE VALUES FOR ENQUEUEING FLAGS (EF) ARE:
;
;		BIT 0: READ
;		BIT 1: REWRITE
;		BIT 2: WRITE
;		BIT 3: DELETE
;		BIT 4: UNTIL FREED (UF)
;		BIT 5: KEY SPECIFIED (KS)
;	REGISTER ASSIGNMENTS
;
;	NOTE: REGISTERS 0, 1, 2, AND 3 ARE DESTROYED BY A RESTORE OPERATION
;		(THIS AFFECTS ACRR2, ACRR3, AND K AS REGISTERS ARE CURRENTLY DEFINED)
	ACRR==7		;CURRENT RETAINED RECORDS TABLE ENTRY
	AURS==13		;CURRENT USER RECORD SPECIFICATION
	I==10		;COUNTER
	J==14		;COUNTER
	K==3		;COUNTER
	AT1==4		;TEMP  NOTE: AT1, AT2, AND AT3 MUST BE CONTIGUOUS
	AT2==5		;TEMP
	AT3==6		;TEMP
	AT4==12		;TEMP
	AT5==11		;TEMP - MUST NOT BE A REGISTER THAT NEEDS TO BE SAVED
	AFT==15		;FILE TABLE POINTER
	AP==16		;PARAMETER LIST POINTER  (MUST BE AC16)
	PP==17		;PUSHDOWN LIST POINTER  (MUST BE AC17)
	ACRR2==1	;ANOTHER CURRENT RETAINED RECORDS TABLE ENTRY
	ACRR3==2	;STILL ANOTHER CURRENT RETAINED RECORDS TABLE 
			;ENTRY
	AUFS==AURS	;CURRENT USER FILE SPECIFICATION
;
;
;
;
;	FIELD VALUES
;
	%FAM.D==2		; ACCESS MODE VALUE FOR 74 DYNAMIC ACCESS

	INDEXD==4		;VALUE OF ACCESS MODE FOR INDEXED
	RANDOM==RANFIL##	;VALUE OF ACCESS MODE FOR RANDOM
	COMPLT==3		;VALUE OF TYPE OF KEY FOR COMP <= 10 
				;DIGITS
	COMP1==5		;VALUE OF TYPE OF KEY FOR COMP-1
	COMPGT==4		;VALUE OF TYPE OF KEY FOR COMP > 10
				;DIGITS
	UNTFRD==2		;UNTIL FREED FLAG BIT IN URSFLG
	USRSKY==000010		;USER SUPPLIED KEY BIT IN FREE ARG
	FREFEV==000200		;FREE ALL IN FILE BIT IN USER ARG
	FREALR==000400		;FREE ALL RECORDS BIT IN USR ARG
	JSTWRT==000015		;(EF) IN RETAIN REC ENTRY,MASK ALL
				;BUT WRITE BIT (USED TO CHECK WRITE ONLY
	JSTRWT==000013		;(EF) AS ABOVE, BUT TO CHECK FOR REWRITE ONLY
;
;	FIELDS VALUES IN RETAINED RECORDS TABLE ENTRY
;
	RTTRD==10		;RETAINED FOR READ (USING FIRST 4 EF BITS)
	RTTNRD==7		;MASKS ALL BUT READ BITS (   "   )
	RTDLRW==05		; MASKS FOR DELETE OR REWRITE RETAIN
;
;
;	EXTERNAL ENTRY POINTS
;
;	
	ENTRY	LFENQ.,LRENQ.,LRDEQ.,LRDEQX,SU.RD,SU.RW,SU.WR,SU.DL,SU.CL
;	MACROS

	DEFINE	SAVE<
	MOVEI	AT5,SU.SAV	;SAVE REGISTERS
	BLT	AT5,SU.SAV+3
	MOVEM	12,SU.SAV+4>

	DEFINE	RESTRM<
	HRLZI	AT5,SU.SAV	;RESTORE REGISTERS
	BLT	AT5,3
	MOVE	12,SU.SAV+4>
;	MRHDCT IS A MACRO TO INCREMENT A METER BUCKET WITHIN
;THE TRAILER BLOCK.
;
;ARGUEMENTS:	OFF	THE BUCKET OFFSET WITH THE TRAILER
;		R	A REGISTER TO USE FOR INDEXING
;
	
DEFINE	MRHDCT	(OFF,R)<
	IFN LSTATS,<
		MOVE	R,MRTDBP	;GET METER TRAILER ADDRESS
		AOS	OFF(R)		;INCREMENT TRAILER BUCKET
	>
>
;	BYTE POINTERS
;
URSCON:	POINT	9,0(AURS),8	;CONSTANT IN USER RECORD SPECIFICATION

URSFLG:	POINT	6,0(AURS),14	;FLAGS IN USER RECORD SPECIFICATION

URSTYP:	POINT	4,1(AURS),12	;TYPE IN USER RECORD SPECIFICATION

IFN ANS74,<
URSNXT:	POINT	1,0(AURS),15	;"NEXT RECORD" FLAG
>;END IFN ANS74

CRRFLG:	POINT	6,0(ACRR),8	;ENQUEUEING FLAGS IN RETAINED RECORDS
				;TABLE ENTRY

CRRFG4:	POINT	4,0(ACRR),6	;FIRST FOUR ENQUEUEING FLAGS IN RETAINED
				;RECORDS TABLE ENTRY (READ, REWRITE,
				;WRITE, DELETE)

CRRQT:	POINT	3,0(ACRR),2	;QUEUEING TECHNIQUE IN RETAINED RECORDS
				;TABLE

CRRINE:	POINT	8,0(ACRR),17	;INCREMENT TO THE NEXT ENTRY IN
				;THE RETAINED RECORDS TABLE

CRRF:	POINT	1,0(ACRR),9	;FREE FLAG

CRRQT2:	POINT	3,0(ACRR2),2	;SAME AS CRRQT, EXCEPT XR = ACRR2

CRRQT3:	POINT	3,0(ACRR3),2	;SAME AS CRRQT, EXCEPT XR = ACRR3

CRRIN2:	POINT	8,0(ACRR2),17	;SAME AS CRRINE, EXCEPT XR = ACRR2

CRRIN3:	POINT	8,0(ACRR3),17	;SAME AS CRRINE, EXCEPT XR = ACRR3

CRRBLK:	POINT	33,1(ACRR),35	;BLOCK NUMBER OF THIS RECORD

CRRBK2:	POINT	33,1(ACRR2),35	;SAME AS CRRBLK, EXCEPT XR = ACRR2

CRRBK3:	POINT	33,1(ACRR3),35	;SAME AS CRRBLK, EXCEPT NR = ACRR3

RRTNXT:	POINT	1,1(ACRR),0	;SET IF RETAINING "NEXT" RECORD

RRTHVF:	POINT	1,1(ACRR),1	;SET IF NEXT RECORD DOESN'T EXIST

AT1HVF:	POINT	1,1(AT1),1	;SAME AS RRTHVF WITH XR = AT1

RRTNX3:	POINT	1,1(ACRR3),0	;"NEXT" FLAG WITH XR = ACRR3

; BYTE PTRS TO FILE TABLE INFO

FTAM:	POINT	3,F.WFLG(AFT),17	;ACCESS MODE FIELD IN FILE TABLE

FTKLB:	POINT	12,F.WIKD(AFT),35	;KEY LENGTH IN BYTES IN FILE TABLE

FTKT:	POINT	3,F.WIKD(AFT),17	;KEY TYPE IN FILE TABLE

FTRM:	POINT	3,F.WFLG(AFT),14	;RECORDING MODE IN FILE TABLE

LFQOPN:	POINT	1,F.WSMU(AP),15		;[565] LFENQ. OPEN FLAG BIT
					;[565] =0 IF LFENQ. C.OPEN CALL NOT DONE
					;[565] =1 IF C.OPEN CALL DONE

;[650] CNTRY==117		;POINTER TO CURRENT RECORD IN CBLIO'S
				;BUFFER FOR ISAM FILE


FTCN:	POINT	4,D.CN(AFT),15	;CHANNEL NUMBER IN FILE TABLE

FTBF:	POINT	12,F.WBKF(AFT),17	;BLOCKING FACTOR IN FILE TABLE

FTOWA:	POINT	4,F.WSMU(AFT),3	;OWN ACCESS IN FILE TABLE (READ,
				;REWRITE, WRITE, DELETE)

FTOTA:	POINT	4,F.WSMU(AFT),12	;OTHERS ACCESS IN FILE TABLE
				;(READ, REWRITE, WRITE, DELETE)

UFSCON=URSCON			;CONSTANT IN USER FILE SPECIFICATION

UFSFLG:	POINT	7,0(AUFS),15	;FLAGS IN USER FILE SPECIFICATION

IDXSHR:	POINT	2,F.WSMU(AFT),17	;FLAG INDICATING SHARED/EXCLUSIVE
					;=0 IF INDEX EXCLUSIVE
					;=1 IF INDEX SHARED
					;=3 IF INDEX GROUP SHARED
;	INTERFACE WITH CBLIO
;
;
;	MAPPING OF KEYS INTO BLOCK NUMBERS
;
;	ONE FUNCTION REQUIRED OF CBLIO FOR ISAM FILES IS THE MAPPING
;	OF SYMBOLIC KEYS INTO BLOCK NUMBERS. THIS IS ACCOMPLISHED IN
;	THE FOLLOWING WAY:
;
;	AFTER SAVING REGISTERS IT REQUIRES, SETTING SU.FRF TO -1, AND SETTING SU.RBP TO 0
;	(EXPLAINED BELOW), THIS PACKAGE SETS AC16 WITH A SPECIAL
;	FLAG  IN LH (DEFINED BY RFLAG INTERNALLY) AND A FILE TABLE
;	ADDRESS IN RH. "SYMBOLIC KEY" IS SAVED AND CHANGED TO CONTAIN
;	THE KEY THAT IS TO BE MAPPED INTO A BLOCK NUMBER. THEN A
;	PUSHJ IS DONE TO THE EXTERNAL SYMBOL "FAKER.".
;
;	CBLIO PERFORMS A READ OF THE RECORD WITH THE KEY IN SYMBOLIC
;	KEY, AND TAKES THESE SPECIAL ACTIONS:
;
;	1: IT SETS FS.BN TO THE BLOCK NUMBER OF THE BLOCK CONTATING
;	THE KEY.
;
;	2: IT FAILS TO MOVE THE RECORD INTO THE USER'S RECORD AREA.
;
;	3. IF THE VALUE OF "SYMBOLIC KEY" IS LOW-VALUES, IT PUTS
;	INTO SU.RBP A BYTE POINTER TO THE ACTUAL KEY OF THE RECORD.
;
;
;	FILLING AND FLUSHING BUFFERS
;
;	WHEN THE USER RETAINS A RECORD, IT IS IMPERATIVE THAT A
;	SUBSEQUENT READ RETRIEVE THE VERY LATEST VERSION OF THAT
;	RECORD. THEREFORE IF RETAIN DISCOVERS THAT A BLOCK
;	CONTAINING A RECORD BEING RETAINED IS CURRENTLY IN THE USER'S
;	BUFFER, THAT BUFFER MUST BE REFILLED FROM DISC. THIS IS
;	DONE BY CALLING CBLIO AT THE ENTRY POINT FORCR. (FORCE READ).
;	THE ONLY PARAMETER REQUIRED IS A FILE TABLE ADDRESS IN AC16,
;	SINCE THERE IS ONLY ONE CURRENT BUFFER.
;	(SU PACKAGE MUST SAVE ANY REGISTERS IT NEEDS BEFORE CALLING FORCR.)
;
;	SIMILARLY, WHEN THE USER FREES A RECORD, IT IS IMPERATIVE
;	THAT THE RECORD BE WRITTEN ON DISC BEFORE IT IS FREED,
;	SO THAT ANOTHER USER RECEIVES THE VERY LATEST COPY. THEREFORE,
;	WHEN FREE DETECTS THAT THE RECORD BEING FREED IS IN THE
;	CURRENT BUFFER, AND THAT THE USER HAS MODIFIED THE RECORD,
;	IT CALLS CBLIO AT THE ENTRY POINT FORCW. (FORCE WRITE), WITH
;	AC16 SET TO A FILE TABLE ADDRESS.
;	(SU PACKAGE MUST SAVE ANY REGISTERS IT NEEDS BEFORE CALLING FORCW.)
;
;
;	MOVING LOW-VALUES TO CURRENT SYMBOLIC KEY
;
;	THE CBLIO ROUTINE LV2SK. IS USED TO MOVE LOW-VALUES TO THE
;	SYMBOLIC KEY. IT IS ASSUMED THAT ALL REGISTERS ARE DESTROYED
;	BY LV2SK.. AC16 POINTS TO THE FILE TABLE UPON PUSHJ PP, LV2SK..
;	THERE ARE NO ERROR RETURNS FROM LV2SK..
;
;
;	COMPARING A KEY AGAINST LOW-VALUES
;
;	THE CBLIO ROUTINE LVTST IS USED TO COMPARE A KEY TO
;	LOW-VALUES. ON INPUT, A BYTE POINTER TO THE KEY TO BE TESTED
;	IS SET IN AC1 AND AC16 CONTAINS A FILE TABLE POINTER. LVTST
;	RETURNS TO 0 IF THE KEY IS EQUAL TO LOW-VALUES, TO 1 IF IT IS
;	NOT.
;	(SU PACKAGE MUST SAVE ANY REGISTERS IT NEEDS BEFORE CALLING LVTST.)
;
;
;
;	REFRESHING IN-CORE STORAGE ALLOCATION TABLES
;
;	LSU SETS USOBJ+13 TO ZERO TO MAKE CBLIO REFRESH ITS IN-CORE
;	STORAGE ALLOCATION TABLES. SEE ZSATB ROUTINE.


	EXTERN	FAKER.		;ENTRY INTO CBLIO

	EXTERN	FS.BN		;LOCATION WHERE CBLIO RETURNS BLOCK
				;NUMBER
IFN ANS74,<
	EXTERN	F.BFAM		;FILE ACCESS MODE BYTE PTR
	EXTERN	SAVNXT		; D.RFLG field for del/rewrt next rec position
>

IFN ANS68,	RFLAG==002100		;THE FAKE READ FLAG
IFN ANS74,	RFLAG==002000		;SET IN LH OF 16 WHEN CALLING FAKER.
IFN ANS74, RNFLAG==RFLAG!200	;NEXTR (READ NEXT RECORD)

	EXTERN	GDPSK		;[445][447] LOCATION IN DEVICE TABLE POINTING TO
				;ANOTHER TABLE CONTAINING THE LAST
				;VERB EXECUTED BY THIS USER, WHETHER
				;THE CURRENT BUFFER CONTAINS LIVE DATA,
				;AND ALSO THE NEXT RECORD FLAG.


	EXTERN	CHTAB		;[447] TABLE OF INPUT CONVERSION INSTRUCTIONS
	LASTUU==7		;OFFSET IN THE TABLE POINTED TO BY
				;THE LEFT HALF OF D.BL THAT CONTAINS
				;MINUS 1 IF THE LAST VERB FOR THIS FILE
				;WAS A WRITE.

	LIVDAT==6		;OFFSET IN THE SAME TABLE WHICH CONTAINS
				;MINUS 1 IF THE BUFFER CONTAINS LIVE
				;DATA

	NXTREC==NNTRY##		;OFFSET IN THE SAME TABLE WHICH CONTAINS
				;-1 IF THE "CURRENT RECORD" IS IN
				;FACT, THE "NEXT RECORD".

	EXTERN	LV2SK.		;CBLIO ROUTINE FOR SETTING SYMBOLIC
				;KEY TO LOW-VALUES

IFN ANS68,	EXTERN	LVTST	;CBLIO ROUTINE FOR COMPARING A KEY TO 
				;LOW-VALUES

	EXTERN	FORCR.		;ENTRY POINT IN CBLIO THAT REFILLS A 
				;BUFFER

	EXTERN	FORCW.		;ENTRY POINT IN CBLIO THAT FLUSHES A
				;BUFFER
;
;	CHECKING ACCESS TO RECORDS BEFORE READ, REWRITE, WRITE OR DELETE
;
;	WHEN CBLIO DETECTS THAT A FILE IS OPEN FOR SIMULTANEOUS UPDATE,
;	IT CALLS SU.RD, SU.RW, SU.WR, SU.DL, OR SU.CL, AS APPROPRIATE
;	(SEE DESCRIPTION OF THESE ROUTINES BELOW).
;
;
;	IMPLICIT FREEING OF RECORDS.
;
;	AFTER EXECUTION OF A READ, REWRITE, WRITE, OR DELETE, CBLIO
;	CALLS LRDEQX VIA PUSHJ WITH NO PARAMETERS OR RETURNED VALUES
;	TO ACCOMPLISH ANY IMPLICIT FREEING OF RECORDS THAT MAY BE
;	REQUIRED.
;	(LRDEQX SAVES ALL REGISTERS FOR CBLIO)
;
;
;	OPENING AND CLOSING FILES.
;
;	LFENQ. OPENS AND CLOSES FILES BY CALLING C.OPEN AND C.CLOS
;	WITH 16 LH CONTAINING FLAGS INDICATING THE FILE IS TO
;	BE OPENED FOR I-O AND 16 RH CONTAINING A FILE TABLE ADDRESS.

	EXTERN	C.OPEN,C.CLOS,USOBJ
	EXTERN	RET.1,RET.2
;	THIS ROUTINE USES THE FOLLOWING CONVENTIONS FOR BLOCK NUMBERS:
;
;	BLOCKS 1 TO 2 ** 33 - 6: DATA BLOCKS
;	BLOCK 2 ** 33 - 5: THE FILE READ QUEUE
;	BLOCK 2 ** 33 - 4: THE FILE REWRITE QUEUE
;	BLOCK 2 ** 33 - 3: THE FILE WRITE QUEUE
;	BLOCK 2 ** 33 - 2: THE FILE DELETE QUEUE
;	BLOCK 2 ** 33 - 1: THE PRIMARY INDEX OF THE FILE
;
;
;	WHEN WE CALL ENQ/DEQ WITH A 33 BIT IDENTIFIER EQUAL TO
; 	2 ** 33 - 1 WE ARE LOCKING THE INDEX OF THE FILE. IF WE
;	CALL ENQ/DEQ WITH A 33 BIT IDENTIFIER EQUAL TO 1234 WE
;	ARE LOCKING DATA BLOCK NUMBER 1234. ETC.
;	TEMPORARY STORAGE
;
;
	EXTERN	SU.RR		;COUNT OF RECORDS RETAINED BY THE USER
	EXTERN	SU.DBR		;COUNT OF USER-RETAINED DBMS RESOURCES
	EXTERN	SU.EQ		;COUNT OF ENTRIES IN THE ENQUEUE TABLE
				;(AS OPPOSED TO THE DEQUEUE TABLE OR
				;(THE MODIFY TABLE)
	EXTERN	SU.DQ		;COUNT OF ENTRIES IN THE DEQUEUE TABLE
	EXTERN	SU.MQ		;COUNT OF ENTRIES IN THE MODIFY TABLE
	EXTERN	SU.RRT		;LOCATION OF THE RETAINED RECORDS TABLE
	EXTERN	SU.T1		;TEMP ONE
	EXTERN	SU.T2		;TEMP TWO
	EXTERN	SU.T3		;TEMP THREE
	EXTERN	SU.T4		;TEMP FOUR
	EXTERN	SU.T5		;TEMP FIVE
	EXTERN	SU.T6		;TEMP SIX
	EXTERN	SU.T7		;TEMP SEVEN
	EXTERN	SU.T8		;TEMP EIGHT
	EXTERN	SU.T9		;[445] TEMP NINE
	EXTERN	SU.CRH		;USED TO STORE THE HIGHEST VALUE OF ACRR
				;(TOTAL LENGTH OF THE RETAINED RECORDS 
				;TABLE)
	EXTERN	SU.EQT		;LOCATION OF THE ENQUEUE TABLE
	EXTERN	SU.DQT		;LOCATION OF THE DEQUEUE TABLE
	EXTERN	SU.MQT		;LOCATION OF THE MODIFY TABLE
	EXTERN	SU.Y		;FLAG
	EXTERN	SU.RBP		;RECORD BYTE POINTER - SPECIAL POINTER
				;TO HANDLE LOW-VALUES (SEE CBLIO 
				;INTERFACE)
	EXTERN	SU.MRR		;MORE RETAINED RECORDS FLAG
	EXTERN	SU.SBD		;SAME BLOCK, DIFFERENT QUEUEING 
				;TECHNIQUE FLAG
	EXTERN	SU.RLV		;[455] RANDOM KEY OF 0 FLAG
	EXTERN	SU.RND		;[455] FILE IS RANDOM FLAG
	EXTERN	SU.SFQ		;SAME FILE FLAG
	EXTERN	SU.SFS		;SAME FILE, SAME QUEUEING TECHNIQUE FLAG
	EXTERN	SU.SBS		;SAME BLOCK, SAME QUEUEING TECHNIQUE
				;FLAG
	EXTERN	SU.NR		;NOT RETAINED FLAG

	EXTERN	SU.FR		;COUNT OF FILES CURRENTLY OPENED FOR
				;SIMULTANEOUS UPDATE

	EXTERN	SU.AK		;TEMPORARY USED FOR ABSOLUTE KEY

	EXTERN	SU.FBT		;LOCATION OF THE FILL/FLUSH BUFFER TABLE

	EXTERN	SU.CFB		;COUNT OF ENTRIES IN THE FILL/FLUSH
				;BUFFER TABLE

	EXTERN	SU.VRB		;INDICATOR OF CURRENT VERB BEING EXECUTED
				;20 = CLOSE, 10 = READ, 4 = REWRITE,
				;2 = WRITE, 1 = DELETE

	EXTERN	SU.HV		;[447] SET TO -1 WHEN HIGH VALUES USED
	EXTERN	SU.CK		;COMPARISON KEY

	EXTERN	SU.SVK		;TEMP USED TO SAVE KEY

	EXTERN	SU.CL1,SU.CL2,SU.CLR,SU.CLS	;TEMPS FOR SU.CL -
				;SU.CL1 AND SU.CL2 MUST BE
				;CONTIGUOUS

	EXTERN	SU.SAV		;AREA TO SAVE REGISTERS 1,2,3,0, AND 12
	
	EXTERN	FET1,FET2,FET3,FET4	;FILE ENQUEUE TEMPS

	EXTERN	SU.FRF		;THE FAKE READ FLAG 0 = REGULAR -1 = FAKE

IFN LSTATS,<

IFN TOPS20,<
	EXTERN	MRTM.E,MRTM.S
>
	EXTERN	MRTMB.,MBTIM.,MRTDBP	;METER TIMING ROUTINES AND LOCATIONS

>;END IFN LSTATS
;	DEBUGGING
;
;
;	IF THE TRNA FOLLOWING LABEL ED3 IN ENQDEQ
;	(AN INTERNAL SUBROUTINE) IS CHANGED TO TRN, ANY LIBOL ROUTINE DOING ENQUEUEING
;	OR DEQUEUEING WILL TYPE THE PARAMETERS TO ENQ/DEQ ON TTY BEFORE
;	CALLING ENQ/DEQ.
;	INITIALIZATION.
;
;	CHECK THAT NO RECORDS ARE CURRENTLY RETAINED. INITIALIZE
;	VARIABLES. POINT AN AC TO THE BEGINNING OF THE USER'S
;	RETAINED RECORDS TABLE, AND ANOTHER AC TO THE FIRST USER
;	RECORD SPECIFICATION IN THE ARGUMENT LIST.

LRENQ.:
	MRTMS.	(AT1)		;START METER TIMING
	SAVE
	SKIPG	SU.DBR		;ANY DBMS RETAINS IN PLACE, ALSO BAD
	SKIPE	SU.RR
	JRST	SU.ER1		;JUMP IF USER IS CURRENTLY RETAINING
				;RECORDS - HE MAY NOT EXECUTE A RETAIN
				;STATEMENT UNLESS ALL RECORDS ARE FREE.

	SETZM	SU.EQ		;SET THE NUMBER OF ENTRIES IN THE
				;ENQUEUE TABLE TO ZERO (LRENQ WILL
				;NOT USE THE DEQUEUE TABLE OR THE
				;MODIFY TABLE)

	SETZM	SU.CFB		;ZERO THE NUMBER OF ENTRIES IN THE
				;FILL/FLUSH BUFFER TABLE

	MOVE	ACRR,SU.RRT	;POINT ACRR TO THE BEGINNING OF THE
				;RETAINED RECORDS TABLE

	MOVEI	AURS,1(AP)	;POINT AURS TO THE FIRST USER RECORD
				;SPECIFICATION IN THE ARGUMENT LIST

	HRRZ	I,0(AP)		;COUNT USER RECORD SPECS IN I

IFN LSTATS,<
	HLRZ	AT2,0(AP)	;GET UNAVAILABLE FLAG
	JUMPE	AT2,LRMRXX	;SKIP OUT IF NO UNAVAILABLE CLAUSE
	MRHDCT	(MB.RTU,AT1)	;INCREMENT METER BUCKET
LRMRXX:>;END IFN LSTATS

	MOVEM	I,SU.RR		;SAVE NUMBER OF RECORDS RETAINED IN SU.RR
	JUMPN	I,LRENQ8
	RESTRM
	POPJ	PP,		;RETURN IF COUNT = 0
;	FIRST LOOP.
;
;	LOOK AT EACH USER RECORD SPECIFICATION. DETERMINE THE QUEUEING
;	TECHNIQUE FOR EACH AND CREATE AN ENTRY IN THE RETAINED RECORDS
;	TABLE CONTAINING THE QUEUEING TECHNIQUE, FILE TABLE POINTER,
;	ENQUEUEING FLAGS, KEY VALUE, AND A ZERO BLOCK NUMBER. THE
;	QUEUEING TECHNIQUES HAVE THE FOLLOWING MEANINGS:
;
;	0: ACCESS TO THIS RECORD AS DEFINED BY THE ENQUEUEING FLAGS
;	   REQUIRES NO ACTION ON OUR PART
;
;	1: ACCESS TO THIS RECORD REQUIRES SHARED ENQUEUEING ON THE
;	   BLOCK IN WHICH THE RECORD RESIDES, AND IF THE FILE IS INDEXED,
;	   SHARED QUEUEING ON THE INDEX
;
;	2: SAME AS 1 EXCEPT EXCLUSIVE QUEUEING REQUIRED ON THE BLOCK.
;
;	3: ACCESS TO THIS RECORD AS DEFINED BY THE ENQUEUEING FLAGS
;	   REQUIRES EXCLUSIVE ENQUEUEING OF THE INDEX
;
;	4: ACCESS TO THIS RECORD WOULD NORMALLY REQUIRE QUEUEING
;	   TECHNIQUE 1, BUT ANOTHER REQUEST REQUIRES TECHNIQUE 3 AND
;	   THEREFORE NO ACTION IS REQUIRED FROM US UNLESS THE REQUEST
;	   REQUIRING TECHNIQUE 3 IS TERMINATED (THE RECORD IS FREED)
;
;	5: SAME AS 4 EXCEPT ACCESS TO THIS RECORD WOULD NORMALLY
;	   REQUIRE TECHNIQUE 2
;
;	7: THIS RECORD IS FROM A RANDOM FILE AND HAS A KEY OF ZERO (0)
;	  WHICH MEANS THE WHOLE FILE MUST BE ENQUEUED EXCLUSIVE.
;	  NORMALLY A RANDOM FILE IS ENQUEUED SHARED, BUT AS LONG AS
;	  ANY RECORD IN THE FILE IS BEING RETAINED WITH A KEY OF 0,
;	  THE FILE MUST BE ENQUEUED EXCLUSIVE.




LRENQ8:	LDB	AT1,URSCON
	CAIE	AT1,147		;MAKE A LITTLE VALIDITY CHECK
	JRST	SU.ER2
	SETZM	0(ACRR)		;ZERO MISCELLANEOUS WORD IN THE
				;CURRENT ENTRY OF THE RETAINED RECORDS
				;TABLE

	LDB	AT1,URSFLG	;MOVE FLAGS FROM THE USER RECORD
				;SPECIFICATION TO THE RETAINED RECORDS
				;TABLE
	DPB	AT1,CRRFLG

IFN LSTATS,<
	TRNN	AT1,UNTFRD	;UNTIL FREED ?
	JRST	LREQMX		;NO, GIT
	MRHDCT	(MB.RTF,AT1)	;YES, INCREMENT METER BUCKET
LREQMX:>;

	HRRZ	AFT,0(AURS)	;SIMILARLY, MOVE FILE TABLE ADDRESS,
				;LEAVING IT IN AFT FOR FUTURE USE
	HRRM	AFT,0(ACRR)
	SETZM	1(ACRR)		;ZERO BLOCK NUMBER

	SETO	AT1,		;INITIALIZE THE DEFINITION OF
				;"RECORD 0" IN THE FILE TABLE OF THE
				;FILE CONTAINING THIS RECORD
	HRRM	AT1,F.WSMU(AFT)


	LDB	AT1,FTOWA	;GET FLAGS SPECIFIED WHEN THE FILE WAS
				;OPENED

	LDB	AT2,CRRFG4	;GET CORRESPONDING FLAGS FROM THIS
				;REQUEST

	SETCA	AT1,		;SET A BIT FOR EACH BIT THAT MUST BE
				;ZERO IN REQUEST
	TRNE	AT2,0(AT1)
	JRST	SU.ER3		;JUMP IF USER ATTEMPTING TO RETAIN
				;A RECORD FOR A FUNCTION NOT SPECIFIED
				;WHEN THE FILE WAS OPENED

	LDB	AT3,FTOTA	;GET OTHERS' FLAGS

	
	JUMPE	AT3,P1		;JUMP IF OTHERS ALLOWED NONE
	OR	AT3,AT2
	TRNE	AT3,777767
	JRST	P2		;JUMP IF EITHER WE OR OTHERS ARE
				;DOING SOMETHING BESIDES READING

	SETZ	AT3,		;SET QUEUEING TECHNIQUE TO 0 (NONE)
	JRST	P1

P2:	LDB	AT3,FTAM
	CAIE	AT3,INDEXD
	JRST	P4		;JUMP IF FILE NOT INDEXED
	TRNN	AT2,000003
	JRST	P5		;JUMP IF RETAIN NOT FOR "ANY" ,WRITE, OR
				;DELETE

	MOVEI	AT3,3		;WE HAVE DETERMINED THAT THE FILE IS
				;INDEXED AND AN INDEX MODIFYING FUNCTION
				;WILL BE EXECUTED - SET QUEUEING 
				;TECHNIQUE TO 3 (INDEX-EXCLUSIVE)
	JRST	P1

P4:
IFN ANS68,	TRNN	AT2,000002
IFN ANS74,	TRNN	AT2,000007	;REWRT,DEL IN ANS74 REQUIRES EXCLUSIVE
	JRST	P7		;JUMP IF NOT RETAINED FOR WRITE
				;(NOR READ-WRITE NOR "ANY")

P6:	MOVEI	AT3,2		;WE HAVE DETERMINED THAT THE FILE IS
				;NOT INDEXED BUT WRITING WILL OCCUR
				;IN A RECORD - SET QUEUEING TECHNIQUE
				;TO 2 (EXCLUSIVE)
	JRST	P1

P5:	TRNE	AT2,000004	;CHECK FOR REWRITE

	JRST	P6		;WE HAVE DETERMINED THAT THE FILE IS
				;INDEXED, THAT NO INDEX-MODIFYING
				;FUNCTION WILL BE EXECUTED, BUT THAT
				;AN INDIVIDUAL RECORD WILL BE MODIFIED
				;- JUMP TO P6 TO SET QT TO 2
P7:	TRNN	AT2,000010
	JRST	SU.ER4		;JUMP IF NOT RETAINED FOR READ
				;(INTERNAL ERROR)

	MOVEI	AT3,1		;SET QT TO 1 (SHARED)

P1:	DPB	AT3,CRRQT

;	AT THIS POINT IN THE FIRST LOOP WE HAVE COMPLETELY SET UP THE
;	RETAINED RECORDS TABLE ENTRY, EXCEPT FOR THE KEY AND THE
;	INCREMENT TO THE NEXT ENTRY, WHICH WE WILL NOW DO:


	LDB	AT3,FTAM
	CAIN	AT3,INDEXD
	JRST	Q1		;JUMP IF FILE INDEXED

Q3:	MOVEI	AT3,3		;SET SIZE OF THIS ENTRY IN THE RETAINED
				;RECORDS TABLE TO 3 WORDS
	JRST	Q9

Q1:
IFN ANS74,<
	MOVE	AT3,D.BL(AFT)	; Get buffer location
	SETZM	SVNXRT(AT3)	; Clear SAVNXT RETAIN save flag
>

	LDB	AT3,FTKT	;GET KEY TYPE

	CAIE	AT3,COMPLT	;CHECK IF COMP < OR = 10 DIGITS
	CAIN	AT3,COMP1	;LIKEWISE IF KEY COMP-1
	JRST	Q3		;IF SO, SET LENGTH OF ENTRY TO 3 WORDS

	CAIE	AT3,COMPGT	
	JRST	Q4
	MOVEI	AT3,4		;IF COMP > 10 DIGITS, ALLOW FOR 2 WORD
				;KEY, SETTING LENGTH OF ENTRY TO 4 WORDS

Q9:	DPB	AT3,CRRINE
	JRST	Q2

Q4:	LDB	AT1,FTRM	;MOVE INTO AT1 THE NUMBER OF BYTES PER
				;WORD, BASED ON RECORDING MODE
	MOVE	AT1,[OCT 4,6,0,5]-1(AT1)
	LDB	AT3,FTKLB	;MOVE INTO AT3 THE LENGTH OF THE KEY IN
				;BYTES
	SETZ	AT2,
	DIV	AT2,AT1		;COMPUTE NUMBER OF WORDS REQUIRED
				;TO STORE KEY
	SKIPE	AT3
	ADDI	AT2,1
	ADDI	AT2,2
	DPB	AT2,CRRINE	;SET LENGTH OF ENTRY TO N + 2 WORDS

Q2:	LDB	AT1,CRRFLG
	TRNN	AT1,000001
	JRST	R1		;JUMP IF KEY NOT SUPPLIED
	LDB	AT1,URSTYP
	CAIN	AT1,2
	JRST	R2		;JUMP IF KEY 1 WORD COMP

	CAIE	AT1,4		;SKIP IF KEY 1 WORD COMP-1
	JRST	R3

R2:	RESTRM
	MOVE	AT1,@1(AURS)	;MOVE 1 WORD KEY
	MOVEM	AT1,2(ACRR)
	JRST	R4

R3:	CAIE	AT1,11
	JRST	R5		;JUMP IF NOT A 2 WORD KEY

	RESTRM
	MOVE	AT1,@1(AURS)
	MOVEM	AT1,2(ACRR)
	MOVEI	AT1,@1(AURS)
	MOVE	AT1,1(AT1)
	MOVEM	AT1,3(ACRR)
	JRST	R4

R5:	CAIE	AT1,15
	JRST	SU.ER5		;JUMP IF INVALID TYPE CODE

	RESTRM
	MOVEI	AT1,@1(AURS)	;GET ADDRESS OF TWO WORD DESCRIPTOR
				;IN AT1

	HRRZ	AT2,1(AT1)	;GET SIZE FIELD FROM TWO WORD DESCRIPTOR
				;IN AT2
	LDB	AT3,FTKLB
	CAME	AT2,AT3
	JRST	SU.ER6		;JUMP IF USER SUPPLIED KEY HAS WRONG
				;SIZE

	MOVE	AT1,0(AT1)	;GET BYTE POINTER TO THE USER KEY IN AT1

	PUSHJ	PP,USRKEY	;[447] MOVE THE KEY
	JRST	R4

R1:
IFN ANS74,<
	LDB	AT3,URSNXT	;GET "NEXT RECORD" FLAG
	JUMPE	AT3,R1A		; JUMP IF NOT RETAINING "NEXT RECORD"
	DPB	AT3,RRTNXT	;SET BIT IN RETAINED RECORD TABLE
	SETZM	2(ACRR)		;SET KEY TO ZERO
	JRST	R4		; AND DON'T MOVE ANY KEY
R1A:	>;END IFN ANS74
	LDB	AT3,FTAM	;KEY IS IMPLIED
	CAIE	AT3,INDEXD
	JRST	R6
	MOVE	AT1,F.WBSK(AFT)	;IF FILE IS INDEXED, USE SYMBOLIC KEY
	LDB	AT2,FTKLB
	PUSHJ	PP,USRKEY	;[447]
	JRST	R4

R6:	HRRZ	AT2,F.RACK(AFT)	;IF FILE IS RANDOM, USE ACTUAL KEY
	SETZ	AT1,		;ASSUME SEQ,KEY=0
	CAIN	AT3,RANDOM
	MOVE	AT1,0(AT2)	;GET ACTUAL KEY FOR RANDOM CASE
	MOVEM	AT1,2(ACRR)	;SET KEY VALUE


;	AT THIS POINT WE'VE COMPLETED THE PROCESSING OF THE USER
;	RECORD SPECIFICATION UNDER CONSIDERATION, THAT'S TO BE
;	DONE IN THE FIRST LOOP.

R4:	LDB	AT2,CRRINE	;INCREMENT ACRR TO POINT TO THE
				;NEXT RETAINED RECORDS ENTRY
	LDB	AT1,CRRFLG	;INCREMENT AURS TO POINT TO THE
	ADD	ACRR,AT2
				;NEXT USER RECORD SPECIFICATION
	ADDI	AURS,1
	TRNE	AT1,000001
	ADDI	AURS,1
	SOJG	I,LRENQ8	;END OF FIRST LOOP? IF NOT, JUMP
;	SECOND LOOP.
;
;	TAKE THE NEXT STEP IN THE DETERMINATION OF THE DEFINITION
;	OF "RECORD 0", BY LOOKING FOR A SPECIAL CASE.
;
;	INSPECT ALL THE RECORD REQUESTS THAT HAVE BEEN TABULATED IN
;	THE RETAINED RECORDS TABLE. DETERMINE THE INDEXES WHICH NEED
;	TO BE ENQUEUED, IF ANY, AND ENQUEUE THEM. BE CAREFUL TO ENQUEUE
;	EACH REQUIRED INDEX ONLY ONCE. ADJUST THE QUEUEING TECHNIQUE OF
;	THOSE RECORD REQUESTS WHICH WOULD NORMALLY REQUIRE SHARED OR
;	EXCLUSIVE ACCESS TO A BLOCK, BUT DON'T, BECAUSE ANOTHER REQUEST
;	REQUIRES EXCLUSIVE ACCESS TO THE WHOLE INDEX (AND THEREFORE THE
;	WHOLE FILE).
;	ALSO CHECK FOR A RANDOM FILE HAVING A RECORD RETAINED WITH A KEY
;	OF 0. IF SUCH IS THE CASE, THE FILE MUST BE ENQUEUED ON EXCLUSIVE
;	SO THE 'NEXT RECORD' WILL NOT CHANGE BETWEEN RETAINING AND
;	READING OR WRITING. IF NO KEY OF 0 IS BEING RETAINED, ENQUEUE ON
;	THE FILE SHARED AND ON EACH INDIVIDUAL BLOCK ACCORDING TO THE
;	REQUESTED OPERATION.

LRENQ1:	MOVEM	ACRR,SU.CRH	;SAVE THE HIGHEST VALUE OF ACRR (WHICH
				;IS THE LENGTH OF THE RETAINED RECORDS
				;TABLE), SO WE KNOW WHEN TO LEAVE THE
				;SECOND, THIRD, AND FOURTH LOOPS.

	MOVEM	ACRR,SU.SVK	;INITIALIZE THE POINTER TO WHERE
				;WE CAN KEEP KEYS REPRESENTING
				;CURRENT POSITIONS OF INDEXED FILES

	MOVE	ACRR,SU.RRT	;START SECOND LOOP AT THE FIRST ENTRY

LRENQ4:	CAML	ACRR,SU.CRH	;END OF THE SECOND LOOP?

	JRST	LRENQ7		;YES, GO ENQUEUE INDEXES AND ENTER THIRD
				;LOOP

				;LOOK FOR A SPECIAL CASE IN
				;THE DETERMINATION OF "RECORD 0".
				;IF THE FILE IS NOT INDEXED AND
				;IF KEY IS ZERO, AND THE ENQUEUEING
				;FLAGS INDICATE THE USER INTENDS ONLY
				;TO WRITE THE RECORD, AND THE USER'S
				;PREVIOUS OPERATION ON THE FILE WAS A
				;READ, SET F.WSMU TO -2 (F.WSMU WAS 
				;INITIALIZED IN THE FIRST LOOP TO -1.
				;IN THE THIRD LOOP IT WILL BE ADDED TO
				;D.RP + 2 (CURRENT RECORD NUMBER + 2)
				;TO DETERMINE THE DEFINITION OF
				;"RECORD 0".
IFN ANS68,<
	SKIPE	2(ACRR)
	JRST	S19		;NOT RECORD 0 (NEXT RECORD)
>
IFN ANS74,<
	LDB	AT1,RRTNXT
	JUMPE	AT1,S19		;NOT RECORD 0 (NEXT RECORD)
>;END IFN ANS74
	HRRZ	AFT,0(ACRR)
	LDB	AT1,FTAM
	CAIN	AT1,INDEXD
	JRST	S19
	CAIN	AT1,RANDOM	;[455] IS THE FILE RANDOM?
	JRST	S20		;[455] YES
	LDB	AT1,CRRFG4
IFN ANS68,<
	TRNE	AT1,JSTWRT	;RETAIN WRITE ONLY?
>;
IFN ANS74,<
	TRNE	AT1,JSTRWT	;RETAIN REWRITE ONLY?
>
	JRST	S19		;NO
	HLRZ	AT1,D.BL(AFT)	;YES,ADDRESS BUFFER AREA
	SETO	AT2,		;WRITE LAST OPER. FLG
	HRREI	AT3,-2		;"KEY 0" VALUE TO GET LAST USED LOCATION
	CAME	AT2,LASTUU(AT1)	;LAST OPER. WRITE?
	HRRM	AT3,F.WSMU(AFT)	;NO, RESET TO (RE)WRITE REC JUST READ

S19:	LDB	AT1,CRRQT
	CAIE	AT1,3
	CAIN	AT1,7		;[455] RANDOM KEY OF 0?
	SKIPA	ACRR2,SU.RRT	;ENTER SUB-LOOP TO SEE IF A PRIOR 
				;REQUEST NEEDS EXCLUSIVE ACCESS TO THE SAME INDEX
	JRST	SS1		;[455] JUMP IF THIS REQUEST DOESN'T REQUIRE
				;[455] INDEX-EXCLUSIVE ACCESS OR RANDOM KEY OF 0
	
S4:	CAMN	ACRR2,ACRR	;END OF SUBLOOP?

	JRST	S5		;YES

	LDB	AT1,CRRQT2	;NO
	CAIE	AT1,3		;INDEX-EXCLUSIVE ACCESS?

	CAIN	AT1,7		;[455] RANDOM KEY OF 0?
	JRST	.+2		;[455] JUMP IF EITHER IS TRUE
	JRST	SS3		;NO

	HRRZ	AT1,0(ACRR2)	;YES
	HRRZ	AT2,0(ACRR)
	CAMN	AT1,AT2		;SAME FILE?

	JRST	SS2		;YES, JUMP OUT OF SUBLOOP (ANOTHER 
				;REQUEST HAS ALREADY ENQUEUED ON THE 
				;INDEX FOR THIS FILE)

SS3:	LDB	AT1,CRRIN2	;MOVE TO THE NEXT ENTRY
	ADD	ACRR2,AT1
	JRST	S4		;RETURN TO BEGINNING OF SUB-LOOP
;	IF WE REACH S5, NO OTHER REQUEST HAS ALREADY ENQUEUED ON THE
;	INDEX SO WE SHALL DO IT.

S5:	SETZ	AT1,		;SET LH = EXCLUSIVE, RH = ENQUEUE

	SETO	AT2,		;-1 MEANS INDEX

	PUSHJ	PP,QUEUE	;CREATE REQUEST ENTRY

	LDB	AT1,FTAM	;[455] GET FILE TYPE
	CAIE	AT1,RANDOM	;[455] IF IT IS A RANDOM FILE DON'T DO ZSATB
	PUSHJ	PP,ZSATB	;ASK CBLIO TO FORGET ABOUT ITS IN-CORE
				;STORAGE ALLOCATION TABLES, IF NECESSARY

	JRST	SS2		;MOVE ON TO THE NEXT ENTRY

SS1:	JUMPE	AT1,SS2		;JUMP IF NO QUEUEING (QT = 0)
	HRRZ	AFT,0(ACRR)
	LDB	AT2,FTAM
	CAIE	AT2,INDEXD
	CAIN	AT2,RANDOM	;[455]
	SKIPA	ACRR2,SU.RRT	;ENTER SUB-LOOP
	JRST	SS2		;JUMP IF FILE NOT INDEXED

;	HERE WE KNOW THAT THE FILE IS EITHER INDEXED OR RANDOM AND THAT THE QUEUEING
;	TECHNIQUE MUST BE EITHER SHARED OR EXCLUSIVE. THE PROBLEM IS
;	TO DETERMINE IF (A) A PRIOR REQUEST HAS REQUIRED SHARED ACCESS
;	TO THE INDEX OR (B) A REQUEST IN THE TABLE (NOT 
;	NECESSARILY PRIOR) WILL REQUIRE EXCLUSIVE ACCESS TO THE INDEX.
;	IF NEITHER IS TRUE, WE MUST GENERATE A SHARED REQUEST FOR THE 
;	INDEX; OTHERWISE, WE NEED DO NOTHING.

	SETZM	SU.Y		;SET Y TO 0

U1:	CAML	ACRR2,SU.CRH	;END OF SUB-LOOP?

	JRST	U2		;YES
	HRRZ	AT1,0(ACRR2)
	HRRZ	AT2,0(ACRR)
	CAME	AT1,AT2		;SAME FILE?

	JRST	U3		;NO, GO TO NEXT ENTRY
	LDB	AT2,FTAM	;[455] GET FILE TYPE
	CAIN	AT2,RANDOM	;[455] IS IT RANDOM
	JRST	S24		;[455] YES
	LDB	AT1,CRRQT2
	CAIN	AT1,3		;INDEX-EXCLUSIVE ACCESS?

	JRST	U4		;YES, GO TO UPDATE QT

U5:	CAML	ACRR2,ACRR	;[455] ARE WE LOOKING AT A PRIOR ENTRY?
	JRST	U3		;NO, GO TO THE NEXT ENTRY

	CAIE	AT1,1		;SHARED?
	CAIN	AT1,2		;OR EXCLUSIVE?
	SETOM	SU.Y		;YES, SET Y TO 1

U3:	LDB	AT1,CRRIN2	;INCREMENT ACRR2 TO POINT TO THE NEXT 
				;ENTRY
	ADD	ACRR2,AT1
	JRST	U1

U4:	LDB	AT1,CRRQT	;UPDATE QUEUEING TECHNIQUE TO INDICATE
				;THAT ANOTHER ENTRY HAS REQUESTED
				;EXCLUSIVE USE OF THE INDEX
	ADDI	AT1,3
	DPB	AT1,CRRQT
	JRST	SS2

U2:	SKIPE	SU.Y		;IF Y IS NON-ZERO, THEN A PRIOR
				;REQUEST HAS TAKEN CARE OF OUR INDEX
				;REQUIREMENT
	JRST	SS2
	HRLZI	AT1,000001	;OTHERWISE WE MUST SUBMIT A REQUEST FOR
				;SHARED ACCESS TO THE INDEX
	SETO	AT2,
	PUSHJ	PP,QUEUE

SS2:	LDB	AT1,CRRINE	;END OF THE SECOND LOOP

	ADD	ACRR,AT1	;POINT TO THE NEXT ENTRY IN THE RETAINED
				;RECORDS TABLE
	JRST	LRENQ4

S24:	LDB	AT1,CRRQT2	;[455]
	CAIN	AT1,7		;[455] RANDOM KEY OF 0?
	JRST	SS2		;[455] YES
	JRST	U5		;[455]

S20:	LDB	AT1,CRRFG4	;[455] GET RETAINED FOR FLAGS
	TRNN	AT1,15		;[455] ARE WE ONLY WRITING?
	JRST	S22		;[455] YES
	LDB	AT1,CRRQT	;[455] GET CURRENT QT
	JUMPE	AT1,S19		;[455] QT = 0, FORGET ALL THIS CRAP
S21:	MOVEI	AT1,7		;[455] NO, CHANGE CURRENT TO 7
	DPB	AT1,CRRQT	;[455]
	JRST	S19		;[455] BACK TO MAIN ROUTINE

S22:	SETZM	ACRR3		;[455] SET UP FOR SUB-LOOP
	MOVE	ACRR2,SU.RRT	;[455] START AT TOP OF RRT
S26:	CAML	ACRR2,ACRR	;[455] LOOK AT ALL PRIOR TO FIND JUST PRIOR
	JRST	S25		;[455] SEE IF THERE IS A PRIOR
	HRRZ	AT1,0(ACRR)	;[455]
	HRRZ	AT2,0(ACRR2)	;[455]
	CAMN	AT1,AT2		;[455] THIS ENTRY SAME AS MAJOR ENTRY
	MOVE	ACRR3,ACRR2	;[455] YES, SAVE FOR LATER
	LDB	AT1,CRRIN2	;[455] LOOK AT NEXT
	ADD	ACRR2,AT1	;[455]
	JRST	S26		;[455]

S25:	JUMPE	ACRR3,S23	;[455] JUMP IF NO PRIOR ENTRY IN TABLE
	LDB	AT1,[POINT 4,0(ACRR3),6] ;[455] GET PRIOR'S RETAINED FOR FLAG
	TRNE	AT1,RTTNRD		;[455] PRIOR WAS A READ ONLY?
	JRST	S21		;[455] NO
IFN ANS68,<			;[455] USE PRIOR KEY FOR THIS ENTRY SINCE
	SKIPN	AT1,2(ACRR3)	;[455] THIS ENTRY IS A WRITE AFTER READ,
	JRST	S21		;[455] UNLESS THE KEY FOR THE PRIOR ENTRY
>;END IFN ANS68			;[455] IS ALSO 0
IFN ANS74,<			;[455] PRIOR KEY IS ZERO
	LDB	AT1,RRTNX3	;GET "NEXT RECORD" FLAG
	JUMPN	AT1,S21		; PRIOR KEY WAS "NEXT RECORD"
	MOVE	AT1,2(ACRR3)	;NO, GET IT
>;END IFN ANS74
	MOVEM	AT1,2(ACRR)	;[455] USE PRIOR KEY
	JRST	S19		;[455] AND RESUME NORMAL PROCESSING

S23:	HLRZ	AT1,D.BL(AFT)	;[455] SINCE NO PRIOR ENTRY EXISTS
				;[455] IN THE TABLE, SEE WHAT THE LAST
				;[455] REAL IO OPERATION WAS FOR THIS FILE
	SETO	AT2,		;[455]
	CAME	AT2,LASTUU(AT1)	;[455] WAS THE LAST UUO A READ?
	SKIPN	AT1,D.RP(AFT)	;[455] YES, USE CURRENT REC # IF NON 0
	JRST	S21		;[455] CURRENT REC # IS 0
	MOVEM	AT1,2(ACRR)	;[455] USE CURRENT REC # FOR THIS ENTRY
				;[455] SINCE IT IS A READ AFTER WRITE
	JRST	S19		;[455] JOIN NORMAL PROCESSING
;	WE HAVE NOW DETERMINED THE QUEUEING REQUIREMENTS FOR INDEXES.
;	SO LET'S ASK ENQ/DEQ IF WE CAN HAVE THEM.

LRENQ7:	SETZ	AT1,		;INDICATE ENQ REQUEST
	PUSHJ	PP,ENQDEQ
	  TRNA			;CAN'T HAVE THEM OR SOMETHING'S WRONG

	JRST	LRENQ0		;NORMAL RETURN - GO TO THE THIRD LOOP

ABNORM:	HLLZ	AT1,0(AP)	;IS THERE AN UNAVAILABLE EXIT?

	JUMPE	AT1,SU.ER7	;NO, MUST BE AN UNEXPECTED ERROR

	AOS	0(PP)		;YES, ADJUST RETURN

	SETZM	SU.RR		;ZERO NUMBER OF RECORDS RETAINED

	RESTRM
	POPJ	PP,		;RETURN TO THE UNAVAILABLE STATEMENT
;	THIRD LOOP.
;
;	FINISH THE DETERMINATION OF THE DEFINITION OF "RECORD 0" FOR
;	EACH FILE FOR WHICH THE USER HAS SPECIFIED THAT RECORDS BE
;	RETAINED
;
;	NOW THAT WE'VE BUILT THE TABLE OF RECORDS TO BE RETAINED
;	(FIRST LOOP), AND GAINED ACCESS TO THE INDEXES WE REQUIRE
;	(SECOND LOOP), IT'S TIME TO DETERMINE WHICH BLOCKS TO WHICH
;	WE NEED TO GAIN ACCESS.
;
;	AT THIS TIME IN THE PROCESSING WE HAVE ALREADY ENQUEUED ON THE
;	INDEX OF AN ISAM FILE AND/OR ON THE ENTIRE FILE FOR A
;	RANDOM FILE. THIS GAURANTEES THAT FROM THIS POINT ON NO
;	CHANGES CAN BE MADE IN THE FILE BY OTHERS. THIS IS TRUE
;	REGARDLESS OF WHETHER WE ENQUEUED SHARED OR EXCLUSIVE.

LRENQ0:	MOVE	ACRR,SU.RRT	;START WITH THE FIRST ENTRY

	SETZM	SU.EQ		;ZERO NUMBER OF ENTRIES IN ENQ QUEUE


LRENQ9:	CAML	ACRR,SU.CRH	;END OF THE THIRD LOOP?

	JRST	LRENQ5		;YES, GO GENERATE FINAL ENQ REQUEST IN
				;THE FOURTH LOOP

				;IF THE FILE IS NOT INDEXED
	HRRZ	AFT,0(ACRR)	;DEFINE "RECORD 0" FOR THE FILE IN
				;WHICH THIS RECORD EXISTS, IF IT HAS
				;NOT ALREADY BEEN DEFINED (DUE TO THE
				;PROCESSING OF ANOTHER ENTRY SPECIFYING
				;ANOTHER RECORD IN THE SAME FILE).
	LDB	AT2,FTAM
	CAIE	AT2,INDEXD	;[455]
	CAIN	AT2,RANDOM	;[455]
	JRST	V5		;[455] IF FILE IS INDEXED, OR RANDOM
				;GO CALL BLKNUM TO GET BLOCK NUMBER
				;AND CHECK FOR LOW-VALUES, REGARDLESS
				;OF OTHER CONSIDERATIONS
	HRRE	AT1,F.WSMU(AFT)
	JUMPGE	AT1,V2		;JUMP IF "RECORD 0" ALREADY DEFINED

	ADD	AT1,D.RP(AFT)	;OTHERWISE RECORD 0 = F.WSMU + D.RP +2
	ADDI	AT1,2
	HRRM	AT1,F.WSMU(AFT)

V2:	MOVE	AT3,2(ACRR)	;[455] IF FILE IS SEQUENTIAL, THEN CONVERT
				;THE RELATIVE KEY TO AN ABSOLUTE KEY
				;BY ADDING THE DEFINITION OF
				;"RECORD 0"
	ADD	AT3,AT1
	MOVEM	AT3,2(ACRR)

	LDB	AT1,CRRQT
	SKIPE	AT1		;NO BLOCK REQUIRED IF FILE IS NOT INDEXED AND QT INDICATES
				;NO QUEUEING - GO TO END OF LOOP

V5:	PUSHJ	PP,BLKNUM	;OTHERWISE, GET BLOCK NUMBER

	LDB	AT1,CRRINE	;MOVE ON TO NEXT REQUEST
	ADD	ACRR,AT1
	JRST	LRENQ9
;	FOURTH AND FINAL LOOP.
;
;	GENERATE AN ENQUEUE REQUEST FOR EACH BLOCK THAT REQUIRES EITHER
;	SHARED OR EXCLUSIVE QUEUEING. MAKE SURE THAT EACH BLOCK IS
;	QUEUED ONLY ONCE. IF ONE REQUEST ASKS SHARED ACCESS AND ANOTHER
;	EXCLUSIVE, QUEUE FOR EXCLUSIVE.

LRENQ5:	MOVE	ACRR,SU.RRT	;START WITH THE FIRST ENTRY

LREN11:	CAML	ACRR,SU.CRH	;END OF THE FOURTH LOOP?

	JRST	LREN12		;YES, GO ON TO THE FINAL ACT

	MOVE	ACRR2,SU.RRT	;INITIALIZE FOR SUB-LOOP

	SETZM	SU.Y		;SET Y TO 0
	HRRZ	AFT,0(ACRR)	;[455]
	LDB	AT3,FTAM	;[455] GET FILE TYPE
	CAIE	AT3,RANDOM	;[455] RANDOM FILE?
IFN ANS68,<
	JRST	W3A		;[455] NO
>
IFN ANS74,<
	JRST	W3B		; No
>
	MOVE	AT2,D.CBN(AFT)	;[455] GET CURRENT REC #
	SETZM	SU.RND		;[455]
	SETZM	SU.RLV		;[455]
W9:	CAML	ACRR2,SU.CRH	;[455] FINISHED SUB-LOOP?
	JRST	W11		;[455] YES, MUST BE NO QT 7'S
	HRRZ	AT1,0(ACRR2)	;[455]
	CAME	AT1,AFT		;[455] SAME FILE?
	JRST	W10		;[455] NO
	SKIPN	SU.Y		;[455] IS THIS THE FIRST RRT ENTRY FOR THIS FILE?
	MOVEM	ACRR2,ACRR3	;[455] YES, SAVE ITS POSITION
	SETOM	SU.Y		;[455] SET FIRST ALREADY SEEN
	LDB	AT1,CRRBK2	;IS THIS AN ENTRY FOR THE CURRENT BLOCK?
	CAMN	AT1,AT2
	SETOM	SU.RND		;[455] YES, SET CURRENT BLOCK # SEEN
	LDB	AT1,CRRQT2	;[455]
	CAIN	AT1,7		;[455] IF ANY ENTRY FOR THIS FILE HAS
				;[455] A QT OF 7 THE WHOLE FILE WILL BE
				;[455] ENQ'D EXCLUSIVE SO NO NEED TO ENQ ANY
				;[455] BLOCKS AT THIS TIME
	SETOM	SU.RLV		;[455] SET RAND EXCLUSIVE SEEN FLAG
W10:	LDB	AT1,CRRIN2	;[455] THIS ONE ISN'T A 7 BUT
	ADD 	ACRR2,AT1	;[455] CHECK EM ALL
	JRST	W9		;[455]
W11:	SKIPL	SU.RLV		;[455] ANY RAND EXCLUSIVE SEEN?
	JRST	W13		;[455] NO, DO IT THE NORMAL WAY
	CAMGE	ACRR3,ACRR	;[455] HAVE WE ALREADY CHECKED THIS FILE
	JRST	W1		;[455] YES GO TO NEXT ONE
	LDB	AT1,CRRBK3	;[455] IS THE FIRST RRT FOR THIS FILE A 0 KEY 
	JUMPE	AT1,W12		;[455] YES DO A FORCR.
	SKIPGE	SU.RND		;[455] WAS THE CURRENT BLOCK # SEEN?
W12:	PUSHJ	PP,FF02		;[455] MAKE AN ENTRY IN SU.FBT
	JRST	W1		;[455] CHECK NEXT ENTRY
W13:	MOVE	ACRR2,SU.RRT	;[455] SET UP ACRR2
	SETZM	SU.Y		;[455] AND SU.Y
IFN ANS74,<
	JRST	W3A		; 

W3B:	CAIE	AT3,INDEXD	; Is file indexed?
	JRST	W3A		; No

	HLRZ	AT1,D.BL(AFT)	; Get buffer position
	SKIPN	AT3,SVNXRT(AT1)	; Is current SAVNXT been saved?
	JRST	W3C		; No, no need to restore it

	; Yes, reset RWDLKY to its old value, saved in RWDLRT at BN5 in BLKNUM
	;  at the same time reset RWDLRT to point at the RETAIN save area, for
	;  the next call to RETAIN code. 

	HRRM	AT3,D.RFLG(AFT)	; Reset extra flags
	SETZM	SVNXRT(AT1)	; Clear save flag field
	MOVE	AT2,RWDLRT(AT1)	; Get  retain save area address
	MOVE	AT3,RWDLKY(AT1)	; Get I-O level NNTRY and save area addr
	HRRZM	AT3,RWDLRT(AT1)	; Restore retain save area address
	MOVEM	AT2,RWDLKY(AT1)	; Restore I-O level del/rewrt save area pointer

W3C:	HRRZ	AT2,D.RFLG(AFT)	; Get savnxt flag
	TRNN	AT2,SAVNXT	; SAVNXT active at I-O level?
	JRST	W3A		; No, cont
	SETZM	CNTRY(AT1)	; Yes, clear fields so that saved position
	SETZM	NNTRY(AT1)	; Will be restored
>; END IFN ANS74
W3A:	LDB	AT1,CRRQT
W3:	CAIN	AT1,1		;QUEUEING TECHNIQUE IS SHARED?

	JRST	W2		;YES

	CAIE	AT1,2		;QUEUEING TECHNIQUE IS EXCLUSIVE?

	JRST	W1		;NO, LEAVE SUBLOOP AND MOVE ON TO THE
				;NEXT MAJOR ENTRY
	CAML	ACRR2,ACRR
	
	JRST	W5		;JUMP IF EXCLUSIVE AND NO PRIOR EXCLUSIVE

				;HERE IF EXCLUSIVE AND IT'S NOT KNOWN
				;YET IF THERE IS A PRIOR EXCLUSIVE
W4:	HRRZ	AT2,0(ACRR)
	HRRZ	AT3,0(ACRR2)
	CAME	AT2,AT3		;SAME FILE?

	JRST	W7		;NO, SO GET NEXT ENTRY
	LDB	AT2,CRRBLK
	LDB	AT3,CRRBK2	;SAME BLOCK?
	CAME	AT2,AT3

	JRST	W7		;NO, SO GET NEXT ENTRY
	LDB	AT2,CRRQT2
	CAIN	AT2,2		;EXCLUSIVE?

	JRST	W1		;YES, JUMP OUT OF SUB-LOOP AND MOVE
				;ON TO THE NEXT MAJOR ENTRY

	CAIE	AT2,1		;SHARED?

	JRST	W7		;NO, SO GET NEXT ENTRY

	CAMGE	ACRR2,ACRR	;A PRIOR ENTRY?

	SETOM	SU.Y		;YES, SET Y TO 1

W7:	LDB	AT2,CRRIN2	;GET NEXT ENTRY IN SUB-LOOP
	ADD	ACRR2,AT2
	JRST	W3

W2:	CAMGE	ACRR2,SU.CRH
	JRST	W4		;JUMP IF SHARED AND NOT ALL BLOCKS CHECKED
	SKIPE	SU.Y		;DOES Y = 1 (A PRIOR ENTRY HAS QUEUED
				;SHARED ON THIS BLOCK?)

	JRST	W1		;YES, MOVE ON TO THE NEXT MAJOR ENTRY

	HRLZI	AT1,1		;SET LH TO SHARED, RH TO ENQ

W8:	LDB	AT2,CRRBLK	;[455] GET BLOCK NUM (FOR FILFLU ROUTINE)
REPEAT 0,<
;THIS CODE HAS BEEN REMOVED (3/31/78) BECAUSE THE BUFFER FILLING
;WAS DONE BEFORE THE .IDA FILE BLOCKS HAD BEEN ENQ'D
;  FILFLU MUST BE CALLED TO MAKE CBLIO PRETEND IT HASN'T READ IN
;THAT DATA BLOCK YET.   IT WILL BE DONE AT THE "READ".

	HRRZ	AFT,0(ACRR)	;IF THIS IS AN INDEXED FILE, BUFFER
	LDB	AT3,FTAM	;FILLING WAS HANDLED IN THE THIRD
	LDB	AT4,FTOTA
	CAIE	AT3,INDEXD	;LOOP BY THE BLKNUM ROUTINE
	 JRST	W14

	TRNN	AT4,3
	TRNN	AT4,4
	 JRST	.+2
W14:
>;END OF REPEAT 0

	PUSHJ	PP,FILFLU	;CHECK TO SEE IF BUFFER WILL NEED
				;TO BE REFILLED

	PUSHJ	PP,QUEUE	;QUEUE REQUEST

W1:
IFN LSTATS,<
	LDB	AT1,CRRQT	;GET QT VALUE
	ADD	AT1,MRTDBP	;ADD IN TRAILER ADDRESS
	AOS	MB.RTN(AT1)	;INCREMENT PROPER RETAIN BUCKET
>
	LDB	AT2,CRRINE	;MOVE ON TO GET NEXT MAJOR ENTRY
	ADD	ACRR,AT2
	JRST	LREN11

W5:	SETZ	AT1,		;SET LH TO EXCLUSIVE, RH TO ENQ
	JRST	W8
;	THE FINAL ACT
;
;	CALL ENQ/DEQ TO QUEUE BLOCKS


LREN12:	SETZ	AT1,		;SET RH TO ENQUEUE

	PUSHJ	PP,ENQDEQ

	JRST	LREN99		;NOT AVAILABLE OR ERROR

	MOVEI	AT1,AT1
	HRLM	AT1,SU.FBT

LREN13:	RESTRM
	SOSGE	AT1,SU.CFB	;NORMAL RETURN. WE NOW HAVE DESIRED
				;ACCESS TO REQUESTED BLOCKS. ASK CBLIO
				;TO REFILL THE CURRENT BUFFER FOR
				;EACH FILE, IF, IN FACT, IT CONTAINS
				;ONE OF THE BLOCKS WE'VE JUST GAINED
				;ACCESS TO.

IFE LSTATS,<
	POPJ	PP,		;RETURN TO USER
>
IFN LSTATS,<
	JRST	LRENMR		;METER THEN EXIT
>
	MOVE	AP,@SU.FBT
	PUSHJ	PP,FORCR.
	JRST	LREN13
IFN LSTATS,<
LRENMR:	MOVE	AT1,MRTDBP	;GET TRAILER ADDRESS
	MOVEI	AT1,MB.SUT(AT1)	;GET ADDRESS TO RETAIN TIMING BUCKET
	MOVEM	AT1,MRTMB.	;SAVE TIMING ADDRESS
	MRTME.	(AT1)		; END RETAIN TIMING
	POPJ	PP,		;RETURN TO CBL PROGRAM
>;END IFN LSTATS
;	THE BLOCKS WEREN'T AVAILABLE, SO NOW WE HAVE TO DEQUEUE THE INDEXES!!!!


LREN99:	MOVE	ACRR,SU.RRT	;LOOK THROUGH THE RETAINED RECORDS TABLE

	SETZM	SU.DQ		;ZERO THE NUMBER OF ENTRIES IN THE DEQUEUE QUEUE

LREN95:	CAML	ACRR,SU.CRH
	JRST	LREN94		;JUMP IF END OF TABLE
	HRRZ	AFT,0(ACRR)
	LDB	AT1,FTAM
	CAIE	AT1,RANDOM	;[455] RANDOM FILE?
	CAIN	AT1,INDEXD	;[455] NO, INDEXED
	SKIPA	ACRR2,SU.RRT	;[455] YES, MUST BE EITHER RAND OR INDEX
				;SEE IF A PREVIOUS ENTRY INVOLVED THE SAME FILE
	JRST	LREN98		;[455] IGNORE ENTRY IF FILE NOT INDEXED, OR RANDOM

LREN96:	CAML	ACRR2,ACRR
	JRST	LREN97		;JUMP IF ALL PREVIOUS ENTRIES EXAMINED
	HRRZ	AT1,0(ACRR2)
	CAMN	AT1,AFT
	JRST	LREN98		;JUMP IF PREVIOUS ENTRY INVOLVED  SAME FILE

	LDB	AT1,CRRIN2	;OTHERWISE, EXAMINE ANOTHER PREVIOUS ENTRY
	ADD	ACRR2,AT1
	JRST	LREN96

LREN97:	MOVEI	AT1,1		;DEQUEUE THE INDEX
	SETO	AT2,
	PUSHJ	PP,QUEUE

LREN98:	LDB	AT1,CRRINE	;MOVE ON TO THE NEXT ENTRY
	ADD	ACRR,AT1
	JRST	LREN95

LREN94:	MOVEI	AT1,1
	MOVEI	AT2,1
	PUSHJ	PP,ENQDEQ	;ACTUALLY CALL ENQ/DEQ
	JRST	SU.ER7
	JRST	ABNORM
;	LRDEQ: LIBOL RECORD DEQUEUE - CALLED FOR EACH EXECUTION OF A FREE STATEMENT
;
;
;	LRDEQ EXPECTS TO FIND IN AC16 THE ADDRESS OF AN ARGUMENT LIST
;	STRUCTURED AS FOLLOWS:
;
;	WORD 1: RH = NUMBER OF RECORDS TO BE FREED (N)
;		LH = 0 => USER DID NOT SUPPLY A NOT RETAINED STATEMENT
;		LH = 1 => USER DID SUPPLY A NOT RETAINED STATEMENT
;
;	WORD 2: BITS 0-8: 152
;		BIT 9: FREE ALL RECORDS, IF SET
;		BIT 10: FREE ALL RECORDS IN THIS FILE, IF SET
;		BITS 11-13: NOT USED
;		BIT 14: USER SUPPLIED DATA NAME OR LITERAL, IF SET
;		BITS 15-17: NOT USED
;		RH = FILE TABLE LOCATION
;
;	WORDS 3,4,...,N: SAME AS SPECIFIED FOR LRENQ
;
;
;	THIS PROCEDURE SHARES ALL DATA STRUCTURES, SUBROUTINES AND
;	SYMBOLS WITH LRENQ.
;
;
;	THIS PROCEDURE ASSUMES THAT BUFFERS ARE NOT SHARED. SHOULD
;	THEY EVER BE SHARED, ONE SMALL CHANGE WILL BE NEEDED IN THE
;	ALGORITHM (SEE COMMENT IN THE CODE).
;
;	THIS PROCEDURE HAS A SECONDARY ENTRY POINT AT LRDEQX, FOR
;	USE IN CASE OF AUTOMATIC FREEING BY READ, REWRITE, WRITE,
;	AND DELETE. TO ENTER THIS PROCEDURE AT LRDEQX, SET THE F
;	BIT OF ALL RECORDS TO BE FREED IN THE RETAINED RECORDS TABLE
;	AND SIMPLY DO A PUSHJ PP, LRDEQX. NO PARAMETERS ARE
;	REQUIRED. LRDEQX RETURNS TO 0(PP).
LRDEQ.:	SAVE
	SKIPE	SU.RR		;ARE ANY RECORDS CURRENTLY RETAINED?

	JRST	A1		;YES, LET'S DIG DEEPER

	HLLZ	AT1,0(AP)	;IS THERE A NOT RETAINED EXIT?
	SKIPE	AT1
	AOS	0(PP)		;YES, ADJUST RETURN
	RESTRM

	POPJ	PP,		;RETURN TO USER

A1:	MRTMS.	(AT1)		;START METER TIMING
	SETZM	SU.CFB		;ZERO NUMBER OF ENTRIES IN THE FILL/
				;FLUSH BUFFER TABLE
	MOVE	AT1,1(AP)
	TLNN	AT1,FREALR	;FREE ALL RECORDS?

	JRST	A2		;NO
	MRHDCT	(MB.FEV,AT1)	;COUNT FREE EVERY REC METER POINT
	MOVE	I,SU.RR
	MOVE	ACRR,SU.RRT
	SETO	AT1,
A00:	DPB	AT1,CRRF	;SET FREE BIT IN EVERY ENTRY OF THE RETAINED RECORDS TABLE
	LDB	AT2,CRRINE
	ADD	ACRR,AT2
	SOJG	I,A00
	PUSHJ	PP,LRDEQX	;DEQUEUE EVERYTHING

	RESTRM
	POPJ	PP,

A2:	SETZM	SU.NR		;ZERO NOT RETAINED FLAG, WHICH WE
				;WILL SET SHOULD WE DISCOVER THE
				;USER ATTEMPTING TO FREE A RECORD HE HAS
				;NOT RETAINED

	MOVEI	AURS,1(AP)	;POINT AURS TO THE 1ST USER RECORD
				;SPECIFICATION

	HRRZ	K,0(AP)		;COUNT USER RECORD SPCEIFICATIONS WITH K

LRDEQ0:	LDB	AT1,URSCON	;MAKE A LITTLE VALIDITY CHECK
	CAIE	AT1,152
	JRST	SU.ER2

	MOVE	AT1,0(AURS)
	MOVSI	ACRR2,(JFCL)	;[550] SET UP FOR LATER KEY COMPARE
	TLNN	AT1,USRSKY	;USER SUPPLIED A KEY?

	JRST	A4		;NO

	MRHDCT	(MB.FRC,AT1)	;COUNT FREE REC METER POINT

	LDB	AT1,URSTYP	;YES, COMPILER HAS ALREADY CHECKED
				;THAT IT MATCHES THE KEY OF THE FILE, SO
				;WE CAN TURN OUR ATTENTION
				;TO BUILDING A BYTE POINTER TO IT.

	CAIN	AT1,2
	JRST	A5		;JUMP IF KEY 1 WORD COMP
	CAIE	AT1,4
	JRST	A6		;JUMP IF KEY NOT 1 WORD COMP-1

A5:	MOVEI	AT3,1		;SET KEY LENGTH IN BYTES IN AT3
	JRST	A7

A6:	CAIE	AT1,11
	JRST	A8		;JUMP IF NOT 2 WORD KEY

	MOVEI	AT3,2		;SET KEY LENGTH IN BYTES IN AT3

A7:	MOVE	AT2,1(AURS)	;GET ADDRESS FROM USER RECORD
				;SPECIFICATION

A12:	TLZ	AT2,777740	;ZERO P AND S FIELDS

	TLO	AT2,444400	;SET BYTE SIZE TO 36
				;WE NOW HAVE A BYTE POINTER TO THE KEY

;[550]	MOVSI	ACRR2,(JFCL)	;[447] SET UP FOR LATER KEY COMPARE
	HRRZ	AFT,0(AURS)	;IF FILE IS SEQUENTIAL, OR THE FILE
				;IS RANDOM AND THE KEY IS ZERO,
				;CONVERT THE RELATIVE KEY INTO AN
				;ABSOLUTE KEY BY ADDING THE DEFINITION
				;OF "RECORD 0" (F.WSMU). ADJUST AT2 TO
				;POINT TO THE ABSOLUTE KEY INSTEAD OF
				;THE RELATIVE KEY. NOTE: IF THE FILE
				;IS NOT INDEXED, THE KEY IS ALWAYS
				;ONE WORD COMP.
	LDB	AT1,FTAM
	CAIN	AT1,INDEXD
	JRST	A9
	SKIPN	AT4,0(AT2)
	JRST	A19
	CAIN	AT1,RANDOM
	JRST	A9

A19:	CAIN	AT1,RANDOM	;[455] RANDOM FILE?
	JRST	FRERLV		;[455] YES
	HRRZ	AT5,F.WSMU(AFT)	;[455]
	ADD	AT4,AT5
	MOVEM	AT4,SU.AK
	HRRI	AT2,SU.AK
	JRST	A9

FRERLV:
	MOVE	ACRR,SU.RRT	;[455] 'FREE' WITH KEY OF 0 WILL
				;[455] FREE FIRST RECORD IN RRT WITH
				;[455] A KEY OF 0 FOR THAT FILE
	CAML	ACRR,SU.CRH	;[455] LOOKED AT ALL RECORDS YET?
	JRST	B6M1		;[455] YES, NO 0 KEY EXISTS
	HRRZ	AT1,0(ACRR)	;[455]
	CAME	AT1,AFT		;[455] SAME FILE?
	JRST	FRELV1		;[455] NO
	LDB	AT1,CRRF	;[455] GET FREED FLAG
	JUMPN	AT1,FRELV1	;[455] ARE WE LOOKING AT AN ALREADY FREED REC
IFN ANS74,<			;(ASSUMING A KEY VALUE OF 0 WERE ALLOWED)
	LDB	AT1,RRTNXT	;IF "NEXT RECORD" WAS RETAINED,
	JUMPN	AT1,FRELV2	; THEN NO KEY WAS MOVED
	JRST	FRELV1		;NOT AN ENTRY FOR "NEXT RECORD"
>;END IFN ANS74

IFN ANS68,<
	SKIPE	2(ACRR)		;[455] IS THIS A 0 KEY?
	JRST	FRELV1		;[455] NO
>;END IFN ANS68
FRELV2:	SETO	AT1,		;[455]
	DPB	AT1,CRRF	;[455] TURN ON FREE FLAG
	JRST	B6		;[455] GO DO NEXT USER RECORD SPEC

FRELV1:	LDB	AT1,CRRINE	;[455]
	ADD	ACRR,AT1	;[455] LOOK AT NEXT ENTRY
	JRST	FRERLV+1	;[455]

A8:	CAIE	AT1,15
	JRST	SU.ER5		;JUMP IF INVALID TYPE CODE

;[532]	PUSH	PP,K
;[532]	RESTRM
	MOVEI	AT1,@1(AURS)	;GET ADDRESS OF 2 WORD DESCRIPTOR
				;IN AT1
;[532]	POP	PP,K

	HRRZ	AT3,1(AT1)	;GET SIZE FIELD FROM TWO WORD DESCRIPTOR
				;IN AT3
;[550]	MOVSI	ACRR2,(JFCL)	;[532] NO CONVERSION NECESSARY
	HRRZ	AFT,0(AURS)	;SET FILE TABLE ADDRESS IN AFT
	LDB	AT2,FTKLB
	CAME	AT2,AT3
	JRST	SU.ER6		;JUMP IF KEY SIZE INAPPROPRIATE; THE
				;COMPILER ALREADY CHECKED THIS, BUT
				;WHAT THE HELL.

	MOVE	AT2,0(AT1)	;GET BYTE POINTER TO USER SUPPLIED
				;KEY IN AT2
	JRST	A9

A4:
IFE LSTATS,<
	TLNE	AT1,FREFEV
	JRST	A9		;JUMP IF EVERY RECORD RETAINED FOR
>				;THIS FILE IS TO BE FREED
IFN LSTATS,<
	TLNN	AT1,FREFEV	;SKIP IF FREE EVERY REC FOR FILE
	JRST	LDQLST		;NOT EVERY REC, JUMP
	MRHDCT	(MB.FFE,AT1)	;COUNT METER POINT
	JRST	A9		;CONTINUE
LDQLST:>
	HRRZ	AFT,0(AURS)
	LDB	AT1,FTAM
	CAIE	AT1,INDEXD
	JRST	A11		;JUMP IF FILE NOT INDEXED

	PUSH	PP,ACRR2	;SAVE CONVERT INSTRUCTION
	PUSHJ	PP,CLVACI	;COMPARE KEY AGAINST LOW-VALUES AND
				;CONVERT, IF NECESSARY

	JRST	[POP	PP,(PP)		;THROW AWAY OLD CONVERT INSTR
		MOVE	ACRR2,D.RCNV(AFT) ;[447] DO FILE TABLE CONV
		PUSHJ	PP,CHGCNV	;[447] CHECK FOR SPECIAL CONV INSTRS.
		MOVE	AT2,SU.RBP	;[447] GET DATA-REC-KEY BYTE PTR
		JRST	A10]		;[534][447] RESUME
;[550]	MOVSI	ACRR2,(JFCL)		;[447] SET UP PHONY CONV INSTR.
	POP	PP,ACRR2		;RESTORE CONVERT INSTR
	MOVE	AT2,F.WBSK(AFT)	;BYTE POINTER TO SYMBOLIC KEY

A10:	LDB	AT3,FTKLB	;[534] GET KEY LENGTH IN AT3
	JRST	A9

A11:	MOVEI	AT3,1		;KEY SIZE IS 1 WHETHER RANDOM OR
				;SEQUENTIAL

	HRRZ	AT2,F.RACK(AFT)	;CREATE BYTE POINTER FROM THE 
				;ADDRESS OF THE ACTUAL KEY

	CAIE	AT1,RANDOM	;BUT ONLY IF IT'S A RANDOM FILE

	MOVEI	AT2,[0]		;IF IT'S A SEQUENTIAL FILE USE KEY
				;OF ZERO 
	JRST	A12
;	AT THIS POINT WE HAVE A BYTE POINTER TO THE KEY OF THE
;	RECORD TO BE FREED IN AT2, AND THE LENGTH OF THAT KEY IN AT3.
;	(EXCEPT IN THE CASE OF FILENAME - EVERY RECORD)
;
;	WE'LL NOW LOCATE THE ONE OR MORE RECORDS TO BE FREED IN THE
;	RETAINED RECORDS TABLE, AND SET THEIR F BITS.

A9:	MOVE	I,SU.RR		;COUNT THE ENTRIES IN THE RETAINED
				;RECORDS TABLE IN I

	SETZM	SU.Y		;ZERO FLAG Y. IN CASE OF THE FILENAME
				;EVERY RECORD OPTION, WE'LL SET IT TO
				;ONE IF WE FIND A MATCH ON FILENAME IN
				;THE RETAINED RECORDS TABLE

	MOVE	ACRR,SU.RRT	;POINT TO THE 1ST ENTRY IN THE 
				;RETAINED RECORDS TABLE

B1:	HRRZ	AT1,0(AURS)
	HRRZ	AT4,0(ACRR)
	CAME	AT1,AT4		;COMPARE FILES

	JRST	B3		;JUMP IF NOT THE RIGHT FILE
	MOVE	AT1,0(AURS)
	TLNN	AT1,000200	;EVERY RECORD OPTION?

	JRST	B4		;NO, JUMP

	SETOB	AT1,SU.Y	;YES, SET F BIT IN RETAINED RECORDS
				;TABLE SO AS TO FREE RECORD LATER,
				;AND ALSO SET Y FLAG TO INDICATE THAT
				;WE FOUND ONE
	DPB	AT1,CRRF

	JRST	B3		;CONTINUE TO LOOK FOR OTHER RECORDS
				;IN THE SAME FILE

B4:	MOVEM	AT3,SU.T3	;COMPARE KEYS

	MOVEM	AT2,SU.T2	;SAVE KEY POINTER AND LENGTH

	MOVE	AT1,AT2		;GET SIZE FIELD FROM BYTE POINTER

	TLZ	AT1,770077	;ISOLATE IT

	TLO	AT1,440000	;SET P TO 36

	HRRI	AT1,2(ACRR)	;SET ADDRESS TO KEY IN RETAINED RECORDS
				;TABLE

	SKIPE	SU.HV		;[447] FORCED HIGH VALUES IN USE?
	JRST	B8		;[447] YES
B5:	ILDB	AT5,AT2		;[447] USE AC 11 BECAUSE FILE TABLE
				;[447] CONV INSTR DOES

	XCT	ACRR2		;[447] CONVERT FROM EXT RECORDING MODE
				;[447] TO INTERNAL MODE IF NECESSARY
	ILDB	AT4,AT1		;[447] SWITCH AT4 FOR AT5
	CAME	AT4,AT5
	JRST	B7		;JUMP IF KEYS NOT EQUAL
	SOJG	AT3,B5
B9:	SETO	AT1,		;[447] SET F FIELD IN THE RETAINED RECORDS
				;TABLE
	DPB	AT1,CRRF	
	JRST	B6		;MOVE ON TO THE NEXT USER RECORD SPEC

B7:	MOVE	AT2,SU.T2	;RESTORE KEY POINTER AND COUNT
	MOVE	AT3,SU.T3

B3:	LDB	AT1,CRRINE	;POINT TO NEXT ENTRY IN THE
				;RETAINED RECORDS TABLE

	ADD	ACRR,AT1
	SOJG	I,B1

B2:	SKIPN	SU.Y		;SET NOT RETAINED FLAG IF NO SUCH
				;RECORD FOUND

B6M1:	SETOM	SU.NR
B6:	MOVE	AT1,0(AURS)
	SETZM	SU.HV		;[447] TURN OFF HIGH VALUES USED
	ADDI	AURS,1
	TLNE	AT1,000010
	ADDI	AURS,1
	SOJG	K,LRDEQ0

A3:	PUSHJ	PP,LRDEQX	;NOW CONSIDER THE IMPLICATIONS OF
				;DELETING THE FLAGGED RECORDS

	JRST	LRDEQC		;AND FINALLY, GO TO CLEANUP
B8:	LDB	AT5,AT2		;[447] GET THE HIGH VALUES CHARACTER
	ILDB	AT4,AT1		;[447] GET RRT KEY CHAR
	CAME	AT4,AT5		;[447] ARE THEY THE SAME
	JRST	B7		;[447] NO--CHECK NEXT RRT ENTRY
	SOJG	AT3,B8+1	;[447] YES--CHECK NEXT CHAR IN RRT
	JRST	B9		;[447] GOTCHA--JOIN COMMON CODE
;	ALL THE RECORDS IN THE RETAINED RECORDS TABLE TO BE FREED HAVE
;	NOW BEEN MARKED WITH SET F BITS. WE WILL NEXT CONSIDER THE
;	IMPLICATIONS OF FREEING THESE RECORDS, WHICH ARE AS FOLLOWS:
;
;		A. IF QUEUEING TECHNIQUE IS 0 (NO QUEUEING), OR 4 OR 5
;		   (COVERED BY ANOTHER RETAINED RECORD'S REQUIREMENT
;		   FOR EXCLUSIVE USE OF THE FILE), THEN THERE IS
;		   NO MORE WORK TO BE DONE.
;
;		B. IF QUEUEING TECHNIQUE IS 3 (INDEX-EXCLUSIVE), WE
;		   NEED TO CHECK IF THERE IS A CONTINUED NEED FOR
;		   EXCLUSIVE USE OF THE FILE (OR INDEX), AND IF NOT,
;		   EITHER FREE THE INDEX OR MODIFY ITS USAGE TO SHARED.
;		   THE LATTER COURSE WOULD BE TAKEN IF ANOTHER REQUEST
;		   FOR THE SAME FILE HAS QUEUEING TECHNIQUE OF 4 OR 5,
;		   AND IT WOULD ALSO BE NECESSARY IN THAT CASE TO 
;		   CHANGE THE QT TO 1 OR 2 AND ENQUEUE ON THE
;		   APPROPRIATE BLOCKS.
;
;		C. IF QUEUEING TECHNIQUE IS 2 (EXCLUSIVE), WE NEED TO CHECK IF 
;		   ANOTHER REQUEST HAS EITHER A SHARED OR EXCLUSIVE
;		   REQUIREMENT FOR THE SAME BLOCK, AND IF SO, REDUCE ITS USAGE
;		   TO SHARED OR LEAVE IT ENQUEUED EXCLUSIVE. OTHERWISE WE FREE IT.
;
;		D. IF QUEUEING TECHNIQUE IS 1 (SHARED), WE NEED TO CHECK
;		   IF ANOTHER REQUEST HAS A CONTINUING REQUIREMENT FOR
;		   THE BLOCK. IF SO, WE LEAVE IT ENQUEUED, OTHERWISE
;		   WE FREE IT.
;
;		E. IF QUEUEING TECHNIQUE IS 7 (RANDOM EXCLUSIVE), WE
;		  NEED TO CHECK IF ANOTHER RECORD FOR THIS FILE HAS A
;		  QT OF 7. IF THERE IS ANOTHER ONE, WE DO NOTHING, IF
;		  THERE ISN'T ANOTHER ONE, WE NEED TO MODIFY FILE
;		  ENQUEUEING TO SHARED. OBVIOUSLY, IF THERE ARE NO OTHER
;		  RECORDS IN THE RRT FOR THIS FILE AT ALL, THEN WE DEQUE
;		  THE FILE RESOURCE. ONCE THE FILE RESOURCE IS TAKEN
;		  CARE OF, THE PROCESSING IN STEPS C AND D ABOVE NEED TO
;		  BE DONE FOR THE DISK BLOCK.
;
;
;	AS WE GO, WE'LL PREPARE THREE LISTS OF ENQ/DEQ REQUESTS:
;	ENQUEUE, DEQUEUE, AND MODIFY LISTS.
;
;	AS WE FREE A RECORD WE'LL LEAVE ITS F BIT SET AND ALSO
;	SET ITS FILE TABLE ADDRESS TO ZERO.
;
;	LRDEQX IS THE SECONDARY ENTRY POINT USED BY READ, REWRITE,
;	WRITE, AND DELETE WHEN AUTOMATICALLY FREEING RECORDS.
;	(SEE COMMENTS ABOVE)
LRDEQX:	SETZM	SU.EQ		;INITIALIZE NUMBER OF ENTRIES IN EACH
				;OF THE ENQ/DEQ TABLES
	SETZM	SU.CFB		;[437] CLEAR FILL/FLUSH BUFFER
	SETZM	SU.DQ
	SETZM	SU.MQ
	SETZM	SU.MRR		;ZERO THE "MORE RETAINED RECORDS" FLAG

	MOVEM	PP,20(PP)	;SAVE ALL REGISTERS
	MOVEM	AP,17(PP)
	MOVE	AP,PP
	MOVEI	PP,1(PP)
	BLT	PP,16(AP)
	MOVE	PP,20(AP)
	MOVE	AP,17(PP)
	ADD	PP,[20,,20]

	MOVE	I,SU.RR
	MOVE	ACRR,SU.RRT

C1:	HRRZ	AFT,0(ACRR)
	JUMPE	AFT,C3		;JUMP IF RECORD FREED BY
				;PREVIOUS FREE STATEMENT (IF SO,
				;FILE TABLE POINTER = 0)
	LDB	AT1,CRRF
	JUMPE	AT1,C4		;JUMP IF RECORD NOT TO BE FREED (F = 0)
	LDB	AT1,CRRQT
	JUMPE	AT1,C5		;JUMP IF QT = 0 (NO QUEUEING)
	CAIG	AT1,5		;[455]
	CAIGE	AT1,4
	JRST	C6		;[455] JUMP IF QT NOT 4 OR 5 OR 7

C5:	SETZ	AT1,		;ZERO FILE TABLE POINTER TO INDICATE
				;RECORD FREED
	HRRM	AT1,0(ACRR)
	JRST	C3

C4:	SETOM	SU.MRR		;SET FLAG INDICATING THAT AT LEAST
				;ONE RETAINED RECORD REMAINS
	JRST	C3

C6:	MOVE	J,SU.RR		;SET J, ACRR2, AND BOOLEAN VARIABLES IN PREPARATION FOR
				;SUB-LOOP
	MOVE	ACRR2,SU.RRT
	SETZM	SU.SBD
	SETZM	SU.SFQ
	SETZM	SU.SFS
	SETZM	SU.SBS

	SETZM	SU.RLV		;[455]
	SETZM	SU.RND		;[455]
C7:	CAMN	ACRR,ACRR2	;I = J?

	JRST	C9		;YES, JUMP TO END OF SUB-LOOP

	HRRZ	AT1,0(ACRR)	;SAME FILE (AND J NOT ALREADY FREED)?
	HRRZ	AT2,0(ACRR2)
	CAME	AT1,AT2
	JRST	C9		;NO, JUMP TO END OF SUB-LOOP

	SETOM	SU.SFQ		;YES, SET SAME FILE FLAG
	LDB	AT1,CRRQT
	LDB	AT2,CRRQT2
	CAMN	AT1,AT2		;SAME QUEUEING TECHNIQUE?

	SETOM	SU.SFS		;YES, SET SAME FILE, SAME QT FLAG

	CAIN	AT2,7		;[455] ANY OTHER ENTRYS FOR THIS FILE EXCLUSIVELY
	SETOM	SU.RLV		;[455] YES, REMEMBER IT
	LDB	AT3,CRRBLK
	LDB	AT4,CRRBK2
	CAME	AT3,AT4		;SAME BLOCK?

	JRST	C9		;NO, JUMP TO END OF SUB-LOOP

	CAMN	AT1,AT2		;SAME QUEUEING TECHNIQUE?
	JRST	C10
	SETOM	SU.SBD		;NO, SET SAME BLOCK, DIFFERENT QT FLAG
	JRST	C9

C10:	SETOM	SU.SBS		;YES, SET SAME BLOCK, SAME QT FLAG

C9:	LDB	AT1,CRRIN2	;INCREMENT J
	ADD	ACRR2,AT1
	SOJG	J,C7

	LDB	AT1,CRRQT
	CAIE	AT1,3		;QT = 3 (INDEX-EXCLUSIVE)?

	JRST	C11		;NO, JUMP

	SKIPE	SU.SFS		;YES, ANOTHER ENTRY HAS SAME QT?

	JRST	C5		;YES!, WE DON'T NEED TO DO ANYTHING.

	SKIPE	SU.SFQ		;NO, ANOTHER ENTRY FOR THE SAME FILE?

	JRST	C17		;YES, JUMP

C16:	MOVEI	AT1,1		;NO, DEQUEUE INDEX
	SETO	AT2,		;SET AT2 TO SPECIAL BLOCK NUMBER
				;INDICATING INDEX

C14:	PUSHJ	PP,QUEUE
	JRST	C5

C11:	HRRZ	AFT,0(ACRR)	;[455]
	LDB	AT2,FTAM	;[455] CHECK FILE TYPE
	CAIE	AT2,RANDOM	;[455] IS IT A RANDOM FILE?
	JRST	C11A		;[455] NO
	SETOM	SU.RND		;[455] YES, REMEMBER IT
	SKIPE	SU.RLV		;[455] IS THERE A RANDOM EXCLUSIVE ENTRY
	JRST	C5		;[455] YES, DO NOTHING ELSE
	CAIE	AT1,7		;[455] IS THIS ENTRY A RANDOM EXCLUSIVE?
	JRST	C11A		;[455] NO, DO IT NORMAL
	HLRZ	AT4,D.BL(AFT)	;[455] SEE IF THERE IS ANY LIVE DATA IN
	SETO	AT5,		;[455] THE CURRENT BUFFER. IF THERE IS,
	CAMN	AT5,LIVDAT(AT4)	;[455] SET AN ENTRY IN SU.FBT SO A FORCW.
	PUSHJ	PP,FF02		;[455] HAPPENS
	SKIPE	SU.SFQ		;[455] YES, ANY OTHER ENTRIES FOR THIS FILE
	JRST	C17		;[455] YES, ENQ PROPER BLOCKS, AND CHANGE
				;[455] FILE ENQ TO SHARED
	JRST	C16		;[455] NO, DEQ FILE AND FREE THIS ENTRY

C11A:	CAIE	AT1,2		;[455] QT = 2 (EXCLUSIVE)?
	JRST	C12		;NO, JUMP

	SKIPE	SU.SBS		;YES, ANOTHER REQUEST IS USING THE
				;SAME BLOCK THE SAME WAY?

	JRST	C5		;YES! DO NOTHING.

	SKIPE	SU.SBD		;NO, ANOTHER REQUEST IS USING
				;THE SAME BLOCK DIFFERENTLY (I.E.,
				;IN SHARED MODE)?

	JRST	C11B		;YES,SKIP AHEAD

	SETZ	AT1,		;NO, INDICATE EXCLUSIVE DEQ

	JRST	C13		; DEQUEUE BLOCK

C11B:	MOVE	AT1,[1,,2]	; SET AT1 TO INDICATE "MODIFY"

	LDB	AT2,CRRBLK	;SET BLOCK NUMBER IN AT2

	PUSHJ	PP,FILFL2	;CHECK TO SEE IF BUFFER NEEDS TO BE
				;WRITTEN ON DISC

	JRST	C14		;MODIFY ACCESS TO SHARED

C12:	SKIPN	SU.SBD		;(QT = 1, SHARED)
	SKIPE	SU.SBS
	JRST	C5		;JUMP IF ANOTHER REQUEST IS USING
				;THE SAME BLOCK, EITHER EXCLUSIVELY
				;OR SHARED
	HRLI	AT1,1		;INDICATE SHARED DEQ

C13:	HRRI	AT1,1
	LDB	AT2,CRRBLK
	PUSHJ	PP,FILFL2	;CHECK TO SEE IF BUFFER NEEDS TO BE
				;WRITTEN ON DISC

	PUSHJ	PP,QUEUE	;DEQUEUE BLOCK

	SKIPE	SU.SFQ		;ANOTHER REQUEST FOR THE SAME FILE?

	JRST	C5		;YES, WE'RE ALL DONE

C15:	HRRZ	AFT,0(ACRR)	;NO, IS FILE INDEXED OR RANDOM?

	LDB	AT1,FTAM
	CAIN	AT1,SEQFIL##	;[455] IF IT'S A SEQUENTIAL FILE, IT CAN'T
				;[455] BE INDEXED OR RANDOM
	JRST	C5		;IT'S SEQUENTIAL
	MOVEI	AT1,12		;CHECK FOR CLOSE VERB
	CAMN	AT1,SU.VRB	; is it
	JRST	C16		; yes, no need to reset position
				;  GO DEQUEUE INDEX (RANDOM AND IDX)

	CAIE	AT1,RANDOM	;[455] IS IT RANDOM OR INDEXED
	PUSHJ	PP,RESTOR	;INDEXED, RESTORE CURRENT RECORD POINTER,
				;IF NECESSARY
	JRST	C16		;GO DEQUEUE INDEX (RANDOM AND IDX)

C17:	MOVE	AT1,[1,,2]		;CHANGE USAGE OF INDEX TO SHARED
	SETO	AT2,
	PUSHJ	PP,QUEUE
;	AT THIS POINT(WE'RE LOOKING AT AN ENTRY WHICH HAS THE
;	ENTIRE INDEX LOCKED, BUT WHICH WE'RE GOING TO FREE),
;	WE NEED TO LOCATE THOSE ENTRIES WHICH HAVE PREVIOUSLY BEEN
;	COVERED BY THIS ENTRY (QT = 4 OR 5), CHANGE THEIR QUEUEING
;	TECHNIQUE TO 1 OR 2 (SHARED OR EXCLUSIVE), AND QUEUE ON THE
;	INDIVIDUAL BLOCKS. THIS WILL REQUIRE A SUB-LOOP AND A
;	SUB-SUB-LOOP.

	MOVE	J,SU.RR		;INITIALIZE FOR SUB-LOOP
	MOVE	ACRR2,SU.RRT
	SKIPE	SU.RND		;[455] IS THIS A RANDOM FILE?
	JRST	E1		;[455] YES

D1:	CAMN	ACRR,ACRR2	;I = J?

	JRST	D2		;YES, GO TO END OF SUB-LOOP
	HRRZ	AT2,0(ACRR2)
	HRRZ	AT1,0(ACRR)
	CAME	AT1,AT2		;SAME FILE (AND J NOT ALREADY FREED)?

	JRST	D2		;NO, GO TO END OF SUB-LOOP

				;AT THIS POINT, QT(J) MUST BE EITHER
				;4 OR 5. IF IT WERE 0,1,2 OR 3 WE
				;WOULDN'T BE HERE.
				;
				;IT CAN'T BE 3, BECAUSE SU.SFS (SAME
				;FILE, SAME QUEUEING) WOULD HAVE BEEN 
				;SET, AND WE WOULDN'T BE HERE (SEE LABEL
				;C8 ABOVE). IT CAN'T BE 1 OR 2, SINCE
				;A VALUE OF 1 OR 2 WOULD NOT HAVE BEEN
				;ASSIGNED INITIALLY BECAUSE QT(I) 
				; = 3, AND FURTHERMORE A CHANGE FROM 4 
				;OR 5 TO 1 OR 2 COULD HAVE ONLY
				;BEEN MADE BY THIS CODE, WHICH COULD NOT
				;HAVE HAPPENED BECAUSE FOR ANY L < I,
				;THE FACT THAT QT(I) = 3 WOULD HAVE SET
				;SU.SFS, AND WE WOULDN'T HAVE COME HERE.
				;FINALLY, IT CAN'T BE ZERO BECAUSE QT(I)
				; IS NOT ZERO AND SU.RR IS NOT ONE.
	LDB	AT3,CRRQT2
	SUBI	AT3,3
	DPB	AT3,CRRQT2	;CHANGE QT TO 1 OR 2

	MOVE	K,SU.RR		;INITIALIZE FOR SUB-LOOP
	MOVE	ACRR3,SU.RRT

D3:	CAMN	ACRR2,ACRR3	;K = J?

	JRST	D5		;YES, JUMP
	HRRZ	AT1,0(ACRR2)
	HRRZ	AT2,0(ACRR3)
	CAME	AT1,AT2		;SAME FILE (AND K NOT ALREADY FREED)?

	JRST	D5		;NO, JUMP
	LDB	AT3,CRRBK2
	LDB	AT1,CRRBK3	;SAME BLOCK?
	CAME	AT1,AT3

	JRST	D5		;NO, JUMP
	LDB	AT1,CRRQT3
	CAIN	AT1,1		;QT(K) = SHARED (1)?

	JRST	D7		;YES, JUMP

	CAIN	AT1,2		;QT(K) = 2 (EXCLUSIVE)?
	JRST	D2		;YES, JUMP OUT OF SUB-SUB-LOOP TO
				;END OF SUB-LOOP. WE DON'T NEED TO
				;DO ANYTHING BECAUSE ANOTHER
				;REQUEST HAS ALREADY QUEUED THE 
				;BLOCK EXCLUSIVE

	CAIN	AT1,5		;QT(K) = 5?

	JRST	D4		;YES, JUMP

	LDB	AT1,CRRQT2	;QT(K) = 4, BY DEFAULT

	CAIE	AT1,1		;QT(J) = SHARED?

	JRST	D10		;NO, IT MUST BE EXCLUSIVE. NO NEED TO GO
				;ANY FURTHER BECAUSE THERE IS NO CHANCE
				;OF FINDING A 2 AFTER A 4

	JRST	D5		;YES, WE MIGHT STILL FIND A 5, SO
				;KEEP LOOKING


D7:	LDB	AT1,CRRQT2
	CAIN	AT1,1		;QT(J) = 1 (SHARED)?

	JRST	D2		;YES, NO NEED TO GO ANY FURTHER
				;BECAUSE REQUEST(K) WILL CAUSE
				;BLOCK TO BE QUEUED. JUMP
				;OUT OF SUB-SUB-LOOP TO END OF SUB-LOOP
	JRST	D5

D4:	LDB	AT1,CRRQT2
	CAIE	AT1,2		;QT(J) = 2 (EXCLUSIVE)?

	JRST	D2		;NO, JUMP OUT OF SUB-SUB-LOOP TO END
				;OF SUB-LOOP. NO NEED TO GO ON BECAUSE
				;REQUEST(K) WILL CAUSE BLOCK TO BE
				;QUEUED


D10:	SETZ	AT1,		;QUEUE THE BLOCK EXCLUSIVE, SINCE
				;NO CHANCE OF FINDING A 2
D9:	HRRZ	AT2,1(ACRR2)
	EXCH	ACRR2,ACRR
	PUSHJ	PP,QUEUE
	EXCH	ACRR2,ACRR
	JRST	D2


D5:	LDB	AT1,CRRIN3
	ADD	ACRR3,AT1
	SOJG	K,D3

D8:	LDB	AT1,CRRQT2	;QT(J) = SHARED?
	CAIE	AT1,1
	JRST	D10		;NO, QUEUE BLOCK EXCLUSIVE
	HRLZI	AT1,1
	JRST	D9		;YES, QUEUE BLOCK SHARED

D2:	LDB	AT1,CRRIN2	;INCREMENT J
	ADD	ACRR2,AT1
	SOJG	J,D1
	JRST	C5
E1:	CAMN	ACRR,ACRR2	;[455] I = J ?
	JRST	E2		;[455] YES, GET NEXT J
	HRRZ	AT2,0(ACRR2)	;[455] NO
	HRRZ	AT1,0(ACRR)	;[455]
	CAME	AT1,AT2		;[455] J SAME FILE AS I ?
	JRST	E2		;[455] NO, GET NEXT J
	MOVE	ACRR3,SU.RRT	;[455] SET UP K FOR SUB-SUB-LOOP
	SETZM	SU.Y		;[455] SET TO -1 IF A PRIOR BLOCK HAS
				;[455] ENQ'D SHARED ON A BLOCK
E9:	CAME	ACRR3,ACRR	;[455] K = I ?
	CAMN	ACRR3,ACRR2	;[455] NO, K = J ?
	JRST	E5		;[455] YES, GET NEXT K IN EITHER CASE
	LDB	AT1,CRRQT2	;[455] NO, CHECK J'S QUEUING TECHNIQUE
	CAIN	AT1,1		;[455] J SHARED?
	JRST	E3		;[455] YES
	CAIE	AT1,2		;[455] NO, J EXCLUSIVE?
	JRST	E2		;[455] NO
	CAMGE	ACRR3,ACRR2	;[455] YES, CHECKED ALL PRIOR TO J YET?
	JRST	E6		;[455] NO, JUMP IF J IS EXCLUSIVE AND WE
				;[455] DO NOT KNOW YET IF THERE IS A
				;[455] PRIOR EXCLUSIVE
	JRST	E7		;[455] YES, JUMP IF J IS EXCLUSIVE AND WE
				;[455] KNOW THERE IS NO PRIOR EXCLUSIVE
E3:	CAML	ACRR3,SU.CRH	;[455] HAVE WE CHECKED ALL K'S?
	JRST	E8		;[455] YES, JUMP IF J IS SHARED AND WE
				;[455] HAVE CHECKED ALL PRIOR ENTRIES
E6:	HRRZ	AT2,0(ACRR2)	;[455]
	HRRZ	AT3,0(ACRR3)	;[455]
	CAME	AT2,AT3		;[455] J AND K SAME FILE?
	JRST	E5		;[455] NO, GET ANOTHER K
	LDB	AT2,CRRBK2
	LDB	AT1,CRRBK3	;J AND K SAME DISK BLOCK?
	CAME	AT1,AT2
	JRST	E5		;[455] NO, GET ANOTHER K
	LDB	AT3,CRRQT3	;[455]
	CAIN	AT3,2		;[455] K EXCLUSIVE?
	JRST	E2		;[455] YES, GET ANOTHER J
	CAIE	AT3,1		;[455] NO, K SHARED?
	JRST	E5		;[455] NO, GET ANOTHER K
	CAMGE	ACRR3,ACRR2	;[455] YES, IS K PRIOR TO J?
	SETOM	SU.Y		;[455] YES, SET PRIOR SHARED FLAG
E5:	LDB	AT3,CRRIN3	;[455] GET NEXT K
	ADD	ACRR3,AT3	;[455]
	JRST	E9		;[455]
E8:	SKIPE	SU.Y		;[455] IF Y NOT 0, A PRIOR ENTRY HAS
				;[455] ALREADY ENQ'D SHARED ON THIS BLOCK
	JRST	E2		;[455] SO GET ANOTHER J
	HRLZI	AT1,1		;[455] SET UP FOR SHARED ENQ
E10:	LDB	AT2,CRRBK2	;[455] GET BLOCK NUMBER TO BE ENQ'D
	PUSHJ	PP,QUEUE	;[455] ADD TO ENQ TABLE
E2:	LDB	AT2,CRRIN2	;[455] GET NEXT J
	ADD	ACRR2,AT2	;[455]
	SOJG	J,E1		;[455] CHECK ALL J'S
	JRST	C5		;[455] FREE I AND GET ANOTHER I
E7:	SETZ	AT1,		;[455] SET UP FOR EXCLUSIVE ENQ
	JRST	E10		;[455] ADD IT TO ENQ TABLE

C3:	LDB	AT1,CRRINE
	ADD	ACRR,AT1
	SOJG	I,C1
;	OUR RESEARCH IS NOW COMPLETE. WE NEED ONLY FLUSH BUFFERS AND CALL ENQ/DEQ


	MOVEI	AT1,AT1
	HRLM	AT1,SU.FBT

C2:	SOSGE	AT1,SU.CFB	;ANY BUFFERS TO BE FLUSHED?
	JRST	C20		;NO, GO ENQUEUE, ETC.
	MOVE	AP,@SU.FBT	;YES
	PUSHJ	PP,FORCW.
	JRST	C2

C20:	SETZ	AT1,		;FIRST WE ENQUEUE WHAT WE NEED
	MOVEI	AP,[0]		;[443] INSURE AP WILL CAUSE BLOCKING
	PUSHJ	PP,ENQDEQ
	JRST	SU.ERD
	MOVEI	AT1,2		;THEN WE RELAX WHAT CAN BE RELAXED
	PUSHJ	PP,ENQDEQ
	JRST	SU.ERD
	MOVEI	AT1,1		;AND FINALLY WE DEQUEUE WHAT WE DON'T
				;NEED
	PUSHJ	PP,ENQDEQ
	JRST	SU.ERD
	SKIPN	SU.MRR		;IF NO MORE RETAINED RECORDS, THEN
				;SET RR TO ZERO
	SETZM	SU.RR

	HRLZI	PP,-17(PP)	;RESTORE ALL REGISTERS
	BLT	PP,17

	POPJ	PP,		;RETURN TO THE (INTERNAL) CALLER
;	FINAL CLEAN UP AND EXIT TO THE FREE STATEMENT


LRDEQC:	RESTRM

IFN LSTATS,<
	MOVE	AT1,MRTDBP	;GET TRAILER BASE ADDRESS
	MOVEI	AT1,MB.FRT(AT1)	;ADD FREE TIME BUCKET OFFSET
	MOVEM	AT1,MRTMB.	;SAVE TIME BUCKET ADDRESS
	MRTME.	(AT1)		;END METER TIMING
>
	HLRZ	AT1,0(AP)	;DID USER SUPPLY A NOT RETAINED
				;STATEMENT?
	JUMPE	AT1,RET.1	;NO, RETURN TO FREE STATEMENT

	MRHDCT	(MB.FNR,AT1)	;COUNT FREE NOT RETAINED BUCKET

	SKIPE	SU.NR		;YES, ANY RECORD NOT RETAINED?

	AOS	0(PP)		;YES, ADJUST RETURN ADDRESS

	POPJ	PP,		;RETURN TO FREE STATEMENT
;	LFENQ: LIBOL FILE ENQUEUE
;
;
;	THIS PROCEDURE IS CALLED ONCE BY THE COBOL OBJECT PROGRAM FOR
;	THE EXECUTION OF EACH OPEN STATEMENT THAT CONTAINS SIMULTANEOUS
;	UPDATE PARAMETERS.
;
;
;	LFENQ EXPECTS TO FIND IN AC16 THE ADDRESS OF AN
;	ARGUMENT LIST, STRUCTURED AS FOLLOWS:
;
;		WORD 1: RH = NUMBER OF FILES TO BE OPENED FOR 
;			     SIMULTANEOUS UPDATE
;			LH = 0 => USER DID NOT SUPPLY AN UNAVAILABLE
;				  STATEMENT
;			LH = 1 => USER SUPPLIED AN UNAVAILABLE STATEMENT
;
;
;			NOTE: IF THE USER SUPPLIED AN UNAVAILABLE 
;			      STATEMENT, THIS PROCEDURE RETURNS TO 1(PP)
;			      IF THE FILE(S) ARE AVAILABLE UNDER THE
;			      CONDITIONS SPECIFIED, AND RETURNS TO 0(PP)
;			      IF THEY ARE NOT. THIS IS EXACTLY THE
;			      OPPOSITE OF THE CONVENTION USED BY LRENQ
;			      AND LRDEQ (TO SEE WHY, TAKE A LOOK AT THE
;			      CODE GENERATED BY OPEN, RETAIN, AND FREE).
;
;
;		WORDS 2 - N + 1:
;			BITS 0 - 8: 143
;			BIT 9: SET IF FILE IS BEING OPENED FOR REWRITE
;			BIT 10: FOR WRITE
;			BIT 11: FOR DELETE
;			BIT 12: SET IF OTHERS ARE ALLOWED TO READ
;			BIT 13: OTHERS ARE ALLOWED TO REWRITE
;			BIT 14: OTHERS ARE ALLOWED TO WRITE
;			BIT 15: OTHERS ARE ALLOWED TO DELETE
;
;			NOTE: IT IS ALWAYS ASSUMED THAT THE FILE IS
;			      BEING OPENED FOR READ.
;
;			BITS 16 - 17: UNUSED
;			RH = FILE TABLE LOCATION
LFENQ.:	SAVE
	SKIPE	SU.FR		;ARE ANY FILES CURRENTLY OPEN FOR 
				;SIMULTANEOUS UPDATE?

	JRST	SU.ER9		;YES, JUMP
	HRRZ	I,0(AP)	
	MOVEM	I,SU.FR		;SET SU.FR TO COUNT OF FILES BEING
				;OPENED FOR SIMULTANEOUS UPDATE, AND
				;LEAVE COUNT IN I

	SETZM	SU.EQ		;SET THE NUMBER OF ENTRIES IN THE
				;ENQUEUE TABLE TO ZERO (LFENQ WILL NOT
				;USE THE DEQUEUE TABLE OR THE
				;MODIFY TABLE).

	MOVEI	AUFS,1(AP)	;POINT AUFS TO THE FIRST USER FILE
				;SPECIFICATION

LFENQ1:	MRTMS.	(AT4)		;START METER TIMING
	LDB	AT4,UFSCON	;MAKE A LITTLE VALIDITY CHECK
	CAIE	AT4,143
	JRST	SU.ER2
	LDB	AT4,UFSFLG	;GET FLAGS FROM USER SPEC

	TRO	AT4,000200	;SET FOR READ BIT
	HRRZ	AFT,0(AUFS)
	DPB	AT4,FTOTA	;SET OTHERS ACCESS IN FILE TABLE
	ROT	AT4,-4
	DPB	AT4,FTOWA	;SET OWN ACCESS IN FILE TABLE
	HRLI	AT4,600		;GENERATE FAKE PARAMETER TO CBLIO
				;OPEN ROUTINE IN FET1
	HRR	AT4,0(AUFS)
	MOVEM	AT4,FET1
	MOVEM	AUFS,FET2	;SAVE OUR REGISTERS
	MOVEM	AP,FET3
	MOVEM	I,FET4
	RESTRM			;RESTORE LIBOL REGISTERS

	MOVE	AP,FET1
	PUSHJ	PP,C.OPEN	;OPEN THE FILE
	SETO	I,		;[565] GET ONES
	DPB	I,LFQOPN	;[565] SET OPENED FROM LFENQ. BIT
	MOVE	AUFS,FET2	;RESTORE OUR REGS
	MOVE	AP,FET3
	MOVE	I,FET4
	HRRZ	AFT,0(AUFS)
	LDB	AT4,FTAM
	CAIE	AT4,INDEXD
	JRST	PPF1
	HLRZ	AT4,D.BL(AFT)
	SETOM	NXTREC(AT4)	;INITIALIZE NXTREC TO -1 SO THAT
				;AN INITIAL RETAIN WILL SAVE 
				;CORRECT POSITION
PPF1:	LDB	AT4,FTOWA
	LDB	AT5,UFSFLG

;	AT4 NOW CONTAINS OWN ACCESS BITS FOR READ, REWRITE, WRITE, AND
;	DELETE IN THE RIGHT HAND FOUR BITS AND AT5 THE SAME FOR OTHERS.
;
;	WE'LL NOW CONSIDER THESE FOUR PAIRS OF BITS AND DETERMINE
;	WHICH QUEUES THE USER SHOULD BE QUEUED ON, AND HOW.
;	HE QUEUES SHARED ON THE QUEUE (E.G. READ) IF HE WANTS TO
;	EXECUTE THE CORRESPONDING VERB WHILE ALLOWING OTHERS TO DO
;	THE SAME, EXCLUSIVE IF HE WANTS TO EXECUTE THE CORRESPONDING
;	VERB EXCLUSIVELY, GROUP 1 SHARED IF HE DOESN'T WANT TO EXECUTE
;	THE CORRESPONDING VERB BUT ALSO WANTS NOONE ELSE TO, AND
;	NO QUEUEING AT ALL IF HE WILL NOT EXECUTE THE VERB AND DOESN'T
;	CARE WHAT OTHERS WILL DO. WE'LL DO THIS BY CALLING FED, THEN ENQDEQ.

	HRRZ	ACRR,AUFS	;SET ACRR SUCH THAT 0(ACRR) POINTS TO THE
				;FILE TABLE
	PUSHJ	PP,FED		;CALL FILE ENQUEUE/DEQUEUE ROUTINE	


	AOS	AUFS		;POINT TO THE NEXT USER FILE SPEC,
				;IF ANY, AND LOOP BACK

	MRTME.	(AT1)		;END METER TIMING

	SOJG	I,LFENQ1	;CALL ENQDEQ TO DO THE ACTUAL QUEUEING,
				;IF ANY
	RESTRM
	SETZ	AT1,
	PUSHJ	PP,ENQDEQ
	JRST	G1		;JUMP IF SOME PROBLEM OR RESOURCES NOT
				;AVAILABLE

	HLLZ	AT1,0(AP)	;EVERYTHING'S OK
	JUMPN	AT1,RET.2	;IF UNAVAILABLE STATEMENT SUPPLIED,
				;ADJUST RETURN
	POPJ	PP,

G1:	SETZM	SU.FR		; [434] CLEAR COUNT OF # OF SIMULTANEOUS FILES
	HRRZ	I,0(AP)		;CLOSE ALL THE FILES
	MOVEI	AUFS,1(AP)

CL:	HRLI	AT4,40		;GENERATE FAKE PARAMETER TO CBLIO
				;CLOSE ROUTINE IN FET1
	HRR	AT4,0(AUFS)
	MOVEM	AT4,FET1
	MOVEM	AUFS,FET2
	MOVEM	AP,FET3		;SAVE OUR REGISTERS
	MOVEM	I,FET4
	RESTRM			;RESTORE LIBOL REGISTERS
	MOVE	AP,FET1
	PUSHJ	PP,C.CLOS	;CLOSE THE FILE
	MOVE	AUFS,FET2
	MOVE	AP,FET3
	MOVE	I,FET4		;RESTORE OUR REGISTERS

	AOS	AUFS		;POINT TO THE NEXT FILE,
				;IF ANY, AND LOOP BACK
	SOJG	I,CL
	HLLZ	AT1,0(AP)
	JUMPE	AT1,SU.ER7
	POPJ	PP,		;RETURN IF UNAVAILABLE STATEMENT 
				;SUPPLIED
;	SU.RD, SU.RW, SU.WR, SU.DL, AND SU.CL: ROUTINES CALLED WHEN
;	CBLIO DISCOVERS A FILE IS OPENED FOR SIMULTANEOUS UPDATE
;	DURING THE EXECUTION OF A READ, REWRITE, WRITE, DELETE,
;	OR CLOSE STATEMENT.
;
;
;
;	UPON ENTRY, AC16 CONTAINS A FILE TABLE POINTER.
;
;	IF THE OPERATION ATTEMPTED BY THE USER IS ACCORDING TO THE
;	RULES OF SIMULTANEOUS UPDATE, CONTROL IS RETURNED TO
;	0(PP).
;
;	IF THE OPERATION ATTEMPTED BY THE USER IS NOT ACCORDING TO
;	THE RULES OF SIMULTANEOUS UPDATE, A MESSAGE IS PRINTED AND THE USER IS KILLED.

	INTERN	SU.RD, SU.RW, SU.WR, SU.DL, SU.CL
SU.RD:	MOVEI	AT5,10		;SET READ BIT IN AT5 AND JUMP TO 
				;COMMON CODE
	JRST	M1
SU.RW:	MOVEI	AT5,4		;LIKEWISE, REWRITE BIT
	JRST	M1
SU.WR:	MOVEI	AT5,2		;LIKEWISE, WRITE BIT
	JRST	M1
SU.DL:	MOVEI	AT5,1		;LIKEWISE, DELETE BIT

M1:	MOVEM	AT5,SU.VRB	;SAVE VERB INDICATOR IN SU.VRB
	SETZM	SU.Y		;INDICATE NO RETAIN "NEXT" YET SEEN

	SAVE
	MOVE	AT5,SU.VRB

	MOVE	AFT,AP		;INITIALIZE KEY FOR SEARCHING TABLE OF
				;RETAINED RECORDS
	LDB	AT1,FTAM
	CAIN	AT1,INDEXD
	JRST	M3		;JUMP IF FILE INDEXED
	CAIE	AT1,RANDOM
	JRST	M4
	HRRZ	AT2,F.RACK(AFT)
	SETOM	SU.Y		;INDICATE RANDOM,RETAIN NEXT INTERESTING
IFN ANS68,<
	SKIPE	AT3,0(AT2)
	JRST	M5		;JUMP IF FILE RANDOM WITH NON-ZERO KEY
>;END IFN ANS68
IFN ANS74,<
	MOVE	AT3,0(AT2)	;GET KEY VALUE
	LDB	AT4,F.BFAM	;GET ACCESS MODE
	JUMPE	AT4,M1A		;SKIP AHEAD IF SEQ ACCESS
	TLNN	AP,200		;READ "NEXT RECORD"?
	 JRST	M5		;NO--GO STORE KEY VALUE
M1A:>;END IFN ANS74


M4:	MOVNS	SU.Y		;MAKE FLAG POSITIVE,INDICATING "NEXT" I/O
	MOVE	AT3,D.RP(AFT)	;FILE IS EITHER SEQUENTIAL OR RANDOM
				;WITH KEY OF ZERO
IFN ANS68,<
	TRNN	AT5,2		;WRITE ONLY
>
IFN ANS74,<
	TRNN	AT5,4		;REWRITE ONLY?
>
	JRST	M6		;JUMP IF VERB ANYTHING BUT (RE )WRITE
	HLRZ	AT2,D.BL(AFT)
	SETO	AT4,
	CAMN	AT4,LASTUU(AT2)	;SKIP IF LAST VERB A READ

M6:	ADDI	AT3,1
	JRST	M5

M3:
IFN ANS74,<
	TLNN	AP,200		;READ NEXT?
	 JRST	M333		;NO, SKIP THIS
>;END IFN ANS74
	PUSHJ	PP,CLVACI	;CHECK FOR LOW-VALUES AND CONVERT,
				;IF NECESSARY
	JRST	M8
M333:	SETO	AT4,
	HRRM	AT4,F.WSMU(AFT)	;INITIALIZE POINTER TO SAVED KEY TO 
				;NULL, SINCE WE WON'T HAVE TO RESTORE
				;OUR PREVIOUS POSITION IN THE FILE

	MOVSI	ACRR2,(JFCL)	;[447] SET UP PHONY CONV INSTR.
	MOVE	AT3,F.WBSK(AFT)	;WE'RE JUST ABOUT READY FOR LOOP
	JRST	M5

M8:
IFN ANS74,<
	SKIPE	SU.HV		;FOUND EOF?
	 JRST	CHK7EF		;YES, CHECK FOR AN ENTRY LIKE THAT
>;END IFN ANS74
	MOVE	ACRR2,D.RCNV(AFT)	;[447] USE REAL CONV INSTR.
	PUSHJ	PP,CHGCNV		;[447] CHECK FOR PHONY CONV INSTRS.
	MOVE	AT3,SU.RBP		;[447]

M5:	SETZM	SU.T1		;NO RETAIN NEXT SEEN YET

	MOVEM	AT3,SU.CK	;SAVE COMPARISON KEY IN SU.CK

	MOVE	ACRR,SU.RRT	;INITIALIZE ACRR FOR LOOP TO
				;SEARCH THE RETAINED RECORDS TABLE
				;FOR THIS RECORD

M7:	CAMGE	ACRR,SU.CRH	;END OF LOOP?
	JRST	M7A		;NO, CONT AT NEXT ENTRY

	SKIPN	ACRR,SU.T1	;RETAIN "NEXT" ENTRY SEEN?
	JRST	SU.ERB		;ERROR,NO RETAIN TO COVER THIS RECORD
	SKIPL	SU.Y		;RANDOM WITH KEY?
	JRST	M10		;NO,RETAIN NEXT VALID FOR "KEY 0" TYPE I/O
	MOVE	AT4,@F.RACK(AP)	;GET ACTUAL KEY
	MOVE	AT3,D.RP(AP)	;GET CURRENT REC NUMBER
	CAIN	AT3,AT4		;RETAINED NEXT=CURRENT NEXT?
	JRST	M10		;YES,GOT PROPER RETAIN
	JRST	SU.ERB		;NO, JUMP TO ERROR, SINCE WE SHOULD
				;HAVE FOUND AN ENTRY FOR THIS RECORD

M7A:	HRRZ	AFT,0(ACRR)
	HRRZ	AT1,AP
	CAME	AFT,AT1		;SAME FILE?

	JRST	M2		;IF NOT, JUMP TO NEXT ENTRY IN LOOP

	LDB	AT4,FTAM
	CAIN	AT4,INDEXD
	JRST	M9		;JUMP IF FILE INDEXED
	CAMN	AT3,2(ACRR)
	JRST	M10		;JUMP IF KEYS MATCH - WE FOUND IT!

	SKIPN	SU.Y		;SKIP IF "RETAIN NEXT" INTERESTING
	JRST	M2		;NO, CONT
IFN ANS74,<
	LDB	AT4,RRTNXT	;GET RETAIN NEXT FLAG
	JUMPE	AT4,M2		;NOT RETAIN NEXT,CONT
>
IFN ANS68,<
	SKIPN	2(ACRR)		; ZERO KEY RETAIN ? (SKIP IF NOT)
>
	MOVEM	ACRR,SU.T1	;IT IS, SAVE RRT ENTRY ADDRESS

M2:	LDB	AT4,CRRINE
	ADD	ACRR,AT4
	JRST	M7

M9:	HLRZ	AT4,D.BL(AP)	;[524] POINT TO FILE TABLE
	LDB	AT4,FTKT	;[524] CHECK FOR NON-DISPLAY KEY TYPES
	CAIGE	AT4,3		;[524] DISPLAY?
	JRST	M9DISP		;[524] YES
	CAIL	AT4,7		;[524] COMP-3?
	JRST	M9DISP		;[524] YES  TREAT AS DISPLAY
	;[524]  KEY IS NOT DISPLAY  COMPARE ONE OR TWO WORDS
	HRRI	AT1,2(ACRR)	;[524] AT1 POINTS TO 1 OF THE RETAINED KEYS
	MOVE	AT5,(AT1)	;[524] GET 1ST WORD OF RETAINED KEY
	CAME	AT5,(AT3)	;[524] IS IT THE ONE HE WANTS TO READ?
	JRST	M12		;[524] NO GO GET THE NEXT ONE
	TRNE	AT4,1		;[524] SKIP IF KEYS ARE 2 WORDS
	JRST	M10		;[524] ONE WORD, AND THEY MATCH!
	MOVE	AT5,1(AT1)	;[524] GET SECOND WORD OF KEY
	CAME	AT5,1(AT3)	;[524] COMPARE 2ND WORD ALSO
	JRST	M12		;[524] NO MATCH
	JRST	M10		;[524] MATCH!

M9DISP:	LDB	AT4,FTRM	;[447] GET INCORE RECORD MODE
	MOVE	AT4,[OCT 441000000000,440600000000,0,440700000000]-1(AT4) ;[447]
				;[447]GET BYTE POS + SIZE BASED ON MODE
	HRRI	AT4,2(ACRR)
	LDB	AT1,FTKLB	;[447] USE AT1 FOR LOOP AND AT5 FOR
				;[447] ILDB SO CONV INSTR WORKS

	SKIPE	SU.HV		;[447] FORCED HIGH VALUES BEING USED?
	JRST	M14		;[447] YES
M11:	ILDB	AT5,AT3		;[447]
	XCT	ACRR2		;[447] CONVERT IF NECESSARY
	ILDB	AT2,AT4
	CAME	AT5,AT2		;[447]
	JRST	M12		;JUMP IF KEYS NOT EQUAL
	SOJG	AT1,M11		;[447]
	JRST	M10		;WE'VE FOUND IT!

M12:	MOVE	AT3,SU.CK
	JRST	M2

IFN ANS74,<
;LOOP THRU RRT AND MATCH IF WE HAVE A "NEXT RECORD" ENTRY THAT FOUND EOF
CHK7EF:	MOVE	ACRR,SU.RRT
CHK7F1:	CAML	ACRR,SU.CRH	;END OF LOOP?
	 JRST	SU.ERB		;YES, ERROR IF NOT FOUND YET
	HRRZ	AFT,0(ACRR)	;GET FILE
	HRRZ	AT1,AP
	CAME	AFT,AT1		;SAME FILE?
	 JRST	CHK7F2		;NO, GO ON TO NEXT ENTRY
	LDB	AT1,RRTHVF	;FOUND EOF IN A "NEXT RECORD" ENTRY?
	JUMPN	AT1,M10		;IF YES, MATCH!

CHK7F2:	LDB	AT4,CRRINE
	ADD	ACRR,AT4
	JRST	CHK7F1		;LOOP
>;END IFN ANS74

M14:	LDB	AT5,AT3		;[447] GET THE HIGH VALUES CHAR
	ILDB	AT2,AT4		;[447] RRT CHAR
	CAME	AT5,AT2		;[447] SAME?
	JRST	M12		;[447] NO
	SOJG	AT1,M14+1	;[447] YES--CHECK NEXT ONE
M10:	LDB	AT4,CRRFG4	;GET VERB FLAGS
	SETZM	SU.HV		;[447] TURN OFF HIGH VALUES SWITCH
	SETCA	AT4,
	MOVE	AT5,SU.VRB
	TRNE	AT5,0(AT4)
	JRST	SU.ERC		;JUMP IF FUNCTION NOT RETAINED FOR
	LDB	AT1,CRRFLG
	TRNE	AT1,000002
	JRST	M13		;JUMP IF UNTIL FREED FLAG SET
	TRNN	AT4,000017
	JRST	M13		;JUMP IF RETAIN FOR ANY VERB
	LSH	AT1,-2
	TRZ	AT1,0(AT5)	;ZERO VERB BIT
	DPB	AT1,CRRFG4
	JUMPN	AT1,M13		;JUMP IF NOT ALL VERB BITS ZERO
	SETO	AT1,
	DPB	AT1,CRRF	;SET FREE FLAG FOR THIS RECORD

;	CBLIO WILL ACTUALLY FREE THE RECORD WE HAVE JUST MARKED
;	AFTER EXECUTION OF THE VERB BEING EXECUTED.

M13:	RESTRM
	POPJ	PP,		;NORMAL RETURN TO CBLIO

SU.CL:	SKIPN	SU.FR		; [434] ANY SIMULTANEOUS FILES OPEN?
	POPJ	PP,		; [434] NO EXIT
	MOVEI	AT1,12		; TELL THE QUEUE ROUTINE THIS IS A
	MOVEM	AT1,SU.VRB	; CLOSE VERB SO LONG TERM LOCK GETS
				; TURNED OFF
	MOVEI	AT1,1		;SET UP DUMMY CALL TO LRDEQ,
				;REQUESTING THAT ALL THE RECORDS IN THE 
				;FILE BEING CLOSED BE FREED. SAVE AC12
				;AND AC16 FOR CBLIO.
	MOVEM	AT1,SU.CL1
	MOVEI	AT1,152200
	HRLM	AT1,SU.CL2
	MOVEM	AP,SU.CLR
	HRRM	AP,SU.CL2
	MOVEI	AP,SU.CL1
	MOVEM	12,SU.CLS
	PUSHJ	PP,LRDEQ.
	MOVE	AFT,SU.CLR	;SET AFT TO FILE TABLE POINTER

	LDB	AT4,FTOWA	;SET AT4 TO OWN ACCESS BITS

	LDB	AT5,FTOTA	;SET AT5 TO OTHERS ACCESS BITS

	MOVEI	ACRR,SU.CL2	;SET ACRR SO THAT 0(ACRR) POINTS TO FILE TABLE

	SETZM	SU.DQ		;ZERO COUNT OF ITEMS DEQUEUED

	HRLI	ACRR,1		;SET LH OF ACRR TO INDICATE DEQUEUE

	PUSHJ	PP,FED		;PREPARE ENQ/DEQ REQUEST BY CALLING FED
	MOVEI	AT1,1
	MOVEI	AP,SU.CL1	;SET AP SO THAT 0(AP) = 0
	SETZM	SU.CL1
	PUSHJ	PP,ENQDEQ	;CALL ENQ/DEQ TO ACTUALLY TO DEQUEUE
	JRST	SU.ER7
	MOVE	12,SU.CLS
	MOVE	AP,SU.CLR
	SETZM	F.WSMU(AP)	;ZERO SU WORD IN THE FILE TABLE

	SOS	SU.FR		;SUBTRACT ONE FROM THE COUNT OF FILES
				;OPEN FOR SIMULTANEOUS UPDATE
	POPJ	PP,
;	MOVKEY: A SUBROUTINE THAT MOVES A KEY INTO THE CURRENT RETAINED
;		RECORDS TABLE ENTRY
;
;
;	ARGUMENTS:
;
;		1: A BYTE  POINTER TO THE KEY TO BE MOVED IN AT1
;		2: LENGTH OF THE KEY IN BYTES IN AT2
;		3: POINTER TO A RETAINED RECORDS TABLE ENTRY IN ACRR
;		4: POINTER TO FILE TABLE IN AFT
;
;	CHANGES:
;
;		AT2
;		AT3
;		AT4
;		AT5
;		SU.T4
;		SU.HV


MOVKEY:	LDB	AT3,FTRM	;BUILD BYTE POINTER TO KEY IN RETAINED
				;RECORDS TABLE IN AT3

	MOVE	AT3,[OCT 441000000000,440600000000,0,440700000000]-1(AT3)

				;DERIVE BYTE SIZE FROM RECORDING MODE

	HRRI	AT3,2(ACRR)	;SET ADDRESS FIELD

	MOVEM	AT1,SU.T4	;FREE UP AT1

	SKIPE	SU.HV		;[447] FORCED HIGH VALUES READ
	JRST	HVLOOP		;[447] YES
	MOVE	AT4,D.RCNV(AFT)	;[447] NO--DO REAL CONV
MKLOOP:	ILDB	AT5,SU.T4	;[447] MOVE BYTES
	XCT	AT4		;[447] CONV IF NECESSARY
	IDPB	AT5,AT3		;[447]
	SOJG	AT2,MKLOOP
	POPJ	PP,		;RETURN

HVLOOP:	LDB	AT5,SU.T4	;[447] GET A HIGH VALUES CHAR
	IDPB	AT5,AT3		;[447] PUT IT IN RRT
	SOJG	AT2,.-1		;[447] DO EM ALL
	SETZM	SU.HV		;[447] TURN OFF HIGH VALUES FLAG
	POPJ	PP,		;[447] RETURN

USRKEY:	LDB	AT3,FTRM	;[447]
	MOVE	AT3,[OCT 441000000000,440600000000,0,440700000000]-1(AT3)	;[447]
	HRRI	AT3,2(ACRR)	;[447]
	MOVEM	AT1,SU.T4	;[447]
USLOOP:	ILDB	AT1,SU.T4	;[447]
	IDPB	AT1,AT3		;[447]
	SOJG	AT2,USLOOP	;[447]
	POPJ	PP,		;[447]
;	QUEUE: A SUBROUTINE THAT CREATES AN ENTRY IN THE ENQUEUE,
;	       DEQUEUE, OR MODIFY ACCESS TABLE (THESE TABLES ARE IN THE
;	       FORMAT OF THE ENQ/DEQ PARAMETER LIST).
;
;
;	ARGUMENTS:
;
;		1: ACRR POINTS TO THE APPROPRIATE ENTRY IN THE RETAINED
;		   RECORDS TABLE. BUT USE OF ACRR BY THIS ROUTINE
;		   IS RESTRICTED TO GETTING THE FILE TABLE LOCATION
;		   FROM 0(ACRR).
;
;		2: AT1 LH = 0 => EXCLUSIVE
;			  = 1 => SHARED
;			  = 3 => GROUP SHARED
;
;		       RH = 0 => ENQUEUE
;		          = 1 => DEQUEUE
;			  = 2 => MODIFY ACCESS
;
;		3: AT2 CONTAINS A 33 BIT USER CODE
;
;	CHANGES:
;
;		AT1
;		AT2
;		AT3
;		AFT
;		QUEUE TABLES: SU.EQT, SU.DQT, SU.MQT
;		QUEUE TABLE COUNTERS: SU.EQ, SU.DQ, SU.MQ
;
;	QUEUE FIRST CHECKS FOR INDEX QUEUEING, IN WHICH CASE
;	A RECORD IS KEPT OF SHARED/EXCLUSIVE MODE UPON ENQUEUE.
;	THIS IS LATER USED TO ENSURE THAT DEQUEUE USES THE SAME 
;	MODE. (ONLY THE 10 NOW (2/79) WORRIES ABOUT THIS)
;
;

QUEUE:	HRRZ	AFT,0(ACRR)	;GET POINTER TO THE FILE TABLE
	AOJN	AT2,QUEUX	;SKIP AHEAD IF NOT INDEX QUEUE (AT2 NOT -1)
	HRRZ	AT3,AT1		;GET ENQDEQ INDICATER
	SOJGE	AT3,QUEUA	;SKIP AHEAD IF NOT ENQUEUE REQUEST

	HLRZ	AT3,AT1		;GET EXCL/SHARD MARK
	DPB	AT3,IDXSHR	;SAVE FLAG IN FILTAB F.WSMU WORD
	JRST	QUEUX		; CONT

QUEUA:	SOJGE	AT3,QUEUX	;SKIP ALL IF MODIFY 

	LDB	AT3,IDXSHR	;GET FILTAB INDEX ENQ SHARE FLAG
	HRL	AT1,AT3		;RESET DEQUEUE MODE TO MATCH ENQUEUE
QUEUX:	SOJ	AT2,		;RESTORE AT2


	MOVE	AT3,@[OCT SU.EQ,SU.DQ,SU.MQ](AT1)
	LSH	AT3,1
	ADD	AT3,@[OCT SU.EQ,SU.DQ,SU.MQ](AT1)
	ADD	AT3,@[OCT SU.EQT,SU.DQT,SU.MQT](AT1)
	ADDI	AT3,2

;	AT3 NOW POINTS TO WHERE WE SHOULD GENERATE THE ENQ/DEQ REQUEST 
;	ENTRY

	AOS	@[OCT SU.EQ,SU.DQ,SU.MQ](AT1)	;INCREMENT COUNT

	SETZM	2(AT3)		;INDICATE WE ARE REFERING TO A 
				;NON-POOLED RESOURCE

	TLZ	AT2,700000	;JAM 5 IN AT2 TO INDICATE 33 BIT USER 
				;CODE OPTION
	TLO	AT2,500000	
	MOVEM	AT2,1(AT3)	;STORE AWAY


	LDB	AT2,FTCN	;GET CHANNEL NUMBER

	HLRZ	AT1,AT1
	ROT	AT1,-1		;GET SHARED/EXCLUSIVE BIT IN BIT 0

	HLL	AT2,AT1		;COMBINE WITH CHANNEL

	TLO	AT2,200000	;TURN OFF LEVEL CHECKING

	PUSH	PP,AT1		;SAVE AT1
	MOVEI	AT1,12		;CHECK FOR CLOSE VERB
	CAMN	AT1,SU.VRB	;IF IT IS, DO NOT SET LONG TERM LOCK
	JRST	QUEUE1		;IT IS
	HRLOI	AT1,577777	;NOT CLOSE, BUT IS IT AN INDEX OR
				;RANDOM FILE RESOURCE?
	CAMN	AT1,1(AT3)	;IF IT IS EITHER, SET LONG TERM LOCK
IFN TOPS20,<			; [643]
	TLO	AT2,(EN%LTL)	; [643] IT IS ONE OF THEM
>				; [643]
IFE TOPS20,<			; [643]
	TLO	AT2,(EQ.FLT)	; [643] IT IS ONE OF THEM
>				; [643]
QUEUE1:	POP	PP,AT1		;RESTORE AT1
	MOVEM	AT2,0(AT3)	;STORE

	HRRM	AT1,2(AT3)	;SET SHARE GROUP

	POPJ	PP,		;RETURN
;	ENQDEQ: A SUBROUTINE TO ACTUALLY CALL ENQ/DEQ
;
;	ARGUMENTS:
;
;		1: AT1: RH = 0 => ENQUEUE
;			   = 1 => DEQUEUE
;			   = 2 => MODIFY ACCESS
;
;		2: AP POINTS TO A LOCATION INTERPRETED AS FOLLOWS:
;
;				LH = 0 => BLOCK
;
;				LH = 1 => RETURN
;
;
;	RETURNS:
;		TO 0(PP) IF RESOURCES NOT AVAILABLE
;		TO 1(PP) IF EVERYTHING'S OK
;
;	CHANGES:
;
;		AT1
;		AT2
;		AT3
;
;	USES:
;
;		QUEUE TABLES: SU.EQU, SU.DQT, SU.MQT
;		QUEUE TABLE COUNTERS: SU.EQ, SU.DQ, SU.MQ
;
;
;	REINITIALIZES:
;
;		SU.EQ
;		SU.DQ
;		SU.MQ      (APPROPRIATE ONE TO ZERO)
;


ENQDEQ:	AOS	0(PP)		;SET NORMAL RETURN

	SKIPN	AT2,@[OCT SU.EQ,SU.DQ,SU.MQ](AT1)

	POPJ	PP,		;RETURN NORMAL IF NO ENTRIES IN TABLE

	MOVE	AT3,@[OCT SU.EQT,SU.DQT,SU.MQT](AT1)

	SETZM	1(AT3)		;ZERO REQUEST ID AND RESERVED FIELDS
				;OF ENQ/DEQ REQUEST
	LSH	AT2,1
	ADD	AT2,@[OCT SU.EQ,SU.DQ,SU.MQ](AT1)

	ADDI	AT2,2		;COMPUTE LENGTH OF REQUEST BLOCK

	HRL	AT2,@[OCT SU.EQ,SU.DQ,SU.MQ](AT1)
				;MOVE IN NUMBER OF ENTRIES

	MOVEM	AT2,0(AT3)	;STORE AT HEAD OF REQUEST LIST

	SETZ	AT3,		;ZERO AT3 TO INDICATE ENQ

	CAIN	AT1,2
	JRST	ED1		;JUMP IF MODIFY ACCESS REQUEST

	JUMPN	AT1,ED2		;JUMP IF DEQUEUE REQUEST

	HLL	AT2,0(AP)	;SET BLOCK OR RETURN FOR ENQ, BASED
				;ON WHETHER USER SUPPLIED RETURN

ED3:	HRR	AT2,@[OCT SU.EQT,SU.DQT,SU.MQT](AT1)

	TRNA
	PUSHJ	PP,PRINT	;IF DEBUGGING SWITCH SET, SEND
				;ENQ/DEQ PARAMETERS TO TTY

	CALLI	AT2,151(AT3)	;CALL ENQ OR DEQ DEPENDING ON SETTING
				;OF AT3

	  JRST	ED4		;ERROR RETURN FROM ENQ/DEQ

	POPJ	PP,		;NORMAL RETURN FROM ENQ/DEQ -
				;RETURN NORMAL TO OUR CALLER

ED1:	HRLI	AT2,3
	JRST	ED3

ED2:	HRLI	AT2,0		;SET DEQ FUNCTION TO NORMAL DEQ

	MOVEI	AT3,1		;SET AT3 TO 1 TO INDICATE DEQ
	JRST	ED3

PRINT:	PUSH	PP,AT4		;SAVE AT4
	HRRZ	AT4,0(AT2)	;MOVE COUNT OF WORDS TO BE PRINTED
				;TO AT4

	PUSH	PP,ACRR		;SAVE ACRR
	PUSH	PP,ACRR2	;SAVE ACRR2
	PUSH	PP,ACRR3	;SAVE ACRR3
	MOVE	ACRR,[POINT 3,0(AT2)]
				;SET UP BYTE POINTER IN ACRR

PRINT2:	MOVEI	ACRR3,14	;SET COUNT OF OCTITS IN A WORD IN ACRR3

PRINT1:	ILDB	ACRR2,ACRR	;GET NEXT OCTIT TO BE PRINTED

	ADDI	ACRR2,"0"	;CONVERT TO ASCII

	OUTCHR	ACRR2		;PRINT THE OCTIT

	SOJG	ACRR3,PRINT1	;END OF WORD? IF NOT, JUMP

	MOVEI	ACRR2,015
	OUTCHR	ACRR2		;PRINT CARRIAGE RETURN

	MOVEI	ACRR2,012
	OUTCHR	ACRR2		;PRINT LINE FEED

	SOJG	AT4,PRINT2	;END OF WORDS TO BE TYPED?

	POP	PP,ACRR3	;RESTORE REGISTERS
	POP	PP,ACRR2
	POP	PP,ACRR
	POP	PP,AT4
	POPJ	PP,		;RETURN

ED4:	SOS	0(PP)		;SET OUR ABNORMAL RETURN
	CAIN	AT2,13
	JRST	SU.ERE		;INSUFFICIENT CORE
	CAIN	AT2,21
	JRST	SU.ERF		;QUOTA EXCEEDED
	CAIE	AT2,1
	JRST	SU.ER7		;SOME CRAZY INTERNAL ERROR

	POPJ	PP,		;RESOURCES NOT AVAILABLE
;	BLKNUM: A SUBROUTINE TO DETERMINE WHICH BLOCK NEEDS TO BE
;	        ENQUEUED OR DEQUEUED
;
;	ARGUMENTS:	
;
;		1: ACRR POINTS TO THE APPROPRIATE ENTRY IN THE
;		   RETAINED RECORDS TABLE. THIS SUBROUTINE GETS WHAT
;		   IT NEEDS FROM THAT ENTRY, AND SETS THE BLOCK NUMBER
;		   FIELD IN THAT SAME ENTRY.
;
;
;	CHANGES:
;
;		ALL REGISTERS EXCEPT AP, ACRR, AND PP
;	SU.T1		F.WSMU(AFT)
;	SU.T2		FS.BN
;	SU.T3		SU.RLV
;	SU.Y		SU.SVK
;	SU.RBP


BLKNUM:	HRRZ	AFT,0(ACRR)
	LDB	AT1,FTAM
	CAIN	AT1,INDEXD
	JRST	BN1		;JUMP IF FILE INDEXED

	CAIN	AT1,RANDOM	;[455]
	 JRST	BN1A
BN0A:	MOVE	AT1,2(ACRR)	;[456] BLOCK NUMBER = 
				;KEY + BLOCKING FACTOR - 1 ALL DIVIDED
				;BY BLOCKING FACTOR

	LDB	AT2,FTBF	;[456]
	SOSN	AT1		;[456]
	TDZA	AT2,AT2		;[456]
	IDIV	AT1,AT2		;[456]
	IMUL	AT1,D.BPL(AFT)	;[456]
	ADDI	AT1,1		;[456]

BN5:	DPB	AT1,CRRBLK

IFN ANS74 ,<
	LDB	AT1,CRRFG4	; GET RETAIN VERB FLAGS
	TRNn	AT1,RTDLRW	; DELETE OR REWRITE RETAIN?
	JRST	BN5C		; No, check to see if RETAIN save needed

	; Clear CNTRY and NNTRY so that next sequential operation will get 
	;  saved position

	HLRZ	AT1,D.BL(AFT)	; Get buffer position
	SETZM	CNTRY(AT1)	; Clear current position 
	SETZM	NNTRY(AT1)	; And next position flag
	POPJ	PP,		; And return


	; Other operations have reestablished next record pos for purposes
	; of the RETAIN. If not already done, save RWDLKY from I-O level. 

BN5C:	HLRZ	AT1,D.BL(AFT)	; Get buffer position
	HRRZ	AT2,D.RFLG(AFT)	; Get extra flags
	SKIPE	SVNXRT(AT1)	; Is current SAVNXT been saved?
	JRST	BN5A		; Yes, no need to save it again

	HRROM	AT2,SVNXRT(AT1)	; Save them during retain
				;  Set left -1 incase no D.RFLG bits set
	PUSH	PP,AT2		; And save them for later
	HRRZ	AT2,RWDLRT(AT1)	; Get retain save area address
	MOVE	AT3,RWDLKY(AT1)	; Get i-o level NNTRY and save area addr
	MOVEM	AT2,RWDLKY(AT1)	; Indicate that SAVNXT should use RETAIN's area
	MOVEM	AT3,RWDLRT(AT1)	; Save I-O level NNTRY and save area addr

	; Copy I-O save area to RETAIN area, RWDLRT area is same size as and 
	;  immediatly follows RWDLKY area

	HRL	AT2,AT3		; Source addr from I-O save area
	HRRZ	AT1,AT2		; Last-word-to-move+1=2*at2-at3
	LSH	AT1,1		; At2*2
	SUBI	AT1,(AT3)	; At2*2-at3
	BLT	AT2,-1(AT1)	; Copy current saved next record keys
	POP	PP,AT2		; Restore D.RFLG
BN5A:	TRZN	AT2,SAVNXT	; Next rec pos saved?
	POPJ	PP,		; No, return
	HRRM	AT2,D.RFLG(AFT)	; Yes reset it off
>; END IFN ANS74

	POPJ	PP,		; and return

BN1A:
IFN ANS68,<
	SKIPN	2(ACRR)		;IF FILE IS RANDOM AND KEY IS 0,
	POPJ	PP,		;DO NOTHING
>
IFN ANS74,<
	LDB	AT1,RRTNXT	;RETAIN NEXT?
	SKIPE	AT1
	 POPJ	PP,		;YES, DO NOTHING
>;END IFN ANS74
	JRST	BN0A

BN1:	MOVEM	ACRR,SU.T1	;GET READY TO CALL CBLIO

	MOVEM	AP,SU.T2	;SAVE ACRR, AP IN TEMPORARY

	SETZM	SU.Y		;SET SU.Y TO 0 TO INDICATE THIS IS NOT
				;THE FIRST RECORD RETAINED FOR THIS FILE
				;BY THIS RETAIN STATEMENT

IFN ANS74,<
	LDB	AT1,CRRFG4	; GET RETAIN VERB FLAGS
	TRNE	AT1,RTDLRW	; DELETE OR REWRITE RETAIN?
	MOVEM	AT1,SU.FRF	; YES, SET RETAIN FLAG POS TO INDICATE SO 
>; END IFN ASN74

	HRRZ	AT1,F.WSMU(AFT)	;IF F.WSMU IS STILL AT ITS INITIAL VALUE
				;(-1), THEN WE NEED TO SAVE THE KEY
				;OF THE CURRENT RECORD
;
;	IF WE HAVE ALREADY BEEN THROUGH HERE ONCE FOR THIS ISAM FILE,
;	THEN WE SIMPLY GO AND USE THE USER KEY TO READ THE FILE AND
;	GET THE BLOCK NUMBER TO ENQUEUE ON. NO FORCED READ WILL HAPPEN
;	SINCE IT WILL HAVE BEEN DONE ON THE FIRST TIME THROUGH HERE.
;
	CAIE	AT1,-1
	JRST	BN2		;JUMP, CURRENT KEY ALREADY SAVED

;
;	THE FIRST RECORD RETAINED IN EACH RETAIN STATEMENT FOR A GIVEN
;	ISAM FILE IS A SPECIAL CASE. THE PROBLEM IS THAT THERE CAN BE
;	SEVERAL RECORDS RETAINED IN EACH RETAIN STATEMENT FOR A SINGLE
;	ISAM FILE, AND WE MUST LEAVE THE FILE IN THE STATE IT WAS IN
;	PRIOR TO THE RETAIN STATEMENT SO THE SUBSEQUENT I-O STATEMENTS
;	WORK THE WAY THE USER EXPECTS THEM TO. IF EVERY RECORD BEING
;	RETAINED HAS A REAL KEY (NOT LOW-VALUES) THEN THE PROBLEM IS NOT
;	BAD, WE CAN JUST GO OFF AND READ EACH KEY NEVER BOTHERING ABOUT
;	RESTORING THE FILE. HOWEVER, IF THE FIRST KEY BEING RETAINED IS
;	LOW-VALUES, WE MUST WORRY ABOUT RESTORATION, WHICH MEANS WE MUST
;	OBTAIN THE KEY OF THE CURRENT RECORD SO WE CAN RESTORE THE FILE
;	POSITION WHEN NECESSARY. THE FLOW IS AS FOLLOWS:
;
;		1. CALL CBLIO AT FAKER. SUPPLYING A KEY OF LOW-VALUES.
;		   BY SETTING NXTREC(AFT) TO -1, CBLIO WILL RETURN TO
;		   US THE CURRENT RECORD FROM WHICH WE CAN GET ITS KEY.
;		   THIS KEY WILL BE STORED AT THE END OF THE RETAINED
;		   RECORDS TABLE (RRT).
;
;			NOTE 1: IF THIS IS THE FIRST EVER I-O REQUEST
;				FOR THIS FILE, CBLIO WILL HAVE PHYSICALLY
;				READ EACH INDEX LEVEL AND THE DATA LEVEL
;				THIS FULFILLS THE NEED FOR REFRESHING
;				BUFFERS AND IS REMEMBERED FOR LATER USE.
;
;			NOTE 2: IF I-O HAS BEEN DONE TO THIS FILE BEFORE
;				THIS CALL TO CBLIO WILL NOT HAVE CAUSED
;				ANY I-O AND WE WILL STILL HAVE BUFFER
;				REFRESHING TO DO LATER.
;
;	2. IF NOTE 1 IS TRUE OR WE ENTER STEP 2 FROM ANOTHER POINT, GO
;	   AND CALL CBLIO TO READ THE FILE USING THE KEY OF THE RECORD
;	   BEING RETAINED, BYPASSING ANY FORCED READ. THIS RETURNS TO US
;	   THE BLOCK NUMBER OF THE RECORD BEING RETAINED, WHICH WE SAVE
;	   IN THE RRT AND RETURN TO THE MAIN CODE. THIS MAY OR
;	   MAY NOT CAUSE I-O DEPENDING ON WHERE THIS RECORD IS RELATIVE
;	   TO THE FIRST DATA BLOCK OF THE FILE, OR THE CURRENT DATA
;	   BLOCK DEPENDING ON HOW WE GOT TO STEP 2.
;
;	3. IF NOTE 2 IS TRUE, THEN THERE WAS A CURRENT RECORD AND NOW WE
;	   NEED TO KNOW IF THE RECORD BEING RETAINED HAS A KEY OF LOW-
;	   VALUES.
;
;	4. IF THE RECORD BEING RETAINED IS NOT FOR LOW-VALUES, THEN WE
;	   DO NOT NEED TO WORRY ABOUT RESTORING THE FILE TO ITS ORIGINAL
;	   POSITION. WE SIMPLY GO AND DO STEP 2, EXCEPT WE FORCE CBLIO
;	   TO DO A BUFFER REFRESH BY CALLING FORCR. PRIOR TO FAKER.
;
;	5. IF THE RECORD BEING RETAINED HAS A KEY OF LOW-VALUES, THEN WE
;	   MUST CALL CBLIO USING THE KEY OF THE CURRENT RECORD. WE MUST
;	   ALSO FORCE BUFFER REFRESHING BY DOING A FORCR. THIS GAURANTEES
;	   THAT THE SUBSEQUENT LOW-VALUES READ WILL GET THE LATEST "NEXT
;	   RECORD". AFTER FORCE READING THE CURRENT RECORD, WE GO TO
;	   STEP 2.
;

	SETOM	SU.Y		;SET SU.Y TO NON-ZERO TO INDICATE THIS
				;IS THE FIRST RECORD RETAINED FOR THIS
				;FILE BY THIS RETAIN STATEMENT

	MOVE	ACRR,SU.SVK	;WE'LL SAVE THE KEY AT THE END OF THE
				;RETAINED RECORDS TABLE - SET ACRR,
				;F.WSMU TO POINT THERE
	HRRM	ACRR,F.WSMU(AFT)
	HLR	AT1,D.BL(AFT)
	MOVE	AT2,NXTREC(AT1)	;THE KEY WE'RE SAVING ACTUALLY HAS TWO
				;PARTS: THE KEY ITSELF, AND THE NEXT
				;RECORD FLAG

	MOVEM	AT2,0(ACRR)
IFN ANS74,<
	SKIPG	SU.FRF		; DON'T RESET NNTRY YET IF DEL OR REWRIT
				; SO WE GET A CHANCE TO SAVE THE PROPER VALUE
>
	SETOM	NXTREC(AT1)	;AFTER SAVING THE NEXT RECORD FLAG IN
				;WORD 0, WE'LL TELL CBLIO THAT IT'S THE
				;NEXT RECORD, REGARDLESS OF WHETHER IT IS
				;OR NOT, SO THAT CBLIO WON'T READ A NEW
				;BLOCK WHEN WE DO A LOW-VALUES FAKE READ
				;TO GET THE KEY OF THE RECORD CURRENTLY
				;BEING POINTED TO
	LDB	AT1,FTRM
	MOVE	AT1,[OCT 441000000000,440600000000,0,440700000000]-1(AT1)
	HRRI	AT1,1(ACRR)
	EXCH	AT1,F.WBSK(AFT)	;EXCHANGE A BYTE POINTER TO OUR PLACE TO
				;SAVE THE KEY WITH THE BYTE POINTER
				;TO THE SYMBOLIC KEY

	MOVEM	AT1,SU.T3	;SAVE THE SYMBOLIC KEY IN SU.T3
	MOVE	AP,AFT
	HRLI	AP,RFLAG
	PUSHJ	PP,LV2SK.	;CALL CBLIO TO MOVE LOW-VALUES INTO
				;WHAT IT THINKS IS THE SYMBOLIC KEY,
				;BUT WHICH IS ACTUALLY OUR PLACE AT
				;THE END OF THE RETAINED RECORDS
				;TABLE USED TO SAVE THE CURRENT KEY.
				; NOTE: THIS MUST ALSO BE DONE IN COBOL-74
				;BECAUSE THIS TELLS CBLIO WHERE TO START!

	HLR	AT1,D.BL(AFT)
	MOVE	AT1,CNTRY(AT1) ;[650] SAVE THE VALUE OF THE POINTER TO
	MOVEM	AT1,SU.RLV	; THE CURRENT RECORD IN CBLIO'S BUFFERS.
				; IT IS USED LATER TO DETERMINE IF THERE
				; REALLY WAS A CURRENT RECORD.
IFN ANS68,	PUSHJ	PP,OWNFAK	;DO A FAKE LOW-VALUES READ
IFN ANS74,	PUSHJ	PP,FAKNXT
	  TRN

	MOVE	ACRR,SU.T1	;RESTORE ACRR TO RETAINED RECORDS TABLE
				;POINTER

	HRRZ	AFT,0(ACRR)	;RESTORE AFT TO FILE TABLE POINTER

	HRRZ	ACRR,F.WSMU(AFT)	;RESTORE ACRR TO SAVE KEY POINTER
	LDB	AT2,FTKLB
	MOVE	AT1,SU.RBP
	SUBI	ACRR,1		;DECREMENT ACRR TO UTILIZE BLOCK NUMBER
				;FIELD OF PSEUDO ENTRY IN TABLE

	PUSHJ	PP,MOVKEY	;MOVE THE CURRENT KEY INTO THE SAVE AREA
	MOVE	AT1,1(ACRR)
	HLR	AT2,D.BL(AFT)
	MOVEM	AT1,NXTREC(AT2)	;RESTORE THE NEXT RECORD FLAG
	MOVE	AT1,SU.T3
	MOVEM	AT1,F.WBSK(AFT)	;RESTORE SYMBOLIC KEY
	MOVE	AT2,ACRR
	MOVE	ACRR,SU.T1
	LDB	AT1,CRRINE
	ADD	AT2,AT1
	PUSH	PP,AT2		;SAVE NEW SU.SVK FOR LATER
	SKIPN	SU.RLV		; WAS THERE A REAL CURRENT RECORD?
	JRST	BN2C		; NO, DON'T RESTORE ANYTHING
	LDB	AT1,FTRM	; YES, NOW SEE IF L-V BEING RETAINED
	MOVE	AT1,[OCT 441000000000,440600000000,0,440700000000]-1(AT1)
	HRRI	AT1,2(ACRR)
	EXCH	AT1,F.WBSK(AFT)	;EXCHANGE A BYTE POINTER TO OUR PLACE TO
				;SAVE THE KEY WITH THE BYTE POINTER
				;TO THE SYMBOLIC KEY
IFN ANS68,<
	PUSHJ	PP,LVTST	; IS THE KEY BEING RETAINED L-V?
	  TRNA			; YES, RESTORE FILE ALSO REFRESHES BUFFERS
>;END IFN ANS68
IFN ANS74,<
	LDB	AT2,RRTNXT	; IS THE KEY BEING RETAINED "NEXT RECORD"?
	SKIPN	AT2
>;END IFN ANS74
	JRST	BN2B		; NO, DON'T RESTORE ANYTHING
IFN ANS68,<
	SETO	AT2,		;SET "RETAINING L-V" BIT IN RRT ENTRY
	DPB	AT2,RRTNXT
>;END IFN ANS68
	PUSH	PP,AT1		; SAVE REAL SYMBOLIC KEY POINTER
	LDB	AT1,FTOTA
	TRNN	AT1,000003	;IF NOT WRITE OR DELETE
	JRST	BN2A		;SKIP IO SINCE NO ONE COULD AFFECT THE "NEXT RECORD"
	PUSHJ	PP,FORCR.
	MOVE	AT1,F.WBSK(AFT)
	HRR	AT1,SU.SVK
	ADDI	AT1,1
	MOVEM	AT1,F.WBSK(AFT)
	PUSHJ	PP,OWNFAK	;OWNFAK DOES A FAKER.
	  TRN
	SETZM	SU.Y		;TURN OFF "FIRST RECORD" FLAG SO LATER
				;FORCR. DOES NOT HAPPEN UNNECESSARILY
	MOVE	ACRR,SU.T1
	HRRZ	AFT,0(ACRR)
BN2A:	POP	PP,AT1
BN2B:	MOVEM	AT1,F.WBSK(AFT)
BN2C:	POP	PP,SU.SVK	;SET SU.SVK TO NEXT SAVE AREA LOCATION
BN2:	HRLI	AP,RFLAG	;SET SPECIAL FLAGS

	HRR	AP,AFT		;SET FILE TABLE LOCATION

	LDB	AT1,FTRM	;BUILD A BYTE POINTER TO OUR KEY

	MOVE	AT1,[OCT 441000000000,440600000000,0,440700000000]-1(AT1)

	HRRI	AT1,2(ACRR)	;SET ADDRESS TO LOCATION OF OUR KEY
				;IN THE RETAINED RECORDS TABLE

	EXCH	AT1,F.WBSK(AFT)	;SWAP WITH FILE TABLE SYMBOLIC KEY 
				;POINTER

	MOVEM	AT1,SU.T3	;SAVE SYMBOLIC KEY POINTER FOR FUTURE 
				;RESTORATION

	SETZM	SU.RBP		;ZERO RECORD BYTE POINTER

;	SKIPE	SU.RLV		; WAS THERE A REAL CURRENT RECORD?
	SKIPN	SU.Y		; IS THIS THE FIRST RECORD IN THIS RETAIN STATEMENT?
	JRST	BN8A		; NO ON BOTH COUNTS, BUFFER REFRESHING
				; HAS ALREADY HAPPENED, DON'T DO IT AGAIN
	LDB	AT1,FTOTA
	TRNE	AT1,000003
	PUSHJ	PP,FORCR.	;ASK CBLIO TO FORGET WHAT'S IN ITS
				;INDEX BUFFERS, IF OTHERS DOING
				;INSERTING OR DELETING

BN8A:
IFN ANS68,<
	PUSHJ	PP,OWNFAK	;CALL CBLIO

	JRST	BN8		;JUMP IF NOT INVALID KEY

	SETZM	FS.BN		;USE BLOCK NUMBER OF 0 FOR NON-
				;EXISTENT RECORDS

	PUSHJ	PP,LVTST	;DETERMINE IF INVALID KEY CAUSED
				;BY EOF OR INVALID KEY (SKIP
				;RETURN IF NOT LOW-VALUES)

	PUSHJ	PP,[PUSHJ PP,UHV
		MOVE ACRR,SU.T1
		SETO	AT2,
		DPB	AT2,RRTNXT ;SET FLAGS IN RRT
		DPB	AT2,RRTHVF ; . .
		POPJ	PP,]
>;END IFN ANS68
IFN ANS74,<
	MOVE	ACRR,SU.T1
	LDB	AT1,RRTNXT
	JUMPE	AT1,[PUSHJ PP,OWNFAK
			JRST BN8	;NOT INVALID KEY
			SETZM FS.BN	;INVALID KEY
			JRST BN8]	;DO READ OF THE KEY


	; Check for special del/rewrt saved seq position case
	; if this case restore proper next record flag

	HRRZ	AT1,D.RFLG(AFT)	; Get extra flags
	TRNN	AT1,SAVNXT	; Next rec pos saved?
	JRST	BN8B		; No cont,
	HLRZ	AT1,D.BL(AFT)	; Yes, get buffer position
	HLRZ	AT2,RWDLKY(AT1)	; Get saved next rec flag
	HRRM	AT2,NNTRY(AT1)	; And set it
				;  this will ensure that the proper saved 
				;  record position will be used


BN8B:	PUSHJ	PP,FAKNXT	;DO A "READ NEXT"
	JRST	BN8		;NOT INVALID KEY
	MOVE	ACRR,SU.T1	;RESTORE ACRR
	PUSHJ	PP,UHV		;STICK HIGH-VALUES IN KEY
	SETO	AT1,
	DPB	AT1,RRTHVF	;INVALID KEY WHEN LOOKING FOR LOW-VALUES.
>;END IFN ANS74

BN8:	MOVE	ACRR,SU.T1	;RESTORE ACRR, AP, SYMBOLIC KEY

	MOVE	AP,SU.T2
	MOVE	AT1,SU.T3
	HRRZ	AFT,0(ACRR)
	MOVEM	AT1,F.WBSK(AFT)
	LDB	AT2,FTKLB
	SKIPN	AT1,SU.RBP	;IF SU.RBP IS NON-ZERO THEN USER GAVE
				;US LOW-VALUES AND WE MUST MOVE THE
				;REAL KEY INTO THE RETAINED RECORDS
				;TABLE ENTRY
	JRST	BN7
	PUSHJ	PP,MOVKEY

BN7:	MOVE	AT1,FS.BN	;MOVE BLOCK NUMBER INTO RETAINED
				;RECORDS TABLE ENTRY.
	JRST	BN5
;	FILFLU: A SUBROUTINE THAT CHECKS TO SEE IF A BLOCK ABOUT
;		TO BE ENQUEUED, DEQUEUED, OR MODIFIED IS IN THE CURRENT
;		BUFFER. IF IT IS, THE FILE TABLE ADDRESS IS ADDED TO THE
;		FILL/FLUSH BUFFER TABLE.
;
;	FILFL2: A SECONDARY ENTRY POINT, WHICH ADDS THE CONDITION THAT
;		THE BUFFER MUST HAVE BEEN MODIFIED (CONTAINS "LIVE"
;		DATA).
;
;
;	ARGUMENTS:
;		1. ACRR POINTS TO AN ENTRY IN THE RETAINED RECORDS
;		   TABLE.
;
;		2. AT2 CONTAINS A BLOCK NUMBER MOD 2 ** 18
;
;
;	CHANGES:
;		AFT
;		AT4
;		AT5
;		SU.CFB (COUNT OF ENTRIES IN THE FILL/FLUSH BUFFER TABLE)
;		SU.FBT (THE FILL/FLUSH BUFFER TABLE)
;		USOBJ(AT5)
;

FILFL2:	HRRZ	AFT,0(ACRR)
	HLRZ	AT4,D.BL(AFT)
	SETO	AT5,
	CAME	AT5,LIVDAT(AT4)
	POPJ	PP,

FILFLU:	HRRZ	AFT,0(ACRR)
	MOVE	AT4,D.CBN(AFT)	;[455]
	LDB	AT5,FTAM
	CAIE	AT5,INDEXD
	JRST	FF01
	HLRZ	AT5,D.BL(AFT)
	SETZM	USOBJ(AT5)
	POPJ	PP,
FF01:	CAME	AT2,AT4
	POPJ	PP,
	CAIN	AT5,RANDOM
	JRST	FF02
	HLRZ	AT5,D.BL(AFT)
	SKIPN	R.BPLR(AT5)
	POPJ	PP,		;NO TABLE ENTRY IF SEQIO FILE AND NO IO DONE YET
FF02:	MOVEI	AT4,AT4
	HRLM	AT4,SU.FBT
	MOVE	AT4,SU.CFB
	MOVEM	AFT,@SU.FBT
	AOS	SU.CFB
	POPJ	PP,
;	RESTOR: A SUBROUTINE WHICH RESTORES THE DEFINITION OF
;	        THE CURRENT RECORD IN THE PROCESSING OF AN ISAM FILE.
;		IT DOES THIS BY CHECKING F.WSMU IN THE FILE TABLE.
;		IF F.WSMU IS NOT -1, THEN IT POINTS TO A PLACE WHERE
;		THE NEXT RECORD FLAG AND CURRENT KEY HAVE BEEN SAVED.
;
;
;	ARGUMENTS:
;
;		AFT POINTS TO A FILE TABLE
;
;
;	CHANGES:
;
;		ALL REGISTERS EXCEPT ACRR, AFT, AP, PP, I
;		SU.T5
;		SU.T6
;		SU.T7
;		SU.T8
;		F.WSMU(AFT)  (SET TO -1)
;		NXTREC(AT3)

RESTOR:	HRRZ	AT1,F.WSMU(AFT)
	CAIN	AT1,-1
	POPJ	PP,
	MOVEM	I,SU.T8
	MOVEM	ACRR,SU.T5	;SAVE I, ACRR
	MOVEM	AP,SU.T6	;SAME AP
	LDB	AT2,FTRM
	MOVE	AT2,[OCT 441000000000,440600000000,0,440700000000]-1(AT2)
	HRRI	AT2,1(AT1)	;PREPARE BYTE POINTER TO SAVED KEY
	EXCH	AT2,F.WBSK(AFT)	;EXCHANGE WITH SYMBOLIC KEY
	MOVEM	AT2,SU.T7
	MOVE	AP,AFT
	PUSHJ	PP,OWNFAK	;DO FAKE READ TO POSITION AT SAVED KEY
	  TRN

	MOVE	AFT,AP		;RESTORE AFT
	MOVE	AP,SU.T6	;RESTORE AP
	HRRZ	AT1,F.WSMU(AFT)
	MOVE	AT2,0(AT1)
	HLR	AT3,D.BL(AFT)
	MOVEM	AT2,NXTREC(AT3)	;RESTORE NEXT RECORD FLAG TO ITS SAVED
				;VALUE
	MOVE	AT2,SU.T7
	MOVEM	AT2,F.WBSK(AFT)	;RESTORE SYMBOLIC KEY
	SETO	AT2,
	HRRM	AT2,F.WSMU(AFT)	;SET F.WSMU TO -1 TO INDICATE NOTHING TO
				;RESTORE

	MOVE	ACRR,SU.T5	;RESTORE ACRR
	MOVE	I,SU.T8		;RESTORE I
	POPJ	PP,		;RETURN
;	CLVACI: CHECK FOR LOW-VALUES AND CONVERT, IF NECESSARY
;		THIS ROUTINE IS CALLED BY THE READ, WRITE, REWRITE,
;		DELETE, AND FREE CODE FOR ISAM FILES. A CHECK IS MADE
;		TO SEE IF THE OBJECT RECORD HAS A KEY OF LOW-VALUES.
;		IF IT DOES NOT, NOTHING HAPPENS. IF IT DOES, THEN WE
;		MUST DETERMINE IF THIS IS THE FIRST OPERATION ON THIS
;		FILE SINCE THE RETAIN STATEMENT. THIS IS DETERMINED BY
;		CHECKING F.WSMU(AFT). IF IT IS -1, THEN WE HAVE ALREADY
;		DONE THIS BEFORE AND CAN RETURN WITH NO FURTHER
;		PROCESSING. OTHERWISE, WE HAVE TO CHECK FURTHER. THE
;		PROBLEM IS THAT IF SEVERAL RECORDS HAVE BEEN RETAINED FOR
;		THE SAME FILE, THEN THE BLKNUM CODE LEFT THE FILE POINTING
;		AT THE LAST RECORD RETAINED. BLKNUM ALSO SAVED THE KEY OF
;		THE ORIGINAL CURRENT RECORD AT THE END OF THE RRT AND
;		PUT A POINTER TO IT IN THE F.WSMU(AFT). SO, WHEN F.WSMU
;		DOES NOT EQUAL -1, IT MEANS THAT THIS LOW-VALUES OPERATION
;		IS RELATIVE TO THE ORIGINAL CURRENT RECORD AND WE MUST
;		NOW RESTORE THE FILE TO THAT POINT. THERE IS A SPECIAL
;		CASE, HOWEVER. IF THERE WAS ONLY ONE RECORD RETAINED
;		FOR THIS FILE, THEN THE BLKNUM CODE LEFT US POINTING
;		AT IT, SO WE CAN TELL CBLIO THAT THE "NEXT RECORD" IS
;		REALLY THE CURRENT RECORD. THIS MEANS WE DO NOT HAVE TO
;		RESTORE THE FILE, POTENTIALLY SAVING I-O, AND RE-READING
;		THE CURRENT RECORD WILL DEFINITELY RESULT IN NO
;		I-O.
;
;		THE WHOLE REASON FOR READING THIS LOW-VALUES RECORD AT THIS
;		TIME IS TO CHECK TO SEE IF THE RECORD BEING READ,
;		WRITTEN, REWRITTEN, DELETED, OR FREED IS THE ONE RETAINED.
;		ONCE THE READ HAPPENS HERE, THE BLOCK NUMBER AND KEY WILL
;		BE COMPARED AGAINST ALL ENTRIES IN THE RRT FOR THIS FILE.
;		IF NONE MATCHES, A FATAL ERROR MESSAGES RESULTS.
;
;
;
;	ARGUMENTS:
;
;		AFT CONTAINS A  POINTER TO THE FILE TABLE
;
;	RETURN:
;
;		TO 1(PP) IF NOT LOW-VALUES
;		TO 0(PP) IF LOW-VALUES, KEY IN SU.RBP
;
;
;	CHANGES:
;
;		ALL REGISTERS EXCEPT K, AURS, AP, PP, ACRR, AFT
;		SU.T1
;		SU.T2
;		SU.T3
;		SU.T4
;		NXTREC(AT1)
;		F.WSMU(AFT)


CLVACI:	MOVEM	K,SU.T1
	MOVEM	AURS,SU.T2
	MOVEM	AP,SU.T3
	MOVEM	ACRR,SU.T4
	MOVE	AT1,F.WBSK(AFT)
	MOVE	AP,AFT
IFN ANS68,<
	PUSHJ	PP,LVTST	;CALL CBLIO TO COMPARE KEY WITH
				;LOW-VALUES
	JRST	CLVAC1
	AOS	0(PP)
>;END IFN ANS68
IFN ANS74,<			;IN ANS74, THIS ROUTINE IS ONLY CALLED
				; IF THE GUY IS DEFINITELY DOING I/O TO
				; THE "NEXT RECORD".
	JRST	CLVAC1
>;END IFN ANS74

CLVAC2:	MOVE	AFT,AP
	MOVE	K,SU.T1
	MOVE	AURS,SU.T2
	MOVE	AP,SU.T3
	MOVE	ACRR,SU.T4
	POPJ	PP,

CLVAC1:	HRRZ	AFT,AP		; IF F.WSMU IS -1, WE HAVE ALREADY
	HRRZ	AT1,F.WSMU(AFT)	; RESTORED THE FILE ONCE
	CAIN	AT1,-1
	JRST	CLVAC3		;JUMP IF IT'S NOT NECESSARY TO 
				;RESTORE OUR POSITION IN THE FILE

;
;	THE FOLLOWING CODE COMPARES THE FILE TABLE ADDRESS OF THE
;	OBJECT RECORD AGAINST ALL THE RRT ENTRIES. IF IT IS
;	DETERMINED THAT THERE IS ONLY ONE MATCH, THEN NO RESTORATION
;	IS NECESSARY SINCE BLKNUM WILL HAVE LEFT US POINTING AT THE
;	CORRECT RECORD.
;

	SETZ	AT3,
	MOVE	AT1,SU.RRT
CLVAC5:	CAML	AT1,SU.CRH
	JRST	CLVAC6
	HRRZ	AT2,0(AT1)
	CAMN	AT2,AFT
	ADDI	AT3,1
	LDB	AT2,[POINT 8,0(AT1),17]
	ADD	AT1,AT2
	JRST	CLVAC5

CLVAC6:	SOJN	AT3,CLVAC7	; REMOVE THE EFFECT OF MATCHING AGAINST ITSELF
				; IF THERE WAS MORE THAN ONE RETAINED RECORD FOR THIS FILE
				;  WE MUST DO REAL RESTORE
	MOVE	AT1,SU.RRT	;LOOP AGAIN.. IF REALLY LOW-VALUES READ
				; AND DIDN'T GET EOF, SET NXTREC=-1
CLVBC5:	CAML	AT1,SU.CRH
	JRST	CLVBC6
	HRRZ	AT2,0(AT1)
	CAMN	AT2,AFT
	 JRST	SETIFL		;SET NXTREC = -1 IF WE SHOULD
	LDB	AT2,[POINT 8,0(AT1),17]
	ADD	AT1,AT2
	JRST	CLVBC5

SETIFL:	LDB	AT2,AT1HVF	;EOF BIT - SET IF LV RETAIN FOUND EOF
	JUMPN	AT2,CLVBC6	;IF EOF FOUND,  DON'T RESET FLAG
	HLRZ	AT1,D.BL(AFT)
IFN ANS74,<
	HRRZ	AT2,D.RFLG(AFT)	; First check to see if special del/rewrt
	TRNN	AT2,SAVNXT	;  And if so, need saved next flag value
	JRST	SETIF1		; Not special, cont
	HLRZ	AT2,RWDLKY(AT1)	; Get saved next rec flag
	HRRM	AT2,NNTRY(AT1)	; And set it
				;  this will ensure that the proper saved 
				;  record position will be used
	TDNA			; Now skip setting NNTRY
SETIF1:
>; END IFN ANS74
	SETOM	NXTREC(AT1)	; TELL CBLIO THAT THE CURRENT RECORD IS
	HLLOS	F.WSMU(AFT)	; THE "NEXT RECORD".
	JRST	CLVAC3

CLVBC6:	HLRZ	AT1,D.BL(AFT)	; YES, NO RESTORE NECESSARY, TURN OFF F.WSMU
	HLLOS	F.WSMU(AFT)	;CLEAR "RESTORE NECESSARY" FLAG
	JRST	CLVAC3

CLVAC7:	PUSHJ	PP,RESTOR	;RESTORE OUR POSITION IN THE FILE AT
				;RETAIN TIME, IF NECESSARY

CLVAC3:
IFN ANS68,<
	PUSHJ	PP,OWNFAK	;DO FAKE READ

	JRST	CLVAC4		;JUMP IF NOT END OF FILE

	PUSHJ	PP,UHV		;USE HIGH VALUES IF END OF FILE
>;END IFN ANS68
IFN ANS74,<
	HRRZ	AT2,D.RFLG(AFT)	; First check to see if special del/rewrt
	TRNN	AT2,SAVNXT	;  And if so, need saved next flag value
	JRST	CLVA3A		; Not special, cont
	HLRZ	AT1,D.BL(AFT)	; Get buffer location
	HLRZ	AT2,RWDLKY(AT1)	; Get saved next rec flag
	HRRM	AT2,NNTRY(AT1)	; And set it
				;  This will ensure that the proper saved 
				;  record position will be used
CLVA3A:
	PUSHJ	PP,FAKNXT
	JRST	CLVAC4		;NOT EOF
	PUSHJ	PP,UHV		;USE HIGH VALUES IF END OF FILE
>;END IFN ANS74

	HLR	AT4,D.BL(AP)
	SETZM	NXTREC(AT4)	;SET NXTREC TO 0 TO GUARANTEE
				;USER GETS END OF FILE ALSO
	JRST	CLVAC2

CLVAC4:	HLR	AT4,D.BL(AP)	;SET NEXT RECORD FLAG SO THAT READ
				;WILL GET SAME RECORD WE GOT WITH
				;THE FAKE READ
	SETOM	NXTREC(AT4)
	JRST	CLVAC2
;	FED: THE FILE ENQUEUE/DEQUEUE ROUTINE
;
;	ARGUMENTS:
;
;		1. AT4: OWN ACCESS BITS FOR READ, REWRITE, WRITE, DELETE
;
;		2: AT5: OTHERS ACCESS BITS FOR SAME
;
;		3: 0(ACRR) POINTS TO THE FILE TABLE FOR THE FILE
;
;		4: ACRR LH = 0 => ENQUEUE; LH = 1 => DEQUEUE
;
;
;	CHANGES:
;
;		AT4
;		AT5
;		ANYTHING CHANGED BY QUEUE
;		K
;		J
;		AT1
;		AT2
FED:	MOVEI	J,4

FED1:	LDB	K,[POINT 1,AT5,32]
	TRNE	AT4,000010
	TRO	K,000002

;	K NOW CONTAINS AN INTEGER BETWEEN 0 AND 3 REPRESENTING THE FOUR
;	COMBINATIONS OF OWN AND OTHERS USE OF THE VERB CURRENTLY
;	REPRESENTED IN BIT 32 OF AT4 AND AT5.

	JRST	.+1(K)
	JRST	H0		;NEITHER OWN NOR OTHER USE

	JRST	H1		;NOT OWN USE BUT OTHER USE

	JRST	H2		;OWN USE BUT NOT OTHER USE

	HRLZI	AT1,1		;OWN USE AND OTHER USE

H10:	MOVN	AT2,J
	SUBI	AT2,1
	HLR	AT1,ACRR
	PUSHJ	PP,QUEUE

H1:	LSH	AT4,1
	LSH	AT5,1
	SOJG	J,FED1
	POPJ	PP,

H2:	TDZA	AT1,AT1
H0:	HRLZI	AT1,3
	JRST	H10
;	ZSATB: A ROUTINE THAT ASKS CBLIO TO REFRESH ITS IN-CORE STORAGE
;	       ALLOCATION TABLES
;
;	INPUTS:
;
;		1. ACRR POINTS TO THE APPROPRIATE ENTRY IN THE RETAINED RECORDS TABLE
;	
;	RETURNS: NOTHING
;
;	CHANGES: AT1, AFT, USOBJ+13(AT1)

ZSATB:	HRRZ	AFT,0(ACRR)
	LDB	AT1,FTOTA
	TRNN	AT1,000003
	POPJ	PP,		;RETURN IF OTHERS NEITHER
				;INSERTING NOR DELETING
	HLRZ	AT1,D.BL(AFT)
	SETZM	USOBJ+13(AT1)
	POPJ	PP,
CHGCNV:	CAMN	ACRR2,[MOVS AT5,CHTAB(AT5)]	;[447]
	HRLI	ACRR2,(HLRZ AT5,(AT5))		;[447]
	CAMN	ACRR2,[MOVE AT5,CHTAB(AT5)]	;[447]
	HRLI	ACRR2,(HRRZ AT5,(AT5))		;[447]
	POPJ	PP,				;[447]

;	UHV:	A ROUTINE TO SET HIGH VALUES IN SU.RBP AND 0 IN FS.BN
;
;
;	ARGUMENTS:
;
;		1: AP POINTS TO A FILE TABLE
;
;	RETURNS:
;
;		1: A BYTE POINTER TO HIGH VALUES IN SU.RBP
;
;		2: ZERO IN FS.BN
;
;		3: -1 IN SU.HV
;
;	CHANGES:
;
;		AFT, AT1, SU.RBP, FS.BN, SU.HV


UHV:	MOVE	AFT,AP
	LDB	AT1,FTRM		;[447] GET RECORD MODE
	HRRI	AT1,[OCT 377,77,0,177]-1(AT1) ;[447] VARIOUS HIGH VALUES CHARS
	HLL	AT1,F.WBSK(AFT)		;[447] FILE TABLE SYMBOLIC KEY BYTE PTR
	SETZM	FS.BN
	TLZ	AT1,770000		;[446] IGNORE OLD BIT POS
;	TLO	AT1,440000		;[446] WHEN HERE IT IS ALWAYS WORD ALIGNED
	MOVEM	AT1,SU.RBP
	SETOM	SU.HV			;[447] TELL WORLD HIGH VALUES BEING USED
	POPJ	PP,
;	OWNFAK: OUR OWN ROUTINE TO CALL CBLIO FAKE READ
;
IFN ANS74,<
FAKNXT:	HRLI	AP,RNFLAG		;GET FAKE READ NEXT FLAGS
	TRNA
>;END IFN ANS74
OWNFAK:	HRLI	AP,RFLAG
IFN ANS74,<
	SKIPN	SU.FRF			; IF NOT ALREADY SET BY DEL/REWRT
>
	SETOM	SU.FRF			;  THEN SET FAKE READ FOR RETAIN FLAG
	HLR	AT1,D.BL(AP)		;[445] GET TABLE ADDR OF ISAM STUFF
	MOVE	AT2,GDPSK(AT1)		;[445] GET BYTE PTR USED FOR KEY CONV
	MOVEM	AT2,SU.T9		;[445] SAVE FOR LATER
	MOVEI	AT2,44			;[445] SET UP CORRECT BYTE POS
	DPB	AT2,[POINT 6,GDPSK(AT1),5] ;[445] MAKE IT RIGHT
IFN ANS74,<
	LDB	AT2,F.BFAM		; GET FILE ACCESS MODE
	PUSH	PP,AT2			; SAVE IT HERE
	MOVEI	AT2,%FAM.D		; GET DYNAMIC ACCESS
	DPB	AT2,F.BFAM		; AND SET IT 
>
	PUSHJ	PP,FAKER.
	  TRNA
IFN ANS68,<
	AOS	0(PP)
>
IFN ANS74,<
	AOS	-1(PP)			; INVALID KEY RETURN
	POP	PP,AT2			; RESTORE ACCESS MODE
	DPB	AT2,F.BFAM		; HERE
>
	SETZM	SU.FRF
	HLR	AT1,D.BL(AP)		;[445] GET TABLE ADDR
	MOVE	AT2,SU.T9		;[445] GET BACK ORIG BYTE PTR
	MOVEM	AT2,GDPSK(AT1)		;[445] RESTORE IT
	POPJ	PP,
;	ERROR HANDLING


	EXTERN	KILL.

DEFINE $SUERR(TEXT),<
	TYPE	SUHDR		;TYPE HEADER FOR MESSAGE
	TYPE	[ASCIZ \TEXT\] ;TYPE THE TEXT OF THE ERROR
	JRST	KILL.		;GO OFF TO KILL.
>

SU.ER1:	$SUERR	<RETAIN statement executed when records are already retained, which is not allowed>

SU.ER2:	$SUERR	<Missing constant (internal error)>

SU.ER3:	$SUERR	<RETAIN statement requesting access by verb not listed at OPEN time>

SU.ER4:	$SUERR	<Invalid RETAIN flags (internal error)>

SU.ER5:	$SUERR	<Invalid type code (internal error)>

SU.ER6:	$SUERR	<Key sizes unequal (internal error)>

SU.ER7:	TYPE	SUHDR		;TYPE HEADER FOR MESSAGE
	TYPE	[ASCIZ \Unexpected return from ENQ/DEQ...error code %\]	;[654]
	MOVEI	AT3,14		;[654] OUTPUT ENQ/DEQ ERROR RETURN
SUER7A:	SETZ	AT1,		;[654] CLEAR CHARACTER BUFFER
	LSHC	AT1,3		;[654] GET A DIGIT
	ADDI	AT1,60		;[654] MAKE IT ASCII
	OUTCHR	AT1		;[654] PRINT IT
	SOJG	AT3,SUER7A	;[654] DO IT AGAIN
	JRST	KILL.

SU.ER9:	$SUERR	<OPEN for simultaneous update is not allowed if files are already OPEN for simultaneous update>

SU.ERB:	$SUERR	<Attempt to execute READ, REWRITE, WRITE, or DELETE on record not retained>

SU.ERC:	$SUERR	<Attempt to execute READ, REWRITE, WRITE, or DELETE on record not retained for that purpose>

SU.ERD:	$SUERR	<Unexpected return from ENQ/DEQ during execution of READ, REWRITE, WRITE, or DELETE (internal)>

SU.ERE:	$SUERR	<Insufficient core for ENQ/DEQ to operate>

SU.ERF:	$SUERR	<Insufficient quota for ENQ/DEQ; change the ENQ/DEQ quota parameter in the monitor to run this program>

;PRELUDE TO THE ABOVE MESSAGES
SUHDR:	ASCIZ/?COBOL: Simultaneous update - /

	END