$CONTROL MAP,CODE,USLINIT                                               00010000
<< DIRC - MODULE 53 >>                                                  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
$SET X0=OFF << IF ON THEN DEBUG CODE COMPILED >>                        00028000
$SET X8=ON                                                     <<l7749>>00030000
$CONTROL SEGMENT= DIRC                                                  00032000
$CONTROL UNCALLABLE                                                     00034000
$THIRTY                                                                 00036000
BEGIN                                                                   00038000
                                                                        00040000
EQUATE                                                         <<DE>>   00042000
   NAMESIZE        = 4;  << UNPACKED REPRESENTATION >>         <<DE>>   00044000
                                                               <<DE>>   00046000
                                                               <<DE>>   00048000
           << DIRECTORY SUDDENDEATH ERRORS >>                  <<DE>>   00050000
                                                               <<DE>>   00052000
DEFINE  SYSABORT     = SUDDENDEATH#;                           <<DE>>   00054000
EQUATE  DIRIOAB      = 400,   << DIRECTORY I/O DISC ERROR   >> <<DE>>   00056000
        DIRBADDST    = 401,   << BAD DST NUMBER             >> <<DE>>   00058000
        DIRABERR     = 402,   << PROCESS ERROR IN DDS BUFF  >> <<DE>>   00060000
        DIRBITERR    = 403,   << DIRECTORY BITMAP ERROR     >> <<DE>>   00062000
                    << 404       FROM FILE SYSTEM           >> <<DE>>   00064000
        DIRINERR     = 405,   << ERROR ADDING NEW ENT OR INX>> <<DE>>   00066000
        DIRLOGERR    = 406,   << DIRECTORY ERROR LOG ON/OFF >> <<DE>>   00068000
        DIRALLOCERR  = 407,   << BAD BITMAP ALLOC/DEALLOC   >> <<DE>>   00070000
        DIRVSDERR    = 415,   << ERROR ADDING VSD ENT OR INX>> <<DE>>   00072000
        DIRPVBINDERR = 418,   << PV BIND OR REF CNT ERROR   >> <<DE>>   00074000
                                                               <<DE>>   00076000
                                                               <<DE>>   00078000
          <<  DIRECTORY BLOCK SIZES >>                         <<DE>>   00080000
                                                               <<DE>>   00082000
        SYSSAIBSIZE  =  3,    << SYSACCOUNT INDEX BLOCK SIZE>> <<DE>>   00084000
        SYSAUIBSIZE  =  1,    << ACCOUNT/USER  INDEX BLOCK  >> <<DE>>   00086000
        SYSAGIBSIZE  =  1,    << ACCOUNT/GROUP INDEX BLOCK  >> <<DE>>   00088000
        SYSGFIBSIZE  =  2,    << GROUP/FILES   INDEX BLOCK  >> <<DE>>   00090000
        SYSGVSIBSIZE =  1,    << GROUP/VSD     INDEX BLOCK  >> <<DE>>   00092000
        SYSAEBSIZE   =  3,    << ACCOUNT ENTRY BLOCK SIZE   >> <<DE>>   00094000
        SYSUEBSIZE   =  2,    << USER    ENTRY BLOCK SIZE   >> <<DE>>   00096000
        SYSGEBSIZE   =  2,    << GROUP   ENTRY BLOCK SIZE   >> <<DE>>   00098000
        SYSFEBSIZE   =  2,    << FILES   ENTRY BLOCK SIZE   >> <<DE>>   00100000
        SYSVSEBSIZE  =  1,    << VSD     ETNRY BLOCK SIZE   >> <<DE>>   00102000
                                                                        00104000
        DDSBSIZE     =  3,    << MAXIMUM BLOCK SECTOR SIZE  >> <<DE>>   00106000
        DDSBWSIZE    = %600;  << MAXIMUM BLOCK WORD  SIZE   >> <<DE>>   00108000
$PAGE "DIRECTORY DATA STRUCTURE"                               <<DE>>   00110000
EQUATE                                                         <<DE>>   00112000
                                                                        00114000
<< ACCOUNT ENTRY >>                                                     00116000
   ANAME           = 0,                  <<NAME>>                       00118000
   AGIPNTR         = ANAME+NAMESIZE,     <<GROUP INDEX PNTR>>           00120000
   AUIPNTR         = AGIPNTR+1,          <<USER INDEX PNTR>>            00122000
   ACAP            = AUIPNTR+1,          <<CAPABILITY>>                 00124000
   ALATTR          = ACAP+2,                                            00126000
   APASS           = ALATTR+2,                                          00128000
   ADFSCOUNT       = APASS+NAMESIZE,     <<DISC FILE SPACE>>            00130000
   ADFSCOUNTD      = ADFSCOUNT /2,                                      00132000
   ADFSLIMIT       = ADFSCOUNT+2,                                       00134000
   ADFSLIMITD      = ADFSLIMIT /2,                                      00136000
   ACPUCOUNT       = ADFSLIMIT+2,        <<CPU TIME>>                   00138000
   ACPUCOUNTD      = ACPUCOUNT /2,                                      00140000
   ACPULIMIT       = ACPUCOUNT+2,                                       00142000
   ACPULIMITD      = ACPULIMIT /2,                                      00144000
   ACONTIMECOUNT   = ACPULIMIT+2,        <<CONNECT TIME>>               00146000
   ACONTIMECOUNTD  = ACONTIMECOUNT /2,                                  00148000
   ACONTIMELIMIT   = ACONTIMECOUNT+2,                                   00150000
   ACONTIMELIMITD  = ACONTIMELIMIT /2,                                  00152000
   ASECW           = ACONTIMELIMIT+2,                                   00154000
   APURGEFLAGW     = ASECW,                                             00156000
   AMAXJOBW        = ASECW+1,            <<MAX. JOB PRIORITY (BYTE) >>  00158000
   ASPARE1         = AMAXJOBW+1,                                        00160000
   ASPARE2         = ASPARE1+1,                                         00162000
   ASIZE           = ASPARE2 +1,                                        00164000
                                                                        00166000
<<GROUP ENTRY>>                                                         00168000
   GNAME           = 0,                  <<NAME>>                       00170000
   GFIPNTR         = GNAME+NAMESIZE,     <<FILE INDEX (OR VOLUME) PNTR>>00172000
   GPASS           = GFIPNTR+1,          <<PASSWORD>>                   00174000
   GDFSCOUNT       = GPASS+NAMESIZE,     <<DISC FILE SPACE>>            00176000
   GDFSLIMIT       = GDFSCOUNT+2,                                       00178000
   GCPUCOUNT       = GDFSLIMIT+2,        <<CPU TIME>>                   00180000
   GCPULIMIT       = GCPUCOUNT+2,                                       00182000
   GCONTIMECOUNT   = GCPULIMIT+2,                                       00184000
   GCONTIMELIMIT   = GCONTIMECOUNT+2,                                   00186000
   GSEC            = GCONTIMELIMIT+2,                                   00188000
   GPURGEFLAGW     = GSEC,                                              00190000
   GCAP            = GSEC +2,                                           00192000
   GLINKAGE        = GCAP+1,                                   <<01.PV>>00194000
   GVSDIPNTR       = GLINKAGE+1,         <<VS DEF INDEX PNTR>> <<02.PV>>00196000
   GHVSNAME        = GVSDIPNTR+1,        <<HOME VS NAME>>      <<02.PV>>00198000
   GHVSANAME       = GHVSNAME,           << "   "  ACCT NAME>> <<02.PV>>00200000
   GHVSGNAME       = GHVSANAME+NAMESIZE, << "   "  GRP  NAME>> <<02.PV>>00202000
   GHVSVSNAME      = GHVSGNAME+NAMESIZE, << "   "  VS   NAME>> <<02.PV>>00204000
   GSAVEFIPNTR     = GHVSVSNAME+NAMESIZE,<<SAVES GFIPNTR>>     <<13.PV>>00206000
   GMOUNTREFCNTR   = GSAVEFIPNTR+1,      <<MOUNT USE COUNTER>> <<13.PV>>00208000
   GSPARE          = GMOUNTREFCNTR+1,                          <<13.PV>>00210000
   GSIZE           = GSPARE+1;                                 <<16.PV>>00212000
<<GLINKAGE DEFINITIONS>>                                       <<01.PV>>00214000
DEFINE                                                         <<01.PV>>00216000
   PVF             = 0:1 #,                                    <<01.PV>>00218000
   MVTABXF         = 8:8 #;                                    <<01.PV>>00220000
EQUATE                                                         <<01.PV>>00222000
   PV              = 1,                                        <<01.PV>>00224000
   VMAX            = 8,                  <<VS MEMBERSHIP MAX>> <<43.PV>>00226000
                                                                        00228000
<<FILE ENTRY >>                                                         00230000
   FNAME           = 0,                  <<NAME>>                       00232000
   FVOLPNTRW       = FNAME+NAMESIZE,     <<VOLUME TABLE POINTER>>       00234000
   FLABELPNTRW     = FVOLPNTRW,          <<FILE LABEL POINTER>>         00236000
   FSIZE           = FLABELPNTRW+2,                                     00238000
                                                                        00240000
<<USER ENTRY>>                                                          00242000
   UNAME           = 0,                  <<NAME>>                       00244000
   UCAP            = UNAME+NAMESIZE,     <<CAPABILITY>>                 00246000
   ULATTR          = UCAP+2,                                            00248000
   UPASS           = ULATTR+2,                                          00250000
   UHGROUP         = UPASS+NAMESIZE,     <<HOME GROUP>>                 00252000
   ULOGCOUNT       = UHGROUP+NAMESIZE,   <<# OF USERS LOGGED ON UNDER>> 00254000
   UMAXJOB         = ULOGCOUNT+1,                                       00256000
   UPURGEFLAGW     = UMAXJOB,                                           00258000
   USPARE          = UMAXJOB +1,                                        00260000
   USIZE           = USPARE +1,                                         00262000
                                                                        00264000
<<VOLUME SET DEFINITION ENTRY>>                                <<02.PV>>00266000
   GVSNAME         = 0,                  <<VOLUME SET NAME>>   <<02.PV>>00268000
   GVSLINKAGEW     = GVSNAME+NAMESIZE,   <<MVTAB LINKAGE>>     <<02.PV>>00270000
   GVSINFO         = GVSLINKAGEW+1,      <<DEFINITION INFO>>   <<02.PV>>00272000
   GVSMEMBERS      = GVSINFO+1,          <<VMAX MEMBERS>>      <<02.PV>>00274000
                                         <<MEMBER INFO>>       <<02.PV>>00276000
                                         <<VMAX MEMBERS>>      <<02.PV>>00278000
   GVSVOLNAME      = GVSMEMBERS,         <<MEMBER NAME>>       <<02.PV>>00280000
   GVSVOLFLAGS     = GVSVOLNAME+NAMESIZE,<<MEMBER STAT FLAGS>> <<02.PV>>00282000
   GVSVOLINFO      = GVSVOLFLAGS+1,      <<MEMBER ATTRIBS>>    <<02.PV>>00284000
   GVSMEMBSZ       = GVSINFO-GVSNAME+1,                        <<15.PV>>00286000
   GVSDREFCNT      = GVSMEMBSZ*(VMAX+1),                       <<58.PV>>00288000
   GVSDSPARE2      = GVSDREFCNT+1,                             <<58.PV>>00290000
   GVSDSIZE        = GVSDSPARE2+1,                             <<58.PV>>00292000
<<VOLUME CLASS DEFINITION ENTRY>>                              <<02.PV>>00294000
   GVCNAME        = 0,                   <<VOLUME CLASS NAME>> <<02.PV>>00296000
   GVCLINKAGEW     = GVCNAME+NAMESIZE,                         <<02.PV>>00298000
   GVCINFO         = GVCLINKAGEW+1,      <<DEFINITION INFO>>   <<02.PV>>00300000
   GVCPNAME        = GVCINFO+1,          <<PARENT DEF  NAME>>  <<02.PV>>00302000
   GVCPANAME       = GVCPNAME,           <<  "    ACCT   " >>  <<02.PV>>00304000
   GVCPGNAME       = GVCPANAME+NAMESIZE, <<  "    GRP    " >>  <<02.PV>>00306000
   GVCPVSNAME      = GVCPGNAME+NAMESIZE, <<  "    VS     " >>  <<02.PV>>00308000
   GVCUNUSED       = GVCPVSNAME+NAMESIZE,                      <<02.PV>>00310000
   GVCDSIZE        = GVSDSIZE,                                 <<02.PV>>00312000
                                                               <<02.PV>>00314000
   MAXENTRYSIZE    = GVSDSIZE,                                 <<02.PV>>00316000
                                                                        00318000
                   <<INDEX>>                                            00320000
                                                                        00322000
                                                                        00324000
   IE1STNAME       = 0,                  <<1ST NAME OF ENTRY BLOCK>>    00326000
   IEPNTR          = IE1STNAME+NAMESIZE, <<PNTR TO IT >>                00328000
   IECOUNT         = IEPNTR+1,           <<# OF ENTRIES IN IT>>         00330000
   ISIZE           = IECOUNT+1;                                         00332000
                                                                        00334000
                                                                        00336000
DEFINE                                                                  00338000
   APURGEFLAGF     = 0:1 #,                                             00340000
   GPURGEFLAGF     = 0:1 #,                                             00342000
   UPURGEFLAGF     = 0:1 #;                                             00344000
EQUATE                                                                  00346000
   GONEFLAG        = 1;                                                 00348000
                                                                        00350000
                                                                        00352000
                      <<INDEX BLOCK PREFIX>>                            00354000
                                                                        00356000
                                                                        00358000
EQUATE                                                                  00360000
   PREMISCWD       = 0;                                                 00362000
DEFINE                                                                  00364000
   TYPEF           = 0:1 #;                                             00366000
EQUATE                                                                  00368000
   INDEXTYPE       = 1,                                                 00370000
   ENTRYTYPE       = 0;                                                 00372000
DEFINE                                                                  00374000
   IPURGEFLAGF     = 1:1 #,                                             00376000
   LEVELF          = 2:3 #;                                    <<02.PV>>00378000
EQUATE                                                                  00380000
   FILELEVEL       = 0,                                                 00382000
   GROUPLEVEL      = 1,                                                 00384000
   ACCOUNTLEVEL    = 2,                                                 00386000
   USERLEVEL       = 3,                                        <<02.PV>>00388000
   VSDEFLEVEL      = 4;                                                 00390000
DEFINE                                                                  00392000
   XSIZEF          = 5:7 #,                                    <<02.PV>>00394000
   BSIZEF          = 12:4 #;                                   <<02.PV>>00396000
EQUATE                                                                  00398000
   PREXCOUNT       = PREMISCWD+1,        <<ELEMENT COUNT>>              00400000
   PREPCOUNT       = PREXCOUNT+1,        <<POINTER REF. COUNT>>         00402000
   PREETOTAL       = PREPCOUNT+1,        <<TOTAL ENTRIES COUNT >>       00404000
   PREEMISCWD      = PREETOTAL+1,                                       00406000
   PREPINDEXP      = PREEMISCWD+1,       <<INDEX PNTR IN WHICH FATHER>> 00408000
   PREPNAME        = PREPINDEXP+1,       <<FATHER'S NAME (IF ANY)>>     00410000
   PRESIZE         = PREPNAME+NAMESIZE;                                 00412000
                                                                        00414000
DEFINE                                                                  00416000
   SYSGLOBDIRBASE  = ABSOLUTE (%1130)#,                                 00418000
   SGDIRBASE1      = ABSOLUTE (%1130)#,                                 00420000
   SGDIRBASE2      = ABSOLUTE (%1131)#,                                 00422000
   ASMB            = ASSEMBLE#;                                         00424000
EQUATE                                                                  00426000
   XX              = 22,                                                00428000
   ZZ              = 139,                                      <<38.PV>>00430000
   SYSLDEV         = 1,                                                 00432000
   DIRSIR          = 8;                                                 00434000
DEFINE                                                                  00436000
   DIRIOADDR       = SYSLDEV#;                                          00438000
DEFINE                                                         <<32.PV>>00440000
    SYSVSDIRBASE = TOS := SGDIRBASE1;                          <<32.PV>>00442000
                   TOS.(0:8) := SYSLDEV;                       <<32.PV>>00444000
                   TOS := SGDIRBASE2 #;                        <<32.PV>>00446000
$PAGE "DIRECTORY DATA SEGMENT BUFFERS"                         <<DE>>   00448000
                   <<DIRECTORY DATA SEGMENT (DDS)>>                     00450000
                                                                        00452000
                                                                        00454000
EQUATE                                                                  00456000
   DDSDST          = 20;                                                00458000
ARRAY                                                                   00460000
   DDS(*)          = DB+0,                                              00462000
   DDSENTRY(*)     = DDS,                                               00464000
   DDSNAME(*)      = DDS,                                               00466000
   WORKAREA (*)    = DDS(128);                                          00468000
INTEGER           << VARIABLES SET BY DIRSTARTOFF >>                    00470000
   ADJUST         = WORKAREA,            <<DL-DB>>                      00472000
   XTYPE          = ADJUST +1;           <<INPUT PARM>>        <<38.PV>>00474000
DOUBLE                                                         <<38.PV>>00476000
   XLINKAGE'INDEXP= XTYPE+1;                                   <<38.PV>>00478000
INTEGER                                                        <<38.PV>>00480000
   XMVTABX        = XLINKAGE'INDEXP,                           <<38.PV>>00482000
   XINDEXP        = XMVTABX+1,           <<FINAL INDEX PNTR>>  <<38.PV>>00484000
   XANAME         = XINDEXP +1,          <<DB-REL ADDRS>>               00486000
   XGUNAME        = XANAME +1,                                          00488000
   XFNAME         = XGUNAME +1,                                         00490000
   XASEC          = XFNAME +1;           <<ACCT SECURITY>>              00492000
DOUBLE                                                                  00494000
   XGSEC          = XASEC +1;            <<GROUP SECURITY>>             00496000
LOGICAL                                                                 00498000
   SIRRETURN      = XGSEC +2;            <<FROM GETSIR>>                00500000
EQUATE                                   <<DISPS INTO PREPRE>>          00502000
   DIRBASE'        = 0,                  <<LDEV OF CONTENTS>>  <<01.PV>>00504000
   DIRBASE1'       = DIRBASE',                                 <<01.PV>>00506000
   DIRBASE2'       = DIRBASE1'+1,                              <<01.PV>>00508000
   CONTENTS        = DIRBASE2'+1,        <<DIRECTORY P. PNTR>> <<01.PV>>00510000
   LPNTR           = CONTENTS+1,         <<DB ADDR OF 1ST ELEMENT>>     00512000
   IOPNTR          = LPNTR+1,            <<BLOCK STARTING ADDR>>        00514000
   NUMVALID        = IOPNTR+1,           <<# VALID DIR PP AFTER IOPNTR>>00516000
   DIRTY           = NUMVALID+1,                                        00518000
   FLAGS           = DIRTY,                                             00520000
   XSIZE           = DIRTY+1,                                           00522000
   USED            = XSIZE+1,            <<=XSIZE * XCOUNT>>            00524000
   BSIZE           = USED+1,             <<BLOCK SIZE (PP.)>>           00526000
   BWSIZE          = BSIZE+1,            <<= BSIZE & LSR(7)>>           00528000
   BFACTOR         = BWSIZE+1,           <<= BWSIZE/XSIZE>>             00530000
   MISCWD          = BFACTOR+1,                                         00532000
   XCOUNT          = MISCWD+1,                                          00534000
   PCOUNT          = XCOUNT+1,                                          00536000
   ETOTAL          = PCOUNT+1,                                          00538000
   EMISCWD         = ETOTAL+1,                                          00540000
   PINDEXP         = EMISCWD+1,                                         00542000
   PNAME           = PINDEXP+1;                                         00544000
                                                                        00546000
                                                                        00548000
ARRAY                                                                   00550000
   DAPREPRE(*)     = DDS(ZZ);                                           00552000
DOUBLE                                                         <<01.PV>>00554000
   DADIRBASE       = DAPREPRE+DIRBASE';                        <<01.PV>>00556000
LOGICAL                                                                 00558000
   DACONTENTS      = DAPREPRE+CONTENTS;                                 00560000
LOGICAL POINTER                                                         00562000
   DALPNTR         = DAPREPRE+LPNTR,                                    00564000
   DAIOPNTR        = DAPREPRE+IOPNTR;                                   00566000
INTEGER                                                                 00568000
   DANUMVALID      = DAPREPRE+NUMVALID;                                 00570000
LOGICAL                                                                 00572000
   DAFLAGS'DIRTY   = DAPREPRE+DIRTY;                                    00574000
DEFINE                                                                  00576000
    FLAGSF         = (0:8) #,                                           00578000
    DIRTYF         = (15:1) #,                                 <<06.PV>>00580000
    BADELMF        = (0:1) #,                                           00582000
    DAFLAGS        = DAFLAGS'DIRTY.FLAGSF #,                            00584000
    DADIRTY        = DAFLAGS'DIRTY.DIRTYF #,                            00586000
    DABADELM       = DAFLAGS'DIRTY.BADELMF#;                            00588000
INTEGER                                                                 00590000
   DAXSIZE         = DAPREPRE+XSIZE,                                    00592000
   DAUSED          = DAPREPRE+USED,                                     00594000
   DABSIZE         = DAPREPRE+BSIZE,                                    00596000
   DABWSIZE        = DAPREPRE+BWSIZE,                                   00598000
   DABFACTOR       = DAPREPRE+BFACTOR,                                  00600000
   DAMISCWD        = DAPREPRE+MISCWD;                                   00602000
DEFINE                                                                  00604000
   DATYPE          = INTEGER (DAMISCWD.(TYPEF)) #,             <<02.PV>>00606000
   DALEVEL         = INTEGER (DAMISCWD.(LEVELF)) #;            <<02.PV>>00608000
ARRAY                                                                   00610000
   DAPRE (*)       = DAPREPRE(MISCWD);                                  00612000
INTEGER                                                                 00614000
   DAXCOUNT        = DAPREPRE+XCOUNT,                                   00616000
   DAPCOUNT        = DAPREPRE+PCOUNT;                                   00618000
LOGICAL                                                                 00620000
   DAETOTAL        = DAPREPRE+ETOTAL,                                   00622000
   DAEMISCWD       = DAPREPRE+EMISCWD;                                  00624000
DEFINE                                                                  00626000
   DAETYPE         = INTEGER (DAEMISCWD.(TYPEF)) #,                     00628000
   DAELEVEL        = INTEGER (DAEMISCWD.(LEVELF)) #,                    00630000
   DAEXSIZE        = INTEGER (DAEMISCWD.(XSIZEF)) #,                    00632000
   DAEBSIZE        = INTEGER (DAEMISCWD.(BSIZEF)) #;                    00634000
LOGICAL                                                                 00636000
   DAPINDEXP       = DAPREPRE+PINDEXP;                                  00638000
ARRAY                                                                   00640000
   DAPNAME (*)     = DAPREPRE(PNAME);                                   00642000
ARRAY                                                                   00644000
   DBPREPRE (*)    = DAPREPRE(XX);                                      00646000
DOUBLE                                                         <<01.PV>>00648000
   DBDIRBASE       = DBPREPRE+DIRBASE';                        <<01.PV>>00650000
LOGICAL                                                                 00652000
   DBCONTENTS      = DBPREPRE+CONTENTS;                                 00654000
LOGICAL POINTER                                                         00656000
   DBLPNTR         = DBPREPRE+LPNTR,                                    00658000
   DBIOPNTR        = DBPREPRE+IOPNTR;                                   00660000
INTEGER                                                                 00662000
   DBNUMVALID      = DBPREPRE+NUMVALID;                                 00664000
LOGICAL                                                                 00666000
   DBFLAGS'DIRTY   = DBPREPRE+DIRTY;                                    00668000
DEFINE                                                                  00670000
    DBFLAGS        = DBFLAGS'DIRTY.FLAGSF #,                            00672000
    DBDIRTY        = DBFLAGS'DIRTY.DIRTYF #,                            00674000
    DBBADELM       = DBFLAGS'DIRTY.BADELMF#;                            00676000
INTEGER                                                                 00678000
   DBXSIZE         = DBPREPRE+XSIZE,                                    00680000
   DBUSED          = DBPREPRE+USED,                                     00682000
   DBBSIZE         = DBPREPRE+BSIZE,                                    00684000
   DBBWSIZE        = DBPREPRE+BWSIZE,                                   00686000
   DBBFACTOR       = DBPREPRE+BFACTOR,                                  00688000
   DBMISCWD        = DBPREPRE+MISCWD;                                   00690000
DEFINE                                                                  00692000
   DBTYPE          = INTEGER (DBMISCWD.(TYPEF)) #,             <<02.PV>>00694000
   DBLEVEL         = INTEGER (DBMISCWD.(LEVELF)) #;            <<02.PV>>00696000
ARRAY                                                                   00698000
   DBPRE (*)       = DBPREPRE(MISCWD);                                  00700000
INTEGER                                                                 00702000
   DBXCOUNT        = DBPREPRE+XCOUNT,                                   00704000
   DBPCOUNT        = DBPREPRE+PCOUNT;                                   00706000
LOGICAL                                                                 00708000
   DBETOTAL        = DBPREPRE+ETOTAL,                                   00710000
   DBEMISCWD       = DBPREPRE+EMISCWD;                                  00712000
DEFINE                                                                  00714000
   DBETYPE         = INTEGER (DBEMISCWD.(TYPEF)) #,                     00716000
   DBELEVEL        = INTEGER (DBEMISCWD.(LEVELF)) #,                    00718000
   DBEXSIZE        = INTEGER (DBEMISCWD.(XSIZEF)) #,                    00720000
   DBEBSIZE        = INTEGER (DBEMISCWD.(BSIZEF)) #;                    00722000
LOGICAL                                                                 00724000
   DBPINDEXP       = DBPREPRE+PINDEXP;                                  00726000
ARRAY                                                                   00728000
   DBPNAME (*)     = DBPREPRE(PNAME);                                   00730000
                                                                        00732000
                                                                        00734000
INTEGER                                                        <<01.PV>>00736000
   SYSACCTINDEX    = DBPREPRE+XX;                              <<DE>>   00738000
DOUBLE                                                                  00740000
   DIRBASE         = SYSACCTINDEX+1;                           <<DE>>   00742000
INTEGER                                                        <<01.PV>>00744000
   DIRBASE1        = DIRBASE,                                  <<01.PV>>00746000
   DIRBASE2        = DIRBASE1+1;                               <<01.PV>>00748000
DEFINE                                                         <<01.PV>>00750000
   DIRLDEV         = DIRBASE1.(0:8) #;                         <<01.PV>>00752000
LOGICAL                                                        <<07103>>00754000
   PV'DIR'SIZE     = DIRBASE + 2,                              <<07103>>00756000
   DDS'CNT         = PV'DIR'SIZE + 1;                          <<07103>>00758000
DOUBLE                                                         <<DE>>   00760000
   DDS'CNT1        = DDS'CNT+1,                                <<DE>>   00762000
   DDS'CNT2        = DDS'CNT1+2,                               <<DE>>   00764000
   DDS'CNT3        = DDS'CNT2+2,                               <<DE>>   00766000
   DDS'CNT4        = DDS'CNT3+2,                               <<DE>>   00768000
   DDS'CNT5        = DDS'CNT4+2;                               <<DE>>   00770000
REAL                                                           <<DE>>   00772000
   GOODPERCENT     = DDS'CNT5+2;                               <<DE>>   00774000
LOGICAL POINTER                                                         00776000
   BASE            = GOODPERCENT+2;                                     00778000
INTEGER POINTER                                                         00780000
   IBASE           = BASE;                                              00782000
DOUBLE POINTER                                                 <<07.PV>>00784000
   DBASE           = BASE;                                     <<07.PV>>00786000
DEFINE                                                                  00788000
   WHICHDIRTY = BASE(DIRTY) #;                                          00790000
                                                                        00792000
<<----------------------------------------------------------->><<07103>>00794000
<< Directory Space Management Data Segment defines           >><<07103>>00796000
<<----------------------------------------------------------->><<07103>>00798000
                                                               <<07103>>00800000
<< Directory Space Management control data                   >><<07103>>00802000
                                                               <<07103>>00804000
LOGICAL  DS'BASE         = DB + 0;                             <<07103>>00806000
DOUBLE   DS'DIR'ADDR     = DS'BASE;            << Dir. addr. >><<07103>>00808000
DEFINE   DS'LDEV         = DS'BASE.(0:8)#;     << Dir. ldev  >><<07103>>00810000
LOGICAL  DS'LAST'WORD    = DS'DIR'ADDR + 2;    << Buf. last w>><<07103>>00812000
POINTER  DS'FIRST'WORD   = DS'LAST'WORD + 1;   << Buf. firs.w>><<07103>>00814000
LOGICAL  DS'DIR'SIZE     = DS'FIRST'WORD + 1;  << Dir. size  >><<07103>>00816000
LOGICAL  DS'FLAGS        = DS'DIR'SIZE + 1;    << DSM flags  >><<07103>>00818000
DEFINE   DS'DIRTY        = DS'FLAGS.(0:1)#;    << Buf. mod.  >><<07103>>00820000
DEFINE   DS'ERR'IN'PROG  = DS'FLAGS.(1:1)#;    << In progress>><<07103>>00822000
DEFINE   DS'DIR'DISABLED = DS'FLAGS.(2:1)#;    << Sys. disabl>><<07103>>00824000
DEFINE   DS'PERM'DISABLE = DS'FLAGS.(3:1)#;    << Perm. dis. >><<07103>>00826000
LOGICAL  DS'CUR'SECTOR   = DS'FLAGS + 1;       << Sec. in buf>><<07103>>00828000
DOUBLE   DS'ADDR         = DS'CUR'SECTOR + 1;  << Sec. addr. >><<07103>>00830000
INTEGER  DS'ADDR1        = DS'ADDR;                            <<07103>>00832000
INTEGER  DS'ADDR2        = DS'ADDR + 1;                        <<07103>>00834000
INTEGER  DS'SIZE         = DS'ADDR + 2;        << Buf data sz>><<07103>>00836000
LOGICAL  DS'REQ'SECTOR   = DS'SIZE + 1;        << Requested s>><<07103>>00838000
LOGICAL  DS'LAST'SECTOR  = DS'REQ'SECTOR + 1;  << BM last sec>><<07103>>00840000
LOGICAL  DS'SYS'LAST     = DS'LAST'SECTOR + 1; << Saved buf p>><<07103>>00842000
LOGICAL  DS'SYS'FIRST    = DS'SYS'LAST + 1;    << Saved buf p>><<07103>>00844000
LOGICAL  DS'SYS'CUR      = DS'SYS'FIRST + 1;   << Saved buf s>><<07103>>00846000
LOGICAL  DS'SYS'SIZE     = DS'SYS'CUR + 1;     << Sys dir siz>><<07103>>00848000
LOGICAL  DS'ERROR'LDEV   = DS'SYS'SIZE + 1;    << Bad dir ldv>><<07103>>00850000
LOGICAL  DS'ERROR'TYPE   = DS'ERROR'LDEV + 1;  << Dir err typ>><<07103>>00852000
DEFINE   DS'HEADER       = 18#;                << DS head sz >><<07103>>00854000
                                                               <<07103>>00856000
<< Buffer area                                               >><<07103>>00858000
                                                               <<07103>>00860000
ARRAY    DS'BUFFER (*)   = DB + DS'HEADER;     << Buffer     >><<07103>>00862000
LOGICAL  DS'DIR'LAST     = DS'BUFFER;          << Sector 0 lw>><<07103>>00864000
LOGICAL  DS'DIR'FIRST    = DS'DIR'LAST + 1;    << Sector 0 fw>><<07103>>00866000
DEFINE   DS'DIR'HEADER   = 2#;                 << BM header  >><<07103>>00868000
DEFINE   DS'BUF'SIZE'S   = 3#;                 << Buf sz sec.>><<07103>>00870000
DEFINE   DS'BUF'SIZE'W   = %600#;              << Buf sz word>><<07103>>00872000
DEFINE   DS'DST          = %25#;               << DSM DST    >><<07103>>00874000
                                                               <<07103>>00876000
<<----------------------------------------------------------->><<07103>>00878000
                                                                        00880000
$PAGE "INCLPXG - PXGLOBAL INCLUDE FILE"                        <<l7749>>00882000
$INCLUDE INCLPXG                                               <<06560>>00884000
$PAGE "INCLCAP - USER CAPABILITIES INCLUDE FILE"               <<l7749>>00886000
$INCLUDE INCLCAP                                               <<06560>>00888000
$PAGE "INCLJMAT - JOB MASTER TABLE INCLUDE FILE"               <<l7749>>00890000
$INCLUDE INCLJMAT                                              <<06560>>00892000
$PAGE "INCLJIT - JOB INFORMATION TABLE INCLUDE FILE"           <<l7749>>00894000
$INCLUDE INCLJIT                                               <<06560>>00896000
$PAGE "INCLSIR - SIR INCLUDE FILE"                             <<l7749>>00898000
$INCLUDE INCLSIR                                               <<07102>>00900000
$PAGE "INCLPCB - PROCESS CONTROL BLOCK INCLUDE FILE"           <<l7749>>00902000
$INCLUDE INCLPCB5                                              <<07102>>00904000
$PAGE  "        "                                              <<DE>>   00906000
<< FLAGS TO DIRECTORY ROUTINES >>                                       00908000
EQUATE                                                                  00910000
   A               = 0,                  <<BLOCK A>>                    00912000
   B               = 1,                                                 00914000
   E               = 0,                  <<EXACT SEARCH>>               00916000
   EN              = 2,                  <<EXACT OR NEXT SEARCH>>       00918000
   EP              = 4,                  <<EXACT OR PRECEEDING SEARCH>> 00920000
   EA              = E+A,                                               00922000
   EB              = E+B,                                               00924000
   ENA             = EN+A,                                              00926000
   ENB             = EN+B,                                              00928000
   EPA             = EP+A,                                              00930000
   EPB             = EP+B;                                              00932000
DEFINE                                                                  00934000
   STARTLEVELF     = 13:3 #,                                            00936000
   ENDLEVELF       = 10:3 #,                                   <<03.PV>>00938000
   ALLFLAG         =  9:1 #,                                   <<03.PV>>00940000
   ENDLEVELFX      =  9:4 #,                                   <<03.PV>>00942000
   TOLEVELF        =  6:3 #,                                   <<03.PV>>00944000
   HITFLAG         =  5:1 #;                                   <<03.PV>>00946000
EQUATE                                                                  00948000
   ALLXXX          = %(2) 1000,                                <<07.PV>>00950000
   ALLACCTS        = ALLXXX + ACCOUNTLEVEL,                    <<07.PV>>00952000
   ALLGROUPS       = ALLXXX + GROUPLEVEL,                      <<07.PV>>00954000
   ALLUSERS        = ALLXXX + USERLEVEL,                       <<07.PV>>00956000
   ALLFILES        = ALLXXX + FILELEVEL,                       <<07.PV>>00958000
   ALLVSDS         = ALLXXX + VSDEFLEVEL;                               00960000
                                                                        00962000
                                                                        00964000
<< MISCELLANEOUS DECLARATIONS >>                                        00966000
   INTEGER                                                              00968000
      S0 = S-0,                                                         00970000
      S1 = S-1,                                                         00972000
      S2 = S-2,                                                         00974000
      S3 = S-3,                                                         00976000
      S4 = S-4,                                                         00978000
      S5 = S-5,                                                         00980000
      S6 = S-6,                                                <<28.PV>>00982000
      XREG = X;                                                         00984000
LOGICAL XR = X;                                                <<07103>>00986000
   INTEGER DELTAQ = Q-0;                                                00988000
   LOGICAL                                                              00990000
      LS0 = S-0,                                                        00992000
      LS1 = S-1,                                                        00994000
   LS2 = S-2,                                                           00996000
   LS3 = S-3,                                                           00998000
   LS4 = S-4,                                                  <<58.PV>>01000000
   LS5 = S-5;                                                  <<58.PV>>01002000
   INTEGER POINTER                                                      01004000
      PS6 = S-6,                                               <<58.PV>>01006000
      PS5 = S-5,                                               <<58.PV>>01008000
      PS4 = S-4,                                                        01010000
      PS3 = S-3,                                               <<58.PV>>01012000
      PS1 = S-1,                                                        01014000
      PS0 = S-0;                                                        01016000
   DOUBLE                                                               01018000
      DS5 = S-5,                                                        01020000
      DS2 = S-2,                                                        01022000
      DS1 = S-1;                                                        01024000
   LOGICAL STATUS = Q-1;                                                01026000
   DEFINE                                                               01028000
      CARRYX = STATUS.(5:1) #,                                          01030000
      CC = STATUS.(6:2) #;                                              01032000
   EQUATE                                                               01034000
      READ  = 0,                                               <<43.PV>>01036000
      WRITE = 1,                                               <<43.PV>>01038000
      DIRIO = %031001,                                         <<07329>>01040000
      CCE = 2,                                                          01042000
      CCG = 0,                                                          01044000
      CCL = 1;                                                          01046000
   POINTER S0PNTR = S-0;                                                01048000
   DOUBLE POINTER                                                       01050000
      DPS0 = S-0,                                                       01052000
      DPS2 = S-2;                                                       01054000
   INTEGER POINTER S0IPNTR = S-0;                                       01056000
   INTEGER S0I     = S-0;                                               01058000
                                                                        01060000
   << MVTAB DEFINITIONS >>                                     <<DE>>   01062000
   INTEGER ARRAY MVTAB (*)  =  DB+0;                           <<DE>>   01064000
   DEFINE                                                      <<DE>>   01066000
           MVTABDST         =  53 #,                           <<DE>>   01068000
           MVTABSZ          =  %25 #,                          <<DE>>   01070000
           ACCTINDEX        =  (0:8) #;  << OF WORD 6 >>       <<DE>>   01072000
                                                               <<DE>>   01074000
   DEFINE                                                      <<DE>>   01076000
      OPTIONS = OPTION PRIVILEGED, UNCALLABLE #;               <<00175>>01078000
LOGICAL POINTER PCB = 3;                                       <<07102>>01080000
                                                               <<06560>>01082000
   DEFINE                                                      <<06560>>01084000
      DEF'MOVE'FROM'DST =                                      <<06560>>01086000
      MOVE'FROM'DST (DBTARGET, DSTN, DSTOFFSET, WORD'COUNT);   <<06560>>01088000
      VALUE          DBTARGET, DSTN, DSTOFFSET, WORD'COUNT;    <<06560>>01090000
      LOGICAL        DBTARGET, DSTN, DSTOFFSET, WORD'COUNT;    <<06560>>01092000
      BEGIN                                                    <<06560>>01094000
      XREG := TOS;      << Save return address               >><<06560>>01096000
      ASSEMBLE (MFDS 0);                                       <<06560>>01098000
      TOS := XREG;                                             <<06560>>01100000
      END#;                                                    <<06560>>01102000
                                                                        01104000
                                                                        01106000
INTRINSIC DEBUG, ASCII;                                        <<07103>>01108000
PROCEDURE HELP; OPTION EXTERNAL;                               <<01.PV>>01110000
                                                               <<01.PV>>01112000
                                                               <<01.PV>>01114000
INTEGER PROCEDURE LUN (VTABINX, MVTABX);                       <<26.PV>>01116000
    VALUE   VTABINX, MVTABX;                                   <<26.PV>>01118000
    INTEGER VTABINX, MVTABX;                                   <<26.PV>>01120000
    OPTION EXTERNAL;                                           <<26.PV>>01122000
                                                               <<26.PV>>01124000
                                                               <<26.PV>>01126000
PROCEDURE SYSABORT (N);                                                 01128000
   VALUE N;                                                             01130000
   INTEGER N;                                                           01132000
   OPTION EXTERNAL;                                                     01134000
                                                                        01136000
                                                                        01138000
INTEGER PROCEDURE EXCHANGEDB (DSTNUM);                         <<01.PV>>01140000
   VALUE DSTNUM;                                                        01142000
   LOGICAL DSTNUM;                                                      01144000
   OPTION EXTERNAL;                                                     01146000
                                                                        01148000
                                                                        01150000
INTEGER PROCEDURE SETSYSDB;                                             01152000
   OPTION EXTERNAL;                                                     01154000
                                                                        01156000
                                                                        01158000
PROCEDURE RESETDB (A);                                                  01160000
   VALUE A;                                                             01162000
   INTEGER A;                                                           01164000
   OPTION EXTERNAL;                                                     01166000
                                                               <<07102>>01168000
DOUBLE PROCEDURE DIRFIND (INDEX);                              <<07102>>01170000
   VALUE   INDEX;                                              <<07102>>01172000
   LOGICAL INDEX;                                              <<07102>>01174000
   OPTION  FORWARD;                                            <<07102>>01176000
                                                               <<DE>>   01178000
                                                               <<DE>>   01180000
DOUBLE PROCEDURE ATTACHIO ( LDEV, QMISC, DX, T, FUNC,          <<DE>>   01182000
                            CNT, P1, P2, FLGS);                <<DE>>   01184000
   VALUE   LDEV, QMISC, DX, T, FUNC, CNT, P1, P2, FLGS;        <<DE>>   01186000
   INTEGER LDEV, QMISC, DX, T, FUNC, CNT, P1, P2, FLGS;        <<DE>>   01188000
   OPTION  EXTERNAL;                                           <<DE>>   01190000
                                                               <<DE>>   01192000
                                                               <<DE>>   01194000
DOUBLE PROCEDURE FRELSPACE (LDEV, FPNTR, MVTABX);              <<DE>>   01196000
   VALUE LDEV, FPNTR, MVTABX;                                  <<DE>>   01198000
   INTEGER LDEV, MVTABX;                                       <<DE>>   01200000
   DOUBLE  FPNTR;                                              <<DE>>   01202000
   OPTION  EXTERNAL, VARIABLE;                                 <<DE>>   01204000
                                                               <<DE>>   01206000
LOGICAL PROCEDURE GETSIR (NUM);                                <<DE>>   01208000
   VALUE NUM;                                                  <<DE>>   01210000
   INTEGER NUM;                                                <<DE>>   01212000
   OPTION EXTERNAL;                                            <<DE>>   01214000
                                                               <<DE>>   01216000
PROCEDURE RELSIR (NUM, A);                                     <<DE>>   01218000
   VALUE NUM, A;                                               <<DE>>   01220000
   INTEGER NUM;  LOGICAL A;                                    <<DE>>   01222000
   OPTION EXTERNAL;                                            <<DE>>   01224000
                                                               <<DE>>   01226000
LOGICAL PROCEDURE SETCRITICAL;                                 <<DE>>   01228000
   OPTION EXTERNAL;                                            <<DE>>   01230000
                                                               <<DE>>   01232000
PROCEDURE RESETCRITICAL (P);                                   <<DE>>   01234000
   VALUE P;                                                    <<DE>>   01236000
   LOGICAL P;                                                  <<DE>>   01238000
   OPTION EXTERNAL;                                            <<DE>>   01240000
                                                               <<07103>>01242000
PROCEDURE GENMSG(SETN,MSG,M,P1,P2,P3,P4,P5,DEST,R1,OFF,DST,IO);<<07103>>01244000
   VALUE         SETN,MSG,M,P1,P2,P3,P4,P5,DEST,R1,OFF,DST,IO; <<07103>>01246000
   INTEGER       SETN,MSG,DEST,DST,R1;                         <<07103>>01248000
   LOGICAL       M,P1,P2,P3,P4,P5,OFF,IO;                      <<07103>>01250000
   OPTION  EXTERNAL,VARIABLE;                                  <<07103>>01252000
                                                               <<07103>>01254000
PROCEDURE SOFT'DEATH (N);                                      <<07103>>01256000
   VALUE   N;                                                  <<07103>>01258000
   INTEGER N;                                                  <<07103>>01260000
   OPTION  EXTERNAL;                                           <<07103>>01262000
                                                               <<07103>>01264000
PROCEDURE DIRXXXBITMAP (FUNC);                                 <<07103>>01266000
   VALUE   FUNC;                                               <<07103>>01268000
   INTEGER FUNC;                                               <<07103>>01270000
   OPTION  FORWARD;                                            <<07103>>01272000
                                                               <<07103>>01274000
$PAGE "Directory Space Management"                             <<07103>>01276000
<<***********************************************************>><<07103>>01278000
<<                                                           >><<07103>>01280000
<<                DIRECTORY  SPACE  MANAGEMENT               >><<07103>>01282000
<<                                                           >><<07103>>01284000
<<***********************************************************>><<07103>>01286000
                                                               <<07103>>01288000
<<----------------------------------------------------------->><<07103>>01290000
<< The Directory Space Management is a set of procedures     >><<07103>>01292000
<< which allows to allocate or deallocate directory space.   >><<07103>>01294000
<< To allocate the directory space the DIRALLOCATE procedure >><<07103>>01296000
<< with parameter size must be invoked. It will return the   >><<07103>>01298000
<< sector start address relative to the directory base. To   >><<07103>>01300000
<< deallocate the directory space the DIRDEALLOCATE procedure>><<07103>>01302000
<< should be invoked with two parameters (sector address and >><<07103>>01304000
<< size). If any IO errors occurs during allocation or       >><<07103>>01306000
<< deallocation then the DSM of specific directory will be   >><<07103>>01308000
<< disabled.                                                 >><<07103>>01310000
<< The directory occupies contigious space on the disc. If it>><<07103>>01312000
<< is system directory it will be located on ldev 1 otherwise>><<07103>>01314000
<< on master volume of private volume set. The first sectors >><<07103>>01316000
<< (up to 32) are occupied by the directory bit map. The dir->><<07103>>01318000
<< rectory data (index and entry blocks) follows directory   >><<07103>>01320000
<< bit map. Each bit in the directory bit map represents one >><<07103>>01322000
<< sector of the directory (that includes the directory bit  >><<07103>>01324000
<< map itself). The bit value of "1" in the directory bit map>><<07103>>01326000
<< indicates available sector. The DSM maintains the dir-    >><<07103>>01328000
<< rectory in the Directory Space Data Segment (%25). This   >><<07103>>01330000
<< data segment can handle up to 3 contigious sector of the  >><<07103>>01332000
<< directory bit map.                                        >><<07103>>01334000
<< If the dir. size is less than 6112 sectors then the dir.  >><<07103>>01336000
<< bit map will occupy 3 sectors. The dir. address will point>><<07103>>01338000
<< to the beginning of directory space. However if the dir.  >><<07103>>01340000
<< size is greater than 6112 sectors then the dir. bit map   >><<07103>>01342000
<< will use 32 sectors. The dir. address will point to 29-th >><<07103>>01344000
<< sector of the directory space. The dir. size is used as a >><<07103>>01346000
<< triger to obtain the address of the dir. bit map. In this >><<07103>>01348000
<< approach the account index block will be always at sector >><<07103>>01350000
<< 3 (relative to dir. addr.). It also implies that only 3   >><<07103>>01352000
<< sectors of the bit map are represented in the bit map.    >><<07103>>01354000
<<                                                           >><<07103>>01356000
<< In the DS data segment residue following control data:    >><<07103>>01358000
<< DS'DIR'ADDR     - directory disc address including ldev,  >><<07103>>01360000
<< DS'LAST'WORD    - last available word in the buffer,      >><<07103>>01362000
<< DS'FIRST'WORD   - first available word in the buffer,     >><<07103>>01364000
<< DS'DIR'SIZE     - directory size,                         >><<07103>>01366000
<< DS'DIRTY        - flag indicating modified data in buffer,>><<07103>>01368000
<< DS'ERR'IN'PROG  - erorr procedure in progress,            >><<07103>>01370000
<< DS'DIR'DISABLED - system directory disabled,              >><<07103>>01372000
<< DS'PERM'DISABLE - permantently disable directory alloc.,  >><<07103>>01374000
<< DS'CUR'SECTOR   - sector start address in the buffer,     >><<07103>>01376000
<< DS'ADDR         - real address of sector in the buffer,   >><<07103>>01378000
<< DS'SIZE         - size of data in the buffer,             >><<07103>>01380000
<< DS'REQ'SECTOR   - requested sector to be read,            >><<07103>>01382000
<< DS'LAST'SECTOR  - directory bit map last sector,          >><<07103>>01384000
<< DS'SYS'LAST     - saved system directory last word,       >><<07103>>01386000
<< DS'SYS'FIRST    - saved system directory first word,      >><<07103>>01388000
<< DS'SYS'CUR      - saved system dircetory current sector,  >><<07103>>01390000
<< DS'ERROR'LDEV   - ldev of disabled directory,             >><<07103>>01392000
<< DS'ERROR'TYPE   - type of error when disabled.            >><<07103>>01394000
<< The buffer follows the above control data.                >><<07103>>01396000
<<----------------------------------------------------------->><<07103>>01398000
$PAGE "Directory Space Management - DSM'ERROR"                 <<07103>>01400000
PROCEDURE DSM'ERROR (SF, ERR);                                 <<07103>>01402000
   VALUE   SF, ERR;                                            <<07103>>01404000
   LOGICAL SF, ERR;                                            <<07103>>01406000
   OPTION  PRIVILEGED, UNCALLABLE;                             <<07103>>01408000
                                                               <<07103>>01410000
<<----------------------------------------------------------->><<07103>>01412000
<< This procedure disables Directory Space Allocation or     >><<07103>>01414000
<< Deallocation of system directory when IO error occured or >><<07103>>01416000
<< deallocating space which is already free. Warmstart or    >><<07103>>01418000
<< coolstart will enable the directory space allocation/     >><<07103>>01420000
<< deallocation. For Private Volume directory only message is>><<07103>>01422000
<< printed. However if DS'PERM'DISABLE is set by INITIAL then>><<07103>>01424000
<< the directory will be disabled permanently.               >><<07103>>01426000
<< It will modify the last and first available pointers in   >><<07103>>01428000
<< sector 0 of the directory bit map. The value of 2 of      >><<07103>>01430000
<< these pointers will indicate that DSM is diabled.         >><<07103>>01432000
<< Additionaly the flag in the Directory Space DST will      >><<07103>>01434000
<< indicate if the system directory is disabled. When the    >><<07103>>01436000
<< DSM of specific directory becomes disabled then a         >><<07103>>01438000
<< following message will be printed on operator console:    >><<07103>>01440000
<< Disc Space Management on LDEV xx is disabled; ERR = y     >><<07103>>01442000
<< where ERR indicates error type (1-write, 2-read and       >><<07103>>01444000
<< 3-space already deallocated, 4-DSM is already disabled).  >><<07103>>01446000
<< This procedure calls also SOFT'DEATH, so for debbuging    >><<07103>>01448000
<< purposes it can be turn to SUDDEN'DEATH when an absolute  >><<07103>>01450000
<< location %1350 bit 15 is set to 1.                        >><<07103>>01452000
<< Some information about error status will be also kept in  >><<07103>>01454000
<< DS data segment.                                          >><<07103>>01456000
<<----------------------------------------------------------->><<07103>>01458000
                                                               <<07103>>01460000
BEGIN                                                          <<07103>>01462000
INTEGER LDEV;                                                  <<07103>>01464000
LOGICAL PERM'DISABLE;                                          <<07103>>01466000
BYTE POINTER BUFFD;                                            <<07103>>01468000
                                                               <<07103>>01470000
IF NOT DS'ERR'IN'PROG THEN                                     <<07103>>01472000
   BEGIN                                                       <<07103>>01474000
   LDEV := DS'LDEV;                                            <<07103>>01476000
   PERM'DISABLE := DS'PERM'DISABLE;                            <<07103>>01478000
                                                               <<07103>>01480000
   <<-------------------------------------------------------->><<07103>>01482000
   << Printing message                                       >><<07103>>01484000
   <<-------------------------------------------------------->><<07103>>01486000
   EXCHANGEDB (0);                                             <<07103>>01488000
   TOS := 0;                                                   <<07103>>01490000
   @BUFFD := @S0 &LSL(1);                                      <<07103>>01492000
   ASSEMBLE (ADDS 50);                                         <<07103>>01494000
   IF (LDEV = 1) OR PERM'DISABLE THEN                          <<07103>>01496000
      BEGIN                                                    <<07103>>01498000
      MOVE BUFFD := "Directory space allocation/",2;           <<07103>>01500000
      MOVE * := "deallocation is disabled on LDEV         ",2; <<07103>>01502000
      END                                                      <<07103>>01504000
   ELSE                                                        <<07103>>01506000
      BEGIN                                                    <<07103>>01508000
      MOVE BUFFD := "Problem with directory space ",2;         <<07103>>01510000
      MOVE * := "allocation/deallocation on LDEV         ",2;  <<07103>>01512000
      END;                                                     <<07103>>01514000
   ASCII (LDEV, -10, BUFFD (S0 - @BUFFD - 8));                 <<07103>>01516000
   CASE * ERR OF                                               <<07103>>01518000
      BEGIN                                                    <<07103>>01520000
      ;                                                        <<07103>>01522000
      MOVE * := "(IO error - write)",2;                        <<07103>>01524000
      MOVE * := "(IO error - read)",2;                         <<07103>>01526000
      MOVE * := "(deallocating free space)",2;                 <<07103>>01528000
      ;                                                        <<07103>>01530000
      END;                                                     <<07103>>01532000
   BUFFD (S0 - @BUFFD) := 0;                                   <<07103>>01534000
   GENMSG (-1, @BUFFD,,,,,,,0);                                <<07103>>01536000
   EXCHANGEDB (DS'DST);                                        <<07103>>01538000
                                                               <<07103>>01540000
   IF DS'ERROR'LDEV <> 1 AND DS'ERROR'TYPE < 4 THEN            <<07103>>01542000
      << Save only first error if system directory           >><<07103>>01544000
      BEGIN                                                    <<07103>>01546000
      DS'ERROR'LDEV := DS'LDEV;                                <<07103>>01548000
      DS'ERROR'TYPE := ERR;                                    <<07103>>01550000
      END;                                                     <<07103>>01552000
                                                               <<07103>>01554000
   DS'DIRTY := FALSE;                                          <<07103>>01556000
   IF DS'PERM'DISABLE THEN                                     <<07103>>01558000
      BEGIN                                                    <<07103>>01560000
      <<----------------------------------------------------->><<07103>>01562000
      << Disable space allocation and deallocation on disc   >><<07103>>01564000
      <<----------------------------------------------------->><<07103>>01566000
      DS'CUR'SECTOR := 0;                                      <<07103>>01568000
      DS'REQ'SECTOR := 1;                                      <<07103>>01570000
      DS'ERR'IN'PROG := TRUE;                                  <<07103>>01572000
      DIRXXXBITMAP (READ);                                     <<07103>>01574000
      IF <= THEN                                               <<07103>>01576000
         BEGIN                                                 <<07103>>01578000
         DS'DIRTY := TRUE;                                     <<07103>>01580000
         DS'DIR'FIRST := DS'DIR'LAST := 2;                     <<07103>>01582000
         DIRXXXBITMAP (WRITE);                                 <<07103>>01584000
         END;                                                  <<07103>>01586000
      DS'ERR'IN'PROG := FALSE;                                 <<07103>>01588000
      END;                                                     <<07103>>01590000
                                                               <<07103>>01592000
   IF DS'LDEV = 1 THEN                                         <<07103>>01594000
      DS'DIR'DISABLED := TRUE      << Only system directory  >><<07103>>01596000
   ELSE                                                        <<07103>>01598000
      DS'LDEV := 0;                << Removable media - P.V. >><<07103>>01600000
                                                               <<07103>>01602000
   SOFT'DEATH (SF);                                            <<07103>>01604000
   END;                                                        <<07103>>01606000
END;                                                           <<07103>>01608000
$PAGE "Directory Space Management - DSM'INIT"                  <<07103>>01610000
LOGICAL PROCEDURE DSM'INIT (DIR'ADDR, SIZE);                   <<07103>>01612000
   VALUE   DIR'ADDR, SIZE;                                     <<07103>>01614000
   LOGICAL SIZE;            << P.V. dir. size                >><<07103>>01616000
   DOUBLE  DIR'ADDR;                                           <<07103>>01618000
   OPTION  PRIVILEGED, UNCALLABLE;                             <<07103>>01620000
                                                               <<07103>>01622000
<<----------------------------------------------------------->><<07103>>01624000
<< This procedure initializes Directory Space Data Segment   >><<07103>>01626000
<< when the directory is switched. If old directory is       >><<07103>>01628000
<< a system directory, then it will save all pointer i.e.    >><<07103>>01630000
<< DS'CUR'SECTOR, DS'LAST'WORD, DS'FIRST'WORD and DS'DIR'SIZE>><<07103>>01632000
<< If new directory is a P.V. directory then the first sec-  >><<07103>>01634000
<< tors of the directory bit map are read into the buffer    >><<07103>>01636000
<< and the directory size is extracted from the disc label.  >><<07103>>01638000
<< Procedure will return FALSE if the directory is diabled.  >><<07103>>01640000
<<----------------------------------------------------------->><<07103>>01642000
                                                               <<07103>>01644000
BEGIN                                                          <<07103>>01646000
INTEGER                                                        <<G7489>>01648000
   DIR'BIT'MAP'WORDS, << Number of words in the bit map.    >> <<G7489>>01650000
   DIR'ADDR0 = DIR'ADDR;                                       <<G7489>>01652000
DEFINE DIR'LDEV = DIR'ADDR0.(0:8)#;                            <<G7489>>01654000
DEFINE EXIT' = DSM'INIT := FALSE;                              <<07103>>01656000
               TOS := EXCHANGEDB (DDSDST);                     <<07103>>01658000
               RETURN#;                                        <<07103>>01660000
                                                               <<07103>>01662000
DSM'INIT := TRUE;          << Directory is O.K.              >><<07103>>01664000
IF DS'DIRTY THEN                                               <<07103>>01666000
   DIRXXXBITMAP (WRITE);                                       <<07103>>01668000
                                                               <<07103>>01670000
IF DIR'LDEV = 1 THEN                                           <<07103>>01672000
   <<-------------------------------------------------------->><<07103>>01674000
   << Switch to system directory                             >><<07103>>01676000
   <<-------------------------------------------------------->><<07103>>01678000
   IF DS'DIR'DISABLED THEN                                     <<07103>>01680000
      BEGIN                                                    <<07103>>01682000
      EXIT';               << Return to caller               >><<07103>>01684000
      END                                                      <<07103>>01686000
   ELSE                                                        <<07103>>01688000
      BEGIN                                                    <<07103>>01690000
      DS'REQ'SECTOR := DS'SYS'CUR;                             <<07103>>01692000
      DS'DIR'SIZE := DS'SYS'SIZE;                              <<07103>>01694000
      END                                                      <<07103>>01696000
ELSE                                                           <<07103>>01698000
   <<-------------------------------------------------------->><<07103>>01700000
   << Switch to Private Volume directory                     >><<07103>>01702000
   <<-------------------------------------------------------->><<07103>>01704000
   BEGIN                                                       <<07103>>01706000
   IF DS'LDEV = 1 THEN                                         <<07103>>01708000
      <<----------------------------------------------------->><<07103>>01710000
      << Save system directory pointers                      >><<07103>>01712000
      <<----------------------------------------------------->><<07103>>01714000
      BEGIN                                                    <<07103>>01716000
      DS'SYS'CUR := DS'CUR'SECTOR;                             <<07103>>01718000
      DS'SYS'LAST := DS'LAST'WORD;                             <<07103>>01720000
      DS'SYS'FIRST := @DS'FIRST'WORD;                          <<07103>>01722000
      DS'SYS'SIZE := DS'DIR'SIZE;                              <<07103>>01724000
      END;                                                     <<07103>>01726000
                                                               <<07103>>01728000
   <<-------------------------------------------------------->><<07103>>01730000
   << If directory size > 6112 sectors then the dircectory   >><<07103>>01732000
   << bit map occupies 32 sectors and only last 3 sectors of >><<07103>>01734000
   << the bit map are represented in directory bit map there->><<07103>>01736000
   << for the DS'DIR'SIZE must be lowered by 29 ( 32 - 3 ).  >><<07103>>01738000
   <<-------------------------------------------------------->><<07103>>01740000
   DS'DIR'SIZE := SIZE;    << Set P.V. dir. size             >><<07103>>01742000
   IF DS'DIR'SIZE > 6112 THEN                                  <<07103>>01744000
      DS'DIR'SIZE := DS'DIR'SIZE - 29;                         <<07103>>01746000
                                                               <<07103>>01748000
   DS'REQ'SECTOR := 1;     << Start from first sector        >><<07103>>01750000
   END;                                                        <<07103>>01752000
                                                               <<07103>>01754000
<<----------------------------------------------------------->><<07103>>01756000
<< Read sectors into the buffer                              >><<07103>>01758000
<<----------------------------------------------------------->><<07103>>01760000
DS'CUR'SECTOR := 0;        << Indicate empty buffer          >><<07103>>01762000
DS'DIR'ADDR := DIR'ADDR;                                       <<07103>>01764000
                                                               <<07103>>01766000
<<----------------------------------------------------------->><<07103>>01768000
<< The dir. address pointed to last 3 sectors of the dir. bit>><<07103>>01770000
<< map. If dir. size is > 6112 (dir. bit map size > 3 sect.) >><<07103>>01772000
<< then the dir. bit map occupies 32 sectors and the dir. bit>><<07103>>01774000
<< map address must be calulated as follow:                  >><<07103>>01776000
<< dir. bit map disc address = dir. disc addr - (32 - 3)     >><<07103>>01778000
<<----------------------------------------------------------->><<07103>>01780000
IF DS'DIR'SIZE > 6112 THEN                                     <<07103>>01782000
   BEGIN                                                       <<07103>>01784000
   DIR'LDEV := 0;                                              <<07103>>01786000
   DIR'ADDR := DIR'ADDR - 29D;                                 <<07103>>01788000
   DIR'LDEV := DS'LDEV;                                        <<07103>>01790000
   DS'DIR'ADDR := DIR'ADDR;                                    <<07103>>01792000
   END;                                                        <<G7489>>01794000
                                                               <<G7489>>01796000
                                                               <<G7489>>01798000
DIR'BIT'MAP'WORDS := ((DS'DIR'SIZE+15)/16)+DS'DIR'HEADER;      <<G7489>>01800000
DS'LAST'SECTOR := (DIR'BIT'MAP'WORDS+127)/128;                 <<G7489>>01802000
                                                               <<G7489>>01804000
DIRXXXBITMAP (READ);       << Read sectors into the buffer   >><<07103>>01806000
IF > THEN                                                      <<07103>>01808000
   BEGIN                                                       <<07103>>01810000
   EXIT';                  << Return to caller               >><<07103>>01812000
   END;                                                        <<07103>>01814000
IF (DS'CUR'SECTOR = 1) AND (DS'DIR'LAST <= 2) THEN             <<07103>>01816000
   << Directory is disabled                                  >><<07103>>01818000
   BEGIN                                                       <<07103>>01820000
   DSM'ERROR (DIRALLOCERR, 4);                                 <<07103>>01822000
   EXIT';                  << Return to caller               >><<07103>>01824000
   END;                                                        <<07103>>01826000
                                                               <<07103>>01828000
IF DS'LDEV = 1 AND DS'SYS'LAST <> 0 THEN                       <<07103>>01830000
   << Reset system directory pointers                        >><<07103>>01832000
   BEGIN                                                       <<07103>>01834000
   DS'LAST'WORD := DS'SYS'LAST;                                <<07103>>01836000
   @DS'FIRST'WORD := DS'SYS'FIRST;                             <<07103>>01838000
   END;                                                        <<07103>>01840000
END;                                                           <<07103>>01842000
$PAGE "Directory Space Management - DIRXXXBITMAP"              <<07103>>01844000
PROCEDURE DIRXXXBITMAP (FUNCTION);                             <<07103>>01846000
   VALUE   FUNCTION;                                           <<07103>>01848000
   INTEGER FUNCTION;                                           <<07103>>01850000
   OPTION  PRIVILEGED, UNCALLABLE;                             <<07103>>01852000
                                                               <<07103>>01854000
<<----------------------------------------------------------->><<07103>>01856000
<< This procedure performs directory bit map IO functions.   >><<07103>>01858000
<< The directory bit map which defines allocated/deallocated >><<07103>>01860000
<< space of directory proceeds the directory contents (index >><<07103>>01862000
<< and entry blocks). Each bit in the bit map represents one >><<07103>>01864000
<< sector of the directory including the directory bit map.  >><<07103>>01866000
<< The bit set to "1" indicates that sector is not used and  >><<07103>>01868000
<< consequently bit set to "0" indicates that sector is used.>><<07103>>01870000
<< The directory can be up to 65000 sectors long i.e. the    >><<07103>>01872000
<< directory bit map can occupied up to 32 sectors on disc.  >><<07103>>01874000
<< The directory space management maintains the bit map in   >><<07103>>01876000
<< DST # %25 called directory space data segment (DS DST).   >><<07103>>01878000
<< The DS data segment have a buffer which can handle up to  >><<07103>>01880000
<< 3 contigious directory bit map sectors. The DS'FIRST'WORD >><<07103>>01882000
<< and DS'LAST'WORD offsets relative to the begining of DS   >><<07103>>01884000
<< data segment represents the limits of the buffer. The     >><<07103>>01886000
<< two words in the begining of the first sector of the bit  >><<07103>>01888000
<< map represent the last and first available word in the    >><<07103>>01890000
<< directory. However, because they are not consistent in    >><<07103>>01892000
<< diffrent MITs we stop using them. They must be kept in    >><<07103>>01894000
<< this sector for compatibility reason. To determine the end>><<07103>>01896000
<< of the directory we will use a directory size value which >><<07103>>01898000
<< can be obtain for the system directory from cold load info>><<07103>>01900000
<< (ldev 1, sector 28, word 20) or from disc label for       >><<07103>>01902000
<< private volumes (master volume ldev, sector 0, word 16).  >><<07103>>01904000
<< The DS'CUR'SECTOR pointer (relative offset to the begin-  >><<07103>>01906000
<< ning of the directory starting from 1) indicates the start>><<07103>>01908000
<< address of current sectors in the DS buffer.              >><<07103>>01910000
<< The DS'REQ'SECTOR pointer indicates (use only when read)  >><<07103>>01912000
<< the sector to be requested by the reader. Two consequtive >><<07103>>01914000
<< reads will overalp last sector i.e. if setors 2, 3 and 4  >><<07103>>01916000
<< are in buffer then the next sectors to be read into the   >><<07103>>01918000
<< buffer, will be 4, 5 and 6. This will allow to handle     >><<07103>>01920000
<< sector spans.                                             >><<07103>>01922000
<< The DIRXXXBITMAP procedure returns following condition    >><<07103>>01924000
<< code:                                                     >><<07103>>01926000
<< - CCE - O.K.                                              >><<07103>>01928000
<< - CCL - requested sectors are beyond the bit map; first   >><<07103>>01930000
<<         sectors of the bit map are placed in the buffer,  >><<07103>>01932000
<< - CCG - IO error and the directory space management for   >><<07103>>01934000
<<         this directory is disabled.                       >><<07103>>01936000
<<----------------------------------------------------------->><<07103>>01938000
                                                               <<07103>>01940000
                                                               <<07103>>01942000
BEGIN                                                          <<07103>>01944000
LOGICAL OUT = FUNCTION;                                        <<07103>>01946000
                                                               <<07103>>01948000
SUBROUTINE DIRDISC (FUNC, ADDR, BUFF, SIZE);                   <<07103>>01950000
   VALUE   FUNC, ADDR, BUFF, SIZE;                             <<07103>>01952000
   INTEGER FUNC, BUFF, SIZE;                                   <<07103>>01954000
   DOUBLE  ADDR;                                               <<07103>>01956000
                                                               <<07103>>01958000
   BEGIN                                                       <<07103>>01960000
   TOS := ATTACHIO (DS'LDEV, 0, DS'DST, BUFF, FUNC, SIZE,      <<07103>>01962000
              DS'ADDR1, DS'ADDR2, %10001);<< Cache serial IO >><<07103>>01964000
   ASSEMBLE (STBX, DEL);                                       <<07103>>01966000
   IF TOS.(13:3) <> 1 THEN                                     <<07103>>01968000
      BEGIN                                                    <<07103>>01970000
      CC := CCG;                                               <<07103>>01972000
      TOS := DIRIOAB;                                          <<07103>>01974000
      IF OUT THEN                                              <<07103>>01976000
         TOS := 1                                              <<07103>>01978000
      ELSE                                                     <<07103>>01980000
         TOS := 2;                                             <<07103>>01982000
      DSM'ERROR (*,*);                                         <<07103>>01984000
      END;                                                     <<07103>>01986000
   END;                                                        <<07103>>01988000
                                                               <<07103>>01990000
LOGICAL SUBROUTINE DISCWRITE;                                  <<07103>>01992000
   BEGIN                                                       <<07103>>01994000
   DISCWRITE := TRUE;                                          <<07103>>01996000
   DS'DIRTY := FALSE;                                          <<07103>>01998000
   DIRDISC (WRITE, DS'ADDR, @DS'BUFFER, DS'SIZE);              <<07103>>02000000
   IF CC <> CCE THEN                                           <<07103>>02002000
      DISCWRITE := FALSE;                                      <<07103>>02004000
   END;                                                        <<07103>>02006000
                                                               <<07103>>02008000
                                                               <<07103>>02010000
CC := CCE;                                                     <<07103>>02012000
                                                               <<07103>>02014000
<<----------------------------------------------------------->><<07103>>02016000
<< Switch to Directory Space Management data segment         >><<07103>>02018000
<<----------------------------------------------------------->><<07103>>02020000
TOS := EXCHANGEDB (DS'DST);                                    <<07103>>02022000
IF NOT (DDSDST <= S0 <= DS'DST) THEN                           <<07103>>02024000
   SYSABORT (DIRBADDST);                                       <<07103>>02026000
                                                               <<07103>>02028000
<<----------------------------------------------------------->><<07103>>02030000
<< Write current buffer contents when flag DIRTY is set ON.  >><<07103>>02032000
<<----------------------------------------------------------->><<07103>>02034000
IF OUT AND DS'DIRTY THEN                                       <<07103>>02036000
   BEGIN                                                       <<07103>>02038000
   DISCWRITE;                                                  <<07103>>02040000
   IF DS'LDEV <> 1 THEN                                        <<07103>>02042000
      DS'LDEV := 0;        << Removable media                >><<07103>>02044000
   END;                                                        <<07103>>02046000
                                                               <<07103>>02048000
<<----------------------------------------------------------->><<07103>>02050000
<< Read bit map sectors into the directory space data segment>><<07103>>02052000
<<----------------------------------------------------------->><<07103>>02054000
IF NOT OUT THEN                                                <<07103>>02056000
   BEGIN                                                       <<07103>>02058000
                                                               <<07103>>02060000
   IF DS'REQ'SECTOR > DS'LAST'SECTOR THEN                      <<07103>>02062000
      <<----------------------------------------------------->><<07103>>02064000
      << Start from the beginnig of the bit map              >><<07103>>02066000
      <<----------------------------------------------------->><<07103>>02068000
      BEGIN                                                    <<07103>>02070000
      CC := CCL;                                               <<07103>>02072000
      DS'REQ'SECTOR := 1;                                      <<07103>>02074000
      END;                                                     <<07103>>02076000
                                                               <<07103>>02078000
   <<-------------------------------------------------------->><<07103>>02080000
   << Set pointer to the first available word in buffer      >><<07103>>02082000
   <<-------------------------------------------------------->><<07103>>02084000
   IF DS'REQ'SECTOR = 1 THEN                                   <<07103>>02086000
      @DS'FIRST'WORD := DS'HEADER + DS'DIR'HEADER              <<07103>>02088000
   ELSE                                                        <<07103>>02090000
      @DS'FIRST'WORD := DS'HEADER;                             <<07103>>02092000
                                                               <<07103>>02094000
   IF (DS'LAST'SECTOR > DS'BUF'SIZE'S) AND                     <<07103>>02096000
      ((DS'REQ'SECTOR < DS'CUR'SECTOR) OR                      <<07103>>02098000
      ((DS'LAST'SECTOR - DS'CUR'SECTOR) >= DS'BUF'SIZE'S) LAND <<07103>>02100000
      (DS'REQ'SECTOR - DS'CUR'SECTOR) >= (DS'BUF'SIZE'S - 1))  <<07103>>02102000
      OR (DS'CUR'SECTOR = 0) THEN                              <<07103>>02104000
      BEGIN                                                    <<07103>>02106000
                                                               <<07103>>02108000
      <<----------------------------------------------------->><<07103>>02110000
      << New sectors are read into the buffer when:          >><<07103>>02112000
      << Directory size > 6000 sectors and requested sector  >><<07103>>02114000
      << has lower address than current segment or the last  >><<07103>>02116000
      << sector of bit map is not in the buffer and the      >><<07103>>02118000
      << requested sector is last in the buffer or initial.  >><<07103>>02120000
      <<----------------------------------------------------->><<07103>>02122000
                                                               <<07103>>02124000
      <<----------------------------------------------------->><<07103>>02126000
      << NOTE. It is potential problem with directory > 6000 >><<07103>>02128000
      << sectors. In such case if the system crash while     >><<07103>>02130000
      << delete account/group is in progress the directory   >><<07103>>02132000
      << bit map and the directory itself can be in inconsis->><<07103>>02134000
      << tent state. The directory deallocates space but     >><<07103>>02136000
      << without forcing updates to be written to the disc.  >><<07103>>02138000
      << However, if the deallocation procedure will require >><<07103>>02140000
      << new sectors to be read into the buffer, the modified>><<07103>>02142000
      << sectors from the buffer will be written to the disc.>><<07103>>02144000
      <<----------------------------------------------------->><<07103>>02146000
                                                               <<07103>>02148000
      IF DS'DIRTY THEN                                         <<07103>>02150000
         DISCWRITE;                                            <<07103>>02152000
                                                               <<07103>>02154000
      <<----------------------------------------------------->><<07103>>02156000
      << Set pointer to last word in buffer                  >><<07103>>02158000
      <<----------------------------------------------------->><<07103>>02160000
      IF (DS'LAST'SECTOR - DS'REQ'SECTOR) >= DS'BUF'SIZE'S THEN<<07103>>02162000
         <<-------------------------------------------------->><<07103>>02164000
         << Directory bit map > 3 sectors (not last sector)  >><<07103>>02166000
         <<-------------------------------------------------->><<07103>>02168000
         DS'LAST'WORD := DS'HEADER + DS'BUF'SIZE'W - 1         <<07103>>02170000
      ELSE                                                     <<07103>>02172000
         DS'LAST'WORD := DS'HEADER + DS'DIR'HEADER - 1 +       <<G7489>>02174000
                         (DS'DIR'SIZE + 15)/16 -               <<G7489>>02176000
                         (DS'REQ'SECTOR-1)*128;                <<G7489>>02178000
                                                               <<07103>>02180000
      <<----------------------------------------------------->><<07103>>02182000
      << Read sectors into the buffer.                       >><<07103>>02184000
      <<----------------------------------------------------->><<07103>>02186000
      DS'CUR'SECTOR := DS'REQ'SECTOR;                          <<07103>>02188000
      DS'ADDR := DS'DIR'ADDR;                                  <<07103>>02190000
      DS'ADDR1 := DS'ADDR1 &LSL(8) &LSR(8);   << Remove ldev >><<07103>>02192000
      DS'ADDR := DS'ADDR + DOUBLE (DS'CUR'SECTOR - 1);         <<07103>>02194000
      DS'SIZE := (((DS'LAST'WORD-DS'HEADER+1)+127)/128)*128;   <<G7489>>02196000
                                                               <<G7489>>02198000
      DIRDISC (READ, DS'ADDR, @DS'BUFFER, DS'SIZE);            <<07103>>02200000
      END;                                                     <<07103>>02202000
   END;                                                        <<07103>>02204000
                                                               <<07103>>02206000
<<----------------------------------------------------------->><<07103>>02208000
<< Switch back to caller DST                                 >><<07103>>02210000
<<----------------------------------------------------------->><<07103>>02212000
ASSEMBLE (ZERO, XCH);         << Reserve word on stack       >><<07103>>02214000
EXCHANGEDB (*);                                                <<07103>>02216000
END;                                                           <<07103>>02218000
$PAGE "Directory Space Management - DIRXXXLLOCATE"             <<07103>>02220000
                                                               <<07103>>02222000
PROCEDURE DIRXXXLLOCATE (PNTR, PPSIZE, SET1);                  <<07103>>02224000
   VALUE   PNTR, PPSIZE, SET1;                                 <<07103>>02226000
   LOGICAL PNTR, SET1;                                         <<07103>>02228000
   INTEGER PPSIZE;                                             <<07103>>02230000
   OPTION  PRIVILEGED, UNCALLABLE;                             <<07103>>02232000
                                                               <<07103>>02234000
<<----------------------------------------------------------->><<07103>>02236000
<< This procedure sets and resets bits in the buffer.        >><<07103>>02238000
<< Input arguments:                                          >><<07103>>02240000
<< PNTR   - sector address relative to DS'DIR,               >><<07103>>02242000
<< PPSIZE - space size,                                      >><<07103>>02244000
<< SET1   - "1" when deallocate or "0" when allocate space.  >><<07103>>02246000
<<----------------------------------------------------------->><<07103>>02248000
                                                               <<07103>>02250000
BEGIN                                                          <<07103>>02252000
LOGICAL POINTER PNTRX = PNTR;                                  <<07103>>02254000
                                                               <<07103>>02256000
<<----------------------------------------------------------->><<07103>>02258000
<< Set buffer word pointer and word bit pointer (X reg.)     >><<07103>>02260000
<<----------------------------------------------------------->><<07103>>02262000
XR := PNTR &LSL(12) &LSR(12);    << Bit offset in the word   >><<07103>>02264000
@PNTRX := DS'HEADER + DS'DIR'HEADER + PNTR &LSR(4) -           <<07103>>02266000
   (DS'CUR'SECTOR - 1) &LSL(7);                                <<07103>>02268000
                                                               <<07103>>02270000
TOS := PNTRX;                << Fetch word from buffer       >><<07103>>02272000
                                                               <<07103>>02274000
WHILE (PPSIZE := PPSIZE - 1) >= 0 DO                           <<07103>>02276000
   BEGIN                                                       <<07103>>02278000
   IF XR = 16 THEN                                             <<07103>>02280000
      <<----------------------------------------------------->><<07103>>02282000
      << Fetch new word                                      >><<07103>>02284000
      <<----------------------------------------------------->><<07103>>02286000
      BEGIN                                                    <<07103>>02288000
      PNTRX := TOS;          << Saved a modified word        >><<07103>>02290000
      @PNTRX := @PNTRX + 1;                                    <<07103>>02292000
      TOS := PNTRX;          << Get new word                 >><<07103>>02294000
      XR := 0;                                                 <<07103>>02296000
      END;                                                     <<07103>>02298000
                                                               <<07103>>02300000
   IF SET1 THEN                                                <<07103>>02302000
      <<----------------------------------------------------->><<07103>>02304000
      << Deallocate - set bit to "1"                         >><<07103>>02306000
      <<----------------------------------------------------->><<07103>>02308000
      BEGIN                                                    <<07103>>02310000
      ASSEMBLE (TSBC 0, X);                                    <<07103>>02312000
      IF <> THEN                                               <<07103>>02314000
         <<-------------------------------------------------->><<07103>>02316000
         << Error exit - space already deallocated           >><<07103>>02318000
         <<-------------------------------------------------->><<07103>>02320000
         BEGIN                                                 <<07103>>02322000
         DSM'ERROR (DIRALLOCERR, 3);                           <<07103>>02324000
         RETURN;                                               <<07103>>02326000
         END;                                                  <<07103>>02328000
      END                                                      <<07103>>02330000
   ELSE                                                        <<07103>>02332000
                                                               <<07103>>02334000
      <<----------------------------------------------------->><<07103>>02336000
      << Allocate - set bit to "0"                           >><<07103>>02338000
      <<----------------------------------------------------->><<07103>>02340000
      ASSEMBLE (TRBC 0, X);                                    <<07103>>02342000
                                                               <<07103>>02344000
   XR := XR + 1;        << Advance bit pointer               >><<07103>>02346000
   END;                                                        <<07103>>02348000
                                                               <<07103>>02350000
PNTRX := TOS;          << Store modified word                >><<07103>>02352000
DS'DIRTY := TRUE;                                              <<07103>>02354000
END;                                                           <<07103>>02356000
$PAGE "Directory Space Management - DIRALLOCATE"               <<07103>>02358000
LOGICAL PROCEDURE DIRALLOCATE (PPSIZE);                        <<07103>>02360000
   VALUE   PPSIZE;                                             <<07103>>02362000
   LOGICAL PPSIZE;                                             <<07103>>02364000
   OPTION  PRIVILEGED, UNCALLABLE;                             <<07103>>02366000
                                                               <<07103>>02368000
<<----------------------------------------------------------->><<07103>>02370000
<< This procedure is looking for a contigious space (size =  >><<07103>>02372000
<< PPSIZE). It starts to exam the bit map sectors which are  >><<07103>>02374000
<< currently in the DS'BUFFER. The relative pointers to DST  >><<07103>>02376000
<< (DS'FIRST'WORD and DS'LAST'WORD) indicate buffer limits.  >><<07103>>02378000
<< If it cannot find the requested space then it will try to >><<07103>>02380000
<< read the next bit map sectors into the buffer. However, it>><<07103>>02382000
<< starts to read from the address of the last sector in the >><<07103>>02384000
<< buffer. This will allow to allocate space between the     >><<07103>>02386000
<< sector bounds. If this procedure reaches the end of the   >><<07103>>02388000
<< directory bit map it will make another pass through the   >><<07103>>02390000
<< directory bit map. If for some reason the directory bit   >><<07103>>02392000
<< map is trashed at the beginnig (space allocated for the   >><<07103>>02394000
<< directory bit map) or at the end (beyond the directory),  >><<07103>>02396000
<< it will not encounter as a valid allocation.              >><<07103>>02398000
<<                                                           >><<07103>>02400000
<< This procedure returns:                                   >><<07103>>02402000
<< - start address of allocated space (relative to the       >><<07103>>02404000
<<   beginning of the directory address).                    >><<07103>>02406000
<< - CCE - O.K.                                              >><<07103>>02408000
<< - CCL - space not available; returns zero address,        >><<07103>>02410000
<< - CCG - requested size too big or directory space         >><<07103>>02412000
<<         allocation disabled; returns zero address.        >><<07103>>02414000
<<----------------------------------------------------------->><<07103>>02416000
                                                               <<07103>>02418000
                                                               <<07103>>02420000
BEGIN                                                          <<07103>>02422000
LOGICAL SIZE;                                                  <<07103>>02424000
DOUBLE DIR'ADDR;                                               <<07103>>02426000
LOGICAL ADDR = DIR'ADDR;                                       <<07103>>02428000
DEFINE  DIR'LDEV = ADDR.(0:8)#;                                <<07103>>02430000
LOGICAL WORD  = S0;     << Tested word from bit map          >><<07103>>02432000
LOGICAL WORDS = S2;     << Tested word from bit map          >><<07103>>02434000
LOGICAL RESULT = DIRALLOCATE;                                  <<07103>>02436000
LOGICAL ONLY'ONE'PASS;                                         <<07103>>02438000
DEFINE  EXIT' = EXCHANGEDB (DDSDST);                           <<07103>>02440000
                RETURN#;                                       <<07103>>02442000
                                                               <<07103>>02444000
LOGICAL SUBROUTINE GET'WORD;                                   <<07103>>02446000
                                                               <<07103>>02448000
   <<-------------------------------------------------------->><<07103>>02450000
   << This subroutine returns non zero word from buffer and  >><<07103>>02452000
   << status TRUE or status FALSE when words in buffer are   >><<07103>>02454000
   << null. The DS'FIRST'WORD and DS'LAST'WORD are the buffer>><<07103>>02456000
   << limits.                                                >><<07103>>02458000
   <<-------------------------------------------------------->><<07103>>02460000
                                                               <<07103>>02462000
   BEGIN                                                       <<07103>>02464000
   WHILE (LOGICAL (@DS'FIRST'WORD) <= DS'LAST'WORD) AND        <<07103>>02466000
         (DS'FIRST'WORD = 0) DO                                <<07103>>02468000
      @DS'FIRST'WORD := @DS'FIRST'WORD + 1;                    <<07103>>02470000
                                                               <<07103>>02472000
   IF LOGICAL (@DS'FIRST'WORD) <= DS'LAST'WORD THEN            <<07103>>02474000
      BEGIN                                                    <<07103>>02476000
      WORDS := DS'FIRST'WORD;                                  <<07103>>02478000
      GET'WORD := TRUE;                                        <<07103>>02480000
      END                                                      <<07103>>02482000
   ELSE                                                        <<07103>>02484000
      BEGIN                                                    <<07103>>02486000
      WORDS := 0;                                              <<07103>>02488000
      GET'WORD := FALSE;                                       <<07103>>02490000
      END;                                                     <<07103>>02492000
   END;                                                        <<07103>>02494000
                                                               <<07103>>02496000
                                                               <<07103>>02498000
<<----------------------------------------------------------->><<07103>>02500000
<< Switch to Directory Space Data Segment                    >><<07103>>02502000
<<----------------------------------------------------------->><<07103>>02504000
SIZE := PV'DIR'SIZE;   << Extract P.V. dir. size in case     >><<07103>>02506000
DIR'ADDR := DIRBASE;   << Directory address from DST # %24   >><<07103>>02508000
IF EXCHANGEDB (DS'DST) <> DDSDST THEN                          <<07103>>02510000
   SYSABORT (DIRBADDST);                                       <<07103>>02512000
                                                               <<07103>>02514000
<<----------------------------------------------------------->><<07103>>02516000
<< Switch to new directory if necessary                      >><<07103>>02518000
<<----------------------------------------------------------->><<07103>>02520000
IF (DIR'LDEV <> DS'LDEV) THEN                                  <<07103>>02522000
   IF NOT DSM'INIT (DIR'ADDR, SIZE) THEN                       <<07103>>02524000
      BEGIN                                                    <<07103>>02526000
      CC := CCG;                                               <<07103>>02528000
      RETURN;          << Directory disabled                 >><<07103>>02530000
      END;                                                     <<07103>>02532000
                                                               <<07103>>02534000
SIZE := 0;             << Initialize size                    >><<07103>>02536000
RESULT := 0;           << Initialize sector address          >><<07103>>02538000
                                                               <<07103>>02540000
<<----------------------------------------------------------->><<07103>>02542000
<< If system directory then check if it is not disabled      >><<07103>>02544000
<<----------------------------------------------------------->><<07103>>02546000
IF (DS'LDEV = 1) AND DS'DIR'DISABLED THEN                      <<07103>>02548000
   BEGIN                                                       <<07103>>02550000
   DSM'ERROR (DIRALLOCERR, 4);       << Msg. - dir. disabled >><<07103>>02552000
   CC := CCG;                                                  <<07103>>02554000
   EXIT';                            << Return to caller     >><<07103>>02556000
   END;                                                        <<07103>>02558000
                                                               <<07103>>02560000
                                                               <<07103>>02562000
TOS := 0;              << Reserved word on stack for testing >><<07103>>02564000
                                                               <<07103>>02566000
DO                                                             <<07103>>02568000
   BEGIN                                                       <<07103>>02570000
   IF (DS'CUR'SECTOR = 1) AND (LOGICAL (@DS'FIRST'WORD) =      <<07103>>02572000
      DS'HEADER + DS'DIR'HEADER) THEN                          <<07103>>02574000
      <<----------------------------------------------------->><<07103>>02576000
      << Only one pass through directory bit map             >><<07103>>02578000
      <<----------------------------------------------------->><<07103>>02580000
      ONLY'ONE'PASS := TRUE                                    <<07103>>02582000
   ELSE                                                        <<07103>>02584000
      <<----------------------------------------------------->><<07103>>02586000
      << Two passes through directory bit map if necessary   >><<07103>>02588000
      <<----------------------------------------------------->><<07103>>02590000
      ONLY'ONE'PASS := FALSE;                                  <<07103>>02592000
                                                               <<07103>>02594000
   DO                                                          <<07103>>02596000
      <<----------------------------------------------------->><<07103>>02598000
      << Scan the bit map directory                          >><<07103>>02600000
      <<----------------------------------------------------->><<07103>>02602000
      BEGIN                                                    <<07103>>02604000
      WHILE GET'WORD DO                                        <<07103>>02606000
         <<-------------------------------------------------->><<07103>>02608000
         << Scan words in the buffer                         >><<07103>>02610000
         <<-------------------------------------------------->><<07103>>02612000
         BEGIN                                                 <<07103>>02614000
         <<-------------------------------------------------->><<07103>>02616000
         << Set sector address DS'DIR relative               >><<07103>>02618000
         <<-------------------------------------------------->><<07103>>02620000
         XR := ((DS'CUR'SECTOR - 1) &LSL(7) - DS'DIR'HEADER +  <<07103>>02622000
            LOGICAL (@DS'FIRST'WORD) - DS'HEADER) &LSL(4) - 1; <<07103>>02624000
         WHILE WORD <> 0 DO  << WHILE does not modify X reg. >><<07103>>02626000
            BEGIN                                              <<07103>>02628000
            <<----------------------------------------------->><<07103>>02630000
            << Scan word                                     >><<07103>>02632000
            <<----------------------------------------------->><<07103>>02634000
            ASSEMBLE (SCAN ,X);                                <<07103>>02636000
            <<----------------------------------------------->><<07103>>02638000
            << Check results                                 >><<07103>>02640000
            <<----------------------------------------------->><<07103>>02642000
            IF 3 <= XR AND XR < DS'DIR'SIZE THEN  << Valid ? >><<07103>>02644000
               BEGIN                                           <<07103>>02646000
               IF (RESULT + SIZE) = XR THEN    << Contigious >><<07103>>02648000
                  SIZE := SIZE + 1                             <<07103>>02650000
               ELSE                                            <<07103>>02652000
                  BEGIN                << Reset pointers     >><<07103>>02654000
                  RESULT := XR;                                <<07103>>02656000
                  SIZE := 1;                                   <<07103>>02658000
                  END;                                         <<07103>>02660000
               IF SIZE = PPSIZE THEN   << Allocate           >><<07103>>02662000
                  <<----------------------------------------->><<07103>>02664000
                  << Exit - space allocated                  >><<07103>>02666000
                  <<----------------------------------------->><<07103>>02668000
                  BEGIN                                        <<07103>>02670000
                  DIRXXXLLOCATE (RESULT, PPSIZE, 0);           <<07103>>02672000
                  CC := CCE;                                   <<07103>>02674000
                  EXIT';         << Return to caller         >><<07103>>02676000
                  END;                                         <<07103>>02678000
               END;                                            <<07103>>02680000
            END;                                               <<07103>>02682000
         @DS'FIRST'WORD := @DS'FIRST'WORD + 1;  << Next word >><<07103>>02684000
         END;                                                  <<07103>>02686000
      <<----------------------------------------------------->><<07103>>02688000
      << Read next sectors into the buffer                   >><<07103>>02690000
      <<----------------------------------------------------->><<07103>>02692000
      DS'REQ'SECTOR := DS'CUR'SECTOR + DS'BUF'SIZE'S;          <<07103>>02694000
      IF ((DS'HEADER + DS'DIR'HEADER + RESULT &LSR(4) -        <<07103>>02696000
         (DS'CUR'SECTOR - 1) &LSL(7)) = DS'LAST'WORD) AND      <<07103>>02698000
         (DS'REQ'SECTOR <= DS'LAST'SECTOR) THEN                <<07103>>02700000
         BEGIN                                                 <<07103>>02702000
         <<-------------------------------------------------->><<07103>>02704000
         << Sectors span - valid only for PPSIZE <= 16       >><<07103>>02706000
         <<-------------------------------------------------->><<07103>>02708000
         DS'REQ'SECTOR := DS'REQ'SECTOR - 1;                   <<07103>>02710000
         RESULT := SIZE := 0;      << Start from beginning   >><<07103>>02712000
         END;                                                  <<07103>>02714000
      DIRXXXBITMAP (READ);                                     <<07103>>02716000
      END                                                      <<07103>>02718000
   UNTIL <>;           << Until reach the end of the bit map >><<07103>>02720000
   IF > THEN                                                   <<07103>>02722000
      <<----------------------------------------------------->><<07103>>02724000
      << Exit - space is not allocated - IO error            >><<07103>>02726000
      <<----------------------------------------------------->><<07103>>02728000
      BEGIN                                                    <<07103>>02730000
      RESULT := 0;                                             <<07103>>02732000
      CC := CCG;                                               <<07103>>02734000
      EXIT';               << Return to caller               >><<07103>>02736000
      END;                                                     <<07103>>02738000
                                                               <<07103>>02740000
   END                                                         <<07103>>02742000
UNTIL ONLY'ONE'PASS;                                           <<07103>>02744000
<<----------------------------------------------------------->><<07103>>02746000
<< Exit - space is not available                             >><<07103>>02748000
<<----------------------------------------------------------->><<07103>>02750000
RESULT := 0;                                                   <<07103>>02752000
CC := CCL;                                                     <<07103>>02754000
EXCHANGEDB (DDSDST);            << Switch back to DST # %24  >><<07103>>02756000
END;                                                           <<07103>>02758000
$PAGE "Directory Space Management - DIRDEALLOCATE"             <<07103>>02760000
                                                               <<07103>>02762000
PROCEDURE DIRDEALLOCATE (PNTR, PPSIZE);                        <<07103>>02764000
   VALUE    PNTR, PPSIZE;                                      <<07103>>02766000
   LOGICAL  PNTR, PPSIZE;                                      <<07103>>02768000
   OPTION   PRIVILEGED, UNCALLABLE;                            <<07103>>02770000
                                                               <<07103>>02772000
<<----------------------------------------------------------->><<07103>>02774000
<< This procedure deallocates directory space                >><<07103>>02776000
<< Input arguments:                                          >><<07103>>02778000
<< PNTR - sector address relative to DS'DIR,                 >><<07103>>02780000
<< PPSIZE - size of deallocated space.                       >><<07103>>02782000
<<----------------------------------------------------------->><<07103>>02784000
                                                               <<07103>>02786000
BEGIN                                                          <<07103>>02788000
DOUBLE DIR'ADDR;                                               <<07103>>02790000
LOGICAL ADDR = DIR'ADDR;                                       <<07103>>02792000
DEFINE  DIR'LDEV = ADDR.(0:8)#;                                <<07103>>02794000
LOGICAL WORD'PNTR;      << Word offset into diretory bit map >><<07103>>02796000
LOGICAL SIZE = WORD'PNTR;    << Used for P.V. dir. size      >><<07103>>02798000
DEFINE  EXIT' = EXCHANGEDB (DDSDST);                           <<07103>>02800000
                RETURN#;                                       <<07103>>02802000
                                                               <<07103>>02804000
<<----------------------------------------------------------->><<07103>>02806000
<< Switch to Directory Space Data Segment                    >><<07103>>02808000
<<----------------------------------------------------------->><<07103>>02810000
SIZE := PV'DIR'SIZE;   << Extract P.V. dir. size in case     >><<07103>>02812000
DIR'ADDR := DIRBASE;                                           <<07103>>02814000
IF EXCHANGEDB (DS'DST) <> DDSDST THEN                          <<07103>>02816000
   SYSABORT (DIRBADDST);                                       <<07103>>02818000
                                                               <<07103>>02820000
<<----------------------------------------------------------->><<07103>>02822000
<< Switch to new directory if necessary                      >><<07103>>02824000
<<----------------------------------------------------------->><<07103>>02826000
IF (DIR'LDEV <> DS'LDEV) THEN                                  <<07103>>02828000
   IF NOT DSM'INIT (DIR'ADDR, SIZE) THEN                       <<07103>>02830000
      RETURN;                                                  <<07103>>02832000
                                                               <<07103>>02834000
<<----------------------------------------------------------->><<07103>>02836000
<< If system directory then check if it not disabled or if   >><<07103>>02838000
<< PNTR points to bit map or beyond directory then exit.     >><<07103>>02840000
<<----------------------------------------------------------->><<07103>>02842000
IF (DS'LDEV = 1) AND DS'DIR'DISABLED OR                        <<07103>>02844000
   (PNTR + PPSIZE) > DS'DIR'SIZE OR                            <<07103>>02846000
   (PNTR < 3) THEN                                             <<07103>>02848000
   BEGIN                                                       <<07103>>02850000
   DSM'ERROR (DIRALLOCERR, 4);                                 <<07103>>02852000
   EXIT';               << Return to caller                  >><<07103>>02854000
   END;                                                        <<07103>>02856000
                                                               <<07103>>02858000
WORD'PNTR := PNTR &LSR(4) + DS'DIR'HEADER;  << Buffer pntr   >><<07103>>02860000
                                                               <<07103>>02862000
<<----------------------------------------------------------->><<07103>>02864000
<< Check if returned space belongs to sectors in the buffer  >><<07103>>02866000
<<----------------------------------------------------------->><<07103>>02868000
IF NOT (((WORD'PNTR &LSR(7) + 1) >= DS'CUR'SECTOR) LAND        <<07103>>02870000
   (((PNTR + PPSIZE - 1) &LSR(4) + DS'DIR'HEADER) &LSR(7) + 1) <<07103>>02872000
   < (DS'CUR'SECTOR + DS'BUF'SIZE'S)) THEN                     <<07103>>02874000
   <<-------------------------------------------------------->><<07103>>02876000
   << Read new sectors into the buffer if necessary          >><<07103>>02878000
   <<-------------------------------------------------------->><<07103>>02880000
   BEGIN                                                       <<07103>>02882000
   DS'REQ'SECTOR := WORD'PNTR &LSR(7) + 1;                     <<07103>>02884000
   DIRXXXBITMAP (READ);                                        <<07103>>02886000
   IF > THEN                                                   <<07103>>02888000
      <<----------------------------------------------------->><<07103>>02890000
      << Exit error                                          >><<07103>>02892000
      <<----------------------------------------------------->><<07103>>02894000
      BEGIN                                                    <<07103>>02896000
      EXIT';                << Return to caller              >><<07103>>02898000
      END;                                                     <<07103>>02900000
   END;                                                        <<07103>>02902000
                                                               <<07103>>02904000
<<----------------------------------------------------------->><<07103>>02906000
<< Reset bits in the buffer                                  >><<07103>>02908000
<<----------------------------------------------------------->><<07103>>02910000
DIRXXXLLOCATE (PNTR, PPSIZE, 1);                               <<07103>>02912000
                                                               <<07103>>02914000
IF (LOGICAL (@DS'FIRST'WORD) - DS'HEADER) >                    <<07103>>02916000
   (WORD'PNTR - (DS'CUR'SECTOR - 1) &LSL(7)) THEN              <<07103>>02918000
   <<-------------------------------------------------------->><<07103>>02920000
   << Reset the DS'FIRST'WORD pointer                        >><<07103>>02922000
   <<-------------------------------------------------------->><<07103>>02924000
   @DS'FIRST'WORD := WORD'PNTR - (DS'CUR'SECTOR - 1) &LSL(7) + <<07103>>02926000
      DS'HEADER;                                               <<07103>>02928000
                                                               <<07103>>02930000
EXCHANGEDB (DDSDST);      << Return to directory DST (%24)   >><<07103>>02932000
END;                                                           <<07103>>02934000
$PAGE "Directory Data Management Routines"                     <<07103>>02936000
<<***********************************************************>><<07103>>02938000
<<                                                           >><<07103>>02940000
<<              DIRECTORY  DATA  MANAGEMENT                  >><<07103>>02942000
<<                                                           >><<07103>>02944000
<<***********************************************************>><<07103>>02946000
                                                               <<07103>>02948000
                                                               <<07103>>02950000
                                                                        02952000
PROCEDURE DIRWRITE (WHICH);                                             02954000
   VALUE WHICH;                                                         02956000
   LOGICAL WHICH;                                                       02958000
   OPTIONS;                                                             02960000
                                                                        02962000
BEGIN                                                                   02964000
   INTEGER TEMP = WHICH;                                                02966000
   LOGICAL POINTER TEMPP;                                               02968000
<< >>                                                                   02970000
   @BASE := IF WHICH THEN @DBPREPRE ELSE @DAPREPRE;                     02972000
   WHICHDIRTY := FALSE;                                                 02974000
   @TEMPP := BASE(IOPNTR);                                              02976000
   TOS := BASE(USED);                                                   02978000
   IF BASE(MISCWD).(TYPEF) = INDEXTYPE THEN                             02980000
      BEGIN                                                             02982000
      MOVE TEMPP := BASE(MISCWD), (PRESIZE);                            02984000
      TOS := TOS+PRESIZE;                                               02986000
      END;                                                              02988000
   ASSEMBLE (TEST);                                                     02990000
   IF = THEN RETURN;                                                    02992000
   TEMP := TOS;                                                         02994000
   TOS := 0D;                                                           02996000
   TOS := BASE (DIRBASE').(0:8);                               <<01.PV>>02998000
   TOS := 0;                                                            03000000
   TOS := DDSDST;                                                       03002000
   TOS := @TEMPP;                                                       03004000
   TOS := 1;                                                            03006000
   TOS := TEMP;                                                         03008000
   TOS := BASE (DIRBASE1').(8:8);                              <<01.PV>>03010000
   TOS := BASE (DIRBASE2');                                    <<01.PV>>03012000
   TOS := 0;          TOS := IBASE(CONTENTS);                           03014000
   ASMB(DADD);                                                          03016000
$IF X0=ON                                                      <<DEBUG>>03018000
   IF IBASE (CONTENTS) <= 0 THEN DEBUG;                        <<DEBUG>>03020000
$IF                                                            <<DEBUG>>03022000
   TOS := ATTACHIO (*,*,*,*,*,*,*,*,DIRIO);                    <<DE>>   03024000
   ASSEMBLE (STBX, DEL);                                                03026000
   IF TOS.(13:3) <> 1 THEN SYSABORT(DIRIOAB);                           03028000
   END    <<DIRWRITE>>;                                                 03030000
                                                                        03032000
                                                                        03034000
                                                                        03036000
                                                                        03038000
PROCEDURE DIRREAD (PNTR, WHICH, EXCOUNT, EEMISCWD);                     03040000
   VALUE PNTR, WHICH, EXCOUNT, EEMISCWD;                                03042000
   LOGICAL PNTR, WHICH, EEMISCWD;                                       03044000
   INTEGER EXCOUNT;                                                     03046000
   OPTIONS;                                                             03048000
                                                               <<DE>>   03050000
BEGIN                                                          <<DE>>   03052000
   LOGICAL TEMP;                                                        03054000
   LOGICAL POINTER TEMPP;                                               03056000
<< >>                                                                   03058000
   @BASE := IF WHICH THEN @DBPREPRE ELSE @DAPREPRE;                     03060000
   IF BASE (CONTENTS) = PNTR AND                               <<43.PV>>03062000
      DBASE (DIRBASE') = DIRBASE THEN RETURN;                  <<43.PV>>03064000
   IF WHICHDIRTY THEN DIRWRITE (WHICH);                                 03066000
   @TEMPP := BASE(IOPNTR);                                              03068000
READIN:                                                                 03070000
   TOS := 0D;                                                           03072000
   TOS := DIRLDEV;                                             <<01.PV>>03074000
   TOS := 0;                                                            03076000
   TOS := DDSDST;                                                       03078000
   TOS := @TEMPP;                                                       03080000
   TOS := 0;                                                            03082000
   TOS := DDSBWSIZE;                                                    03084000
   TOS := DIRBASE1.(8:8);                                      <<01.PV>>03086000
   TOS := DIRBASE2;                                            <<01.PV>>03088000
   TOS := 0;                                                   <<DE>>   03090000
   TOS := PNTR;                                                <<DE>>   03092000
   ASMB(DADD);                                                          03094000
$IF X0=ON                                                      <<DEBUG>>03096000
   IF IPNTR <= 0 THEN DEBUG;                                   <<DEBUG>>03098000
$IF                                                            <<DEBUG>>03100000
   TOS := ATTACHIO (*,*,*,*,*,*,*,*,DIRIO);                    <<DE>>   03102000
   ASSEMBLE (STBX, DEL);                                                03104000
   IF TOS.(13:3) <> 1 THEN SYSABORT(DIRIOAB);                           03106000
   TEMP := DDSBSIZE;                                                    03108000
SETUP:                                                                  03110000
   DBASE (DIRBASE') := DIRBASE;                                <<10.PV>>03112000
   BASE (CONTENTS) := PNTR;                                             03114000
   BASE (NUMVALID) := TEMP;                                             03116000
   IF TEMPP.(TYPEF) = INDEXTYPE THEN                                    03118000
      BEGIN                                                             03120000
      MOVE BASE(MISCWD) := TEMPP, (PRESIZE);                            03122000
      TEMP := PRESIZE;                                                  03124000
      END                                                               03126000
   ELSE                                                                 03128000
      BEGIN                                                             03130000
      BASE(XCOUNT) := EXCOUNT;                                          03132000
      BASE(MISCWD) := EEMISCWD;                                         03134000
      TEMP := 0;                                                        03136000
      END;                                                              03138000
   BASE (LPNTR) := @TEMPP+INTEGER(TEMP);                                03140000
   BASE(USED) := (BASE(XSIZE) := BASE(MISCWD).(XSIZEF)) * BASE(XCOUNT); 03142000
   BASE(BFACTOR) := ((BASE(BWSIZE) := (BASE(BSIZE)                      03144000
      := BASE(MISCWD).(BSIZEF)) & LSL(7)) - TEMP) / BASE(XSIZE);        03146000
   END <<DIRREAD>>;                                                     03148000
                                                               <<07102>>03150000
PROCEDURE DIR'GR'LINK (INDEX);                                 <<07102>>03152000
   VALUE   INDEX;                                              <<07102>>03154000
   LOGICAL INDEX;           << Old group index pointer       >><<07102>>03156000
   OPTIONS;                                                    <<07102>>03158000
                                                               <<07102>>03160000
<<----------------------------------------------------------->><<07102>>03162000
<< This procedure updates the group index (father) pointer in>><<07102>>03164000
<< file index blocks belonging to the same account. It also  >><<07102>>03166000
<< updates the group index pointer in the JITs of all pro-   >><<07102>>03168000
<< cesses logon to the same account. The directory area B    >><<07102>>03170000
<< conteined a new group index block when exit from this pro->><<07102>>03172000
<< cedure. The area A contents will be undefined.            >><<07102>>03174000
<<----------------------------------------------------------->><<07102>>03176000
                                                               <<07102>>03178000
BEGIN                                                          <<07102>>03180000
INTEGER PCBPT;                                                 <<07102>>03182000
INTEGER CNT;                                                   <<07102>>03184000
INTEGER JMATINX = CNT;                                         <<07102>>03186000
DEFINE  PCBGLOBLOC = 0#;                                       <<07102>>03188000
INTEGER JMSIZE;             << JMAT size in words            >><<07102>>03190000
INTEGER XTCOUNT;            << Number of accessors           >><<07102>>03192000
LOGICAL NEW'INDEX;          << New group index pointer       >><<07102>>03194000
LOGICAL MISC;               << MISCW word from index block   >><<07102>>03196000
INTEGER IND'COUNT;          << Number of indexes in index blk>><<07102>>03198000
LOGICAL A'PNTR;             << Addr. of A contents           >><<07102>>03200000
LOGICAL A'COUNT;            << # of entries in A             >><<07102>>03202000
LOGICAL POINTER PNTR;       << Working pointer               >><<07102>>03204000
INTEGER POINTER ECNT;       << Entry count                   >><<07102>>03206000
LOGICAL POINTER LINK;                                          <<07102>>03208000
LOGICAL ARRAY JMATARR (*) = DB + 0;                            <<07102>>03210000
LOGICAL ARRAY JITARR (*)  = DB + 0;                            <<07102>>03212000
LOGICAL ARRAY QARRAY (*)  = DB + 0;                            <<07102>>03214000
EQUATE                << JMAT job states >>                    <<*8805>>03216000
   FREE'ENTRY = 0,                                             <<*8805>>03218000
   WAIT'STATE = %40;                                           <<*8805>>03220000
                                                               <<07102>>03222000
NEW'INDEX := DBCONTENTS;    << Index block address           >><<07102>>03224000
IND'COUNT := DBXCOUNT;                                         <<07102>>03226000
XTCOUNT := DBPCOUNT;        << Number of accessors           >><<07102>>03228000
MISC := DBEMISCWD;          << Save B misc. word             >><<07102>>03230000
A'PNTR := DACONTENTS;       << Save addr. of A contents      >><<07102>>03232000
A'COUNT := DAXCOUNT;        << Save count of A               >><<07102>>03234000
                                                               <<07102>>03236000
<<----------------------------------------------------------->><<07102>>03238000
<< Examine all entries in index block                        >><<07102>>03240000
<<----------------------------------------------------------->><<07102>>03242000
WHILE (IND'COUNT := IND'COUNT - 1) >= 0 DO                     <<07102>>03244000
   BEGIN                                                       <<07102>>03246000
   @PNTR := @DBLPNTR + IND'COUNT * ISIZE;           << Entry >><<07102>>03248000
   @ECNT := @PNTR + IECOUNT;  << # of entries in entry block >><<07102>>03250000
   @PNTR := @PNTR + IEPNTR;   << Entry block address         >><<07102>>03252000
   <<-------------------------------------------------------->><<07102>>03254000
   << Read entry block                                       >><<07102>>03256000
   <<-------------------------------------------------------->><<07102>>03258000
   DIRREAD (PNTR, A, ECNT, MISC);                              <<07102>>03260000
   <<-------------------------------------------------------->><<07102>>03262000
   << Update father pointers in the file index blocks        >><<07102>>03264000
   <<-------------------------------------------------------->><<07102>>03266000
   CNT := ECNT;      << Saved count because B will be dstr   >><<07102>>03268000
   WHILE (CNT := CNT - 1) >= 0 DO                              <<07102>>03270000
      BEGIN                                                    <<07102>>03272000
      @PNTR := @DALPNTR + CNT * GSIZE;             << Entry  >><<07102>>03274000
      @LINK := @PNTR + GLINKAGE;                               <<07102>>03276000
      <<----------------------------------------------------->><<07102>>03278000
      << If system group entry of private volume and active  >><<07102>>03280000
      << then use saved system file index pointer.           >><<07102>>03282000
      <<----------------------------------------------------->><<07102>>03284000
      IF LINK.(PVF) AND (LINK.(MVTABXF) <> 0) THEN             <<07102>>03286000
         @PNTR := @PNTR + GSAVEFIPNTR                          <<07102>>03288000
      ELSE                                                     <<07102>>03290000
         @PNTR := @PNTR + GFIPNTR;                             <<07102>>03292000
      IF PNTR <> 0 THEN                                        <<07102>>03294000
         <<-------------------------------------------------->><<07102>>03296000
         << Read and update the file index block             >><<07102>>03298000
         <<-------------------------------------------------->><<07102>>03300000
         BEGIN                                                 <<07102>>03302000
         DIRREAD (PNTR, B, 0, 0);                              <<07102>>03304000
         DBPINDEXP := NEW'INDEX;                               <<07102>>03306000
         DIRWRITE (B);                                         <<07102>>03308000
         END;                                                  <<07102>>03310000
      END;                                                     <<07102>>03312000
   <<-------------------------------------------------------->><<07102>>03314000
   << Restore in B the group index block                     >><<07102>>03316000
   <<-------------------------------------------------------->><<07102>>03318000
   DIRREAD (NEW'INDEX, B, 0, 0);                               <<07102>>03320000
   END;                                                        <<07102>>03322000
DIRREAD (A'PNTR, A, A'COUNT, DBEMISCWD);  << Restore A       >><<07102>>03324000
                                                               <<07102>>03326000
IF DIRLDEV = SYSLDEV THEN                                      <<07102>>03328000
   BEGIN                                                       <<07102>>03330000
   <<-------------------------------------------------------->><<07102>>03332000
   << For system group index blocks check all main processes >><<07102>>03334000
   << if they belong to the same account and if so update    >><<07102>>03336000
   << group index pointer in JIT.                            >><<07102>>03338000
   <<-------------------------------------------------------->><<07102>>03340000
   EXCHANGEDB (JMATDST);                                       <<07102>>03342000
   JMSIZE := JMATCURSIZE &LSL(7);   << JMAT size in words    >><<07102>>03344000
   JMATINX := JMATENTRYPTR;                                    <<07102>>03346000
                                                               <<07102>>03348000
   DO                                                          <<07102>>03350000
      IF (JMATJOBSTATE <> FREE'ENTRY LAND                      <<*8805>>03352000
          JMATJOBSTATE <> WAIT'STATE) THEN                     <<*8805>>03354000
         BEGIN                                                 <<07102>>03356000
         PCBPT := JMATMAINPIN * PCBSIZE;                       <<07102>>03358000
         EXCHANGEDB (SPCBSTKDST);   << Switch to process stk >><<07102>>03360000
         EXCHANGEDB (PXG'JITDST);   << Switch to JIT DST     >><<07102>>03362000
         IF JITAIP2 = INDEX THEN   << Update sys. gr. index p>><<07102>>03364000
            BEGIN                                              <<07102>>03366000
            XTCOUNT := XTCOUNT - 1;                            <<07102>>03368000
            JITAIP2 := NEW'INDEX;                              <<07102>>03370000
            END;                                               <<07102>>03372000
         EXCHANGEDB (JMATDST);   << Switch back to JMAT DST  >><<07102>>03374000
         END                                                   <<07102>>03376000
      UNTIL ((JMATINX := JMATINX + JMATENTRYSIZE) > JMSIZE OR  <<07102>>03378000
            XTCOUNT = 0);                                      <<07102>>03380000
   END;                                                        <<07102>>03382000
                                                               <<07102>>03384000
EXCHANGEDB (DDSDST);             << Switch back to DIR DST   >><<07102>>03386000
END;   << DIR'GR'LINK >>                                       <<07102>>03388000
                                                               <<07102>>03390000
LOGICAL PROCEDURE DIR'EXP'INDEX'BLK (LINK);                    <<07102>>03392000
   VALUE   LINK;                                               <<07102>>03394000
   LOGICAL LINK;                                               <<07102>>03396000
   OPTIONS;                                                    <<07102>>03398000
                                                               <<07102>>03400000
<<----------------------------------------------------------->><<07102>>03402000
<< This procedure expands index block and links the block to >><<07102>>03404000
<< the father. If space for new index block is not available >><<07102>>03406000
<< or existing block has already maximum size, it returns    >><<07102>>03408000
<< FALSE. The consider index block must be in directory A    >><<07102>>03410000
<< area. This procedure uses A and B area. When exit the B   >><<07102>>03412000
<< area will contain the new index block and the A area will >><<07102>>03414000
<< have father group block (account).                        >><<07102>>03416000
<<----------------------------------------------------------->><<07102>>03418000
                                                               <<07102>>03420000
BEGIN                                                          <<07102>>03422000
INTEGER NEW'INDEX;                                             <<07102>>03424000
LOGICAL INDEX;                                                 <<07102>>03426000
LOGICAL POINTER PNTR;                                          <<07102>>03428000
LOGICAL A'PNTR;             << Addr. of A contents           >><<07102>>03430000
LOGICAL A'COUNT;            << # of entries in A             >><<07102>>03432000
LOGICAL RETURN'VALUE = DIR'EXP'INDEX'BLK;                      <<07102>>03434000
ARRAY   NAME (0 : NAMESIZE - 1) = Q;                           <<07102>>03436000
                                                               <<07102>>03438000
RETURN'VALUE := TRUE;                                          <<07102>>03440000
IF DBBSIZE >= DDSBSIZE THEN                                    <<07102>>03442000
   BEGIN                                                       <<07102>>03444000
   RETURN'VALUE := FALSE;                                      <<07102>>03446000
   RETURN;                                                     <<07102>>03448000
   END;                                                        <<07102>>03450000
                                                               <<07102>>03452000
<<----------------------------------------------------------->><<07102>>03454000
<< Allocate space for new index block and write to disc      >><<07102>>03456000
<<----------------------------------------------------------->><<07102>>03458000
NEW'INDEX := DIRALLOCATE (DBBSIZE + 1);                        <<07102>>03460000
IF <> THEN                                                     <<07102>>03462000
   BEGIN                                                       <<07102>>03464000
   RETURN'VALUE := FALSE;                                      <<07102>>03466000
   RETURN;                                                     <<07102>>03468000
   END;                                                        <<07102>>03470000
INDEX := DBCONTENTS;                 << Save old index pnt   >><<07102>>03472000
DBCONTENTS := NEW'INDEX;             << Set new index pointer>><<07102>>03474000
DBMISCWD.(BSIZEF) := DBBSIZE + 1;    << Set new size         >><<07102>>03476000
DIRWRITE (B);                        << Write block on disc  >><<07102>>03478000
DIRXXXBITMAP (WRITE);                << Update bit map       >><<07102>>03480000
A'PNTR := DACONTENTS;                << Save addr. of A      >><<07102>>03482000
A'COUNT := DAXCOUNT;                 << Save count of A      >><<07102>>03484000
                                                               <<07102>>03486000
<<----------------------------------------------------------->><<07102>>03488000
<< Link father to index block                                >><<07102>>03490000
<<----------------------------------------------------------->><<07102>>03492000
MOVE NAME := DDSNAME, (NAMESIZE);    << Save name            >><<07102>>03494000
MOVE DDSNAME := DBPNAME, (NAMESIZE); << Extract father name  >><<07102>>03496000
TOS := DIRFIND (DBPINDEXP);          << Find father          >><<07102>>03498000
MOVE DDSNAME := NAME, (NAMESIZE);    << Restore name         >><<07102>>03500000
@PNTR := TOS + LINK;                 << Addr. of index pntr  >><<07102>>03502000
PNTR := NEW'INDEX;                   << Set new index pntr   >><<07102>>03504000
DIRWRITE (A);                        << Update on disc       >><<07102>>03506000
DIRREAD (NEW'INDEX, B, 0, 0);        << New index block in B >><<07102>>03508000
DIRREAD (A'PNTR, A, A'COUNT, DBEMISCWD); << Restore A        >><<07102>>03510000
DIRDEALLOCATE (INDEX, (DBBSIZE - 1));<< Return old space     >><<07102>>03512000
DIRXXXBITMAP (WRITE);                                          <<07102>>03514000
END;                                                           <<07102>>03516000
                                                               <<07102>>03518000
LOGICAL PROCEDURE DIR'EXPAND'INDEX;                            <<07102>>03520000
   OPTION UNCALLABLE;                                          <<*7869>>03522000
                                                               <<07102>>03524000
<<----------------------------------------------------------->><<07102>>03526000
<< This procedure allows to expand number of groups and users>><<07102>>03528000
<< per account. It can be done by increasing size of group or>><<07102>>03530000
<< user index block. Increasing size of file index block is  >><<07102>>03532000
<< far more difficult (very complicated for private volumes).>><<07102>>03534000
<< When the group index block is increased the JMAT must be  >><<07102>>03536000
<< locked prior to the directory (DIR SIR).                  >><<07102>>03538000
<<----------------------------------------------------------->><<07102>>03540000
                                                               <<07102>>03542000
BEGIN                                                          <<07102>>03544000
DEFINE  SIRTABINX = JMATSIR * SIRTABENTRYLENGTH#;              <<07102>>03546000
LOGICAL OLD'INDEX;                 << Old index block pointer>><<07102>>03548000
LOGICAL RETURN'VALUE = DIR'EXPAND'INDEX;                       <<07102>>03550000
                                                               <<07102>>03552000
RETURN'VALUE := FALSE;                                         <<07102>>03554000
OLD'INDEX := DBCONTENTS;                                       <<07102>>03556000
CASE * DBELEVEL OF                                             <<07102>>03558000
   BEGIN                                                       <<07102>>03560000
   <<-------------------------------------------------------->><<07102>>03562000
   << File level - expansion disallowed                      >><<07102>>03564000
   <<-------------------------------------------------------->><<07102>>03566000
   ;                                                           <<07102>>03568000
   <<-------------------------------------------------------->><<07102>>03570000
   << Group level                                            >><<07102>>03572000
   <<-------------------------------------------------------->><<07102>>03574000
   IF SIR'HOLDER = CURPRC AND                                  <<07102>>03576000
      <<----------------------------------------------------->><<07102>>03578000
      <<This is a heavy restriction which allow only one user>><<07102>>03580000
      <<(the group creator) to be logged on in this account. >><<07102>>03582000
      <<This restriction is caused by lack of synchronization>><<07102>>03584000
      <<between any FOPEN (extracts group index block pointer>><<07102>>03586000
      <<from JIT) and the processing of group index block    >><<07102>>03588000
      <<expansion.                                           >><<07102>>03590000
      <<----------------------------------------------------->><<07102>>03592000
      DBPCOUNT <= 1 AND          << Number of accressors     >><<07102>>03594000
      DIR'EXP'INDEX'BLK (AGIPNTR) THEN                         <<07102>>03596000
      BEGIN                                                    <<07102>>03598000
      DIR'GR'LINK (OLD'INDEX);                                 <<07102>>03600000
      RETURN'VALUE := TRUE;                                    <<07102>>03602000
      END;                                                     <<07102>>03604000
   <<-------------------------------------------------------->><<07102>>03606000
   << Account index already has maximum size                 >><<07102>>03608000
   <<-------------------------------------------------------->><<07102>>03610000
   ;                                                           <<07102>>03612000
   <<-------------------------------------------------------->><<07102>>03614000
   << User level                                             >><<07102>>03616000
   <<-------------------------------------------------------->><<07102>>03618000
   IF DIR'EXP'INDEX'BLK (AUIPNTR) THEN                         <<07102>>03620000
      RETURN'VALUE := TRUE;                                    <<07102>>03622000
   <<-------------------------------------------------------->><<07102>>03624000
   << Volume Set Definition level - expansion disallowed     >><<07102>>03626000
   <<-------------------------------------------------------->><<07102>>03628000
   ;                                                           <<07102>>03630000
   END;                                                        <<07102>>03632000
END;   << DIR'EXPAND'INDEX >>                                  <<07102>>03634000
                                                               <<07102>>03636000
                                                                        03638000
                                                                        03640000
LOGICAL PROCEDURE DIRNEWINDEX (IBSIZE, ILEVEL, EBSIZE, ESIZE);          03642000
   VALUE IBSIZE, ILEVEL, EBSIZE, ESIZE;                                 03644000
   INTEGER IBSIZE, ILEVEL, EBSIZE, ESIZE;                               03646000
   OPTIONS;                                                             03648000
<< CALLER MUST MOVE PINDEXP AND PNAME INTO DBPINDEXP AND DBPNAME >>     03650000
BEGIN                                                                   03652000
                                                                        03654000
   IF EBSIZE > DDSBSIZE THEN GOTO NEVER;                                03656000
   TOS := DIRALLOCATE (IBSIZE);                                         03658000
   IF <> THEN                                                           03660000
      BEGIN                                                             03662000
      IF < THEN XREG := CCL                                             03664000
      ELSE                                                              03666000
NEVER:   XREG := CCG;                                                   03668000
      CC := XREG;                                                       03670000
      DIRNEWINDEX := 0;                                                 03672000
      RETURN;                                                           03674000
      END;                                                              03676000
   CC := CCE;                                                           03678000
   DBDIRBASE := DIRBASE;                                       <<02.PV>>03680000
   DBCONTENTS := (DIRNEWINDEX := TOS);                                  03682000
   @DBLPNTR := @DBIOPNTR+PRESIZE;                                       03684000
   DBNUMVALID := IBSIZE;                                                03686000
   DBUSED := 0;                                                         03688000
   DBBFACTOR := (DBBWSIZE := (DBBSIZE := IBSIZE) & LSL(7)) / ISIZE;     03690000
   TOS := 0;                                                            03692000
   TOS.(TYPEF) := INDEXTYPE;                                            03694000
   TOS.(LEVELF) := ILEVEL;                                              03696000
   TOS.(XSIZEF) := (DBXSIZE := ISIZE);                                  03698000
   TOS.(BSIZEF) := DBBSIZE;                                             03700000
   DBMISCWD := TOS;                                                     03702000
   DBXCOUNT := (DBPCOUNT := (DBETOTAL := 0));                           03704000
   TOS := 0;                                                            03706000
   TOS.(TYPEF) := ENTRYTYPE;                                            03708000
   TOS.(LEVELF) := ILEVEL;                                              03710000
   TOS.(XSIZEF) := ESIZE;                                               03712000
   TOS.(BSIZEF) := EBSIZE;                                              03714000
   DBEMISCWD := TOS;                                                    03716000
   DIRXXXBITMAP (WRITE);                                       <<28.PV>>03718000
   DIRWRITE (B);                                                        03720000
   END    <<DIRNEWINDEX>>;                                              03722000
                                                                        03724000
                                                                        03726000
                                                                        03728000
                                                                        03730000
INTEGER PROCEDURE DIRSCAN (ENTRYNAME, TYPE'WHICH);                      03732000
   VALUE TYPE'WHICH;                                                    03734000
   ARRAY ENTRYNAME;                                                     03736000
   LOGICAL TYPE'WHICH;                                                  03738000
   OPTIONS;                                                             03740000
   << ASSUMES NAMESIZE = 4 >>                                           03742000
<< RETURNS:                                                             03744000
   CCG - EXACT ENTRY RETURNED.                                          03746000
   CCL - PRECEEDING OR NEXT ENTRY RETURNED                              03748000
   CCE - "PSEUDO" PRECEEDING OR NEXT ENTRY RETURNED (OUTSIDE BOUNDS)  >>03750000
                                                                        03752000
BEGIN                                                                   03754000
   DOUBLE POINTER DENTRYNAME = ENTRYNAME;                               03756000
   DEFINE                                                               03758000
      WHICHFIELD  = 15:1 #,                                             03760000
      TYPEFIELD  = 13:2 #;                                              03762000
   DOUBLE POINTER ENDX;                                                 03764000
   DOUBLE POINTER PNTR;                                                 03766000
   INTEGER POINTER IPNTR = PNTR;                                        03768000
<< >>                                                                   03770000
   @BASE := IF (TYPE'WHICH) THEN @DBPREPRE ELSE @DAPREPRE;              03772000
   BASE (FLAGS).FLAGSF := 0; <<CLEANUP OLD RESIDUE>>                    03774000
   @ENDX := (@PNTR := IBASE(LPNTR))+IBASE(USED);                        03776000
   << CHANGE TO BINARY SEARCH LATER >>                                  03778000
   WHILE @PNTR < @ENDX DO                                               03780000
      BEGIN                                                             03782000
      IF DENTRYNAME = PNTR THEN                                         03784000
         IF DENTRYNAME (1) & DLSL (1) & DLSR (1) =                      03786000
            PNTR (XREG) & DLSL (1) & DLSR (1)                           03788000
         THEN GO TO EXACTONE;                                           03790000
      IF < THEN GOTO NEXTONE;                                           03792000
      @PNTR := @PNTR+IBASE(XSIZE);                                      03794000
      END;                                                              03796000
   @ENDX := 0;                                                          03798000
NEXTONE:                                                                03800000
   IF TYPE'WHICH.(TYPEFIELD) <= 1 THEN                                  03802000
      << EXACT OR EXACT/NEXT REQUEST >>                                 03804000
         BEGIN                                                          03806000
         TOS := @PNTR;                                                  03808000
         XREG := IF @ENDX <> 0 THEN CCL ELSE CCE;                       03810000
         END                                                            03812000
   ELSE                                                                 03814000
      << EXACT/PRECEEDING REQUEST >>                                    03816000
         BEGIN                                                          03818000
         TOS := @PNTR-IBASE(XSIZE);                                     03820000
         XREG := IF @PNTR <> IBASE(LPNTR) THEN CCL ELSE CCE;            03822000
         END;                                                           03824000
   GOTO EXIT;                                                           03826000
EXACTONE:                                                               03828000
   BASE (FLAGS).BADELMF := IPNTR (2) < 0; <<FLAGGED ENTRY?>>            03830000
   TOS := @PNTR;                                                        03832000
   XREG := CCG;                                                         03834000
EXIT:                                                                   03836000
   CC := XREG;                                                          03838000
   DIRSCAN := TOS;                                                      03840000
   END    <<DIRSCAN>>;                                                  03842000
                                                                        03844000
                                                                        03846000
                                                                        03848000
                                                                        03850000
DOUBLE PROCEDURE DIRINSERT (INDEXPOINTER);                              03852000
   VALUE INDEXPOINTER;                                                  03854000
   LOGICAL INDEXPOINTER;                                                03856000
   OPTIONS;                                                             03858000
<< WHEN CALLED:                                                         03860000
   1. DIRECTORY IS LOCKED,                                              03862000
   2. ENTRY HAS BEEN MOVED TO THE DATA SEGMENT (AT 0),                  03864000
   3. DB IS SET AT THE DATA SEGMENT.  >>                                03866000
<< RETURNS:                                                             03868000
   (S-0)                  (S-1)                                         03870000
   0 - SUCCESSFUL            0                                          03872000
   1 - DUPLICATE NAME        0                                          03874000
   4 - NO USER ROOM          N         N% USED.  NO INDEX ROOM          03876000
   5 - NO USER ROOM          0         > 65K ENTRIES                    03878000
   6 - NO SYSTEM ROOM        N         FOR N CONTIGUOUS BLOCKS        >>03880000
                                                                        03882000
BEGIN                                                                   03884000
   LOGICAL NEWPREIETOTAL;                                               03886000
   INTEGER STEMP;                                                       03888000
   INTEGER STEMP2;                                                      03890000
   INTEGER STEMP3, STEMP4;                                              03892000
   INTEGER                                                              03894000
      ZT,                                                               03896000
      ZTOTAL,                                                           03898000
      ZH1,                                                              03900000
      ZHALF1,                                                           03902000
      ZH2,                                                              03904000
      ZHALF2;                                                           03906000
   LOGICAL POINTER                                                      03908000
      IPNTR,                                                            03910000
      IPNTR2;                                                           03912000
   INTEGER POINTER                                                      03914000
      IIPNTR = IPNTR,                                                   03916000
      IIPNTR2 = IPNTR2;                                                 03918000
   INTEGER TEMP;                                                        03920000
   LOGICAL POINTER TEMPP = TEMP;                                        03922000
   INTEGER ESIZE;                                                       03924000
   LOGICAL POINTER S2PNTR = S-2;                                        03926000
   LOGICAL POINTER S4PNTR = S-4;                                        03928000
                                                                        03930000
                                                                        03932000
                                                                        03934000
LOGICAL SUBROUTINE ZINSERT (ELEMENT, WHICH, PNTR);                      03936000
   VALUE WHICH;                                                         03938000
   ARRAY ELEMENT, PNTR;                                                 03940000
   LOGICAL WHICH;                                                       03942000
BEGIN                                                                   03944000
   @BASE := IF WHICH THEN @DBPREPRE ELSE @DAPREPRE;                     03946000
   IF @PNTR = 0 THEN                                                    03948000
                                                                        03950000
      << *** FIND PREVIOUS ELEMENT *** >>                               03952000
      BEGIN                                                             03954000
      @PNTR := DIRSCAN (ELEMENT, EN LOR WHICH);                         03956000
      IF > THEN                                                         03958000
         BEGIN                                                          03960000
         ZINSERT := 0;                                                  03962000
         RETURN;                                                        03964000
         END;                                                           03966000
      END;                                                              03968000
   STEMP2 := BASE(XSIZE);                                               03970000
   STEMP := IBASE(LPNTR) + IBASE(USED) - @PNTR;                         03972000
   IF <> THEN                                                           03974000
      << ******** CHECK CODE FOR FOLLOWING 2 STATEMENTS **************>>03976000
      MOVE PNTR (STEMP+STEMP2-1) := PNTR(STEMP-1), (-STEMP);            03978000
   MOVE PNTR := ELEMENT, (STEMP2);                                      03980000
   ZINSERT := @PNTR;                                                    03982000
   END    <<ZINSERT>>;                                                  03984000
                                                                        03986000
                                                                        03988000
                                                                        03990000
LOGICAL SUBROUTINE ZNEWENTRYBLOCK (NAME, INDEXPLACE);                   03992000
   ARRAY NAME, INDEXPLACE;                                              03994000
BEGIN                                                                   03996000
   IF (STEMP3 := DBXCOUNT+1) > DBBFACTOR THEN                           03998000
      IF NOT DIR'EXPAND'INDEX THEN                             <<07102>>04000000
      BEGIN                                                             04002000
      TOS := INTEGER (FIXR ((REAL(DBETOTAL)/REAL((DBXCOUNT) *           04004000
         ((DBEBSIZE & LSL(7))/ESIZE)))*100.));                          04006000
      TOS := 4;                                                         04008000
      << *********** CHECK THIS BRANCH ***********>>                    04010000
      GOTO BADEXIT;                                                     04012000
      END;                                                              04014000
   STEMP4 := DIRALLOCATE (DBEBSIZE);                                    04016000
   IF < THEN                                                            04018000
      BEGIN                                                             04020000
      TOS := DBEBSIZE;                                                  04022000
      TOS := 6;                                                         04024000
      << *********** CHECK THIS BRANCH ***********>>                    04026000
      GOTO BADEXIT;                                                     04028000
      END;                                                              04030000
   DIRXXXBITMAP (WRITE);                                       <<28.PV>>04032000
                                                                        04034000
   << *** INDEX HAS ROOM AND WE HAVE A BLOCK *** >>                     04036000
   << ******* CHECK CODE FOR FOLLLOWING STATEMENT **************>>      04038000
   ZINSERT (NAME, B, INDEXPLACE);                                       04040000
   DBXCOUNT := STEMP3;                                                  04042000
   DBUSED := DBUSED+ISIZE;                                              04044000
   INDEXPLACE (IEPNTR) := (ZNEWENTRYBLOCK := STEMP4);                   04046000
   END    <<ZNEWENTRYBLOCK>>;                                           04048000
                                                                        04050000
                                                                        04052000
                                                                        04054000
SUBROUTINE ZSET;                                                        04056000
BEGIN                                                                   04058000
   ZTOTAL := ZT * (XREG := ESIZE);                                      04060000
   ZHALF1 := (ZH1 := ZT & LSR(1)) * XREG;                               04062000
   ZHALF2 := (ZH2 := (ZT+1) & LSR(1)) * XREG;                           04064000
   END    <<ZSET>>;                                                     04066000
                                                                        04068000
                                                                        04070000
                                                                        04072000
SUBROUTINE ZDISTRIBUTE;                                                 04074000
BEGIN                                                                   04076000
   MOVE DBLPNTR (ZHALF2-1) := DALPNTR (ZTOTAL-1), (-ZHALF2);            04078000
   DBUSED := ZHALF2;                                                    04080000
   DBXCOUNT := ZH2;                                                     04082000
   DIRWRITE (B);                                                        04084000
   DAUSED := ZHALF1;                                                    04086000
   DAXCOUNT := ZH1;                                                     04088000
   DIRWRITE (A);                                                        04090000
   END    <<ZDISTRIBUTE>>;                                              04092000
                                                                        04094000
                                                                        04096000
                                                                        04098000
                                                                        04100000
<< >>                                                                   04102000
   DIRREAD (INDEXPOINTER, B, 0, 0);                                     04104000
   ESIZE := DBEXSIZE;                                                   04106000
   NEWPREIETOTAL := DBETOTAL+1;                                         04108000
   IF CARRY THEN                                                        04110000
      BEGIN                                                             04112000
      TOS := 5;                                                         04114000
      GOTO BADEXITZ;                                                    04116000
      END;                                                              04118000
   @IPNTR := DIRSCAN (DDSENTRY, EPB);                                   04120000
   IF > THEN                                                            04122000
DUPNAME:                                                                04124000
      BEGIN                                                             04126000
      TOS := 1;                                                         04128000
BADEXITZ:                                                               04130000
      ASSEMBLE (ZROB);                                                  04132000
BADEXIT:                                                                04134000
      CC := CCG;                                                        04136000
      GOTO EXIT;                                                        04138000
      END;                                                              04140000
   IF = THEN                                                            04142000
                                                                        04144000
      <<*** NO CONTAINING BLOCK: ALLOCATE 1 OR INSERT IN FIRST ONE ***>>04146000
      BEGIN                                                             04148000
      @IPNTR := @DBLPNTR;                                               04150000
      IF DBXCOUNT > 0 THEN GOTO CHECKFIT;                               04152000
      TOS := ZNEWENTRYBLOCK (DDSENTRY, IPNTR);                          04154000
      IPNTR (IECOUNT) := 0;                                             04156000
      << *** SET UP NULL BLOCK *** >>                                   04158000
      DBNUMVALID := DBBSIZE;    <<PROCECT AGAINST INACCURATE COPY IN B>>04160000
      DADIRBASE := DIRBASE;                                    <<02.PV>>04162000
      DACONTENTS := TOS;                                                04164000
      @DALPNTR := @DAIOPNTR;                                            04166000
      DANUMVALID := DBEBSIZE;                                           04168000
      DAXSIZE := DBEXSIZE;                                              04170000
      DAUSED := 0;                                                      04172000
      DABWSIZE := (DABSIZE := DBEBSIZE) & LSL(7);                       04174000
      DABFACTOR := DABWSIZE/DAXSIZE;                                    04176000
      DAMISCWD := DBEMISCWD;                                            04178000
      DAXCOUNT := 0;                                                    04180000
      GOTO NORMALINSERT;                                                04182000
      END;                                                              04184000
CHECKFIT:                                                               04186000
   IF IIPNTR (IECOUNT) < (TEMP := (DBEBSIZE & LSL(7)) / ESIZE) THEN     04188000
                                                                        04190000
      << *** A NORMAL INSERTION *** >>                                  04192000
      BEGIN                                                             04194000
      DIRREAD (IPNTR (IEPNTR), A, IPNTR(IECOUNT), DBEMISCWD);           04196000
NORMALINSERT:                                                           04198000
      IF ZINSERT (DDSENTRY, A, DDS) = 0 THEN GOTO DUPNAME;              04200000
      DAUSED := DAUSED+ESIZE;                                           04202000
      DAXCOUNT := DAXCOUNT+1;                                           04204000
      DIRWRITE (A);                                                     04206000
      DBETOTAL := NEWPREIETOTAL;                                        04208000
      MOVE IPNTR := DALPNTR, (NAMESIZE);                                04210000
      IIPNTR (IECOUNT) := IIPNTR (IECOUNT) + 1;                         04212000
      DIRWRITE (B);                                                     04214000
      END                                                               04216000
   ELSE                                                                 04218000
                                                                        04220000
      << *** DISTRIBUTION REQUIRED *** >>                               04222000
      BEGIN                                                             04224000
      IF DBXCOUNT = 1 THEN GOTO NEWDISTRIBUTE;                          04226000
      IF @IPNTR = @DBLPNTR THEN GOTO UPPER;                             04228000
      IF @IPNTR = @DBLPNTR (DBUSED-ISIZE) THEN GOTO LOWER;              04230000
      IF IIPNTR (ISIZE+IECOUNT) <= IIPNTR (-ISIZE+IECOUNT) THEN         04232000
UPPER:   XREG := ISIZE                                                  04234000
      ELSE                                                              04236000
LOWER:   XREG := -ISIZE;                                                04238000
      @IPNTR2 := @IPNTR (XREG);                                         04240000
      TOS := (ZT := IIPNTR (IECOUNT) + IIPNTR2 (XREG) + 1);             04242000
      IF REAL (TOS & LSR(1)) / REAL (TEMP) < GOODPERCENT THEN           04244000
                                                                        04246000
         << *** DISTRIBUTE AMONG NEIGHBORS *** >>                       04248000
         BEGIN                                                          04250000
         ZSET;                                                          04252000
         IF @IPNTR > @IPNTR2 THEN                                       04254000
            BEGIN  <<MAKE IPNTR LOWER ONE>>                             04256000
            TOS := @IPNTR2;                                             04258000
            @IPNTR2 := @IPNTR;                                          04260000
            @IPNTR := TOS;                                              04262000
            END;                                                        04264000
         << READ IN LOWER BLOCK >>                                      04266000
         DIRREAD (IPNTR (IEPNTR), A, IPNTR (IECOUNT), DBEMISCWD);       04268000
         << KLUGE TO READ IN UPPER BLOCK RIGHT ON TOP OF LOWER >>       04270000
         DANUMVALID := DBEBSIZE;                                        04272000
         TOS := @DBIOPNTR;                                              04274000
         @DBIOPNTR := @DALPNTR (DAUSED);                                04276000
         DIRREAD (IPNTR2 (IEPNTR), B, IPNTR2 (IECOUNT), DBEMISCWD);     04278000
         @DBIOPNTR := (@DBLPNTR := TOS);                                04280000
         << (KLUGE A'S SIZE FOR ZINSERT) >>                             04282000
         TOS := DAXCOUNT;                                               04284000
         TOS := DAUSED;                                                 04286000
         DAUSED := ZTOTAL-ESIZE;                                        04288000
         DAXCOUNT := ZT-1;                                              04290000
         IF (TEMP := ZINSERT (DDSENTRY, A,  DDS)) = 0 THEN              04292000
            BEGIN                                                       04294000
            DAUSED := TOS;                                              04296000
            DAXCOUNT := TOS;                                            04298000
            DBCONTENTS := 0;                                            04300000
            GOTO DUPNAME;                                               04302000
            END;                                                        04304000
         DBNUMVALID := DANUMVALID;                                      04306000
         ZDISTRIBUTE;                                                   04308000
         MOVE DAPNAME := DBLPNTR, (NAMESIZE);   <<DAPNAME NOT USED>>    04310000
         DIRREAD (INDEXPOINTER, B, 0, 0);                               04312000
         DBETOTAL := NEWPREIETOTAL;                                     04314000
         IF TEMP = @DALPNTR THEN                                        04316000
            MOVE IPNTR := DALPNTR, (NAMESIZE);                          04318000
         IPNTR (IECOUNT) := ZH1;                                        04320000
         MOVE IPNTR2 := DAPNAME, (NAMESIZE);                            04322000
         IPNTR2 (XREG) := ZH2;                                          04324000
         DIRWRITE (B);                                                  04326000
         END                                                            04328000
      ELSE                                                              04330000
NEWDISTRIBUTE:                                                          04332000
                                                                        04334000
         << *** DISTRIBUTE WITH NEW BLOCK *** >>                        04336000
         BEGIN                                                          04338000
         ZT := IPNTR (IECOUNT) +1;                                      04340000
         ZSET;                                                          04342000
         DIRREAD (IPNTR (IEPNTR), A, IPNTR(IECOUNT), DBEMISCWD);        04344000
         TEMP := DIRSCAN (DDSENTRY, ENA);                               04346000
         IF > THEN GOTO DUPNAME;                                        04348000
         @IPNTR2 := @IPNTR+ISIZE;                                       04350000
         XREG := @DALPNTR(ZHALF1);                                      04352000
         IF TEMP <= XREG THEN                                           04354000
            IF < THEN XREG := XREG-DAXSIZE                              04356000
            ELSE XREG := @DDSENTRY;                                     04358000
         TOS := ZNEWENTRYBLOCK (DDS(XREG), IPNTR2);                     04360000
         IPNTR2 (IECOUNT) := ZH2;                                       04362000
         DBETOTAL := NEWPREIETOTAL;                                     04364000
         IPNTR (XREG) := ZH1;                                           04366000
         IF TEMP = @DALPNTR THEN                                        04368000
            MOVE IPNTR := DDSENTRY, (NAMESIZE);                         04370000
         DIRWRITE (B);                                                  04372000
         << *** SET UP NULL BLOCK IN B *** >>                           04374000
         DANUMVALID := DBEBSIZE;    <<PROTECT AGAINST INACCURATE COPYA>>04376000
         DBCONTENTS := TOS;                                             04378000
         @DBLPNTR := @DBIOPNTR;                                         04380000
         DBNUMVALID := DBEBSIZE;                                        04382000
         DBXSIZE := DBEXSIZE;                                           04384000
         DBUSED := 0;                                                   04386000
         DBBFACTOR := (DBBWSIZE := (DBBSIZE := DBEBSIZE) & LSL(7))      04388000
            / DBXSIZE;                                                  04390000
         DBMISCWD := DBEMISCWD;                                         04392000
         DBXCOUNT := 0;                                                 04394000
         ZINSERT (DDSENTRY, A, TEMPP);                                  04396000
         ZDISTRIBUTE;                                                   04398000
         END;                                                           04400000
      END;                                                              04402000
   TOS := 0D;    <<SUCCESSFIL RETURN>>                                  04404000
   CC := CCE;                                                           04406000
EXIT:                                                                   04408000
   DIRINSERT := TOS;                                                    04410000
   END    <<DIRINSERT>>;                                                04412000
                                                                        04414000
                                                                        04416000
                                                                        04418000
                                                                        04420000
DOUBLE PROCEDURE DIRFIND (INDEXPOINTER);                                04422000
   VALUE INDEXPOINTER;                                                  04424000
   LOGICAL INDEXPOINTER;                                                04426000
   OPTIONS;                                                             04428000
<< RETURN:                                                              04430000
   HIGH ORDER  =  DB ADDR OF INDEX (IN B).                              04432000
   LOW ORDER   =  DB ADDR OF ENTRY (IN A).    >>                        04434000
BEGIN                                                                   04436000
   INTEGER                                                     <<61.PV>>04438000
       MVTABX;                                                 <<61.PV>>04440000
   DIRREAD (INDEXPOINTER, B, 0, 0);                                     04442000
   TOS := DIRSCAN (DDSENTRY, EPB);                                      04444000
   IF = THEN                                                            04446000
NOTFOUND:                                                               04448000
      BEGIN                                                             04450000
      DIRFIND := 0D;                                                    04452000
      RETURN;                                                           04454000
      END;                                                              04456000
   DIRREAD (S0PNTR(IEPNTR), A, S0PNTR(IECOUNT), DBEMISCWD);             04458000
   TOS := DIRSCAN (DDSENTRY, EA);                                       04460000
   IF <= THEN GOTO NOTFOUND;                                            04462000
   IF BASE (MISCWD).(LEVELF) = GROUPLEVEL AND                  <<09.PV>>04464000
      XTYPE.(ENDLEVELF) = FILELEVEL THEN                       <<09.PV>>04466000
    IF (TOS := S0PNTR (GLINKAGE)).(PVF) = PV THEN              <<09.PV>>04468000
     IF (MVTABX := TOS.(MVTABXF)) <> 0 THEN                    <<61.PV>>04470000
     BEGIN     <<PV AND MOUNTED>>                              <<09.PV>>04472000
         TOS := DDSDST;                 <<E: TARGET>>          <<61.PV>>04474000
         TOS := @DIRBASE;               <<D: TARGET OFFSET>>   <<61.PV>>04476000
         TOS := MVTABDST;               <<C: SOURCE>>          <<61.PV>>04478000
         TOS := (MVTABX*MVTABSZ)+2;     <<B: SOURCE OFFSET>>   <<61.PV>>04480000
         TOS := 2;                      <<A: COUNT>>           <<61.PV>>04482000
         ASSEMBLE (MDS);                <<DIRBASE SWITCH>>     <<61.PV>>04484000
     END                                                       <<09.PV>>04486000
     ELSE <<PV AND NOT MOUNTED>>                               <<61.PV>>04488000
    ELSE <<NOT PV>> DEL;                                       <<16.PV>>04490000
   DIRFIND := TOS;                                                      04492000
   END    <<DIRFIND>>;                                                  04494000
                                                                        04496000
                                                                        04498000
                                                                        04500000
                                                                        04502000
PROCEDURE DIRREMOVE (ELEMENT, WHICH);                                   04504000
   VALUE WHICH;                                                         04506000
   LOGICAL WHICH;                                                       04508000
   ARRAY ELEMENT;                                                       04510000
   OPTIONS;                                                             04512000
<< DECREMENTS <USED> AND <XCOUNT>;                                      04514000
   REMOVES ELEMENT;                                                     04516000
   DEALLOCATES BLOCK WHEN AN ENTRY BLOCK IS DEPLETED.  >>               04518000
BEGIN                                                                   04520000
   @BASE := IF WHICH THEN @DBPREPRE ELSE @DAPREPRE;                     04522000
   WHICHDIRTY := TRUE;                                                  04524000
   IBASE(USED) := IBASE(USED) - IBASE(XSIZE);                           04526000
   IBASE(XCOUNT) := IBASE(XCOUNT)-1;                                    04528000
   IF = THEN                                                            04530000
      BEGIN                                                             04532000
      IF BASE(MISCWD).(TYPEF) = ENTRYTYPE THEN                          04534000
         BEGIN                                                          04536000
         DIRDEALLOCATE (BASE(CONTENTS), BASE(BSIZE));                   04538000
         BASE (CONTENTS) := (WHICHDIRTY := 0);                          04540000
         END;                                                           04542000
      RETURN;                                                           04544000
      END;                                                              04546000
   MOVE ELEMENT := ELEMENT (BASE(XSIZE)),                               04548000
      (IBASE(LPNTR)+IBASE(USED)-@ELEMENT);                              04550000
   END    <<DIRREMOVE>>;                                                04552000
                                                                        04554000
                                                                        04556000
                                                                        04558000
LOGICAL PROCEDURE ACCCHECK (LEVEL, ACCTNAME, ACCTSEC,GROUPNAME,         04560000
      GROUPSEC, CREATOR, FILESEC, USERINFO);                            04562000
   VALUE LEVEL, ACCTSEC, GROUPSEC, FILESEC;                    << ... >>04564000
   INTEGER LEVEL;                                                       04566000
   BYTE ARRAY ACCTNAME;                <<NOT OPT.>>                     04568000
   LOGICAL ACCTSEC;                    <<NOT OPT.>>                     04570000
   BYTE ARRAY GROUPNAME;               <<NOT OPT. IF LEVEL <= 1>>       04572000
   DOUBLE GROUPSEC;                    <<NOT OPT. IF LEVEL <= 1>>       04574000
   BYTE ARRAY CREATOR;                 <<NOT OPT. IF LEVEL = 0>>        04576000
   DOUBLE FILESEC;                     <<NOT OPT. IF LEVEL = 0>>        04578000
   BYTE ARRAY USERINFO;                <<OPT.                           04580000
                                       (0:7) = UACCT (ALWAYS),          04582000
                                       (8:15)= UHGROUP (IF LEVEL <= 1)  04584000
                                       (16:23)=ULGROUP (IF LEVEL <= 1)  04586000
                                       (24:31)=UNAME (IF LEVEL =0) >>   04588000
   OPTION VARIABLE, PRIVILEGED, UNCALLABLE;                             04590000
<<                                                                      04592000
   RETURNS ACCESS  (ACCCHECK.(10:6) = RAWLXS)                           04594000
   AT LEVEL    (0/1/2 = FILE/GROUP/ACCT)                                04596000
   DB MUST BE AT STACK.                                                 04598000
   PARAMETERS REQUIRED INDICATED ABOCE (DEPENDS ON LEVEL)               04600000
   IF <USERINFO> OMITTEDD, JIT ACCESSED TO GET INFO.                    04602000
   NOTE: <USERINFO> = JIT1(8:23).                                       04604000
   >>                                                                   04606000
BEGIN                                                                   04608000
<< MISC. DECL >>                                                        04610000
   INTEGER           XREG              = X,                             04612000
                     S15               = S-15,                          04614000
                     S2                = S-2,                           04616000
                     S0                = S-0;                           04618000
   DEFINE            ASM               = ASSEMBLE #;                    04620000
<< PARAMETER BREAKDOWN >>                                               04622000
   LOGICAL           PMASK             = Q-4;                           04624000
   INTEGER           GSEC1             = GROUPSEC,                      04626000
                     GSEC2             = GSEC1 +1,                      04628000
                     FILESEC1          = FILESEC,                       04630000
                     FILESEC2          = FILESEC1 +1;                   04632000
   DEFINE            UACCT             = USERINFO #,                    04634000
                     UHGROUP           = USERINFO (8) #,                04636000
                     ULGROUP           = USERINFO (16) #,               04638000
                     UNAME             = USERINFO (24) #;               04640000
   LOGICAL           ACCESSX           = ACCCHECK;                      04642000
<< LOCALS >>                                                            04644000
   INTEGER           JIT'DST;                                  <<06560>>04646000
   LOGICAL ARRAY     JITARR (*)        = DB + 0;               <<06560>>04648000
   LOGICAL ARRAY QARRAY (*) = Q + 0;   <<Define PXGLOBAL area>><<06560>>04650000
   INTEGER PCBGLOBLOC;                 <<Required for PXGLOB >><<06560>>04652000
   LOGICAL POINTER UCAPPTR;            <<User attr. from PXG >><<06560>>04654000
   LOGICAL           ACCESSOR          := %60;    <<INIT ANY AND AC>>   04656000
   DEFINE            ACACCR            = ACCESSOR.(11:1) #,             04658000
                     ALACCR            = ACCESSOR.(12:1) #,             04660000
                     GUACCR            = ACCESSOR.(13:1) #,             04662000
                     GLACCR            = ACCESSOR.(14:1) #,             04664000
                     CRACCR            = ACCESSOR.(15:1) #;             04666000
                                                                        04668000
   SUBROUTINE DEF'MOVE'FROM'DST;                               <<06560>>04670000
                                                               <<06560>>04672000
                                                               <<06560>>04674000
                                                               <<06560>>04676000
                                                                        04678000
                                                                        04680000
   << GET USER CAPABILITY ATTRIBUTES AND JIT DST >>                     04682000
   PXGLOBAL;   <<Initialize pointers to PXGLOBAL             >><<06560>>04684000
   @UCAPPTR := @PXG'USERATTRIBUTES;    <<Set ptr to user attr>><<06560>>04686000
   JIT'DST := PXG'JITDST;                                      <<06560>>04688000
   IF NOT (PMASK) THEN                                                  04690000
      BEGIN    <<GET USER INFO FROM JIT.  CALLER DIDN'T SUPPLY>>        04692000
      ASM (ADDS 16);                                                    04694000
      TOS := @S15;                                                      04696000
      @USERINFO := S0 &LSL(1);                                          04698000
      MOVE'FROM'DST ( *, JIT'DST, @JITHACCTNAME, 16);          <<06560>>04700000
      END;                                                              04702000
   IF UACCT <> ACCTNAME, (8) THEN                                       04704000
      BEGIN                                                             04706000
      ACACCR := 0;                                                      04708000
      TOS := %76;                                                       04710000
      END                                                               04712000
   ELSE TOS := %77;                                                     04714000
   IF NOT (UCAPSF) THEN TOS.(15:1) := 0;                       <<06560>>04716000
   ACCCHECK := TOS;                                                     04718000
   IF NOT (UCAPSM) THEN                                        <<06560>>04720000
      BEGIN                                                             04722000
      IF NOT (ACACCR) OR NOT (UCAPAM) THEN                     <<06560>>04724000
         BEGIN    <<NOT AM OR SM>>                                      04726000
         << DETERMINE USER'S ACCESSOR CATEGORIES >>                     04728000
         << ANY AND AC ALREADY SET >>                                   04730000
         IF LEVEL <> 2 AND ACACCR THEN                                  04732000
            BEGIN    << MEM OF ACCT >>                                  04734000
            ALACCR := UCAPAL;                                  <<06560>>04736000
            TOS := 1;                                                   04738000
            IF UHGROUP = GROUPNAME, (8) THEN                            04740000
               <<HOME GROUP>>                                           04742000
               GLACCR := UCAPGL                                <<06560>>04744000
            ELSE IF ULGROUP <> GROUPNAME, (8) THEN TOS := TOS-1;        04746000
            GUACCR := TOS;                                              04748000
            IF LEVEL = 0 AND UNAME = CREATOR, (8) THEN CRACCR := TRUE;  04750000
            END;                                                        04752000
         << USER'S ACCESSOR CATEGORIES DETERMINED >>                    04754000
                                                                        04756000
         << APPLY TO ACCT SECURITY MATRIX >>                            04758000
         TOS := ACCESSOR & LSR(4);                                      04760000
         TOS := ACCTSEC.(4:12);                                         04762000
         XREG := 5;                                                     04764000
         DO BEGIN                                                       04766000
            ASM (DDUP;  AND, DEL);                                      04768000
            IF = THEN                                                   04770000
               BEGIN                                                    04772000
               TOS := ACCESSX;                                          04774000
               ASM (TRBC 10, X);                                        04776000
               ACCCHECK := TOS;                                         04778000
               END;                                                     04780000
            TOS := TOS & LSR(2);                                        04782000
            XREG := XREG -1;                                            04784000
            END                                                         04786000
         UNTIL <;                                                       04788000
         IF LEVEL <> 2 AND ACCESSX <> 0 THEN                            04790000
            BEGIN                                                       04792000
                                                                        04794000
            << APPLY ACCESSOR TO GROUP SECURITY >>                      04796000
            TOS := ACCESSOR & LSR(1);                                   04798000
            TOS := GSEC1.(2:14);                                        04800000
            TOS := GSEC2;                                               04802000
            XREG := 5;                                                  04804000
            DO BEGIN                                                    04806000
               TOS := S2;                                               04808000
               ASM (DDUP, AND;  DDEL);                                  04810000
               IF = THEN                                                04812000
                  BEGIN                                                 04814000
                  TOS := ACCESSX;                                       04816000
                  ASM (TRBC 10, X);                                     04818000
                  ACCCHECK := TOS;                                      04820000
                  END;                                                  04822000
               TOS := TOS & DLSR(5);                                    04824000
               XREG := XREG -1;                                         04826000
               END                                                      04828000
            UNTIL <;                                                    04830000
            IF LEVEL = 0 AND ACCESSX <> 0 THEN                          04832000
               BEGIN                                                    04834000
                                                                        04836000
               << APPLY ACCESSOR TO FILE SECURITY >>                    04838000
               TOS := FILESEC1.(2:14);                                  04840000
               TOS := FILESEC2;                                         04842000
               XREG := 4;                                               04844000
               DO BEGIN                                                 04846000
                  TOS := ACCESSOR;                                      04848000
                  ASM (DDUP, AND;  DDEL);                               04850000
                  IF = THEN                                             04852000
                     BEGIN                                              04854000
                     TOS := ACCESSX;                                    04856000
                     ASM (TRBC 10, X);                                  04858000
                     ACCCHECK := TOS;                                   04860000
                     END;                                               04862000
                  TOS := TOS & DLSR(6);                                 04864000
                  XREG := XREG -1;                                      04866000
                  END                                                   04868000
               UNTIL <;                                                 04870000
               END;                                                     04872000
            END;                                                        04874000
         END;                                                           04876000
      END;                                                     << ... >>04878000
   END    <<ACCESS>>;                                                   04880000
                                                                        04882000
                                                                        04884000
                                                                        04886000
                                                                        04888000
PROCEDURE DIRRESET (NUMSECTS);                                          04890000
   VALUE NUMSECTS;                                             << ... >>04892000
   DOUBLE NUMSECTS;                                                     04894000
   OPTIONS;                                                             04896000
<< CALLED TO SUBTRACT <NUMSECTS> FROM FATHER (AND GRANDFATHER) WHEN     04898000
   ERROR DETECTED AFTER THEY ARE BUMPED.  ASSUMES B CONTAINS CURRENT    04900000
   INDEX (THUS POINTER TO FATHER)                                       04902000
   >>                                                                   04904000
   WHILE DBPINDEXP <> 0 DO                                              04906000
      BEGIN                                                             04908000
      MOVE DDSNAME := DBPNAME, (NAMESIZE);                              04910000
      TOS := DIRFIND (DBPINDEXP);                                       04912000
      IF DAMISCWD.(LEVELF) = GROUPLEVEL THEN TOS := TOS +GDFSCOUNT      04914000
      ELSE TOS := TOS +ADFSCOUNT;                                       04916000
      DPS0 := DPS0 -NUMSECTS;                                           04918000
      DIRWRITE (A);                                            << ... >>04920000
      END;                                                              04922000
                                                                        04924000
                                                                        04926000
                                                                        04928000
                                                                        04930000
                                                                        04932000
DOUBLE PROCEDURE DIRSTARTOFF (PARR, NUMSECTS, RECIP, PARMS,    <<01.PV>>04934000
                              MVTABX);                         <<01.PV>>04936000
   VALUE NUMSECTS, PARMS, MVTABX;                              <<01.PV>>04938000
   ARRAY PARR;                         <<DB ADDR OF SPEC PART>>         04940000
   DOUBLE NUMSECTS;                    <<TO ADJUST ACCT/GROUP>>         04942000
   INTEGER PROCEDURE RECIP;            <<FOR VISIT OF @ HIT>>           04944000
   INTEGER PARMS;                      <<FOR VISIT OF @ HIT>>           04946000
   INTEGER MVTABX;                                             <<01.PV>>04948000
   OPTION VARIABLE, PRIVILEGED, INTERNAL, UNCALLABLE;                   04950000
<<                                                                      04952000
   ANALYZES THE SPECIFICATION PART FOR DIRECTORY ROUTINES, AND          04954000
   GOES DOWN TREE UNTIL JUST BEFORE HIT OF TARGET, LEAVING:             04956000
      ADJUST, XTYPE, LINKAGE'XINDEXP, XANAME, XGUNAME,           43.PV  04958000
      XFNAME, XASEC AND XGSEC;                                   43.PV  04960000
      DB THRU DB+3 TO FINAL NAME.                                       04962000
   IF <NUMSECTS> SPECIFIED, THEN IT'S ADDED TO ACCT AND GROUP.          04964000
   IF <RECIP> AND <PARMS> SPECIFIED, THEN @ ENTRY HIT IS VISITED.       04966000
      CARRY SET ON RETURN => RECIP SAID STOP OR DON'T SCAN MY TREE.     04968000
   IF JUST <PARMS> SPECIFIED, THEN S ACCESS TO GROUP CHECKED.           04970000
   TYPE RETURN IS DIRECTORY ERROR PAIR.                                 04972000
   >>                                                                   04974000
BEGIN                                                                   04976000
   LOGICAL PMASK = Q-4;                                                 04978000
   INTEGER IPMASK = PMASK;                                              04980000
   SWITCH STARTSWITCH := NOINDEX, AINDEX, GINDEX, NOINDEX;              04982000
   DEFINE                                                      <<01.PV>>04984000
       MVTABX'M       = (15:1) #,                              <<01.PV>>04986000
       PARMS'M        = (14:1) #,                              <<01.PV>>04988000
       RECIP'M        = (13:1) #,                              <<01.PV>>04990000
       NUMSECTS'M     = (12:1) #,                              <<01.PV>>04992000
       PARR'M         = (11:1) #,                              <<01.PV>>04994000
       MVTABX'P       = PMASK.MVTABX'M #,                      <<01.PV>>04996000
       PARMS'P        = PMASK.PARMS'M #,                       <<01.PV>>04998000
       RECIP'P        = PMASK.RECIP'M #,                       <<01.PV>>05000000
       NUMSECTS'P     = PMASK.NUMSECTS'M #,                    <<01.PV>>05002000
       PARR'P         = PMASK.PARR'M #;                        <<03.PV>>05004000
   DEFINE                                                               05006000
      MOVLB1 =                                                          05008000
         TOS := 0;                                                      05010000
         TOS := #,                                                      05012000
      MOVLB2 =                                                          05014000
                +ADJUST;                                                05016000
         TOS := NAMESIZE;                                               05018000
         ASSEMBLE (MVLB) #;                                             05020000
                                                                        05022000
                                                                        05024000
SUBROUTINE VISIT (NEEDSIR);                                    <<58.PV>>05026000
   << S-0 = POINTER TO ENTRY >>                                <<58.PV>>05028000
   VALUE NEEDSIR;                                              <<58.PV>>05030000
   LOGICAL NEEDSIR;                                            <<58.PV>>05032000
   IF RECIP'P AND PARMS'P THEN                                 <<09.PV>>05034000
      BEGIN                                                             05036000
      TOS := IF NEEDSIR THEN GETSIR (DIRSIR) ELSE SIRRETURN;   <<58.PV>>05038000
      TOS := DIRSIR;                                           <<58.PV>>05040000
      TOS := SIRRETURN; <<SAVE IT>>                            <<58.PV>>05042000
      ASMB (CAB, CAB; XCH);                                    <<58.PV>>05044000
      TOS := 0;                                                         05046000
      TOS := @PS6;                                             <<58.PV>>05048000
      TOS := DAMISCWD.(LEVELF);                                         05050000
      TOS := PARMS;                                                     05052000
      TOS := DS5;                                                       05054000
      TOS := RECIP (*, *, *, *);  <<VISIT>>                             05056000
      IF LS5 THEN <<NEEDSIR: EXTRA GETSIR INVOKED>>            <<58.PV>>05058000
       IF LS0 THEN                                             <<58.PV>>05060000
       BEGIN <<EXTRA WAS NOT RELEASED>>                        <<58.PV>>05062000
           TOS := DS2;                                         <<58.PV>>05064000
           RELSIR (*, *);                                      <<58.PV>>05066000
       END ELSE                                                <<58.PV>>05068000
      ELSE <<EXTRA GETSIR NOT INVOKED>>                        <<58.PV>>05070000
       IF NOT LS0 THEN                                         <<62.PV>>05072000
       BEGIN                                                   <<62.PV>>05074000
           GETSIR (DIRSIR);                                    <<62.PV>>05076000
           S0.(0:1) := TRUE; <<FORCE REDO>>                    <<62.PV>>05078000
       END;                                                    <<62.PV>>05080000
      SIRRETURN := S3;                                         <<60.PV>>05082000
      IF S0 < 0 THEN                                           <<56.PV>>05084000
      BEGIN  <<CAUSE STARTOFF TO BE REDONE>>                   <<56.PV>>05086000
          TOS := 0;                                            <<56.PV>>05088000
          GO TO EXIT;                                          <<56.PV>>05090000
      END;                                                     <<56.PV>>05092000
      IF TOS &LSR(1) > 0 THEN    <<STOP OR GOTO BROTHER>>               05094000
         BEGIN        <<SO STOP ENTIRE SCAN>>                           05096000
         CARRYX := 1;                                                   05098000
         GOTO OKAYEXIT;                                                 05100000
         END;                                                           05102000
      ASSEMBLE (DDEL, DEL);                                    <<57.PV>>05104000
      END;                                                              05106000
                                                                        05108000
                                                                        05110000
SUBROUTINE BADEXIT (NUM);                                               05112000
   VALUE NUM;                                                           05114000
   INTEGER NUM;                                                         05116000
BEGIN                                                                   05118000
   TOS := DBELEVEL;                                                     05120000
   TOS := S2;                                                           05122000
   IF NUMSECTS'P THEN DIRRESET (NUMSECTS);                     <<01.PV>>05124000
   GOTO EXIT;                                                           05126000
   END    <<SUBROUTINE BADEXIT>>;                                       05128000
                                                                        05130000
                                                                        05132000
<< >>                                                                   05134000
   PUSH (DL);                                                           05136000
$IF X0=ON                                                      <<DEBUG>>05138000
   ASMB (RSW;DEL); IF < THEN DEBUG;                            <<DEBUG>>05140000
$IF                                                            <<DEBUG>>05142000
   IF EXCHANGEDB(DDSDST) <> 0 THEN SYSABORT(DIRBADDST);        <<DE>>   05144000
   SIRRETURN := GETSIR (DIRSIR);                               <<56.PV>>05146000
   IF DADIRTY OR DBDIRTY THEN SYSABORT (DIRABERR);             <<DE>>   05148000
   ADJUST := -TOS;                                                      05150000
   XASEC := -1;                                                         05152000
   XGSEC := -1D;                                                        05154000
   IF RECIP'P AND PARMS'P THEN PARMS := PARMS - DELTAQ;        <<01.PV>>05156000
   CARRYX := 0;                                                         05158000
   TOS := @WORKAREA+1;                                                  05160000
   TOS := @PARR+ADJUST;                                                 05162000
   TOS := 6;                                                   <<38.PV>>05164000
   ASSEMBLE (MVLB);                                                     05166000
   IF MVTABX'P THEN XMVTABX:= MVTABX ELSE MVTABX:= XMVTABX;    <<38.PV>>05168000
   IF MVTABX = 0 THEN                                          <<38.PV>>05170000
   BEGIN  <<DEFAULT TO SYSVS DIRECTORY BASE>>                  <<38.PV>>05172000
       SYSVSDIRBASE;                                           <<38.PV>>05174000
       DIRBASE := TOS;                                         <<38.PV>>05176000
   END ELSE                                                    <<38.PV>>05178000
   BEGIN  <<SWITCH TO APPROPRIATE DIRECTORY BASE>>             <<38.PV>>05180000
       TOS := DDSDST;                 <<E: TARGET>>            <<38.PV>>05182000
       TOS := @DIRBASE;               <<D: TARGET OFFSET>>     <<38.PV>>05184000
       TOS := MVTABDST;               <<C: SOURCE>>            <<38.PV>>05186000
       TOS := (MVTABX*MVTABSZ)+2;     <<B: SOURCE OFFSET>>     <<38.PV>>05188000
       TOS := 2;                      <<A: COUNT>>             <<38.PV>>05190000
       ASSEMBLE (MDS);                                         <<38.PV>>05192000
       <<---------------------------------------------------->><<07103>>05194000
       << Extract dir. size from first word of Mounted Vol.  >><<07103>>05196000
       << Table entry. The dir. size in MVTAB entry used only>><<07103>>05198000
       << 11 bits i.e. must be multiply by 32 to obtain a    >><<07103>>05200000
       << real dir. size. The dir. size saved in DDSDST is   >><<07103>>05202000
       << used by Directory Space Management.                >><<07103>>05204000
       <<---------------------------------------------------->><<07103>>05206000
       TOS := DDSDST;                                          <<DE>>   05208000
       TOS := @PV'DIR'SIZE;                                    <<07103>>05210000
       TOS := MVTABDST;                                        <<DE>>   05212000
       TOS := MVTABX * MVTABSZ;                                <<07103>>05214000
       TOS := 1;                                               <<DE>>   05216000
       ASSEMBLE (MDS);                                         <<DE>>   05218000
       PV'DIR'SIZE := PV'DIR'SIZE &LSL (5);                    <<07103>>05220000
   END;                                                        <<38.PV>>05222000
   GOTO STARTSWITCH (XTYPE.(STARTLEVELF));                              05224000
NOINDEX:                                                                05226000
   XINDEXP := SYSACCTINDEX;                                             05228000
   IF XTYPE.(ENDLEVELFX) = ALLACCTS THEN GOTO OKAYEXIT;                 05230000
   MOVLB1 XANAME MOVLB2;                                                05232000
   IF XTYPE.(ENDLEVELF) = ACCOUNTLEVEL THEN GOTO OKAYEXIT;              05234000
   TOS := DIRFIND (SYSACCTINDEX); <<GET PTR TO ACCT ENTRY>>    <<47.PV>>05236000
   ASSEMBLE (DTST, DELB);                                               05238000
                                                                        05240000
   IF = THEN GOTO NONEXIST;                                             05242000
   XASEC := PS0 (ASECW);                                                05244000
   IF NOT RECIP'P AND PARMS'P THEN                             <<01.PV>>05246000
      BEGIN    <<CHECK FOR SAVE ACCESS>>                                05248000
      TOS := 0;                                                         05250000
      TOS := ACCOUNTLEVEL;                                              05252000
      TOS := XANAME &LSL(1);                                            05254000
      TOS := XASEC;                                                     05256000
      EXCHANGEDB (0);                                                   05258000
      TOS := ACCCHECK (*, *, *);                                        05260000
      EXCHANGEDB (DDSDST);                                              05262000
      IF NOT (TOS) THEN GOTO NOSAVE;                                    05264000
      END;                                                              05266000
   IF NUMSECTS'P THEN                                          <<01.PV>>05268000
      BEGIN    <<BUMP SECTOR COUNT>>                                    05270000
      TOS := TOS +ADFSCOUNT;                                            05272000
      IF (TOS := DPS0 +NUMSECTS) > DPS0(1) THEN GOTO NOROOM;            05274000
      DPS2 := TOS;                                                      05276000
      DIRWRITE (A);                                                     05278000
      TOS := TOS -ADFSCOUNT;                                            05280000
      END;                                                              05282000
   VISIT (TRUE); <<ACCOUNT ENTRY>>                             <<58.PV>>05284000
   CASE *XTYPE.(ENDLEVELF) OF                                  <<16.PV>>05286000
   BEGIN                                                       <<07.PV>>05288000
       XREG := AGIPNTR;    <<0 : FILE>>                        <<07.PV>>05290000
       XREG := AGIPNTR;    <<1 : GROUP>>                       <<07.PV>>05292000
       GO TO OKAYEXIT;     <<2 : ACCT - NEVER GET HERE>>       <<47.PV>>05294000
       XREG := AUIPNTR;    <<3 : USER>>                        <<07.PV>>05296000
       XREG := AGIPNTR;    <<4 : VSD>>                         <<07.PV>>05298000
   END;                                                        <<07.PV>>05300000
   XINDEXP := S0PNTR (XREG);                                            05302000
   DEL; <<PTR TO ACCT ENTRY>>                                  <<47.PV>>05304000
AINDEX:                                                                 05306000
   MOVLB1 XGUNAME MOVLB2;                                               05308000
   CASE *XTYPE.(ENDLEVELF) OF                                  <<16.PV>>05310000
   BEGIN                                                       <<08.PV>>05312000
       ; <<KEEP GOING>>    <<0 : FILE>>                        <<08.PV>>05314000
       GO TO OKAYEXIT;     <<1 : GROUP>>                       <<08.PV>>05316000
       GO TO OKAYEXIT;     <<2 : ACCT - NEVER GET HERE>>       <<47.PV>>05318000
       GO TO OKAYEXIT;     <<3 : USER - NEVER GET HERE>>       <<08.PV>>05320000
       ; <<KEEP GOING>>    <<4>>                               <<08.PV>>05322000
   END;                                                        <<08.PV>>05324000
   TOS := DIRFIND (XINDEXP); <<GET PTR TO GROUP ENTRY>>        <<47.PV>>05326000
   ASSEMBLE (DTST, DELB);                                               05328000
                                                                        05330000
   IF = THEN                                                            05332000
NONEXIST:    BADEXIT (2);                                               05334000
   TOS := PS0(GSEC);                                                    05336000
   TOS := PS1(GSEC+1);                                                  05338000
   XGSEC := TOS;                                                        05340000
   IF NOT RECIP'P AND PARMS'P THEN                             <<01.PV>>05342000
      BEGIN    <<CHECK SAVE ACCESS TO GROUP>>                           05344000
      TOS := 0;                                                         05346000
      TOS := GROUPLEVEL;                                                05348000
      TOS := XANAME &LSL(1);                                            05350000
      TOS := XASEC;                                                     05352000
      TOS := XGUNAME &LSL(1);                                           05354000
      TOS := XGSEC;                                                     05356000
      EXCHANGEDB (0);                                                   05358000
      TOS := ACCCHECK (*, *, *, *, *);                                  05360000
      EXCHANGEDB (DDSDST);                                              05362000
      IF NOT (TOS) THEN                                                 05364000
NOSAVE:    BADEXIT (3);                                                 05366000
      END;                                                              05368000
   IF NUMSECTS'P THEN                                          <<01.PV>>05370000
      BEGIN    <<ADJUST BY NUMSECTS>>                                   05372000
      TOS := TOS +GDFSCOUNT;                                            05374000
      IF (TOS := DPS0 +NUMSECTS) > DPS0(1) THEN                         05376000
NOROOM:    BADEXIT (8);                                                 05378000
      DPS2 := TOS;                                                      05380000
      DIRWRITE (A);                                                     05382000
      TOS := TOS -GDFSCOUNT;                                            05384000
      END;                                                              05386000
   VISIT (FALSE); <<GROUP ENTRY>>                              <<58.PV>>05388000
   CASE *XTYPE.(ENDLEVELF) OF                                  <<16.PV>>05390000
   BEGIN                                                       <<07.PV>>05392000
       XREG := GFIPNTR;    <<0 : FILE>>                        <<07.PV>>05394000
       GO TO OKAYEXIT;     <<1 : GROUP>>                       <<47.PV>>05396000
       GO TO OKAYEXIT;     <<2 : ACCT - NEVER GET HERE>>       <<47.PV>>05398000
       GO TO OKAYEXIT;     <<3 : USER - NEVER GET HERE>>       <<47.PV>>05400000
       XREG := GVSDIPNTR;  <<4 : VSD>>                         <<07.PV>>05402000
   END;                                                        <<07.PV>>05404000
   XINDEXP := S0PNTR (XREG);                                   <<07.PV>>05406000
   DEL; <<PTR TO GROUP ENTRY>>                                 <<47.PV>>05408000
GINDEX:                                                                 05410000
   IF NOT LOGICAL (XTYPE.(ALLFLAG)) THEN                       <<07.PV>>05412000
      BEGIN                                                             05414000
      MOVLB1 XFNAME MOVLB2;                                             05416000
      END;                                                              05418000
OKAYEXIT:                                                               05420000
   TOS := 0D;                                                           05422000
EXIT:                                                                   05424000
   DIRSTARTOFF := TOS;                                                  05426000
   END    <<SIMPLESTARTOFF>>;                                           05428000
                                                                        05430000
                                                                        05432000
                                                                        05434000
                                                                        05436000
DOUBLE PROCEDURE DIRECINSERT (TYPE, LINKAGE'INDEXP, ANAME,     <<38.PV>>05438000
                              GUNAME, FNAME, INSERT, MVTABX);  <<38.PV>>05440000
    VALUE   TYPE, LINKAGE'INDEXP, MVTABX;                      <<38.PV>>05442000
    LOGICAL TYPE, MVTABX;                                      <<38.PV>>05444000
    DOUBLE  LINKAGE'INDEXP;                                    <<38.PV>>05446000
    ARRAY   ANAME, GUNAME, FNAME, INSERT;                               05448000
    OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                            05450000
<< <INSERT> POINTS TO WORD AFTER <NAME> IN THEN ENTRY  (I.E. TO         05452000
   AN INDEXPOINTER OR FILE POINTER CELL).                               05454000
   ALLOCATES AND INITIALIZES APPROPRIATE INDICES FOR ACCOUNT AND GROUP  05456000
   ENTRIES  (THE CORRESPONDING INDEX CELLS OF <INSERT> ARE IGNORED).  >>05458000
    BEGIN                                                               05460000
        ARRAY PARR (*) = TYPE;                                          05462000
        LOGICAL                                                         05464000
            PMASK = Q-4;                                                05466000
            DEFINE                                                      05468000
                MVTABX'M = (15:1) #,                                    05470000
                MVTABX'P = PMASK.MVTABX'M #;                            05472000
            DOUBLE                                                      05474000
                JUNKD;                                                  05476000
            INTEGER                                                     05478000
                JUNK1 = JUNKD,                                          05480000
                JUNK0 = JUNK1+1;                                        05482000
        LOGICAL JMAT'SIR'ALLOC := FALSE;                       <<07102>>05484000
        LOGICAL JMAT'SIR'RET;                                  <<07102>>05486000
        DOUBLE  RETURN'VALUE = DIRECINSERT;                    <<07102>>05488000
<<>>                                                                    05490000
        DOUBLE SUBROUTINE NEWTREE (LEVEL, IBSIZE, EBSIZE,               05492000
                                   ESIZE, XIPNTR, SD);                  05494000
            VALUE   LEVEL, IBSIZE, EBSIZE, ESIZE, XIPNTR, SD;           05496000
            INTEGER LEVEL, IBSIZE, EBSIZE, ESIZE, XIPNTR, SD;           05498000
            BEGIN                                                       05500000
                DBPINDEXP := XINDEXP;                                   05502000
                MOVE DBPNAME := DDSENTRY ,(NAMESIZE);                   05504000
                TOS := DIRNEWINDEX (IBSIZE,                             05506000
                    LEVEL, EBSIZE, ESIZE);                              05508000
                IF <> THEN                                              05510000
                   BEGIN                                       <<DE>>   05512000
                     DEL;                                               05514000
                     CC := CCG;                                         05516000
                     JUNK1 := IBSIZE;                                   05518000
                     JUNK0 := 6;                                        05520000
                     NEWTREE := JUNKD;                                  05522000
                   END                                         <<DE>>   05524000
                ELSE                                                    05526000
                BEGIN                                                   05528000
                    EXCHANGEDB (0);                                     05530000
                    INSERT (S3<<XIPNTR>>-NAMESIZE) := TOS;              05532000
                    EXCHANGEDB (DDSDST);                                05534000
                END;                                                    05536000
            END;<<OF NEWTREE>>                                          05538000
                                                                        05540000
                                                                        05542000
        SUBROUTINE RETURNTREE (XIPNTR, IBSIZE);                         05544000
            VALUE   XIPNTR, IBSIZE;                                     05546000
            INTEGER XIPNTR, IBSIZE;                                     05548000
            BEGIN                                                       05550000
                EXCHANGEDB (0);                                         05552000
                TOS := INSERT (XIPNTR-NAMESIZE);                        05554000
                EXCHANGEDB (DDSDST);                                    05556000
                DIRDEALLOCATE (*, S2<<IBSIZE>>);                        05558000
            END;<<OF RETURNTREE>>                                       05560000
                                                                        05562000
                                                                        05564000
        DOUBLE SUBROUTINE INSERTENTRY (LEVEL);                          05566000
            VALUE   LEVEL;                                              05568000
            INTEGER LEVEL;                                              05570000
            BEGIN                                                       05572000
                TOS := NAMESIZE;                                        05574000
                TOS := @INSERT+ADJUST;                                  05576000
                CASE *S3 <<LEVEL>> OF                          <<16.PV>>05578000
                BEGIN                                                   05580000
                    TOS := FSIZE;                                       05582000
                    TOS := GSIZE;                                       05584000
                    TOS := ASIZE;                                       05586000
                    TOS := USIZE;                                       05588000
                    TOS := GVSDSIZE;                                    05590000
                END;                                                    05592000
                TOS := TOS - NAMESIZE;                                  05594000
                ASMB (MVLB);                                            05596000
                IF (INSERTENTRY := DIRINSERT (XINDEXP)) <> 0D THEN      05598000
                BEGIN  <<NEED TO RETURN DIR SPACE>>                     05600000
                    CASE *LEVEL OF                             <<16.PV>>05602000
                    BEGIN                                               05604000
                        ;      <<0: FILE>>                              05606000
                        BEGIN  <<1: GROUP>>                             05608000
                            RETURNTREE (GFIPNTR, SYSGFIBSIZE);          05610000
                            RETURNTREE (GVSDIPNTR, SYSGVSIBSIZE);       05612000
                        END;<<OF GROUP>>                                05614000
                        BEGIN  <<2: ACCT>>                              05616000
                            RETURNTREE (AGIPNTR, SYSAGIBSIZE);          05618000
                            RETURNTREE (AUIPNTR, SYSAUIBSIZE);          05620000
                        END;<<OF ACCT>>                                 05622000
                        ;       <<3: USER>>                             05624000
                        ;       <<4: VSD>>                              05626000
                    END;<<OF LEVEL>>                                    05628000
                    CC := CCG;  <<FAILURE>>                             05630000
                END;                                                    05632000
            END;<<OF INSERTENTRY>>                                      05634000
                                                                        05636000
                                                                        05638000
START :                                                        <<07102>>05640000
        CC := CCE;  <<OK UNTIL ANY FAILURE>>                            05642000
        IF MVTABX'P THEN                                                05644000
             TOS := DIRSTARTOFF (PARR,,,,MVTABX)                        05646000
        ELSE TOS := DIRSTARTOFF (PARR);                                 05648000
        ASMB (DTST);                                                    05650000
        IF = THEN                                                       05652000
        BEGIN <<FOUND REQUIRED LEVEL>>                                  05654000
            DDEL;                                                       05656000
            CASE *TYPE.(ENDLEVELF) OF                          <<16.PV>>05658000
            BEGIN                                                       05660000
                TOS := INSERTENTRY (FILELEVEL);                         05662000
                BEGIN  <<GROUP>>                                        05664000
                    TOS := NEWTREE (FILELEVEL, SYSGFIBSIZE,             05666000
                                    SYSFEBSIZE, FSIZE,                  05668000
                                    GFIPNTR, DIRINERR);        <<DE>>   05670000
                    ASMB (DTST);                                        05672000
                    IF = THEN  <<SUCCESSFULL?>>                         05674000
                    BEGIN                                               05676000
                        DDEL;                                           05678000
                        TOS := NEWTREE (VSDEFLEVEL,                     05680000
                             SYSGVSIBSIZE,SYSVSEBSIZE,                  05682000
                             GVSDSIZE, GVSDIPNTR, DIRVSDERR);  <<DE>>   05684000
                        ASMB (DTST);                                    05686000
                        IF <> THEN                                      05688000
                         RETURNTREE (GFIPNTR, SYSGFIBSIZE)              05690000
                        ELSE                                            05692000
                        BEGIN                                           05694000
                            DDEL;                                       05696000
                            TOS := INSERTENTRY (GROUPLEVEL);            05698000
                        END;                                            05700000
                    END;                                                05702000
                END;<<OF GROUP>>                                        05704000
                BEGIN  <<ACCT>>                                         05706000
                    TOS := NEWTREE (GROUPLEVEL, SYSAGIBSIZE,            05708000
                           SYSGEBSIZE,GSIZE,AGIPNTR,DIRINERR); <<DE>>   05710000
                    ASMB (DTST);                                        05712000
                    IF = THEN <<SUCCESSFULL?>>                          05714000
                    BEGIN                                               05716000
                        DDEL;                                           05718000
                        TOS := NEWTREE (USERLEVEL, SYSAUIBSIZE,         05720000
                                        SYSUEBSIZE, USIZE,              05722000
                                        AUIPNTR, DIRINERR);    <<DE>>   05724000
                        ASMB (DTST);                                    05726000
                        IF <> THEN RETURNTREE (AGIPNTR, SYSAGIBSIZE)    05728000
                        ELSE                                            05730000
                        BEGIN <<SUCCESSFULL>>                           05732000
                            DDEL;                                       05734000
                            TOS := INSERTENTRY (ACCOUNTLEVEL);          05736000
                        END;                                            05738000
                    END;                                                05740000
                END;<<OF ACCT>>                                         05742000
                TOS := INSERTENTRY (USERLEVEL);                         05744000
                TOS := INSERTENTRY (VSDEFLEVEL);                        05746000
            END;<<OF ENDLEVEL>>                                         05748000
        END ELSE CC := CCG;                                             05750000
        DIRECINSERT := TOS;                                             05752000
        RELSIR (DIRSIR,SIRRETURN);                                      05754000
        EXCHANGEDB (0);                                                 05756000
                                                               <<07102>>05758000
<<----------------------------------------------------------->><<07102>>05760000
<< This test is valid only for groups.                       >><<07102>>05762000
<< To expand number of groups per account by the expansion   >><<07102>>05764000
<< index block procedure, the JMAT SIR must be locked prior  >><<07102>>05766000
<< to the DIR SIR.                                           >><<07102>>05768000
<<----------------------------------------------------------->><<07102>>05770000
                                                               <<07102>>05772000
    IF RETURN'VALUE <> 0D AND          << If error           >><<07102>>05774000
       TYPE.(ENDLEVELF) = GROUPLEVEL AND                       <<07102>>05776000
       NOT JMAT'SIR'ALLOC THEN                                 <<07102>>05778000
       BEGIN                                                   <<07102>>05780000
       JMAT'SIR'RET := GETSIR (JMATSIR);                       <<07102>>05782000
       JMAT'SIR'ALLOC := TRUE;                                 <<07102>>05784000
       GOTO START;                                             <<07102>>05786000
       END;                                                    <<07102>>05788000
                                                               <<07102>>05790000
    IF JMAT'SIR'ALLOC THEN                                     <<07102>>05792000
       RELSIR (JMATSIR, JMAT'SIR'RET);                         <<07102>>05794000
                                                               <<07102>>05796000
    END;<<OF DIRECINSERT>>                                              05798000
                                                                        05800000
                                                                        05802000
                                                                        05804000
                                                                        05806000
                                                                        05808000
DOUBLE PROCEDURE DIRECINSERTFILE (NUMSECTS, DUMMY, ANAME,      <<38.PV>>05810000
                          GNAME, FNAME, FADDR, MVTABX);        <<38.PV>>05812000
   VALUE NUMSECTS, DUMMY, FADDR, MVTABX;                       <<38.PV>>05814000
   DOUBLE NUMSECTS, FADDR;                                              05816000
   INTEGER DUMMY, MVTABX;                                      <<38.PV>>05818000
   ARRAY ANAME, GNAME, FNAME;                                           05820000
   OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                    <<18.PV>>05822000
<<                                                                      05824000
   INSERTS FILE ENTRY UNDER ACCT AND GROUP.                             05826000
   INCREMENTS ACCT AND GROUP SPACE COUNTS BY <NUMSECTS>.                05828000
   CHECKS THAT USER HAS SAVE ACCESS TO GROUP.                           05830000
   (ALWAYS GLOBAL ACCESS).                                              05832000
   >>                                                                   05834000
BEGIN                                                                   05836000
   ENTRY DIRECRESETFILE;  <<NO SECURITY CHECK>>                <<00091>>05838000
   ARRAY PARR (*) = NUMSECTS;                                           05840000
   ARRAY FILENTRY (0:5);                                       <<18.PV>>05842000
   DOUBLE ARRAY DFILENTRY (*) = FILENTRY;                      <<18.PV>>05844000
   DOUBLE LNUMSECTS;                                                    05846000
   DOUBLE DDB4 = DB+4;                                                  05848000
   LOGICAL                                                     <<18.PV>>05850000
       PMASK = Q-4;                                            <<18.PV>>05852000
   DEFINE                                                      <<18.PV>>05854000
       MVTABX'M = (15:1) #,                                    <<18.PV>>05856000
       MVTABX'P = PMASK.MVTABX'M #;                            <<18.PV>>05858000
   INTEGER                                                     <<18.PV>>05860000
       TYPE = NUMSECTS;                                        <<38.PV>>05862000
   DOUBLE                                                      <<38.PV>>05864000
       LINKAGE'INDEXP = TYPE+1;                                <<38.PV>>05866000
   LOGICAL CHECKSEC;                                           <<00091>>05868000
                                                               <<00091>>05870000
   IF NOT (CHECKSEC:=TRUE) THEN                                <<00091>>05872000
      BEGIN                                                    <<00091>>05874000
DIRECRESETFILE:                                                <<00091>>05876000
      CHECKSEC:=FALSE;                                         <<00091>>05878000
      END;                                                     <<00091>>05880000
<< >>                                                                   05882000
   LNUMSECTS := NUMSECTS;                                               05884000
   NUMSECTS := DOUBLE (DUMMY := 0);                            <<43.PV>>05886000
   IF CHECKSEC THEN <<DO SECURITY CHECK>>                      <<00091>>05888000
      BEGIN                                                    <<00091>>05890000
      TOS:=IF NOT MVTABX'P THEN DIRSTARTOFF(PARR,LNUMSECTS,,0) <<00091>>05892000
           ELSE DIRSTARTOFF(PARR,LNUMSECTS,,0,MVTABX);         <<00091>>05894000
      END                                                      <<00091>>05896000
   ELSE <<NO SECURITY CHECK>>                                  <<00091>>05898000
      BEGIN                                                    <<00091>>05900000
      TOS:=IF NOT MVTABX'P THEN DIRSTARTOFF(PARR,LNUMSECTS)    <<00091>>05902000
           ELSE DIRSTARTOFF(PARR,LNUMSECTS,,,MVTABX);          <<00091>>05904000
      END;                                                     <<00091>>05906000
   ASSEMBLE (DTST);                                            <<43.PV>>05908000
   IF <> THEN GO TO BADEXIT;                                   <<43.PV>>05910000
   DDB4 := FADDR;                                                       05912000
   TOS := DIRINSERT (XINDEXP);                                          05914000
   ASSEMBLE (DTST);                                                     05916000
   IF <> THEN                                                           05918000
      BEGIN                                                             05920000
      DIRRESET (LNUMSECTS);                                             05922000
BADEXIT:                                                                05924000
      TOS := CCG;                                                       05926000
      END                                                               05928000
   ELSE                                                                 05930000
      TOS := CCE;                                                       05932000
   CC := TOS;                                                           05934000
   DIRECINSERTFILE := TOS;                                              05936000
   RELSIR (DIRSIR, SIRRETURN);                                          05938000
   EXCHANGEDB (0);                                             << ... >>05940000
   END    <<PROCEDURE DIRECINSERTFILE>>;                                05942000
                                                                        05944000
                                                                        05946000
                                                                        05948000
                                                                        05950000
DOUBLE PROCEDURE DIRECFIND (TYPE, LINKAGE'INDEXP, ANAME,GUNAME,<<38.PV>>05952000
                            FNAME, PRETURN);                   <<38.PV>>05954000
   VALUE TYPE, LINKAGE'INDEXP;                                 <<38.PV>>05956000
   INTEGER TYPE;                                               <<38.PV>>05958000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>05960000
   ARRAY ANAME, GUNAME, FNAME, PRETURN;                                 05962000
   OPTION PRIVILEGED, UNCALLABLE;                                       05964000
<< <PRETURN> WILL CONTAIN FULL FINAL ENTRY .  >>                        05966000
BEGIN                                                                   05968000
   LOGICAL LTYPE = TYPE;                                                05970000
                                                                        05972000
   ARRAY PARR (*) = TYPE;                                               05974000
   IF (TOS := DIRSTARTOFF (PARR)) <> 0D THEN GOTO BADEXIT;              05976000
   ASSEMBLE (DDEL);                                                     05978000
   TOS := @PRETURN+ADJUST;                                              05980000
   TOS := DIRFIND (XINDEXP);                                            05982000
   ASSEMBLE (DTST, DELB);                                               05984000
   IF = THEN                                                            05986000
      BEGIN                                                             05988000
      DDEL;                                                             05990000
      TOS := LTYPE.(ENDLEVELF);                                         05992000
      TOS := 2;                                                         05994000
BADEXIT:                                                                05996000
      TOS := CCG;                                                       05998000
      GOTO EXIT;                                                        06000000
      END;                                                              06002000
   CASE *TYPE.(ENDLEVELF) OF                                   <<16.PV>>06004000
      BEGIN                                                             06006000
      TOS := FSIZE;                                                     06008000
      TOS := GSIZE;                                                     06010000
      TOS := ASIZE;                                                     06012000
      TOS := USIZE;                                                     06014000
      TOS := GVSDSIZE;                                         <<05.PV>>06016000
      END;                                                              06018000
   ASSEMBLE (MVBL);                                                     06020000
   TOS := 0D;                                                           06022000
   TOS := CCE;                                                          06024000
EXIT:                                                                   06026000
   CC := TOS;                                                           06028000
   DIRECFIND := TOS;                                                    06030000
   RELSIR (DIRSIR, SIRRETURN);                                          06032000
   EXCHANGEDB (0);                                                      06034000
   END    <<DIRECFIND>>;                                                06036000
                                                                        06038000
                                                                        06040000
                                                                        06042000
                                                                        06044000
                                                                        06046000
DOUBLE PROCEDURE DIRECFINDFILE (TYPE, LINKAGE'INDEXP, ANAME,   <<38.PV>>06048000
                                GNAME, FNAME, PRETURN, MVTABX);<<38.PV>>06050000
   VALUE   TYPE, LINKAGE'INDEXP, MVTABX;                       <<38.PV>>06052000
   LOGICAL TYPE, MVTABX;                                       <<38.PV>>06054000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>06056000
   ARRAY ANAME, GNAME, FNAME, PRETURN;                                  06058000
   OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                    <<38.PV>>06060000
<< RETURNS IN <PRETURN> THEN FILE POINTER; AND ASEC/GSEC                06062000
      DEPENDING ON THE TYPE OF SEARCH. >>                               06064000
BEGIN                                                                   06066000
   LOGICAL                                                     <<38.PV>>06068000
       PMASK = Q-4;                                            <<38.PV>>06070000
   DEFINE                                                      <<38.PV>>06072000
       MVTABX'M = (15:1) #,                                    <<38.PV>>06074000
       MVTABX'P = PMASK.MVTABX'M #;                            <<38.PV>>06076000
   ARRAY PARR (*) = TYPE;                                               06078000
   IF MVTABX'P THEN                                            <<42.PV>>06080000
    TOS := DIRSTARTOFF (PARR,,,,MVTABX)                        <<42.PV>>06082000
   ELSE                                                        <<42.PV>>06084000
    TOS := DIRSTARTOFF (PARR);                                 <<42.PV>>06086000
   ASSEMBLE (DTST);                                            <<42.PV>>06088000
   IF <> THEN GO TO BADEXIT;                                   <<42.PV>>06090000
   << 2 ZEROES ON STACK >>                                              06092000
   TOS := DIRFIND (XINDEXP);                                            06094000
   ASSEMBLE (DTST, DELB);                                               06096000
   IF = THEN                                                            06098000
      BEGIN                                                             06100000
      << 3 ZEROS ON STACK >>                                   <<28.PV>>06102000
      DEL; <<ONE OF THEM. ONLY NEED 2>>                        <<28.PV>>06104000
      TOS := TOS +2;  <<NOT FOUND : FILE>>                     <<28.PV>>06106000
BADEXIT:                                                                06108000
      RELSIR (DIRSIR, SIRRETURN);                                       06110000
      EXCHANGEDB (0);                                                   06112000
      TOS := CCG;                                                       06114000
      GOTO EXIT;                                                        06116000
      END;                                                              06118000
   TOS := DPS0(2);                                                      06120000
   TOS := XGSEC;                                                        06122000
   TOS := XASEC;                                                        06124000
   CARRYX := IF DABADELM THEN 1 ELSE 0;                                 06126000
   RELSIR (DIRSIR, SIRRETURN);                                          06128000
   EXCHANGEDB (0);                                                      06130000
   TOS := @PRETURN;                                                     06132000
   TOS := @S5;                                                          06134000
   IF INTEGER (TYPE.(STARTLEVELF)) = 1 THEN TOS := 4                    06136000
   ELSE IF < THEN TOS := 5                                              06138000
      ELSE TOS := 2;                                                    06140000
   ASSEMBLE (MOVE);                                                     06142000
   ASSEMBLE (SUBS 6);                                                   06144000
   TOS := CCE;                                                          06146000
EXIT:                                                                   06148000
   CC := TOS;                                                           06150000
   DIRECFINDFILE := TOS;                                       << ... >>06152000
   END    <<PROCEDURE DIRECFINDFILE>>;                                  06154000
DOUBLE PROCEDURE DIRECSETFLAG (TYPE,LINKAGE'INDEXP,ANAME,      <<38.PV>>06156000
                               GNAME,FNAME,MVTABX);            <<32.PV>>06158000
    VALUE   TYPE,LINKAGE'INDEXP,MVTABX;                        <<38.PV>>06160000
    LOGICAL TYPE, MVTABX;                                      <<38.PV>>06162000
    DOUBLE  LINKAGE'INDEXP;                                    <<38.PV>>06164000
    ARRAY   ANAME,GNAME,FNAME;                                 <<32.PV>>06166000
    OPTION  PRIVILEGED,UNCALLABLE,VARIABLE;                    <<32.PV>>06168000
    COMMENT                                                             06170000
        RETURNS CONDITION CODE ONLY.                                    06172000
            CCE - FILE ENTRY FLAGGED                                    06174000
            CCL - FILE NOT FOUNG                                        06176000
            CCG - FILE ENTRY ALREADY FLAGGED;                           06178000
    BEGIN                                                               06180000
        ENTRY DIRECRESETFLAG;                                           06182000
        LOGICAL                                                <<32.PV>>06184000
            SETFLAG := TRUE,                                   <<32.PV>>06186000
            PMASK = Q-4;                                       <<32.PV>>06188000
        ARRAY PARR (*) = TYPE;                                          06190000
       DEFINE                                                  <<32.PV>>06192000
           MVTABX'M = (15:1) #,                                <<32.PV>>06194000
           MVTABX'P = PMASK.MVTABX'M #;                        <<32.PV>>06196000
        IF FALSE THEN                                                   06198000
DIRECRESETFLAG:                                                         06200000
         SETFLAG := FALSE;                                              06202000
        IF MVTABX'P THEN                                       <<42.PV>>06204000
         TOS := DIRSTARTOFF (PARR,,,,MVTABX)                   <<42.PV>>06206000
        ELSE                                                   <<42.PV>>06208000
         TOS := DIRSTARTOFF (PARR);                            <<42.PV>>06210000
        ASSEMBLE (DTST);                                       <<42.PV>>06212000
        IF <> THEN GO TO NFOUND;                               <<42.PV>>06214000
        TOS := DIRFIND (XINDEXP);                                       06216000
        ASSEMBLE (DTST,DELB);                                           06218000
        IF = THEN                                                       06220000
        BEGIN                                                           06222000
            DEL;  DDEL;                                        <<43.PV>>06224000
            TOS := [16/0, 16/2] D;                             <<32.PV>>06226000
NFOUND:                                                                 06228000
            TOS := CCG;                                                 06230000
            GO EXIT;                                                    06232000
        END;                                                            06234000
        IF DABADELM AND SETFLAG THEN                           <<32.PV>>06236000
        BEGIN <<ALREADY SET>>                                  <<32.PV>>06238000
            DEL;                                               <<32.PV>>06240000
            TOS := CCL;                                        <<32.PV>>06242000
            GO EXIT;                                           <<32.PV>>06244000
        END;                                                   <<32.PV>>06246000
        S0PNTR (2) := IF SETFLAG THEN S0PNTR (2) LOR %100000            06248000
                          ELSE S0PNTR (2) LAND %77777;                  06250000
        DEL;                                                            06252000
        DIRWRITE (A); <<WRITE ENTRY BUFFER>>                            06254000
        TOS := CCE;                                                     06256000
EXIT:                                                                   06258000
        CC := TOS;                                                      06260000
        DIRECSETFLAG := TOS;                                   <<32.PV>>06262000
        RELSIR (DIRSIR,SIRRETURN);                                      06264000
        EXCHANGEDB (0);  <<BACK TO STACK>>                              06266000
        END;<<OF DIRECSETFLAG/DIRECRESETFLAG>>                          06268000
DOUBLE PROCEDURE DIRECBIND (TYPE, LINKAGE'INDEXP, ANAME,       <<38.PV>>06270000
                          GUNAME, GIPNTR, MVTABX);             <<41.PV>>06272000
    VALUE   TYPE, LINKAGE'INDEXP, MVTABX;                      <<38.PV>>06274000
    INTEGER TYPE, GIPNTR, MVTABX;                              <<41.PV>>06276000
    DOUBLE  LINKAGE'INDEXP;                                    <<38.PV>>06278000
    ARRAY   ANAME, GUNAME;                                     <<23.PV>>06280000
    OPTION  PRIVILEGED, UNCALLABLE, VARIABLE;                  <<23.PV>>06282000
    COMMENT                                                    <<23.PV>>06284000
        DB MUST BE AT STACK WHEN CALLED.                       <<23.PV>>06286000
        RETURNS: 0D IF MOUNT (LOGICAL) SUCCESSFULL.            <<23.PV>>06288000
                 FAILURE CAUSE VIA FUNCTION IF UNSUCCESSFULL.  <<23.PV>>06290000
                 CONDITION CODE :                              <<23.PV>>06292000
                     CCE - SUCCESSFULL                         <<23.PV>>06294000
                     CCG - SEARCH FAILURE                      <<23.PV>>06296000
                           FUNCTION (RESULT) CONTAINS ERROR    <<23.PV>>06298000
                           CODE (SEARCH FAILURE) AND ENTRY     <<23.PV>>06300000
                           TYPE NOT FOUND.                     <<23.PV>>06302000
                     CCL - NOT RETURNED                        <<23.PV>>06304000
    ;                                                          <<23.PV>>06306000
    BEGIN                                                      <<23.PV>>06308000
        DOUBLE                                                 <<23.PV>>06310000
            RESULT = DIRECBIND;                                <<23.PV>>06312000
        INTEGER                                                <<23.PV>>06314000
            DSIR,                                              <<50.PV>>06316000
            RS1 = RESULT,                                      <<23.PV>>06318000
            RS0 = RS1+1,                                       <<23.PV>>06320000
            REFCNTR,                                           <<51.PV>>06322000
            FIPNTR,                                            <<51.PV>>06324000
            TEMP;                                              <<23.PV>>06326000
       LOGICAL                                                 <<23.PV>>06328000
           PMASK = Q-4;                                        <<23.PV>>06330000
        DEFINE                                                 <<23.PV>>06332000
            MVTABX'M = (15:1) #,                               <<23.PV>>06334000
            MVTABX'P = PMASK.MVTABX'M #;                       <<23.PV>>06336000
        ARRAY                                                  <<23.PV>>06338000
            PARR (*) = TYPE;                                   <<23.PV>>06340000
                                                               <<23.PV>>06342000
        INTEGER SUBROUTINE GETENTRY (MVTABX');                 <<50.PV>>06344000
            VALUE   MVTABX';                                   <<50.PV>>06346000
            INTEGER MVTABX';                                   <<50.PV>>06348000
            BEGIN                                              <<23.PV>>06350000
                IF (RESULT :=                                  <<23.PV>>06352000
                   DIRSTARTOFF (PARR,,,,MVTABX')) <> 0D THEN   <<23.PV>>06354000
                 TOS := 0                                      <<50.PV>>06356000
                ELSE                                           <<23.PV>>06358000
                BEGIN <<FIND REQUIRED ENTRY AND/OR TREE>>      <<51.PV>>06360000
                    TOS := DIRFIND (XINDEXP);                  <<23.PV>>06362000
                    ASMB (DTST, DELB);                         <<23.PV>>06364000
                    IF = THEN RESULT := [16/1, 16/2] D;        <<50.PV>>06366000
                END;                                           <<23.PV>>06368000
                TEMP := TOS;                                   <<23.PV>>06370000
                GETENTRY := TEMP;                              <<23.PV>>06372000
            END;<<OF GETENTRY>>                                <<23.PV>>06374000
                                                               <<23.PV>>06376000
        SUBROUTINE LOCKTREE (REFCNTR');                        <<51.PV>>06378000
            VALUE   REFCNTR';                                  <<51.PV>>06380000
            INTEGER REFCNTR';                                  <<51.PV>>06382000
            BEGIN                                              <<51.PV>>06384000
                EXCHANGEDB (0);                                <<51.PV>>06386000
                TYPE := FILELEVEL & LSL (3);                   <<51.PV>>06388000
                GETENTRY (MVTABX);                             <<51.PV>>06390000
                DBPCOUNT := REFCNTR';                          <<51.PV>>06392000
                DIRWRITE (B);                                  <<51.PV>>06394000
            END;<<OF LOCKTREE>>                                <<51.PV>>06396000
                                                               <<51.PV>>06398000
        CC := CCG;                                             <<23.PV>>06400000
        TYPE := GROUPLEVEL & LSL (3);  <<FORCE IT>>            <<23.PV>>06402000
        IF (TOS := GETENTRY (MVTABX)) = 0 THEN                 <<50.PV>>06404000
        BEGIN  <<NOT FOUND IN PV DIRECTORY>>                   <<50.PV>>06406000
            DEL;                                               <<50.PV>>06408000
            RS1 := -RS1; <<INDICATE WHICH DIRECTORY>>          <<50.PV>>06410000
            <<CALLERS RESPONSIBILITY TO DISMOUNT>>             <<50.PV>>06412000
        END ELSE                                               <<50.PV>>06414000
        BEGIN  <<FOUND IN PV DIRECTORY>>                       <<50.PV>>06416000
            DSIR := SIRRETURN; <<MOST ACCURATE COPY FOR EXIT>> <<56.PV>>06418000
            TOS := PS0 (GFIPNTR);  <<DIR ADDR IN PV>>          <<50.PV>>06420000
            DELB;                <<ENTRY POINTER>>             <<50.PV>>06422000
            EXCHANGEDB (0);                                    <<50.PV>>06424000
            IF (TOS := GETENTRY (0)) <> 0 THEN                 <<50.PV>>06426000
            BEGIN  <<FOUND IN SYSTEM DIRECTORY>>               <<50.PV>>06428000
                IF PS0 (GLINKAGE).(MVTABXF) <> 0 THEN          <<50.PV>>06430000
                BEGIN <<ALREADY MOUNTED?>>                     <<50.PV>>06432000
                    IF PS0 (GMOUNTREFCNTR) <= 0 THEN           <<50.PV>>06434000
                       SYSABORT (DIRPVBINDERR);                <<DE>>   06436000
                    IF PS0 (GLINKAGE).(MVTABXF) <> MVTABX      <<01420>>06438000
                       THEN SYSABORT (DIRPVBINDERR);           <<DE>>   06440000
                    FIPNTR := PS0 (GFIPNTR);                   <<51.PV>>06442000
                END ELSE                                       <<50.PV>>06444000
                BEGIN                                          <<50.PV>>06446000
                    PS0 (GLINKAGE).(MVTABXF) := MVTABX;        <<50.PV>>06448000
                    PS0 (GSAVEFIPNTR) := PS0 (GFIPNTR);        <<50.PV>>06450000
                    FIPNTR := PS0 (GFIPNTR) := S1;             <<50.PV>>06452000
                END;                                           <<50.PV>>06454000
                REFCNTR := PS0 (XREG) := PS0 (GMOUNTREFCNTR)+1;<<51.PV>>06456000
                DDEL;                                          <<50.PV>>06458000
                DIRWRITE (A);  <<UPDATE ENTRY BLOCK>>          <<50.PV>>06460000
                LOCKTREE (REFCNTR);                            <<51.PV>>06462000
                CC := CCE;                                     <<50.PV>>06464000
            END ELSE DEL;                                      <<50.PV>>06466000
            SIRRETURN := DSIR;                                 <<56.PV>>06468000
        END;                                                   <<50.PV>>06470000
        RELSIR (DIRSIR,SIRRETURN);                             <<56.PV>>06472000
        EXCHANGEDB (0);  <<TO STACK>>                          <<23.PV>>06474000
        GIPNTR := FIPNTR;                                      <<51.PV>>06476000
    END;<<OF DIRECBIND>>                                       <<23.PV>>06478000
DOUBLE PROCEDURE DIRECUNBIND (TYPE, LINKAGE'INDEXP, ANAME,     <<38.PV>>06480000
                              GUNAME, MVTABX);                 <<23.PV>>06482000
    VALUE   TYPE, LINKAGE'INDEXP, MVTABX;                      <<38.PV>>06484000
    INTEGER TYPE, MVTABX;                                      <<38.PV>>06486000
    DOUBLE  LINKAGE'INDEXP;                                    <<38.PV>>06488000
    ARRAY   ANAME, GUNAME;                                     <<23.PV>>06490000
    OPTION  PRIVILEGED, UNCALLABLE, VARIABLE;                  <<23.PV>>06492000
    COMMENT                                                    <<23.PV>>06494000
        DB MUST BE AT STACK WHEN CALLED.                       <<23.PV>>06496000
        RETURNS:                                               <<23.PV>>06498000
                                                               <<23.PV>>06500000
                 CONDITION CODE :                              <<23.PV>>06502000
                     CCE - SUCCESSFULL                         <<23.PV>>06504000
                     CCG - SEARCH FAILURE                      <<23.PV>>06506000
                           FUNCTION (RESULT) CONTAINS ERROR    <<23.PV>>06508000
                           CODE (SEARCH FAILURE) AND ENTRY     <<23.PV>>06510000
                           TYPE NOT FOUND.                     <<23.PV>>06512000
                     CCL - NOT RETURNED                        <<23.PV>>06514000
    ;                                                          <<23.PV>>06516000
    BEGIN                                                      <<23.PV>>06518000
        DOUBLE                                                 <<23.PV>>06520000
            RESULT = DIRECUNBIND;                              <<23.PV>>06522000
        INTEGER                                                <<23.PV>>06524000
            DSIR,                                              <<56.PV>>06526000
            RS1 = RESULT,                                      <<23.PV>>06528000
            RS0 = RS1+1,                                       <<23.PV>>06530000
            REFCNTR,                                           <<51.PV>>06532000
            TEMP;                                              <<23.PV>>06534000
        LOGICAL                                                <<23.PV>>06536000
            PMASK = Q-4;                                       <<23.PV>>06538000
        DEFINE                                                 <<23.PV>>06540000
            MVTABX'M = (15:1) #,                               <<23.PV>>06542000
            MVTABX'P = PMASK.MVTABX'M #;                       <<23.PV>>06544000
        ARRAY                                                  <<23.PV>>06546000
            PARR (*) = TYPE;                                   <<23.PV>>06548000
                                                               <<23.PV>>06550000
        INTEGER SUBROUTINE GETENTRY (MVTABX');                 <<50.PV>>06552000
            VALUE   MVTABX';                                   <<51.PV>>06554000
            INTEGER MVTABX';                                   <<51.PV>>06556000
            BEGIN                                              <<23.PV>>06558000
                IF (RESULT :=                                  <<23.PV>>06560000
                    DIRSTARTOFF (PARR,,,,MVTABX')) <> 0D THEN  <<51.PV>>06562000
                     TOS := 0                                  <<51.PV>>06564000
                ELSE                                           <<23.PV>>06566000
                BEGIN <<FIND REQUIRED ENTRY AND/OR TREE>>      <<51.PV>>06568000
                    TOS := DIRFIND (XINDEXP);                  <<23.PV>>06570000
                    ASMB (DTST, DELB);                         <<23.PV>>06572000
                    IF = THEN RESULT := [16/1, 16/2] D;        <<50.PV>>06574000
                END;                                           <<23.PV>>06576000
                TEMP := TOS;                                   <<23.PV>>06578000
                GETENTRY := TEMP;                              <<23.PV>>06580000
            END;<<OF GETENTRY>>                                <<23.PV>>06582000
                                                               <<23.PV>>06584000
        SUBROUTINE UNLOCKTREE (REFCNTR');                      <<51.PV>>06586000
            VALUE   REFCNTR';                                  <<51.PV>>06588000
            INTEGER REFCNTR';                                  <<51.PV>>06590000
            BEGIN                                              <<51.PV>>06592000
                EXCHANGEDB (0);                                <<51.PV>>06594000
                TYPE := FILELEVEL & LSL (3);                   <<51.PV>>06596000
                GETENTRY (MVTABX);                             <<51.PV>>06598000
                DBPCOUNT := REFCNTR';                          <<51.PV>>06600000
                DIRWRITE (B);                                  <<51.PV>>06602000
            END;<<OF UNLOCKTREE>>                              <<51.PV>>06604000
                                                               <<51.PV>>06606000
        CC := CCG;                                             <<23.PV>>06608000
        TYPE := GROUPLEVEL & LSL (3);  <<FORCE IT>>            <<23.PV>>06610000
        IF (TOS := GETENTRY (0)) <> 0 THEN                     <<50.PV>>06612000
        BEGIN <<FOUND>>                                        <<48.PV>>06614000
            DSIR := SIRRETURN; <<MOST ACCURATE COPY FOR EXIT>> <<56.PV>>06616000
            REFCNTR := PS0 (XREG) := PS0 (GMOUNTREFCNTR) - 1;  <<51.PV>>06618000
            IF PS0 (XREG) <= 0 THEN                            <<48.PV>>06620000
            BEGIN                                              <<48.PV>>06622000
                IF < THEN SYSABORT (DIRPVBINDERR);             <<DE>>   06624000
                PS0 (GFIPNTR) := PS0 (GSAVEFIPNTR);            <<48.PV>>06626000
                PS0 (GLINKAGE).(MVTABXF) := 0;                 <<48.PV>>06628000
                PS0 (GSAVEFIPNTR) := 0;                        <<48.PV>>06630000
            END;                                               <<48.PV>>06632000
            DEL;                                               <<48.PV>>06634000
            DIRWRITE (A);  <<UPDATE ENTRY BLOCK>>              <<48.PV>>06636000
            UNLOCKTREE (REFCNTR);                              <<51.PV>>06638000
            CC := CCE;                                         <<48.PV>>06640000
            SIRRETURN := DSIR;                                 <<56.PV>>06642000
        END ELSE DEL;                                          <<50.PV>>06644000
        RELSIR (DIRSIR,SIRRETURN);                             <<23.PV>>06646000
        EXCHANGEDB (0);  <<TO STACK>>                          <<23.PV>>06648000
    END;<<OF DIRECUNBIND>>                                     <<23.PV>>06650000
                                                                        06652000
                                                                        06654000
                                                                        06656000
                                                                        06658000
<< *** PURGE ROUTINES *** >>                                            06660000
                                                                        06662000
                                                                        06664000
                                                                        06666000
                                                                        06668000
                                                                        06670000
<< THESE PROCEDURES RETURN THE NUMBER OF SECTORS REMOVED. >>            06672000
<< CARRY SET IF ENTRY (OR TREE) ENTIRELY REMOVED. >>                    06674000
                                                                        06676000
                                                                        06678000
                                                                        06680000
                                                                        06682000
DOUBLE PROCEDURE DIRPURGESCAN (PURGER, MVTABX);                <<26.PV>>06684000
   VALUE MVTABX;                                               <<26.PV>>06686000
   DOUBLE PROCEDURE PURGER;                                             06688000
   INTEGER MVTABX;                                             <<26.PV>>06690000
                                                                        06692000
   OPTIONS;                                                             06694000
<< B CONTAINS INDEX TO BE CLEANSED.                                     06696000
   THIS ROUTINE RESTORES A.                                             06698000
   <PURGER> MUST AT MOST ONLY REMOVE ENTRY FROM A  (I.E. RETURN A       06700000
   ALMOST- AND B EXACTLY- INTACT).  >>                                  06702000
BEGIN                                                                   06704000
   DOUBLE RESULT = DIRPURGESCAN;                                        06706000
   POINTER                                                              06708000
      IPNTR, IEND,                                                      06710000
      EPNTR, EEND;                                                      06712000
                                                                        06714000
   TOS := DACONTENTS;    <<SAVE FOR RESTORE OF A>>                      06716000
   TOS := A;                                                            06718000
   TOS := DAXCOUNT;                                                     06720000
   TOS := DAMISCWD;                                                     06722000
   TOS := DADIRBASE; <<DIRECTORY BASE FOR DACONTENTS>>         <<01055>>06724000
   @IEND := (@IPNTR := @DBLPNTR) + DBUSED;                              06726000
   WHILE @IPNTR < @IEND DO    <<SCAN THRU INDICES>>                     06728000
      BEGIN                                                             06730000
      DIRREAD (IPNTR (IEPNTR), A, IPNTR (IECOUNT), DBEMISCWD);          06732000
      @EEND := (@EPNTR := @DALPNTR) + DAUSED;                           06734000
      WHILE @EPNTR < @EEND DO    <<SCAN THRU ENTRIES>>                  06736000
         BEGIN                                                          06738000
         TOS := 0D;                                                     06740000
         TOS := @EPNTR;                                                 06742000
         TOS := MVTABX;                                        <<26.PV>>06744000
         TOS := PURGER (*, *);                                 <<26.PV>>06746000
         IF CARRY THEN                                                  06748000
            BEGIN    <<ACTUALLY REMOVED; WAS NOT BEING USED>>           06750000
            DBETOTAL := DBETOTAL-1;                                     06752000
            IPNTR(IECOUNT) := IPNTR(IECOUNT)-1;                         06754000
            IF @EPNTR = @DALPNTR THEN                                   06756000
               MOVE IPNTR := DALPNTR, (NAMESIZE);                       06758000
            DIRWRITE (B);                                      <<53.PV>>06760000
            DIRWRITE (A);                                      <<53.PV>>06762000
            @EEND := @EEND-DAXSIZE;                                     06764000
            END                                                         06766000
         ELSE                                                           06768000
            @EPNTR := @EPNTR+DAXSIZE;                                   06770000
         DIRPURGESCAN := TOS +RESULT;                                   06772000
         END;<<OF ENTRY BLOCK SCAN>>                           <<53.PV>>06774000
      IF DAXCOUNT = 0 THEN                                              06776000
         BEGIN    <<ENTRY BLOCK DEPLETED>>                              06778000
         DIRREMOVE (IPNTR, B);                                          06780000
         DIRWRITE (B);                                         <<53.PV>>06782000
         @IEND := @IEND-DBXSIZE;                                        06784000
         END                                                            06786000
      ELSE                                                              06788000
         BEGIN                                                          06790000
         IF DADIRTY THEN DIRWRITE (A);                         <<53.PV>>06792000
         @IPNTR := @IPNTR+DBXSIZE;                                      06794000
         END;                                                           06796000
      END;<<OF INDEX BLOCK SCAN>>                              <<53.PV>>06798000
   DIRBASE := TOS; <<AS IT WAS UPON ENTRY>>                    <<01055>>06800000
   DIRREAD (*, *, *, *);                                                06802000
   CARRYX:= IF (DBXCOUNT +DBPCOUNT) = 0 THEN 1 ELSE 0;                  06804000
   END    <<DIRPURGESCAN>>;                                             06806000
                                                                        06808000
                                                                        06810000
                                                                        06812000
                                                                        06814000
DOUBLE PROCEDURE DDELFILE (NTRY, MVTABX);                      <<26.PV>>06816000
   VALUE MVTABX;                                               <<26.PV>>06818000
   ARRAY NTRY;                                                          06820000
   INTEGER MVTABX;                                             <<26.PV>>06822000
   OPTIONS;                                                             06824000
BEGIN                                                                   06826000
   DOUBLE ARRAY DENTRY (*) = NTRY;                                      06828000
   EQUATE VTABDST = 29;                                                 06830000
   INTEGER ARRAY VTAB (*) = DB+0;                                       06832000
                                                                        06834000
   TOS := 0D;                                                           06836000
   TOS := DENTRY (2);                                                   06838000
   TOS := LUN (S1.(0:8),MVTABX);                               <<26.PV>>06840000
   S2.(0:8) := 0;                                              <<26.PV>>06842000
   ASSEMBLE (CAB, CAB);                                        <<26.PV>>06844000
   EXCHANGEDB (0);                                             <<26.PV>>06846000
                                                                        06848000
   TOS := FRELSPACE (*, *, MVTABX);                            <<00630>>06850000
   EXCHANGEDB (DDSDST);                                                 06852000
   IF (DDELFILE := TOS) <> 0D THEN                                      06854000
      BEGIN                                                             06856000
      DIRREMOVE (NTRY, A);                                              06858000
      TOS := 1;                                                         06860000
      END                                                               06862000
   ELSE TOS := 0;                                                       06864000
   CARRYX := TOS;                                                       06866000
   END    <<DDELFILE>>;                                                 06868000
                                                                        06870000
                                                                        06872000
                                                                        06874000
                                                                        06876000
DOUBLE PROCEDURE DDELVSD (NTRY, MVTABX);                       <<26.PV>>06878000
    VALUE MVTABX;                                              <<26.PV>>06880000
    ARRAY NTRY;                                                <<10.PV>>06882000
    INTEGER MVTABX;                                            <<26.PV>>06884000
    OPTIONS;                                                   <<10.PV>>06886000
                                                               <<32.PV>>06888000
    BEGIN                                                      <<10.PV>>06890000
        IF NTRY (GVSLINKAGEW).(MVTABXF) = 0 THEN               <<34.PV>>06892000
        BEGIN  <<NOT IN USE>>                                  <<32.PV>>06894000
            DIRREMOVE (NTRY, A);                               <<32.PV>>06896000
            CARRYX := 1;                                       <<32.PV>>06898000
        END ELSE CARRYX := 0;                                  <<33.PV>>06900000
    END;<<OF DDELVSD>>                                         <<10.PV>>06902000
                                                               <<10.PV>>06904000
                                                               <<10.PV>>06906000
                                                               <<10.PV>>06908000
                                                               <<10.PV>>06910000
                                                               <<15.PV>>06912000
                                                               <<15.PV>>06914000
                                                               <<15.PV>>06916000
                                                               <<15.PV>>06918000
DOUBLE PROCEDURE DDELUSER (NTRY, MVTABX);                      <<26.PV>>06920000
   VALUE MVTABX;                                               <<26.PV>>06922000
   ARRAY NTRY;                                                          06924000
   INTEGER MVTABX;                                             <<26.PV>>06926000
   OPTIONS;                                                             06928000
BEGIN                                                                   06930000
   IF NTRY (ULOGCOUNT) = 0 THEN                                         06932000
      BEGIN                                                             06934000
      DIRREMOVE (NTRY, A);                                              06936000
      TOS := 1;                                                         06938000
      END                                                               06940000
   ELSE                                                                 06942000
      BEGIN                                                             06944000
      NTRY (UPURGEFLAGW).(UPURGEFLAGF) := GONEFLAG;                     06946000
      DADIRTY := TRUE;                                                  06948000
      TOS := 0;                                                         06950000
      END;                                                              06952000
   CARRYX := TOS;                                                       06954000
   DDELUSER := 0D;                                                      06956000
   END    <<DDELUSER>>;                                                 06958000
                                                                        06960000
                                                                        06962000
                                                                        06964000
                                                                        06966000
DOUBLE PROCEDURE DDELGROUP (NTRY, MVTABX);                     <<26.PV>>06968000
   VALUE MVTABX;                                               <<26.PV>>06970000
   ARRAY NTRY;                                                          06972000
   INTEGER MVTABX;                                             <<26.PV>>06974000
   OPTIONS;                                                             06976000
BEGIN                                                                   06978000
   DOUBLE POINTER DNTRY = NTRY;                                         06980000
   DOUBLE                                                      <<15.PV>>06982000
       SECTORS,                                                <<01055>>06984000
       PVDIRBASE,                                              <<01055>>06986000
       SAVEVSD;                                                <<15.PV>>06988000
   LOGICAL                                                     <<15.PV>>06990000
       VSDGONE := FALSE,                                       <<43.PV>>06992000
       BOUNDTOHVS;                                             <<43.PV>>06994000
   TOS := DBCONTENTS;                                                   06996000
   TOS := DBDIRBASE; <<DIRECTORY BASE FOR DBCONTENTS>>         <<45.PV>>06998000
   DIRREAD (NTRY (GVSDIPNTR), B, 0, 0);                        <<15.PV>>07000000
   DIRPURGESCAN (DDELVSD, MVTABX);                             <<26.PV>>07002000
   IF CARRY THEN                                               <<15.PV>>07004000
   BEGIN                                                       <<15.PV>>07006000
       TOS := DBCONTENTS;                                      <<15.PV>>07008000
       TOS := DBBSIZE;                                         <<15.PV>>07010000
       SAVEVSD := TOS;                                         <<15.PV>>07012000
       VSDGONE := TRUE;                                        <<15.PV>>07014000
   END;                                                        <<15.PV>>07016000
   IF BOUNDTOHVS := (NTRY (GLINKAGE).(PVF) = PV LAND           <<45.PV>>07018000
                     NTRY (XREG).(MVTABXF) <> 0) THEN          <<45.PV>>07020000
   BEGIN                                                       <<45.PV>>07022000
       MVTABX := NTRY (XREG).(MVTABXF);                        <<45.PV>>07024000
       TOS := DDSDST;                 <<E: TARGET>>            <<45.PV>>07026000
       TOS := @DIRBASE;               <<D: TARGET OFFSET>>     <<45.PV>>07028000
       TOS := MVTABDST;               <<C: SOURCE>>            <<45.PV>>07030000
       TOS := (MVTABX*MVTABSZ)+2;     <<B: SOURCE OFFSET>>     <<45.PV>>07032000
       TOS := 2;                      <<A: COUNT>>             <<45.PV>>07034000
       ASSEMBLE (MDS);                                         <<45.PV>>07036000
       PVDIRBASE := DIRBASE; <<MAY NEED IT LATER>>             <<01055>>07038000
   END;                                                        <<45.PV>>07040000
   DIRREAD (NTRY(GFIPNTR), B, 0, 0);                                    07042000
   << *** DELETE ALL FILES NOT BEING USED *** >>                        07044000
   SECTORS := DIRPURGESCAN (DDELFILE, MVTABX);                 <<01055>>07046000
   IF CARRY AND VSDGONE AND NOT BOUNDTOHVS THEN                <<43.PV>>07048000
      BEGIN    <<FULLY SUCCESSFUL DELETION: REMOVE ENTRY & ITS INDEX>>  07050000
      DIRDEALLOCATE (DBCONTENTS, DBBSIZE);                              07052000
      <<EMIT LOG RECORD>>                                               07054000
      DBDIRTY := DBCONTENTS := 0;                                       07056000
      TOS := SAVEVSD;                                          <<15.PV>>07058000
      DIRDEALLOCATE (*, *);                                    <<15.PV>>07060000
      DIRREMOVE (NTRY, A);                                              07062000
      TOS := 1;                                                         07064000
      END                                                               07066000
   ELSE                                                                 07068000
      BEGIN    <<ENTRY WAS IN-USE>>                            <<61.PV>>07070000
          IF BOUNDTOHVS THEN                                   <<61.PV>>07072000
          BEGIN                                                <<61.PV>>07074000
              TOS := DACONTENTS;  <<SAVE THE ENVIRONMENT>>     <<01055>>07076000
              TOS := A;           <<FOR RESTORING BUFFER (A)>> <<01055>>07078000
              TOS := DAXCOUNT;    <<AFTER ACCOUNTING HOUSE- >> <<01055>>07080000
              TOS := DAMISCWD;    <<KEEPING (DIRRESET) IN>>    <<01055>>07082000
              TOS := DADIRBASE;   <<PV'S DIRECTORY>>           <<01055>>07084000
              DIRBASE := PVDIRBASE; <<SET UP FOR SWITCH>>      <<01055>>07086000
              DIRREAD (NTRY (GFIPNTR),B,0,0);                  <<01055>>07088000
              DIRRESET (SECTORS);                              <<01055>>07090000
              DIRBASE := TOS;    <<SET UP FOR SWITCH BACK>>    <<01055>>07092000
              DIRREAD (*,*,*,*); <<RESTORE ENTRY BUFFER (A)>>  <<01055>>07094000
              SECTORS := 0D; <<ALREADY UPDATED. FAKE IT>>      <<01055>>07096000
          END ELSE                                             <<61.PV>>07098000
          BEGIN                                                <<61.PV>>07100000
              DBMISCWD.(IPURGEFLAGF) := GONEFLAG;              <<61.PV>>07102000
              NTRY (GPURGEFLAGW).(GPURGEFLAGF) := GONEFLAG;    <<61.PV>>07104000
              @NTRY := @NTRY + GDFSCOUNT;                      <<61.PV>>07106000
              DNTRY := DNTRY - SECTORS;                        <<01055>>07108000
              DIRWRITE (B);                                    <<61.PV>>07110000
              DADIRTY := TRUE;                                 <<61.PV>>07112000
              <<CALLER MUST WRITE OUT THIS GROUP>>             <<61.PV>>07114000
          END;                                                 <<61.PV>>07116000
          TOS := 0; <<TO SET CARRY>>                           <<61.PV>>07118000
      END;                                                              07120000
   CARRYX := TOS;                                                       07122000
   DDELGROUP := SECTORS;                                       <<01055>>07124000
   DIRBASE := TOS; <<AS IT WAS UPON ENTRY>>                    <<45.PV>>07126000
   DIRREAD (*, B, 0, 0);    <<RESTORE INCOMING INDEX>>                  07128000
   END    <<DDELGROUP>>;                                                07130000
                                                                        07132000
                                                                        07134000
                                                                        07136000
DOUBLE PROCEDURE DDELACCT (NTRY, MVTABX);                      <<26.PV>>07138000
   VALUE MVTABX;                                               <<26.PV>>07140000
   ARRAY NTRY;                                                          07142000
   INTEGER MVTABX;                                             <<26.PV>>07144000
   OPTIONS;                                                             07146000
BEGIN                                                                   07148000
   DOUBLE POINTER DNTRY = NTRY;                                         07150000
   DOUBLE                                                      <<15.PV>>07152000
       SAVEU;                                                           07154000
   LOGICAL                                                     <<15.PV>>07156000
       FREEUSERS := FALSE;                                              07158000
                                                                        07160000
   TOS := DBCONTENTS;                                                   07162000
   DIRREAD (NTRY(AUIPNTR), B, 0, 0);                                    07164000
   DIRPURGESCAN (DDELUSER, MVTABX);                            <<26.PV>>07166000
   IF CARRY THEN                                                        07168000
      BEGIN                                                             07170000
      TOS := DBCONTENTS;                                                07172000
      TOS := DBBSIZE;                                                   07174000
      SAVEU := TOS;                                                     07176000
      FREEUSERS := TRUE;                                                07178000
      END;                                                              07180000
   DBMISCWD.(IPURGEFLAGF) := GONEFLAG;                                  07182000
   DIRWRITE (B);                                                        07184000
   DIRREAD (NTRY(AGIPNTR), B, 0, 0);                                    07186000
   TOS := DIRPURGESCAN (DDELGROUP, MVTABX);                    <<26.PV>>07188000
   IF CARRY AND FREEUSERS THEN                                          07190000
      BEGIN                                                             07192000
      DIRDEALLOCATE (DBCONTENTS, DBBSIZE);                              07194000
      DBDIRTY := DBCONTENTS := 0;                                       07196000
      TOS := SAVEU;                                                     07198000
      DIRDEALLOCATE (*, *);                                             07200000
      <<EMIT LOG RECORD>>                                               07202000
      DIRREMOVE (NTRY, A);                                              07204000
      TOS := 1;                                                         07206000
      END                                                               07208000
   ELSE                                                                 07210000
      BEGIN                                                             07212000
      DBMISCWD.(IPURGEFLAGF) := GONEFLAG;                               07214000
      DNTRY (ADFSCOUNTD) := -DS1 +DNTRY (ADFSCOUNTD);                   07216000
      DIRWRITE (B);                                                     07218000
      DADIRTY := TRUE;                                                  07220000
      TOS := 0;                                                         07222000
      END;                                                              07224000
   CARRYX := TOS;                                                       07226000
   DDELACCT := TOS;                                                     07228000
   DIRREAD (*, B, 0, 0);                                                07230000
   END    <<DDELACCT>>;                                                 07232000
                                                                        07234000
                                                                        07236000
                                                                        07238000
DOUBLE PROCEDURE DIRECPURGE (TYPE, LINKAGE'INDEXP, ANAME,      <<38.PV>>07240000
                             GUNAME, FNAME, MVTABX);           <<38.PV>>07242000
   VALUE TYPE, LINKAGE'INDEXP, MVTABX;                         <<38.PV>>07244000
   INTEGER TYPE, MVTABX;                                       <<38.PV>>07246000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>07248000
   ARRAY ANAME, GUNAME, FNAME;                                          07250000
   OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                    <<21.PV>>07252000
                                                                        07254000
<< GENERAL PURGE ROUTINE                                                07256000
                                                                        07258000
DOUBLE PROCEDURE DIRECPURGEFILE                                         07260000
      (NUMSECTS, DUMMY, ANAME, GNAME, FNAME);                    43.PV  07262000
   VALUE NUMSECTS, DUMMY;                                        43.PV  07264000
   DOUBLE NUMSECTS;                                                     07266000
   INTEGER DUMMY;                                                43.PV  07268000
   ...                                                                  07270000
   PURGE FILE ENTRY AND ADJUST ACCT & GROUP SPACE COUNTS                07272000
   BY <NUMSECTS>.                                                       07274000
   >>                                                                   07276000
BEGIN                                                                   07278000
   ENTRY DIRECPURGEFILE;                                                07280000
   ARRAY PARR (*) = TYPE;                                               07282000
   DOUBLE NUMSECTS = TYPE;                                              07284000
   DOUBLE LNUMSECTS;                                                    07286000
   LOGICAL FFLAG := FALSE;                                              07288000
   INTEGER SAVEFSIR = LNUMSECTS;                                        07290000
   EQUATE FSIR = 37;                                                    07292000
   DOUBLE GROUPSPACEGONE := 0D;                                         07294000
   LOGICAL                                                     <<21.PV>>07296000
       PMASK = Q-4;                                            <<21.PV>>07298000
       DEFINE                                                  <<21.PV>>07300000
           MVTABX'M = (15:1) #,                                <<21.PV>>07302000
           MVTABX'P = PMASK.MVTABX'M #;                        <<21.PV>>07304000
                                                                        07306000
                                                                        07308000
   IF TYPE.(ENDLEVELF) <> 3 THEN SAVEFSIR := GETSIR(FSIR);     <<03.PV>>07310000
   IF MVTABX'P THEN                                            <<21.PV>>07312000
    TOS := DIRSTARTOFF (PARR,,,,MVTABX)                        <<21.PV>>07314000
   ELSE                                                        <<21.PV>>07316000
   BEGIN                                                       <<26.PV>>07318000
       MVTABX := 0;                                            <<26.PV>>07320000
       TOS := DIRSTARTOFF (PARR);                              <<26.PV>>07322000
   END;                                                        <<26.PV>>07324000
   GOTO START;                                                          07326000
                                                                        07328000
                                                                        07330000
DIRECPURGEFILE:                                                         07332000
   FFLAG := TRUE;                                                       07334000
   LNUMSECTS := NUMSECTS;                                               07336000
   NUMSECTS := 0D;                                                      07338000
   IF MVTABX'P THEN                                            <<42.PV>>07340000
    TOS := DIRSTARTOFF (PARR, LNUMSECTS, , ,MVTABX)            <<42.PV>>07342000
   ELSE                                                        <<42.PV>>07344000
   BEGIN                                                       <<42.PV>>07346000
       MVTABX := 0;                                            <<42.PV>>07348000
       TOS := DIRSTARTOFF (PARR, LNUMSECTS);                   <<42.PV>>07350000
   END;                                                        <<42.PV>>07352000
                                                                        07354000
                                                                        07356000
START:                                                                  07358000
   IF DS1 <> 0D THEN GOTO BADEXIT;                                      07360000
   ASSEMBLE (DDEL);                                                     07362000
   TOS := DIRFIND (XINDEXP);                                            07364000
   ASSEMBLE (DTST);                                                     07366000
   IF = THEN                                                            07368000
      BEGIN                                                             07370000
      DDEL;                                                             07372000
      TOS := TYPE.(ENDLEVELF);                                          07374000
      TOS := 2;                                                         07376000
      GOTO BADEXIT0;                                                    07378000
      END;                                                              07380000
   ASSEMBLE (DDUP, ZROB);                                               07382000
   ASSEMBLE (DUP, ZROB);                                                07384000
   CASE *TYPE.(ENDLEVELF) OF                                   <<16.PV>>07386000
      BEGIN                                                             07388000
         BEGIN                                                          07390000
         DIRREMOVE (*, A);                                              07392000
         ASSEMBLE (NEG, DDEL);    <<SET CARRY>>                         07394000
         END;                                                           07396000
      GROUPSPACEGONE := DDELGROUP (*, MVTABX);                 <<26.PV>>07398000
      DDELACCT (*, MVTABX);                                    <<26.PV>>07400000
      DDELUSER (*, MVTABX);                                    <<26.PV>>07402000
      DDELVSD (*, MVTABX);                                     <<26.PV>>07404000
                                                                        07406000
      END;                                                              07408000
   IF CARRY THEN                                                        07410000
      BEGIN                                                             07412000
      XREG := IECOUNT;                                                  07414000
      DBETOTAL := DBETOTAL-1;                                           07416000
      IF TOS = @DALPNTR THEN                                            07418000
         BEGIN                                                          07420000
         ASSEMBLE (DUP);                                                07422000
         MOVE * := DALPNTR, (NAMESIZE);                                 07424000
         END;                                                           07426000
      S0IPNTR(XREG) := S0IPNTR(XREG)-1;                                 07428000
      IF = THEN                                                         07430000
         BEGIN                                                          07432000
         DIRREMOVE (*, B);                                              07434000
         TOS := 0;                                                      07436000
         END;                                                           07438000
      ASSEMBLE (ZERO, ZROB);                                            07440000
      TOS := CCE;                                                       07442000
      DIRWRITE (B);                                                     07444000
      IF DADIRTY THEN DIRWRITE (A);                            <<53.PV>>07446000
      DIRXXXBITMAP (WRITE);                                    <<28.PV>>07448000
      END                                                               07450000
   ELSE                                                                 07452000
      BEGIN                                                             07454000
      IF DADIRTY THEN DIRWRITE (A);                            <<53.PV>>07456000
      DIRXXXBITMAP (WRITE);                                    <<43.PV>>07458000
      ASSEMBLE (ZROB, DEL);                                             07460000
      TOS := 7;                                                         07462000
BADEXIT0:                                                               07464000
      IF FFLAG THEN DIRRESET (LNUMSECTS);                               07466000
BADEXIT:                                                                07468000
      TOS := CCG;                                                       07470000
      END;                                                              07472000
   CC := TOS;                                                           07474000
   DIRECPURGE := TOS;                                                   07476000
   TOS := GROUPSPACEGONE;                                               07478000
   IF <> THEN DIRRESET (*) ELSE ASSEMBLE (DDEL);                        07480000
   RELSIR (DIRSIR, SIRRETURN);                                          07482000
   IF NOT (FFLAG)                                                       07484000
      AND TYPE.(ENDLEVELF) <> 3 THEN RELSIR (FSIR, SAVEFSIR);  <<03.PV>>07486000
   EXCHANGEDB (0);                                                      07488000
   END    <<DIRECPURGE>>;                                               07490000
                                                                        07492000
                                                                        07494000
                                                                        07496000
                                                                        07498000
                                                                        07500000
DOUBLE PROCEDURE DIRECADJUST (NUMSECTS, DUMMY,                 <<39.PV>>07502000
                              ANAME, GNAME, MVTABX);           <<39.PV>>07504000
   VALUE NUMSECTS, DUMMY, MVTABX;                              <<39.PV>>07506000
   DOUBLE NUMSECTS;                                                     07508000
   INTEGER DUMMY, MVTABX;                                      <<39.PV>>07510000
   ARRAY ANAME, GNAME;                                                  07512000
   OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                    <<39.PV>>07514000
<< ADJUSTS THA ACCT AND GROUP SPACE COUNTS BY NUMSECTS >>               07516000
BEGIN                                                                   07518000
   LOGICAL                                                     <<39.PV>>07520000
       PMASK = Q-4;                                            <<39.PV>>07522000
   DEFINE                                                      <<39.PV>>07524000
       MVTABX'M = (15:1) #,                                    <<39.PV>>07526000
       MVTABX'P = PMASK.MVTABX'M #;                            <<39.PV>>07528000
   ARRAY PARR (*) = NUMSECTS;                                           07530000
   DOUBLE LNUMSECTS;                                                    07532000
   LNUMSECTS := NUMSECTS;                                               07534000
   TOS := 0;  TOS.(ALLFLAG) := TRUE;                           <<26.PV>>07536000
   TOS := 0;                                                            07538000
   NUMSECTS := TOS;                                                     07540000
   DUMMY := 0;                                                 <<38.PV>>07542000
   IF NOT MVTABX'P THEN MVTABX := 0;                           <<39.PV>>07544000
   IF (DIRECADJUST :=                                          <<39.PV>>07546000
       DIRSTARTOFF (PARR,LNUMSECTS,,,MVTABX)) <> 0D THEN       <<39.PV>>07548000
      TOS := CCG                                                        07550000
   ELSE TOS := CCE;                                                     07552000
   CC := TOS;                                                           07554000
   RELSIR (DIRSIR, SIRRETURN);                                          07556000
   EXCHANGEDB (0);                                             << ... >>07558000
   END    <<PROCEDURE DIRECADJUST>>;                                    07560000
                                                                        07562000
                                                                        07564000
                                                                        07566000
                                                                        07568000
LOGICAL PROCEDURE DIRDOENTRY (ELEMENT, LEAFLEVEL, RECIP,       <<56.PV>>07570000
                              PARMS, VISIT);                   <<56.PV>>07572000
   VALUE LEAFLEVEL, PARMS, VISIT;                              <<56.PV>>07574000
   ARRAY ELEMENT;                                                       07576000
   INTEGER LEAFLEVEL, PARMS;                                            07578000
   LOGICAL VISIT;                                              <<56.PV>>07580000
   INTEGER PROCEDURE RECIP;                                             07582000
   OPTION PRIVILEGED, UNCALLABLE, FORWARD;                              07584000
                                                                        07586000
                                                                        07588000
                                                                        07590000
                                                                        07592000
PROCEDURE DIRSCANTREE (INDEX, LEAFLEVEL, RECIP, PARMS);                 07594000
   VALUE INDEX, LEAFLEVEL, PARMS;                                       07596000
   INTEGER INDEX, LEAFLEVEL, PARMS;                                     07598000
   INTEGER PROCEDURE RECIP;                                             07600000
   OPTIONS;                                                             07602000
BEGIN                                                                   07604000
   INTEGER                                                     <<56.PV>>07606000
       VISIT := TRUE;                                          <<56.PV>>07608000
   INTEGER POINTER                                                      07610000
      IP,                                                               07612000
      EP;                                                               07614000
   DOUBLE POINTER                                                       07616000
      DIP = IP,                                                         07618000
      DEP = EP,                                                         07620000
      DDBLPNTR = DBLPNTR;                                               07622000
   DOUBLE ARRAY DDDSENTRY (*) = DDSENTRY;                               07624000
<< >>                                                                   07626000
   DIRREAD (INDEX, B, 0, 0);     << GET TREE >>                         07628000
   DBPCOUNT := DBPCOUNT +1;      << MARK AS UNDELETABLE >>              07630000
   DIRWRITE (B);                                                        07632000
   TOS := DDBLPNTR;              << START SCAN: INITIAL NAME >>         07634000
   TOS := DDBLPNTR (1) & DLSL (1) & DLSR (1);                           07636000
   PARMS := PARMS -DELTAQ;                                              07638000
                                                                        07640000
NEXTNAME:                                                               07642000
   << INDEX IN BLOCK B; TARGET NAME ON TOS >>                           07644000
   DDDSENTRY (1) := TOS;                                                07646000
   DDDSENTRY := TOS;                                                    07648000
   @IP := DIRSCAN (DDSENTRY, EPB);  << FIND CONTAINING BLOCK >>         07650000
   IF = THEN                                                            07652000
      BEGIN    <<OK. SO FIND NEXT BLOCK FOR THIS DUMMY ENTRY>>          07654000
      @IP := DIRSCAN (DDSENTRY, ENB);                                   07656000
      IF = THEN GOTO LEAVE;                                             07658000
      END;                                                              07660000
NEXTBLOCK:                                                              07662000
   DIRREAD (IP (IEPNTR), A, IP (IECOUNT), DBEMISCWD);                   07664000
   @EP := DIRSCAN (DDSENTRY, ENA);  << FIND ENTRY IN BLOCK >>           07666000
   IF = THEN                                                            07668000
      BEGIN                      << NOT IN ENTRY BLOCK >>               07670000
      IF (@IP := @IP +DBXSIZE) >= @DBLPNTR +DBUSED THEN GOTO LEAVE;     07672000
                                                                        07674000
                                                                        07676000
      GOTO NEXTBLOCK;                                                   07678000
      END;                                                              07680000
   TOS := DEP;                                                          07682000
   TOS := DEP (1) & DLSL (1) & DLSR (1);                                07684000
   DABADELM := EP (2) < 0;  <<FLAGGED ENTRY?>>                 <<00175>>07686000
   TOS := DIRDOENTRY (EP, LEAFLEVEL, RECIP, PARMS, VISIT);     <<56.PV>>07688000
   << DIRECTORY MAY BE COMPLETELY MODIFIED, EXCEPT THAT                 07690000
      INDEX BLOCK <INDEX> STILL EXISTS.     THE DIRECTORY IS LOCKED >>  07692000
   DIRREAD (INDEX, B, 0, 0);                                            07694000
   IF TOS <= 0 THEN                                            <<56.PV>>07696000
   BEGIN  <<CONTINUE SCAN>>                                    <<56.PV>>07698000
       IF = THEN                                               <<56.PV>>07700000
       BEGIN  <<NEXT TARGET NAME & VISIT ENTRY>>               <<56.PV>>07702000
           TOS := TOS+1;  <<NEXT TARGET NAME>>                 <<56.PV>>07704000
           VISIT := TRUE;                                      <<56.PV>>07706000
       END ELSE <<REDO ENTRY - NO VISIT>> VISIT := FALSE;      <<56.PV>>07708000
       GO TO NEXTNAME;                                         <<56.PV>>07710000
   END;                                                        <<56.PV>>07712000
                                                                        07714000
LEAVE:                                                                  07716000
   DBPCOUNT := DBPCOUNT -1;            <<ALLOW DELETION>>               07718000
   DIRWRITE (B);                                                        07720000
   END    <<DIRSCANTREE>>;                                              07722000
                                                                        07724000
                                                                        07726000
                                                                        07728000
                                                                        07730000
LOGICAL PROCEDURE DIRDOENTRY (ELEMENT, LEAFLEVEL, RECIP,       <<56.PV>>07732000
                    PARMS, VISIT);                             <<56.PV>>07734000
   VALUE LEAFLEVEL, PARMS, VISIT;                              <<56.PV>>07736000
   ARRAY ELEMENT;                                                       07738000
   INTEGER LEAFLEVEL, PARMS;                                            07740000
   LOGICAL VISIT;                                              <<56.PV>>07742000
   INTEGER PROCEDURE RECIP;                                             07744000
   OPTIONS;                                                             07746000
BEGIN                                                                   07748000
   ARRAY SAVEGLOB1 (0:10) = Q;    <<ASSUME AT Q+1>>            <<38.PV>>07750000
   DOUBLE SAVEDIRBASE;                                         <<11.PV>>07752000
   INTEGER                                                     <<11.PV>>07754000
       ADDR,                                                   <<11.PV>>07756000
       MVTABX := 0; <<WHEN NON-ZERO, SWITCH "DIRBASE">>        <<11.PV>>07758000
<< >>                                                                   07760000
   XREG := 0;                                                  <<10.PV>>07762000
   CASE *DAMISCWD.(LEVELF) OF  <<CURRENT SUBTREE>>             <<16.PV>>07764000
   BEGIN                                                       <<07.PV>>07766000
       ;                                               <<0>>   <<10.PV>>07768000
       BEGIN                                           <<1>>   <<11.PV>>07770000
           IF LEAFLEVEL = FILELEVEL THEN                       <<11.PV>>07772000
           BEGIN  <<SET UP FOR POSSIBLE "DIRBASE" SWITCH>>     <<11.PV>>07774000
               IF ELEMENT (GLINKAGE).(PVF) = PV THEN           <<11.PV>>07776000
                MVTABX := ELEMENT (GLINKAGE).(MVTABXF);        <<11.PV>>07778000
               XREG := GFIPNTR;                                <<11.PV>>07780000
           END                                                 <<11.PV>>07782000
           ELSE XREG := GVSDIPNTR;                             <<11.PV>>07784000
       END;                                            <<1>>   <<11.PV>>07786000
       CASE *LEAFLEVEL OF                              <<2>>   <<16.PV>>07788000
       BEGIN                                                   <<07.PV>>07790000
           XREG := AGIPNTR;   <<0>>                            <<07.PV>>07792000
           XREG := AGIPNTR;   <<1>>                            <<07.PV>>07794000
           ;                  <<2>>                            <<10.PV>>07796000
           XREG := AUIPNTR;   <<3>>                            <<07.PV>>07798000
           XREG := AGIPNTR;   <<4>>                            <<07.PV>>07800000
       END;                                                    <<07.PV>>07802000
       ;                                               <<3>>   <<10.PV>>07804000
       ;                                               <<4>>   <<10.PV>>07806000
   END;                                                        <<07.PV>>07808000
   TOS := IF XREG = 0 THEN 0 ELSE ELEMENT (XREG);              <<07.PV>>07810000
   TOS := DAMISCWD.(LEVELF);                                            07812000
   TOS := SETCRITICAL;    <<DISALLOW ABORTION IN RECIP>>                07814000
   PARMS := PARMS - DELTAQ;                                    <<56.PV>>07816000
   IF VISIT THEN                                               <<56.PV>>07818000
   BEGIN                                                       <<56.PV>>07820000
       TOS := 0;     << GET READY FOR VISIT VIA RECIP >>       <<56.PV>>07822000
       TOS := @ELEMENT;                                        <<56.PV>>07824000
       TOS := S3;                                              <<56.PV>>07826000
       TOS := PARMS;                                           <<56.PV>>07828000
       TOS := DIRSIR;                                          <<56.PV>>07830000
       TOS := SIRRETURN;                                       <<56.PV>>07832000
       PUSH (Q, DL);                                           <<56.PV>>07834000
       ASSEMBLE(LSUB,INCA,DUP);                                <<DE>>   07836000
       ADDR := TOS;                                            <<DE>>   07838000
       TOS := @WORKAREA;                                       <<56.PV>>07840000
       TOS := 11;                                              <<56.PV>>07842000
       ASSEMBLE (MVBL);                                        <<56.PV>>07844000
       SAVEDIRBASE := DIRBASE;                                 <<56.PV>>07846000
       TOS := RECIP (*, *, *, *);    << VISIT ENTRY >>         <<56.PV>>07848000
       IF NOT (LS0) OR S0 < 0 THEN                             <<56.PV>>07850000
       BEGIN                                                   <<56.PV>>07852000
           IF NOT LS0 THEN GETSIR (DIRSIR) <<SIR WAS RELEASED>><<58.PV>>07854000
            ELSE S0.(15:1) := 0; <<RESET SIR FLAG>>            <<58.PV>>07856000
           TOS := @WORKAREA;                                   <<56.PV>>07858000
           TOS := ADDR;                                        <<56.PV>>07860000
           TOS := 11;                                          <<56.PV>>07862000
           ASSEMBLE (MVLB);                                    <<56.PV>>07864000
           DIRBASE := SAVEDIRBASE;                             <<56.PV>>07866000
           IF S0 < 0 THEN                                      <<56.PV>>07868000
           BEGIN <<REQUESTED TO REDO ENTRY>>                   <<56.PV>>07870000
               DIRDOENTRY := TOS;                              <<56.PV>>07872000
               RESETCRITICAL (*);                              <<56.PV>>07874000
               RETURN;                                         <<56.PV>>07876000
           END;                                                <<56.PV>>07878000
       END ELSE S0.(15:1) := 0; <<RESET SIR FLAG>>             <<58.PV>>07880000
   END <<OF VISITING ENTRY>> ELSE                              <<56.PV>>07882000
   BEGIN <<NO VISIT>>                                          <<56.PV>>07884000
       SAVEDIRBASE := DIRBASE;                                 <<56.PV>>07886000
       TOS := 0;  <<SET UP FOR NEXT TEST ON TOS>>              <<56.PV>>07888000
   END;                                                        <<56.PV>>07890000
   IF TOS & LSR(1) > 1 THEN                                             07892000
      DIRDOENTRY := 1;           << STOP SCAN >>                        07894000
   RESETCRITICAL(*);                                                    07896000
   IF < THEN                     << CONTINUE SCAN >>                    07898000
      IF TOS <> LEAFLEVEL THEN                                          07900000
      BEGIN                                                    <<11.PV>>07902000
          IF MVTABX <> 0 THEN  <<NEXT SUBTREE ON MOUNTED PV>>  <<11.PV>>07904000
          BEGIN                                                <<11.PV>>07906000
              TOS := DDSDST;            <<E: TARGET>>          <<45.PV>>07908000
              TOS := @DIRBASE;          <<D: TARGET OFFSET>>   <<45.PV>>07910000
              TOS := MVTABDST;          <<C: SOURCE>>          <<45.PV>>07912000
              TOS := (MVTABX*MVTABSZ)+2;<<B: SOURCE OFFSET>>   <<45.PV>>07914000
              TOS := 2;                 <<A: COUNT>>           <<45.PV>>07916000
              ASSEMBLE (MDS);                                  <<45.PV>>07918000
          END;                                                 <<11.PV>>07920000
          DIRSCANTREE (*, LEAFLEVEL, RECIP, PARMS);            <<11.PV>>07922000
      END;                                                     <<11.PV>>07924000
   DIRBASE := SAVEDIRBASE;                                     <<11.PV>>07926000
   END    <<DIRDOENTRY>>;                                               07928000
                                                                        07930000
                                                                        07932000
                                                                        07934000
                                                                        07936000
DOUBLE PROCEDURE DIRECSCAN (TYPE, LINKAGE'INDEXP, ANAME,       <<38.PV>>07938000
                          GUNAME, FNAME, RECIP, PARMS, MVTABX);<<38.PV>>07940000
   VALUE TYPE, LINKAGE'INDEXP, MVTABX;                         <<38.PV>>07942000
   INTEGER TYPE, MVTABX;                                       <<38.PV>>07944000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>07946000
   INTEGER PROCEDURE RECIP;                                             07948000
   ARRAY ANAME, GUNAME, FNAME, PARMS;                                   07950000
   OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                    <<35.PV>>07952000
BEGIN                                                                   07954000
   ARRAY PARR (*) = TYPE;                                               07956000
   LOGICAL                                                     <<35.PV>>07958000
       DSIR,                                                   <<56.PV>>07960000
       LTYPE = TYPE,                                           <<35.PV>>07962000
       PMASK = Q-4;                                            <<35.PV>>07964000
   DEFINE                                                      <<35.PV>>07966000
       MVTABX'M = (15:1) #,                                    <<35.PV>>07968000
       MVTABX'P = PMASK.MVTABX'M #;                            <<35.PV>>07970000
                                                                        07972000
<< >>                                                                   07974000
                                                                        07976000
                                                                        07978000
   TOS := @PARMS;                                                       07980000
   PUSH (Q);                                                            07982000
   @PARMS := TOS -TOS;                                                  07984000
   IF LTYPE.(HITFLAG) THEN                                     <<56.PV>>07986000
   BEGIN                                                       <<56.PV>>07988000
       IF MVTABX'P THEN                                        <<56.PV>>07990000
        TOS := DIRSTARTOFF (PARR,,RECIP,@PARMS,MVTABX)         <<56.PV>>07992000
       ELSE                                                    <<56.PV>>07994000
        TOS := DIRSTARTOFF (PARR, ,RECIP, @PARMS);             <<56.PV>>07996000
       IF DS1 < 0D THEN                                        <<56.PV>>07998000
       BEGIN  <<NEED TO REDO STARTOFF - DDS WAS DISTURBED>>    <<56.PV>>08000000
           DDEL; <<RETURN FROM DIRSTARTOFF>>                   <<56.PV>>08002000
           DSIR := SIRRETURN; <<MOST ACCURATE COPY FOR EXIT>>  <<56.PV>>08004000
           EXCHANGEDB (0);                                     <<56.PV>>08006000
           IF MVTABX'P THEN                                    <<56.PV>>08008000
            TOS := DIRSTARTOFF (PARR,,,,MVTABX)                <<56.PV>>08010000
           ELSE                                                <<56.PV>>08012000
            TOS := DIRSTARTOFF (PARR);                         <<56.PV>>08014000
           SIRRETURN := DSIR;                                  <<56.PV>>08016000
       END;                                                    <<56.PV>>08018000
   END                                                         <<56.PV>>08020000
   ELSE                                                        <<42.PV>>08022000
    IF MVTABX'P THEN                                           <<42.PV>>08024000
     TOS := DIRSTARTOFF (PARR,,,,MVTABX)                       <<42.PV>>08026000
    ELSE                                                       <<42.PV>>08028000
     TOS := DIRSTARTOFF (PARR);                                <<42.PV>>08030000
   IF DS1 <> 0D THEN GOTO BADEXIT;                                      08032000
   IF CARRY THEN GOTO GOODEXIT;                                         08034000
   << (2 ZEROS ON STACK) >>                                             08036000
   IF LOGICAL (TYPE.(ALLFLAG)) THEN                                     08038000
      DIRSCANTREE (XINDEXP, TYPE.(TOLEVELF), RECIP, @PARMS)             08040000
   ELSE                                                                 08042000
      BEGIN                                                             08044000
      TOS := XINDEXP;            << MAKE USE OF 2 ZEROS >>              08046000
      TOS := DIRFIND (*);        << VISIT ROOT >>                       08048000
      ASSEMBLE (DTST, ZROB);     << SETUP FOR DIRDOENTRY >>             08050000
      IF = THEN                                                         08052000
         BEGIN                                                          08054000
         ASSEMBLE (DDEL);                                               08056000
         TOS := TYPE.(ENDLEVELF);                                       08058000
         TOS := 2;                                                      08060000
BADEXIT: TOS := CCG;                                                    08062000
         GOTO EXIT;                                                     08064000
         END;                                                           08066000
      DIRDOENTRY (*, TYPE.(TOLEVELF), RECIP, @PARMS, TRUE);    <<56.PV>>08068000
      TOS := 0D;                                                        08070000
      END;                                                              08072000
                                                                        08074000
GOODEXIT:                                                               08076000
   IF DADIRTY THEN DIRWRITE (A);                                        08078000
   IF DBDIRTY THEN DIRWRITE (B);                                        08080000
   TOS := CCE;                                                          08082000
EXIT:                                                                   08084000
   CC := TOS;                                                           08086000
   DIRECSCAN := TOS;                                                    08088000
   RELSIR (DIRSIR, SIRRETURN);                                          08090000
   EXCHANGEDB (0);                                                      08092000
   END    <<DIRECSCAN>>;                                                08094000
                                                                        08096000
INTEGER PROCEDURE DIRECLOGON(MASK,JMATARR,CONTIME,CPUTIME,     <<06560>>08098000
      AENTRY,UENTRY,GENTRY);                                   <<02.EB>>08100000
   VALUE MASK, CONTIME, CPUTIME;                                        08102000
   INTEGER MASK;                                                        08104000
   ARRAY JMATARR,AENTRY,UENTRY,GENTRY;                         <<06560>>08106000
   DOUBLE CONTIME, CPUTIME;                                             08108000
   OPTION PRIVILEGED, UNCALLABLE;                                       08110000
BEGIN                                                                   08112000
   ENTRY DIRECLOGOFF;                                                   08114000
                                                                        08116000
COMMENT THESE ROUTINES DO DIRECTORY JUGGLING FOR LOGON AND     <<05.EB>>08118000
   LOGOFF.  ESSENTIALLY, THIS INCLUDES:                                 08120000
   1. FINDING (RETURNING FOR LOGON) THE ACCOUNT, GROUP AND USER ENTRIES.08122000
   2. DECREMENTING (INCREMENTING FOR LOGON) THEN FOLLOWING:             08124000
      A. USER ENTRY LOGON COUNT,                                        08126000
      B. ACCT/GROUP INDEX POINTER COUNT,                                08128000
      C. GROUP/FILE INDEX POINTER COUNT.                                08130000
   3. FOR LOGOFF, UPDATE THE ACCT AND GROUP CONNECT AND CPU TIMES.      08132000
   INPUT PARAMETERS:                                                    08134000
      <MASK>                                                            08136000
         LOGON - MUST BE 0.                                             08138000
         LOGOFF                                                         08140000
            = 0 ACCT/USER/GROUP EXIST,                                  08142000
            = 1 ACCT/USER EXIST, NO GROUP,                     <<05.EB>>08144000
            = 2 NO ACCT,                                       <<05.EB>>08146000
            = 3 ACCT EXISTS, NO USER,                          <<05.EB>>08148000
            = 4 ACCT/USER EXIST, NO HOME GROUP SPEC.,          <<05.EB>>08150000
      <JMATENTRY> THE FULL JMATENTRY IN STACK.  USED TO GET THE ACCOUNT,08152000
         GROUP AND USER NAMES.                                          08154000
      <CONTIME> AND <CPUTIME>                                           08156000
         LOGON - IGNORED,                                               08158000
         LOGOFF - TIMES USED FOR UPDATE (IF MASK = 0).                  08160000
   RETURNS:                                                             08162000
      LOGON - SAME AS <MASK>, LOGOFF.                                   08164000
      LOGOFF                                                            08166000
            .(15:1) ACCT CONNECT EXCEEDED,                              08168000
            .(14:1) ACCT CPU                                            08170000
            .(13:1) GROUP CONNECT                                       08172000
            .(12:1) GROUP CPU.                                          08174000
            .(11:1)         ACCT CONNECT TIME NEGATIVE         <<04282>>08176000
            .(10:1)         GROUP CONNECT TIME NEGATIVE        <<04282>>08178000
            .( 9:1)         ACCT CPU TIME NEGATIVE             <<04282>>08180000
            .( 8:1)         GROUP CPU TIME NEGATIVE            <<04282>>08182000
;                                                              <<05.EB>>08184000
                                                                        08186000
   INTEGER POINTER   PS0               = S-0;                           08188000
   INTEGER           ADJUST            = WORKAREA;                      08190000
   DOUBLE            DDDSENTRY1        = DDS,                           08192000
                     DDDSENTRY2        = DDS +2;                        08194000
                                                                        08196000
   INTEGER           SAVESIR,                                           08198000
                     SAVEAGI,                                           08200000
                     RESULT            = DIRECLOGON,                    08202000
                     INCRDECR          := +1;                           08204000
   LOGICAL           OFFLAG            := FALSE;                        08206000
   ARRAY             LOCALAGU (0:15) = Q;                               08208000
   DOUBLE            LAN1              = LOCALAGU +4,                   08210000
                     LAN2              = LOCALAGU +6,                   08212000
                     LUN1              = LOCALAGU,                      08214000
                     LUN2              = LOCALAGU +2,                   08216000
                     LGN1              = LOCALAGU +12,                  08218000
                     LGN2              = LOCALAGU +14;                  08220000
   INTEGER                                                     <<02.EB>>08222000
      DLOFFSET,                                                <<02.EB>>08224000
      AENTRYDL,                                                <<02.EB>>08226000
      UENTRYDL,                                                <<02.EB>>08228000
      GENTRYDL;                                                <<02.EB>>08230000
   LOGICAL LOGONGROUP = LGN1;                                  <<05.EB>>08232000
   DEFINE JMATINX = 0#;                                        <<06560>>08234000
                                                                        08236000
                                                                        08238000
   GOTO START;                                                          08240000
                                                                        08242000
                                                                        08244000
DIRECLOGOFF:                                                            08246000
   OFFLAG := TRUE;                                                      08248000
   INCRDECR := -1;                                                      08250000
                                                                        08252000
                                                                        08254000
START:                                                                  08256000
   RESULT := 0;                                                         08258000
   IF MASK = 2 THEN RETURN; << NO ACCT >>                      <<05.EB>>08260000
   MOVE LOCALAGU := JMATUSERNAME, (16);                        <<06560>>08262000
   PUSH (DL);                                                           08264000
   DLOFFSET := S0;                                             <<02.EB>>08266000
   AENTRYDL := @AENTRY -DLOFFSET;                              <<02.EB>>08268000
   UENTRYDL := @UENTRY -DLOFFSET;                              <<02.EB>>08270000
   GENTRYDL := @GENTRY -DLOFFSET;                              <<02.EB>>08272000
   IF EXCHANGEDB(DDSDST) <> 0 THEN SYSABORT(DIRBADDST);        <<DE>>   08274000
   SAVESIR := GETSIR (DIRSIR);                                          08276000
   SYSVSDIRBASE;                                               <<32.PV>>08278000
   DIRBASE := TOS;                                             <<32.PV>>08280000
   XTYPE := GROUPLEVEL & LSL (3); <<PREVENT DIRBASE SWITCH>>   <<52.PV>>08282000
   IF DADIRTY OR DBDIRTY THEN SYSABORT (DIRABERR);             <<DE>>   08284000
   ADJUST := -TOS;                                                      08286000
   DDDSENTRY1 := LAN1;                 <<FIND ACCT>>                    08288000
   DDDSENTRY2 := LAN2;                                                  08290000
   TOS := DIRFIND (SYSACCTINDEX);                                       08292000
   ASSEMBLE (DTST, DELB);                                               08294000
   IF = THEN                                                            08296000
      BEGIN                                                             08298000
      IF OFFLAG THEN SYSABORT (DIRLOGERR);                     <<DE>>   08300000
      RESULT := 2; << NO ACCT >>                               <<05.EB>>08302000
      GOTO EXIT;                                                        08304000
      END;                                                              08306000
   SAVEAGI := PS0 (AGIPNTR);              <<SAVE AGI INDEX P>>          08308000
   IF OFFLAG THEN                                                       08310000
      BEGIN                                                             08312000
      IF MASK = 0 THEN                                                  08314000
         BEGIN                                                          08316000
         IF (DPS0 (ACPUCOUNTD) := DPS0 (ACPUCOUNTD) +CPUTIME) >         08318000
            DPS0 (ACPULIMITD) THEN RESULT.(14:1) := 1;                  08320000
         IF CONTIME < 0D THEN                                  <<04282>>08322000
              BEGIN                                            <<04282>>08324000
              RESULT.(11:1) := 1;  << ACCT CONNECT NEGATIVE >> <<04282>>08326000
              CONTIME := 0D;  << RESET CONNECT TIME FOR ACCOUNT<<04282>>08328000
              END;                                             <<04282>>08330000
         IF CPUTIME < 0D THEN                                  <<04282>>08332000
              BEGIN                                            <<04282>>08334000
              RESULT.(9:1) := 1;  << THIS IS A HOOK INTO SYSTEM<<04282>>08336000
              CPUTIME := 0D; <<RESET CPU TIME >>               <<04282>>08338000
              END;                                             <<04282>>08340000
         IF (DPS0 (ACONTIMECOUNTD) := DPS0 (ACONTIMECOUNTD) +           08342000
            CONTIME) > DPS0 (ACONTIMELIMITD) THEN                       08344000
               RESULT.(15:1) := 1;                                      08346000
         DIRWRITE (A);                                                  08348000
         END;                                                           08350000
      END                                                               08352000
   ELSE                                                                 08354000
      BEGIN                            <<LOGON: RETURN ENTRY>>          08356000
      TOS := AENTRYDL;                                         <<02.EB>>08358000
      ASSEMBLE (DDUP, DEL);                                             08360000
      TOS := ASIZE;                                                     08362000
      ASSEMBLE (MVBL);                                                  08364000
      END;                                                              08366000
                                                                        08368000
   IF MASK = 3 THEN GO EXIT;<<LOGOFF:NO USER AT LOGON>>        <<05.EB>>08370000
   DDDSENTRY1 := LUN1;                 <<FIND USER>>                    08372000
   DDDSENTRY2 := LUN2;                                                  08374000
   TOS := DIRFIND (PS0(AUIPNTR));                                       08376000
   ASSEMBLE (DTST, DELB);                                               08378000
   IF = THEN                                                            08380000
      BEGIN                                                             08382000
      IF OFFLAG THEN SYSABORT (DIRLOGERR);                     <<DE>>   08384000
      RESULT := 3; << NO USER>>                                <<05.EB>>08386000
      GOTO EXIT;                                                        08388000
      END;                                                              08390000
   PS0 (ULOGCOUNT) := PS0(ULOGCOUNT) +INCRDECR;    <<ADJUST LOGON CNT>> 08392000
   DIRWRITE (A);                                                        08394000
   IF MASK >= 1 THEN GO EXIT;<<LOGOFF:NO GROUP AT LOGON >>     <<05.EB>>08396000
   IF NOT (OFFLAG) THEN                                                 08398000
      BEGIN                            <<LOGON: RETURN USER ENTRY>>     08400000
      TOS := UENTRYDL;                                         <<02.EB>>08402000
      ASSEMBLE (DDUP, DEL);                                             08404000
      TOS := USIZE;                                                     08406000
      ASSEMBLE (MVBL);                                                  08408000
      IF LOGONGROUP = "  " THEN                                <<05.EB>>08410000
         BEGIN <<NO GRP., USE HOME GRP. IN U. ENTRY>>          <<05.EB>>08412000
         LGN1 := DPS0(UHGROUP/2);                              <<05.EB>>08414000
         LGN2 := DPS0(UHGROUP/2 +1);                           <<05.EB>>08416000
         IF LOGONGROUP = "  " THEN                             <<05.EB>>08418000
            BEGIN << NO HOME GROUP EXISTS >>                   <<05.EB>>08420000
            RESULT := 4;                                       <<05.EB>>08422000
            GO EXIT;                                           <<05.EB>>08424000
            END;                                               <<05.EB>>08426000
         END;                                                  <<05.EB>>08428000
      END;                                                              08430000
                                                                        08432000
   DDDSENTRY1 := LGN1;                 <<FIND GROUP>>                   08434000
   DDDSENTRY2 := LGN2;                                                  08436000
   TOS := DIRFIND (SAVEAGI);                                            08438000
   ASSEMBLE (DTST, DELB);                                               08440000
   IF = THEN                                                            08442000
      BEGIN                                                             08444000
      IF OFFLAG THEN SYSABORT (DIRLOGERR);                     <<DE>>   08446000
      RESULT := 1; << NO GROUP >>                              <<05.EB>>08448000
      GOTO EXIT;                                                        08450000
      END;                                                              08452000
   IF OFFLAG THEN                                                       08454000
      BEGIN                                                             08456000
         IF CONTIME < 0D THEN                                  <<04282>>08458000
              BEGIN                                            <<04282>>08460000
              RESULT.(10:1) := 1; << GROUP CONNECT TIME NEGATIV<<04282>>08462000
              CONTIME := 0D;  << RESET CON. TIME FOR ACCOUNTING<<04282>>08464000
              END;                                             <<04282>>08466000
         IF CPUTIME < 0D THEN                                  <<04282>>08468000
              BEGIN                                            <<04282>>08470000
              RESULT.(8:1) := 1; << THIS IS A HOOK INTO SYSTEM <<04282>>08472000
              CPUTIME := 0D; <<RESET CPUTIME >>                <<04282>>08474000
              END;                                             <<04282>>08476000
      TOS := TOS +GCPUCOUNT;                                            08478000
      IF (DPS0 := DPS0 +CPUTIME) > DPS0(1) THEN                         08480000
         RESULT.(12:1) := 1;                                            08482000
      IF (DPS0(2) := DPS0(2) +CONTIME) > DPS0(3) THEN                   08484000
         RESULT.(13:1) := 1;                                            08486000
      TOS := TOS -GCPUCOUNT;                                            08488000
      DIRWRITE (A);                                                     08490000
      END                                                               08492000
   ELSE                                                                 08494000
      BEGIN                               <<LOGON: RETURN ENTRY>>       08496000
      TOS := GENTRYDL;                                         <<02.EB>>08498000
      ASSEMBLE (DDUP, DEL);                                             08500000
      TOS := GSIZE;                                                     08502000
      ASSEMBLE (MVBL);                                                  08504000
      END;                                                              08506000
   DBPCOUNT := DBPCOUNT +INCRDECR;     <<ADJUST INDEX POINTER COUNTERS>>08508000
   DIRWRITE (B);                                                        08510000
   TOS := IF PS0 (GLINKAGE).(PVF) = PV AND                     <<37.PV>>08512000
             PS0 (GLINKAGE).(MVTABXF) <> 0 THEN                <<37.PV>>08514000
           PS0 (GSAVEFIPNTR) ELSE                              <<37.PV>>08516000
           PS0 (GFIPNTR);                                      <<37.PV>>08518000
   DIRREAD (*, B, 0, 0);                                       <<37.PV>>08520000
   DBPCOUNT := DBPCOUNT + INCRDECR;                                     08522000
   DIRWRITE (B);                                                        08524000
                                                                        08526000
EXIT:                                                                   08528000
   RELSIR (DIRSIR, SAVESIR);                                            08530000
   EXCHANGEDB (0);                                                      08532000
   END    <<DIRECLOGON / DIRECLOGOFF>>;                                 08534000
$CONTROL SEGMENT=MAIN                                                   08536000
                                                                        08538000
                                                                        08540000
                                                                        08542000
END.    << OUTER BLOCK >>                                      <<DE>>   08544000
