Commented source code for BTPSEQ

    C.BTPSEQ
001 SUBROUTINE BTPSEQ(BFILE,NODE.ID,NODE.POS,PN,ADJKEY)
002 * Find prev or next key in 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 if any.
008 PREV = (PN="PREV") ;* Set direction flag
009 IF PREV THEN PTR=NODE.POS ELSE PTR=NODE.POS+1
010 READ NODE FROM BFILE, NODE.ID ELSE STOP "Can't find node"
011 ORIG.ID = NODE<2,NODE.POS> ;* Remember for when we hit leaf
012 100 NEXT.NODE.ID = NODE<3, PTR> ;* Get id of next node
013 IF NEXT.NODE.ID # "" THEN ;* There's another node, keep looking for leaf
014   NODE.ID = NEXT.NODE.ID
015   READ NODE FROM BFILE, NODE.ID ELSE STOP
016   IF PREV THEN PTR=NODE<1>+1 ELSE PTR=1
017   GO TO 100
018   END
019 * Reached a leaf, is it also the one with the key?
020 IF NODE<2, NODE.POS> # ORIG.ID THEN ;* No, this leaf has the adjacent key
021   IF PREV THEN NODE.POS = NODE<1> ELSE NODE.POS = 1
022   ADJKEY = NODE<2,NODE.POS>
023   RETURN
024   END
025 IF PREV AND (NODE.POS > 1) THEN ;* Yes, prev key is right alongside
026   NODE.POS=NODE.POS-1
027   ADJKEY = NODE<2,NODE.POS>
028   RETURN
029   END
030 IF NOT(PREV) AND (NODE.POS < NODE<1>) THEN ;* Yes, alongside
031   NODE.POS=NODE.POS+1
032   ADJKEY = NODE<2,NODE.POS> ;* Get adjacent key
033   RETURN
034   END
035 200 * We're at one end of a node, adjacent key is some parent
036 PARENT.ID = NODE<4>
037 IF PARENT.ID # "" THEN ;* Parent exists
038   READ PARENT FROM BFILE, PARENT.ID ELSE STOP "Can't reread"
039   LOCATE(NODE.ID, PARENT, 3; NODE.POS) ELSE STOP "Forgot node"
040   IF (PREV AND (NODE.POS=1)) OR (NOT(PREV) AND NODE.POS > PARENT<1>) THEN ;* Look higher
041     NODE.ID = PARENT.ID
042     NODE = PARENT
043     GO TO 200
044     END
045   IF PREV THEN NODE.POS=NODE.POS-1
046   ADJKEY = PARENT<2,NODE.POS>
047   NODE.ID = PARENT.ID
048   END ELSE ADJKEY = "" ;* No parent exists
049 RETURN
050 END