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