*DECK DB$LOK
USETEXT CDCSCTX 
      PROC DB$LOK((KEYLOC),(KEYOFFSET),(QUEUED)); 
      BEGIN 
 #
* *   DB$LOK -- LOCK RECORD                      PAGE  1
* *   C O GIMBER                                 DATE  04/27/76 
* *   R L MCALLESTER                             DATE  08/22/79 
* *   R L MCALLESTER - PROTECTIVE/EXCLUSIVE      DATE  03/16/81 
* 
* DC  PURPOSE 
* 
*     LOCK A RECORD.  THIS ROUTINE CAN BE CALLED FOR IMMEDIATE RETURN,
*     IF THE RECORD IS ALREADY LOCKED, OR DELAYED RETURN. 
* 
* DC  ENTRY CONDITIONS
* 
*     P<RSARBLK> IS SET.
* 
*     PARAMETER 
# 
      ITEM KEYLOC;           #LOCATION OF KEY#
      ITEM KEYOFFSET;        #OFFSET OF KEY IN KEY LOCATION#
      ITEM QUEUED B;         #TRUE IF RETURN MUST WAIT UNTIL# 
                             #PREVIOUS LOCK IS RETURNED#
# 
* DC  EXIT CONDITIONS 
* 
*     P<RSARBLK> IS SET.
*     LOKSTATUS (CDCS COMMON) TRUE IF RECORD LOCKED WITHOUT BEING 
*     QUEUED.  FALSE, IF RECORD NOT LOCKED, OR RECORD LOCKED AFTER
*     BEING QUEUED. 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$ERR;      #CDCS ERROR HANDLER# 
      XREF PROC DB$FLOP;     #GENERATE FLOW POINT#
      XREF PROC DB$LKRU;     #RELEASE ALL LOCKS FOR THE RUN-UNIT# 
      XREF FUNC DB$LNK;      #CREATE LINKED MEMORY BLOCK# 
      XREF PROC DB$LNKD;     #DELETE LINKED MEMORY BLOCK# 
      XREF FUNC DB$LNKG;     #GET BLOCK FROM SAVED BLOCK CHAIN# 
      XREF PROC DB$LNKS;     #SAVE BLOCK ON SAVED BLOCK CHAIN#
      XREF PROC DB$MBA;      #ALLOCATE RCB MANAGED MEMORY BLOCK#
      XREF PROC DB$MFA;      #ALLOCATE MANAGED MEMORY BLOCK#
      XREF PROC DB$MBF;      #FREE RCB MANAGED MEMORY BLOCK#
      XREF PROC DB$MFF;      #FREE MANAGED MEMORY BLOCK#
      XREF PROC DB$POP;      #POP ENTRY FROM PUSH-POP STACK#
      XREF PROC DB$POP2;     #POP 2 ENTRIES FROM PUSH-POP STACK#
      XREF PROC DB$PUNT;     #CDCS ABORT PROCESSOR# 
      XREF PROC DB$PUSH;     #PUSH ENTRY INTO PUSH-POP STACK# 
      XREF PROC DB$PSH2;     #PUSH 2 ENTRIES INTO PUSH-POP STACK# 
      XREF PROC DB$SCHD;     #CDCS SCHEDULER# 
      XREF FUNC DB$SFST;     #STATUS SFCALL INTERFACE#
      XREF PROC DB$SOSI;     #SWAP LOCK REQUESTER OUT, LOCK HOLDER IN#
      XREF PROC DB$SWPI;     #SWAP IN USERS RSB/CST#
      XREF PROC DB$SWPO;     #SWAP OUT USERS RSB/CST# 
      XREF PROC DB$UNDU;     #BACK-OUT TRANSACTION UPDATES# 
# 
* 
* DC  NON-LOCAL VARIABLES 
* 
*     CDCS COMMON 
# 
      XREF ITEM DB$ERDN I;         # ERROR MESSAGE INSERT NUMBER       #
      XREF ITEM DB$ERIN C(30);     # ERROR MESSAGE INSERT              #
  
      XREF ARRAY DB$RA0;
        BEGIN 
        ITEM RA;
*CALL ALTDCLS 
  
        ITEM NEXTIDL I(00,00,60);  # POINTER TO NEXT IDLE BLOCK        #
        ITEM BLKAGE I(01,00,60);   # TIMESTAMP WHEN PLACED IN IDLE     #
        END 
      XDEF ITEM TLOCKL I=2000;     # TRANSACTION LOCK LIMIT            #
*CALL ARTDCLS 
# 
* DC  EMBEDDED PROCEDURES 
# 
      XDEF PROC DB$LOKA;     # LOCK ENTIRE AREA                        #
      XDEF PROC DB$LOKD;     # DELETE RECORD OR AREA LOCK              #
      XDEF PROC DB$LOKT;     # TEST FOR LOCK                           #
# 
* DC  DATA STRUCTURES 
* 
*     LOCK QUEUE -
*       CONSISTS OF AT MOST ONE AREA LOCK AND ONE KEY LOCK PER RECORD.
*       THE ORIGIN OF THE CHAIN IS IN THE OFT (POINTER OFALT).
*       THE MEMBERS OF THE CHAIN ARE DOUBLY LINKED BY THE 
*         ITEMS ALNEXT AND ALPRIOR. 
*       ALNEXT IS ZERO FOR THE LAST MEMBER OF THE CHAIN.
* 
*       AN AREA LOCK ENTRY IS IDENTIFIED BY ALLOCK EQUAL TO TRUE. 
*       IF AN AREA LOCK IS PRESENT, IT IS THE FIRST ALT IN THE CHAIN, 
*         THAT IS THE ONE POINTED TO BY OFALT.
*       THE RECORD LOCKS (ALSO CALLED KEY LOCKS) FOLLOW IN NO 
*         SIGNIFICANT ORDER.
* 
*       THE PRESENCE OF AN ALT IN THE LOCK QUEUE DOES NOT INDICATE
*         THAT THE AREA OR RECORD IS LOCKED.
*       THE AREA OR RECORD IS LOCKED IF THE ALOWNER FLAG IS SET TRUE. 
*       THE AREA CANT BE LOCKED AS LONG AS ANY LOCKED RECORDS REMAIN
*         IN THE LOCK QUEUE.
*       NEW RECORD LOCK ENTRIES WILL BE LOCKED AS LONG AS THERE IS NO 
*         LOCKED AREA ENTRY.
* 
*       THE AREA LOCK IS SET WHEN THERE ARE NO LOCKED RECORDS.
*       WHEN THE AREA LOCK IS SET, NEW RECORD LOCKS MUST WAIT UNTIL 
*         THE AREA LOCK IS RELEASED.
* 
* 
*     WAIT QUEUE -
*       ANY MEMBER OF THE LOCK QUEUE MIGHT HAVE A WAIT QUEUE. 
*       THE WAIT QUEUE IS A DOUBLY LINKED RING OF ALT ENTRIES THAT ARE
*         WAITING FOR THE LOCK. 
*       THE MEMBERS OF THE WAIT QUEUE ARE LINKED BY ALWNEXT AND 
*         ALWPRIOR. 
*       WHEN A LOCK QUEUE MEMBER HAS NO WAIT QUEUE ITS WAIT LINKS BOTH
*         POINT TO ITS SELF.
*       A WAIT QUEUE MEMBER IS IDENTIFIED BY (ALPRIOR EQ 0).
* 
*     RSB QUEUE - 
*       WITHIN A BEGIN/COMMIT TRANSACTION SEQUENCE, A USER MAY HOLD 
*         MULTIPLE RECORD LOCKS FOR EACH AREA.
*       THE ALTS FOR THESE RECORD LOCKS ARE HELD IN A SINGLY LINKED 
*         LIST ORIGINATING AT THE RSB AREA CONTROL BLOCK. 
*       RSARALT POINTS TO THE MOST RECENTLY LINKED ALT ENTRY. 
*          (PERHAPS THE POINTER IS INDIRECT, NEGATIVE)
*       THE MOST RECENT ALT MAY BE IN A WAIT QUEUE WAITING FOR
*         ASSIGNMENT OF THE LOCK. 
*       ALL OTHER RSAREA QUEUE MEMBERS ARE IN THE LOCK QUEUE OF THE 
*         ASSOCIATED OFT. 
* 
* DC  LOCK MODES
* 
*     PROTECTIVE MODE - 
*       A PROTECTIVE LOCK PERMITS ANOTHER USER TO READ THE LOCKED 
*         RECORD, BUT ONLY IF THAT USER HAS OPENED THE AREA FOR 
*         READ ONLY.
*       PROTECTIVE MODE IS THE STANDARD MODE. 
* 
*     EXCLUSIVE MODE -
*       AN EXCLUSIVE LOCK DOES NOT PERMIT THE RECORD TO BE READ.
*       AREA LOCKS CAN BE REQUESTED AS EITHER PROTECTIVE OR EXCLUSIVE.
*       OUTSIDE OF A BEGIN/COMMIT SEQUENCE, ALL RECORD LOCKS ARE
*         PROTECTIVE MODE.
*       WITHIN A BEGIN/COMMIT SEQUENCE, RECORD LOCKS ARE ASSIGNED IN
*         PROTECTIVE MODE WHEN THE RECORD IS FIRST READ.
*       ON A DELETE OR REWRITE WITHIN A BEGIN/COMMIT SEQUENCE THE 
*         RECORD LOCK IS CHANGED TO EXCLUSIVE MODE. 
*       WITHIN A BEGIN /COMMIT SEQUENCE, RECORD LOCKS ARE NOT DELETED 
*         UNTIL THE TRANSACTION IS COMMITTED OR DROPPED.
 #
  
# 
*     LOCAL VARIABLES 
# 
  
      BASED ARRAY KEYBASE;
        BEGIN 
        ITEM KEY    C(00,00,240);  # KEY FOR REQUESTED LOCK            #
        ITEM KEYWD  I(00,00,60);   # FIRST WORD OF KEY                 #
        END 
  
      ITEM ALTX;             #ADDRESS OF ENTRY IN ALT LOCK QUEUE# 
      ITEM ALTU;             #ADDRESS OF ENTRY IN ALT WAIT QUEUE# 
      ITEM ALTW;             #ADDRESS OF ENTRY IN ALT WAIT QUEUE# 
      ITEM ARTX;             # SUBSCRIPT TO THE AUTO RECOVERY TABLE    #
      ITEM INDEX; 
      ITEM KL;
      ITEM LTQT U;           # TQT ADDRESS OF THE LOCK HOLDER          #
      ITEM ORIGIN I;         # ORIGIN OF USER ALT CHAIN                #
      ITEM OWNER B;          # OWNER STATUS FOR PROC CREATEENTRY       #
      ITEM TRSALT I;         # TEMPORARY RSARALT SUBSTITUTE            #
      ITEM TQTX   I;         # ADDRESS OF THE TQT ENTRY                #
      ITEM WQUEUE B;         # QUEUE STATUS FOR PROC CREATEENTRY       #
      ITEM XA     I;         # INDUCTION VARIABLE                      #
# 
*     LOCAL DEF-S 
# 
      DEF DFADJ    #39#;     # CHARACTER LENGTH OF ALT HEADER +9       #
      DEF DFALTLEN #06#;     # WORD LENGTH OF STANDARD ALT             #
      DEF DFDLADIM #70#;     # DEADLOCK ARRAY MAXIMUM DIMENSION        #
      DEF DFKLMAX  #30#;     # MAX KEY CHARACTERS FOR A STANDARD ALT   #
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   F U N C T I O N   -   A C C E P T .            #
#                                                                      #
#**********************************************************************#
  
      FUNC ACCEPT B;
      BEGIN 
 #
* *   ACCEPT -- ALT MEETS LOCK CRITERIA         PAGE  1 
* *   D E TRIGLIA                               DATE 1/24/80
* 
* DC  PURPOSE 
* 
*     THIS ROUTINE CHECKS THE ALT POINTED TO BY ALTW TO SEE IF
*     IT MEETS THE CRITERIA FOR GETTING THE LOCK. IF IT DOES, PUT IT
*     IN THE LOCK QUEUE (IF IT'S NOT ALREADY THERE) AND RETURN TRUE.
* 
*     THE CRITERIA FOR GETTING A LOCK ARE AS FOLLOWS: 
* 
*     1. THE ALT HAS ALREADY BEEN SKIPPED OVER DFSKIPLIMIT TIMES OR 
*     2. THE USER THAT OWNS THIS ALT IS SWAPPED IN. 
* 
* DC  ENTRY CONDITIONS
* 
*     ALTW IS POINTING TO THE ALT TO BE CHECKED.
* 
* DC  EXIT CONDITIONS 
* 
*     IF ACCEPT RETURNS TRUE THEN THE ALT POINTED TO BY ALTW SATISFIED
*       ONE OF THE CRITERIA AND IS IN THE LOCK QUEUE. 
*     IF ACCEPT RETURNS FALSE THEN THE ALT POINTED BY ALTW DID NOT
*       SATISFY EITHER OF THE CRITERIA. 
* 
* DC  CALLING ROUTINES
* 
*     GIVELOCK
* 
* DC  CALLED ROUTINES 
* 
*     DB$SFST                             STATUS SFCALL TO SEE IF USER
*                                         IS SWAPPED OUT
 #
#     THIS IS THE MAXIMUM NUMBER OF TIMES AN ALT CAN BE SKIPPED        #
#     BEFORE IT GETS THE LOCK EVEN IF IT'S SWAPPED OUT.                #
#                                                                      #
      DEF DFSKIPLIMIT  # 30 #;
#                                                                      #
#     THIS IS THE SFCALL RETURN CODE THAT INDICATES THAT THE USER      #
#     IS SWAPPED OUT.                                                  #
#                                                                      #
      DEF DFSWAPPEDOUT  # O"44" #;
  
  
  
#     B E G I N   A C C E P T   E X E C U T A B L E   C O D E .        #
  
  
 #
* 
* DC  DESCRIPTION 
* 
*     IF THIS ALT HASN'T BEEN SKIPPED DFSKIPLIMIT TIMES AND THE 
*     THE USER IS SWAPPED OUT THEN SKIP THE ALT, ELSE PUT THE 
*     ALT IN THE LOCK QUEUE IF IT'S NOT ALREADY THERE.
 #
#                                                                      #
#     DB$SFST DOES A NON-INTERRUPTIBLE STATUS SFCALL                   #
#     RETURNING THE RETURN CODE FROM THE STATUS FUNCTION.              #
#                                                                      #
      IF DB$SFST EQ DFSWAPPEDOUT
         AND ALSKIP [ALTW] LS DFSKIPLIMIT 
      THEN
        BEGIN 
        ACCEPT = FALSE; 
        RETURN; 
  
        END 
#                                                                      #
#     IF THIS ALT IS ALREADY IN THE LOCK QUEUE, DON'T PUT IT IN THE    #
#     LOCK QUEUE.                                                      #
#                                                                      #
      IF ALTW NQ ALTX 
      THEN
        BEGIN 
        ALPRIOR [ALTW] = ALPRIOR [ALTX];
        ALNEXT  [ALTW] = ALNEXT  [ALTX];
        ALNEXT  [ALPRIOR [ALTX]] = ALTW;
#                                                                      #
#     IF THIS IS THE LAST ALT IN THE LOCK QUEUE, THERE IS NO ALPRIOR   #
#     TO ADJUST.                                                       #
#                                                                      #
        IF ALNEXT [ALTW] NQ 0 
        THEN
          ALPRIOR [ALNEXT  [ALTX]] = ALTW;
#                                                                      #
#     THE ALPRIOR FIELD OF THE ALT THAT USED TO BE IN THE LOCK         #
#     QUEUE MUST BE ZEROED.                                            #
#                                                                      #
        ALPRIOR [ALTX] = 0; 
#                                                                      #
#     SET ALTX EQUAL TO ALTW SO THAT THE LOOP IN GIVELOCK              #
#     WILL TERMINATE.                                                  #
#                                                                      #
        ALTX = ALTW;
        END 
      ACCEPT = TRUE;
      RETURN; 
  
      END                               #        END ACCEPT            #
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   C H E C K D E A D L O K#
#                                                                      #
#**********************************************************************#
  
 #
* 
* *   CHECK DEADLOCK                             PAGE  1
* 
*     THIS PROC CHECKS FOR THE DEADLOCK CONDITION GIVEN THE OFT,
*     UFT AND THE KEY.
 #
      PROC CHECKDEADLOK;
      BEGIN 
 #
* 
* DC  ENTRY 
* 
*     ALTX CONTAINS THE ADDRESS OF AN ALT THAT HAS JUST BEEN LINKED 
*     INTO A WAIT QUEUE, OR INTO THE LOCK QUEUE WITHOUT OWNER STATUS. 
* 
*     THE TQT BASE POINTER CONTAINS THE ADDRESS OF THE TQT ASSOCIATED 
*     WITH THE REQUESTED LOCK.
* 
* DC  EXIT
* 
*     IF NO DEADLOCK CONDITION IS FOUND, EXIT NORMALLY. 
*       ALTX AND P<TQT> ARE UNALTERED.
* 
*     IF A DEADLOCK IS FOUND, ALL LOCKS THAT ARE CURRENTLY HELD FOR THE 
*       TQT THAT IS REQUESTING A NEW LOCK ARE RELEASED. 
*       AN ERROR EXIT IS TAKEN. 
* 
* DC  DEADLOCK DETECTION METHOD 
* 
*     THE LOCK CANDIDATE IS AN INACTIVE LOCK (ALOWNER = FALSE). 
* 
*     A CONSTRAINING LOCK IS AN ACTIVE LOCK THAT MUST BE RELEASED 
*     BEFORE THE CANDIDATE CAN OBTAIN ACTIVE STATUS.
* 
*     LOCK CANDIDATES ARE USUALLY IN A WAIT QUEUE BUT MAY BE IN THE 
*     LOCK QUEUE WHEN THERE IS AN AREA LOCK AND A RECORD LOCK IN THE
*     SAME LOCK QUEUE.
*     EITHER THE AREA LOCK IS ACTIVE OR ALL THE RECORD LOCKS ARE ACTIVE.
* 
*     ANY ACTIVE LOCK IS THE CONSTRAINING LOCK FOR ALL OF THE CANDIDATES
*     IN ITS WAIT QUEUE.
*     WHEN AN AREA LOCK IS ACTIVE, IT IS THE CONSTRAINING LOCK FOR ANY
*     RECORD LOCK CANDIDATE FOR THAT AREA.
* 
*     IF THERE IS AN INACTIVE AREA LOCK IN THE LOCK QUEUE, IT AND ITS 
*     WAIT QUEUE ENTRIES ARE CONSTRAINED BY EACH OF THE RECORD LOCKS
*     IN THE LOCK QUEUE 
* 
*     TO IDENTIFY A DEADLOCK WE TRACE FROM THE CANDIDATE LOCK TO ITS
*     CONSTRAINING LOCK.
*     THE CONSTRAINING LOCK IS ASSOCIATED WITH AN OWNING TQT. 
* 
*     THE OWNING TQT MIGHT BE WAITING FOR A CANDIDATE LOCK ON A 
*     DIFFERENT AREA. 
* 
*     IF IT IS WAITING, WE GO TO ITS CANDIDATE LOCK AND THEN ITS
*     CONSTRAINING LOCK --- ETC.
*     IF THIS CHAIN IS CIRCULAR, IT WILL LEAD BACK TO THE TQT OF THE
*     ORIGINAL CANDIDATE. 
*     A CIRCULAR CHAIN DEFINES A DEADLOCK.
* 
*     IF THE TQT IS NOT WAITING FOR A CANDIDATE, THE CHAIN IS BROKEN
*     AND DOES NOT DEFINE A DEADLOCK. 
* 
*     A CHAIN MAY HAVE SEVERAL BRANCHES IF AN AREA LOCK IS CONSTRAINED
*     BY SEVERAL ACTIVE RECORD LOCKS. 
*     IN THAT CASE IT IS NECESSARY TO FOLLOW EACH BRANCH OF THE CHAIN 
*     TO WHERE IT IS BROKEN BEFORE IT CAN BE ASSURED THAT THERE IS NO 
*     DEADLOCK. 
* 
* DC  NOTES:  
* 
*     AN INACTIVE LOCK IS NEVER A CONSTRAINING LOCK BECAUSE ITS TQT IS
*     WAITING FOR ITSELF. 
* 
*     THERE ARE NO CIRCULAR CHAINS THAT DO NOT INCLUDE THE TQT OF THE 
*     REQUESTING CANDIDATE BECAUSE NO CIRCULAR CHAIN IS EVER COMPLETED. 
*       AN EXCEPTION TO THIS IS A PERIOD OF TIME DURING WHICH A 
*       DEADLOCK IS BEING RESOLVED. 
*       THE CIRCULAR CHAIN IS COMPLETED BUT THEN DEMOLISHED BY DROPPING 
*       ONE USER'S TRANSACTION. 
 #
      ARRAY DLARRAY [DFDLADIM]; 
        BEGIN 
        ITEM ALTLIST;              # LIST OF ALT ADDRESSES FOR DEADLOCK#
        END 
      ITEM LI;                     # LIST INDEX                        #
      ITEM LJ;
  
  
  
#     B E G I N   - CHECKDEADLOK -   E X E C U T A B L E   C O D E .   #
  
  
        FOR LJ=0 STEP 1 UNTIL 100 DO
        BEGIN 
  
        ALTW = ALTX;
        LI = -1;
        FOR INDEX=0 STEP 1 UNTIL 500 DO 
          BEGIN 
# 
*         IF THE ALT AT ALTW IS A WAIT QUEUE MEMBER,
*           TRACE THE WAIT QUEUE TO ITS ALT IN THE LOCK QUEUE.
# 
          FOR ALTW = ALTW WHILE ALPRIOR[ALTW] EQ 0
          DO
            BEGIN 
            ALTW = ALWNEXT[ALTW]; 
            END 
# 
*         IF THIS LOCK QUEUE MEMBER DOESNT OWN THE LOCK,
*           FIND THE ONE (OR ONES) THAT DOES. 
# 
          IF NOT ALOWNER[ALTW]
          THEN
            BEGIN 
            IF ALLOCK[ALTW] 
            THEN
# 
*             THIS ONE IS AN UNLOCKED AREA LOCK.
*             THEN ALL THE FOLLOWING RECORD LOCKS ARE LOCKED. 
*             INITIATE A LIST TO BE CHECKED FOR DEADLOCK. 
# 
              BEGIN 
              LI = LI +1; 
              IF LI GR DFDLADIM 
              THEN
                BEGIN 
                DB$PUNT("DB$LOK   2");
                END 
              ALTW = ALNEXT[ALTW];
              ALTLIST[LI] = ALTW; 
              END 
            ELSE
# 
*             THIS ONE IS AN UNLOCKED RECORD LOCK.
*             THERE MUST BE A LOCKED AREA LOCK, FIND IT.
# 
              BEGIN 
              FOR ALTW = ALTW WHILE NOT ALOWNER[ALTW] 
              DO
                BEGIN 
                ALTW = ALPRIOR[ALTW]; 
                END 
              END 
            END 
# 
*         ALTW CONTAINS THE ADDRESS OF A LOCK THAT MUST BE RELEASED 
*         BEFORE THE REQUESTED LOCK CAN BE GRANTED. 
*         IF THE LOCK WE ARE WAITING FOR IS FOR THE SAME TQT AS 
*         THE REQUESTED LOCK, THEN THERE IS A DEADLOCK. 
* 
*         RETURN ALL THE LOCKS FOR THIS TQT.
*         ISSUE A CDCS ERROR
# 
          TQTX = ALTQT[ALTW]; 
          IF TQTX EQ LOC(TQT) THEN
            BEGIN 
            IF TQARTX[0] NQ 0 
            THEN             # IN TRANSACTION MODE                     #
              BEGIN          # BACK OUT THE TRANSACTION                #
              DB$UNDU;
              END 
            DB$LKRU(TRUE);   # RELEASE ALL LOCKS FOR THIS RUN-UNIT     #
            DB$ERR(21); 
            END 
          P<TQT> == TQTX; 
# 
* 
*         IF THE TQT HAS BEEN DELETED WITHOUT DELETEING THE ALT,
*         DELETE THE ABANDONED ALT. 
# 
          IF ALRUID[ALTW] NQ B<0,24>TQRUID[0] 
          THEN
            BEGIN 
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("LOK-ORP");      # DELETE AN ORPHAN ALT          #
            CONTROL ENDIF;
            IF ALWNEXT[ALTW] EQ ALTW
            THEN
              BEGIN 
              DB$LNKD(ALTW);
              END 
            ELSE
              BEGIN 
              ALTU = ALWNEXT[ALTW]; 
  
              # LINK THE NEXT WAIT QUEUE BLOCK INTO THE LOCK QUEUE.    #
  
              ALPRIOR[ALTU] = ALPRIOR[ALTW];
              ALNEXT[ALPRIOR[ALTU]] = ALTU; 
              ALNEXT[ALTU] = ALNEXT[ALTW];
              IF ALNEXT[ALTU] NQ 0 THEN 
                ALPRIOR[ALNEXT[ALTU]] = ALTU; 
  
              # DELINK THE OLD BLOCK FROM THE WAIT QUEUE.              #
  
              ALWPRIOR[ALTU] = ALWPRIOR[ALTW];
              ALWNEXT[ALWPRIOR[ALTU]] = ALTU; 
              ALOWNER[ALTU] = TRUE; 
              DB$MFF(ALTW); 
              END 
            ALTW = 0; 
            END 
          ELSE
            BEGIN 
            ALTW = TQALT[0];
            END 
          P<TQT> == TQTX; 
# 
*         TQALT IS NON-ZERO IF THE TQT IS WAITING FOR A LOCK. 
* 
*         IF TQALT IS NON-ZERO, FOLLOW THE CHAIN IN SEARCH OF A 
*         DEADLOCK. 
# 
          IF ALTW NQ 0
          THEN
            BEGIN 
            TEST INDEX; 
            END 
# 
*         IF TQALT IS ZERO THERE IS NO DEADLOCK ON THIS CHAIN.
*           IF A LIST OF RECORD LOCKS WAS INITIATED ALONG THE WAY,
*           TAKE THE NEXT LOCK FROM THE LIST AND CHECK IT FOR 
*           DEADLOCK. 
# 
          FOR LI = LI STEP -1 UNTIL 0 
          DO
            BEGIN 
            ALTLIST[LI] = ALNEXT[ALTLIST[LI]];  # ADVANCE LIST         #
            ALTW = ALTLIST[LI]; 
            IF ALTW NQ 0
            THEN
              BEGIN 
              TEST INDEX; 
              END 
# 
*           ELSE, LOOP IN LI LOOP LOOKING FOR ANOTHER LIST
# 
            END  # LI # 
          RETURN;                  # NO MORE LISTS, DO A NORMAL RETURN #
  
          END    # INDEX #
# 
*       TRY WAITING FOR A DEADLOCKED TRANSACTION TO BE BACKED OUT.
# 
        DB$PUSH(CHECKDEADLOK);
        DB$PUSH(ALTX);
        DB$PUSH(LJ);
        DB$PUSH(5); 
        DB$SCHD(LOC(STATCOMP),DFWAITCOUNT); 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LOK-DED"); 
        CONTROL ENDIF;
  
        DB$POP(LJ); 
        DB$POP(ALTX); 
        DB$POP(CHECKDEADLOK); 
  
        END    # LJ # 
# 
*       INTERNAL ERROR IF LOOP EXECUTED TOO MANY TIMES. 
# 
        DB$PUNT("DB$LOK   1");
        END 
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   C R E A T E E N T R Y .#
#                                                                      #
#**********************************************************************#
  
 #
* *   CREATEENTRY                                PAGE  1
* 
* DC  PURPOSE 
* 
*     THIS ROUTINE CREATES A NEW ALT GIVEN THE KEY, UFT, ALT ENTRY, 
*     OWNER AND QUEUE STATUS. 
 #
      PROC CREATEENTRY; 
        BEGIN 
  
        IF NOT WQUEUE              # NOT FOR THE WAIT QUEUE            #
        THEN                       # BUILD IT IN THE LOCK QUEUE        #
          BEGIN 
          IF KL LQ DFKLMAX
          THEN
            BEGIN            # USE A STANDARD SIZE ALT FROM IDLE LIST  #
            ALTX = DB$LNKG(ALTX,DFALTLEN,IDLEALTP); 
            ALLONG[ALTX] = FALSE; 
            END 
          ELSE
            BEGIN            # GET AN OVERSIZE ALT FROM CMM            #
            ALTX = DB$LNK(ALTX,(KL+DFADJ)/10);
            ALLONG[ALTX] = TRUE;
            END 
          ALWNEXT[ALTX] = ALTX; 
          ALWPRIOR[ALTX] = ALTX;
          END 
        ELSE
          BEGIN 
          IF IDLEALTP NQ 0
            AND KL LQ DFKLMAX 
          THEN
            BEGIN                  # TAKE ALT ENTRY FROM THE IDLE LIST #
            ALTW = IDLEALTP;
            IDLEALTP = NEXTIDL[ALTW]; 
            ALLONG[ALTW] = FALSE; 
            END 
          ELSE
            BEGIN                  # GET AN ENTRY FROM CMM             #
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("LOK-C1 ");      # GENERATE FLOW POINT - COMPASS1#!#
            CONTROL ENDIF;
  
            IF KL LQ DFKLMAX
            THEN
              BEGIN          # GET A STANDARD SIZED WAIT QUEUE FROM CMM#
              DB$MFA(DFALTLEN,ALTW);
              ALLONG[ALTW] = FALSE; 
              END 
            ELSE
              BEGIN          # GET A LONG WAIT QUEUE ENTRY             #
              DB$MFA((KL+DFADJ)/10,ALTW); 
              ALLONG[ALTW] = TRUE;
              END 
            END 
  
          # LINK NEW MEMBER AS LAST IN THE WAIT LIST (FIFO)            #
  
          ALWNEXT[ALTW] = ALTX; 
          ALWPRIOR[ALTW] = ALWPRIOR[ALTX];
          ALWPRIOR[ALTX] = ALTW;
          ALWNEXT[ALWPRIOR[ALTW]] = ALTW; 
  
          ALPRIOR[ALTW] = 0;       # IDENTIFY AS A WAIT QUEUE MEMBER   #
          ALTX = ALTW;
          END 
        IF RSARALT[0] GQ 0
        THEN
          BEGIN 
                                   # LINK NEW ENTRY INTO RSB ALT CHAIN #
          ALUFNEXT[ALTX] = RSARALT[0];
          RSARALT[0] = ALTX;
          END 
        ELSE
          BEGIN 
                                   # LINK NEW ENTRY INTO RSB ALT CHAIN #
                                   # LINKING TO THE INITIAL LINKAGE    #
                                   # AREA CONTROL BLOCK.               #
          ALUFNEXT[ALTX] = RSFALT[-RSARALT[0]]; 
          RSFALT[-RSARALT[0]] = ALTX; 
          END 
        ALEXCL[ALTX] = FALSE;      # INITIALIZE AS PROTECTIVE LOCK     #
        ALOWNER[ALTX] = OWNER;
        ALTQT[ALTX] = LOC(TQT); 
        ALRUID[ALTX] = B<0,24>TQRUID[0];
        ALSKIP[ALTX] = 0;      # ZERO SKIP COUNTER                     #
  
                               # FLAG LOCK ENTRIES CREATED WITH        #
                               # MULTI-LOCK CAPABILITY SET             #
        ALMLOK[ALTX] = RCMLOK[0]; 
        IF KEYLOC EQ 0 THEN 
          ALLOCK[ALTX] = TRUE;
        ELSE
          BEGIN 
          ALLOCK[ALTX] = FALSE; 
        C<0,KL>ALKEY[ALTX] = C<KEYOFFSET,KL>KEY;
          END 
        IF OWNER
        THEN
          BEGIN 
          TQALT[0] =0;
          RETURN; 
  
          END 
        TQALT[0] = ALTX;
        RETURN; 
  
        END 
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   G I V E L O C K .      #
#                                                                      #
#**********************************************************************#
  
      PROC GIVELOCK;
      BEGIN 
 #
* *   GIVELOCK -- ASSIGN LOCK TO NEW ALT         PAGE  1
* *   D E TRIGLIA                                DATE  1/24/80
* 
* DC  PURPOSE 
* 
*     THIS ROUTINE GIVES A RECORD LOCK TO THE FIRST ALT IN THE WAIT 
*     QUEUE THAT SATISFIES ONE OF THE FOLLOWING CONDITIONS: 
* 
*     1. THIS ALT HAS ALREADY BEEN SKIPPED OVER DFSKIPLIMIT TIMES.
*     2. THE USER THAT OWNS THIS ALT IS SWAPPED IN. 
* 
*     IF NO SUCH ALT EXISTS, THEN GIVE THE LOCK TO THE FIRST ALT IN 
*     THE WAIT QUEUE, I.E. THE ALT THAT IS IN THE LOCK QUEUE. 
* 
* DC  ENTRY CONDITIONS
* 
*     ALTX IS POINTING TO THE FRONT OF THE WAIT QUEUE.
* 
* DC  EXIT CONDITIONS 
* 
*     THE LOCK AND WAIT QUEUE POINTERS ARE ADJUSTED SO THAT 
*     THE ALT NOW IN THE LOCK QUEUE IS THE ONE THAT SHOULD GET
*     THE LOCK, ACCORDING TO THE ABOVE MENTIONED CRITERIA.
* 
* DC  CALLING ROUTINES
* 
*     DB$LOKD 
* 
* DC  CALLED ROUTINES 
* 
*     ACCEPT                              SEE IF THIS ALT MEETS 
*                                         CRITERION FOR GETTING LOCK
* 
 #
#                                                                      #
#     LOCAL VARIABLES                                                  #
#                                                                      #
      ITEM SAVETQT U;                   #         SAVE THE TQT POINTER #
  
  
  
#     B E G I N   G I V E L O C K   E X E C U T A B L E   C O D E .    #
  
  
 #
* DC  DESCRIPTION 
* 
 #
#                                                                      #
#     ALTW WILL STEP THROUGH THE WAIT QUEUE WHILE GIVELOCK DECIDES     #
#     WHO TO GIVE THE LOCK TO. THE TQT POINTER MUST BE SAVED NOW       #
#     SO THAT IT CAN BE RESTORED WHEN EXITTING THIS ROUTINE. SET       #
#     UP THE TQT POINTER SO THAT THE THE USER WHO OWNS ALT ALTW        #
#     ALSO OWNS THE TQT.                                               #
#                                                                      #
      ALTW = ALTX;
      SAVETQT = P< TQT >; 
      P< TQT > = ALTQT [ALTW];
 #
*     LOOP THROUGH THE ALT'S IN THE WAIT QUEUE TO FIND ONE THAT MEETS 
*     THE CRITERIA FOR GETTING THE LOCK. THE FAST FOR LOOP MUST BE
*     USED SO THAT THE END CONDITION IS CHECKED AT THE BOTTOM OF THE
*     LOOP. 
 #
      CONTROL FASTLOOP; 
      FOR ALTW = ALTW WHILE ALTW NQ ALTX DO 
        BEGIN 
#                                                                      #
#       THE ACCEPT FUNCTION CHECKS TO SEE IF THE ALT POINTED TO BY     #
#       ALTW MEETS THE CRITERION FOR GETTING THE LOCK. IF THE ALT DOES #
#       ACCEPT PUTS IT IN THE LOCK QUEUE AND LEAVES ALTX = ALTW.       #
#                                                                      #
        IF NOT ACCEPT 
        THEN
          BEGIN 
#                                                                      #
#       INCREMENT THE SKIP COUNTER AND MOVE TO THE NEXT ALT IN THE     #
#       WAIT QUEUE AND THE APPROPRIATE TQT.                            #
#                                                                      #
          ALSKIP [ALTW] = ALSKIP [ALTW] + 1;
          ALTW = ALWNEXT [ALTW];
          P< TQT > = ALTQT [ALTW];
          END 
        END 
#                                                                      #
#     RESTORE THE TQT POINTER                                          #
#                                                                      #
      P< TQT > = SAVETQT; 
#                                                                      #
#     BACK TO SLOW LOOPS SO THAT OTHER LOOPS ARE EXECUTED              #
#     CORRECTLY.                                                       #
#                                                                      #
      CONTROL SLOWLOOP; 
      RETURN; 
  
      END                               #        END GIVELOCK          #
  
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   F U N C T I O N   -   K E Y E Q U A L .        #
#                                                                      #
#**********************************************************************#
  
      FUNC KEYEQUAL B;
      BEGIN 
 #
* *   DB$LOK                                     PAGE  1
* *   KEYEQUAL -- COMPARE LOCK KEYS 
* *   BOB MCALLESTER                             DATE  05/28/81 
* 
* DC  PURPOSE 
* 
*     THE KEY OF THE REQUESTED RECORD LOCK IS COMPARED WITH A KEY 
*     IN AN EXISTING ALT ENTRY. 
* 
* DC  ENTRY CONDITIONS
* 
* D   ASSUMPTIONS 
* 
*     KEYOFFSET              CHARACTER OFFSET TO FIRST CHARACTER OF KEY 
*     KL                     LENGTH OF KEY IN CHARACTERS
*     P<KEYBASE>             LOCATION OF THE FIRST WORD OF THE KEY
*     ALTX                   LOCATION OF ALT CONTAINING COMPARISON KEY
* 
* DC  EXIT CONDITIONS 
* 
*     FUNCTION TRUE IF KEYS ARE EQUAL 
* 
* DC  DESCRIPTION 
* 
*     IF THE KEYS TO BE COMPARED ARE ONE WORD LONG AND ON A WORD
*     BOUNDARY, AN INTEGER COMPARISON IS USED.
*     OTHERWISE A CHARACTER COMPARE IS DONE.
 #
  
  
#     B E G I N   K E Y E Q U A L   E X E C U T A B L E   C O D E .    #
  
      IF KEYOFFSET EQ 0 
        AND KL EQ 10
      THEN
        BEGIN 
        KEYEQUAL = KEYWD[0] EQ ALKEYWD[ALTX]; 
        RETURN; 
  
        END 
  
      KEYEQUAL = C<KEYOFFSET,KL>KEY[0] EQ C<0,KL>ALKEY[ALTX]; 
      RETURN; 
  
      END 
  
  
#**********************************************************************#
#                                                                      #
#     I N T E R N A L   P R O C E D U R E   -   W A I T L O C K .      #
#                                                                      #
#**********************************************************************#
  
      PROC WAITLOCK;
      BEGIN 
 #
* *   WAITLOCK -- WAIT FOR A LOCK TO BE ASSIGNED PAGE  1
* *   BOB MCALLESTER                             DATE  9/19/87
* 
* DC  PURPOSE 
* 
*     ISSUE AN INFORMATIVE WAIT MESSAGE 
*     THEN WAIT FOR THE LOCK TO COME AVAILABLE. 
 #
  
      BASED ARRAY SAVEAREA; 
        BEGIN 
        ITEM SERIN  C(00,00,10);   # SAVE DB$ERIN                      #
        ITEM SALTX  I(01,00,60);   # SAVE ALTX                         #
        ITEM SXA    I(02,00,60);   # SAVE XA                           #
        ITEM SRCIR2 I(03,00,60);   # SAVE RCIR[2] (RCIRRC, RCIRES)     #
        ITEM SRCIR3 I(04,00,60);   # SAVE RCIR[3] (RCIRERR)            #
        END 
  
  
#     B E G I N   W A I T L O C K   E X E C U T A B L E   C O D E .    #
  
      DB$PUSH(WAITLOCK);
      DB$MBA(5, P<SAVEAREA>); 
      SERIN[0] = " "; 
      SALTX[0] = ALTX;
      SRCIR2[0] = RCIR[2];
      SRCIR3[0] = RCIR[3];
# 
*         IF THE LOCK HOLDER IS SWAPPED OUT, SWAP OUT THE USER NOW
*         REQUESTING THE LOCK AND SWAP IN THE LOCK HOLDER. AN SF
*         FUNCTION MUST BE PERFORMED FOR THE SWAPPED OUT USER 
*         TO GET IT SWAPPED IN IF IT IS TO DO FURTHER PROCESSING. 
*         THE SF FUNCTION DONE IN THIS CASE IS TO WRITE THE COMPLETE
*         BIT IN THE USER FIELD LENGTH WHEN IT GETS THE LOCK. 
*         IF THE USER TERMINATES WHILE IT IS SWAPPED OUT, DB$WRP WILL 
*         WILL TAKE CARE OF SWAPPING IT IN BEFORE TERMINATING IT. 
# 
      DB$SOSI(LTQT);
WAITWAIT: 
      ALTX = SALTX[0];
  
      FOR XA = 1 STEP 1 UNTIL 100  # DELAY EIGHT SECONDS               #
      DO
        BEGIN 
        SXA[0] = XA;
        DB$PUSH(4); 
        DB$SCHD(LOC(STATCOMP),DFWAITCOUNT); 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LOK-S1");
        CONTROL ENDIF;
  
        ALTX = SALTX[0];
        XA = SXA[0];
        IF ALOWNER[ALTX]
        THEN
          BEGIN 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("LOK-WX");
          CONTROL ENDIF;
  
          GOTO LOCKOK;       # LOCK IS ASSIGNED, SKIP THE WAIT MESSAGE #
  
          END 
        END 
      FOR XA = 1 STEP 1 WHILE ALPRIOR[ALTX] EQ  0 
      DO                     # IF IN WAIT QUEUE, GO TO LOCK QUEUE      #
        BEGIN 
        ALTX = ALWNEXT[ALTX]; 
        IF XA GR 1000 
        THEN
          BEGIN 
          DB$PUNT("DB$LOK 5");
          END 
        END 
                             # THERE MUST BE A LOCK ON EITHER          #
                             # A RECORD LOCK OR AN AREA LOCK           #
      FOR XA = 1 STEP 1 WHILE NOT ALOWNER[ALTX] 
      DO                     # FIND A LOCKED MEMBER OF THE LOCK QUEUE  #
        BEGIN 
        IF ALLOCK[ALTX] 
        THEN                 # THE UNLOCKED ENTRY IS AN AREA LOCK      #
          BEGIN 
          ALTX = ALNEXT[ALTX];     # MOVE FORWARD TO RECORD LOCK       #
          END 
        ELSE                 # THE UNLOCKED ENTRY IS A RECORD LOCK     #
          BEGIN 
          ALTX = ALPRIOR[ALTX];    # MOVE BACKWARD TO AREA LOCK        #
          END 
        IF XA GR 1000 
        THEN
          BEGIN 
          DB$PUNT("DB$LOK 6");
          END 
        END 
      LTQT = ALTQT[ALTX]; 
      P<TQT> == LTQT; 
      DB$ERIN = C<0,4>TQRUID[0];
      IF B<24,18>TQRUID[0] NQ 0 
      THEN
        BEGIN 
        C<4,3>DB$ERIN = C<4,3>TQRUID[0];
        END 
      P<TQT> == LTQT; 
      IF SERIN[0] NQ C<0,10>DB$ERIN 
      THEN
        BEGIN 
        SERIN[0] = C<0,10>DB$ERIN;
        IF TQRSB[0] LS 0
        THEN
#           MUST SWAP IN THE RSB TO GET THE AREA NAME                  #
          BEGIN 
          DB$SWPI;
          IF RSFCAORD[0] NQ 0 
          THEN
            BEGIN 
            SETRSARBLK; 
            END 
          END 
        C<0,10>DB$ERIN = SERIN[0];
        DB$ERR(86);          # WAITING FOR LOCK HELD BY (DB$ERIN)      #
        DB$SWPO(TRUE);       # DURING A MAJOR DELAY, SWAP OUT RSB/CST  #
                             # ALSO, ADVISE THE OS TO SWAP OUT THE USER#
        RCIR[2] = SRCIR2[0];
        RCIR[3] = SRCIR3[0];
        END 
      GOTO WAITWAIT;
  
 LOCKOK:  
      ALTX = SALTX[0];
      IF SERIN[0] NQ " "
      THEN
        BEGIN 
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LOK-S2");
        CONTROL ENDIF;
  
        DB$ERR(87);          # OBTAINED LOCK                           #
        END 
      RCIR[2] = SRCIR2[0];
      RCIR[3] = SRCIR3[0];
      IF TQRSB[0] LS 0
      THEN
        BEGIN 
        DB$SWPI;               # SWAP IN RSB/CST                   #
        IF RSFCAORD[0] NQ 0 
        THEN
          BEGIN 
          SETRSARBLK; 
          P<OFT> = RSAROFIT[0]; 
          P<FKL> = RSFFKLLOC[0];
          P<FPT> = LOC(FKL) + RSARFPT[0]; 
          END 
        END 
      DB$MBF(P<SAVEAREA>);
      DB$POP(WAITLOCK); 
      END 
  
#**********************************************************************#
#     E N D   O F   I N T E R N A L   P R O C E D U R E S .            #
#**********************************************************************#
  
  
  
  
#     B E G I N   D B $ L O K   E X E C U T A B L E   C O D E .        #
  
  
 #
* *   DB$LOK DESCRIPTION                         PAGE  1
* 
* DC  DESCRIPTION (DB$LOK)
* 
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("LOK    ");            # GENERATE FLOW POINT - ENTRY   #
      CONTROL ENDIF;
  
      P<OFT> = RSAROFIT[0]; 
      P<FKL> = RSFFKLLOC[0];
      P<FPT> = LOC(FKL) + RSARFPT[0]; 
      LOKSTATUS = TRUE; 
 #
*     RETURN IF AREA LOCKED.
 #
      ALTX = RSARALT[0];
      IF ALTX LS 0
      THEN                         # RSARALT IS AN INDIRECT POINTER    #
        BEGIN 
        ALTX = RSFALT[-ALTX]; 
        END 
  
      IF ALTX NQ 0
        AND ALLOCK[ALTX]
        AND ALOWNER[ALTX] 
      THEN
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LOK-R2 ");          # GENERATE FLOW POINT - RETURN 2#
        CONTROL ENDIF;
  
        RETURN; 
  
        END 
 #
*     IF THE RECORD LOCK IS ALREADY HELD BY THE USER, CONTROL IS
*     RETURNED WITH LOKSTATUS TRUE. 
*     IF A PREVIOUS LOCK ATTEMPT WAS DELAYED BECAUSE OF AN EXCLUSIVE
*     LOCK, THERE MAY BE A RECORD LOCK FOR THIS USER EVEN THOUGH IT 
*     IS OPENED FOR READ ONLY.  IN THAT CASE, RELEASE THE LOCK. 
 #
      P<KEYBASE> = KEYLOC;
      KL = OFPRIKL[0];
      IF ALTX NQ 0
        AND KEYEQUAL
      THEN
        BEGIN 
        IF FPFITPD[0] LS 2
        THEN                       # AREA IS OPENED FOR READ ONLY      #
          BEGIN 
          DB$LOKD(FALSE);          # RELEASE RECORD LOCKS              #
          END 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LOK-R3 ");          # GENERATE FLOW POINT - RETURN 3#
        CONTROL ENDIF;
  
        RETURN; 
  
        END 
 #
*     IF NOT WITHIN A BEGIN/COMMIT SEQUENCE, RETURN EXISTING RECORD 
*     LOCKS.
*     MULTIPLE RECORD LOCKS ARE REQUIRED WITHIN A BEGIN/COMMIT SEQUENCE.
*     MULTIPLE LOCKS ARE ALSO EXPLICITLY PERMITTED WHEN RCMLOK IS TRUE. 
*       (SEE DB$CPRO) 
 #
      IF TQARTX[0] EQ 0 
        AND NOT RCMLOK[0] 
      THEN
        BEGIN 
        DB$LOKD(FALSE); 
        END 
 #
*     COUNT THE LOCKS AND ABORT THE USER IF THE NUMBER OF LOCKS 
*     REACHES THE TRANSACTION LOCK LIMIT. 
 #
      IF TQARTX[0] NQ 0 
        AND TLOCKL NQ 0 
      THEN
        BEGIN 
        P<ART> = SAARTPTR[SALX];
        ARTX = TQARTX[0]; 
        ARLOCKS[ARTX] = ARLOCKS[ARTX] +1; 
        IF ARLOCKS[ARTX] GR TLOCKL
        THEN
          BEGIN 
          DB$ERDN = TLOCKL; 
          DB$ERR(60); 
          END 
        END 
 #
*     STARTING FROM THE OFT, SCAN THE LOCK QUEUE. 
*     IF ANOTHER TASK HAS ALREADY LOCKED THE RECORD, DO ONE OF THE
*     FOLLOWING.
* 
*       . IF IT IS THE REQUESTING TASK THAT ALREADY OWNS THE LOCK,
*         THEN RETURN WITH LOCKSTATUS TRUE. 
*         THIS MAY HAPPEN DURING CONSTRAINT PROCESSING WHERE A TASK 
*         MAY REQUEST A LOCK THROUGH TWO DIFFERENT AREA CONTROL BLOCKS
*         FOR THE SAME FILE.
*         THIS MAY ALSO HAPPEN DURING A TRANSACTION WHEN THERE ARE
*         MULTIPLE RECORDS LOCKED.
* 
*       . IF THE EXISTING LOCK IS NOT AN EXCLUSIVE LOCK 
*         AND THE AREA IS OPENED FOR INPUT ONLY 
*         THEN NO ALT ENTRY IS CREATED AND
*         CONTROL IS RETURNED WITH LOKSTATUS = TRUE.
* 
*       . IF THE LOCK IS REQUESTED WITHOUT QUEUEING 
*         CONTROL IS RETURNED WITH LOKSTATUS = FALSE. 
* 
*       . IF IMMEDIATE RETURN IS SET FOR THE USER 
*         THEN ALL EXISTING LOCKS FOR THE TASK ARE RELEASED 
*         AND A NONFATAL ERROR (55) IS RETURNED.
* 
*       . IF NONE OF THE ABOVE, A WAIT QUEUE ALT IS CREATED.
*         A CHECK FOR DEADLOCK IS PERFORMED.
*         DB$SCHD IS CALLED WHILE WAITING FOR THE LOCK TO BE ASSIGNED.
*         WHEN THE LOCK IS OBTAINED CONTROL IS RETURNED WITH
*         LOKSTATUS = FALSE.
*         THE FALSE STATUS FORCES A RE-READ OF THE RECORD.
* 
 #
      ALTX = LOC(OFALT[0]); 
      FOR ALTX=ALTX WHILE ALNEXT[ALTX] NQ 0 DO
        BEGIN 
        ALTX = ALNEXT[ALTX];
        IF KEYEQUAL 
          AND NOT ALLOCK[ALTX]
        THEN
          BEGIN 
          WQUEUE = TRUE;
  
 WAITKEY: 
          IF ALTQT[ALTX] EQ LOC(TQT)
          THEN
            BEGIN 
                             # THIS RECORD WAS LOCKED PREVIOUSLY BY    #
                             # THE SAME USER.  IT IS NOT THE RECORD    #
                             # MOST RECENTLY LOCKED.                   #
  
                             # ALTERNATELY THIS LOCK MAY BE AN AREA    #
                             # LOCK SET VIA A BASIC AREA CONTROL BLOCK #
                             # AND OUR RECORD LOCK REQUEST IS FROM     #
                             # DB$CPRO VIA AN EXTENDED AREA CONTROL    #
                             # BLOCK.                                  #
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("LOK-R3A"); 
            CONTROL ENDIF;
  
            RETURN; 
  
            END 
          IF FPFITPD[0] LS 2
            AND NOT ALEXCL[ALTX]
          THEN
            BEGIN 
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("LOK-R3B"); 
            CONTROL ENDIF;
  
            RETURN; 
  
            END 
          OWNER = FALSE;
          $BEGIN                   #DEBUG TRACE#
          XREF PROC DB$TRCT;
          DB$TRCT("WAIT LOCK=:",KEY,KL);
          $END
          IF NOT QUEUED  THEN 
            BEGIN 
            LOKSTATUS = FALSE;
  
            CONTROL IFGR DFFLOP,0;
              DB$FLOP("LOK-R4 ");      # GENERATE FLOW POINT - RETURN 4#
            CONTROL ENDIF;
  
            RETURN; 
  
            END 
  
          IF RCFUNC[0] EQ DFWR2 
              AND LOC(KEYBASE) EQ LOC(RCPPAKY2[0])
          THEN
            BEGIN                   # ON A WRITE FUNCTION              #
            FPFITES[0] = O"446";    # RETURN A DUPLICATE KEY ERROR     #
            DB$ERR(12); 
            END 
          ELSE
            BEGIN 
            IF TQIMRTN[0]    # IF IMMEDIATE RETURN IS SET              #
            THEN
              BEGIN 
              IF TQARTX[0] NQ 0 
              THEN           # IN TRANSACTION MODE                     #
                BEGIN        # BACK OUT THE TRANSACTION                #
                DB$UNDU;
                END 
              DB$LKRU(TRUE); # RELEASE ALL LOCKS FOR THIS RUN-UNIT     #
              DB$ERR(55);    # ERROR 603, LOCKED RECORD                #
              END 
            END 
# 
*         SAVE THE TQT ADDRESS OF THE LOCK HOLDER 
# 
          LTQT = ALTQT[ALTX]; 
          CREATEENTRY;
          DB$PUSH(DB$LOK);
          CHECKDEADLOK; 
  
          WAITLOCK;                # WAIT FOR THE LOCK TO BE ASSIGNED  #
  
          P<OFT> = RSAROFIT[0]; 
          P<FKL> = RSFFKLLOC[0];
          P<FPT> = LOC(FKL) + RSARFPT[0]; 
          DB$POP(DB$LOK); 
          LOKSTATUS = FALSE;
          RETURN; 
  
          END 
        END 
 #
*     IF THERE IS NO ENTRY FOR THE RECORD IN THE LOCK QUEUE 
*     THEN CHECK FOR AN AREA LOCK.
*     IF THE AREA IS LOCKED, DO ONE OF THE ABOVE ACTIONS, 
*       EXCEPT IF AN ALT IS BUILT IT IS PLACED IN THE LOCK QUEUE
*       INSTEAD OF THE WAIT QUEUE.
 #
      WQUEUE = FALSE;              # BUILD A LOCK QUEUE MEMBER         #
      IF OFALT[0] NQ 0
        AND ALLOCK[OFALT[0]]
        AND ALOWNER[OFALT[0]] 
      THEN                         # THERE IS AN AREA LOCK             #
        BEGIN 
        ALTX = OFALT[0];
        GOTO WAITKEY;              # WAIT FOR THE LOCK                 #
  
        END 
 #
* 
*     WHEN THERE ARE NO CONFLICTING AREA OR RECORD LOCKS
*     CREATE A LOCKED ALT IN THE LOCK QUEUE, UNLESS THE AREA IS OPENED
*     FOR READ ONLY.
*     RETURN LOKSTATUS = TRUE.
 #
      OWNER = TRUE; 
      IF FPFITPD[0] GR 1
      THEN                   # NOT READ ONLY                           #
        BEGIN 
        CREATEENTRY;
        END 
      $BEGIN                       #DEBUG TRACE#
      DB$TRCT("LOCK=:",KEY,KL); 
      $END
      RETURN; 
  
  
  
#**********************************************************************#
#                                                                      #
#     E M B E D D E D   P R O C E D U R E   -   D B $ L O K A .        #
#                                                                      #
#**********************************************************************#
  
      PROC DB$LOKA(EXCL); 
      BEGIN 
 #
* *   DB$LOKA -- LOCK ENTIRE AREA                PAGE  1
* *   C O GIMBER                                 4/28/76
* 
* DC  PURPOSE 
* 
*     THIS ROUTINE IS CALLED WHEN IT IS DESIRED TO LOCK AN ENTIRE 
*     AREA. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM EXCL B;           # TRUE FOR EXCLUSIVE LOCK                 #
                             # FALSE FOR PROTECTIVE LOCK               #
# 
* D   ASSUMPTIONS 
* 
*     P<RSARBLK> IS SET.
* 
* DC  EXIT CONDITIONS 
* 
*     P<RSARBLK> IS SET.
* 
* DC  CALLED ROUTINES 
* 
*     DB$FLOP                GRENERATE A FLOW POINT 
 #
  
  
  
#     B E G I N   D B $ L O K A   E X E C U T A B L E   C O D E .      #
  
  
 #
* DC  DESCRIPTION 
* 
*     -----THIS ROUTINE IS PART OF DB$LOK-----
* 
*     CHECK IF ANY EXISTING RECORD LOCKS. 
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("LOKA   ");        # GENERATE FLOW POINT - ENTRY       #
      CONTROL ENDIF;
  
      P<OFT> = RSAROFIT[0]; 
      P<FKL> = RSFFKLLOC[0];
      P<FPT> = LOC(FKL) + RSARFPT[0]; 
      IF RSARALT[0] NQ 0
      THEN
        BEGIN 
        ALTX = RSARALT[0];
        IF ALTX LS 0
        THEN                       # RSARALT IS AN INDIRECT POINTER    #
          BEGIN 
          ALTX = RSFALT[-ALTX]; 
          END 
  
        IF NOT ALLOCK[ALTX] 
        THEN
          BEGIN 
          DB$LOKD(TRUE);
          DB$ERR(62); 
          END 
        ELSE
          BEGIN 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("LOKA-R1");    # GENERATE FLOW POINT - RETURN 1    #
          CONTROL ENDIF;
  
          RETURN; 
  
          END 
        END 
 #
*     SET QUEUED FLAG TRUE SO RETURN WILL NOT BE DONE UNTIL 
*     LOCK CAN BE PERFORMED.
 #
      KEYLOC = 0; 
      QUEUED = TRUE;
      KL = 0; 
      ALTX = LOC(OFALT[0]); 
 #
*     IF THERE IS NO LOCK QUEUE, THE AREA LOCK IS GIVEN IMMEDIATELY.
 #
      WQUEUE = FALSE; 
      IF OFALT[0] EQ 0
      THEN
        BEGIN 
        OWNER = TRUE; 
        CREATEENTRY;
        ALEXCL[ALTX] = EXCL;
        $BEGIN
        DB$TRCT("AREA LOCK:",0,0);
        $END
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LOKA-R2");      # GENERATE FLOW POINT - RETURN 2    #
        CONTROL ENDIF;
  
        RETURN; 
  
        END 
 #
*     IF THERE IS A LOCK QUEUE, THE AREA LOCK WILL HAVE TO WAIT.
*     IF THERE IS AN AREA LOCK, THIS ONE IS PLACED IN THE WAIT QUEUE. 
*       IF IMMEDIATE RETURN IS SET FOR THE USER, THEN RELEASE LOCKS AND 
*       ISSUE A NON-FATAL ERROR. OTHERWISE, ADD ENTRY AT END OF FIRST 
*       ENTRY IN WAIT QUEUE.
 #
        BEGIN 
        IF TQIMRTN[0]        # IF IMMEDIATE RETURN IS SET              #
        THEN
          BEGIN 
          DB$LKRU(TRUE);     # RELEASE ALL LOCKS FOR THIS RUN-UNIT     #
          DB$ERR(55); 
          END 
        END 
      OWNER = FALSE;
      IF ALLOCK[OFALT[0]]                                               000290
      THEN
        BEGIN 
        ALTX = OFALT[0];                                                000320
        WQUEUE = TRUE;
        END 
# 
*     SAVE THE TQT ADDRESS OF THE LOCK HOLDER.
# 
      LTQT = ALTQT[OFALT[0]]; 
      CREATEENTRY;
      ALEXCL[ALTX] = EXCL;
      DB$PUSH(DB$LOKA); 
      CHECKDEADLOK; 
  
      P<FKL> = RSFFKLLOC[0];
      P<FPT> = LOC(FKL) + RSARFPT[0]; 
      WAITLOCK;                    # WAIT FOR THE LOCK TO BE ASSIGNED  #
  
      DB$POP(DB$LOKA);
      RETURN; 
  
      END 
  
  
#**********************************************************************#
#                                                                      #
#     E M B E D D E D   P R O C E D U R E   -   D B $ L O K D .        #
#                                                                      #
#**********************************************************************#
  
      PROC DB$LOKD(AREAFLAG); 
      BEGIN 
 #
* *   DB$LOKD -- DELETE LOCK ENTRY               PAGE  1
* *   C O GIMBER                                 4/28/76
* *   D E TRIGLIA                                DATE  1/24/80
* 
* DC  PURPOSE 
* 
*     DELETE LOCK IF ANY ON CURRENT AREA (OFT). 
* 
* DC  ENTRY CONDITIONS
* 
*     P<RSARBLK> IS SET.
*     PARAMETERS
# 
      ITEM AREAFLAG B;       #TRUE IF AREA LOCK IS TO BE DELETED# 
                             #FALSE IF ONLY KEY LOCK IS TO BE DELETED#
# 
* 
* DC  EXIT CONDITIONS 
* 
*     P<RSARBLK> IS SET.
*     ANY RECORD LOCK IN THIS AREA FOR THIS USER IS DELETED.
*     AN AREA LOCK IS DELETED IF AREAFLAG IS TRUE.
 #
  
  
  
#     B E G I N   D B $ L O K D   E X E C U T A B L E   C O D E .      #
  
  
 #
* 
* DC  DESCRIPTION 
* 
*     -----THIS ROUTINE IS PART OF DB$LOK-----
* 
*     NO LOCKS ARE RELEASED DURING A BEGIN/COMMIT TRANSACTION SEQUENCE. 
*     MULTIPLE RECORDS CAN BE LOCKED BY THE USER DURING A TRANSACTION.
* 
*     IF THERE ARE NO LOCKS OR IF WITHIN A BEGIN/COMMIT SEQUENCE
*     THEN RETURN.
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("LOKD   ");            # GENERATE FLOW POINT - ENTRY   #
      CONTROL ENDIF;
  
      P<OFT> = RSAROFIT[0]; 
      ALTX = RSARALT[0];
      IF ALTX LS 0
      THEN                         # RSARALT IS AN INDIRECT POINTER    #
        BEGIN 
        ALTX = RSFALT[-ALTX]; 
        END 
  
      IF ALTX EQ 0
        OR TQARTX[0] NQ 0 
      THEN
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
        DB$FLOP("LOKD-R1");            # GENERATE FLOW POINT - RETURN 1#
        CONTROL ENDIF;
  
        RETURN; 
  
        END 
 #
*     IF AREA LOCK AND AREAFLAG NOT SET THEN RETURN.
 #
      ALTX = RSARALT[0];
      IF ALTX LS 0
      THEN                         # RSARALT IS AN INDIRECT POINTER    #
        BEGIN 
        ALTX = RSFALT[-ALTX]; 
        END 
      IF ALLOCK[ALTX] AND NOT AREAFLAG THEN 
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LOKD-R2");          # GENERATE FLOW POINT - RETURN 2#
        CONTROL ENDIF;
  
        RETURN; 
  
        END 
 #
* 
*     *******  START OF LOOP TO RELEASE MULTIPLE RECORD LOCKS  *******
* 
 #
      TRSALT = RSARALT[0];
      IF TRSALT LS 0
      THEN                         # RSARALT IS AN INDIRECT POINTER    #
        BEGIN 
        TRSALT = RSFALT[-TRSALT]; 
        RSFALT[-RSARALT[0]] = 0;
        ORIGIN = LOC(RSFALT[-RSARALT[0]]);
        END 
      ELSE
        BEGIN 
        RSARALT[0] = 0; 
        ORIGIN = LOC(RSARALT[0]); 
        END 
  
      FOR ALTX = ALTX WHILE TRSALT NQ 0 
      DO
      BEGIN 
      ALTX = TRSALT;
      TRSALT = ALUFNEXT[ALTX];
 #
*     IF THE REQUESTING RCB HAS PERMISSION FOR MULTIPLE LOCKS,
*     IT SHOULD NOT BE ALLOWED TO DROP ANY LOCKS THAT IT DID NOT SET. 
 #
      IF RCMLOK[0] AND NOT ALMLOK[ALTX] 
      THEN
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LOKD-T1"); 
        CONTROL ENDIF;
  
        IF ORIGIN EQ 0
        THEN                 # THERE CAN BE ONLY ONE LOCK W/O ALMLOK   #
          BEGIN 
          DB$PUNT("DB$LOKD 1"); 
          END 
        ALNEXT[ORIGIN] = ALTX;
        ALUFNEXT[ALTX] = 0; 
        ORIGIN = 0; 
        TEST ALTX;           # TEST FOR MORE ALTS                      #
  
        END 
 #
*     IF IN ALT WAIT QUEUE THEN 
*       DELINK ENTRY. 
*     TEST FOR ANOTHER RECORD LOCK TO RELEASE.
 #
      IF ALPRIOR[ALTX] EQ 0 
      THEN
        BEGIN 
        $BEGIN                     #DEBUG TRACE#
        DB$TRCT("DEL WAIT KEY:",0,0); 
        $END
        ALWNEXT[ALWPRIOR[ALTX]] = ALWNEXT[ALTX];
        ALWPRIOR[ALWNEXT[ALTX]] = ALWPRIOR[ALTX]; 
        IF ALLONG[ALTX] 
        THEN
          BEGIN              # RETURN LONG ALTS TO CMM                 #
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("LOKD-C1");        # GENERATE FLOW POINT - COMPASS1#
          CONTROL ENDIF;
  
          DB$MFF(ALTX); 
          END 
        ELSE
          BEGIN              # SAVE ENTRY IN LIST OF IDLE ALTS         #
          NEXTIDL[ALTX] = IDLEALTP; 
          IDLEALTP = ALTX;
          BLKAGE[ALTX] = TIMESTAMP; 
          END 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LOKD-R3");          # GENERATE FLOW POINT - RETURN 3#
        CONTROL ENDIF;
  
        TEST ALTX;
        END 
 #
*     IF LOCK QUEUE MEMBER HAS NO WAIT QUEUE THEN DELINK IT.
 #
      IF ALWNEXT[ALTX] EQ ALTX
      THEN
        BEGIN 
        $BEGIN                     #DEBUG TRACE#
        DB$TRCT("DEL LOCK:",0,0); 
        $END
        IF ALLONG[ALTX] 
        THEN
          BEGIN              # RETURN LONG ALTS TO CMM                 #
          DB$LNKD(ALTX);
          END 
        ELSE
          BEGIN              # SAVE STANDARD SIZED ALTS                #
          DB$LNKS(ALTX,IDLEALTP); 
          END 
        END 
      ELSE
 #
*       IF THERE IS A WAIT QUEUE, ADVANCE THE NEXT MEMBER.
 #
        BEGIN 
        $BEGIN                     #DEBUG TRACE#
        DB$TRCT("DEL KEY LOCK WITH WAIT ENTRY:",0,0); 
        $END
        ALTW = ALWNEXT[ALTX]; 
  
        # LINK THE NEXT WAIT QUEUE BLOCK INTO THE LOCK QUEUE.          #
  
        ALPRIOR[ALTW] = ALPRIOR[ALTX];
        ALNEXT[ALPRIOR[ALTW]] = ALTW; 
        ALNEXT[ALTW] = ALNEXT[ALTX];
        IF ALNEXT[ALTW] NQ 0 THEN 
          ALPRIOR[ALNEXT[ALTW]] = ALTW; 
  
        # DELINK THE OLD BLOCK FROM THE WAIT QUEUE.                    #
  
        ALWPRIOR[ALTW] = ALWPRIOR[ALTX];
        ALWNEXT[ALWPRIOR[ALTW]] = ALTW; 
        IF ALLONG[ALTX] 
        THEN
          BEGIN              # RETURN LONG ALTS TO CMM                 #
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("LOKD-C2");        # GENERATE FLOW POINT - COMPASS2#
          CONTROL ENDIF;
  
          DB$MFF(ALTX); 
          END 
        ELSE
          BEGIN              # SAVE ENTRY IN LIST OF IDLE ALTS         #
          NEXTIDL[ALTX] = IDLEALTP; 
          IDLEALTP = ALTX;
          BLKAGE[ALTX] = TIMESTAMP; 
          END 
        END 
 #
* 
*     *******  END OF LOOP TO RELEASE MULTIPLE RECORD LOCKS  *******
* 
 #
      END 
 #
*     EVALUATE THE REMAINING LOCK QUEUE.
*       IF THERE IS STILL AN AREA LOCK WITH OWNER FLAG, 
*         THEN NO FURTHER CHANGE IS REQUIRED. 
 #
      IF OFALT[0] EQ 0
      THEN
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP("LOKD-R4");      # GENERATE FLOW POINT - RETURN 4    #
        CONTROL ENDIF;
  
        RETURN;                    # NO LOCK ENTRIES ARE LEFT          #
  
        END 
      ALTX = OFALT[0];
      IF ALLOCK[ALTX] 
      THEN
        BEGIN 
        IF ALOWNER[ALTX]
        THEN
          BEGIN 
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("LOKD-R5");    # GENERATE FLOW POINT - RETURN 5    #
          CONTROL ENDIF;
  
          RETURN;                  # NO CHANGE OF STATUS IN AREA LOCK  #
  
          END 
        IF ALNEXT[ALTX] EQ 0
        THEN                       # THERE ARE NO KEY LOCKS WAITING    #
          BEGIN 
          ALOWNER[ALTX] = TRUE;    # SET THE AREA LOCK                 #
          TQALT[ALTQT[ALTX] - LOC(TQT)] = 0;
  
          CONTROL IFGR DFFLOP,0;
            DB$FLOP("LOKD-R6");    # GENERATE FLOW POINT - RETURN 6    #
          CONTROL ENDIF;
  
          RETURN; 
  
          END 
        ALTX = ALNEXT[ALTX];       # SKIP PAST THE AREA LOCK           #
        END 
      FOR ALTX = ALTX WHILE ALTX NQ 0 
      DO
        BEGIN 
        IF NOT ALOWNER[ALTX]
        THEN
          BEGIN 
#                                                                      #
#         GIVE THE LOCK TO THE FIRST ALT IN THE WAIT QUEUE THAT HAS    #
#         BEEN SKIPPED OVER ENOUGH TIMES OR WHOSE USER IS CURRENTLY    #
#         SWAPPED IN. IF NO SUCH ALT EXISTS, GIVE THE LOCK TO          #
#         THE ALT IN THE LOCK QUEUE. IF THERE IS NO WAIT QUEUE,        #
#         GIVE THE LOCK TO THE ALT IN THE LOCK QUEUE WITHOUT CALLING   #
#         GIVELOCK.                                                    #
#                                                                      #
          IF ALWNEXT [ALTX] NQ ALTX     # TRUE IF THERE IS A WAIT QUEUE#
          THEN
            GIVELOCK; 
          ALOWNER[ALTX] = TRUE;    #SET ALL KEY LOCKS IN THE LOCK QUEUE#
          TQALT[ALTQT[ALTX] - LOC(TQT)] = 0;
          END 
        ALTX = ALNEXT[ALTX];
        END 
      END 
  
  
#**********************************************************************#
#                                                                      #
#     E M B E D D E D   P R O C E D U R E   -   D B $ L O K T .        #
#                                                                      #
#**********************************************************************#
  
      PROC DB$LOKT((KEYLOC)); 
      BEGIN 
 #
* *   DB$LOKT -- LOCK TEST FUNCTION              PAGE  1
* *   C O GIMBER                                 4/28/79
* 
* DC  PURPOSE 
* 
*     THIS ROUTINE ABORTS THE FUNCTION IF RECORD OR AREA NOT LOCKED.
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
# 
        ITEM KEYLOC;         #LOCATION OF KEY TO TEST#
# 
*     P<RSARBLK> IS SET.
* 
* DC  EXIT CONDITIONS 
* 
*     P<RSARBLK> IS SET.
 #
  
  
  
#     B E G I N   D B $ L O K T   E X E C U T A B L E   C O D E        #
  
  
 #
* DC  DESCRIPTION 
* 
*     -----THIS ROUTINE IS PART OF DB$LOK-----
* 
*     ERROR IF AREA NOT OPEN FOR OUTPUT.
 #
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP("LOKT   ");        # GENERATE FLOW POINT - ENTRY       #
      CONTROL ENDIF;
  
      P<FKL> = RSFFKLLOC[0];
      P<FPT> = LOC(FKL) + RSARFPT[0]; 
      IF B<1>FPFITPD[0] EQ 0 THEN 
        DB$ERR(58); 
 #
*     IF NOT LOCK ON RECORD, THEN ABORT FUNCTION. 
 #
      P<KEYBASE> = KEYLOC;
      KL = OFPRIKL[0];
      ALTX = RSARALT[0];
      IF ALTX LS 0
      THEN                         # RSARALT IS AN INDIRECT POINTER    #
        BEGIN 
        ALTX = RSFALT[-ALTX]; 
        END 
      IF ALTX EQ 0 THEN 
        BEGIN 
        DB$ERR(22); 
        RETURN; 
  
        END 
 #
*     IF THE USER DOES NOT HAVE THE RECORD OR THE AREA LOCKED,
*       ISSUE A NON-FATAL ERROR TO ABORT THE FUNCTION.
* 
*     IF NONE OF THE ABOVE ERRORS APPLY,
*       THEN IF WITHIN A BEGIN/COMMIT TRANSACTION SEQUENCE, 
*       CONVERT A PROTECTIVE RECORD LOCK TO AN EXCLUSIVE LOCK.
*     RETURN. 
 #
      IF NOT ALLOCK[ALTX] 
      THEN
        BEGIN 
        KEYOFFSET = 0;
  
        FOR ALTX = ALTX WHILE ALTX NQ 0 
        DO
          BEGIN              # SCAN MULTIPLE RECORD LOCKS FOR A MATCH  #
          IF KEYEQUAL 
          THEN
            BEGIN 
            IF TQARTX[0] NQ 0 
            THEN
              BEGIN 
              ALEXCL[ALTX] = TRUE;  # MAKE THE LOCK EXCLUSIVE          #
              END 
            RETURN; 
  
            END 
          ALTX = ALUFNEXT[ALTX];
          END 
        DB$ERR(59); 
        END 
      RETURN; 
  
      END 
  
      END 
      TERM; 
