$CONTROL MAP,CODE,USLINIT                                               00010000
<< MAKECAT -- MODULE 40 >>                                              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=PRIV,MAIN=MAKECAT << MODULE 40 >>                      00028000
BEGIN                                                                   00030000
                                                                        00032000
                                                                        00034000
<< QUIT PROCEDURE ERRORS >>                                             00036000
                                                                        00038000
EQUATE                                                                  00040000
   INSUFFCAPERR     = 1,                                                00042000
   OPENINERR        = 2,                                                00044000
   OPENCATERR       = 3,                                                00046000
   WRITELABELERR    = 4,                                                00048000
   CLOSECATERR      = 5,                                                00050000
   INITMSGERR       = 6,                                                00052000
   MAKEHELPERR      = 7,                                                00054000
   HENLARGERROR     = 8,                                       <<01310>>00056000
   ZENDQUITERRS     = 0;                                                00058000
                                                                        00060000
EQUATE                                                                  00062000
   PCBSIZE = 16,                                                        00064000
   PCBB    = 3,                                                         00066000
   CPCB    = 4,                                                         00068000
   QI      = 5,                                                         00070000
                                                                        00072000
   MSGBASE       = %1371,                                               00074000
   MSGSIR        = %24,                                                 00076000
   SYSDISC       = 1,                                                   00078000
   CONSOLECELL   = %1074,                                               00080000
   SBUFDSTN      = %10,                                                 00082000
   SBUFSIZEW     = 128,                                                 00084000
   SBUFSIZE      = 256,                                                 00086000
   SBUFSIZEWM1   = SBUFSIZEW -1;                                        00088000
                                                                        00090000
DEFINE                                                                  00092000
   DISABLE = ASSEMBLE( SED 0) #,                                        00094000
   ENABLE  = ASSEMBLE( SED 1) #,                                        00096000
   MYPIN = ((ABSOLUTE(CPCB) -ABSOLUTE(PCBB))/ PCBSIZE)#,                00098000
   SYSPROC = LOGICAL(ABSOLUTE(ABSOLUTE(CPCB) +9).(6:1))#;               00100000
                                                                        00102000
EQUATE                                                                  00104000
   CCG           = 0,                                                   00106000
   CCL           = 1,                                                   00108000
   CCE           = 2,                                                   00110000
   STOPPER       = 0,                                                   00112000
                                                                        00114000
   HEADERSIZE    = 2,                                          <<00711>>00116000
   MAXNOSETS     = 62, <<(SECTOR-4 WORD HEADER-WORK AREA)/2>>  <<00711>>00118000
   MSGDIRSIZE    = MAXNOSETS*2 + HEADERSIZE + 2<<WORK AREA>>,  <<00711>>00120000
   MAXSETNOCELL  = 0,                                          <<00711>>00122000
   MAXRECELL     = 1,                                          <<00711>>00124000
   CURRENTRECELL = MSGDIRSIZE - 1,                             <<00711>>00126000
   RECSIZE           = 40,                                              00128000
   RECSIZEB          = RECSIZE*2,                                       00130000
   RECSIZEM1         = RECSIZE -1,                                      00132000
   BUFFSIZE          = RECSIZE -4,                                      00134000
   BUFFSIZEM1        = BUFFSIZE -1,                                     00136000
   BUFFSIZEB         = BUFFSIZE*2,                                      00138000
   BLKFACTOR         = 16,                                              00140000
   PHYSBLK           = BLKFACTOR * RECSIZE,                    <<01310>>00142000
   SECTORPERBLK      = PHYSBLK/128,                                     00144000
                                                                        00146000
   HRECSIZE          = 40,                                              00148000
   HRECSIZEM1        = HRECSIZE -1,                                     00150000
   HRECSIZEB         = HRECSIZE *2,                                     00152000
   HBUFFSIZE         = HRECSIZE -4,                                     00154000
   HBUFFSIZEB        = HRECSIZEB -8,<<HELP NEVER SEES LINENOS>>         00156000
   HBUFFSIZEM1       = HBUFFSIZE - 1,                          <<01310>>00158000
   HBLKFACTOR        = 16,                                     <<01310>>00160000
   HPHYSBLK          = HBLKFACTOR * HRECSIZE,                  <<01310>>00162000
   HSECTORPERBLK     = HPHYSBLK / 128,                         <<01310>>00164000
   HMAXDIRSIZE       = HPHYSBLK * 4,                           <<01310>>00166000
   HMAXDIRSIZEB      = HMAXDIRSIZE * 2,                        <<01310>>00168000
   HMAXDIRSIZEM1     = HMAXDIRSIZE - 1,                        <<01310>>00170000
   HNEXTNUMLBLS      = 4 * HSECTORPERBLK,                      <<01310>>00172000
   HNEXTNUMWORDS     = HNEXTNUMLBLS * 128,                     <<01310>>00174000
   HINNUMULBLS       = 4 * HSECTORPERBLK - 1,                  <<01310>>00176000
   HFIRST'BLK'SPACE  = HINNUMULBLS * 128;                      <<01310>>00178000
                                                               <<01310>>00180000
INTEGER                                                        <<01310>>00182000
   HLABELS'WRITTEN         := 0,                               <<01310>>00184000
   HWORDS'WRITTEN          := 0,                               <<01310>>00186000
   HLABELS'IN'NEXT'BLOCK   := HINNUMULBLS,                     <<01310>>00188000
   HWORDS'IN'NEXT'BLOCK    := HFIRST'BLK'SPACE,                <<01310>>00190000
   HNUMOFULABELS           := HINNUMULBLS;                     <<01310>>00192000
                                                                        00194000
INTEGER                                                                 00196000
   STATUS = Q-1,                                                        00198000
   S0 =S-0,                                                             00200000
   X = X;                                                               00202000
                                                                        00204000
BYTE POINTER BPS0 = S-0;                                                00206000
POINTER PS0 = S-0;                                                      00208000
DOUBLE POINTER DPS0 = S-0;                                              00210000
                                                                        00212000
DEFINE                                                                  00214000
   MSGDSTN       = ABSOLUTE(MSGBASE+2)#,                                00216000
                                                                        00218000
   CONDCODE      = STATUS.(6:2)#,                                       00220000
   CCGRETN       = BEGIN                                                00222000
                      CONDCODE := CCG;                                  00224000
                      GO OUTL;                                          00226000
                   END#,                                                00228000
   CCLRETN       = BEGIN                                                00230000
                      CONDCODE := CCL;                                  00232000
                      GO OUTL;                                          00234000
                   END#,                                                00236000
   DEF'MOVEFROMDSEG =                                                   00238000
      MOVEFROMDSEG(TARGET,DSTN,OFFSET,COUNT);                           00240000
         VALUE TARGET,DSTN,OFFSET,COUNT;                                00242000
         LOGICAL TARGET,DSTN,OFFSET,COUNT;                              00244000
      BEGIN                                                             00246000
         X := TOS; << SAVE RETURN ADDRESS >>                            00248000
         ASSEMBLE(MFDS 0);                                              00250000
         TOS := X; << RESTORE RETURN ADDRESS >>                         00252000
      END #,                                                            00254000
                                                                        00256000
   DEF'MOVETODSEG =                                                     00258000
      MOVETODSEG(DSTN,OFFSET,SOURCE,COUNT);                             00260000
         VALUE DSTN,OFFSET,SOURCE,COUNT;                                00262000
         LOGICAL DSTN,OFFSET,SOURCE,COUNT;                              00264000
      BEGIN                                                             00266000
         X := TOS;                                                      00268000
         ASSEMBLE(MTDS 0);                                              00270000
         TOS := X;                                                      00272000
      END #,                                                            00274000
                                                                        00276000
                                                                        00278000
   DEF'PXGLOB =                                                         00280000
      PXGLOB(INDEX);                                                    00282000
         VALUE INDEX;                                                   00284000
         INTEGER INDEX;                                                 00286000
      COMMENT     *** WORKS ONLY IF DB AT STACK *** ;                   00288000
      BEGIN                                                             00290000
                                                                        00292000
      ASSEMBLE(                                                         00294000
      PSHR %40;     << DL >>                                            00296000
      LDXN 1;       << PCBX GLOBE PTR 1 BELOW DL >>                     00298000
      SUBM S-0,I,X; << OFFSET TO PXGLOB >>                              00300000
      STAX,ADBX;    << X:= OFFSET + INDEX >>                            00302000
      LOAD DB+0,X;  << GET VALUE >>                                     00304000
      STOR S-3;);   << PUT IN RETURN VALUE >>                           00306000
      END << PXGLOB >>   #;                                             00308000
                                                                        00310000
<< END GLOBAL DECLS >>                                                  00312000
                                                                        00314000
                                                                        00316000
<< DATA FOR MAKECAT >>                                                  00318000
                                                                        00320000
INTEGER ARRAY DIRECTORY(0:MSGDIRSIZE-1) := MSGDIRSIZE(0);               00322000
                                                                        00324000
ARRAY FNARRAY(0:3) =DB;                                                 00326000
INTEGER                 << ERR(PARM) >>                                 00328000
   INFN = FNARRAY,      << 0 >>                                         00330000
   CATFN = INFN+1,      << 1 >>                                         00332000
   LISTFN = CATFN+1,    << 2 >>                                         00334000
   CATOLDFN = LISTFN+1; << 3 >>                                         00336000
                                                                        00338000
EQUATE                                                                  00340000
   INFNX     = 0,                                                       00342000
   CATFNX    = 1,                                                       00344000
   LISTFNX   = 2,                                                       00346000
   CATOLDFNX = 3;                                                       00348000
                                                                        00350000
DOUBLE CATSIZE;                                                         00352000
                                                                        00354000
LOGICAL INSTALL := TRUE; <<STAYS THIS WAY ENTERING THRU DIR>>           00356000
LOGICAL BUILDMODE :=TRUE; << For BUILD parameter >>                     00358000
                                                                        00360000
BYTE ARRAY BUFF(0:79);                                                  00362000
ARRAY BUFF'(*)=BUFF;                                                    00364000
                                                                        00366000
                                                                        00368000
ENTRY BUILD,DIR,HELP;                                                   00370000
                                                                        00372000
<< EXTERNAL DECLARATIONS >>                                             00374000
                                                                        00376000
INTRINSIC FCLOSE,FWRITE,FWRITELABEL,PRINT,FOPEN,FGETINFO,               00378000
   WHO,TERMINATE,SETJCW,SEARCH,PRINTFILEINFO,FREADLABEL,       <<01310>>00380000
   FCONTROL,GETJCW,                                            <<04571>>00382000
   FSPACE,FWRITEDIR,MYCOMMAND,FRENAME,ASCII,FREAD,FCHECK,BINARY;        00384000
                                                                        00386000
                                                                        00388000
INTEGER PROCEDURE FINDPARM(STRING,PARMPTR,DELPTR);                      00390000
   BYTE ARRAY STRING; BYTE POINTER PARMPTR,DELPTR;                      00392000
   OPTION VARIABLE,EXTERNAL;                                            00394000
                                                                        00396000
INTEGER PROCEDURE GENMSG(A,B,C,D,E,F,G,H,I,J,K,L,M);                    00398000
   VALUE A,B,C,D,E,F,G,H,I,J,K,L,M;                                     00400000
   LOGICAL A,B,C,D,E,F,G,H,I,J,K,L,M;                                   00402000
   OPTION VARIABLE,EXTERNAL;                                            00404000
                                                                        00406000
PROCEDURE GETUSERMODE; OPTION EXTERNAL;                                 00408000
PROCEDURE GETPRIVMODE; OPTION EXTERNAL;                                 00410000
                                                                        00412000
PROCEDURE INITMSG; OPTION EXTERNAL;                                     00414000
                                                                        00416000
INTEGER PROCEDURE NEXTPARM(STRING,PARMPTR,DELPTR);                      00418000
   BYTE ARRAY STRING; BYTE POINTER PARMPTR,DELPTR;                      00420000
   OPTION VARIABLE,EXTERNAL;                                            00422000
                                                                        00424000
                                                                        00426000
<< FORWARD DECLARATIONS >>                                              00428000
                                                                        00430000
PROCEDURE ERR(A);VALUE A;INTEGER A;OPTION FORWARD;                      00432000
                                                                        00434000
PROCEDURE OPENHELPCAT; OPTION FORWARD;                                  00436000
                                                                        00438000
PROCEDURE OPENIN; OPTION FORWARD;                                       00440000
                                                                        00442000
PROCEDURE SCANHELPCAT;OPTION FORWARD;                                   00444000
                                                               <<01310>>00446000
PROCEDURE QUIT( NUM );                                         <<01310>>00448000
   VALUE NUM;  INTEGER NUM;                                    <<01310>>00450000
   OPTION FORWARD;                                             <<01310>>00452000
                                                                        00454000
$CONTROL SEGMENT=USER                                                   00456000
                                                                        00458000
$TITLE "CAPABILITYOK"                                                   00460000
LOGICAL PROCEDURE CAPABILITYOK;                                         00462000
BEGIN                                                                   00464000
                                                                        00466000
DOUBLE CAPD;                                                            00468000
LOGICAL CAPI = CAPD;                                                    00470000
BYTE ARRAY USERNAME(0:7),GROUPNAME(0:7),                                00472000
           ACCTNAME(0:7);                                               00474000
LOGICAL WRONGCAPABILITY:=FALSE;                                         00476000
                                                                        00478000
WHO(,CAPD,,USERNAME,GROUPNAME,ACCTNAME);                                00480000
IF BUILDMODE = TRUE                                                     00482000
   THEN IF ((USERNAME="MANAGER ") LAND (ACCTNAME="SYS     "))           00484000
        THEN CAPABILITYOK:=TRUE                                         00486000
        ELSE BEGIN                                                      00488000
             WRONGCAPABILITY:=TRUE;                                     00490000
             MOVE BUFF:=("** USER MUST BE MANAGER.SYS ",                00492000
                       "FOR BUILD"),2;                                  00494000
             END;                                                       00496000
   ELSE IF CAPI.(5:1) OR CAPI.(0:1)                                     00498000
           THEN CAPABILITYOK:=TRUE                                      00500000
           ELSE BEGIN                                                   00502000
                WRONGCAPABILITY:=TRUE;                                  00504000
                MOVE BUFF:=("**USER LACKS OP(OPERATOR) OR SM",          00506000
                     "(SYSTEM MANAGER) CAPABILITY. "),2;                00508000
                END;                                                    00510000
IF WRONGCAPABILITY = TRUE                                               00512000
   THEN PRINT(BUFF',-(S0-@BUFF),0);DEL;                                 00514000
END; << PROCEDURE CAPABILITYOK >>                                       00516000
$TITLE "BUZZFETCH"                                             <<01507>>00518000
$PAGE                                                          <<01507>>00520000
INTEGER PROCEDURE BUZZFETCH( STRING );                         <<01507>>00522000
   VALUE STRING;                                               <<01507>>00524000
   BYTE POINTER STRING;                                        <<01507>>00526000
   OPTION INTERNAL;                                            <<01507>>00528000
COMMENT                                                        <<01507>>00530000
   RETURNS BUZZ NUMBER FROM BUZZ WORD ARRAY.  RETURNS "0"      <<01507>>00532000
   IF NO MATCH IS FOUND.                                       <<01507>>00534000
;                                                              <<01507>>00536000
                                                               <<01507>>00538000
BEGIN                                                          <<01507>>00540000
                                                               <<01507>>00542000
   INTEGER LEN;                                                <<01507>>00544000
                                                               <<01507>>00546000
   BYTE ARRAY DICT(*)    = PB  :=                              <<01507>>00548000
      5,3, "ALL",          << 1 >>                             <<01507>>00550000
      5,3, "SET",          << 2 >>                             <<01507>>00552000
      7,5, "ENTRY",        << 3 >>                             <<01507>>00554000
      6,4, "ITEM",         << 4 >>                             <<01507>>00556000
      9,7, "SUBITEM",      << 5 >>                             <<01507>>00558000
     11,9, "STARTHELP",    << 6 >>                             <<04571>>00560000
     10,8, "STOPHELP",     << 7 >>                             <<04571>>00562000
      8,6, "SUBSET",       << 8 >>                             <<01507>>00564000
     10,8, "CONTINUE",     << 9 >>                             <<01507>>00566000
      0;                                                       <<01507>>00568000
                                                               <<01507>>00570000
   BYTE ARRAY ENDICT(*) = PB := 0;  << END ADDRESS OF DICT >>  <<01507>>00572000
                                                               <<01507>>00574000
   BYTE POINTER DICTP;                                         <<01507>>00576000
                                                               <<01507>>00578000
                                                               <<01507>>00580000
   TOS := 0;                << SET UP DB DICTIONARY ARRAY. >>  <<01507>>00582000
   @DICTP := @S0 & LSL(1);  << BYTE ADDRESS.               >>  <<01507>>00584000
   TOS := X                 << WORD LENGTH OF DICT.        >>  <<01507>>00586000
       := (@ENDICT - @DICT + 1 ) & LSR(1);                     <<01507>>00588000
   ASSEMBLE( ADDS 0 );      << ALLOCATE SPACE.             >>  <<01507>>00590000
   TOS := @DICTP & LSR(1);  << WORD ADDRESS OF TARGET.     >>  <<01507>>00592000
   TOS := @DICT & LSR(1);   << WORD ADDRESS OF SOURCE.     >>  <<01507>>00594000
   TOS := X;                << COUNT OF SOURCE.            >>  <<01507>>00596000
   ASSEMBLE( MOVE PB );     << PUT DICTIONARY INTO STACK.  >>  <<01507>>00598000
                                                               <<01507>>00600000
   MOVE STRING := STRING WHILE ANS,1;                          <<01507>>00602000
   LEN := TOS - @STRING;                                       <<01507>>00604000
                                                               <<01507>>00606000
   BUZZFETCH := SEARCH( STRING, LEN, DICTP );                  <<01507>>00608000
                                                               <<01507>>00610000
END;  << BUZZFETCH >>                                          <<01507>>00612000
$TITLE "CLOSECAT"                                                       00614000
PROCEDURE CLOSECAT(PERM);                                               00616000
   VALUE PERM;                                                          00618000
   LOGICAL PERM;                                                        00620000
BEGIN                                                                   00622000
                                                                        00624000
INTEGER                                                                 00626000
   DOMAIN,                                                              00628000
   LEN,                                                                 00630000
   I;                                                                   00632000
                                                                        00634000
BYTE ARRAY BUFF(0:27);                                                  00636000
BYTE ARRAY BUFF1(0:27);                                                 00638000
                                                                        00640000
SUBROUTINE ERRETN(FINDEX);                                              00642000
   VALUE FINDEX;                                                        00644000
   INTEGER FINDEX;                                                      00646000
BEGIN                                                                   00648000
   ERR(FINDEX);                                                         00650000
   CONDCODE := CCL;                                                     00652000
   GO OUTL;                                                             00654000
END; << ERRETN >>                                                       00656000
                                                                        00658000
SUBROUTINE RENAME(FNX);                                                 00660000
   VALUE FNX;INTEGER FNX;                                               00662000
BEGIN                                                                   00664000
      I := 0;                                                           00666000
      MOVE BUFF := "CAT";                                               00668000
      DO BEGIN                                                          00670000
         I := I+1;                                                      00672000
         BUFF(ASCII(I,10,BUFF(3)) +3) := " ";                           00674000
         FRENAME(FNARRAY(FNX),BUFF);                                    00676000
      END UNTIL = OR I >9999;                                           00678000
      IF <> THEN ERRETN(FNX);                                           00680000
      FCLOSE(FNARRAY(FNX),DOMAIN,0);<<CLOSE WITH NEW NAME>>             00682000
      IF <> THEN ERRETN(FNX);                                           00684000
END; << RENAME >>                                                       00686000
                                                                        00688000
CONDCODE := CCE;                                                        00690000
DOMAIN := IF PERM THEN 1 ELSE 2;                                        00692000
FCLOSE(CATFN,DOMAIN,0);                                                 00694000
IF <> THEN                                                              00696000
BEGIN                                                                   00698000
   IF PERM THEN << OLD CAT IS PERM, ALREADY OPEN? >>                    00700000
   BEGIN                                                                00702000
      FGETINFO(CATFN,BUFF1);                                            00704000
      FGETINFO(INFN,BUFF);                                              00706000
      SCAN BUFF UNTIL " ",1;                                            00708000
      LEN := TOS -@BUFF;                                                00710000
      IF BUFF1 = BUFF,(LEN) THEN << ALREADY OPEN>>                      00712000
         RENAME(INFNX)                                                  00714000
      ELSE                                                              00716000
      BEGIN                                                             00718000
         MOVE BUFF := "CATALOG ";                                       00720000
         CATOLDFN := FOPEN(BUFF,1,%100); <<PERM;ECXL>>                  00722000
         IF <> THEN ERRETN(CATOLDFNX);                                  00724000
         RENAME(CATOLDFNX);                                             00726000
      END;                                                              00728000
   END                                                                  00730000
   ELSE                                                                 00732000
   BEGIN << OLD CAT IS TEMP, OPEN IT >>                                 00734000
      MOVE BUFF := "CATALOG ";                                          00736000
      CATOLDFN := FOPEN(BUFF,2,%100); << TEMP, EXCL ACC >>              00738000
      IF <> THEN ERRETN(CATOLDFNX);                                     00740000
      RENAME(CATOLDFNX);                                                00742000
   END;                                                                 00744000
   FCLOSE(CATFN,DOMAIN,0); << TRY AGAIN >>                              00746000
   IF <> THEN ERRETN(CATFNX);                                           00748000
END;                                                                    00750000
                                                                        00752000
OUTL:                                                                   00754000
END; << CLOSECAT >>                                                     00756000
$TITLE "CLOSEHELPCAT"                                                   00758000
PROCEDURE CLOSEHELPCAT;                                                 00760000
BEGIN                                                                   00762000
CONDCODE := CCE;                                                        00764000
FCLOSE(INFN,0,0);                                                       00766000
IF <> THEN                                                              00768000
BEGIN                                                                   00770000
   ERR(0);                                                              00772000
   CONDCODE := CCL;                                                     00774000
END                                                                     00776000
ELSE                                                                    00778000
BEGIN                                                                   00780000
   FCLOSE( CATFN, 9, 0 );  << RETURN UNUSED SPACE. >>          <<01310>>00782000
   IF <> THEN                                                           00784000
   BEGIN                                                                00786000
      ERR(1);                                                           00788000
      CONDCODE := CCL;                                                  00790000
   END;                                                                 00792000
END;                                                                    00794000
                                                                        00796000
END; << CLOSEHELPCAT >>                                                 00798000
                                                                        00800000
$TITLE "DIRFILLIN"                                                      00802000
PROCEDURE DIRFILLIN(DIRECTORY);                                         00804000
   INTEGER ARRAY DIRECTORY;                                             00806000
COMMENT FILLS IN DIRECTORY HOLES WHEN MISSING SETS OCCUR                00808000
   AFTER AN EXISTING SET.                                               00810000
   IF SET <N+1> IS MISSING, RECOFFSET <N+1> IS FILLED IN                00812000
   WITH RECOFFSET OF NEXT EXISTING SET.  THIS GIVES UPPER               00814000
   BOUNDS FOR SET <N>.                                                  00816000
   ALL MISSING MESSAGE SETS ARE MARKED WITH A "-1" AS THE      <<01297>>00818000
   FIRST MESSAGE NUMBER.                                       <<01297>>00820000
   NOTE:  THE LAST MESSAGE SET IS ALWAYS A VALID ENTRY.        <<01297>>00822000
;                                                              <<01297>>00824000
                                                               <<01297>>00826000
BEGIN                                                          <<01297>>00828000
                                                               <<01297>>00830000
INTEGER  I, J;       << INDEX VARIABLES.                   >>  <<01297>>00832000
POINTER                                                        <<01297>>00834000
   PTR,              << MISSING SET POINTER.               >>  <<01297>>00836000
   MAXSET'PTR;       << POINTS TO THE LAST SET ENTRY.      >>  <<01297>>00838000
                                                               <<01297>>00840000
   @MAXSET'PTR := @DIRECTORY( DIRECTORY( MAXSETNOCELL ) * 2 ); <<01297>>00842000
                                                               <<01297>>00844000
   @PTR := @DIRECTORY( 2 );   << ENTRY FOR FIRST SET.      >>  <<01297>>00846000
   DO                                                          <<01297>>00848000
   BEGIN                                                       <<01297>>00850000
                                                               <<01297>>00852000
   << FIND THE NEXT MISSING SET ENTRY, IF THERE.           >>  <<01297>>00854000
      WHILE  ( PTR <> 0 )  AND  ( @PTR < @MAXSET'PTR )         <<01297>>00856000
         DO  @PTR := @PTR(2);                                  <<01297>>00858000
                                                               <<01297>>00860000
   << IF A MISSING SET ENTRY WAS FOUND, FIND THE NEXT      >>  <<01297>>00862000
   << VALID SET ENTRY.                                     >>  <<01297>>00864000
      I := 0;                                                  <<01297>>00866000
      IF  PTR = 0  THEN                                        <<01297>>00868000
      BEGIN                                                    <<01297>>00870000
                                                               <<01297>>00872000
         DO I := I + 2        << FIND NEXT VALID ENTRY.    >>  <<01297>>00874000
         UNTIL  PTR( I ) <> 0;                                 <<01297>>00876000
                                                               <<01297>>00878000
      <<  "PTR" AND "PTR( I-2 )" DEFINE A GAP OF MISSING   >>  <<01297>>00880000
      <<  SET ENTRIES.  FILL THE HOLES...                  >>  <<01297>>00882000
         FOR J := 0 STEP 2 UNTIL I-2 DO                        <<01297>>00884000
         BEGIN                                                 <<01297>>00886000
            PTR( J ) := PTR( I );                              <<01297>>00888000
            PTR( J+1 ) := -1;                                  <<01297>>00890000
         END;                                                  <<01297>>00892000
                                                               <<01297>>00894000
      END;                                                     <<01297>>00896000
                                                               <<01297>>00898000
   << CONTINUE SEARCH FOR MISSING MESSAGE SET ENTRIES.     >>  <<01297>>00900000
      @PTR := @PTR( I+2 );                                     <<01297>>00902000
                                                               <<01297>>00904000
   END                                                         <<01297>>00906000
   UNTIL  @PTR >= @MAXSET'PTR;                                 <<01297>>00908000
                                                               <<01297>>00910000
END;  << DIRFILLIN >>                                          <<01297>>00912000
$TITLE "ERR"                                                            00914000
$CONTROL SEGMENT=PRIV1                                                  00916000
PROCEDURE ERR(FINDEX);                                                  00918000
   VALUE FINDEX; INTEGER FINDEX;                                        00920000
   OPTION PRIVILEGED;                                                   00922000
BEGIN                                                                   00924000
                                                                        00926000
INTEGER                                                                 00928000
   ECODE;                                                               00930000
                                                                        00932000
FCHECK(FNARRAY(FINDEX),ECODE);                                          00934000
TOS := @BUFF;                                                           00936000
MOVE * := "** FILE ERROR ON ",2;                                        00938000
CASE FINDEX OF                                                          00940000
BEGIN                                                                   00942000
   MOVE * := "INPUT",2;                                                 00944000
   MOVE * := "CATALOG",2;                                               00946000
   MOVE * := "LIST",2;                                                  00948000
   MOVE * := "OLD CATALOG",2;                                           00950000
END;                                                                    00952000
MOVE * := (" (!)",0);                                                   00954000
GENMSG(-1,@BUFF,%10000,ECODE);                                          00956000
                                                                        00958000
END; << ERR >>                                                          00960000
$TITLE "MAKEHELP"                                                       00962000
$CONTROL SEGMENT=USER                                                   00964000
LOGICAL PROCEDURE MAKEHELP;                                             00966000
BEGIN                                                                   00968000
                                                                        00970000
OPENIN;                                                                 00972000
IF <> THEN GO OUTL;                                                     00974000
OPENHELPCAT;                                                            00976000
IF <> THEN GO OUTL;                                                     00978000
SCANHELPCAT;                                                            00980000
IF <> THEN GO OUTL;                                                     00982000
CLOSEHELPCAT;                                                           00984000
IF <> THEN GO OUTL;                                                     00986000
MAKEHELP := TRUE;                                                       00988000
                                                                        00990000
OUTL:                                                                   00992000
END; << MAKEHELP >>                                                     00994000
$TITLE "OPENCAT"                                                        00996000
$CONTROL SEGMENT=USER                                                   00998000
PROCEDURE OPENCAT(ON'SDISC);                                            01000000
   VALUE ON'SDISC;                                                      01002000
   LOGICAL ON'SDISC;                                                    01004000
BEGIN                                                                   01006000
   BYTE ARRAY BUFF(0:7);                                                01008000
   BYTE ARRAY DEV(0:5);                                                 01010000
                                                                        01012000
CONDCODE := CCE;                                                        01014000
MOVE BUFF := "CATALOG ";                                                01016000
IF ON'SDISC THEN MOVE DEV := "1 "                                       01018000
ELSE MOVE DEV := "DISC ";                                               01020000
CATFN := FOPEN(BUFF,4,5,                                                01022000
   RECSIZE,DEV,,1,BLKFACTOR,,CATSIZE,1);                                01024000
<< NEW, WRITE ACCESS >>                                                 01026000
IF <> THEN                                                              01028000
BEGIN                                                                   01030000
   ERR(CATFNX);                                                         01032000
   CCLRETN;                                                             01034000
END;                                                                    01036000
OUTL:                                                                   01038000
END; << OPENCAT >>                                                      01040000
$TITLE "OPENHELPCAT"                                                    01042000
PROCEDURE OPENHELPCAT;                                                  01044000
BEGIN                                                                   01046000
                                                                        01048000
BYTE ARRAY BUFF(0:7);                                                   01050000
                                                                        01052000
CONDCODE := CCE;                                                        01054000
                                                               <<01310>>01056000
<< OPEN HELPCAT WITH ENOUGH SPACE FOR KEY CONTINUATION.    >>  <<01310>>01058000
   CATSIZE := CATSIZE + CATSIZE & DLSR(3);                     <<01310>>01060000
                                                               <<01310>>01062000
MOVE BUFF := "HELPCAT ";                                                01064000
CATFN := FOPEN(BUFF,4,5,HRECSIZE,,,HNUMOFULABELS,              <<01310>>01066000
   HBLKFACTOR,,CATSIZE,32); << NEW, WRITE ACCESS >>            <<01310>>01068000
IF <> THEN                                                              01070000
BEGIN                                                                   01072000
   ERR(CATFNX);                                                         01074000
   CCLRETN;                                                             01076000
END;                                                                    01078000
                                                                        01080000
OUTL:                                                                   01082000
END; << OPENHELPCAT >>                                                  01084000
$TITLE "ENLARGEHDIR"                                           <<01310>>01086000
PROCEDURE ENLARGEHDIR( FILENUM, RECNO, DIR', DIRX );           <<01310>>01088000
                                                               <<01310>>01090000
   VALUE   RECNO;                                              <<01310>>01092000
   INTEGER FILENUM, RECNO, DIRX;                               <<01310>>01094000
   INTEGER ARRAY DIR';                                         <<01310>>01096000
                                                               <<01310>>01098000
<< THE "HELP" DIRECTORY HAS BEEN FOUND TO BE TOO SMALL >>      <<01310>>01100000
<< TO CONTAIN ALL THE ENTRIES IN THE HELP CATALOG.     >>      <<01310>>01102000
<< THIS PROCEDURE WILL ENLARGE THE DIRECTORY SPACE.    >>      <<01310>>01104000
<< THIS IS DONE BY CREATING A NEW FILE WITH MORE USER  >>      <<01310>>01106000
<< LABEL (DIRECTORY) SPACE, COPYING THE OLD USER       >>      <<01310>>01108000
<< LABELS, AND COPYING THE OLD FILE.  THE OLD FILE     >>      <<01310>>01110000
<< IS ASSUMED TO BE THE FILE CURRENTLY BEING BUILT FOR >>      <<01310>>01112000
<< THE HELP CATALOG.  THIS FILE IS DESTROYED AND THE   >>      <<01310>>01114000
<< NEW FILE'S NUMBER TAKES ITS PLACE.                  >>      <<01310>>01116000
                                                               <<01310>>01118000
BEGIN                                                          <<01310>>01120000
                                                               <<01310>>01122000
   INTEGER                                                     <<01310>>01124000
      OLD,   << OLD FILE NUMBER (TO BE DELETED).       >>      <<01310>>01126000
      NEW,   << NEW FILE NUMBER THAT REPLACES OLD FILE >>      <<01310>>01128000
      I,     << INDEX COUNTER.                         >>      <<01310>>01130000
      LEN;   << LENGTH OF COPY RECORD TRANSFERRED.     >>      <<01310>>01132000
                                                               <<01310>>01134000
   LOGICAL                                                     <<01310>>01136000
      DUMMY := 0, << REQUIRED BY FCONTROL.             >>      <<01310>>01138000
      CONTINUE;   << LOOPING FLAG.                     >>      <<01310>>01140000
                                                               <<01310>>01142000
   LOGICAL ARRAY                                               <<01310>>01144000
      WORK(0:127);<< WORKING STORAGE FOR COPYING.      >>      <<01310>>01146000
                                                               <<01310>>01148000
   BYTE ARRAY                                                  <<01310>>01150000
      DIR(*) = DIR';                                           <<01310>>01152000
                                                               <<01310>>01154000
   SUBROUTINE PRINTX( LENGTH );  << PRINTS "BUFF" >>           <<01310>>01156000
      VALUE LENGTH;   INTEGER LENGTH;                          <<01310>>01158000
   BEGIN                                                       <<01310>>01160000
      FWRITE( LISTFN, BUFF', -LENGTH, 0 );                     <<01310>>01162000
   END;                                                        <<01310>>01164000
<< CAN A FILE BE CREATED WITH A LARGE ENOUGH DIRECTORY?   >>   <<01310>>01166000
   IF (HLABELS'WRITTEN + HLABELS'IN'NEXT'BLOCK + HNEXTNUMLBLS) <<01310>>01168000
      > 255   THEN                                             <<01310>>01170000
   BEGIN                                                       <<01310>>01172000
                                                               <<01310>>01174000
   << 255 IS THE MAXIMUM NUMBER OF USER LABELS.  THERE IS >>   <<01310>>01176000
   << NO ROOM FOR A LARGE ENOUGH DIRECTORY.               >>   <<01310>>01178000
      MOVE BUFF := "** OVERFLOWS DIRECTORY.  REC=", 2;         <<01310>>01180000
      TOS := ASCII( RECNO+1, 10, BPS0 );                       <<01310>>01182000
      TOS := TOS + TOS; << ADD LENGTH OF ASCII TO STRING. >>   <<01310>>01184000
      PRINTX( TOS - @BUFF );                                   <<01310>>01186000
      CCLRETN;                                                 <<01310>>01188000
                                                               <<01310>>01190000
   END  << NOT ENOUGH USER LABELS.  >>                         <<01310>>01192000
   ELSE                                                        <<01310>>01194000
   BEGIN                                                       <<01310>>01196000
                                                               <<01310>>01198000
   << A LARGER DIRECTORY CAN BE CREATED.  MAKE A NEW FILE.>>   <<01310>>01200000
      OLD := FILENUM;                                          <<01310>>01202000
      HNUMOFULABELS := HNUMOFULABELS + HNEXTNUMLBLS;           <<01310>>01204000
      MOVE BUFF := "HELPCAT ";                                 <<01310>>01206000
      NEW := FOPEN( BUFF, 4, 5, HRECSIZE,,, HNUMOFULABELS,     <<01310>>01208000
                    HBLKFACTOR,, CATSIZE, 32 );                <<01310>>01210000
      IF <> THEN                                               <<01310>>01212000
      BEGIN                                                    <<01310>>01214000
                                                               <<01310>>01216000
      << AN ERROR OCCURRED WHILE ATTEMPTING TO OPEN FILE. >>   <<01310>>01218000
         MOVE BUFF := "** UNABLE TO OPEN LARGER FILE.", 2;     <<01310>>01220000
         PRINTX( TOS - @BUFF );                                <<01310>>01222000
         CCLRETN;                                              <<01310>>01224000
                                                               <<01310>>01226000
      END;                                                     <<01310>>01228000
                                                               <<01310>>01230000
   << COPY THE OLD DIRECTORY INTO THE NEW, LARGER ONE.    >>   <<01310>>01232000
      FOR I := 0 UNTIL HLABELS'WRITTEN - 1  DO                 <<01310>>01234000
      BEGIN                                                    <<01310>>01236000
                                                               <<01310>>01238000
      << READ A LABEL FROM OLD DIRECTORY.  CHECK FOR ERROR>>   <<01310>>01240000
         FREADLABEL( OLD, WORK, 128, I );                      <<01310>>01242000
         IF <> THEN                                            <<01310>>01244000
         BEGIN                                                 <<01310>>01246000
            MOVE BUFF := "UNABLE TO READ DIRECTORY", 2;        <<01310>>01248000
            PRINTX( TOS - @BUFF );                             <<01310>>01250000
            CCLRETN;                                           <<01310>>01252000
         END                                                   <<01310>>01254000
         ELSE  << FREADLABEL WAS OKAY.                    >>   <<01310>>01256000
         BEGIN                                                 <<01310>>01258000
                                                               <<01310>>01260000
         << WRITE THE LABEL TO THE NEW FILE.  ERROR CHECK.>>   <<01310>>01262000
            FWRITELABEL( NEW, WORK, 128, I );                  <<01310>>01264000
            IF > THEN                                          <<01310>>01266000
            BEGIN                                              <<01310>>01268000
               MOVE BUFF := "ENLARGED DIRECTORY TOO SMALL.", 2;<<01310>>01270000
               PRINTX( TOS - @BUFF );                          <<01310>>01272000
               CCLRETN;                                        <<01310>>01274000
            END                                                <<01310>>01276000
            ELSE IF < THEN  << FWRITELABEL ERROR.         >>   <<01310>>01278000
            BEGIN                                              <<01310>>01280000
               MOVE BUFF := "COPYING ERROR (DIRECTORY).", 2;   <<01310>>01282000
               PRINTX( TOS - @BUFF );                          <<01310>>01284000
               CCLRETN;                                        <<01310>>01286000
            END;                                               <<01310>>01288000
                                                               <<01310>>01290000
         END;  << FWRITELABEL CHECKS >>                        <<01310>>01292000
                                                               <<01310>>01294000
      END;  << DIRECTORY COPYING LOOP >>                       <<01310>>01296000
                                                               <<01310>>01298000
   << COPY THE OLD FILE CONTENTS INTO THE NEW FILE.       >>   <<01310>>01300000
      FCONTROL( OLD, 5, DUMMY );  << "REWIND" >>               <<01310>>01302000
      IF <> THEN                                               <<01310>>01304000
      BEGIN                                                    <<01310>>01306000
         MOVE BUFF := "UNABLE TO 'REWIND' OLD FILE.", 2;       <<01310>>01308000
         PRINTX( TOS - @BUFF );                                <<01310>>01310000
         CCLRETN;                                              <<01310>>01312000
      END;                                                     <<01310>>01314000
                                                               <<01310>>01316000
      CONTINUE := TRUE;                                        <<01310>>01318000
      WHILE CONTINUE DO                                        <<01310>>01320000
      BEGIN                                                    <<01310>>01322000
                                                               <<01310>>01324000
      << READ A RECORD FROM THE OLD FILE.  ERROR CHECK.   >>   <<01310>>01326000
         LEN := FREAD( OLD, WORK, HRECSIZE );                  <<01310>>01328000
         IF > THEN CONTINUE:=FALSE  << LAST REC WAS READ. >>   <<01310>>01330000
         ELSE IF < THEN  << FREAD ERROR.                  >>   <<01310>>01332000
         BEGIN                                                 <<01310>>01334000
            MOVE BUFF := "READING ERROR WHILE ENLARGING.", 2;  <<01310>>01336000
            PRINTX( TOS - @BUFF );                             <<01310>>01338000
            CCLRETN;                                           <<01310>>01340000
         END                                                   <<01310>>01342000
                                                               <<01310>>01344000
         ELSE   << FREAD WAS OKAY.                        >>   <<01310>>01346000
         BEGIN                                                 <<01310>>01348000
                                                               <<01310>>01350000
         << WRITE RECORD TO NEW FILE.  CHECK FOR ERRORS.  >>   <<01310>>01352000
            FWRITE( NEW, WORK, LEN, 0 );                       <<01310>>01354000
            IF > THEN   << NEW FILE TOO SMALL.            >>   <<01310>>01356000
            BEGIN                                              <<01310>>01358000
               MOVE BUFF := "ENLARGED FILE TOO SMALL.", 2;     <<01310>>01360000
               PRINTX( TOS - @BUFF );                          <<01310>>01362000
               CCLRETN;                                        <<01310>>01364000
            END                                                <<01310>>01366000
            ELSE IF < THEN  << FWRITE ERROR.              >>   <<01310>>01368000
            BEGIN                                              <<01310>>01370000
               MOVE BUFF := "COPYING ERROR (FILE).", 2;        <<01310>>01372000
               PRINTX( TOS - @BUFF );                          <<01310>>01374000
               CCLRETN;                                        <<01310>>01376000
            END;                                               <<01310>>01378000
                                                               <<01310>>01380000
         END;  << FWRITE CHECKS.  >>                           <<01310>>01382000
                                                               <<01310>>01384000
      END;  << FILE COPYING LOOP.  >>                          <<01310>>01386000
                                                               <<01310>>01388000
   << FILL OUT THE NEXT DIRECTORY BLOCK.                  >>   <<01310>>01390000
      FOR I := DIRX UNTIL HWORDS'IN'NEXT'BLOCK*2 - 2           <<01310>>01392000
          DO  DIR( I ) := 0;                                   <<01310>>01394000
                                                               <<01310>>01396000
   << WRITE THE CONTENTS OF "DIR" AND RESET COUNTERS.     >>   <<01310>>01398000
      FOR I := 0 UNTIL HLABELS'IN'NEXT'BLOCK - 1  DO           <<01310>>01400000
      BEGIN                                                    <<01310>>01402000
                                                               <<01310>>01404000
         FWRITELABEL( NEW, DIR'( I*128 ), 128,                 <<01310>>01406000
                      HLABELS'WRITTEN + I       );             <<01310>>01408000
         IF <> THEN                                            <<01310>>01410000
         BEGIN                                                 <<01310>>01412000
            ERR( CATFNX );                                     <<01310>>01414000
            CCLRETN;                                           <<01310>>01416000
         END;                                                  <<01310>>01418000
                                                               <<01310>>01420000
      END;                                                     <<01310>>01422000
                                                               <<01310>>01424000
      DIRX := 0;                                               <<01310>>01426000
      HLABELS'WRITTEN := HLABELS'WRITTEN                       <<01310>>01428000
                         + HLABELS'IN'NEXT'BLOCK;              <<01310>>01430000
      HWORDS'WRITTEN := HWORDS'WRITTEN                         <<01310>>01432000
                         + HWORDS'IN'NEXT'BLOCK;               <<01310>>01434000
      HLABELS'IN'NEXT'BLOCK := HNEXTNUMLBLS;                   <<01310>>01436000
      HWORDS'IN'NEXT'BLOCK := HNEXTNUMWORDS;                   <<01310>>01438000
      FOR I := 0 UNTIL HMAXDIRSIZEM1                           <<01310>>01440000
          DO DIR'(I) := 0;                                     <<01310>>01442000
                                                               <<01310>>01444000
   << REPLACE OLD FILE WITH NEW.  DELETE OLD FILE.        >>   <<01310>>01446000
      FILENUM := NEW;                                          <<01310>>01448000
      FCLOSE( OLD, 4, 0 );                                     <<01310>>01450000
                                                               <<01310>>01452000
   END;  << ELSE CLAUSE:  CAN MAKE BIGGER DIRECTORY.      >>   <<01310>>01454000
                                                               <<01310>>01456000
   CONDCODE := CCE;                                            <<01310>>01458000
   OUTL:   << JUMP OFF POINT FOR "CCLRETN".               >>   <<01310>>01460000
                                                               <<01310>>01462000
END;   << ENLARGEHDIR >>                                       <<01310>>01464000
$TITLE "OPENIN"                                                         01466000
PROCEDURE OPENIN;                                                       01468000
BEGIN                                                                   01470000
                                                                        01472000
BYTE ARRAY BUFF(0:7);                                                   01474000
                                                                        01476000
CONDCODE := CCE;                                                        01478000
   MOVE BUFF := "INPUT ";                                               01480000
INFN := FOPEN(BUFF,5,5); <<OLDPERM,ASCII;WRITE>>                        01482000
IF <> THEN                                                              01484000
BEGIN                                                                   01486000
   ERR(INFNX);                                                          01488000
   CCLRETN;                                                             01490000
END;                                                                    01492000
FGETINFO(INFN,,,,,,,,,,CATSIZE);                                        01494000
IF <> THEN                                                              01496000
BEGIN                                                                   01498000
   ERR(INFNX);                                                          01500000
   CCLRETN;                                                             01502000
END;                                                                    01504000
OUTL:                                                                   01506000
END; << OPENIN >>                                                       01508000
$TITLE "SCANCAT"                                                        01510000
PROCEDURE SCANCAT(DIRECTORY);                                           01512000
   INTEGER ARRAY DIRECTORY;                                             01514000
COMMENT:                                                                01516000
   SCANS MESSAGE CATALOG TO DETERMINE VALIDITY & MAKE DIRECTORY.        01518000
   FIRST COLUMN SPECIALTIES ARE "$" AND NUMBERIC. "$SET X" INDICATES    01520000
   THE START OF A NEW SET "X". "$" ANYTHING ELSE IS A COMMENT.          01522000
   "&" OR "%" INDICATES MESSAGE IS CONTINUED ON THE FOLLOWING LINE.     01524000
   COMMENTS CAN NOT BE IMBEDDED WITHIN CONTINUED MESSAGES. THE          01526000
   DIRECTORY CONTAINS THE RECORD OFFSET FOR EACH MESSAGE SET & TH       01528000
   STARTING MESSAGE NUMBER.                                             01530000
CONDITION CODE                                                          01532000
   CCE = EVERYTHING OK                                                  01534000
   CCL = PROBLEM OF SOME TYPE                                           01536000
;                                                                       01538000
BEGIN                                                                   01540000
                                                                        01542000
INTEGER                                                                 01544000
   MSGNO'OLD,                                                           01546000
   MSGNO,                                                               01548000
   MAXSETNO,                                                            01550000
   SETNO,                                                               01552000
   I,                                                          <<00210>>01554000
   RECNO,                                                               01556000
   LEN,                                                                 01558000
   PLEN;                                                                01560000
                                                                        01562000
LOGICAL                                                                 01564000
   STUFFDIR,                                                            01566000
   LINED,                                                      <<00210>>01568000
   CONTINUE;                                                            01570000
                                                                        01572000
BYTE POINTER                                                            01574000
   PTR;                                                                 01576000
                                                                        01578000
                                                                        01580000
                                                                        01582000
   ARRAY BUFF'(0:66);                                                   01584000
   BYTE ARRAY BUFF(*)=BUFF';                                            01586000
   ARRAY BUFF'OLD'(0:RECSIZE);                                          01588000
   BYTE ARRAY BUFF'OLD(*)=BUFF'OLD';                                    01590000
                                                                        01592000
                                                                        01594000
SUBROUTINE PRINTWARN( LEN );                                   <<01321>>01596000
   VALUE LEN;  INTEGER LEN;                                    <<01321>>01598000
BEGIN                                                          <<01321>>01600000
                                                               <<01321>>01602000
<< DOES NOT SET CONDITION CODE--JUST PRINTS WARNING. >>        <<01321>>01604000
   FWRITE( LISTFN, BUFF', -LEN, 0 );                           <<01321>>01606000
                                                               <<01321>>01608000
END;  << PRINTWARN >>                                          <<01321>>01610000
                                                               <<01321>>01612000
                                                                        01614000
SUBROUTINE PRINTX(LENGTH);                                              01616000
   VALUE LENGTH; INTEGER LENGTH;                                        01618000
BEGIN                                                                   01620000
   FWRITE(LISTFN,BUFF',-LENGTH,0);                                      01622000
   CONDCODE := CCL; << FOUND AN ERROR >>                                01624000
END; << PRINTX >>                                                       01626000
                                                                        01628000
SUBROUTINE PRINTXSET(LEN);                                              01630000
   VALUE LEN;                                                           01632000
   INTEGER LEN;                                                         01634000
COMMENT ADDS " .SET=<SETNO>" TO MSG                                     01636000
;                                                                       01638000
BEGIN                                                                   01640000
   MOVE BUFF(LEN) := " .SET= ",2;                                       01642000
   TOS := ASCII(SETNO,10,BPS0);                                         01644000
   TOS := TOS +TOS; <<ADD ASCII TO END ADDR >>                          01646000
   PRINTX(TOS-@BUFF);                                                   01648000
END; << PRINTXSET >>                                                    01650000
                                                                        01652000
SUBROUTINE WRITECATALOG;                                                01654000
BEGIN                                                                   01656000
   FWRITE(CATFN,BUFF',-LEN,0);                                          01658000
   IF <> THEN                                                           01660000
   BEGIN                                                                01662000
      ERR(CATFNX);                                                      01664000
      CCLRETN;                                                          01666000
   END;                                                                 01668000
END; << WRITECATALOG >>                                                 01670000
                                                                        01672000
SUBROUTINE STUFFDIR';                                                   01674000
BEGIN                                                                   01676000
   IF STUFFDIR THEN                                                     01678000
   BEGIN                                                                01680000
      IF DIRECTORY(SETNO*2) <> 0 THEN << DUPLICATE SET >>               01682000
      BEGIN << WARN, BUT TAKE LAST OCCURRENCE >>                        01684000
         MOVE BUFF := ("** WARNING. DUPLICATE SET NO. ",                01686000
            "IN RECORD "),2;                                            01688000
         TOS := ASCII(RECNO+1,10,BPS0);                                 01690000
         TOS := TOS+TOS; << ADD ASCII TO END ADR >>                     01692000
         MOVE * := ". LAST ONE USED",2;                                 01694000
         PRINTXSET(TOS-@BUFF);                                          01696000
         CONDCODE := CCE; << RESET TO OK (PRINTX SETS) >>               01698000
      END;                                                              01700000
      DIRECTORY(SETNO*2) := RECNO; << STARTING MSG ADDR>>               01702000
      DIRECTORY(X:=X+1) := MSGNO; << STARTING MSG NO. >>                01704000
      STUFFDIR := FALSE;                                                01706000
   END;                                                                 01708000
END; << STUFFDIR >>                                                     01710000
                                                                        01712000
LOGICAL SUBROUTINE CHKCONTINUE;                                         01714000
BEGIN                                                                   01716000
   LINED:=TRUE;                                                <<00210>>01718000
   FOR I:=LEN-8 UNTIL LEN-1                                    <<00210>>01720000
      DO IF BUFF(I)<>NUMERIC THEN LINED:=FALSE;                <<00210>>01722000
   X:=LEN - (IF LINED THEN 8 ELSE 0);                          <<00210>>01724000
   DO X:=X-1 UNTIL X<0 OR BUFF(X)<>" ";<<FIND LAST NON-BLANK>> <<00135>>01726000
   IF X>=0 AND (BUFF(X)="&" OR BUFF(X)="%")                    <<00135>>01728000
      THEN CHKCONTINUE:=TRUE;                                  <<00135>>01730000
END; << CHKCONTINUE >>                                                  01732000
                                                                        01734000
SUBROUTINE FINISHUP;                                                    01736000
BEGIN                                                                   01738000
   IF MAXSETNO=0 THEN << NO SET FOR MSGS >>                             01740000
   BEGIN                                                                01742000
      PRINTX(LEN);                                                      01744000
      MOVE BUFF := "**MISSING MESSAGE SET NO.",2;                       01746000
      PRINTX(TOS-@BUFF);                                                01748000
      CCLRETN;                                                          01750000
   END;                                                                 01752000
   STUFFDIR';   << IN CASE THE LAST SET HAD NO MESSAGES. >>    <<01297>>01754000
   DIRECTORY(MAXSETNOCELL) := MAXSETNO;                                 01756000
   DIRECTORY(MAXRECELL) := RECNO-1;                                     01758000
   GO OUTL;<< EVERYTHING DONE >>                                        01760000
END; << FINISHUP >>                                                     01762000
                                                                        01764000
SUBROUTINE LOOKFORSET;                                                  01766000
BEGIN                                                                   01768000
                                                                        01770000
PLEN := FINDPARM(BUFF(1),PTR);                                          01772000
IF PLEN = 3 AND PTR = "SET" THEN                                        01774000
BEGIN                                                                   01776000
   PLEN := NEXTPARM(PTR(PLEN),PTR);                                     01778000
   MOVE PTR := PTR WHILE N,1;                                           01780000
   PLEN := TOS -@PTR;                                                   01782000
   SETNO := BINARY(PTR,PLEN);                                           01784000
   IF <> THEN << NOT NUMERIC >>                                         01786000
   BEGIN                                                                01788000
      PRINTX(LEN);                                                      01790000
      MOVE BUFF := "     ^";                                            01792000
      PRINTX(7);                                                        01794000
      MOVE BUFF := "**EXPECTED NUMERIC",2;                              01796000
      PRINTX(TOS-@BUFF);                                                01798000
   END                                                                  01800000
   ELSE                                                                 01802000
   BEGIN                                                                01804000
      IF SETNO =0 OR SETNO > MAXNOSETS THEN                             01806000
      BEGIN                                                             01808000
         PRINTX(LEN);                                                   01810000
         MOVE BUFF :="**INVALID SET NO. MAXIMUM=",2;                    01812000
         TOS := ASCII(MAXSETNO,10,S0);                                  01814000
         PRINTX((TOS+TOS)-@BUFF);                                       01816000
         SETNO := 0; << MAKE INVALID >>                                 01818000
      END                                                               01820000
      ELSE                                                              01822000
      BEGIN                                                             01824000
                                                                        01826000
      << NOW HAVE VALID SET NO. >>                                      01828000
         IF SETNO > MAXSETNO THEN MAXSETNO := SETNO;                    01830000
         STUFFDIR := TRUE; << FILL DIR WHEN MSG FOUND>>                 01832000
         MSGNO := -1; << FOUND NEW SET. RESET >>                        01834000
      END;                                                              01836000
   END;                                                                 01838000
END                                                                     01840000
ELSE CONTINUE := FALSE;                                                 01842000
<< FOUND COMMENT. NOT ALLOWED IN CONTINUED MSGS >>                      01844000
                                                                        01846000
END; << LOOKFORSET >>                                                   01848000
                                                                        01850000
SUBROUTINE LOOKFORMSGNO;                                                01852000
BEGIN                                                                   01854000
                                                                        01856000
MSGNO'OLD :=MSGNO;                                                      01858000
MOVE BUFF := BUFF WHILE N,1;                                            01860000
MSGNO := BINARY(BUFF,S0-@BUFF); DEL;                                    01862000
IF <> THEN                                                              01864000
BEGIN                                                                   01866000
   PRINTX(LEN);                                                         01868000
   BUFF := "^";                                                         01870000
   PRINTX(1);                                                           01872000
   MOVE BUFF := "**EXPECTED NUMERIC",2;                                 01874000
   PRINTXSET(TOS-@BUFF);                                                01876000
END                                                                     01878000
ELSE                                                                    01880000
BEGIN                                                                   01882000
   IF CONTINUE THEN   << NUMBER IN COL 1 OF CONTINUE LINE.>>   <<01321>>01884000
   BEGIN                                                                01886000
      CONTINUE := CHKCONTINUE;                                 <<01321>>01888000
      MSGNO := MSGNO'OLD;                                      <<01321>>01890000
      PRINTWARN( LEN );                                        <<01321>>01892000
      MOVE BUFF := "^  TREATED AS CONTINUATION LINE.", 2;      <<01321>>01894000
      PRINTWARN( TOS - @BUFF );                                <<01321>>01896000
      RETURN;                                                  <<01321>>01898000
   END;                                                                 01900000
   IF MSGNO <= MSGNO'OLD THEN                                           01902000
   BEGIN                                                                01904000
      PRINTX(LEN);                                                      01906000
      MOVE BUFF := ("**MESSAGE NO. NOT ASCENDING",                      01908000
         " LAST NO.="),2;                                               01910000
      TOS := ASCII(MSGNO'OLD,10,BPS0);                                  01912000
      ASSEMBLE(ADD);                                                    01914000
      PRINTXSET(TOS-@BUFF);                                             01916000
   END;                                                                 01918000
                                                                        01920000
      << FOUND VALID MSG NO. >>                                         01922000
                                                                        01924000
   STUFFDIR'; << PLACE FIRST MSG INFO IN DIR. >>                        01926000
   << NOW CHECK FOR CONTINUE >>                                         01928000
   CONTINUE := CHKCONTINUE;                                             01930000
END;                                                                    01932000
                                                                        01934000
END; << LOOKFORMSGNO >>                                                 01936000
                                                                        01938000
SUBROUTINE LOOKFORCONTINUE;                                             01940000
BEGIN                                                                   01942000
      IF NOT CONTINUE THEN                                              01944000
      BEGIN << WAS LOOKING FOR START OF MSG >>                          01946000
         PRINTX(LEN);                                                   01948000
         BUFF := "^";                                                   01950000
         PRINTX(1);                                                     01952000
         MOVE BUFF := "**EXPECTED MESSAGE NO.",2;                       01954000
         PRINTXSET(TOS-@BUFF);                                          01956000
      END                                                               01958000
      ELSE CONTINUE := CHKCONTINUE;                                     01960000
END; << LOOKFORCONTINUE >>                                              01962000
                                                                        01964000
                                                                        01966000
<< MAIN BODY >>                                                         01968000
                                                                        01970000
<< OPEN LIST FILE >>                                                    01972000
MOVE BUFF := "LIST ";                                                   01974000
LISTFN := FOPEN(BUFF,%14,1,-132);                                       01976000
IF <> THEN                                                              01978000
BEGIN                                                                   01980000
   ERR(LISTFNX);                                                        01982000
   CCLRETN;                                                             01984000
END;                                                                    01986000
                                                                        01988000
<< SET UP >>                                                            01990000
CONTINUE := STUFFDIR := FALSE;                                          01992000
CONDCODE := CCE;                                                        01994000
MSGNO := MSGNO'OLD := -1;                                               01996000
DIRECTORY := RECNO := MAXSETNO := SETNO := 0;                           01998000
MOVE DIRECTORY(1) := DIRECTORY,(MSGDIRSIZE-1);                          02000000
                                                                        02002000
LOOP:                                                                   02004000
   LEN := FREAD(INFN,BUFF',-RECSIZEB);                                  02006000
   IF < THEN                                                            02008000
   BEGIN                                                                02010000
      ERR(INFNX);                                                       02012000
      CCLRETN;                                                          02014000
   END;                                                                 02016000
   IF > THEN FINISHUP; << FINISH & GET OUT >>                           02018000
   MOVE BUFF'OLD' := BUFF',(RECSIZE);                                   02020000
   WRITECATALOG;                                                        02022000
                                                                        02024000
   << LOOK FOR $ >>                                                     02026000
   IF BUFF = "$" THEN LOOKFORSET                                        02028000
   ELSE                                                                 02030000
                                                                        02032000
   << NO $. LOOK FOR MSGNO >>                                           02034000
   IF BUFF = NUMERIC THEN LOOKFORMSGNO                                  02036000
   ELSE LOOKFORCONTINUE;                                                02038000
   << NOT $, NOT START OF MSG. MUST BE CONTINUE >>                      02040000
                                                                        02042000
   << EVERYTHING DONE >>                                                02044000
   RECNO := RECNO+1;                                                    02046000
   GO LOOP;                                                             02048000
                                                                        02050000
OUTL:                                                                   02052000
END; << SCANCAT >>                                                      02054000
$TITLE "SCANHELPCAT"                                                    02056000
PROCEDURE SCANHELPCAT;                                                  02058000
COMMENT                                                                 02060000
   BUILDS DIRECTORY & PLACES IN USERLABELS. CURRENTLY USES 1            02062000
   PHYSICAL BLOCK (40 WORDS IN RECORD X 16 RECORDS PER BLOCK)           02064000
   1ST WORD OF DIRECTORY IS DIRECTORY SIZE IN WORDS.                    02066000
   DIRECTORY IS "SEARCH" FORMAT WITH 2 BYTES FOR RECORD NO.             02068000
   FORMAT :                                                             02070000
      9,5,"FILE",LRECNO,RRECNO,                                         02072000
                                                                        02074000
CONDITION CODE                                                          02076000
   CCE = EVERYTHING OK                                                  02078000
   CCL = PROBLEM OF SOME TYPE                                           02080000
;                                                                       02082000
BEGIN                                                                   02084000
                                                                        02086000
EQUATE                                                                  02088000
   MAXKEYS       = 16,                                                  02090000
   MAXKEYSM1     = MAXKEYS -1;                                          02092000
                                                                        02094000
INTEGER                                                                 02096000
   MSGNO'OLD,                                                           02098000
   MSGNO,                                                               02100000
   MAXSETNO,                                                            02102000
   SETNO,                                                               02104000
   RECNO,                                                               02106000
   LEN,                                                                 02108000
   KEYRECNO,                                                            02110000
   HELPSETNO,                                                           02112000
   KEYBUFFLEN,                                                          02114000
   NUMPARMS,                                                            02116000
   ENTRYTYPE,                                                           02118000
   DUMMY,                                                               02120000
   DIRX,                                                                02122000
   INDEX = DUMMY,                                                       02124000
   ENTRYX;                                                              02126000
                                                                        02128000
LOGICAL                                                                 02130000
   HELPSET,                                                             02132000
   STUFFKEY,                                                            02134000
   ENDOFSET,                                                            02136000
   SUBSET,                                                              02138000
   SUBSETONLY,                                                 <<04571>>02140000
   STOPHELP,                                                            02142000
   STARTHELP,                                                  <<04571>>02144000
   STOPHELPENDING;                                                      02146000
                                                                        02148000
INTEGER                                                                 02150000
   I,                                                          <<01310>>02152000
   CONTINUE'LINES:=0, << COUNTS "\CONTINUE" ENTRIES. >>        <<01310>>02154000
   PARM1LEN,                                                            02156000
   PARM2LEN;                                                            02158000
                                                                        02160000
DOUBLE                                                         <<01310>>02162000
   TEMPLINENUM,                                                <<04570>>02164000
   LINENUM;                                                    <<01310>>02166000
BYTE POINTER                                                            02168000
   PARM1,                                                               02170000
   PARM2;                                                               02172000
                                                                        02174000
ARRAY KEYBUFF'(0:HRECSIZEM1);                                           02176000
BYTE ARRAY KEYBUFF(*) = KEYBUFF';                                       02178000
INTEGER ARRAY DIR'(0:HMAXDIRSIZEM1);                           <<01310>>02180000
BYTE ARRAY DIR(*) = DIR';                                               02182000
                                                                        02184000
   ARRAY BUFF'(0:66);                                                   02186000
   BYTE ARRAY BUFF(*)=BUFF';                                            02188000
                                                                        02190000
   LOGICAL ARRAY TBUFF(0:HRECSIZEM1);                          <<01310>>02192000
   BYTE ARRAY TBUFFB(*) = TBUFF;                               <<01310>>02194000
                                                                        02196000
INTRINSIC FREADDIR, DBINARY, DASCII;                           <<01310>>02198000
                                                                        02200000
<<********************************************************>>   <<04570>>02202000
<<                                                        >>   <<04570>>02204000
<<               P R I N T X             subroutine       >>   <<04570>>02206000
<<                                                        >>   <<04570>>02208000
<<********************************************************>>   <<04570>>02210000
SUBROUTINE PRINTX(LENGTH);                                              02212000
   VALUE LENGTH; INTEGER LENGTH;                                        02214000
BEGIN                                                                   02216000
   FWRITE(LISTFN,BUFF',-LENGTH,0);                                      02218000
   CONDCODE := CCL; << FOUND AN ERROR >>                                02220000
END; << PRINTX >>                                                       02222000
                                                                        02224000
SUBROUTINE WRITECATALOG;                                                02226000
                                                               <<04570>>02228000
<<  This subroutine writes out the input record read from >>   <<04570>>02230000
<<  the input file out to the new help catalog at the same>>   <<04570>>02232000
<<  record.  For records following a \SUBSET command and  >>   <<04570>>02234000
<<  a \STOPHELP output is not done (the records are not   >>   <<04570>>02236000
<<  written to the output file) until a \STARTHELP command>>   <<04570>>02238000
<<  is read in.                                           >>   <<04570>>02240000
                                                               <<04570>>02242000
BEGIN                                                                   02244000
   IF SUBSETONLY LOR                                           <<04571>>02246000
      (SUBSET LAND STOPHELPENDING) LOR                         <<04571>>02248000
      (SUBSET LAND STARTHELP)  THEN                            <<04571>>02250000
      BEGIN                                                    <<04571>>02252000
      SUBSETONLY := FALSE;                                     <<04571>>02254000
      STARTHELP := FALSE;                                      <<04571>>02256000
      END                                                      <<04571>>02258000
   ELSE                                                                 02260000
   BEGIN                                                                02262000
      FWRITEDIR(CATFN,BUFF',-LEN,DOUBLE(RECNO));                        02264000
      IF <> THEN                                                        02266000
      BEGIN                                                             02268000
         ERR(CATFNX);                                                   02270000
         CCLRETN;                                                       02272000
      END;                                                              02274000
      RECNO := RECNO + 1;  <<OUTPUT RECORD NUMBER>>            <<04571>>02276000
   END;                                                                 02278000
END; << WRITECATALOG >>                                                 02280000
                                                                        02282000
<<********************************************************>>   <<04570>>02284000
<<                                                        >>   <<04570>>02286000
<<          S T U F F H E L P D I R     subroutine        >>   <<04570>>02288000
<<                                                        >>   <<04570>>02290000
<<********************************************************>>   <<04570>>02292000
SUBROUTINE STUFFHELPDIR;                                                02294000
BEGIN                                                                   02296000
IF DIRX + PARM2LEN + 4 >= HWORDS'IN'NEXT'BLOCK*2 THEN          <<01310>>02298000
BEGIN << DIRECTORY TOO LARGE >>                                         02300000
    ENLARGEHDIR( CATFN, RECNO, DIR', DIRX );                   <<01310>>02302000
    IF CONDCODE = CCL THEN QUIT( HENLARGERROR );               <<01310>>02304000
END;                                                           <<01310>>02306000
                                                               <<01310>>02308000
                                                               <<01310>>02310000
DIR(DIRX)                   := PARM2LEN + 4;                   <<01310>>02312000
DIR(DIRX:=DIRX+1)           := PARM2LEN;                       <<01310>>02314000
MOVE DIR(DIRX:=DIRX+1)      := PARM2,(PARM2LEN);               <<01310>>02316000
DIR(DIRX:=DIRX+PARM2LEN)    := RECNO.(0:8);                    <<01310>>02318000
DIR(DIRX:=DIRX+1)           := RECNO.(8:8);                    <<01310>>02320000
DIRX := DIRX + 1;                                              <<01310>>02322000
                                                               <<01310>>02324000
                                                               <<01310>>02326000
                                                                        02328000
END; << STUFFHELPDIR >>                                                 02330000
                                                                        02332000
                                                                        02334000
<<********************************************************>>   <<04570>>02336000
<<                                                        >>   <<04570>>02338000
<<               D O S T U F F K E Y     subroutine       >>   <<04570>>02340000
<<                                                        >>   <<04570>>02342000
<<********************************************************>>   <<04570>>02344000
SUBROUTINE DOSTUFFKEY;                                                  02346000
BEGIN << REWRITES ENTRY WITH KEY WORDS>>                                02348000
                                                                        02350000
STUFFKEY := FALSE;                                                      02352000
                                                               <<01310>>02354000
FWRITEDIR(CATFN,KEYBUFF',HRECSIZE,DOUBLE(                               02356000
   KEYRECNO + CONTINUE'LINES ) );                              <<01310>>02358000
IF <> THEN                                                              02360000
BEGIN                                                                   02362000
   ERR(CATFNX);                                                         02364000
   CCLRETN;                                                             02366000
END;                                                                    02368000
                                                                        02370000
END; << SUBROUTINE DOSTUFFKEY >>                                        02372000
                                                                        02374000
                                                                        02376000
<<********************************************************>>   <<04570>>02378000
<<                                                        >>   <<04570>>02380000
<<               F I N I S H U P         subroutine       >>   <<04570>>02382000
<<                                                        >>   <<04570>>02384000
<<********************************************************>>   <<04570>>02386000
SUBROUTINE FINISHUP;                                                    02388000
BEGIN                                                                   02390000
   IF ENDOFSET THEN << HELPSET ENDED WITH "\ALL">>                      02392000
   BEGIN                                                                02394000
      IF STUFFKEY THEN DOSTUFFKEY;<<PUT KEYS FROM LAST ENTRY>>          02396000
      DIR(DIRX) := 0; << STOPPER >>                                     02398000
      HWORDS'WRITTEN := HWORDS'WRITTEN + ( DIRX&LSR(1) );      <<01310>>02400000
      INDEX := 0;                                                       02402000
      DO BEGIN                                                          02404000
         FWRITELABEL( CATFN, DIR'(INDEX*128), 128,             <<01310>>02406000
                      INDEX + HLABELS'WRITTEN         );       <<01310>>02408000
         IF <> THEN                                                     02410000
         BEGIN                                                          02412000
            ERR(CATFNX);                                                02414000
            CCLRETN;                                                    02416000
         END;                                                           02418000
         INDEX := INDEX +1;                                             02420000
         DIRX := DIRX - 256;                                   <<01310>>02422000
      END UNTIL <= ;                                                    02424000
      FREADLABEL( CATFN, DIR', 128, 0 );                       <<01310>>02426000
      DIR := HWORDS'WRITTEN.(0:8);                             <<01310>>02428000
      DIR(1) := HWORDS'WRITTEN.(8:8);                          <<01310>>02430000
      FWRITELABEL( CATFN, DIR', 128, 0 );                      <<01310>>02432000
   END                                                                  02434000
   ELSE                                                                 02436000
   BEGIN                                                                02438000
      MOVE BUFF := ("**MISSING '\ALL' AT END OF",                       02440000
         "HELPSET"),2;                                                  02442000
      PRINTX(TOS -@BUFF);                                               02444000
   END;                                                                 02446000
   GO OUTL; << EVERYTHING DONE >>                                       02448000
END; << FINISHUP >>                                                     02450000
                                                                        02452000
<<********************************************************>>   <<04570>>02454000
<<                                                        >>   <<04570>>02456000
<<               L O O K F O R H E L P   subroutine       >>   <<04570>>02458000
<<                                                        >>   <<04570>>02460000
<<********************************************************>>   <<04570>>02462000
SUBROUTINE LOOKFORHELP;                                                 02464000
BEGIN                                                                   02466000
                                                                        02468000
ENDOFSET := FALSE; << WANT LAST RECORD TO BE "\ALL">>                   02470000
   BUFF(HRECSIZEB) :=  STOPPER;<< STOPPER >>                            02472000
   PARM1LEN := FINDPARM(BUFF(1),PARM1);                                 02474000
   PARM2LEN := NEXTPARM(PARM1(PARM1LEN),PARM2);                         02476000
   CASE BUZZFETCH(PARM1) OF                                             02478000
   BEGIN                                                                02480000
                                                                        02482000
<<0:GALLEY CMD>>  ;                                                     02484000
<<1:ALL - END OF HELPSET >>                                             02486000
      BEGIN                                                             02488000
         ENDOFSET := TRUE;                                              02490000
      END;                                                              02492000
<<2: SET   >>                                                           02494000
      ; << NOT USED >>                                                  02496000
<<3: ENTRY>>                                                   <<04571>>02498000
      BEGIN                                                             02500000
         IF STUFFKEY THEN <<PUT KEYS FROM LAST ENTRY IN CAT>>           02502000
            DOSTUFFKEY;                                                 02504000
         STUFFHELPDIR;                                                  02506000
         KEYRECNO := RECNO; << KEY LIST ADR >>                          02508000
         KEYBUFF' := "  ";                                              02510000
         MOVE KEYBUFF'(1) := KEYBUFF',(HRECSIZEM1);                     02512000
         MOVE KEYBUFF(HBUFFSIZEB) := BUFF(HBUFFSIZEB),(8);              02514000
            << LINE NOS >>                                              02516000
         KEYBUFF := "\";                                                02518000
         MOVE KEYBUFF(1) := PARM1,(PARM1LEN);                           02520000
         KEYBUFF(PARM1LEN +1) := "=";                                   02522000
         MOVE KEYBUFF(PARM1LEN +2) := PARM2,(PARM2LEN);                 02524000
         KEYBUFFLEN := PARM1LEN + PARM2LEN +2;                          02526000
         CONTINUE'LINES := 0;                                  <<01310>>02528000
      END;                                                              02530000
<<4: ITEM >>      GO SUBITEM;                                           02532000
<<5:SUBITEM>>                                                           02534000
      BEGIN                                                             02536000
SUBITEM:                                                                02538000
      STUFFKEY := TRUE;                                        <<01310>>02540000
  << item keywords are moved to buffer KEYBUFF until the >>    <<04570>>02542000
  << total length of KEYBUFF plus the next keyword is 72 >>    <<04570>>02544000
  << or greater.  When it reaches greater than 72 the    >>    <<04570>>02546000
  << space is made for continuation lines by moving the  >>    <<04570>>02548000
  << records in the output catalog down and inserting    >>    <<04570>>02550000
  << the keyword buffer KEYBUFF.                         >>    <<04570>>02552000
  <<                                                     >>    <<04570>>02554000
      IF HBUFFSIZEB <= KEYBUFFLEN + PARM2LEN + 1 THEN          <<01310>>02556000
         BEGIN                                                          02558000
                                                               <<01310>>02560000
      << MAKE ROOM FOR THE CONTINUATION LINE IF POSSIBLE.  >>  <<01310>>02562000
      << NOTE:  CURRENT RECORD HAS NOT YET BEEN WRITTEN.   >>  <<01310>>02564000
         FOR I := RECNO-1 STEP -1                              <<01310>>02566000
                  UNTIL KEYRECNO + CONTINUE'LINES + 1  DO      <<01310>>02568000
         BEGIN                                                 <<01310>>02570000
            FREADDIR( CATFN, TBUFF, HRECSIZE, DOUBLE(I) );     <<01310>>02572000
    <<  read output file record I  >>                          <<04570>>02574000
            IF <> THEN                                         <<01310>>02576000
            BEGIN                                              <<01310>>02578000
               MOVE BUFF := "CONTINUATION FREADDIR ERROR.", 2; <<01310>>02580000
               PRINTX( TOS - @BUFF );                          <<01310>>02582000
               GO OUTL;                                        <<01310>>02584000
            END;                                               <<01310>>02586000
    << write output file record I to output rec. I+1 >>        <<04570>>02588000
            FWRITEDIR( CATFN, TBUFF, HRECSIZE, DOUBLE(I+1) );  <<01310>>02590000
            IF <> THEN                                         <<01310>>02592000
            BEGIN                                              <<01310>>02594000
               MOVE BUFF := "CONTINUATION FWRITEDIR ERROR.", 2;<<01310>>02596000
               PRINTX( TOS - @BUFF );                          <<01310>>02598000
               GO OUTL;                                        <<01310>>02600000
            END;                                               <<01310>>02602000
         END;                                                  <<01310>>02604000
         RECNO := RECNO + 1;                                   <<01310>>02606000
                                                               <<01310>>02608000
      << UPDATE COUNTERS AND CREATE NEW LINE.              >>  <<01310>>02610000
         KEYBUFF( KEYBUFFLEN ) := ",";                         <<01310>>02612000
         KEYBUFFLEN := KEYBUFFLEN + 1;                         <<01310>>02614000
         DOSTUFFKEY;                                           <<01310>>02616000
                                                               <<01310>>02618000
      << HANDLE THE LINE NUMBERS.                          >>  <<01310>>02620000
         FREADDIR( CATFN, TBUFF, HRECSIZE,                     <<01310>>02622000
                   DOUBLE( KEYRECNO + CONTINUE'LINES )     );  <<01310>>02624000
  << check for valid line numbers in columns 73 to 80 >>       <<04570>>02626000
      TEMPLINENUM := DBINARY(TBUFFB(72),8);                    <<04570>>02628000
      IF <> THEN                                               <<04570>>02630000
         BEGIN                                                 <<04570>>02632000
         MOVE BUFF :=                                          <<04570>>02634000
"INVALID LINE NUMBER IN INPUT TEXT, COLUMNS 73 TO 80",2;       <<04570>>02636000
         PRINTX(TOS-@BUFF);                                    <<04570>>02638000
         GO OUTL;                                              <<04570>>02640000
         END;                                                  <<04570>>02642000
      LINENUM := TEMPLINENUM + 1D;  << FOR COMPARISON  >>      <<04570>>02644000
         FREADDIR( CATFN, TBUFF, HRECSIZE,                     <<01310>>02646000
                   DOUBLE( KEYRECNO + CONTINUE'LINES + 1 )  ); <<01310>>02648000
         IF ( DBINARY( TBUFFB(72), 8 ) )   <=   LINENUM THEN   <<01310>>02650000
         BEGIN                                                 <<01310>>02652000
            MOVE BUFF :=                                       <<01310>>02654000
                 "INSUFF. LINE # SPACE FOR CONTINUATION",2 ;   <<01310>>02656000
            PRINTX( TOS - @BUFF );                             <<01310>>02658000
            GO OUTL;                                           <<01310>>02660000
         END;                                                  <<01310>>02662000
                                                               <<01310>>02664000
         KEYBUFF := " ";                                       <<01310>>02666000
         KEYBUFF( 1 ) := " ";                                  <<01310>>02668000
         MOVE KEYBUFF'(1) := KEYBUFF', (HRECSIZEM1);           <<01310>>02670000
         MOVE KEYBUFF := "\CONTINUE ";                         <<01310>>02672000
         KEYBUFFLEN := 9;                                      <<01310>>02674000
         CONTINUE'LINES := CONTINUE'LINES + 1;                 <<01310>>02676000
                                                               <<01310>>02678000
         I := DASCII( LINENUM, 10, TBUFFB );                   <<01310>>02680000
         MOVE KEYBUFF(72) := "00000000";                       <<01310>>02682000
         MOVE KEYBUFF( 80-I ) := TBUFFB, (I);                  <<01310>>02684000
         DOSTUFFKEY;                                           <<01310>>02686000
                                                               <<01310>>02688000
         IF HBUFFSIZEB >= KEYBUFFLEN + PARM2LEN + 1 THEN       <<01310>>02690000
            GO SUBITEM;                                        <<01310>>02692000
         PRINTX( LEN );                                        <<01310>>02694000
         MOVE BUFF := "**KEYWORD LIST WON'T FIT", 2;           <<01310>>02696000
         PRINTX( TOS - @BUFF );                                <<01310>>02698000
         GO OUTL;                                              <<01310>>02700000
      END;                                                     <<01310>>02702000
                                                               <<01310>>02704000
      IF PARM2LEN > 0 THEN                                     <<01310>>02706000
      BEGIN                                                    <<01310>>02708000
         KEYBUFF( KEYBUFFLEN ) := ",";                         <<01310>>02710000
         MOVE KEYBUFF(KEYBUFFLEN+1) := PARM2,(PARM2LEN);       <<01310>>02712000
         KEYBUFFLEN := KEYBUFFLEN + PARM2LEN + 1;              <<01310>>02714000
      END;                                                     <<01310>>02716000
                                                               <<01310>>02718000
   END;                                                        <<01310>>02720000
                                                               <<01310>>02722000
<<6: STARTHELP >>                                                       02724000
      BEGIN                                                    <<04571>>02726000
      STOPHELPENDING := FALSE;                                          02728000
      STARTHELP := TRUE;                                       <<04571>>02730000
      END;                                                     <<04571>>02732000
<<7: STOPHELP >>                                                        02734000
      STOPHELPENDING := TRUE;                                           02736000
<<8: SUBSET >>                                                          02738000
      BEGIN                                                    <<04571>>02740000
      SUBSET := TRUE;                                                   02742000
      SUBSETONLY := FALSE;                                     <<04571>>02744000
      END;                                                     <<04571>>02746000
<<9: CONTINUE >>                                               <<01310>>02748000
      GO LOOP;  << IF A CONTINUATION LINE IS NEEDED, >>        <<01310>>02750000
                << IT WILL BE ADDED ELSEWHERE.       >>        <<01310>>02752000
                                                                        02754000
   END; << CASE >>                                                      02756000
END; << LOOKFORHELP >>                                                  02758000
                                                                        02760000
                                                                        02762000
<< MAIN BODY >>                                                         02764000
                                                                        02766000
<< OPEN LIST FILE >>                                                    02768000
MOVE BUFF := "LIST ";                                                   02770000
LISTFN := FOPEN(BUFF,%14,1,-132);                                       02772000
IF <> THEN                                                              02774000
BEGIN                                                                   02776000
   ERR(LISTFNX);                                                        02778000
   CCLRETN;                                                             02780000
END;                                                                    02782000
                                                                        02784000
<< SET UP >>                                                            02786000
SUBSETONLY := STARTHELP := FALSE;                              <<04571>>02788000
SUBSET := STOPHELP := STOPHELPENDING := STUFFKEY := FALSE;              02790000
CONDCODE := CCE;                                                        02792000
RECNO := MSGNO := MSGNO'OLD := MAXSETNO := SETNO:=0;                    02794000
HELPSETNO := 0;                                                         02796000
DIRX := 2;                                                              02798000
                                                                        02800000
LOOP:                                                                   02802000
   LEN := FREAD(INFN,BUFF',-HRECSIZEB);                                 02804000
   IF < THEN                                                            02806000
   BEGIN                                                                02808000
      ERR(INFNX);                                                       02810000
      CCLRETN;                                                          02812000
   END;                                                                 02814000
   IF > THEN FINISHUP; << FINISH & GET OUT >>                           02816000
                                                                        02818000
   IF BUFF = "\" THEN LOOKFORHELP;                                      02820000
        << regular records with no "\" are just read in >>     <<04570>>02822000
        << and written back out to the new help catalog.>>     <<04570>>02824000
                                                               <<04570>>02826000
   WRITECATALOG;                                                        02828000
                                                                        02832000
   << EVERYTHING DONE >>                                                02834000
   GO LOOP;                                                             02838000
                                                                        02840000
OUTL:                                                                   02842000
END;  << SCANHELPCAT >>                                        <<01310>>02844000
$TITLE "QUIT"                                                           02846000
PROCEDURE QUIT(NUM);                                                    02848000
   VALUE NUM;INTEGER NUM;                                               02850000
BEGIN                                                                   02852000
   SETJCW(GETJCW LOR %100000);  << FATAL ERROR >>              <<04571>>02854000
   TERMINATE;                                                           02856000
END; << QUIT >>                                                         02858000
$TITLE "MAIN BODY"                                                      02860000
$CONTROL SEGMENT=PRIV                                                   02862000
                                                                        02864000
SUBROUTINE DEF'MOVETODSEG;                                              02866000
                                                                        02868000
SUBROUTINE TURNOFFTRAPS;                                       <<00812>>02870000
   BEGIN                                                       <<00812>>02872000
   PUSH(STATUS);                                               <<00812>>02874000
   TOS.(2:1) := 0;                                             <<00812>>02876000
   SET(STATUS);                                                <<00812>>02878000
   END;                                                        <<00812>>02880000
                                                               <<00812>>02882000
<< MAIN BODY OF PROGRAM >>                                              02884000
                                                                        02886000
      <<                                                >>              02888000
      << MAIN ENTRY POINT:                              >>              02890000
      <<    -OPENS ON "DISC".                           >>              02892000
      <<    -CLOSES CATALOG AS TEMPORARY                >>              02894000
      <<    -IF OLDTEMP CATALOG, RENAMES AS CATXXXX     >>              02896000
      <<                                                >>              02898000
      << BUILD ENTRY POINT:                             >>              02900000
      <<    - OPENS ON "1", SYSTEM DISC.                >>              02902000
      <<    - CLOSES CATALOG AS PERMANENT.              >>              02904000
      <<    - IF OLD CATALOG, RENAMES AS CATXXXX        >>              02906000
      <<                                                >>              02908000
      << DIR ENTRY POINT: JUST CALLS INITMSG            >>              02910000
                                                                        02912000
MAIN: INSTALL := FALSE;                                                 02914000
      BUILDMODE:=FALSE;                                                 02916000
                                                                        02918000
BUILD:                                                                  02920000
                                                                        02922000
TURNOFFTRAPS;                                                  <<00812>>02924000
GETUSERMODE;                                                            02926000
IF INSTALL THEN IF NOT CAPABILITYOK THEN QUIT(INSUFFCAPERR);            02928000
OPENIN; << OPEN INPUT FILE >>                                           02930000
IF <> THEN QUIT(OPENINERR);                                             02932000
OPENCAT(INSTALL);                                                       02934000
IF <> THEN QUIT(OPENCATERR);                                            02936000
SCANCAT(DIRECTORY);                                                     02938000
IF = THEN << PERFECT MSG CAT, NOW PUT DIR IN DSEG >>                    02940000
BEGIN                                                                   02942000
   DIRECTORY(CURRENTRECELL) :=DIRECTORY(MAXRECELL)+1;                   02944000
   << SET CURRENT PTR ABOVE LIMIT FOR INITIALIZATION>>                  02946000
                                                                        02948000
   DIRFILLIN(DIRECTORY); << FILL IN HOLES >>                            02950000
   FWRITELABEL(CATFN,DIRECTORY,MSGDIRSIZE);                             02952000
   << PUT DIRECTORY IN CATALOG >>                                       02954000
                                                                        02956000
   IF <> THEN                                                           02958000
   BEGIN                                                                02960000
      ERR(CATFNX);                                                      02962000
      QUIT(WRITELABELERR);                                              02964000
   END;                                                                 02966000
   CLOSECAT(INSTALL);                                                   02968000
   IF <> THEN QUIT(CLOSECATERR);                                        02970000
   GETPRIVMODE;                                                         02972000
   IF INSTALL THEN                                                      02974000
   BEGIN                                                                02976000
DIR:                                                                    02978000
      BUILDMODE:=FALSE;                                                 02980000
      TURNOFFTRAPS;                                            <<00812>>02982000
   GETPRIVMODE;                                                <<14.EB>>02984000
      IF NOT CAPABILITYOK THEN QUIT(INSUFFCAPERR);                      02986000
      INITMSG; << SET UP DATASEG, SYS DB CELLS >>                       02988000
      IF <> THEN QUIT(INITMSGERR);                                      02990000
      MOVE BUFF := "** NEW CATALOG INSTALLED",2;                        02992000
      PRINT(BUFF',-(S0-@BUFF),0);DEL;                                   02994000
   END                                                                  02996000
   ELSE                                                                 02998000
   BEGIN                                                                03000000
      MOVE BUFF := "** VALID MESSAGE CATALOG",2;                        03002000
      PRINT(BUFF',-(S0-@BUFF),0);DEL;                                   03004000
   END;                                                                 03006000
END                                                                     03008000
ELSE                                                                    03010000
BEGIN                                                                   03012000
   GETPRIVMODE;                                                         03014000
   MOVE BUFF := "** MESSAGE CATALOG CONTAINS ERROR",2;                  03016000
   PRINT(BUFF',-(S0-@BUFF),0);DEL;                                      03018000
END;                                                                    03020000
                                                                        03022000
RETURN;                                                                 03024000
                                                                        03026000
HELP:   << MAKEHELP ENTRY POINT >>                                      03028000
                                                                        03030000
TURNOFFTRAPS;                                                  <<00812>>03032000
GETUSERMODE;                                                            03034000
IF NOT MAKEHELP THEN QUIT(MAKEHELPERR);                                 03036000
GETPRIVMODE;                                                            03038000
                                                                        03040000
END. << MAKECAT >>                                                      03042000
