.ad 8
.bm 8
.fm 4
.bt $Copyright by   SAP AG, 2001$$Page %$
.tm 12
.hm 6
.hs 3
.tt 1 $SQL$Project Distributed Database System$VBD77$
.tt 2 $$$
.tt 3 $TorstenS$tree_locklist$$2000-08-01$
***********************************************************
.nf
 
 
    ========== licence begin  GPL
    Copyright (C) 2000 SAP AG
 
    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License
    as published by the Free Software Foundation; either version 2
    of the License, or (at your option) any later version.
 
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
 
    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
    ========== licence end
 
.fo
.nf
.sp
Module  : tree_locklist
=========
.sp
Purpose : managing locks on trees and leaves
.CM *-END-* purpose -------------------------------------
.sp
.cp 3
Define  :
 
        VAR
              b77locklist : tbd7_locklist_array;
 
        FUNCTION
              b77anyleaf_write_locks (VAR root_desc : tbd7_root_desc)
                    : boolean;
 
        PROCEDURE
              b77conv_lock_to_req (
                    pid             : tsp00_TaskId;
                    VAR root_desc   : tbd7_root_desc;
                    lockstate       : tbd_treelock;
                    excl_lock_exist : boolean);
 
        PROCEDURE
              b77delete_lockentry (pid : tsp00_TaskId;
                    VAR root_desc : tbd7_root_desc;
                    VAR leaf      : tsp00_PageNo;
                    indexnode     : tsp00_PageNo;
                    lockstate     : tbd_treelock);
 
        PROCEDURE
              b77dump_locklist (VAR hostfile : tgg00_VfFileref;
                    VAR buf       : tsp00_Page;
                    VAR dump_pno  : tsp00_Int4;
                    VAR pos       : integer;
                    VAR hosterror : tsp00_VfReturn;
                    VAR errtext   : tsp00_ErrText);
 
        FUNCTION
              b77excl_using_root (VAR root_desc : tbd7_root_desc;
                    pid : tsp00_TaskId) : boolean;
 
        FUNCTION
              b77exist_lock_within_subtree (
                    pid           : tsp00_TaskId;
                    VAR root_desc : tbd7_root_desc;
                    indexnode     : tsp00_PageNo): boolean;
 
        FUNCTION
              b77first_lock (VAR root_desc : tbd7_root_desc;
                    VAR root_ptr : tbd7_entry_ptr) : boolean;
 
        PROCEDURE
              b77index_check (VAR current : tbd_current_tree;
                    VAR root_desc : tbd7_root_desc);
 
        PROCEDURE
              b77index_or_leaf_writers (VAR root_desc : tbd7_root_desc;
                    pid             : tsp00_TaskId;
                    VAR index_found : boolean;
                    VAR leaf_found  : boolean);
 
        PROCEDURE
              b77init_tree_locklist (partition : integer;
                    VAR alloc_sum : tsp00_Int4;
                    VAR e         : tgg00_BasisError);
 
        PROCEDURE
              b77insert_lockentry (pid : tsp00_TaskId;
                    VAR root_desc : tbd7_root_desc;
                    leaf          : tsp00_PageNo;
                    lockstate     : tbd_treelock;
                    ignore_svp    : boolean);
 
        FUNCTION
              b77is_empty_locklist (VAR root_desc : tbd7_root_desc)
                    : boolean;
 
        FUNCTION
              b77leaf_in_locklist (VAR root_desc : tbd7_root_desc;
                    leaf : tsp00_PageNo;
                    pid  : tsp00_TaskId) : boolean;
 
        PROCEDURE
              b77liconv_to_index_lock (VAR root_desc : tbd7_root_desc;
                    pid       : tsp00_TaskId;
                    indexnode : tsp00_PageNo;
                    lockstate : tbd_treelock);
 
        FUNCTION
              b77lleaf_in_locklist (VAR root_desc : tbd7_root_desc;
                    leaf      : tsp00_PageNo;
                    lockstate : tbd_treelock;
                    pid       : tsp00_TaskId) : boolean;
 
        PROCEDURE
              b77show_treelocklist (VAR current : tbd_current_tree;
                    VAR rec_count : tsp00_Int4;
                    partition     : integer);
 
        FUNCTION
              b77stree_in_locklist (VAR root_desc : tbd7_root_desc)
                    : boolean;
 
        FUNCTION
              b77tree_in_locklist (VAR root_desc : tbd7_root_desc)
                    : boolean;
 
        PROCEDURE
              b77lconv_to_leaf (pid : tsp00_TaskId;
                    VAR root_desc : tbd7_root_desc;
                    leaf          : tsp00_PageNo;
                    indexnode     : tsp00_PageNo;
                    lockstate     : tbd_treelock);
&       ifdef TRACE
 
        PROCEDURE
              b77pointer_check (pointer : tbd7_entry_ptr;
                    root : tsp00_PageNo);
 
        PROCEDURE
              b77print_tree_locklist;
&       endif
 
        PROCEDURE
              b77reset_lock (pid  : tsp00_TaskId;
                    VAR root_desc    : tbd7_root_desc;
                    VAR old_locktype : tbd_treelock);
 
        PROCEDURE
              b77root_description (root : tsp00_PageNo;
                    VAR root_desc : tbd7_root_desc);
 
        PROCEDURE
              b77set_not_generated;
 
        PROCEDURE
              b77tconv_to_tree (pid : tsp00_TaskId;
                    VAR root_desc : tbd7_root_desc;
                    leaf          : tsp00_PageNo;
                    lockstate     : tbd_treelock);
 
        PROCEDURE
              b77check_locklist (VAR root_desc : tbd7_root_desc);
 
        PROCEDURE
              b77check_whole_locklist (Partition : integer);
 
        PROCEDURE
              b77pid_check (pid : tsp00_TaskId;
                    root : tsp00_PageNo);
 
        FUNCTION
              b77write_index_locked (VAR root_desc : tbd7_root_desc;
                    indexnode      : tsp00_PageNo) : boolean;
 
.CM *-END-* define --------------------------------------
.sp;.cp 3
Use     :
 
        FROM
              concurrency : VBD75;
 
        VAR
              b75region_cnt : tsp00_Int4;
 
      ------------------------------ 
 
        FROM
              tree_requestlist : VBD76;
 
        FUNCTION
              b76last_request (pointer : tbd7_entry_ptr)
                    : tbd7_entry_ptr;
&       ifdef TRACE
 
      ------------------------------ 
 
        FROM
              Test_Procedures : VTA01;
 
        PROCEDURE
              t01addr (debug : tgg00_Debug;
                    nam     : tsp00_Sname;
                    pointer : tbd7_entry_ptr);
 
        PROCEDURE
              t01bool (debug : tgg00_Debug;
                    nam : tsp00_Sname;
                    boo : boolean);
 
        PROCEDURE
              t01int4 (layer : tgg00_Debug;
                    nam : tsp00_Sname;
                    int : tsp00_Int4);
 
        PROCEDURE
              t01treeid (debug : tgg00_Debug;
                    nam : tsp00_Sname;
                    VAR treeid : tgg00_FileId);
 
        PROCEDURE
              t01p2int4 (debug : tgg00_Debug;
                    name_1 : tsp00_Sname;
                    int_1  : tsp00_Int4;
                    name_2 : tsp00_Sname;
                    int_2  : tsp00_Int4);
 
        FUNCTION
              t01trace (debug : tgg00_Debug) : boolean;
&       endif
 
      ------------------------------ 
 
        FROM
              filesysteminterface_1 : VBD01;
 
        VAR
              b01downfilesystem : boolean;
 
      ------------------------------ 
 
        FROM
              filesysteminterface_7 : VBD07;
 
        PROCEDURE
              b07cadd_record (VAR t : tgg00_TransContext;
                    VAR file_id : tgg00_FileId;
                    VAR b       : tgg00_Rec);
 
      ------------------------------ 
 
        FROM
              Configuration_Parameter : VGG01;
 
        VAR
              g01glob : tgg_kernel_globals;
 
        PROCEDURE
              g01allocate_msg (msg_label : tsp_c8;
                    msg_text   : tsp_c24;
                    alloc_size : tsp_int4);
 
        PROCEDURE
              g01abort (msg_no : tsp_int4;
                    msg_label  : tsp_c8;
                    msg_text   : tsp_c24;
                    bad_value  : tsp_int4);
 
        FUNCTION
              g01CacheSize : tsp00_Int4;
 
        PROCEDURE
              g01check (msg_no : tsp_int4;
                    msg_label  : tsp_c8;
                    msg_text   : tsp_c24;
                    bad_value  : tsp_int4;
                    constraint : boolean);
 
        FUNCTION
              g01maxuser : tsp_int4;
 
        FUNCTION
              g01maxservertask : tsp_int4;
 
        PROCEDURE
              g01next_prim_number (VAR prim_int : tsp_int4);
 
        PROCEDURE
              g01new_dump_page (VAR hostfile : tgg_vf_fileref;
                    VAR buf      : tsp_page;
                    VAR out_pno  : tsp_int4;
                    VAR out_pos  : integer;
                    VAR host_err : tsp_vf_return;
                    VAR errtext  : tsp_errtext);
 
      ------------------------------ 
 
        FROM
              Kernel_move_and_fill : VGG10;
 
        PROCEDURE
              g10mv   (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4; destin_upb : tsp_int4;
                    VAR source     : tsp_c8;   source_pos : tsp_int4;
                    VAR destin     : tsp_page; destin_pos : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv1  (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;           destin_upb : tsp_int4;
                    VAR source     : tbd7_locklistentry; source_pos : tsp_int4;
                    VAR destin     : tsp_page;           destin_pos : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv2  (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;       destin_upb : tsp_int4;
                    VAR source     : tbd7_entry_ptr; source_pos : tsp_int4;
                    VAR destin     : tsp_page;       destin_pos : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
        PROCEDURE
              g10mv3  (mod_id      : tsp_c6;
                    mod_intern_num : tsp_int4;
                    source_upb     : tsp_int4;  destin_upb : tsp_int4;
                    VAR source     : tsp_sname; source_pos : tsp_int4;
                    VAR destin     : tsp_buf;   destin_pos : tsp_int4;
                    length         : tsp_int4;
                    VAR e          : tgg_basis_error);
 
      ------------------------------ 
 
        FROM
              RTE_kernel : VEN101;
 
        PROCEDURE
              vallocat (length : tsp_int4;
                    VAR p      : tsp_objaddr;
                    VAR ok     : boolean);
 
        PROCEDURE
              vprio (pid     : tsp_process_id;
                    prio     : tsp_int1;
                    set_prio : boolean);
 
      ------------------------------ 
 
        FROM
              RTE-Extension-20 : VSP20;
 
        PROCEDURE
              s20ch4 (val      : tsp_int4;
                    VAR destin : tsp_page;
                    di         : tsp_int4);
 
        PROCEDURE
              s20ch4a (val     : tsp_int4;
                    VAR destin : tsp_page;
                    di         : tsp_int4);
 
        PROCEDURE
              s20ch4b (val     : tsp_int4;
                    VAR destin : tsp_buf;
                    di         : tsp_int4);
 
        PROCEDURE
              s20ch4l (val      : tsp_int4;
                    VAR destin  : tsp_buf;
                    di          : tsp_int4);
 
.CM *-END-* use -----------------------------------------
.sp;.cp 3
Synonym :
 
        PROCEDURE
              g10mv;
 
              tsp_moveobj tsp_c8
              tsp_moveobj tsp_page
 
        PROCEDURE
              g10mv1;
 
              tsp_moveobj tbd7_locklistentry
              tsp_moveobj tsp_page
 
        PROCEDURE
              g10mv2;
 
              tsp_moveobj tbd7_entry_ptr
              tsp_moveobj tsp_page
 
        PROCEDURE
              g10mv3;
 
              tsp_moveobj tsp_sname
              tsp_moveobj tsp_buf
 
        PROCEDURE
              s20ch4;
 
              tsp_moveobj tsp_page
 
        PROCEDURE
              s20ch4a;
 
              tsp_moveobj tsp_page
              tsp_int4 tsp_process_id
 
        PROCEDURE
              s20ch4b;
 
              tsp_moveobj tsp_buf
              tsp_int4 tsp_process_id
 
        PROCEDURE
              s20ch4l;
 
              tsp_moveobj tsp_buf
&             ifdef TRACE
 
        PROCEDURE
              t01addr;
 
              tsp00_BufAddr tbd7_entry_ptr
&             endif
 
.CM *-END-* synonym -------------------------------------
.sp;.cp 3
Author  : TorstenS
.sp
.cp 3
Created : 1982-02-19
.sp
.cp 3
Version : 2001-04-18
.sp
.cp 3
Release :      Date : 2000-08-01
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
 
Specification:
 
.sp;.cp 6
B77ANYLEAF_WRITE_LOCKS
.sp
This function checks whether there are any w_lock_leaf lockentries
on a B* tree. The B* tree is identified by ROOT_DESC. If such
a lockentry exists the function provides TRUE; otherwise FALSE.
 
.sp;.cp 10
B77CONV_LOCK_TO_REQ
.sp
This procedure converts either a locked r_lock_tree to a requested
s_lock_tree, a locked w_lock_leaf to a requested w_lock_tree or a
locked w_lock_index to a requested w_lock_tree.
The destination lock is identified by the parameter lockstate.
Note that this will not affect the position of the entry within
the chain, but it makes a reorganization of the next-request and
next-lock chain necessary.
 
.sp;.cp 9
B77DELETE_LOCKENTRY
.sp
This procedure removes a lockentry from the treelocklist. The lock-
entry is identified by PID and ROOT_DESC and according to the lockstate
additional LEAF. If the lockstate is r_lock_tree then the procedure
provides the leaf (output paramter LEAF) which was locked. The state
that the lockstate is r_lock_tree and the leaf is not equal to
NIL_PAGE_NO_GG00 occurs when a reset lock on a leaf was executed.
 
.sp;.cp 6
B77DUMP_LOCKLIST
.sp
This procedure writes the global structure of the treelocklist into
the kerneldumpfile. The format of the dumpfile is described below
this section. Note that the dump always starts at the top of a new
page and at the end a non full dump page is filled with a fillchar,
so that the following dumpinformation always starts on the top of a
new page too.
 
 
.sp;.cp 6
B77EXCL_USING_ROOT
.sp
This function checks whether there are any lockentries from other
users on a certain tree identified by ROOT_DESC. IF there are no
locks from other users then the function provides true.
 
.sp;.cp 10
B77EXIST_LOCK_WITHIN_SUBTREE
.sp
This function checks whether there are any lockentries on a certain
subtree identified by INDEXNODE and ROOT_DESC and the 'owner' is
different from PID. Note that only the
following lockstates are recognized: r_lock_leaf, w_lock_leaf, s_lock_tree,
r_lock_index and w_lock_index. The following lockstates are ignored
r_lock_tree, w_lock_tree and d_lock_tree. True is
provided, if any lockentries are found.
 
.sp;.cp 6
B77FIRST_LOCK
.sp
This function provides in ROOT_PTR a pointer which references
the first lockentry of ROOT_DESC. IF no lockentry is found the
function returns false otherwise true.
 
.sp;.cp 8
B77INDEX_OR_LEAF_WRITERS
.sp
This procedure checks whether there are any w_lock_leaf and
w_lock_index lockentries from other users (not equal PID) on
a B*tree. The B*tree is identified by ROOT_DESC. INDEX_FOUND
is true, when an w_lock_index lockentry is found and LEAF_FOUND
is true, if a w_lock_leaf is found.
 
.sp;.cp 6
B77INIT_TREE_LOCKLIST
.sp
This procedure generates and initializes the treelocklist and
therefore it must be called during system generation and for
each system restart. If in the generation phase is not enought
storage available then an error will be provided.
 
.sp;.cp 8
B77INSERT_LOCKENTRY
.sp
This procedure inserts a lockentry into the treelocklist in
consideration of the ascending order of the horizontal single
chained list and the vertical double chained list relative to
the ROOT respectively the LEAF. Note that the procedure causes
a vabort if there is not enought storage storage in the treelocklist!
 
.sp;.cp 6
B77IS_EMPTY_LOCKLIST
.sp
This function checks whether there is a lockentry on a
B* tree, independent on a certain lockstate. The tree is
identified by ROOT_DESC. If a lockentry exists the function
provides FALSE; otherwise TRUE.
 
.sp;.cp 6
B77LEAF_IN_LOCKLIST
.sp
This function checks whether there is a lockentry with lockstate
r_lock_leaf or w_lock_leaf on a LEAF and the 'owner' doesn't
agree with PID. If such a lockentry exists the function provides
TRUE.
 
.sp;.cp 9
B77LICONV_TO_INDEX_LOCK
.sp
This procedure converts either a r_lock_tree to a r_lock_index,
a w_lock_leaf to a w_lock_index or a r_lock_index to a r_lock_index.
The destination lock is identified by LOCKSTATE. The locked indexnode
is specified by INDEXNODE. Note that this neither will affect the
position of the lockentry within the chain nor the next-lock chain!
 
.sp;.cp 6
B77LLEAF_IN_LOCKLIST
.sp
This function checks whether there is a lockentry with lockstate
r_lock_leaf or w_lock_leaf (dependent on the paramter lockstate)
on a LEAF and the 'owner' doesn't agree with PID. If such a
lockentry exists the function provides TRUE.
 
.sp;.cp 11
B77LCONV_TO_LEAF
.sp
This procedure converts a r_lock_tree lockentry to a r_lock_leaf,
a r_lock_tree to a w_lock_leaf or a r_lock_leaf to another r_lock_leaf,
whereby the paramter LOCKSTATE identifies the new lockstate and LEAF
the locked leaf. INDEXNODE specifies the indexnode of the locked leaf.
If INDEXNODE is equal to cbd7_dummy_index then a existing index within
the lockentry is unchanged. Note that the transformation will affect the
position of the lockentry within the vertical double chain list and
the next-lock chain independent on INDEXNODE!
 
.sp;.cp 8
B77POINTER_CHECK
.sp
This procedure verifies whether a pointer realy references an entry
within the treelocklist. If an error occurs then a message is written
into the vtrace and the opmsg3. Finaly a vabort is performed. Note
that this facility is only available in the slow system and besides
very expensive.
 
.sp;.cp 11
B77RESET_LOCK
.sp
This procedure resets a lock on a B*tree, i.e. the present lock
(w_lock_tree, w_lock_leaf, r_lock_leaf or s_lock_tree) will be
converted into a r_lock_tree. If the present lock is on B* leaflevel
then LEAF specifies that leaf. Note that this is the reason for
a lockentry r_lock_tree with a leaf not equal to NIL_PAGE_NO_GG00.
The paramter OLD_LOCKTYPE contains the  old lockstate. The PID
is necessary to identify the lockentry.
 
.sp;.cp 21
B77ROOT_DESCRIPTION
.sp
This procedure provides the hashaddress and the position of all
matching entries for the given ROOT within the treelocklist.
If an entry with the same ROOT already exists then the components
of ROOT_DESC contains the following informations:
.sp
.nf
    RD_HASH     : hashaddress
    RD_PTR      : Pointer to the first entry, which accomplish the
                  search condition (i.e. same root)
    RD_PREV_PTR : Pointer to the previous entry, which has the same
                  hashaddress, but a smaller root!
    RD_EXIST    : True, because the entry exists.
    RD_ROOT     : proper number of the root
else
    RD_HASH     : hashaddress
    RD_PTR      : Pointer to NIL or to an entry with the same
                  hashaddress but a greater root.
    RD_PREV_PTR : Pointer to NIL or to an entry with the same
                  hashaddress but a smaller root.
    RD_EXIST    : False, because no entry exists.
    RD_ROOT     : proper number of the root
.sp
.fo
 
 
.sp;.cp 7
B77SET_NOT_GENERATED
.sp
This procedure is called during system initialization and
sets a flag which indicates that the treelocklist isn't
generated at this moment. (see B77INIT_TREE_LOCKLIST)
.sp
 
.sp;.cp 6
B77STREE_IN_LOCKLIST
.sp
This function checks whether there is a lockentry with lockstate
s_lock_tree on a B*tree which is identified by ROOT_DESC. If such an
entry exists the function provides TRUE; otherwise FALSE.
 
.sp;.cp 9
B77TCONV_TO_TREE
.sp
This procedure converts either a r_lock_tree to a s_lock_tree,
a w_lock_leaf to a w_lock_tree or a w_lock_index to a w_lock_tree.
The destination lock is identified by the parameter lockstate. In
the latter case additional the LEAF which was locked with a
w_lock_leaf is stored within the converted lockentry. Note that
this neither will affect the position of the lockentry within the chain nor the next-lock chain!
 
.sp;.cp 6
B77TREE_IN_LOCKLIST
.sp
This function checks whether there is a lockentry with lockstate
w_lock_tree or d_lock_tree on a B*tree which is identified by ROOT_DESC.
If such an entry exists the function provides TRUE; otherwise FALSE.
 
.sp;.cp 6
B77WRITE_INDEX_LOCKED
.sp
This function checks whether there is a lockentry with lockstate
w_lock_index on the INDEXNODE of a B*tree which is identified by
ROOT_DESC. If such an entry exists the function provides TRUE;
otherwise FALSE.
 
.CM *-END-* specification -------------------------------
.sp
***********************************************************
.sp
.cp 10
.fo
.oc _/1
Description:
.sp;.cp 25
The treelocklist management consists of a structure named
B77LOCKLIST which resides in the shared memory. This
administrative structure contains all necessary informations
to perform an access on the treelocklist.
In detail this is:
.sp
.nf
 - tll_generated       : indicates whether the storage for the
                         hashlist and the treelocklistentries
                         is already allocated.
 
 - tll_locklistsize    : this is the total number of entries
                         for locks and requests within the
                         treelocklist.
 
 - tll_hashsize        : this specifies the total number of slots
                         within the hashlist. Each slot contains
                         a pointer referencing an entry with a
                         special pagenumber.
 
 - tll_anchor          : this is a pointer on an array containing
                         references on lock- and requestentries.
 
 - tll_entry           : this is a pointer on an array containing
                         the proper lock- and requestentries.
 
 - tll_free_entry      : this is a pointer on an list of free
                         entries within the treelocklist.
 
 - tll_prevent_split   : this flag indicates whether it is allowed
                         to splitt a tree. During the savepointphase
                         it is necessary that no treesplitting will be
                         preformed. That will guarantee the structurelle
                         consistence of the database.
 
 - tll_split_counter   : this counter specifies the number of active
                         splittoperations (w_lock_tree). Only locked
                         entries are counted; no requests!
 
 - tll_pid_request     : this pid specifies the first task which tries
                         to perform a splittoperation during the
                         savepointphase. This task suspends itself and
                         will resume when the savepoint is completed.
 
 - tll_resume_counter  : this counter specifies the number of
                         splitt requests (d_lock_tree, w_lock_tree
                         or/and w_lock_index) in different B*trees,
                         which became runnable, but were not started,
                         because a savepoint was active. All these
                         tasks must be started explicite after the
                         savepointphase.
 
.sp;.cp 20
.fo
 
The illustration below describes the general layout of a
treelockentry, indepentend on lockmode. The pysical
layout is described in VBD007 with tbd7_lockentry.
 
.sp
.nf
    *----------------------*
    | R : root             | -> root of the B*tree
    | L : leaf             | -> leaf of the B*tree
    | P : pid              | -> 'owner' of the entry (tasknumber)
    | S : lockstate        | -> lockstate of the root or the leaf
    | M : mode             | -> is entry locked or requested
    | PO: prio_on          | -> has the task a special priority
    | RS: resume_after_svp | -> is there an w_lock_tree request,
    |                      |    which must be trigger after the
    |                      |    completion of the savepoint
    | ND: next_diff_root   | -> next entry with same hashaddress
    | NE: next_eq_root     | -> next entry with same root
    | PE: prev_eq_root     | -> previous entry with same root
    | NL: next_lock        | -> next lockentry within B*tree
    | NR: next_request     | -> next requestentry within B*tree
    | FR: first_request    | -> first requestentry within B*tree
    *----------------------*
.fo
.sp;.cp 45
The following example shows a typical situation within the
treelocklist. Note that not mentioned pointers are set to NIL.
.sp
.nf
 
   HASHTABLE  |                  TREELOCKLISTENTRIES
              |
              |
              |                                                       |
   *-----*        *-----------------*    ND       *-----------------* |
1  | nil |  *---> | R :  3          |------------>| R : 13          | |
2  | nil |  |     | L : 47          |   NR        | L : nil_page_no | |
3  | nil |  |     | P : 12          |<---*        | P : 11          | |
4  |x'a8'| -*  NL | S : w_lock_tree | FR |     NL | S : r_lock_tree | |
   |     |     *--| M : requested   |--* |     *--| M : locked      | |
   |     |     |  *-----------------*  | |     |  *-----------------* |
   |     |     |  NE  |         | PE   | |     |  NE  |         | PE  |
   |     |     |      |         |      | |     |      |         |     |
   |     |     |  *-----------------*  | |     |  *-----------------* |
   |     |     *->| R : 3           |  | |     *->| R : 13          | |
n-1| nil |        | L : 42          |  | |        | L : nil_page_no | |
n  | nil |        | P : 17          |  | |        | P : 15          | |
   *-----*     NL | S : w_lock_leaf |  | |        | S : r_lock_tree | |
               *--| M : locked      |  | |        | M : locked      | |
               |  *-----------------*  | |        *-----------------* |
               |  NE  |         | PE   | |                            |
               |      |         |      | |                         V  |
               |  *-----------------*  | |                         e  |
               |  | R : 3           |<-* |                         r  |
               |  | L : 42          |    |                         t  |
               |  | P : 18          | ---*                         i  |
               |  | S : r_lock_leaf |                              c  |
               |  | M : requested   |                              a  |
               |  *-----------------*                              l  |
               |  NE  |         | PE                                  |
               |      |         |                                  C  |
               |  *-----------------*                              h  |
               *->| R : 3           |                              a  |
                  | L : nil_page_no |                              i  |
                  | P : 13          |                              n  |
                  | S : r_lock_tree |                                 |
                  | M : locked      |                                 |
                  *-----------------*                                 |
                                                                      |
                       Horizontal Chain
             - - - - - - - - - - - - - - - - - - - - - - - - - ->
.fo
.pa
The kerneldumpfile contains the global structures of this module
in the following sequence :
.sp2;
.sp
.nf
 
DUMPLABEL : B77UNDEF                    8 Bytes
DUMPCODE  : 401                         2 Bytes
 
DUMPLABEL : B77VAR                      8 Bytes
            402                         2 Bytes
            TLL_PREVENT_SPLIT           1 Byte
            TLL_SPLIT_COUNTER           2 Bytes
            TLL_RESUME_COUNTER          2 Bytes
            TLL_SVP_IGNORE_CNT          2 Bytes
            TLL_PID_REQUEST             4 Bytes
            PARTITION                   2 Bytes
 
DUMPLABEL : B77HASH                     8 Bytes
DUMPCODE  : 403                         2 Bytes
            TLL_HASHSIZE                4 Bytes
            TLL_GENERATED               1 Byte
            TLL_ANCHOR
                            (total : TLL_HASHSIZE a 4 Bytes)
                            or with BIT64:
                            (total : TLL_HASHSIZE a 8 Bytes)
 
DUMPLABEL : B77HASHF                    8 Bytes
DUMPCODE  : 404                         2 Bytes
            TLL_HASHSIZE                4 Bytes
            REMAIN_COUNT                4 Bytes
            REMAIN_ANCHOR
                            (total : REMAIN_COUNT a 4 Bytes)
                            or with BIT64:
                            (total : REMAIN_COUNT a 8 Bytes)
 
DUMPLABEL : B77LOCKL                    8 Bytes
DUMPCODE  : 405                         2 Bytes
            TLL_LOCKLISTSIZE            2 Bytes
            TLL_GENERATED               1 Byte
            TLL_ENTRY
                STORAGE ADDRESS         4/8 Bytes
                LLE_ROOT                4   Bytes
                LLE_LEAF                4   Bytes
                LLE_INDEX               4   Bytes
                LLE_PID                 4   Bytes
                LLE_FILLER1             2   Bytes
                            LLE_EXCL_LOCK_EXIST     1   Byte
                                LLE_IGNORE_SVP          1   Byte
                LLE_STATE               1   Bytes
                LLE_MODE                1   Byte
                LLE_PRIO_ON             1   Byte
                LLE_RESUME_AFTER_SVP    1   Byte
                LLE_NEXT_DIFF_ROOT      4/8 Bytes
                LLE_NEXT_EQ_ROOT        4/8 Bytes
                LLE_PREV_EQ_ROOT        4/8 Bytes
                LLE_NEXT_LOCK           4/8 Bytes
                LLE_NEXT_REQUEST        4/8 Bytes
                LLE_NEXT_FIRST_REQUEST  4/8 Bytes
 
                            (total : TLL_LOCKLISTSIZE a 48 Bytes)
                            or with BIT64:
                            (total : TLL_LOCKLISTSIZE a 80 Bytes)
 
DUMPLABEL : B77FOLLW
DUMPCODE  : 406
            TLL_LOCKLISTSIZE            2 Bytes
            REMAIN_COUNT                2 Bytes
            REMAIN_ENTRIES
                            (total : REMAIN_COUNT a 48 Bytes)
                            or with BIT64:
                            (total : REMAIN_COUNT a 80 Bytes)
.fo
.CM *-END-* description ---------------------------------
.sp 2
***********************************************************
.sp
.cp 10
.nf
.oc _/1
Structure:
 
.CM *-END-* structure -----------------------------------
.sp 2
**********************************************************
.sp
.cp 10
.nf
.oc _/1
.CM -lll-
Code    :
 
 
(*------------------------------*) 
 
FUNCTION
      b77anyleaf_write_locks
            (VAR root_desc : tbd7_root_desc) : boolean;
 
VAR
      found    : boolean;
      root_ptr : tbd7_entry_ptr;
 
BEGIN
&ifdef TRACE
b77print_tree_locklist;
&endif
found := false;
IF  b77first_lock (root_desc, root_ptr)
THEN
    REPEAT
        IF  root_ptr^.lle_leaf >= NIL_PAGE_NO_GG00
        THEN
            root_ptr := NIL
        ELSE
            IF  root_ptr^.lle_state = w_lock_leaf
            THEN
                BEGIN
                root_desc.rd_collision_ptr := root_ptr;
                found := true
                END
            ELSE
                root_ptr := root_ptr^.lle_next_lock;
            (*ENDIF*) 
        (*ENDIF*) 
    UNTIL
        found OR (root_ptr = NIL);
    (*ENDREPEAT*) 
(*ENDIF*) 
b77anyleaf_write_locks := found
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77check_locklist (VAR root_desc : tbd7_root_desc);
 
BEGIN
WITH b77locklist [root_desc.rd_partition] DO
    bd77check_locklist (tll_anchor^ [root_desc.rd_hash], tll_prevent_split)
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77check_whole_locklist (Partition : integer);
 
VAR
      hash_item : integer;
 
BEGIN
WITH b77locklist [Partition] DO
    BEGIN
    FOR hash_item := 1 TO tll_hashsize DO
        IF  tll_anchor^ [hash_item] <> NIL
        THEN
            bd77check_locklist (tll_anchor^ [hash_item], tll_prevent_split)
        (*ENDIF*) 
    (*ENDFOR*) 
    END;
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77conv_lock_to_req (
            pid             : tsp00_TaskId;
            VAR root_desc   : tbd7_root_desc;
            lockstate       : tbd_treelock;
            excl_lock_exist : boolean);
 
VAR
      found                  : boolean;
      entry_ptr, prev_eq_ptr : tbd7_entry_ptr;
 
BEGIN
IF  b77first_lock (root_desc, entry_ptr)
THEN
    BEGIN
&   ifdef TRACE
    IF  t01trace (bd_lock)
    THEN
        BEGIN
        t01p2int4 (bd_lock, 'pid         ', pid,
              'root        ', root_desc.rd_root);
        t01int4 (bd_lock, 'lockst      ', ord (lockstate));
        b77print_tree_locklist
        END;
&   endif
    (*ENDIF*) 
    found := false;
    prev_eq_ptr := root_desc.rd_ptr;
    REPEAT
        IF  entry_ptr^.lle_pid = pid
        THEN
            BEGIN
            (* --- Establish next-lock chain --- *)
            IF  prev_eq_ptr <> entry_ptr
            THEN
                BEGIN
                prev_eq_ptr^.lle_next_lock :=
                      entry_ptr^.lle_next_lock;
                entry_ptr^.lle_next_lock := NIL
                END;
            (* --- Establish next-request chain --- *)
            (*ENDIF*) 
            prev_eq_ptr := b76last_request (root_desc.rd_ptr);
            IF  prev_eq_ptr^.lle_mode = bd7lm_locked
            THEN
                BEGIN
                IF  prev_eq_ptr <> entry_ptr
                THEN
                    prev_eq_ptr^.lle_first_request := entry_ptr
                (*ENDIF*) 
                END
            ELSE
                prev_eq_ptr^.lle_next_request := entry_ptr;
            (*ENDIF*) 
            IF  entry_ptr^.lle_state = w_lock_index
            THEN
                WITH b77locklist [root_desc.rd_partition] DO
                    tll_split_counter := pred (tll_split_counter);
                (*ENDWITH*) 
            (*ENDIF*) 
            entry_ptr^.lle_state := lockstate;
            entry_ptr^.lle_mode  := bd7lm_requested;
            (* PTS 1106058 TS 2000-03-28 *)
            entry_ptr^.lle_excl_lock_exist := excl_lock_exist;
            (* PTS 1106058 *)
            found                := true
            END
        ELSE
            BEGIN
            prev_eq_ptr := entry_ptr;
            entry_ptr   := entry_ptr^.lle_next_lock
            END;
        (*ENDIF*) 
    UNTIL
        found OR (entry_ptr =NIL)
    (*ENDREPEAT*) 
    END;
(*ENDIF*) 
IF  NOT found
THEN
    g01abort (csp3_b77x3_lockentry_not_found, csp3_n_treelock,
          'lckentry not found (pid)', pid);
&ifdef TRACE
(*ENDIF*) 
b77print_tree_locklist;
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77delete_lockentry (pid : tsp00_TaskId;
            VAR root_desc : tbd7_root_desc;
            VAR leaf      : tsp00_PageNo;
            indexnode     : tsp00_PageNo;
            lockstate     : tbd_treelock);
 
CONST
      c_set_prio = true;
 
VAR
      found       : boolean;
      prev_eq_ptr : tbd7_entry_ptr;
      entry_ptr   : tbd7_entry_ptr;
 
BEGIN
&ifdef TRACE
t01int4 (bd_lock, 'lockstate   ', ord(lockstate));
b77print_tree_locklist;
&endif
found := false;
WITH root_desc DO
    BEGIN
    IF  rd_exist
    THEN
        BEGIN
        prev_eq_ptr := rd_ptr;
        IF  b77first_lock (root_desc, entry_ptr)
        THEN
            REPEAT
                IF  (entry_ptr^.lle_pid = pid)
                    AND
                    (entry_ptr^.lle_state = lockstate)
                    AND
                    (entry_ptr^.lle_index = indexnode)
                THEN
                    BEGIN
                    found := true;
                    IF  (lockstate = r_lock_tree)
                    THEN
                        leaf := entry_ptr^.lle_leaf
                    (*ENDIF*) 
                    END
                ELSE
                    BEGIN
                    prev_eq_ptr := entry_ptr;
                    entry_ptr := entry_ptr^.lle_next_lock
                    END;
                (*ENDIF*) 
            UNTIL
                found OR (entry_ptr = NIL)
            (*ENDREPEAT*) 
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  NOT (found OR b01downfilesystem)
    THEN
        g01abort (csp3_b77x1_lockentry_not_found, csp3_n_treelock,
              'lckentry not found (pid)', pid);
    (*ENDIF*) 
    IF  found
    THEN
        BEGIN
        IF  prev_eq_ptr = entry_ptr
        THEN
            (* Delete the first lockentry within the vertical chain. *)
            IF  entry_ptr^.lle_next_eq_root = NIL
            THEN
                BEGIN
                (* Only one entry with this root number  *)
                IF  rd_prev_ptr = entry_ptr
                THEN
                    (* This root entry is referenced direct by the *)
                    (* anchor, i.e. it is the first one within the *)
                    (* horizontal single chained list.             *)
                    b77locklist [rd_partition].tll_anchor^ [rd_hash] :=
                          entry_ptr^.lle_next_diff_root
                ELSE
                    rd_prev_ptr^.lle_next_diff_root :=
                          entry_ptr^.lle_next_diff_root;
                (*ENDIF*) 
                rd_exist := false;
                rd_ptr   := NIL
                END
            ELSE
                (* More than one entry with this root number, i.e. *)
                (* we have got a vertical double chained list.     *)
                IF  rd_prev_ptr = entry_ptr
                THEN
                    (* This root entry is referenced direct by the *)
                    (* anchor, i.e. it is the first one within the *)
                    (* horizontal single chained list.             *)
                    WITH b77locklist [rd_partition] DO
                        BEGIN
                        (* --- Establish horizontal chain ---*)
                        tll_anchor^ [rd_hash] :=
                              entry_ptr^.lle_next_eq_root;
                        tll_anchor^ [rd_hash]^.lle_next_diff_root :=
                              entry_ptr^.lle_next_diff_root;
                        rd_ptr      := tll_anchor^ [rd_hash];
                        rd_prev_ptr := rd_ptr;
                        (* ---  Establish next-lock chain --- *)
                        IF  entry_ptr^.lle_next_lock <> NIL
                        THEN
                            BEGIN
                            IF  (entry_ptr^.lle_next_lock <>
                                entry_ptr^.lle_next_eq_root)
                            THEN
                                tll_anchor^ [rd_hash]^.lle_next_lock :=
                                      entry_ptr^.lle_next_lock;
                            (*ENDIF*) 
                            entry_ptr^.lle_next_lock := NIL
                            END;
                        (* --- Establish next-request chain --- *)
                        (*ENDIF*) 
                        IF  entry_ptr^.lle_first_request <> NIL
                        THEN
                            BEGIN
                            IF  (entry_ptr^.lle_first_request <>
                                entry_ptr^.lle_next_eq_root)
                            THEN
                                tll_anchor^ [rd_hash]^.lle_first_request :=
                                      entry_ptr^.lle_first_request;
                            (*ENDIF*) 
                            entry_ptr^.lle_first_request := NIL
                            END;
                        (* --- Revive resume_after_svp --- *)
                        (*ENDIF*) 
                        IF  entry_ptr^.lle_resume_after_svp
                        THEN
                            WITH entry_ptr^ DO
                                BEGIN
                                lle_resume_after_svp := false;
                                lle_next_eq_root^.lle_resume_after_svp :=
                                      true
                                END;
                            (*ENDWITH*) 
                        (* --- Establish vertical chain ---*)
                        (*ENDIF*) 
                        entry_ptr^.lle_next_eq_root^.lle_prev_eq_root :=
                              NIL;
                        entry_ptr^.lle_next_eq_root := NIL;
                        END
                    (*ENDWITH*) 
                ELSE
                    WITH rd_prev_ptr^ DO
                        BEGIN
                        (* --- Establish horizontal chain --- *)
                        lle_next_diff_root := entry_ptr^.lle_next_eq_root;
                        lle_next_diff_root^.lle_next_diff_root :=
                              entry_ptr^.lle_next_diff_root;
                        root_desc.rd_ptr := lle_next_diff_root;
                        (* --- Establish next-lock chain --- *)
                        IF  entry_ptr^.lle_next_lock <> NIL
                        THEN
                            BEGIN
                            IF  (entry_ptr^.lle_next_lock <>
                                entry_ptr^.lle_next_eq_root)
                            THEN
                                lle_next_diff_root^.lle_next_lock :=
                                      entry_ptr^.lle_next_lock;
                            (*ENDIF*) 
                            entry_ptr^.lle_next_lock := NIL
                            END;
                        (* --- Establish first-request chain --- *)
                        (*ENDIF*) 
                        IF  entry_ptr^.lle_first_request <> NIL
                        THEN
                            BEGIN
                            IF  (entry_ptr^.lle_first_request <>
                                entry_ptr^.lle_next_eq_root)
                            THEN
                                lle_next_diff_root^.lle_first_request :=
                                      entry_ptr^.lle_first_request;
                            (*ENDIF*) 
                            entry_ptr^.lle_first_request := NIL
                            END;
                        (* --- Revive resume_after_svp --- *)
                        (*ENDIF*) 
                        IF  entry_ptr^.lle_resume_after_svp
                        THEN
                            WITH entry_ptr^ DO
                                BEGIN
                                lle_resume_after_svp := false;
                                lle_next_eq_root^.lle_resume_after_svp :=
                                      true
                                END;
                            (*ENDWITH*) 
                        (* --- Establish vertical chain --- *)
                        (*ENDIF*) 
                        entry_ptr^.lle_next_eq_root^.lle_prev_eq_root :=
                              NIL;
                        entry_ptr^.lle_next_eq_root := NIL;
                        END
                    (*ENDWITH*) 
                (*ENDIF*) 
            (*ENDIF*) 
        ELSE
            BEGIN
            (* Delete one lockentry within the vertical chained list. *)
            (* Note that this is not the first entry!                 *)
            (* --- Establish next-lock chain --- *)
            prev_eq_ptr^.lle_next_lock := entry_ptr^.lle_next_lock;
            IF  entry_ptr^.lle_next_lock <> NIL
            THEN
                entry_ptr^.lle_next_lock := NIL;
            (* --- Establish vertical chain --- *)
            (*ENDIF*) 
            IF  entry_ptr^.lle_next_eq_root <> NIL
            THEN
                BEGIN
                entry_ptr^.lle_prev_eq_root^.lle_next_eq_root :=
                      entry_ptr^.lle_next_eq_root;
                entry_ptr^.lle_next_eq_root^.lle_prev_eq_root :=
                      entry_ptr^.lle_prev_eq_root;
                entry_ptr^.lle_next_eq_root := NIL;
                END
            ELSE
                entry_ptr^.lle_prev_eq_root^.lle_next_eq_root := NIL;
            (*ENDIF*) 
            entry_ptr^.lle_prev_eq_root := NIL
            END;
        (*ENDIF*) 
        IF  entry_ptr^.lle_prio_on
        THEN
            BEGIN
            entry_ptr^.lle_prio_on := false;
            vprio (entry_ptr^.lle_pid, cbd7_prio_high, NOT c_set_prio)
            END;
        (*ENDIF*) 
        WITH b77locklist [rd_partition] DO
            BEGIN
            IF  (lockstate = w_lock_tree) OR
                (lockstate = d_lock_tree) OR
                (lockstate = w_lock_index)
            THEN
                tll_split_counter := pred (tll_split_counter);
            (*ENDIF*) 
            IF  entry_ptr^.lle_ignore_svp
            THEN
                BEGIN
                tll_svp_ignore_cnt := pred (tll_svp_ignore_cnt);
                entry_ptr^.lle_ignore_svp  := false
                END;
            (*ENDIF*) 
            entry_ptr^.lle_root  := NIL_PAGE_NO_GG00;
            entry_ptr^.lle_leaf  := NIL_PAGE_NO_GG00;
            entry_ptr^.lle_index := NIL_PAGE_NO_GG00;
            entry_ptr^.lle_next_diff_root := tll_free_entry;
            tll_free_entry := entry_ptr;
&           ifdef TRACE
            bd77cleanentry (tll_free_entry);
&           endif
            END
        (*ENDWITH*) 
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
&ifdef TRACE
b77print_tree_locklist;
&endif
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77dump_locklist (VAR hostfile : tgg00_VfFileref;
            VAR buf       : tsp00_Page;
            VAR dump_pno  : tsp00_Int4;
            VAR pos       : integer;
            VAR hosterror : tsp00_VfReturn;
            VAR errtext   : tsp00_ErrText);
 
CONST
      mark0_b77undef  = 'B77UNDEF';
      code0_b77undef  = 401;
      mark1_b77var    = 'B77VAR  ';
      code1_b77var    = 402;
      mark2_b77hash   = 'B77HASH ';
      code2_b77hash   = 403;
      mark3_b77hashf  = 'B77HASHF';
      code3_b77hashf  = 404;
      mark4_b77lockl  = 'B77LOCKL';
      code4_b77lockl  = 405;
      mark5_b77follw  = 'B77FOLLW';
      code5_b77follw  = 406;
 
VAR
      move_err                : tgg00_BasisError;
      partition               : tsp00_Int2;
      h_int                   : tsp00_IntMapC2;
      count, hashaddress, hlp : tsp00_Int4;
      entry_address           : tbd7_entry_ptr;
      dump_mark               : tsp00_C8;
      buf_ptr                 : tsp00_VfBufaddr;
 
BEGIN
move_err := e_ok;
buf_ptr  := @buf;
FOR partition := 0 TO b75region_cnt  - 1 DO
    WITH b77locklist [partition] DO
        BEGIN
        IF  hosterror = vf_ok
        THEN
            g01new_dump_page (hostfile, buf, dump_pno, pos, hosterror, errtext);
        (*ENDIF*) 
        IF  NOT tll_generated AND (hosterror = vf_ok)
        THEN
            BEGIN
            dump_mark := mark0_b77undef;
            g10mv ('VBD77 ',   1,    
                  sizeof (dump_mark), sizeof (buf),
                  dump_mark, 1,
                  buf, pos, sizeof (dump_mark), move_err);
            move_err := e_ok; (* ignore error *)
            pos := pos + sizeof (dump_mark);
            h_int.mapInt_sp00 := code0_b77undef;
            buf[pos] := h_int.mapC2_sp00 [1];
            buf[pos+1] := h_int.mapC2_sp00 [2];
            pos := pos + 2
            END;
        (*ENDIF*) 
        IF  tll_generated AND (hosterror = vf_ok)
        THEN
            BEGIN
            (* *)
            (* --- Dump TLL-VARIABLES --- *)
            (* *)
            IF  (pos -1) + sizeof (dump_mark) + sizeof (h_int) +
                sizeof (tll_prevent_split)    +
                sizeof (tll_split_counter)    +
                sizeof (tll_resume_counter)   +
                sizeof (tll_svp_ignore_cnt)   +
                sizeof (tll_pid_request)      +
                sizeof (partition)       > sizeof (buf)
            THEN
                g01new_dump_page (hostfile, buf, dump_pno, pos, hosterror, errtext);
            (*ENDIF*) 
            IF  hosterror = vf_ok
            THEN
                BEGIN
                dump_mark := mark1_b77var;
                g10mv ('VBD77 ',   2,    
                      sizeof (dump_mark), sizeof (buf),
                      dump_mark, 1,
                      buf, pos, sizeof (dump_mark), move_err);
                move_err := e_ok; (* ignore error *)
                pos := pos + sizeof (dump_mark);
                h_int.mapInt_sp00 := code1_b77var;
                buf [pos]   := h_int.mapC2_sp00 [1];
                buf [pos+1] := h_int.mapC2_sp00 [2];
                pos := pos + 2;
                (* *)
                buf [pos] := chr (ord (tll_prevent_split));
                pos := succ (pos);
                (* *)
                h_int.mapInt_sp00 := tll_split_counter;
                buf [pos]   := h_int.mapC2_sp00 [1];
                buf [pos+1] := h_int.mapC2_sp00 [2];
                pos := pos + 2;
                (* *)
                h_int.mapInt_sp00 := tll_resume_counter;
                buf [pos]   := h_int.mapC2_sp00 [1];
                buf [pos+1] := h_int.mapC2_sp00 [2];
                pos := pos + 2;
                (* *)
                h_int.mapInt_sp00 := tll_svp_ignore_cnt;
                buf [pos]   := h_int.mapC2_sp00 [1];
                buf [pos+1] := h_int.mapC2_sp00 [2];
                pos := pos + 2;
                (* *)
                s20ch4a (tll_pid_request, buf, pos);
                pos := pos + 4;
                (* *)
                h_int.mapInt_sp00 := partition;
                buf[pos]   := h_int.mapC2_sp00 [1];
                buf[pos+1] := h_int.mapC2_sp00 [2];
                pos := pos + 2
                      (* *)
                END;
            (*ENDIF*) 
            IF  hosterror = vf_ok
            THEN
                (* *)
                (* --- Dump hashtable --- *)
                (* *)
                IF  (pos - 1) + sizeof (dump_mark) + sizeof (h_int) +
                    sizeof (tll_hashsize) +
                    sizeof (tll_generated) > sizeof (buf)
                THEN
                    g01new_dump_page (hostfile, buf, dump_pno, pos, hosterror, errtext);
                (*ENDIF*) 
            (*ENDIF*) 
            IF  hosterror = vf_ok
            THEN
                BEGIN
                dump_mark := mark2_b77hash;
                g10mv ('VBD77 ',   3,    
                      sizeof (dump_mark), sizeof (buf),
                      dump_mark, 1,
                      buf, pos, sizeof (dump_mark), move_err);
                move_err := e_ok; (* ignore error *)
                pos := pos + sizeof (dump_mark);
                h_int.mapInt_sp00 := code2_b77hash;
                buf[pos] := h_int.mapC2_sp00 [1];
                buf[pos+1] := h_int.mapC2_sp00 [2];
                pos := pos + 2;
                (* *)
                s20ch4 (tll_hashsize, buf, pos);
                pos := pos + 4;
                (* *)
                buf[pos] := chr (ord (tll_generated));
                pos := succ (pos)
                END;
            (*ENDIF*) 
            hashaddress := 1;
            WHILE (hosterror = vf_ok) AND (hashaddress <= tll_hashsize) DO
                BEGIN
                IF  (pos - 1) + sizeof (tbd7_entry_ptr) <= sizeof (buf)
                THEN
                    BEGIN
                    g10mv2 ('VBD77 ',   4,    
                          sizeof (tbd7_entry_ptr), sizeof (buf),
                          tll_anchor^ [hashaddress], 1,
                          buf, pos, sizeof (tbd7_entry_ptr), move_err);
                    move_err := e_ok; (* ignore error *)
                    pos := pos + sizeof (tbd7_entry_ptr);
                    hashaddress := succ (hashaddress)
                    END
                ELSE
                    BEGIN
                    g01new_dump_page (hostfile, buf, dump_pno, pos, hosterror, errtext);
                    IF  hosterror = vf_ok
                    THEN
                        BEGIN
                        dump_mark := mark3_b77hashf;
                        g10mv ('VBD77 ',   5,    
                              sizeof (dump_mark), sizeof (buf),
                              dump_mark, 1,
                              buf, pos, sizeof (dump_mark), move_err);
                        move_err := e_ok; (* ignore error *)
                        pos := pos + sizeof (dump_mark);
                        h_int.mapInt_sp00 := code3_b77hashf;
                        buf [pos]     := h_int.mapC2_sp00 [1];
                        buf [pos + 1] := h_int.mapC2_sp00 [2];
                        pos := pos + 2;
                        s20ch4 (tll_hashsize, buf, pos);
                        pos := pos + 4;
                        hlp := tll_hashsize - hashaddress + 1;
                        s20ch4 (hlp, buf, pos);
                        pos := pos + 4
                        END
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END;
            (*ENDWHILE*) 
            IF  hosterror = vf_ok
            THEN
                BEGIN
                (* *)
                (* Dump proper treelocklist *)
                (* *)
                IF  (pos - 1) + sizeof (dump_mark) + sizeof (h_int) +
                    sizeof (tll_locklistsize) +
                    sizeof (tll_generated) > sizeof (buf)
                THEN
                    g01new_dump_page (hostfile, buf, dump_pno, pos, hosterror, errtext)
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            IF  hosterror = vf_ok
            THEN
                BEGIN
                dump_mark := mark4_b77lockl;
                g10mv ('VBD77 ',   6,    
                      sizeof (dump_mark), sizeof (buf),
                      dump_mark, 1,
                      buf, pos, sizeof (dump_mark), move_err);
                move_err := e_ok; (* ignore error *)
                pos := pos + sizeof (dump_mark);
                h_int.mapInt_sp00 := code4_b77lockl;
                buf[pos] := h_int.mapC2_sp00 [1];
                buf[pos+1] := h_int.mapC2_sp00 [2];
                pos := pos + 2;
                h_int.mapInt_sp00 := tll_locklistsize;
                buf[pos] := h_int.mapC2_sp00 [1];
                buf[pos+1] := h_int.mapC2_sp00 [2];
                pos := pos + 2;
                buf[pos] := chr (ord (tll_generated));
                pos := succ (pos)
                END;
            (*ENDIF*) 
            count := 1;
            WHILE (hosterror = vf_ok) AND (count <= tll_locklistsize) DO
                BEGIN
                (* tbd7_locklistentry + storage address *)
                IF  (pos - 1) + sizeof (tll_entry^ [count])
                    + sizeof (tbd7_entry_ptr) <= sizeof (buf)
                THEN
                    BEGIN
                    entry_address := @tll_entry^ [count];
                    g10mv2 ('VBD77 ',   7,    
                          sizeof (tbd7_entry_ptr), sizeof (buf),
                          entry_address, 1,
                          buf, pos, sizeof (tbd7_entry_ptr), move_err);
                    move_err := e_ok; (* ignore error *)
                    pos   := pos + sizeof (tbd7_entry_ptr);
                    g10mv1 ('VBD77 ',   8,    
                          sizeof (tll_entry^ [count]), sizeof (buf),
                          tll_entry^ [count], 1,
                          buf, pos, sizeof (tll_entry^ [count]), move_err);
                    move_err := e_ok; (* ignore error *)
                    pos   := pos + sizeof (tll_entry^ [count]);
                    count := succ (count)
                    END
                ELSE
                    BEGIN
                    g01new_dump_page (hostfile, buf, dump_pno, pos, hosterror, errtext);
                    IF  hosterror = vf_ok
                    THEN
                        BEGIN
                        dump_mark := mark5_b77follw;
                        g10mv ('VBD77 ',   9,    
                              sizeof (dump_mark), sizeof (buf),
                              dump_mark, 1,
                              buf, pos, sizeof (dump_mark), move_err);
                        move_err := e_ok; (* ignore error *)
                        pos := pos + sizeof (dump_mark);
                        h_int.mapInt_sp00 := code5_b77follw;
                        buf [pos]     := h_int.mapC2_sp00 [1];
                        buf [pos + 1] := h_int.mapC2_sp00 [2];
                        pos := pos + 2;
                        h_int.mapInt_sp00 := tll_locklistsize;
                        buf [pos]   := h_int.mapC2_sp00 [1];
                        buf [pos+1] := h_int.mapC2_sp00 [2];
                        pos := pos + 2;
                        h_int.mapInt_sp00 := tll_locklistsize - count + 1;
                        buf [pos]     := h_int.mapC2_sp00 [1];
                        buf [pos + 1] := h_int.mapC2_sp00 [2];
                        pos := pos + 2
                        END
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END
            (*ENDWHILE*) 
            END
        (*ENDIF*) 
        END;
    (*ENDWITH*) 
(*ENDFOR*) 
IF  hosterror = vf_ok
THEN
    g01new_dump_page (hostfile, buf, dump_pno, pos, hosterror, errtext)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      b77excl_using_root (VAR root_desc : tbd7_root_desc;
            pid : tsp00_TaskId) : boolean;
 
VAR
      found    : boolean;
      root_ptr : tbd7_entry_ptr;
 
BEGIN
&ifdef TRACE
b77print_tree_locklist;
&endif
found := false;
IF  b77first_lock (root_desc, root_ptr)
THEN
    REPEAT
        IF  root_ptr^.lle_pid <> pid
        THEN
            BEGIN
            root_desc.rd_collision_ptr := root_ptr;
            found := true
            END
        ELSE
            root_ptr := root_ptr^.lle_next_lock;
        (*ENDIF*) 
    UNTIL
        found OR (root_ptr = NIL);
    (*ENDREPEAT*) 
(*ENDIF*) 
b77excl_using_root := NOT found
END;
 
(*------------------------------*) 
 
FUNCTION
      b77exist_lock_within_subtree (
            pid           : tsp00_TaskId; (* PTS 1107109 TS 2000-07-20 *)
            VAR root_desc : tbd7_root_desc;
            indexnode     : tsp00_PageNo): boolean;
 
VAR
      found    : boolean;
      root_ptr : tbd7_entry_ptr;
 
BEGIN
&ifdef TRACE
b77print_tree_locklist;
&endif
found := false;
IF  b77first_lock (root_desc, root_ptr)
THEN
    REPEAT
        IF  (root_ptr^.lle_pid   <> pid) AND
            (
            (root_ptr^.lle_index = indexnode  ) OR
            (root_ptr^.lle_state = s_lock_tree) (* PTS 1107109 TS 2000-07-20 *)
            )
        THEN
            BEGIN
            root_desc.rd_collision_ptr := root_ptr;
            found := true
            END
        ELSE
            root_ptr := root_ptr^.lle_next_lock;
        (*ENDIF*) 
    UNTIL
        found OR (root_ptr = NIL);
    (*ENDREPEAT*) 
(*ENDIF*) 
b77exist_lock_within_subtree := found
END;
 
(*------------------------------*) 
 
FUNCTION
      b77first_lock (VAR root_desc : tbd7_root_desc;
            VAR root_ptr : tbd7_entry_ptr) : boolean;
 
VAR
      found : boolean;
 
BEGIN
found := false;
IF  root_desc.rd_exist
THEN
    BEGIN
    IF  root_desc.rd_ptr^.lle_mode = bd7lm_locked
    THEN
        BEGIN
        found    := true;
        root_ptr := root_desc.rd_ptr
        END
    ELSE
        IF  root_desc.rd_ptr^.lle_next_lock <> NIL
        THEN
            BEGIN
            found    := true;
            root_ptr := root_desc.rd_ptr^.lle_next_lock
            END;
        (*ENDIF*) 
    (*ENDIF*) 
    END;
&ifdef TRACE
(*ENDIF*) 
IF  found
THEN
    b77pointer_check (root_ptr, root_desc.rd_root);
&endif
(*ENDIF*) 
b77first_lock := found
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77index_check (VAR current : tbd_current_tree;
            VAR root_desc : tbd7_root_desc);
 
VAR
      root_ptr : tbd7_entry_ptr;
 
BEGIN
WITH current DO
    BEGIN
    IF  ((curr_tree_id.fileTfn_gg00 = tfnTable_egg00)
        OR
        (curr_tree_id.fileTfn_gg00 = tfnShortScol_egg00))
    THEN
        BEGIN
        root_ptr := root_desc.rd_ptr;
        REPEAT
            IF  (root_ptr^.lle_state = r_lock_leaf)
                OR
                (root_ptr^.lle_state = w_lock_leaf)
                OR
                (root_ptr^.lle_state = r_lock_index)
                OR
                (root_ptr^.lle_state = w_lock_index)
            THEN
                BEGIN
                IF  (ftsDynamic_egg00 IN curr_tree_id.fileType_gg00)
                    AND
                    g01glob.bd_subtree
                THEN
                    BEGIN
                    IF  (root_ptr^.lle_index = NIL_PAGE_NO_GG00)
                    THEN
                        BEGIN
&                       ifdef TRACE
                        t01treeid (bd_lock, 'TREEID      ',
                              curr_tree_id);
&                       endif
                        bd77break ('B77check17              ', root_ptr)
                        END;
                    (*ENDIF*) 
                    END
                ELSE
                    BEGIN
                    IF  (root_ptr^.lle_index <> NIL_PAGE_NO_GG00)
                    THEN
                        BEGIN
&                       ifdef TRACE
                        t01treeid (bd_lock, 'TREEID      ',
                              curr_tree_id);
&                       endif
                        bd77break ('B77check18              ', root_ptr)
                        END
                    (*ENDIF*) 
                    END
                (*ENDIF*) 
                END;
            (*ENDIF*) 
            root_ptr := root_ptr^.lle_next_eq_root;
        UNTIL
            (root_ptr = NIL)
        (*ENDREPEAT*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77index_or_leaf_writers (VAR root_desc : tbd7_root_desc;
            pid             : tsp00_TaskId;
            VAR index_found : boolean;
            VAR leaf_found  : boolean);
 
VAR
      root_ptr : tbd7_entry_ptr;
 
BEGIN
&ifdef TRACE
b77print_tree_locklist;
&endif
IF  b77first_lock (root_desc, root_ptr)
THEN
    REPEAT
        IF  (root_ptr^.lle_state = w_lock_index)
            AND
            (root_ptr^.lle_pid <> pid)
        THEN
            BEGIN
            IF  root_desc.rd_collision_ptr = NIL
            THEN
                root_desc.rd_collision_ptr := root_ptr;
            (*ENDIF*) 
            index_found := true
            END
        ELSE
            BEGIN
            IF  (root_ptr^.lle_state = w_lock_leaf)
                AND
                (root_ptr^.lle_pid <> pid)
            THEN
                BEGIN
                root_desc.rd_collision_ptr := root_ptr;
                leaf_found := true
                END
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        root_ptr := root_ptr^.lle_next_lock;
    UNTIL
        ((index_found) AND (leaf_found)) OR (root_ptr = NIL)
    (*ENDREPEAT*) 
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77init_tree_locklist (partition : integer;
            VAR alloc_sum : tsp00_Int4;
            VAR e         : tgg00_BasisError);
 
VAR
      lock_jumper : tsp00_Int2;
      prim_number : tsp00_Int4;
      hash_jumper : tsp00_Int4;
      univ_addr   : tbd7_univ_ptr;
 
BEGIN
e := e_ok;
WITH b77locklist [partition] DO
    BEGIN
    IF  NOT tll_generated
    THEN
        BEGIN
        prim_number := g01CacheSize * 8 DIV b75region_cnt;
        g01next_prim_number (prim_number);
        IF  prim_number > cbd7_maxhashlist
        THEN
            tll_hashsize := cbd7_maxhashlist - 1
        ELSE
            tll_hashsize := prim_number;
        (*ENDIF*) 
        (* *)
        IF  partition = 0
        THEN
            BEGIN
            g01allocate_msg (csp3_n_dynpool, 'TREELOCK_HEAD_LIST all :',
                  tll_hashsize * sizeof (tbd7_entry_ptr));
            g01allocate_msg (csp3_n_dynpool, 'DATA_CACHE_PAGES*10/par:',
                  tll_hashsize);
            g01allocate_msg (csp3_n_dynpool, 'TREELOCK_HEAD_LIST elem:',
                  sizeof (tbd7_entry_ptr))
            END;
        (* *)
        (*ENDIF*) 
        IF  bd77vallocat (tll_hashsize * sizeof (tbd7_entry_ptr),
            alloc_sum, univ_addr)
        THEN
            BEGIN
            tll_anchor := univ_addr.anchorlistaddr;
            tll_locklistsize := (g01maxuser + g01maxservertask + 2) * 2;
            (* *)
            IF  partition = 0
            THEN
                BEGIN
                g01allocate_msg (csp3_n_dynpool,
                      'TREELOCK_LIST all      :',
                      tll_locklistsize * sizeof (tbd7_locklistentry));
                g01allocate_msg (csp3_n_dynpool,
                      '(USER + SERVER + 2) * 2:',
                      tll_locklistsize);
                g01allocate_msg (csp3_n_dynpool,
                      'TREELOCK_LIST elem     :',
                      sizeof (tbd7_locklistentry))
                END;
            (* *)
            (*ENDIF*) 
            IF  bd77vallocat (tll_locklistsize *
                sizeof (tbd7_locklistentry), alloc_sum, univ_addr)
            THEN
                BEGIN
                tll_generated := true;
                tll_entry := univ_addr.entrylistaddr
                END
            ELSE
                e := e_sysbuf_storage_exceeded
            (*ENDIF*) 
            END
        ELSE
            e := e_sysbuf_storage_exceeded
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    IF  e = e_ok
    THEN
        BEGIN
        tll_prevent_split    := false;
        tll_split_counter    := 0;
        tll_resume_counter   := 0;
        tll_pid_request      := cgg_nil_pid;
        tll_svp_ignore_cnt   := 0;
        tll_fill1            := 0;
&       ifdef BIT64
        tll_fill2            := 0;
&       endif
        FOR hash_jumper := 1 TO tll_hashsize DO
            tll_anchor^ [hash_jumper] := NIL;
        (*ENDFOR*) 
        FOR lock_jumper := 1 TO tll_locklistsize DO
            WITH tll_entry^ [lock_jumper] DO
                BEGIN
                lle_root             := NIL_PAGE_NO_GG00;
                lle_leaf             := NIL_PAGE_NO_GG00;
                lle_index            := NIL_PAGE_NO_GG00;
                lle_pid              := cgg_nil_pid;
                lle_filler1          := 0;
                lle_excl_lock_exist  := false; (* PTS 1106058 TS 2000-03-28 *)
                lle_ignore_svp       := false;
                lle_mode             := bd7lm_nil;
                lle_prio_on          := false;
                lle_resume_after_svp := false;
                lle_prev_eq_root     := NIL;
                lle_next_eq_root     := NIL;
                lle_next_lock        := NIL;
                lle_next_request     := NIL;
                lle_first_request    := NIL;
                IF  lock_jumper < tll_locklistsize
                THEN
                    BEGIN
                    lle_next_diff_root := @tll_entry^ [lock_jumper + 1];
                    END
                ELSE
                    lle_next_diff_root := NIL
                (*ENDIF*) 
                END;
            (*ENDWITH*) 
        (*ENDFOR*) 
        tll_free_entry := @tll_entry^ [1]
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77insert_lockentry (pid : tsp00_TaskId;
            VAR root_desc : tbd7_root_desc;
            leaf          : tsp00_PageNo;
            lockstate     : tbd_treelock;
            ignore_svp    : boolean);
 
VAR
      inserted, last_lock      : boolean;
      entry_ptr, new_entry_ptr : tbd7_entry_ptr;
      prev_eq_ptr              : tbd7_entry_ptr;
 
BEGIN
&ifdef TRACE
b77print_tree_locklist;
&endif
WITH root_desc DO
    BEGIN
    IF  b77locklist [rd_partition].tll_free_entry = NIL
    THEN
        g01abort (csp3_b77x1_lock_overflow, csp3_n_treelock,
              'lock overflow (pid)     ', pid);
    (*ENDIF*) 
    new_entry_ptr :=
          bd77insert_lockentry (pid, rd_root, rd_partition, leaf,
          lockstate, ignore_svp);
    IF  rd_exist
    THEN
        BEGIN
        inserted    := false;
        last_lock   := false;
        entry_ptr   := root_desc.rd_ptr;
        prev_eq_ptr := entry_ptr;
        IF  g01glob.bd_lock_check
        THEN
            bd77pid_exclusive_check (pid, root_desc.rd_root);
        (*ENDIF*) 
        REPEAT
            IF  entry_ptr = NIL
            THEN
                BEGIN
                (* Add a new lockentry to the end of the vertical *)
                (* double chained list.                           *)
                prev_eq_ptr^.lle_next_eq_root := new_entry_ptr;
                new_entry_ptr^.lle_prev_eq_root := prev_eq_ptr;
                inserted := true
                END
            ELSE
                (* Add a new lockentry within the vertical double *)
                (* chained list.                                  *)
                IF  leaf <= entry_ptr^.lle_leaf
                THEN
                    BEGIN
                    (* The lockentry substitutes the present head *)
                    (* of the vertical double chained list.       *)
                    IF  prev_eq_ptr = entry_ptr
                    THEN
                        BEGIN
                        (* --- Establish horizontal chain --- *)
                        IF  rd_prev_ptr = entry_ptr
                        THEN
                            BEGIN
                            b77locklist [rd_partition].tll_anchor^ [rd_hash] :=
                                  new_entry_ptr;
                            rd_prev_ptr := new_entry_ptr;
                            END
                        ELSE
                            rd_prev_ptr^.lle_next_diff_root :=
                                  new_entry_ptr;
                        (*ENDIF*) 
                        rd_ptr := new_entry_ptr;
                        IF  entry_ptr^.lle_next_diff_root <> NIL
                        THEN
                            BEGIN
                            new_entry_ptr^.lle_next_diff_root :=
                                  entry_ptr^.lle_next_diff_root;
                            entry_ptr^.lle_next_diff_root := NIL
                            END;
                        (* --- Establish vertical chain --- *)
                        (*ENDIF*) 
                        new_entry_ptr^.lle_next_eq_root := entry_ptr;
                        entry_ptr^.lle_prev_eq_root := new_entry_ptr;
                        (* --- Establish next-lock chain --- *)
                        IF  entry_ptr^.lle_mode = bd7lm_locked
                        THEN
                            new_entry_ptr^.lle_next_lock := entry_ptr
                        ELSE
                            BEGIN
                            IF  entry_ptr^.lle_next_lock <> NIL
                            THEN
                                BEGIN
                                new_entry_ptr^.lle_next_lock :=
                                      entry_ptr^.lle_next_lock;
                                entry_ptr^.lle_next_lock := NIL
                                END
                            (*ENDIF*) 
                            END;
                        (*ENDIF*) 
                        (* --- Establish first-request chain --- *)
                        IF  entry_ptr^.lle_first_request <> NIL
                        THEN
                            BEGIN
                            new_entry_ptr^.lle_first_request :=
                                  entry_ptr^.lle_first_request;
                            entry_ptr^.lle_first_request := NIL
                            END
                        ELSE
                            IF  entry_ptr^.lle_mode = bd7lm_requested
                            THEN
                                new_entry_ptr^.lle_first_request :=
                                      entry_ptr;
                            (* --- Revive resume_after_svp flag --- *)
                            (*ENDIF*) 
                        (*ENDIF*) 
                        IF  entry_ptr^.lle_resume_after_svp
                        THEN
                            BEGIN
                            new_entry_ptr^.lle_resume_after_svp := true;
                            entry_ptr^.lle_resume_after_svp := false;
                            END
                        (*ENDIF*) 
                        END
                    ELSE
                        (* The lockentry will not be added to the    *)
                        (* first position of the vertical double     *)
                        (* chained list.                             *)
                        BEGIN
                        WHILE  entry_ptr^.lle_leaf >= leaf DO
                            entry_ptr := entry_ptr^.lle_prev_eq_root;
                        (*ENDWHILE*) 
                        (* --- Establish vertical chain --- *)
                        new_entry_ptr^.lle_next_eq_root :=
                              entry_ptr^.lle_next_eq_root;
                        IF  entry_ptr^.lle_next_eq_root <> NIL
                        THEN
                            entry_ptr^.lle_next_eq_root^.lle_prev_eq_root :=
                                  new_entry_ptr;
                        (*ENDIF*) 
                        entry_ptr^.lle_next_eq_root := new_entry_ptr;
                        new_entry_ptr^.lle_prev_eq_root := entry_ptr;
                        (* --- Establish next-lock chain --- *)
                        IF  NOT last_lock
                        THEN
                            BEGIN
                            new_entry_ptr^.lle_next_lock :=
                                  prev_eq_ptr^.lle_next_lock;
                            prev_eq_ptr^.lle_next_lock := new_entry_ptr
                            END
                        (*ENDIF*) 
                        END;
                    (*ENDIF*) 
                    inserted := true
                    END
                ELSE
                    BEGIN
                    prev_eq_ptr := entry_ptr;
                    IF  entry_ptr^.lle_next_lock <> NIL
                    THEN
                        entry_ptr := entry_ptr^.lle_next_lock
                    ELSE
                        BEGIN
                        IF  NOT last_lock
                        THEN
                            BEGIN
                            entry_ptr^.lle_next_lock := new_entry_ptr;
                            last_lock := true
                            END;
                        (*ENDIF*) 
                        entry_ptr := entry_ptr^.lle_next_eq_root
                        END
                    (*ENDIF*) 
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
        UNTIL
            inserted
        (*ENDREPEAT*) 
        END
    ELSE
        BEGIN
        (* It doesn 't exist an entry with this root number, whether *)
        (* locked nor requested.                                     *)
        IF  rd_prev_ptr = rd_ptr
        THEN
            BEGIN
            b77locklist [rd_partition].tll_anchor^ [rd_hash] := new_entry_ptr;
            rd_prev_ptr := new_entry_ptr
            END
        ELSE
            rd_prev_ptr^.lle_next_diff_root := new_entry_ptr;
        (*ENDIF*) 
        new_entry_ptr^.lle_next_diff_root := rd_ptr;
        rd_ptr   := new_entry_ptr;
        rd_exist := true;
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
&ifdef TRACE
b77print_tree_locklist;
&endif
END;
 
(*------------------------------*) 
 
FUNCTION
      b77is_empty_locklist (VAR root_desc : tbd7_root_desc) : boolean;
 
VAR
      found    : boolean;
      root_ptr : tbd7_entry_ptr;
 
BEGIN
&ifdef TRACE
b77print_tree_locklist;
&endif
found := false;
IF  b77first_lock (root_desc, root_ptr)
THEN
    found := true;
(*ENDIF*) 
b77is_empty_locklist := NOT found
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77lconv_to_leaf (pid : tsp00_TaskId;
            VAR root_desc : tbd7_root_desc;
            leaf          : tsp00_PageNo;
            indexnode     : tsp00_PageNo;
            lockstate     : tbd_treelock);
 
VAR
      found, delete_old_entry  : boolean;
      last_lock                : boolean;
      entry_ptr, new_pos_ptr   : tbd7_entry_ptr;
      prev_eq_ptr              : tbd7_entry_ptr;
 
BEGIN
WITH root_desc DO
    BEGIN
    IF  rd_exist
    THEN
        BEGIN
&       ifdef TRACE
        IF  t01trace (bd_lock)
        THEN
            BEGIN
            t01p2int4 (bd_lock, 'pid         ', pid,
                  'root        ', rd_root);
            t01p2int4 (bd_lock, 'leaf        ', leaf,
                  'lockst      ', ord (lockstate));
            b77print_tree_locklist
            END;
&       endif
        (*ENDIF*) 
        delete_old_entry := true;
        found            := false;
        entry_ptr        := rd_ptr;
        prev_eq_ptr      := entry_ptr;
        new_pos_ptr      := entry_ptr;
        WHILE entry_ptr^.lle_pid <> pid DO
            BEGIN
            IF  entry_ptr^.lle_leaf < leaf
            THEN
                new_pos_ptr := entry_ptr;
            (*ENDIF*) 
            prev_eq_ptr := entry_ptr;
            entry_ptr   := entry_ptr^.lle_next_lock;
            IF  entry_ptr = NIL
            THEN
                g01abort (csp3_b77x2_lockentry_not_found,
                      csp3_n_treelock, 'lckentry not found (pid)', pid)
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        IF  entry_ptr = new_pos_ptr
        THEN
            BEGIN
            new_pos_ptr := new_pos_ptr^.lle_next_eq_root;
            prev_eq_ptr := new_pos_ptr
            END;
        (* *)
        (* Is it necessary to remove the old entry? *)
        (* *)
        (*ENDIF*) 
        IF  (entry_ptr^.lle_prev_eq_root = NIL)
        THEN
            IF  (entry_ptr^.lle_leaf > leaf) OR
                (entry_ptr^.lle_next_eq_root = NIL)
            THEN
                delete_old_entry := false
            ELSE
                BEGIN
                IF  (entry_ptr^.lle_next_eq_root <> NIL)
                THEN
                    IF  (entry_ptr^.lle_next_eq_root^.lle_leaf > leaf)
                    THEN
                        delete_old_entry := false
                    (*ENDIF*) 
                (*ENDIF*) 
                END
            (*ENDIF*) 
        ELSE
            IF  (entry_ptr^.lle_prev_eq_root^.lle_leaf <= leaf)
            THEN
                IF  (entry_ptr^.lle_next_eq_root <> NIL)
                THEN
                    BEGIN
                    IF  (entry_ptr^.lle_next_eq_root^.lle_leaf >= leaf)
                    THEN
                        delete_old_entry := false
                    (*ENDIF*) 
                    END
                ELSE
                    delete_old_entry := false;
                (*ENDIF*) 
            (* *)
            (* *)
            (*ENDIF*) 
        (*ENDIF*) 
        IF  delete_old_entry
        THEN
            (* Delete the old lockentry. *)
            BEGIN
            IF  entry_ptr^.lle_prev_eq_root = NIL
            THEN
                (* Delete head *)
                BEGIN
                (* --- Establish horizontal chain --- *)
                IF  rd_prev_ptr = entry_ptr
                THEN
                    BEGIN
                    b77locklist [rd_partition].tll_anchor^ [rd_hash] :=
                          entry_ptr^.lle_next_eq_root;
                    rd_prev_ptr := entry_ptr^.lle_next_eq_root
                    END
                ELSE
                    rd_prev_ptr^.lle_next_diff_root :=
                          entry_ptr^.lle_next_eq_root;
                (*ENDIF*) 
                rd_ptr := entry_ptr^.lle_next_eq_root;
                IF  entry_ptr^.lle_next_diff_root <> NIL
                THEN
                    BEGIN
                    entry_ptr^.lle_next_eq_root^.lle_next_diff_root :=
                          entry_ptr^.lle_next_diff_root;
                    entry_ptr^.lle_next_diff_root := NIL
                    END;
                (* --- Establish vertical chain --- *)
                (*ENDIF*) 
                entry_ptr^.lle_next_eq_root^.lle_prev_eq_root := NIL;
                (* --- Establish first-request chain --- *)
                IF  entry_ptr^.lle_first_request <> NIL
                THEN
                    BEGIN
                    IF  (entry_ptr^.lle_first_request <>
                        entry_ptr^.lle_next_eq_root)
                    THEN
                        entry_ptr^.lle_next_eq_root^.lle_first_request :=
                              entry_ptr^.lle_first_request;
                    (*ENDIF*) 
                    entry_ptr^.lle_first_request := NIL
                    END;
                (* ---- Establish next-lock chain ---- *)
                (*ENDIF*) 
                IF  entry_ptr^.lle_next_eq_root^.lle_mode = bd7lm_requested
                THEN
                    entry_ptr^.lle_next_eq_root^.lle_next_lock :=
                          entry_ptr^.lle_next_lock;
                (*ENDIF*) 
                entry_ptr^.lle_next_lock := NIL;
                (* --- Revive resume_after_svp --- *)
                IF  entry_ptr^.lle_resume_after_svp
                THEN
                    WITH entry_ptr^ DO
                        BEGIN
                        lle_resume_after_svp := false;
                        lle_next_eq_root^.lle_resume_after_svp := true
                        END
                    (*ENDWITH*) 
                (*ENDIF*) 
                END
            ELSE
                (* Delete within vertical chain *)
                BEGIN
                (* --- Establish vertical chain --- *)
                entry_ptr^.lle_prev_eq_root^.lle_next_eq_root :=
                      entry_ptr^.lle_next_eq_root;
                IF  entry_ptr^.lle_next_eq_root <> NIL
                THEN
                    entry_ptr^.lle_next_eq_root^.lle_prev_eq_root :=
                          entry_ptr^.lle_prev_eq_root;
                (* --- Establish next-lock chain --- *)
                (*ENDIF*) 
                prev_eq_ptr^.lle_next_lock := entry_ptr^.lle_next_lock;
                entry_ptr^.lle_next_lock := NIL
                END;
            (*ENDIF*) 
            (* *)
            (* Insert lockentry into vertical chain *)
            (* *)
            prev_eq_ptr := new_pos_ptr;
            last_lock   := false;
            found       := false;
            (* Determine new position for converted lockentry *)
            WHILE (new_pos_ptr^.lle_next_eq_root <> NIL) AND
                  NOT found DO
                IF  new_pos_ptr^.lle_leaf > leaf
                THEN
                    found := true
                ELSE
                    IF  new_pos_ptr^.lle_next_lock <> NIL
                    THEN
                        BEGIN
                        prev_eq_ptr := new_pos_ptr;
                        new_pos_ptr := new_pos_ptr^.lle_next_lock
                        END
                    ELSE
                        BEGIN
                        IF  NOT last_lock
                        THEN
                            BEGIN
                            prev_eq_ptr := new_pos_ptr;
                            last_lock := true
                            END;
                        (*ENDIF*) 
                        new_pos_ptr := new_pos_ptr^.lle_next_eq_root
                        END;
                    (*ENDIF*) 
                (*ENDIF*) 
            (*ENDWHILE*) 
            IF  NOT found AND (new_pos_ptr^.lle_leaf <= leaf)
            THEN
                (* *)
                (* Append lockentry to tail *)
                (* *)
                BEGIN
                new_pos_ptr^.lle_next_eq_root := entry_ptr;
                entry_ptr^.lle_prev_eq_root := new_pos_ptr;
                entry_ptr^.lle_next_eq_root := NIL;
                (* ---- Establish next-lock chain ---- *)
                IF  new_pos_ptr^.lle_mode = bd7lm_locked
                THEN
                    new_pos_ptr^.lle_next_lock := entry_ptr
                ELSE
                    prev_eq_ptr^.lle_next_lock := entry_ptr
                (*ENDIF*) 
                END
            ELSE
                IF  new_pos_ptr^.lle_prev_eq_root = NIL
                    (* *)
                    (* Insert lockentry to head *)
                    (* *)
                THEN
                    BEGIN
                    (* --- Establish horizontal chain --- *)
                    IF  rd_prev_ptr = new_pos_ptr
                    THEN
                        BEGIN
                        b77locklist [rd_partition].tll_anchor^ [rd_hash]
                              := entry_ptr;
                        rd_prev_ptr := entry_ptr
                        END
                    ELSE
                        rd_prev_ptr^.lle_next_diff_root := entry_ptr;
                    (*ENDIF*) 
                    rd_ptr := entry_ptr;
                    IF  new_pos_ptr^.lle_next_diff_root <> NIL
                    THEN
                        BEGIN
                        entry_ptr^.lle_next_diff_root :=
                              new_pos_ptr^.lle_next_diff_root;
                        new_pos_ptr^.lle_next_diff_root := NIL
                        END;
                    (* --- Establish vertical chain --- *)
                    (*ENDIF*) 
                    entry_ptr^.lle_prev_eq_root   := NIL;
                    entry_ptr^.lle_next_eq_root   := new_pos_ptr;
                    new_pos_ptr^.lle_prev_eq_root := entry_ptr;
                    (* ---- Establish first-request chain --- *)
                    IF  new_pos_ptr^.lle_first_request <> NIL
                    THEN
                        BEGIN
                        entry_ptr^.lle_first_request :=
                              new_pos_ptr^.lle_first_request;
                        new_pos_ptr^.lle_first_request := NIL
                        END
                    ELSE
                        IF  new_pos_ptr^.lle_mode = bd7lm_requested
                        THEN
                            entry_ptr^.lle_first_request := new_pos_ptr;
                        (* ---- Establish next-lock chain ---- *)
                        (*ENDIF*) 
                    (*ENDIF*) 
                    IF  new_pos_ptr^.lle_mode = bd7lm_locked
                    THEN
                        entry_ptr^.lle_next_lock := new_pos_ptr
                    ELSE
                        BEGIN
                        entry_ptr^.lle_next_lock :=
                              new_pos_ptr^.lle_next_lock;
                        new_pos_ptr^.lle_next_lock := NIL
                        END;
                    (*ENDIF*) 
                    (* --- Revive resume_after_svp --- *)
                    IF  new_pos_ptr^.lle_resume_after_svp
                    THEN
                        BEGIN
                        entry_ptr^.lle_resume_after_svp   := true;
                        new_pos_ptr^.lle_resume_after_svp := false
                        END
                    (*ENDIF*) 
                    END
                ELSE
                    BEGIN
                    (* Insert lockentry into the middle of the *)
                    (* vertical chain.                         *)
                    WHILE new_pos_ptr^.lle_leaf > leaf DO
                        new_pos_ptr := new_pos_ptr^.lle_prev_eq_root;
                    (*ENDWHILE*) 
                    (* --- Establish vertical chain --- *)
                    new_pos_ptr^.lle_next_eq_root^.lle_prev_eq_root :=
                          entry_ptr;
                    entry_ptr^.lle_next_eq_root :=
                          new_pos_ptr^.lle_next_eq_root;
                    new_pos_ptr^.lle_next_eq_root := entry_ptr;
                    entry_ptr^.lle_prev_eq_root := new_pos_ptr;
                    (* --- Establish next-lock chain --- *)
                    entry_ptr^.lle_next_lock :=
                          prev_eq_ptr^.lle_next_lock ;
                    prev_eq_ptr^.lle_next_lock := entry_ptr
                    END
                (*ENDIF*) 
            (*ENDIF*) 
            END;
        (*ENDIF*) 
        entry_ptr^.lle_state := lockstate;
        entry_ptr^.lle_leaf  := leaf;
        IF  indexnode <> cbd7_dummy_index
        THEN
            entry_ptr^.lle_index := indexnode
        (*ENDIF*) 
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      b77leaf_in_locklist (VAR root_desc : tbd7_root_desc;
            leaf : tsp00_PageNo;
            pid  : tsp00_TaskId) : boolean;
 
VAR
      found    : boolean;
      root_ptr : tbd7_entry_ptr;
 
BEGIN
&ifdef TRACE
b77print_tree_locklist;
&endif
found := false;
IF  b77first_lock (root_desc, root_ptr)
THEN
    REPEAT
        IF  root_ptr^.lle_leaf > leaf
        THEN
            root_ptr := NIL
        ELSE
            BEGIN
            IF  (root_ptr^.lle_leaf = leaf)
            THEN
                IF  ((root_ptr^.lle_state = r_lock_leaf) OR
                    (root_ptr^.lle_state  = w_lock_leaf)) AND
                    (root_ptr^.lle_pid <> pid)
                THEN
                    BEGIN
                    root_desc.rd_collision_ptr := root_ptr;
                    found := true
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            root_ptr := root_ptr^.lle_next_lock
            END;
        (*ENDIF*) 
    UNTIL
        found OR (root_ptr = NIL);
    (*ENDREPEAT*) 
(*ENDIF*) 
b77leaf_in_locklist := found
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77liconv_to_index_lock (VAR root_desc : tbd7_root_desc;
            pid       : tsp00_TaskId;
            indexnode : tsp00_PageNo;
            lockstate : tbd_treelock);
 
VAR
      found    : boolean;
      root_ptr : tbd7_entry_ptr;
 
BEGIN
WITH b77locklist [root_desc.rd_partition] DO
    BEGIN
    found := false;
    IF  b77first_lock (root_desc, root_ptr)
    THEN
        BEGIN
&       ifdef TRACE
        IF  t01trace (bd_lock)
        THEN
            BEGIN
            t01p2int4 (bd_lock, 'pid         ', pid,
                  'root        ', root_desc.rd_root);
            t01p2int4 (bd_lock, 'indexnode   ', indexnode,
                  'lockst      ', ord (lockstate));
            b77print_tree_locklist
            END;
&       endif
        (*ENDIF*) 
        REPEAT
            IF  root_ptr^.lle_pid = pid
            THEN
                BEGIN
                root_ptr^.lle_state := lockstate;
                root_ptr^.lle_index := indexnode;
                IF  lockstate = w_lock_index
                THEN
                    tll_split_counter := succ (tll_split_counter);
                (*ENDIF*) 
                found := true
                END
            ELSE
                root_ptr := root_ptr^.lle_next_lock;
            (*ENDIF*) 
        UNTIL
            found OR (root_ptr = NIL)
        (*ENDREPEAT*) 
        END
    (*ENDIF*) 
    END;
(*ENDWITH*) 
IF  NOT found
THEN
    g01abort (csp3_b77x4_lockentry_not_found, csp3_n_treelock,
          'lckentry not found (pid)', pid);
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      b77lleaf_in_locklist (VAR root_desc : tbd7_root_desc;
            leaf      : tsp00_PageNo;
            lockstate : tbd_treelock;
            pid       : tsp00_TaskId) : boolean;
 
VAR
      found    : boolean;
      root_ptr : tbd7_entry_ptr;
 
BEGIN
&ifdef TRACE
b77print_tree_locklist;
&endif
found := false;
IF  b77first_lock (root_desc, root_ptr)
THEN
    REPEAT
        IF  root_ptr^.lle_leaf > leaf
        THEN
            root_ptr := NIL
        ELSE
            BEGIN
            IF  root_ptr^.lle_leaf = leaf
            THEN
                IF  (root_ptr^.lle_state = lockstate) AND
                    (root_ptr^.lle_pid <> pid)
                THEN
                    BEGIN
                    root_desc.rd_collision_ptr := root_ptr;
                    found := true
                    END;
                (*ENDIF*) 
            (*ENDIF*) 
            root_ptr := root_ptr^.lle_next_lock
            END;
        (*ENDIF*) 
    UNTIL
        found OR (root_ptr = NIL);
    (*ENDREPEAT*) 
(*ENDIF*) 
b77lleaf_in_locklist := found
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77show_treelocklist (VAR current : tbd_current_tree;
            VAR rec_count : tsp00_Int4;
            partition     : integer);
 
VAR
      hashaddress  : tsp00_Int4;
      loop_counter : tsp00_Int4;
      entry_ptr    : tbd7_entry_ptr;
      help_ptr     : tbd7_entry_ptr;
 
BEGIN
WITH b77locklist [partition], current, curr_trans^ DO
    BEGIN
    hashaddress  := 1;
    loop_counter := 0;
    WHILE (hashaddress <= tll_hashsize     ) AND
          (trError_gg00 = e_ok                   ) AND
          (loop_counter <= tll_locklistsize) DO
        BEGIN
        IF  tll_anchor^ [hashaddress] <> NIL
        THEN
            BEGIN
            entry_ptr := tll_anchor^ [hashaddress];
            REPEAT
                bd77move_into_file (current, rec_count, entry_ptr);
                loop_counter := succ (loop_counter);
                IF  (entry_ptr^.lle_next_eq_root <> NIL) AND
                    (trError_gg00 = e_ok                     ) AND
                    (loop_counter <= tll_locklistsize  )
                THEN
                    BEGIN
                    help_ptr := entry_ptr^.lle_next_eq_root;
                    REPEAT
                        bd77move_into_file (current, rec_count,
                              help_ptr);
                        loop_counter := succ (loop_counter);
                        help_ptr := help_ptr^.lle_next_eq_root
                    UNTIL
                        (help_ptr = NIL) OR
                        (trError_gg00 <> e_ok) OR
                        (loop_counter > tll_locklistsize)
                    (*ENDREPEAT*) 
                    END;
                (*ENDIF*) 
                entry_ptr := entry_ptr^.lle_next_diff_root
            UNTIL
                (entry_ptr = NIL) OR
                (trError_gg00 <> e_ok ) OR
                (loop_counter > tll_locklistsize)
            (*ENDREPEAT*) 
            END;
        (*ENDIF*) 
        hashaddress := succ (hashaddress)
        END
    (*ENDWHILE*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      b77stree_in_locklist (VAR root_desc : tbd7_root_desc) : boolean;
 
VAR
      found    : boolean;
      root_ptr : tbd7_entry_ptr;
 
BEGIN
&ifdef TRACE
b77print_tree_locklist;
&endif
found := false;
IF  b77first_lock (root_desc, root_ptr)
THEN
    REPEAT
        IF  root_ptr^.lle_state = s_lock_tree
        THEN
            BEGIN
            root_desc.rd_collision_ptr := root_ptr;
            found := true
            END
        ELSE
            root_ptr := root_ptr^.lle_next_lock;
        (*ENDIF*) 
    UNTIL
        found OR (root_ptr = NIL);
    (*ENDREPEAT*) 
(*ENDIF*) 
b77stree_in_locklist := found
END;
 
(*------------------------------*) 
 
FUNCTION
      b77tree_in_locklist (VAR root_desc : tbd7_root_desc) : boolean;
 
VAR
      found    : boolean;
      root_ptr : tbd7_entry_ptr;
 
BEGIN
&ifdef TRACE
b77print_tree_locklist;
&endif
found := false;
IF  b77first_lock (root_desc, root_ptr)
THEN
    REPEAT
        IF  (root_ptr^.lle_state = w_lock_tree) OR
            (root_ptr^.lle_state = d_lock_tree)
        THEN
            BEGIN
            root_desc.rd_collision_ptr := root_ptr;
            found := true
            END
        ELSE
            root_ptr := root_ptr^.lle_next_lock;
        (*ENDIF*) 
    UNTIL
        found OR (root_ptr = NIL);
    (*ENDREPEAT*) 
(*ENDIF*) 
b77tree_in_locklist := found
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77set_not_generated;
 
VAR
      partition : integer;
 
BEGIN
FOR partition := 0 TO  b75region_cnt - 1 DO
    b77locklist [partition].tll_generated := false
(*ENDFOR*) 
END;
 
&ifdef TRACE
(*------------------------------*) 
 
PROCEDURE
      b77pointer_check (pointer : tbd7_entry_ptr;
            root : tsp00_PageNo);
 
VAR
      partition   : integer;
      found       : boolean;
      lockelement : tsp00_Int2;
      hlp         : tbd7_entry_ptr;
 
BEGIN
partition := root MOD b75region_cnt;
WITH b77locklist [partition] DO
    BEGIN
    found       := false;
    lockelement := 1;
    WHILE ( lockelement <= tll_locklistsize ) AND ( NOT found ) DO
        BEGIN
        hlp := @tll_entry^ [lockelement];
        IF  pointer = hlp
        THEN
            found := true
        ELSE
            lockelement := succ (lockelement)
        (*ENDIF*) 
        END;
    (*ENDWHILE*) 
    IF  NOT found
    THEN
        BEGIN
        t01addr (bd_lock, '*** BAD PTR ', pointer);
        g01check (csp3_b77c1_illegal_pointer, csp3_n_treelock,
              'BD77: illegal pointer   ', 0, found)
        END
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
&endif
&ifdef TRACE
(*------------------------------*) 
 
PROCEDURE
      b77print_tree_locklist;
 
VAR
      partition   : integer;
      hashaddress : tsp00_Int4;
      entry_ptr   : tbd7_entry_ptr;
      help_ptr    : tbd7_entry_ptr;
 
BEGIN
IF  t01trace (bd_lock)
THEN
    BEGIN
    FOR partition := 0 TO  b75region_cnt - 1 DO
        WITH b77locklist [partition] DO
            BEGIN
            FOR hashaddress := 1 TO tll_hashsize DO
                IF  tll_anchor^ [hashaddress] <> NIL
                THEN
                    BEGIN
                    entry_ptr := tll_anchor^ [hashaddress];
                    REPEAT
                        bd77print_tree_locklist (entry_ptr);
                        IF   entry_ptr^.lle_next_eq_root <> NIL
                        THEN
                            BEGIN
                            help_ptr := entry_ptr^.lle_next_eq_root;
                            REPEAT
                                bd77print_tree_locklist (help_ptr);
                                help_ptr := help_ptr^.lle_next_eq_root;
                            UNTIL
                                help_ptr = NIL
                            (*ENDREPEAT*) 
                            END;
                        (*ENDIF*) 
                        entry_ptr := entry_ptr^.lle_next_diff_root;
                    UNTIL
                        entry_ptr = NIL
                    (*ENDREPEAT*) 
                    END
                (*ENDIF*) 
            (*ENDFOR*) 
            END
        (*ENDWITH*) 
    (*ENDFOR*) 
    END
(*ENDIF*) 
END;
 
&endif
(*------------------------------*) 
 
PROCEDURE
      b77reset_lock (pid : tsp00_TaskId;
            VAR root_desc    : tbd7_root_desc;
            VAR old_locktype : tbd_treelock);
 
VAR
      found     : boolean;
      root_ptr  : tbd7_entry_ptr;
 
BEGIN
WITH b77locklist [root_desc.rd_partition] DO
    BEGIN
    found := false;
    IF  b77first_lock (root_desc, root_ptr)
    THEN
        BEGIN
&       ifdef TRACE
        IF  t01trace (bd_lock)
        THEN
            BEGIN
            t01p2int4 (bd_lock, 'pid         ', pid,
                  'root        ', root_desc.rd_root);
            b77print_tree_locklist
            END;
&       endif
        (*ENDIF*) 
        REPEAT
            IF  root_ptr^.lle_pid = pid
            THEN
                BEGIN
                old_locktype          := root_ptr^.lle_state;
                root_ptr^.lle_state   := r_lock_tree;
                root_ptr^.lle_index   := NIL_PAGE_NO_GG00;
                IF  (old_locktype = w_lock_tree) OR
                    (old_locktype = d_lock_tree) OR
                    (old_locktype = w_lock_index)
                THEN
                    tll_split_counter := pred (tll_split_counter);
                (*ENDIF*) 
                IF  root_ptr^.lle_ignore_svp
                THEN
                    BEGIN
                    tll_svp_ignore_cnt := pred (tll_svp_ignore_cnt);
                    root_ptr^.lle_ignore_svp  := false
                    END;
                (*ENDIF*) 
                found := true
                END
            ELSE
                root_ptr := root_ptr^.lle_next_lock;
            (*ENDIF*) 
        UNTIL
            found OR (root_ptr = NIL)
        (*ENDREPEAT*) 
        END;
    (*ENDIF*) 
    IF  NOT found
    THEN
        g01abort (csp3_b77x5_lockentry_not_found, csp3_n_treelock,
              'lckentry not found (pid)', pid);
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77tconv_to_tree (pid : tsp00_TaskId;
            VAR root_desc : tbd7_root_desc;
            leaf          : tsp00_PageNo;
            lockstate     : tbd_treelock);
 
VAR
      found         : boolean;
      old_lockstate : tbd_treelock;
      root_ptr      : tbd7_entry_ptr;
 
BEGIN
WITH b77locklist [root_desc.rd_partition] DO
    BEGIN
    found := false;
    IF  b77first_lock (root_desc, root_ptr)
    THEN
        BEGIN
&       ifdef TRACE
        IF  t01trace (bd_lock)
        THEN
            BEGIN
            t01p2int4 (bd_lock, 'pid         ', pid,
                  'root        ', root_desc.rd_root);
            t01p2int4 (bd_lock, 'leaf        ', leaf,
                  'lockst      ', ord (lockstate));
            b77print_tree_locklist
            END;
&       endif
        (*ENDIF*) 
        REPEAT
            IF  root_ptr^.lle_pid = pid
            THEN
                BEGIN
                old_lockstate       := root_ptr^.lle_state;
                root_ptr^.lle_state := lockstate;
                root_ptr^.lle_leaf  := leaf;
                IF  (lockstate = w_lock_tree      ) AND
                    (old_lockstate <> w_lock_index)
                THEN
                    tll_split_counter := succ (tll_split_counter);
                (*ENDIF*) 
                found := true
                END
            ELSE
                root_ptr := root_ptr^.lle_next_lock;
            (*ENDIF*) 
        UNTIL
            found  OR (root_ptr = NIL)
        (*ENDREPEAT*) 
        END;
    (*ENDIF*) 
    IF  NOT found
    THEN
        g01abort (csp3_b77x6_lockentry_not_found, csp3_n_treelock,
              'lckentry not found (pid)', pid)
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      b77write_index_locked (VAR root_desc : tbd7_root_desc;
            indexnode : tsp00_PageNo) : boolean;
 
VAR
      found    : boolean;
      root_ptr : tbd7_entry_ptr;
 
BEGIN
&ifdef TRACE
b77print_tree_locklist;
&endif
found := false;
IF  b77first_lock (root_desc, root_ptr)
THEN
    REPEAT
        IF  (root_ptr^.lle_state = w_lock_index) AND
            (root_ptr^.lle_index = indexnode)
        THEN
            BEGIN
            root_desc.rd_collision_ptr := root_ptr;
            found := true
            END
        ELSE
            root_ptr := root_ptr^.lle_next_lock;
        (*ENDIF*) 
    UNTIL
        found OR (root_ptr = NIL);
    (*ENDREPEAT*) 
(*ENDIF*) 
b77write_index_locked := found
END;
 
(*------------------------------*) 
 
FUNCTION
      bd77is_in_freelist (pointer : tbd7_entry_ptr) : boolean;
 
VAR
      partition : integer;
      found     : boolean;
      free_ptr  : tbd7_entry_ptr;
 
BEGIN
found := false;
IF  pointer <> NIL
THEN
    BEGIN
    partition := pointer^.lle_root MOD b75region_cnt;
    free_ptr := b77locklist [partition].tll_free_entry;
    WHILE (free_ptr <> NIL) AND (NOT found) DO
        IF  free_ptr = pointer
        THEN
            found := true
        ELSE
            free_ptr := free_ptr^.lle_next_diff_root
        (*ENDIF*) 
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
bd77is_in_freelist := found
END;
 
(*------------------------------*) 
 
PROCEDURE
      bd77break (check_msg24 : tsp00_C24; entry_ptr : tbd7_entry_ptr);
 
BEGIN
&ifdef TRACE
t01addr (bd_lock, '** BAD entry', entry_ptr);
&endif
g01abort (csp3_b77x1_check, csp3_n_treelock, check_msg24, 0)
END;
 
(*------------------------------*) 
 
PROCEDURE
      bd77check_locklist (
            entry_ptr     : tbd7_entry_ptr;
            prevent_split : boolean);
 
VAR
      hlp : tbd7_entry_ptr;
 
BEGIN
WHILE entry_ptr <> NIL DO
    BEGIN
    bd77cycle_check (entry_ptr);
    bd77locksem_check (entry_ptr, prevent_split);
    (* *)
    (* Is horizontal single chained list in ascending order? *)
    (* *)
    IF  entry_ptr^.lle_next_diff_root <> NIL
    THEN
        IF  NOT (entry_ptr^.lle_root <
            entry_ptr^.lle_next_diff_root^.lle_root)
        THEN
            bd77break ('B77check7               ', entry_ptr);
        (*ENDIF*) 
    (*ENDIF*) 
    IF  entry_ptr^.lle_next_eq_root <> NIL
    THEN
        BEGIN
        bd77locknext_check (entry_ptr);
        bd77requestnext_check (entry_ptr);
        hlp := entry_ptr^.lle_next_eq_root;
        WHILE hlp <> NIL DO
            BEGIN
            bd77cycle_check (hlp);
            IF  (hlp^.lle_prev_eq_root^.lle_root <> hlp^.lle_root)
            THEN
                bd77break ('B77check8               ', entry_ptr);
            (* Is there a horizontal chain? *)
            (*ENDIF*) 
            IF  hlp^.lle_next_diff_root <> NIL
            THEN
                bd77break ('B77check9               ', hlp);
            (*ENDIF*) 
            hlp := hlp^.lle_next_eq_root
            END
        (*ENDWHILE*) 
        END;
    (*ENDIF*) 
    entry_ptr := entry_ptr^.lle_next_diff_root
    END
(*ENDWHILE*) 
END;
 
&ifdef TRACE
(*------------------------------*) 
 
PROCEDURE
      bd77cleanentry (entry_ptr : tbd7_entry_ptr);
 
BEGIN
IF  (entry_ptr^.lle_next_lock <> NIL) OR
    (entry_ptr^.lle_next_request <> NIL) OR
    (entry_ptr^.lle_first_request <> NIL) OR
    (entry_ptr^.lle_prev_eq_root <> NIL) OR
    (entry_ptr^.lle_next_eq_root <> NIL) OR
    entry_ptr^.lle_resume_after_svp
THEN
    BEGIN
    t01addr (bd_lock, '*** BAD PTR ', entry_ptr);
    g01check (csp3_b77c2_illegal_pointer, csp3_n_treelock,
          'BD77: POINTER NOT NIL   ', 0, false)
    END
(*ENDIF*) 
END;
 
&endif
(*------------------------------*) 
 
PROCEDURE
      bd77cycle_check (entry_ptr : tbd7_entry_ptr);
 
BEGIN
IF  (entry_ptr = entry_ptr^.lle_next_diff_root) OR
    (entry_ptr = entry_ptr^.lle_next_eq_root) OR
    (entry_ptr = entry_ptr^.lle_prev_eq_root) OR
    (entry_ptr = entry_ptr^.lle_next_lock) OR
    (entry_ptr = entry_ptr^.lle_next_request) OR
    (entry_ptr = entry_ptr^.lle_first_request)
THEN
    bd77break ('B77check6               ', entry_ptr)
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      bd77insert_lockentry (pid : tsp00_TaskId;
            root       : tsp00_PageNo;
            partition  : integer;
            leaf       : tsp00_PageNo;
            lockstate  : tbd_treelock;
            ignore_svp : boolean) : tbd7_entry_ptr;
 
VAR
      new_entry_ptr : tbd7_entry_ptr;
 
BEGIN
WITH b77locklist [partition] DO
    BEGIN
&   ifdef TRACE
    b77pointer_check (tll_free_entry, root);
&   endif
    new_entry_ptr  := tll_free_entry;
    tll_free_entry := tll_free_entry^.lle_next_diff_root;
    IF  new_entry_ptr^.lle_index <> NIL_PAGE_NO_GG00
    THEN
        g01abort (csp3_b77x1_index_occupied, csp3_n_treelock,
              'index occupied (pid):   ', pid);
    (*ENDIF*) 
    new_entry_ptr^.lle_next_diff_root  := NIL;
    new_entry_ptr^.lle_pid             := pid;
    new_entry_ptr^.lle_root            := root;
    new_entry_ptr^.lle_leaf            := leaf;
    new_entry_ptr^.lle_state           := lockstate;
    new_entry_ptr^.lle_mode            := bd7lm_locked;
    new_entry_ptr^.lle_ignore_svp      := ignore_svp;
    (* PTS 1106058 TS 2000-03-28 *)
    new_entry_ptr^.lle_excl_lock_exist := false;
    (* PTS 1106058 *)
    END;
(*ENDWITH*) 
bd77insert_lockentry := new_entry_ptr;
END;
 
(*------------------------------*) 
 
PROCEDURE
      bd77locksem_check (entry_ptr : tbd7_entry_ptr;
            prevent_split : boolean);
 
VAR
      found                     : boolean;
      found_lock, found_request : boolean;
      jumper, original          : tbd7_entry_ptr;
 
BEGIN
original := entry_ptr;
WHILE entry_ptr <> NIL DO
    BEGIN
    jumper := original;
    CASE entry_ptr^.lle_state OF
        s_lock_tree :
            WHILE jumper <> NIL DO
                BEGIN
                IF  (
                    (jumper^.lle_state   = w_lock_leaf) OR
                    (jumper^.lle_state   = d_lock_tree) OR
                    (jumper^.lle_state   = w_lock_tree) OR
                    (jumper^.lle_state   = w_lock_index)
                    )
                    AND
                    (jumper^.lle_mode    = bd7lm_locked)
                    AND
                    (entry_ptr^.lle_mode = bd7lm_locked)
                THEN
                    bd77break ('B77check1               ', jumper);
                (*ENDIF*) 
                jumper := jumper^.lle_next_eq_root
                END;
            (*ENDWHILE*) 
        r_lock_tree :
            BEGIN
            found := false;
            WHILE jumper <> NIL DO
                BEGIN
                IF  (jumper^.lle_mode      = bd7lm_locked)
                    AND
                    (entry_ptr^.lle_mode   = bd7lm_locked)
                    AND
                    (
                    (jumper^.lle_state     = w_lock_tree) OR
                    (jumper^.lle_state    = d_lock_tree)
                    )
                THEN
                    bd77break ('B77check2               ', jumper);
                (* *)
                (* Is there a not resumed task with a r_lock_tree? *)
                (* *)
                (*ENDIF*) 
                IF  (jumper^.lle_state = d_lock_tree)
                    OR
                    (jumper^.lle_state = w_lock_tree)
                THEN
                    found := true;
                (*ENDIF*) 
                jumper := jumper^.lle_next_eq_root
                END;
            (*ENDWHILE*) 
            IF  (entry_ptr^.lle_mode = bd7lm_requested) AND NOT found
            THEN
                bd77break ('B77check10              ', entry_ptr)
            (*ENDIF*) 
            END;
        r_lock_leaf :
            BEGIN
            found := false;
            WHILE jumper <> NIL DO
                BEGIN
                IF  (
                    ((jumper^.lle_state    = w_lock_leaf) AND
                    (jumper^.lle_leaf      = entry_ptr^.lle_leaf))
                    OR
                    ((jumper^.lle_state    = w_lock_tree) OR
                    (jumper^.lle_state     = d_lock_tree))
                    OR
                    ((entry_ptr^.lle_index = jumper^.lle_index) AND
                    (jumper^.lle_state     = w_lock_index))
                    )
                    AND
                    (jumper^.lle_mode      = bd7lm_locked)
                    AND
                    (entry_ptr^.lle_mode   = bd7lm_locked)
                THEN
                    bd77break ('B77check3               ', jumper);
                (* *)
                (* Is there a not resumed task with a r_lock_leaf? *)
                (* *)
                (*ENDIF*) 
                IF  ((jumper^.lle_mode  = bd7lm_locked)    OR
                    (jumper^.lle_mode   = bd7lm_requested))
                    AND
                    (jumper^.lle_state = w_lock_leaf)
                    AND
                    (jumper^.lle_leaf  = entry_ptr^.lle_leaf)
                THEN
                    found := true;
                (*ENDIF*) 
                jumper := jumper^.lle_next_eq_root
                END;
            (*ENDWHILE*) 
            IF  (entry_ptr^.lle_mode = bd7lm_requested) AND NOT found
            THEN
                bd77break ('B77check11              ', entry_ptr)
            (*ENDIF*) 
            END;
        r_lock_index :
            BEGIN
            IF  (entry_ptr^.lle_mode = bd7lm_requested)
            THEN
                BEGIN
                found := false;
                WHILE jumper <> NIL DO
                    BEGIN
                    IF  (jumper^.lle_state = w_lock_index)
                        AND
                        (jumper^.lle_index  = entry_ptr^.lle_index)
                    THEN
                        found := true;
                    (*ENDIF*) 
                    jumper := jumper^.lle_next_eq_root
                    END;
                (*ENDWHILE*) 
                IF  NOT found
                THEN
                    bd77break ('B77check19              ', entry_ptr)
                (*ENDIF*) 
                END
            (*ENDIF*) 
            END;
        w_lock_index :
            BEGIN
            (* PTS 1107109 TS 2000-07-17 *)
            WHILE jumper <> NIL DO
                BEGIN
                IF  (
                    (jumper^.lle_mode     = bd7lm_locked)
                    AND
                    (entry_ptr^.lle_mode  = bd7lm_locked)
                    AND
                    (entry_ptr <> jumper)
                    )
                    AND
                    (
                    (jumper^.lle_index = entry_ptr^.lle_index)
                    OR
                    (jumper^.lle_state = w_lock_tree)
                    OR
                    (jumper^.lle_state = d_lock_tree)
                    )
                THEN
                    bd77break ('B77check13              ', jumper);
                (*ENDIF*) 
                jumper := jumper^.lle_next_eq_root
                END;
            (*ENDWHILE*) 
            IF  (entry_ptr^.lle_mode = bd7lm_requested)
            THEN
                BEGIN
                found  := false;
                jumper := original;
                WHILE jumper <> NIL DO
                    BEGIN
                    IF  (jumper^.lle_mode = bd7lm_locked)
                        AND
                        (
                        (jumper^.lle_index = entry_ptr^.lle_index)
                        OR
                        (jumper^.lle_state = s_lock_tree)
                        )
                    THEN
                        found := true;
                    (*ENDIF*) 
                    jumper := jumper^.lle_next_eq_root
                    END;
                (*ENDWHILE*) 
                IF  NOT found AND NOT prevent_split
                THEN
                    bd77break ('B77check20              ', entry_ptr)
                (*ENDIF*) 
                END;
            (* PTS 1107109 *)
            (*ENDIF*) 
            END;
        w_lock_tree, d_lock_tree :
            BEGIN
            (* PTS 1107109 TS 2000-07-17 *)
            IF  (entry_ptr^.lle_mode = bd7lm_locked)
            THEN
                BEGIN
                WHILE jumper <> NIL DO
                    BEGIN
                    IF  (
                        (jumper^.lle_mode = bd7lm_locked) AND
                        (jumper           <> entry_ptr  )
                        )
                        OR
                        (
                        (jumper^.lle_mode  = bd7lm_requested) AND
                        (jumper^.lle_state <> d_lock_tree   ) AND
                        (jumper^.lle_state <> w_lock_tree   ) AND
                        (jumper^.lle_state <> r_lock_tree   )
                        )
                    THEN
                        bd77break ('B77check21              ', jumper);
                    (*ENDIF*) 
                    jumper := jumper^.lle_next_eq_root
                    END
                (*ENDWHILE*) 
                END;
            (* PTS 1107109 *)
            (*ENDIF*) 
            END;
        OTHERWISE
            BEGIN
            END
        END;
    (*ENDCASE*) 
    jumper        := original;
    found_request := false;
    found_lock    := false;
    WHILE jumper <> NIL DO
        BEGIN
        IF  jumper^.lle_mode = bd7lm_requested
        THEN
            found_request := true
        ELSE
            found_lock := true;
        (*ENDIF*) 
        jumper := jumper^.lle_next_eq_root
        END;
    (*ENDWHILE*) 
    IF  found_request  AND
        NOT found_lock AND
        NOT original^.lle_resume_after_svp
    THEN
        bd77break ('B77check14              ', entry_ptr);
    (*ENDIF*) 
    IF  ((entry_ptr^.lle_root <> NIL_PAGE_NO_GG00 ) AND
        bd77is_in_freelist (entry_ptr))
    THEN
        bd77break ('B77check5               ', entry_ptr);
    (*ENDIF*) 
    entry_ptr := entry_ptr^.lle_next_eq_root
    END
(*ENDWHILE*) 
END;
 
&ifdef TRACE
(*------------------------------*) 
 
PROCEDURE
      bd77print_tree_locklist (ptr : tbd7_entry_ptr);
 
BEGIN
WITH ptr^ DO
    BEGIN
    t01addr (bd_lock, 'address     ', ptr);
    t01int4 (bd_lock, 'root        ', lle_root);
    t01int4 (bd_lock, 'leaf        ', lle_leaf);
    t01int4 (bd_lock, 'index       ', lle_index);
    t01int4 (bd_lock, 'pid         ', lle_pid);
    t01int4 (bd_lock, 'lockstate   ', ord(lle_state));
    t01int4 (bd_lock, 'mode        ', ord(lle_mode));
    IF  lle_next_diff_root <> NIL
    THEN
        t01addr (bd_lock, 'next_diff_ro', lle_next_diff_root);
    (*ENDIF*) 
    IF  lle_next_eq_root <> NIL
    THEN
        t01addr (bd_lock, 'next_eq_root', lle_next_eq_root);
    (*ENDIF*) 
    IF  lle_prev_eq_root <> NIL
    THEN
        t01addr (bd_lock, 'prev_eq_root', lle_prev_eq_root);
    (*ENDIF*) 
    IF  lle_next_lock <> NIL
    THEN
        t01addr (bd_lock, 'next_lock   ', lle_next_lock);
    (*ENDIF*) 
    IF  lle_next_request <> NIL
    THEN
        t01addr (bd_lock, 'next_request', lle_next_request);
    (*ENDIF*) 
    IF  lle_first_request <> NIL
    THEN
        t01addr (bd_lock, 'first_reques', lle_first_request)
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
&endif
(*------------------------------*) 
 
PROCEDURE
      bd77locknext_check (entry_ptr : tbd7_entry_ptr);
 
VAR
      jumper : tbd7_entry_ptr;
 
BEGIN
jumper := entry_ptr;
WHILE jumper <> NIL DO
    BEGIN
    IF  (jumper^.lle_mode = bd7lm_requested) AND
        (jumper^.lle_prev_eq_root <> NIL) AND
        (jumper^.lle_next_lock <> NIL)
    THEN
        bd77break('B77check15              ', jumper);
    (*ENDIF*) 
    IF  (jumper^.lle_mode = bd7lm_locked) AND
        (jumper^.lle_prev_eq_root <> NIL)
    THEN
        BEGIN
        IF  entry_ptr^.lle_next_lock <> jumper
        THEN
            BEGIN
&           ifdef TRACE
            t01addr (bd_lock, 'entry_ptr   ', entry_ptr);
&           endif
            bd77break('B77check4               ', jumper);
            END;
        (*ENDIF*) 
        entry_ptr := entry_ptr^.lle_next_lock
        END;
    (*ENDIF*) 
    jumper := jumper^.lle_next_eq_root;
    END
(*ENDWHILE*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      bd77move_into_file (VAR current : tbd_current_tree;
            VAR rec_count : tsp00_Int4;
            entry_ptr     : tbd7_entry_ptr);
 
VAR
      n   : tsp00_Sname;
      rec : tgg00_Rec;
 
BEGIN
WITH entry_ptr^, current, curr_trans^ DO
    BEGIN
    rec_count  := rec_count + 1;
    rec.keylen := sizeof (rec_count);
    rec.len    := cgg_rec_key_offset;
    (* *)
    s20ch4l (rec_count, rec.buf, rec.len + 1);
    rec.len    := rec.len + sizeof (rec_count) + 1;
    rec.buf [rec.len] := ' ';
    (* *)
    s20ch4l (lle_root, rec.buf, rec.len + 1);
    rec.len    := rec.len + sizeof (lle_root) + 1;
    rec.buf [rec.len] := ' ';
    (* *)
    s20ch4l (lle_index, rec.buf, rec.len + 1);
    rec.len    := rec.len + sizeof (lle_index) + 1;
    rec.buf [rec.len] := ' ';
    (* *)
    s20ch4l (lle_leaf, rec.buf, rec.len + 1);
    rec.len    := rec.len + sizeof (lle_leaf) + 1;
    rec.buf [rec.len] := ' ';
    (* *)
    s20ch4b (lle_pid, rec.buf, rec.len + 1);
    rec.len    := rec.len + sizeof (lle_pid) + 1;
    rec.buf [rec.len] := ' ';
    (* *)
    CASE lle_state OF
        no_bd_lock:
            n := 'no_bd_lock  ';
        r_lock_tree:
            n := 'r_lock_tree ';
        r_lock_leaf:
            n := 'r_lock_leaf ';
        w_lock_leaf:
            n := 'w_lock_leaf ';
        w_lock_tree:
            n := 'w_lock_tree ';
        s_lock_tree:
            n := 's_lock_tree ';
        r_lock_index:
            n := 'r_lock_index';
        w_lock_index:
            n := 'w_lock_index';
        d_lock_tree:
            n := 'd_lock_tree ';
        OTHERWISE
            n := 'undef       '
        END;
    (*ENDCASE*) 
    g10mv3 ('VBD77 ',  10,    
          sizeof (n), sizeof (rec.buf),
          n, 1, rec.buf, rec.len +1, sizeof (n), trError_gg00);
    rec.len := rec.len + sizeof (n) + 1;
    rec.buf [rec.len] := ' ';
    (* *)
    CASE lle_mode OF
        bd7lm_nil :
            n := 'NONE        ';
        bd7lm_locked :
            n := 'LOCK        ';
        bd7lm_requested :
            n := 'REQ         ';
        OTHERWISE
            n := 'UNDEF       ';
        END;
    (*ENDCASE*) 
    g10mv3 ('VBD77 ',  11,    
          sizeof (n), sizeof (rec.buf),
          n, 1, rec.buf, rec.len +1, 5, trError_gg00);
    rec.len := rec.len + 5;
    IF  trError_gg00= e_ok
    THEN
        b07cadd_record (curr_trans^, curr_tree_id, rec)
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      bd77requestnext_check (entry_ptr : tbd7_entry_ptr);
 
VAR
      found            : boolean;
      jumper, original : tbd7_entry_ptr;
 
BEGIN
IF  entry_ptr^.lle_first_request <> NIL
THEN
    original := entry_ptr^.lle_first_request
ELSE
    IF  entry_ptr^.lle_mode = bd7lm_requested
    THEN
        original := entry_ptr
    ELSE
        original := NIL;
    (*ENDIF*) 
(*ENDIF*) 
WHILE entry_ptr <> NIL DO
    BEGIN
    IF  entry_ptr^.lle_mode = bd7lm_requested
    THEN
        BEGIN
        jumper := original;
        found  := false;
        WHILE (jumper <> NIL) AND NOT found DO
            BEGIN
            IF  jumper = entry_ptr
            THEN
                found := true;
            (*ENDIF*) 
            jumper := jumper^.lle_next_request;
            IF  bd77is_in_freelist (jumper)
            THEN
                bd77break ('B77check16              ', jumper)
            (*ENDIF*) 
            END;
        (*ENDWHILE*) 
        IF  NOT found
        THEN
            bd77break ('B77check12              ', entry_ptr)
        (*ENDIF*) 
        END;
    (*ENDIF*) 
    entry_ptr := entry_ptr^.lle_next_eq_root
    END
(*ENDWHILE*) 
END;
 
(*------------------------------*) 
 
FUNCTION
      bd77vallocat (length : tsp00_Int4;
            VAR alloc_sum  : tsp00_Int4;
            VAR ptr        : tbd7_univ_ptr) : boolean;
 
VAR
      is_ok : boolean;
 
BEGIN
alloc_sum := alloc_sum + length;
vallocat (length, ptr.any_addr, is_ok );
bd77vallocat := is_ok
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77root_description (root : tsp00_PageNo;
            VAR root_desc : tbd7_root_desc);
 
VAR
      stop  : boolean;
 
BEGIN
WITH root_desc DO
    BEGIN
    rd_collision_ptr := NIL;
    rd_partition     := root MOD b75region_cnt;
    rd_hash   := (root MOD b77locklist [rd_partition].tll_hashsize) + 1;
    rd_ptr      := b77locklist [rd_partition].tll_anchor^ [rd_hash];
    rd_prev_ptr := rd_ptr;
    rd_exist    := false;
    rd_root     := root;
    stop        := false;
    WHILE (rd_ptr <> NIL) AND NOT stop DO
        IF  rd_ptr^.lle_root = root
        THEN
            BEGIN
            rd_exist := true;
            stop     := true
            END
        ELSE
            IF  rd_ptr^.lle_root > root
            THEN
                stop := true
            ELSE
                BEGIN
                rd_prev_ptr := rd_ptr;
                rd_ptr      := rd_ptr^.lle_next_diff_root
                END;
            (*ENDIF*) 
        (*ENDIF*) 
    (*ENDWHILE*) 
&   ifdef TRACE
    IF  t01trace (bd_lock)
    THEN
        BEGIN
        t01addr (bd_lock, 'rd_ptr      ', rd_ptr);
        t01addr (bd_lock, 'rd_prev_ptr ', rd_prev_ptr);
        t01addr (bd_lock, 'rd_collision', rd_collision_ptr);
        t01bool (bd_lock, 'rd_exist    ', rd_exist);
        t01int4 (bd_lock, 'rd_root     ', rd_root)
        END;
&   endif
    (*ENDIF*) 
    END
(*ENDWITH*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      b77pid_check ( pid : tsp00_TaskId;
            root : tsp00_PageNo );
 
VAR
      root_desc : tbd7_root_desc;
      entry_ptr : tbd7_entry_ptr;
 
BEGIN
b77root_description (root, root_desc);
IF  root_desc.rd_exist
THEN
    BEGIN
    entry_ptr := root_desc.rd_ptr;
    WHILE entry_ptr <> NIL DO
        IF  (entry_ptr^.lle_mode <> bd7lm_nil) AND
            (entry_ptr^.lle_pid  = pid)
        THEN
            g01abort (csp3_b77x1_pid_found, csp3_n_treelock,
                  'PIDCHECK found pid:     ', pid)
        ELSE
            entry_ptr := entry_ptr^.lle_next_eq_root;
        (*ENDIF*) 
    (*ENDWHILE*) 
    END;
(*ENDIF*) 
END;
 
(*------------------------------*) 
 
PROCEDURE
      bd77pid_exclusive_check (pid : tsp00_TaskId;
            root : tsp00_PageNo);
 
VAR
      entry_ptr : tbd7_entry_ptr;
      root_desc : tbd7_root_desc;
 
BEGIN
b77root_description (root, root_desc);
entry_ptr := root_desc.rd_ptr;
WHILE entry_ptr <> NIL DO
    IF  (entry_ptr^.lle_pid  = pid) AND
        (entry_ptr^.lle_mode = bd7lm_locked)
    THEN
        g01abort (csp3_b77x1_second_lock, csp3_n_treelock,
              'EXCL second lock (root):', root_desc.rd_root)
    ELSE
        entry_ptr := entry_ptr^.lle_next_eq_root
    (*ENDIF*) 
(*ENDWHILE*) 
END;
 
.CM *-END-* code ----------------------------------------
.SP 2 
***********************************************************
*-PRETTY-*  statements    :        957
*-PRETTY-*  lines of code :       2974        PRETTYX 3.10 
*-PRETTY-*  lines in file :       3905         1997-12-10 
.PA 
