$CONTROL MAP,CODE,USLINIT                                               00010000
<<HELPUSER - MODULE 84>>                                                00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$CONTROL SEGMENT=HELPUSER,MAIN=HELPUSER << MODULE 84 >>                 00028000
COMMENT                                                                 00030000
   THIS IS THE HELP SUBSYSTEM, ACCESSED THROUGH THE PROCEDURE           00032000
   HELPROC.  THE COMMAND :HELP CALLS THIS ROUTINE.                      00034000
   WHEN THIS SEGMENT IS ADDED TO THE SL IT MUST BE PUT                  00036000
   IN AS A PERMANENTLY ALLOCATED SEGMENT, NOT AS A SYSTEM               00038000
   SEGMENT.  THIS IS TO GET CONTROL Y TO WORK.  SYSDUMP                 00040000
   DIALOG: "HELPUSER,U84,P"                                             00042000
;                                                                       00044000
BEGIN                                                                   00046000
                                                                        00048000
EQUATE                                                                  00050000
   NONDUP            = 0, <<NON DUPLIC. LIST DEV>>             <<02343>>00052000
   JOB               = 2, <<IF IN :JOB>>                       <<02343>>00054000
   TERMSIZEWM1       = 35, << 72 BYTES FOR TERMINAL >>                  00056000
   HRECSIZE          = 40,                                              00058000
   HRECSIZEM1        = HRECSIZE -1,                                     00060000
   HRECSIZEB         = HRECSIZE *2,                                     00062000
   HBUFFSIZE         = HRECSIZE -4,                                     00064000
   HBUFFSIZEB        = HRECSIZEB -8, <<HELP NEVER READS LINENOS>>       00066000
   HBLKFACTOR        = 16,                                     <<01310>>00068000
   HPHYSBLK          = HBLKFACTOR * HRECSIZE,                  <<01310>>00070000
   HSECTORSPERBLK    = HPHYSBLK / 128,                         <<01310>>00072000
   CACHE0LABELS      = 4 * HSECTORSPERBLK - 1,                 <<01310>>00074000
   CACHE0WORDS       = CACHE0LABELS * 128,                     <<01310>>00076000
   OTHERCACHELABELS  = 4 * HSECTORSPERBLK,                     <<01310>>00078000
   OTHERCACHEWORDS   = OTHERCACHELABELS * 128,                 <<01310>>00080000
   HMAXDIRSIZE       = OTHERCACHEWORDS,                        <<01310>>00082000
   HMAXDIRSIZEM1     = HMAXDIRSIZE - 1;                        <<01310>>00084000
                                                               <<01310>>00086000
DEFINE                                                         <<01310>>00088000
   LABELS'PER'CACHE = (IF CACHE = 0                            <<01310>>00090000
                         THEN CACHE0LABELS                     <<01310>>00092000
                         ELSE OTHERCACHELABELS) #;             <<01310>>00094000
DEFINE                                                         <<01310>>00096000
   WORDS'PER'CACHE  = (IF CACHE = 0                            <<01310>>00098000
                         THEN CACHE0WORDS                      <<01310>>00100000
                         ELSE OTHERCACHEWORDS) #;              <<01310>>00102000
                                                               <<01310>>00104000
DEFINE                                                         <<02343>>00106000
   JOB'TYPE = (12:2)#,    <<JOB/SESSION BITS>>                 <<02343>>00108000
   LIST'TYPE = (14:1)#;   <<DUP./NON DUP. LIST DEV>>           <<02343>>00110000
                                                               <<01310>>00112000
                                                                        00114000
                                                                        00116000
INTEGER                                                                 00118000
   STATUS = Q-1,                                                        00120000
   S0 =S-0,                                                             00122000
   X = X;                                                               00124000
                                                                        00126000
BYTE POINTER BPS0 = S-0;                                                00128000
POINTER PS0 = S-0;                                                      00130000
DOUBLE POINTER DPS0 = S-0;                                              00132000
                                                                        00134000
                                                                        00136000
EQUATE                                                                  00138000
   CR                = %15,                                             00140000
   HELPSET           = 17,                                              00142000
                                                                        00144000
                                                                        00146000
   NOINFO            = 11,                                              00148000
   VENTRY'INVITEM    = 12,                                              00150000
   IGNORED           = 13,                                              00152000
   ENDOFCAT          = 14,                                              00154000
   MAXSYNTAXERR      = 29,                                              00156000
                                                                        00158000
   CTLY              = 40,                                              00160000
   BREAKHIT          = 41,                                              00162000
   INPUTEOF          = 42,                                              00164000
                                                                        00166000
   FATALERR          = 50,                                              00168000
   CATERR            = 51,                                              00170000
   NOUSERLABEL       = 52,                                              00172000
   NOHELPDIR         = 53,                                              00174000
   USERLABELERR      = 54,                                              00176000
   OPENSTDINERR      = 55,                                              00178000
   READERR           = 56,                                              00180000
   LISTERR           = 57,                                              00182000
                                                                        00184000
   ALLX              = 1,                                               00186000
   SETX              = 2,                                               00188000
   ENTRYX            = 3,                                               00190000
   ITEMX             = 4,                                               00192000
   SUBITEMX          = 5,                                               00194000
   ANYX              = 6,                                               00196000
   STOPHELP          = 6,                                               00198000
   STARTHELP         = 7,                                               00200000
   SUBSET            = 8,                                               00202000
   KEY'CONTINUED     = 9,                                      <<01310>>00204000
                                                                        00206000
   DISP              = 2,                                               00208000
   NODISP            = 0;                                               00210000
                                                                        00212000
                                                                        00214000
                                                                        00216000
INTRINSIC RESETCONTROL,PRINT,SEARCH,MYCOMMAND,FWRITE,FOPEN,             00218000
   FGETINFO,WHO,                                               <<02343>>00222000
   FCLOSE,FREAD,FREADDIR,FCHECK,FREADLABEL;                             00224000
                                                                        00226000
INTEGER PROCEDURE DEBLANK(BUFF,WIDTH);                                  00228000
   VALUE WIDTH; BYTE ARRAY BUFF; INTEGER WIDTH;                         00230000
   OPTION EXTERNAL;                                                     00232000
                                                                        00234000
LOGICAL PROCEDURE REQUESTSERVICE; OPTION EXTERNAL;                      00236000
                                                                        00238000
INTEGER PROCEDURE GENMSGU(A,B);                                         00240000
   VALUE A,B;                                                           00242000
   LOGICAL A,B;                                                         00244000
   OPTION EXTERNAL;                                                     00246000
                                                                        00248000
<< FORWARD DECLS >>                                                     00250000
                                                                        00252000
PROCEDURE PRINTCARET(OFFSET);                                           00254000
   VALUE OFFSET; INTEGER OFFSET; OPTION INTERNAL,FORWARD;               00256000
                                                                        00258000
PROCEDURE READCAT'(A,B,C,D,E);                                          00260000
   VALUE A,D;INTEGER A,C,D,E;                                           00262000
   ARRAY B;OPTION FORWARD;                                              00264000
                                                                        00266000
INTEGER PROCEDURE TRAVERSE(CATFN,FN,RECNO,STOPPER,ERRNO);               00268000
   VALUE CATFN,FN,RECNO,STOPPER;                                        00270000
   INTEGER CATFN,FN,RECNO,STOPPER,ERRNO;                                00272000
   OPTION FORWARD;                                                      00274000
$TITLE "BUZZFETCH"                                                      00276000
INTEGER PROCEDURE BUZZFETCH(STRING);                                    00278000
   VALUE STRING; BYTE POINTER STRING;                                   00280000
   OPTION INTERNAL;                                            <<01650>>00282000
COMMENT                                                                 00284000
   RETURNS BUZZ NUMBER FROM BUZZ WORD ARRAY. RETURNS 0 IF               00286000
   IT CAN'T FIND A MATCH.                                               00288000
;                                                                       00290000
BEGIN                                                                   00292000
                                                                        00294000
INTEGER LEN;                                                            00296000
                                                                        00298000
                                                                        00300000
BYTE ARRAY DICT(*) = PB :=                                              00302000
    5,3,"ALL",       << 1 >>                                            00304000
    5,3,"SET",       << 2 >>                                            00306000
    7,5,"ENTRY",     << 3 >>                                            00308000
    6,4,"ITEM",      << 4 >>                                            00310000
    9,7,"SUBITEM",   << 5 >>                                            00312000
   10,8,"STOPHELP",  << 6 >>                                            00314000
   11,9,"STARTHELP", << 7 >>                                            00316000
    8,6,"SUBSET",    << 8 >>                                            00318000
   10,8,"CONTINUE",  << 9 >>                                   <<01310>>00320000
   0;                                                                   00322000
                                                                        00324000
BYTE ARRAY ENDICT(*) = PB :=0; << END ADDRESS OF DICT >>                00326000
                                                                        00328000
BYTE POINTER DICTP;                                                     00330000
                                                                        00332000
TOS := 0;                   << SET UP DB DICT ARRAY >>                  00334000
@DICTP := @S0 & LSL(1);     << BYTE ADDRESS >>                          00336000
TOS := X := (@ENDICT - @DICT + 1 ) & LSR(1);                   <<01310>>00338000
                            << WORD LENGTH OF DICT >>                   00340000
ASSEMBLE( ADDS 0 );         << ALLOCATE SPACE >>                        00342000
TOS := @DICTP & LSR(1);     << WORD ADR TARGET >>                       00344000
TOS := @DICT & LSR(1);      << WORD ADR SOURCE >>                       00346000
TOS := X;                   << COUNT >>                                 00348000
ASSEMBLE( MOVE PB );        << PUT DICT INTO STACK >>                   00350000
                                                                        00352000
MOVE STRING := STRING WHILE ANS,1;                                      00354000
LEN := TOS -@STRING;                                                    00356000
                                                                        00358000
BUZZFETCH := SEARCH(STRING,LEN,DICTP);                                  00360000
END; << BUZZFETCH >>                                                    00362000
$TITLE "CONTROLYTRAP"                                                   00364000
PROCEDURE CONTROLYTRAP;                                                 00366000
   OPTION INTERNAL;                                                     00368000
BEGIN << THIS IS A DUMMY, JUST USED TO ENABLE CTL Y >>                  00370000
   TOS := %31400 +TOS;                                                  00372000
   ASSEMBLE( XEQ 0);                                                    00374000
END; << CONTROLYTRAP >>                                                 00376000
$TITLE "DISPLAYBLOCK"                                                   00378000
INTEGER PROCEDURE DISPLAYBLOCK(CATFN,FN,RECNO,BUFF',BUZZNO,             00380000
      ERRNO);                                                           00382000
   VALUE CATFN,FN,RECNO;                                                00384000
   INTEGER CATFN,FN,RECNO,BUZZNO,ERRNO;                                 00386000
   ARRAY BUFF';                                                         00388000
   OPTION INTERNAL;                                                     00390000
COMMENT                                                                 00392000
   READS FROM CATALOG STARTING AT RECNO & WRITES TO FN UNTIL            00394000
   A RECORD CONTAINING "\'BUZZWORD'" IS FOUND. IF FN IS ZERO,           00396000
   THE WRITE IS SKIPPED. ERRNO MAY CONTAIN CATERR,BREAKHIT,             00398000
   LISTERR,CTLY. RETURNS NEXT RECORD NUMBER IN THE FILE.                00400000
;                                                                       00402000
BEGIN                                                                   00404000
                                                                        00406000
INTEGER                                                                 00408000
   SAVEFN,                                                              00410000
   LEN;                                                                 00412000
                                                                        00414000
BYTE ARRAY BUFF(*) = BUFF';                                             00416000
                                                                        00418000
SAVEFN := FN;                                                           00420000
LEN := BUZZNO := ERRNO := 0;                                            00422000
DO BEGIN                                                                00424000
   READCAT'(CATFN,BUFF',LEN,RECNO,ERRNO);                               00426000
   IF ERRNO <> 0 THEN  << ERRNO = CATERR >>                             00428000
   ELSE                                                                 00430000
   IF REQUESTSERVICE THEN ERRNO := BREAKHIT                             00432000
   ELSE                                                                 00434000
   BEGIN                                                                00436000
      RESETCONTROL;                                                     00438000
      IF = THEN ERRNO := CTLY                                           00440000
      ELSE                                                              00442000
      IF BUFF = "\" THEN                                                00444000
      BEGIN                                                             00446000
         BUZZNO := BUZZFETCH(BUFF(1));                                  00448000
         IF BUZZNO = STOPHELP THEN                                      00450000
         BEGIN                                                          00452000
            BUZZNO := 0;                                                00454000
            FN := NODISP;                                               00456000
         END                                                            00458000
         ELSE                                                  <<01310>>00460000
         IF BUZZNO = KEY'CONTINUED THEN                        <<01310>>00462000
            BUZZNO := 0                                        <<01310>>00464000
         ELSE                                                           00466000
         IF BUZZNO = STARTHELP THEN                                     00468000
         BEGIN                                                          00470000
            BUZZNO := 0;                                                00472000
            FN := SAVEFN;                                               00474000
         END;                                                           00476000
      END                                                               00478000
      ELSE                                                              00480000
      BEGIN                                                             00482000
         IF FN <> NODISP THEN                                           00484000
         BEGIN                                                          00486000
            PRINT(BUFF',-LEN,0);                                        00488000
            IF <> THEN ERRNO := LISTERR;                                00490000
         END;                                                           00492000
      END;                                                              00494000
   END;                                                                 00496000
   RECNO := RECNO +1;                                                   00498000
END UNTIL ERRNO <> 0 OR BUZZNO <> 0;                                    00500000
DISPLAYBLOCK := RECNO-1;                                                00502000
BUFF(LEN) := CR;  << TERMINATOR FOR MYCOMMAND >>                        00504000
                                                                        00506000
END; << DISPLAYBLOCK >>                                                 00508000
$TITLE "DISPLAYKEY"                                                     00510000
PROCEDURE DISPLAYKEY(CATFN,FN,KEYREC);                                  00512000
   VALUE CATFN,FN,KEYREC;                                               00514000
   INTEGER CATFN,FN,KEYREC;                                             00516000
   OPTION INTERNAL;                                                     00518000
COMMENT PRINTS LIST OF KEYWORDS WHICH ARE BRANCHES FROM                 00520000
   CURRENT HELP TREE NODE. LIST IS FOUND IN RECORD OF CATALOG           00522000
   CONTAINING "\ENTRY".                                                 00524000
;                                                                       00526000
BEGIN                                                                   00528000
                                                                        00530000
INTEGER                                                                 00532000
   BUFFLEN,                                                             00534000
   I,                                                                   00536000
   LEN,                                                                 00538000
   NUMPARMS,                                                            00540000
   OINDEX;                                                              00542000
BYTE POINTER PTR;                                                       00544000
DOUBLE ARRAY PARMS''(0:15);                                             00546000
INTEGER ARRAY PARMS'(*) = PARMS'';                                      00548000
ARRAY BUFF'(0:36);                                                      00550000
BYTE ARRAY BUFF(*) = BUFF';                                             00552000
ARRAY OBUFF'(0:39);                                                     00554000
BYTE ARRAY OBUFF(*) = OBUFF';                                           00556000
                                                                        00558000
READCAT'(CATFN,BUFF',BUFFLEN,KEYREC,I);                                 00560000
<< EXTRACT KEYWORDS >>                                                  00562000
BUFF(BUFFLEN) := CR;                                                    00564000
MYCOMMAND(BUFF(1),,16,NUMPARMS,PARMS'');                                00566000
IF NUMPARMS > 2 THEN                                                    00568000
BEGIN << HAVE SOME TO DISPLAY >>                                        00570000
   MOVE OBUFF := "KEYWORDS: "; OINDEX := 10;                            00572000
   I := 1; << STARTS AT THIRD PARM >>                                   00574000
                                                               <<01310>>00576000
   WHILE ( I := I + 1 ) < NUMPARMS   DO                        <<01310>>00578000
   BEGIN                                                       <<01310>>00580000
                                                               <<01310>>00582000
      @PTR := PARMS'( I*2 );                                   <<01310>>00584000
      LEN := PARMS'( I*2+1 ).(0:8);                            <<01310>>00586000
                                                               <<01310>>00588000
   << CHECK FOR CONTINUATION (KEYWORD OF ZERO LENGTH).   >>    <<01310>>00590000
      IF LEN = 0 THEN                                          <<01310>>00592000
      BEGIN                                                    <<01310>>00594000
                                                               <<01310>>00596000
         PRINT( OBUFF', -( OINDEX ), 0 );                      <<01310>>00598000
         OBUFF := " ";                                         <<01310>>00600000
         MOVE OBUFF(1) := OBUFF, (79);                         <<01310>>00602000
         OINDEX := 10;                                         <<01310>>00604000
         READCAT'( CATFN, BUFF', BUFFLEN, KEYREC+1, I );       <<01310>>00606000
         IF BUFFLEN < 9 OR BUFF <> "\CONTINUE" THEN            <<01310>>00608000
         BEGIN                                                 <<01310>>00610000
            PRINT ( OBUFF', -(OINDEX-1), 0 );                  <<01310>>00612000
            MOVE OBUFF :=                                      <<01310>>00614000
               "***EXPECTED CONTINUE LINE FROM 'MAKECAT'. ";   <<01310>>00616000
            PRINT ( OBUFF', -42, 0 );                          <<01310>>00618000
            MOVE OBUFF :=                                      <<01310>>00620000
               "   ENTIRE KEYWORD LIST NOT DISPLAYED.     ";   <<01310>>00622000
            PRINT ( OBUFF', -42, 0 );                          <<01310>>00624000
            RETURN;                                            <<01310>>00626000
         END;                                                  <<01310>>00628000
         KEYREC := KEYREC + 1;                                 <<01310>>00630000
         BUFF( BUFFLEN ) := CR;                                <<01310>>00632000
         MYCOMMAND( BUFF(1),, 16, NUMPARMS, PARMS'' );         <<01310>>00634000
         I := 0;                                               <<01310>>00636000
                                                               <<01310>>00638000
      END                                                      <<01310>>00640000
                                                               <<01310>>00642000
   << IF THE KEYWORD IS THERE, ADD IT TO THE BUFFER.     >>    <<01310>>00644000
      ELSE                                                     <<01310>>00646000
      BEGIN                                                    <<01310>>00648000
                                                               <<01310>>00650000
         MOVE OBUFF( OINDEX ) := PTR, (LEN);                   <<01310>>00652000
         OBUFF( OINDEX + LEN ) := ",";                         <<01310>>00654000
         OINDEX := OINDEX + LEN + 1;                           <<01310>>00656000
                                                               <<01310>>00658000
      END;                                                     <<01310>>00660000
                                                               <<01310>>00662000
   END;  << KEYWORD EXTRACTING LOOP. >>                        <<01310>>00664000
                                                               <<01310>>00666000
   PRINT(OBUFF',-(OINDEX-1),0);                                         00668000
END;                                                                    00670000
END; << DISPLAYKEY >>                                                   00672000
$TITLE "FINDKEY"                                                        00674000
INTEGER PROCEDURE FINDKEY(CATFN,RECNO,ITEM,ITEMLEN,BUZZNO,              00676000
      ERRNO);                                                           00678000
   VALUE CATFN,RECNO,ITEMLEN;                                           00680000
   BYTE ARRAY ITEM;                                                     00682000
   INTEGER CATFN,RECNO,ITEMLEN,BUZZNO,ERRNO;                            00684000
   OPTION INTERNAL;                                                     00686000
COMMENT                                                                 00688000
   STARTS AT RECNO IN CATALOG & SEARCHES FOR A MATCH BETWEEN            00690000
   ITEM AND ITEM SPECIFIED IN THE CATALOG RECORD. THE RECORD            00692000
   NUMBER OF THE MATCH IS RETURNED. BUZZNO IS THE INDEX INTO            00694000
   THE ARRAY OF "SET,ENTRY,ITEM,SUBITEM,ALL". ZERO IS RETURNED          00696000
   IF ITEM CAN'T BE FOUND OR I/O ERROR.                                 00698000
;                                                                       00700000
BEGIN                                                                   00702000
                                                                        00704000
INTEGER                                                                 00706000
   NUMPARMS,                                                            00708000
   LEN;                                                                 00710000
DOUBLE ARRAY PARMS''(0:1) = Q;                                          00712000
BYTE POINTER PARM1 = PARMS'';                                           00714000
BYTE POINTER PARM2 = PARMS'' +2;                                        00716000
INTEGER ARRAY PARMS'(*) = PARMS'';                                      00718000
DEFINE                                                                  00720000
   PARM1LEN = PARMS'(1).(0:8)#,                                         00722000
   PARM2LEN = PARMS'(3).(0:8)#;                                         00724000
ARRAY BUFF'(0:HBUFFSIZE);                                               00726000
BYTE ARRAY BUFF(*) = BUFF';                                             00728000
                                                                        00730000
DO BEGIN                                                                00732000
   RECNO := DISPLAYBLOCK(CATFN,NODISP,RECNO,BUFF',BUZZNO,               00734000
      ERRNO) +1;                                                        00736000
   IF ERRNO <> 0 THEN GO OUTL;                                          00738000
   IF BUZZNO = ALLX THEN GO OUTL;                                       00740000
      << EOF IN CATALOG >>                                              00742000
   MYCOMMAND(BUFF(1),,2,NUMPARMS,PARMS'');                              00744000
END UNTIL BUZZNO = ENTRYX OR ITEMLEN =PARM2LEN AND                      00746000
   PARM2 = ITEM,(ITEMLEN);                                              00748000
IF BUZZNO <> ENTRYX THEN FINDKEY := RECNO -1;                           00750000
OUTL:                                                                   00752000
                                                                        00754000
END; << FINDKEY >>                                                      00756000
$TITLE "HELPARSE"                                                       00758000
PROCEDURE HELPARSE(COMIMAGE,PARM1,PARM1LEN,PARM2,PARM2LEN,              00760000
      PARM3);                                                           00762000
   BYTE ARRAY COMIMAGE;                                                 00764000
   INTEGER PARM1LEN,PARM2LEN;                                           00766000
   BYTE POINTER PARM1,PARM2,PARM3;                                      00768000
   OPTION INTERNAL;                                                     00770000
BEGIN                                                                   00772000
                                                                        00774000
@PARM3 := PARM1LEN := PARM2LEN := 0;                                    00776000
SCAN COMIMAGE WHILE %6440,1; << INIT. DEBLANK >>                        00778000
@PARM1 := TOS;                                                          00780000
IF NOCARRY THEN << SOME TEXT >>                                         00782000
BEGIN                                                                   00784000
   MOVE PARM1 := PARM1 WHILE ANS,1;                                     00786000
   @PARM2 := TOS;                                                       00788000
   PARM1LEN := @PARM2 -@PARM1;                                          00790000
   SCAN PARM2 WHILE %6440,1; << DEBLANK AFTER 1ST PARM >>               00792000
   @PARM2 := TOS;                                                       00794000
   IF NOCARRY THEN << MORE TEXT >>                                      00796000
   BEGIN                                                                00798000
      IF PARM2 = SPECIAL THEN << DELIM >>                               00800000
         @PARM2 := @PARM2(1); << SKIP DELIM >>                          00802000
      SCAN PARM2 WHILE %6440,1; << DEBLANK >>                           00804000
      @PARM2 := TOS;                                           <<01129>>00806000
      IF NOCARRY THEN << REALLY IS  PARM >>                             00808000
      BEGIN                                                             00810000
         MOVE PARM2 := PARM2 WHILE ANS,1;                               00812000
         PARM2LEN := TOS -@PARM2;                                       00814000
            << CHECK FOR 3RD PARM >>                                    00816000
         SCAN PARM2(PARM2LEN) WHILE %6440,1;                            00818000
         @PARM3 := TOS;                                                 00820000
         IF PARM3 = CR THEN @PARM3 := 0;                                00822000
      END;                                                              00824000
   END;                                                                 00826000
END;                                                                    00828000
                                                                        00830000
END; << HELPARSE >>                                                     00832000
$TITLE "HELPROC"                                                        00834000
PROCEDURE HELPROC(CATFN,LISTFN,COMIMAGE,COMBASE,ERRNO,                  00836000
   INTERACT);                                                           00838000
   VALUE CATFN,LISTFN,INTERACT;                                         00840000
   INTEGER CATFN,LISTFN,ERRNO;                                          00842000
   BYTE ARRAY COMIMAGE,COMBASE;                                         00844000
   LOGICAL INTERACT;                                                    00846000
BEGIN                                                                   00848000
                                                                        00850000
LABEL                                                                   00852000
   OUTL,                                                                00854000
   ABORTL;                                                              00856000
                                                                        00858000
INTEGER                                                                 00860000
   STOPPER,     << FIRST DECL, USED AS STOPPER >>                       00862000
   RECNO,                                                               00864000
   NEXTREC,                                                             00866000
   KEYREC,                                                              00868000
   MENUREC,                                                             00870000
   PARM1LEN,                                                            00872000
   PARM2LEN,                                                            00874000
   BUZZNO,                                                              00876000
   LEN,                                                                 00878000
   INDEX = STOPPER,                                                     00880000
   KLEN,                                                                00882000
   INFN,                                                                00884000
   OLDPLABEL;                                                           00886000
                                                                        00888000
LOGICAL                                                                 00890000
   DUMMY,                                                      <<01310>>00892000
   DONE,                                                                00894000
   NOTFIRST,                                                            00896000
   MORE,                                                                00898000
   CATEOF;                                                              00900000
                                                                        00902000
BYTE POINTER                                                            00904000
   DEFN, << FOR SEARCH >>                                               00906000
   PARM1,                                                               00908000
   PARM2,                                                               00910000
   PARM3,                                                               00912000
   COMPTR,                                                              00914000
   CARETBASE;                                                           00916000
                                                                        00918000
POINTER                                                                 00920000
   CARETBASE';                                                          00922000
                                                                        00924000
INTEGER PROMPT := ">>";                                                 00926000
BYTE NOCARET := 0;                                                      00928000
                                                                        00930000
EQUATE DSIZE = 20;                                             <<00730>>00932000
BYTE ARRAY DICT(*) =PB :=                                               00934000
5,3,"ALL",                                                              00936000
5,3,"END",                                                              00938000
6,4,"EXIT",                                                             00940000
3,1,"E",                                                                00942000
0;                                                                      00944000
BYTE ARRAY DICTP(0:DSIZE-1);                                   <<00730>>00946000
                                                                        00948000
                                                                        00950000
ARRAY INBUFF'(0:TERMSIZEWM1);                                           00952000
BYTE ARRAY INBUFF(*) = INBUFF';                                         00954000
                                                                        00956000
ARRAY KBUFF'(0:36);                                                     00958000
BYTE ARRAY KBUFF(*) = KBUFF';                                           00960000
                                                                        00962000
INTEGER ARRAY DIR'(0:HMAXDIRSIZE);                                      00964000
BYTE ARRAY DIR(*) = DIR';                                               00966000
                                                                        00968000
DEFINE                                                                  00970000
   ERRETN = ERRNO); ERR(ERRNO,NOCARET #,                                00972000
                                                                        00974000
   SETUPDICT = MOVE DICTP := DICT,(DSIZE)#;                             00976000
                                                                        00978000
INTEGER                                                        <<01310>>00980000
   CACHE,              << CACHE NUMBER CURRENTLY IN DIR. >>    <<01310>>00982000
   CACHE'LIMIT := 0,   << # OF CACHES IN WHOLE DIRECTORY >>    <<01310>>00984000
   FIRSTCACHE,         << FIRST CACHE CHECKED THIS COMMND>>    <<01310>>00986000
   TOTAL'LABELS,       << NUM OF LABELS IN HELP CATALOG. >>    <<01310>>00988000
   WORDS'IN'DIRECTORY, << WORD COUNT; FIRST WORD IN DIR. >>    <<01310>>00990000
   LNUM;               << LABEL NUMBER INDEX.            >>    <<01310>>00992000
                                                               <<01310>>00994000
LOGICAL                                                        <<01310>>00996000
   INITIAL'SETUPDIR    << FLAG FOR FIRST CACHE SET UP.   >>    <<01310>>00998000
         := TRUE,                                              <<01310>>01000000
   HELPSUBSYS:=FALSE,   <<TRUE IF IN SUB SYSTEM>>              <<02343>>01002000
   MODE,                <<SESSION/JOB, ETC>>                   <<02343>>01004000
   NONDUPLIST,          <<TRUE IF NON DUP. LIST DEV>>          <<02343>>01006000
   CONTINUE;           << LOOPING FLAG.                  >>    <<01310>>01008000
                                                               <<01310>>01010000
INTRINSIC DEBUG,PRINT,READ,MYCOMMAND,XCONTRAP;                          01012000
                                                                        01014000
SUBROUTINE WARN(ERRNUM,PTR);                                            01016000
   VALUE ERRNUM; INTEGER ERRNUM;                                        01018000
   BYTE POINTER PTR;                                                    01020000
BEGIN                                                                   01022000
                                                               <<01515>>01024000
IF INTERACT OR HELPSUBSYS                                      <<02343>>01028000
      THEN PRINTCARET( @PTR - @CARETBASE );                    <<01515>>01030000
   GENMSGU( HELPSET, ERRNUM );                                 <<01515>>01032000
                                                               <<01515>>01034000
END; << WARN >>                                                         01036000
                                                                        01038000
                                                                        01040000
SUBROUTINE ERR(ERRNUM,PTR);                                             01042000
   VALUE ERRNUM; INTEGER ERRNUM;                                        01044000
   BYTE ARRAY PTR;                                                      01046000
COMMENT                                                                 01048000
   ALWAYS CALLED AFTER DISPLAYING. IF ERRNUM=0 THEN                     01050000
   CONTROL IS RETURNED TO THE CALLER, OTHERWISE A                       01052000
   SXIT IS MADE TO LABELS ABORTL OR OUTL.                               01054000
   THIS ALLOWS LOOPING ON ERROR CONDITION W/O STACK                     01056000
   OVERFLOW.                                                            01058000
;                                                                       01060000
BEGIN                                                                   01062000
                                                                        01064000
IF ERRNUM <> 0 THEN                                                     01066000
BEGIN                                                                   01068000
   ERRNO := ERRNUM;                                                     01070000
   RECNO:= NEXTREC; << RESTORE CLOBBERED PTR>>                          01072000
   IF ERRNO <= MAXSYNTAXERR THEN                               <<01515>>01074000
   BEGIN                                                                01076000
       IF (PTR <> 0) AND (INTERACT OR HELPSUBSYS)              <<02343>>01080000
         THEN PRINTCARET( @PTR - @CARETBASE );                 <<01515>>01082000
      GENMSGU(HELPSET,ERRNO);                                           01084000
      X := @OUTL;                                                       01086000
   END                                                                  01088000
   ELSE                                                                 01090000
   IF ERRNO = CTLY THEN                                                 01092000
   BEGIN                                                                01094000
      ERRNO := 0;                                                       01096000
      X := @OUTL;                                                       01098000
   END                                                                  01100000
   ELSE X := @ABORTL;                                                   01102000
                                                                        01104000
      << X HOLDS NEW RETURN ADDRESS. DELETE PARMS & >>                  01106000
      << OLD RETURN ADDRESS, THEN RETURN            >>                  01108000
   ASSEMBLE(DEL,DDEL);                                                  01110000
   TOS := X;                                                            01112000
   RETURN 0;                                                            01114000
END;                                                                    01116000
                                                                        01118000
END; << ERR >>                                                          01120000
                                                                        01122000
LOGICAL SUBROUTINE FIND(REC,PARM,PLEN);                                 01124000
   VALUE REC,PLEN;INTEGER REC,PLEN;                                     01126000
   BYTE ARRAY PARM;                                                     01128000
BEGIN                                                                   01130000
   RECNO := FINDKEY(CATFN,REC+1,PARM,PLEN,BUZZNO,ERRETN);               01132000
   IF RECNO <> 0 THEN FIND := TRUE;                                     01134000
END; << FIND >>                                                         01136000
                                                                        01138000
LOGICAL SUBROUTINE READMORE;                                            01140000
BEGIN                                                                   01142000
                                                                        01144000
HELPSUBSYS:=TRUE;         <<WANT TO PRINT CARET ON ERRORS>>    <<02343>>01146000
@COMPTR := @CARETBASE := @INBUFF;                                       01148000
PRINT(PROMPT,-1,%320);                                                  01150000
LEN := FREAD(INFN,INBUFF',-72);                                         01152000
IF < THEN ERR(READERR,NOCARET);                                         01154000
IF > THEN ERR(INPUTEOF,NOCARET);                                        01156000
IF REQUESTSERVICE THEN ERR(BREAKHIT,NOCARET);                           01158000
IF NONDUPLIST  THEN PRINT(INBUFF',-LEN,0); <<ECHO>>            <<02343>>01160000
COMPTR(LEN) := CR;                                                      01162000
NOTFIRST := TRUE;                                                       01164000
                                                                        01166000
END; << READMORE >>                                                     01168000
$PAGE                                                          <<01310>>01170000
LOGICAL SUBROUTINE SETUPDIR;                                   <<01310>>01172000
BEGIN                                                                   01174000
                                                               <<01310>>01176000
<< DETERMINE THE NEXT CACHE TO BE PLACED IN "DIR".         >>  <<01310>>01178000
   IF INITIAL'SETUPDIR THEN                                    <<01310>>01180000
   BEGIN                                                       <<01310>>01182000
      CACHE := 0;                                              <<01310>>01184000
      FGETINFO( CATFN, ,,,,,,,,,,,,,,,, TOTAL'LABELS );        <<01310>>01186000
      IF TOTAL'LABELS <= 0                                     <<01310>>01188000
         THEN ERR( NOUSERLABEL, NOCARET );                     <<01310>>01190000
   END                                                         <<01310>>01192000
   ELSE                                                        <<01310>>01194000
   BEGIN                                                       <<01310>>01196000
      CACHE := IF CACHE + 1 > CACHE'LIMIT                      <<01310>>01198000
                  THEN 0                                       <<01310>>01200000
                  ELSE CACHE + 1;                              <<01310>>01202000
      IF CACHE = FIRSTCACHE THEN                               <<01310>>01204000
      BEGIN                                                    <<01310>>01206000
         SETUPDIR := FALSE;                                    <<01310>>01208000
         CACHE := IF CACHE = 0        << DON'T READ IN >>      <<01310>>01210000
                     THEN CACHE'LIMIT << NEXT CACHE    >>      <<01310>>01212000
                     ELSE CACHE - 1;                           <<01310>>01214000
         RETURN;                                               <<01310>>01216000
      END;                                                     <<01310>>01218000
   END; << NOT INITIAL'SETUPDIR >>                             <<01310>>01220000
                                                               <<01310>>01222000
<< READ IN NEXT DIRECTORY CACHE.                           >>  <<01310>>01224000
   FOR INDEX := 0 UNTIL HMAXDIRSIZEM1 DO  DIR'( INDEX ) := 0;  <<01310>>01226000
   IF CACHE = 0 THEN                                           <<01310>>01228000
      LNUM := 0                                                <<01310>>01230000
   ELSE                                                        <<01310>>01232000
      LNUM := CACHE0LABELS + ( CACHE-1 ) * OTHERCACHELABELS;   <<01310>>01234000
   IF LNUM > TOTAL'LABELS THEN                                 <<01310>>01236000
   BEGIN                                                       <<01310>>01238000
      ERR( USERLABELERR, NOCARET );                            <<01310>>01240000
   END;                                                        <<01310>>01242000
   FREADLABEL( CATFN, DIR', 128, LNUM );                       <<01310>>01244000
   IF <> THEN                                                  <<01310>>01246000
   BEGIN                                                       <<01310>>01248000
      ERR( USERLABELERR, NOCARET );                            <<01310>>01250000
   END;                                                        <<01310>>01252000
                                                               <<01310>>01254000
<< IF THIS IS THE INTIAL EXECUTION OF THIS SUBROUTINE,     >>  <<01310>>01256000
<< DETERMINE THE TOTAL NUMBER OF CACHES IN THE DIRECTORY.  >>  <<01310>>01258000
   IF INITIAL'SETUPDIR THEN                                    <<01310>>01260000
   BEGIN                                                       <<01310>>01262000
      IF DIR' = 0 THEN                                         <<01310>>01264000
         ERR( NOHELPDIR, NOCARET )                             <<01310>>01266000
      ELSE                                                     <<01310>>01268000
         WORDS'IN'DIRECTORY := DIR';                           <<01310>>01270000
      IF TOTAL'LABELS <= CACHE0LABELS  THEN                    <<01310>>01272000
         CACHE'LIMIT := 0                                      <<01310>>01274000
      ELSE                                                     <<01310>>01276000
         CACHE'LIMIT := 1 +                                    <<01310>>01278000
            (TOTAL'LABELS-CACHE0LABELS-1) / OTHERCACHELABELS;  <<01310>>01280000
      INITIAL'SETUPDIR := FALSE;                               <<01310>>01282000
   END;                                                        <<01310>>01284000
                                                               <<01310>>01286000
<< FINISH FILLING THIS CACHE.                              >>  <<01310>>01288000
   INDEX := 1;                                                          01290000
   CONTINUE := TRUE;                                           <<01310>>01292000
   WHILE CONTINUE DO                                           <<01310>>01294000
   BEGIN                                                                01296000
      FREADLABEL( CATFN, DIR'( INDEX*128 ), 128,               <<01310>>01298000
                  ( LNUM + INDEX )  );                         <<01310>>01300000
      IF > THEN CONTINUE := FALSE                              <<01310>>01302000
      ELSE IF < THEN                                           <<01310>>01304000
      BEGIN                                                    <<01310>>01306000
         ERR( USERLABELERR, NOCARET );                         <<01310>>01308000
      END                                                      <<01310>>01310000
      ELSE                                                     <<01310>>01312000
      BEGIN                                                    <<01310>>01314000
         INDEX := INDEX + 1;                                   <<01310>>01316000
         IF INDEX >= LABELS'PER'CACHE                          <<01310>>01318000
            THEN CONTINUE := FALSE;                            <<01310>>01320000
      END;                                                     <<01310>>01322000
   END;                                                                 01324000
                                                               <<01310>>01326000
<< REPLACE WORD COUNT ENTRY WHERE APPROPRIATE.             >>  <<01310>>01328000
   IF CACHE = 0 THEN                                           <<01310>>01330000
   BEGIN                                                       <<01310>>01332000
      DIR      := 2;       <<  NULL   >>                       <<01310>>01334000
      DIR( 1 ) := 0;       <<  ENTRY  >>                       <<01310>>01336000
   END;                                                        <<01310>>01338000
                                                               <<01310>>01340000
   SETUPDIR := TRUE;                                           <<01310>>01342000
                                                               <<01310>>01344000
END; << SETUPDIR >>                                                     01346000
                                                               <<01310>>01348000
LOGICAL SUBROUTINE HELPSEARCH;                                 <<01310>>01350000
BEGIN                                                          <<01310>>01352000
                                                               <<01310>>01354000
<< SEARCH THE CURRENT DIRECTORY CACHE FOR THE PARAMETER.   >>  <<01310>>01356000
   FIRSTCACHE := CACHE;                                        <<01310>>01358000
                                                               <<01310>>01360000
   TRYSEARCH:                                                  <<01310>>01362000
                                                               <<01310>>01364000
   IF SEARCH( PARM1, PARM1LEN, DIR, DEFN ) > 0 THEN            <<01310>>01366000
   BEGIN                                                       <<01310>>01368000
      RECNO.(0:8) := DEFN;                                     <<01310>>01370000
      RECNO.(8:8) := DEFN(1);                                  <<01310>>01372000
      HELPSEARCH := TRUE;                                      <<01310>>01374000
      RETURN;                                                  <<01310>>01376000
   END                                                         <<01310>>01378000
                                                               <<01310>>01380000
<< PARAMETER NOT FOUND IN THE CACHE.  CHECK OTHER CACHES.  >>  <<01310>>01382000
   ELSE IF SETUPDIR THEN                                       <<01310>>01384000
           GO TRYSEARCH                                        <<01310>>01386000
        ELSE                                                   <<01310>>01388000
           HELPSEARCH := FALSE;                                <<01310>>01390000
                                                               <<01310>>01392000
END;  << HELPSEARCH >>                                         <<01310>>01394000
                                                                        01396000
SUBROUTINE SETMENU;                                                     01398000
BEGIN                                                                   01400000
   KEYREC := NEXTREC := RECNO := MENUREC;                               01402000
END; << SETMENU >>                                                      01404000
                                                                        01406000
SUBROUTINE DISPLAY(STOPPER);                                            01408000
   VALUE STOPPER;INTEGER STOPPER;                                       01410000
BEGIN                                                                   01412000
                                                                        01414000
IF MORE AND CATEOF THEN                                                 01416000
BEGIN << AT END OF CATALOG & CR TYPED>>                                 01418000
   MORE := FALSE;                                                       01420000
   ERR(ENDOFCAT,NOCARET);                                               01422000
END;                                                                    01424000
NEXTREC := RECNO := TRAVERSE(CATFN,DISP,RECNO,STOPPER,                  01426000
   ERRETN);                                                             01428000
IF NOT MORE THEN DISPLAYKEY(CATFN,DISP,KEYREC);                         01430000
MORE := FALSE;                                                          01432000
IF RECNO= 0 THEN                                                        01434000
BEGIN   << HIT END OF CATALOG, SET BACK TO ENTRY >>                     01436000
   NEXTREC := RECNO := KEYREC;                                          01438000
   CATEOF := TRUE;                                                      01440000
END                                                                     01442000
ELSE CATEOF := FALSE;                                                   01444000
                                                                        01446000
END; << DISPLAY >>                                                      01448000
                                                                        01450000
<< MAIN BODY >>                                                         01452000
                                                                        01454000
<<CHECK IF LIST DEVICE (IN :JOB) IS NON DUPLICATIVE>>          <<02343>>01456000
WHO(MODE);                                                     <<02343>>01458000
IF MODE.JOB'TYPE = JOB   AND   MODE.LIST'TYPE = NONDUP         <<02343>>01460000
  THEN NONDUPLIST:=TRUE    <<NEED TO ECHO INPUTS>>             <<02343>>01462000
ELSE NONDUPLIST:=FALSE;    <<NO NEED TO ECHO>>                 <<02343>>01464000
                                                               <<02343>>01466000
<< SETUP >>                                                             01468000
<< OPEN $STDIN >>                                                       01470000
INFN := FOPEN(,%44);                                                    01472000
IF <> THEN ERR(OPENSTDINERR,NOCARET);                                   01474000
STOPPER := CR;                                                          01476000
NOTFIRST := MORE := ERRNO := 0;                                         01478000
@CARETBASE := @COMBASE;                                                 01480000
   << DEBLANK COMIMAGE >>                                               01482000
SCAN COMIMAGE WHILE %6440,1;                                            01484000
@COMPTR := TOS;                                                         01486000
DONE := IF COMPTR =CR THEN FALSE ELSE TRUE;                             01488000
                                                                        01490000
SETUPDICT;                                                              01492000
DUMMY := SETUPDIR;                                             <<01310>>01494000
XCONTRAP(@CONTROLYTRAP,OLDPLABEL);                                      01496000
<< FETCH MENU RECORD. FIRST NODE >>                                     01498000
INDEX := DIR(2);                                                        01500000
MENUREC.(0:8) := DIR(INDEX);                                            01502000
MENUREC.(8:8) := DIR(INDEX+1);                                          01504000
SETMENU;                                                                01506000
                                                                        01508000
<< GRAND LOOP. FIND, DISPLAY & READ >>                                  01510000
                                                                        01512000
DO BEGIN                                                                01514000
   BUZZNO := SUBITEMX;                                                  01516000
   HELPARSE(COMPTR,PARM1,PARM1LEN,PARM2,PARM2LEN,PARM3);                01518000
   IF @PARM3 <> 0 THEN WARN(IGNORED,PARM3);                             01520000
   CASE SEARCH(PARM1,PARM1LEN,DICTP) OF                                 01522000
   BEGIN                                                                01524000
                                                                        01526000
   BEGIN << 0: UNKNOWN COMMAND >>                                       01528000
      IF PARM1LEN = 0 THEN IF NOTFIRST THEN                             01530000
         MORE := TRUE << CR >> ELSE                                     01532000
      ELSE                                                              01534000
      BEGIN                                                             01536000
         IF HELPSEARCH THEN                                             01538000
         BEGIN << FOUND ENTRY. CHECK FOR ITEM >>                        01540000
            KEYREC := RECNO;                                            01542000
            IF PARM2LEN <> 0 THEN                                       01544000
            IF PARM2LEN=3 AND PARM2="ALL" THEN BUZZNO:=ENTRYX           01546000
            ELSE                                                        01548000
            IF NOT FIND(RECNO,PARM2,PARM2LEN) THEN                      01550000
               ERR(VENTRY'INVITEM,PARM2);                               01552000
         END                                                            01554000
         ELSE                                                           01556000
         BEGIN << NOT ENTRY >>                                          01558000
            IF NOT FIND(KEYREC,PARM1,PARM1LEN) THEN                     01560000
            IF FIND(MENUREC,PARM1,PARM1LEN) THEN                        01562000
               KEYREC := MENUREC << MENU ITEM >>                        01564000
            ELSE ERR(NOINFO,PARM1);                                     01566000
               << FOUND AS ITEM UNDER CURRENT ENTRY >>                  01568000
            IF PARM2LEN <> 0 THEN WARN(IGNORED,PARM2);                  01570000
         END;                                                           01572000
      END;                                                              01574000
      DISPLAY(BUZZNO);                                                  01576000
   END; << 0 : UNKNOWN COMMAND >>                                       01578000
                                                                        01580000
                                                                        01582000
   DISPLAY(ENTRYX); << ALL >>                                  <<00730>>01584000
                                                                        01586000
   << END >>                                                   <<02343>>01590000
   IF HELPSUBSYS THEN  DONE:=TRUE                              <<02343>>01592000
    ELSE ERR(NOINFO,PARM1);                                    <<02343>>01594000
                                                               <<02343>>01596000
   << EXIT >>                                                  <<02343>>01598000
   IF HELPSUBSYS THEN  DONE:=TRUE                              <<02343>>01600000
    ELSE  ERR(NOINFO,PARM1);                                   <<02343>>01602000
                                                               <<02343>>01604000
   << E >>                                                     <<02343>>01606000
    IF HELPSUBSYS THEN  DONE:=TRUE                             <<02343>>01608000
     ELSE ERR(NOINFO,PARM1);                                   <<02343>>01610000
                                                                        01612000
   END; << CASE >>                                                      01614000
                                                                        01616000
OUTL:                                                                   01618000
                                                                        01620000
END UNTIL DONE OR READMORE;                                             01622000
                                                                        01624000
ABORTL:                                                                 01626000
XCONTRAP(OLDPLABEL,OLDPLABEL);                                          01628000
FCLOSE(INFN,0,0);  << CLOSE $STDINX >>                                  01630000
                                                                        01632000
END; << HELPROC >>                                                      01634000
$TITLE "PRINTCARET"                                                     01636000
PROCEDURE PRINTCARET(OFFSET);                                           01638000
   VALUE OFFSET;                                                        01640000
   INTEGER OFFSET;                                                      01642000
   OPTION INTERNAL;                                                     01644000
BEGIN                                                                   01646000
                                                                        01648000
ARRAY BUFF'(0:TERMSIZEWM1);                                             01650000
BYTE ARRAY BUFF(*) = BUFF';                                             01652000
                                                                        01654000
BUFF := " ";                                                            01656000
MOVE BUFF(1) := BUFF,(OFFSET);                                          01658000
BUFF(OFFSET +1) := "^";                                                 01660000
PRINT(BUFF',-OFFSET -2,0);                                              01662000
                                                                        01664000
END; << PROCEDURE PRINTCARET >>                                         01666000
$TITLE "READCAT'"                                                       01668000
PROCEDURE READCAT'(CATFN,BUFF',LEN,RECNO,ERRNO);                        01670000
   VALUE CATFN,RECNO;                                                   01672000
   INTEGER CATFN,LEN,RECNO,ERRNO;                                       01674000
   ARRAY BUFF';                                                         01676000
   OPTION INTERNAL;                                                     01678000
BEGIN                                                                   01680000
                                                                        01682000
BYTE ARRAY BUFF(*) = BUFF';                                             01684000
                                                                        01686000
LEN := 0; << IN CASE FREAD FAILS >>                                     01688000
FREADDIR(CATFN,BUFF',HBUFFSIZE,DOUBLE(RECNO));                          01690000
IF <> THEN ERRNO := CATERR                                              01692000
ELSE                                                                    01694000
BEGIN                                                                   01696000
   ERRNO := 0;                                                          01698000
                                                                        01700000
   LEN := DEBLANK(BUFF,HBUFFSIZEB);                                     01702000
END;                                                                    01704000
                                                                        01706000
END; << READCAT' >>                                                     01708000
$TITLE "TRAVERSE"                                                       01710000
INTEGER PROCEDURE TRAVERSE(CATFN,FN,RECNO,STOPPER,ERRNO);               01712000
   VALUE CATFN,FN,RECNO,STOPPER;                                        01714000
   INTEGER CATFN,FN,RECNO,STOPPER,ERRNO;                                01716000
   OPTION INTERNAL;                                                     01718000
COMMENT DISPLAYS HELP TREE. STARTS AT RECNO & CONTINUES UNTIL           01720000
A NODE >= STOPPER IS FOUND. THE RECORD NUMBER OF THE NODE IS            01722000
RETURNED, UNLESS THIS IS THE END OF THE TREE IN WHICH CASE A            01724000
ZERO IS RETURNED. AN I/O ERROR SETS ERRNO TO NON-ZERO.                  01726000
;                                                                       01728000
BEGIN                                                                   01730000
INTEGER                                                                 01732000
   BUZZNO,                                                              01734000
   DUMMY = BUZZNO;                                                      01736000
                                                                        01738000
ARRAY BUFF'(0:HBUFFSIZE);                                               01740000
                                                                        01742000
DO BEGIN                                                                01744000
   RECNO := DISPLAYBLOCK(CATFN,FN,RECNO+1,BUFF',BUZZNO,                 01746000
      ERRNO);                                                           01748000
END UNTIL ERRNO <> 0 OR STOPPER >= BUZZNO;                              01750000
TRAVERSE := IF BUZZNO = ALLX THEN 0 ELSE RECNO;                         01752000
IF ERRNO = CTLY THEN PRINT(DUMMY,0,0);                                  01754000
                                                                        01756000
END; << TRAVERSE >>                                                     01758000
$CONTROL SEGMENT=MAIN                                                   01760000
END. << HELPUSER >>                                                     01762000
