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