Creating the BTPINS and BTPKEY programs

So far, you have created a fairly typical NAMES file containing names and addresses, and a simple GET.NAMES update program for maintaining that file. Together, they form a rudimentary mailing list application that might be found on any Pick system. The next step is to start using B-TREE-P subroutines to create B-trees, so that the mailing list can be sorted and searched in a convenient manner.

One of the most important B-TREE-P programs is a subroutine named BTPINS, short for B-TREE-P Insert. Give the command EDIT BP BTPINS in order to enter the Editor and type in the following source code for BTPINS:

    BTPINS
001 SUBROUTINE BTPINS(ROOT,SIZE,BFILE,DFILE,ID,ITEM)
002 UID = ID
003 CALL BTPKEY(ROOT, UID, ITEM, KEY)
004 FK = KEY
005 READ NID FROM BFILE, ROOT ELSE
006   READ NID FROM BFILE, "NEXT.ID" ELSE NID = 0
007   WRITE (NID+1) ON BFILE, "NEXT.ID"
008   WRITE NID ON BFILE, ROOT
009   WRITE "" ON BFILE, NID
010   END
011 BU = 0
012 NP = ""
013 100 READ N FROM BFILE, NID ELSE STOP "BTP1"
014 L = 0 ; R = N<1>+1
015 IF R = 1 THEN P = 1 ELSE
016   LOOP
017     P = INT((L+R)/2)
018     IN = N<2, P>
019     IF IN = UID THEN
020       CRT "Already inserted!"
021       IF BU THEN STOP "BTP2" ELSE RETURN
022       END
023     READ IT FROM DFILE, IN ELSE STOP "BTP3"
024     CALL BTPKEY(ROOT, IN, IT, KEY)
025     IG = (FK > KEY)
026     IF IG THEN L = P ELSE R = P
027   UNTIL (R-L) <= 1 DO REPEAT
028   IF IG THEN P = R
029   END
030 NNID = N<3, P>
031 IF (NNID # "") AND NOT(BU) THEN
032   NID = NNID
033   GO TO 100
034   END
035 N = INSERT(N, 2, P, 0, UID)
036 IF BU THEN N = INSERT(N, 3, P+1, 0, NP)
037 N<1> = N<1>+1
038 IF N<1> <= (2*SIZE) THEN WRITE N ON BFILE, NID ELSE
039   LOOP
040     READ NP FROM BFILE, "NEXT.ID" ELSE NP = 0
041     WRITE (NP+1) ON BFILE, "NEXT.ID"
042     READ NN FROM BFILE, NP ELSE NN = ""
043   UNTIL NN = "" DO REPEAT
044   J = 1
045   FOR I = (SIZE+2) TO ((2*SIZE)+2)
046     IF N<2, I> # "" THEN NN<2, J> = N<2, I>
047     CID = N<3, I>
048     IF CID # "" THEN
049       NN<3, J> = CID
050       READ C FROM BFILE, CID ELSE STOP "BTP4"
051       C<4> = NP
052       WRITE C ON BFILE, CID
053       END
054     J = J+1
055   NEXT I
056   NN<1> = SIZE
057   NN<4> = N<4>
058   WRITE NN ON BFILE, NP
059   UID = N<2, SIZE+1>
060   NN = SIZE
061   FOR I = 1 TO (SIZE+1)
062     IF I <= SIZE THEN NN<2, I> = N<2, I>
063     IF N<3, I> # "" THEN NN<3, I> = N<3, I>
064   NEXT I
065   NN<4> = N<4>
066   WRITE NN ON BFILE, NID
067   IF NN<4> # "" THEN
068     BU = 1
069     NID = NN<4>
070     GO TO 100
071     END
072   LOOP
073     READ RID FROM BFILE, "NEXT.ID" ELSE RID = 0
074     WRITE (RID+1) ON BFILE, "NEXT.ID"
075     READ NN FROM BFILE, RID ELSE NN = ""
076   UNTIL NN = "" DO REPEAT
077   NN<1> = 1
078   NN<2> = UID
079   NN<3, 1> = NID
080   NN<3, 2> = NP
081   WRITE NN ON BFILE, RID
082   WRITE RID ON BFILE, ROOT
083   READ NN FROM BFILE, NID ELSE STOP "BTP5"
084   NN<4> = RID
085   WRITE NN ON BFILE, NID
086   READ NN FROM BFILE, NP ELSE STOP "BTP6"
087   NN<4> = RID
088   WRITE NN ON BFILE, NP
089   END
090 RETURN
091 END

At this point, don't worry about trying to understand how BTPINS works. It has been coded in such a way that it will never have to be modified by you, regardless of the application that will be using your B-trees or the way in which you will be doing searching and sorting of your files.

Compile BTPINS. Once BTPINS has been successfully compiled, catalog the program with the command CATALOG BP BTPINS, since most Pick systems require that subroutines be cataloged. Similarly, edit, compile, and catalog the following BTPKEY subroutine:

    BTPKEY
001 SUBROUTINE BTPKEY(ROOT, ID, ITEM, KEY)
002 EQU nul TO CHAR(0)
003 BEGIN CASE
004 CASE ROOT = "ZIP" ;* By zip/adr/comp/lname/fname/id
005   KEY = ITEM<6>:nul:ITEM<4>:nul:ITEM<3>:nul:ITEM<2>:nul:ITEM<1>:nul:(ID"R#10")
006 CASE ROOT = "COMP" ;* By company/lname/fname/id
007   KEY = ITEM<3>:nul:ITEM<2>:nul:ITEM<1>:nul:(ID "R#10")
008 CASE ROOT = "LNAME" ;* By lname/fname/id
009   KEY = ITEM<2>:nul:ITEM<1>:nul:(ID "R#10")
010 CASE 1 ; STOP "BTP7"
011 END CASE
012 RETURN
013 END

BTPKEY is called by BTPINS, and controls the way in which your files will sort. By changing the statements inside BTPKEY, you can design B-trees that allow you to sort and search your files in any order you want. For now, just leave BTPKEY exactly as listed above.