Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/cblsrc/lsu.mac
There are 14 other files named lsu.mac in the archive. Click here to see a list.
; UPD ID= 1948 on 11/7/88 at 2:04 PM by KSTEVENS                       
TITLE	LSU FOR LIBOL
SUBTTL	LIBOL'S SIMULTANEOUS UPDATE PACKAGE. J MASLANKA / RUTH FONG

	SEARCH COPYRT
	SALL

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

COPYRIGHT (C) 1974, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION


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

;REVISION HISTORY:

;V13 ******
; KWS 	23-JUN-88	[1204] Retained records don't exist if unavailable path
; KWS	22-JUN-88	[1203] When using RETAIN NEXT QT should be 2 also.
; KWS	19-MAR-85	[1136] Change error message if DEQ. with out ENQ.
; KWS	10-MAR-85	[1135] Make RETAIN NEXT work properly.
; RLF	14-MAY-84	[1124] For 'WRITE', 'REWRITE', and 'DELETE', don't
;				regenerate byte pointer to key field in buffer

;V12B *****
; JSM	16-FEB-83	[1054] Allow SMU OPEN UNAVAILABLE after DECLARATIVE.
; RLF	10-FEB-83	[1051] Fix REWRITE after READ NEXT for relative file.
; RLF	21-DEC-82	[1047] DEQ all records when fatal error encountered.
; DMN	22-Jun-81	[1000] Make simultaneous update of relative files work again

;V12 *****

; WTK	 1-Nov-80	;[654] Supplement ENQ/DEQ error return message.
; HAM	 3-Oct-80	;[650] Make CNTRY external.
; HAM	 4-Sep-80	;[643] Do not do long-term lock on TOPS-10.
; 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.

;*****


	SEARCH	LBLPRM
	SEARCH	FTDEFS
IFN TOPS20,<
	SEARCH	MONSYM,MACSYM
>
IFE TOPS20,<
	SEARCH	UUOSYM,MACTEN
>

	SEARCH	COMUNI

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 USING THE TOPS-10/20 ENQ CAPABILITY. THERE ARE TWO LEVELS
;	AT WHICH ENQ LOCKS CAN BE CLAIMED OR RELEASED. (1) IS AT THE 
;	LEVEL OF FILE-SHARING, AND (2) IS FOR RECORD SHARING OR LOCKING.
;	THE USER MUST SPECIFY THE FILE LEVEL IN THE COBOL OPEN STATEMENT
;	BEFORE ATTEMPTING TO ACCESS THE RECORD LEVEL IN THE RETAIN
;	STATEMENT. AT BOTH LEVELS, THE USER MUST SPECIFY COMPLETELY
;	THE DESIRED COLLECTION OF RESOURCES AND LOCKS ON THEM WILL BE
;	EITHER GIVEN FOR THE ENTIRE COLLECTION OR DENIED COMPLETELY.
;	HOWEVER, AT BOTH LEVELS THE LOCKS MAY BE RELEASED INDIVIDUALLY
;	OR IN A PIECEMEAL FASHION.
;
;
;	THE PACKAGE CONSISTS OF THREE MAJOR EXECUTABLE PARTS.
;
; (1)	CALLS ACCESSED FROM COMPILED USER CODE TO DO LOCKING AND UNLOCKING
;
;	(A) FOR FILES: LFENQ. TO LOCK; SU.CL, CALLED BY C.CLOS AND CL.MIX
;		IS MENTIONED BELOW.
;
;	(B) FOR RECORDS: LRENQ. TO RETAIN, AND LRDEQ. AND LRDEQX TO FREE
;		LRDEQ. DOES FREE ... EVERY AND LRDEQX DOES FREE ... KEY.
;		LRDEQ. CALLS LRDEQX
;
; (2)	CALLS ACCESSED BY CBLIO OR RMSIO, PRIMARILY TO CHECK IF A RECORD
;	HAS BEEN RETAINED BEFORE A VERB FOR IT IS DONE, I.E. SU.RD, SU.WR,
;	SU.RW, SU.DL AND SU.RMS .  THE EXCEPTION IS SU.CL, WHICH IS 
;	CALLED BY THE CLOSE ROUTINES C.CLOS IN CBLIO AND CL.MIX IN RMSIO.
;	THE PRIMARY FUNCTION OF SU.CL IS TO FREE LOCKS ON FILES. HOWEVER,
;	IT WILL DO A FREE EVERY ON A FILE FIRST IF THE USER STILL HAS
;	LOCKS OUTSTANDING ON IT.
;
; (3)	A BUNCH OF LITTLE ROUTINES WHICH DO UTILITY FUNCTIONS SUCH AS
;	MOVING KEYS, COMPARING KEYS, SETTING UP FAKE READS AND BUFFER
;	FLUSHING ROUTINES. THE MOST FAMOUS OF THESE IS THE BLKNUM ROUTINE,
;	WHICH DETERMINES FILE BLOCK NUMBERS FOR RRT ENTRIES GIVEN THE
;	FILE KEY OR NEXT RECORD.
;
;
;	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: (HEADER WORD OF ARGUMENT LIST -- APPEARS ONLY ONCE)
;
;	        RH = NUMBER OF RECORDS TO BE RETAINED (N)
;	        LH = 0 => USER DID NOT SUPPLY AN UNAVAILABLE STATEMENT
;	        LH = 1 => USER SUPPLIED AN UNAVAILABLE STATEMENT
;
;	(THE PATTERN OF WORDS 2 AND 3 IS REPEATED UNTIL N IS EXHAUSTED.
;	(EACH RETAINED REQUEST HAS ONE ENTRY. EACH KEYED ENTRY CONTAINS
;	(BOTH WORDS 2 AND 3, BUT EACH "NEXT" ENTRY HAS ONLY WORD 2 AS
;	(NOTED BELOW.)
;
;	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.
;
RARGRD==400	;BIT 9
RARGRW==200	;BIT 10
RARGWR==100	;BIT 11
RARGDL==40	;BIT 12
RARGUF==20	;BIT 13
RARGRI==10	;BIT 14
RARGRN==4	;BIT 15
;
;	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
;			    DISPLAY-7 OR DISPLAY-8 ITEM. FOR RMS FILES
;			    IT IS A THREE-WORD DESCRIPTOR AS INDICATED
;			    BELOW. THE THIRD WORD CONTAINS THE NUMBER
;			    OF THE KEY OF REFERENCE AND THE ADDRESS OF
;			    THE KEY FIELD OR 0 IF IT IS WORD-ALIGNED.
;			    TYPE 15 IS CURRENTLY THE ONLY ONE IMPLEMENTED
;			    FOR RMS-20 FILES.
;
;			    THE DESCRIPTOR HAS THE FOLLOWING FORMAT:
;
;			WORD 1: A BYTE POINTER TO THE IDENTIFIER OR
;				LITERAL. FOR RMS FILES THIS MUST BE AN
;				IDENTIFIER.
;
;			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
;
;			WORD 3: (FOR RMS FILES ONLY) THIS WORD EXISTS 
;				ONLY FOR TYPE 15
;
;				LH: NUMBER OF THE KEY OF REFERENCE,
;				    WHERE 0 MEANS PRIMARY KEY, 1 MEANS
;				    FIRST ALTERNATE, ETC.
;				RH: IS ADDRESS OF WORD-ALIGNED FIELD
;				    WHICH CONTAINS THE KEY VALUE.
;				    IF THIS FIELD CONTAINS 0 (ZERO),
;				    THE ADDRESS IN THE RH OF WORD 1
;				    ABOVE IS WORD-ALIGNED ALREADY AND
;				    IS THE ADDRESS TO USE.
;
;
;
;	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).
;
;	************************************************************
;	*                                                          *
;	* NOTE: THIS FORM OF SIMULTANEOUS UPDATE FOR SEQUENTIAL    *
;	* FILES HAS BEEN DECOMMITTED IN VERSION 13 OF COBOL-10/20. *
;	*                                                          *
;	************************************************************
;
;	(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 CONSTANT, EXCEPT LOW-VALUES.
; 
;
;
;	AN IMPORTANT ASSUMPTION MADE BY THIS ROUTINE IS THAT THE
;	ABOVE RESTRICTIONS WERE CHECKED AT COMPILE TIME
;
;		**************************
;		*			 *
;		* RETAINED RECORDS TABLE *
;		*			 *
;		**************************
;
;	THIS PROCEDURE USES A DATA STRUCTURE CALLED THE RETAINED
;	RECORDS TABLE. THE FORMAT OF THIS TABLE IS AS FOLLOWS:
;
;	WORD 0: THE MISCELLANEOUS WORD 
;
;		BITS 0-2: QUEUEING TECHNIQUE (CRRQT)
;		BITS 3-8: ENQUEUEING FLAGS (CRRFLG)
;		BIT 9: F BIT - SET TO INDICATE THIS ENTRY SHOULD BE
;			       FREED (CRRF)
;		BITS 10-17: THE INCREMENT TO THE NEXT ENTRY,
;			   IN WORDS (CRRINE)
;		BITS 18-35: LOCATION OF THE FILE TABLE OR 0, 
;			    INDICATING THE RECORD HAS BEEN FREED.
;
;
;	WORD 1: BLOCK NUMBER WORD
;
;		BIT 0: FLAG FOR RETAINING NEXT RECORD (RRTNXT)
;		BIT 1: FLAG THAT NEXT RECORD DOES NOT EXIST (RRTHVF)
;				I.E. EOF WAS FOUND
;		BIT 2: UNUSED
;		BITS 3 - 35: 33-BIT BLOCK OR BUCKET NUMBER FOR ENQ
;				USER REQUEST CODE (CRRBLK)
;
;	WORD 2:
;		(FOR RMS FILES ONLY -- IS UNUSED FOR NON-RMS FILES)
;
;		BITS 0-17: NUMBER OF KEY OF REFERENCE (APPLIES
;				TO INDEXED FILES ONLY)
;		BITS 18-35: ADDRESS OF KEY BUFFER
;
;	WORDS 3 THRU N-1: KEY VALUE BEING RETAINED
;
;
;
;	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)
;
;***********************************************************************
;	GENERALIZED FLOW OF EXECUTION
;	-----------------------------
;
; COBOL SIMULTANEOUS UPDATE OPTION 1 FUNCTIONS AT TWO LEVELS. THE UPPER
; LEVEL IS THAT OF FILE I-O AND THE LOWER IS RECORD I-O. AT EACH LEVEL
; THE GENERAL PHILOSOPHY OF LSU IS TO ACQUIRE ALL REQUIRED RESOURCES AT
; ONCE OR TO ABANDON THE ATTEMPT WITH NO RESOURCES ACQUIRED. ON THE 
; OTHER HAND, AT BOTH LEVELS RESOURCES MAY BE RELEASED IN A PIECEMEAL
; FASHION.
;
; THERE ARE FIVE MAJOR EXECUTABLE FUNCTIONS IN THIS MODULE, AND THEY ARE
; DISCUSSED BELOW IN THE ORDER IN WHICH THEY ARE EXECUTED. THE FORMATS
; OF THE LOCKS ARE DISCUSSED IN ANOTHER SECTION ENTITLED "OVERVIEW OF
; LSU ENQ LOCK FORMATS".
;
;   (1) ACQUIRE FILE RESOURCES, IN "LFENQ.", WHICH SHOWS UP AS AN EXTERNAL
;       CALL IN THE GENERATED USER CODE. ALL FILES TO BE SHARED HAVE TO
;       BE OPENED IN ONE COBOL OPEN STATEMENT. "LFENQ." CALLS THE APPROPRIATE
;       FILE OPENING MODULE EITHER FROM CBLIO OR RMSIO TO OPEN EACH FILE
;       INDIVIDUALLY. FOR EACH FILE THERE WERE ORIGINALLY THE FOUR VERB
;       VERB RESOURCES FOR RECORD I-O WHICH COULD BE LOCKED. A FIFTH WAS
;       INVENTED FOR RMS RELATIVE AND INDEXED FILES. THIS IS THE SMU 
;       OPTION 1 CAPABILITY LOCK, WHICH INDICATES TO ALL THAT THE FILE 
;       IS CURRENTLY LOCKED BY A RUN-UNIT DOING SMU OPTION 1.
;
;       AFTER ALL THE FILES TO BE SHARED HAVE BEEN SUCCESSFULLY OPENED,
;       THE LOCKS FOR THESE ARE GENERATED IN THE "FED" ROUTINE ON THE
;       BASIS OF THE VERB FLAGS SET IN THE F.WSMU WORD OF THE FILE TABLE.
;	THE LOCKS ARE FORMATTED IN THE "QUEUE" ROUTINE AND ACQUIRED IN THE
;	"ENQDEQ" ROUTINE. IF NOT ALL LOCKS ARE AVAILABLE AND THE USER HAS
;       PROVIDED NO FAILURE ROUTE THE PROGRAM BOMBS WITH A FATAL ENQ/DEQ
;       ERROR. IF "UNAVAILABLE" IS THERE, THE "UNAVAILABLE" EXIT IS PC+2
;       AND THE NORMAL EXIT TO USER GENERATED CODE IS PC+1. IF INSTEAD
;       DECLARATIVES IS PRESENT, THE FAILED EXIT TO NORMAL USER CODE IS
;	COBOL "NEXT SENTENCE".
;
;   (2) ACQUIRE RECORD RESOURCES, IN "LRENQ.", WHICH SHOWS UP AS ANOTHER
;       EXTERNAL CALL IN THE USER'S GENERATED CODE. THE USER NAMES ALL
;       OF THE RECORD RESOURCES AND THE CORRESPONDING VERBS WHICH HE
;       WISHES TO USE ON THEM IN ONE COBOL RETAIN STATEMENT. THE LRENQ.
;       ROUTINE GOES THROUGH FOUR LOOPS AS FOLLOWS: (1) SET UP THE
;       RETAINED RECORDS TABLE (RRT), (2) ISOLATE ANY UNRESOLVABLE LOCK
;       REQUESTS FOR "NEXT" AND INDEX-ALTERING REQUESTS (THESE ARE KNOWN
;       AS AMBIGUOUS REQUESTS.) AND ENQ THE APPROPRIATE WHOLE-FILE LOCK.
;       THIS IS THE ZERO (0) USER CODE FOR RELATIVE FILES, AND FOR INDEXED
;       FILES THIS IS THE INDEX CAPABILITY LOCK. (3) USING THE "BLKNUM"
;       ROUTINE, CONVERT THE REQUESTED
;       KEY OR RESOLVED "NEXT" INTO FILE BLOCK OR BUCKET NUMBERS AND 
;       POST THESE TO THE RRT ENTRIES. (4) FORMAT THE ENQ LOCK REQUESTS
;       AND MAKE THE SECOND OR MAIN ENQ REQUEST FOR ALL OF THE RESOLVED
;       DATA BLOCKS OR BUCKETS. IF THE USER SUPPLIES THE "UNAVAILABLE"
;       CLAUSE, THE NORMAL RETURN IS TO PC+2 AND THE "UNAVAILABLE" TO
;       PC+1. NOTE: THIS IS THE REVERSE OF LFENQ. IF THE USER DOES NOT 
;       SUPPLY THE "UNAVAILABLE" CLAUSE AND THE RETAIN FAILS, HE GETS A
;       FATAL PROGRAM FAILURE.
;
;       SINCE THE THIRD LOOP CONVERTS RECORD KEY VALUES INTO BLOCK NUBERS
;       THERE IS A LIKELIHOOD ON SOME FILES THAT SOME DIFFERENT KEY VALUES
;       WILL SHARE THE SAME FILE BLOCK OR BUCKET NUMBER. IN THIS CASE,
;       ONLY ONE REQUEST IS MADE THE OWNER OF THE LOCK AND ALL OTHERS
;       ARE SAID TO BE QUEUED FOR THE LOCK. THE OWNER IS THE FIRST RRT
;       ENTRY WITH THE HIGHEST SEVERITY. I.E. IF ANY REQUESTS ARE FOR
;       AN EXCLUSIVE LOCK (WRITE OR DELETE) THE FIRST ONE IS THE OWNER.
;       OTHERWISE, THE FIRST REQUEST FOR A SHARED LOCK IS THE OWNER.
;       THIS IS WORKED OUT IN LOOP 4.
;
;       THE "BLKNUM" ROUTINE DOES "FAKE" READS TO GET THE BLOCK NUMBERS
;       FOR NON-RMS INDEXED FILES AND BUCKET NUMBERS FOR RMS INDEXED AND
;       RELATIVE FILES. THIS MEANS THAT IT ACTUALLY READS THE FILE BUT
;       DOES NOT RETURN ANY DATA TO THE USER. FOR NON-RMS FILES IT USES
;       THE SAME LIBOL BUFFERS AS THE REGULAR READS, SO IT HAS TO GO
;       THROUGH ENORMOUS GYRATIONS WITH FORCED READS (FORCR.) AND FORCED
;       WRITES (FORCW.) TO RESTORE LIBOL'S BUFFERS TO THE STATE WHERE
;       THEY WERE BEFORE THE RETAIN BEGAN TO EXECUTE. FOR RMS FILES THE
;       SU.RMS ROUTINE USES A SHADOW RAB, WHICH IS A RAB PARALLEL TO
;       THE ONE WHICH MANAGES THE USER'S DATA, AND IT IS CONNECTED TO
;       THE FAB, SO IT IS A REAL RAB. THIS ROUTINE DOES REAL READS TO
;       THE FILE THROUGH THE SHADOW RAB, BUT SINCE IT IS A SEPARATE RAB
;       THE ROUTINE CAN SIMPLY DISCARD THE DATA WHEN IT IS FINISHED WITH
;       IT. FOR NON-RMS FILES, THE "BLKNUM" ROUTINE SIMPLY CALCULATES
;       THE APPROPRIATE BLOCK NUMBER WITHOUT DOING ANY FILE ACCESS.
;
;   (3) CHECK IF RECORD RESOURCE RETAINED, IN THE ROUTINES SU.RD, SU.WR,
;       SU.RW, SU.DL AND SU.RMS. THESE ARE NEVER CALLED FROM USER GENERATED
;       CODE. THEY ARE CALLED FROM THE RECORD I-O VERB ROUTINES WHICH ARE
;       EMBEDDED AS EXTERNAL CALLS IN THE GENERATED CODE. THE FOUR NON-RMS
;       ROUTINES EACH DO AN INITIAL VERB-SETTING FLAG AND THEN MERGE INTO
;       ONE ROUTINE. THEY TAKE THE
;       USER SUPPLIED KEY VALUE OR "NEXT" AND CHECK THE RRT TABLE FOR AN
;       ENTRY FOR THE SPECIFIED FILE WHICH HAS THE SAME KEY VALUE OR 
;       WHICH HAS BEEN FLAGGED AS RETAINED FOR NEXT. THEY ARE INVISIBLE
;       TO THE USER UNTIL THEY FAIL TO FIND AN APPROPRIATE RRT ENTRY FOR
;       THE USER'S SPECIFIED RECORD. THEN THEY WILL BOMB THE PROGRAM
;       WITH A FATAL PROGRAM FAILURE. THEY DO NOT DO ANY ENQUEUING. THE
;       THE SU.xx ROUTINES FOR NON-RMS FILES ALSO DO FAKE READS TO MAKE
;       SURE THAT THE USER'S BUFFER CONTEXT IS CORRECT. IF THEY ARE
;       SUCCESSFUL THEY RETURN TO THE CALLING ROUTINE AT PC+1.
;
;   (4) RELEASING ACQUIRED RECORD RESOURCES. AT USER LEVEL THERE ARE 
;       THREE WAYS THAT THIS CAN BE DONE: (1) IMPLICITLY BY THE RECORD 
;       I-O VERB, (2) EXPLICITLY BY THE "FREE" VERB, AND (3) IMPLICITLY 
;       BY THE "CLOSE" VERB. 
;
;       (1) THE IMPLICIT FREE BY THE RECORD I-O VERB
;       DOES ONE OR TWO THINGS. THE FIRST THING IS TO ZERO THE VERB FLAG
;       IN THE RRT ENTRY. SECOND, IF ALL THE VERB FLAGS BECOME ZERO THE 
;       RECORD I-O VERB CALLS "LRDEQX" TO FREE THE REQUESTED RECORD.
;       HOWEVER, IF THE VERB SELECTION IS "ANY" OR "UNTIL FREED" IS
;       SPECIFIED, THE RECORD MUST BE EXPLICITLY FREED AS IN (2) BELOW.
;
;       (2) THE EXPLICIT FREE VERB CALLS "LRDEQ." FROM THE GENERATED USER
;       CODE, AND THIS ROUTINE LINES UP ALL THE REQUESTS TO BE FREED. IF
;       ALL THE REQUESTS ON A FILE OR ALL REQUESTS ARE TO BE FREED A GROUP
;       REQUEST IS GENERATED AND PASSED ON TO "LRDEQX" WHICH DEQUEUES
;       EVERY RECORD LOCK ON THE FILE OR FILES. IF SPECIFIC RECORD REQUESTS
;       ARE TO BE FREED, "LRENQ." PASSES THEM INDIVIDUALLY TO "LRDEQX",
;       WHICH CHECKS TO SEE IF THE REQUEST IS THE OWNER OF AN ENQ LOCK.
;       IF IT IS NOT, THE REQUEST IS MERELY CANCELLED FROM THE RRT BY
;       ZEROING OUT THE FILE TABLE ADDRESS IN THE RRT. IF IT IS THE OWNER
;       OF A LOCK, "LRDEQX" LOOKS AT THE REST OF THE RRT ENTRIES TO SEE
;       IF THERE IS ANOTHER ENTRY WHICH WANTS THE SAME BLOCK OR BUCKET
;       TO BE LOCKED. IF SO, THE OWNERSHIP OF THE ENQ LOCK IS TRANSFERRED
;       TO THAT RRT ENTRY AND THIS REQUEST IS CANCELLED AS ABOVE. HOWEVER,
;       THE OTHER RRT ENTRY MAY NOT WANT THE ENQ LOCK AT THE SAME SEVERITY.
;       IN THIS CASE, "LRDEQX" WILL DIMINISH THE SEVERITY OF THE LOCK AND
;       MODIFY IT THROUGH ENQ, BUT IT WILL NEVER AUGMENT THE SEVERITY.
;       (I.E., IT WILL GO FROM EXCLUSIVE TO SHARED BUT NOT THE OTHER WAY.)
;	WHEN OWNERSHIP OF A LOCK IS TRANSFERRED FROM ONE RRT ENTRY TO
;       ANOTHER, THE OTHER IS SAID TO BE "PROMOTED".
;
;       (3) RECORD LOCKS ARE FREED IMPLICITLY BY THE "CLOSE" VERB. THIS
;       IS THE FIRST THING DONE BY SU.CL, WHICH SETS UP A REQUEST TO
;       FREE ALL RECORD LOCKS ON THE FILE AND CALLS "LRDEQX" TO DEQUEUE
;       THEM ALL. SU.CL IS ONLY CALLED BY THE APPROPRIATE CLOSE ROUTINE,
;       EITHER C.CLOS IN CBLIO OR CL.MIX IN RMSIO. IT IS NEVER CALLED
;       DIRECTLY FROM THE GENERATED USER CODE.
;
;   (5) RELEASING ACQUIRED FILE RESOURCES. THIS IS THE SECOND THING DONE
;       BY SU.CL, AND IT IS DONE ON A PER-FILE BASIS. SU.CL CALLS THE
;       "FED" ROUTINE TO GENERATE THE LOCK REQUESTS, AND THE "QUEUE"
;       ROUTINE TO FORMAT THE REQUEST BLOCKS FOR DEQ AND THEN CALLS
;       ENQDEQ. FOLLOWING THE SUCCESSFUL DEQ, SU.CL CLOSES THE FILE.
;       AS YOU ARE AWARE, MANY FILES MAY BE NAMED IN ONE COBOL "CLOSE"
;       STATEMENT, BUT THE CODE IS GENERATED TO CLOSE EACH ONE INDIVID-
;       UALLY IN THE USER'S CODE BY MAKING AN EXTERNAL CALL TO THE
;       APPROPRIATE CLOSE ROUTINE, C.CLOS FOR NON-RMS FILES OR CL.MIX
;       FOR RMS FILES.
;
;
;
;       GENERALIZED FLOW DIAGRAM FOR SMU OPTION 1 EXECUTION
;       ---------------------------------------------------
;
;     COBOL VERBS
;     -----------
;
;    "OPEN"     "RETAIN"     "READ","WRITE","REWRITE","DELETE"       "FREE"      "CLOSE"
;     ----       ------       ----   -----   -------   ------         ----        -----
;
;
;     LIBOL ROUTINES
;     --------------
;
;   +------+    +------+    +----------------------------------+    +------+    +------+
;   |LFENQ.|--->|LRENQ.|--->|READ., RDNXT.,WRITE.,RERIT.,DELET.|--->|LRDEQ.|--->|C.CLOS|
;   +------+    +------+    |----------------------------------|    +------+    |------|
;      |           |        |RD.MIR,RD.MIS,WT.MIR,RW.MIR,DL.MIR|       |        |CL.MIX|
;      |           |        +----------------------------------+       |        +------+
;      |           |                        |          |               |           |
;      |        +------+                    |          |               |        +------+
;      |        |BLKNUM|                    |          |               |        |SU.CL |
;      |        +------+                    |          |               |        +------+
;      |           |                        |          |               |           |
;      |           |                        |          +---------------+-----------+
;      |           |                        |                          |
;      V           V                        V                          V
;   +------+    +------+    +--------------------------+            +------+
;   |C.OPEN|    |FAKER.|    |SU.RD, SU.WR, SU.RW, SU.DL|            |LRDEQX|
;   |------|    |------|    |--------------------------+            +------+
;   |OP.MIX|    |FA.MIR|    |SU.RMS|        |
;   |OP.MIS|    |FA.MIS|    +------+        V
;   +------+    +------+                 +------+
;                                        |FAKER.|
;                                        +------+
;
;	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
	ATMP0==0	;A NAME FOR AC0, WHICH SHALL BE A TEMP FOREVER.
	ATMP1==1	;THIS NAME AND THE FOLLOWING THREE ARE GIVEN FOR
	ATMP2==2	; FOR USAGE WITH SU.RMS BECAUSE OF THE STRANGE
	ATMP3==3	; MISMATCH OF AC ASSIGNMENTS BETWEEN RMSIO AND LSU
	ATMP4==4	; THEY APPLY ONLY TO THE CODE IN SU.RMS

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

;	SMU OPTION 1 FLAGS AND BITS

F.SMU1==2			;SMU OPTION 1 CAPABILITY FLAG
SM1.GP==52			;SMU OPTION 1 CAPABILITY SHARER GROUP NO.

FA%NXT==1B9			;FAKE READ NEXT RECORD
FA%KYR==1B10			;KEY REFERENCE SPECIFIED FOR FAKE READ
FA%FAK==1B11			;THIS READ IS A FAKE READ

VB%NXT==1B9			;RECORD I-O VERB FOR NEXT RECORD
VB%KYR==1B10			;RECORD I-O VERB IS KEYED

;
;
;	EXTERNAL ENTRY POINTS
;
;	
	ENTRY	LFENQ.,LRENQ.,LRDEQ.,LRDEQX,SU.RD,SU.RW,SU.WR,SU.DL,SU.CL
	ENTRY	SU.RMS	;CALLED FROM RMSIO.MAC FOR COBOL TO CHECK RECORD I-O VERBS
;	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>
;
;	RANDOM CONSTANTS 
;
;
;	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

URSNXT:	POINT	1,0(AURS),15	;"NEXT RECORD" FLAG

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

RRTNCK:	POINT	1,1(ACRR),2	;SET IF DOING RMS RECORD I-O FOR RETAINED NEXT RECORD

; 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

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

FRMS:	POINT	1,F.RMS(AFT),7	;RMS FLAG IN FILE TABLE

IFE TOPS20, <
FTCN:	POINT	4,D.CN(AFT),15	;TOPS-10 CHANNEL NUMBER IN FILE TABLE
>
IFN TOPS20, <
FTCN:	POINT	18,D.JFN(AFT),35	;TOPS-20 JFN 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)
RTNXSH:	POINT	1,F.WSMU(AFT),13	;"Retain Next Record" has shared
					; lock on file.
RTNXCL:	POINT	1,F.WSMU(AFT),14	;"Retain Next Record" has entire
					; file locked exclusively.
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
IDXSHR:	POINT	2,F.WSMU(AFT),17	;FLAG INDICATING SHARED/EXCLUSIVE
					;=0 IF INDEX EXCLUSIVE
					;=1 IF INDEX SHARED
					;=3 IF INDEX GROUP SHARED


UFSCON=URSCON			;CONSTANT IN USER FILE SPECIFICATION

UFSFLG:	POINT	7,0(AUFS),15	;FLAGS IN USER FILE SPECIFICATION
;THERE ARE SEVEN BITS IN THIS FIELD AND THERE REALLY SHOULD BE EIGHT. THE
;LEFTMOST BIT IS MISSING, AND IT IS THE READ BIT FOR SELF. ASSUMING THIS
;BIT THE FIELD BREAKS DOWN INTO TWO SUB-FIELDS OF FOUR BITS EACH. THE
;LEFT HALF CONTAINS THE BITS FOR SELF ACCESS AND THE RIGHT HALF THE BITS
;FOR OTHERS ACCESS THESE BITS ARE IN THE SAME ORDER IN BOTH SUB-FIELDS
;AND THEY INDICATE THE SMU RECORD VERB CAPABILITIES FOR SELF AND OTHERS.
;LEFTMOST BIT IS FOR READ, NEXT FOR REWRITE, NEXT FOR WRITE, AND THE
;RIGHTMOST IS FOR DELETE. AT LFENQ1 + 4 A TRO INSTRUCTION ALWAYS GIVES
;READ CAPABILITY TO SELF.
;
;	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
	EXTERN	F.BFAM		;FILE ACCESS MODE BYTE PTR
	EXTERN	SAVNXT		; D.RFLG field for del/rewrt next rec position

	RFLAG==002000		;SET IN LH OF 16 WHEN CALLING FAKER.
	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

	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
;
;		OVERVIEW OF LSU ENQ LOCK FORMATS
;               --------------------------------
;
;	THE LOCK REQUESTING PROCESS INVOLVES TWO MAJOR FACTORS, (1)
;	DETERMINING THE PROPER BLOCK NUMBERS TO BE LOCKED ON THE USERS
;	SHARED FILES, AND (2) THE FLAGS AND GROUP NUMBERS TO BE SET
;	IN THE LOCK REQUEST. WHEN WE TALK ABOUT BLOCK NUMBERS HERE
;	WHAT IS ACTUALLY BEING DESCRIBED IS THE CONVENTIONS FOR
;	CREATING THE 33-BIT USER CODES WHICH ARE SUPPLIED AS PART OF
;	THE ENQ REQUEST BLOCK WHEN AN ENQ MONITOR CALL IS MADE.
;
;	THERE ARE TWO SETS OF CONVENTIONS WHICH ARE USED FOR BLOCK
;	NUMBERS IN THIS ROUTINE. ONE IS FOR NON-RMS FILES. IT IS
;	DESCRIBED UNDER HEADINGS I AND II AND IS THE STANDARD LOCKING
;	CONVENTION WHICH HAS BEEN USED HISTORICALLY FOR THOSE FILES. THE
;	SECOND IS DESCRIBED UNDER HEADING III AND IS THE LOCKING CODE
;	CONVENTION FOR RMS FILES EXCEPT THAT TWO ADDITIONAL CAPABILITY 
;	LOCKS HAVE BEEN DEVELOPED TO COVER TWO ITEMS WHICH WILL BE DESCRIBED
;	BELOW, WHICH ARE THE SMU OPTION 1 CAPABILITY AND THE RECORD 0
;	CAPABILITY FOR RETAINING A NEXT RECORD WHICH CANNOT BE DETER-
;	MINED UNAMBIGUOUSLY. THE RMS-20 LOCKING CONVENTIONS ARE
;	WRITTEN UP IN CHAPTER 8 OF THE RMS V0 DESIGN DOCUMENT.
;
;  I. LOCKING CONVENTIONS FOR NON-RMS FILES.
;
;	FOR LOCKING RECORD I-O CAPABILITIES ON THE FILE AT OPEN TIME.
;		(SEE LFENQ.)
;
;	BLOCK 2 ** 33 - 5: THE FILE READ CAPABILITY AT OPEN TIME
;	BLOCK 2 ** 33 - 4: THE FILE REWRITE CAPABILITY AT OPEN TIME
;	BLOCK 2 ** 33 - 3: THE FILE WRITE CAPABILITY AT OPEN TIME
;	BLOCK 2 ** 33 - 2: THE FILE DELETE CAPABILITY AT OPEN TIME
;
;	THERE IS ONE LOCK REQUEST SET UP FOR EACH VERB AS REQUIRED.
;	THESE BLOCK NUMBERS ARE SET UP IN THE ENQ REQUEST BLOCK IN
;	CONJUNCTION WITH THE GROUP NUMBER AND THE EXCLUSIVE BIT.
;	TWO GROUP NUMBERS ARE USED, 0 AND 1. THERE ARE FOUR COMBINATIONS
;	OF LOCKING ACTIONS AVAILABLE PER VERB, AS FOLLOWS.
;
;   A.	OPEN	 FOR	VERB	 OTHERS	VERB
;
;		SHARER GROUP 0, EXCLUSIVE LOCK BIT NOT SET
;
;		ALLOWS CONCURRENT ACCESS FOR VERB BY MULTIPLE 
;		CONCURRENT USERS.
;
;   B.	OPEN	 FOR	VERB (not) OTHERS	VERB
;
;		SHARER GROUP 0, EXCLUSIVE LOCK BIT SET
;
;		GIVES THIS USER SOLE USE OF THE VERB ON THIS FILE.
;
;   C.	OPEN (not) FOR	VERB	 OTHERS	VERB
;
;		*** NO ENQ REQUEST BLOCK GENERATED ***
;
;		DOES NOT ALLOW THIS USER USE OF THE VERB AND DOES
;		NOT SAY WHAT OTHER USERS ARE ALLOWED TO DO.
;
;   D.	OPEN (not) FOR	VERB (not) OTHERS	VERB
;
;		SHARER GROUP 1, EXCLUSIVE LOCK BIT NOT SET
;
;		CURRENT USER WILL NOT USE VERB, AND NO OTHER USER IS
;		ALLOWED TO USE IT. THIS IS KIND OF A "PHONY" LOCK
;		BECAUSE IT IS THEORETICALLY POSSIBLE FOR A USER TO
;		KNOW ABOUT GROUP 1, BUT LSU IS SET UP TO UNDERSTAND
;		GROUP 1 TO MEAN THAT NO ONE USES THE VERB RESOURCE.
;
;   II.	LOCKS ON VARIOUS KINDS OF DATA BLOCK RESOURCES, AT RETAIN TIME
;		PRIOR TO RECORD I-O VERBS. ALL SHARER GROUP NUMBERS
;		ARE 0. LOCK IS EITHER SHARED OR EXCLUSIVE DEPENDING
;		ON VERB SELECTION IN THE RETAIN STATEMENT. GENERALLY
;		UPDATES NEED EXCLUSIVE LOCKS, AND ALL RETRIEVALS TAKE
;		SHARED LOCKS. HOWEVER, ON AN INDEXED FILE A REWRITE
;		OR A DELETE WILL TAKE AN EXCLUSIVE LOCK ON THE DATA
;		BLOCK, BUT ONLY A SHARED LOCK ON THE INDEX OF THE FILE,
;		BECAUSE THESE VERBS DON'T UPDATE THE INDEX.
;		(SEE LRENQ. ROUTINE, QUEUING TECHNIQUES AND BLKNUM.)
;
;		THE RETAIN  VERB DOES THE LOCKING, AND THE RECORD I-O
;		VERBS DO NOT. THE RECORD I-O VERB ONLY DOES A CHECK
;		IN THE ROUTINES SU.xx TO SEE IF THE RECORD IS RETAINED.
;		THE "FOR" CLAUSE OF THE RETAIN CONTAINS YOUR VERB SELECTION
;		AND IT MUST BE A SUBSET OF THE "FOR" CLAUSE ON YOUR OPEN.
;		ALSO, THE "FOR" CLAUSE OF THE RETAIN DOES NO CHECKING
;		ON THE FOLLOWING RECORD I-O VERBS. THUS, IF YOU RETAIN
;		FOR ANY AND ONLY DO A READ, LRENQ. DOES ALL THE CHECKING
;		AND LOCKING FOR EVERY RECORD I-O VERB. SOME OF THE
;		CODE IN LRENQ. LOOKS LIKE OVERKILL, BUT MAY NOT BE, IN
;		THOSE CASES WHERE IT MUST PROCESS AN OVERLY GENEROUS
;		"FOR" CLAUSE.
;
;   A.	BLOCKS 1 TO 2 ** 33 - 6: LIVE DATA BLOCKS ON THE FILE
;
;	IF WE CALL ENQ/DEQ WITH A 33 BIT IDENTIFIER EQUAL TO 1234 WE
;	ARE LOCKING DATA BLOCK NUMBER 1234. ETC. THE BLKNUM ROUTINE FINDS
;	THE BLOCK NUMBER. THIS ROUTINE IS CALLED BY THE THIRD LOOP OF
;	LRENQ.
;
;   B.	BLOCK 2 ** 33 - 1: THE PRIMARY INDEX OF THE FILE, FOR ISAM FILES
;		ONLY. THIS HAS THE EFFECT OF LOCKING THE ENTIRE FILE
;		BOTH IDX AND IDA BECAUSE ACCESS TO DATA IN AN ISAM
;		FILE IS SOLELY THROUGH THE FILE'S INDEX.
;		WHEN WE CALL ENQ/DEQ WITH A 33 BIT IDENTIFIER EQUAL TO
; 		2 ** 33 - 1 WE ARE LOCKING THE INDEX OF THE FILE. 
;
;   C.	BLOCK 0: USED ONLY WITH RETAIN NEXT ON INDEXED AND RELATIVE FILES.
;		THE ENTIRE FILE IS LOCKED BECAUSE RETAIN NEXT WAS NOT
;		ABLE TO ESTABLISH THE BLOCK NUMBER OF THE NEXT RECORD.
;		THIS CAN HAPPEN IN SOME CASES WITH INDEXED AND
;		RELATIVE FILES, I.E. WHEN THE USER ATTEMPTS TO LOCK
;		A NON-EXISTENT RECORD FOR WRITE.
;		ALSO, ALL UPDATES TO RELATIVE FILES ARE NOW LOCKING ON
;		BLOCK 0 BECAUSE THERE ARE EXTREME AMBIGUITIES DUE TO
;		THE FACT THAT THE BLOCK NUMBER IS CALCULATED AND NOT
;		RETRIEVED VIA ACCESSESS TO THE FILE. FOR READ NEXT TO
;		A RELATIVE FILE IT IS PATENTLY MEANINGLESS TO CALCULATE
;		THE BLOCK NUMBER BECAUSE YOU DON'T KNOW WHERE THE NEXT
;		RECORD IS ON THE FILE WITHOUT TRYING TO ACCESS IT.
;		IN ORDER TO SET THIS UP RIGHT, WE WOULD HAVE TO RE-
;		CONSTRUCT ALL OF THE WORK FOR RELATIVE FILES IN CBLIO
;		WHICH WAS DONE FOR ISAM FILES.
;
;  III.	33-BIT CODES FOR RESOURCE LOCKS FOR RMS-20 FILES
;
;	THE 33-BIT CODE IS INCLUDED IN THE .ENQUC WORD IN THE INDIVIDUAL
;	LOCK REQUEST BLOCK. THESE LOCK REQUESTS, AS WELL AS ALL OTHERS
;	ISSUED FROM THE CONTEXT OF LSU, USE THE 5B2 + 33-BIT FORMAT.
;
;	WITH TWO EXCEPTIONS, THE RMS LOCKS ARE FORMATTED AS SHOWN IN THE
;	RMS V0 DESIGN DOCUMENT. THE TWO EXCEPTIONS WILL BE DESCRIBED BELOW.
;	ALL 33-BIT CODES FOR RMS ARE DIVIDED INTO THREE PARTS. THE FIRST
;	PART IS THE LEFTMOST THREE BIT WHICH ARE A RESOURCE TYPE CODE.
;	THE SECOND PART IS THE RIGHTMOST 18 BITS WHICH IS A NUMERIC
;	"RESOURCE NAME". THE THIRD PART IS THE INTERVENING 12 BITS, WHICH
;	ARE UNUSED AND SET TO 0. THE GENERAL FORMAT IS LAID OUT BELOW.
;
;	USER REQUEST WORD (.ENQUC) FOR ENQ LOCKS IN COBOL
;	-------------------------------------------------
;
;        0-2 3-5   6  -  17         18   -   35          BIT NUMBERS
;	+---+---+-------------+-----------------------+
;	| 5 | X |       0     |              Z        |
;	+---+---+-------------+-----------------------+
;	    | <----- 33-BIT USER CODE --------------> |
;
;	WHERE    X = THE THREE-BIT RMS RESOURCE TYPE CODE
;
;	         Z = THE 18-BIT RMS RESOURCE NAME. THIS NAME VARIES IN
;		     MEANING ACCORDING TO THE RESOURCE CODE.
;
;
;	THE FOLLOWING TABLE GIVES A LIST OF RESOURCE CODES AND FOR EACH
;	THE VALUES OF THE "RESOURCE NAMES".
;
;	RES CODES		RESOURCE NAMES
;	---------		--------------
;
;	1 - FILE LOCK		FILE ACCESS VALUE
;				 1 = READ, 2 = REWRITE, 4 = WRITE, 10=DELETE
;				THESE LOCKS SAY WHAT RECORD I-O FUNCTIONS
;				WILL BE DONE BY THE RUN-UNIT ON THE FILE.
;
;				THESE LOCKS ARE ENQUEUED IN LFENQ. AND
;				DEQUEUED IN SU.CL   THE FED ROUTINE 
;				FORMATS THEM IN BOTH PLACES.
;
;				EXAMPLE: 510000,,1
;				THIS SPECIFIES READ CAPABILITY FOR THE 
;				USER WHO OPENED THE FILE.
;
;	2 - CAPABILITY LOCK	CAPABILITY VALUE
;				   1 = INDEX, 2 = SMU OPTION 1
;
;				THESE ARE TWO UNRELATED CAPABILITIES.
;
;				THE SMU OPTION 1 LOCK IS ENQUEUED AND
;				DEQUEUED AT THE SAME TIME AS THE FILE
;				ACCESS LOCKS IN 1 ABOVE. IT LOOKS LIKE
;				THIS: 520000,,2
;
;				THE INDEX CAPABILITY LOCK IS ENQUEUED IN
;				THE SECOND LOOP OF LRENQ. AND IT MEANS
;				THAT THE WHOLE FILE IS LOCKED. IT IS FOR
;				ANY FILE UPDATE FUNCTION TO AN INDEXED
;				FILE WHICH CAN CHANGE THE INDEX STRUCTURE
;				OR WHICH WISHES TO KEEP IT FROM BEING
;				CHANGED. IT LOOKS LIKE THIS: 520000,,1
;
;				IT IS NOTED IN THE RETAINED RECORDS TABLE
;				ENTRY BY SETTING A 1-BIT FLAG.
;
;	3 - BUCKET LOCK		BUCKET NUMBER - FOR INDEXED FILES AND
;				  RELATIVE FILES WHERE A BUCKET NUMBER
;				  HAS BEEN FOUND BY THE FAKE READS.
;				  THIS BUCKET NUMBER IS MADE THE RESOURCE
;				  NAME, AND ONLY THE NAMED BUCKET IS LOCKED.
;				  THIS LOCK LOOKS GENERALLY LIKE THIS:
;				  530000,,BUCKET-NO
;
;				THE LOCK IS ENQUEUED IN LOOP 4 OF LRENQ.
;				AND IS DEQUEUED IN LRDEQX. IT IS KEPT IN
;				THE RETAINED RECORDS TABLE WHILE IT IS
;				IN EFFECT.
;
;	0 - RECORD LOCK		NULL VALUE - FOR RELATIVE FILES ONLY
;				  IS USED ONLY IF BUCKET NO. CANNOT
;				  BE ASCERTAINED BY FAKE READS. IT HAS
;				  THE EFFECT OF LOCKING THE ENTIRE 
;				  RELATIVE FILE. IT LOOKS LIKE THIS:
;				  500000,,0
;
;				THE LOCK IS ENQUEUED IN LOOP 2 OF LRENQ.
;				AND IS DEQUEUED IN LRDEQX. IT IS KEPT IN
;				THE RETAINED RECORDS TABLE WHILE IT IS
;				IN EFFECT.
;
;	EXCEPTIONS
;	----------
;
;	1. SMU OPTION 1 - CAPABILITY VALUE = F.SMU1 == 2
;		THIS LOCK WILL ONLY BE REQUESTED BY COBOL PROGRAMS WANTING
;		TO DO SMU OPTION 1 ON A FILE. THIS MEANS THAT COBOL PRO-
;		GRAMS DOING SMU OPTION 1 WILL BE ABLE TO ACCESS THE FILE
;		SHARED IF NO USER WANTS IT EXCLUSIVELY. THE COBOL SHARE
;		GROUP NUMBER FOR THIS HIDDEN FORM OF SHARING IS CURRENTLY
;		1 (ONE). NO OTHER LANGUAGE OTS IS SUPPOSED TO KNOW ABOUT
;		IT. HOWEVER, RMS WILL KNOW ABOUT IT AND RESPECT IT.
;
;	2. RECORD 0 FOR NULL RECORD LOCK OR BUCKET NUMBER OF BUCKET LOCK
;		FOR THE AMBIGUOUS CASE OF RETAINING NEXT RECORD. WILL
;		LOCK THE FILE (INDEXED OR RELATIVE) EXCLUSIVELY FOR
;		RETAIN FOR ANY FORM OF UPDATES OR SHARED IF RETAIN IS
;		FOR RETRIEVAL ONLY.
;	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.FKR		;SET TO -1 IF FAKE READ IS FROM BLKNUM ROUTINE
	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.ACR		;TEMP TO SAVE POINTER TO CURRENT RRT ENTRY
				; FOR RECORD I-O VERBS FOR SMU OPTION 1

	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

; INTERFACE WITH RMSIO

	EXTERN	FA.MIR	;FAKE READ ON KEY FOR RMS FILES
	EXTERN	FA.MIS	;FAKE READ SEQUENTIAL FOR RMS FILES

	EXTERN	RMKCUR	;TO HOLD ADDR OF CURRENT RMS INDEX KEY DESCRIP
	EXTERN	QCODE	;TO HOLD 33-BIT USER CODE FOR ENQ REQUEST
	EXTERN	SM.ARG	;TWO-WORD ARG BLOCK FOR CALL TO RMS FAKE READS
	EXTERN	SM.BUF	;ADDRESS OF RMS SHADOW BUFFER FOR RMS FAKE READS
	EXTERN	SM.RLN	;RECORD LENGTH IN BYTES FOR CALL TO RMS OPEN
	EXTERN	SM.BN	;BUCKET NUMBER RETURNED FROM FAKE READ CALL
	EXTERN	SM.BSZ	;RMS FILE BYTE SIZE FOR FAKE READS
	EXTERN	SM.KBF	;RMS KEY BUFFER ADDRESS FOR FAKE READS
	EXTERN	SM.KRF	;RMS INDEXED KEY OF REFERENCE NUMBER FOR FAKE READS
	EXTERN	VB.FLG	;BYTE POINTER TO VERB FLAG IN FIRST ARG WORD,
			; DEFINED IN RMSIO.MAC
;	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.:	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

	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

	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)

	SETZ	AT1,		;INITIALIZE RETAIN-NEXT-EXCLUSIVE FLAG
	DPB	AT1,RTNXCL	; IN F.WSMU WORD OF FILE TABLE

	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:

;BECAUSE THE RFA OF AN RMS-20 RELATIVE FILE POINTS ONLY TO THE RECORD NUMBER,
; SMU OPTION 1 RETAIN FOR OTHER THAN READ HAS TO GET HEAVY-HANDED
; AND LOCK UP THE ENTIRE FILE. I DON'T FEEL THAT WE SHOULD ATTEMPT
; TO CALCULATE THE BUCKET NUMBER FOR SUCH FILES HERE BECAUSE IT
; WOULD BE DUPLICATING THE RMS ALGORITHM FOR IT, AND WHAT IF THE
; RMS ALGORITHM CHANGED? IF RMS WERE TO COME BACK WITH THE BUCKET
; NUMBER IN THE RFA AS IT DOES WITH INDEXED FILES THIS OBJECTION
; WOULD BE REMOVED. RMS-20 PUTS THE BUCKET NUMBER OF THE RELATIVE RECORD
; INTO THE LSN FIELD OF THE RAB. HOWEVER, THEY NUMBER THE FIRST BUCKET 
; AS 0. SO WE HAVE TO ADD 1 TO IT IN THE FAKE READS IN ORDER TO PRESERVE
; LSU'S SPECIAL USAGE OF BUCKET 0.

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

; IF WE COME HERE WE ARE DOING SOME FORM OF UPDATE TO THE FILE. WE ARE
; GOING TO BE HEAVY-HANDED. IF THE FILE IS INDEXED, SET THE QUEUING
; TECHNIQUE TO 3 (INDEXED EXCLUSIVE) AND IF IT IS RELATIVE, SET IT TO 7
; (EXCLUSIVE). THIS WILL SAVE SOME SERIOUS LOCKING HASSLES BELOW.
; FOR REWRITE TRYING TO LOCK THE INDEX OF AN INDEXED FILE SHARED AND THE
; DATA BLOCK EXCLUSIVE LED TO AN INTERESTING RACE CONDITION WITH ENQ, SO
; WE DECIDED TO DO AN EXCLUSIVE LOCK ON ALL RECORD I-O THAT DOES FILE
; ALTERING.

;[1157] The 12B/12C functionality of block locking rather than file locking 
;[1157] is being returned. It is unknown as to why it was ever taken away in
;[1157] the first place. Ignore preceding comments.

P6:
	MOVEI	AT3,2		;[1157]Allow shared access... lock on block

	;THIS IS THE MOST OPPORTUNE PLACE TO CHECK FOR A RELATIVE FILE
	; EXCLUSIVE RETAIN OF NEXT RECORD. GET A LITTLE HEAVY-HANDED
	; AND AVOID A LOT OF HASSLES BELOW BY MAKING QT=7 FOR ALL CASES
	; RIGHT OFF THE BAT. ALSO, SET RETAIN-NEXT-EXCLUSIVE FLAG.
	; THIS IS NOT BEING DONE FOR INDEXED FILES BECAUSE THEY DO NOT
	; HAVE THIS PROBLEM WITH RETAIN-NEXT-EXCLUSIVE.

	LDB	AT1,URSNXT	;RETAINING NEXT RECORD?
	CAIN	AT1,0		;
	 JRST	P1		; NO
	SETO	AT1,		;SET RETAIN-NEXT-EXCLUSIVE BIT IN FILE TABLE
	DPB	AT1,RTNXCL	;
;[1203] Delete line so that QT = 2 as above.
	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,4		;SET SIZE OF THIS ENTRY IN THE RETAINED
				;RECORDS TABLE TO 4 WORDS
	JRST	Q9

Q1:
	HLRZ	AT3,D.BL(AFT)	; Get buffer location (NON-RMS FILE) HLRZ FIXES A BUG
	LDB	AT1,FRMS		;CHECK IF DOING RMS FILE
	CAIE	AT1,1		;
	 JRST	Q1A		;NOT RMS
	HRRZ	AT3,D.RMSP(AFT)	;GET ADDR OF RMS CONTROL BLOCK
	SKIPA			;HOP OVER NON-RMS CLEAR
Q1A:
	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	AT2,URSNXT	;RETAINING NEXT RECORD?
	TRNE	AT2,1		;
	 JRST	Q4A		;YES, GO WITH REGULAR FILE TABLE KEY DESCRIP
	LDB	AT2,FRMS		;RMS FILE?
	CAIE	AT2,1		;
	 JRST	Q4A		;NO, GO WITH REGULAR FILE TABLE KEY DESCRIP
		;NOW WE HAVE TO GET THE KEY LENGTH IN BYTES FOR THIS
		; PARTICULAR RMS FILE KEY. GETTING TO IT IS FUN.
	HRRZ	AT2,1(AURS)	;POINTER TO KEY DESCRIPTOR IN CALLING ARG LIST
	HLRZ	AT3,2(AT2)	;GET KEY NO OF THIS RMS INDEX KEY
	IMULI	AT3,2		;DOUBLE IT TO GET RELATIVE POSITION OF
				;THIS KEY IN %N KEY DESCRIP LIST
	HLRZ	AT4,F.RMKL(AFT)	;GET START ADDR OF %N RMS KEY LIST
	ADD	AT4,AT3		;INCREM TO THIS TWO-WORD KEY DESCRIP
	ADDI	AT4,1		; + OFFSET 1 FOR BLOCK HEADER
	MOVEM	AT4,RMKCUR	;SAVE IT ASIDE, TO USE LATER IN THIS CYCLE

	HRRZ	AT3,0(AT4)	;GET KEY LENGTH IN BYTES INTO AT3
	SKIPA			;HOP OVER NEXT INSTR, DON'T UNDO ALL THIS
Q4A:
	LDB	AT3,FTKLB	;MOVE INTO AT3 THE LENGTH OF THE KEY IN
				;BYTES
	SETZ	AT2,		;COMPILE RESULT IN AT2
	DIV	AT2,AT1		;COMPUTE NUMBER OF WORDS REQUIRED
				;TO STORE KEY
	SKIPE	AT3
	ADDI	AT2,1		;ROUND UP ANY REMAINDER WHATEVER
	ADDI	AT2,3		;ADD IN THE THREE-WORD TABLE-ENTRY HEADER

	DPB	AT2,CRRINE	;PUT LENGTH OF ENTRY INTO RRT TABLE.

;THIS CODE SETS UP ACRR2 TO POINT TO THE BEGINNING OF AN RRT ENTRY.
; IN VERSION 13 THIS HAS BEEN CHANGED FROM 2 WORDS LESS THAN THE BEGI-
; NING OF THE RRT KEY FIELD TO 3 LESS.

Q2:
	;FIRST INITIALIZE THE KEY FIELD TO BINARY ZEROES. IT HAS ALREADY
	;BEEN ALLOCATED A WHOLE NUMBER OF WORDS AT THE END OF THE RRT ENTRY

	MOVE	ACRR2,ACRR	;USE ACRR2 TO ADDRESS WORDS IN KEY FIELD
	ADDI	ACRR2,3		;POINT AT FIRST WORD OF KEY FIELD
	LDB	AT3,CRRINE	;GET COUNT OF WORDS TO NEXT ACRR ENTRY
	SUBI	AT3,4		;KNOCK OFF 3 WORDS OF HEADER THIS ENTRY AND FIRST WORD IN NEXT ENTRY
				; THIS GIVES COUNT OF WORDS IN KEY FIELD.
Q2C:				;
	SETZM	0(ACRR2)	;ZERO OUT A WORD OF THE KEY FIELD
	ADDI	ACRR2,1		;ADVANCE TO NEXT WORD
	SOJGE	AT3,Q2C		; AND GO ZERO IT IF NECESSARY
	MOVE	ACRR2,ACRR	;USE ACRR2 AS A TEMP TO CARRY POINTER TO
				;KEY POS IN RRT DOWN TO R4:
	LDB	AT1,CRRFLG
	TRNN	AT1,000001
	 JRST	R1		;JUMP IF KEY NOT SUPPLIED
	LDB	AT1,FTAM	;TEST FOR INDEXED ACCESS METHOD
	CAIE	AT1,INDEXD	;
	 JRST	Q2A		; NOT INDEXED
	LDB	AT1,FRMS	;TEST FOR RMS INDEXED
	CAIE	AT1,1		;
	 JRST	Q2A		; NOT RMS INDEXED
	HRRZ	AT1,1(AURS)	;GET KEY-OF-REF # AND KEY BUFFER ADDRESS
	MOVE	AT2,2(AT1)	; FROM ARG LIST
	HRRZ	AT3,AT2		;LOOK AT ONLY ADDRESS IN RH OF WORD
	CAIE	AT3,0		;NOW TEST FOR 0 KEY BUFF ADDR
	 JRST	Q2B		;  NO
	HRR	AT2,0(AT1)	; YES, GET ADDRESS FROM 0-TH ARG WORD
Q2B:
	MOVEM	AT2,2(ACRR2)	; AND PUT IT IN THE RRT ENTRY
	ADDI	ACRR2,1		;THEN BUMP UP ACRR2 TO POINT TO BEGIN POS OF KEY IN RRT
Q2A:
	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,3(ACRR)	; TO RRT ENTRY
	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
	MOVE	AT3,1(T1)	;[1205]GET ARG DESCRIPTOR
	TLNE	AT3,(1B7)	;[1205IS ARGNUM LITERAL
	 LDB	AT2,[POINT 5,1(AT1),35]	;[1174]NUMERIC SIZE FIELD IS SMALLER
	LDB	AT3,FRMS		;DOING RMS FILE?
	CAIE	AT3,1		;
	 JRST	R5A		;NO
	LDB	AT3,FTAM		;INDEXED?
	CAIE	AT3,INDEXD	;
	 JRST	R5A		;NO
	MOVE	AT3,RMKCUR	;GET BACK ADDR OF CURR RMS KEY DESCRIP
	HRRZ	AT3,0(AT3)	;GET KEY SIZE IN BYTES
	SKIPA			; AND HOP OVER OTHER PATH
R5A:
	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:
	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	3(ACRR)		;SET KEY TO ZERO
	JRST	R4		; AND DON'T MOVE ANY KEY
R1A:	
	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,3(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".
	LDB	AT1,RRTNXT
	JUMPE	AT1,S19		;NOT RECORD 0 (NEXT RECORD)
	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
	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	S4A		;[455] JUMP IF EITHER IS TRUE
	JRST	SS3		;NO
S4A:
	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 COME HERE, WE ARE ASKING FOR AN EXCLUSIVE LOCK ON THE WHOLE FILE.
; FOR AN INDEXED FILE, THIS IS THE INDEX CAPABILITY, BUT FOR A RELATIVE
; FILE IT IS THE LOCK ON RECORD 0. FOR INDEXED FILES THE LOCK FORMATS
; ARE DIFFERENT FOR RMS AND NON-RMS AS NOTED IN THE COMMENTS IN THE 
; QONFIL ROUTINE BELOW. BUT, FOR RELATIVE FILES OF BOTH TYPES, WE ARE 
; USING THE BLOCK 0 FORMAT FROM NON-RMS COBOL FILES BECAUSE RMS HAS NO 
; CAPABILITY LIKE THIS. BESIDES, THIS CAPABILITY WILL EXIST ONLY FOR 
; SMU OPTION 1.

S5:

	PUSHJ	PP,QONFIL	;CALL TO SET UP LOCK FORMATS

	SETO	AT2,		;SO QUEUE ROUTINE CAN PLAY ITS LITTLE GAME
	SETZ	AT1,		;SET LH = EXCLUSIVE, RH = ENQUEUE

	PUSHJ	PP,QUEUE	;CREATE REQUEST ENTRY

	LDB	AT1,FRMS		;DON'T DO ZSATB FOR RMS FILES EITHER
	CAIN	AT1,1		;
	 JRST	SS2		;IS RMS FILE

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


;THE PURPOSE OF THE FOLLOWING CODE, FROM U2: DOWN TO U2A:+1 IS TO QUEUE
; UP SHARED LOCKS ON INDEXES OR ENTIRE RELATIVE FILES. ONE PRIMARY USAGE
; IS FOR RETAIN NEXT RECORD FOR READ. THIS CODE SHOULD BE BYPASSED IF
; AN EXCLUSIVE LOCK IS GOING TO BE QUEUED. THIS WAS BEING DONE FOR INDEXED
; FILES, BUT NOT FOR RELATIVE FILES. THIS IS WHY THE NEW CODE WAS ADDED
; FROM U2:+2 TO U2A:.

U2:	SKIPE	SU.Y		;IF Y IS NON-ZERO, THEN A PRIOR
				;REQUEST HAS TAKEN CARE OF OUR INDEX
				;REQUIREMENT
	JRST	SS2

	;BEFORE WE GET INTO QUEUEING UP A SHARED LOCK FOR A RELATIVE FILE
	; CHECK TO SEE IF THE RETAIN-NEXT-EXCLUSIVE FLAG HAS BEEN SET.
	; CHECK FIRST FOR RELATIVE FILES BECAUSE INDEXED FILES ARE NOT
	; AFFECTED, AND WE DON'T WANT TO ALTER THE QUEUEING FOR THEM.

	LDB	AT1,FTAM	;GET FILE ORGANIZATION
	CAIE	AT1,RANDOM	;IS IT RELATIVE?
	 JRST	U2A		; NO
	LDB	AT1,RTNXCL	;GET RETAIN-NEXT-EXCLUSIVE FLAG
	CAIE	AT1,0		;IS IT ON?
	 JRST	SS2		; YES, BYPASS SETTING UP SHARED LOCK ALSO.
U2A:
	PUSHJ	PP,QONFIL	;CALL TO SET UP CAPABILITY LOCKS.

	SETO	AT2,	;FOR QUEUE ROUTINE TO PLAY ITS LITTLE GAME
	HRLZI	AT1,000001	;WE MUST SUBMIT A REQUEST FOR
				;SHARED ACCESS TO THE INDEX
	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
				;IF WE ALWAYS CHANGE QT TO 7 FOR ANY OPER
				; ATION ON A RELATIVE FILE IT IS VERY HEAVY
				; HANDED BUT IT AVOIDS ALL KINS OF MESS
				; WITH LOCK QUEUEING WHICH EXISTS BECAUSE
				; OF THE WAY IN WHICH THE MAIN LOOPS OF THIS
				; ROUTINE ARE CONSTRUCTED.
	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
				;[455] USE PRIOR KEY FOR THIS ENTRY SINCE
				;[455] THIS ENTRY IS A WRITE AFTER READ,
				;[455] UNLESS THE KEY FOR THE PRIOR ENTRY
				;[455] IS ALSO 0
	LDB	AT1,RRTNX3	;GET "NEXT RECORD" FLAG
	JUMPN	AT1,S21		; PRIOR KEY WAS "NEXT RECORD"
	MOVE	AT1,3(ACRR3)	;NO, GET IT
	MOVEM	AT1,3(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,3(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

;QONFIL ROUTINE TO SET UP 33-BIT USER CODE FOR FILE CAPABILITY LOCKS FOR
; INDEX FILES AND RELATIVE FILES. FOR INDEXED FILES THIS IS THE INDEX
; CAPABILITY AND FOR RELATIVE FILES IT IS THE WHOLE FILE LOCK ON RECORD 0.
;
;	USES AC AT1 AND RETURNS 33-BIT LOCK CODE IN QCODE
;			AS WELL AS CODE TO SET LONG-TERM LOCK BIT
;

QONFIL:
	SETOM	QCDLTL##	;SET FLAG INDICATING LONG-TERM LOCK
	SETZM	QCODE		;ASSUME FILE IS RELATIVE
	LDB	AT1,FTAM	;GET FILE'S ORGANIZATION
	CAIN	AT1,RANDOM	;IS IT RELATIVE?
	 JRST	QONXIT		; YES
	SETOM	QCODE		;NO, SET CODE TO -1 FOR NON-RMS INDEXED
	LDB	AT1,FRMS	;GET FILE'S RMS FLAG
	CAIN	AT1,0		;IS IT RMS FILE?
	 JRST	QONXIT		; NOT RMS
	HRLZI	AT1,20000	;YES - SET UP RMS INDEX CAP CODE
	HRRI	AT1,1		;
	MOVEM	AT1,QCODE	;[RLF/JSM] AND SAVE IT FOR QUEUE ROUTINE
QONXIT:
	POPJ	PP,		; AND RETURN TO CALLER
;	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).

V5:	PUSHJ	PP,BLKNUM	;OTHERWISE, GET BLOCK NUMBER
	SETZM	SU.FKR		;OUT OF BLKNUM

	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?
	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
	JRST	W3A		; 

W3B:
	LDB	AT1,FRMS	;IS IT AN RMS FILE? IF SO, WE DON'T WORRY
	CAIE	AT1,0		; ABOUT SAVING AND RESTORING THE CONTEXT
	 JRST	W3A		;  BECAUSE OF THE SHADOW RAB AND BUFFERS

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

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

	MOVEM	AT2,QCODE
	PUSHJ	PP,QUEUE	;QUEUE REQUEST

W1:	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
	LDB	AT2,FRMS	;TEST FOR RMS FILE
	CAIN	AT2,1		; AND IF SO
	 POPJ	PP,		;  RETURN IMMEDIATELY, BECAUSE WE DON'T
				;  HAVE TO WORRY ABOUT FLUSHING BUFFERS.

	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.

	POPJ	PP,		;RETURN TO USER
	MOVE	AP,@SU.FBT
	PUSHJ	PP,FORCR.
	JRST	LREN13
;	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:				;DEQUEUE THE INDEX

	PUSHJ	PP,QONFIL	;SET UP 33-BIT USER CODE
	MOVEI	AT1,1		
;[1172] Deleted two lines @lren97 + 2

	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
	TRN			;IF WE GET BACK HERE, WE SEND USER TO UNAVAILABLE
				; IF HE HAS THEM IN THE STATEMENT. IF NOT, WE
	JRST	ABNORM		; LET ABNORM TAKE CARE OF THAT, TOO.
;	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).
;
;	THE LRDEQ. ROUTINE CONSISTS OF THREE PARTS: (1) A PROLOGUE WHICH
;	HANDLES THE CASE OF "FREE EVERY ..." AND SETS UP FOR THE MAIN
;	LOOP FOR THE OTHER CASES, (2) THE MAIN LOOP WHICH GOES FROM
;	"LRDEQ0:" TO "B6 + 5 / SOJG K,LRDEQ0", AND (3) AN EPILOGUE FROM
;	"A3:" TO THE END OF THE ROUTINE, WHICH CALLS "LRDEQX". THE MAIN
;	LOOP HAS TWO DISTINCT FUNCTIONS. THE FIRST IS TO FIGURE OUT THE
;	FILE'S ACCESS METHOD (AS IN COBOL-68) AND BUILD A BYTE POINTER 
;	TO THE KEY FIELD IN THE RRT ENTRY. THIS PART GOES DOWN TO "A9:"
;	OR TO FRERLV IN THE CASE WITH A RELATIVE FILE KEY OF 0 FOR RETAIN NEXT.
;	SECOND, IS A PAIR OF PARALLEL SUB-LOOPS TO FIND A MATCH FOR THE
;	RECORD TO BE FREED IN THE RRT. THE PRIMARY SUB-LOOP STARTS AT "A9:"
;	AND SEARCHES FOR A MATCH ON KEY. THE SECONDARY SUB-LOOP STARTS
;	AT "FRERLV:" AND SEARCHES FOR A RELATIVE FILE RETAIN NEXT. THE
;	KEY IS NOT TESTED IN THIS LOOP, HOWEVER THE SUB-LOOP IS ENTERED
;	IF A RELATIVE FILE KEY OF 0 IS FOUND IN THE ARGUMENT LIST OF
;	THE FREE VERB.
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:	SETZM	SU.CFB		;ZERO NUMBER OF ENTRIES IN THE FILL/
				;FLUSH BUFFER TABLE
	MOVE	AT1,1(AP)
	TLNN	AT1,FREALR	;FREE EVERY RECORD?

	JRST	A2		;NO

	MOVE	I,SU.RR		;YES, FREE EVERY RECORD
	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,		; AND RETURN TO CALLER

;SET UP TO DO OTHER TWO FORMS OF FREE, I.E. FREE FILENAME ...

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

;BEGINNING OF MAIN LOOP TO FREE RECORDS RETAINED

LRDEQ0:	LDB	AT1,URSCON	;MAKE A LITTLE VALIDITY CHECK
	CAIE	AT1,152		;CHECK FOR GENFIL OPERATOR FOR FREE VERB
	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

	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

	HRRZ	AFT,0(AURS)	;GET ADDRESS OF FILE'S FILE TABLE FROM
				; ARGUMENT LIST

;THE FOLLOWING COMMENT IS PRESERVED FOR POSTERITY DUE TO THE CLARITY
; WITH WHICH IT EXPRESSES THE ORIGINAL IMPLEMENTOR'S INTENTION. IT
; ALSO HAPPENS TO TELL THE TRUTH.

;***********************************************************************
;
;     NOTE: IF THE FILE IS NOT INDEXED, THE KEY IS ALWAYS ONE WORD COMP.
;
;***********************************************************************

	LDB	AT1,FRMS	;IF RMS-20 FILE ZERO OUT SU.HV. WE DON'T
	CAIN	AT1,1		; NEED TO DO HIGH-VALUES ON EOF FOR RETAIN
	 SETZM	SU.HV		;  NEXT STUFF

	LDB	AT1,FTAM	;GET FILE'S ACCESS METHOD
	CAIN	AT1,INDEXD	;AND DISTINGUISH BETWEEN INDEXED AND RELATIVE
	JRST	A9
	SKIPN	AT4,0(AT2)	;THEN TEST BETWEEN RELATIVE WITH A LIVE KEY
				; AND RELATIVE NEXT (KEY CONTAINS 0).
	 JRST	FRERLV
	JRST	A9

;THE FOLLOWING CHUNK OF CODE TESTS OUT THOSE KEYS WHICH CONSIST OF LIVE
; BYTES. THESE MAY BE EITHER INDEX KEYS OR LIVE RELATIVE KEYS.

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

	HRRZ	AFT,0(AURS)	;SET FILE TABLE ADDRESS IN AFT
	LDB	AT2,FRMS		;RMS FILE?
	CAIE	AT2,1		;
	 JRST	A8A		;NO, GO WITH REGULAR FILE TABLE KEY DESCRIP
		;NOW WE HAVE TO GET THE KEY LENGTH IN BYTES FOR THIS
		; PARTICULAR RMS FILE KEY. GETTING TO IT IS FUN.
	HRRZ	AT2,1(AURS)	;POINTER TO KEY DESCRIPTOR IN CALLING ARG LIST
	HLRZ	AT3,2(AT2)	;GET KEY NO OF THIS RMS INDEX KEY
	IMULI	AT3,2		;DOUBLE IT TO GET RELATIVE POSITION OF
				;THIS KEY IN %N KEY DESCRIP LIST
	HLRZ	AT4,F.RMKL(AFT)	;GET START ADDR OF %N RMS KEY LIST
	ADD	AT4,AT3		;INCREM TO THIS TWO-WORD KEY DESCRIP
	ADDI	AT4,1		; + OFFSET 1 FOR BLOCK HEADER
	MOVEM	AT4,RMKCUR	;SAVE IT ASIDE, TO USE LATER IN THIS CYCLE

	HRRZ	AT2,0(AT4)	;GET KEY LENGTH IN BYTES INTO AT2
	SKIPA			;HOP OVER NEXT INSTR, DON'T UNDO ALL THIS
A8A:
	LDB	AT2,FTKLB	;FOR NON-RMS FILES GET THE KEY LENGTH IN BYTES
	MOVEI	AT1,@1(AURS)	;GET ADDRESS OF TWO WORD DESCRIPTOR
				;INTO AT1

	HRRZ	AT3,1(AT1)	;GET SIZE FIELD FROM TWO WORD DESCRIPTOR
				;IN AT3
	MOVE 	AT4,1(T1)	;[1205]GET ARG. DESCRIPTOR
	TLNE	AT4,(1B7)	;[1205]IS ARGNUM LIT.?
	 LDB	AT3,[POINT 5,1(AT1),35]	;[1174]NUMERIC SIZE FIELD IS SMALLER
	CAME	AT2,AT3
	JRST	SU.ER6		;JUMP IF KEY SIZE INAPPROPRIATE;
				;THE COMPILER ALREADY CHECKED THIS,
				; SO IS REDUNDANT.

	MOVE	AT2,0(AT1)	;GET BYTE POINTER TO USER SUPPLIED
				; KEY IN AT2
	LDB	AT4,FRMS	;IF RMS FILE WE HAVE TO GET THIS BYTE POINTER
	CAIE	AT4,1		; BY A MORE CONTRIVED ROUTE.
	 JRST	A9		;  NOT RMS-20 FILE.

	HLRZ	AT4,2(AT1)	;GET USER'S KEY-OF-REFERENCE NUMBER
	MOVEM	AT4,SM.KRF##	; AND SAVE ASIDE FOR COMPARISON BELOW
	HRRZ	AT4,2(AT1)	;GET ADDRESS FIELD FROM RH OF THIRD WORD OF DESCRIPTOR
	CAIN	AT4,0		; IF 0, AT2 IS ALREADY PROPERLY SET UP
	 JRST	A9		;

	MOVE	AT2,AT4		;GET ADDRESS FOR BYTE POINTER INTO AT2
	LDB	AT4,[POINT 6,0(AT1),11] ;GET BYTESIZE PART OF FIRST DESCRIP WORD
	SUBI	AT4,6		;NORMALIZE IT TO USE FOR INDEXING
	HRL	AT2,[OCT 440600		; AND SET UP THE PROPER BYTE
			 440700		;  POINTER
			 0		;
			 441000]-1(AT4)	;
	LDB	AT1,FTRM		; GET RECORDING MODE
	LDB	AT3,FRMS		; GET RMS BIT
	CAIE	AT4,0			; IF 0, NOT RMS FILE
	HRL	AT2,[OCT 440600
			 440700
			 0
			 441100]-1(AT4)	; RMS EBCDIC HAS 9-BIT BYTES
	JRST	A9			;AND GO TO DO KEY COMPARISON

A4:	TLNE	AT1,FREFEV
	JRST	A9		;JUMP IF FREE FILENAME EVERY RECORD 

	LDB	AT1,FRMS	;CHECK TO SEE IF USER IS TRYING TO DEFAULT
	CAIN	AT1,1		; A KEY TO FREE WITH SMU OPTION 1 WITH RMS-20 FILE.
	 JRST	SU.ERH		;  USER IS. GIVE HIM FATAL RUN-TIME ERROR
	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	A13		;KEY WAS FOUND TO BE LOW-VALUES

					;LIVE KEY WAS FOUND
	POP	PP,ACRR2		;RESTORE CONVERT INSTR
	MOVE	AT2,F.WBSK(AFT)		;BYTE POINTER TO SYMBOLIC KEY
	JRST	A10

A13:
	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

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

A11:	MOVEI	AT3,1		;KEY SIZE IS 1 IF RELATIVE 

	HRRZ	AT2,F.RACK(AFT)	;CREATE BYTE POINTER FROM THE 
				;ADDRESS OF THE ACTUAL KEY
	JRST	A12
;HERE WE CHECK OUT FREE RELATIVE KEY 0 FOR RETAIN NEXT
; NOTE: THIS PROCEDURE AND THE ONE AT A9: ARE MAINTAINING A LOOP WHICH
; CHECKS THE CURRENT FREE REQUEST AGAINST THE REQUESTS IN THE RRT.
; EACH OF THEM KEEPS TRACK OF THE ITERATIVE PROCESS IN A COMPLETELY
; DIFFERENT WAY. HOWEVER, BOTH WAYS ARE CORRECT.

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
FRELV0:
	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
				;(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"
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	FRELV0		;[455]
;	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:
	LDB	AT1,FRMS	;IF RMS FILE, WE HAVE TO CHECK KEY-OF-
	CAIE	AT1,1		; REFERENCE NUMBER AFTER FILE AND BEFORE KEY
	 JRST	B4A		;NOT RMS
	MOVEI	AT1,@1(AURS)	;GET ADDR OF THREE-WORD DESCRIPTOR
	HLRZ	AT1,2(AT1)	;GET USER'S KEY-OF-REFERENCE NUMBER
	HLRZ	AT4,2(ACRR)	;GET RRT KEY-OF-REFERENCE NUMBER
	CAME	AT1,AT4		;ARE THE NUMBERS THE SAME?
	 JRST	B3		; NO, GO GET NEXT RRT ENTRY

B4A:
	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,3(ACRR)	;SET ADDRESS TO KEY IN RETAINED RECORDS
				;TABLE

	SKIPN	SU.HV		;[447] FORCED HIGH VALUES IN USE?
	 JRST	B5		;[447] NO

B8:	LDB	AT5,AT2		;[447] GET THE HIGH VALUES CHARACTER
B8A:
	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,B8A		;[447] YES--CHECK NEXT CHAR IN RRT
	JRST	B9		;[447] GOTCHA--JOIN COMMON CODE

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

;	FINAL CLEAN UP AND EXIT TO THE FREE STATEMENT


	RESTRM

	HLRZ	AT1,0(AP)	;DID USER SUPPLY A NOT RETAINED
				;STATEMENT?
	JUMPE	AT1,RET.1	;NO, RETURN TO FREE STATEMENT

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

	AOS	0(PP)		;YES, ADJUST RETURN ADDRESS

	POPJ	PP,		;RETURN TO FREE STATEMENT
;LRDEQX:
;	THIS ROUTINE IS CALLED UNDER THREE DIFFERENT CIRCUMSTANCES.
;
;	(1) BY THE RECORD I-O VERBS WHEN THEY ARE FINISHING UP THEIR
;	    WORK, IN ORDER TO AUTOMATICALLY FREE A RECORD.
;	(2) BY THE CLOSE VERB WHEN IT IS FREE ALL OF THE RECORDS WHICH
;	    WERE (STILL) RETAINED ON A FILE.
;	(3) BY THE FREE VERB ITSELF, WHICH AN EXPLICIT GROUP OF RECORDS
;	    TO BE FREED. THE FREE VERB IS COMPILED AS A CALL TO LRDEQ.,
;	    WHICH SETS THE FREE FLAG IN THE RRT ENTRY AND THEN CALLS
;	    THIS ROUTINE.
;
;	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]

;INITIALIZE LOOP TO PREPARE REQUESTS

	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		;I GUESS THAT THEY ARE BOOLEAN, IN THE
	SETZM	SU.SFQ		; SENSE THAT THEY ARE BINARY SWITCHES.
	SETZM	SU.SFS
	SETZM	SU.SBS

	SETZM	SU.RLV		;[455]
	SETZM	SU.RND		;[455]
C7:	CAMN	ACRR,ACRR2	;I = J? BEGINNING OF SUB-LOOP TO CHECK
				; OUT ENTRIES WITH QT == 1, 2, 3, OR 7

	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

;END OF SUB-LOOP

	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:
	PUSHJ	PP,QONFIL	;TO GET 33-BIT QCODE VALUE
	MOVEI	AT1,1		;SPECIFY DEQUEUE 
	SETO	AT2,		;SPECIFY 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
	LDB	AT2,FRMS	;IF THE FILE IS RMS WE WANT TO FOLLOW THIS
	CAIN	AT2,1		; PATH. HOWEVER, THERE IS NO NEED TO 
	 JRST	C11C		; FLUSH THE BUFFERS.
	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
C11C:
	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

	LDB	AT3,FRMS	;AGAIN, FOR RMS FILES NO NEED TO FLUSH
	CAIE	AT3,1		; THE BUFFERS

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

	MOVEM	AT2,QCODE	;[RLF] SAVE SPECIAL BLOCK NUMBER IN QCODE
	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

	LDB	AT3,FRMS	;AGAIN, FOR RMS FILES NO NEED TO FLUSH
	CAIE	AT3,1		; THE BUFFERS

	 PUSHJ	PP,FILFL2	;CHECK TO SEE IF BUFFER NEEDS TO BE
				;WRITTEN ON DISC
	MOVEM	AT2,QCODE	;[RLF] SAVE BLOCK NUMBER IN QCODE. AT2 APPEARS
				; TO BE UNTOUCHED BY FILFLU ROUTINES.

	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?

	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)

	LDB	AT1,FRMS	;FIND IF THE FILE IS AN RMS FILE
	CAIN	AT1,1		; IF IT IS
	 JRST	C16		;  BYPASS THE RESTORE, 
				;   WHICH IS FOR NON-RMS ISAM FILES.

	LDB	AT1,FTAM	;GET FILE'S ORGANIZATION
	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)

;THIS IS ESSENTIALLY THE END FOR THE MAIN LOOP. WHAT FOLLOWS IS A FAIRLY
; LENGTHY PAIR OF EXCURSIONS FOR INDEXED FILES LOCKED INDEXED EXCLUSIVE
; AND FOR RELATIVE (RANDOM) BLOCK 0 EXCLUSIVE.


C17:	MOVE	AT1,[1,,2]		;CHANGE USAGE OF INDEX TO SHARED
	SETO	AT2,
	MOVEM	AT2,QCODE		;[RLF] SAVE ITS BLOCK NUM ASIDE
	PUSHJ	PP,QUEUE
;	AT THIS POINT WE ARE LOOKING AT AN ENTRY WHICH HAS THE
;	ENTIRE INDEX OF AN INDEXED FILE LOCKED OR AN ENTIRE RELATIVE 
;	FILE LOCKED ON BLOCK 0, BUT WHICH WE'RE GOING TO FREE.
;	WE NEED TO LOCATE THOSE ENTRIES WHICH HAVE PREVIOUSLY BEEN
;	COVERED BY THIS ENTRY (QT'S = 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

;BEGINNING OF CODE FOR QUEUING UP THE INDEXED EXCLUSIVE ENTRY

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)		;GET THE BLOCK NUMBER
	MOVEM	AT2,QCODE		;[RLF] AND SAVE IT ASIDE
	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

;END OF CODE FOR QUEUING UP INDEXED EXCLUSIVE ENTRY

;BEGINNING OF CODE FOR QUEUING UP RELATIVE BLOCK 0 ENTRY

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
	MOVEM	AT2,QCODE	;[RLF]	AND SAVE IT ASIDE
	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

;END OF CODE FOR QUEUING UP RELATIVE BLOCK 0 ENTRY

;THE END OF THE MAIN LOOP BEGUN AT C1:

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


	MOVEI	AT1,AT1
	HRLM	AT1,SU.FBT

;THIS IS THE BUFFER FLUSHING LOOP, AND IT APPLIES ONLY TO NON-RMS FILES
; WE DID NOT LET THE RMS FILE ENTRIES GO THROUGH THE FF0X AND FILFLX
; ROUTINES, SO THEY ARE NOT INVOLVED IN THE COUNT OF THOSE ELIGIBLE FOR
; BUFFER FLUSHING, I.E. SU.CFB, AND THE LIST OF THOSE TO HAVE THEIR 
; BUFFERS FLUSHED, I.E. 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

;NOW FOLLOW THE THREE CALLS TO THE ENQDEQ ROUTINE

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
;	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:	LDB	AT4,UFSCON	;MAKE A LITTLE VALIDITY CHECK
	CAIE	AT4,143
	JRST	SU.ER2
	HRRZ	AFT,0(AUFS)	;GET ADDRESS OF CURRENT FILE TABLE
	LDB	AT4,FTAM	;GET FILE ORG
	CAIN	AT4,SEQFIL	;IS IT SEQUENTIAL?
	 JRST	SU.ERG		;YES - NOT ALLOWED FOR SMU OPTION 1
	LDB	AT4,UFSFLG	;GET FLAGS FROM USER SPEC

	TRO	AT4,000200	;SET FOR READ BIT, ALWAYS GIVE READ TO SELF
	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
	LDB	AT3,FRMS		;DOING RMS FILE?
	CAIE	AT3,0		; YES --
	HRLI	AT4,40700		;FAKE PARAM IS FOR RMSIO
	HRR	AT4,0(AUFS)
	MOVEM	AT4,FET1
	MOVEM	AUFS,FET2	;SAVE OUR REGISTERS
	MOVEM	AP,FET3
	MOVEM	I,FET4
	RESTRM			;RESTORE LIBOL REGISTERS

	LDB	AP,FRMS		;DOING RMS FILE?
	CAIN	AP,0		;
	 JRST	LFENQ2		; NO
	MOVEI	AP,FET1		;YES -- SET UP CALL TO RMS OPEN
	PUSHJ	PP,OP.MIX##	;
	 JRST	LFENQ5		;[1054] GO CHECK IF OPEN ERROR 

LFENQ2:				;OPEN THRU CBLIO
	MOVE	AP,FET1
	PUSHJ	PP,C.OPEN	;OPEN THE FILE
LFENQ5:				;[1054]
	SKIPN	FS.FS##		;[1054] IF NO OPEN ERROR
	 JRST	LFENQ3		;[1054] GO ON
LFENQ4:				;[1054]
	HRRZ	AT1,FET3	;[1054] IF OPEN ERROR, CHECK FOR UNAVAILABLE
	HLLZ	AT1,0(AT1)	;[1054] CLAUSE.
	JUMPE	AT1,SU.ERJ	;[1054] UNAV NOT THERE, BOMB HIM OUT
	JRST	RET.2		;[1054] RETURN TO "NEXT SENTENCE"

LFENQ3:
	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
	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

	SOJG	I,LFENQ1	;CALL ENQDEQ TO DO THE ACTUAL QUEUEING,
				;IF ANY
	RESTRM
	PUSH	PP,AT4		;GET AN AC TO WORK WITH
	MOVE	AT4,SU.EQT	;GET ADDR OF ENQ REQ BLOCK HDR
	SETZM	1(AT4)		;ZERO OUT SECOND WORD
	LDB	AT1,FRMS		;RMS FILE?
	CAIN	AT1,0		;
	 JRST	PPF2		; NO
	LDB	AT1,FTCN		;GET CHAN / JFN FOR REQUEST-ID
	MOVEM	AT1,1(AT4)	; AND PUT IT IN SECOND WORD OF HDR
PPF2:
	POP	PP,AT4		; AND RESTORE THE AC
	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
	LDB	AT3,FRMS		;ARE WE DOING AN RMS FILE?
	CAIN	AT3,1		;RMS FILE?
	ADDI	AT4,100000	; YES - FAKE IT FOR RMSIO
	HRR	AT4,0(AUFS)
	MOVEM	AT4,FET1
	MOVEM	AUFS,FET2
	MOVEM	AP,FET3		;SAVE OUR REGISTERS
	MOVEM	I,FET4
	RESTRM			;RESTORE LIBOL REGISTERS
	LDB	AP,FRMS		;DOING RMS FILE?
	CAIN	AP,0		;
	 JRST	CL1		; NO
	MOVEI	AP,FET1		;YES - SET UP FOR RMSIO CALL
	PUSHJ	PP,CL.MIX##	; TO CLOSE THE FILE
	 JRST	CL2		; AND GO ON.
CL1:
	MOVE	AP,FET1		;CBLIO FILE
	PUSHJ	PP,C.CLOS		;CLOSE THE FILE
CL2:
	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
	INTERN	SU.RMS
	INTERN	CRRF		;FREE FLAG BYTE POINTER FOR SMU OPTION 1 WITH RMS FILE

;THERE IS ONE MORE ENTRY POINT FOR SMU OPTION 1 WITH RMS FILES -- SU.RMS.
; THERE IS ONLY ONE BECAUSE THE FLAG WORD OF THE ARG LIST FOR THE RMSIO
; VERB CALL CONTAINS A FOUR-BIT FIELD WHICH SAYS WHICH VERB IT IS. THIS
; VERB FLAG HAS TO BE CONVERTED TO THE PROPER SMU VERB BIT AND SAVED IN
; SU.VRB. THE CLOSE VERB FOR RMS FILES IS NOT COVERED UNDER SU.RMS 
; BECAUSE IT IS COVERED UNDER THE REGULAR SU.CL.

;SU.RMS IS CALLED FROM THE SETIO ROUTINE IN RMSIO FOR COBOL, AND THAT
; ROUTINE USES THE VERB FLAGS TO DECIDE WHETHER TO CALL THIS ROUTINE.
; THIS ROUTINE WILL ONLY COVER THE FOUR RECORD I-O VERBS, READ, WRITE,
; REWRITE AND DELETE. ITS PURPOSE IS TO CHECK IF THE CURRENT VERB AND
; RECORD HAVE BEEN APPROPRIATELY COVERED IN A PREVIOUS RETAIN STATEMENT
; WHICH IS STILL CURRENTLY IN EFFECT.
;
;THE SU.RMS ROUTINE GOES THROUGH THE FOLLOWING STEPS:
;
; (1) DERIVE THE SMU FLAG FOR THE CURRENT VERB AND SAVE IT IN SU.VRB
;
; (2) USING THE ARGUMENT LIST FROM THE VERB, GET THE KEY FOR THE RECORD
;     I-O OR IN THE CASE OF READ OR SEQUENTIAL ACCESS THIS MAY BE "NEXT".
;
; (3A) IF THERE IS A KEY, COMPARE THE VERB'S KEY VALUE WITH THE KEY
;      VALUES FOUND FOR THIS FILE IN THE RETAINED RECORDS TABLE. THE
;      VERB'S KEY VALUE IS POINTED TO BY THE SECOND WORD OF THE ARG
;      LIST IN THE CASE OF KEYED RECORD I-O.
;
; (3B) IF THERE IS "NEXT" CHECK FOR A "NEXT" RETAINED FOR THIS FILE
;      IN THE RETAINED RECORDS TABLE. IN THE CASE OF "NEXT" THE ARG
;      LIST IS ONLY ONE WORD LONG.
;
; (4) IF THE TEST IN (3A) OR (3B) FAILS, ISSUE THE ERROR MESSAGE THAT
;     THE RECORD WAS NOT RETAINED AND TERMINATE THE PROGRAM WITH A
;     PROGRAM FAILURE.
;
; (5) CHECK THE VERB FLAG IN SU.VRB WITH THE VERBS RETAINED FOR. IF
;     THE VERB WAS NOT RETAINED, ISSUE THE ERROR MESSAGE THAT THE VERB
;     WAS NOT RETAINED FOR AND TERMINATE THE PROGRAM WITH A PROGRAM
;     FAILURE.
;
; (6) IN THE EVENT OF SUCCESS, RETURN TO THE ROUTINE SETIO AND COMPLETE
;     THE RECORD I-O VERB. 
;
;AFTER THE VERB HAS BEEN COMPLETED, AND DURING THE EXIT PROCEDURES BACK
; TO THE USER'S GENERATED PROGRAM CODE, WE WILL CHECK OFF THE VERB AS 
; COMPLETED IN F.WSMU IN THE FILE TABLE. THIS IS STATED SOMEWHERE ELSE 
; IN THIS FILE, BUT IF THE RECORD IS RETAINED FOR "ALL" OR "UNTIL FREED"
; IT IS NOT CHECKED OFF. THIS CHECKING WILL BE DONE IN A CALL TO ANOTHER
; ROUTINE, PERHAPS LRDEQX
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
	SKIPN	SU.RR		;[1136] HAVE RECORD(S) BEEN RETAINED
	JRST	SU.ERB		;[1136] NO
	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
	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:


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
	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:
	TLNN	AP,200		;READ NEXT?
	 JRST	M333		;NO, SKIP THIS
	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:
	SKIPE	SU.HV		;FOUND EOF?
	 JRST	CHK7EF		;YES, CHECK FOR AN ENTRY LIKE THAT
	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
	HRRZ	AT4,F.RACK(AP)	;[1051] GET ACTUAL KEY'S ADDRESS
	MOVE	AT5,(AT4)	;[1051] THEN THE KEY.
	MOVE	AT3,D.RP(AP)	;GET CURRENT REC NUMBER
	CAIN	AT3,AT5		;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,3(ACRR)
	JRST	M10		;JUMP IF KEYS MATCH - WE FOUND IT!

	SKIPN	SU.Y		;SKIP IF "RETAIN NEXT" INTERESTING
	JRST	M2		;NO, CONT
	LDB	AT4,RRTNXT	;GET RETAIN NEXT FLAG
	JUMPE	AT4,M2		;NOT RETAIN NEXT,CONT
	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,3(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 441100000000,440600000000,0,440700000000]-1(AT4)
;;;	MOVE	AT4,[OCT 441000000000,440600000000,0,440700000000]-1(AT4) ;[447]
				;[447]GET BYTE POS + SIZE BASED ON MODE
	HRRI	AT4,3(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

;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

M14:	LDB	AT5,AT3		;[447] GET THE HIGH VALUES CHAR
M14A:
	ILDB	AT2,AT4		;[447] RRT CHAR
	CAME	AT5,AT2		;[447] SAME?
	JRST	M12		;[447] NO
	SOJG	AT1,M14A	;[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.RMS:	;CHECK OUT RMS RECORD I-O VERB FOR PROPER RETAIN KEY/NEXT FOR VERB
	;UNFORTUNATELY THERE IS A GROSS AND DISGUSTING MISMATCH OF AC
	; ASSIGNMENTS WHEN GOING FROM RMSIO TO LSU. AC'S 0 THRU 4 ARE
	; TEMPS IN RMSIO, AND CAN SERVE THE SAME PURPOSE HERE. WE WILL
	; USE THEIR LSU NAMES. ALSO, WE WILL NEED AC16 FOR REFERENCE.
	; THE OTHER TEMPS DEFINED FOR LSU OVERLAP PERMANENT AC'S IN
	; RMSIO. SO WE WILL LEAVE THEM ALONE.


	;GET PROPER SMU OPTION 1 VERB NO. AND SAVE IT IN SU.VRB

	LDB	ATMP1,VB.FLG	;GET THE VERB FLAG FROM THE FIRST ARG WORD
				; THE BYTE POINTER VB.FLG IS DEFINED IN RMSIO
	SUBI	ATMP1,2		;SUBTRACT 2 TO SET UP ENTRY INTO SMALL VERB NUMBER TABLE
				; THIS TABLE HAS POSITION 1 AS ITS BASE
	MOVE	ATMP2,[OCT 10		;READ
			    2		;WRITE
			    4		;REWRITE
			    1]-1(ATMP1)	;DELETE
	MOVEM	ATMP2,SU.VRB	;SAVE SMU OPTION 1 VERB NUMBER

	HRRZ	AFT,0(AP)	;GET FILE TABLE WORD FROM ARG LIST
	HLLZ	ATMP0,0(AP)	;GET FLAGS
	TXNN	ATMP0,VB%NXT	;SEQUENTIAL RECORD I-O?
	 MOVE	ATMP3,1(AP)	; NO, KEYED - GET ADDR OF KEY BUFFER INFO
				;  FROM ARG LIST
	MOVE	ACRR,SU.RRT	;GET ADDRESS OF RRT TABLE
SU.RM1:
	SKIPE	SU.RR		;[1204]ANY RETAINED RECORDS
	CAML	ACRR,SU.CRH	;CHECK IF WE ARE STILL WITHIN THE RRT
	 JRST	SU.ERB		; NO, MATCH ON RECORD NOT FOUND
	HRRZ	ATMP0,0(ACRR)	;GET RRT ENTRY'S FILE TABLE ADDRESS

	;NOW THAT WE HAVE THE RRT ENTRY, WE CHECK IT OUT VS. CURRENT RECORD I-O VERB

	CAME	ATMP0,AFT	;SAME FILE?
	 JRST	SU.RM2		; NO, GO ON TO NEXT ENTRY
	HLLZ	ATMP0,0(AP)	;GET FLAGS AGAIN
	TXNE	ATMP0,VB%NXT	;DOING SEQUENTIAL RECORD I-O?
	 JRST	SU.RM3		; YES

;WE WILL FOLLOW THE GENERAL SU.XX STRATEGY FOR CHECKING RETAIN FOR RECORD
; I-O VERBS, AS FOLLOWS. (1) AT THIS POINT WE CHECK FOR RETAIN ON KEY OR
; NEXT. IF THAT IS OK, (2) WE GO TO CHECK THE VERB. IF THE VERB IS OK
; WE RETURN TO THE USER. THE ONLY CRITERION FOR AN RRT ENTRY MATCH FOR
; THIS PURPOSE IS THE KEY VALUE OR THE "NEXT" FLAG. ONCE THIS CRITERION
; IS MET, THE ENTRY MUST STAND THE TEST FOR VERB. BUT IF IT FAILS THAT
; TEST THE USER GETS A PROGRAM FAILURE AND THE SU.XX ALGORITHM WILL NOT
; GO ON TO ANOTHER RRT ENTRY.

SU.RM4:

	LDB	ATMP1,FTAM	;GET FILE'S ORGANIZATION
	CAIE	ATMP1,INDEXD	; IS IT RMS INDEXED?
	 JRST	SU.RM5		; NO - RMS RELATIVE

SU.RM6:
		;HERE TO CHECK FOR RETAINED KEY FOR RMS INDEXED FILE

		;WE COMPARE THE NUMBER OF THE KEY-OF-REF FIRST
		; IF THAT MATCHES WE COMPARE THE KEY ITSELF

	MOVE	ATMP1,SM.KRF##	;GET THE KEY-OF-REF NO SNARFED FROM REAL FAB
				; OR FROM ARG LIST IF KEYED READ
	MOVE	ATMP0,SU.VRB	;GET VERB FLAGS TO SEE IF WE ARE DOING READ
	TRNE	ATMP0,10	;DOING READ?
	 HLRZ	ATMP1,1(AP)	; YES, GET KEY-OF-REF NO FROM ARG LIST
	MOVEM	ATMP1,SM.KRF##	;STUFF IT BACK FOR USE BELOW, IN CASE WE
				; ARE DOING A READ.
	HLRZ	ATMP2,2(ACRR)	;GET KEY-OF-REF NO FROM RRT ENTRY
	CAME	ATMP1,ATMP2	;SAME KEY-OF-REF NO IN RRT ENTRY?
	 JRST	SU.RM2		; NO - GO ON TO NEXT RRT ENTRY

	;NOW WE DO THE KEY COMPARISONS. THEY WILL BE DONE BYTE BY BYTE
	; A SLOW AND KROCKY METHOD, BUT AT LEAST THE ALGORITHM IS
	; STRAIGHTFORWARD. THE TWO KEYS BEING COMPARED ARE (1) IN THE
	; RRT ENTRY AND (2) IN THE USER'S KEY OR DATA BUFFER. THESE KEYS
	; ARE KEPT IN THE BYTE SIZE OF THE INERNAL DATA USAGE MODE. WE'LL
	; DO IT IN THE FOLLOWING STEPS:
	;
	; (1) CONSTRUCT THE BYTE POINTER TO THE BEGINNING BYTE OF EACH
	;     KEY. FORTUNATELY IN THE CASE OF READ BOTH ARE WORD-ALIGNED
	;     BECAUSE THE KEY FIELD HAS BEEN SET UP TO BE WORD-ALIGNED
	;     BY THE COMPILER. HOWEVER, FOR THE OTHER VERBS WE HAVE TO
	;     ISOLATE THE BEGINNING OF THE KEY FIELD IN THE IN-CORE
	;     USER'S DATA BUFFER BY GOING THRU THE %N TABLE.
	;
	; (2) SET UP THE COUNT OF THE NUMBER OF BYTES. THIS COMES FROM
	;     THE %N TABLE POINTED AT BY THE WORD F.RMKL IN THE FILE TABLE.
	;
	; (3) DO THE KEY COMPARISON LOOP.

	;CONSTRUCT THE BYTE POINTER TO THE RRT ENTRY'S KEY

	HRRZ	AFT,0(AP)	;GET THE FILE TABLE'S ADDRESS
	LDB	ATMP1,FTRM	;GET THE FILE'S IN-CORE DATA MODE
	HRLZ	ATMP2,[OCT 441100	;THEN PUT ITS BYTE POINT NUMBERS
			   440600	; IN LEFT HALF OF AN AC.
			   0
			   440700]-1(ATMP1)
	MOVE	ATMP3,ATMP2	;BUILD BYTE POINTER TO KEY VALUE
	HRRI	ATMP3,3(ACRR)	; IN RRT ENTRY.
	;
	;NOW DO FIRST HALF OF SETTING UP POINTER FOR KEY FIELD. FOR KEYED
	; READS THIS WILL BE SUFFICIENT BECAUSE IT WILL POINT AT THE KEY
	; BUFFER WHICH WAS MADE TO BE WORD-ALIGNED BY THE COMPILER.
	;
	MOVEM	ATMP3,SU.T1	; AND SAVE IT ASIDE

	MOVE	ATMP3,ATMP2	;BUILD BYTE POINTER TO 
	HRRZ	ATMP1,1(AP)	; KEY VALUE IN
	HRRI	ATMP3,(ATMP1)	; RECORD'S KEY BUFFER
	MOVEM	ATMP3,SU.T2	; AND SAVE IT ASIDE.

	;FIND THE LOCATION OF THE KEY IN THE RECORD

	HLRZ	ATMP1,F.RMKL(AFT)  ;GET LOCATION OF %N TABLE FOR FILE
	ADDI	ATMP1,1		;TO GET TO FIRST ENTRY IN TABLE
	MOVE	ATMP2,SM.KRF##	;GET ENTRY NUMBER SAVED ASIDE ABOVE
	LSH	ATMP2,1		; AND MULTIPLY IT BY 2 TO GET THE TOTAL
				; DISPLACEMENT IN WORDS
	ADD	ATMP1,ATMP2	;ADD DISPLACEMENT TO LOC OF FIRST ENTRY

SU.RM9:
	HRRZ	ATMP4,0(ATMP1)	;GET THE COUNT OF BYTES AND PUT IT IN ATMP4

	;DO THE CHARACTER COMPARISON LOOP

SU.RM7:
	ILDB	ATMP1,SU.T1	;GET A CHARACTER FROM EACH KEY STRING
	ILDB	ATMP2,SU.T2	;
	CAME	ATMP1,ATMP2	;ARE THEY EQUAL?
	 JRST	SU.RM2		;NO, CHECK FAILS. GO TO NEXT RRT ENTRY
	SOJG	ATMP4,SU.RM7	; YES, GO GET NEXT CHARACTER
	 JRST	SUVBCK		;LOOP COMPLETED SUCCESSFULLY, KEYS MATCH

SU.RM5:		;CHECK IF RMS RELATIVE KEY HAS BEEN RETAINED
		;KEY SHOULD ALWAYS BE SET UP INTERNALLY AS ONE-WORD COMP

	HRRZ	ATMP1,F.RACK(AFT)	;GET ADDRESS OF FILE'S REL KEY
	MOVE	ATMP2,(ATMP1)		;GET KEY FIELD ITSELF
	CAMN	ATMP2,3(ACRR)	;SAME AS RETAINED KEY VALUE?
	 JRST	SUVBCK		; YES

	;THE NEXT CHUNK OF CODE IS JUST A STOPGAP UNTIL RMS CAN PASS BACK
	; THE FILE PAGE NUMBER IN THE LSN FIELD OF THE FILE'S RAB.

	HRRZI	ATMP2,0		;SET UP TO TEST KEY 0 (WHOLE FILE LOCK)
	CAME	ATMP2,3(ACRR)	; MAKE TEST
	 JRST	SU.RM2		;FAILED - GO ON TO NEXT RRT ENTRY
	MOVE	ATMP1,SU.VRB	;NOW SEE IF WE ARE DOING AN UPDATE VERB
	TRNE	ATMP1,10	;DOING READ?
	TRNN	ATMP1,7		;DOING UPDATE RECORD I-O VERB?
	 JRST	SU.ERB		;FAILURE - NOT RETAINED, I.E. VERB IS
				; READ OR IS NOT A WRITE, REWRITE OR DELETE
	JRST	SUVBCK		;SUCCESS - GO DO VERB CHECK

SU.RM3:		;HERE WE CHECK FOR RETAIN NEXT ON THE FILE

	LDB	ATMP0,RRTNXT	;CHECK IF THIS ENTRY FOR RETAIN NEXT
	CAIE	ATMP0,1		;
	 JRST SU.RM2		; NO
	LDB	ATMP0,CRRFLG	;YES - NOW CHECK FOR "ANY" OR "UNTIL FREED"
	TRNE	ATMP0,2		; "UNTIL FREED" BIT SET?
	 JRST	SUVBCK		;YES, LEAVE "NEXT" FLAGS AS IS
	LDB	ATMP0,CRRFG4	;GET ONLY THE VERB FLAGS
	CAIN	ATMP0,17	; ALL FOUR FLAGS SET?
	 JRST	SUVBCK		;YES - THIS VERB MAY BE USED AGAIN
	SETOM	ATMP0,		;PREPARE TO SET FLAG TO CHECK OFF THIS ENTRY
	DPB	ATMP0,RRTNCK	; AND CHECK IT OFF AS SPOKEN FOR
				;WE WILL USE THIS FLAG TO INDICATE THAT THE
				; ENTRY HAS BEEN USED FOR RECORD I-O
				; CHECKING WHEN WE EXIT FROM THIS VERB.
	JRST	SUVBCK		;GO TO NORMAL EXIT AND RETURN TO RMSIO

SU.RM2:		;WE GET THE INCREMENT TO THE NEXT ENTRY AND GO AROUND AGAIN

	LDB	ATMP0,CRRINE	;GET INCREM TO NEXT ENTRY FROM CURRENT ENTRY
	ADD	ACRR,ATMP0	; AND ADD IT TO THE ADDRESS OF CURRENT ENTRY
	JRST	SU.RM1		;  AND GO THROUGH THE LOOP AGAIN.

SUVBCK:		;HERE WE CHECK OFF THE VERB AND EVENTUALLY RETURN TO RMSIO

	MOVEM	ACRR,SU.ACR##	;SAVE ASIDE POINTER TO CURRENT RRT ENTRY
	LDB	ATMP4,CRRFG4	;GET VERB FLAGS THAT WERE RETAINED FOR
	SETCA	ATMP4,		;MAKE COMPLEMENT FOR EASIER TESTING
	MOVE	ATMP3,SU.VRB	;GET SMU OPTION 1 FLAG FOR THIS VERB
	TRNE	ATMP3,0(ATMP4)	;IS IT ON FOR THE CURRENT VERB?
	 JRST	SU.ERC		;JUMP TO PROGRAM FAILURE IF VERB NOT RETAINED
	LDB	ATMP1,CRRFLG	;GET ALL SIX RETAIN FLAGS
	TRNE	ATMP1,2		; "UNTIL FREED" FLAG SET?
	 JRST	SU.RXT		; YES - BYPASS FLAG SETTING CEREMONY
	TRNN	ATMP4,17	;FOR "ANY" VERB SET?
	 JRST	SU.RXT		; YES - BYPASS FLAG SETTING CEREMONY
	LSH	ATMP1,-2	;SHIFT RIGHT 2 TO KEEP JUST THE 4 VERB FLAGS
	TRZ	ATMP1,0(ATMP3)	; RESET VERB BIT FOR OUR CURRENT VERB
	DPB	ATMP1,CRRFG4	; AND PUT BACK THE FOUR VERB FLAGS
	JUMPN	ATMP1,SU.RXT	;JUMP IF NOT ALL VERB BITS ZERO
	SETO	ATMP1,		;SET "FREE" FLAG FOR THIS RRT ENTRY
	DPB	ATMP1,CRRF	;

;	RMSIO WILL MAKE ANTHER CALL TO LSU TO FREE THE RECORD JUST MARKED
;	WHEN THE EXECUTION OF THE CURRENT VERB IS COMPLETE.

SU.RXT:
	POPJ	PP,		;NORMAL RETURN 
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	AT4,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
	PUSH	PP,AT4		;GET AN AC TO WORK WITH
	MOVE	AT4,SU.DQT	;GET ADDR OF DEQ REQ BLOCK HDR
	SETZM	1(AT4)		;ZERO OUT SECOND WORD
	LDB	AT1,FRMS		;RMS FILE?
	CAIN	AT1,0		;
	 JRST	SUCLNX		; NO
	LDB	AT1,FTCN		;GET CHAN / JFN FOR REQUEST-ID
	MOVEM	AT1,1(AT4)	; AND PUT IT IN SECOND WORD OF HEADER
SUCLNX:
	POP	PP,AT4		; AND RESTORE THE AC
	HRRZI	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	AT4,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


	;BUILD BYTE POINTER TO KEY IN RETAINED RECORDS TABLE IN AT3
MOVKEY:
	LDB	AT3,FTRM	;GET FILE'S RECORDING MODE
	MOVE	AT3,[OCT 441100000000,440600000000,0,440700000000]-1(AT3)

				;DERIVE BYTE SIZE FROM RECORDING MODE

	HRRI	AT3,3(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
HVLOP1:
	IDPB	AT5,AT3		;[447] PUT IT IN RRT
	SOJG	AT2,HVLOP1	;[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 441100000000,440600000000,0,440700000000]-1(AT3)
;;;;	MOVE	AT3,[OCT 441000000000,440600000000,0,440700000000]-1(AT3)	;[447]
	HRRI	AT3,3(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
;
;   NOTE: THE PURPOSE OF AT2 HAS BEEN CHANGED. ITS CONTENTS MAY BE THE
;   SAME AS BEFORE, BUT THE CONTENTS WILL ALSO BE STORED IN LOCATION QCODE
;   COMING INTO THE QUEUE ROUTINE, THE CONTENTS WILL ACTUALLY INDICATE
;   WHETHER OR NOT WE WANT A LOCK ON AN INDEX CAPABILITY. PREVIOUSLY, A
;   NON-RMS INDEXED FILE USED -1 TO INDICATE THIS REQUIREMENT, AND THE
;   QUEUE ROUTINE PLAYS A FUNNY LITTLE GAME WITH IT. RMS INDEXED FILES
;   REQUIRE A DIFFERENT FORMAT FOR THIS REQUEST, BUT WE WANT TO BE ABLE
;   TO LET QUEUE PLAY ITS FUNNY LITTLE GAME. SO IN ALL CASES WE WILL
;   STORE THE VALUE OF THE 33-BIT USER CODE IN LOCATION QCODE AND WE WILL
;   GET IT BACK AT LOCATION QUEUX.
;
;	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:
	MOVE	AT2,QCODE		;SET UP  AT2 FOR CALL TO ENQDEQ ROUTINE
	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

	SKIPE	QCDLTL##	;CODE SET FOR LONG-TERM LOCK?
				; IF SO, DO THE APPROPRIATE TEST INSTR.
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]
	SETZM	QCDLTL##	;RESET FLAG FOR LONG-TERM LOCK
	MOVEM	AT2,0(AT3)	;STORE FLAG/CHAN/JFN WORD

	LDB	AT2,FRMS	;RMS FILE?
	CAIE	AT2,0		;
	MOVEI	AT1,SM1.GP	;YES, PUT RMS SMU OPTION 1 SHARE GROUP

	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

IFE TOPS20, <
	CALLI	AT2,151(AT3)	;CALL ENQ OR DEQ DEPENDING ON SETTING
				;OF AT3
	  JRST	ED4		;ERROR RETURN FROM ENQ/DEQ
>

IFN TOPS20, <
	PUSH	PP,ACRR2		;SET UP AC'S 1 AND 2 FOR ENQ AND
	PUSH	PP,ACRR3		; DEQ JSYS CALLS. ENQ = JSYS 513
	HLRZ	ACRR2,AT2		; AND DEQ = JSYS 514. THE INDEX
	HRRZ	ACRR3,AT2		; ON THE JSYS CALL WILL BE EITHER
	ENQ	(AT3)			; 0 (FOR ENQ) OR 1 (FOR DEQ)
	 ERJMP	[MOVE AT2,ACRR2		;SAVE JSYS ERROR CODE TO REPORT TO USER
		 POP  PP,ACRR3		; AND RESTORE AC'S 1 AND 2
		 POP  PP,ACRR2		;
		 JRST ED4]		;

	POP	PP,ACRR3		;NORMAL RETURN FROM JSYS CALL
	POP	PP,ACRR2		;
>

	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,ENQX18
	JRST	SU.ERF		;QUOTA EXCEEDED
	CAIE	AT2,ENQX5	;IS FILE LOCKED?
	CAIN	AT2,ENQX6	;OR SOME LOCKED?
	POPJ	PP,		;RESOURCES NOT AVAILABLE
	CAIN	AT2,ENQX7	;RESOURCE NOT LOCKED (FOR DEQ)?
	POPJ	PP,		; YES
	JRST	SU.ER7		;SOME INTERNAL ERROR
;	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,FRMS	;RMS FILE?
	TRNE	AT1,1		;
	 JRST	BNRMS		; YES

	HRRZI	AT1,0		;[1065] ZERO OUT TO HOLD CALCULATED BLOCK NO.
	LDB	AT2,FTAM	;GET ACCESS METHOD
	CAIN	AT2,INDEXD
	 JRST	BN1		;JUMP IF FILE INDEXED

	CAIE	AT2,RANDOM	;[455]
	 JRST	BN0A		;JUMP IF NOT RANDOM EITHER
	LDB	AT2,RRTNXT	;RETAIN NEXT?
	CAIE	AT2,0		;
	 JRST	BN0B		;[1065] YES, RETURN BLOCK NO = 0
;	LDB	AT2,CRRFG4	;SEE IF ONLY DOING READ
;	CAIE	AT2,10		;
;	 JRST	BN0B		;[1065] NO, KEEP BLK NO = 0

BN0A:	MOVE	AT1,3(ACRR)	;[456] FOR RELATIVE FILES, BLOCK NUMBER = 
				;KEY + BLOCKING FACTOR - 1 ALL DIVIDED
				;BY BLOCKING FACTOR (FOR READ ONLY)

	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]
	MOVE	AT2,AT1		;GET BLK NO INTO AT2 FOR DPB BELOW
BN0B:				;[1065]

;[L1000] 
;KEEP BLKNUM ROUTINE FOR RELATIVE FILES FROM FALLING INTO CODE FOR ISAM FILES
;NOTE, EDIT L1000 HAS BEEN REWORKED SOMEWHAT HERE. IN V12B, IT IMMEDIATELY
;PRECEDED THE TAG BN5:, WHICH HAD A CONDITIONAL ASSEMBLY SWITCH STARTING
;ON THE LINE FOLLOWING GOING DOWN TO JUST BEFORE A POPJ, INDICATING THAT
;IT APPLIED TO ANS74 ONLY. THUS, PRIOR TO 74 EVERYING EXITED WITHOUT DOING
;THE GUTS OF BN5. SOMETIME BETWEEN F.I. V12B AND THE CURRENT V13 CODE THIS
;CODE GOT REWORKED, WITH THE BN5 ROUTINE WINDING UP AFTER BN7. HOWEVER
;THE JRST TO BN5 WAS REMOVED AND THIS EDIT WAS STUCK IN JUST PRIOR TO IT
;IN THAT POSITION. AS A RESULT, BN5 WAS NOT REACHABLE IN THE CODE.
;HOWEVER, THE CODE STARTING AT BN1: IS ALSO ISAM CODE, AND THE STUFF FOR
;RELATIVE AND SEQUENTIAL FILES SHOULD BE KEPT OUT OF IT AS WELL. THIS
;IS WHY THIS EDIT HAS BEEN MOVED AND SLIGHTLY REWORKED. 

	DPB	AT2,CRRBLK	;[L1000]
	POPJ	PP,		;[L1000]
;Here for ISAM file

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

	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 

	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)
	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	; GET RECORDING MODE
	LDB	AT2,FRMS	; GET RMS BIT
	CAIE	AT2,0		; IF NOT 0, RMS; SET UP 9-BIT BYTE PTR.
	SKIPA	AT1,[OCT 441100000000,440600000000,0,440700000000]-1(AT1)
	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

	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.
	PUSHJ	PP,FAKNXT	;DO A FAKE READ NEXT
	  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 441100000000,440600000000,0,440700000000]-1(AT1)
	HRRI	AT1,3(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
	LDB	AT2,RRTNXT	; IS THE KEY BEING RETAINED "NEXT RECORD"?
	JUMPE	AT2,BN2B	; NO, DON'T RESTORE ANYTHING
	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,2
	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 441100000000,440600000000,0,440700000000]-1(AT1)

	HRRI	AT1,3(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:
	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:	
;[1135]	Delete the following line. It doesn't belong here.
;	SETZM	NNTRY(AT4)	;ZERO IT OUT TO MAKE FAKNXT DO THE FAKE READ.
				; AT4 CONTAINS THE POINTER TO THE ISAM IN-CORE
				; STATS BLOCK.
	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.

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.

BN5:	DPB	AT1,CRRBLK
	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:	TRZE	AT2,SAVNXT	; Next rec pos saved?
	HRRM	AT2,D.RFLG(AFT)	; Yes, reset it off
	POPJ	PP,		; and return
;BNRMS DETERMINES THE APPROPRIATE BUCKET NUMBER FOR AN RMS FILE TO 
; REQUEST AN ENQ LOCK FOR. IT DOES THIS BY MEANS OF FAKE READS TO THE
; FILE IN A FASHION PARALLEL TO NON-RMS FILES. HOWEVER, IT DOES SO IN 
; A DIFFERENT MANNER. THE FAKE READ PROCESS USES A "FAKE" OR "SHADOW"
; RAB AS WELL AS DIFFERENT BUFFERS INSTEAD OF USING THE USER'S RAB AND
; BUFFERS. AS A RESULT IT CAN BE A LOT SIMPLER. THE NON-RMS FAKE READ
; PROCEDURES USE THE SAME BUFFERS AS THE USER RECORD I-O VERBS, AND SO
; THEY HAVE TO BE SURE TO RESTORE THE USER'S BUFFERS TO THE STATE THAT
; THEY WERE IN AT THE BEGINNING OF THE FAKE READ PROCEDURE. WITH FAKE
; OR SHADOW BUFFERS, YOU DON'T HAVE TO RESTORE THE CONTEXT BECAUSE THE
; USERS BUFFERS ARE NOT CHANGED BY THE FAKE READS. ALSO, WE DON'T HAVE
; TO WORRY ABOUT SYNCHRONIZING THE USER'S BUFFERS WITH THE FAKE BUFFERS
; HERE BECAUSE THEY WILL BE CHECKED BY THE APPROPRIATE SU.xx ROUTINE
; WHEN THE USER'S RECORD I-O VERBS ARE EXECUTED.
;
;THUS, THE PRIMARY PURPOSE OF THIS ROUTINE IS TO TAKE THE APPROPRIATE
; PARAMETERS OUT OF THE RETAINED RECORDS TABLE AND FORMAT THEM INTO THE
; TWO-WORD BLOCK AT SM.ARG AND MAKE THE APPROPRIATE CALL TO FA.MIR OR
; FA.MIS TO DO THE FAKE READ. THERE ARE TWO MAJOR CASES AND ONE EXCE-
; TION. (1) WE DO A KEYED FAKE READ TO FA.MIR AND BRING BACK THE BUCKET
; NUMBER FOR THE BLOCK IN THE RRT. (2) WE DO A FAKE READ NEXT TO FA.MIS
; BRINGING BACK THE BUCKET NUMBER AND THE KEY VALUE FOR THE RRT. THE
; EXCEPTION IS FOR RELATIVE FILE  RECORDS WHICH ARE BEING RETAINED FOR
; SOME OTHER ACTIVITY THAN READ. FOR THESE THE RECORD 0 WILL BE ENQUED
; EXCLUSIVELY, ESSENTIALLY LOCKING OUT THE ENTIRE RELATIVE FILE. THE
; REASON IS THAT THE RFA RETURNED FOR A RELATIVE FILE RECORD CONTAINS
; ONLY THE RECORD NUMBER, AND NOT THE BUCKET NUMBER AND RECORD NUMBER.
; BECAUSE OF THE FACT THAT LSU ENQUEUES ON BUCKET NUMBER, THIS WOULD BE
; A REAL HASSLE. IT WOULD BE SENSELESS TO DUPLICATE THE ALGORITHM FOR
; CALCULATING THE BUCKET NUMBER HERE BECAUSE IT MIGHT CHANGE IN RMS AT
; SOME POINT, AND IT MIGHT HAPPEN THAT NOONE WOULD THINK TO CHANGE IT
; HERE. THIS COULD CAUSE SOME SERIOUS PROBLEMS.

BNRMS:
IFN TOPS20,<
	MOVEM	ACRR,SU.T1##	;SAVE ASIDE ADDR OF CURRENT RRT ENTRY
	LDB	AT1,FTAM	;GET FILE'S ORGANIZATION
	CAIN	AT1,INDEXD	;IS IT INDEXED?
	 JRST	BNRMSA		; YES
	LDB	AT1,CRRQT	;NO, RELATIVE, GET QUEUEING TECHNIQUE
	CAIE	AT1,7		;QT = 7?
	 JRST	BNRMSA		; NO
	HRRZI	AT1,0		;MOVE 0 TO CURRENT RECORD BLOCK FIELD OF
				; RRT, EFFECTIVELY LOCKING UP ENTIRE FILE.
				;NOTE: IF QT = 7 HERE, WE WANT TO LOCK UP
				; THE ENTIRE FILE. THIS CODE SHOULD NOT BE
				; RELAXED WHEN THE CODE IN THE FIRST LOOP
				; IS RELAXED TO ACCOMODATE THE BUCKE-IN-
				; LSN FIELD FROM RMS FOR RELATIVE FILES.
	DPB	AT1,CRRBLK	;
	POPJ	PP,		; AND RETURN

BNRMSA:				;COME HERE FOR RMS INDEXED FILES AND RELATIVE
				; FILES WHICH ARE FOR READ ONLY.

;FIRST, SET UP THE ARG WORDS SM.ARG AND + 1

	HRRZ	AT1,0(ACRR)	;GET FILE TABLE ADDRESS
	TXO	AT1,FA%FAK	;TURN ON FAKE READ FLAG
	LDB	AT2,RRTNXT	;GET RETAIN-NEXT FLAG
	CAIN	AT2,0		; IS IT ON?
	 TXOA	AT1,FA%KYR	;  NO, WE ARE DOING KEYED READ
	 TXO	AT1,FA%NXT	;  YES, IS RETAIN NEXT
	HRRZI	AT3,0		;SET UP AC TO REFERENCE THE TWO SM.ARG WORDS
	MOVEM	AT1,SM.ARG(AT3)	; AND SAVE THE WORD IN THE FIRST SM.ARG WORD
	ADDI	AT3,1		;BUMP UP TO NEXT SM.ARG WORD
	SETZM	SM.ARG(AT3)	; AND ZERO IT OUT
	SETZM	SM.BN		;ALSO, ZERO OUT THE OTHER TWO WORDS WHICH
	SETZM	SM.KBF		; PASS BACK INFORMATION

;NOW SAVE FOUR AC'S -- AP, ACRR, AURS AND AFT

	MOVEM	AP,SU.T2	;ADDRESS OF ARG LIST FOR CALL TO LRENQ.
	MOVEM	ACRR,SU.T1	;ADDRESS OF CURRENT RRT ENTRY, TO CONFORM
				; TO NON-RMS SMU OPTION 1 USAGE
	MOVEM	AURS,SU.T3	;ADDRESS OF CURRENT USER RECORD SPEC
	MOVEM	AFT,SU.T4	;ADDRESS OF CURRENT FILE TABLE

;NOW WE DECIDE WHETHER WE CALL FAKE SEQUENTIAL OR KEYED READ

	CAIE	AT2,0		;DOING FAKE KEYED READ?
	 JRST	BNRMSQ		; NO, SEQUENTIAL

;FAKE READ IS KEYED

	MOVE	AT1,2(ACRR)	;GET THE KEY-OF-REFERENCE WORD FROM RRT ENTRY
	MOVEM	AT1,SM.ARG(AT3)	; AND SAVE IT IN SECOND SM.ARG WORD
	MOVEI	AP,SM.ARG	;SMASH AP RIGHT AWAY WITH ADDRESS OF ARG
				; LIST FOR CALL TO RMSIO ROUTINE
	PUSHJ	PP,FA.MIR	;MAKE CALL FOR FAKE READ KEYED
	 JFCL			; SUCCESS RETURN (RIGHT NOW THERE IS NO
				; DIFFERENCE BETWEEN SUCCESS OR FAILURE
				; BECAUSE THE KEYED FAKE READ CALL ONLY
				; WANTS A BUCKET NUMBER TO PUT IN THE
				; RRT ENTRY.
	MOVE	AP,SU.T2	;BRING BACK AP
	MOVE	ACRR,SU.T1	; AND ACRR
	MOVE	AURS,SU.T3	;  ETC
	MOVE	AFT,SU.T4	;   ETC

	MOVE	AT1,SM.BN	;GET BUCKET NUMBER FROM FAKE READ
	MOVEM	AT1,FS.BN##	;PUT IT IN FILE STATUS BLOCK NUMBER FIELD
	TLO	AT1,030000	;TURN ON 3-BIT DATA-BLOCK CODE FOR LOCK REQUEST
	DPB	AT1,CRRBLK	; AND PUT IT IN RRT ENTRY

	POPJ	PP,		; AND RETURN

;FAKE SEQUENTIAL READ -- WE ARE ALL SET UP FOR THE CALL

BNRMSQ:
	MOVEI	AP,SM.ARG##	;SET UP ADDRESS OF SMU OPTION 1 ARG BLOCK
	PUSHJ	PP,FA.MIS	; AND DO FAKE SEQUENTIAL READ
	 JRST	BNRSQ1		; SUCCESS --
	HRRZI	AT1,1		; FAILURE -- SET UP EOF FLAG IN AC
	 JRST	BNRSQ2		;
BNRSQ1:
	HRRZI	AT1,0		; INIT EOF FLAG IN AC

;NOW WE RESTORE THE FOUR AC'S AP, ACRR, AURS AND AFT

BNRSQ2:
	MOVE	AP,SU.T2	;BRING BACK AP
	MOVE	ACRR,SU.T1	; AND ACRR
	MOVE	AURS,SU.T3	;  ETC
	MOVE	AFT,SU.T4	;   ETC

;NOW PUT FAKE READ RETURN INFO INTO RRT

	DPB	AT1,RRTHVF	;COPY OFF EOF FLAG
	HRRZ	AT1,SM.BN	;GET BUCKET NUMBER
	DPB	AT1,CRRBLK	;PUT IT INTO RRT ENTRY
	MOVEM	AT1,FS.BN##	; AND INTO FILE-STATUS ENTRY
	LDB	AT2,FTAM	;GET FILE'S ORGANIZATION
	CAIE	AT2,INDEXD	; IS IT INDEXED?
	 JRST	BNRSQ3		;  NO, RELATIVE

	MOVE	AT1,SM.KRF	;YES, MOVE KEY-OF-REF NUMBER
	HRLM	AT1,2(ACRR)	;
	MOVE	AT1,SM.KBF	; AND KEY BUFFER ADDRESS
	HRRM	AT1,2(ACRR)	;  TO THIRD WORD OF RRT ENTRY

;NOW MOVE KEY VALUE TO RRT ENTRY. WE DO THIS BECAUSE THE USER WILL BE
; ABLE TO FIND THE RECORD'S KEY VALUE AFTER HE DOES THE READ NEXT AND
; HE MAY WANT TO FREE THE RECORD ON THE KEY VALUE. SO WE HAVE TO SAVE 
; IT IN THE RRT ENTRY.

	;FIRST CREATE BYTE POINTER TO BEGINNING OF RECORD BUFFER. THIS
	; BYTE POINER WILL HAVE TO BE MODIFIED TO POINT TO THE BEGINNING
	; OF THE KEY OF REFERENCE IN THE NEXT STEP.

	MOVE	AT1,SM.BSZ	;GET FILE'S BYTE SIZE, AS IN FAB
	ADDI	AT1,4400	;RMS INDEXED FILE KEY FIELDS ALWAYS WORD-ALIGNED
				; IF THEY ARE NOT SO IN THE RECORD ITSELF,
				;  THEY ARE FORCED INTO %TEMP FIELDS.
	LSH	AT1,^D24	;SHIFT TO LEFT-HAND END OF WORD.
	ADD	AT1,SM.BUF	;AND ADD IN SHADOW BUFFER ADDRESS

	;SECOND, MODIFY BYTE POINTER TO POINT TO KEY OF REFERENCE

	MOVE	AT3,SM.KRF	;GET KEY-OF-REFERENCE NUMBER
	IMULI	AT3,2		;DOUBLE IT TO GET ITS REL POS IN %N LIST
	ADDI	AT3,1		; ADD 1 FOR %N LIST HEADER WORD
	HLRZ	AT4,F.RMKL(AFT)	;GET START ADDR OF %N KEY LIST
	ADD	AT4,AT3		;INCREM TO OUR 2-WORD KEY DESCRIPTOR
	HLRZ	AT2,0(AT4)	; AND GET BEGINNING KEY POS INTO AT2
	HRRZ	AT5,SM.BSZ	;GET FAB'S BYTE SIZE AGAIN
	IDIV	AT2,AT5		; AND DIVIDE IT INTO THE BEGIN BYTE POS
	ADD	AT1,AT2		;ADD QUOTIENT TO ADDRESS IN BYTE PTR.
	CAIN	AT3,0		;IF REMAINDER IS ZERO
	 JRST	BNRSQ5		; BYTE PTR IS ALL SET UP
BNRSQ6:				;LOOP TO BUMP POINTER UP TO PROPER BYTE
	IBP	AT1		; INCREMENT THE BYTE POINTER
	SOJG	AT3,BNRSQ6	; AND TEST IF INCREMENT MUST BE DONE AGAIN
BNRSQ5:				;

	; THIRD, IN AC2 SET UP COUNT OF BYTES TO MOVE. MOVKEY WANTS THIS

	HRRZ	AT2,0(AT4)	;GET KEY LENGTH IN BYTES FROM %N ENTRY

	;NOW MAKE CALL TO MOVKEY ROUTINE

	PUSHJ	PP,MOVKEY	;MOVE KEY VALUE TO RRT ENTRY
	 JRST	BNRSQ4		;  AND GO TO RETURN

BNRSQ3:
	SETZM	2(ACRR)		;FOR RELATIVE FILE, ZERO IT OUT
	MOVE	AT1,SM.KBF	; AND PUT RFA VALUE INTO KEY FIELD
	MOVEM	AT1,3(ACRR)	;  IN RRT

; AND RETURN TO THIRD LOOP

BNRSQ4:
> ; END IFN TOPS20
	POPJ	PP,		;
;	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 OR -1 THRU -5
;		   NOTE: LRDEQX ROUTINE DEPENDS ON THESE ROUTINES NOT
;		   CHANGING THE CONTENTS OF AT2.
;
;
;	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	; GET RECORDING MODE
	LDB	AT4,FRMS	; GET RMS BIT
	CAIE	AT4,0		; IF NOT 0,RMS; SET UP 9-BIT BYTE POINTER
	SKIPA	AT2,[OCT 441100000000,440600000000,0,440700000000]-1(AT2)
	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
				;IN ANS74, THIS ROUTINE IS ONLY CALLED
				; IF THE GUY IS DEFINITELY DOING I/O TO
				; THE "NEXT RECORD".
	JRST	CLVAC1

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

	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
;
;THE PURPOSE OF THIS CUTE LITTLE ROUTINE IS TO DETERMINE THREE THINGS
;FOR SETTING UP ENQ AND DEQ REQUEST BLOCKS FOR FILES: (1) IF A LOCK
;REQUEST WILL BE CREATED AND IF SO WHAT WILL THE 33-BIT USER CODE BE,
;(2) WHETHER OR NOT THE SHARE BIT WILL BE SET, AND (3) THE GROUP ID.
;THESE THREE THINGS ARE DETERMINED IN A RATHER ARCANE FASHION.
;
;YOU COME INTO THE ROUTINE WITH THE "FOR" REQUIREMENTS OF THE CURRENT 
;USER IN BITS 32 - 35 OF AT4 AND THE "OTHER" REQUIREMENTS IN THE SAME
;BITS OF AT5. FROM LEFT TO RIGHT, THEY ARE READ (J = 4), REWRITE (J = 3),
;WRITE (J = 2), DELETE (J = 1). AND THEY ARE PROCESSED IN THAT ORDER.
;THERE ARE FOUR PASSES THROUGH THE ROUTINE, AND ONE BY ONE THE INDIVIDUAL
;BITS ARE LSH'ED INTO BIT 32. FOR A GIVEN PASS WE GET THE CURRENT OCCUPANT
;OF BIT 32 OF AT5 INTO K, AND IF OUR CORRESPONDING REQUIREMENT BIT IS ON
;WE ADD 2 TO K. THUS, THE VALUE IN K TELLS WHAT THE "FOR" AND "OTHER"
;REQUIREMENTS ARE FOR A GIVEN VERB, AS FOLLOWS:
;
;		FOR	OTHER
;		---	-----
;	K=0	NO	NO	NOBODY AT ALL DOES VERB
;	K=1	NO	YES	WE ARE NOT INTERESTED IN USING VERB
;	K=2	YES	NO	WE ARE ONLY ONES WHO CAN USE VERB
;	K=3	YES	YES	EVERYBODY CAN DO THE VERB
;
;LOCK REQUESTS ARE CREATED FOR THREE OF THESE VALUES, K = 0, 2, AND 3.
;NONE IS FOR K = 1. FOR THE VALUES K = 0, 2, AND 3, A CORRESPONDING VALUE
;IS PUT INTO AT1, AND THESE ARE 3, 0, AND 1 RESPECTIVELY. THESE VALUES IN
;AT1 DETERMINE (3) THE GROUP ID (2) AND THE SHARE BIT, TRICKILY. WHEN LFENQ. OR
;SU.CL CALLS THE QUEUE ROUTINE LATER, THE CONTENTS OF AT1 (WHICH WIND UP
;IN AT1) ARE ROTATED ONE BIT TO THE RIGHT. THIS MEANS THAT THE SHARE BIT
;IS SET FOR K = 0 OR 3, AND THE GROUP ID WILL BE 0 FOR K = 2 OR 3, BUT
;WILL BE 1 FOR K = 0. ACCORDING TO THE LSU STRATEGY, THE VERB CAN BE
;SHARED ONLY IF THE SHARE BIT IS ON AND THE GROUP ID IS 0, AND THIS IS
;THE CASE ONLY IF K = 3. THE CODE BETWEEN H10 AND H12 SETS UP THE 33-BIT
;USER CODE (2), AND THIS CODE IS BYPASSED FOR K = 1. THE CODE BETWEEN
;H10 + 3 AND H11 - 1 SETS IT UP FOR RMS FILES, AND THE CODE BETWEEN H11 AND
;H12 SETS IT UP FOR NON-RMS (CBLIO-STYLE) FILES.
;
;THE RMS CAPABILITY BITS ARE SET UP SIMILARLY. ACCORDING TO THE RMS V0
;DESIGN SPEC, SECTION 8, THEY ALL HAVE A RESOURCE TYPE OF 1, WHICH IS
;FILE LOCK. THIS IS SPECIFIED IN BITS 3-5 OF THE USER CODE. BITS 18-35
;CARRY THE VERB CAPABILITY NUMBER, I.E. READ = 1, REWRITE = 2, WRITE =
; 4, AND DELETE = 10. BITS 6-17 ARE ZERO-FILLED. THE SMU OPTION 1 BIT
;WOULD ALSO BE SET BELOW UNDER THE COMMENT AT H1:
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:
	LDB	AT3,FRMS		;RMS FILE?
	CAIN	AT3,0		;
	 JRST	H11		; -NO-
	HRRZI	AT3,4		;SET UP RECORD I-O REQUIREMENT
	SUB	AT3,J		;
	HRRZI	AT2,1		;FILL RIGHTMOST BIT
	LSH	AT2,(AT3)		; AND SLIDE IT OVER TO RIGHT POS
	HRLI	AT2,10000		;SET UP FILE CAPABILITY
	JRST	H12
H11:
	MOVN	AT2,J
	SUBI	AT2,1
H12:
	HLR	AT1,ACRR
	MOVEM	AT2,QCODE		;SAVE ASIDE 33-BIT USER CODE
	PUSHJ	PP,QUEUE

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

;NOW, TO WRAP UP,
;IF WE ARE DOING SMU OPTION 1 FOR AN RMS FILE, THE SMU OPTION 1 CAPABILITY
;BIT IS SET UP AND QUEUED HERE. THE QUEUE ROUTINE WILL CHECK FOR THIS
;CAPABILITY AND SET THE SMU OPTION 1 GROUP NUMBER.

	LDB	AT3,FRMS	;RMS FILE?
	CAIN	AT3,0		;
	 JRST	HXIT		;NO
	HRLZI	AT1,3		;SET "GROUP SHARE" CODE
	HLR	AT1,ACRR	; AND TELL APPROPRIATE ENQ/DEQ CODE
	HRRZI	AT2,F.SMU1	;SET SMU OPTION 1 CAPABILITY FLAG
	HRLI	AT2,20000	; AND FILE CAPABILITY FLAG
	MOVEM	AT2,QCODE	;SAVE IT ALL IN QCODE
	PUSHJ	PP,QUEUE	;AND SHIP IT TO ENQ REQUEST BLOCK
HXIT:
	POPJ	PP,		; AND RETURN

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
;
FAKNXT:	HRLI	AP,RNFLAG		;GET FAKE READ NEXT FLAGS
	TRNA
OWNFAK:	HRLI	AP,RFLAG
	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
	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
	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
	MOVE	AT1,[XWD .DEQDA,0]	;[1047] GET FUNCTION CODE
	CALLI	AT1,152			;[1047] DEQ ALL RECORDS
	 JRST	SU.ER7			;[1047] UNEXPECTE 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.ERF:	$SUERR	<Insufficient quota for ENQ/DEQ; change the ENQ/DEQ quota parameter in the monitor to run this program>

SU.ERG:	$SUERR	<Sequential Files may not be opened under Simultaneous Update Option 1>

SU.ERH:	$SUERR	<Retain/Free for RMS-20 Files may not default the Name of the Key Item>

;[1054] Error Message for SMU Option 1 Open Failed after Declaratives
SU.ERJ:	$SUERR <File Open Failed -- Cannot Continue.>

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

	END