$CONTROL SUBPROGRAM,MAP,CODE                                            00010000
<< INITIAL - UTILITY ROUTINES >>                                        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
BEGIN                                                                   00028000
$CONTROL SEGMENT=INITUTIL                                               00030000
                                                                        00032000
<<----------------------------------------------------------------->>   00034000
<<                 INITIAL    UTILITY PROCEDURES                   >>   00036000
<<    These procedures are used by INITIAL III and ICF version.    >>   00038000
<<----------------------------------------------------------------->>   00040000
                                                               <<SY>>   00042000
                                                               <<SY>>   00044000
     <<******************************************************>><<SY>>   00046000
     <<    GLOBAL ARRAYS AND VARIABLE SHARED WITH INITIAL    >><<SY>>   00048000
     <<******************************************************>><<SY>>   00050000
                                                               <<SY>>   00052000
     DEFINE EXT'DCL =                                          <<SY>>   00054000
                EXTERNAL INTEGER POINTER                       <<SY>>   00056000
                                                               <<SY>>   00058000
                         BUF',                                 <<SY>>   00060000
                         LBUF',                                <<SY>>   00062000
                         FLAB',                                <<SY>>   00064000
                         MHINFO',                              <<SY>>   00066000
                         REASSIGNED',                          <<SY>>   00068000
                                                               <<SY>>   00070000
                         LPDT,                                 <<SY>>   00072000
                         LDT,                                  <<SY>>   00074000
                         VTAB;                                 <<SY>>   00076000
                                                               <<SY>>   00078000
                EXTERNAL LOGICAL LISTPURGE                     <<SY>>   00080000
                                                               <<SY>>   00082000
                << END OF EXTERNAL DECLARATIONS >> #;          <<SY>>   00084000
                                                               <<SY>>   00086000
     <<******************************************************>><<SY>>   00088000
     <<     END EXTERNAL  -   START OF GLOBAL EQUATES        >><<SY>>   00090000
     <<******************************************************>><<SY>>   00092000
                                                               <<SY>>   00094000
   LOGICAL   STATUS       =   Q-1,                             <<SY>>   00096000
             STAT         =   Q-1;                             <<SY>>   00098000
                                                               <<SY>>   00100000
   INTEGER   X            =   X,                               <<SY>>   00102000
             S0           =   S-0,                             <<SY>>   00104000
             S1           =   S-1,                             <<SY>>   00106000
             S2           =   S-2,                             <<SY>>   00108000
             S3           =   S-3,                             <<SY>>   00110000
             S4           =   S-4,                             <<SY>>   00112000
             S5           =   S-5,                             <<SY>>   00114000
             XREG         =   X,                               <<SY>>   00116000
             DELTAQ       =   Q-0;                             <<SY>>   00118000
                                                               <<SY>>   00120000
   DOUBLE    DS0          =   S-1,                             <<SY>>   00122000
             DS1          =   S-1,                             <<SY>>   00124000
             DS3          =   S-3,                             <<SY>>   00126000
             DS5          =   S-5,                             <<SY>>   00128000
             DS6          =   S-6;                             <<SY>>   00130000
                                                               <<SY>>   00132000
   DEFINE    CARRYX       =   STAT.(5:1) #,                    <<SY>>   00134000
             ASMB         =   ASSEMBLE #,                      <<SY>>   00136000
             CC           =   STAT.(6:2) #;                    <<SY>>   00138000
   EQUATE    CCG          =   0,                               <<SY>>   00140000
             CCL          =   1,                               <<SY>>   00142000
             CCE          =   2,                               <<SY>>   00144000
                                                               <<SY>>   00146000
             CSTIX        =    1,  <<CST TABLE>>               <<SY>>   00148000
             DSTIX        =    2,  <<DST TABLE>>               <<SY>>   00150000
             SYSDISC      =    1,  <<LDEV FOR SYSTEM DISC>>    <<SY>>   00152000
             WRITE        =    1,                              <<SY>>   00154000
             READ         =    0,                              <<SY>>   00156000
             DIRDSTN      =   20,                              <<SY>>   00158000
             FILETYPE     =    0;                              <<SY>>   00160000
                                                               <<SY>>   00162000
   POINTER   S0PNTR       =   S-0;                             <<SY>>   00164000
                                                               <<SY>>   00166000
   INTEGER POINTER                                             <<SY>>   00168000
             PS0          =   S-0,                             <<SY>>   00170000
             PS1          =   S-1,                             <<SY>>   00172000
             PS4          =   S-4,                             <<SY>>   00174000
             S0IPNTR      =   S-0,                             <<SY>>   00176000
             DST          =   DSTIX;  << DATA SEGMENT TABLE >> <<SY>>   00178000
                                                               <<SY>>   00180000
   DOUBLE POINTER                                              <<SY>>   00182000
             DPS0         =   S-0,                             <<SY>>   00184000
             DPS2         =   S-2;                             <<SY>>   00186000
                                                               <<SY>>   00188000
   DEFINE NREASS          =   REASSIGNED'(0) #;                <<SY>>   00190000
   DEFINE FLMISCX         =   28 #,                            <<SY>>   00192000
          FLCHECKSUMX     =   34 #,                            <<SY>>   00194000
          FLCLIDX         =   35 #,                            <<SY>>   00196000
          FLCHECKSUM      =   FLAB'(34) #,                     <<SY>>   00198000
          CHECKSUM        =                                    <<SY>>   00200000
                X := 127;                                      <<SY>>   00202000
                TOS := -1;                                     <<SY>>   00204000
                DO BEGIN                                       <<SY>>   00206000
                   IF X <> FLCHECKSUMX AND                     <<SY>>   00208000
                      X <> FLMISCX AND X <> FLCLIDX            <<SY>>   00210000
                      THEN TOS:=TOS XOR LOGICAL(FLAB'(X));     <<SY>>   00212000
                   X := X - 1;                                 <<SS>>   00214000
                   END UNTIL < #;                              <<SY>>   00216000
                                                               <<SY>>   00218000
  EQUATE    NMHSUBTYPES   =  14,                               <<SY>>   00220000
            MHDISCTYPE    =  0,                                <<SY>>   00222000
            NFHSUBTYPES   =  3,                                <<SY>>   00224000
            NFHSUBTYPESP1 =  NFHSUBTYPES+1,                    <<SY>>   00226000
            NMHSUBTYPESP1 =  NMHSUBTYPES+1,                    <<SY>>   00228000
            MHSECTRK      =  3,   << SECTORS/TRACK >>          <<SY>>   00230000
            MHINFOSIZE    =  7,                                <<SY>>   00232000
                                                               <<SY>>   00234000
            DISC0         =  0,   << MOVING HEAD DISC >>       <<SY>>   00236000
            DISC1         =  1,   << FIXED  HEAD DISC >>       <<SY>>   00238000
                                                                        00240000
         << ERROR MESSAGE NUMBERS >>                           <<SY>>   00242000
            M275          =  275,                              <<SY>>   00244000
            M276          =  276,                              <<SY>>   00246000
            M328          =  328;                              <<SY>>   00248000
$PAGE "DIRECTORY DATA STRUCTURE "                              <<SY>>   00250000
                                                               <<SY>>   00252000
           <<------------------------>>                        <<SY>>   00254000
           << DIRECTORY DATA SEGMENT >>                        <<SY>>   00256000
           <<------------------------>>                        <<SY>>   00258000
                                                               <<DE>>   00260000
EQUATE  << Directory block sizes >>                            <<DE>>   00262000
                                                               <<DE>>   00264000
   SYSSAIBSIZE  =  3,      << SYSACCOUNT INDEX BLOCK SIZE>>    <<DE>>   00266000
   SYSAUIBSIZE  =  1,      << ACCOUNT/USER  INDEX BLOCK  >>    <<DE>>   00268000
   SYSAGIBSIZE  =  1,      << ACCOUNT/GROUP INDEX BLOCK  >>    <<DE>>   00270000
   SYSGFIBSIZE  =  2,      << GROUP/FILES   INDEX BLOCK  >>    <<DE>>   00272000
   SYSGVSIBSIZE =  1,      << GROUP/VSD     INDEX BLOCK  >>    <<DE>>   00274000
   SYSAEBSIZE   =  3,      << ACCOUNT ENTRY BLOCK SIZE   >>    <<DE>>   00276000
   SYSUEBSIZE   =  2,      << USER    ENTRY BLOCK SIZE   >>    <<DE>>   00278000
   SYSGEBSIZE   =  2,      << GROUP   ENTRY BLOCK SIZE   >>    <<DE>>   00280000
   SYSFEBSIZE   =  2,      << FILES   ENTRY BLOCK SIZE   >>    <<DE>>   00282000
   SYSVSEBSIZE  =  1,      << VSD     ETNRY BLOCK SIZE   >>    <<DE>>   00284000
   DDSBSIZE     =  3,      << MAXIMUM BLOCK SECTOR SIZE  >>    <<DE>>   00286000
   DDSBWSIZE    = %600;    << MAXIMUM BLOCK WORD  SIZE   >>    <<DE>>   00288000
                                                                        00290000
EQUATE                                                                  00292000
   NAMESIZE        = 4,                  <<UNPACKED REPRESENTATION>>    00294000
                   <<ENTRY EQUATES>>                                    00296000
<< ACCOUNT ENTRY >>                                                     00298000
   ANAME           = 0,                  <<NAME>>                       00300000
   AGIPNTR         = ANAME+NAMESIZE,     <<GROUP INDEX PNTR>>           00302000
   AUIPNTR         = AGIPNTR+1,          <<USER INDEX PNTR>>            00304000
   ACAP            = AUIPNTR+1,          <<CAPABILITY>>                 00306000
   ALATTR          = ACAP+2,                                            00308000
   APASS           = ALATTR+2,                                          00310000
   ADFSCOUNT       = APASS+NAMESIZE,     <<DISC FILE SPACE>>            00312000
   ADFSCOUNTD      = ADFSCOUNT /2,                                      00314000
   ADFSLIMIT       = ADFSCOUNT+2,                                       00316000
   ACPUCOUNT       = ADFSLIMIT+2,        <<CPU TIME>>                   00318000
   ACPULIMIT       = ACPUCOUNT+2,                                       00320000
   ACONTIMECOUNT   = ACPULIMIT+2,        <<CONNECT TIME>>               00322000
   ACONTIMELIMIT   = ACONTIMECOUNT+2,                                   00324000
   ASECW           = ACONTIMELIMIT+2,                                   00326000
   AMAXJOBW        = ASECW+1,            <<MAX. JOB PRIORITY (BYTE) >>  00328000
   ASPARE1         = AMAXJOBW+1,                               <<04733>>00330000
   ASPARE2         = ASPARE1+1,                                <<04733>>00332000
   ASIZE           = ASPARE2+1,                                <<04733>>00334000
<<GROUP ENTRY>>                                                         00336000
   GNAME           = 0,                  <<NAME>>                       00338000
   GFIPNTR         = GNAME+NAMESIZE,     <<FILE INDEX (OR VOLUME) PNTR>>00340000
   GPASS           = GFIPNTR+1,          <<PASSWORD>>                   00342000
   GDFSCOUNT       = GPASS+NAMESIZE,     <<DISC FILE SPACE>>            00344000
   GDFSLIMIT       = GDFSCOUNT+2,                                       00346000
   GCPUCOUNT       = GDFSLIMIT+2,        <<CPU TIME>>                   00348000
   GCPULIMIT       = GCPUCOUNT+2,                                       00350000
   GCONTIMECOUNT   = GCPULIMIT+2,                                       00352000
   GCONTIMELIMIT   = GCONTIMECOUNT+2,                                   00354000
   GSEC            = GCONTIMELIMIT+2,                                   00356000
   GCAP            = GSEC+2,                                            00358000
   GLINKAGE        = GCAP+1,                                   <<04733>>00360000
   GVSDIPNTR       = GLINKAGE+1,         <<VS DEF INDEX PNTR>> <<04733>>00362000
   GHVSNAME        = GVSDIPNTR+1,        <<HOME VS NAME>>      <<04733>>00364000
   GHVSANAME       = GHVSNAME,           << "   "  ACCT NAME>> <<04733>>00366000
   GHVSGNAME       = GHVSANAME+NAMESIZE, << "   "  GRP  NAME>> <<04733>>00368000
   GHVSVSNAME      = GHVSGNAME+NAMESIZE, << "   "  VS   NAME>> <<04733>>00370000
   GSAVEFIPNTR     = GHVSVSNAME+NAMESIZE,<<SAVES GFIPNTR>>     <<04733>>00372000
   GMOUNTREFCNTR   = GSAVEFIPNTR+1,      <<MOUNT REF COUNTER>> <<04733>>00374000
   GSPARE          = GMOUNTREFCNTR+1,                          <<04733>>00376000
   GSIZE           = GSPARE+1;                                 <<04733>>00378000
<<GLINKAGE DEFINITIONS>>                                       <<04733>>00380000
DEFINE                                                         <<04733>>00382000
   PVF             = 0:1 #,                                    <<04733>>00384000
   MVTABXF         = 8:8 #;                                    <<04733>>00386000
EQUATE                                                         <<04733>>00388000
   PV              = 1,                                        <<04733>>00390000
   VMAX            = 8,                  <<VS MEMBERSHIP MAX>> <<04733>>00392000
<<FILE ENTRY >>                                                         00394000
   FNAME           = 0,                  <<NAME>>                       00396000
   FVOLPNTRW       = FNAME+NAMESIZE,     <<VOLUME TABLE POINTER>>       00398000
   FLABELPNTRW     = FVOLPNTRW,          <<FILE LABEL POINTER>>         00400000
   FSIZE           = FLABELPNTRW+2,                                     00402000
<<USER ENTRY>>                                                          00404000
   UNAME           = 0,                  <<NAME>>                       00406000
   UCAP            = UNAME+NAMESIZE,     <<CAPABILITY>>                 00408000
   ULATTR          = UCAP+2,                                            00410000
   UPASS           = ULATTR+2,                                          00412000
   UHGROUP         = UPASS+NAMESIZE,     <<HOME GROUP>>                 00414000
   ULOGCOUNT       = UHGROUP+NAMESIZE,   <<# OF USERS LOGGED ON UNDER>> 00416000
   UMAXJOB         = ULOGCOUNT+1,                                       00418000
   USPARE          = UMAXJOB+1,                                         00420000
   USIZE           = USPARE+1,                                          00422000
<<VOLUME SET DEFINITION ENTRY>>                                <<04733>>00424000
   GVSNAME         = 0,                  <<VOLUME SET NAME>>   <<04733>>00426000
   GVSLINKAGEW     = GVSNAME+NAMESIZE,   <<MVTAB LINKAGE>>     <<04733>>00428000
   GVSINFO         = GVSLINKAGEW+1,      <<DEFINITION INFO>>   <<04733>>00430000
   GVSMEMBERS      = GVSINFO+1,          <<VMAX MEMBERS>>      <<04733>>00432000
                                         <<MEMBER INFO>>       <<04733>>00434000
                                         <<VMAX MEMBERS>>      <<04733>>00436000
   GVSVOLNAME      = GVSMEMBERS,         <<MEMBER NAME>>       <<04733>>00438000
   GVSDREFCNT      = (GVSINFO-GVSNAME+1)*(VMAX+1),             <<04733>>00440000
   GVSDSPARE2      = GVSDREFCNT+1,                             <<04733>>00442000
   GVSDSIZE        = GVSDSPARE2+1,                             <<04733>>00444000
                                                               <<04733>>00446000
<<VOLUME CLASS DEFINITION ENTRY>>                              <<04733>>00448000
   GVCNAME        = 0,                   <<VOLUME CLASS NAME>> <<04733>>00450000
   GVCLINKAGEW     = GVCNAME+NAMESIZE,                         <<04733>>00452000
   GVCINFO         = GVCLINKAGEW+1,      <<DEFINITION INFO>>   <<04733>>00454000
   GVCPNAME        = GVCINFO+1,          <<PARENT DEF  NAME>>  <<04733>>00456000
   GVCPANAME       = GVCPNAME,           <<  "    ACCT   " >>  <<04733>>00458000
   GVCPGNAME       = GVCPANAME+NAMESIZE, <<  "    GRP    " >>  <<04733>>00460000
   IE1STNAME       = 0,                  <<1ST NAME OF ENTRY BLOCK>>    00462000
   IEPNTR          = IE1STNAME+NAMESIZE, <<PNTR TO IT >>                00464000
   IECOUNT         = IEPNTR+1,           <<# OF ENTRIES IN IT>>         00466000
   ISIZE           = IECOUNT+1;                                         00468000
EQUATE                                                                  00470000
   PREMISCWD       = 0;                                                 00472000
DEFINE                                                                  00474000
   TYPEF           = 0:1 #;                                             00476000
EQUATE                                                                  00478000
   INDEXTYPE       = 1,                                                 00480000
   ENTRYTYPE       = 0;                                                 00482000
DEFINE                                                                  00484000
   LEVELF          = 2:3 #;                                    <<04733>>00486000
EQUATE                                                                  00488000
   FILELEVEL       = 0,                                                 00490000
   GROUPLEVEL      = 1,                                                 00492000
   ACCOUNTLEVEL    = 2,                                                 00494000
   USERLEVEL       = 3,                                        <<04733>>00496000
   VSDEFLEVEL      = 4;                                        <<04733>>00498000
DEFINE                                                                  00500000
   XSIZEF          = 5:7 #,                                    <<04733>>00502000
   BSIZEF          = 12:4 #;                                   <<04733>>00504000
EQUATE                                                                  00506000
   PREXCOUNT       = PREMISCWD+1,        <<ELEMENT COUNT>>              00508000
   PREPCOUNT       = PREXCOUNT+1,        <<POINTER REF. COUNT>>         00510000
   PREETOTAL       = PREPCOUNT+1,        <<TOTAL ENTRIES COUNT >>       00512000
   PREEMISCWD      = PREETOTAL+1,                                       00514000
   PREPINDEXP      = PREEMISCWD+1,       <<INDEX PNTR IN WHICH FATHER>> 00516000
   PREPNAME        = PREPINDEXP+1,       <<FATHER'S NAME (IF ANY)>>     00518000
   PRESIZE         = PREPNAME+NAMESIZE;                                 00520000
EQUATE                                                                  00522000
   XX              = 22,                                                00524000
   ZZ              = 139;                                      <<04733>>00526000
EQUATE                                                                  00528000
   DDSDST          = 20;                                                00530000
ARRAY                                                                   00532000
   DDS(*)          = DB+0,                                              00534000
   DDSENTRY(*)     = DDS,                                               00536000
   DDSNAME(*)      = DDS,                                               00538000
   WORKAREA (*)    = DDS(128);                                          00540000
INTEGER           << VARIABLES SET BY DIRSTARTOFF >>                    00542000
   ADJUST         = WORKAREA,            <<DL-DB>>                      00544000
   XTYPE          = ADJUST +1;           <<INPUT PARM>>        <<04733>>00546000
DOUBLE                                                         <<04733>>00548000
   XLINKAGE'INDEXP= XTYPE+1;                                   <<04733>>00550000
INTEGER                                                        <<04733>>00552000
   XMVTABX        = XLINKAGE'INDEXP,                           <<04733>>00554000
   XINDEXP        = XMVTABX+1,           <<FINAL INDEX PNTR>>  <<04733>>00556000
   XANAME         = XINDEXP +1,          <<DB-REL ADDRS>>               00558000
   XGUNAME        = XANAME +1,                                          00560000
   XFNAME         = XGUNAME +1,                                         00562000
   XASEC          = XFNAME +1;           <<ACCT SECURITY>>              00564000
DOUBLE                                                                  00566000
   XGSEC          = XASEC +1;            <<GROUP SECURITY>>             00568000
LOGICAL                                                                 00570000
   SIRRETURN      = XGSEC +2;            <<FROM GETSIR>>                00572000
EQUATE                                   <<DISPS INTO PREPRE>>          00574000
   DIRBASE'        = 0,                  <<DIRBASE OF CONTENT>><<04733>>00576000
   DIRBASE1'       = DIRBASE',                                 <<04733>>00578000
   DIRBASE2'       = DIRBASE1'+1,                              <<04733>>00580000
   CONTENTS        = DIRBASE2'+1,        <<DIRECTORY P. PNTR>> <<04733>>00582000
   LPNTR           = CONTENTS+1,         <<DB ADDR OF 1ST ELEMENT>>     00584000
   IOPNTR          = LPNTR+1,            <<BLOCK STARTING ADDR>>        00586000
   NUMVALID        = IOPNTR+1,           <<# VALID DIR PP AFTER IOPNTR>>00588000
   DIRTY           = NUMVALID+1,                                        00590000
   XSIZE           = DIRTY+1,                                           00592000
   USED            = XSIZE+1,            <<=XSIZE * XCOUNT>>            00594000
   BSIZE           = USED+1,             <<BLOCK SIZE (PP.)>>           00596000
   BWSIZE          = BSIZE+1,            <<= BSIZE & LSR(7)>>           00598000
   BFACTOR         = BWSIZE+1,           <<= BWSIZE/XSIZE>>             00600000
   MISCWD          = BFACTOR+1,                                         00602000
   XCOUNT          = MISCWD+1,                                          00604000
   PCOUNT          = XCOUNT+1,                                          00606000
   ETOTAL          = PCOUNT+1,                                          00608000
   EMISCWD         = ETOTAL+1,                                          00610000
   PINDEXP         = EMISCWD+1,                                         00612000
   PNAME           = PINDEXP+1;                                         00614000
ARRAY                                                                   00616000
   DAPREPRE(*)     = DDS(ZZ);                                           00618000
LOGICAL                                                                 00620000
   DACONTENTS      = DAPREPRE+CONTENTS;                                 00622000
LOGICAL POINTER                                                         00624000
   DALPNTR         = DAPREPRE+LPNTR,                                    00626000
   DAIOPNTR        = DAPREPRE+IOPNTR;                                   00628000
INTEGER                                                                 00630000
   DANUMVALID      = DAPREPRE+NUMVALID;                                 00632000
LOGICAL                                                                 00634000
   DADIRTY         = DAPREPRE+DIRTY;                                    00636000
INTEGER                                                                 00638000
   DAXSIZE         = DAPREPRE+XSIZE,                                    00640000
   DAUSED          = DAPREPRE+USED,                                     00642000
   DABSIZE         = DAPREPRE+BSIZE,                                    00644000
   DABWSIZE        = DAPREPRE+BWSIZE,                                   00646000
   DABFACTOR       = DAPREPRE+BFACTOR,                                  00648000
   DAMISCWD        = DAPREPRE+MISCWD;                                   00650000
INTEGER                                                                 00652000
   DAXCOUNT        = DAPREPRE+XCOUNT;                          <<04733>>00654000
ARRAY                                                                   00656000
   DAPNAME (*)     = DAPREPRE(PNAME);                                   00658000
ARRAY                                                                   00660000
   DBPREPRE (*)    = DAPREPRE(XX);                                      00662000
LOGICAL                                                                 00664000
   DBCONTENTS      = DBPREPRE+CONTENTS;                                 00666000
LOGICAL POINTER                                                         00668000
   DBLPNTR         = DBPREPRE+LPNTR,                                    00670000
   DBIOPNTR        = DBPREPRE+IOPNTR;                                   00672000
INTEGER                                                                 00674000
   DBNUMVALID      = DBPREPRE+NUMVALID;                                 00676000
LOGICAL                                                                 00678000
   DBDIRTY         = DBPREPRE+DIRTY;                                    00680000
INTEGER                                                                 00682000
   DBXSIZE         = DBPREPRE+XSIZE,                                    00684000
   DBUSED          = DBPREPRE+USED,                                     00686000
   DBBSIZE         = DBPREPRE+BSIZE,                                    00688000
   DBBWSIZE        = DBPREPRE+BWSIZE,                                   00690000
   DBBFACTOR       = DBPREPRE+BFACTOR,                                  00692000
   DBMISCWD        = DBPREPRE+MISCWD;                                   00694000
INTEGER                                                                 00696000
   DBXCOUNT        = DBPREPRE+XCOUNT,                                   00698000
   DBPCOUNT        = DBPREPRE+PCOUNT;                                   00700000
LOGICAL                                                                 00702000
   DBETOTAL        = DBPREPRE+ETOTAL,                                   00704000
   DBEMISCWD       = DBPREPRE+EMISCWD;                                  00706000
DEFINE                                                                  00708000
   DBELEVEL        = INTEGER (DBEMISCWD.(LEVELF)) #,                    00710000
   DBEXSIZE        = INTEGER (DBEMISCWD.(XSIZEF)) #,                    00712000
   DBEBSIZE        = INTEGER (DBEMISCWD.(BSIZEF)) #;                    00714000
LOGICAL                                                                 00716000
   DBPINDEXP       = DBPREPRE+PINDEXP;                                  00718000
ARRAY                                                                   00720000
   DBPNAME (*)     = DBPREPRE(PNAME);                                   00722000
INTEGER                                                        <<04733>>00724000
   SYSACCTINDEX    = DBPREPRE + XX; <<INDEX TO SYSACCTINDEX>>  <<DE>>   00726000
DOUBLE                                                                  00728000
   DIRBASE         = SYSACCTINDEX+1;                           <<DE>>   00730000
                                                               <<DE>>   00732000
INTEGER                                                        <<DE>>   00734000
   SYSACCTINX'SAV  = DIRBASE+2,                                <<DE>>   00736000
   DDS'CNT         = SYSACCTINX'SAV+1;                         <<DE>>   00738000
                                                               <<DE>>   00740000
DOUBLE                                                         <<DE>>   00742000
   DDS'CNT1        = DDS'CNT+1,                                <<DE>>   00744000
   DDS'CNT2        = DDS'CNT1+2,                               <<DE>>   00746000
   DDS'CNT3        = DDS'CNT2+2,                               <<DE>>   00748000
   DDS'CNT4        = DDS'CNT3+2,                               <<DE>>   00750000
   DDS'CNT5        = DDS'CNT4+2;                               <<DE>>   00752000
                                                               <<DE>>   00754000
REAL                                                           <<DE>>   00756000
   GOODPERCENT     = DDS'CNT5+2;                               <<DE>>   00758000
                                                               <<DE>>   00760000
LOGICAL POINTER                                                         00762000
   BASE            = GOODPERCENT+2;                                     00764000
INTEGER POINTER                                                         00766000
   IBASE           = BASE;                                              00768000
DEFINE                                                                  00770000
   WHICHDIRTY = BASE(DIRTY) #;                                          00772000
                                                               <<DE>>   00774000
                                                               <<DE>>   00776000
         << DIRECTORY SPACE DATA SEGMENT >>                    <<DE>>   00778000
EQUATE                                                         <<DE>>   00780000
   DSVMBASE        = 2,                                        <<DE>>   00782000
   DIRSPACEDST     = 21,                                       <<DE>>   00784000
   DIRSPHDR        = 10,         << 10 word DSD header info >> <<DE>>   00786000
   DIRSPBUFF       = 384,          << size of bitmap buffer >> <<DE>>   00788000
   DSBUFF1         = 1,           << First sector in buffer >> <<DE>>   00790000
   DSBUFF2         = 2;            << 2 sectors in 2nd part >> <<DE>>   00792000
<< 1  =>  AVAILABLE,                                                    00794000
   0  =>  ALLOCATED.  >>                                                00796000
DOUBLE                                                         <<04733>>00798000
   DSBASE          = DB+0;                                     <<04733>>00800000
INTEGER                                                        <<04733>>00802000
   DSBASE1         = DSBASE,                                   <<04733>>00804000
   DSBASE2         = DSBASE1+1;                                <<04733>>00806000
DEFINE                                                         <<DE>>   00808000
   DSLDEV          = DSBASE1.(0:8) #,                          <<DE>>   00810000
   DSBASEA1        = DSBASE1.(8:8) #;                          <<DE>>   00812000
LOGICAL                                                        <<DE>>   00814000
   DSFLAGS         = DSBASE2+1;           <<bitmap dst flags>> <<DE>>   00816000
DEFINE        << Bits used in DSFLAGS >>                       <<DE>>   00818000
   DIRSP'DIRTY     = DSFLAGS.(0:1) #,   << DSDS was modified>> <<DE>>   00820000
   DIRSP'CYCLE     = DSFLAGS.(1:1) #,   << Search for holes >> <<DE>>   00822000
   DIRSP'NEXT2     = DSFLAGS.(2:1) #,   << Read next 2 sect >> <<DE>>   00824000
   DIRSP'LASTIN    = DSFLAGS.(3:1) #,   << Last sectors in  >> <<DE>>   00826000
   DIRSP'PREV2     = DSFLAGS.(4:1) #,   << Read prev 2 sect >> <<DE>>   00828000
   DIRSP'FIRSTIN   = DSFLAGS.(5:1) #,   << First sectors in >> <<DE>>   00830000
   DIRSP'UNUSED    = DSFLAGS.(6:10)#;   << NOT USED >>         <<DE>>   00832000
                                                               <<DE>>   00834000
LOGICAL                                                        <<DE>>   00836000
   DSUNUSED        = DSFLAGS+1,                                <<DE>>   00838000
   DSADDR1         = DSUNUSED+1,  << Disc address of sector >> <<DE>>   00840000
   DSADDR2         = DSADDR1+1,   << in bitmap buffer no. 2 >> <<DE>>   00842000
   DSBUFFLEN       = DSADDR2+1;   << Length of buff 2nd part>> <<DE>>   00844000
INTEGER                                                        <<DE>>   00846000
   CUR'SEGMENT     = DSBUFFLEN+1;  << Sector # of bitmap seg>> <<DE>>   00848000
LOGICAL                                                        <<DE>>   00850000
   BUF'LASTWORD    = CUR'SEGMENT+1;   << Ptr to last in buff>> <<DE>>   00852000
POINTER                                                        <<DE>>   00854000
   BUF'FIRSTAVAIL  = BUF'LASTWORD+1;  << Ptr to 1st in buff >> <<DE>>   00856000
                                                               <<DE>>   00858000
ARRAY                                                          <<DE>>   00860000
   DIRSPIOBASE (*) = DB+DIRSPHDR,                              <<DE>>   00862000
   DIRSPIOBASE2(*) = DIRSPIOBASE+128;                          <<DE>>   00864000
                                                               <<DE>>   00866000
LOGICAL                                                        <<DE>>   00868000
   DIR'LASTWORD    = DIRSPIOBASE;    << Last word of BITMAP >> <<DE>>   00870000
POINTER                                                        <<DE>>   00872000
   DIR'FIRSTAVAIL  = DIR'LASTWORD+1;  << 1st word of BITMAP >> <<DE>>   00874000
                                                               <<DE>>   00876000
LOGICAL                                                        <<DE>>   00878000
   START'BITMAP    = DIR'FIRSTAVAIL+1;                         <<DE>>   00880000
                                                               <<DE>>   00882000
ARRAY                                                          <<DE>>   00884000
   BITMAP (*)      = START'BITMAP;                             <<DE>>   00886000
                                                               <<DE>>   00888000
                                                               <<DE>>   00890000
<< FLAGS TO DIRECTORY ROUTINES >>                                       00892000
EQUATE                                                                  00894000
   A               = 0,                  <<BLOCK A>>                    00896000
   B               = 1,                                                 00898000
   E               = 0,                  <<EXACT SEARCH>>               00900000
   EN              = 2,                  <<EXACT OR NEXT SEARCH>>       00902000
   EP              = 4,                  <<EXACT OR PRECEEDING SEARCH>> 00904000
   EA              = E+A,                                               00906000
   ENA             = EN+A,                                              00908000
   ENB             = EN+B,                                              00910000
   EPB             = EP+B;                                              00912000
DEFINE                                                                  00914000
   STARTLEVELF     = 13:3 #,                                            00916000
   ENDLEVELF       = 10:3 #,                                   <<04733>>00918000
   ALLFLAG         = 9:1#,                                     <<04733>>00920000
   ENDLEVELFX      = 9:4 #,                                    <<04733>>00922000
   TOLEVELF        = 6:3  #,                                   <<04733>>00924000
   HITFLAG         = 5:1  #;                                   <<04733>>00926000
EQUATE                                                                  00928000
   ALLXXX          = %(2)1000,                                 <<04733>>00930000
   ALLACCTS        = ALLXXX + ACCOUNTLEVEL;                    <<04733>>00932000
$PAGE " EXTERNAL PROCEDURES "                                           00934000
                                                                        00936000
  PROCEDURE DIRDISC (FUNC, ADDR, BUF, WORDS);                           00938000
    VALUE   FUNC, ADDR, WORDS;                                          00940000
    INTEGER FUNC, WORDS;                                                00942000
    DOUBLE  ADDR;                                                       00944000
    ARRAY   BUF;                                                        00946000
    OPTION  EXTERNAL;                                                   00948000
                                                                        00950000
  PROCEDURE DIRERROR (REGISTERS, FNAME);                                00952000
    VALUE   REGISTERS;                                                  00954000
    DOUBLE  REGISTERS;                                                  00956000
    BYTE ARRAY FNAME;                                                   00958000
    OPTION  EXTERNAL;                                                   00960000
                                                                        00962000
  PROCEDURE DISC (WRITE, LDEV, RECORD, BUF, WORDS);                     00964000
    VALUE   WRITE, LDEV, RECORD, WORDS;                                 00966000
    INTEGER WRITE, LDEV, WORDS;                                         00968000
    DOUBLE  RECORD;                                                     00970000
    ARRAY   BUF;                                                        00972000
    OPTION  EXTERNAL;                                                   00974000
                                                                        00976000
  PROCEDURE ERRMESSAGE (MSGNR, NUM1, NUM2, NUM3, NUM4,                  00978000
                     STRING1, STRING2);                                 00980000
    VALUE   MSGNR, NUM1, NUM2, NUM3, NUM4;                              00982000
    INTEGER MSGNR;                                                      00984000
    LOGICAL NUM1, NUM2, NUM3, NUM4;                                     00986000
    BYTE ARRAY STRING1, STRING2;                                        00988000
    OPTION  EXTERNAL, VARIABLE;                                         00990000
                                                                        00992000
  PROCEDURE EXCHANGEDB (DSTN);                                          00994000
    VALUE   DSTN;                                                       00996000
    INTEGER DSTN;                                                       00998000
    OPTION  EXTERNAL;                                                   01000000
                                                                        01002000
  LOGICAL PROCEDURE GETEXTLEN ( EXTENT );                               01004000
    VALUE   EXTENT;                                                     01006000
    INTEGER EXTENT;                                                     01008000
    OPTION EXTERNAL;                                                    01010000
                                                                        01012000
  PROCEDURE HELP;                                                       01014000
    OPTION  EXTERNAL;                                                   01016000
                                                                        01018000
  PROCEDURE MESSAGE (MSGNR, NUM1, NUM2, NUM3, NUM4,                     01020000
                     STRING1, STRING2);                                 01022000
    VALUE   MSGNR, NUM1, NUM2, NUM3, NUM4;                              01024000
    INTEGER MSGNR;                                                      01026000
    LOGICAL NUM1, NUM2, NUM3, NUM4;                                     01028000
    BYTE ARRAY STRING1, STRING2;                                        01030000
    OPTION  EXTERNAL, VARIABLE;                                         01032000
                                                                        01034000
  PROCEDURE PRINTFNAME ( NAME );                                        01036000
    ARRAY   NAME;                                                       01038000
    OPTION  EXTERNAL;                                                   01040000
                                                                        01042000
  PROCEDURE PRINTFNR (NAME, REASON);                                    01044000
    VALUE   REASON;                                                     01046000
    BYTE ARRAY NAME;                                                    01048000
    INTEGER REASON;                                                     01050000
    OPTION  EXTERNAL;                                                   01052000
                                                                        01054000
  PROCEDURE REMDISCSPACE ( LDEV, NSECT, DADDR );                        01056000
    VALUE   LDEV, NSECT, DADDR;                                         01058000
    INTEGER LDEV;                                                       01060000
    DOUBLE  NSECT, DADDR;                                               01062000
    OPTION  EXTERNAL;                                                   01064000
                                                                        01066000
  PROCEDURE RETDISCSPACE ( LDEV, NSECT, DADDR );                        01068000
    VALUE   LDEV, NSECT, DADDR;                                         01070000
    INTEGER LDEV;                                                       01072000
    DOUBLE  NSECT, DADDR;                                               01074000
    OPTION  EXTERNAL;                                                   01076000
                                                                        01078000
  LOGICAL   PROCEDURE GET'AREA (AREA'LIST,ENTRY',MAXENT,LDEV,           01080000
                                DISC'ADDR,LENGTH);                      01082000
    VALUE   ENTRY', MAXENT;                                             01084000
    INTEGER ARRAY AREA'LIST;                                            01086000
    INTEGER ENTRY', MAXENT, LDEV;                                       01088000
    DOUBLE  DISC'ADDR, LENGTH;                                          01090000
    OPTION  EXTERNAL;                                                   01092000
                                                                        01094000
  LOGICAL   PROCEDURE ADD'BADFILE (FNAME);                              01096000
    ARRAY   FNAME;                                                      01098000
    OPTION  EXTERNAL;                                                   01100000
                                                                        01102000
  LOGICAL   PROCEDURE REMOVE'BADFILE (FNAME);                           01104000
    ARRAY   FNAME;                                                      01106000
    OPTION  EXTERNAL;                                                   01108000
                                                                        01110000
$CONTROL SEGMENT=DIRECTORY1                                    <<DE>>   01112000
PROCEDURE DIRXXXBITMAP (FUNCTION);                             <<DE>>   01114000
   VALUE   FUNCTION;                                           <<DE>>   01116000
   INTEGER FUNCTION;                                           <<DE>>   01118000
                                                               <<DE>>   01120000
<< The function of this procedure is to perform the I/O for >> <<DE>>   01122000
<< the directory  BITMAP  which defines  space available in >> <<DE>>   01124000
<< the  entry and  index area  (which immediately follows). >> <<DE>>   01126000
<< A BITMAP can be up to 32 sectors [128 words each], which >> <<DE>>   01128000
<< allows for a  directory  to be  65,000 sectors  in total >> <<DE>>   01130000
<< length.   The data segment buffer [DSDS - %25] maintains >> <<DE>>   01132000
<< 3 sectors of the bitmap.  The first sector is always sec->> <<DE>>   01134000
<< tor zero (relative to DIRBASE), which contains the point->> <<DE>>   01136000
<< ers to FIRSTAVAIL and LASTWORD.    The remaining two sec->> <<DE>>   01138000
<< tors are used  to page thru the remaining portion of the >> <<DE>>   01140000
<< BITMAP.   DSFLAGS are used to provide for paging forward >> <<DE>>   01142000
<< and backward.                                            >> <<DE>>   01144000
                                                               <<DE>>   01146000
BEGIN                                                          <<DE>>   01148000
   DEFINE IN = FUNCTION = READ #,                              <<DE>>   01150000
         OUT = FUNCTION = WRITE#;                              <<DE>>   01152000
                                                               <<DE>>   01154000
   DOUBLE OLDDB;                                               <<DE>>   01156000
   PUSH (DB);                                                  <<DE>>   01158000
   OLDDB := TOS;                                               <<DE>>   01160000
   EXCHANGEDB (DIRSPACEDST);                                   <<DE>>   01162000
   IF IN OR DIRSP'DIRTY AND OUT THEN                           <<DE>>   01164000
   BEGIN                                                       <<DE>>   01166000
      IF OUT THEN                                              <<DE>>   01168000
      BEGIN                                                    <<DE>>   01170000
         DIRSP'DIRTY := FALSE;                                 <<DE>>   01172000
         IF CUR'SEGMENT<>0 AND DSBUFFLEN<>0 THEN               <<DE>>   01174000
         BEGIN                                                 <<DE>>   01176000
            TOS := WRITE;                                      <<DE>>   01178000
            TOS := DSADDR1;                                    <<DE>>   01180000
            TOS := DSADDR2;                                    <<DE>>   01182000
            TOS := @DIRSPIOBASE2;                              <<DE>>   01184000
            TOS := (IF DSBUFFLEN=0 THEN 256 ELSE DSBUFFLEN);   <<DE>>   01186000
            DIRDISC (*, *, *, *);                              <<DE>>   01188000
         END;                                                  <<DE>>   01190000
      << Restore first sector of BITMAP which contains ptrs >> <<DE>>   01192000
         @DIR'FIRSTAVAIL :=                                    <<DE>>   01194000
             (IF CUR'SEGMENT<=1 AND @BUF'FIRSTAVAIL<=DIRSPBUFF <<DE>>   01196000
                 THEN @BUF'FIRSTAVAIL - DIRSPHDR + DSVMBASE    <<DE>>   01198000
                 ELSE @BUF'FIRSTAVAIL - DIRSPHDR + DSVMBASE +  <<DE>>   01200000
                                       (CUR'SEGMENT-1)*128);   <<DE>>   01202000
         TOS := WRITE;                                         <<DE>>   01204000
         TOS := DSBASE1.(8:8);                                 <<DE>>   01206000
         TOS := DSBASE2;                                       <<DE>>   01208000
         TOS := (IF DSBUFFLEN=0 THEN 384 ELSE 128);            <<DE>>   01210000
         DIRDISC (*, *, *, *);                                 <<DE>>   01212000
      END                                                      <<DE>>   01214000
      ELSE BEGIN <<IN>>                                        <<DE>>   01216000
         IF DIRSP'NEXT2 OR DIRSP'PREV2 THEN                    <<DE>>   01218000
            BEGIN   << Read in 2 sectors of the bitmap >>      <<DE>>   01220000
               IF DIRSP'NEXT2 AND (NOT DIRSP'LASTIN ) OR       <<DE>>   01222000
                  DIRSP'PREV2 AND (NOT DIRSP'FIRSTIN) THEN     <<DE>>   01224000
                  BEGIN                                        <<DE>>   01226000
                  CUR'SEGMENT := CUR'SEGMENT +                 <<DE>>   01228000
                     (IF DIRSP'NEXT2 THEN 2 ELSE -2);          <<DE>>   01230000
                  @BUF'FIRSTAVAIL := 128 - DSVMBASE; <<buff#2>><<DE>>   01232000
                  IF CUR'SEGMENT <= 1 THEN                     <<DE>>   01234000
                     BEGIN  << Sector no. never less than 1 >> <<DE>>   01236000
                        DIRSP'FIRSTIN := TRUE;                 <<DE>>   01238000
                        CUR'SEGMENT   := 1;                    <<DE>>   01240000
                        @BUF'FIRSTAVAIL := DIRSPHDR + DSVMBASE;<<DE>>   01242000
                     END ELSE DIRSP'FIRSTIN:=FALSE;            <<DE>>   01244000
                  IF LOGICAL(((CUR'SEGMENT+2)*128)-1)          <<DE>>   01246000
                     >= DIR'LASTWORD                           <<DE>>   01248000
                     THEN BEGIN                                <<DE>>   01250000
                          DIRSP'LASTIN := TRUE;                <<DE>>   01252000
                          BUF'LASTWORD:=DIR'LASTWORD+DIRSPHDR- <<DE>>   01254000
                              LOGICAL ((CUR'SEGMENT-1)*128);   <<DE>>   01256000
                          END                                  <<DE>>   01258000
                     ELSE BEGIN                                <<DE>>   01260000
                          DIRSP'LASTIN := FALSE;               <<DE>>   01262000
                          BUF'LASTWORD := (DIRSPBUFF-1) +      <<DE>>   01264000
                                           DIRSPHDR - DSVMBASE;<<DE>>   01266000
                          END;                                 <<DE>>   01268000
                  DSBUFFLEN := (BUF'LASTWORD -                 <<DE>>   01270000
                       LOGICAL(@BUF'FIRSTAVAIL))-DIRSPHDR+1;   <<DE>>   01272000
                  IF DSBUFFLEN>256 THEN DSBUFFLEN:=256;        <<DE>>   01274000
                  TOS := 0;              TOS := CUR'SEGMENT;   <<DE>>   01276000
                  TOS := DSBASE1.(8:8);  TOS := DSBASE2;       <<DE>>   01278000
                  ASSEMBLE (DADD);                             <<DE>>   01280000
                  DSADDR2 := TOS;        DSADDR1 := TOS;       <<DE>>   01282000
                  TOS := READ;                                 <<DE>>   01284000
                  TOS := DSADDR1;                              <<DE>>   01286000
                  TOS := DSADDR2;                              <<DE>>   01288000
                  TOS := DSBUFFLEN;                            <<DE>>   01290000
                  DIRDISC (*, *, *, *);                        <<DE>>   01292000
                  END                                          <<DE>>   01294000
            END                                                <<DE>>   01296000
         ELSE BEGIN  << First read of BITMAP >>                <<DE>>   01298000
            DSFLAGS := FALSE;  << Set all flags off >>         <<DE>>   01300000
            TOS := READ;                                       <<DE>>   01302000
            TOS := DSBASE1.(8:8);                              <<DE>>   01304000
            TOS := DSBASE2;                                    <<DE>>   01306000
            TOS := 128;                                        <<DE>>   01308000
            DIRDISC (*, *, *, *);                              <<DE>>   01310000
            BUF'LASTWORD := DIRSPBUFF+DIRSPHDR-DSVMBASE-1;     <<DE>>   01312000
            IF (DIR'LASTWORD+DIRSPHDR-DSVMBASE) < BUF'LASTWORD <<DE>>   01314000
               THEN BUF'LASTWORD := DIR'LASTWORD               <<DE>>   01316000
                                  + DIRSPHDR - DSVMBASE;       <<DE>>   01318000
            CUR'SEGMENT := 1;                                  <<DE>>   01320000
            @BUF'FIRSTAVAIL:=@DIR'FIRSTAVAIL+DIRSPHDR-DSVMBASE;<<DE>>   01322000
            WHILE @BUF'FIRSTAVAIL >= (DIRSPBUFF - DSVMBASE)    <<DE>>   01324000
                DO BEGIN                                       <<DE>>   01326000
                   @BUF'FIRSTAVAIL := @BUF'FIRSTAVAIL - 256;   <<DE>>   01328000
                   CUR'SEGMENT := CUR'SEGMENT + 2;             <<DE>>   01330000
                   END;                                        <<DE>>   01332000
            DSBUFFLEN := (BUF'LASTWORD -                       <<DE>>   01334000
                         ( 128 + DIRSPHDR - DSVMBASE -1) );    <<DE>>   01336000
            TOS := 0;             TOS := CUR'SEGMENT;          <<DE>>   01338000
            TOS := DSBASE1.(8:8); TOS := DSBASE2;              <<DE>>   01340000
            ASSEMBLE (DADD);                                   <<DE>>   01342000
            DSADDR2 := TOS;       DSADDR1 := TOS;              <<DE>>   01344000
                                                               <<DE>>   01346000
            TOS := READ;                                       <<DE>>   01348000
            TOS := DSADDR1;                                    <<DE>>   01350000
            TOS := DSADDR2;                                    <<DE>>   01352000
            TOS := DSBUFFLEN;                                  <<DE>>   01354000
            DIRDISC (*, *, *, *);                              <<DE>>   01356000
            IF CUR'SEGMENT = 1 THEN DIRSP'FIRSTIN := TRUE;     <<DE>>   01358000
            IF DIR'LASTWORD <= BUF'LASTWORD THEN               <<DE>>   01360000
               DIRSP'LASTIN := TRUE;                           <<DE>>   01362000
            END;                                               <<DE>>   01364000
      END;                                                     <<DE>>   01366000
   END;                                                        <<DE>>   01368000
   TOS := OLDDB;                                               <<DE>>   01370000
   SET(DB);                                                    <<DE>>   01372000
END; << DIRXXXBITMAP >>                                        <<DE>>   01374000
$PAGE "DIRECTORY ROUTINES"                                              01376000
PROCEDURE DIRSET (WHICH);                                               01378000
   VALUE WHICH;                                                         01380000
   INTEGER WHICH;                                                       01382000
BEGIN                                                                   01384000
   CASE (WHICH) OF                                                      01386000
      BEGIN                                                             01388000
      TOS := @DAPREPRE;                                                 01390000
      TOS := @DBPREPRE;                                                 01392000
      END;                                                              01394000
   @BASE := TOS;                                                        01396000
   END    <<DIRSET>>;                                                   01398000
                                                                        01400000
PROCEDURE DIRXXXLLOCATE (PNTRIN, PPSIZE, SETTO);                        01402000
   VALUE PNTRIN, PPSIZE, SETTO;                                         01404000
   LOGICAL PNTRIN, SETTO;                                               01406000
   INTEGER PPSIZE;                                                      01408000
BEGIN                                                                   01410000
   LOGICAL POINTER PNTR = PNTRIN;                                       01412000
                                                               <<04733>>01414000
   TOS := 0;                                                            01416000
   @PNTR := INTEGER (PNTRIN & DCSR(4)) + @BITMAP;                       01418000
   XREG := TOS & LSR(12);                                               01420000
   TOS := PNTR;                                                         01422000
   DO BEGIN                                                             01424000
      IF SETTO THEN ASSEMBLE(TSBC 0,X)                                  01426000
      ELSE ASSEMBLE(TRBC 0,X);                                          01428000
      IF (XREG := XREG+1) = 16 THEN                                     01430000
         BEGIN                                                          01432000
         PNTR := TOS;                                                   01434000
         @PNTR := @PNTR+1;                                              01436000
         XREG := 0;                                                     01438000
         TOS := PNTR;                                                   01440000
         END;                                                           01442000
      END                                                               01444000
   UNTIL (PPSIZE := PPSIZE-1) <= 0;                                     01446000
   PNTR := TOS;                                                         01448000
   @DIR'FIRSTAVAIL:=@BUF'FIRSTAVAIL-DIRSPHDR+DSVMBASE;         <<DE>>   01450000
   TOS := WRITE;                                               <<04733>>01452000
   TOS := DSBASE1.(8:8);                                       <<04733>>01454000
   TOS := DSBASE2;                                             <<04733>>01456000
   TOS := @DIRSPIOBASE;                                        <<DE>>   01458000
   DIRDISC (*, *, *, 384);                                     <<DE>>   01460000
   END    <<DIRXXXLLOCATE>>;                                            01462000
                                                                        01464000
LOGICAL PROCEDURE DIRALLOCATE (PPSIZE);                                 01466000
   VALUE PPSIZE;                                                        01468000
   INTEGER PPSIZE;                                                      01470000
<<                                                                      01472000
   LOOK FOR CONTIGUOUS ONES.    RETURNS:                                01474000
   CCE - OKAY:  ADDRESS RETURNED,                                       01476000
   CCL - CAN'T FIND ANY:  0 RETURNED,                                   01478000
   CCG - PPSIZE > DDS BLOCK:  0 RETURNED.                               01480000
>>                                                                      01482000
BEGIN                                                                   01484000
   INTEGER                                                              01486000
      SIZE := 0;                                                        01488000
SUBROUTINE FIND (LOWLIM, UPLIM);                                        01490000
   VALUE LOWLIM, UPLIM;                                                 01492000
   INTEGER LOWLIM, UPLIM;                                      <<04733>>01494000
DO BEGIN                                                                01496000
   XREG := 1;                                                           01498000
   TOS := DPS2;                                                         01500000
   DO BEGIN                                                             01502000
      ASSEMBLE (DTST);                                                  01504000
      IF >= THEN                                                        01506000
         BEGIN                                                          01508000
         SIZE := 0;    <<  ('ZERO' DOESN'T SET CC )  >>                 01510000
         IF = THEN GOTO NEXT2WORDS;                                     01512000
         END                                                            01514000
      ELSE                                                              01516000
         IF (SIZE := SIZE+1) = PPSIZE THEN                              01518000
            BEGIN    <<FOUND>>                                          01520000
            ASSEMBLE (DDEL);                                            01522000
            TOS := (LOWLIM-@BITMAP) & LSL(4) + XREG;           <<04733>>01524000
            IF (@BUF'FIRSTAVAIL:=S0&LSR(4)+(@BITMAP-DSVMBASE)) <<DE>>   01526000
               > INTEGER(BUF'LASTWORD) THEN                    <<DE>>   01528000
               @BUF'FIRSTAVAIL:=LOGICAL(@BITMAP-DSVMBASE);     <<DE>>   01530000
            TOS := TOS-SIZE;                                            01532000
            DIRXXXLLOCATE (S0, SIZE, 0);                                01534000
            XREG := CCE;                                                01536000
            GOTO EXIT;                                                  01538000
            END;                                                        01540000
      TOS := TOS & DLSL(1);                                             01542000
      END                                                               01544000
   UNTIL (XREG := XREG+1) >= 33;                                        01546000
NEXT2WORDS:                                                             01548000
   ASSEMBLE (DDEL);                                                     01550000
   END                                                                  01552000
UNTIL (S2 := S2+2) > UPLIM;                                    <<04733>>01554000
   IF PPSIZE > DDSBSIZE THEN                                            01556000
      BEGIN                                                    <<DE>>   01558000
      XREG := CCG;                                             <<DE>>   01560000
      GOTO ZEXIT;                                              <<DE>>   01562000
      END;                                                     <<DE>>   01564000
   EXCHANGEDB (DIRSPACEDST);                                   <<DE>>   01566000
                                                               <<DE>>   01568000
   << Search for space in directory bitmap >>                  <<DE>>   01570000
   FIND (@BUF'FIRSTAVAIL+DSVMBASE,BUF'LASTWORD+DSVMBASE);      <<DE>>   01572000
   FIND (@BITMAP, @BUF'FIRSTAVAIL+DSVMBASE);                   <<DE>>   01574000
   WHILE NOT(DIRSP'LASTIN)                                     <<DE>>   01576000
      DO BEGIN                                                 <<DE>>   01578000
         DIRSP'NEXT2 := TRUE;                                  <<DE>>   01580000
         DIRXXXBITMAP (READ);                                  <<DE>>   01582000
         FIND (@BUF'FIRSTAVAIL+DSVMBASE,BUF'LASTWORD+DSVMBASE);<<DE>>   01584000
         END;                                                  <<DE>>   01586000
   DIRSP'NEXT2 := FALSE;                                       <<DE>>   01588000
   WHILE NOT(DIRSP'FIRSTIN)                                    <<DE>>   01590000
      DO BEGIN                                                 <<DE>>   01592000
         DIRSP'PREV2 := TRUE;                                  <<DE>>   01594000
         DIRXXXBITMAP (READ);                                  <<DE>>   01596000
         FIND (@BUF'FIRSTAVAIL+DSVMBASE,BUF'LASTWORD+DSVMBASE);<<DE>>   01598000
         END;                                                  <<DE>>   01600000
DIRC'FULL: XREG := CCL;   << None available >>                 <<DE>>   01602000
ZEXIT:     TOS := 0;                                           <<DE>>   01604000
EXIT:    << DIRBASE relative pointer is in TOS >>              <<DE>>   01606000
   DIRALLOCATE := TOS + ((CUR'SEGMENT-1) & LSL(11) );          <<DE>>   01608000
   DIRSP'PREV2 := FALSE;                                       <<DE>>   01610000
   DIRSP'NEXT2 := FALSE;                                       <<DE>>   01612000
   CC := XREG;                                                 <<DE>>   01614000
   EXCHANGEDB (DDSDST);                                        <<DE>>   01616000
END;  << DIRALLOCATE >>                                        <<DE>>   01618000
PROCEDURE DIRDEALLOCATE (PNTR, PPSIZE);                        <<DE>>   01620000
   VALUE   PNTR, PPSIZE;                                       <<DE>>   01622000
   LOGICAL PNTR;                                               <<DE>>   01624000
   INTEGER PPSIZE;                                             <<DE>>   01626000
BEGIN                                                          <<DE>>   01628000
   LOGICAL PSECT;                                              <<DE>>   01630000
                                                               <<DE>>   01632000
   EXCHANGEDB (DIRSPACEDST);                                   <<DE>>   01634000
   PSECT := ((PNTR + (DSVMBASE & LSL(4))) & LSR(11));          <<DE>>   01636000
   IF PSECT > LOGICAL(CUR'SEGMENT+1) THEN                      <<DE>>   01638000
      BEGIN  << Read next bitmap sector >>                     <<DE>>   01640000
         DIRSP'NEXT2 := TRUE;                                  <<DE>>   01642000
         WHILE PSECT > LOGICAL(CUR'SEGMENT+1) DO               <<DE>>   01644000
            DIRXXXBITMAP (READ);                               <<DE>>   01646000
         DIRSP'NEXT2 := FALSE;                                 <<DE>>   01648000
      END                                                      <<DE>>   01650000
   ELSE IF (PSECT > 0) AND                                     <<DE>>   01652000
           (PSECT <= LOGICAL(CUR'SEGMENT-1)) THEN              <<DE>>   01654000
      BEGIN                                                    <<DE>>   01656000
         DIRSP'PREV2 := TRUE;                                  <<DE>>   01658000
         WHILE PSECT <= LOGICAL(CUR'SEGMENT-1) DO              <<DE>>   01660000
            DIRXXXBITMAP (READ);                               <<DE>>   01662000
         DIRSP'PREV2 := FALSE;                                 <<DE>>   01664000
      END;                                                     <<DE>>   01666000
   WHILE PNTR >= ( (DIRSPBUFF & LSL(4)) - (DSVMBASE & LSL(4)) )<<DE>>   01668000
         DO PNTR := PNTR - 4096;                               <<DE>>   01670000
   DIRXXXLLOCATE (PNTR, PPSIZE, 1);                            <<DE>>   01672000
   EXCHANGEDB (DDSDST);                                        <<DE>>   01674000
   END;  << DIRDEALLOCATE >>                                   <<DE>>   01676000
                                                                        01678000
PROCEDURE DIRWRITE (WHICH);                                             01680000
   VALUE WHICH;                                                         01682000
   LOGICAL WHICH;                                                       01684000
BEGIN                                                                   01686000
   INTEGER TEMP = WHICH;                                                01688000
   LOGICAL POINTER TEMPP;                                               01690000
<< >>                                                                   01692000
   DIRSET (WHICH);                                                      01694000
   WHICHDIRTY := FALSE;                                                 01696000
   @TEMPP := BASE(IOPNTR);                                              01698000
   TOS := BASE(USED);                                                   01700000
   IF BASE(MISCWD).(TYPEF) = INDEXTYPE THEN                             01702000
      BEGIN                                                             01704000
      MOVE TEMPP := BASE(MISCWD), (PRESIZE);                            01706000
      TOS := TOS+PRESIZE;                                               01708000
      END;                                                              01710000
   ASSEMBLE (TEST);                                                     01712000
   IF = THEN RETURN;                                                    01714000
   TEMP := TOS;                                                         01716000
   TOS := WRITE;                                                        01718000
   TOS := DIRBASE;                                                      01720000
   TOS := 0;                                                            01722000
   TOS := IBASE(CONTENTS);                                              01724000
   ASSEMBLE(DADD);                                                      01726000
   DIRDISC(*,*,TEMPP,TEMP);                                             01728000
   END    <<DIRWRITE>>;                                                 01730000
                                                                        01732000
PROCEDURE DIRREAD (PNTR, WHICH, EXCOUNT, EEMISCWD);                     01734000
   VALUE PNTR, WHICH, EXCOUNT, EEMISCWD;                                01736000
   LOGICAL PNTR, WHICH, EEMISCWD;                                       01738000
   INTEGER EXCOUNT;                                                     01740000
                                                               <<DE>>   01742000
BEGIN                                                          <<DE>>   01744000
   LOGICAL TEMP;                                                        01746000
   LOGICAL POINTER TEMPP;                                               01748000
   DIRSET (WHICH);                                                      01750000
   IF BASE (CONTENTS)= PNTR THEN RETURN;                                01752000
   IF WHICHDIRTY THEN DIRWRITE (WHICH);                                 01754000
   @TEMPP := BASE(IOPNTR);                                              01756000
<< *** CHECK FOR PP. CONTAINED IN DDS BLOCKS AND MOVE *** >>            01758000
   TOS := READ;                                                         01760000
   TOS := DIRBASE;                                                      01762000
   TOS := 0;                                                            01764000
   TOS := PNTR;                                                <<DE>>   01766000
   ASSEMBLE(DADD);                                                      01768000
   DIRDISC(*,*,TEMPP,DDSBWSIZE);                                        01770000
   TEMP := DDSBSIZE;                                                    01772000
   BASE (CONTENTS) := PNTR;                                             01774000
   BASE (NUMVALID) := TEMP;                                             01776000
   IF TEMPP.(TYPEF) = INDEXTYPE THEN                                    01778000
      BEGIN                                                             01780000
      MOVE BASE(MISCWD) := TEMPP, (PRESIZE);                            01782000
      TEMP := PRESIZE;                                                  01784000
      END                                                               01786000
   ELSE                                                                 01788000
      BEGIN                                                             01790000
      BASE(XCOUNT) := EXCOUNT;                                          01792000
      BASE(MISCWD) := EEMISCWD;                                         01794000
      TEMP := 0;                                                        01796000
      END;                                                              01798000
   BASE (LPNTR) := @TEMPP+INTEGER(TEMP);                                01800000
   BASE(USED) := (BASE(XSIZE) := BASE(MISCWD).(XSIZEF)) * BASE(XCOUNT); 01802000
   BASE(BFACTOR) := ((BASE(BWSIZE) := (BASE(BSIZE)                      01804000
      := BASE(MISCWD).(BSIZEF)) & LSL(7)) - TEMP) / BASE(XSIZE);        01806000
   END <<DIRREAD>>;                                                     01808000
                                                                        01810000
LOGICAL PROCEDURE DIRNEWINDEX (IBSIZE, ILEVEL, EBSIZE, ESIZE);          01812000
   VALUE IBSIZE, ILEVEL, EBSIZE, ESIZE;                                 01814000
   INTEGER IBSIZE, ILEVEL, EBSIZE, ESIZE;                               01816000
<< CALLER MUST MOVE PINDEXP AND PNAME INTO DBPINDEXP AND DBPNAME >>     01818000
BEGIN                                                                   01820000
   IF EBSIZE > DDSBSIZE THEN GOTO NEVER;                                01822000
   TOS := DIRALLOCATE (IBSIZE);                                         01824000
   IF <> THEN                                                           01826000
      BEGIN                                                             01828000
      IF < THEN XREG := CCL                                             01830000
      ELSE                                                              01832000
NEVER:   XREG := CCG;                                                   01834000
      CC := XREG;                                                       01836000
      DIRNEWINDEX := 0;                                                 01838000
      RETURN;                                                           01840000
      END;                                                              01842000
   CC := CCE;                                                           01844000
   DBCONTENTS := (DIRNEWINDEX := TOS);                                  01846000
   @DBLPNTR := @DBIOPNTR+PRESIZE;                                       01848000
   DBNUMVALID := IBSIZE;                                                01850000
   DBUSED := 0;                                                         01852000
   DBBFACTOR := (DBBWSIZE := (DBBSIZE := IBSIZE) & LSL(7)) / ISIZE;     01854000
   TOS := 0;                                                            01856000
   TOS.(TYPEF) := INDEXTYPE;                                            01858000
   TOS.(LEVELF) := ILEVEL;                                              01860000
   TOS.(XSIZEF) := (DBXSIZE := ISIZE);                                  01862000
   TOS.(BSIZEF) := DBBSIZE;                                             01864000
   DBMISCWD := TOS;                                                     01866000
   DBXCOUNT := (DBPCOUNT := (DBETOTAL := 0));                           01868000
   TOS := 0;                                                            01870000
   TOS.(TYPEF) := ENTRYTYPE;                                            01872000
   TOS.(LEVELF) := ILEVEL;                                              01874000
   TOS.(XSIZEF) := ESIZE;                                               01876000
   TOS.(BSIZEF) := EBSIZE;                                              01878000
   DBEMISCWD := TOS;                                                    01880000
   DIRWRITE (B);                                                        01882000
   END    <<DIRNEWINDEX>>;                                              01884000
$PAGE                                                          <<DE>>   01886000
                                                                        01888000
DOUBLE PROCEDURE DIRECNULL (NUMSECT);                                   01890000
   VALUE NUMSECT;                                                       01892000
   LOGICAL NUMSECT;                                            <<DE>>   01894000
BEGIN                                                                   01896000
   INTEGER  DIRECNULL2 = Q-5,                                  <<DE>>   01898000
            LIM = NUMSECT,                                     <<DE>>   01900000
            NUMWDS,                                            <<DE>>   01902000
            REM,                                               <<DE>>   01904000
            REMWDS,                                            <<DE>>   01906000
            NSECT;                                             <<DE>>   01908000
   DOUBLE   ADDR;                                              <<DE>>   01910000
                                                               <<DE>>   01912000
                                                               <<DE>>   01914000
   EXCHANGEDB (DIRSPACEDST);                                   <<DE>>   01916000
   TOS := DSBASE1.(8:8);                                       <<DE>>   01918000
   TOS := DSBASE2;                                             <<DE>>   01920000
   ADDR := TOS;    << ADDRESS OF DIRECTORY >>                  <<DE>>   01922000
                                                               <<DE>>   01924000
   TOS := 0;                                                   <<DE>>   01926000
   TOS := NUMSECT & DCSR(4);                                   <<DE>>   01928000
   NUMWDS := TOS;  << SIZE OF BITMAP IN WORDS >>               <<DE>>   01930000
   REM := TOS & LSR(12);                                       <<DE>>   01932000
                                                               <<DE>>   01934000
   TOS := 0;                                                   <<DE>>   01936000
   TOS := NUMWDS & DCSR(7);                                    <<DE>>   01938000
   NSECT := TOS;   <<SIZE OF BITMAP IN SECTORS >>              <<DE>>   01940000
   REMWDS := TOS & LSR(9);                                     <<DE>>   01942000
                                                               <<DE>>   01944000
   BITMAP := %17777;                                           <<DE>>   01946000
   BITMAP(1) := %177777;                                       <<DE>>   01948000
   MOVE BITMAP(2) := BITMAP(1), (384-DSVMBASE-1);              <<DE>>   01950000
                                                               <<DE>>   01952000
   IF NSECT >= 3 THEN    << SIZE OF BITMAP BUFFER >>           <<DE>>   01954000
      BEGIN      << BITMAP GREATER THAN BUFFER >>              <<DE>>   01956000
         IF REM <> 0 THEN                                      <<DE>>   01958000
            BITMAP (255+REMWDS) := NOT((-1) & LSR(REM));       <<DE>>   01960000
         BITMAP (256+REMWDS) := 0;                             <<DE>>   01962000
         TOS := WRITE;                                         <<DE>>   01964000
         TOS := (ADDR + DOUBLE(NSECT) - 1D);                   <<DE>>   01966000
         TOS := @DIRSPIOBASE2;                                 <<DE>>   01968000
         TOS := (128 + REMWDS + 1);                            <<DE>>   01970000
         DIRDISC ( *, *, *, * );                               <<DE>>   01972000
         BITMAP := BITMAP & LSR(1);                            <<DE>>   01974000
         IF REMWDS <> 0 THEN BITMAP:=BITMAP & LSR(1);          <<DE>>   01976000
         BITMAP (255+REMWDS) := %177777;                       <<DE>>   01978000
         BITMAP (256+REMWDS) := %177777;                       <<DE>>   01980000
                                                               <<DE>>   01982000
         WHILE (NSECT:=NSECT-1) > 3 DO                         <<DE>>   01984000
            BEGIN                                              <<DE>>   01986000
               TOS := WRITE;                                   <<DE>>   01988000
               TOS := (ADDR + DOUBLE(NSECT) - 1D);             <<DE>>   01990000
               TOS := @DIRSPIOBASE2;                           <<DE>>   01992000
               TOS := 128;                                     <<DE>>   01994000
               DIRDISC ( *, *, *, * );                         <<DE>>   01996000
               IF BITMAP <> 0 THEN                             <<DE>>   01998000
                  BITMAP := BITMAP & LSR(1)                    <<DE>>   02000000
               ELSE                                            <<DE>>   02002000
                  BITMAP(1) := BITMAP(1) & LSR(1);             <<DE>>   02004000
            END;                                               <<DE>>   02006000
                                                               <<DE>>   02008000
         DIR'LASTWORD := NUMWDS + 1;                           <<DE>>   02010000
         @DIR'FIRSTAVAIL := (IF BITMAP<>0 THEN DSVMBASE ELSE   <<DE>>   02012000
                         IF BITMAP(1)<>0 THEN DSVMBASE+1       <<DE>>   02014000
                         ELSE DSVMBASE+2 );                    <<DE>>   02016000
      END                                                      <<DE>>   02018000
   ELSE BEGIN << DIRECTORY FITS IN 3 SECTOR BUFFER >>          <<DE>>   02020000
         BITMAP (NUMWDS-1) := NOT ( (-1) & LSR(REM) );         <<DE>>   02022000
         BITMAP (NUMWDS)   := 0;                               <<DE>>   02024000
         DIR'LASTWORD := NUMWDS + 1;                           <<DE>>   02026000
         @DIR'FIRSTAVAIL := DSVMBASE;                          <<DE>>   02028000
      END;                                                     <<DE>>   02030000
                                                               <<DE>>   02032000
   BUF'LASTWORD    := DIR'LASTWORD  + DIRSPHDR - DSVMBASE;     <<DE>>   02034000
   @BUF'FIRSTAVAIL := @DIR'FIRSTAVAIL+DIRSPHDR-DSVMBASE;       <<DE>>   02036000
   IF @BUF'FIRSTAVAIL>%607 << LAST WORD OF BITMAP >>           <<DE>>   02038000
      THEN @BUF'FIRSTAVAIL := %607;                            <<DE>>   02040000
                                                               <<DE>>   02042000
   EXCHANGEDB (DDSDST);                                                 02044000
   TOS := NUMSECT;                                                      02046000
   LIM := SYSACCTINDEX+SYSSAIBSIZE;                                     02048000
   DIRECNULL := 0D;                                                     02050000
   DDS := 0;                                                            02052000
   WHILE (TOS := TOS-1) >= LIM DO                                       02054000
      BEGIN                                                             02056000
      TOS := WRITE;                                                     02058000
      TOS := 0;                                                         02060000
      TOS := S2;                                                        02062000
      TOS := TOS+DIRBASE;                                               02064000
      DIRDISC(*,*,DDS,1);                                               02066000
      END;                                                              02068000
   ASSEMBLE (DEL);                                                      02070000
   DBPINDEXP := 0;                                             <<DE>>   02072000
   DBPNAME   := %20040;                                        <<DE>>   02074000
   MOVE DBPNAME (1) := DBPNAME, (NAMESIZE-1);                  <<DE>>   02076000
   DIRNEWINDEX (SYSSAIBSIZE,ACCOUNTLEVEL,SYSAEBSIZE,ASIZE);    <<DE>>   02078000
   EXCHANGEDB (0);                                                      02080000
   CC := IF DIRECNULL2 = 0 THEN CCE ELSE CCG;                           02082000
   END    <<DIRECNULL>>;                                                02084000
                                                                        02086000
INTEGER PROCEDURE DIRSCAN (ENTRYNAME, TYPE'WHICH);                      02088000
   VALUE TYPE'WHICH;                                                    02090000
   ARRAY ENTRYNAME;                                                     02092000
   LOGICAL TYPE'WHICH;                                                  02094000
   << ASSUMES NAMESIZE = 4 >>                                           02096000
<< RETURNS:                                                             02098000
   CCG - EXACT ENTRY RETURNED.                                          02100000
   CCL - PRECEEDING OR NEXT ENTRY RETURNED                              02102000
   CCE - "PSEUDO" PRECEEDING OR NEXT ENTRY RETURNED (OUTSIDE BOUNDS)  >>02104000
BEGIN                                                                   02106000
   DOUBLE POINTER DENTRYNAME = ENTRYNAME;                               02108000
   DEFINE                                                               02110000
      WHICHFIELD  = 15:1 #,                                             02112000
      TYPEFIELD  = 13:2 #;                                              02114000
   DOUBLE POINTER ENDX;                                                 02116000
   DOUBLE POINTER PNTR;                                                 02118000
<< >>                                                                   02120000
   DIRSET (TYPE'WHICH.(WHICHFIELD));                                    02122000
   @ENDX := (@PNTR := IBASE(LPNTR))+IBASE(USED);                        02124000
   << CHANGE TO BINARY SEARCH LATER >>                                  02126000
   WHILE @PNTR < @ENDX DO                                               02128000
      BEGIN                                                             02130000
      IF DENTRYNAME = PNTR THEN                                         02132000
         IF DENTRYNAME (1) &DLSL (1) & DLSR (1) =                       02134000
            PNTR (XREG) & DLSL (1) & DLSR (1)                           02136000
         THEN GO TO EXACTONE;                                           02138000
      IF < THEN GOTO NEXTONE;                                           02140000
      @PNTR := @PNTR+IBASE(XSIZE);                                      02142000
      END;                                                              02144000
   @ENDX := 0;                                                          02146000
NEXTONE:                                                                02148000
   IF TYPE'WHICH.(TYPEFIELD) <= 1 THEN                                  02150000
      << EXACT OR EXACT/NEXT REQUEST >>                                 02152000
         BEGIN                                                          02154000
         TOS := @PNTR;                                                  02156000
         XREG := IF @ENDX <> 0 THEN CCL ELSE CCE;                       02158000
         END                                                            02160000
   ELSE                                                                 02162000
      << EXACT/PRECEEDING REQUEST >>                                    02164000
         BEGIN                                                          02166000
         TOS := @PNTR-IBASE(XSIZE);                                     02168000
         XREG := IF @PNTR <> IBASE(LPNTR) THEN CCL ELSE CCE;            02170000
         END;                                                           02172000
   GOTO EXIT;                                                           02174000
EXACTONE:                                                               02176000
   TOS := @PNTR;                                                        02178000
   XREG := CCG;                                                         02180000
EXIT:                                                                   02182000
   CC := XREG;                                                          02184000
   DIRSCAN := TOS;                                                      02186000
   END    <<DIRSCAN>>;                                                  02188000
                                                                        02190000
DOUBLE PROCEDURE DIRINSERT (INDEXPOINTER);                              02192000
   VALUE INDEXPOINTER;                                                  02194000
   LOGICAL INDEXPOINTER;                                                02196000
<< WHEN CALLED:                                                         02198000
   1. DIRECTORY IS LOCKED,                                              02200000
   2. ENTRY HAS BEEN MOVED TO THE DATA SEGMENT (AT 0),                  02202000
   3. DB IS SET AT THE DATA SEGMENT.  >>                                02204000
<< RETURNS:                                                             02206000
   (S-0)                  (S-1)                                         02208000
   0 - SUCCESSFUL            0                                          02210000
   1 - DUPLICATE NAME        0                                          02212000
   4 - NO USER ROOM          N         N% USED.  NO INDEX ROOM          02214000
   5 - NO USER ROOM          0         > 65K ENTRIES                    02216000
   6 - NO SYSTEM ROOM        N         FOR N CONTIGUOUS BLOCKS        >>02218000
BEGIN                                                                   02220000
   LOGICAL NEWPREIETOTAL;                                               02222000
   INTEGER STEMP;                                                       02224000
   INTEGER STEMP2;                                                      02226000
   INTEGER STEMP3, STEMP4;                                              02228000
   INTEGER                                                              02230000
      ZT,                                                               02232000
      ZTOTAL,                                                           02234000
      ZH1,                                                              02236000
      ZHALF1,                                                           02238000
      ZH2,                                                              02240000
      ZHALF2;                                                           02242000
   LOGICAL POINTER                                                      02244000
      IPNTR,                                                            02246000
      IPNTR2;                                                           02248000
   INTEGER POINTER                                                      02250000
      IIPNTR = IPNTR,                                                   02252000
      IIPNTR2 = IPNTR2;                                                 02254000
   INTEGER TEMP;                                                        02256000
   LOGICAL POINTER TEMPP = TEMP;                                        02258000
   INTEGER ESIZE;                                                       02260000
   LOGICAL POINTER S2PNTR = S-2;                                        02262000
   LOGICAL POINTER S4PNTR = S-4;                                        02264000
   LOGICAL OVERRIDE := FALSE;  << TRUE-OK TO OVERRIDE GOOD% >> <<04733>>02266000
   LOGICAL TIPNTR;  << HOLD IPNTR INCASE OF OVERRIDE >>        <<04733>>02268000
   LOGICAL TIPNTR2;  << DITTO FOR IPNTR2 >>                    <<04733>>02270000
   INTEGER TZT;  << DITTO FOR ZT >>                            <<04733>>02272000
LOGICAL SUBROUTINE ZINSERT (ELEMENT, WHICH, PNTR);                      02274000
   VALUE WHICH;                                                         02276000
   ARRAY ELEMENT, PNTR;                                                 02278000
   LOGICAL WHICH;                                                       02280000
BEGIN                                                                   02282000
   DIRSET (WHICH);                                                      02284000
   IF @PNTR = 0 THEN                                                    02286000
      << *** FIND PREVIOUS ELEMENT *** >>                               02288000
      BEGIN                                                             02290000
      @PNTR := DIRSCAN (ELEMENT, EN LOR WHICH);                         02292000
      IF > THEN                                                         02294000
         BEGIN                                                          02296000
         ZINSERT := 0;                                                  02298000
         RETURN;                                                        02300000
         END;                                                           02302000
      END;                                                              02304000
   STEMP2 := BASE(XSIZE);                                               02306000
   STEMP := IBASE(LPNTR) + IBASE(USED) - @PNTR;                         02308000
   IF <> THEN                                                           02310000
      << ******** CHECK CODE FOR FOLLOWING 2 STATEMENTS **************>>02312000
      MOVE PNTR (STEMP+STEMP2-1) := PNTR(STEMP-1), (-STEMP);            02314000
   MOVE PNTR := ELEMENT, (STEMP2);                                      02316000
   ZINSERT := @PNTR;                                                    02318000
   END    <<ZINSERT>>;                                                  02320000
LOGICAL SUBROUTINE ZNEWENTRYBLOCK (NAME, INDEXPLACE);                   02322000
   ARRAY NAME, INDEXPLACE;                                              02324000
BEGIN                                                                   02326000
   IF (STEMP3 := DBXCOUNT+1) > DBBFACTOR THEN                           02328000
      BEGIN                                                             02330000
      IF OVERRIDE THEN GO CRAM'IT;  << OVERRIDE GOOD% >>       <<04733>>02332000
      TOS := INTEGER (FIXR ((REAL(DBETOTAL)/REAL((DBXCOUNT) *           02334000
         ((DBEBSIZE & LSL(7))/ESIZE)))*100.));                          02336000
      TOS := 4;                                                         02338000
      << *********** CHECK THIS BRANCH ***********>>                    02340000
      GOTO BADEXIT;                                                     02342000
      END;                                                              02344000
   STEMP4 := DIRALLOCATE (DBEBSIZE);                                    02346000
   IF < THEN                                                            02348000
      BEGIN                                                             02350000
      IF OVERRIDE THEN GO CRAM'IT;  << OVERRIDE GOOD% >>       <<04733>>02352000
      TOS := DBEBSIZE;                                                  02354000
      TOS := 6;                                                         02356000
      << *********** CHECK THIS BRANCH ***********>>                    02358000
      GOTO BADEXIT;                                                     02360000
      END;                                                              02362000
   << *** INDEX HAS ROOM AND WE HAVE A BLOCK *** >>                     02364000
   << ******* CHECK CODE FOR FOLLLOWING STATEMENT **************>>      02366000
   ZINSERT (NAME, B, INDEXPLACE);                                       02368000
   DBXCOUNT := STEMP3;                                                  02370000
   DBUSED := DBUSED+ISIZE;                                              02372000
   INDEXPLACE (IEPNTR) := (ZNEWENTRYBLOCK := STEMP4);                   02374000
   END    <<ZNEWENTRYBLOCK>>;                                           02376000
SUBROUTINE ZSET;                                                        02378000
BEGIN                                                                   02380000
   ZTOTAL := ZT * (XREG := ESIZE);                                      02382000
   ZHALF1 := (ZH1 := ZT & LSR(1)) * XREG;                               02384000
   ZHALF2 := (ZH2 := (ZT+1) & LSR(1)) * XREG;                           02386000
   END    <<ZSET>>;                                                     02388000
SUBROUTINE ZDISTRIBUTE;                                                 02390000
BEGIN                                                                   02392000
   MOVE DBLPNTR (ZHALF2-1) := DALPNTR (ZTOTAL-1), (-ZHALF2);            02394000
   DBUSED := ZHALF2;                                                    02396000
   DBXCOUNT := ZH2;                                                     02398000
   DIRWRITE (B);                                                        02400000
   DAUSED := ZHALF1;                                                    02402000
   DAXCOUNT := ZH1;                                                     02404000
   DIRWRITE (A);                                                        02406000
   END    <<ZDISTRIBUTE>>;                                              02408000
<< >>                                                                   02410000
   DIRREAD (INDEXPOINTER, B, 0, 0);                                     02412000
   ESIZE := DBEXSIZE;                                                   02414000
   NEWPREIETOTAL := DBETOTAL+1;                                         02416000
   IF CARRY THEN                                                        02418000
      BEGIN                                                             02420000
      TOS := 5;                                                         02422000
      GOTO BADEXITZ;                                                    02424000
      END;                                                              02426000
   @IPNTR := DIRSCAN (DDSENTRY, EPB);                                   02428000
   IF > THEN                                                            02430000
DUPNAME:                                                                02432000
      BEGIN                                                             02434000
      TOS := 1;                                                         02436000
BADEXITZ:                                                               02438000
      ASSEMBLE (ZROB);                                                  02440000
BADEXIT:                                                                02442000
      CC := CCG;                                                        02444000
      GOTO EXIT;                                                        02446000
      END;                                                              02448000
   IF = THEN                                                            02450000
      <<*** NO CONTAINING BLOCK: ALLOCATE 1 OR INSERT IN FIRST ONE ***>>02452000
      BEGIN                                                             02454000
      @IPNTR := @DBLPNTR;                                               02456000
      IF DBXCOUNT > 0 THEN GOTO CHECKFIT;                               02458000
      TOS := ZNEWENTRYBLOCK (DDSENTRY, IPNTR);                          02460000
      IPNTR (IECOUNT) := 0;                                             02462000
      << *** SET UP NULL BLOCK *** >>                                   02464000
      DBNUMVALID := DBBSIZE;    <<PROCECT AGAINST INACCURATE COPY IN B>>02466000
      DACONTENTS := TOS;                                                02468000
      @DALPNTR := @DAIOPNTR;                                            02470000
      DANUMVALID := DBEBSIZE;                                           02472000
      DAXSIZE := DBEXSIZE;                                              02474000
      DAUSED := 0;                                                      02476000
      DABWSIZE := (DABSIZE := DBEBSIZE) & LSL(7);                       02478000
      DABFACTOR := DABWSIZE/DAXSIZE;                                    02480000
      DAMISCWD := DBEMISCWD;                                            02482000
      DAXCOUNT := 0;                                                    02484000
      GOTO NORMALINSERT;                                                02486000
      END;                                                              02488000
CHECKFIT:                                                               02490000
   IF IIPNTR (IECOUNT) < (TEMP := (DBEBSIZE & LSL(7)) / ESIZE) THEN     02492000
      << *** A NORMAL INSERTION *** >>                                  02494000
      BEGIN                                                             02496000
      DIRREAD (IPNTR (IEPNTR), A, IPNTR(IECOUNT), DBEMISCWD);           02498000
NORMALINSERT:                                                           02500000
      IF ZINSERT (DDSENTRY, A, DDS) = 0 THEN GOTO DUPNAME;              02502000
      DAUSED := DAUSED+ESIZE;                                           02504000
      DAXCOUNT := DAXCOUNT+1;                                           02506000
      DIRWRITE (A);                                                     02508000
      DBETOTAL := NEWPREIETOTAL;                                        02510000
      MOVE IPNTR := DALPNTR, (NAMESIZE);                                02512000
      IIPNTR (IECOUNT) := IIPNTR (IECOUNT) + 1;                         02514000
      DIRWRITE (B);                                                     02516000
      END                                                               02518000
   ELSE                                                                 02520000
      << *** DISTRIBUTION REQUIRED *** >>                               02522000
      BEGIN                                                             02524000
      IF DBXCOUNT = 1 THEN GOTO NEWDISTRIBUTE;                          02526000
      IF @IPNTR = @DBLPNTR THEN GOTO UPPER;                             02528000
      IF @IPNTR = @DBLPNTR (DBUSED-ISIZE) THEN GOTO LOWER;              02530000
      IF IIPNTR (ISIZE+IECOUNT) <= IIPNTR (-ISIZE+IECOUNT) THEN         02532000
UPPER:   XREG := ISIZE                                                  02534000
      ELSE                                                              02536000
LOWER:   XREG := -ISIZE;                                                02538000
      @IPNTR2 := @IPNTR (XREG);                                         02540000
      TOS := (ZT := IIPNTR (IECOUNT) + IIPNTR2 (XREG) + 1);             02542000
      IF IIPNTR2(IECOUNT) < TEMP THEN                          <<04733>>02544000
        BEGIN                                                  <<04733>>02546000
          OVERRIDE := TRUE;                                    <<04733>>02548000
          TIPNTR := IPNTR;                                     <<04733>>02550000
          TIPNTR2 := IPNTR2;                                   <<04733>>02552000
          TZT := ZT;                                           <<04733>>02554000
        END;                                                   <<04733>>02556000
      IF REAL (TOS & LSR(1)) / REAL (TEMP) < GOODPERCENT THEN           02558000
         << *** DISTRIBUTE AMONG NEIGHBORS *** >>                       02560000
         BEGIN                                                          02562000
CRAM'IT:   IF OVERRIDE THEN                                    <<04733>>02564000
             BEGIN                                             <<04733>>02566000
               IPNTR := TIPNTR;                                <<04733>>02568000
               IPNTR2 := TIPNTR;                               <<04733>>02570000
               ZT := TZT;                                      <<04733>>02572000
             END;                                              <<04733>>02574000
         ZSET;                                                          02576000
         IF @IPNTR > @IPNTR2 THEN                                       02578000
            BEGIN  <<MAKE IPNTR LOWER ONE>>                             02580000
            TOS := @IPNTR2;                                             02582000
            @IPNTR2 := @IPNTR;                                          02584000
            @IPNTR := TOS;                                              02586000
            END;                                                        02588000
         << READ IN LOWER BLOCK >>                                      02590000
         DIRREAD (IPNTR (IEPNTR), A, IPNTR (IECOUNT), DBEMISCWD);       02592000
         << KLUGE TO READ IN UPPER BLOCK RIGHT ON TOP OF LOWER >>       02594000
         DANUMVALID := DBEBSIZE;                                        02596000
         TOS := @DBIOPNTR;                                              02598000
         @DBIOPNTR := @DALPNTR (DAUSED);                                02600000
         DIRREAD (IPNTR2 (IEPNTR), B, IPNTR2 (IECOUNT), DBEMISCWD);     02602000
         @DBIOPNTR := (@DBLPNTR := TOS);                                02604000
         << (KLUGE A'S SIZE FOR ZINSERT) >>                             02606000
         TOS := DAXCOUNT;                                               02608000
         TOS := DAUSED;                                                 02610000
         DAUSED := ZTOTAL-ESIZE;                                        02612000
         DAXCOUNT := ZT-1;                                              02614000
         IF (TEMP := ZINSERT (DDSENTRY, A,  DDS)) = 0 THEN              02616000
            BEGIN                                                       02618000
            DAUSED := TOS;                                              02620000
            DAXCOUNT := TOS;                                            02622000
            DBCONTENTS := 0;                                            02624000
            GOTO DUPNAME;                                               02626000
            END;                                                        02628000
         DBNUMVALID := DANUMVALID;                                      02630000
         ZDISTRIBUTE;                                                   02632000
         MOVE DAPNAME := DBLPNTR, (NAMESIZE);   <<DAPNAME NOT USED>>    02634000
         DIRREAD (INDEXPOINTER, B, 0, 0);                               02636000
         DBETOTAL := NEWPREIETOTAL;                                     02638000
         IF TEMP = @DALPNTR THEN                                        02640000
            MOVE IPNTR := DALPNTR, (NAMESIZE);                          02642000
         IPNTR (IECOUNT) := ZH1;                                        02644000
         MOVE IPNTR2 := DAPNAME, (NAMESIZE);                            02646000
         IPNTR2 (XREG) := ZH2;                                          02648000
         DIRWRITE (B);                                                  02650000
         END                                                            02652000
      ELSE                                                              02654000
NEWDISTRIBUTE:                                                          02656000
         << *** DISTRIBUTE WITH NEW BLOCK *** >>                        02658000
         BEGIN                                                          02660000
         ZT := IPNTR (IECOUNT) +1;                                      02662000
         ZSET;                                                          02664000
         DIRREAD (IPNTR (IEPNTR), A, IPNTR(IECOUNT), DBEMISCWD);        02666000
         TEMP := DIRSCAN (DDSENTRY, ENA);                               02668000
         IF > THEN GOTO DUPNAME;                                        02670000
         @IPNTR2 := @IPNTR+ISIZE;                                       02672000
         XREG := @DALPNTR(ZHALF1);                                      02674000
         IF TEMP <= XREG THEN                                           02676000
            IF < THEN XREG := XREG-DAXSIZE                              02678000
            ELSE XREG := @DDSENTRY;                                     02680000
         TOS := ZNEWENTRYBLOCK (DDS(XREG), IPNTR2);                     02682000
         IPNTR2 (IECOUNT) := ZH2;                                       02684000
         DBETOTAL := NEWPREIETOTAL;                                     02686000
         IPNTR (XREG) := ZH1;                                           02688000
         IF TEMP = @DALPNTR THEN                                        02690000
            MOVE IPNTR := DDSENTRY, (NAMESIZE);                         02692000
         DIRWRITE (B);                                                  02694000
         << *** SET UP NULL BLOCK IN B *** >>                           02696000
         DANUMVALID := DBEBSIZE;    <<PROTECT AGAINST INACCURATE COPYA>>02698000
         DBCONTENTS := TOS;                                             02700000
         @DBLPNTR := @DBIOPNTR;                                         02702000
         DBNUMVALID := DBEBSIZE;                                        02704000
         DBXSIZE := DBEXSIZE;                                           02706000
         DBUSED := 0;                                                   02708000
         DBBFACTOR := (DBBWSIZE := (DBBSIZE := DBEBSIZE) & LSL(7))      02710000
            / DBXSIZE;                                                  02712000
         DBMISCWD := DBEMISCWD;                                         02714000
         DBXCOUNT := 0;                                                 02716000
         ZINSERT (DDSENTRY, A, TEMPP);                                  02718000
         ZDISTRIBUTE;                                                   02720000
         END;                                                           02722000
      END;                                                              02724000
   TOS := 0D;    <<SUCCESSFIL RETURN>>                                  02726000
   CC := CCE;                                                           02728000
EXIT:                                                                   02730000
   DIRINSERT := TOS;                                                    02732000
   END    <<DIRINSERT>>;                                                02734000
DOUBLE PROCEDURE DIRFIND (INDEXPOINTER);                                02736000
   VALUE INDEXPOINTER;                                                  02738000
   LOGICAL INDEXPOINTER;                                                02740000
<< RETURN:                                                              02742000
   HIGH ORDER  =  DB ADDR OF INDEX (IN B).                              02744000
   LOW ORDER   =  DB ADDR OF ENTRY (IN A).    >>                        02746000
BEGIN                                                                   02748000
   DIRREAD (INDEXPOINTER, B, 0, 0);                                     02750000
   TOS := DIRSCAN (DDSENTRY, EPB);                                      02752000
   IF = THEN                                                            02754000
NOTFOUND:                                                               02756000
      BEGIN                                                             02758000
      DIRFIND := 0D;                                                    02760000
      RETURN;                                                           02762000
      END;                                                              02764000
   DIRREAD (S0PNTR(IEPNTR), A, S0PNTR(IECOUNT), DBEMISCWD);             02766000
   TOS := DIRSCAN (DDSENTRY, EA);                                       02768000
   IF <= THEN GOTO NOTFOUND;                                            02770000
   DIRFIND := TOS;                                                      02772000
   END    <<DIRFIND>>;                                                  02774000
                                                                        02776000
PROCEDURE DIRREMOVE (ELEMENT, WHICH);                                   02778000
   VALUE WHICH;                                                         02780000
   LOGICAL WHICH;                                                       02782000
   ARRAY ELEMENT;                                                       02784000
<< DECREMENTS <USED> AND <XCOUNT>;                                      02786000
   REMOVES ELEMENT;                                                     02788000
   DEALLOCATES BLOCK WHEN AN ENTRY BLOCK IS DEPLETED.  >>               02790000
BEGIN                                                                   02792000
   DIRSET (WHICH);                                                      02794000
   WHICHDIRTY := TRUE;                                                  02796000
   IBASE(USED) := IBASE(USED) - IBASE(XSIZE);                           02798000
   IBASE(XCOUNT) := IBASE(XCOUNT)-1;                                    02800000
   IF = THEN                                                            02802000
      BEGIN                                                             02804000
      IF BASE(MISCWD).(TYPEF) = ENTRYTYPE THEN                          02806000
         BEGIN                                                          02808000
         DIRDEALLOCATE (BASE(CONTENTS), BASE(BSIZE));                   02810000
         BASE (CONTENTS) := (WHICHDIRTY := 0);                          02812000
         END;                                                           02814000
      RETURN;                                                           02816000
      END;                                                              02818000
   MOVE ELEMENT := ELEMENT (BASE(XSIZE)),                               02820000
      (IBASE(LPNTR)+IBASE(USED)-@ELEMENT);                              02822000
   END    <<DIRREMOVE>>;                                                02824000
PROCEDURE DIRRESET (NUMSECTS);                                          02826000
   VALUE NUMSECTS;                                                      02828000
   DOUBLE NUMSECTS;                                                     02830000
<< CALLED TO SUBTRACT <NUMSECTS> FROM FATHER (AND GRANDFATHER) WHEN     02832000
   ERROR DETECTED AFTER THEY ARE BUMPED.  ASSUMES B CONTAINS CURRENT    02834000
   INDEX (THUS POINTER TO FATHER)                                       02836000
   >>                                                                   02838000
   WHILE DBPINDEXP <> 0 DO                                              02840000
      BEGIN                                                             02842000
      MOVE DDSNAME := DBPNAME, (NAMESIZE);                              02844000
      TOS := DIRFIND (DBPINDEXP);                                       02846000
      IF DAMISCWD.(LEVELF) = GROUPLEVEL THEN TOS := TOS +GDFSCOUNT      02848000
      ELSE TOS := TOS +ADFSCOUNT;                                       02850000
      DPS0 := DPS0 -NUMSECTS;                                           02852000
      DIRWRITE (A);                                                     02854000
      END;                                                              02856000
                                                                        02858000
DOUBLE PROCEDURE DIRSTARTOFF (PARR, NUMSECTS, RECIP, PARMS);            02860000
   VALUE NUMSECTS, PARMS;                                               02862000
   ARRAY PARR;                         <<DB ADDR OF SPEC PART>>         02864000
   DOUBLE NUMSECTS;                    <<TO ADJUST ACCT/GROUP>>         02866000
   INTEGER PROCEDURE RECIP;            <<FOR VISIT OF @ HIT>>           02868000
   INTEGER PARMS;                      <<FOR VISIT OF @ HIT>>           02870000
   OPTION VARIABLE;                                                     02872000
<<                                                                      02874000
   ANALYZES THE SPECIFICATION PART FOR DIRECTORY ROUTINES, AND          02876000
   GOES DOWN TREE UNTIL JUST BEFORE HIT OF TARGET, LEAVING:             02878000
      ADJUST, XTYPE, XINDEXP, XANAME, XGUNAME, XFNAME, XASEC AND XGSEC; 02880000
      DB THRU DB+3 TO FINAL NAME.                                       02882000
   IF <NUMSECTS> SPECIFIED, THEN IT'S ADDED TO ACCT AND GROUP.          02884000
   IF <RECIP> AND <PARMS> SPECIFIED, THEN @ ENTRY HIT IS VISITED.       02886000
      CARRY SET ON RETURN => RECIP SAID STOP OR DON'T SCAN MY TREE.     02888000
   IF JUST <PARMS> SPECIFIED, THEN S ACCESS TO GROUP CHECKED.           02890000
   TYPE RETURN IS DIRECTORY ERROR PAIR.                                 02892000
   >>                                                                   02894000
BEGIN                                                                   02896000
   LOGICAL PMASK = Q-4;                                                 02898000
   INTEGER IPMASK = PMASK;                                              02900000
   SWITCH STARTSWITCH := NOINDEX, AINDEX, GINDEX, NOINDEX;              02902000
   DEFINE                                                               02904000
      MOVLB1 =                                                          02906000
         TOS := 0;                                                      02908000
         TOS := #,                                                      02910000
      MOVLB2 =                                                          02912000
                +ADJUST;                                                02914000
         TOS := NAMESIZE;                                               02916000
         ASSEMBLE (MVLB) #;                                             02918000
                                                                        02920000
                                                                        02922000
SUBROUTINE VISIT;                                                       02924000
   << S-0 = POINTER TO ENTRY >>                                         02926000
   IF IPMASK.(14:2) = 3 THEN                                            02928000
      BEGIN                                                             02930000
      TOS := 0D;                                                        02932000
      TOS := 0;                                                         02934000
      TOS := @PS4;                                                      02936000
      TOS := DAMISCWD.(LEVELF);                                         02938000
      TOS := PARMS;                                                     02940000
      TOS := DS5;                                                       02942000
      TOS := RECIP (*, *, *, *);  <<VISIT>>                             02944000
      IF TOS &LSR(1) > 0 THEN    <<STOP OR GOTO BROTHER>>               02946000
         BEGIN        <<SO STOP ENTIRE SCAN>>                           02948000
         CARRYX := 1;                                                   02950000
         GOTO OKAYEXIT;                                                 02952000
         END;                                                           02954000
      ASSEMBLE (DDEL);                                                  02956000
      END;                                                              02958000
                                                                        02960000
                                                                        02962000
SUBROUTINE BADEXIT (NUM);                                               02964000
   VALUE NUM;                                                           02966000
   INTEGER NUM;                                                         02968000
BEGIN                                                                   02970000
   TOS := DBELEVEL;                                                     02972000
   TOS := S2;                                                           02974000
   IF PMASK & LSR(2) THEN DIRRESET (NUMSECTS);                          02976000
   GOTO EXIT;                                                           02978000
   END    <<SUBROUTINE BADEXIT>>;                                       02980000
                                                                        02982000
                                                                        02984000
<< >>                                                                   02986000
   PUSH (DL);                                                           02988000
   EXCHANGEDB(DDSDST);                                                  02990000
   ADJUST := -TOS;                                                      02992000
   XASEC := -1;                                                         02994000
   XGSEC := -1D;                                                        02996000
   IF IPMASK.(14:2) = 3 THEN PARMS := PARMS -DELTAQ;                    02998000
   CARRYX := 0;                                                         03000000
   TOS := @WORKAREA+1;                                                  03002000
   TOS := @PARR+ADJUST;                                                 03004000
   TOS := 1;                                                   <<04733>>03006000
   ASSEMBLE (MVLB 1);                                          <<04733>>03008000
   ASSEMBLE (INCB);                                            <<04733>>03010000
   TOS := 4;                                                   <<04733>>03012000
   ASSEMBLE (MVLB);                                                     03014000
   GOTO STARTSWITCH (XTYPE.(STARTLEVELF));                              03016000
NOINDEX:                                                                03018000
   XINDEXP := SYSACCTINDEX;                                             03020000
   IF XTYPE.(ENDLEVELFX) = ALLACCTS THEN GOTO OKAYEXIT;                 03022000
   MOVLB1 XANAME MOVLB2;                                                03024000
   IF XTYPE.(ENDLEVELF) = ACCOUNTLEVEL THEN GOTO OKAYEXIT;              03026000
   TOS := DIRFIND (SYSACCTINDEX);                                       03028000
   ASSEMBLE (DTST, DELB);                                               03030000
                                                                        03032000
   IF = THEN GOTO NONEXIST;                                             03034000
   XASEC := PS0 (ASECW);                                                03036000
   IF PMASK &LSR(2) THEN                                                03038000
      BEGIN    <<BUMP SECTOR COUNT>>                                    03040000
      TOS := TOS +ADFSCOUNT;                                            03042000
      IF (TOS := DPS0 +NUMSECTS) > DPS0(1) THEN GOTO NOROOM;            03044000
      DPS2 := TOS;                                                      03046000
      DIRWRITE (A);                                                     03048000
      TOS := TOS -ADFSCOUNT;                                            03050000
      END;                                                              03052000
   VISIT;                                                               03054000
   CASE XTYPE.(ENDLEVELF) OF                                   <<04733>>03056000
   BEGIN                                                       <<04733>>03058000
       XREG := AGIPNTR;    <<0 : FILE>>                        <<04733>>03060000
       XREG := AGIPNTR;    <<1 : GROUP>>                       <<04733>>03062000
       ;                   <<2 : ACCT>>                        <<04733>>03064000
       XREG := AUIPNTR;    <<3 : USER>>                        <<04733>>03066000
       XREG := AGIPNTR;    <<4 : VSD>>                         <<04733>>03068000
   END;                                                        <<04733>>03070000
   XINDEXP := S0PNTR (XREG);                                            03072000
AINDEX:                                                                 03074000
   MOVLB1 XGUNAME MOVLB2;                                               03076000
   CASE XTYPE.(ENDLEVELF) OF                                   <<04733>>03078000
   BEGIN                                                       <<04733>>03080000
       ; <<KEEP GOING>>    <<0>>                               <<04733>>03082000
       GO TO OKAYEXIT;     <<1>>                               <<04733>>03084000
       ;                   <<2>>                               <<04733>>03086000
       GO TO OKAYEXIT;     <<3>>                               <<04733>>03088000
       ; <<KEEP GOING>>    <<4>>                               <<04733>>03090000
   END;                                                        <<04733>>03092000
   TOS := DIRFIND (XINDEXP);                                            03094000
   ASSEMBLE (DTST, DELB);                                               03096000
                                                                        03098000
   IF = THEN                                                            03100000
NONEXIST:    BADEXIT (2);                                               03102000
   TOS := PS0(GSEC);                                                    03104000
   TOS := PS1(GSEC+1);                                                  03106000
   XGSEC := TOS;                                                        03108000
   IF PMASK & LSR(2) THEN                                               03110000
      BEGIN    <<ADJUST BY NUMSECTS>>                                   03112000
      TOS := TOS +GDFSCOUNT;                                            03114000
      IF (TOS := DPS0 +NUMSECTS) > DPS0(1) THEN                         03116000
NOROOM:    BADEXIT (8);                                                 03118000
      DPS2 := TOS;                                                      03120000
      DIRWRITE (A);                                                     03122000
      TOS := TOS -GDFSCOUNT;                                            03124000
      END;                                                              03126000
   VISIT;                                                               03128000
   CASE XTYPE.(ENDLEVELF) OF                                   <<04733>>03130000
   BEGIN                                                       <<04733>>03132000
       XREG := GFIPNTR;    <<0 : FILE>>                        <<04733>>03134000
       ;                   <<1 : GROUP>>                       <<04733>>03136000
       ;                   <<2 : ACCT>>                        <<04733>>03138000
       ;                   <<3 : USER>>                        <<04733>>03140000
       XREG := GVSDIPNTR;  <<4 : VSD>>                         <<04733>>03142000
   END;                                                        <<04733>>03144000
   XINDEXP := S0PNTR (XREG);                                   <<04733>>03146000
GINDEX:                                                                 03148000
   IF NOT LOGICAL (XTYPE.(ALLFLAG)) THEN                       <<04733>>03150000
      BEGIN                                                             03152000
      MOVLB1 XFNAME MOVLB2;                                             03154000
      END;                                                              03156000
OKAYEXIT:                                                               03158000
   TOS := 0D;                                                           03160000
EXIT:                                                                   03162000
   DIRSTARTOFF := TOS;                                                  03164000
   END    <<SIMPLESTARTOFF>>;                                           03166000
$PAGE                                                                   03168000
$CONTROL SEGMENT=DIRECTORY2                                             03170000
                                                                        03172000
DOUBLE PROCEDURE DIRECINSERT (TYPE, INDEXP, ANAME, GUNAME, FNAME,       03174000
   INSERT);                                                             03176000
   VALUE TYPE, INDEXP;                                                  03178000
   LOGICAL TYPE, INDEXP;                                                03180000
   ARRAY ANAME, GUNAME, FNAME, INSERT;                                  03182000
<< <INSERT> POINTS TO WORD AFTER <NAME> IN THEN ENTRY  (I.E. TO         03184000
   AN INDEXPOINTER OR FILE POINTER CELL).                               03186000
   ALLOCATES AND INITIALIZES APPROPRIATE INDICES FOR ACCOUNT AND GROUP  03188000
   ENTRIES  (THE CORRESPONDING INDEX CELLS OF <INSERT> ARE IGNORED).  >>03190000
    BEGIN                                                               03192000
        ARRAY PARR (*) = TYPE;                                          03194000
        DOUBLE                                                          03196000
            JUNKD;                                                      03198000
        INTEGER                                                         03200000
            JUNK1 = JUNKD,                                              03202000
            JUNK0 = JUNK1+1;                                            03204000
<<>>                                                                    03206000
        DOUBLE SUBROUTINE NEWTREE (LEVEL, IBSIZE, EBSIZE,               03208000
                                   ESIZE, XIPNTR, SD);                  03210000
            VALUE   LEVEL, IBSIZE, EBSIZE, ESIZE, XIPNTR, SD;           03212000
            INTEGER LEVEL, IBSIZE, EBSIZE, ESIZE, XIPNTR, SD;           03214000
            BEGIN                                                       03216000
                DBPINDEXP := XINDEXP;                                   03218000
                MOVE DBPNAME := DDSENTRY ,(NAMESIZE);                   03220000
                TOS := DIRNEWINDEX (IBSIZE,                             03222000
                    LEVEL, EBSIZE, ESIZE);                              03224000
                IF <> THEN                                              03226000
                 IF > THEN HELP ELSE                                    03228000
                 BEGIN                                                  03230000
                     DEL;                                               03232000
                     CC := CCG;                                         03234000
                     JUNK1 := IBSIZE;                                   03236000
                     JUNK0 := 6;                                        03238000
                     NEWTREE := JUNKD;                                  03240000
                 END                                                    03242000
                ELSE                                                    03244000
                BEGIN                                                   03246000
                    EXCHANGEDB (0);                                     03248000
                    INSERT (S3<<XIPNTR>>-NAMESIZE) := TOS;              03250000
                    EXCHANGEDB (DDSDST);                                03252000
                END;                                                    03254000
            END;<<OF NEWTREE>>                                          03256000
                                                                        03258000
                                                                        03260000
        SUBROUTINE RETURNTREE (XIPNTR, IBSIZE);                         03262000
            VALUE   XIPNTR, IBSIZE;                                     03264000
            INTEGER XIPNTR, IBSIZE;                                     03266000
            BEGIN                                                       03268000
                EXCHANGEDB (0);                                         03270000
                TOS := INSERT (XIPNTR-NAMESIZE);                        03272000
                EXCHANGEDB (DDSDST);                                    03274000
                DIRDEALLOCATE (*, S2<<IBSIZE>>);                        03276000
            END;<<OF RETURNTREE>>                                       03278000
                                                                        03280000
                                                                        03282000
        DOUBLE SUBROUTINE INSERTENTRY (LEVEL);                          03284000
            VALUE   LEVEL;                                              03286000
            INTEGER LEVEL;                                              03288000
            BEGIN                                                       03290000
                TOS := NAMESIZE;                                        03292000
                TOS := @INSERT+ADJUST;                                  03294000
                CASE *S3 <<LEVEL>> OF                          <<04733>>03296000
                BEGIN                                                   03298000
                    TOS := FSIZE;                                       03300000
                    TOS := GSIZE;                                       03302000
                    TOS := ASIZE;                                       03304000
                    TOS := USIZE;                                       03306000
                    TOS := GVSDSIZE;                                    03308000
                END;                                                    03310000
                TOS := TOS - NAMESIZE;                                  03312000
                ASMB (MVLB);                                            03314000
                IF (INSERTENTRY := DIRINSERT (XINDEXP)) <> 0D THEN      03316000
                BEGIN  <<NEED TO RETURN DIR SPACE>>                     03318000
                    CASE *LEVEL OF                             <<04733>>03320000
                    BEGIN                                               03322000
                        ;      <<0: FILE>>                              03324000
                        BEGIN  <<1: GROUP>>                             03326000
                            RETURNTREE (GFIPNTR, SYSGFIBSIZE);          03328000
                            RETURNTREE (GVSDIPNTR, SYSGVSIBSIZE);       03330000
                        END;<<OF GROUP>>                                03332000
                        BEGIN  <<2: ACCT>>                              03334000
                            RETURNTREE (AGIPNTR, SYSAGIBSIZE);          03336000
                            RETURNTREE (AUIPNTR, SYSAUIBSIZE);          03338000
                        END;<<OF ACCT>>                                 03340000
                        ;       <<3: USER>>                             03342000
                        ;       <<4: VSD>>                              03344000
                    END;<<OF LEVEL>>                                    03346000
                    CC := CCG;  <<FAILURE>>                             03348000
                END;                                                    03350000
            END;<<OF INSERTENTRY>>                                      03352000
                                                                        03354000
                                                                        03356000
        CC := CCE;  <<OK UNTIL ANY FAILURE>>                            03358000
        TOS := DIRSTARTOFF (PARR);                                      03360000
        ASMB (DTST);                                                    03362000
        IF = THEN                                                       03364000
        BEGIN <<FOUND REQUIRED LEVEL>>                                  03366000
            DDEL;                                                       03368000
            CASE *TYPE.(ENDLEVELF) OF                          <<04733>>03370000
            BEGIN                                                       03372000
                TOS := INSERTENTRY (FILELEVEL);                         03374000
                BEGIN  <<GROUP>>                                        03376000
                    TOS := NEWTREE (FILELEVEL, SYSGFIBSIZE,             03378000
                                    SYSFEBSIZE, FSIZE,                  03380000
                                    GFIPNTR, 405);                      03382000
                    ASMB (DTST);                                        03384000
                    IF = THEN  <<SUCCESSFULL?>>                         03386000
                    BEGIN                                               03388000
                        DDEL;                                           03390000
                        TOS := NEWTREE (VSDEFLEVEL,                     03392000
                             SYSGVSIBSIZE,SYSVSEBSIZE,                  03394000
                             GVSDSIZE,GVSDIPNTR,415);                   03396000
                        ASMB (DTST);                                    03398000
                        IF <> THEN                                      03400000
                         RETURNTREE (GFIPNTR, SYSGFIBSIZE)              03402000
                        ELSE                                            03404000
                        BEGIN                                           03406000
                            DDEL;                                       03408000
                            TOS := INSERTENTRY (GROUPLEVEL);            03410000
                        END;                                            03412000
                    END;                                                03414000
                END;<<OF GROUP>>                                        03416000
                BEGIN  <<ACCT>>                                         03418000
                    TOS := NEWTREE (GROUPLEVEL, SYSAGIBSIZE,            03420000
                                    SYSGEBSIZE, GSIZE, AGIPNTR, 405);   03422000
                    ASMB (DTST);                                        03424000
                    IF = THEN <<SUCCESSFULL?>>                          03426000
                    BEGIN                                               03428000
                        DDEL;                                           03430000
                        TOS := NEWTREE (USERLEVEL, SYSAUIBSIZE,         03432000
                                        SYSUEBSIZE, USIZE,              03434000
                                        AUIPNTR,405);                   03436000
                        ASMB (DTST);                                    03438000
                        IF <> THEN RETURNTREE (AGIPNTR, SYSAGIBSIZE)    03440000
                        ELSE                                            03442000
                        BEGIN <<SUCCESSFULL>>                           03444000
                            DDEL;                                       03446000
                            TOS := INSERTENTRY (ACCOUNTLEVEL);          03448000
                        END;                                            03450000
                    END;                                                03452000
                END;<<OF ACCT>>                                         03454000
                TOS := INSERTENTRY (USERLEVEL);                         03456000
                TOS := INSERTENTRY (VSDEFLEVEL);                        03458000
            END;<<OF ENDLEVEL>>                                         03460000
        END ELSE CC := CCG;                                             03462000
        DIRECINSERT := TOS;                                             03464000
        EXCHANGEDB (0);                                                 03466000
    END;<<OF DIRECINSERT>>                                              03468000
DOUBLE PROCEDURE DIRECINSERTFILE (NUMSECTS, ANAME, GNAME,               03470000
      FNAME, FADDR);                                                    03472000
   VALUE NUMSECTS, FADDR;                                               03474000
   DOUBLE NUMSECTS, FADDR;                                              03476000
   ARRAY ANAME, GNAME, FNAME;                                           03478000
<<                                                                      03480000
   INSERTS FILE ENTRY UNDER ACCT AND GROUP.                             03482000
   INCREMENTS ACCT AND GROUP SPACE COUNTS BY <NUMSECTS>.                03484000
   CHECKS THAT USER HAS SAVE ACCESS TO GROUP.                           03486000
   (ALWAYS GLOBAL ACCESS).                                              03488000
   >>                                                                   03490000
BEGIN                                                                   03492000
   ARRAY PARR (*) = NUMSECTS;                                           03494000
   DOUBLE LNUMSECTS;                                                    03496000
   DOUBLE DDB4 = DB+4;                                                  03498000
<< >>                                                                   03500000
   LNUMSECTS := NUMSECTS;                                               03502000
   NUMSECTS := 0D;                                                      03504000
   IF (TOS := DIRSTARTOFF (PARR, LNUMSECTS, , 0)) <> 0D THEN            03506000
      GOTO BADEXIT;                                                     03508000
   DDB4 := FADDR;                                                       03510000
   TOS := DIRINSERT (XINDEXP);                                          03512000
   ASSEMBLE (DTST);                                                     03514000
   IF <> THEN                                                           03516000
      BEGIN                                                             03518000
      DIRRESET (LNUMSECTS);                                             03520000
BADEXIT:                                                                03522000
      TOS := CCG;                                                       03524000
      END                                                               03526000
   ELSE                                                                 03528000
      TOS := CCE;                                                       03530000
   CC := TOS;                                                           03532000
   DIRECINSERTFILE := TOS;                                              03534000
   EXCHANGEDB (0);                                                      03536000
   END    <<PROCEDURE DIRECINSERTFILE>>;                                03538000
DOUBLE PROCEDURE DIRECFIND (TYPE, INDEXP, ANAME, GUNAME, FNAME,         03540000
   PRETURN);                                                            03542000
   VALUE TYPE, INDEXP;                                                  03544000
   INTEGER TYPE, INDEXP;                                                03546000
   ARRAY ANAME, GUNAME, FNAME, PRETURN;                                 03548000
<< <PRETURN> WILL CONTAIN FULL FINAL ENTRY .  >>                        03550000
BEGIN                                                                   03552000
   LOGICAL LTYPE = TYPE;                                                03554000
                                                                        03556000
   ARRAY PARR (*) = TYPE;                                               03558000
   IF (TOS := DIRSTARTOFF (PARR)) <> 0D THEN GOTO BADEXIT;              03560000
   ASSEMBLE (DDEL);                                                     03562000
   TOS := @PRETURN+ADJUST;                                              03564000
   TOS := DIRFIND (XINDEXP);                                            03566000
   ASSEMBLE (DTST, DELB);                                               03568000
   IF = THEN                                                            03570000
      BEGIN                                                             03572000
      DDEL;                                                             03574000
      TOS := LTYPE.(ENDLEVELF);                                         03576000
      TOS := 2;                                                         03578000
BADEXIT:                                                                03580000
      TOS := CCG;                                                       03582000
      GOTO EXIT;                                                        03584000
      END;                                                              03586000
   CASE TYPE.(ENDLEVELF) OF                                    <<04733>>03588000
      BEGIN                                                             03590000
      TOS := FSIZE;                                                     03592000
      TOS := GSIZE;                                                     03594000
      TOS := ASIZE;                                                     03596000
      TOS := USIZE;                                                     03598000
      TOS := GVSDSIZE;                                         <<04733>>03600000
      END;                                                              03602000
   ASSEMBLE (MVBL);                                                     03604000
   TOS := 0D;                                                           03606000
   TOS := CCE;                                                          03608000
EXIT:                                                                   03610000
   CC := TOS;                                                           03612000
   DIRECFIND := TOS;                                                    03614000
   EXCHANGEDB (0);                                                      03616000
   END    <<DIRECFIND>>;                                                03618000
                                                                        03620000
DOUBLE PROCEDURE DIRECFINDFILE (TYPE, INDEXP, ANAME, GNAME,             03622000
      FNAME, PRETURN);                                                  03624000
   VALUE TYPE, INDEXP;                                                  03626000
   LOGICAL TYPE, INDEXP;                                                03628000
   ARRAY ANAME, GNAME, FNAME, PRETURN;                                  03630000
<< RETURNS IN <PRETURN> THEN FILE POINTER; AND ASEC/GSEC                03632000
      DEPENDING ON THE TYPE OF SEARCH. >>                               03634000
BEGIN                                                                   03636000
   ARRAY PARR (*) = TYPE;                                               03638000
   IF (TOS := DIRSTARTOFF (PARR)) <> 0D THEN GOTO BADEXIT;              03640000
   << 2 ZEROES ON STACK >>                                              03642000
   TOS := DIRFIND (XINDEXP);                                            03644000
   ASSEMBLE (DTST, DELB);                                               03646000
   IF = THEN                                                            03648000
      BEGIN                                                             03650000
      << 2 ZEROS ON STACK >>                                            03652000
      TOS := TOS +2;                                                    03654000
BADEXIT:                                                                03656000
      EXCHANGEDB (0);                                                   03658000
      TOS := CCG;                                                       03660000
      GOTO EXIT;                                                        03662000
      END;                                                              03664000
   TOS := DPS0(2);                                                      03666000
   TOS := XGSEC;                                                        03668000
   TOS := XASEC;                                                        03670000
   EXCHANGEDB (0);                                                      03672000
   TOS := @PRETURN;                                                     03674000
   TOS := @S5;                                                          03676000
   IF INTEGER (TYPE.(STARTLEVELF)) = 1 THEN TOS := 4                    03678000
   ELSE IF < THEN TOS := 5                                              03680000
      ELSE TOS := 2;                                                    03682000
   ASSEMBLE (MOVE);                                                     03684000
   ASSEMBLE (SUBS 6);                                                   03686000
   TOS := CCE;                                                          03688000
EXIT:                                                                   03690000
   CC := TOS;                                                           03692000
   DIRECFINDFILE := TOS;                                                03694000
   END    <<PROCEDURE DIRECFINDFILE>>;                                  03696000
DOUBLE PROCEDURE DIRECPURGE (TYPE, INDEXP, ANAME, GUNAME, FNAME);       03698000
   VALUE TYPE, INDEXP;                                                  03700000
   INTEGER TYPE, INDEXP;                                                03702000
   ARRAY ANAME, GUNAME, FNAME;                                          03704000
                                                                        03706000
<< GENERAL PURGE ROUTINE                                                03708000
DOUBLE PROCEDURE DIRECPURGEFILE                                         03710000
      (NUMSECTS, ANAME, GNAME, FNAME);                                  03712000
   VALUE NUMSECTS;                                                      03714000
   DOUBLE NUMSECTS;                                                     03716000
   ...                                                                  03718000
   PURGE FILE ENTRY AND ADJUST ACCT & GROUP SPACE COUNTS                03720000
   BY <NUMSECTS>.                                                       03722000
   >>                                                                   03724000
BEGIN                                                                   03726000
   ENTRY DIRECPURGEFILE;                                                03728000
   ARRAY PARR (*) = TYPE;                                               03730000
   DOUBLE NUMSECTS = TYPE;                                              03732000
   DOUBLE LNUMSECTS;                                                    03734000
   LOGICAL FFLAG := FALSE;                                              03736000
   DOUBLE GROUPSPACEGONE := 0D;                                         03738000
                                                                        03740000
                                                                        03742000
   TOS := DIRSTARTOFF (PARR);                                           03744000
   GOTO START;                                                          03746000
                                                                        03748000
                                                                        03750000
DIRECPURGEFILE:                                                         03752000
   FFLAG := TRUE;                                                       03754000
   LNUMSECTS := NUMSECTS;                                               03756000
   NUMSECTS := 0D;                                                      03758000
   TOS := DIRSTARTOFF (PARR, LNUMSECTS);                                03760000
                                                                        03762000
                                                                        03764000
START:                                                                  03766000
   IF DS1 <> 0D THEN GOTO BADEXIT;                                      03768000
   ASSEMBLE (DDEL);                                                     03770000
   TOS := DIRFIND (XINDEXP);                                            03772000
   ASSEMBLE (DTST);                                                     03774000
   IF = THEN                                                            03776000
      BEGIN                                                             03778000
      DDEL;                                                             03780000
      TOS := TYPE.(ENDLEVELF);                                          03782000
      TOS := 2;                                                         03784000
      GOTO BADEXIT0;                                                    03786000
      END;                                                              03788000
   ASSEMBLE (DDUP, ZROB);                                               03790000
   ASSEMBLE (DUP, ZROB);                                                03792000
         DIRREMOVE (*, A);                                              03794000
         ASSEMBLE (NEG, DDEL);    <<SET CARRY>>                         03796000
   IF DADIRTY THEN DIRWRITE (A);                                        03798000
   IF CARRY THEN                                                        03800000
      BEGIN                                                             03802000
      XREG := IECOUNT;                                                  03804000
      DBETOTAL := DBETOTAL-1;                                           03806000
      IF TOS = @DALPNTR THEN                                            03808000
         BEGIN                                                          03810000
         ASSEMBLE (DUP);                                                03812000
         MOVE * := DALPNTR, (NAMESIZE);                                 03814000
         END;                                                           03816000
      S0IPNTR(XREG) := S0IPNTR(XREG)-1;                                 03818000
      IF = THEN                                                         03820000
         BEGIN                                                          03822000
         DIRREMOVE (*, B);                                              03824000
         TOS := 0;                                                      03826000
         END;                                                           03828000
      ASSEMBLE (ZERO, ZROB);                                            03830000
      TOS := CCE;                                                       03832000
      DIRWRITE (B);                                                     03834000
      END                                                               03836000
   ELSE                                                                 03838000
      BEGIN                                                             03840000
      ASSEMBLE (ZROB, DEL);                                             03842000
      TOS := 7;                                                         03844000
BADEXIT0:                                                               03846000
      IF FFLAG THEN DIRRESET (LNUMSECTS);                               03848000
BADEXIT:                                                                03850000
      TOS := CCG;                                                       03852000
      END;                                                              03854000
   CC := TOS;                                                           03856000
   DIRECPURGE := TOS;                                                   03858000
   TOS := GROUPSPACEGONE;                                               03860000
   IF <> THEN DIRRESET (*) ELSE ASSEMBLE (DDEL);                        03862000
   EXCHANGEDB (0);                                                      03864000
   END    <<DIRECPURGE>>;                                               03866000
DOUBLE PROCEDURE DIRECADJUST (NUMSECTS, ANAME, GNAME);                  03868000
   VALUE NUMSECTS;                                                      03870000
   DOUBLE NUMSECTS;                                                     03872000
   ARRAY ANAME, GNAME;                                                  03874000
<< ADJUSTS THA ACCT AND GROUP SPACE COUNTS BY NUMSECTS >>               03876000
BEGIN                                                                   03878000
   ARRAY PARR (*) = NUMSECTS;                                           03880000
   DOUBLE LNUMSECTS;                                                    03882000
   LNUMSECTS := NUMSECTS;                                               03884000
   TOS := %40;                                                          03886000
   TOS := 0;                                                            03888000
   NUMSECTS := TOS;                                                     03890000
   IF (DIRECADJUST := DIRSTARTOFF (PARR, LNUMSECTS)) <> 0D THEN         03892000
      TOS := CCG                                                        03894000
   ELSE TOS := CCE;                                                     03896000
   CC := TOS;                                                           03898000
   EXCHANGEDB (0);                                                      03900000
   END    <<PROCEDURE DIRECADJUST>>;                                    03902000
LOGICAL PROCEDURE DIRDOENTRY (ELEMENT, LEAFLEVEL, RECIP, PARMS,         03904000
   GETSIRRESULT);                                                       03906000
   VALUE LEAFLEVEL, PARMS, GETSIRRESULT;                                03908000
   ARRAY ELEMENT;                                                       03910000
   INTEGER LEAFLEVEL, PARMS, GETSIRRESULT;                              03912000
   INTEGER PROCEDURE RECIP;                                             03914000
   OPTION FORWARD;                                                      03916000
PROCEDURE DIRSCANTREE (INDEX, LEAFLEVEL, RECIP, PARMS, GETSIRRESULT);   03918000
   VALUE INDEX, LEAFLEVEL, PARMS, GETSIRRESULT;                         03920000
   INTEGER INDEX, LEAFLEVEL, PARMS, GETSIRRESULT;                       03922000
   INTEGER PROCEDURE RECIP;                                             03924000
BEGIN                                                                   03926000
   INTEGER POINTER                                                      03928000
      IP,                                                               03930000
      EP;                                                               03932000
   DOUBLE POINTER                                                       03934000
      DIP = IP,                                                         03936000
      DEP = EP,                                                         03938000
      DDBLPNTR = DBLPNTR;                                               03940000
   DOUBLE ARRAY DDDSENTRY (*) = DDSENTRY;                               03942000
<< >>                                                                   03944000
   DIRREAD (INDEX, B, 0, 0);     << GET TREE >>                         03946000
   DBPCOUNT := DBPCOUNT +1;      << MARK AS UNDELETABLE >>              03948000
   DIRWRITE (B);                                                        03950000
   TOS := DDBLPNTR;              << START SCAN: INITIAL NAME >>         03952000
   TOS := DDBLPNTR (1) & DLSL (1) & DLSR (1);                           03954000
   PARMS := PARMS -DELTAQ;                                              03956000
                                                                        03958000
NEXTNAME:                                                               03960000
   << INDEX IN BLOCK B; TARGET NAME ON TOS >>                           03962000
   DDDSENTRY (1) := TOS;                                                03964000
   DDDSENTRY := TOS;                                                    03966000
   @IP := DIRSCAN (DDSENTRY, EPB);  << FIND CONTAINING BLOCK >>         03968000
   IF = THEN                                                            03970000
      BEGIN                                                             03972000
      @IP := DIRSCAN(DDSENTRY,ENB);                                     03974000
      IF = THEN GOTO LEAVE;                                             03976000
   END;                                                                 03978000
NEXTBLOCK:                                                              03980000
   DIRREAD (IP (IEPNTR), A, IP (IECOUNT), DBEMISCWD);                   03982000
   @EP := DIRSCAN (DDSENTRY, ENA);  << FIND ENTRY IN BLOCK >>           03984000
   IF = THEN                                                            03986000
      BEGIN                      << NOT IN ENTRY BLOCK >>               03988000
      IF (@IP := @IP +DBXSIZE) >= @DBLPNTR +DBUSED THEN GOTO LEAVE;     03990000
      GOTO NEXTBLOCK;                                                   03992000
      END;                                                              03994000
   TOS := DEP;                                                          03996000
   TOS := DEP (1) & DLSL (1) & DLSR (1);                                03998000
   ASSEMBLE (INCA);              << NEXT TARGET NAME >>                 04000000
   TOS := DIRDOENTRY (EP, LEAFLEVEL, RECIP, PARMS, GETSIRRESULT);       04002000
   << DIRECTORY MAY BE COMPLETELY MODIFIED, EXCEPT THAT                 04004000
      INDEX BLOCK <INDEX> STILL EXISTS.     THE DIRECTORY IS LOCKED >>  04006000
   DIRREAD (INDEX, B, 0, 0);                                            04008000
   IF NOT (TOS) THEN GOTO NEXTNAME;                                     04010000
                                                                        04012000
LEAVE:                                                                  04014000
   DBPCOUNT := DBPCOUNT-1; <<ALLOW DELETION OF INDEX>>                  04016000
   DIRWRITE (B);                                                        04018000
   END    <<DIRSCANTREE>>;                                              04020000
LOGICAL PROCEDURE DIRDOENTRY (ELEMENT, LEAFLEVEL, RECIP, PARMS,         04022000
   GETSIRRESULT);                                                       04024000
   VALUE LEAFLEVEL, PARMS, GETSIRRESULT;                                04026000
   ARRAY ELEMENT;                                                       04028000
   INTEGER LEAFLEVEL, PARMS, GETSIRRESULT;                              04030000
   INTEGER PROCEDURE RECIP;                                             04032000
BEGIN                                                                   04034000
<< >>                                                                   04036000
   XREG := 0;                                                  <<04733>>04038000
   CASE DAMISCWD.(LEVELF) OF  <<CURRENT SUBTREE>>              <<04733>>04040000
   BEGIN                                                       <<04733>>04042000
       ;                                               <<0>>   <<04733>>04044000
       XREG := IF LEAFLEVEL = FILELEVEL THEN GFIPNTR   <<1>>   <<04733>>04046000
                                         ELSE GVSDIPNTR;       <<04733>>04048000
       CASE LEAFLEVEL OF                               <<2>>   <<04733>>04050000
       BEGIN                                                   <<04733>>04052000
           XREG := AGIPNTR;   <<0>>                            <<04733>>04054000
           XREG := AGIPNTR;   <<1>>                            <<04733>>04056000
           ;                  <<2>>                            <<04733>>04058000
           XREG := AUIPNTR;   <<3>>                            <<04733>>04060000
           XREG := AGIPNTR;   <<4>>                            <<04733>>04062000
       END;                                                    <<04733>>04064000
       ;                                               <<3>>   <<04733>>04066000
       ;                                               <<4>>   <<04733>>04068000
   END;                                                        <<04733>>04070000
   TOS := DAMISCWD.(LEVELF);                                            04072000
   TOS := 0;                     << GET READY FOR VISIT VIA RECIP >>    04074000
   TOS := @ELEMENT;                                                     04076000
   TOS := S2;                                                           04078000
   TOS := (PARMS := PARMS -DELTAQ);                                     04080000
          TOS := 0;                                                     04082000
   TOS := GETSIRRESULT;                                                 04084000
   TOS := RECIP (*, *, *, *);    << VISIT ENTRY >>                      04086000
   IF TOS & LSR(1) > 1 THEN                                             04088000
      DIRDOENTRY := 1;           << STOP SCAN >>                        04090000
   IF < THEN                     << CONTINUE SCAN >>                    04092000
      IF TOS <> LEAFLEVEL THEN                                          04094000
         DIRSCANTREE (                                                  04096000
            ELEMENT (XREG),                                    <<04733>>04098000
            LEAFLEVEL, RECIP, PARMS, GETSIRRESULT);                     04100000
   END    <<DIRDOENTRY>>;                                               04102000
DOUBLE PROCEDURE DIRECSCAN (TYPE, INDEXP, ANAME, GUNAME, FNAME,         04104000
   RECIP, PARMS);                                                       04106000
   VALUE TYPE, INDEXP;                                                  04108000
   INTEGER TYPE, INDEXP;                                                04110000
   INTEGER PROCEDURE RECIP;                                             04112000
   ARRAY ANAME, GUNAME, FNAME, PARMS;                                   04114000
BEGIN                                                                   04116000
   ARRAY PARR (*) = TYPE;                                               04118000
   LOGICAL SAVESIR;                                                     04120000
LOGICAL LTYPE = TYPE;                                                   04122000
<< >>                                                                   04124000
                                                                        04126000
                                                                        04128000
   TOS := @PARMS;                                                       04130000
   PUSH (Q);                                                            04132000
   @PARMS := TOS -TOS;                                                  04134000
   IF LTYPE.(HITFLAG) THEN                                              04136000
      TOS := DIRSTARTOFF (PARR, , RECIP, @PARMS)                        04138000
   ELSE TOS := DIRSTARTOFF (PARR);                                      04140000
   SAVESIR := SIRRETURN;                                                04142000
   IF DS1 <> 0D THEN GOTO BADEXIT;                                      04144000
   IF CARRY THEN GOTO GOODEXIT;                                         04146000
   << (2 ZEROS ON STACK) >>                                             04148000
   IF LOGICAL (TYPE.(ALLFLAG)) THEN                                     04150000
      DIRSCANTREE (XINDEXP, TYPE.(TOLEVELF), RECIP, @PARMS,             04152000
         SAVESIR)                                                       04154000
   ELSE                                                                 04156000
      BEGIN                                                             04158000
      TOS := XINDEXP;            << MAKE USE OF 2 ZEROS >>              04160000
      TOS := DIRFIND (*);        << VISIT ROOT >>                       04162000
      ASSEMBLE (DTST, ZROB);     << SETUP FOR DIRDOENTRY >>             04164000
      IF = THEN                                                         04166000
         BEGIN                                                          04168000
         ASSEMBLE (DDEL);                                               04170000
         TOS := TYPE.(ENDLEVELF);                                       04172000
         TOS := 2;                                                      04174000
BADEXIT: TOS := CCG;                                                    04176000
         GOTO EXIT;                                                     04178000
         END;                                                           04180000
      DIRDOENTRY (*, TYPE.(TOLEVELF), RECIP, @PARMS, SAVESIR);          04182000
      TOS := 0D;                                                        04184000
      END;                                                              04186000
                                                                        04188000
GOODEXIT:                                                               04190000
   IF DADIRTY THEN DIRWRITE (A);                                        04192000
   IF DBDIRTY THEN DIRWRITE (B);                                        04194000
   TOS := CCE;                                                          04196000
EXIT:                                                                   04198000
   CC := TOS;                                                           04200000
   DIRECSCAN := TOS;                                                    04202000
   EXCHANGEDB (0);                                                      04204000
   END    <<DIRECSCAN>>;                                                04206000
          <<--------------------                                        04208000
            CLEAN UP DIRECTORY                                          04210000
          -------------------->>                                        04212000
  INTEGER PROCEDURE DIRECTORYCLEAN(ELEMENT,LEVEL,PARMS,GARBAGE);        04214000
    VALUE LEVEL,PARMS,GARBAGE;                                          04216000
    ARRAY ELEMENT;                                                      04218000
    INTEGER LEVEL,PARMS;                                                04220000
    DOUBLE GARBAGE;                                                     04222000
    COMMENT                                                             04224000
      SCAN DIRECTORY AND PERFORM THE FOLLOWING ACTIONS:                 04226000
    AT ACCOUNT LEVEL -                                                  04228000
       RESET COUNT OF # LOGGED ON IN INDEX BLOCK                        04230000
       IF RELOAD OR RECOVERY RESET FILE SPACE COUNT                     04232000
    AT GROUP LEVEL -                                                    04234000
       SAME ACTIONS AS ACCOUNT LEVEL                                    04236000
    AT FILE LEVEL -                                                     04238000
       ACCOUNTSONLY RELOAD: PURGE FILE                                  04240000
       RELOAD: SET BIT 8 OF FIRST WORD OF DISC ADDRESS                  04242000
       RECOVERY: REMOVE DISC SPACE FOR FILE. IF ANY PART OF IT          04244000
                 OVERLAPS A DELETED TRACK, PURGE THE FILE. OTHERWISE    04246000
                 ADJUST THE ACCOUNT AND GROUP FILE SPACE COUNTS;        04248000
      BEGIN                                                             04250000
                                                               <<SY>>   04252000
        EXT'DCL;                                               <<SY>>   04254000
        INTEGER POINTER DTT;                                   <<04772>>04256000
        BYTE    POINTER BBUF;                                  <<04772>>04258000
        DOUBLE  POINTER FLABDBL;                               <<04772>>04260000
                                                               <<SY>>   04262000
        INTEGER ARRAY ARQ(*)=Q+0;                                       04264000
        DOUBLE ARRAY DELEMENT(*)=ELEMENT;                               04266000
        DOUBLE POINTER DELEMENTP1;                                      04268000
        LOGICAL LEN, NSECT;                                             04270000
        DOUBLE FILEADR,DISCADR=FILEADR,FSECT;                           04272000
        DOUBLE SECTORS;                                                 04274000
        INTEGER DISCADR0=DISCADR;                                       04276000
        BYTE POINTER BFLAB;                                             04278000
        INTEGER I,J,K,VOLUME,LDEV;                                      04280000
        INTEGER TYPE,SUBTYP,AREA'LDEV;                         <<04733>>04282000
        DOUBLE SIZE;                                           <<04733>>04284000
        INTEGER ERR'CODE;                                      <<SY>>   04286000
                                                               <<04733>>04288000
        EQUATE  VTABSIZE          =  14,                       <<SY>>   04290000
                VTAB12            =  12,                       <<SY>>   04292000
                REL               =   4,                       <<SY>>   04294000
                LDTSIZE           =   5,                       <<SY>>   04296000
                LPDTSIZE          =   2,                       <<SY>>   04298000
                LPDT1             =   1,                       <<SY>>   04300000
                LDT2              =   2;                       <<SY>>   04302000
                                                               <<SY>>   04304000
        DEFINE  TYP               =  (10:6) #,                 <<SY>>   04306000
                SUBTYPE           =  (12:4) #,                 <<SY>>   04308000
                FLNUMEXTS         =  FLAB'(39).(11:5) #,       <<SY>>   04310000
                EXT0              =  22 #,                     <<SY>>   04312000
                VTABLDEV          =  (0:8)  #;                 <<SY>>   04314000
                                                               <<SY>>   04316000
                                                               <<04733>>04318000
SUBROUTINE REMOVE(ERR'CODE);                                   <<04733>>04320000
VALUE ERR'CODE;                                                <<04733>>04322000
INTEGER                                                        <<04733>>04324000
   ERR'CODE;        << INDICATES REASON FOR PURGE >>           <<04733>>04326000
                                                               <<04733>>04328000
COMMENT                                                        <<04733>>04330000
PURGE THE DIRECTORY ENTRY FOR A FILE.  PRINT THE FILE NAME     <<04733>>04332000
AND REASON FOR PURGING.                                        <<04733>>04334000
                                                               <<04733>>04336000
;                                                              <<04733>>04338000
BEGIN                                                          <<04733>>04340000
                                                               <<04733>>04342000
<< IF NO FILES PURGED YET, PRINT HEADER:  FOLLOWING FILES >>   <<04733>>04344000
<< PURGED--DISC ERRORS                                    >>   <<04733>>04346000
                                                               <<04733>>04348000
IF ARQ(PARMS+1) = 0 THEN MESSAGE(2280);                        <<04733>>04350000
                                                               <<04733>>04352000
ARQ(PARMS+1) := ARQ(PARMS+1) + 1;                              <<04733>>04354000
PRINTFNR(ARQ(PARMS+2),ERR'CODE);                               <<04733>>04356000
                                                               <<04733>>04358000
TOS := DIRECPURGE(FILETYPE,0,ARQ(PARMS+10),ARQ(PARMS+6),       <<04733>>04360000
                  ARQ(PARMS+2));                               <<04733>>04362000
IF <> THEN DIRERROR(*,BBUF);                                   <<04733>>04364000
                                                               <<04733>>04366000
DDEL;                                                          <<04733>>04368000
END;   << REMOVE >>                                            <<04733>>04370000
                                                               <<04733>>04372000
INTEGER SUBROUTINE CHECK'DATA'LOST(FLABEL);                    <<04733>>04374000
VALUE FLABEL;                                                  <<04733>>04376000
LOGICAL                                                        <<04733>>04378000
   FLABEL;     << IF TRUE, DISCADR AND LEN POINT AT  >>        <<04733>>04380000
               <<     A FILE LABEL                   >>        <<04733>>04382000
COMMENT                                                        <<04733>>04384000
CHECK IF THE DISC AREA BEGINNING AT DISCADR, OF LENGTH LEN     <<04733>>04386000
OVERLAPS AN AREA OF THE DISC WHICH LOST DATA                   <<04733>>04388000
DURING SPARING.  IF FLABEL IS TRUE, DO FURTHER CHECKS TO SEE   <<04733>>04390000
IF THE AREA OVERLAPS A DELETED TRACK OR IF THE FILE LABEL OR   <<04733>>04392000
FILE LABEL CHECKSUM IS BAD.  WE DO NOT CHECK FILE EXTENTS      <<04733>>04394000
TO SEE IF THEY OVERLAP DELETED TRACKS BECAUSE THIS IS TAKEN    <<04733>>04396000
CARE OF WHEN WE TRY TO REMOVE THE DISC SPACE FOR THE EXTENT.   <<04733>>04398000
IF ANY OF THESE ERRORS ARE FOUND, RETURN AN ERROR NUMBER.      <<04733>>04400000
OTHERWISE RETURN ZERO.  THE RETURNS ARE:                       <<04733>>04402000
                                                               <<04733>>04404000
                0   NO ERROR                                   <<04733>>04406000
                4   FILE LABEL CHECKSUM ERROR                  <<04733>>04408000
                6   ON DELETED OR NEWLY REASSIGNED AREA        <<04733>>04410000
                7   BAD FILE LABEL                             <<04733>>04412000
;                                                              <<04733>>04414000
BEGIN                                                          <<04733>>04416000
CHECK'DATA'LOST := 0;     << INITIALIZE RETURN >>              <<04733>>04418000
                                                               <<04733>>04420000
<< SEE IF THE AREA OVERLAPS A NEWLY REASSIGNED AREA    >>      <<04733>>04422000
<< (AN AREA WHERE DATA WAS JUST LOST)                  >>      <<04733>>04424000
                                                               <<04733>>04426000
J := 1;                                                        <<04733>>04428000
WHILE GET'AREA(REASSIGNED',J,NREASS+1,AREA'LDEV,FSECT,SIZE) DO <<SS>>   04430000
   BEGIN                                                       <<04733>>04432000
   IF LDEV = AREA'LDEV THEN                                    <<04733>>04434000
      IF FSECT < (DISCADR + DOUBLE(LEN)) AND                   <<04733>>04436000
         (FSECT + SIZE) > DISCADR THEN                         <<04733>>04438000
         BEGIN                                                 <<04733>>04440000
         CHECK'DATA'LOST := 6;                                 <<04733>>04442000
         RETURN;                                               <<04733>>04444000
         END;                                                  <<04733>>04446000
   J := J+1;                                                   <<04733>>04448000
   END;                                                        <<04733>>04450000
                                                               <<04733>>04452000
IF NOT FLABEL THEN RETURN;      << NOT A FILE LABEL >>         <<04733>>04454000
                                                               <<04733>>04456000
<< IF THE SPACE IS ON A TYPE 0 OR TYPE 1 DISC, CHECK THE >>    <<04733>>04458000
<< DTT TO SEE IF IT OVERLAYS A DELETED TRACK.            >>    <<04733>>04460000
                                                               <<04733>>04462000
TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;                            <<04733>>04464000
SUBTYP := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;                   <<04733>>04466000
                                                               <<04733>>04468000
IF TYPE = DISC0 OR TYPE = DISC1 THEN                           <<04733>>04470000
   BEGIN                                                       <<04733>>04472000
   DISC(READ,LDEV,1D,DTT,128);   << GET THE DTT >>             <<04733>>04474000
   J := 0;                                                     <<04733>>04476000
   WHILE (J:=J+1) <= DTT(0) DO                                 <<04733>>04478000
      IF DTT(J).(14:2) = 2 THEN                                <<04733>>04480000
         BEGIN           << DELETED TRACK >>                   <<04733>>04482000
         NSECT := IF TYPE = DISC0 THEN                         <<04733>>04484000
                     MHINFO'(SUBTYP*MHINFOSIZE+MHSECTRK)       <<SS>>   04486000
                  ELSE                                         <<04733>>04488000
                     32;                                       <<04733>>04490000
         FSECT := NSECT**LOGICAL(DTT(J)&LSR(2));               <<04733>>04492000
                                                               <<04733>>04494000
         IF FSECT < (DISCADR+DOUBLE(LEN)) AND                  <<04733>>04496000
            (FSECT + DOUBLE(NSECT)) > DISCADR THEN             <<04733>>04498000
            BEGIN                                              <<04733>>04500000
            CHECK'DATA'LOST := 6;                              <<04733>>04502000
            RETURN;                                            <<04733>>04504000
            END;                                               <<04733>>04506000
         END;                                                  <<04733>>04508000
   END;                                                        <<04733>>04510000
                                                               <<04733>>04512000
IF ARQ(PARMS+4) < 0 THEN                                       <<04733>>04514000
   BEGIN                        << BAD FILE LABEL >>           <<04733>>04516000
   CHECK'DATA'LOST := 7;                                       <<04733>>04518000
   RETURN;                                                     <<04733>>04520000
   END;                                                        <<04733>>04522000
                                                               <<04733>>04524000
<< WAIT TILL NOW TO READ THE FILE LABEL BECAUSE IT MIGHT >>    <<04733>>04526000
<< HAVE BEEN FOUND ABOVE TO OVERLAP A DELETED TRACK.     >>    <<04733>>04528000
                                                               <<04733>>04530000
DISC (READ,LDEV,DISCADR,FLAB',128);  <<Read the file label>>   <<SS>>   04532000
CHECKSUM;            << CHECK FOR FILE LABEL CHECKSUM ERROR >> <<04733>>04534000
IF TOS <> FLCHECKSUM THEN     << LABEL MUST BE IN 'FLAB' >>    <<04733>>04536000
   BEGIN                                                       <<04733>>04538000
   CHECK'DATA'LOST := 4;                                       <<04733>>04540000
   RETURN;                                                     <<04733>>04542000
   END;                                                        <<04733>>04544000
                                                               <<04733>>04546000
END;   << CHECK'DATA'LOST >>                                   <<04733>>04548000
                                                               <<04733>>04550000
          EXCHANGEDB(0);               << Initialize these   >><<04772>>04552000
          @DTT     :=  @LBUF' (128);   << 3 vars. w/o split  >><<04772>>04554000
          @BBUF    :=  @BUF';          << stck bcause of ex- >><<04772>>04556000
          @FLABDBL :=  @FLAB';         << ternal globals:    >><<04772>>04558000
          EXCHANGEDB(DDSDST);          << LBUF',BUF',& FLAB' >><<04772>>04560000
                                                               <<04772>>04562000
          PARMS := PARMS-ARQ;                                           04564000
                                                               <<04733>>04566000
                                                               <<04733>>04568000
          IF LEVEL=ACCOUNTLEVEL THEN                                    04570000
            BEGIN   <<ACCOUNT ENTRY>>                                   04572000
              DIRREAD(ELEMENT(AGIPNTR),B,0,0); <<READ INDEX BLOCK>>     04574000
              IF DBPCOUNT<>0 THEN                                       04576000
                BEGIN  <<RESET COUNT OF # OF PEOPLE LOGGED ON>>         04578000
                  DBPCOUNT := 0;                                        04580000
                  DBDIRTY := TRUE;                                      04582000
                END;                                                    04584000
              IF ARQ(PARMS) >= REL OR ARQ(PARMS+14) <> 0 THEN           04586000
                BEGIN  <<RELOAD OR RECOVERY>>                           04588000
                  DELEMENT(ADFSCOUNTD) := 0D;                           04590000
                  DADIRTY := TRUE;                                      04592000
                  MOVE ARQ(PARMS+10) := ELEMENT,(4);                    04594000
                END;                                                    04596000
            END                                                         04598000
          ELSE IF LEVEL=GROUPLEVEL THEN                                 04600000
            BEGIN  <<GROUP ENTRY>>                                      04602000
              IF LOGICAL (ELEMENT (GLINKAGE).(PVF))            <<04733>>04604000
                 AND ELEMENT (X).(MVTABXF) <> 0 THEN           <<04733>>04606000
              BEGIN  <<RESET MVTABX & RESTORE GFIPNTR>>        <<04733>>04608000
                  ELEMENT (X).(MVTABXF) := 0;                  <<04733>>04610000
                  IF ELEMENT (GSAVEFIPNTR) <> 0 THEN           <<04733>>04612000
                   ELEMENT (GFIPNTR) := ELEMENT (GSAVEFIPNTR); <<04733>>04614000
                  ELEMENT (GSAVEFIPNTR) := 0;                  <<04733>>04616000
                  ELEMENT (GMOUNTREFCNTR) := 0;                <<04733>>04618000
                  DADIRTY := TRUE;                             <<04733>>04620000
              END;                                             <<04733>>04622000
              DIRREAD(ELEMENT(GVSDIPNTR),B,0,0); <<VSD INDEX>> <<04733>>04624000
              IF DBPCOUNT<>0 THEN                              <<04733>>04626000
                BEGIN                                          <<04733>>04628000
                  DBPCOUNT:=0;                                 <<04733>>04630000
                  DBDIRTY :=TRUE;                              <<04733>>04632000
                END;                                           <<04733>>04634000
              DIRREAD(ELEMENT(GFIPNTR),B,0,0); <<READ INDEX BLOCK>>     04636000
              IF DBPCOUNT<>0 THEN                                       04638000
                BEGIN                                                   04640000
                  DBPCOUNT := 0;                                        04642000
                  DBDIRTY := TRUE;                                      04644000
                END;                                                    04646000
              IF ARQ(PARMS) >= REL OR ARQ(PARMS+14) <> 0 THEN           04648000
                BEGIN  <<RELOAD OR RECOVERY>>                           04650000
                  @DELEMENTP1 := @ELEMENT+1;                            04652000
                  DELEMENTP1(4) := 0D;  <<FILE SPACE COUNT>>            04654000
                  DADIRTY := TRUE;                                      04656000
                  MOVE ARQ(PARMS+6) := ELEMENT,(4);                     04658000
                END;                                                    04660000
            END                                                         04662000
          ELSE IF LEVEL<>FILELEVEL THEN ERRMESSAGE(M275)       <<04733>>04664000
          ELSE                                                          04666000
            BEGIN  <<FILE ENTRY>>                                       04668000
              IF ARQ(PARMS) >= REL THEN <<RELOAD>>                      04670000
              IF LOGICAL(ARQ(PARMS+15)) THEN                            04672000
                BEGIN  <<ACCOUNTSONLY - PURGE FILE>>                    04674000
                  MOVE ARQ(PARMS+2) := ELEMENT,(4);                     04676000
                  EXCHANGEDB(0);                                        04678000
                  TOS := DIRECPURGE(FILETYPE,0,ARQ(PARMS+10),           04680000
                    ARQ(PARMS+6),ARQ(PARMS+2));                         04682000
                  IF <> THEN DIRERROR(*,BBUF);                          04684000
                  DDEL;                                                 04686000
                  EXCHANGEDB(DIRDSTN);                                  04688000
                END                                                     04690000
              ELSE                                                      04692000
                BEGIN  <<SET BIT IN FILE ENTRY>>                        04694000
                  ELEMENT(FVOLPNTRW).(8:1) := 1; <<FILE NOT FOUND YET>> 04696000
                  X := PARMS+1;                                         04698000
                  ARQ(X) := ARQ(X)+1;  <<# OF FILES IN DIRECTORY>>      04700000
                  DADIRTY := TRUE;                                      04702000
                END                                                     04704000
              ELSE                                                      04706000
                BEGIN           << DOING A RECOVER   >>        <<04733>>04708000
                                <<   LOST DISC SPACE >>        <<04733>>04710000
                  TOS := ELEMENT(FVOLPNTRW);                            04712000
                  VOLUME := S0.(0:8);  <<VTAB INDEX>>                   04714000
                  TOS := TOS.(8:8);                                     04716000
                  TOS := ELEMENT(X:=X+1);                               04718000
                  DISCADR := TOS;   <<DISC ADDRESS>>                    04720000
                  MOVE ARQ(PARMS+2) := ELEMENT,(4);                     04722000
                  EXCHANGEDB(0);                                        04724000
                  LDEV:=VTAB(VOLUME*VTABSIZE+VTAB12).VTABLDEV;          04726000
                  LEN := 1;                                             04728000
                                                               <<04733>>04730000
                << CHECK TO SEE IF FILE LABEL IS BAD OR     >> <<04733>>04732000
                <<    IS ON A BAD PART OF THE DISC.  IF SO, >> <<04733>>04734000
                <<    REMOVE THE FILE'S DIRECTORY ENTRY     >> <<04733>>04736000
                                                               <<04733>>04738000
                  IF (ERR'CODE := CHECK'DATA'LOST(TRUE))       <<04733>>04740000
                                                <> 0 THEN      <<04733>>04742000
                     BEGIN                                     <<04733>>04744000
                     REMOVE(ERR'CODE);  << REMOVE FILE      >> <<04733>>04746000
                     GOTO OK;           <<  DIRECTORY ENTRY >> <<04733>>04748000
                     END;                                      <<04733>>04750000
                                                               <<04733>>04752000
                << FLAB WAS SET UP BY CHECK'DATA'LOST >>       <<04733>>04754000
                                                               <<04733>>04756000
                  SECTORS := 0D;                                        04758000
                  I := 0;                                               04760000
                  DO                                                    04762000
                    BEGIN  <<REMOVE SPACE FOR FILE'S EXTENTS>>          04764000
                      ERR'CODE := 0;   << INIT. ERROR CODE >>  <<04733>>04766000
                      TOS := FLABDBL(EXT0+I);                           04768000
                      IF = THEN BEGIN DDEL;GOTO NEXTEXTENT;END;         04770000
                      VOLUME := S1.(0:8);                               04772000
                      S1.(0:8) := 0;                                    04774000
                      DISCADR := TOS;                                   04776000
                   TOS:=VTAB(VOLUME*VTABSIZE+VTAB12).VTABLDEV;          04778000
                      LDEV := S0;                                       04780000
                      TOS := 0;                                         04782000
                      TOS := GETEXTLEN(I);                              04784000
                      ASSEMBLE(DDUP,DUP);                               04786000
                      LEN := TOS;                                       04788000
                      SECTORS := TOS+SECTORS;                           04790000
                                                               <<04733>>04792000
                      << CHECK TO SEE IF EXTENT OVERLAPS AN >> <<04733>>04794000
                      << AREA OF THE DISC WHICH JUST LOST   >> <<04733>>04796000
                      << DATA.  IF SO, SAVE THE FILE NAME   >> <<04733>>04798000
                      << (USER HAS OPTION TO PURGE LATER)   >> <<04733>>04800000
                      << AND CONTINUE CHECKING ALL EXTENTS. >> <<04733>>04802000
                                                               <<04733>>04804000
                      IF (ERR'CODE := CHECK'DATA'LOST(FALSE))  <<04733>>04806000
                                                     <> 0 THEN <<04733>>04808000
                         BEGIN                                 <<04733>>04810000
                         << REMOVE DUPLICATE ENTRIES FIRST >>  <<04733>>04812000
                         REMOVE'BADFILE(ARQ(PARMS+2));         <<04733>>04814000
                                                               <<04733>>04816000
                         << IF UNABLE TO SAVE FILE NAME,   >>  <<04733>>04818000
                         <<    WE WILL PURGE IT NOW.       >>  <<04733>>04820000
                                                               <<04733>>04822000
                         IF ADD'BADFILE(ARQ(PARMS+2)) THEN     <<04733>>04824000
                            ERR'CODE := 0;                     <<04733>>04826000
                         END;                                  <<04733>>04828000
                                                               <<04733>>04830000
                      << REMOVE THE DISC SPACE FOR THIS     >> <<04733>>04832000
                      << EXTENT.  IF WE CAN'T GET THE SPACE >> <<04733>>04834000
                      << BACK, IT MIGHT BE BECAUSE THE      >> <<04733>>04836000
                      << EXTENT IS ON A TRACK WHICH WAS     >> <<04733>>04838000
                      << JUST DELETED.                      >> <<04733>>04840000
                                                               <<04733>>04842000
                      REMDISCSPACE(*,*,DISCADR);                        04844000
                      IF <> THEN  <<COULDN'T REMOVE SPACE>>             04846000
                         ERR'CODE := 5;                        <<04733>>04848000
                                                               <<04733>>04850000
                      IF ERR'CODE <> 0 THEN                    <<04733>>04852000
                        BEGIN  <<PURGE FILE - RETURN SPACE>>   <<04733>>04854000
                                                               <<04733>>04856000
                          << REMOVE FILE DIRECTORY ENTRY. >>   <<04733>>04858000
                          << IF FILE IS ON LIST OF BAD    >>   <<04733>>04860000
                          << FILES, REMOVE IT.            >>   <<04733>>04862000
                                                               <<04733>>04864000
                          REMOVE'BADFILE(ARQ(PARMS+2));        <<04733>>04866000
                          REMOVE( ERR'CODE);                   <<04733>>04868000
                                                               <<04733>>04870000
                          K := -1;                                      04872000
                          WHILE (K:=K+1) < I DO                         04874000
                            BEGIN  <<RETURN SPACE FOR EXTENTE>>         04876000
                              DISCADR := FLABDBL(EXT0+K);               04878000
                              IF <> THEN                                04880000
                                BEGIN                                   04882000
                                  TOS := DISCADR0;                      04884000
                                  VOLUME := S0.(0:8);                   04886000
                                  DISCADR0 := TOS.(8:8);                04888000
                                  LDEV := VTAB(VOLUME*VTABSIZE          04890000
                                    +VTAB12).VTABLDEV;                  04892000
                                  RETDISCSPACE(LDEV,DOUBLE(    <<04733>>04894000
                                    GETEXTLEN(K)),DISCADR);             04896000
                                  IF <> THEN MESSAGE(M328);    <<04733>>04898000
                                END;                                    04900000
                            END;                                        04902000
                          GOTO OK;                                      04904000
                        END;                                            04906000
                                                               <<04733>>04908000
  NEXTEXTENT:                                                           04910000
                    END                                                 04912000
                  UNTIL (I:=I+1)>FLNUMEXTS;                             04914000
                  TOS := DIRECADJUST(SECTORS,ARQ(PARMS+10),             04916000
                    ARQ(PARMS+6));  <<ADJUST FILE SPACE COUNTS>>        04918000
                  IF <> THEN DIRERROR(*,BBUF);                          04920000
                  DDEL;                                                 04922000
  OK:             EXCHANGEDB(DIRDSTN);                                  04924000
                END;                                                    04926000
            END;                                                        04928000
          DIRECTORYCLEAN := 1;  <<CONTINUE SCAN>>                       04930000
      END <<DIRECTORYCLEAN>> ;                                          04932000
          <<------------------------------------                        04934000
            CLEAN UP USER ENTRIES IN DIRECTORY                          04936000
          ------------------------------------>>                        04938000
  INTEGER PROCEDURE USERCLEAN(ELEMENT,LEVEL,PARMS,GARBAGE);             04940000
    VALUE LEVEL,PARMS,GARBAGE;                                          04942000
    ARRAY ELEMENT;                                                      04944000
    INTEGER LEVEL,PARMS;                                                04946000
    DOUBLE GARBAGE;                                                     04948000
    COMMENT                                                             04950000
      SCAN DIRECTORY. AT ACCOUNT LEVEL AND USER LEVEL RESET COUNT       04952000
    OF USERS LOGGED ON;                                                 04954000
      BEGIN                                                             04956000
          IF LEVEL=ACCOUNTLEVEL THEN                                    04958000
            BEGIN                                                       04960000
              DIRREAD(ELEMENT(AUIPNTR),B,0,0);                          04962000
              IF DBPCOUNT<>0 THEN                                       04964000
                BEGIN                                                   04966000
                  DBPCOUNT := 0;                                        04968000
                  DBDIRTY := TRUE;                                      04970000
                END;                                                    04972000
            END                                                         04974000
          ELSE IF LEVEL<>USERLEVEL THEN ERRMESSAGE(M276)       <<04733>>04976000
          ELSE IF ELEMENT(ULOGCOUNT)<>0 THEN                            04978000
            BEGIN                                                       04980000
              ELEMENT(X) := 0;                                          04982000
              DADIRTY := TRUE;                                          04984000
            END;                                                        04986000
          USERCLEAN := 1;                                               04988000
      END <<USERCLEAN>> ;                                               04990000
INTEGER PROCEDURE SET'1'MGR(ELEMENT, LEVEL, PARMS, GARBAGE);   <<04733>>04992000
  VALUE LEVEL, PARMS, GARBAGE;                                 <<04733>>04994000
  ARRAY ELEMENT;                                               <<04733>>04996000
  INTEGER LEVEL, PARMS;                                        <<04733>>04998000
  DOUBLE GARBAGE;                                              <<04733>>05000000
                                                               <<04733>>05002000
  COMMENT                                                      <<04733>>05004000
    SET LOGON COUNT FOR MANAGER.SYS TO MINIMUM LEVEL OF ONE    <<04733>>05006000
    SO THAT USER MANAGER.SYS CAN NOT BE PURGED;                <<04733>>05008000
                                                               <<04733>>05010000
    BEGIN                                                      <<04733>>05012000
      ELEMENT(ULOGCOUNT) := 1;                                 <<04733>>05014000
      DADIRTY := TRUE;                                         <<04733>>05016000
      SET'1'MGR := %77;                                        <<04733>>05018000
    END;  << SET'1'MGR >>                                      <<04733>>05020000
          <<------------------------------------>>             <<04733>>05022000
          <<CLEAN UP VOLUME SET DEFINITION ENTRIES IN DIRECTORY  RV.PV>>05024000
          <<---------------------------------->>               <<04733>>05026000
  INTEGER PROCEDURE VSDCLEAN (ELEMENT,LEVEL,PARMS,GARBAGE);    <<04733>>05028000
      VALUE   LEVEL,PARMS,GARBAGE;                             <<04733>>05030000
      ARRAY   ELEMENT;                                         <<04733>>05032000
      INTEGER LEVEL,PARMS;                                     <<04733>>05034000
      DOUBLE  GARBAGE;                                         <<04733>>05036000
      COMMENT                                                  <<04733>>05038000
          SCAN DIRECTORY FOR VOLUME SET DEFINITION ENTRIES     <<04733>>05040000
          AND RESET ALL BUT (0:1) OF GVSLINKAGEW AND RESET     <<04733>>05042000
          GVSDREFCNT WORDS;                                    <<04733>>05044000
      BEGIN                                                    <<04733>>05046000
          IF LEVEL = VSDEFLEVEL THEN                           <<04733>>05048000
          BEGIN                                                <<04733>>05050000
              ELEMENT (GVSLINKAGEW).(1:15) := 0;               <<04733>>05052000
              ELEMENT (GVSDREFCNT) := 0;                       <<04733>>05054000
              DADIRTY := TRUE;                                 <<04733>>05056000
          END;                                                 <<04733>>05058000
          VSDCLEAN := 1;  <<CONTINUE SCAN>>                    <<04733>>05060000
      END;<<OF VSDCLEAN>>                                      <<04733>>05062000
          <<-----------------------                                     05064000
            PURGE FILES NOT FOUND                                       05066000
          ----------------------->>                                     05068000
  INTEGER PROCEDURE FILEPURGE(ELEMENT,LEVEL,PARMS,GARBAGE);             05070000
    VALUE LEVEL,PARMS,GARBAGE;                                          05072000
    ARRAY ELEMENT;                                                      05074000
    INTEGER LEVEL,PARMS;                                                05076000
    DOUBLE GARBAGE;                                                     05078000
      BEGIN                                                             05080000
                                                               <<SY>>   05082000
        EXT'DCL;                                               <<SY>>   05084000
        BYTE POINTER BBUF := @BUF';                            <<SY>>   05086000
        INTEGER ARRAY ARQ(*)=Q+0;                                       05088000
          PARMS := PARMS-ARQ;                                           05090000
          IF LEVEL=ACCOUNTLEVEL THEN MOVE ARQ(PARMS+9) := ELEMENT,(4)   05092000
          ELSE IF LEVEL=GROUPLEVEL THEN MOVE ARQ(PARMS+5) := ELEMENT,(4)05094000
          ELSE IF ELEMENT(4).(8:1)=1 THEN                               05096000
            BEGIN  <<PURGE FILE>>                                       05098000
              MOVE ARQ(PARMS+1) := ELEMENT,(4);                         05100000
              EXCHANGEDB(0);                                            05102000
              IF LISTPURGE THEN                                         05104000
                 PRINTFNAME(ARQ(PARMS+1));                              05106000
              TOS := DIRECPURGE(FILETYPE,0,ARQ(PARMS+9),ARQ(PARMS+5),   05108000
                ARQ(PARMS+1));                                          05110000
              IF <> THEN DIRERROR(*,BBUF);                              05112000
              DDEL;                                                     05114000
              EXCHANGEDB(DIRDSTN);                                      05116000
              ARQ(X) := ARQ(PARMS)-1;                                   05118000
              IF = THEN                                                 05120000
                BEGIN  <<FINISHED SCAN>>                                05122000
                  TOS := 4;                                             05124000
                  GOTO RET;                                             05126000
                END;                                                    05128000
            END;                                                        05130000
          TOS := 1;                                                     05132000
  RET:    FILEPURGE := TOS;                                             05134000
      END <<FILEPURGE>> ;                                               05136000
END.  << INTIAL UTILITY PROCEDURES >>                                   05138000
