Trailing-Edge
-
PDP-10 Archives
-
BB-H580C-SB_1981
-
lsu.mac
There are 14 other files named lsu.mac in the archive. Click here to see a list.
; UPD ID= 3573 on 6/9/81 at 5:13 PM by MAYBERRY
TITLE LSU FOR LIBOL
SUBTTL LIBOL'S SIMULTANEOUS UPDATE PACKAGE.
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1981 BY DIGITAL EQUIPMENT CORPORATION
;REVISION HISTORY:
;V12 *****
; WTK 01-Nov-80 ;[654] Supplement ENQ/DEQ error return message.
; HAM 03-Oct-80 ;[650] Make CNTRY external.
; HAM 21-MAR-79 ;[565] FIX LFENQ. CALL TO C.OPEN, FLAG TO SHOW IT'S DONE
; HAM 16-JAN-79 ;[550] FIX NULL CONVERSION IN LRDEQ
; EHM 12-SEP-78 ;[534] FIX EOF FOR LOW-VALUES READ OF ISAM FILES
; EHM 23-JUN-78 ;[532] FIX ILLEGAL INSTRUCTION
;V10 *****
; DW-EM 27-FEB-78 ;[524] FIX RETAIN/READ OF COMP ISAM KEYS
; 13-SEP-76 ; [456] FIX RANDOM BLOCK NUMBER CALCULATION SO
; CORRECT BLOCK NUMBER GETS UPDATED WHEN IT SHOULD
; 02-SEP-76 ; [455] FIX KEY OF 0 READ OF RANDOM FILES WITH
; MISSING RECORDS, REQUIRES CHANGE TO COMUNI
; 16-AUG-76 ; [447] FIX LOW-VALUES SIMUL UPDATE READS OF
; ISAM FILES WHEN IN-CORE MODE AND RECORDING MODE
; ARE DIFFERENT
; 11-AUG-76 ; [446] FIX LOW-VALUES SIMUL UPDATE READS OF
; ISAM FILES SO END OF FILE DOES NOT GIVE ATTEMPT
; TO READ RECORD NOT RETAINED ERROR
; 11-AUG-76 ; [445] FIX LOW-VALUES SIMUL UPDATE READS OF
; ISAM FILE WITH DISPLAY NUMERIC KEYS
;SSC 2-AUG-76 ADD TEST FOR ALREADY RETAINED DBMS RESOURCES
; 27-JUL-76 ; [443] SET UP AP SO LREDQX WORKS FOR ISAM FREES
; 01-JUN-76 ; [437] SET UP FOUR TABLES AND INITIALIZE COUNT PROPERLY FOR RANDOM FILES.
; PATCH IN CBLIO ALSO.
; 05-APR-76 ; [434] FIX SIMULTANEOUS UPDATE FOR UNAVAILABLE CLAUSE
; 16-MAY-75 /GPS CREATION.
;*****
SALL
HISEG
SEARCH LBLPRM
SEARCH FTDEFS
IFN LSTATS,<
SEARCH METUNV ;LSTATS METER DEFINITIONS
>
IFN TOPS20,<
SEARCH MONSYM,MACSYM
>
IFE TOPS20,<
SEARCH UUOSYM,MACTEN
>
DEFINE TYPE(ADDR),<
IFN TOPS20,<
HRROI 1,ADDR
PSOUT%
>
IFE TOPS20,<
OUTSTR ADDR
>
>;END DEFINE TYPE
; THE LIBOL SIMULTANEOUS UPDATE PACKAGE: LRENQ, LRDEQ, LFENQ,
; SU.RD, SU.RW, SU.WR,
; SU.DL, AND SU.CL
;
;
;
; THIS PACKAGE IMPLEMENTS IN LIBOL THE COBOL SIMULTANEOUS UPDATE
; FEATURE.
;
;
; LRENQ: LIBOL RECORD ENQUEUE
;
;
; THE FOLLOWING PROCEDURE, LRENQ, IS CALLED BY THE COBOL OBJECT
; PROGRAM ONCE FOR THE EXECUTION OF EACH RETAIN STATEMENT.
;
; LRENQ EXPECTS TO FIND IN AC16 THE ADDRESS OF AN ARGUMENT LIST,
; STRUCTURED AS FOLLOWS:
;
; WORD 1: RH = NUMBER OF RECORDS TO BE RETAINED (N)
; LH = 0 => USER DID NOT SUPPLY AN UNAVAILABLE STATEMENT
; LH = 1 => USER SUPPLIED AN UNAVAILABLE STATEMENT
;
; WORD 2: BITS 0-8: 147
; BIT 9: SET IF USER INTENDS TO READ
; BIT 10: SET IF USER INTENDS TO REWRITE
; BIT 11: SET IF USER INTENDS TO WRITE
; BIT 12: SET IF USER INTENDS TO DELETE
; BIT 13: SET IF USER SPECIFIED UNTIL FREED
; BIT 14: SET IF USER SPECIFIED A RECORD IDENTIFIER
; (AS OPPOSED TO IMPLICITLY DESIGNATING THE
; CURRENT RECORD. IF THIS BIT IS SET, THE NEXT
; WORD DESIGNATES THE RECORD; OTHERWISE THE NEXT
; WORD DESIGNATES THE NEXT RECORD TO BE RETAINED
; AND HAS THE SAME FORMAT AS THIS ONE.)
; BIT 15: (COBOL-74 ONLY): "RETAIN NEXT RECORD..."
; BITS 16-17: NOT USED
; RH = FILE TABLE LOCATION FOR THE FILE CONTAINING THIS
; RECORD.
;
; WORD 3: (IF BIT 14 OF PRECEDING WORD = 1)
;
; BITS 0-8: 0
; BITS 9-12: TYPE (SEE BELOW)
; BITS 13-35: FULL ADDRESS, USING I,X AND Y
;
; TYPE = 2 => ADDRESS IS ADDRESS OF A ONE WORD
; COMPUTATIONAL ITEM (INTEGER)
;
; TYPE = 11 (BASE 8) => ADDRESS IS ADDRESS OF A TWO WORD
; COMPUTATIONAL ITEM (INTEGER)
;
; TYPE = 4 MEANS ADDRESS IS ADDRESS OF A ONE WORD
; COMPUTATIONAL-1 ITEM (FLOATING POINT)
;
; TYPE = 15 (BASE 8) => MEANS ADDRESS IS ADDRESS OF A TWO
; WORD DESCRIPTOR OF A DISPLAY-6,
; DISPLAY-7 OR DISPLAY-8 ITEM; THE
; DESCRIPTOR HAS THE FOLLOWING
; FORMAT:
;
; WORD 1: A BYTE POINTER TO THE IDENTIFIER OR
; LITERAL
;
; WORD 2: BIT 0 = 1 => ITEM IS NUMERIC
; BIT 1 = 1 => ITEM IS SIGNED
; BIT 2 = 1 => ITEM IS A FIGURATIVE
; CONSTANT
; BIT 3 = 1 => ITEM IS A LITERAL
; BITS 4-11 ARE NOT USED
; BIT 12 = 1 IF P OCCURS IN THE ITEM'S
; PICTURE
; BITS 13-17 CONTAIN THE NUMBER OF DECIMAL
; PLACES CONTAINED IN THE ITEM
; BITS 18-35 CONTAIN THE SIZE OF THE ITEM
; IN BYTES
;
; (THE PATTERN OF WORDS 2 AND 3 IS REPEATED UNTIL N IS EXHAUSTED)
;
;
; THE FOLLOWING RESTRICTIONS APPLY TO THE USER SUPPLIED RECORD
; IDENTIFIERS:
;
; (1) FOR SEQUENTIAL FILES, THE RECORD IDENTIFIER MUST BE TYPE 2
; (A ONE WORD COMPUTATIONAL ITEM).
;
; (2) FOR RANDOM FILES, THE RECORD IDENTIFIER MUST BE TYPE 2
; (A ONE WORD COMPUTATIONAL ITEM).
;
; (3) FOR INDEXED FILES, THE RECORD IDENTIFIER MUST AGREE WITH
; THE RECORD KEY DEFINED FOR THE FILE IN CLASS, USAGE, SIZE,
; AND NUMBER OF DECIMAL PLACES. IT MAY NOT BE A LITERAL
; OR FIGURATIVE CONSTAND, EXCEPT LOW-VALUES.
;
;
;
; AN IMPORTANT ASSUMPTION MADE BY THIS ROUTINE IS THAT THE
; ABOVE RESTRICTIONS WERE CHECKED AT COMPILE TIME
; THIS PROCEDURE USES A DATA STRUCTURE CALLED THE RETAINED
; RECORDS TABLE. THE FORMAT OF THIS TABLE IS AS FOLLOWS:
;
; WORD 1: THE MISCELLANEOUS WORD (0)
;
; BITS 0-2: QUEUEING TECHNIQUE (QT)
; BITS 3-8: ENQUEUEING FLAGS (EF)
; BIT 9: F BIT (SET TO INDICATE THIS ENTRY SHOULD BE
; FREED)
; BITS 10-17: THE INCREMENT TO THE NEXT ENTRY,
; IN WORDS (INE)
; BITS 18-35: LOCATION OF THE FILE TABLE OR 0,
; INDICATING THE RECORD HAS BEEN FREED.
;
;
; WORD 2: BLOCK NUMBER
;
; WORDS 3-N: KEY
;
;
; THE VALUES FOR QUEUEING TECHNIQUE (QT) ARE:
;
; 0: NO QUEUEING
; 1: SHARED
; 2: EXCLUSIVE
; 3: INDEX-EXCLUSIVE
; 4: SHARED, BUT COVERED BY ANOTHER ITEM'S INDEX-EXCLUSIVE
; 5: EXCLUSIVE, BUT COVERED BY ANOTHER ITEM'S
; INDEX-EXCLUSIVE
; 7: RANDOM RECORD RETAINED WITH KEY OF 0, FILE IS EXCLUSIVE
;
;
; THE VALUES FOR ENQUEUEING FLAGS (EF) ARE:
;
; BIT 0: READ
; BIT 1: REWRITE
; BIT 2: WRITE
; BIT 3: DELETE
; BIT 4: UNTIL FREED (UF)
; BIT 5: KEY SPECIFIED (KS)
; REGISTER ASSIGNMENTS
;
; NOTE: REGISTERS 0, 1, 2, AND 3 ARE DESTROYED BY A RESTORE OPERATION
; (THIS AFFECTS ACRR2, ACRR3, AND K AS REGISTERS ARE CURRENTLY DEFINED)
ACRR==7 ;CURRENT RETAINED RECORDS TABLE ENTRY
AURS==13 ;CURRENT USER RECORD SPECIFICATION
I==10 ;COUNTER
J==14 ;COUNTER
K==3 ;COUNTER
AT1==4 ;TEMP NOTE: AT1, AT2, AND AT3 MUST BE CONTIGUOUS
AT2==5 ;TEMP
AT3==6 ;TEMP
AT4==12 ;TEMP
AT5==11 ;TEMP - MUST NOT BE A REGISTER THAT NEEDS TO BE SAVED
AFT==15 ;FILE TABLE POINTER
AP==16 ;PARAMETER LIST POINTER (MUST BE AC16)
PP==17 ;PUSHDOWN LIST POINTER (MUST BE AC17)
ACRR2==1 ;ANOTHER CURRENT RETAINED RECORDS TABLE ENTRY
ACRR3==2 ;STILL ANOTHER CURRENT RETAINED RECORDS TABLE
;ENTRY
AUFS==AURS ;CURRENT USER FILE SPECIFICATION
;
;
;
;
; FIELD VALUES
;
%FAM.D==2 ; ACCESS MODE VALUE FOR 74 DYNAMIC ACCESS
INDEXD==4 ;VALUE OF ACCESS MODE FOR INDEXED
RANDOM==RANFIL## ;VALUE OF ACCESS MODE FOR RANDOM
COMPLT==3 ;VALUE OF TYPE OF KEY FOR COMP <= 10
;DIGITS
COMP1==5 ;VALUE OF TYPE OF KEY FOR COMP-1
COMPGT==4 ;VALUE OF TYPE OF KEY FOR COMP > 10
;DIGITS
UNTFRD==2 ;UNTIL FREED FLAG BIT IN URSFLG
USRSKY==000010 ;USER SUPPLIED KEY BIT IN FREE ARG
FREFEV==000200 ;FREE ALL IN FILE BIT IN USER ARG
FREALR==000400 ;FREE ALL RECORDS BIT IN USR ARG
JSTWRT==000015 ;(EF) IN RETAIN REC ENTRY,MASK ALL
;BUT WRITE BIT (USED TO CHECK WRITE ONLY
JSTRWT==000013 ;(EF) AS ABOVE, BUT TO CHECK FOR REWRITE ONLY
;
; FIELDS VALUES IN RETAINED RECORDS TABLE ENTRY
;
RTTRD==10 ;RETAINED FOR READ (USING FIRST 4 EF BITS)
RTTNRD==7 ;MASKS ALL BUT READ BITS ( " )
RTDLRW==05 ; MASKS FOR DELETE OR REWRITE RETAIN
;
;
; EXTERNAL ENTRY POINTS
;
;
ENTRY LFENQ.,LRENQ.,LRDEQ.,LRDEQX,SU.RD,SU.RW,SU.WR,SU.DL,SU.CL
; MACROS
DEFINE SAVE<
MOVEI AT5,SU.SAV ;SAVE REGISTERS
BLT AT5,SU.SAV+3
MOVEM 12,SU.SAV+4>
DEFINE RESTRM<
HRLZI AT5,SU.SAV ;RESTORE REGISTERS
BLT AT5,3
MOVE 12,SU.SAV+4>
; MRHDCT IS A MACRO TO INCREMENT A METER BUCKET WITHIN
;THE TRAILER BLOCK.
;
;ARGUEMENTS: OFF THE BUCKET OFFSET WITH THE TRAILER
; R A REGISTER TO USE FOR INDEXING
;
DEFINE MRHDCT (OFF,R)<
IFN LSTATS,<
MOVE R,MRTDBP ;GET METER TRAILER ADDRESS
AOS OFF(R) ;INCREMENT TRAILER BUCKET
>
>
; BYTE POINTERS
;
URSCON: POINT 9,0(AURS),8 ;CONSTANT IN USER RECORD SPECIFICATION
URSFLG: POINT 6,0(AURS),14 ;FLAGS IN USER RECORD SPECIFICATION
URSTYP: POINT 4,1(AURS),12 ;TYPE IN USER RECORD SPECIFICATION
IFN ANS74,<
URSNXT: POINT 1,0(AURS),15 ;"NEXT RECORD" FLAG
>;END IFN ANS74
CRRFLG: POINT 6,0(ACRR),8 ;ENQUEUEING FLAGS IN RETAINED RECORDS
;TABLE ENTRY
CRRFG4: POINT 4,0(ACRR),6 ;FIRST FOUR ENQUEUEING FLAGS IN RETAINED
;RECORDS TABLE ENTRY (READ, REWRITE,
;WRITE, DELETE)
CRRQT: POINT 3,0(ACRR),2 ;QUEUEING TECHNIQUE IN RETAINED RECORDS
;TABLE
CRRINE: POINT 8,0(ACRR),17 ;INCREMENT TO THE NEXT ENTRY IN
;THE RETAINED RECORDS TABLE
CRRF: POINT 1,0(ACRR),9 ;FREE FLAG
CRRQT2: POINT 3,0(ACRR2),2 ;SAME AS CRRQT, EXCEPT XR = ACRR2
CRRQT3: POINT 3,0(ACRR3),2 ;SAME AS CRRQT, EXCEPT XR = ACRR3
CRRIN2: POINT 8,0(ACRR2),17 ;SAME AS CRRINE, EXCEPT XR = ACRR2
CRRIN3: POINT 8,0(ACRR3),17 ;SAME AS CRRINE, EXCEPT XR = ACRR3
CRRBLK: POINT 33,1(ACRR),35 ;BLOCK NUMBER OF THIS RECORD
CRRBK2: POINT 33,1(ACRR2),35 ;SAME AS CRRBLK, EXCEPT XR = ACRR2
CRRBK3: POINT 33,1(ACRR3),35 ;SAME AS CRRBLK, EXCEPT NR = ACRR3
RRTNXT: POINT 1,1(ACRR),0 ;SET IF RETAINING "NEXT" RECORD
RRTHVF: POINT 1,1(ACRR),1 ;SET IF NEXT RECORD DOESN'T EXIST
AT1HVF: POINT 1,1(AT1),1 ;SAME AS RRTHVF WITH XR = AT1
RRTNX3: POINT 1,1(ACRR3),0 ;"NEXT" FLAG WITH XR = ACRR3
; BYTE PTRS TO FILE TABLE INFO
FTAM: POINT 3,F.WFLG(AFT),17 ;ACCESS MODE FIELD IN FILE TABLE
FTKLB: POINT 12,F.WIKD(AFT),35 ;KEY LENGTH IN BYTES IN FILE TABLE
FTKT: POINT 3,F.WIKD(AFT),17 ;KEY TYPE IN FILE TABLE
FTRM: POINT 3,F.WFLG(AFT),14 ;RECORDING MODE IN FILE TABLE
LFQOPN: POINT 1,F.WSMU(AP),15 ;[565] LFENQ. OPEN FLAG BIT
;[565] =0 IF LFENQ. C.OPEN CALL NOT DONE
;[565] =1 IF C.OPEN CALL DONE
;[650] CNTRY==117 ;POINTER TO CURRENT RECORD IN CBLIO'S
;BUFFER FOR ISAM FILE
FTCN: POINT 4,D.CN(AFT),15 ;CHANNEL NUMBER IN FILE TABLE
FTBF: POINT 12,F.WBKF(AFT),17 ;BLOCKING FACTOR IN FILE TABLE
FTOWA: POINT 4,F.WSMU(AFT),3 ;OWN ACCESS IN FILE TABLE (READ,
;REWRITE, WRITE, DELETE)
FTOTA: POINT 4,F.WSMU(AFT),12 ;OTHERS ACCESS IN FILE TABLE
;(READ, REWRITE, WRITE, DELETE)
UFSCON=URSCON ;CONSTANT IN USER FILE SPECIFICATION
UFSFLG: POINT 7,0(AUFS),15 ;FLAGS IN USER FILE SPECIFICATION
IDXSHR: POINT 2,F.WSMU(AFT),17 ;FLAG INDICATING SHARED/EXCLUSIVE
;=0 IF INDEX EXCLUSIVE
;=1 IF INDEX SHARED
;=3 IF INDEX GROUP SHARED
; INTERFACE WITH CBLIO
;
;
; MAPPING OF KEYS INTO BLOCK NUMBERS
;
; ONE FUNCTION REQUIRED OF CBLIO FOR ISAM FILES IS THE MAPPING
; OF SYMBOLIC KEYS INTO BLOCK NUMBERS. THIS IS ACCOMPLISHED IN
; THE FOLLOWING WAY:
;
; AFTER SAVING REGISTERS IT REQUIRES, SETTING SU.FRF TO -1, AND SETTING SU.RBP TO 0
; (EXPLAINED BELOW), THIS PACKAGE SETS AC16 WITH A SPECIAL
; FLAG IN LH (DEFINED BY RFLAG INTERNALLY) AND A FILE TABLE
; ADDRESS IN RH. "SYMBOLIC KEY" IS SAVED AND CHANGED TO CONTAIN
; THE KEY THAT IS TO BE MAPPED INTO A BLOCK NUMBER. THEN A
; PUSHJ IS DONE TO THE EXTERNAL SYMBOL "FAKER.".
;
; CBLIO PERFORMS A READ OF THE RECORD WITH THE KEY IN SYMBOLIC
; KEY, AND TAKES THESE SPECIAL ACTIONS:
;
; 1: IT SETS FS.BN TO THE BLOCK NUMBER OF THE BLOCK CONTATING
; THE KEY.
;
; 2: IT FAILS TO MOVE THE RECORD INTO THE USER'S RECORD AREA.
;
; 3. IF THE VALUE OF "SYMBOLIC KEY" IS LOW-VALUES, IT PUTS
; INTO SU.RBP A BYTE POINTER TO THE ACTUAL KEY OF THE RECORD.
;
;
; FILLING AND FLUSHING BUFFERS
;
; WHEN THE USER RETAINS A RECORD, IT IS IMPERATIVE THAT A
; SUBSEQUENT READ RETRIEVE THE VERY LATEST VERSION OF THAT
; RECORD. THEREFORE IF RETAIN DISCOVERS THAT A BLOCK
; CONTAINING A RECORD BEING RETAINED IS CURRENTLY IN THE USER'S
; BUFFER, THAT BUFFER MUST BE REFILLED FROM DISC. THIS IS
; DONE BY CALLING CBLIO AT THE ENTRY POINT FORCR. (FORCE READ).
; THE ONLY PARAMETER REQUIRED IS A FILE TABLE ADDRESS IN AC16,
; SINCE THERE IS ONLY ONE CURRENT BUFFER.
; (SU PACKAGE MUST SAVE ANY REGISTERS IT NEEDS BEFORE CALLING FORCR.)
;
; SIMILARLY, WHEN THE USER FREES A RECORD, IT IS IMPERATIVE
; THAT THE RECORD BE WRITTEN ON DISC BEFORE IT IS FREED,
; SO THAT ANOTHER USER RECEIVES THE VERY LATEST COPY. THEREFORE,
; WHEN FREE DETECTS THAT THE RECORD BEING FREED IS IN THE
; CURRENT BUFFER, AND THAT THE USER HAS MODIFIED THE RECORD,
; IT CALLS CBLIO AT THE ENTRY POINT FORCW. (FORCE WRITE), WITH
; AC16 SET TO A FILE TABLE ADDRESS.
; (SU PACKAGE MUST SAVE ANY REGISTERS IT NEEDS BEFORE CALLING FORCW.)
;
;
; MOVING LOW-VALUES TO CURRENT SYMBOLIC KEY
;
; THE CBLIO ROUTINE LV2SK. IS USED TO MOVE LOW-VALUES TO THE
; SYMBOLIC KEY. IT IS ASSUMED THAT ALL REGISTERS ARE DESTROYED
; BY LV2SK.. AC16 POINTS TO THE FILE TABLE UPON PUSHJ PP, LV2SK..
; THERE ARE NO ERROR RETURNS FROM LV2SK..
;
;
; COMPARING A KEY AGAINST LOW-VALUES
;
; THE CBLIO ROUTINE LVTST IS USED TO COMPARE A KEY TO
; LOW-VALUES. ON INPUT, A BYTE POINTER TO THE KEY TO BE TESTED
; IS SET IN AC1 AND AC16 CONTAINS A FILE TABLE POINTER. LVTST
; RETURNS TO 0 IF THE KEY IS EQUAL TO LOW-VALUES, TO 1 IF IT IS
; NOT.
; (SU PACKAGE MUST SAVE ANY REGISTERS IT NEEDS BEFORE CALLING LVTST.)
;
;
;
; REFRESHING IN-CORE STORAGE ALLOCATION TABLES
;
; LSU SETS USOBJ+13 TO ZERO TO MAKE CBLIO REFRESH ITS IN-CORE
; STORAGE ALLOCATION TABLES. SEE ZSATB ROUTINE.
EXTERN FAKER. ;ENTRY INTO CBLIO
EXTERN FS.BN ;LOCATION WHERE CBLIO RETURNS BLOCK
;NUMBER
IFN ANS74,<
EXTERN F.BFAM ;FILE ACCESS MODE BYTE PTR
EXTERN SAVNXT ; D.RFLG field for del/rewrt next rec position
>
IFN ANS68, RFLAG==002100 ;THE FAKE READ FLAG
IFN ANS74, RFLAG==002000 ;SET IN LH OF 16 WHEN CALLING FAKER.
IFN ANS74, RNFLAG==RFLAG!200 ;NEXTR (READ NEXT RECORD)
EXTERN GDPSK ;[445][447] LOCATION IN DEVICE TABLE POINTING TO
;ANOTHER TABLE CONTAINING THE LAST
;VERB EXECUTED BY THIS USER, WHETHER
;THE CURRENT BUFFER CONTAINS LIVE DATA,
;AND ALSO THE NEXT RECORD FLAG.
EXTERN CHTAB ;[447] TABLE OF INPUT CONVERSION INSTRUCTIONS
LASTUU==7 ;OFFSET IN THE TABLE POINTED TO BY
;THE LEFT HALF OF D.BL THAT CONTAINS
;MINUS 1 IF THE LAST VERB FOR THIS FILE
;WAS A WRITE.
LIVDAT==6 ;OFFSET IN THE SAME TABLE WHICH CONTAINS
;MINUS 1 IF THE BUFFER CONTAINS LIVE
;DATA
NXTREC==NNTRY## ;OFFSET IN THE SAME TABLE WHICH CONTAINS
;-1 IF THE "CURRENT RECORD" IS IN
;FACT, THE "NEXT RECORD".
EXTERN LV2SK. ;CBLIO ROUTINE FOR SETTING SYMBOLIC
;KEY TO LOW-VALUES
IFN ANS68, EXTERN LVTST ;CBLIO ROUTINE FOR COMPARING A KEY TO
;LOW-VALUES
EXTERN FORCR. ;ENTRY POINT IN CBLIO THAT REFILLS A
;BUFFER
EXTERN FORCW. ;ENTRY POINT IN CBLIO THAT FLUSHES A
;BUFFER
;
; CHECKING ACCESS TO RECORDS BEFORE READ, REWRITE, WRITE OR DELETE
;
; WHEN CBLIO DETECTS THAT A FILE IS OPEN FOR SIMULTANEOUS UPDATE,
; IT CALLS SU.RD, SU.RW, SU.WR, SU.DL, OR SU.CL, AS APPROPRIATE
; (SEE DESCRIPTION OF THESE ROUTINES BELOW).
;
;
; IMPLICIT FREEING OF RECORDS.
;
; AFTER EXECUTION OF A READ, REWRITE, WRITE, OR DELETE, CBLIO
; CALLS LRDEQX VIA PUSHJ WITH NO PARAMETERS OR RETURNED VALUES
; TO ACCOMPLISH ANY IMPLICIT FREEING OF RECORDS THAT MAY BE
; REQUIRED.
; (LRDEQX SAVES ALL REGISTERS FOR CBLIO)
;
;
; OPENING AND CLOSING FILES.
;
; LFENQ. OPENS AND CLOSES FILES BY CALLING C.OPEN AND C.CLOS
; WITH 16 LH CONTAINING FLAGS INDICATING THE FILE IS TO
; BE OPENED FOR I-O AND 16 RH CONTAINING A FILE TABLE ADDRESS.
EXTERN C.OPEN,C.CLOS,USOBJ
EXTERN RET.1,RET.2
; THIS ROUTINE USES THE FOLLOWING CONVENTIONS FOR BLOCK NUMBERS:
;
; BLOCKS 1 TO 2 ** 33 - 6: DATA BLOCKS
; BLOCK 2 ** 33 - 5: THE FILE READ QUEUE
; BLOCK 2 ** 33 - 4: THE FILE REWRITE QUEUE
; BLOCK 2 ** 33 - 3: THE FILE WRITE QUEUE
; BLOCK 2 ** 33 - 2: THE FILE DELETE QUEUE
; BLOCK 2 ** 33 - 1: THE PRIMARY INDEX OF THE FILE
;
;
; WHEN WE CALL ENQ/DEQ WITH A 33 BIT IDENTIFIER EQUAL TO
; 2 ** 33 - 1 WE ARE LOCKING THE INDEX OF THE FILE. IF WE
; CALL ENQ/DEQ WITH A 33 BIT IDENTIFIER EQUAL TO 1234 WE
; ARE LOCKING DATA BLOCK NUMBER 1234. ETC.
; TEMPORARY STORAGE
;
;
EXTERN SU.RR ;COUNT OF RECORDS RETAINED BY THE USER
EXTERN SU.DBR ;COUNT OF USER-RETAINED DBMS RESOURCES
EXTERN SU.EQ ;COUNT OF ENTRIES IN THE ENQUEUE TABLE
;(AS OPPOSED TO THE DEQUEUE TABLE OR
;(THE MODIFY TABLE)
EXTERN SU.DQ ;COUNT OF ENTRIES IN THE DEQUEUE TABLE
EXTERN SU.MQ ;COUNT OF ENTRIES IN THE MODIFY TABLE
EXTERN SU.RRT ;LOCATION OF THE RETAINED RECORDS TABLE
EXTERN SU.T1 ;TEMP ONE
EXTERN SU.T2 ;TEMP TWO
EXTERN SU.T3 ;TEMP THREE
EXTERN SU.T4 ;TEMP FOUR
EXTERN SU.T5 ;TEMP FIVE
EXTERN SU.T6 ;TEMP SIX
EXTERN SU.T7 ;TEMP SEVEN
EXTERN SU.T8 ;TEMP EIGHT
EXTERN SU.T9 ;[445] TEMP NINE
EXTERN SU.CRH ;USED TO STORE THE HIGHEST VALUE OF ACRR
;(TOTAL LENGTH OF THE RETAINED RECORDS
;TABLE)
EXTERN SU.EQT ;LOCATION OF THE ENQUEUE TABLE
EXTERN SU.DQT ;LOCATION OF THE DEQUEUE TABLE
EXTERN SU.MQT ;LOCATION OF THE MODIFY TABLE
EXTERN SU.Y ;FLAG
EXTERN SU.RBP ;RECORD BYTE POINTER - SPECIAL POINTER
;TO HANDLE LOW-VALUES (SEE CBLIO
;INTERFACE)
EXTERN SU.MRR ;MORE RETAINED RECORDS FLAG
EXTERN SU.SBD ;SAME BLOCK, DIFFERENT QUEUEING
;TECHNIQUE FLAG
EXTERN SU.RLV ;[455] RANDOM KEY OF 0 FLAG
EXTERN SU.RND ;[455] FILE IS RANDOM FLAG
EXTERN SU.SFQ ;SAME FILE FLAG
EXTERN SU.SFS ;SAME FILE, SAME QUEUEING TECHNIQUE FLAG
EXTERN SU.SBS ;SAME BLOCK, SAME QUEUEING TECHNIQUE
;FLAG
EXTERN SU.NR ;NOT RETAINED FLAG
EXTERN SU.FR ;COUNT OF FILES CURRENTLY OPENED FOR
;SIMULTANEOUS UPDATE
EXTERN SU.AK ;TEMPORARY USED FOR ABSOLUTE KEY
EXTERN SU.FBT ;LOCATION OF THE FILL/FLUSH BUFFER TABLE
EXTERN SU.CFB ;COUNT OF ENTRIES IN THE FILL/FLUSH
;BUFFER TABLE
EXTERN SU.VRB ;INDICATOR OF CURRENT VERB BEING EXECUTED
;20 = CLOSE, 10 = READ, 4 = REWRITE,
;2 = WRITE, 1 = DELETE
EXTERN SU.HV ;[447] SET TO -1 WHEN HIGH VALUES USED
EXTERN SU.CK ;COMPARISON KEY
EXTERN SU.SVK ;TEMP USED TO SAVE KEY
EXTERN SU.CL1,SU.CL2,SU.CLR,SU.CLS ;TEMPS FOR SU.CL -
;SU.CL1 AND SU.CL2 MUST BE
;CONTIGUOUS
EXTERN SU.SAV ;AREA TO SAVE REGISTERS 1,2,3,0, AND 12
EXTERN FET1,FET2,FET3,FET4 ;FILE ENQUEUE TEMPS
EXTERN SU.FRF ;THE FAKE READ FLAG 0 = REGULAR -1 = FAKE
IFN LSTATS,<
IFN TOPS20,<
EXTERN MRTM.E,MRTM.S
>
EXTERN MRTMB.,MBTIM.,MRTDBP ;METER TIMING ROUTINES AND LOCATIONS
>;END IFN LSTATS
; DEBUGGING
;
;
; IF THE TRNA FOLLOWING LABEL ED3 IN ENQDEQ
; (AN INTERNAL SUBROUTINE) IS CHANGED TO TRN, ANY LIBOL ROUTINE DOING ENQUEUEING
; OR DEQUEUEING WILL TYPE THE PARAMETERS TO ENQ/DEQ ON TTY BEFORE
; CALLING ENQ/DEQ.
; INITIALIZATION.
;
; CHECK THAT NO RECORDS ARE CURRENTLY RETAINED. INITIALIZE
; VARIABLES. POINT AN AC TO THE BEGINNING OF THE USER'S
; RETAINED RECORDS TABLE, AND ANOTHER AC TO THE FIRST USER
; RECORD SPECIFICATION IN THE ARGUMENT LIST.
LRENQ.:
MRTMS. (AT1) ;START METER TIMING
SAVE
SKIPG SU.DBR ;ANY DBMS RETAINS IN PLACE, ALSO BAD
SKIPE SU.RR
JRST SU.ER1 ;JUMP IF USER IS CURRENTLY RETAINING
;RECORDS - HE MAY NOT EXECUTE A RETAIN
;STATEMENT UNLESS ALL RECORDS ARE FREE.
SETZM SU.EQ ;SET THE NUMBER OF ENTRIES IN THE
;ENQUEUE TABLE TO ZERO (LRENQ WILL
;NOT USE THE DEQUEUE TABLE OR THE
;MODIFY TABLE)
SETZM SU.CFB ;ZERO THE NUMBER OF ENTRIES IN THE
;FILL/FLUSH BUFFER TABLE
MOVE ACRR,SU.RRT ;POINT ACRR TO THE BEGINNING OF THE
;RETAINED RECORDS TABLE
MOVEI AURS,1(AP) ;POINT AURS TO THE FIRST USER RECORD
;SPECIFICATION IN THE ARGUMENT LIST
HRRZ I,0(AP) ;COUNT USER RECORD SPECS IN I
IFN LSTATS,<
HLRZ AT2,0(AP) ;GET UNAVAILABLE FLAG
JUMPE AT2,LRMRXX ;SKIP OUT IF NO UNAVAILABLE CLAUSE
MRHDCT (MB.RTU,AT1) ;INCREMENT METER BUCKET
LRMRXX:>;END IFN LSTATS
MOVEM I,SU.RR ;SAVE NUMBER OF RECORDS RETAINED IN SU.RR
JUMPN I,LRENQ8
RESTRM
POPJ PP, ;RETURN IF COUNT = 0
; FIRST LOOP.
;
; LOOK AT EACH USER RECORD SPECIFICATION. DETERMINE THE QUEUEING
; TECHNIQUE FOR EACH AND CREATE AN ENTRY IN THE RETAINED RECORDS
; TABLE CONTAINING THE QUEUEING TECHNIQUE, FILE TABLE POINTER,
; ENQUEUEING FLAGS, KEY VALUE, AND A ZERO BLOCK NUMBER. THE
; QUEUEING TECHNIQUES HAVE THE FOLLOWING MEANINGS:
;
; 0: ACCESS TO THIS RECORD AS DEFINED BY THE ENQUEUEING FLAGS
; REQUIRES NO ACTION ON OUR PART
;
; 1: ACCESS TO THIS RECORD REQUIRES SHARED ENQUEUEING ON THE
; BLOCK IN WHICH THE RECORD RESIDES, AND IF THE FILE IS INDEXED,
; SHARED QUEUEING ON THE INDEX
;
; 2: SAME AS 1 EXCEPT EXCLUSIVE QUEUEING REQUIRED ON THE BLOCK.
;
; 3: ACCESS TO THIS RECORD AS DEFINED BY THE ENQUEUEING FLAGS
; REQUIRES EXCLUSIVE ENQUEUEING OF THE INDEX
;
; 4: ACCESS TO THIS RECORD WOULD NORMALLY REQUIRE QUEUEING
; TECHNIQUE 1, BUT ANOTHER REQUEST REQUIRES TECHNIQUE 3 AND
; THEREFORE NO ACTION IS REQUIRED FROM US UNLESS THE REQUEST
; REQUIRING TECHNIQUE 3 IS TERMINATED (THE RECORD IS FREED)
;
; 5: SAME AS 4 EXCEPT ACCESS TO THIS RECORD WOULD NORMALLY
; REQUIRE TECHNIQUE 2
;
; 7: THIS RECORD IS FROM A RANDOM FILE AND HAS A KEY OF ZERO (0)
; WHICH MEANS THE WHOLE FILE MUST BE ENQUEUED EXCLUSIVE.
; NORMALLY A RANDOM FILE IS ENQUEUED SHARED, BUT AS LONG AS
; ANY RECORD IN THE FILE IS BEING RETAINED WITH A KEY OF 0,
; THE FILE MUST BE ENQUEUED EXCLUSIVE.
LRENQ8: LDB AT1,URSCON
CAIE AT1,147 ;MAKE A LITTLE VALIDITY CHECK
JRST SU.ER2
SETZM 0(ACRR) ;ZERO MISCELLANEOUS WORD IN THE
;CURRENT ENTRY OF THE RETAINED RECORDS
;TABLE
LDB AT1,URSFLG ;MOVE FLAGS FROM THE USER RECORD
;SPECIFICATION TO THE RETAINED RECORDS
;TABLE
DPB AT1,CRRFLG
IFN LSTATS,<
TRNN AT1,UNTFRD ;UNTIL FREED ?
JRST LREQMX ;NO, GIT
MRHDCT (MB.RTF,AT1) ;YES, INCREMENT METER BUCKET
LREQMX:>;
HRRZ AFT,0(AURS) ;SIMILARLY, MOVE FILE TABLE ADDRESS,
;LEAVING IT IN AFT FOR FUTURE USE
HRRM AFT,0(ACRR)
SETZM 1(ACRR) ;ZERO BLOCK NUMBER
SETO AT1, ;INITIALIZE THE DEFINITION OF
;"RECORD 0" IN THE FILE TABLE OF THE
;FILE CONTAINING THIS RECORD
HRRM AT1,F.WSMU(AFT)
LDB AT1,FTOWA ;GET FLAGS SPECIFIED WHEN THE FILE WAS
;OPENED
LDB AT2,CRRFG4 ;GET CORRESPONDING FLAGS FROM THIS
;REQUEST
SETCA AT1, ;SET A BIT FOR EACH BIT THAT MUST BE
;ZERO IN REQUEST
TRNE AT2,0(AT1)
JRST SU.ER3 ;JUMP IF USER ATTEMPTING TO RETAIN
;A RECORD FOR A FUNCTION NOT SPECIFIED
;WHEN THE FILE WAS OPENED
LDB AT3,FTOTA ;GET OTHERS' FLAGS
JUMPE AT3,P1 ;JUMP IF OTHERS ALLOWED NONE
OR AT3,AT2
TRNE AT3,777767
JRST P2 ;JUMP IF EITHER WE OR OTHERS ARE
;DOING SOMETHING BESIDES READING
SETZ AT3, ;SET QUEUEING TECHNIQUE TO 0 (NONE)
JRST P1
P2: LDB AT3,FTAM
CAIE AT3,INDEXD
JRST P4 ;JUMP IF FILE NOT INDEXED
TRNN AT2,000003
JRST P5 ;JUMP IF RETAIN NOT FOR "ANY" ,WRITE, OR
;DELETE
MOVEI AT3,3 ;WE HAVE DETERMINED THAT THE FILE IS
;INDEXED AND AN INDEX MODIFYING FUNCTION
;WILL BE EXECUTED - SET QUEUEING
;TECHNIQUE TO 3 (INDEX-EXCLUSIVE)
JRST P1
P4:
IFN ANS68, TRNN AT2,000002
IFN ANS74, TRNN AT2,000007 ;REWRT,DEL IN ANS74 REQUIRES EXCLUSIVE
JRST P7 ;JUMP IF NOT RETAINED FOR WRITE
;(NOR READ-WRITE NOR "ANY")
P6: MOVEI AT3,2 ;WE HAVE DETERMINED THAT THE FILE IS
;NOT INDEXED BUT WRITING WILL OCCUR
;IN A RECORD - SET QUEUEING TECHNIQUE
;TO 2 (EXCLUSIVE)
JRST P1
P5: TRNE AT2,000004 ;CHECK FOR REWRITE
JRST P6 ;WE HAVE DETERMINED THAT THE FILE IS
;INDEXED, THAT NO INDEX-MODIFYING
;FUNCTION WILL BE EXECUTED, BUT THAT
;AN INDIVIDUAL RECORD WILL BE MODIFIED
;- JUMP TO P6 TO SET QT TO 2
P7: TRNN AT2,000010
JRST SU.ER4 ;JUMP IF NOT RETAINED FOR READ
;(INTERNAL ERROR)
MOVEI AT3,1 ;SET QT TO 1 (SHARED)
P1: DPB AT3,CRRQT
; AT THIS POINT IN THE FIRST LOOP WE HAVE COMPLETELY SET UP THE
; RETAINED RECORDS TABLE ENTRY, EXCEPT FOR THE KEY AND THE
; INCREMENT TO THE NEXT ENTRY, WHICH WE WILL NOW DO:
LDB AT3,FTAM
CAIN AT3,INDEXD
JRST Q1 ;JUMP IF FILE INDEXED
Q3: MOVEI AT3,3 ;SET SIZE OF THIS ENTRY IN THE RETAINED
;RECORDS TABLE TO 3 WORDS
JRST Q9
Q1:
IFN ANS74,<
MOVE AT3,D.BL(AFT) ; Get buffer location
SETZM SVNXRT(AT3) ; Clear SAVNXT RETAIN save flag
>
LDB AT3,FTKT ;GET KEY TYPE
CAIE AT3,COMPLT ;CHECK IF COMP < OR = 10 DIGITS
CAIN AT3,COMP1 ;LIKEWISE IF KEY COMP-1
JRST Q3 ;IF SO, SET LENGTH OF ENTRY TO 3 WORDS
CAIE AT3,COMPGT
JRST Q4
MOVEI AT3,4 ;IF COMP > 10 DIGITS, ALLOW FOR 2 WORD
;KEY, SETTING LENGTH OF ENTRY TO 4 WORDS
Q9: DPB AT3,CRRINE
JRST Q2
Q4: LDB AT1,FTRM ;MOVE INTO AT1 THE NUMBER OF BYTES PER
;WORD, BASED ON RECORDING MODE
MOVE AT1,[OCT 4,6,0,5]-1(AT1)
LDB AT3,FTKLB ;MOVE INTO AT3 THE LENGTH OF THE KEY IN
;BYTES
SETZ AT2,
DIV AT2,AT1 ;COMPUTE NUMBER OF WORDS REQUIRED
;TO STORE KEY
SKIPE AT3
ADDI AT2,1
ADDI AT2,2
DPB AT2,CRRINE ;SET LENGTH OF ENTRY TO N + 2 WORDS
Q2: LDB AT1,CRRFLG
TRNN AT1,000001
JRST R1 ;JUMP IF KEY NOT SUPPLIED
LDB AT1,URSTYP
CAIN AT1,2
JRST R2 ;JUMP IF KEY 1 WORD COMP
CAIE AT1,4 ;SKIP IF KEY 1 WORD COMP-1
JRST R3
R2: RESTRM
MOVE AT1,@1(AURS) ;MOVE 1 WORD KEY
MOVEM AT1,2(ACRR)
JRST R4
R3: CAIE AT1,11
JRST R5 ;JUMP IF NOT A 2 WORD KEY
RESTRM
MOVE AT1,@1(AURS)
MOVEM AT1,2(ACRR)
MOVEI AT1,@1(AURS)
MOVE AT1,1(AT1)
MOVEM AT1,3(ACRR)
JRST R4
R5: CAIE AT1,15
JRST SU.ER5 ;JUMP IF INVALID TYPE CODE
RESTRM
MOVEI AT1,@1(AURS) ;GET ADDRESS OF TWO WORD DESCRIPTOR
;IN AT1
HRRZ AT2,1(AT1) ;GET SIZE FIELD FROM TWO WORD DESCRIPTOR
;IN AT2
LDB AT3,FTKLB
CAME AT2,AT3
JRST SU.ER6 ;JUMP IF USER SUPPLIED KEY HAS WRONG
;SIZE
MOVE AT1,0(AT1) ;GET BYTE POINTER TO THE USER KEY IN AT1
PUSHJ PP,USRKEY ;[447] MOVE THE KEY
JRST R4
R1:
IFN ANS74,<
LDB AT3,URSNXT ;GET "NEXT RECORD" FLAG
JUMPE AT3,R1A ; JUMP IF NOT RETAINING "NEXT RECORD"
DPB AT3,RRTNXT ;SET BIT IN RETAINED RECORD TABLE
SETZM 2(ACRR) ;SET KEY TO ZERO
JRST R4 ; AND DON'T MOVE ANY KEY
R1A: >;END IFN ANS74
LDB AT3,FTAM ;KEY IS IMPLIED
CAIE AT3,INDEXD
JRST R6
MOVE AT1,F.WBSK(AFT) ;IF FILE IS INDEXED, USE SYMBOLIC KEY
LDB AT2,FTKLB
PUSHJ PP,USRKEY ;[447]
JRST R4
R6: HRRZ AT2,F.RACK(AFT) ;IF FILE IS RANDOM, USE ACTUAL KEY
SETZ AT1, ;ASSUME SEQ,KEY=0
CAIN AT3,RANDOM
MOVE AT1,0(AT2) ;GET ACTUAL KEY FOR RANDOM CASE
MOVEM AT1,2(ACRR) ;SET KEY VALUE
; AT THIS POINT WE'VE COMPLETED THE PROCESSING OF THE USER
; RECORD SPECIFICATION UNDER CONSIDERATION, THAT'S TO BE
; DONE IN THE FIRST LOOP.
R4: LDB AT2,CRRINE ;INCREMENT ACRR TO POINT TO THE
;NEXT RETAINED RECORDS ENTRY
LDB AT1,CRRFLG ;INCREMENT AURS TO POINT TO THE
ADD ACRR,AT2
;NEXT USER RECORD SPECIFICATION
ADDI AURS,1
TRNE AT1,000001
ADDI AURS,1
SOJG I,LRENQ8 ;END OF FIRST LOOP? IF NOT, JUMP
; SECOND LOOP.
;
; TAKE THE NEXT STEP IN THE DETERMINATION OF THE DEFINITION
; OF "RECORD 0", BY LOOKING FOR A SPECIAL CASE.
;
; INSPECT ALL THE RECORD REQUESTS THAT HAVE BEEN TABULATED IN
; THE RETAINED RECORDS TABLE. DETERMINE THE INDEXES WHICH NEED
; TO BE ENQUEUED, IF ANY, AND ENQUEUE THEM. BE CAREFUL TO ENQUEUE
; EACH REQUIRED INDEX ONLY ONCE. ADJUST THE QUEUEING TECHNIQUE OF
; THOSE RECORD REQUESTS WHICH WOULD NORMALLY REQUIRE SHARED OR
; EXCLUSIVE ACCESS TO A BLOCK, BUT DON'T, BECAUSE ANOTHER REQUEST
; REQUIRES EXCLUSIVE ACCESS TO THE WHOLE INDEX (AND THEREFORE THE
; WHOLE FILE).
; ALSO CHECK FOR A RANDOM FILE HAVING A RECORD RETAINED WITH A KEY
; OF 0. IF SUCH IS THE CASE, THE FILE MUST BE ENQUEUED ON EXCLUSIVE
; SO THE 'NEXT RECORD' WILL NOT CHANGE BETWEEN RETAINING AND
; READING OR WRITING. IF NO KEY OF 0 IS BEING RETAINED, ENQUEUE ON
; THE FILE SHARED AND ON EACH INDIVIDUAL BLOCK ACCORDING TO THE
; REQUESTED OPERATION.
LRENQ1: MOVEM ACRR,SU.CRH ;SAVE THE HIGHEST VALUE OF ACRR (WHICH
;IS THE LENGTH OF THE RETAINED RECORDS
;TABLE), SO WE KNOW WHEN TO LEAVE THE
;SECOND, THIRD, AND FOURTH LOOPS.
MOVEM ACRR,SU.SVK ;INITIALIZE THE POINTER TO WHERE
;WE CAN KEEP KEYS REPRESENTING
;CURRENT POSITIONS OF INDEXED FILES
MOVE ACRR,SU.RRT ;START SECOND LOOP AT THE FIRST ENTRY
LRENQ4: CAML ACRR,SU.CRH ;END OF THE SECOND LOOP?
JRST LRENQ7 ;YES, GO ENQUEUE INDEXES AND ENTER THIRD
;LOOP
;LOOK FOR A SPECIAL CASE IN
;THE DETERMINATION OF "RECORD 0".
;IF THE FILE IS NOT INDEXED AND
;IF KEY IS ZERO, AND THE ENQUEUEING
;FLAGS INDICATE THE USER INTENDS ONLY
;TO WRITE THE RECORD, AND THE USER'S
;PREVIOUS OPERATION ON THE FILE WAS A
;READ, SET F.WSMU TO -2 (F.WSMU WAS
;INITIALIZED IN THE FIRST LOOP TO -1.
;IN THE THIRD LOOP IT WILL BE ADDED TO
;D.RP + 2 (CURRENT RECORD NUMBER + 2)
;TO DETERMINE THE DEFINITION OF
;"RECORD 0".
IFN ANS68,<
SKIPE 2(ACRR)
JRST S19 ;NOT RECORD 0 (NEXT RECORD)
>
IFN ANS74,<
LDB AT1,RRTNXT
JUMPE AT1,S19 ;NOT RECORD 0 (NEXT RECORD)
>;END IFN ANS74
HRRZ AFT,0(ACRR)
LDB AT1,FTAM
CAIN AT1,INDEXD
JRST S19
CAIN AT1,RANDOM ;[455] IS THE FILE RANDOM?
JRST S20 ;[455] YES
LDB AT1,CRRFG4
IFN ANS68,<
TRNE AT1,JSTWRT ;RETAIN WRITE ONLY?
>;
IFN ANS74,<
TRNE AT1,JSTRWT ;RETAIN REWRITE ONLY?
>
JRST S19 ;NO
HLRZ AT1,D.BL(AFT) ;YES,ADDRESS BUFFER AREA
SETO AT2, ;WRITE LAST OPER. FLG
HRREI AT3,-2 ;"KEY 0" VALUE TO GET LAST USED LOCATION
CAME AT2,LASTUU(AT1) ;LAST OPER. WRITE?
HRRM AT3,F.WSMU(AFT) ;NO, RESET TO (RE)WRITE REC JUST READ
S19: LDB AT1,CRRQT
CAIE AT1,3
CAIN AT1,7 ;[455] RANDOM KEY OF 0?
SKIPA ACRR2,SU.RRT ;ENTER SUB-LOOP TO SEE IF A PRIOR
;REQUEST NEEDS EXCLUSIVE ACCESS TO THE SAME INDEX
JRST SS1 ;[455] JUMP IF THIS REQUEST DOESN'T REQUIRE
;[455] INDEX-EXCLUSIVE ACCESS OR RANDOM KEY OF 0
S4: CAMN ACRR2,ACRR ;END OF SUBLOOP?
JRST S5 ;YES
LDB AT1,CRRQT2 ;NO
CAIE AT1,3 ;INDEX-EXCLUSIVE ACCESS?
CAIN AT1,7 ;[455] RANDOM KEY OF 0?
JRST .+2 ;[455] JUMP IF EITHER IS TRUE
JRST SS3 ;NO
HRRZ AT1,0(ACRR2) ;YES
HRRZ AT2,0(ACRR)
CAMN AT1,AT2 ;SAME FILE?
JRST SS2 ;YES, JUMP OUT OF SUBLOOP (ANOTHER
;REQUEST HAS ALREADY ENQUEUED ON THE
;INDEX FOR THIS FILE)
SS3: LDB AT1,CRRIN2 ;MOVE TO THE NEXT ENTRY
ADD ACRR2,AT1
JRST S4 ;RETURN TO BEGINNING OF SUB-LOOP
; IF WE REACH S5, NO OTHER REQUEST HAS ALREADY ENQUEUED ON THE
; INDEX SO WE SHALL DO IT.
S5: SETZ AT1, ;SET LH = EXCLUSIVE, RH = ENQUEUE
SETO AT2, ;-1 MEANS INDEX
PUSHJ PP,QUEUE ;CREATE REQUEST ENTRY
LDB AT1,FTAM ;[455] GET FILE TYPE
CAIE AT1,RANDOM ;[455] IF IT IS A RANDOM FILE DON'T DO ZSATB
PUSHJ PP,ZSATB ;ASK CBLIO TO FORGET ABOUT ITS IN-CORE
;STORAGE ALLOCATION TABLES, IF NECESSARY
JRST SS2 ;MOVE ON TO THE NEXT ENTRY
SS1: JUMPE AT1,SS2 ;JUMP IF NO QUEUEING (QT = 0)
HRRZ AFT,0(ACRR)
LDB AT2,FTAM
CAIE AT2,INDEXD
CAIN AT2,RANDOM ;[455]
SKIPA ACRR2,SU.RRT ;ENTER SUB-LOOP
JRST SS2 ;JUMP IF FILE NOT INDEXED
; HERE WE KNOW THAT THE FILE IS EITHER INDEXED OR RANDOM AND THAT THE QUEUEING
; TECHNIQUE MUST BE EITHER SHARED OR EXCLUSIVE. THE PROBLEM IS
; TO DETERMINE IF (A) A PRIOR REQUEST HAS REQUIRED SHARED ACCESS
; TO THE INDEX OR (B) A REQUEST IN THE TABLE (NOT
; NECESSARILY PRIOR) WILL REQUIRE EXCLUSIVE ACCESS TO THE INDEX.
; IF NEITHER IS TRUE, WE MUST GENERATE A SHARED REQUEST FOR THE
; INDEX; OTHERWISE, WE NEED DO NOTHING.
SETZM SU.Y ;SET Y TO 0
U1: CAML ACRR2,SU.CRH ;END OF SUB-LOOP?
JRST U2 ;YES
HRRZ AT1,0(ACRR2)
HRRZ AT2,0(ACRR)
CAME AT1,AT2 ;SAME FILE?
JRST U3 ;NO, GO TO NEXT ENTRY
LDB AT2,FTAM ;[455] GET FILE TYPE
CAIN AT2,RANDOM ;[455] IS IT RANDOM
JRST S24 ;[455] YES
LDB AT1,CRRQT2
CAIN AT1,3 ;INDEX-EXCLUSIVE ACCESS?
JRST U4 ;YES, GO TO UPDATE QT
U5: CAML ACRR2,ACRR ;[455] ARE WE LOOKING AT A PRIOR ENTRY?
JRST U3 ;NO, GO TO THE NEXT ENTRY
CAIE AT1,1 ;SHARED?
CAIN AT1,2 ;OR EXCLUSIVE?
SETOM SU.Y ;YES, SET Y TO 1
U3: LDB AT1,CRRIN2 ;INCREMENT ACRR2 TO POINT TO THE NEXT
;ENTRY
ADD ACRR2,AT1
JRST U1
U4: LDB AT1,CRRQT ;UPDATE QUEUEING TECHNIQUE TO INDICATE
;THAT ANOTHER ENTRY HAS REQUESTED
;EXCLUSIVE USE OF THE INDEX
ADDI AT1,3
DPB AT1,CRRQT
JRST SS2
U2: SKIPE SU.Y ;IF Y IS NON-ZERO, THEN A PRIOR
;REQUEST HAS TAKEN CARE OF OUR INDEX
;REQUIREMENT
JRST SS2
HRLZI AT1,000001 ;OTHERWISE WE MUST SUBMIT A REQUEST FOR
;SHARED ACCESS TO THE INDEX
SETO AT2,
PUSHJ PP,QUEUE
SS2: LDB AT1,CRRINE ;END OF THE SECOND LOOP
ADD ACRR,AT1 ;POINT TO THE NEXT ENTRY IN THE RETAINED
;RECORDS TABLE
JRST LRENQ4
S24: LDB AT1,CRRQT2 ;[455]
CAIN AT1,7 ;[455] RANDOM KEY OF 0?
JRST SS2 ;[455] YES
JRST U5 ;[455]
S20: LDB AT1,CRRFG4 ;[455] GET RETAINED FOR FLAGS
TRNN AT1,15 ;[455] ARE WE ONLY WRITING?
JRST S22 ;[455] YES
LDB AT1,CRRQT ;[455] GET CURRENT QT
JUMPE AT1,S19 ;[455] QT = 0, FORGET ALL THIS CRAP
S21: MOVEI AT1,7 ;[455] NO, CHANGE CURRENT TO 7
DPB AT1,CRRQT ;[455]
JRST S19 ;[455] BACK TO MAIN ROUTINE
S22: SETZM ACRR3 ;[455] SET UP FOR SUB-LOOP
MOVE ACRR2,SU.RRT ;[455] START AT TOP OF RRT
S26: CAML ACRR2,ACRR ;[455] LOOK AT ALL PRIOR TO FIND JUST PRIOR
JRST S25 ;[455] SEE IF THERE IS A PRIOR
HRRZ AT1,0(ACRR) ;[455]
HRRZ AT2,0(ACRR2) ;[455]
CAMN AT1,AT2 ;[455] THIS ENTRY SAME AS MAJOR ENTRY
MOVE ACRR3,ACRR2 ;[455] YES, SAVE FOR LATER
LDB AT1,CRRIN2 ;[455] LOOK AT NEXT
ADD ACRR2,AT1 ;[455]
JRST S26 ;[455]
S25: JUMPE ACRR3,S23 ;[455] JUMP IF NO PRIOR ENTRY IN TABLE
LDB AT1,[POINT 4,0(ACRR3),6] ;[455] GET PRIOR'S RETAINED FOR FLAG
TRNE AT1,RTTNRD ;[455] PRIOR WAS A READ ONLY?
JRST S21 ;[455] NO
IFN ANS68,< ;[455] USE PRIOR KEY FOR THIS ENTRY SINCE
SKIPN AT1,2(ACRR3) ;[455] THIS ENTRY IS A WRITE AFTER READ,
JRST S21 ;[455] UNLESS THE KEY FOR THE PRIOR ENTRY
>;END IFN ANS68 ;[455] IS ALSO 0
IFN ANS74,< ;[455] PRIOR KEY IS ZERO
LDB AT1,RRTNX3 ;GET "NEXT RECORD" FLAG
JUMPN AT1,S21 ; PRIOR KEY WAS "NEXT RECORD"
MOVE AT1,2(ACRR3) ;NO, GET IT
>;END IFN ANS74
MOVEM AT1,2(ACRR) ;[455] USE PRIOR KEY
JRST S19 ;[455] AND RESUME NORMAL PROCESSING
S23: HLRZ AT1,D.BL(AFT) ;[455] SINCE NO PRIOR ENTRY EXISTS
;[455] IN THE TABLE, SEE WHAT THE LAST
;[455] REAL IO OPERATION WAS FOR THIS FILE
SETO AT2, ;[455]
CAME AT2,LASTUU(AT1) ;[455] WAS THE LAST UUO A READ?
SKIPN AT1,D.RP(AFT) ;[455] YES, USE CURRENT REC # IF NON 0
JRST S21 ;[455] CURRENT REC # IS 0
MOVEM AT1,2(ACRR) ;[455] USE CURRENT REC # FOR THIS ENTRY
;[455] SINCE IT IS A READ AFTER WRITE
JRST S19 ;[455] JOIN NORMAL PROCESSING
; WE HAVE NOW DETERMINED THE QUEUEING REQUIREMENTS FOR INDEXES.
; SO LET'S ASK ENQ/DEQ IF WE CAN HAVE THEM.
LRENQ7: SETZ AT1, ;INDICATE ENQ REQUEST
PUSHJ PP,ENQDEQ
TRNA ;CAN'T HAVE THEM OR SOMETHING'S WRONG
JRST LRENQ0 ;NORMAL RETURN - GO TO THE THIRD LOOP
ABNORM: HLLZ AT1,0(AP) ;IS THERE AN UNAVAILABLE EXIT?
JUMPE AT1,SU.ER7 ;NO, MUST BE AN UNEXPECTED ERROR
AOS 0(PP) ;YES, ADJUST RETURN
SETZM SU.RR ;ZERO NUMBER OF RECORDS RETAINED
RESTRM
POPJ PP, ;RETURN TO THE UNAVAILABLE STATEMENT
; THIRD LOOP.
;
; FINISH THE DETERMINATION OF THE DEFINITION OF "RECORD 0" FOR
; EACH FILE FOR WHICH THE USER HAS SPECIFIED THAT RECORDS BE
; RETAINED
;
; NOW THAT WE'VE BUILT THE TABLE OF RECORDS TO BE RETAINED
; (FIRST LOOP), AND GAINED ACCESS TO THE INDEXES WE REQUIRE
; (SECOND LOOP), IT'S TIME TO DETERMINE WHICH BLOCKS TO WHICH
; WE NEED TO GAIN ACCESS.
;
; AT THIS TIME IN THE PROCESSING WE HAVE ALREADY ENQUEUED ON THE
; INDEX OF AN ISAM FILE AND/OR ON THE ENTIRE FILE FOR A
; RANDOM FILE. THIS GAURANTEES THAT FROM THIS POINT ON NO
; CHANGES CAN BE MADE IN THE FILE BY OTHERS. THIS IS TRUE
; REGARDLESS OF WHETHER WE ENQUEUED SHARED OR EXCLUSIVE.
LRENQ0: MOVE ACRR,SU.RRT ;START WITH THE FIRST ENTRY
SETZM SU.EQ ;ZERO NUMBER OF ENTRIES IN ENQ QUEUE
LRENQ9: CAML ACRR,SU.CRH ;END OF THE THIRD LOOP?
JRST LRENQ5 ;YES, GO GENERATE FINAL ENQ REQUEST IN
;THE FOURTH LOOP
;IF THE FILE IS NOT INDEXED
HRRZ AFT,0(ACRR) ;DEFINE "RECORD 0" FOR THE FILE IN
;WHICH THIS RECORD EXISTS, IF IT HAS
;NOT ALREADY BEEN DEFINED (DUE TO THE
;PROCESSING OF ANOTHER ENTRY SPECIFYING
;ANOTHER RECORD IN THE SAME FILE).
LDB AT2,FTAM
CAIE AT2,INDEXD ;[455]
CAIN AT2,RANDOM ;[455]
JRST V5 ;[455] IF FILE IS INDEXED, OR RANDOM
;GO CALL BLKNUM TO GET BLOCK NUMBER
;AND CHECK FOR LOW-VALUES, REGARDLESS
;OF OTHER CONSIDERATIONS
HRRE AT1,F.WSMU(AFT)
JUMPGE AT1,V2 ;JUMP IF "RECORD 0" ALREADY DEFINED
ADD AT1,D.RP(AFT) ;OTHERWISE RECORD 0 = F.WSMU + D.RP +2
ADDI AT1,2
HRRM AT1,F.WSMU(AFT)
V2: MOVE AT3,2(ACRR) ;[455] IF FILE IS SEQUENTIAL, THEN CONVERT
;THE RELATIVE KEY TO AN ABSOLUTE KEY
;BY ADDING THE DEFINITION OF
;"RECORD 0"
ADD AT3,AT1
MOVEM AT3,2(ACRR)
LDB AT1,CRRQT
SKIPE AT1 ;NO BLOCK REQUIRED IF FILE IS NOT INDEXED AND QT INDICATES
;NO QUEUEING - GO TO END OF LOOP
V5: PUSHJ PP,BLKNUM ;OTHERWISE, GET BLOCK NUMBER
LDB AT1,CRRINE ;MOVE ON TO NEXT REQUEST
ADD ACRR,AT1
JRST LRENQ9
; FOURTH AND FINAL LOOP.
;
; GENERATE AN ENQUEUE REQUEST FOR EACH BLOCK THAT REQUIRES EITHER
; SHARED OR EXCLUSIVE QUEUEING. MAKE SURE THAT EACH BLOCK IS
; QUEUED ONLY ONCE. IF ONE REQUEST ASKS SHARED ACCESS AND ANOTHER
; EXCLUSIVE, QUEUE FOR EXCLUSIVE.
LRENQ5: MOVE ACRR,SU.RRT ;START WITH THE FIRST ENTRY
LREN11: CAML ACRR,SU.CRH ;END OF THE FOURTH LOOP?
JRST LREN12 ;YES, GO ON TO THE FINAL ACT
MOVE ACRR2,SU.RRT ;INITIALIZE FOR SUB-LOOP
SETZM SU.Y ;SET Y TO 0
HRRZ AFT,0(ACRR) ;[455]
LDB AT3,FTAM ;[455] GET FILE TYPE
CAIE AT3,RANDOM ;[455] RANDOM FILE?
IFN ANS68,<
JRST W3A ;[455] NO
>
IFN ANS74,<
JRST W3B ; No
>
MOVE AT2,D.CBN(AFT) ;[455] GET CURRENT REC #
SETZM SU.RND ;[455]
SETZM SU.RLV ;[455]
W9: CAML ACRR2,SU.CRH ;[455] FINISHED SUB-LOOP?
JRST W11 ;[455] YES, MUST BE NO QT 7'S
HRRZ AT1,0(ACRR2) ;[455]
CAME AT1,AFT ;[455] SAME FILE?
JRST W10 ;[455] NO
SKIPN SU.Y ;[455] IS THIS THE FIRST RRT ENTRY FOR THIS FILE?
MOVEM ACRR2,ACRR3 ;[455] YES, SAVE ITS POSITION
SETOM SU.Y ;[455] SET FIRST ALREADY SEEN
LDB AT1,CRRBK2 ;IS THIS AN ENTRY FOR THE CURRENT BLOCK?
CAMN AT1,AT2
SETOM SU.RND ;[455] YES, SET CURRENT BLOCK # SEEN
LDB AT1,CRRQT2 ;[455]
CAIN AT1,7 ;[455] IF ANY ENTRY FOR THIS FILE HAS
;[455] A QT OF 7 THE WHOLE FILE WILL BE
;[455] ENQ'D EXCLUSIVE SO NO NEED TO ENQ ANY
;[455] BLOCKS AT THIS TIME
SETOM SU.RLV ;[455] SET RAND EXCLUSIVE SEEN FLAG
W10: LDB AT1,CRRIN2 ;[455] THIS ONE ISN'T A 7 BUT
ADD ACRR2,AT1 ;[455] CHECK EM ALL
JRST W9 ;[455]
W11: SKIPL SU.RLV ;[455] ANY RAND EXCLUSIVE SEEN?
JRST W13 ;[455] NO, DO IT THE NORMAL WAY
CAMGE ACRR3,ACRR ;[455] HAVE WE ALREADY CHECKED THIS FILE
JRST W1 ;[455] YES GO TO NEXT ONE
LDB AT1,CRRBK3 ;[455] IS THE FIRST RRT FOR THIS FILE A 0 KEY
JUMPE AT1,W12 ;[455] YES DO A FORCR.
SKIPGE SU.RND ;[455] WAS THE CURRENT BLOCK # SEEN?
W12: PUSHJ PP,FF02 ;[455] MAKE AN ENTRY IN SU.FBT
JRST W1 ;[455] CHECK NEXT ENTRY
W13: MOVE ACRR2,SU.RRT ;[455] SET UP ACRR2
SETZM SU.Y ;[455] AND SU.Y
IFN ANS74,<
JRST W3A ;
W3B: CAIE AT3,INDEXD ; Is file indexed?
JRST W3A ; No
HLRZ AT1,D.BL(AFT) ; Get buffer position
SKIPN AT3,SVNXRT(AT1) ; Is current SAVNXT been saved?
JRST W3C ; No, no need to restore it
; Yes, reset RWDLKY to its old value, saved in RWDLRT at BN5 in BLKNUM
; at the same time reset RWDLRT to point at the RETAIN save area, for
; the next call to RETAIN code.
HRRM AT3,D.RFLG(AFT) ; Reset extra flags
SETZM SVNXRT(AT1) ; Clear save flag field
MOVE AT2,RWDLRT(AT1) ; Get retain save area address
MOVE AT3,RWDLKY(AT1) ; Get I-O level NNTRY and save area addr
HRRZM AT3,RWDLRT(AT1) ; Restore retain save area address
MOVEM AT2,RWDLKY(AT1) ; Restore I-O level del/rewrt save area pointer
W3C: HRRZ AT2,D.RFLG(AFT) ; Get savnxt flag
TRNN AT2,SAVNXT ; SAVNXT active at I-O level?
JRST W3A ; No, cont
SETZM CNTRY(AT1) ; Yes, clear fields so that saved position
SETZM NNTRY(AT1) ; Will be restored
>; END IFN ANS74
W3A: LDB AT1,CRRQT
W3: CAIN AT1,1 ;QUEUEING TECHNIQUE IS SHARED?
JRST W2 ;YES
CAIE AT1,2 ;QUEUEING TECHNIQUE IS EXCLUSIVE?
JRST W1 ;NO, LEAVE SUBLOOP AND MOVE ON TO THE
;NEXT MAJOR ENTRY
CAML ACRR2,ACRR
JRST W5 ;JUMP IF EXCLUSIVE AND NO PRIOR EXCLUSIVE
;HERE IF EXCLUSIVE AND IT'S NOT KNOWN
;YET IF THERE IS A PRIOR EXCLUSIVE
W4: HRRZ AT2,0(ACRR)
HRRZ AT3,0(ACRR2)
CAME AT2,AT3 ;SAME FILE?
JRST W7 ;NO, SO GET NEXT ENTRY
LDB AT2,CRRBLK
LDB AT3,CRRBK2 ;SAME BLOCK?
CAME AT2,AT3
JRST W7 ;NO, SO GET NEXT ENTRY
LDB AT2,CRRQT2
CAIN AT2,2 ;EXCLUSIVE?
JRST W1 ;YES, JUMP OUT OF SUB-LOOP AND MOVE
;ON TO THE NEXT MAJOR ENTRY
CAIE AT2,1 ;SHARED?
JRST W7 ;NO, SO GET NEXT ENTRY
CAMGE ACRR2,ACRR ;A PRIOR ENTRY?
SETOM SU.Y ;YES, SET Y TO 1
W7: LDB AT2,CRRIN2 ;GET NEXT ENTRY IN SUB-LOOP
ADD ACRR2,AT2
JRST W3
W2: CAMGE ACRR2,SU.CRH
JRST W4 ;JUMP IF SHARED AND NOT ALL BLOCKS CHECKED
SKIPE SU.Y ;DOES Y = 1 (A PRIOR ENTRY HAS QUEUED
;SHARED ON THIS BLOCK?)
JRST W1 ;YES, MOVE ON TO THE NEXT MAJOR ENTRY
HRLZI AT1,1 ;SET LH TO SHARED, RH TO ENQ
W8: LDB AT2,CRRBLK ;[455] GET BLOCK NUM (FOR FILFLU ROUTINE)
REPEAT 0,<
;THIS CODE HAS BEEN REMOVED (3/31/78) BECAUSE THE BUFFER FILLING
;WAS DONE BEFORE THE .IDA FILE BLOCKS HAD BEEN ENQ'D
; FILFLU MUST BE CALLED TO MAKE CBLIO PRETEND IT HASN'T READ IN
;THAT DATA BLOCK YET. IT WILL BE DONE AT THE "READ".
HRRZ AFT,0(ACRR) ;IF THIS IS AN INDEXED FILE, BUFFER
LDB AT3,FTAM ;FILLING WAS HANDLED IN THE THIRD
LDB AT4,FTOTA
CAIE AT3,INDEXD ;LOOP BY THE BLKNUM ROUTINE
JRST W14
TRNN AT4,3
TRNN AT4,4
JRST .+2
W14:
>;END OF REPEAT 0
PUSHJ PP,FILFLU ;CHECK TO SEE IF BUFFER WILL NEED
;TO BE REFILLED
PUSHJ PP,QUEUE ;QUEUE REQUEST
W1:
IFN LSTATS,<
LDB AT1,CRRQT ;GET QT VALUE
ADD AT1,MRTDBP ;ADD IN TRAILER ADDRESS
AOS MB.RTN(AT1) ;INCREMENT PROPER RETAIN BUCKET
>
LDB AT2,CRRINE ;MOVE ON TO GET NEXT MAJOR ENTRY
ADD ACRR,AT2
JRST LREN11
W5: SETZ AT1, ;SET LH TO EXCLUSIVE, RH TO ENQ
JRST W8
; THE FINAL ACT
;
; CALL ENQ/DEQ TO QUEUE BLOCKS
LREN12: SETZ AT1, ;SET RH TO ENQUEUE
PUSHJ PP,ENQDEQ
JRST LREN99 ;NOT AVAILABLE OR ERROR
MOVEI AT1,AT1
HRLM AT1,SU.FBT
LREN13: RESTRM
SOSGE AT1,SU.CFB ;NORMAL RETURN. WE NOW HAVE DESIRED
;ACCESS TO REQUESTED BLOCKS. ASK CBLIO
;TO REFILL THE CURRENT BUFFER FOR
;EACH FILE, IF, IN FACT, IT CONTAINS
;ONE OF THE BLOCKS WE'VE JUST GAINED
;ACCESS TO.
IFE LSTATS,<
POPJ PP, ;RETURN TO USER
>
IFN LSTATS,<
JRST LRENMR ;METER THEN EXIT
>
MOVE AP,@SU.FBT
PUSHJ PP,FORCR.
JRST LREN13
IFN LSTATS,<
LRENMR: MOVE AT1,MRTDBP ;GET TRAILER ADDRESS
MOVEI AT1,MB.SUT(AT1) ;GET ADDRESS TO RETAIN TIMING BUCKET
MOVEM AT1,MRTMB. ;SAVE TIMING ADDRESS
MRTME. (AT1) ; END RETAIN TIMING
POPJ PP, ;RETURN TO CBL PROGRAM
>;END IFN LSTATS
; THE BLOCKS WEREN'T AVAILABLE, SO NOW WE HAVE TO DEQUEUE THE INDEXES!!!!
LREN99: MOVE ACRR,SU.RRT ;LOOK THROUGH THE RETAINED RECORDS TABLE
SETZM SU.DQ ;ZERO THE NUMBER OF ENTRIES IN THE DEQUEUE QUEUE
LREN95: CAML ACRR,SU.CRH
JRST LREN94 ;JUMP IF END OF TABLE
HRRZ AFT,0(ACRR)
LDB AT1,FTAM
CAIE AT1,RANDOM ;[455] RANDOM FILE?
CAIN AT1,INDEXD ;[455] NO, INDEXED
SKIPA ACRR2,SU.RRT ;[455] YES, MUST BE EITHER RAND OR INDEX
;SEE IF A PREVIOUS ENTRY INVOLVED THE SAME FILE
JRST LREN98 ;[455] IGNORE ENTRY IF FILE NOT INDEXED, OR RANDOM
LREN96: CAML ACRR2,ACRR
JRST LREN97 ;JUMP IF ALL PREVIOUS ENTRIES EXAMINED
HRRZ AT1,0(ACRR2)
CAMN AT1,AFT
JRST LREN98 ;JUMP IF PREVIOUS ENTRY INVOLVED SAME FILE
LDB AT1,CRRIN2 ;OTHERWISE, EXAMINE ANOTHER PREVIOUS ENTRY
ADD ACRR2,AT1
JRST LREN96
LREN97: MOVEI AT1,1 ;DEQUEUE THE INDEX
SETO AT2,
PUSHJ PP,QUEUE
LREN98: LDB AT1,CRRINE ;MOVE ON TO THE NEXT ENTRY
ADD ACRR,AT1
JRST LREN95
LREN94: MOVEI AT1,1
MOVEI AT2,1
PUSHJ PP,ENQDEQ ;ACTUALLY CALL ENQ/DEQ
JRST SU.ER7
JRST ABNORM
; LRDEQ: LIBOL RECORD DEQUEUE - CALLED FOR EACH EXECUTION OF A FREE STATEMENT
;
;
; LRDEQ EXPECTS TO FIND IN AC16 THE ADDRESS OF AN ARGUMENT LIST
; STRUCTURED AS FOLLOWS:
;
; WORD 1: RH = NUMBER OF RECORDS TO BE FREED (N)
; LH = 0 => USER DID NOT SUPPLY A NOT RETAINED STATEMENT
; LH = 1 => USER DID SUPPLY A NOT RETAINED STATEMENT
;
; WORD 2: BITS 0-8: 152
; BIT 9: FREE ALL RECORDS, IF SET
; BIT 10: FREE ALL RECORDS IN THIS FILE, IF SET
; BITS 11-13: NOT USED
; BIT 14: USER SUPPLIED DATA NAME OR LITERAL, IF SET
; BITS 15-17: NOT USED
; RH = FILE TABLE LOCATION
;
; WORDS 3,4,...,N: SAME AS SPECIFIED FOR LRENQ
;
;
; THIS PROCEDURE SHARES ALL DATA STRUCTURES, SUBROUTINES AND
; SYMBOLS WITH LRENQ.
;
;
; THIS PROCEDURE ASSUMES THAT BUFFERS ARE NOT SHARED. SHOULD
; THEY EVER BE SHARED, ONE SMALL CHANGE WILL BE NEEDED IN THE
; ALGORITHM (SEE COMMENT IN THE CODE).
;
; THIS PROCEDURE HAS A SECONDARY ENTRY POINT AT LRDEQX, FOR
; USE IN CASE OF AUTOMATIC FREEING BY READ, REWRITE, WRITE,
; AND DELETE. TO ENTER THIS PROCEDURE AT LRDEQX, SET THE F
; BIT OF ALL RECORDS TO BE FREED IN THE RETAINED RECORDS TABLE
; AND SIMPLY DO A PUSHJ PP, LRDEQX. NO PARAMETERS ARE
; REQUIRED. LRDEQX RETURNS TO 0(PP).
LRDEQ.: SAVE
SKIPE SU.RR ;ARE ANY RECORDS CURRENTLY RETAINED?
JRST A1 ;YES, LET'S DIG DEEPER
HLLZ AT1,0(AP) ;IS THERE A NOT RETAINED EXIT?
SKIPE AT1
AOS 0(PP) ;YES, ADJUST RETURN
RESTRM
POPJ PP, ;RETURN TO USER
A1: MRTMS. (AT1) ;START METER TIMING
SETZM SU.CFB ;ZERO NUMBER OF ENTRIES IN THE FILL/
;FLUSH BUFFER TABLE
MOVE AT1,1(AP)
TLNN AT1,FREALR ;FREE ALL RECORDS?
JRST A2 ;NO
MRHDCT (MB.FEV,AT1) ;COUNT FREE EVERY REC METER POINT
MOVE I,SU.RR
MOVE ACRR,SU.RRT
SETO AT1,
A00: DPB AT1,CRRF ;SET FREE BIT IN EVERY ENTRY OF THE RETAINED RECORDS TABLE
LDB AT2,CRRINE
ADD ACRR,AT2
SOJG I,A00
PUSHJ PP,LRDEQX ;DEQUEUE EVERYTHING
RESTRM
POPJ PP,
A2: SETZM SU.NR ;ZERO NOT RETAINED FLAG, WHICH WE
;WILL SET SHOULD WE DISCOVER THE
;USER ATTEMPTING TO FREE A RECORD HE HAS
;NOT RETAINED
MOVEI AURS,1(AP) ;POINT AURS TO THE 1ST USER RECORD
;SPECIFICATION
HRRZ K,0(AP) ;COUNT USER RECORD SPCEIFICATIONS WITH K
LRDEQ0: LDB AT1,URSCON ;MAKE A LITTLE VALIDITY CHECK
CAIE AT1,152
JRST SU.ER2
MOVE AT1,0(AURS)
MOVSI ACRR2,(JFCL) ;[550] SET UP FOR LATER KEY COMPARE
TLNN AT1,USRSKY ;USER SUPPLIED A KEY?
JRST A4 ;NO
MRHDCT (MB.FRC,AT1) ;COUNT FREE REC METER POINT
LDB AT1,URSTYP ;YES, COMPILER HAS ALREADY CHECKED
;THAT IT MATCHES THE KEY OF THE FILE, SO
;WE CAN TURN OUR ATTENTION
;TO BUILDING A BYTE POINTER TO IT.
CAIN AT1,2
JRST A5 ;JUMP IF KEY 1 WORD COMP
CAIE AT1,4
JRST A6 ;JUMP IF KEY NOT 1 WORD COMP-1
A5: MOVEI AT3,1 ;SET KEY LENGTH IN BYTES IN AT3
JRST A7
A6: CAIE AT1,11
JRST A8 ;JUMP IF NOT 2 WORD KEY
MOVEI AT3,2 ;SET KEY LENGTH IN BYTES IN AT3
A7: MOVE AT2,1(AURS) ;GET ADDRESS FROM USER RECORD
;SPECIFICATION
A12: TLZ AT2,777740 ;ZERO P AND S FIELDS
TLO AT2,444400 ;SET BYTE SIZE TO 36
;WE NOW HAVE A BYTE POINTER TO THE KEY
;[550] MOVSI ACRR2,(JFCL) ;[447] SET UP FOR LATER KEY COMPARE
HRRZ AFT,0(AURS) ;IF FILE IS SEQUENTIAL, OR THE FILE
;IS RANDOM AND THE KEY IS ZERO,
;CONVERT THE RELATIVE KEY INTO AN
;ABSOLUTE KEY BY ADDING THE DEFINITION
;OF "RECORD 0" (F.WSMU). ADJUST AT2 TO
;POINT TO THE ABSOLUTE KEY INSTEAD OF
;THE RELATIVE KEY. NOTE: IF THE FILE
;IS NOT INDEXED, THE KEY IS ALWAYS
;ONE WORD COMP.
LDB AT1,FTAM
CAIN AT1,INDEXD
JRST A9
SKIPN AT4,0(AT2)
JRST A19
CAIN AT1,RANDOM
JRST A9
A19: CAIN AT1,RANDOM ;[455] RANDOM FILE?
JRST FRERLV ;[455] YES
HRRZ AT5,F.WSMU(AFT) ;[455]
ADD AT4,AT5
MOVEM AT4,SU.AK
HRRI AT2,SU.AK
JRST A9
FRERLV:
MOVE ACRR,SU.RRT ;[455] 'FREE' WITH KEY OF 0 WILL
;[455] FREE FIRST RECORD IN RRT WITH
;[455] A KEY OF 0 FOR THAT FILE
CAML ACRR,SU.CRH ;[455] LOOKED AT ALL RECORDS YET?
JRST B6M1 ;[455] YES, NO 0 KEY EXISTS
HRRZ AT1,0(ACRR) ;[455]
CAME AT1,AFT ;[455] SAME FILE?
JRST FRELV1 ;[455] NO
LDB AT1,CRRF ;[455] GET FREED FLAG
JUMPN AT1,FRELV1 ;[455] ARE WE LOOKING AT AN ALREADY FREED REC
IFN ANS74,< ;(ASSUMING A KEY VALUE OF 0 WERE ALLOWED)
LDB AT1,RRTNXT ;IF "NEXT RECORD" WAS RETAINED,
JUMPN AT1,FRELV2 ; THEN NO KEY WAS MOVED
JRST FRELV1 ;NOT AN ENTRY FOR "NEXT RECORD"
>;END IFN ANS74
IFN ANS68,<
SKIPE 2(ACRR) ;[455] IS THIS A 0 KEY?
JRST FRELV1 ;[455] NO
>;END IFN ANS68
FRELV2: SETO AT1, ;[455]
DPB AT1,CRRF ;[455] TURN ON FREE FLAG
JRST B6 ;[455] GO DO NEXT USER RECORD SPEC
FRELV1: LDB AT1,CRRINE ;[455]
ADD ACRR,AT1 ;[455] LOOK AT NEXT ENTRY
JRST FRERLV+1 ;[455]
A8: CAIE AT1,15
JRST SU.ER5 ;JUMP IF INVALID TYPE CODE
;[532] PUSH PP,K
;[532] RESTRM
MOVEI AT1,@1(AURS) ;GET ADDRESS OF 2 WORD DESCRIPTOR
;IN AT1
;[532] POP PP,K
HRRZ AT3,1(AT1) ;GET SIZE FIELD FROM TWO WORD DESCRIPTOR
;IN AT3
;[550] MOVSI ACRR2,(JFCL) ;[532] NO CONVERSION NECESSARY
HRRZ AFT,0(AURS) ;SET FILE TABLE ADDRESS IN AFT
LDB AT2,FTKLB
CAME AT2,AT3
JRST SU.ER6 ;JUMP IF KEY SIZE INAPPROPRIATE; THE
;COMPILER ALREADY CHECKED THIS, BUT
;WHAT THE HELL.
MOVE AT2,0(AT1) ;GET BYTE POINTER TO USER SUPPLIED
;KEY IN AT2
JRST A9
A4:
IFE LSTATS,<
TLNE AT1,FREFEV
JRST A9 ;JUMP IF EVERY RECORD RETAINED FOR
> ;THIS FILE IS TO BE FREED
IFN LSTATS,<
TLNN AT1,FREFEV ;SKIP IF FREE EVERY REC FOR FILE
JRST LDQLST ;NOT EVERY REC, JUMP
MRHDCT (MB.FFE,AT1) ;COUNT METER POINT
JRST A9 ;CONTINUE
LDQLST:>
HRRZ AFT,0(AURS)
LDB AT1,FTAM
CAIE AT1,INDEXD
JRST A11 ;JUMP IF FILE NOT INDEXED
PUSH PP,ACRR2 ;SAVE CONVERT INSTRUCTION
PUSHJ PP,CLVACI ;COMPARE KEY AGAINST LOW-VALUES AND
;CONVERT, IF NECESSARY
JRST [POP PP,(PP) ;THROW AWAY OLD CONVERT INSTR
MOVE ACRR2,D.RCNV(AFT) ;[447] DO FILE TABLE CONV
PUSHJ PP,CHGCNV ;[447] CHECK FOR SPECIAL CONV INSTRS.
MOVE AT2,SU.RBP ;[447] GET DATA-REC-KEY BYTE PTR
JRST A10] ;[534][447] RESUME
;[550] MOVSI ACRR2,(JFCL) ;[447] SET UP PHONY CONV INSTR.
POP PP,ACRR2 ;RESTORE CONVERT INSTR
MOVE AT2,F.WBSK(AFT) ;BYTE POINTER TO SYMBOLIC KEY
A10: LDB AT3,FTKLB ;[534] GET KEY LENGTH IN AT3
JRST A9
A11: MOVEI AT3,1 ;KEY SIZE IS 1 WHETHER RANDOM OR
;SEQUENTIAL
HRRZ AT2,F.RACK(AFT) ;CREATE BYTE POINTER FROM THE
;ADDRESS OF THE ACTUAL KEY
CAIE AT1,RANDOM ;BUT ONLY IF IT'S A RANDOM FILE
MOVEI AT2,[0] ;IF IT'S A SEQUENTIAL FILE USE KEY
;OF ZERO
JRST A12
; AT THIS POINT WE HAVE A BYTE POINTER TO THE KEY OF THE
; RECORD TO BE FREED IN AT2, AND THE LENGTH OF THAT KEY IN AT3.
; (EXCEPT IN THE CASE OF FILENAME - EVERY RECORD)
;
; WE'LL NOW LOCATE THE ONE OR MORE RECORDS TO BE FREED IN THE
; RETAINED RECORDS TABLE, AND SET THEIR F BITS.
A9: MOVE I,SU.RR ;COUNT THE ENTRIES IN THE RETAINED
;RECORDS TABLE IN I
SETZM SU.Y ;ZERO FLAG Y. IN CASE OF THE FILENAME
;EVERY RECORD OPTION, WE'LL SET IT TO
;ONE IF WE FIND A MATCH ON FILENAME IN
;THE RETAINED RECORDS TABLE
MOVE ACRR,SU.RRT ;POINT TO THE 1ST ENTRY IN THE
;RETAINED RECORDS TABLE
B1: HRRZ AT1,0(AURS)
HRRZ AT4,0(ACRR)
CAME AT1,AT4 ;COMPARE FILES
JRST B3 ;JUMP IF NOT THE RIGHT FILE
MOVE AT1,0(AURS)
TLNN AT1,000200 ;EVERY RECORD OPTION?
JRST B4 ;NO, JUMP
SETOB AT1,SU.Y ;YES, SET F BIT IN RETAINED RECORDS
;TABLE SO AS TO FREE RECORD LATER,
;AND ALSO SET Y FLAG TO INDICATE THAT
;WE FOUND ONE
DPB AT1,CRRF
JRST B3 ;CONTINUE TO LOOK FOR OTHER RECORDS
;IN THE SAME FILE
B4: MOVEM AT3,SU.T3 ;COMPARE KEYS
MOVEM AT2,SU.T2 ;SAVE KEY POINTER AND LENGTH
MOVE AT1,AT2 ;GET SIZE FIELD FROM BYTE POINTER
TLZ AT1,770077 ;ISOLATE IT
TLO AT1,440000 ;SET P TO 36
HRRI AT1,2(ACRR) ;SET ADDRESS TO KEY IN RETAINED RECORDS
;TABLE
SKIPE SU.HV ;[447] FORCED HIGH VALUES IN USE?
JRST B8 ;[447] YES
B5: ILDB AT5,AT2 ;[447] USE AC 11 BECAUSE FILE TABLE
;[447] CONV INSTR DOES
XCT ACRR2 ;[447] CONVERT FROM EXT RECORDING MODE
;[447] TO INTERNAL MODE IF NECESSARY
ILDB AT4,AT1 ;[447] SWITCH AT4 FOR AT5
CAME AT4,AT5
JRST B7 ;JUMP IF KEYS NOT EQUAL
SOJG AT3,B5
B9: SETO AT1, ;[447] SET F FIELD IN THE RETAINED RECORDS
;TABLE
DPB AT1,CRRF
JRST B6 ;MOVE ON TO THE NEXT USER RECORD SPEC
B7: MOVE AT2,SU.T2 ;RESTORE KEY POINTER AND COUNT
MOVE AT3,SU.T3
B3: LDB AT1,CRRINE ;POINT TO NEXT ENTRY IN THE
;RETAINED RECORDS TABLE
ADD ACRR,AT1
SOJG I,B1
B2: SKIPN SU.Y ;SET NOT RETAINED FLAG IF NO SUCH
;RECORD FOUND
B6M1: SETOM SU.NR
B6: MOVE AT1,0(AURS)
SETZM SU.HV ;[447] TURN OFF HIGH VALUES USED
ADDI AURS,1
TLNE AT1,000010
ADDI AURS,1
SOJG K,LRDEQ0
A3: PUSHJ PP,LRDEQX ;NOW CONSIDER THE IMPLICATIONS OF
;DELETING THE FLAGGED RECORDS
JRST LRDEQC ;AND FINALLY, GO TO CLEANUP
B8: LDB AT5,AT2 ;[447] GET THE HIGH VALUES CHARACTER
ILDB AT4,AT1 ;[447] GET RRT KEY CHAR
CAME AT4,AT5 ;[447] ARE THEY THE SAME
JRST B7 ;[447] NO--CHECK NEXT RRT ENTRY
SOJG AT3,B8+1 ;[447] YES--CHECK NEXT CHAR IN RRT
JRST B9 ;[447] GOTCHA--JOIN COMMON CODE
; ALL THE RECORDS IN THE RETAINED RECORDS TABLE TO BE FREED HAVE
; NOW BEEN MARKED WITH SET F BITS. WE WILL NEXT CONSIDER THE
; IMPLICATIONS OF FREEING THESE RECORDS, WHICH ARE AS FOLLOWS:
;
; A. IF QUEUEING TECHNIQUE IS 0 (NO QUEUEING), OR 4 OR 5
; (COVERED BY ANOTHER RETAINED RECORD'S REQUIREMENT
; FOR EXCLUSIVE USE OF THE FILE), THEN THERE IS
; NO MORE WORK TO BE DONE.
;
; B. IF QUEUEING TECHNIQUE IS 3 (INDEX-EXCLUSIVE), WE
; NEED TO CHECK IF THERE IS A CONTINUED NEED FOR
; EXCLUSIVE USE OF THE FILE (OR INDEX), AND IF NOT,
; EITHER FREE THE INDEX OR MODIFY ITS USAGE TO SHARED.
; THE LATTER COURSE WOULD BE TAKEN IF ANOTHER REQUEST
; FOR THE SAME FILE HAS QUEUEING TECHNIQUE OF 4 OR 5,
; AND IT WOULD ALSO BE NECESSARY IN THAT CASE TO
; CHANGE THE QT TO 1 OR 2 AND ENQUEUE ON THE
; APPROPRIATE BLOCKS.
;
; C. IF QUEUEING TECHNIQUE IS 2 (EXCLUSIVE), WE NEED TO CHECK IF
; ANOTHER REQUEST HAS EITHER A SHARED OR EXCLUSIVE
; REQUIREMENT FOR THE SAME BLOCK, AND IF SO, REDUCE ITS USAGE
; TO SHARED OR LEAVE IT ENQUEUED EXCLUSIVE. OTHERWISE WE FREE IT.
;
; D. IF QUEUEING TECHNIQUE IS 1 (SHARED), WE NEED TO CHECK
; IF ANOTHER REQUEST HAS A CONTINUING REQUIREMENT FOR
; THE BLOCK. IF SO, WE LEAVE IT ENQUEUED, OTHERWISE
; WE FREE IT.
;
; E. IF QUEUEING TECHNIQUE IS 7 (RANDOM EXCLUSIVE), WE
; NEED TO CHECK IF ANOTHER RECORD FOR THIS FILE HAS A
; QT OF 7. IF THERE IS ANOTHER ONE, WE DO NOTHING, IF
; THERE ISN'T ANOTHER ONE, WE NEED TO MODIFY FILE
; ENQUEUEING TO SHARED. OBVIOUSLY, IF THERE ARE NO OTHER
; RECORDS IN THE RRT FOR THIS FILE AT ALL, THEN WE DEQUE
; THE FILE RESOURCE. ONCE THE FILE RESOURCE IS TAKEN
; CARE OF, THE PROCESSING IN STEPS C AND D ABOVE NEED TO
; BE DONE FOR THE DISK BLOCK.
;
;
; AS WE GO, WE'LL PREPARE THREE LISTS OF ENQ/DEQ REQUESTS:
; ENQUEUE, DEQUEUE, AND MODIFY LISTS.
;
; AS WE FREE A RECORD WE'LL LEAVE ITS F BIT SET AND ALSO
; SET ITS FILE TABLE ADDRESS TO ZERO.
;
; LRDEQX IS THE SECONDARY ENTRY POINT USED BY READ, REWRITE,
; WRITE, AND DELETE WHEN AUTOMATICALLY FREEING RECORDS.
; (SEE COMMENTS ABOVE)
LRDEQX: SETZM SU.EQ ;INITIALIZE NUMBER OF ENTRIES IN EACH
;OF THE ENQ/DEQ TABLES
SETZM SU.CFB ;[437] CLEAR FILL/FLUSH BUFFER
SETZM SU.DQ
SETZM SU.MQ
SETZM SU.MRR ;ZERO THE "MORE RETAINED RECORDS" FLAG
MOVEM PP,20(PP) ;SAVE ALL REGISTERS
MOVEM AP,17(PP)
MOVE AP,PP
MOVEI PP,1(PP)
BLT PP,16(AP)
MOVE PP,20(AP)
MOVE AP,17(PP)
ADD PP,[20,,20]
MOVE I,SU.RR
MOVE ACRR,SU.RRT
C1: HRRZ AFT,0(ACRR)
JUMPE AFT,C3 ;JUMP IF RECORD FREED BY
;PREVIOUS FREE STATEMENT (IF SO,
;FILE TABLE POINTER = 0)
LDB AT1,CRRF
JUMPE AT1,C4 ;JUMP IF RECORD NOT TO BE FREED (F = 0)
LDB AT1,CRRQT
JUMPE AT1,C5 ;JUMP IF QT = 0 (NO QUEUEING)
CAIG AT1,5 ;[455]
CAIGE AT1,4
JRST C6 ;[455] JUMP IF QT NOT 4 OR 5 OR 7
C5: SETZ AT1, ;ZERO FILE TABLE POINTER TO INDICATE
;RECORD FREED
HRRM AT1,0(ACRR)
JRST C3
C4: SETOM SU.MRR ;SET FLAG INDICATING THAT AT LEAST
;ONE RETAINED RECORD REMAINS
JRST C3
C6: MOVE J,SU.RR ;SET J, ACRR2, AND BOOLEAN VARIABLES IN PREPARATION FOR
;SUB-LOOP
MOVE ACRR2,SU.RRT
SETZM SU.SBD
SETZM SU.SFQ
SETZM SU.SFS
SETZM SU.SBS
SETZM SU.RLV ;[455]
SETZM SU.RND ;[455]
C7: CAMN ACRR,ACRR2 ;I = J?
JRST C9 ;YES, JUMP TO END OF SUB-LOOP
HRRZ AT1,0(ACRR) ;SAME FILE (AND J NOT ALREADY FREED)?
HRRZ AT2,0(ACRR2)
CAME AT1,AT2
JRST C9 ;NO, JUMP TO END OF SUB-LOOP
SETOM SU.SFQ ;YES, SET SAME FILE FLAG
LDB AT1,CRRQT
LDB AT2,CRRQT2
CAMN AT1,AT2 ;SAME QUEUEING TECHNIQUE?
SETOM SU.SFS ;YES, SET SAME FILE, SAME QT FLAG
CAIN AT2,7 ;[455] ANY OTHER ENTRYS FOR THIS FILE EXCLUSIVELY
SETOM SU.RLV ;[455] YES, REMEMBER IT
LDB AT3,CRRBLK
LDB AT4,CRRBK2
CAME AT3,AT4 ;SAME BLOCK?
JRST C9 ;NO, JUMP TO END OF SUB-LOOP
CAMN AT1,AT2 ;SAME QUEUEING TECHNIQUE?
JRST C10
SETOM SU.SBD ;NO, SET SAME BLOCK, DIFFERENT QT FLAG
JRST C9
C10: SETOM SU.SBS ;YES, SET SAME BLOCK, SAME QT FLAG
C9: LDB AT1,CRRIN2 ;INCREMENT J
ADD ACRR2,AT1
SOJG J,C7
LDB AT1,CRRQT
CAIE AT1,3 ;QT = 3 (INDEX-EXCLUSIVE)?
JRST C11 ;NO, JUMP
SKIPE SU.SFS ;YES, ANOTHER ENTRY HAS SAME QT?
JRST C5 ;YES!, WE DON'T NEED TO DO ANYTHING.
SKIPE SU.SFQ ;NO, ANOTHER ENTRY FOR THE SAME FILE?
JRST C17 ;YES, JUMP
C16: MOVEI AT1,1 ;NO, DEQUEUE INDEX
SETO AT2, ;SET AT2 TO SPECIAL BLOCK NUMBER
;INDICATING INDEX
C14: PUSHJ PP,QUEUE
JRST C5
C11: HRRZ AFT,0(ACRR) ;[455]
LDB AT2,FTAM ;[455] CHECK FILE TYPE
CAIE AT2,RANDOM ;[455] IS IT A RANDOM FILE?
JRST C11A ;[455] NO
SETOM SU.RND ;[455] YES, REMEMBER IT
SKIPE SU.RLV ;[455] IS THERE A RANDOM EXCLUSIVE ENTRY
JRST C5 ;[455] YES, DO NOTHING ELSE
CAIE AT1,7 ;[455] IS THIS ENTRY A RANDOM EXCLUSIVE?
JRST C11A ;[455] NO, DO IT NORMAL
HLRZ AT4,D.BL(AFT) ;[455] SEE IF THERE IS ANY LIVE DATA IN
SETO AT5, ;[455] THE CURRENT BUFFER. IF THERE IS,
CAMN AT5,LIVDAT(AT4) ;[455] SET AN ENTRY IN SU.FBT SO A FORCW.
PUSHJ PP,FF02 ;[455] HAPPENS
SKIPE SU.SFQ ;[455] YES, ANY OTHER ENTRIES FOR THIS FILE
JRST C17 ;[455] YES, ENQ PROPER BLOCKS, AND CHANGE
;[455] FILE ENQ TO SHARED
JRST C16 ;[455] NO, DEQ FILE AND FREE THIS ENTRY
C11A: CAIE AT1,2 ;[455] QT = 2 (EXCLUSIVE)?
JRST C12 ;NO, JUMP
SKIPE SU.SBS ;YES, ANOTHER REQUEST IS USING THE
;SAME BLOCK THE SAME WAY?
JRST C5 ;YES! DO NOTHING.
SKIPE SU.SBD ;NO, ANOTHER REQUEST IS USING
;THE SAME BLOCK DIFFERENTLY (I.E.,
;IN SHARED MODE)?
JRST C11B ;YES,SKIP AHEAD
SETZ AT1, ;NO, INDICATE EXCLUSIVE DEQ
JRST C13 ; DEQUEUE BLOCK
C11B: MOVE AT1,[1,,2] ; SET AT1 TO INDICATE "MODIFY"
LDB AT2,CRRBLK ;SET BLOCK NUMBER IN AT2
PUSHJ PP,FILFL2 ;CHECK TO SEE IF BUFFER NEEDS TO BE
;WRITTEN ON DISC
JRST C14 ;MODIFY ACCESS TO SHARED
C12: SKIPN SU.SBD ;(QT = 1, SHARED)
SKIPE SU.SBS
JRST C5 ;JUMP IF ANOTHER REQUEST IS USING
;THE SAME BLOCK, EITHER EXCLUSIVELY
;OR SHARED
HRLI AT1,1 ;INDICATE SHARED DEQ
C13: HRRI AT1,1
LDB AT2,CRRBLK
PUSHJ PP,FILFL2 ;CHECK TO SEE IF BUFFER NEEDS TO BE
;WRITTEN ON DISC
PUSHJ PP,QUEUE ;DEQUEUE BLOCK
SKIPE SU.SFQ ;ANOTHER REQUEST FOR THE SAME FILE?
JRST C5 ;YES, WE'RE ALL DONE
C15: HRRZ AFT,0(ACRR) ;NO, IS FILE INDEXED OR RANDOM?
LDB AT1,FTAM
CAIN AT1,SEQFIL## ;[455] IF IT'S A SEQUENTIAL FILE, IT CAN'T
;[455] BE INDEXED OR RANDOM
JRST C5 ;IT'S SEQUENTIAL
MOVEI AT1,12 ;CHECK FOR CLOSE VERB
CAMN AT1,SU.VRB ; is it
JRST C16 ; yes, no need to reset position
; GO DEQUEUE INDEX (RANDOM AND IDX)
CAIE AT1,RANDOM ;[455] IS IT RANDOM OR INDEXED
PUSHJ PP,RESTOR ;INDEXED, RESTORE CURRENT RECORD POINTER,
;IF NECESSARY
JRST C16 ;GO DEQUEUE INDEX (RANDOM AND IDX)
C17: MOVE AT1,[1,,2] ;CHANGE USAGE OF INDEX TO SHARED
SETO AT2,
PUSHJ PP,QUEUE
; AT THIS POINT(WE'RE LOOKING AT AN ENTRY WHICH HAS THE
; ENTIRE INDEX LOCKED, BUT WHICH WE'RE GOING TO FREE),
; WE NEED TO LOCATE THOSE ENTRIES WHICH HAVE PREVIOUSLY BEEN
; COVERED BY THIS ENTRY (QT = 4 OR 5), CHANGE THEIR QUEUEING
; TECHNIQUE TO 1 OR 2 (SHARED OR EXCLUSIVE), AND QUEUE ON THE
; INDIVIDUAL BLOCKS. THIS WILL REQUIRE A SUB-LOOP AND A
; SUB-SUB-LOOP.
MOVE J,SU.RR ;INITIALIZE FOR SUB-LOOP
MOVE ACRR2,SU.RRT
SKIPE SU.RND ;[455] IS THIS A RANDOM FILE?
JRST E1 ;[455] YES
D1: CAMN ACRR,ACRR2 ;I = J?
JRST D2 ;YES, GO TO END OF SUB-LOOP
HRRZ AT2,0(ACRR2)
HRRZ AT1,0(ACRR)
CAME AT1,AT2 ;SAME FILE (AND J NOT ALREADY FREED)?
JRST D2 ;NO, GO TO END OF SUB-LOOP
;AT THIS POINT, QT(J) MUST BE EITHER
;4 OR 5. IF IT WERE 0,1,2 OR 3 WE
;WOULDN'T BE HERE.
;
;IT CAN'T BE 3, BECAUSE SU.SFS (SAME
;FILE, SAME QUEUEING) WOULD HAVE BEEN
;SET, AND WE WOULDN'T BE HERE (SEE LABEL
;C8 ABOVE). IT CAN'T BE 1 OR 2, SINCE
;A VALUE OF 1 OR 2 WOULD NOT HAVE BEEN
;ASSIGNED INITIALLY BECAUSE QT(I)
; = 3, AND FURTHERMORE A CHANGE FROM 4
;OR 5 TO 1 OR 2 COULD HAVE ONLY
;BEEN MADE BY THIS CODE, WHICH COULD NOT
;HAVE HAPPENED BECAUSE FOR ANY L < I,
;THE FACT THAT QT(I) = 3 WOULD HAVE SET
;SU.SFS, AND WE WOULDN'T HAVE COME HERE.
;FINALLY, IT CAN'T BE ZERO BECAUSE QT(I)
; IS NOT ZERO AND SU.RR IS NOT ONE.
LDB AT3,CRRQT2
SUBI AT3,3
DPB AT3,CRRQT2 ;CHANGE QT TO 1 OR 2
MOVE K,SU.RR ;INITIALIZE FOR SUB-LOOP
MOVE ACRR3,SU.RRT
D3: CAMN ACRR2,ACRR3 ;K = J?
JRST D5 ;YES, JUMP
HRRZ AT1,0(ACRR2)
HRRZ AT2,0(ACRR3)
CAME AT1,AT2 ;SAME FILE (AND K NOT ALREADY FREED)?
JRST D5 ;NO, JUMP
LDB AT3,CRRBK2
LDB AT1,CRRBK3 ;SAME BLOCK?
CAME AT1,AT3
JRST D5 ;NO, JUMP
LDB AT1,CRRQT3
CAIN AT1,1 ;QT(K) = SHARED (1)?
JRST D7 ;YES, JUMP
CAIN AT1,2 ;QT(K) = 2 (EXCLUSIVE)?
JRST D2 ;YES, JUMP OUT OF SUB-SUB-LOOP TO
;END OF SUB-LOOP. WE DON'T NEED TO
;DO ANYTHING BECAUSE ANOTHER
;REQUEST HAS ALREADY QUEUED THE
;BLOCK EXCLUSIVE
CAIN AT1,5 ;QT(K) = 5?
JRST D4 ;YES, JUMP
LDB AT1,CRRQT2 ;QT(K) = 4, BY DEFAULT
CAIE AT1,1 ;QT(J) = SHARED?
JRST D10 ;NO, IT MUST BE EXCLUSIVE. NO NEED TO GO
;ANY FURTHER BECAUSE THERE IS NO CHANCE
;OF FINDING A 2 AFTER A 4
JRST D5 ;YES, WE MIGHT STILL FIND A 5, SO
;KEEP LOOKING
D7: LDB AT1,CRRQT2
CAIN AT1,1 ;QT(J) = 1 (SHARED)?
JRST D2 ;YES, NO NEED TO GO ANY FURTHER
;BECAUSE REQUEST(K) WILL CAUSE
;BLOCK TO BE QUEUED. JUMP
;OUT OF SUB-SUB-LOOP TO END OF SUB-LOOP
JRST D5
D4: LDB AT1,CRRQT2
CAIE AT1,2 ;QT(J) = 2 (EXCLUSIVE)?
JRST D2 ;NO, JUMP OUT OF SUB-SUB-LOOP TO END
;OF SUB-LOOP. NO NEED TO GO ON BECAUSE
;REQUEST(K) WILL CAUSE BLOCK TO BE
;QUEUED
D10: SETZ AT1, ;QUEUE THE BLOCK EXCLUSIVE, SINCE
;NO CHANCE OF FINDING A 2
D9: HRRZ AT2,1(ACRR2)
EXCH ACRR2,ACRR
PUSHJ PP,QUEUE
EXCH ACRR2,ACRR
JRST D2
D5: LDB AT1,CRRIN3
ADD ACRR3,AT1
SOJG K,D3
D8: LDB AT1,CRRQT2 ;QT(J) = SHARED?
CAIE AT1,1
JRST D10 ;NO, QUEUE BLOCK EXCLUSIVE
HRLZI AT1,1
JRST D9 ;YES, QUEUE BLOCK SHARED
D2: LDB AT1,CRRIN2 ;INCREMENT J
ADD ACRR2,AT1
SOJG J,D1
JRST C5
E1: CAMN ACRR,ACRR2 ;[455] I = J ?
JRST E2 ;[455] YES, GET NEXT J
HRRZ AT2,0(ACRR2) ;[455] NO
HRRZ AT1,0(ACRR) ;[455]
CAME AT1,AT2 ;[455] J SAME FILE AS I ?
JRST E2 ;[455] NO, GET NEXT J
MOVE ACRR3,SU.RRT ;[455] SET UP K FOR SUB-SUB-LOOP
SETZM SU.Y ;[455] SET TO -1 IF A PRIOR BLOCK HAS
;[455] ENQ'D SHARED ON A BLOCK
E9: CAME ACRR3,ACRR ;[455] K = I ?
CAMN ACRR3,ACRR2 ;[455] NO, K = J ?
JRST E5 ;[455] YES, GET NEXT K IN EITHER CASE
LDB AT1,CRRQT2 ;[455] NO, CHECK J'S QUEUING TECHNIQUE
CAIN AT1,1 ;[455] J SHARED?
JRST E3 ;[455] YES
CAIE AT1,2 ;[455] NO, J EXCLUSIVE?
JRST E2 ;[455] NO
CAMGE ACRR3,ACRR2 ;[455] YES, CHECKED ALL PRIOR TO J YET?
JRST E6 ;[455] NO, JUMP IF J IS EXCLUSIVE AND WE
;[455] DO NOT KNOW YET IF THERE IS A
;[455] PRIOR EXCLUSIVE
JRST E7 ;[455] YES, JUMP IF J IS EXCLUSIVE AND WE
;[455] KNOW THERE IS NO PRIOR EXCLUSIVE
E3: CAML ACRR3,SU.CRH ;[455] HAVE WE CHECKED ALL K'S?
JRST E8 ;[455] YES, JUMP IF J IS SHARED AND WE
;[455] HAVE CHECKED ALL PRIOR ENTRIES
E6: HRRZ AT2,0(ACRR2) ;[455]
HRRZ AT3,0(ACRR3) ;[455]
CAME AT2,AT3 ;[455] J AND K SAME FILE?
JRST E5 ;[455] NO, GET ANOTHER K
LDB AT2,CRRBK2
LDB AT1,CRRBK3 ;J AND K SAME DISK BLOCK?
CAME AT1,AT2
JRST E5 ;[455] NO, GET ANOTHER K
LDB AT3,CRRQT3 ;[455]
CAIN AT3,2 ;[455] K EXCLUSIVE?
JRST E2 ;[455] YES, GET ANOTHER J
CAIE AT3,1 ;[455] NO, K SHARED?
JRST E5 ;[455] NO, GET ANOTHER K
CAMGE ACRR3,ACRR2 ;[455] YES, IS K PRIOR TO J?
SETOM SU.Y ;[455] YES, SET PRIOR SHARED FLAG
E5: LDB AT3,CRRIN3 ;[455] GET NEXT K
ADD ACRR3,AT3 ;[455]
JRST E9 ;[455]
E8: SKIPE SU.Y ;[455] IF Y NOT 0, A PRIOR ENTRY HAS
;[455] ALREADY ENQ'D SHARED ON THIS BLOCK
JRST E2 ;[455] SO GET ANOTHER J
HRLZI AT1,1 ;[455] SET UP FOR SHARED ENQ
E10: LDB AT2,CRRBK2 ;[455] GET BLOCK NUMBER TO BE ENQ'D
PUSHJ PP,QUEUE ;[455] ADD TO ENQ TABLE
E2: LDB AT2,CRRIN2 ;[455] GET NEXT J
ADD ACRR2,AT2 ;[455]
SOJG J,E1 ;[455] CHECK ALL J'S
JRST C5 ;[455] FREE I AND GET ANOTHER I
E7: SETZ AT1, ;[455] SET UP FOR EXCLUSIVE ENQ
JRST E10 ;[455] ADD IT TO ENQ TABLE
C3: LDB AT1,CRRINE
ADD ACRR,AT1
SOJG I,C1
; OUR RESEARCH IS NOW COMPLETE. WE NEED ONLY FLUSH BUFFERS AND CALL ENQ/DEQ
MOVEI AT1,AT1
HRLM AT1,SU.FBT
C2: SOSGE AT1,SU.CFB ;ANY BUFFERS TO BE FLUSHED?
JRST C20 ;NO, GO ENQUEUE, ETC.
MOVE AP,@SU.FBT ;YES
PUSHJ PP,FORCW.
JRST C2
C20: SETZ AT1, ;FIRST WE ENQUEUE WHAT WE NEED
MOVEI AP,[0] ;[443] INSURE AP WILL CAUSE BLOCKING
PUSHJ PP,ENQDEQ
JRST SU.ERD
MOVEI AT1,2 ;THEN WE RELAX WHAT CAN BE RELAXED
PUSHJ PP,ENQDEQ
JRST SU.ERD
MOVEI AT1,1 ;AND FINALLY WE DEQUEUE WHAT WE DON'T
;NEED
PUSHJ PP,ENQDEQ
JRST SU.ERD
SKIPN SU.MRR ;IF NO MORE RETAINED RECORDS, THEN
;SET RR TO ZERO
SETZM SU.RR
HRLZI PP,-17(PP) ;RESTORE ALL REGISTERS
BLT PP,17
POPJ PP, ;RETURN TO THE (INTERNAL) CALLER
; FINAL CLEAN UP AND EXIT TO THE FREE STATEMENT
LRDEQC: RESTRM
IFN LSTATS,<
MOVE AT1,MRTDBP ;GET TRAILER BASE ADDRESS
MOVEI AT1,MB.FRT(AT1) ;ADD FREE TIME BUCKET OFFSET
MOVEM AT1,MRTMB. ;SAVE TIME BUCKET ADDRESS
MRTME. (AT1) ;END METER TIMING
>
HLRZ AT1,0(AP) ;DID USER SUPPLY A NOT RETAINED
;STATEMENT?
JUMPE AT1,RET.1 ;NO, RETURN TO FREE STATEMENT
MRHDCT (MB.FNR,AT1) ;COUNT FREE NOT RETAINED BUCKET
SKIPE SU.NR ;YES, ANY RECORD NOT RETAINED?
AOS 0(PP) ;YES, ADJUST RETURN ADDRESS
POPJ PP, ;RETURN TO FREE STATEMENT
; LFENQ: LIBOL FILE ENQUEUE
;
;
; THIS PROCEDURE IS CALLED ONCE BY THE COBOL OBJECT PROGRAM FOR
; THE EXECUTION OF EACH OPEN STATEMENT THAT CONTAINS SIMULTANEOUS
; UPDATE PARAMETERS.
;
;
; LFENQ EXPECTS TO FIND IN AC16 THE ADDRESS OF AN
; ARGUMENT LIST, STRUCTURED AS FOLLOWS:
;
; WORD 1: RH = NUMBER OF FILES TO BE OPENED FOR
; SIMULTANEOUS UPDATE
; LH = 0 => USER DID NOT SUPPLY AN UNAVAILABLE
; STATEMENT
; LH = 1 => USER SUPPLIED AN UNAVAILABLE STATEMENT
;
;
; NOTE: IF THE USER SUPPLIED AN UNAVAILABLE
; STATEMENT, THIS PROCEDURE RETURNS TO 1(PP)
; IF THE FILE(S) ARE AVAILABLE UNDER THE
; CONDITIONS SPECIFIED, AND RETURNS TO 0(PP)
; IF THEY ARE NOT. THIS IS EXACTLY THE
; OPPOSITE OF THE CONVENTION USED BY LRENQ
; AND LRDEQ (TO SEE WHY, TAKE A LOOK AT THE
; CODE GENERATED BY OPEN, RETAIN, AND FREE).
;
;
; WORDS 2 - N + 1:
; BITS 0 - 8: 143
; BIT 9: SET IF FILE IS BEING OPENED FOR REWRITE
; BIT 10: FOR WRITE
; BIT 11: FOR DELETE
; BIT 12: SET IF OTHERS ARE ALLOWED TO READ
; BIT 13: OTHERS ARE ALLOWED TO REWRITE
; BIT 14: OTHERS ARE ALLOWED TO WRITE
; BIT 15: OTHERS ARE ALLOWED TO DELETE
;
; NOTE: IT IS ALWAYS ASSUMED THAT THE FILE IS
; BEING OPENED FOR READ.
;
; BITS 16 - 17: UNUSED
; RH = FILE TABLE LOCATION
LFENQ.: SAVE
SKIPE SU.FR ;ARE ANY FILES CURRENTLY OPEN FOR
;SIMULTANEOUS UPDATE?
JRST SU.ER9 ;YES, JUMP
HRRZ I,0(AP)
MOVEM I,SU.FR ;SET SU.FR TO COUNT OF FILES BEING
;OPENED FOR SIMULTANEOUS UPDATE, AND
;LEAVE COUNT IN I
SETZM SU.EQ ;SET THE NUMBER OF ENTRIES IN THE
;ENQUEUE TABLE TO ZERO (LFENQ WILL NOT
;USE THE DEQUEUE TABLE OR THE
;MODIFY TABLE).
MOVEI AUFS,1(AP) ;POINT AUFS TO THE FIRST USER FILE
;SPECIFICATION
LFENQ1: MRTMS. (AT4) ;START METER TIMING
LDB AT4,UFSCON ;MAKE A LITTLE VALIDITY CHECK
CAIE AT4,143
JRST SU.ER2
LDB AT4,UFSFLG ;GET FLAGS FROM USER SPEC
TRO AT4,000200 ;SET FOR READ BIT
HRRZ AFT,0(AUFS)
DPB AT4,FTOTA ;SET OTHERS ACCESS IN FILE TABLE
ROT AT4,-4
DPB AT4,FTOWA ;SET OWN ACCESS IN FILE TABLE
HRLI AT4,600 ;GENERATE FAKE PARAMETER TO CBLIO
;OPEN ROUTINE IN FET1
HRR AT4,0(AUFS)
MOVEM AT4,FET1
MOVEM AUFS,FET2 ;SAVE OUR REGISTERS
MOVEM AP,FET3
MOVEM I,FET4
RESTRM ;RESTORE LIBOL REGISTERS
MOVE AP,FET1
PUSHJ PP,C.OPEN ;OPEN THE FILE
SETO I, ;[565] GET ONES
DPB I,LFQOPN ;[565] SET OPENED FROM LFENQ. BIT
MOVE AUFS,FET2 ;RESTORE OUR REGS
MOVE AP,FET3
MOVE I,FET4
HRRZ AFT,0(AUFS)
LDB AT4,FTAM
CAIE AT4,INDEXD
JRST PPF1
HLRZ AT4,D.BL(AFT)
SETOM NXTREC(AT4) ;INITIALIZE NXTREC TO -1 SO THAT
;AN INITIAL RETAIN WILL SAVE
;CORRECT POSITION
PPF1: LDB AT4,FTOWA
LDB AT5,UFSFLG
; AT4 NOW CONTAINS OWN ACCESS BITS FOR READ, REWRITE, WRITE, AND
; DELETE IN THE RIGHT HAND FOUR BITS AND AT5 THE SAME FOR OTHERS.
;
; WE'LL NOW CONSIDER THESE FOUR PAIRS OF BITS AND DETERMINE
; WHICH QUEUES THE USER SHOULD BE QUEUED ON, AND HOW.
; HE QUEUES SHARED ON THE QUEUE (E.G. READ) IF HE WANTS TO
; EXECUTE THE CORRESPONDING VERB WHILE ALLOWING OTHERS TO DO
; THE SAME, EXCLUSIVE IF HE WANTS TO EXECUTE THE CORRESPONDING
; VERB EXCLUSIVELY, GROUP 1 SHARED IF HE DOESN'T WANT TO EXECUTE
; THE CORRESPONDING VERB BUT ALSO WANTS NOONE ELSE TO, AND
; NO QUEUEING AT ALL IF HE WILL NOT EXECUTE THE VERB AND DOESN'T
; CARE WHAT OTHERS WILL DO. WE'LL DO THIS BY CALLING FED, THEN ENQDEQ.
HRRZ ACRR,AUFS ;SET ACRR SUCH THAT 0(ACRR) POINTS TO THE
;FILE TABLE
PUSHJ PP,FED ;CALL FILE ENQUEUE/DEQUEUE ROUTINE
AOS AUFS ;POINT TO THE NEXT USER FILE SPEC,
;IF ANY, AND LOOP BACK
MRTME. (AT1) ;END METER TIMING
SOJG I,LFENQ1 ;CALL ENQDEQ TO DO THE ACTUAL QUEUEING,
;IF ANY
RESTRM
SETZ AT1,
PUSHJ PP,ENQDEQ
JRST G1 ;JUMP IF SOME PROBLEM OR RESOURCES NOT
;AVAILABLE
HLLZ AT1,0(AP) ;EVERYTHING'S OK
JUMPN AT1,RET.2 ;IF UNAVAILABLE STATEMENT SUPPLIED,
;ADJUST RETURN
POPJ PP,
G1: SETZM SU.FR ; [434] CLEAR COUNT OF # OF SIMULTANEOUS FILES
HRRZ I,0(AP) ;CLOSE ALL THE FILES
MOVEI AUFS,1(AP)
CL: HRLI AT4,40 ;GENERATE FAKE PARAMETER TO CBLIO
;CLOSE ROUTINE IN FET1
HRR AT4,0(AUFS)
MOVEM AT4,FET1
MOVEM AUFS,FET2
MOVEM AP,FET3 ;SAVE OUR REGISTERS
MOVEM I,FET4
RESTRM ;RESTORE LIBOL REGISTERS
MOVE AP,FET1
PUSHJ PP,C.CLOS ;CLOSE THE FILE
MOVE AUFS,FET2
MOVE AP,FET3
MOVE I,FET4 ;RESTORE OUR REGISTERS
AOS AUFS ;POINT TO THE NEXT FILE,
;IF ANY, AND LOOP BACK
SOJG I,CL
HLLZ AT1,0(AP)
JUMPE AT1,SU.ER7
POPJ PP, ;RETURN IF UNAVAILABLE STATEMENT
;SUPPLIED
; SU.RD, SU.RW, SU.WR, SU.DL, AND SU.CL: ROUTINES CALLED WHEN
; CBLIO DISCOVERS A FILE IS OPENED FOR SIMULTANEOUS UPDATE
; DURING THE EXECUTION OF A READ, REWRITE, WRITE, DELETE,
; OR CLOSE STATEMENT.
;
;
;
; UPON ENTRY, AC16 CONTAINS A FILE TABLE POINTER.
;
; IF THE OPERATION ATTEMPTED BY THE USER IS ACCORDING TO THE
; RULES OF SIMULTANEOUS UPDATE, CONTROL IS RETURNED TO
; 0(PP).
;
; IF THE OPERATION ATTEMPTED BY THE USER IS NOT ACCORDING TO
; THE RULES OF SIMULTANEOUS UPDATE, A MESSAGE IS PRINTED AND THE USER IS KILLED.
INTERN SU.RD, SU.RW, SU.WR, SU.DL, SU.CL
SU.RD: MOVEI AT5,10 ;SET READ BIT IN AT5 AND JUMP TO
;COMMON CODE
JRST M1
SU.RW: MOVEI AT5,4 ;LIKEWISE, REWRITE BIT
JRST M1
SU.WR: MOVEI AT5,2 ;LIKEWISE, WRITE BIT
JRST M1
SU.DL: MOVEI AT5,1 ;LIKEWISE, DELETE BIT
M1: MOVEM AT5,SU.VRB ;SAVE VERB INDICATOR IN SU.VRB
SETZM SU.Y ;INDICATE NO RETAIN "NEXT" YET SEEN
SAVE
MOVE AT5,SU.VRB
MOVE AFT,AP ;INITIALIZE KEY FOR SEARCHING TABLE OF
;RETAINED RECORDS
LDB AT1,FTAM
CAIN AT1,INDEXD
JRST M3 ;JUMP IF FILE INDEXED
CAIE AT1,RANDOM
JRST M4
HRRZ AT2,F.RACK(AFT)
SETOM SU.Y ;INDICATE RANDOM,RETAIN NEXT INTERESTING
IFN ANS68,<
SKIPE AT3,0(AT2)
JRST M5 ;JUMP IF FILE RANDOM WITH NON-ZERO KEY
>;END IFN ANS68
IFN ANS74,<
MOVE AT3,0(AT2) ;GET KEY VALUE
LDB AT4,F.BFAM ;GET ACCESS MODE
JUMPE AT4,M1A ;SKIP AHEAD IF SEQ ACCESS
TLNN AP,200 ;READ "NEXT RECORD"?
JRST M5 ;NO--GO STORE KEY VALUE
M1A:>;END IFN ANS74
M4: MOVNS SU.Y ;MAKE FLAG POSITIVE,INDICATING "NEXT" I/O
MOVE AT3,D.RP(AFT) ;FILE IS EITHER SEQUENTIAL OR RANDOM
;WITH KEY OF ZERO
IFN ANS68,<
TRNN AT5,2 ;WRITE ONLY
>
IFN ANS74,<
TRNN AT5,4 ;REWRITE ONLY?
>
JRST M6 ;JUMP IF VERB ANYTHING BUT (RE )WRITE
HLRZ AT2,D.BL(AFT)
SETO AT4,
CAMN AT4,LASTUU(AT2) ;SKIP IF LAST VERB A READ
M6: ADDI AT3,1
JRST M5
M3:
IFN ANS74,<
TLNN AP,200 ;READ NEXT?
JRST M333 ;NO, SKIP THIS
>;END IFN ANS74
PUSHJ PP,CLVACI ;CHECK FOR LOW-VALUES AND CONVERT,
;IF NECESSARY
JRST M8
M333: SETO AT4,
HRRM AT4,F.WSMU(AFT) ;INITIALIZE POINTER TO SAVED KEY TO
;NULL, SINCE WE WON'T HAVE TO RESTORE
;OUR PREVIOUS POSITION IN THE FILE
MOVSI ACRR2,(JFCL) ;[447] SET UP PHONY CONV INSTR.
MOVE AT3,F.WBSK(AFT) ;WE'RE JUST ABOUT READY FOR LOOP
JRST M5
M8:
IFN ANS74,<
SKIPE SU.HV ;FOUND EOF?
JRST CHK7EF ;YES, CHECK FOR AN ENTRY LIKE THAT
>;END IFN ANS74
MOVE ACRR2,D.RCNV(AFT) ;[447] USE REAL CONV INSTR.
PUSHJ PP,CHGCNV ;[447] CHECK FOR PHONY CONV INSTRS.
MOVE AT3,SU.RBP ;[447]
M5: SETZM SU.T1 ;NO RETAIN NEXT SEEN YET
MOVEM AT3,SU.CK ;SAVE COMPARISON KEY IN SU.CK
MOVE ACRR,SU.RRT ;INITIALIZE ACRR FOR LOOP TO
;SEARCH THE RETAINED RECORDS TABLE
;FOR THIS RECORD
M7: CAMGE ACRR,SU.CRH ;END OF LOOP?
JRST M7A ;NO, CONT AT NEXT ENTRY
SKIPN ACRR,SU.T1 ;RETAIN "NEXT" ENTRY SEEN?
JRST SU.ERB ;ERROR,NO RETAIN TO COVER THIS RECORD
SKIPL SU.Y ;RANDOM WITH KEY?
JRST M10 ;NO,RETAIN NEXT VALID FOR "KEY 0" TYPE I/O
MOVE AT4,@F.RACK(AP) ;GET ACTUAL KEY
MOVE AT3,D.RP(AP) ;GET CURRENT REC NUMBER
CAIN AT3,AT4 ;RETAINED NEXT=CURRENT NEXT?
JRST M10 ;YES,GOT PROPER RETAIN
JRST SU.ERB ;NO, JUMP TO ERROR, SINCE WE SHOULD
;HAVE FOUND AN ENTRY FOR THIS RECORD
M7A: HRRZ AFT,0(ACRR)
HRRZ AT1,AP
CAME AFT,AT1 ;SAME FILE?
JRST M2 ;IF NOT, JUMP TO NEXT ENTRY IN LOOP
LDB AT4,FTAM
CAIN AT4,INDEXD
JRST M9 ;JUMP IF FILE INDEXED
CAMN AT3,2(ACRR)
JRST M10 ;JUMP IF KEYS MATCH - WE FOUND IT!
SKIPN SU.Y ;SKIP IF "RETAIN NEXT" INTERESTING
JRST M2 ;NO, CONT
IFN ANS74,<
LDB AT4,RRTNXT ;GET RETAIN NEXT FLAG
JUMPE AT4,M2 ;NOT RETAIN NEXT,CONT
>
IFN ANS68,<
SKIPN 2(ACRR) ; ZERO KEY RETAIN ? (SKIP IF NOT)
>
MOVEM ACRR,SU.T1 ;IT IS, SAVE RRT ENTRY ADDRESS
M2: LDB AT4,CRRINE
ADD ACRR,AT4
JRST M7
M9: HLRZ AT4,D.BL(AP) ;[524] POINT TO FILE TABLE
LDB AT4,FTKT ;[524] CHECK FOR NON-DISPLAY KEY TYPES
CAIGE AT4,3 ;[524] DISPLAY?
JRST M9DISP ;[524] YES
CAIL AT4,7 ;[524] COMP-3?
JRST M9DISP ;[524] YES TREAT AS DISPLAY
;[524] KEY IS NOT DISPLAY COMPARE ONE OR TWO WORDS
HRRI AT1,2(ACRR) ;[524] AT1 POINTS TO 1 OF THE RETAINED KEYS
MOVE AT5,(AT1) ;[524] GET 1ST WORD OF RETAINED KEY
CAME AT5,(AT3) ;[524] IS IT THE ONE HE WANTS TO READ?
JRST M12 ;[524] NO GO GET THE NEXT ONE
TRNE AT4,1 ;[524] SKIP IF KEYS ARE 2 WORDS
JRST M10 ;[524] ONE WORD, AND THEY MATCH!
MOVE AT5,1(AT1) ;[524] GET SECOND WORD OF KEY
CAME AT5,1(AT3) ;[524] COMPARE 2ND WORD ALSO
JRST M12 ;[524] NO MATCH
JRST M10 ;[524] MATCH!
M9DISP: LDB AT4,FTRM ;[447] GET INCORE RECORD MODE
MOVE AT4,[OCT 441000000000,440600000000,0,440700000000]-1(AT4) ;[447]
;[447]GET BYTE POS + SIZE BASED ON MODE
HRRI AT4,2(ACRR)
LDB AT1,FTKLB ;[447] USE AT1 FOR LOOP AND AT5 FOR
;[447] ILDB SO CONV INSTR WORKS
SKIPE SU.HV ;[447] FORCED HIGH VALUES BEING USED?
JRST M14 ;[447] YES
M11: ILDB AT5,AT3 ;[447]
XCT ACRR2 ;[447] CONVERT IF NECESSARY
ILDB AT2,AT4
CAME AT5,AT2 ;[447]
JRST M12 ;JUMP IF KEYS NOT EQUAL
SOJG AT1,M11 ;[447]
JRST M10 ;WE'VE FOUND IT!
M12: MOVE AT3,SU.CK
JRST M2
IFN ANS74,<
;LOOP THRU RRT AND MATCH IF WE HAVE A "NEXT RECORD" ENTRY THAT FOUND EOF
CHK7EF: MOVE ACRR,SU.RRT
CHK7F1: CAML ACRR,SU.CRH ;END OF LOOP?
JRST SU.ERB ;YES, ERROR IF NOT FOUND YET
HRRZ AFT,0(ACRR) ;GET FILE
HRRZ AT1,AP
CAME AFT,AT1 ;SAME FILE?
JRST CHK7F2 ;NO, GO ON TO NEXT ENTRY
LDB AT1,RRTHVF ;FOUND EOF IN A "NEXT RECORD" ENTRY?
JUMPN AT1,M10 ;IF YES, MATCH!
CHK7F2: LDB AT4,CRRINE
ADD ACRR,AT4
JRST CHK7F1 ;LOOP
>;END IFN ANS74
M14: LDB AT5,AT3 ;[447] GET THE HIGH VALUES CHAR
ILDB AT2,AT4 ;[447] RRT CHAR
CAME AT5,AT2 ;[447] SAME?
JRST M12 ;[447] NO
SOJG AT1,M14+1 ;[447] YES--CHECK NEXT ONE
M10: LDB AT4,CRRFG4 ;GET VERB FLAGS
SETZM SU.HV ;[447] TURN OFF HIGH VALUES SWITCH
SETCA AT4,
MOVE AT5,SU.VRB
TRNE AT5,0(AT4)
JRST SU.ERC ;JUMP IF FUNCTION NOT RETAINED FOR
LDB AT1,CRRFLG
TRNE AT1,000002
JRST M13 ;JUMP IF UNTIL FREED FLAG SET
TRNN AT4,000017
JRST M13 ;JUMP IF RETAIN FOR ANY VERB
LSH AT1,-2
TRZ AT1,0(AT5) ;ZERO VERB BIT
DPB AT1,CRRFG4
JUMPN AT1,M13 ;JUMP IF NOT ALL VERB BITS ZERO
SETO AT1,
DPB AT1,CRRF ;SET FREE FLAG FOR THIS RECORD
; CBLIO WILL ACTUALLY FREE THE RECORD WE HAVE JUST MARKED
; AFTER EXECUTION OF THE VERB BEING EXECUTED.
M13: RESTRM
POPJ PP, ;NORMAL RETURN TO CBLIO
SU.CL: SKIPN SU.FR ; [434] ANY SIMULTANEOUS FILES OPEN?
POPJ PP, ; [434] NO EXIT
MOVEI AT1,12 ; TELL THE QUEUE ROUTINE THIS IS A
MOVEM AT1,SU.VRB ; CLOSE VERB SO LONG TERM LOCK GETS
; TURNED OFF
MOVEI AT1,1 ;SET UP DUMMY CALL TO LRDEQ,
;REQUESTING THAT ALL THE RECORDS IN THE
;FILE BEING CLOSED BE FREED. SAVE AC12
;AND AC16 FOR CBLIO.
MOVEM AT1,SU.CL1
MOVEI AT1,152200
HRLM AT1,SU.CL2
MOVEM AP,SU.CLR
HRRM AP,SU.CL2
MOVEI AP,SU.CL1
MOVEM 12,SU.CLS
PUSHJ PP,LRDEQ.
MOVE AFT,SU.CLR ;SET AFT TO FILE TABLE POINTER
LDB AT4,FTOWA ;SET AT4 TO OWN ACCESS BITS
LDB AT5,FTOTA ;SET AT5 TO OTHERS ACCESS BITS
MOVEI ACRR,SU.CL2 ;SET ACRR SO THAT 0(ACRR) POINTS TO FILE TABLE
SETZM SU.DQ ;ZERO COUNT OF ITEMS DEQUEUED
HRLI ACRR,1 ;SET LH OF ACRR TO INDICATE DEQUEUE
PUSHJ PP,FED ;PREPARE ENQ/DEQ REQUEST BY CALLING FED
MOVEI AT1,1
MOVEI AP,SU.CL1 ;SET AP SO THAT 0(AP) = 0
SETZM SU.CL1
PUSHJ PP,ENQDEQ ;CALL ENQ/DEQ TO ACTUALLY TO DEQUEUE
JRST SU.ER7
MOVE 12,SU.CLS
MOVE AP,SU.CLR
SETZM F.WSMU(AP) ;ZERO SU WORD IN THE FILE TABLE
SOS SU.FR ;SUBTRACT ONE FROM THE COUNT OF FILES
;OPEN FOR SIMULTANEOUS UPDATE
POPJ PP,
; MOVKEY: A SUBROUTINE THAT MOVES A KEY INTO THE CURRENT RETAINED
; RECORDS TABLE ENTRY
;
;
; ARGUMENTS:
;
; 1: A BYTE POINTER TO THE KEY TO BE MOVED IN AT1
; 2: LENGTH OF THE KEY IN BYTES IN AT2
; 3: POINTER TO A RETAINED RECORDS TABLE ENTRY IN ACRR
; 4: POINTER TO FILE TABLE IN AFT
;
; CHANGES:
;
; AT2
; AT3
; AT4
; AT5
; SU.T4
; SU.HV
MOVKEY: LDB AT3,FTRM ;BUILD BYTE POINTER TO KEY IN RETAINED
;RECORDS TABLE IN AT3
MOVE AT3,[OCT 441000000000,440600000000,0,440700000000]-1(AT3)
;DERIVE BYTE SIZE FROM RECORDING MODE
HRRI AT3,2(ACRR) ;SET ADDRESS FIELD
MOVEM AT1,SU.T4 ;FREE UP AT1
SKIPE SU.HV ;[447] FORCED HIGH VALUES READ
JRST HVLOOP ;[447] YES
MOVE AT4,D.RCNV(AFT) ;[447] NO--DO REAL CONV
MKLOOP: ILDB AT5,SU.T4 ;[447] MOVE BYTES
XCT AT4 ;[447] CONV IF NECESSARY
IDPB AT5,AT3 ;[447]
SOJG AT2,MKLOOP
POPJ PP, ;RETURN
HVLOOP: LDB AT5,SU.T4 ;[447] GET A HIGH VALUES CHAR
IDPB AT5,AT3 ;[447] PUT IT IN RRT
SOJG AT2,.-1 ;[447] DO EM ALL
SETZM SU.HV ;[447] TURN OFF HIGH VALUES FLAG
POPJ PP, ;[447] RETURN
USRKEY: LDB AT3,FTRM ;[447]
MOVE AT3,[OCT 441000000000,440600000000,0,440700000000]-1(AT3) ;[447]
HRRI AT3,2(ACRR) ;[447]
MOVEM AT1,SU.T4 ;[447]
USLOOP: ILDB AT1,SU.T4 ;[447]
IDPB AT1,AT3 ;[447]
SOJG AT2,USLOOP ;[447]
POPJ PP, ;[447]
; QUEUE: A SUBROUTINE THAT CREATES AN ENTRY IN THE ENQUEUE,
; DEQUEUE, OR MODIFY ACCESS TABLE (THESE TABLES ARE IN THE
; FORMAT OF THE ENQ/DEQ PARAMETER LIST).
;
;
; ARGUMENTS:
;
; 1: ACRR POINTS TO THE APPROPRIATE ENTRY IN THE RETAINED
; RECORDS TABLE. BUT USE OF ACRR BY THIS ROUTINE
; IS RESTRICTED TO GETTING THE FILE TABLE LOCATION
; FROM 0(ACRR).
;
; 2: AT1 LH = 0 => EXCLUSIVE
; = 1 => SHARED
; = 3 => GROUP SHARED
;
; RH = 0 => ENQUEUE
; = 1 => DEQUEUE
; = 2 => MODIFY ACCESS
;
; 3: AT2 CONTAINS A 33 BIT USER CODE
;
; CHANGES:
;
; AT1
; AT2
; AT3
; AFT
; QUEUE TABLES: SU.EQT, SU.DQT, SU.MQT
; QUEUE TABLE COUNTERS: SU.EQ, SU.DQ, SU.MQ
;
; QUEUE FIRST CHECKS FOR INDEX QUEUEING, IN WHICH CASE
; A RECORD IS KEPT OF SHARED/EXCLUSIVE MODE UPON ENQUEUE.
; THIS IS LATER USED TO ENSURE THAT DEQUEUE USES THE SAME
; MODE. (ONLY THE 10 NOW (2/79) WORRIES ABOUT THIS)
;
;
QUEUE: HRRZ AFT,0(ACRR) ;GET POINTER TO THE FILE TABLE
AOJN AT2,QUEUX ;SKIP AHEAD IF NOT INDEX QUEUE (AT2 NOT -1)
HRRZ AT3,AT1 ;GET ENQDEQ INDICATER
SOJGE AT3,QUEUA ;SKIP AHEAD IF NOT ENQUEUE REQUEST
HLRZ AT3,AT1 ;GET EXCL/SHARD MARK
DPB AT3,IDXSHR ;SAVE FLAG IN FILTAB F.WSMU WORD
JRST QUEUX ; CONT
QUEUA: SOJGE AT3,QUEUX ;SKIP ALL IF MODIFY
LDB AT3,IDXSHR ;GET FILTAB INDEX ENQ SHARE FLAG
HRL AT1,AT3 ;RESET DEQUEUE MODE TO MATCH ENQUEUE
QUEUX: SOJ AT2, ;RESTORE AT2
MOVE AT3,@[OCT SU.EQ,SU.DQ,SU.MQ](AT1)
LSH AT3,1
ADD AT3,@[OCT SU.EQ,SU.DQ,SU.MQ](AT1)
ADD AT3,@[OCT SU.EQT,SU.DQT,SU.MQT](AT1)
ADDI AT3,2
; AT3 NOW POINTS TO WHERE WE SHOULD GENERATE THE ENQ/DEQ REQUEST
; ENTRY
AOS @[OCT SU.EQ,SU.DQ,SU.MQ](AT1) ;INCREMENT COUNT
SETZM 2(AT3) ;INDICATE WE ARE REFERING TO A
;NON-POOLED RESOURCE
TLZ AT2,700000 ;JAM 5 IN AT2 TO INDICATE 33 BIT USER
;CODE OPTION
TLO AT2,500000
MOVEM AT2,1(AT3) ;STORE AWAY
LDB AT2,FTCN ;GET CHANNEL NUMBER
HLRZ AT1,AT1
ROT AT1,-1 ;GET SHARED/EXCLUSIVE BIT IN BIT 0
HLL AT2,AT1 ;COMBINE WITH CHANNEL
TLO AT2,200000 ;TURN OFF LEVEL CHECKING
PUSH PP,AT1 ;SAVE AT1
MOVEI AT1,12 ;CHECK FOR CLOSE VERB
CAMN AT1,SU.VRB ;IF IT IS, DO NOT SET LONG TERM LOCK
JRST QUEUE1 ;IT IS
HRLOI AT1,577777 ;NOT CLOSE, BUT IS IT AN INDEX OR
;RANDOM FILE RESOURCE?
CAMN AT1,1(AT3) ;IF IT IS EITHER, SET LONG TERM LOCK
IFN TOPS20,< ; [643]
TLO AT2,(EN%LTL) ; [643] IT IS ONE OF THEM
> ; [643]
IFE TOPS20,< ; [643]
TLO AT2,(EQ.FLT) ; [643] IT IS ONE OF THEM
> ; [643]
QUEUE1: POP PP,AT1 ;RESTORE AT1
MOVEM AT2,0(AT3) ;STORE
HRRM AT1,2(AT3) ;SET SHARE GROUP
POPJ PP, ;RETURN
; ENQDEQ: A SUBROUTINE TO ACTUALLY CALL ENQ/DEQ
;
; ARGUMENTS:
;
; 1: AT1: RH = 0 => ENQUEUE
; = 1 => DEQUEUE
; = 2 => MODIFY ACCESS
;
; 2: AP POINTS TO A LOCATION INTERPRETED AS FOLLOWS:
;
; LH = 0 => BLOCK
;
; LH = 1 => RETURN
;
;
; RETURNS:
; TO 0(PP) IF RESOURCES NOT AVAILABLE
; TO 1(PP) IF EVERYTHING'S OK
;
; CHANGES:
;
; AT1
; AT2
; AT3
;
; USES:
;
; QUEUE TABLES: SU.EQU, SU.DQT, SU.MQT
; QUEUE TABLE COUNTERS: SU.EQ, SU.DQ, SU.MQ
;
;
; REINITIALIZES:
;
; SU.EQ
; SU.DQ
; SU.MQ (APPROPRIATE ONE TO ZERO)
;
ENQDEQ: AOS 0(PP) ;SET NORMAL RETURN
SKIPN AT2,@[OCT SU.EQ,SU.DQ,SU.MQ](AT1)
POPJ PP, ;RETURN NORMAL IF NO ENTRIES IN TABLE
MOVE AT3,@[OCT SU.EQT,SU.DQT,SU.MQT](AT1)
SETZM 1(AT3) ;ZERO REQUEST ID AND RESERVED FIELDS
;OF ENQ/DEQ REQUEST
LSH AT2,1
ADD AT2,@[OCT SU.EQ,SU.DQ,SU.MQ](AT1)
ADDI AT2,2 ;COMPUTE LENGTH OF REQUEST BLOCK
HRL AT2,@[OCT SU.EQ,SU.DQ,SU.MQ](AT1)
;MOVE IN NUMBER OF ENTRIES
MOVEM AT2,0(AT3) ;STORE AT HEAD OF REQUEST LIST
SETZ AT3, ;ZERO AT3 TO INDICATE ENQ
CAIN AT1,2
JRST ED1 ;JUMP IF MODIFY ACCESS REQUEST
JUMPN AT1,ED2 ;JUMP IF DEQUEUE REQUEST
HLL AT2,0(AP) ;SET BLOCK OR RETURN FOR ENQ, BASED
;ON WHETHER USER SUPPLIED RETURN
ED3: HRR AT2,@[OCT SU.EQT,SU.DQT,SU.MQT](AT1)
TRNA
PUSHJ PP,PRINT ;IF DEBUGGING SWITCH SET, SEND
;ENQ/DEQ PARAMETERS TO TTY
CALLI AT2,151(AT3) ;CALL ENQ OR DEQ DEPENDING ON SETTING
;OF AT3
JRST ED4 ;ERROR RETURN FROM ENQ/DEQ
POPJ PP, ;NORMAL RETURN FROM ENQ/DEQ -
;RETURN NORMAL TO OUR CALLER
ED1: HRLI AT2,3
JRST ED3
ED2: HRLI AT2,0 ;SET DEQ FUNCTION TO NORMAL DEQ
MOVEI AT3,1 ;SET AT3 TO 1 TO INDICATE DEQ
JRST ED3
PRINT: PUSH PP,AT4 ;SAVE AT4
HRRZ AT4,0(AT2) ;MOVE COUNT OF WORDS TO BE PRINTED
;TO AT4
PUSH PP,ACRR ;SAVE ACRR
PUSH PP,ACRR2 ;SAVE ACRR2
PUSH PP,ACRR3 ;SAVE ACRR3
MOVE ACRR,[POINT 3,0(AT2)]
;SET UP BYTE POINTER IN ACRR
PRINT2: MOVEI ACRR3,14 ;SET COUNT OF OCTITS IN A WORD IN ACRR3
PRINT1: ILDB ACRR2,ACRR ;GET NEXT OCTIT TO BE PRINTED
ADDI ACRR2,"0" ;CONVERT TO ASCII
OUTCHR ACRR2 ;PRINT THE OCTIT
SOJG ACRR3,PRINT1 ;END OF WORD? IF NOT, JUMP
MOVEI ACRR2,015
OUTCHR ACRR2 ;PRINT CARRIAGE RETURN
MOVEI ACRR2,012
OUTCHR ACRR2 ;PRINT LINE FEED
SOJG AT4,PRINT2 ;END OF WORDS TO BE TYPED?
POP PP,ACRR3 ;RESTORE REGISTERS
POP PP,ACRR2
POP PP,ACRR
POP PP,AT4
POPJ PP, ;RETURN
ED4: SOS 0(PP) ;SET OUR ABNORMAL RETURN
CAIN AT2,13
JRST SU.ERE ;INSUFFICIENT CORE
CAIN AT2,21
JRST SU.ERF ;QUOTA EXCEEDED
CAIE AT2,1
JRST SU.ER7 ;SOME CRAZY INTERNAL ERROR
POPJ PP, ;RESOURCES NOT AVAILABLE
; BLKNUM: A SUBROUTINE TO DETERMINE WHICH BLOCK NEEDS TO BE
; ENQUEUED OR DEQUEUED
;
; ARGUMENTS:
;
; 1: ACRR POINTS TO THE APPROPRIATE ENTRY IN THE
; RETAINED RECORDS TABLE. THIS SUBROUTINE GETS WHAT
; IT NEEDS FROM THAT ENTRY, AND SETS THE BLOCK NUMBER
; FIELD IN THAT SAME ENTRY.
;
;
; CHANGES:
;
; ALL REGISTERS EXCEPT AP, ACRR, AND PP
; SU.T1 F.WSMU(AFT)
; SU.T2 FS.BN
; SU.T3 SU.RLV
; SU.Y SU.SVK
; SU.RBP
BLKNUM: HRRZ AFT,0(ACRR)
LDB AT1,FTAM
CAIN AT1,INDEXD
JRST BN1 ;JUMP IF FILE INDEXED
CAIN AT1,RANDOM ;[455]
JRST BN1A
BN0A: MOVE AT1,2(ACRR) ;[456] BLOCK NUMBER =
;KEY + BLOCKING FACTOR - 1 ALL DIVIDED
;BY BLOCKING FACTOR
LDB AT2,FTBF ;[456]
SOSN AT1 ;[456]
TDZA AT2,AT2 ;[456]
IDIV AT1,AT2 ;[456]
IMUL AT1,D.BPL(AFT) ;[456]
ADDI AT1,1 ;[456]
BN5: DPB AT1,CRRBLK
IFN ANS74 ,<
LDB AT1,CRRFG4 ; GET RETAIN VERB FLAGS
TRNn AT1,RTDLRW ; DELETE OR REWRITE RETAIN?
JRST BN5C ; No, check to see if RETAIN save needed
; Clear CNTRY and NNTRY so that next sequential operation will get
; saved position
HLRZ AT1,D.BL(AFT) ; Get buffer position
SETZM CNTRY(AT1) ; Clear current position
SETZM NNTRY(AT1) ; And next position flag
POPJ PP, ; And return
; Other operations have reestablished next record pos for purposes
; of the RETAIN. If not already done, save RWDLKY from I-O level.
BN5C: HLRZ AT1,D.BL(AFT) ; Get buffer position
HRRZ AT2,D.RFLG(AFT) ; Get extra flags
SKIPE SVNXRT(AT1) ; Is current SAVNXT been saved?
JRST BN5A ; Yes, no need to save it again
HRROM AT2,SVNXRT(AT1) ; Save them during retain
; Set left -1 incase no D.RFLG bits set
PUSH PP,AT2 ; And save them for later
HRRZ AT2,RWDLRT(AT1) ; Get retain save area address
MOVE AT3,RWDLKY(AT1) ; Get i-o level NNTRY and save area addr
MOVEM AT2,RWDLKY(AT1) ; Indicate that SAVNXT should use RETAIN's area
MOVEM AT3,RWDLRT(AT1) ; Save I-O level NNTRY and save area addr
; Copy I-O save area to RETAIN area, RWDLRT area is same size as and
; immediatly follows RWDLKY area
HRL AT2,AT3 ; Source addr from I-O save area
HRRZ AT1,AT2 ; Last-word-to-move+1=2*at2-at3
LSH AT1,1 ; At2*2
SUBI AT1,(AT3) ; At2*2-at3
BLT AT2,-1(AT1) ; Copy current saved next record keys
POP PP,AT2 ; Restore D.RFLG
BN5A: TRZN AT2,SAVNXT ; Next rec pos saved?
POPJ PP, ; No, return
HRRM AT2,D.RFLG(AFT) ; Yes reset it off
>; END IFN ANS74
POPJ PP, ; and return
BN1A:
IFN ANS68,<
SKIPN 2(ACRR) ;IF FILE IS RANDOM AND KEY IS 0,
POPJ PP, ;DO NOTHING
>
IFN ANS74,<
LDB AT1,RRTNXT ;RETAIN NEXT?
SKIPE AT1
POPJ PP, ;YES, DO NOTHING
>;END IFN ANS74
JRST BN0A
BN1: MOVEM ACRR,SU.T1 ;GET READY TO CALL CBLIO
MOVEM AP,SU.T2 ;SAVE ACRR, AP IN TEMPORARY
SETZM SU.Y ;SET SU.Y TO 0 TO INDICATE THIS IS NOT
;THE FIRST RECORD RETAINED FOR THIS FILE
;BY THIS RETAIN STATEMENT
IFN ANS74,<
LDB AT1,CRRFG4 ; GET RETAIN VERB FLAGS
TRNE AT1,RTDLRW ; DELETE OR REWRITE RETAIN?
MOVEM AT1,SU.FRF ; YES, SET RETAIN FLAG POS TO INDICATE SO
>; END IFN ASN74
HRRZ AT1,F.WSMU(AFT) ;IF F.WSMU IS STILL AT ITS INITIAL VALUE
;(-1), THEN WE NEED TO SAVE THE KEY
;OF THE CURRENT RECORD
;
; IF WE HAVE ALREADY BEEN THROUGH HERE ONCE FOR THIS ISAM FILE,
; THEN WE SIMPLY GO AND USE THE USER KEY TO READ THE FILE AND
; GET THE BLOCK NUMBER TO ENQUEUE ON. NO FORCED READ WILL HAPPEN
; SINCE IT WILL HAVE BEEN DONE ON THE FIRST TIME THROUGH HERE.
;
CAIE AT1,-1
JRST BN2 ;JUMP, CURRENT KEY ALREADY SAVED
;
; THE FIRST RECORD RETAINED IN EACH RETAIN STATEMENT FOR A GIVEN
; ISAM FILE IS A SPECIAL CASE. THE PROBLEM IS THAT THERE CAN BE
; SEVERAL RECORDS RETAINED IN EACH RETAIN STATEMENT FOR A SINGLE
; ISAM FILE, AND WE MUST LEAVE THE FILE IN THE STATE IT WAS IN
; PRIOR TO THE RETAIN STATEMENT SO THE SUBSEQUENT I-O STATEMENTS
; WORK THE WAY THE USER EXPECTS THEM TO. IF EVERY RECORD BEING
; RETAINED HAS A REAL KEY (NOT LOW-VALUES) THEN THE PROBLEM IS NOT
; BAD, WE CAN JUST GO OFF AND READ EACH KEY NEVER BOTHERING ABOUT
; RESTORING THE FILE. HOWEVER, IF THE FIRST KEY BEING RETAINED IS
; LOW-VALUES, WE MUST WORRY ABOUT RESTORATION, WHICH MEANS WE MUST
; OBTAIN THE KEY OF THE CURRENT RECORD SO WE CAN RESTORE THE FILE
; POSITION WHEN NECESSARY. THE FLOW IS AS FOLLOWS:
;
; 1. CALL CBLIO AT FAKER. SUPPLYING A KEY OF LOW-VALUES.
; BY SETTING NXTREC(AFT) TO -1, CBLIO WILL RETURN TO
; US THE CURRENT RECORD FROM WHICH WE CAN GET ITS KEY.
; THIS KEY WILL BE STORED AT THE END OF THE RETAINED
; RECORDS TABLE (RRT).
;
; NOTE 1: IF THIS IS THE FIRST EVER I-O REQUEST
; FOR THIS FILE, CBLIO WILL HAVE PHYSICALLY
; READ EACH INDEX LEVEL AND THE DATA LEVEL
; THIS FULFILLS THE NEED FOR REFRESHING
; BUFFERS AND IS REMEMBERED FOR LATER USE.
;
; NOTE 2: IF I-O HAS BEEN DONE TO THIS FILE BEFORE
; THIS CALL TO CBLIO WILL NOT HAVE CAUSED
; ANY I-O AND WE WILL STILL HAVE BUFFER
; REFRESHING TO DO LATER.
;
; 2. IF NOTE 1 IS TRUE OR WE ENTER STEP 2 FROM ANOTHER POINT, GO
; AND CALL CBLIO TO READ THE FILE USING THE KEY OF THE RECORD
; BEING RETAINED, BYPASSING ANY FORCED READ. THIS RETURNS TO US
; THE BLOCK NUMBER OF THE RECORD BEING RETAINED, WHICH WE SAVE
; IN THE RRT AND RETURN TO THE MAIN CODE. THIS MAY OR
; MAY NOT CAUSE I-O DEPENDING ON WHERE THIS RECORD IS RELATIVE
; TO THE FIRST DATA BLOCK OF THE FILE, OR THE CURRENT DATA
; BLOCK DEPENDING ON HOW WE GOT TO STEP 2.
;
; 3. IF NOTE 2 IS TRUE, THEN THERE WAS A CURRENT RECORD AND NOW WE
; NEED TO KNOW IF THE RECORD BEING RETAINED HAS A KEY OF LOW-
; VALUES.
;
; 4. IF THE RECORD BEING RETAINED IS NOT FOR LOW-VALUES, THEN WE
; DO NOT NEED TO WORRY ABOUT RESTORING THE FILE TO ITS ORIGINAL
; POSITION. WE SIMPLY GO AND DO STEP 2, EXCEPT WE FORCE CBLIO
; TO DO A BUFFER REFRESH BY CALLING FORCR. PRIOR TO FAKER.
;
; 5. IF THE RECORD BEING RETAINED HAS A KEY OF LOW-VALUES, THEN WE
; MUST CALL CBLIO USING THE KEY OF THE CURRENT RECORD. WE MUST
; ALSO FORCE BUFFER REFRESHING BY DOING A FORCR. THIS GAURANTEES
; THAT THE SUBSEQUENT LOW-VALUES READ WILL GET THE LATEST "NEXT
; RECORD". AFTER FORCE READING THE CURRENT RECORD, WE GO TO
; STEP 2.
;
SETOM SU.Y ;SET SU.Y TO NON-ZERO TO INDICATE THIS
;IS THE FIRST RECORD RETAINED FOR THIS
;FILE BY THIS RETAIN STATEMENT
MOVE ACRR,SU.SVK ;WE'LL SAVE THE KEY AT THE END OF THE
;RETAINED RECORDS TABLE - SET ACRR,
;F.WSMU TO POINT THERE
HRRM ACRR,F.WSMU(AFT)
HLR AT1,D.BL(AFT)
MOVE AT2,NXTREC(AT1) ;THE KEY WE'RE SAVING ACTUALLY HAS TWO
;PARTS: THE KEY ITSELF, AND THE NEXT
;RECORD FLAG
MOVEM AT2,0(ACRR)
IFN ANS74,<
SKIPG SU.FRF ; DON'T RESET NNTRY YET IF DEL OR REWRIT
; SO WE GET A CHANCE TO SAVE THE PROPER VALUE
>
SETOM NXTREC(AT1) ;AFTER SAVING THE NEXT RECORD FLAG IN
;WORD 0, WE'LL TELL CBLIO THAT IT'S THE
;NEXT RECORD, REGARDLESS OF WHETHER IT IS
;OR NOT, SO THAT CBLIO WON'T READ A NEW
;BLOCK WHEN WE DO A LOW-VALUES FAKE READ
;TO GET THE KEY OF THE RECORD CURRENTLY
;BEING POINTED TO
LDB AT1,FTRM
MOVE AT1,[OCT 441000000000,440600000000,0,440700000000]-1(AT1)
HRRI AT1,1(ACRR)
EXCH AT1,F.WBSK(AFT) ;EXCHANGE A BYTE POINTER TO OUR PLACE TO
;SAVE THE KEY WITH THE BYTE POINTER
;TO THE SYMBOLIC KEY
MOVEM AT1,SU.T3 ;SAVE THE SYMBOLIC KEY IN SU.T3
MOVE AP,AFT
HRLI AP,RFLAG
PUSHJ PP,LV2SK. ;CALL CBLIO TO MOVE LOW-VALUES INTO
;WHAT IT THINKS IS THE SYMBOLIC KEY,
;BUT WHICH IS ACTUALLY OUR PLACE AT
;THE END OF THE RETAINED RECORDS
;TABLE USED TO SAVE THE CURRENT KEY.
; NOTE: THIS MUST ALSO BE DONE IN COBOL-74
;BECAUSE THIS TELLS CBLIO WHERE TO START!
HLR AT1,D.BL(AFT)
MOVE AT1,CNTRY(AT1) ;[650] SAVE THE VALUE OF THE POINTER TO
MOVEM AT1,SU.RLV ; THE CURRENT RECORD IN CBLIO'S BUFFERS.
; IT IS USED LATER TO DETERMINE IF THERE
; REALLY WAS A CURRENT RECORD.
IFN ANS68, PUSHJ PP,OWNFAK ;DO A FAKE LOW-VALUES READ
IFN ANS74, PUSHJ PP,FAKNXT
TRN
MOVE ACRR,SU.T1 ;RESTORE ACRR TO RETAINED RECORDS TABLE
;POINTER
HRRZ AFT,0(ACRR) ;RESTORE AFT TO FILE TABLE POINTER
HRRZ ACRR,F.WSMU(AFT) ;RESTORE ACRR TO SAVE KEY POINTER
LDB AT2,FTKLB
MOVE AT1,SU.RBP
SUBI ACRR,1 ;DECREMENT ACRR TO UTILIZE BLOCK NUMBER
;FIELD OF PSEUDO ENTRY IN TABLE
PUSHJ PP,MOVKEY ;MOVE THE CURRENT KEY INTO THE SAVE AREA
MOVE AT1,1(ACRR)
HLR AT2,D.BL(AFT)
MOVEM AT1,NXTREC(AT2) ;RESTORE THE NEXT RECORD FLAG
MOVE AT1,SU.T3
MOVEM AT1,F.WBSK(AFT) ;RESTORE SYMBOLIC KEY
MOVE AT2,ACRR
MOVE ACRR,SU.T1
LDB AT1,CRRINE
ADD AT2,AT1
PUSH PP,AT2 ;SAVE NEW SU.SVK FOR LATER
SKIPN SU.RLV ; WAS THERE A REAL CURRENT RECORD?
JRST BN2C ; NO, DON'T RESTORE ANYTHING
LDB AT1,FTRM ; YES, NOW SEE IF L-V BEING RETAINED
MOVE AT1,[OCT 441000000000,440600000000,0,440700000000]-1(AT1)
HRRI AT1,2(ACRR)
EXCH AT1,F.WBSK(AFT) ;EXCHANGE A BYTE POINTER TO OUR PLACE TO
;SAVE THE KEY WITH THE BYTE POINTER
;TO THE SYMBOLIC KEY
IFN ANS68,<
PUSHJ PP,LVTST ; IS THE KEY BEING RETAINED L-V?
TRNA ; YES, RESTORE FILE ALSO REFRESHES BUFFERS
>;END IFN ANS68
IFN ANS74,<
LDB AT2,RRTNXT ; IS THE KEY BEING RETAINED "NEXT RECORD"?
SKIPN AT2
>;END IFN ANS74
JRST BN2B ; NO, DON'T RESTORE ANYTHING
IFN ANS68,<
SETO AT2, ;SET "RETAINING L-V" BIT IN RRT ENTRY
DPB AT2,RRTNXT
>;END IFN ANS68
PUSH PP,AT1 ; SAVE REAL SYMBOLIC KEY POINTER
LDB AT1,FTOTA
TRNN AT1,000003 ;IF NOT WRITE OR DELETE
JRST BN2A ;SKIP IO SINCE NO ONE COULD AFFECT THE "NEXT RECORD"
PUSHJ PP,FORCR.
MOVE AT1,F.WBSK(AFT)
HRR AT1,SU.SVK
ADDI AT1,1
MOVEM AT1,F.WBSK(AFT)
PUSHJ PP,OWNFAK ;OWNFAK DOES A FAKER.
TRN
SETZM SU.Y ;TURN OFF "FIRST RECORD" FLAG SO LATER
;FORCR. DOES NOT HAPPEN UNNECESSARILY
MOVE ACRR,SU.T1
HRRZ AFT,0(ACRR)
BN2A: POP PP,AT1
BN2B: MOVEM AT1,F.WBSK(AFT)
BN2C: POP PP,SU.SVK ;SET SU.SVK TO NEXT SAVE AREA LOCATION
BN2: HRLI AP,RFLAG ;SET SPECIAL FLAGS
HRR AP,AFT ;SET FILE TABLE LOCATION
LDB AT1,FTRM ;BUILD A BYTE POINTER TO OUR KEY
MOVE AT1,[OCT 441000000000,440600000000,0,440700000000]-1(AT1)
HRRI AT1,2(ACRR) ;SET ADDRESS TO LOCATION OF OUR KEY
;IN THE RETAINED RECORDS TABLE
EXCH AT1,F.WBSK(AFT) ;SWAP WITH FILE TABLE SYMBOLIC KEY
;POINTER
MOVEM AT1,SU.T3 ;SAVE SYMBOLIC KEY POINTER FOR FUTURE
;RESTORATION
SETZM SU.RBP ;ZERO RECORD BYTE POINTER
; SKIPE SU.RLV ; WAS THERE A REAL CURRENT RECORD?
SKIPN SU.Y ; IS THIS THE FIRST RECORD IN THIS RETAIN STATEMENT?
JRST BN8A ; NO ON BOTH COUNTS, BUFFER REFRESHING
; HAS ALREADY HAPPENED, DON'T DO IT AGAIN
LDB AT1,FTOTA
TRNE AT1,000003
PUSHJ PP,FORCR. ;ASK CBLIO TO FORGET WHAT'S IN ITS
;INDEX BUFFERS, IF OTHERS DOING
;INSERTING OR DELETING
BN8A:
IFN ANS68,<
PUSHJ PP,OWNFAK ;CALL CBLIO
JRST BN8 ;JUMP IF NOT INVALID KEY
SETZM FS.BN ;USE BLOCK NUMBER OF 0 FOR NON-
;EXISTENT RECORDS
PUSHJ PP,LVTST ;DETERMINE IF INVALID KEY CAUSED
;BY EOF OR INVALID KEY (SKIP
;RETURN IF NOT LOW-VALUES)
PUSHJ PP,[PUSHJ PP,UHV
MOVE ACRR,SU.T1
SETO AT2,
DPB AT2,RRTNXT ;SET FLAGS IN RRT
DPB AT2,RRTHVF ; . .
POPJ PP,]
>;END IFN ANS68
IFN ANS74,<
MOVE ACRR,SU.T1
LDB AT1,RRTNXT
JUMPE AT1,[PUSHJ PP,OWNFAK
JRST BN8 ;NOT INVALID KEY
SETZM FS.BN ;INVALID KEY
JRST BN8] ;DO READ OF THE KEY
; Check for special del/rewrt saved seq position case
; if this case restore proper next record flag
HRRZ AT1,D.RFLG(AFT) ; Get extra flags
TRNN AT1,SAVNXT ; Next rec pos saved?
JRST BN8B ; No cont,
HLRZ AT1,D.BL(AFT) ; Yes, get buffer position
HLRZ AT2,RWDLKY(AT1) ; Get saved next rec flag
HRRM AT2,NNTRY(AT1) ; And set it
; this will ensure that the proper saved
; record position will be used
BN8B: PUSHJ PP,FAKNXT ;DO A "READ NEXT"
JRST BN8 ;NOT INVALID KEY
MOVE ACRR,SU.T1 ;RESTORE ACRR
PUSHJ PP,UHV ;STICK HIGH-VALUES IN KEY
SETO AT1,
DPB AT1,RRTHVF ;INVALID KEY WHEN LOOKING FOR LOW-VALUES.
>;END IFN ANS74
BN8: MOVE ACRR,SU.T1 ;RESTORE ACRR, AP, SYMBOLIC KEY
MOVE AP,SU.T2
MOVE AT1,SU.T3
HRRZ AFT,0(ACRR)
MOVEM AT1,F.WBSK(AFT)
LDB AT2,FTKLB
SKIPN AT1,SU.RBP ;IF SU.RBP IS NON-ZERO THEN USER GAVE
;US LOW-VALUES AND WE MUST MOVE THE
;REAL KEY INTO THE RETAINED RECORDS
;TABLE ENTRY
JRST BN7
PUSHJ PP,MOVKEY
BN7: MOVE AT1,FS.BN ;MOVE BLOCK NUMBER INTO RETAINED
;RECORDS TABLE ENTRY.
JRST BN5
; FILFLU: A SUBROUTINE THAT CHECKS TO SEE IF A BLOCK ABOUT
; TO BE ENQUEUED, DEQUEUED, OR MODIFIED IS IN THE CURRENT
; BUFFER. IF IT IS, THE FILE TABLE ADDRESS IS ADDED TO THE
; FILL/FLUSH BUFFER TABLE.
;
; FILFL2: A SECONDARY ENTRY POINT, WHICH ADDS THE CONDITION THAT
; THE BUFFER MUST HAVE BEEN MODIFIED (CONTAINS "LIVE"
; DATA).
;
;
; ARGUMENTS:
; 1. ACRR POINTS TO AN ENTRY IN THE RETAINED RECORDS
; TABLE.
;
; 2. AT2 CONTAINS A BLOCK NUMBER MOD 2 ** 18
;
;
; CHANGES:
; AFT
; AT4
; AT5
; SU.CFB (COUNT OF ENTRIES IN THE FILL/FLUSH BUFFER TABLE)
; SU.FBT (THE FILL/FLUSH BUFFER TABLE)
; USOBJ(AT5)
;
FILFL2: HRRZ AFT,0(ACRR)
HLRZ AT4,D.BL(AFT)
SETO AT5,
CAME AT5,LIVDAT(AT4)
POPJ PP,
FILFLU: HRRZ AFT,0(ACRR)
MOVE AT4,D.CBN(AFT) ;[455]
LDB AT5,FTAM
CAIE AT5,INDEXD
JRST FF01
HLRZ AT5,D.BL(AFT)
SETZM USOBJ(AT5)
POPJ PP,
FF01: CAME AT2,AT4
POPJ PP,
CAIN AT5,RANDOM
JRST FF02
HLRZ AT5,D.BL(AFT)
SKIPN R.BPLR(AT5)
POPJ PP, ;NO TABLE ENTRY IF SEQIO FILE AND NO IO DONE YET
FF02: MOVEI AT4,AT4
HRLM AT4,SU.FBT
MOVE AT4,SU.CFB
MOVEM AFT,@SU.FBT
AOS SU.CFB
POPJ PP,
; RESTOR: A SUBROUTINE WHICH RESTORES THE DEFINITION OF
; THE CURRENT RECORD IN THE PROCESSING OF AN ISAM FILE.
; IT DOES THIS BY CHECKING F.WSMU IN THE FILE TABLE.
; IF F.WSMU IS NOT -1, THEN IT POINTS TO A PLACE WHERE
; THE NEXT RECORD FLAG AND CURRENT KEY HAVE BEEN SAVED.
;
;
; ARGUMENTS:
;
; AFT POINTS TO A FILE TABLE
;
;
; CHANGES:
;
; ALL REGISTERS EXCEPT ACRR, AFT, AP, PP, I
; SU.T5
; SU.T6
; SU.T7
; SU.T8
; F.WSMU(AFT) (SET TO -1)
; NXTREC(AT3)
RESTOR: HRRZ AT1,F.WSMU(AFT)
CAIN AT1,-1
POPJ PP,
MOVEM I,SU.T8
MOVEM ACRR,SU.T5 ;SAVE I, ACRR
MOVEM AP,SU.T6 ;SAME AP
LDB AT2,FTRM
MOVE AT2,[OCT 441000000000,440600000000,0,440700000000]-1(AT2)
HRRI AT2,1(AT1) ;PREPARE BYTE POINTER TO SAVED KEY
EXCH AT2,F.WBSK(AFT) ;EXCHANGE WITH SYMBOLIC KEY
MOVEM AT2,SU.T7
MOVE AP,AFT
PUSHJ PP,OWNFAK ;DO FAKE READ TO POSITION AT SAVED KEY
TRN
MOVE AFT,AP ;RESTORE AFT
MOVE AP,SU.T6 ;RESTORE AP
HRRZ AT1,F.WSMU(AFT)
MOVE AT2,0(AT1)
HLR AT3,D.BL(AFT)
MOVEM AT2,NXTREC(AT3) ;RESTORE NEXT RECORD FLAG TO ITS SAVED
;VALUE
MOVE AT2,SU.T7
MOVEM AT2,F.WBSK(AFT) ;RESTORE SYMBOLIC KEY
SETO AT2,
HRRM AT2,F.WSMU(AFT) ;SET F.WSMU TO -1 TO INDICATE NOTHING TO
;RESTORE
MOVE ACRR,SU.T5 ;RESTORE ACRR
MOVE I,SU.T8 ;RESTORE I
POPJ PP, ;RETURN
; CLVACI: CHECK FOR LOW-VALUES AND CONVERT, IF NECESSARY
; THIS ROUTINE IS CALLED BY THE READ, WRITE, REWRITE,
; DELETE, AND FREE CODE FOR ISAM FILES. A CHECK IS MADE
; TO SEE IF THE OBJECT RECORD HAS A KEY OF LOW-VALUES.
; IF IT DOES NOT, NOTHING HAPPENS. IF IT DOES, THEN WE
; MUST DETERMINE IF THIS IS THE FIRST OPERATION ON THIS
; FILE SINCE THE RETAIN STATEMENT. THIS IS DETERMINED BY
; CHECKING F.WSMU(AFT). IF IT IS -1, THEN WE HAVE ALREADY
; DONE THIS BEFORE AND CAN RETURN WITH NO FURTHER
; PROCESSING. OTHERWISE, WE HAVE TO CHECK FURTHER. THE
; PROBLEM IS THAT IF SEVERAL RECORDS HAVE BEEN RETAINED FOR
; THE SAME FILE, THEN THE BLKNUM CODE LEFT THE FILE POINTING
; AT THE LAST RECORD RETAINED. BLKNUM ALSO SAVED THE KEY OF
; THE ORIGINAL CURRENT RECORD AT THE END OF THE RRT AND
; PUT A POINTER TO IT IN THE F.WSMU(AFT). SO, WHEN F.WSMU
; DOES NOT EQUAL -1, IT MEANS THAT THIS LOW-VALUES OPERATION
; IS RELATIVE TO THE ORIGINAL CURRENT RECORD AND WE MUST
; NOW RESTORE THE FILE TO THAT POINT. THERE IS A SPECIAL
; CASE, HOWEVER. IF THERE WAS ONLY ONE RECORD RETAINED
; FOR THIS FILE, THEN THE BLKNUM CODE LEFT US POINTING
; AT IT, SO WE CAN TELL CBLIO THAT THE "NEXT RECORD" IS
; REALLY THE CURRENT RECORD. THIS MEANS WE DO NOT HAVE TO
; RESTORE THE FILE, POTENTIALLY SAVING I-O, AND RE-READING
; THE CURRENT RECORD WILL DEFINITELY RESULT IN NO
; I-O.
;
; THE WHOLE REASON FOR READING THIS LOW-VALUES RECORD AT THIS
; TIME IS TO CHECK TO SEE IF THE RECORD BEING READ,
; WRITTEN, REWRITTEN, DELETED, OR FREED IS THE ONE RETAINED.
; ONCE THE READ HAPPENS HERE, THE BLOCK NUMBER AND KEY WILL
; BE COMPARED AGAINST ALL ENTRIES IN THE RRT FOR THIS FILE.
; IF NONE MATCHES, A FATAL ERROR MESSAGES RESULTS.
;
;
;
; ARGUMENTS:
;
; AFT CONTAINS A POINTER TO THE FILE TABLE
;
; RETURN:
;
; TO 1(PP) IF NOT LOW-VALUES
; TO 0(PP) IF LOW-VALUES, KEY IN SU.RBP
;
;
; CHANGES:
;
; ALL REGISTERS EXCEPT K, AURS, AP, PP, ACRR, AFT
; SU.T1
; SU.T2
; SU.T3
; SU.T4
; NXTREC(AT1)
; F.WSMU(AFT)
CLVACI: MOVEM K,SU.T1
MOVEM AURS,SU.T2
MOVEM AP,SU.T3
MOVEM ACRR,SU.T4
MOVE AT1,F.WBSK(AFT)
MOVE AP,AFT
IFN ANS68,<
PUSHJ PP,LVTST ;CALL CBLIO TO COMPARE KEY WITH
;LOW-VALUES
JRST CLVAC1
AOS 0(PP)
>;END IFN ANS68
IFN ANS74,< ;IN ANS74, THIS ROUTINE IS ONLY CALLED
; IF THE GUY IS DEFINITELY DOING I/O TO
; THE "NEXT RECORD".
JRST CLVAC1
>;END IFN ANS74
CLVAC2: MOVE AFT,AP
MOVE K,SU.T1
MOVE AURS,SU.T2
MOVE AP,SU.T3
MOVE ACRR,SU.T4
POPJ PP,
CLVAC1: HRRZ AFT,AP ; IF F.WSMU IS -1, WE HAVE ALREADY
HRRZ AT1,F.WSMU(AFT) ; RESTORED THE FILE ONCE
CAIN AT1,-1
JRST CLVAC3 ;JUMP IF IT'S NOT NECESSARY TO
;RESTORE OUR POSITION IN THE FILE
;
; THE FOLLOWING CODE COMPARES THE FILE TABLE ADDRESS OF THE
; OBJECT RECORD AGAINST ALL THE RRT ENTRIES. IF IT IS
; DETERMINED THAT THERE IS ONLY ONE MATCH, THEN NO RESTORATION
; IS NECESSARY SINCE BLKNUM WILL HAVE LEFT US POINTING AT THE
; CORRECT RECORD.
;
SETZ AT3,
MOVE AT1,SU.RRT
CLVAC5: CAML AT1,SU.CRH
JRST CLVAC6
HRRZ AT2,0(AT1)
CAMN AT2,AFT
ADDI AT3,1
LDB AT2,[POINT 8,0(AT1),17]
ADD AT1,AT2
JRST CLVAC5
CLVAC6: SOJN AT3,CLVAC7 ; REMOVE THE EFFECT OF MATCHING AGAINST ITSELF
; IF THERE WAS MORE THAN ONE RETAINED RECORD FOR THIS FILE
; WE MUST DO REAL RESTORE
MOVE AT1,SU.RRT ;LOOP AGAIN.. IF REALLY LOW-VALUES READ
; AND DIDN'T GET EOF, SET NXTREC=-1
CLVBC5: CAML AT1,SU.CRH
JRST CLVBC6
HRRZ AT2,0(AT1)
CAMN AT2,AFT
JRST SETIFL ;SET NXTREC = -1 IF WE SHOULD
LDB AT2,[POINT 8,0(AT1),17]
ADD AT1,AT2
JRST CLVBC5
SETIFL: LDB AT2,AT1HVF ;EOF BIT - SET IF LV RETAIN FOUND EOF
JUMPN AT2,CLVBC6 ;IF EOF FOUND, DON'T RESET FLAG
HLRZ AT1,D.BL(AFT)
IFN ANS74,<
HRRZ AT2,D.RFLG(AFT) ; First check to see if special del/rewrt
TRNN AT2,SAVNXT ; And if so, need saved next flag value
JRST SETIF1 ; Not special, cont
HLRZ AT2,RWDLKY(AT1) ; Get saved next rec flag
HRRM AT2,NNTRY(AT1) ; And set it
; this will ensure that the proper saved
; record position will be used
TDNA ; Now skip setting NNTRY
SETIF1:
>; END IFN ANS74
SETOM NXTREC(AT1) ; TELL CBLIO THAT THE CURRENT RECORD IS
HLLOS F.WSMU(AFT) ; THE "NEXT RECORD".
JRST CLVAC3
CLVBC6: HLRZ AT1,D.BL(AFT) ; YES, NO RESTORE NECESSARY, TURN OFF F.WSMU
HLLOS F.WSMU(AFT) ;CLEAR "RESTORE NECESSARY" FLAG
JRST CLVAC3
CLVAC7: PUSHJ PP,RESTOR ;RESTORE OUR POSITION IN THE FILE AT
;RETAIN TIME, IF NECESSARY
CLVAC3:
IFN ANS68,<
PUSHJ PP,OWNFAK ;DO FAKE READ
JRST CLVAC4 ;JUMP IF NOT END OF FILE
PUSHJ PP,UHV ;USE HIGH VALUES IF END OF FILE
>;END IFN ANS68
IFN ANS74,<
HRRZ AT2,D.RFLG(AFT) ; First check to see if special del/rewrt
TRNN AT2,SAVNXT ; And if so, need saved next flag value
JRST CLVA3A ; Not special, cont
HLRZ AT1,D.BL(AFT) ; Get buffer location
HLRZ AT2,RWDLKY(AT1) ; Get saved next rec flag
HRRM AT2,NNTRY(AT1) ; And set it
; This will ensure that the proper saved
; record position will be used
CLVA3A:
PUSHJ PP,FAKNXT
JRST CLVAC4 ;NOT EOF
PUSHJ PP,UHV ;USE HIGH VALUES IF END OF FILE
>;END IFN ANS74
HLR AT4,D.BL(AP)
SETZM NXTREC(AT4) ;SET NXTREC TO 0 TO GUARANTEE
;USER GETS END OF FILE ALSO
JRST CLVAC2
CLVAC4: HLR AT4,D.BL(AP) ;SET NEXT RECORD FLAG SO THAT READ
;WILL GET SAME RECORD WE GOT WITH
;THE FAKE READ
SETOM NXTREC(AT4)
JRST CLVAC2
; FED: THE FILE ENQUEUE/DEQUEUE ROUTINE
;
; ARGUMENTS:
;
; 1. AT4: OWN ACCESS BITS FOR READ, REWRITE, WRITE, DELETE
;
; 2: AT5: OTHERS ACCESS BITS FOR SAME
;
; 3: 0(ACRR) POINTS TO THE FILE TABLE FOR THE FILE
;
; 4: ACRR LH = 0 => ENQUEUE; LH = 1 => DEQUEUE
;
;
; CHANGES:
;
; AT4
; AT5
; ANYTHING CHANGED BY QUEUE
; K
; J
; AT1
; AT2
FED: MOVEI J,4
FED1: LDB K,[POINT 1,AT5,32]
TRNE AT4,000010
TRO K,000002
; K NOW CONTAINS AN INTEGER BETWEEN 0 AND 3 REPRESENTING THE FOUR
; COMBINATIONS OF OWN AND OTHERS USE OF THE VERB CURRENTLY
; REPRESENTED IN BIT 32 OF AT4 AND AT5.
JRST .+1(K)
JRST H0 ;NEITHER OWN NOR OTHER USE
JRST H1 ;NOT OWN USE BUT OTHER USE
JRST H2 ;OWN USE BUT NOT OTHER USE
HRLZI AT1,1 ;OWN USE AND OTHER USE
H10: MOVN AT2,J
SUBI AT2,1
HLR AT1,ACRR
PUSHJ PP,QUEUE
H1: LSH AT4,1
LSH AT5,1
SOJG J,FED1
POPJ PP,
H2: TDZA AT1,AT1
H0: HRLZI AT1,3
JRST H10
; ZSATB: A ROUTINE THAT ASKS CBLIO TO REFRESH ITS IN-CORE STORAGE
; ALLOCATION TABLES
;
; INPUTS:
;
; 1. ACRR POINTS TO THE APPROPRIATE ENTRY IN THE RETAINED RECORDS TABLE
;
; RETURNS: NOTHING
;
; CHANGES: AT1, AFT, USOBJ+13(AT1)
ZSATB: HRRZ AFT,0(ACRR)
LDB AT1,FTOTA
TRNN AT1,000003
POPJ PP, ;RETURN IF OTHERS NEITHER
;INSERTING NOR DELETING
HLRZ AT1,D.BL(AFT)
SETZM USOBJ+13(AT1)
POPJ PP,
CHGCNV: CAMN ACRR2,[MOVS AT5,CHTAB(AT5)] ;[447]
HRLI ACRR2,(HLRZ AT5,(AT5)) ;[447]
CAMN ACRR2,[MOVE AT5,CHTAB(AT5)] ;[447]
HRLI ACRR2,(HRRZ AT5,(AT5)) ;[447]
POPJ PP, ;[447]
; UHV: A ROUTINE TO SET HIGH VALUES IN SU.RBP AND 0 IN FS.BN
;
;
; ARGUMENTS:
;
; 1: AP POINTS TO A FILE TABLE
;
; RETURNS:
;
; 1: A BYTE POINTER TO HIGH VALUES IN SU.RBP
;
; 2: ZERO IN FS.BN
;
; 3: -1 IN SU.HV
;
; CHANGES:
;
; AFT, AT1, SU.RBP, FS.BN, SU.HV
UHV: MOVE AFT,AP
LDB AT1,FTRM ;[447] GET RECORD MODE
HRRI AT1,[OCT 377,77,0,177]-1(AT1) ;[447] VARIOUS HIGH VALUES CHARS
HLL AT1,F.WBSK(AFT) ;[447] FILE TABLE SYMBOLIC KEY BYTE PTR
SETZM FS.BN
TLZ AT1,770000 ;[446] IGNORE OLD BIT POS
; TLO AT1,440000 ;[446] WHEN HERE IT IS ALWAYS WORD ALIGNED
MOVEM AT1,SU.RBP
SETOM SU.HV ;[447] TELL WORLD HIGH VALUES BEING USED
POPJ PP,
; OWNFAK: OUR OWN ROUTINE TO CALL CBLIO FAKE READ
;
IFN ANS74,<
FAKNXT: HRLI AP,RNFLAG ;GET FAKE READ NEXT FLAGS
TRNA
>;END IFN ANS74
OWNFAK: HRLI AP,RFLAG
IFN ANS74,<
SKIPN SU.FRF ; IF NOT ALREADY SET BY DEL/REWRT
>
SETOM SU.FRF ; THEN SET FAKE READ FOR RETAIN FLAG
HLR AT1,D.BL(AP) ;[445] GET TABLE ADDR OF ISAM STUFF
MOVE AT2,GDPSK(AT1) ;[445] GET BYTE PTR USED FOR KEY CONV
MOVEM AT2,SU.T9 ;[445] SAVE FOR LATER
MOVEI AT2,44 ;[445] SET UP CORRECT BYTE POS
DPB AT2,[POINT 6,GDPSK(AT1),5] ;[445] MAKE IT RIGHT
IFN ANS74,<
LDB AT2,F.BFAM ; GET FILE ACCESS MODE
PUSH PP,AT2 ; SAVE IT HERE
MOVEI AT2,%FAM.D ; GET DYNAMIC ACCESS
DPB AT2,F.BFAM ; AND SET IT
>
PUSHJ PP,FAKER.
TRNA
IFN ANS68,<
AOS 0(PP)
>
IFN ANS74,<
AOS -1(PP) ; INVALID KEY RETURN
POP PP,AT2 ; RESTORE ACCESS MODE
DPB AT2,F.BFAM ; HERE
>
SETZM SU.FRF
HLR AT1,D.BL(AP) ;[445] GET TABLE ADDR
MOVE AT2,SU.T9 ;[445] GET BACK ORIG BYTE PTR
MOVEM AT2,GDPSK(AT1) ;[445] RESTORE IT
POPJ PP,
; ERROR HANDLING
EXTERN KILL.
DEFINE $SUERR(TEXT),<
TYPE SUHDR ;TYPE HEADER FOR MESSAGE
TYPE [ASCIZ \TEXT\] ;TYPE THE TEXT OF THE ERROR
JRST KILL. ;GO OFF TO KILL.
>
SU.ER1: $SUERR <RETAIN statement executed when records are already retained, which is not allowed>
SU.ER2: $SUERR <Missing constant (internal error)>
SU.ER3: $SUERR <RETAIN statement requesting access by verb not listed at OPEN time>
SU.ER4: $SUERR <Invalid RETAIN flags (internal error)>
SU.ER5: $SUERR <Invalid type code (internal error)>
SU.ER6: $SUERR <Key sizes unequal (internal error)>
SU.ER7: TYPE SUHDR ;TYPE HEADER FOR MESSAGE
TYPE [ASCIZ \Unexpected return from ENQ/DEQ...error code %\] ;[654]
MOVEI AT3,14 ;[654] OUTPUT ENQ/DEQ ERROR RETURN
SUER7A: SETZ AT1, ;[654] CLEAR CHARACTER BUFFER
LSHC AT1,3 ;[654] GET A DIGIT
ADDI AT1,60 ;[654] MAKE IT ASCII
OUTCHR AT1 ;[654] PRINT IT
SOJG AT3,SUER7A ;[654] DO IT AGAIN
JRST KILL.
SU.ER9: $SUERR <OPEN for simultaneous update is not allowed if files are already OPEN for simultaneous update>
SU.ERB: $SUERR <Attempt to execute READ, REWRITE, WRITE, or DELETE on record not retained>
SU.ERC: $SUERR <Attempt to execute READ, REWRITE, WRITE, or DELETE on record not retained for that purpose>
SU.ERD: $SUERR <Unexpected return from ENQ/DEQ during execution of READ, REWRITE, WRITE, or DELETE (internal)>
SU.ERE: $SUERR <Insufficient core for ENQ/DEQ to operate>
SU.ERF: $SUERR <Insufficient quota for ENQ/DEQ; change the ENQ/DEQ quota parameter in the monitor to run this program>
;PRELUDE TO THE ABOVE MESSAGES
SUHDR: ASCIZ/?COBOL: Simultaneous update - /
END