<title>Commented source code for BTPDEL</title><h2>Commented source code for <tt>BTPDEL</tt></h2><pre>    C.BTPDEL001 SUBROUTINE BTPDEL(ROOT,SIZE,BFILE,DFILE,ID,ITEM)002 * Delete key from B-tree with nodes in following format:003 *   AMC 0:  Arbitrary node number.004 *   AMC 1:  Count of keys in node.005 *   AMC 2:  Keys, stored as a subvalue list.006 *   AMC 3:  (number of keys)+1 pointers to next nodes.007 *   AMC 4:  Pointer to parent node if any.008 CALL BTPKEY(ROOT,ID,ITEM,FINDKEY) ;* Get sort string for comparing to rest of tree009 READ NODE.ID FROM BFILE, ROOT ELSE STOP "No root"010 FOUND = 0 ;* Flopped true once key found in tree011 100 READ NODE FROM BFILE, NODE.ID ELSE STOP "Can't find node"012 LEFT = 0 ; RIGHT = NODE<1>+1 ;* Boundaries for binary search of keys in node013 IF (RIGHT=1) OR FOUND THEN NEXT.PTR=1 ; POS=1 ELSE ;* Not an empty root and not searching for adjacent key014   LOOP015     POS = INT((LEFT+RIGHT)/2) ;* Find position midway between boundaries016     COMPARE.ID = NODE<2,POS> ;* Get that key017     IF COMPARE.ID = ID THEN ;* Key is in node018       FOUND=1 ; OWNER.ID=NODE.ID ; OWNER.POS=POS ;* Remember so and where019       RIGHT=LEFT ; NEXT.PTR=POS+1 ;* Force loop stop, go right to find adjacent key020       END ELSE ;* These keys don't match021           NEXT.PTR = POS ;* If loop stops, go left next time022           READ COMPARE.ITEM FROM DFILE, COMPARE.ID ELSE STOP "Can't read"023           CALL BTPKEY(ROOT,COMPARE.ID,COMPARE.ITEM,KEY) ;* Convert COMPARE.ITEM to KEY for comparison024           IS.GREATER = (FINDKEY > KEY) ;* Is our key greater than node key?025           IF IS.GREATER THEN LEFT = POS ELSE RIGHT = POS ;* Adjust search boundaries026           END027   UNTIL (RIGHT-LEFT) <= 1 DO REPEAT028     IF NOT(FOUND) THEN ;* May have to adjust POS029       IF IS.GREATER THEN POS = RIGHT ; NEXT.PTR=POS ;* Else POS already OK030       END031   END032 NEXT.NODE.ID = NODE<3, NEXT.PTR> ;* Get id of next node033 IF NEXT.NODE.ID # "" THEN ;* There's another node, keep looking for leaf034   NODE.ID = NEXT.NODE.ID035   GO TO 100036   END037 IF NOT(FOUND) THEN CRT ID:" not present to delete" ; RETURN038 * Reached a leaf, is it also the one with the key?039 IF NODE<2, POS> # ID THEN ;* No, this leaf has the adjacent key040   READ OWNER.NODE FROM BFILE, OWNER.ID ELSE STOP "Can't reread"041   OWNER.NODE<2, OWNER.POS> = NODE<2,1> ;* Replace key found with adjacent key042   WRITE OWNER.NODE ON BFILE, OWNER.ID043   POS = 1 ;* So following delete will erase adjacent key from leaf044   END045 NODE = DELETE(NODE, 2, POS) ;* Erase the leaf key046 NODE<1> = NODE<1> - 1 ;* Reduce count of keys in node047 200 IF (NODE<1> < SIZE) AND (NODE<4> # "") THEN ;* Underflow, since too few keys in a non-root node048   PARENT.ID = NODE<4> ;* Get id of parent of underflowed node049   READ PARENT FROM BFILE, PARENT.ID ELSE STOP "Can't reread"050   LOCATE(NODE.ID, PARENT, 3; POS) ELSE STOP "Forgot"051   NEIGHBOR.ID = PARENT<3, POS+1> ; PARENT.POS = POS ;* Assume neighbor's on right052   NEIGHBOR.ON.LEFT = (NEIGHBOR.ID="") ;* Are we wrong?053   IF NEIGHBOR.ON.LEFT THEN NEIGHBOR.ID = PARENT<3, POS-1> ; PARENT.POS=POS-1 ;* Yes, try other side054   READ NEIGHBOR FROM BFILE, NEIGHBOR.ID ELSE STOP "Can't find"055   TOTAL.KEYS = NODE<1> + NEIGHBOR<1> ;* How many keys left in both nodes056   IF TOTAL.KEYS >= 2*SIZE THEN ;* Borrow some from neighbor by moving one at a time thru parent pos057     MOVE.COUNT = INT((NEIGHBOR<1>-NODE<1>)/2) ;* Qty to take058     FOR I = 1 TO MOVE.COUNT059       IF NEIGHBOR.ON.LEFT THEN ;* Taking from left node060         NEIGHBOR.POS = NEIGHBOR<1> ;* Where we take key from061         NODE.POS = 1 ;* Where we insert key after taking062         NEIGHBOR.PTR.POS = NEIGHBOR.POS+1 ;* Where we take the ptr, if any063         NODE.PTR.POS = NODE.POS ;* Where we insert the ptr after taking064         END ELSE ;* Taking from right node065             NODE.POS = NODE<1> + 1 ;* Where we insert key066             NEIGHBOR.POS = 1 ;* Where we take key067             NODE.PTR.POS = NODE.POS + 1 ;* Where we insert ptr068             NEIGHBOR.PTR.POS = NEIGHBOR.POS ;* Where we take ptr069             END070       NODE = INSERT(NODE,2,NODE.POS;PARENT<2,PARENT.POS>) ;* Move from parent to node071       NODE<1> = NODE<1>+1 ;* Increase count of keys in node072       PARENT<2,PARENT.POS> = NEIGHBOR<2,NEIGHBOR.POS> ;* Move from neighbor to parent073       NEIGHBOR = DELETE(NEIGHBOR,2,NEIGHBOR.POS) ;* Delete from neighbor074       NEIGHBOR<1> = NEIGHBOR<1>-1 ;* Decrease neighbor key count075       CHILD.ID = NEIGHBOR<3,NEIGHBOR.PTR.POS>076       IF CHILD.ID # "" THEN ;* Not a leaf077         NODE = INSERT(NODE,3,NODE.PTR.POS;CHILD.ID) ;* Move ptr too078         NEIGHBOR = DELETE(NEIGHBOR,3,NEIGHBOR.PTR.POS)079         READ CHILD FROM BFILE, CHILD.ID ELSE STOP "Can't find child"080         CHILD<4> = NODE.ID ;* Tell child about new parent081         WRITE CHILD ON BFILE, CHILD.ID082         END083     NEXT I084     WRITE NEIGHBOR ON BFILE, NEIGHBOR.ID085     WRITE PARENT ON BFILE, PARENT.ID086     WRITE NODE ON BFILE, NODE.ID087     END ELSE ;* Concatenate into neighbor088         IF NEIGHBOR.ON.LEFT THEN ;* Will be concatenating onto neighbor end089           INS.POS = NEIGHBOR<1>+1 ;* Where we insert into neighbor090           INS.PTR.POS = INS.POS+1 ;* Where ptrs are inserted into neighbor091           GET.POS = 1 ;* Where ptr for alongside moved parent comes from092           END ELSE ;* Will be inserting into front of neighbor093               INS.POS = 1 ;* Where keys are inserted into neighbor094               INS.PTR.POS = 1 ;* Where ptrs are inserted into neighbor095               GET.POS = NODE<1>+1 ;* Where first pointer comes from096               END097         NEIGHBOR = INSERT(NEIGHBOR,2,INS.POS;PARENT<2,PARENT.POS>) ;* Move parent into neighbor098         NOT.LEAF = (NEIGHBOR<3,1> # "") ;* At a leaf?099         IF NOT.LEAF THEN ;* No, move ptr too100           CHILD.ID = NODE<3,GET.POS>101           NEIGHBOR = INSERT(NEIGHBOR,3,INS.PTR.POS;CHILD.ID)102           READ CHILD FROM BFILE, CHILD.ID ELSE STOP "Can't find child"103           CHILD<4> = NEIGHBOR.ID ;* Tell child about new parent104           WRITE CHILD ON BFILE, CHILD.ID105           END106         IF NEIGHBOR.ON.LEFT THEN ;* Adjust so rest of inserts come after concated parent107           INS.POS = INS.POS+1 ; INS.PTR.POS = INS.PTR.POS+1108           END109         FOR I = NODE<1> TO 1 STEP -1110           NEIGHBOR = INSERT(NEIGHBOR,2,INS.POS;NODE<2,I>) ;* Concat key from node111           IF NOT.LEAF THEN ;* Concat ptr too112             IF NEIGHBOR.ON.LEFT THEN ;* Bring right hand ptr113               NODE.PTR.POS = I+1114               END ELSE NODE.PTR.POS = I ;* Bring left hand ptr115             CHILD.ID = NODE<3,NODE.PTR.POS>116             NEIGHBOR = INSERT(NEIGHBOR,3,INS.PTR.POS;CHILD.ID) ;* Concat ptr117             READ CHILD FROM BFILE, CHILD.ID ELSE STOP "Can't find child"118             CHILD<4> = NEIGHBOR.ID ;* Tell child about new parent119             WRITE CHILD ON BFILE, CHILD.ID120             END121         NEXT I122         NEIGHBOR<1> = NEIGHBOR<1> + NODE<1> + 1123         WRITE NEIGHBOR ON BFILE, NEIGHBOR.ID ;* May get written again below to clear parent124         DELETE BFILE, NODE.ID125         PARENT = DELETE(PARENT, 2, PARENT.POS)126         PARENT = DELETE(PARENT, 3, POS)127         PARENT<1> = PARENT<1>-1128         IF PARENT<1> <= 0 THEN ;* Descendants of root just got concated129           DELETE BFILE, PARENT.ID ;* Delete old empty root130           WRITE NEIGHBOR.ID ON BFILE, ROOT ;* Point to new root131           NEIGHBOR<4> = "" ;* Since now root, clear parent ptr132           WRITE NEIGHBOR ON BFILE, NEIGHBOR.ID133           END ELSE ;* Parent still has keys134               WRITE PARENT ON BFILE, PARENT.ID135               NODE = PARENT136               NODE.ID = PARENT.ID137               GO TO 200 ;* Check if parent underflowed138               END139         END140   END ELSE WRITE NODE ON BFILE, NODE.ID ;* No underflow141 RETURN142 END</pre><hr><A HREF="btp.html">B-TREE-P</A> copyright &copy 1987-1999 by <A HREF="/home/contact.html">Semaphore Corporation</A>