$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
$CONTROL SEGMENT= DIRC                                                  00030000
$CONTROL UNCALLABLE                                                     00032000
$THIRTY                                                                 00034000
BEGIN                                                                   00036000
                                                                        00038000
EQUATE                                                         <<DE>>   00040000
   NAMESIZE        = 4;  << UNPACKED REPRESENTATION >>         <<DE>>   00042000
                                                               <<DE>>   00044000
                                                               <<DE>>   00046000
           << DIRECTORY SUDDENDEATH ERRORS >>                  <<DE>>   00048000
                                                               <<DE>>   00050000
DEFINE  SYSABORT     = SUDDENDEATH#;                           <<DE>>   00052000
EQUATE  DIRIOAB      = 400,   << DIRECTORY I/O DISC ERROR   >> <<DE>>   00054000
        DIRBADDST    = 401,   << BAD DST NUMBER             >> <<DE>>   00056000
        DIRABERR     = 402,   << PROCESS ERROR IN DDS BUFF  >> <<DE>>   00058000
        DIRBITERR    = 403,   << DIRECTORY BITMAP ERROR     >> <<DE>>   00060000
                    << 404       FROM FILE SYSTEM           >> <<DE>>   00062000
        DIRINERR     = 405,   << ERROR ADDING NEW ENT OR INX>> <<DE>>   00064000
        DIRLOGERR    = 406,   << DIRECTORY ERROR LOG ON/OFF >> <<DE>>   00066000
        DIRALLOCERR  = 407,   << BAD BITMAP ALLOC/DEALLOC   >> <<DE>>   00068000
        DIRVSDERR    = 415,   << ERROR ADDING VSD ENT OR INX>> <<DE>>   00070000
        DIRPVBINDERR = 418,   << PV BIND OR REF CNT ERROR   >> <<DE>>   00072000
                                                               <<DE>>   00074000
                                                               <<DE>>   00076000
          <<  DIRECTORY BLOCK SIZES >>                         <<DE>>   00078000
                                                               <<DE>>   00080000
        SYSSAIBSIZE  =  3,    << SYSACCOUNT INDEX BLOCK SIZE>> <<DE>>   00082000
        SYSAUIBSIZE  =  1,    << ACCOUNT/USER  INDEX BLOCK  >> <<DE>>   00084000
        SYSAGIBSIZE  =  1,    << ACCOUNT/GROUP INDEX BLOCK  >> <<DE>>   00086000
        SYSGFIBSIZE  =  2,    << GROUP/FILES   INDEX BLOCK  >> <<DE>>   00088000
        SYSGVSIBSIZE =  1,    << GROUP/VSD     INDEX BLOCK  >> <<DE>>   00090000
        SYSAEBSIZE   =  3,    << ACCOUNT ENTRY BLOCK SIZE   >> <<DE>>   00092000
        SYSUEBSIZE   =  2,    << USER    ENTRY BLOCK SIZE   >> <<DE>>   00094000
        SYSGEBSIZE   =  2,    << GROUP   ENTRY BLOCK SIZE   >> <<DE>>   00096000
        SYSFEBSIZE   =  2,    << FILES   ENTRY BLOCK SIZE   >> <<DE>>   00098000
        SYSVSEBSIZE  =  1,    << VSD     ETNRY BLOCK SIZE   >> <<DE>>   00100000
                                                                        00102000
        DDSBSIZE     =  3,    << MAXIMUM BLOCK SECTOR SIZE  >> <<DE>>   00104000
        DDSBWSIZE    = %600;  << MAXIMUM BLOCK WORD  SIZE   >> <<DE>>   00106000
$PAGE "DIRECTORY DATA STRUCTURE"                               <<DE>>   00108000
EQUATE                                                         <<DE>>   00110000
                                                                        00112000
<< ACCOUNT ENTRY >>                                                     00114000
   ANAME           = 0,                  <<NAME>>                       00116000
   AGIPNTR         = ANAME+NAMESIZE,     <<GROUP INDEX PNTR>>           00118000
   AUIPNTR         = AGIPNTR+1,          <<USER INDEX PNTR>>            00120000
   ACAP            = AUIPNTR+1,          <<CAPABILITY>>                 00122000
   ALATTR          = ACAP+2,                                            00124000
   APASS           = ALATTR+2,                                          00126000
   ADFSCOUNT       = APASS+NAMESIZE,     <<DISC FILE SPACE>>            00128000
   ADFSCOUNTD      = ADFSCOUNT /2,                                      00130000
   ADFSLIMIT       = ADFSCOUNT+2,                                       00132000
   ADFSLIMITD      = ADFSLIMIT /2,                                      00134000
   ACPUCOUNT       = ADFSLIMIT+2,        <<CPU TIME>>                   00136000
   ACPUCOUNTD      = ACPUCOUNT /2,                                      00138000
   ACPULIMIT       = ACPUCOUNT+2,                                       00140000
   ACPULIMITD      = ACPULIMIT /2,                                      00142000
   ACONTIMECOUNT   = ACPULIMIT+2,        <<CONNECT TIME>>               00144000
   ACONTIMECOUNTD  = ACONTIMECOUNT /2,                                  00146000
   ACONTIMELIMIT   = ACONTIMECOUNT+2,                                   00148000
   ACONTIMELIMITD  = ACONTIMELIMIT /2,                                  00150000
   ASECW           = ACONTIMELIMIT+2,                                   00152000
   APURGEFLAGW     = ASECW,                                             00154000
   AMAXJOBW        = ASECW+1,            <<MAX. JOB PRIORITY (BYTE) >>  00156000
   ASPARE1         = AMAXJOBW+1,                                        00158000
   ASPARE2         = ASPARE1+1,                                         00160000
   ASIZE           = ASPARE2 +1,                                        00162000
                                                                        00164000
<<GROUP ENTRY>>                                                         00166000
   GNAME           = 0,                  <<NAME>>                       00168000
   GFIPNTR         = GNAME+NAMESIZE,     <<FILE INDEX (OR VOLUME) PNTR>>00170000
   GPASS           = GFIPNTR+1,          <<PASSWORD>>                   00172000
   GDFSCOUNT       = GPASS+NAMESIZE,     <<DISC FILE SPACE>>            00174000
   GDFSLIMIT       = GDFSCOUNT+2,                                       00176000
   GCPUCOUNT       = GDFSLIMIT+2,        <<CPU TIME>>                   00178000
   GCPULIMIT       = GCPUCOUNT+2,                                       00180000
   GCONTIMECOUNT   = GCPULIMIT+2,                                       00182000
   GCONTIMELIMIT   = GCONTIMECOUNT+2,                                   00184000
   GSEC            = GCONTIMELIMIT+2,                                   00186000
   GPURGEFLAGW     = GSEC,                                              00188000
   GCAP            = GSEC +2,                                           00190000
   GLINKAGE        = GCAP+1,                                   <<01.PV>>00192000
   GVSDIPNTR       = GLINKAGE+1,         <<VS DEF INDEX PNTR>> <<02.PV>>00194000
   GHVSNAME        = GVSDIPNTR+1,        <<HOME VS NAME>>      <<02.PV>>00196000
   GHVSANAME       = GHVSNAME,           << "   "  ACCT NAME>> <<02.PV>>00198000
   GHVSGNAME       = GHVSANAME+NAMESIZE, << "   "  GRP  NAME>> <<02.PV>>00200000
   GHVSVSNAME      = GHVSGNAME+NAMESIZE, << "   "  VS   NAME>> <<02.PV>>00202000
   GSAVEFIPNTR     = GHVSVSNAME+NAMESIZE,<<SAVES GFIPNTR>>     <<13.PV>>00204000
   GMOUNTREFCNTR   = GSAVEFIPNTR+1,      <<MOUNT USE COUNTER>> <<13.PV>>00206000
   GSPARE          = GMOUNTREFCNTR+1,                          <<13.PV>>00208000
   GSIZE           = GSPARE+1;                                 <<16.PV>>00210000
<<GLINKAGE DEFINITIONS>>                                       <<01.PV>>00212000
DEFINE                                                         <<01.PV>>00214000
   PVF             = 0:1 #,                                    <<01.PV>>00216000
   MVTABXF         = 8:8 #;                                    <<01.PV>>00218000
EQUATE                                                         <<01.PV>>00220000
   PV              = 1,                                        <<01.PV>>00222000
   VMAX            = 8,                  <<VS MEMBERSHIP MAX>> <<43.PV>>00224000
                                                                        00226000
<<FILE ENTRY >>                                                         00228000
   FNAME           = 0,                  <<NAME>>                       00230000
   FVOLPNTRW       = FNAME+NAMESIZE,     <<VOLUME TABLE POINTER>>       00232000
   FLABELPNTRW     = FVOLPNTRW,          <<FILE LABEL POINTER>>         00234000
   FSIZE           = FLABELPNTRW+2,                                     00236000
                                                                        00238000
<<USER ENTRY>>                                                          00240000
   UNAME           = 0,                  <<NAME>>                       00242000
   UCAP            = UNAME+NAMESIZE,     <<CAPABILITY>>                 00244000
   ULATTR          = UCAP+2,                                            00246000
   UPASS           = ULATTR+2,                                          00248000
   UHGROUP         = UPASS+NAMESIZE,     <<HOME GROUP>>                 00250000
   ULOGCOUNT       = UHGROUP+NAMESIZE,   <<# OF USERS LOGGED ON UNDER>> 00252000
   UMAXJOB         = ULOGCOUNT+1,                                       00254000
   UPURGEFLAGW     = UMAXJOB,                                           00256000
   USPARE          = UMAXJOB +1,                                        00258000
   USIZE           = USPARE +1,                                         00260000
                                                                        00262000
<<VOLUME SET DEFINITION ENTRY>>                                <<02.PV>>00264000
   GVSNAME         = 0,                  <<VOLUME SET NAME>>   <<02.PV>>00266000
   GVSLINKAGEW     = GVSNAME+NAMESIZE,   <<MVTAB LINKAGE>>     <<02.PV>>00268000
   GVSINFO         = GVSLINKAGEW+1,      <<DEFINITION INFO>>   <<02.PV>>00270000
   GVSMEMBERS      = GVSINFO+1,          <<VMAX MEMBERS>>      <<02.PV>>00272000
                                         <<MEMBER INFO>>       <<02.PV>>00274000
                                         <<VMAX MEMBERS>>      <<02.PV>>00276000
   GVSVOLNAME      = GVSMEMBERS,         <<MEMBER NAME>>       <<02.PV>>00278000
   GVSVOLFLAGS     = GVSVOLNAME+NAMESIZE,<<MEMBER STAT FLAGS>> <<02.PV>>00280000
   GVSVOLINFO      = GVSVOLFLAGS+1,      <<MEMBER ATTRIBS>>    <<02.PV>>00282000
   GVSMEMBSZ       = GVSINFO-GVSNAME+1,                        <<15.PV>>00284000
   GVSDREFCNT      = GVSMEMBSZ*(VMAX+1),                       <<58.PV>>00286000
   GVSDSPARE2      = GVSDREFCNT+1,                             <<58.PV>>00288000
   GVSDSIZE        = GVSDSPARE2+1,                             <<58.PV>>00290000
<<VOLUME CLASS DEFINITION ENTRY>>                              <<02.PV>>00292000
   GVCNAME        = 0,                   <<VOLUME CLASS NAME>> <<02.PV>>00294000
   GVCLINKAGEW     = GVCNAME+NAMESIZE,                         <<02.PV>>00296000
   GVCINFO         = GVCLINKAGEW+1,      <<DEFINITION INFO>>   <<02.PV>>00298000
   GVCPNAME        = GVCINFO+1,          <<PARENT DEF  NAME>>  <<02.PV>>00300000
   GVCPANAME       = GVCPNAME,           <<  "    ACCT   " >>  <<02.PV>>00302000
   GVCPGNAME       = GVCPANAME+NAMESIZE, <<  "    GRP    " >>  <<02.PV>>00304000
   GVCPVSNAME      = GVCPGNAME+NAMESIZE, <<  "    VS     " >>  <<02.PV>>00306000
   GVCUNUSED       = GVCPVSNAME+NAMESIZE,                      <<02.PV>>00308000
   GVCDSIZE        = GVSDSIZE,                                 <<02.PV>>00310000
                                                               <<02.PV>>00312000
   MAXENTRYSIZE    = GVSDSIZE,                                 <<02.PV>>00314000
                                                                        00316000
                   <<INDEX>>                                            00318000
                                                                        00320000
                                                                        00322000
   IE1STNAME       = 0,                  <<1ST NAME OF ENTRY BLOCK>>    00324000
   IEPNTR          = IE1STNAME+NAMESIZE, <<PNTR TO IT >>                00326000
   IECOUNT         = IEPNTR+1,           <<# OF ENTRIES IN IT>>         00328000
   ISIZE           = IECOUNT+1;                                         00330000
                                                                        00332000
                                                                        00334000
DEFINE                                                                  00336000
   APURGEFLAGF     = 0:1 #,                                             00338000
   GPURGEFLAGF     = 0:1 #,                                             00340000
   UPURGEFLAGF     = 0:1 #;                                             00342000
EQUATE                                                                  00344000
   GONEFLAG        = 1;                                                 00346000
                                                                        00348000
                                                                        00350000
                      <<INDEX BLOCK PREFIX>>                            00352000
                                                                        00354000
                                                                        00356000
EQUATE                                                                  00358000
   PREMISCWD       = 0;                                                 00360000
DEFINE                                                                  00362000
   TYPEF           = 0:1 #;                                             00364000
EQUATE                                                                  00366000
   INDEXTYPE       = 1,                                                 00368000
   ENTRYTYPE       = 0;                                                 00370000
DEFINE                                                                  00372000
   IPURGEFLAGF     = 1:1 #,                                             00374000
   LEVELF          = 2:3 #;                                    <<02.PV>>00376000
EQUATE                                                                  00378000
   FILELEVEL       = 0,                                                 00380000
   GROUPLEVEL      = 1,                                                 00382000
   ACCOUNTLEVEL    = 2,                                                 00384000
   USERLEVEL       = 3,                                        <<02.PV>>00386000
   VSDEFLEVEL      = 4;                                                 00388000
DEFINE                                                                  00390000
   XSIZEF          = 5:7 #,                                    <<02.PV>>00392000
   BSIZEF          = 12:4 #;                                   <<02.PV>>00394000
EQUATE                                                                  00396000
   PREXCOUNT       = PREMISCWD+1,        <<ELEMENT COUNT>>              00398000
   PREPCOUNT       = PREXCOUNT+1,        <<POINTER REF. COUNT>>         00400000
   PREETOTAL       = PREPCOUNT+1,        <<TOTAL ENTRIES COUNT >>       00402000
   PREEMISCWD      = PREETOTAL+1,                                       00404000
   PREPINDEXP      = PREEMISCWD+1,       <<INDEX PNTR IN WHICH FATHER>> 00406000
   PREPNAME        = PREPINDEXP+1,       <<FATHER'S NAME (IF ANY)>>     00408000
   PRESIZE         = PREPNAME+NAMESIZE;                                 00410000
                                                                        00412000
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                                                                  00438000
   DIRIOADDR       = SYSLDEV#;                                          00440000
DEFINE                                                         <<32.PV>>00442000
    SYSVSDIRBASE = TOS := SGDIRBASE1;                          <<32.PV>>00444000
                   TOS.(0:8) := SYSLDEV;                       <<32.PV>>00446000
                   TOS := SGDIRBASE2 #;                        <<32.PV>>00448000
$PAGE "DIRECTORY DATA SEGMENT BUFFERS"                         <<DE>>   00452000
                   <<DIRECTORY DATA SEGMENT (DDS)>>                     00454000
                                                                        00456000
                                                                        00458000
EQUATE                                                                  00460000
   DDSDST          = 20;                                                00462000
ARRAY                                                                   00464000
   DDS(*)          = DB+0,                                              00466000
   DDSENTRY(*)     = DDS,                                               00468000
   DDSNAME(*)      = DDS,                                               00470000
   WORKAREA (*)    = DDS(128);                                          00472000
INTEGER           << VARIABLES SET BY DIRSTARTOFF >>                    00474000
   ADJUST         = WORKAREA,            <<DL-DB>>                      00476000
   XTYPE          = ADJUST +1;           <<INPUT PARM>>        <<38.PV>>00478000
DOUBLE                                                         <<38.PV>>00480000
   XLINKAGE'INDEXP= XTYPE+1;                                   <<38.PV>>00482000
INTEGER                                                        <<38.PV>>00484000
   XMVTABX        = XLINKAGE'INDEXP,                           <<38.PV>>00486000
   XINDEXP        = XMVTABX+1,           <<FINAL INDEX PNTR>>  <<38.PV>>00488000
   XANAME         = XINDEXP +1,          <<DB-REL ADDRS>>               00490000
   XGUNAME        = XANAME +1,                                          00492000
   XFNAME         = XGUNAME +1,                                         00494000
   XASEC          = XFNAME +1;           <<ACCT SECURITY>>              00496000
DOUBLE                                                                  00498000
   XGSEC          = XASEC +1;            <<GROUP SECURITY>>             00500000
LOGICAL                                                                 00502000
   SIRRETURN      = XGSEC +2;            <<FROM GETSIR>>                00504000
EQUATE                                   <<DISPS INTO PREPRE>>          00506000
   DIRBASE'        = 0,                  <<LDEV OF CONTENTS>>  <<01.PV>>00508000
   DIRBASE1'       = DIRBASE',                                 <<01.PV>>00510000
   DIRBASE2'       = DIRBASE1'+1,                              <<01.PV>>00512000
   CONTENTS        = DIRBASE2'+1,        <<DIRECTORY P. PNTR>> <<01.PV>>00514000
   LPNTR           = CONTENTS+1,         <<DB ADDR OF 1ST ELEMENT>>     00516000
   IOPNTR          = LPNTR+1,            <<BLOCK STARTING ADDR>>        00518000
   NUMVALID        = IOPNTR+1,           <<# VALID DIR PP AFTER IOPNTR>>00520000
   DIRTY           = NUMVALID+1,                                        00522000
   FLAGS           = DIRTY,                                             00524000
   XSIZE           = DIRTY+1,                                           00526000
   USED            = XSIZE+1,            <<=XSIZE * XCOUNT>>            00528000
   BSIZE           = USED+1,             <<BLOCK SIZE (PP.)>>           00530000
   BWSIZE          = BSIZE+1,            <<= BSIZE & LSR(7)>>           00532000
   BFACTOR         = BWSIZE+1,           <<= BWSIZE/XSIZE>>             00534000
   MISCWD          = BFACTOR+1,                                         00536000
   XCOUNT          = MISCWD+1,                                          00538000
   PCOUNT          = XCOUNT+1,                                          00540000
   ETOTAL          = PCOUNT+1,                                          00542000
   EMISCWD         = ETOTAL+1,                                          00544000
   PINDEXP         = EMISCWD+1,                                         00546000
   PNAME           = PINDEXP+1;                                         00548000
                                                                        00550000
                                                                        00552000
ARRAY                                                                   00554000
   DAPREPRE(*)     = DDS(ZZ);                                           00556000
DOUBLE                                                         <<01.PV>>00558000
   DADIRBASE       = DAPREPRE+DIRBASE';                        <<01.PV>>00560000
LOGICAL                                                                 00562000
   DACONTENTS      = DAPREPRE+CONTENTS;                                 00564000
LOGICAL POINTER                                                         00566000
   DALPNTR         = DAPREPRE+LPNTR,                                    00568000
   DAIOPNTR        = DAPREPRE+IOPNTR;                                   00570000
INTEGER                                                                 00572000
   DANUMVALID      = DAPREPRE+NUMVALID;                                 00574000
LOGICAL                                                                 00576000
   DAFLAGS'DIRTY   = DAPREPRE+DIRTY;                                    00578000
DEFINE                                                                  00580000
    FLAGSF         = (0:8) #,                                           00582000
    DIRTYF         = (15:1) #,                                 <<06.PV>>00584000
    BADELMF        = (0:1) #,                                           00586000
    DAFLAGS        = DAFLAGS'DIRTY.FLAGSF #,                            00588000
    DADIRTY        = DAFLAGS'DIRTY.DIRTYF #,                            00590000
    DABADELM       = DAFLAGS'DIRTY.BADELMF#;                            00592000
INTEGER                                                                 00594000
   DAXSIZE         = DAPREPRE+XSIZE,                                    00596000
   DAUSED          = DAPREPRE+USED,                                     00598000
   DABSIZE         = DAPREPRE+BSIZE,                                    00600000
   DABWSIZE        = DAPREPRE+BWSIZE,                                   00602000
   DABFACTOR       = DAPREPRE+BFACTOR,                                  00604000
   DAMISCWD        = DAPREPRE+MISCWD;                                   00606000
DEFINE                                                                  00608000
   DATYPE          = INTEGER (DAMISCWD.(TYPEF)) #,             <<02.PV>>00610000
   DALEVEL         = INTEGER (DAMISCWD.(LEVELF)) #;            <<02.PV>>00612000
ARRAY                                                                   00614000
   DAPRE (*)       = DAPREPRE(MISCWD);                                  00616000
INTEGER                                                                 00618000
   DAXCOUNT        = DAPREPRE+XCOUNT,                                   00620000
   DAPCOUNT        = DAPREPRE+PCOUNT;                                   00622000
LOGICAL                                                                 00624000
   DAETOTAL        = DAPREPRE+ETOTAL,                                   00626000
   DAEMISCWD       = DAPREPRE+EMISCWD;                                  00628000
DEFINE                                                                  00630000
   DAETYPE         = INTEGER (DAEMISCWD.(TYPEF)) #,                     00632000
   DAELEVEL        = INTEGER (DAEMISCWD.(LEVELF)) #,                    00634000
   DAEXSIZE        = INTEGER (DAEMISCWD.(XSIZEF)) #,                    00636000
   DAEBSIZE        = INTEGER (DAEMISCWD.(BSIZEF)) #;                    00638000
LOGICAL                                                                 00640000
   DAPINDEXP       = DAPREPRE+PINDEXP;                                  00642000
ARRAY                                                                   00644000
   DAPNAME (*)     = DAPREPRE(PNAME);                                   00646000
ARRAY                                                                   00648000
   DBPREPRE (*)    = DAPREPRE(XX);                                      00650000
DOUBLE                                                         <<01.PV>>00652000
   DBDIRBASE       = DBPREPRE+DIRBASE';                        <<01.PV>>00654000
LOGICAL                                                                 00656000
   DBCONTENTS      = DBPREPRE+CONTENTS;                                 00658000
LOGICAL POINTER                                                         00660000
   DBLPNTR         = DBPREPRE+LPNTR,                                    00662000
   DBIOPNTR        = DBPREPRE+IOPNTR;                                   00664000
INTEGER                                                                 00666000
   DBNUMVALID      = DBPREPRE+NUMVALID;                                 00668000
LOGICAL                                                                 00670000
   DBFLAGS'DIRTY   = DBPREPRE+DIRTY;                                    00672000
DEFINE                                                                  00674000
    DBFLAGS        = DBFLAGS'DIRTY.FLAGSF #,                            00676000
    DBDIRTY        = DBFLAGS'DIRTY.DIRTYF #,                            00678000
    DBBADELM       = DBFLAGS'DIRTY.BADELMF#;                            00680000
INTEGER                                                                 00682000
   DBXSIZE         = DBPREPRE+XSIZE,                                    00684000
   DBUSED          = DBPREPRE+USED,                                     00686000
   DBBSIZE         = DBPREPRE+BSIZE,                                    00688000
   DBBWSIZE        = DBPREPRE+BWSIZE,                                   00690000
   DBBFACTOR       = DBPREPRE+BFACTOR,                                  00692000
   DBMISCWD        = DBPREPRE+MISCWD;                                   00694000
DEFINE                                                                  00696000
   DBTYPE          = INTEGER (DBMISCWD.(TYPEF)) #,             <<02.PV>>00698000
   DBLEVEL         = INTEGER (DBMISCWD.(LEVELF)) #;            <<02.PV>>00700000
ARRAY                                                                   00702000
   DBPRE (*)       = DBPREPRE(MISCWD);                                  00704000
INTEGER                                                                 00706000
   DBXCOUNT        = DBPREPRE+XCOUNT,                                   00708000
   DBPCOUNT        = DBPREPRE+PCOUNT;                                   00710000
LOGICAL                                                                 00712000
   DBETOTAL        = DBPREPRE+ETOTAL,                                   00714000
   DBEMISCWD       = DBPREPRE+EMISCWD;                                  00716000
DEFINE                                                                  00718000
   DBETYPE         = INTEGER (DBEMISCWD.(TYPEF)) #,                     00720000
   DBELEVEL        = INTEGER (DBEMISCWD.(LEVELF)) #,                    00722000
   DBEXSIZE        = INTEGER (DBEMISCWD.(XSIZEF)) #,                    00724000
   DBEBSIZE        = INTEGER (DBEMISCWD.(BSIZEF)) #;                    00726000
LOGICAL                                                                 00728000
   DBPINDEXP       = DBPREPRE+PINDEXP;                                  00730000
ARRAY                                                                   00732000
   DBPNAME (*)     = DBPREPRE(PNAME);                                   00734000
                                                                        00736000
                                                                        00738000
INTEGER                                                        <<01.PV>>00740000
   SYSACCTINDEX    = DBPREPRE+XX;                              <<DE>>   00742000
DOUBLE                                                                  00744000
   DIRBASE         = SYSACCTINDEX+1;                           <<DE>>   00746000
INTEGER                                                        <<01.PV>>00748000
   DIRBASE1        = DIRBASE,                                  <<01.PV>>00750000
   DIRBASE2        = DIRBASE1+1;                               <<01.PV>>00752000
DEFINE                                                         <<01.PV>>00754000
   DIRLDEV         = DIRBASE1.(0:8) #;                         <<01.PV>>00756000
INTEGER                                                        <<DE>>   00760000
   SYSACCTINX'SAV  = DIRBASE+2,                                <<DE>>   00762000
   DDS'CNT         = SYSACCTINX'SAV+1;                         <<DE>>   00764000
DOUBLE                                                         <<DE>>   00766000
   DDS'CNT1        = DDS'CNT+1,                                <<DE>>   00768000
   DDS'CNT2        = DDS'CNT1+2,                               <<DE>>   00770000
   DDS'CNT3        = DDS'CNT2+2,                               <<DE>>   00772000
   DDS'CNT4        = DDS'CNT3+2,                               <<DE>>   00774000
   DDS'CNT5        = DDS'CNT4+2;                               <<DE>>   00776000
REAL                                                           <<DE>>   00778000
   GOODPERCENT     = DDS'CNT5+2;                               <<DE>>   00780000
LOGICAL POINTER                                                         00782000
   BASE            = GOODPERCENT+2;                                     00784000
INTEGER POINTER                                                         00786000
   IBASE           = BASE;                                              00788000
DOUBLE POINTER                                                 <<07.PV>>00790000
   DBASE           = BASE;                                     <<07.PV>>00792000
DEFINE                                                                  00794000
   WHICHDIRTY = BASE(DIRTY) #;                                          00796000
                                                                        00798000
             << DIRECTORY SPACE DATA SEGMENT >>                <<DE>>   00800000
                                                               <<DE>>   00802000
EQUATE                                                         <<DE>>   00804000
   DIRSPHDR        = 10,         << 10 word DSD header info >> <<DE>>   00806000
   DIRSPBUFF       = 384,        << Dirc Bitmap buffer size >> <<DE>>   00808000
   DIRSPSIZE       = DIRSPBUFF + DIRSPHDR,                     <<DE>>   00810000
   DSVMBASE        = 2,  << Start of bitmap [after 2 wd hdr]>> <<DE>>   00812000
   DIRSPACEDST     = 21,             << Directory Space DST >> <<DE>>   00814000
   DSBUFF1         = 1,           << First sector in buffer >> <<DE>>   00816000
   DSBUFF2         = 2;            << 2 sectors in 2nd part >> <<DE>>   00818000
   << BITMAP:  1=Available,  0=Allocated >>                    <<DE>>   00820000
                                                               <<DE>>   00822000
DOUBLE                                                         <<DE>>   00824000
   DSBASE          = DB+0;                                     <<DE>>   00826000
INTEGER                                                        <<DE>>   00828000
   DSBASE1         = DSBASE,                                   <<DE>>   00830000
   DSBASE2         = DSBASE1+1;                                <<DE>>   00832000
DEFINE                                                         <<DE>>   00834000
   DSLDEV          = DSBASE1.(0:8) #,                          <<DE>>   00836000
   DSBASEA1        = DSBASE1.(8:8) #;                          <<DE>>   00838000
LOGICAL                                                        <<DE>>   00840000
   DSFLAGS         = DSBASE2+1;           <<bitmap dst flags>> <<DE>>   00842000
   DEFINE     << Bits used in DSFLAGS >>                       <<DE>>   00844000
      DIRSP'DIRTY  = DSFLAGS.(0:1) #,   << DSDS was modified>> <<DE>>   00846000
      DIRSP'CYCLE  = DSFLAGS.(1:1) #,   << Search for holes >> <<DE>>   00848000
      DIRSP'NEXT2  = DSFLAGS.(2:1) #,   << Read next 2 sect >> <<DE>>   00850000
      DIRSP'LASTIN = DSFLAGS.(3:1) #,   << Last sectors in  >> <<DE>>   00852000
      DIRSP'PREV2  = DSFLAGS.(4:1) #,   << Read prev 2 sect >> <<DE>>   00854000
      DIRSP'FIRSTIN= DSFLAGS.(5:1) #,   << First sectors in >> <<DE>>   00856000
      DIRSP'UNUSED = DSFLAGS.(6:10)#;   << NOT USED >>         <<DE>>   00858000
                                                               <<DE>>   00860000
LOGICAL                                                        <<DE>>   00862000
   DSUNUSED        = DSFLAGS+1,                                <<DE>>   00864000
   DSADDR1         = DSUNUSED+1,  << Disc address of sector >> <<DE>>   00866000
   DSADDR2         = DSADDR1+1,   << in bitmap buffer no. 2 >> <<DE>>   00868000
   DSBUFFLEN       = DSADDR2+1;   << Length of buff 2nd part>> <<DE>>   00870000
INTEGER                                                        <<DE>>   00872000
   CUR'SEGMENT     = DSBUFFLEN+1;  << Sector # of bitmap seg>> <<DE>>   00874000
LOGICAL                                                        <<DE>>   00876000
   BUF'LASTWORD    = CUR'SEGMENT+1;   << Ptr to last in buff>> <<DE>>   00878000
POINTER                                                        <<DE>>   00880000
   BUF'FIRSTAVAIL  = BUF'LASTWORD+1;  << Ptr to 1st in buff >> <<DE>>   00882000
                                                               <<DE>>   00884000
ARRAY                                                          <<DE>>   00886000
   DIRSPIOBASE (*) = DB+DIRSPHDR,                              <<DE>>   00888000
   DIRSPIOBASE2(*) = DIRSPIOBASE+128;                          <<DE>>   00890000
                                                               <<DE>>   00892000
LOGICAL                                                        <<DE>>   00894000
   DIR'LASTWORD    = DIRSPIOBASE;    << Last word of BITMAP >> <<DE>>   00896000
POINTER                                                        <<DE>>   00898000
   DIR'FIRSTAVAIL  = DIR'LASTWORD+1;  << 1st word of BITMAP >> <<DE>>   00900000
                                                               <<DE>>   00902000
LOGICAL                                                        <<DE>>   00904000
   START'BITMAP    = DIR'FIRSTAVAIL+1;                         <<DE>>   00906000
                                                               <<DE>>   00908000
ARRAY                                                          <<DE>>   00910000
   BITMAP (*)      = START'BITMAP;                             <<DE>>   00912000
                                                                        00914000
                                                                        00916000
$PAGE  "        "                                              <<DE>>   00918000
<< FLAGS TO DIRECTORY ROUTINES >>                                       00920000
EQUATE                                                                  00922000
   A               = 0,                  <<BLOCK A>>                    00924000
   B               = 1,                                                 00926000
   E               = 0,                  <<EXACT SEARCH>>               00928000
   EN              = 2,                  <<EXACT OR NEXT SEARCH>>       00930000
   EP              = 4,                  <<EXACT OR PRECEEDING SEARCH>> 00932000
   EA              = E+A,                                               00934000
   EB              = E+B,                                               00936000
   ENA             = EN+A,                                              00938000
   ENB             = EN+B,                                              00940000
   EPA             = EP+A,                                              00942000
   EPB             = EP+B;                                              00944000
DEFINE                                                                  00946000
   STARTLEVELF     = 13:3 #,                                            00948000
   ENDLEVELF       = 10:3 #,                                   <<03.PV>>00950000
   ALLFLAG         =  9:1 #,                                   <<03.PV>>00952000
   ENDLEVELFX      =  9:4 #,                                   <<03.PV>>00954000
   TOLEVELF        =  6:3 #,                                   <<03.PV>>00956000
   HITFLAG         =  5:1 #;                                   <<03.PV>>00958000
EQUATE                                                                  00960000
   ALLXXX          = %(2) 1000,                                <<07.PV>>00962000
   ALLACCTS        = ALLXXX + ACCOUNTLEVEL,                    <<07.PV>>00964000
   ALLGROUPS       = ALLXXX + GROUPLEVEL,                      <<07.PV>>00966000
   ALLUSERS        = ALLXXX + USERLEVEL,                       <<07.PV>>00968000
   ALLFILES        = ALLXXX + FILELEVEL,                       <<07.PV>>00970000
   ALLVSDS         = ALLXXX + VSDEFLEVEL;                               00972000
                                                                        00974000
                                                                        00976000
<< MISCELLANEOUS DECLARATIONS >>                                        00978000
   INTEGER                                                              00980000
      S0 = S-0,                                                         00982000
      S1 = S-1,                                                         00984000
      S2 = S-2,                                                         00986000
      S3 = S-3,                                                         00988000
      S4 = S-4,                                                         00990000
      S5 = S-5,                                                         00992000
      S6 = S-6,                                                <<28.PV>>00994000
      XREG = X;                                                         00996000
   INTEGER DELTAQ = Q-0;                                                00998000
   LOGICAL                                                              01000000
      LS0 = S-0,                                                        01002000
      LS1 = S-1,                                                        01004000
   LS2 = S-2,                                                           01006000
   LS3 = S-3,                                                           01008000
   LS4 = S-4,                                                  <<58.PV>>01010000
   LS5 = S-5;                                                  <<58.PV>>01012000
   INTEGER POINTER                                                      01014000
      PS6 = S-6,                                               <<58.PV>>01016000
      PS5 = S-5,                                               <<58.PV>>01018000
      PS4 = S-4,                                                        01020000
      PS3 = S-3,                                               <<58.PV>>01022000
      PS1 = S-1,                                                        01024000
      PS0 = S-0;                                                        01026000
   DOUBLE                                                               01028000
      DS5 = S-5,                                                        01030000
      DS2 = S-2,                                                        01032000
      DS1 = S-1;                                                        01034000
   LOGICAL STATUS = Q-1;                                                01036000
   DEFINE                                                               01038000
      CARRYX = STATUS.(5:1) #,                                          01040000
      CC = STATUS.(6:2) #;                                              01042000
   EQUATE                                                               01044000
      READ  = 0,                                               <<43.PV>>01046000
      WRITE = 1,                                               <<43.PV>>01048000
      DIRIO = %030001,                                         <<DE>>   01050000
      CCE = 2,                                                          01052000
      CCG = 0,                                                          01054000
      CCL = 1;                                                          01056000
   POINTER S0PNTR = S-0;                                                01058000
   DOUBLE POINTER                                                       01060000
      DPS0 = S-0,                                                       01062000
      DPS2 = S-2;                                                       01064000
   INTEGER POINTER S0IPNTR = S-0;                                       01066000
   INTEGER S0I     = S-0;                                               01068000
                                                                        01070000
   << MVTAB DEFINITIONS >>                                     <<DE>>   01072000
   INTEGER ARRAY MVTAB (*)  =  DB+0;                           <<DE>>   01074000
   DEFINE                                                      <<DE>>   01076000
           MVTABDST         =  53 #,                           <<DE>>   01078000
           MVTABSZ          =  %25 #,                          <<DE>>   01080000
           ACCTINDEX        =  (0:8) #;  << OF WORD 6 >>       <<DE>>   01082000
                                                               <<DE>>   01084000
   DEFINE                                                      <<DE>>   01086000
      OPTIONS = OPTION PRIVILEGED, UNCALLABLE #;               <<00175>>01088000
                                                                        01090000
                                                                        01092000
INTRINSIC DEBUG;                                               <<01.PV>>01094000
PROCEDURE HELP; OPTION EXTERNAL;                               <<01.PV>>01096000
                                                               <<01.PV>>01098000
                                                               <<01.PV>>01100000
INTEGER PROCEDURE LUN (VTABINX, MVTABX);                       <<26.PV>>01102000
    VALUE   VTABINX, MVTABX;                                   <<26.PV>>01104000
    INTEGER VTABINX, MVTABX;                                   <<26.PV>>01106000
    OPTION EXTERNAL;                                           <<26.PV>>01108000
                                                               <<26.PV>>01110000
                                                               <<26.PV>>01112000
PROCEDURE SYSABORT (N);                                                 01114000
   VALUE N;                                                             01116000
   INTEGER N;                                                           01118000
   OPTION EXTERNAL;                                                     01120000
                                                                        01122000
                                                                        01124000
INTEGER PROCEDURE EXCHANGEDB (DSTNUM);                         <<01.PV>>01126000
   VALUE DSTNUM;                                                        01128000
   LOGICAL DSTNUM;                                                      01130000
   OPTION EXTERNAL;                                                     01132000
                                                                        01134000
                                                                        01136000
INTEGER PROCEDURE SETSYSDB;                                             01138000
   OPTION EXTERNAL;                                                     01140000
                                                                        01142000
                                                                        01144000
PROCEDURE RESETDB (A);                                                  01146000
   VALUE A;                                                             01148000
   INTEGER A;                                                           01150000
   OPTION EXTERNAL;                                                     01152000
                                                               <<DE>>   01154000
                                                               <<DE>>   01156000
DOUBLE PROCEDURE ATTACHIO ( LDEV, QMISC, DX, T, FUNC,          <<DE>>   01158000
                            CNT, P1, P2, FLGS);                <<DE>>   01160000
   VALUE   LDEV, QMISC, DX, T, FUNC, CNT, P1, P2, FLGS;        <<DE>>   01162000
   INTEGER LDEV, QMISC, DX, T, FUNC, CNT, P1, P2, FLGS;        <<DE>>   01164000
   OPTION  EXTERNAL;                                           <<DE>>   01166000
                                                               <<DE>>   01168000
                                                               <<DE>>   01170000
DOUBLE PROCEDURE FRELSPACE (LDEV, FPNTR, MVTABX);              <<DE>>   01172000
   VALUE LDEV, FPNTR, MVTABX;                                  <<DE>>   01174000
   INTEGER LDEV, MVTABX;                                       <<DE>>   01176000
   DOUBLE  FPNTR;                                              <<DE>>   01178000
   OPTION  EXTERNAL, VARIABLE;                                 <<DE>>   01180000
                                                               <<DE>>   01182000
LOGICAL PROCEDURE GETSIR (NUM);                                <<DE>>   01184000
   VALUE NUM;                                                  <<DE>>   01186000
   INTEGER NUM;                                                <<DE>>   01188000
   OPTION EXTERNAL;                                            <<DE>>   01190000
                                                               <<DE>>   01192000
PROCEDURE RELSIR (NUM, A);                                     <<DE>>   01194000
   VALUE NUM, A;                                               <<DE>>   01196000
   INTEGER NUM;  LOGICAL A;                                    <<DE>>   01198000
   OPTION EXTERNAL;                                            <<DE>>   01200000
                                                               <<DE>>   01202000
LOGICAL PROCEDURE SETCRITICAL;                                 <<DE>>   01204000
   OPTION EXTERNAL;                                            <<DE>>   01206000
                                                               <<DE>>   01208000
PROCEDURE RESETCRITICAL (P);                                   <<DE>>   01210000
   VALUE P;                                                    <<DE>>   01212000
   LOGICAL P;                                                  <<DE>>   01214000
   OPTION EXTERNAL;                                            <<DE>>   01216000
$PAGE " DIRECTORY ROUTINES"                                    <<DE>>   01218000
PROCEDURE DIRXXXBITMAP (FUNCTION);                             <<DE>>   01220000
   VALUE   FUNCTION;                                           <<DE>>   01222000
   INTEGER FUNCTION;                                           <<DE>>   01224000
   OPTIONS;                                                    <<DE>>   01226000
                                                               <<DE>>   01228000
<< The function of this procedure is to perform the I/O for >> <<DE>>   01230000
<< the directory  BITMAP  which defines  space available in >> <<DE>>   01232000
<< the  entry and  index area  (which immediately follows). >> <<DE>>   01234000
<< A BITMAP can be up to 32 sectors [128 words each], which >> <<DE>>   01236000
<< allows for a  directory  to be  65,000 sectors  in total >> <<DE>>   01238000
<< length.   The data segment buffer [DSDS - %25] maintains >> <<DE>>   01240000
<< 3 sectors of the bitmap.  The first sector is always sec->> <<DE>>   01242000
<< tor zero (relative to DIRBASE), which contains the point->> <<DE>>   01244000
<< ers to FIRSTAVAIL and LASTWORD.    The remaining two sec->> <<DE>>   01246000
<< tors are used  to page thru the remaining portion of the >> <<DE>>   01248000
<< BITMAP.   DSFLAGS are used to provide for paging forward >> <<DE>>   01250000
<< and backward.                                            >> <<DE>>   01252000
                                                               <<DE>>   01254000
BEGIN                                                          <<DE>>   01256000
   DEFINE IN = FUNCTION = READ #,                              <<DE>>   01258000
         OUT = FUNCTION = WRITE#;                              <<DE>>   01260000
                                                               <<DE>>   01262000
SUBROUTINE DISCIO (FUNC, BUFF, ADDR1, ADDR2);                  <<DE>>   01264000
   VALUE   FUNC, BUFF, ADDR1, ADDR2;                           <<DE>>   01266000
   INTEGER FUNC, BUFF;                                         <<DE>>   01268000
   LOGICAL ADDR1, ADDR2;                                       <<DE>>   01270000
                                                               <<DE>>   01272000
BEGIN                                                          <<DE>>   01274000
   TOS := ATTACHIO ( DSLDEV, 0, DIRSPACEDST,                   <<DE>>   01276000
          (IF BUFF=1 THEN @DIRSPIOBASE ELSE @DIRSPIOBASE2),    <<DE>>   01278000
           FUNC, (IF DSBUFFLEN=0 THEN DIRSPBUFF ELSE IF BUFF=1 <<DE>>   01280000
                  THEN 128 ELSE DSBUFFLEN), ADDR1, ADDR2, 1);  <<DE>>   01282000
   ASSEMBLE (STBX, DEL);                                       <<DE>>   01284000
   IF TOS.(13:3) <> 1 THEN SYSABORT (DIRIOAB);                 <<DE>>   01286000
END; <<END DISCIO>>                                            <<DE>>   01288000
   TOS := EXCHANGEDB (DIRSPACEDST);                            <<DE>>   01290000
   IF NOT(DDSDST<=S0<=DIRSPACEDST) THEN SYSABORT (DIRBADDST);  <<DE>>   01292000
   IF IN OR DIRSP'DIRTY AND OUT THEN                           <<DE>>   01294000
   BEGIN                                                       <<DE>>   01296000
      IF OUT THEN                                              <<DE>>   01298000
      BEGIN                                                    <<DE>>   01300000
         DIRSP'DIRTY := FALSE;                                 <<DE>>   01302000
         IF CUR'SEGMENT<>0 AND DSBUFFLEN<>0 THEN               <<DE>>   01304000
            DISCIO (WRITE, DSBUFF2, DSADDR1, DSADDR2);         <<DE>>   01306000
      << Restore first sector of BITMAP which contains ptrs >> <<DE>>   01308000
         @DIR'FIRSTAVAIL :=                                    <<DE>>   01310000
             (IF CUR'SEGMENT<=1 AND @BUF'FIRSTAVAIL<=DIRSPBUFF <<DE>>   01312000
                 THEN @BUF'FIRSTAVAIL - DIRSPHDR + DSVMBASE    <<DE>>   01314000
                 ELSE @BUF'FIRSTAVAIL - DIRSPHDR + DSVMBASE +  <<DE>>   01316000
                          (CUR'SEGMENT-1)*128);                <<DE>>   01318000
         DISCIO (WRITE, DSBUFF1, DSBASE1.(8:8), DSBASE2);      <<DE>>   01320000
      << Invalidate LDEV if this is removeable volume >>       <<DE>>   01322000
         IF DSLDEV<>SYSLDEV THEN DSLDEV:=0;                    <<DE>>   01324000
      END                                                      <<DE>>   01326000
      ELSE BEGIN <<IN>>                                        <<DE>>   01328000
         IF DIRSP'NEXT2 OR DIRSP'PREV2 THEN                    <<DE>>   01330000
            BEGIN   << Read in 2 sectors of the bitmap >>      <<DE>>   01332000
               IF DIRSP'NEXT2 AND (NOT DIRSP'LASTIN ) OR       <<DE>>   01334000
                  DIRSP'PREV2 AND (NOT DIRSP'FIRSTIN) THEN     <<DE>>   01336000
                  BEGIN                                        <<DE>>   01338000
                  CUR'SEGMENT := CUR'SEGMENT +                 <<DE>>   01340000
                     (IF DIRSP'NEXT2 THEN 2 ELSE -2);          <<DE>>   01342000
                  @BUF'FIRSTAVAIL := 128 - DSVMBASE; <<buff#2>><<DE>>   01344000
                  IF CUR'SEGMENT <= 1 THEN                     <<DE>>   01346000
                     BEGIN  << Sector no. never less than 1 >> <<DE>>   01348000
                        DIRSP'FIRSTIN := TRUE;                 <<DE>>   01350000
                        CUR'SEGMENT   := 1;                    <<DE>>   01352000
                        @BUF'FIRSTAVAIL := DIRSPHDR + DSVMBASE;<<DE>>   01354000
                     END ELSE DIRSP'FIRSTIN:=FALSE;            <<DE>>   01356000
                  IF LOGICAL(((CUR'SEGMENT+2)*128)-1)          <<DE>>   01358000
                     >= DIR'LASTWORD                           <<DE>>   01360000
                     THEN BEGIN                                <<DE>>   01362000
                          DIRSP'LASTIN := TRUE;                <<DE>>   01364000
                          BUF'LASTWORD:=DIR'LASTWORD+DIRSPHDR- <<DE>>   01366000
                              LOGICAL((CUR'SEGMENT-1)*128);    <<DE>>   01368000
                          END                                  <<DE>>   01370000
                     ELSE BEGIN                                <<DE>>   01372000
                          DIRSP'LASTIN := FALSE;               <<DE>>   01374000
                          BUF'LASTWORD := (DIRSPBUFF-1) +      <<DE>>   01376000
                                           DIRSPHDR - DSVMBASE;<<DE>>   01378000
                          END;                                 <<DE>>   01380000
                  DSBUFFLEN := (BUF'LASTWORD -                 <<DE>>   01382000
                     LOGICAL(@BUF'FIRSTAVAIL))-DIRSPHDR+1;     <<DE>>   01384000
                  IF DSBUFFLEN>256 THEN DSBUFFLEN:=256;        <<DE>>   01386000
                  TOS := 0;              TOS := CUR'SEGMENT;   <<DE>>   01388000
                  TOS := DSBASE1.(8:8);  TOS := DSBASE2;       <<DE>>   01390000
                  ASSEMBLE (DADD);                             <<DE>>   01392000
                  DSADDR2 := TOS;        DSADDR1 := TOS;       <<DE>>   01394000
                  DISCIO (READ, DSBUFF2, DSADDR1, DSADDR2);    <<DE>>   01396000
                  END                                          <<DE>>   01398000
            END                                                <<DE>>   01400000
         ELSE BEGIN  << First read of BITMAP >>                <<DE>>   01402000
            DSFLAGS := FALSE;  << Set all flags off >>         <<DE>>   01404000
            DISCIO (READ, DSBUFF1, DSBASE1.(8:8), DSBASE2);    <<DE>>   01406000
            BUF'LASTWORD := DIRSPBUFF+DIRSPHDR-DSVMBASE-1;     <<DE>>   01408000
            IF (DIR'LASTWORD+DIRSPHDR-DSVMBASE) < BUF'LASTWORD <<DE>>   01410000
               THEN BUF'LASTWORD := DIR'LASTWORD               <<DE>>   01412000
                                  + DIRSPHDR - DSVMBASE;       <<DE>>   01414000
            CUR'SEGMENT := 1;                                  <<DE>>   01416000
            @BUF'FIRSTAVAIL:=@DIR'FIRSTAVAIL+DIRSPHDR-DSVMBASE;<<DE>>   01418000
            WHILE @BUF'FIRSTAVAIL >= (DIRSPBUFF - DSVMBASE)    <<DE>>   01420000
                DO BEGIN                                       <<DE>>   01422000
                   @BUF'FIRSTAVAIL := @BUF'FIRSTAVAIL - 256;   <<DE>>   01424000
                   CUR'SEGMENT := CUR'SEGMENT + 2;             <<DE>>   01426000
                   END;                                        <<DE>>   01428000
            DSBUFFLEN := (BUF'LASTWORD -                       <<DE>>   01430000
                         ( 128 + DIRSPHDR - DSVMBASE -1) );    <<DE>>   01432000
            IF INTEGER(DSBUFFLEN)<0 THEN DSBUFFLEN:=0;         <<DE>>   01434000
            IF DSBUFFLEN <> 0 THEN                             <<04858>>01436000
               BEGIN                                           <<04858>>01438000
               TOS := 0;              TOS := CUR'SEGMENT;      <<04858>>01440000
               TOS := DSBASE1.(8:8);  TOS := DSBASE2;          <<04858>>01442000
               ASSEMBLE (DADD);                                <<04858>>01444000
               DSADDR2 := TOS;        DSADDR1 := TOS;          <<04858>>01446000
               DISCIO (READ, DSBUFF2, DSADDR1, DSADDR2);       <<04858>>01448000
               END;                                            <<04858>>01450000
            IF CUR'SEGMENT = 1 THEN DIRSP'FIRSTIN := TRUE;     <<DE>>   01452000
            IF DIR'LASTWORD <= BUF'LASTWORD THEN               <<DE>>   01454000
               DIRSP'LASTIN := TRUE;                           <<DE>>   01456000
            END;                                               <<DE>>   01458000
      END;                                                     <<DE>>   01460000
   END;                                                        <<DE>>   01462000
   ASSEMBLE (ZERO, XCH);                                       <<DE>>   01464000
   EXCHANGEDB (*);                                             <<DE>>   01466000
END; << DIRXXXBITMAP >>                                        <<DE>>   01468000
PROCEDURE DIRXXXLLOCATE (PNTRIN, PPSIZE, SETTO);                        01470000
   VALUE PNTRIN, PPSIZE, SETTO;                                         01472000
   LOGICAL PNTRIN, SETTO;                                               01474000
   INTEGER PPSIZE;                                                      01476000
   OPTIONS;                                                             01478000
                                                                        01480000
BEGIN                                                                   01482000
   LOGICAL POINTER PNTR = PNTRIN;                                       01484000
   EQUATE                                                               01486000
      AB1          = 4,                  <<FREEING FREED>>              01488000
      AB0          = 5;                  <<USING USED>>                 01490000
<< >>                                                                   01492000
   TOS := 0;                                                            01494000
   @PNTR := INTEGER (PNTRIN & DCSR(4)) + @BITMAP;                       01496000
   XREG := TOS & LSR(12);                                               01498000
   TOS := PNTR;                                                         01500000
   DO BEGIN                                                             01502000
      IF SETTO THEN                                                     01504000
         BEGIN                                                          01506000
         ASSEMBLE (TSBC 0,X);                                           01508000
         IF <> THEN SYSABORT (DIRALLOCERR);                    <<DE>>   01510000
         END                                                            01512000
      ELSE                                                              01514000
         BEGIN                                                          01516000
         ASSEMBLE (TRBC 0,X);                                           01518000
         IF =  THEN SYSABORT (DIRALLOCERR);                    <<DE>>   01520000
         END;                                                           01522000
      IF (XREG := XREG+1) = 16 THEN                                     01524000
         BEGIN                                                          01526000
         PNTR := TOS;                                                   01528000
         @PNTR := @PNTR+1;                                              01530000
         XREG := 0;                                                     01532000
         TOS := PNTR;                                                   01534000
         END;                                                           01536000
      END                                                               01538000
   UNTIL (PPSIZE := PPSIZE-1) <= 0;                                     01540000
   PNTR := TOS;                                                         01542000
   @DIR'FIRSTAVAIL:=@BUF'FIRSTAVAIL-DIRSPHDR+DSVMBASE;         <<DE>>   01544000
   DIRSP'DIRTY := TRUE;                                        <<28.PV>>01546000
   END    <<DIRXXXLLOCATE>>;                                            01548000
                                                                        01550000
                                                                        01552000
                                                                        01554000
                                                                        01556000
LOGICAL PROCEDURE DIRALLOCATE (PPSIZE);                                 01558000
   VALUE PPSIZE;                                                        01560000
   INTEGER PPSIZE;                                                      01562000
   OPTIONS;                                                             01564000
<<                                                                      01566000
   LOOK FOR CONTIGUOUS ONES.    RETURNS:                                01568000
   CCE - OKAY:  ADDRESS RETURNED,                                       01570000
   CCL - CAN'T FIND ANY:  0 RETURNED,                                   01572000
   CCG - PPSIZE > DDS BLOCK:  0 RETURNED.                               01574000
>>                                                                      01576000
BEGIN                                                                   01578000
   INTEGER                                                              01580000
      SIZE := 0;                                                        01582000
                                                                        01584000
SUBROUTINE FIND (LOWLIM, UPLIM);                                        01586000
   VALUE LOWLIM, UPLIM;                                                 01588000
   INTEGER LOWLIM, UPLIM;                                      <<10.PV>>01590000
DO BEGIN                                                                01592000
   XREG := 1;                                                           01594000
   TOS := DPS2;                                                         01596000
   DO BEGIN                                                             01598000
      ASSEMBLE (DTST);                                                  01600000
      IF >= THEN                                                        01602000
         BEGIN                                                          01604000
         SIZE := 0;    <<  ('ZERO' DOESN'T SET CC )  >>                 01606000
         IF = THEN GOTO NEXT2WORDS;                                     01608000
         END                                                            01610000
      ELSE                                                              01612000
         IF (SIZE := SIZE+1) = PPSIZE THEN                              01614000
            BEGIN    <<FOUND>>                                          01616000
            ASSEMBLE (DDEL);                                            01618000
            TOS := (LOWLIM-@BITMAP) & LSL(4) + XREG;           <<10.PV>>01620000
            IF (@BUF'FIRSTAVAIL :=                             <<DE>>   01622000
                S0 & LSR (4) + (@BITMAP-DSVMBASE) )            <<DE>>   01624000
                > INTEGER (BUF'LASTWORD)                       <<DE>>   01626000
                THEN @BUF'FIRSTAVAIL :=                        <<DE>>   01628000
                             LOGICAL (@BITMAP-DSVMBASE);       <<DE>>   01630000
            TOS := TOS-SIZE;                                            01632000
            DIRXXXLLOCATE (S0, SIZE, 0);                                01634000
            XREG := CCE;                                                01636000
            GOTO EXIT;                                                  01638000
            END;                                                        01640000
      TOS := TOS & DLSL(1);                                             01642000
      END                                                               01644000
   UNTIL (XREG := XREG+1) >= 33;                                        01646000
NEXT2WORDS:                                                             01648000
   ASSEMBLE (DDEL);                                                     01650000
   END                                                                  01652000
UNTIL (S2 := S2+2) > UPLIM;                                    <<10.PV>>01654000
                                                                        01656000
   IF PPSIZE > DDSBSIZE THEN                                            01658000
      BEGIN                                                             01660000
      XREG := CCG;                                                      01662000
      GOTO ZEXIT;                                                       01664000
      END;                                                              01666000
   TOS := DIRBASE;                                             <<06.PV>>01668000
   IF EXCHANGEDB(DIRSPACEDST)<>DDSDST THEN SYSABORT(DIRBADDST);<<DE>>   01670000
   IF DIRSP'DIRTY THEN DIRXXXBITMAP (WRITE);                   <<DE>>   01672000
   IF DS1 <> DSBASE THEN                                       <<06.PV>>01674000
   BEGIN  <<NEED TO UPDATE DST>>                               <<06.PV>>01676000
       DSBASE := TOS;                                          <<06.PV>>01678000
       DIRXXXBITMAP (READ);                                    <<28.PV>>01680000
   END                                                         <<06.PV>>01682000
   ELSE DDEL;                                                  <<06.PV>>01684000
                                                               <<DE>>   01686000
   << Search for space in directory bitmap >>                  <<DE>>   01688000
   FIND (@BUF'FIRSTAVAIL+DSVMBASE, BUF'LASTWORD+DSVMBASE);     <<DE>>   01690000
   FIND (@BITMAP, @BUF'FIRSTAVAIL+DSVMBASE);                   <<DE>>   01692000
   WHILE NOT(DIRSP'LASTIN)                                     <<DE>>   01694000
      DO BEGIN                                                 <<DE>>   01696000
         DIRSP'NEXT2 := TRUE;                                  <<DE>>   01698000
         DIRXXXBITMAP (READ);                                  <<DE>>   01700000
         FIND (@BUF'FIRSTAVAIL+DSVMBASE,BUF'LASTWORD+DSVMBASE);<<DE>>   01702000
         END;                                                  <<DE>>   01704000
   DIRSP'NEXT2 := FALSE;                                       <<DE>>   01706000
   WHILE NOT(DIRSP'FIRSTIN)                                    <<DE>>   01708000
      DO BEGIN                                                 <<DE>>   01710000
         DIRSP'PREV2 := TRUE;                                  <<DE>>   01712000
         DIRXXXBITMAP (READ);                                  <<DE>>   01714000
         FIND (@BUF'FIRSTAVAIL+DSVMBASE,BUF'LASTWORD+DSVMBASE);<<DE>>   01716000
         END;                                                  <<DE>>   01718000
DIRC'FULL: XREG := CCL;   << None available >>                 <<DE>>   01720000
ZEXIT:     TOS := 0;                                           <<DE>>   01722000
EXIT:    << DIRBASE relative pointer is in TOS >>              <<DE>>   01724000
   DIRALLOCATE := TOS + ((CUR'SEGMENT-1) & LSL(11) );          <<DE>>   01726000
   DIRSP'PREV2 := FALSE;                                       <<DE>>   01728000
   DIRSP'NEXT2 := FALSE;                                       <<DE>>   01730000
   CC := XREG;                                                 <<DE>>   01732000
   EXCHANGEDB (DDSDST);                                        <<DE>>   01734000
END;  << DIRALLOCATE >>                                        <<DE>>   01736000
                                                                        01738000
                                                                        01740000
                                                                        01742000
PROCEDURE DIRDEALLOCATE (PNTR, PPSIZE);                                 01744000
   VALUE PNTR, PPSIZE;                                                  01746000
   LOGICAL PNTR;                                                        01748000
   INTEGER PPSIZE;                                                      01750000
   OPTIONS;                                                             01752000
                                                                        01754000
BEGIN                                                          <<DE>>   01756000
   LOGICAL PSECT;                                              <<DE>>   01758000
                                                               <<DE>>   01760000
   TOS := DIRBASE;                                             <<10.PV>>01762000
   IF EXCHANGEDB(DIRSPACEDST)<>DDSDST THEN SYSABORT(DIRBADDST);<<DE>>   01764000
   DIRXXXBITMAP (WRITE);                                       <<28.PV>>01766000
   IF DS1 <> DSBASE THEN                                       <<10.PV>>01768000
   BEGIN  <<NEED TO UPDATE DST>>                               <<10.PV>>01770000
       DSBASE := TOS;                                          <<10.PV>>01772000
       DIRXXXBITMAP (READ);                                    <<28.PV>>01774000
   END  ELSE DEL;                                              <<DE>>   01776000
   PSECT := ((PNTR + (DSVMBASE & LSL(4))) & LSR(11));          <<DE>>   01778000
   IF PSECT > LOGICAL(CUR'SEGMENT+1) THEN                      <<DE>>   01780000
      BEGIN  << Read next bitmap sector >>                     <<DE>>   01782000
         DIRSP'NEXT2 := TRUE;                                  <<DE>>   01784000
         WHILE PSECT > LOGICAL(CUR'SEGMENT+1) DO               <<DE>>   01786000
            DIRXXXBITMAP (READ);                               <<DE>>   01788000
         DIRSP'NEXT2 := FALSE;                                 <<DE>>   01790000
      END                                                      <<DE>>   01792000
   ELSE IF (PSECT > 0) AND                                     <<DE>>   01794000
           (PSECT <= LOGICAL(CUR'SEGMENT-1)) THEN              <<DE>>   01796000
      BEGIN                                                    <<DE>>   01798000
         DIRSP'PREV2 := TRUE;                                  <<DE>>   01800000
         WHILE PSECT <= LOGICAL(CUR'SEGMENT-1) DO              <<DE>>   01802000
            DIRXXXBITMAP (READ);                               <<DE>>   01804000
         DIRSP'PREV2 := FALSE;                                 <<DE>>   01806000
      END;                                                     <<DE>>   01808000
   WHILE PNTR >= ( (DIRSPBUFF & LSL(4)) - (DSVMBASE & LSL(4)) )<<DE>>   01810000
         DO PNTR := PNTR - 4096;                               <<DE>>   01812000
   DIRXXXLLOCATE (PNTR, PPSIZE, 1);                                     01814000
   EXCHANGEDB (DDSDST);                                                 01816000
   END    <<DEALLOCATE>>;                                               01818000
                                                                        01820000
                                                                        01822000
                                                                        01824000
                                                                        01826000
PROCEDURE DIRWRITE (WHICH);                                             01828000
   VALUE WHICH;                                                         01830000
   LOGICAL WHICH;                                                       01832000
   OPTIONS;                                                             01834000
                                                                        01836000
BEGIN                                                                   01838000
   INTEGER TEMP = WHICH;                                                01840000
   LOGICAL POINTER TEMPP;                                               01842000
<< >>                                                                   01844000
   @BASE := IF WHICH THEN @DBPREPRE ELSE @DAPREPRE;                     01846000
   WHICHDIRTY := FALSE;                                                 01848000
   @TEMPP := BASE(IOPNTR);                                              01850000
   TOS := BASE(USED);                                                   01852000
   IF BASE(MISCWD).(TYPEF) = INDEXTYPE THEN                             01854000
      BEGIN                                                             01856000
      MOVE TEMPP := BASE(MISCWD), (PRESIZE);                            01858000
      TOS := TOS+PRESIZE;                                               01860000
      END;                                                              01862000
   ASSEMBLE (TEST);                                                     01864000
   IF = THEN RETURN;                                                    01866000
   TEMP := TOS;                                                         01868000
   TOS := 0D;                                                           01870000
   TOS := BASE (DIRBASE').(0:8);                               <<01.PV>>01872000
   TOS := 0;                                                            01874000
   TOS := DDSDST;                                                       01876000
   TOS := @TEMPP;                                                       01878000
   TOS := 1;                                                            01880000
   TOS := TEMP;                                                         01882000
   TOS := BASE (DIRBASE1').(8:8);                              <<01.PV>>01884000
   TOS := BASE (DIRBASE2');                                    <<01.PV>>01886000
   TOS := 0;          TOS := IBASE(CONTENTS);                           01888000
   ASMB(DADD);                                                          01890000
$IF X0=ON                                                      <<DEBUG>>01892000
   IF IBASE (CONTENTS) <= 0 THEN DEBUG;                        <<DEBUG>>01894000
$IF                                                            <<DEBUG>>01896000
   TOS := ATTACHIO (*,*,*,*,*,*,*,*,DIRIO);                    <<DE>>   01898000
   ASSEMBLE (STBX, DEL);                                                01900000
   IF TOS.(13:3) <> 1 THEN SYSABORT(DIRIOAB);                           01902000
   END    <<DIRWRITE>>;                                                 01904000
                                                                        01906000
                                                                        01908000
                                                                        01910000
                                                                        01912000
PROCEDURE DIRREAD (PNTR, WHICH, EXCOUNT, EEMISCWD);                     01914000
   VALUE PNTR, WHICH, EXCOUNT, EEMISCWD;                                01916000
   LOGICAL PNTR, WHICH, EEMISCWD;                                       01918000
   INTEGER EXCOUNT;                                                     01920000
   OPTIONS;                                                             01922000
                                                               <<DE>>   01924000
BEGIN                                                          <<DE>>   01926000
   LOGICAL TEMP;                                                        01928000
   LOGICAL POINTER TEMPP;                                               01930000
<< >>                                                                   01932000
   @BASE := IF WHICH THEN @DBPREPRE ELSE @DAPREPRE;                     01934000
   IF BASE (CONTENTS) = PNTR AND                               <<43.PV>>01936000
      DBASE (DIRBASE') = DIRBASE THEN RETURN;                  <<43.PV>>01938000
   IF WHICHDIRTY THEN DIRWRITE (WHICH);                                 01940000
   @TEMPP := BASE(IOPNTR);                                              01942000
<< *** CHECK FOR PP. CONTAINED IN DDS BLOCKS AND MOVE *** >>            01944000
<< THIS JUST GOT TOOOO COMPLICATED :                                    01946000
   IF DACONTENTS <> 0 THEN                                              01948000
      IF PNTR >= DACONTENTS THEN                                        01950000
         IF (TEMP := PNTR-DACONTENTS) < LOGICAL(DANUMVALID) THEN        01952000
            BEGIN                                                       01954000
            XREG := TEMP & LSL(7);                                      01956000
            TOS := IF EXCOUNT = 0 THEN DAIOPNTR (XREG) ELSE EEMISCWD;   01958000
            IF TOS.(BSIZEF) <= INTEGER (TEMP := DANUMVALID              01960000
               -INTEGER(TEMP)) THEN                                     01962000
               BEGIN                                                    01964000
               TRACE (13, (XREG & LSR(7))*100+INTEGER(TEMP));           01966000
               DANUMVALID := DANUMVALID-INTEGER(TEMP);                  01968000
               MOVE TEMPP := DAIOPNTR(XREG), (TEMP & LSL(7));           01970000
               GOTO SETUP;                                              01972000
               END;                                                     01974000
            END;                                                        01976000
   IF DBCONTENTS <> 0 THEN                                              01978000
      IF PNTR >= DBCONTENTS THEN                                        01980000
         IF (TEMP := PNTR-DBCONTENTS) < LOGICAL(DBNUMVALID) THEN        01982000
            BEGIN                                                       01984000
            XREG := TEMP & LSL(7);                                      01986000
            TOS := IF EXCOUNT = 0 THEN DBIOPNTR (XREG) ELSE EEMISCWD;   01988000
            IF TOS.(BSIZEF) <= INTEGER (TEMP := DBNUMVALID              01990000
               -INTEGER(TEMP)) THEN                                     01992000
               BEGIN                                                    01994000
               TRACE (13,-((XREG & LSR(7))*100+INTEGER(TEMP)));         01996000
               DBNUMVALID := DBNUMVALID-INTEGER(TEMP);                  01998000
               MOVE TEMPP := DBIOPNTR (XREG), (TEMP & LSL(7));          02000000
               GOTO SETUP;                                              02002000
               END;                                                     02004000
            END;                                                        02006000
   >>                                                                   02008000
READIN:                                                                 02010000
   TOS := 0D;                                                           02012000
   TOS := DIRLDEV;                                             <<01.PV>>02014000
   TOS := 0;                                                            02016000
   TOS := DDSDST;                                                       02018000
   TOS := @TEMPP;                                                       02020000
   TOS := 0;                                                            02022000
   TOS := DDSBWSIZE;                                                    02024000
   TOS := DIRBASE1.(8:8);                                      <<01.PV>>02026000
   TOS := DIRBASE2;                                            <<01.PV>>02028000
   TOS := 0;                                                   <<DE>>   02030000
   TOS := PNTR;                                                <<DE>>   02032000
   ASMB(DADD);                                                          02034000
$IF X0=ON                                                      <<DEBUG>>02036000
   IF IPNTR <= 0 THEN DEBUG;                                   <<DEBUG>>02038000
$IF                                                            <<DEBUG>>02040000
   TOS := ATTACHIO (*,*,*,*,*,*,*,*,DIRIO);                    <<DE>>   02042000
   ASSEMBLE (STBX, DEL);                                                02044000
   IF TOS.(13:3) <> 1 THEN SYSABORT(DIRIOAB);                           02046000
   TEMP := DDSBSIZE;                                                    02048000
SETUP:                                                                  02050000
   DBASE (DIRBASE') := DIRBASE;                                <<10.PV>>02052000
   BASE (CONTENTS) := PNTR;                                             02054000
   BASE (NUMVALID) := TEMP;                                             02056000
   IF TEMPP.(TYPEF) = INDEXTYPE THEN                                    02058000
      BEGIN                                                             02060000
      MOVE BASE(MISCWD) := TEMPP, (PRESIZE);                            02062000
      TEMP := PRESIZE;                                                  02064000
      END                                                               02066000
   ELSE                                                                 02068000
      BEGIN                                                             02070000
      BASE(XCOUNT) := EXCOUNT;                                          02072000
      BASE(MISCWD) := EEMISCWD;                                         02074000
      TEMP := 0;                                                        02076000
      END;                                                              02078000
   BASE (LPNTR) := @TEMPP+INTEGER(TEMP);                                02080000
   BASE(USED) := (BASE(XSIZE) := BASE(MISCWD).(XSIZEF)) * BASE(XCOUNT); 02082000
   BASE(BFACTOR) := ((BASE(BWSIZE) := (BASE(BSIZE)                      02084000
      := BASE(MISCWD).(BSIZEF)) & LSL(7)) - TEMP) / BASE(XSIZE);        02086000
   END <<DIRREAD>>;                                                     02088000
                                                                        02090000
                                                                        02092000
                                                                        02094000
                                                                        02096000
LOGICAL PROCEDURE DIRNEWINDEX (IBSIZE, ILEVEL, EBSIZE, ESIZE);          02098000
   VALUE IBSIZE, ILEVEL, EBSIZE, ESIZE;                                 02100000
   INTEGER IBSIZE, ILEVEL, EBSIZE, ESIZE;                               02102000
   OPTIONS;                                                             02104000
<< CALLER MUST MOVE PINDEXP AND PNAME INTO DBPINDEXP AND DBPNAME >>     02106000
BEGIN                                                                   02108000
                                                                        02110000
   IF EBSIZE > DDSBSIZE THEN GOTO NEVER;                                02112000
   TOS := DIRALLOCATE (IBSIZE);                                         02114000
   IF <> THEN                                                           02116000
      BEGIN                                                             02118000
      IF < THEN XREG := CCL                                             02120000
      ELSE                                                              02122000
NEVER:   XREG := CCG;                                                   02124000
      CC := XREG;                                                       02126000
      DIRNEWINDEX := 0;                                                 02128000
      RETURN;                                                           02130000
      END;                                                              02132000
   CC := CCE;                                                           02134000
   DBDIRBASE := DIRBASE;                                       <<02.PV>>02136000
   DBCONTENTS := (DIRNEWINDEX := TOS);                                  02138000
   @DBLPNTR := @DBIOPNTR+PRESIZE;                                       02140000
   DBNUMVALID := IBSIZE;                                                02142000
   DBUSED := 0;                                                         02144000
   DBBFACTOR := (DBBWSIZE := (DBBSIZE := IBSIZE) & LSL(7)) / ISIZE;     02146000
   TOS := 0;                                                            02148000
   TOS.(TYPEF) := INDEXTYPE;                                            02150000
   TOS.(LEVELF) := ILEVEL;                                              02152000
   TOS.(XSIZEF) := (DBXSIZE := ISIZE);                                  02154000
   TOS.(BSIZEF) := DBBSIZE;                                             02156000
   DBMISCWD := TOS;                                                     02158000
   DBXCOUNT := (DBPCOUNT := (DBETOTAL := 0));                           02160000
   TOS := 0;                                                            02162000
   TOS.(TYPEF) := ENTRYTYPE;                                            02164000
   TOS.(LEVELF) := ILEVEL;                                              02166000
   TOS.(XSIZEF) := ESIZE;                                               02168000
   TOS.(BSIZEF) := EBSIZE;                                              02170000
   DBEMISCWD := TOS;                                                    02172000
   DIRXXXBITMAP (WRITE);                                       <<28.PV>>02174000
   DIRWRITE (B);                                                        02176000
   END    <<DIRNEWINDEX>>;                                              02178000
                                                                        02180000
                                                                        02182000
                                                                        02184000
                                                                        02186000
INTEGER PROCEDURE DIRSCAN (ENTRYNAME, TYPE'WHICH);                      02188000
   VALUE TYPE'WHICH;                                                    02190000
   ARRAY ENTRYNAME;                                                     02192000
   LOGICAL TYPE'WHICH;                                                  02194000
   OPTIONS;                                                             02196000
   << ASSUMES NAMESIZE = 4 >>                                           02198000
<< RETURNS:                                                             02200000
   CCG - EXACT ENTRY RETURNED.                                          02202000
   CCL - PRECEEDING OR NEXT ENTRY RETURNED                              02204000
   CCE - "PSEUDO" PRECEEDING OR NEXT ENTRY RETURNED (OUTSIDE BOUNDS)  >>02206000
                                                                        02208000
BEGIN                                                                   02210000
   DOUBLE POINTER DENTRYNAME = ENTRYNAME;                               02212000
   DEFINE                                                               02214000
      WHICHFIELD  = 15:1 #,                                             02216000
      TYPEFIELD  = 13:2 #;                                              02218000
   DOUBLE POINTER ENDX;                                                 02220000
   DOUBLE POINTER PNTR;                                                 02222000
   INTEGER POINTER IPNTR = PNTR;                                        02224000
<< >>                                                                   02226000
   @BASE := IF (TYPE'WHICH) THEN @DBPREPRE ELSE @DAPREPRE;              02228000
   BASE (FLAGS).FLAGSF := 0; <<CLEANUP OLD RESIDUE>>                    02230000
   @ENDX := (@PNTR := IBASE(LPNTR))+IBASE(USED);                        02232000
   << CHANGE TO BINARY SEARCH LATER >>                                  02234000
   WHILE @PNTR < @ENDX DO                                               02236000
      BEGIN                                                             02238000
      IF DENTRYNAME = PNTR THEN                                         02240000
         IF DENTRYNAME (1) & DLSL (1) & DLSR (1) =                      02242000
            PNTR (XREG) & DLSL (1) & DLSR (1)                           02244000
         THEN GO TO EXACTONE;                                           02246000
      IF < THEN GOTO NEXTONE;                                           02248000
      @PNTR := @PNTR+IBASE(XSIZE);                                      02250000
      END;                                                              02252000
   @ENDX := 0;                                                          02254000
NEXTONE:                                                                02256000
   IF TYPE'WHICH.(TYPEFIELD) <= 1 THEN                                  02258000
      << EXACT OR EXACT/NEXT REQUEST >>                                 02260000
         BEGIN                                                          02262000
         TOS := @PNTR;                                                  02264000
         XREG := IF @ENDX <> 0 THEN CCL ELSE CCE;                       02266000
         END                                                            02268000
   ELSE                                                                 02270000
      << EXACT/PRECEEDING REQUEST >>                                    02272000
         BEGIN                                                          02274000
         TOS := @PNTR-IBASE(XSIZE);                                     02276000
         XREG := IF @PNTR <> IBASE(LPNTR) THEN CCL ELSE CCE;            02278000
         END;                                                           02280000
   GOTO EXIT;                                                           02282000
EXACTONE:                                                               02284000
   BASE (FLAGS).BADELMF := IPNTR (2) < 0; <<FLAGGED ENTRY?>>            02286000
   TOS := @PNTR;                                                        02288000
   XREG := CCG;                                                         02290000
EXIT:                                                                   02292000
   CC := XREG;                                                          02294000
   DIRSCAN := TOS;                                                      02296000
   END    <<DIRSCAN>>;                                                  02298000
                                                                        02300000
                                                                        02302000
                                                                        02304000
                                                                        02306000
DOUBLE PROCEDURE DIRINSERT (INDEXPOINTER);                              02308000
   VALUE INDEXPOINTER;                                                  02310000
   LOGICAL INDEXPOINTER;                                                02312000
   OPTIONS;                                                             02314000
<< WHEN CALLED:                                                         02316000
   1. DIRECTORY IS LOCKED,                                              02318000
   2. ENTRY HAS BEEN MOVED TO THE DATA SEGMENT (AT 0),                  02320000
   3. DB IS SET AT THE DATA SEGMENT.  >>                                02322000
<< RETURNS:                                                             02324000
   (S-0)                  (S-1)                                         02326000
   0 - SUCCESSFUL            0                                          02328000
   1 - DUPLICATE NAME        0                                          02330000
   4 - NO USER ROOM          N         N% USED.  NO INDEX ROOM          02332000
   5 - NO USER ROOM          0         > 65K ENTRIES                    02334000
   6 - NO SYSTEM ROOM        N         FOR N CONTIGUOUS BLOCKS        >>02336000
                                                                        02338000
BEGIN                                                                   02340000
   LOGICAL NEWPREIETOTAL;                                               02342000
   INTEGER STEMP;                                                       02344000
   INTEGER STEMP2;                                                      02346000
   INTEGER STEMP3, STEMP4;                                              02348000
   INTEGER                                                              02350000
      ZT,                                                               02352000
      ZTOTAL,                                                           02354000
      ZH1,                                                              02356000
      ZHALF1,                                                           02358000
      ZH2,                                                              02360000
      ZHALF2;                                                           02362000
   LOGICAL POINTER                                                      02364000
      IPNTR,                                                            02366000
      IPNTR2;                                                           02368000
   INTEGER POINTER                                                      02370000
      IIPNTR = IPNTR,                                                   02372000
      IIPNTR2 = IPNTR2;                                                 02374000
   INTEGER TEMP;                                                        02376000
   LOGICAL POINTER TEMPP = TEMP;                                        02378000
   INTEGER ESIZE;                                                       02380000
   LOGICAL POINTER S2PNTR = S-2;                                        02382000
   LOGICAL POINTER S4PNTR = S-4;                                        02384000
                                                                        02386000
                                                                        02388000
                                                                        02390000
LOGICAL SUBROUTINE ZINSERT (ELEMENT, WHICH, PNTR);                      02392000
   VALUE WHICH;                                                         02394000
   ARRAY ELEMENT, PNTR;                                                 02396000
   LOGICAL WHICH;                                                       02398000
BEGIN                                                                   02400000
   @BASE := IF WHICH THEN @DBPREPRE ELSE @DAPREPRE;                     02402000
   IF @PNTR = 0 THEN                                                    02404000
                                                                        02406000
      << *** FIND PREVIOUS ELEMENT *** >>                               02408000
      BEGIN                                                             02410000
      @PNTR := DIRSCAN (ELEMENT, EN LOR WHICH);                         02412000
      IF > THEN                                                         02414000
         BEGIN                                                          02416000
         ZINSERT := 0;                                                  02418000
         RETURN;                                                        02420000
         END;                                                           02422000
      END;                                                              02424000
   STEMP2 := BASE(XSIZE);                                               02426000
   STEMP := IBASE(LPNTR) + IBASE(USED) - @PNTR;                         02428000
   IF <> THEN                                                           02430000
      << ******** CHECK CODE FOR FOLLOWING 2 STATEMENTS **************>>02432000
      MOVE PNTR (STEMP+STEMP2-1) := PNTR(STEMP-1), (-STEMP);            02434000
   MOVE PNTR := ELEMENT, (STEMP2);                                      02436000
   ZINSERT := @PNTR;                                                    02438000
   END    <<ZINSERT>>;                                                  02440000
                                                                        02442000
                                                                        02444000
                                                                        02446000
LOGICAL SUBROUTINE ZNEWENTRYBLOCK (NAME, INDEXPLACE);                   02448000
   ARRAY NAME, INDEXPLACE;                                              02450000
BEGIN                                                                   02452000
   IF (STEMP3 := DBXCOUNT+1) > DBBFACTOR THEN                           02454000
      BEGIN                                                             02456000
      TOS := INTEGER (FIXR ((REAL(DBETOTAL)/REAL((DBXCOUNT) *           02458000
         ((DBEBSIZE & LSL(7))/ESIZE)))*100.));                          02460000
      TOS := 4;                                                         02462000
      << *********** CHECK THIS BRANCH ***********>>                    02464000
      GOTO BADEXIT;                                                     02466000
      END;                                                              02468000
   STEMP4 := DIRALLOCATE (DBEBSIZE);                                    02470000
   IF < THEN                                                            02472000
      BEGIN                                                             02474000
      TOS := DBEBSIZE;                                                  02476000
      TOS := 6;                                                         02478000
      << *********** CHECK THIS BRANCH ***********>>                    02480000
      GOTO BADEXIT;                                                     02482000
      END;                                                              02484000
   DIRXXXBITMAP (WRITE);                                       <<28.PV>>02486000
                                                                        02488000
   << *** INDEX HAS ROOM AND WE HAVE A BLOCK *** >>                     02490000
   << ******* CHECK CODE FOR FOLLLOWING STATEMENT **************>>      02492000
   ZINSERT (NAME, B, INDEXPLACE);                                       02494000
   DBXCOUNT := STEMP3;                                                  02496000
   DBUSED := DBUSED+ISIZE;                                              02498000
   INDEXPLACE (IEPNTR) := (ZNEWENTRYBLOCK := STEMP4);                   02500000
   END    <<ZNEWENTRYBLOCK>>;                                           02502000
                                                                        02504000
                                                                        02506000
                                                                        02508000
SUBROUTINE ZSET;                                                        02510000
BEGIN                                                                   02512000
   ZTOTAL := ZT * (XREG := ESIZE);                                      02514000
   ZHALF1 := (ZH1 := ZT & LSR(1)) * XREG;                               02516000
   ZHALF2 := (ZH2 := (ZT+1) & LSR(1)) * XREG;                           02518000
   END    <<ZSET>>;                                                     02520000
                                                                        02522000
                                                                        02524000
                                                                        02526000
SUBROUTINE ZDISTRIBUTE;                                                 02528000
BEGIN                                                                   02530000
   MOVE DBLPNTR (ZHALF2-1) := DALPNTR (ZTOTAL-1), (-ZHALF2);            02532000
   DBUSED := ZHALF2;                                                    02534000
   DBXCOUNT := ZH2;                                                     02536000
   DIRWRITE (B);                                                        02538000
   DAUSED := ZHALF1;                                                    02540000
   DAXCOUNT := ZH1;                                                     02542000
   DIRWRITE (A);                                                        02544000
   END    <<ZDISTRIBUTE>>;                                              02546000
                                                                        02548000
                                                                        02550000
                                                                        02552000
                                                                        02554000
<< >>                                                                   02556000
   DIRREAD (INDEXPOINTER, B, 0, 0);                                     02558000
   ESIZE := DBEXSIZE;                                                   02560000
   NEWPREIETOTAL := DBETOTAL+1;                                         02562000
   IF CARRY THEN                                                        02564000
      BEGIN                                                             02566000
      TOS := 5;                                                         02568000
      GOTO BADEXITZ;                                                    02570000
      END;                                                              02572000
   @IPNTR := DIRSCAN (DDSENTRY, EPB);                                   02574000
   IF > THEN                                                            02576000
DUPNAME:                                                                02578000
      BEGIN                                                             02580000
      TOS := 1;                                                         02582000
BADEXITZ:                                                               02584000
      ASSEMBLE (ZROB);                                                  02586000
BADEXIT:                                                                02588000
      CC := CCG;                                                        02590000
      GOTO EXIT;                                                        02592000
      END;                                                              02594000
   IF = THEN                                                            02596000
                                                                        02598000
      <<*** NO CONTAINING BLOCK: ALLOCATE 1 OR INSERT IN FIRST ONE ***>>02600000
      BEGIN                                                             02602000
      @IPNTR := @DBLPNTR;                                               02604000
      IF DBXCOUNT > 0 THEN GOTO CHECKFIT;                               02606000
      TOS := ZNEWENTRYBLOCK (DDSENTRY, IPNTR);                          02608000
      IPNTR (IECOUNT) := 0;                                             02610000
      << *** SET UP NULL BLOCK *** >>                                   02612000
      DBNUMVALID := DBBSIZE;    <<PROCECT AGAINST INACCURATE COPY IN B>>02614000
      DADIRBASE := DIRBASE;                                    <<02.PV>>02616000
      DACONTENTS := TOS;                                                02618000
      @DALPNTR := @DAIOPNTR;                                            02620000
      DANUMVALID := DBEBSIZE;                                           02622000
      DAXSIZE := DBEXSIZE;                                              02624000
      DAUSED := 0;                                                      02626000
      DABWSIZE := (DABSIZE := DBEBSIZE) & LSL(7);                       02628000
      DABFACTOR := DABWSIZE/DAXSIZE;                                    02630000
      DAMISCWD := DBEMISCWD;                                            02632000
      DAXCOUNT := 0;                                                    02634000
      GOTO NORMALINSERT;                                                02636000
      END;                                                              02638000
CHECKFIT:                                                               02640000
   IF IIPNTR (IECOUNT) < (TEMP := (DBEBSIZE & LSL(7)) / ESIZE) THEN     02642000
                                                                        02644000
      << *** A NORMAL INSERTION *** >>                                  02646000
      BEGIN                                                             02648000
      DIRREAD (IPNTR (IEPNTR), A, IPNTR(IECOUNT), DBEMISCWD);           02650000
NORMALINSERT:                                                           02652000
      IF ZINSERT (DDSENTRY, A, DDS) = 0 THEN GOTO DUPNAME;              02654000
      DAUSED := DAUSED+ESIZE;                                           02656000
      DAXCOUNT := DAXCOUNT+1;                                           02658000
      DIRWRITE (A);                                                     02660000
      DBETOTAL := NEWPREIETOTAL;                                        02662000
      MOVE IPNTR := DALPNTR, (NAMESIZE);                                02664000
      IIPNTR (IECOUNT) := IIPNTR (IECOUNT) + 1;                         02666000
      DIRWRITE (B);                                                     02668000
      END                                                               02670000
   ELSE                                                                 02672000
                                                                        02674000
      << *** DISTRIBUTION REQUIRED *** >>                               02676000
      BEGIN                                                             02678000
      IF DBXCOUNT = 1 THEN GOTO NEWDISTRIBUTE;                          02680000
      IF @IPNTR = @DBLPNTR THEN GOTO UPPER;                             02682000
      IF @IPNTR = @DBLPNTR (DBUSED-ISIZE) THEN GOTO LOWER;              02684000
      IF IIPNTR (ISIZE+IECOUNT) <= IIPNTR (-ISIZE+IECOUNT) THEN         02686000
UPPER:   XREG := ISIZE                                                  02688000
      ELSE                                                              02690000
LOWER:   XREG := -ISIZE;                                                02692000
      @IPNTR2 := @IPNTR (XREG);                                         02694000
      TOS := (ZT := IIPNTR (IECOUNT) + IIPNTR2 (XREG) + 1);             02696000
      IF REAL (TOS & LSR(1)) / REAL (TEMP) < GOODPERCENT THEN           02698000
                                                                        02700000
         << *** DISTRIBUTE AMONG NEIGHBORS *** >>                       02702000
         BEGIN                                                          02704000
         ZSET;                                                          02706000
         IF @IPNTR > @IPNTR2 THEN                                       02708000
            BEGIN  <<MAKE IPNTR LOWER ONE>>                             02710000
            TOS := @IPNTR2;                                             02712000
            @IPNTR2 := @IPNTR;                                          02714000
            @IPNTR := TOS;                                              02716000
            END;                                                        02718000
         << READ IN LOWER BLOCK >>                                      02720000
         DIRREAD (IPNTR (IEPNTR), A, IPNTR (IECOUNT), DBEMISCWD);       02722000
         << KLUGE TO READ IN UPPER BLOCK RIGHT ON TOP OF LOWER >>       02724000
         DANUMVALID := DBEBSIZE;                                        02726000
         TOS := @DBIOPNTR;                                              02728000
         @DBIOPNTR := @DALPNTR (DAUSED);                                02730000
         DIRREAD (IPNTR2 (IEPNTR), B, IPNTR2 (IECOUNT), DBEMISCWD);     02732000
         @DBIOPNTR := (@DBLPNTR := TOS);                                02734000
         << (KLUGE A'S SIZE FOR ZINSERT) >>                             02736000
         TOS := DAXCOUNT;                                               02738000
         TOS := DAUSED;                                                 02740000
         DAUSED := ZTOTAL-ESIZE;                                        02742000
         DAXCOUNT := ZT-1;                                              02744000
         IF (TEMP := ZINSERT (DDSENTRY, A,  DDS)) = 0 THEN              02746000
            BEGIN                                                       02748000
            DAUSED := TOS;                                              02750000
            DAXCOUNT := TOS;                                            02752000
            DBCONTENTS := 0;                                            02754000
            GOTO DUPNAME;                                               02756000
            END;                                                        02758000
         DBNUMVALID := DANUMVALID;                                      02760000
         ZDISTRIBUTE;                                                   02762000
         MOVE DAPNAME := DBLPNTR, (NAMESIZE);   <<DAPNAME NOT USED>>    02764000
         DIRREAD (INDEXPOINTER, B, 0, 0);                               02766000
         DBETOTAL := NEWPREIETOTAL;                                     02768000
         IF TEMP = @DALPNTR THEN                                        02770000
            MOVE IPNTR := DALPNTR, (NAMESIZE);                          02772000
         IPNTR (IECOUNT) := ZH1;                                        02774000
         MOVE IPNTR2 := DAPNAME, (NAMESIZE);                            02776000
         IPNTR2 (XREG) := ZH2;                                          02778000
         DIRWRITE (B);                                                  02780000
         END                                                            02782000
      ELSE                                                              02784000
NEWDISTRIBUTE:                                                          02786000
                                                                        02788000
         << *** DISTRIBUTE WITH NEW BLOCK *** >>                        02790000
         BEGIN                                                          02792000
         ZT := IPNTR (IECOUNT) +1;                                      02794000
         ZSET;                                                          02796000
         DIRREAD (IPNTR (IEPNTR), A, IPNTR(IECOUNT), DBEMISCWD);        02798000
         TEMP := DIRSCAN (DDSENTRY, ENA);                               02800000
         IF > THEN GOTO DUPNAME;                                        02802000
         @IPNTR2 := @IPNTR+ISIZE;                                       02804000
         XREG := @DALPNTR(ZHALF1);                                      02806000
         IF TEMP <= XREG THEN                                           02808000
            IF < THEN XREG := XREG-DAXSIZE                              02810000
            ELSE XREG := @DDSENTRY;                                     02812000
         TOS := ZNEWENTRYBLOCK (DDS(XREG), IPNTR2);                     02814000
         IPNTR2 (IECOUNT) := ZH2;                                       02816000
         DBETOTAL := NEWPREIETOTAL;                                     02818000
         IPNTR (XREG) := ZH1;                                           02820000
         IF TEMP = @DALPNTR THEN                                        02822000
            MOVE IPNTR := DDSENTRY, (NAMESIZE);                         02824000
         DIRWRITE (B);                                                  02826000
         << *** SET UP NULL BLOCK IN B *** >>                           02828000
         DANUMVALID := DBEBSIZE;    <<PROTECT AGAINST INACCURATE COPYA>>02830000
         DBCONTENTS := TOS;                                             02832000
         @DBLPNTR := @DBIOPNTR;                                         02834000
         DBNUMVALID := DBEBSIZE;                                        02836000
         DBXSIZE := DBEXSIZE;                                           02838000
         DBUSED := 0;                                                   02840000
         DBBFACTOR := (DBBWSIZE := (DBBSIZE := DBEBSIZE) & LSL(7))      02842000
            / DBXSIZE;                                                  02844000
         DBMISCWD := DBEMISCWD;                                         02846000
         DBXCOUNT := 0;                                                 02848000
         ZINSERT (DDSENTRY, A, TEMPP);                                  02850000
         ZDISTRIBUTE;                                                   02852000
         END;                                                           02854000
      END;                                                              02856000
   TOS := 0D;    <<SUCCESSFIL RETURN>>                                  02858000
   CC := CCE;                                                           02860000
EXIT:                                                                   02862000
   DIRINSERT := TOS;                                                    02864000
   END    <<DIRINSERT>>;                                                02866000
                                                                        02868000
                                                                        02870000
                                                                        02872000
                                                                        02874000
DOUBLE PROCEDURE DIRFIND (INDEXPOINTER);                                02876000
   VALUE INDEXPOINTER;                                                  02878000
   LOGICAL INDEXPOINTER;                                                02880000
   OPTIONS;                                                             02882000
<< RETURN:                                                              02884000
   HIGH ORDER  =  DB ADDR OF INDEX (IN B).                              02886000
   LOW ORDER   =  DB ADDR OF ENTRY (IN A).    >>                        02888000
BEGIN                                                                   02890000
   INTEGER                                                     <<61.PV>>02892000
       MVTABX;                                                 <<61.PV>>02894000
   DIRREAD (INDEXPOINTER, B, 0, 0);                                     02896000
   TOS := DIRSCAN (DDSENTRY, EPB);                                      02898000
   IF = THEN                                                            02900000
NOTFOUND:                                                               02902000
      BEGIN                                                             02904000
      DIRFIND := 0D;                                                    02906000
      RETURN;                                                           02908000
      END;                                                              02910000
   DIRREAD (S0PNTR(IEPNTR), A, S0PNTR(IECOUNT), DBEMISCWD);             02912000
   TOS := DIRSCAN (DDSENTRY, EA);                                       02914000
   IF <= THEN GOTO NOTFOUND;                                            02916000
   IF BASE (MISCWD).(LEVELF) = GROUPLEVEL AND                  <<09.PV>>02918000
      XTYPE.(ENDLEVELF) = FILELEVEL THEN                       <<09.PV>>02920000
    IF (TOS := S0PNTR (GLINKAGE)).(PVF) = PV THEN              <<09.PV>>02922000
     IF (MVTABX := TOS.(MVTABXF)) <> 0 THEN                    <<61.PV>>02924000
     BEGIN     <<PV AND MOUNTED>>                              <<09.PV>>02926000
         TOS := DDSDST;                 <<E: TARGET>>          <<61.PV>>02928000
         TOS := @DIRBASE;               <<D: TARGET OFFSET>>   <<61.PV>>02930000
         TOS := MVTABDST;               <<C: SOURCE>>          <<61.PV>>02932000
         TOS := (MVTABX*MVTABSZ)+2;     <<B: SOURCE OFFSET>>   <<61.PV>>02934000
         TOS := 2;                      <<A: COUNT>>           <<61.PV>>02936000
         ASSEMBLE (MDS);                <<DIRBASE SWITCH>>     <<61.PV>>02938000
     END                                                       <<09.PV>>02940000
     ELSE <<PV AND NOT MOUNTED>>                               <<61.PV>>02942000
    ELSE <<NOT PV>> DEL;                                       <<16.PV>>02944000
   DIRFIND := TOS;                                                      02946000
   END    <<DIRFIND>>;                                                  02948000
                                                                        02950000
                                                                        02952000
                                                                        02954000
                                                                        02956000
PROCEDURE DIRREMOVE (ELEMENT, WHICH);                                   02958000
   VALUE WHICH;                                                         02960000
   LOGICAL WHICH;                                                       02962000
   ARRAY ELEMENT;                                                       02964000
   OPTIONS;                                                             02966000
<< DECREMENTS <USED> AND <XCOUNT>;                                      02968000
   REMOVES ELEMENT;                                                     02970000
   DEALLOCATES BLOCK WHEN AN ENTRY BLOCK IS DEPLETED.  >>               02972000
BEGIN                                                                   02974000
   @BASE := IF WHICH THEN @DBPREPRE ELSE @DAPREPRE;                     02976000
   WHICHDIRTY := TRUE;                                                  02978000
   IBASE(USED) := IBASE(USED) - IBASE(XSIZE);                           02980000
   IBASE(XCOUNT) := IBASE(XCOUNT)-1;                                    02982000
   IF = THEN                                                            02984000
      BEGIN                                                             02986000
      IF BASE(MISCWD).(TYPEF) = ENTRYTYPE THEN                          02988000
         BEGIN                                                          02990000
         DIRDEALLOCATE (BASE(CONTENTS), BASE(BSIZE));                   02992000
         BASE (CONTENTS) := (WHICHDIRTY := 0);                          02994000
         END;                                                           02996000
      RETURN;                                                           02998000
      END;                                                              03000000
   MOVE ELEMENT := ELEMENT (BASE(XSIZE)),                               03002000
      (IBASE(LPNTR)+IBASE(USED)-@ELEMENT);                              03004000
   END    <<DIRREMOVE>>;                                                03006000
                                                                        03008000
                                                                        03010000
                                                                        03012000
LOGICAL PROCEDURE ACCCHECK (LEVEL, ACCTNAME, ACCTSEC,GROUPNAME,         03014000
      GROUPSEC, CREATOR, FILESEC, USERINFO);                            03016000
   VALUE LEVEL, ACCTSEC, GROUPSEC, FILESEC;                    << ... >>03018000
   INTEGER LEVEL;                                                       03020000
   BYTE ARRAY ACCTNAME;                <<NOT OPT.>>                     03022000
   LOGICAL ACCTSEC;                    <<NOT OPT.>>                     03024000
   BYTE ARRAY GROUPNAME;               <<NOT OPT. IF LEVEL <= 1>>       03026000
   DOUBLE GROUPSEC;                    <<NOT OPT. IF LEVEL <= 1>>       03028000
   BYTE ARRAY CREATOR;                 <<NOT OPT. IF LEVEL = 0>>        03030000
   DOUBLE FILESEC;                     <<NOT OPT. IF LEVEL = 0>>        03032000
   BYTE ARRAY USERINFO;                <<OPT.                           03034000
                                       (0:7) = UACCT (ALWAYS),          03036000
                                       (8:15)= UHGROUP (IF LEVEL <= 1)  03038000
                                       (16:23)=ULGROUP (IF LEVEL <= 1)  03040000
                                       (24:31)=UNAME (IF LEVEL =0) >>   03042000
   OPTION VARIABLE, PRIVILEGED, UNCALLABLE;                             03044000
<<                                                                      03046000
   RETURNS ACCESS  (ACCCHECK.(10:6) = RAWLXS)                           03048000
   AT LEVEL    (0/1/2 = FILE/GROUP/ACCT)                                03050000
   DB MUST BE AT STACK.                                                 03052000
   PARAMETERS REQUIRED INDICATED ABOCE (DEPENDS ON LEVEL)               03054000
   IF <USERINFO> OMITTEDD, JIT ACCESSED TO GET INFO.                    03056000
   NOTE: <USERINFO> = JIT1(8:23).                                       03058000
   >>                                                                   03060000
BEGIN                                                                   03062000
<< MISC. DECL >>                                                        03064000
   INTEGER           XREG              = X,                             03066000
                     S15               = S-15,                          03068000
                     S16               = S-16,                          03070000
                     S2                = S-2,                           03072000
                     S0                = S-0;                           03074000
   INTEGER ARRAY     DB6 (*)           = DB+6,                          03076000
                     DB2 (*)           = DB+2;                          03078000
   INTEGER POINTER   PS0               = S-0;                           03080000
   DEFINE            ASM               = ASSEMBLE #;                    03082000
<< PARAMETER BREAKDOWN >>                                               03084000
   LOGICAL           PMASK             = Q-4;                           03086000
   INTEGER           GSEC1             = GROUPSEC,                      03088000
                     GSEC2             = GSEC1 +1,                      03090000
                     FILESEC1          = FILESEC,                       03092000
                     FILESEC2          = FILESEC1 +1;                   03094000
   DEFINE            UACCT             = USERINFO #,                    03096000
                     UHGROUP           = USERINFO (8) #,                03098000
                     ULGROUP           = USERINFO (16) #,               03100000
                     UNAME             = USERINFO (24) #;               03102000
   LOGICAL           ACCESSX           = ACCCHECK;                      03104000
<< LOCALS >>                                                            03106000
   INTEGER           JITDST;                                            03108000
   POINTER           JIT1              = DB+2;                          03110000
   LOGICAL           UATTR;            <<USER ATTRIBUTES (FROM PSBX) >> 03112000
   DEFINE            SMCAP             = UATTR.(0:1) #,                 03114000
                     AMCAP             = UATTR.(1:1) #,                 03116000
                     ALCAP             = UATTR.(2:1) #,                 03118000
                     GLCAP             = UATTR.(3:1) #,                 03120000
                     SFCAP             = UATTR.(15:1)  #;               03122000
   LOGICAL           ACCESSOR          := %60;    <<INIT ANY AND AC>>   03124000
   DEFINE            ACACCR            = ACCESSOR.(11:1) #,             03126000
                     ALACCR            = ACCESSOR.(12:1) #,             03128000
                     GUACCR            = ACCESSOR.(13:1) #,             03130000
                     GLACCR            = ACCESSOR.(14:1) #,             03132000
                     CRACCR            = ACCESSOR.(15:1) #;             03134000
                                                                        03136000
   INTEGER PROCEDURE EXCHANGEDB (DST);                                  03138000
      VALUE DST;                                                        03140000
      INTEGER DST;                                                      03142000
      OPTION EXTERNAL;                                                  03144000
                                                                        03146000
                                                                        03148000
   << GET USER CAPABILITY ATTRIBUTES AND JIT DST >>                     03150000
   PUSH (DL);                                                           03152000
   XREG := TOS - PS0(-1);                                      <<DE>>   03154000
   UATTR := DB2(XREG);                                                  03156000
   JITDST := DB6 (XREG).(6:10);                                         03158000
   IF NOT (PMASK) THEN                                                  03160000
      BEGIN    <<GET USER INFO FROM JIT.  CALLER DIDN'T SUPPLY>>        03162000
      ASM (ADDS 16);                                                    03164000
      TOS := @S15;                                                      03166000
      @USERINFO := S0 &LSL(1);                                          03168000
      PUSH (DL);                                                        03170000
      ASM (NEG, ADD);                                                   03172000
      EXCHANGEDB (JITDST);                                              03174000
      TOS := @JIT1(8);                                                  03176000
      TOS := 16;                                                        03178000
      ASM (MVBL);                                                       03180000
      EXCHANGEDB (0);                                                   03182000
      END;                                                              03184000
   IF UACCT <> ACCTNAME, (8) THEN                                       03186000
      BEGIN                                                             03188000
      ACACCR := 0;                                                      03190000
      TOS := %76;                                                       03192000
      END                                                               03194000
   ELSE TOS := %77;                                                     03196000
   IF NOT (SFCAP) THEN TOS.(15:1) := 0;                                 03198000
   ACCCHECK := TOS;                                                     03200000
   IF NOT (SMCAP) THEN                                                  03202000
      BEGIN                                                             03204000
      IF NOT (ACACCR) OR NOT (AMCAP) THEN                               03206000
         BEGIN    <<NOT AM OR SM>>                                      03208000
         << DETERMINE USER'S ACCESSOR CATEGORIES >>                     03210000
         << ANY AND AC ALREADY SET >>                                   03212000
         IF LEVEL <> 2 AND ACACCR THEN                                  03214000
            BEGIN    << MEM OF ACCT >>                                  03216000
            ALACCR := ALCAP;                                            03218000
            TOS := 1;                                                   03220000
            IF UHGROUP = GROUPNAME, (8) THEN                            03222000
               <<HOME GROUP>>                                           03224000
               GLACCR := GLCAP                                          03226000
            ELSE IF ULGROUP <> GROUPNAME, (8) THEN TOS := TOS-1;        03228000
            GUACCR := TOS;                                              03230000
            IF LEVEL = 0 AND UNAME = CREATOR, (8) THEN CRACCR := TRUE;  03232000
            END;                                                        03234000
         << USER'S ACCESSOR CATEGORIES DETERMINED >>                    03236000
                                                                        03238000
         << APPLY TO ACCT SECURITY MATRIX >>                            03240000
         TOS := ACCESSOR & LSR(4);                                      03242000
         TOS := ACCTSEC.(4:12);                                         03244000
         XREG := 5;                                                     03246000
         DO BEGIN                                                       03248000
            ASM (DDUP;  AND, DEL);                                      03250000
            IF = THEN                                                   03252000
               BEGIN                                                    03254000
               TOS := ACCESSX;                                          03256000
               ASM (TRBC 10, X);                                        03258000
               ACCCHECK := TOS;                                         03260000
               END;                                                     03262000
            TOS := TOS & LSR(2);                                        03264000
            XREG := XREG -1;                                            03266000
            END                                                         03268000
         UNTIL <;                                                       03270000
         IF LEVEL <> 2 AND ACCESSX <> 0 THEN                            03272000
            BEGIN                                                       03274000
                                                                        03276000
            << APPLY ACCESSOR TO GROUP SECURITY >>                      03278000
            TOS := ACCESSOR & LSR(1);                                   03280000
            TOS := GSEC1.(2:14);                                        03282000
            TOS := GSEC2;                                               03284000
            XREG := 5;                                                  03286000
            DO BEGIN                                                    03288000
               TOS := S2;                                               03290000
               ASM (DDUP, AND;  DDEL);                                  03292000
               IF = THEN                                                03294000
                  BEGIN                                                 03296000
                  TOS := ACCESSX;                                       03298000
                  ASM (TRBC 10, X);                                     03300000
                  ACCCHECK := TOS;                                      03302000
                  END;                                                  03304000
               TOS := TOS & DLSR(5);                                    03306000
               XREG := XREG -1;                                         03308000
               END                                                      03310000
            UNTIL <;                                                    03312000
            IF LEVEL = 0 AND ACCESSX <> 0 THEN                          03314000
               BEGIN                                                    03316000
                                                                        03318000
               << APPLY ACCESSOR TO FILE SECURITY >>                    03320000
               TOS := FILESEC1.(2:14);                                  03322000
               TOS := FILESEC2;                                         03324000
               XREG := 4;                                               03326000
               DO BEGIN                                                 03328000
                  TOS := ACCESSOR;                                      03330000
                  ASM (DDUP, AND;  DDEL);                               03332000
                  IF = THEN                                             03334000
                     BEGIN                                              03336000
                     TOS := ACCESSX;                                    03338000
                     ASM (TRBC 10, X);                                  03340000
                     ACCCHECK := TOS;                                   03342000
                     END;                                               03344000
                  TOS := TOS & DLSR(6);                                 03346000
                  XREG := XREG -1;                                      03348000
                  END                                                   03350000
               UNTIL <;                                                 03352000
               END;                                                     03354000
            END;                                                        03356000
         END;                                                           03358000
      END;                                                     << ... >>03360000
   END    <<ACCESS>>;                                                   03362000
                                                                        03364000
                                                                        03366000
                                                                        03368000
                                                                        03370000
PROCEDURE DIRRESET (NUMSECTS);                                          03372000
   VALUE NUMSECTS;                                             << ... >>03374000
   DOUBLE NUMSECTS;                                                     03376000
   OPTIONS;                                                             03378000
<< CALLED TO SUBTRACT <NUMSECTS> FROM FATHER (AND GRANDFATHER) WHEN     03380000
   ERROR DETECTED AFTER THEY ARE BUMPED.  ASSUMES B CONTAINS CURRENT    03382000
   INDEX (THUS POINTER TO FATHER)                                       03384000
   >>                                                                   03386000
   WHILE DBPINDEXP <> 0 DO                                              03388000
      BEGIN                                                             03390000
      MOVE DDSNAME := DBPNAME, (NAMESIZE);                              03392000
      TOS := DIRFIND (DBPINDEXP);                                       03394000
      IF DAMISCWD.(LEVELF) = GROUPLEVEL THEN TOS := TOS +GDFSCOUNT      03396000
      ELSE TOS := TOS +ADFSCOUNT;                                       03398000
      DPS0 := DPS0 -NUMSECTS;                                           03400000
      DIRWRITE (A);                                            << ... >>03402000
      END;                                                              03404000
                                                                        03406000
                                                                        03408000
                                                                        03410000
                                                                        03412000
                                                                        03414000
DOUBLE PROCEDURE DIRSTARTOFF (PARR, NUMSECTS, RECIP, PARMS,    <<01.PV>>03416000
                              MVTABX);                         <<01.PV>>03418000
   VALUE NUMSECTS, PARMS, MVTABX;                              <<01.PV>>03420000
   ARRAY PARR;                         <<DB ADDR OF SPEC PART>>         03422000
   DOUBLE NUMSECTS;                    <<TO ADJUST ACCT/GROUP>>         03424000
   INTEGER PROCEDURE RECIP;            <<FOR VISIT OF @ HIT>>           03426000
   INTEGER PARMS;                      <<FOR VISIT OF @ HIT>>           03428000
   INTEGER MVTABX;                                             <<01.PV>>03430000
   OPTION VARIABLE, PRIVILEGED, INTERNAL, UNCALLABLE;                   03432000
<<                                                                      03434000
   ANALYZES THE SPECIFICATION PART FOR DIRECTORY ROUTINES, AND          03436000
   GOES DOWN TREE UNTIL JUST BEFORE HIT OF TARGET, LEAVING:             03438000
      ADJUST, XTYPE, LINKAGE'XINDEXP, XANAME, XGUNAME,           43.PV  03440000
      XFNAME, XASEC AND XGSEC;                                   43.PV  03442000
      DB THRU DB+3 TO FINAL NAME.                                       03444000
   IF <NUMSECTS> SPECIFIED, THEN IT'S ADDED TO ACCT AND GROUP.          03446000
   IF <RECIP> AND <PARMS> SPECIFIED, THEN @ ENTRY HIT IS VISITED.       03448000
      CARRY SET ON RETURN => RECIP SAID STOP OR DON'T SCAN MY TREE.     03450000
   IF JUST <PARMS> SPECIFIED, THEN S ACCESS TO GROUP CHECKED.           03452000
   TYPE RETURN IS DIRECTORY ERROR PAIR.                                 03454000
   >>                                                                   03456000
BEGIN                                                                   03458000
   LOGICAL PMASK = Q-4;                                                 03460000
   INTEGER IPMASK = PMASK;                                              03462000
   SWITCH STARTSWITCH := NOINDEX, AINDEX, GINDEX, NOINDEX;              03464000
   DEFINE                                                      <<01.PV>>03466000
       MVTABX'M       = (15:1) #,                              <<01.PV>>03468000
       PARMS'M        = (14:1) #,                              <<01.PV>>03470000
       RECIP'M        = (13:1) #,                              <<01.PV>>03472000
       NUMSECTS'M     = (12:1) #,                              <<01.PV>>03474000
       PARR'M         = (11:1) #,                              <<01.PV>>03476000
       MVTABX'P       = PMASK.MVTABX'M #,                      <<01.PV>>03478000
       PARMS'P        = PMASK.PARMS'M #,                       <<01.PV>>03480000
       RECIP'P        = PMASK.RECIP'M #,                       <<01.PV>>03482000
       NUMSECTS'P     = PMASK.NUMSECTS'M #,                    <<01.PV>>03484000
       PARR'P         = PMASK.PARR'M #;                        <<03.PV>>03486000
   DEFINE                                                               03488000
      MOVLB1 =                                                          03490000
         TOS := 0;                                                      03492000
         TOS := #,                                                      03494000
      MOVLB2 =                                                          03496000
                +ADJUST;                                                03498000
         TOS := NAMESIZE;                                               03500000
         ASSEMBLE (MVLB) #;                                             03502000
                                                                        03504000
                                                                        03506000
SUBROUTINE VISIT (NEEDSIR);                                    <<58.PV>>03508000
   << S-0 = POINTER TO ENTRY >>                                <<58.PV>>03510000
   VALUE NEEDSIR;                                              <<58.PV>>03512000
   LOGICAL NEEDSIR;                                            <<58.PV>>03514000
   IF RECIP'P AND PARMS'P THEN                                 <<09.PV>>03516000
      BEGIN                                                             03518000
      TOS := IF NEEDSIR THEN GETSIR (DIRSIR) ELSE SIRRETURN;   <<58.PV>>03520000
      TOS := DIRSIR;                                           <<58.PV>>03522000
      TOS := SIRRETURN; <<SAVE IT>>                            <<58.PV>>03524000
      ASMB (CAB, CAB; XCH);                                    <<58.PV>>03526000
      TOS := 0;                                                         03528000
      TOS := @PS6;                                             <<58.PV>>03530000
      TOS := DAMISCWD.(LEVELF);                                         03532000
      TOS := PARMS;                                                     03534000
      TOS := DS5;                                                       03536000
      TOS := RECIP (*, *, *, *);  <<VISIT>>                             03538000
      IF LS5 THEN <<NEEDSIR: EXTRA GETSIR INVOKED>>            <<58.PV>>03540000
       IF LS0 THEN                                             <<58.PV>>03542000
       BEGIN <<EXTRA WAS NOT RELEASED>>                        <<58.PV>>03544000
           TOS := DS2;                                         <<58.PV>>03546000
           RELSIR (*, *);                                      <<58.PV>>03548000
       END ELSE                                                <<58.PV>>03550000
      ELSE <<EXTRA GETSIR NOT INVOKED>>                        <<58.PV>>03552000
       IF NOT LS0 THEN                                         <<62.PV>>03554000
       BEGIN                                                   <<62.PV>>03556000
           GETSIR (DIRSIR);                                    <<62.PV>>03558000
           S0.(0:1) := TRUE; <<FORCE REDO>>                    <<62.PV>>03560000
       END;                                                    <<62.PV>>03562000
      SIRRETURN := S3;                                         <<60.PV>>03564000
      IF S0 < 0 THEN                                           <<56.PV>>03566000
      BEGIN  <<CAUSE STARTOFF TO BE REDONE>>                   <<56.PV>>03568000
          TOS := 0;                                            <<56.PV>>03570000
          GO TO EXIT;                                          <<56.PV>>03572000
      END;                                                     <<56.PV>>03574000
      IF TOS &LSR(1) > 0 THEN    <<STOP OR GOTO BROTHER>>               03576000
         BEGIN        <<SO STOP ENTIRE SCAN>>                           03578000
         CARRYX := 1;                                                   03580000
         GOTO OKAYEXIT;                                                 03582000
         END;                                                           03584000
      ASSEMBLE (DDEL, DEL);                                    <<57.PV>>03586000
      END;                                                              03588000
                                                                        03590000
                                                                        03592000
SUBROUTINE BADEXIT (NUM);                                               03594000
   VALUE NUM;                                                           03596000
   INTEGER NUM;                                                         03598000
BEGIN                                                                   03600000
   TOS := DBELEVEL;                                                     03602000
   TOS := S2;                                                           03604000
   IF NUMSECTS'P THEN DIRRESET (NUMSECTS);                     <<01.PV>>03606000
   GOTO EXIT;                                                           03608000
   END    <<SUBROUTINE BADEXIT>>;                                       03610000
                                                                        03612000
                                                                        03614000
<< >>                                                                   03616000
   PUSH (DL);                                                           03618000
$IF X0=ON                                                      <<DEBUG>>03620000
   ASMB (RSW;DEL); IF < THEN DEBUG;                            <<DEBUG>>03622000
$IF                                                            <<DEBUG>>03624000
   IF EXCHANGEDB(DDSDST) <> 0 THEN SYSABORT(DIRBADDST);        <<DE>>   03626000
   SIRRETURN := GETSIR (DIRSIR);                               <<56.PV>>03628000
   IF DADIRTY OR DBDIRTY THEN SYSABORT (DIRABERR);             <<DE>>   03630000
   ADJUST := -TOS;                                                      03632000
   XASEC := -1;                                                         03634000
   XGSEC := -1D;                                                        03636000
   IF RECIP'P AND PARMS'P THEN PARMS := PARMS - DELTAQ;        <<01.PV>>03638000
   CARRYX := 0;                                                         03640000
   TOS := @WORKAREA+1;                                                  03642000
   TOS := @PARR+ADJUST;                                                 03644000
   TOS := 6;                                                   <<38.PV>>03646000
   ASSEMBLE (MVLB);                                                     03648000
   IF MVTABX'P THEN XMVTABX:= MVTABX ELSE MVTABX:= XMVTABX;    <<38.PV>>03650000
   IF MVTABX = 0 THEN                                          <<38.PV>>03652000
   BEGIN  <<DEFAULT TO SYSVS DIRECTORY BASE>>                  <<38.PV>>03654000
       SYSVSDIRBASE;                                           <<38.PV>>03656000
       DIRBASE := TOS;                                         <<38.PV>>03658000
       SYSACCTINDEX := SYSACCTINX'SAV;                         <<DE>>   03660000
   END ELSE                                                    <<38.PV>>03662000
   BEGIN  <<SWITCH TO APPROPRIATE DIRECTORY BASE>>             <<38.PV>>03664000
       TOS := DDSDST;                 <<E: TARGET>>            <<38.PV>>03666000
       TOS := @DIRBASE;               <<D: TARGET OFFSET>>     <<38.PV>>03668000
       TOS := MVTABDST;               <<C: SOURCE>>            <<38.PV>>03670000
       TOS := (MVTABX*MVTABSZ)+2;     <<B: SOURCE OFFSET>>     <<38.PV>>03672000
       TOS := 2;                      <<A: COUNT>>             <<38.PV>>03674000
       ASSEMBLE (MDS);                                         <<38.PV>>03676000
       TOS := DDSDST;                                          <<DE>>   03678000
       TOS := @SYSACCTINDEX;                                   <<DE>>   03680000
       TOS := MVTABDST;                                        <<DE>>   03682000
       TOS := (MVTABX*MVTABSZ)+6;                              <<DE>>   03684000
       TOS := 1;                                               <<DE>>   03686000
       ASSEMBLE (MDS);                                         <<DE>>   03688000
       SYSACCTINDEX := SYSACCTINDEX & LSR(8);                  <<DE>>   03690000
   END;                                                        <<38.PV>>03692000
   GOTO STARTSWITCH (XTYPE.(STARTLEVELF));                              03694000
NOINDEX:                                                                03696000
   XINDEXP := SYSACCTINDEX;                                             03698000
   IF XTYPE.(ENDLEVELFX) = ALLACCTS THEN GOTO OKAYEXIT;                 03700000
   MOVLB1 XANAME MOVLB2;                                                03702000
   IF XTYPE.(ENDLEVELF) = ACCOUNTLEVEL THEN GOTO OKAYEXIT;              03704000
   TOS := DIRFIND (SYSACCTINDEX); <<GET PTR TO ACCT ENTRY>>    <<47.PV>>03706000
   ASSEMBLE (DTST, DELB);                                               03708000
                                                                        03710000
   IF = THEN GOTO NONEXIST;                                             03712000
   XASEC := PS0 (ASECW);                                                03714000
   IF NOT RECIP'P AND PARMS'P THEN                             <<01.PV>>03716000
      BEGIN    <<CHECK FOR SAVE ACCESS>>                                03718000
      TOS := 0;                                                         03720000
      TOS := ACCOUNTLEVEL;                                              03722000
      TOS := XANAME &LSL(1);                                            03724000
      TOS := XASEC;                                                     03726000
      EXCHANGEDB (0);                                                   03728000
      TOS := ACCCHECK (*, *, *);                                        03730000
      EXCHANGEDB (DDSDST);                                              03732000
      IF NOT (TOS) THEN GOTO NOSAVE;                                    03734000
      END;                                                              03736000
   IF NUMSECTS'P THEN                                          <<01.PV>>03738000
      BEGIN    <<BUMP SECTOR COUNT>>                                    03740000
      TOS := TOS +ADFSCOUNT;                                            03742000
      IF (TOS := DPS0 +NUMSECTS) > DPS0(1) THEN GOTO NOROOM;            03744000
      DPS2 := TOS;                                                      03746000
      DIRWRITE (A);                                                     03748000
      TOS := TOS -ADFSCOUNT;                                            03750000
      END;                                                              03752000
   VISIT (TRUE); <<ACCOUNT ENTRY>>                             <<58.PV>>03754000
   CASE *XTYPE.(ENDLEVELF) OF                                  <<16.PV>>03756000
   BEGIN                                                       <<07.PV>>03758000
       XREG := AGIPNTR;    <<0 : FILE>>                        <<07.PV>>03760000
       XREG := AGIPNTR;    <<1 : GROUP>>                       <<07.PV>>03762000
       GO TO OKAYEXIT;     <<2 : ACCT - NEVER GET HERE>>       <<47.PV>>03764000
       XREG := AUIPNTR;    <<3 : USER>>                        <<07.PV>>03766000
       XREG := AGIPNTR;    <<4 : VSD>>                         <<07.PV>>03768000
   END;                                                        <<07.PV>>03770000
   XINDEXP := S0PNTR (XREG);                                            03772000
   DEL; <<PTR TO ACCT ENTRY>>                                  <<47.PV>>03774000
AINDEX:                                                                 03776000
   MOVLB1 XGUNAME MOVLB2;                                               03778000
   CASE *XTYPE.(ENDLEVELF) OF                                  <<16.PV>>03780000
   BEGIN                                                       <<08.PV>>03782000
       ; <<KEEP GOING>>    <<0 : FILE>>                        <<08.PV>>03784000
       GO TO OKAYEXIT;     <<1 : GROUP>>                       <<08.PV>>03786000
       GO TO OKAYEXIT;     <<2 : ACCT - NEVER GET HERE>>       <<47.PV>>03788000
       GO TO OKAYEXIT;     <<3 : USER - NEVER GET HERE>>       <<08.PV>>03790000
       ; <<KEEP GOING>>    <<4>>                               <<08.PV>>03792000
   END;                                                        <<08.PV>>03794000
   TOS := DIRFIND (XINDEXP); <<GET PTR TO GROUP ENTRY>>        <<47.PV>>03796000
   ASSEMBLE (DTST, DELB);                                               03798000
                                                                        03800000
   IF = THEN                                                            03802000
NONEXIST:    BADEXIT (2);                                               03804000
   TOS := PS0(GSEC);                                                    03806000
   TOS := PS1(GSEC+1);                                                  03808000
   XGSEC := TOS;                                                        03810000
   IF NOT RECIP'P AND PARMS'P THEN                             <<01.PV>>03812000
      BEGIN    <<CHECK SAVE ACCESS TO GROUP>>                           03814000
      TOS := 0;                                                         03816000
      TOS := GROUPLEVEL;                                                03818000
      TOS := XANAME &LSL(1);                                            03820000
      TOS := XASEC;                                                     03822000
      TOS := XGUNAME &LSL(1);                                           03824000
      TOS := XGSEC;                                                     03826000
      EXCHANGEDB (0);                                                   03828000
      TOS := ACCCHECK (*, *, *, *, *);                                  03830000
      EXCHANGEDB (DDSDST);                                              03832000
      IF NOT (TOS) THEN                                                 03834000
NOSAVE:    BADEXIT (3);                                                 03836000
      END;                                                              03838000
   IF NUMSECTS'P THEN                                          <<01.PV>>03840000
      BEGIN    <<ADJUST BY NUMSECTS>>                                   03842000
      TOS := TOS +GDFSCOUNT;                                            03844000
      IF (TOS := DPS0 +NUMSECTS) > DPS0(1) THEN                         03846000
NOROOM:    BADEXIT (8);                                                 03848000
      DPS2 := TOS;                                                      03850000
      DIRWRITE (A);                                                     03852000
      TOS := TOS -GDFSCOUNT;                                            03854000
      END;                                                              03856000
   VISIT (FALSE); <<GROUP ENTRY>>                              <<58.PV>>03858000
   CASE *XTYPE.(ENDLEVELF) OF                                  <<16.PV>>03860000
   BEGIN                                                       <<07.PV>>03862000
       XREG := GFIPNTR;    <<0 : FILE>>                        <<07.PV>>03864000
       GO TO OKAYEXIT;     <<1 : GROUP>>                       <<47.PV>>03866000
       GO TO OKAYEXIT;     <<2 : ACCT - NEVER GET HERE>>       <<47.PV>>03868000
       GO TO OKAYEXIT;     <<3 : USER - NEVER GET HERE>>       <<47.PV>>03870000
       XREG := GVSDIPNTR;  <<4 : VSD>>                         <<07.PV>>03872000
   END;                                                        <<07.PV>>03874000
   XINDEXP := S0PNTR (XREG);                                   <<07.PV>>03876000
   DEL; <<PTR TO GROUP ENTRY>>                                 <<47.PV>>03878000
GINDEX:                                                                 03880000
   IF NOT LOGICAL (XTYPE.(ALLFLAG)) THEN                       <<07.PV>>03882000
      BEGIN                                                             03884000
      MOVLB1 XFNAME MOVLB2;                                             03886000
      END;                                                              03888000
OKAYEXIT:                                                               03890000
   TOS := 0D;                                                           03892000
EXIT:                                                                   03894000
   DIRSTARTOFF := TOS;                                                  03896000
   END    <<SIMPLESTARTOFF>>;                                           03898000
                                                                        03900000
                                                                        03902000
                                                                        03904000
                                                                        03906000
DOUBLE PROCEDURE DIRECINSERT (TYPE, LINKAGE'INDEXP, ANAME,     <<38.PV>>03908000
                              GUNAME, FNAME, INSERT, MVTABX);  <<38.PV>>03910000
    VALUE   TYPE, LINKAGE'INDEXP, MVTABX;                      <<38.PV>>03912000
    LOGICAL TYPE, MVTABX;                                      <<38.PV>>03914000
    DOUBLE  LINKAGE'INDEXP;                                    <<38.PV>>03916000
    ARRAY   ANAME, GUNAME, FNAME, INSERT;                               03918000
    OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                            03920000
<< <INSERT> POINTS TO WORD AFTER <NAME> IN THEN ENTRY  (I.E. TO         03922000
   AN INDEXPOINTER OR FILE POINTER CELL).                               03924000
   ALLOCATES AND INITIALIZES APPROPRIATE INDICES FOR ACCOUNT AND GROUP  03926000
   ENTRIES  (THE CORRESPONDING INDEX CELLS OF <INSERT> ARE IGNORED).  >>03928000
    BEGIN                                                               03930000
        ARRAY PARR (*) = TYPE;                                          03932000
        LOGICAL                                                         03934000
            PMASK = Q-4;                                                03936000
            DEFINE                                                      03938000
                MVTABX'M = (15:1) #,                                    03940000
                MVTABX'P = PMASK.MVTABX'M #;                            03942000
            DOUBLE                                                      03944000
                JUNKD;                                                  03946000
            INTEGER                                                     03948000
                JUNK1 = JUNKD,                                          03950000
                JUNK0 = JUNK1+1;                                        03952000
<<>>                                                                    03954000
        DOUBLE SUBROUTINE NEWTREE (LEVEL, IBSIZE, EBSIZE,               03956000
                                   ESIZE, XIPNTR, SD);                  03958000
            VALUE   LEVEL, IBSIZE, EBSIZE, ESIZE, XIPNTR, SD;           03960000
            INTEGER LEVEL, IBSIZE, EBSIZE, ESIZE, XIPNTR, SD;           03962000
            BEGIN                                                       03964000
                DBPINDEXP := XINDEXP;                                   03966000
                MOVE DBPNAME := DDSENTRY ,(NAMESIZE);                   03968000
                TOS := DIRNEWINDEX (IBSIZE,                             03970000
                    LEVEL, EBSIZE, ESIZE);                              03972000
                IF <> THEN                                              03974000
                   IF >  THEN SYSABORT (SD) ELSE               <<DE>>   03976000
                   BEGIN                                       <<DE>>   03978000
                     DEL;                                               03980000
                     CC := CCG;                                         03982000
                     JUNK1 := IBSIZE;                                   03984000
                     JUNK0 := 6;                                        03986000
                     NEWTREE := JUNKD;                                  03988000
                   END                                         <<DE>>   03990000
                ELSE                                                    03992000
                BEGIN                                                   03994000
                    EXCHANGEDB (0);                                     03996000
                    INSERT (S3<<XIPNTR>>-NAMESIZE) := TOS;              03998000
                    EXCHANGEDB (DDSDST);                                04000000
                END;                                                    04002000
            END;<<OF NEWTREE>>                                          04004000
                                                                        04006000
                                                                        04008000
        SUBROUTINE RETURNTREE (XIPNTR, IBSIZE);                         04010000
            VALUE   XIPNTR, IBSIZE;                                     04012000
            INTEGER XIPNTR, IBSIZE;                                     04014000
            BEGIN                                                       04016000
                EXCHANGEDB (0);                                         04018000
                TOS := INSERT (XIPNTR-NAMESIZE);                        04020000
                EXCHANGEDB (DDSDST);                                    04022000
                DIRDEALLOCATE (*, S2<<IBSIZE>>);                        04024000
            END;<<OF RETURNTREE>>                                       04026000
                                                                        04028000
                                                                        04030000
        DOUBLE SUBROUTINE INSERTENTRY (LEVEL);                          04032000
            VALUE   LEVEL;                                              04034000
            INTEGER LEVEL;                                              04036000
            BEGIN                                                       04038000
                TOS := NAMESIZE;                                        04040000
                TOS := @INSERT+ADJUST;                                  04042000
                CASE *S3 <<LEVEL>> OF                          <<16.PV>>04044000
                BEGIN                                                   04046000
                    TOS := FSIZE;                                       04048000
                    TOS := GSIZE;                                       04050000
                    TOS := ASIZE;                                       04052000
                    TOS := USIZE;                                       04054000
                    TOS := GVSDSIZE;                                    04056000
                END;                                                    04058000
                TOS := TOS - NAMESIZE;                                  04060000
                ASMB (MVLB);                                            04062000
                IF (INSERTENTRY := DIRINSERT (XINDEXP)) <> 0D THEN      04064000
                BEGIN  <<NEED TO RETURN DIR SPACE>>                     04066000
                    CASE *LEVEL OF                             <<16.PV>>04068000
                    BEGIN                                               04070000
                        ;      <<0: FILE>>                              04072000
                        BEGIN  <<1: GROUP>>                             04074000
                            RETURNTREE (GFIPNTR, SYSGFIBSIZE);          04076000
                            RETURNTREE (GVSDIPNTR, SYSGVSIBSIZE);       04078000
                        END;<<OF GROUP>>                                04080000
                        BEGIN  <<2: ACCT>>                              04082000
                            RETURNTREE (AGIPNTR, SYSAGIBSIZE);          04084000
                            RETURNTREE (AUIPNTR, SYSAUIBSIZE);          04086000
                        END;<<OF ACCT>>                                 04088000
                        ;       <<3: USER>>                             04090000
                        ;       <<4: VSD>>                              04092000
                    END;<<OF LEVEL>>                                    04094000
                    CC := CCG;  <<FAILURE>>                             04096000
                END;                                                    04098000
            END;<<OF INSERTENTRY>>                                      04100000
                                                                        04102000
                                                                        04104000
        CC := CCE;  <<OK UNTIL ANY FAILURE>>                            04106000
        IF MVTABX'P THEN                                                04108000
             TOS := DIRSTARTOFF (PARR,,,,MVTABX)                        04110000
        ELSE TOS := DIRSTARTOFF (PARR);                                 04112000
        ASMB (DTST);                                                    04114000
        IF = THEN                                                       04116000
        BEGIN <<FOUND REQUIRED LEVEL>>                                  04118000
            DDEL;                                                       04120000
            CASE *TYPE.(ENDLEVELF) OF                          <<16.PV>>04122000
            BEGIN                                                       04124000
                TOS := INSERTENTRY (FILELEVEL);                         04126000
                BEGIN  <<GROUP>>                                        04128000
                    TOS := NEWTREE (FILELEVEL, SYSGFIBSIZE,             04130000
                                    SYSFEBSIZE, FSIZE,                  04132000
                                    GFIPNTR, DIRINERR);        <<DE>>   04134000
                    ASMB (DTST);                                        04136000
                    IF = THEN  <<SUCCESSFULL?>>                         04138000
                    BEGIN                                               04140000
                        DDEL;                                           04142000
                        TOS := NEWTREE (VSDEFLEVEL,                     04144000
                             SYSGVSIBSIZE,SYSVSEBSIZE,                  04146000
                             GVSDSIZE, GVSDIPNTR, DIRVSDERR);  <<DE>>   04148000
                        ASMB (DTST);                                    04150000
                        IF <> THEN                                      04152000
                         RETURNTREE (GFIPNTR, SYSGFIBSIZE)              04154000
                        ELSE                                            04156000
                        BEGIN                                           04158000
                            DDEL;                                       04160000
                            TOS := INSERTENTRY (GROUPLEVEL);            04162000
                        END;                                            04164000
                    END;                                                04166000
                END;<<OF GROUP>>                                        04168000
                BEGIN  <<ACCT>>                                         04170000
                    TOS := NEWTREE (GROUPLEVEL, SYSAGIBSIZE,            04172000
                           SYSGEBSIZE,GSIZE,AGIPNTR,DIRINERR); <<DE>>   04174000
                    ASMB (DTST);                                        04176000
                    IF = THEN <<SUCCESSFULL?>>                          04178000
                    BEGIN                                               04180000
                        DDEL;                                           04182000
                        TOS := NEWTREE (USERLEVEL, SYSAUIBSIZE,         04184000
                                        SYSUEBSIZE, USIZE,              04186000
                                        AUIPNTR, DIRINERR);    <<DE>>   04188000
                        ASMB (DTST);                                    04190000
                        IF <> THEN RETURNTREE (AGIPNTR, SYSAGIBSIZE)    04192000
                        ELSE                                            04194000
                        BEGIN <<SUCCESSFULL>>                           04196000
                            DDEL;                                       04198000
                            TOS := INSERTENTRY (ACCOUNTLEVEL);          04200000
                        END;                                            04202000
                    END;                                                04204000
                END;<<OF ACCT>>                                         04206000
                TOS := INSERTENTRY (USERLEVEL);                         04208000
                TOS := INSERTENTRY (VSDEFLEVEL);                        04210000
            END;<<OF ENDLEVEL>>                                         04212000
        END ELSE CC := CCG;                                             04214000
        DIRECINSERT := TOS;                                             04216000
        RELSIR (DIRSIR,SIRRETURN);                                      04218000
        EXCHANGEDB (0);                                                 04220000
    END;<<OF DIRECINSERT>>                                              04222000
                                                                        04224000
                                                                        04226000
                                                                        04228000
                                                                        04230000
                                                                        04232000
DOUBLE PROCEDURE DIRECINSERTFILE (NUMSECTS, DUMMY, ANAME,      <<38.PV>>04234000
                          GNAME, FNAME, FADDR, MVTABX);        <<38.PV>>04236000
   VALUE NUMSECTS, DUMMY, FADDR, MVTABX;                       <<38.PV>>04238000
   DOUBLE NUMSECTS, FADDR;                                              04240000
   INTEGER DUMMY, MVTABX;                                      <<38.PV>>04242000
   ARRAY ANAME, GNAME, FNAME;                                           04244000
   OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                    <<18.PV>>04246000
<<                                                                      04248000
   INSERTS FILE ENTRY UNDER ACCT AND GROUP.                             04250000
   INCREMENTS ACCT AND GROUP SPACE COUNTS BY <NUMSECTS>.                04252000
   CHECKS THAT USER HAS SAVE ACCESS TO GROUP.                           04254000
   (ALWAYS GLOBAL ACCESS).                                              04256000
   >>                                                                   04258000
BEGIN                                                                   04260000
   ENTRY DIRECRESETFILE;  <<NO SECURITY CHECK>>                <<00091>>04262000
   ARRAY PARR (*) = NUMSECTS;                                           04264000
   ARRAY FILENTRY (0:5);                                       <<18.PV>>04266000
   DOUBLE ARRAY DFILENTRY (*) = FILENTRY;                      <<18.PV>>04268000
   DOUBLE LNUMSECTS;                                                    04270000
   DOUBLE DDB4 = DB+4;                                                  04272000
   LOGICAL                                                     <<18.PV>>04274000
       PMASK = Q-4;                                            <<18.PV>>04276000
   DEFINE                                                      <<18.PV>>04278000
       MVTABX'M = (15:1) #,                                    <<18.PV>>04280000
       MVTABX'P = PMASK.MVTABX'M #;                            <<18.PV>>04282000
   INTEGER                                                     <<18.PV>>04284000
       TYPE = NUMSECTS;                                        <<38.PV>>04286000
   DOUBLE                                                      <<38.PV>>04288000
       LINKAGE'INDEXP = TYPE+1;                                <<38.PV>>04290000
   LOGICAL CHECKSEC;                                           <<00091>>04292000
                                                               <<00091>>04294000
   IF NOT (CHECKSEC:=TRUE) THEN                                <<00091>>04296000
      BEGIN                                                    <<00091>>04298000
DIRECRESETFILE:                                                <<00091>>04300000
      CHECKSEC:=FALSE;                                         <<00091>>04302000
      END;                                                     <<00091>>04304000
<< >>                                                                   04306000
   LNUMSECTS := NUMSECTS;                                               04308000
   NUMSECTS := DOUBLE (DUMMY := 0);                            <<43.PV>>04310000
   IF CHECKSEC THEN <<DO SECURITY CHECK>>                      <<00091>>04312000
      BEGIN                                                    <<00091>>04314000
      TOS:=IF NOT MVTABX'P THEN DIRSTARTOFF(PARR,LNUMSECTS,,0) <<00091>>04316000
           ELSE DIRSTARTOFF(PARR,LNUMSECTS,,0,MVTABX);         <<00091>>04318000
      END                                                      <<00091>>04320000
   ELSE <<NO SECURITY CHECK>>                                  <<00091>>04322000
      BEGIN                                                    <<00091>>04324000
      TOS:=IF NOT MVTABX'P THEN DIRSTARTOFF(PARR,LNUMSECTS)    <<00091>>04326000
           ELSE DIRSTARTOFF(PARR,LNUMSECTS,,,MVTABX);          <<00091>>04328000
      END;                                                     <<00091>>04330000
   ASSEMBLE (DTST);                                            <<43.PV>>04332000
   IF <> THEN GO TO BADEXIT;                                   <<43.PV>>04334000
   DDB4 := FADDR;                                                       04336000
   TOS := DIRINSERT (XINDEXP);                                          04338000
   ASSEMBLE (DTST);                                                     04340000
   IF <> THEN                                                           04342000
      BEGIN                                                             04344000
      DIRRESET (LNUMSECTS);                                             04346000
BADEXIT:                                                                04348000
      TOS := CCG;                                                       04350000
      END                                                               04352000
   ELSE                                                                 04354000
      TOS := CCE;                                                       04356000
   CC := TOS;                                                           04358000
   DIRECINSERTFILE := TOS;                                              04360000
   RELSIR (DIRSIR, SIRRETURN);                                          04362000
   EXCHANGEDB (0);                                             << ... >>04364000
   END    <<PROCEDURE DIRECINSERTFILE>>;                                04366000
                                                                        04368000
                                                                        04370000
                                                                        04372000
                                                                        04374000
DOUBLE PROCEDURE DIRECFIND (TYPE, LINKAGE'INDEXP, ANAME,GUNAME,<<38.PV>>04376000
                            FNAME, PRETURN);                   <<38.PV>>04378000
   VALUE TYPE, LINKAGE'INDEXP;                                 <<38.PV>>04380000
   INTEGER TYPE;                                               <<38.PV>>04382000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>04384000
   ARRAY ANAME, GUNAME, FNAME, PRETURN;                                 04386000
   OPTION PRIVILEGED, UNCALLABLE;                                       04388000
<< <PRETURN> WILL CONTAIN FULL FINAL ENTRY .  >>                        04390000
BEGIN                                                                   04392000
   LOGICAL LTYPE = TYPE;                                                04394000
                                                                        04396000
   ARRAY PARR (*) = TYPE;                                               04398000
   IF (TOS := DIRSTARTOFF (PARR)) <> 0D THEN GOTO BADEXIT;              04400000
   ASSEMBLE (DDEL);                                                     04402000
   TOS := @PRETURN+ADJUST;                                              04404000
   TOS := DIRFIND (XINDEXP);                                            04406000
   ASSEMBLE (DTST, DELB);                                               04408000
   IF = THEN                                                            04410000
      BEGIN                                                             04412000
      DDEL;                                                             04414000
      TOS := LTYPE.(ENDLEVELF);                                         04416000
      TOS := 2;                                                         04418000
BADEXIT:                                                                04420000
      TOS := CCG;                                                       04422000
      GOTO EXIT;                                                        04424000
      END;                                                              04426000
   CASE *TYPE.(ENDLEVELF) OF                                   <<16.PV>>04428000
      BEGIN                                                             04430000
      TOS := FSIZE;                                                     04432000
      TOS := GSIZE;                                                     04434000
      TOS := ASIZE;                                                     04436000
      TOS := USIZE;                                                     04438000
      TOS := GVSDSIZE;                                         <<05.PV>>04440000
      END;                                                              04442000
   ASSEMBLE (MVBL);                                                     04444000
   TOS := 0D;                                                           04446000
   TOS := CCE;                                                          04448000
EXIT:                                                                   04450000
   CC := TOS;                                                           04452000
   DIRECFIND := TOS;                                                    04454000
   RELSIR (DIRSIR, SIRRETURN);                                          04456000
   EXCHANGEDB (0);                                                      04458000
   END    <<DIRECFIND>>;                                                04460000
                                                                        04462000
                                                                        04464000
                                                                        04466000
                                                                        04468000
                                                                        04470000
DOUBLE PROCEDURE DIRECFINDFILE (TYPE, LINKAGE'INDEXP, ANAME,   <<38.PV>>04472000
                                GNAME, FNAME, PRETURN, MVTABX);<<38.PV>>04474000
   VALUE   TYPE, LINKAGE'INDEXP, MVTABX;                       <<38.PV>>04476000
   LOGICAL TYPE, MVTABX;                                       <<38.PV>>04478000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>04480000
   ARRAY ANAME, GNAME, FNAME, PRETURN;                                  04482000
   OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                    <<38.PV>>04484000
<< RETURNS IN <PRETURN> THEN FILE POINTER; AND ASEC/GSEC                04486000
      DEPENDING ON THE TYPE OF SEARCH. >>                               04488000
BEGIN                                                                   04490000
   LOGICAL                                                     <<38.PV>>04492000
       PMASK = Q-4;                                            <<38.PV>>04494000
   DEFINE                                                      <<38.PV>>04496000
       MVTABX'M = (15:1) #,                                    <<38.PV>>04498000
       MVTABX'P = PMASK.MVTABX'M #;                            <<38.PV>>04500000
   ARRAY PARR (*) = TYPE;                                               04502000
   IF MVTABX'P THEN                                            <<42.PV>>04504000
    TOS := DIRSTARTOFF (PARR,,,,MVTABX)                        <<42.PV>>04506000
   ELSE                                                        <<42.PV>>04508000
    TOS := DIRSTARTOFF (PARR);                                 <<42.PV>>04510000
   ASSEMBLE (DTST);                                            <<42.PV>>04512000
   IF <> THEN GO TO BADEXIT;                                   <<42.PV>>04514000
   << 2 ZEROES ON STACK >>                                              04516000
   TOS := DIRFIND (XINDEXP);                                            04518000
   ASSEMBLE (DTST, DELB);                                               04520000
   IF = THEN                                                            04522000
      BEGIN                                                             04524000
      << 3 ZEROS ON STACK >>                                   <<28.PV>>04526000
      DEL; <<ONE OF THEM. ONLY NEED 2>>                        <<28.PV>>04528000
      TOS := TOS +2;  <<NOT FOUND : FILE>>                     <<28.PV>>04530000
BADEXIT:                                                                04532000
      RELSIR (DIRSIR, SIRRETURN);                                       04534000
      EXCHANGEDB (0);                                                   04536000
      TOS := CCG;                                                       04538000
      GOTO EXIT;                                                        04540000
      END;                                                              04542000
   TOS := DPS0(2);                                                      04544000
   TOS := XGSEC;                                                        04546000
   TOS := XASEC;                                                        04548000
   CARRYX := IF DABADELM THEN 1 ELSE 0;                                 04550000
   RELSIR (DIRSIR, SIRRETURN);                                          04552000
   EXCHANGEDB (0);                                                      04554000
   TOS := @PRETURN;                                                     04556000
   TOS := @S5;                                                          04558000
   IF INTEGER (TYPE.(STARTLEVELF)) = 1 THEN TOS := 4                    04560000
   ELSE IF < THEN TOS := 5                                              04562000
      ELSE TOS := 2;                                                    04564000
   ASSEMBLE (MOVE);                                                     04566000
   ASSEMBLE (SUBS 6);                                                   04568000
   TOS := CCE;                                                          04570000
EXIT:                                                                   04572000
   CC := TOS;                                                           04574000
   DIRECFINDFILE := TOS;                                       << ... >>04576000
   END    <<PROCEDURE DIRECFINDFILE>>;                                  04578000
DOUBLE PROCEDURE DIRECSETFLAG (TYPE,LINKAGE'INDEXP,ANAME,      <<38.PV>>04580000
                               GNAME,FNAME,MVTABX);            <<32.PV>>04582000
    VALUE   TYPE,LINKAGE'INDEXP,MVTABX;                        <<38.PV>>04584000
    LOGICAL TYPE, MVTABX;                                      <<38.PV>>04586000
    DOUBLE  LINKAGE'INDEXP;                                    <<38.PV>>04588000
    ARRAY   ANAME,GNAME,FNAME;                                 <<32.PV>>04590000
    OPTION  PRIVILEGED,UNCALLABLE,VARIABLE;                    <<32.PV>>04592000
    COMMENT                                                             04594000
        RETURNS CONDITION CODE ONLY.                                    04596000
            CCE - FILE ENTRY FLAGGED                                    04598000
            CCL - FILE NOT FOUNG                                        04600000
            CCG - FILE ENTRY ALREADY FLAGGED;                           04602000
    BEGIN                                                               04604000
        ENTRY DIRECRESETFLAG;                                           04606000
        LOGICAL                                                <<32.PV>>04608000
            SETFLAG := TRUE,                                   <<32.PV>>04610000
            PMASK = Q-4;                                       <<32.PV>>04612000
        ARRAY PARR (*) = TYPE;                                          04614000
       DEFINE                                                  <<32.PV>>04616000
           MVTABX'M = (15:1) #,                                <<32.PV>>04618000
           MVTABX'P = PMASK.MVTABX'M #;                        <<32.PV>>04620000
        IF FALSE THEN                                                   04622000
DIRECRESETFLAG:                                                         04624000
         SETFLAG := FALSE;                                              04626000
        IF MVTABX'P THEN                                       <<42.PV>>04628000
         TOS := DIRSTARTOFF (PARR,,,,MVTABX)                   <<42.PV>>04630000
        ELSE                                                   <<42.PV>>04632000
         TOS := DIRSTARTOFF (PARR);                            <<42.PV>>04634000
        ASSEMBLE (DTST);                                       <<42.PV>>04636000
        IF <> THEN GO TO NFOUND;                               <<42.PV>>04638000
        TOS := DIRFIND (XINDEXP);                                       04640000
        ASSEMBLE (DTST,DELB);                                           04642000
        IF = THEN                                                       04644000
        BEGIN                                                           04646000
            DEL;  DDEL;                                        <<43.PV>>04648000
            TOS := [16/0, 16/2] D;                             <<32.PV>>04650000
NFOUND:                                                                 04652000
            TOS := CCG;                                                 04654000
            GO EXIT;                                                    04656000
        END;                                                            04658000
        IF DABADELM AND SETFLAG THEN                           <<32.PV>>04660000
        BEGIN <<ALREADY SET>>                                  <<32.PV>>04662000
            DEL;                                               <<32.PV>>04664000
            TOS := CCL;                                        <<32.PV>>04666000
            GO EXIT;                                           <<32.PV>>04668000
        END;                                                   <<32.PV>>04670000
        S0PNTR (2) := IF SETFLAG THEN S0PNTR (2) LOR %100000            04672000
                          ELSE S0PNTR (2) LAND %77777;                  04674000
        DEL;                                                            04676000
        DIRWRITE (A); <<WRITE ENTRY BUFFER>>                            04678000
        TOS := CCE;                                                     04680000
EXIT:                                                                   04682000
        CC := TOS;                                                      04684000
        DIRECSETFLAG := TOS;                                   <<32.PV>>04686000
        RELSIR (DIRSIR,SIRRETURN);                                      04688000
        EXCHANGEDB (0);  <<BACK TO STACK>>                              04690000
        END;<<OF DIRECSETFLAG/DIRECRESETFLAG>>                          04692000
DOUBLE PROCEDURE DIRECBIND (TYPE, LINKAGE'INDEXP, ANAME,       <<38.PV>>04694000
                          GUNAME, GIPNTR, MVTABX);             <<41.PV>>04696000
    VALUE   TYPE, LINKAGE'INDEXP, MVTABX;                      <<38.PV>>04698000
    INTEGER TYPE, GIPNTR, MVTABX;                              <<41.PV>>04700000
    DOUBLE  LINKAGE'INDEXP;                                    <<38.PV>>04702000
    ARRAY   ANAME, GUNAME;                                     <<23.PV>>04704000
    OPTION  PRIVILEGED, UNCALLABLE, VARIABLE;                  <<23.PV>>04706000
    COMMENT                                                    <<23.PV>>04708000
        DB MUST BE AT STACK WHEN CALLED.                       <<23.PV>>04710000
        RETURNS: 0D IF MOUNT (LOGICAL) SUCCESSFULL.            <<23.PV>>04712000
                 FAILURE CAUSE VIA FUNCTION IF UNSUCCESSFULL.  <<23.PV>>04714000
                 CONDITION CODE :                              <<23.PV>>04716000
                     CCE - SUCCESSFULL                         <<23.PV>>04718000
                     CCG - SEARCH FAILURE                      <<23.PV>>04720000
                           FUNCTION (RESULT) CONTAINS ERROR    <<23.PV>>04722000
                           CODE (SEARCH FAILURE) AND ENTRY     <<23.PV>>04724000
                           TYPE NOT FOUND.                     <<23.PV>>04726000
                     CCL - NOT RETURNED                        <<23.PV>>04728000
    ;                                                          <<23.PV>>04730000
    BEGIN                                                      <<23.PV>>04732000
        DOUBLE                                                 <<23.PV>>04734000
            RESULT = DIRECBIND;                                <<23.PV>>04736000
        INTEGER                                                <<23.PV>>04738000
            DSIR,                                              <<50.PV>>04740000
            RS1 = RESULT,                                      <<23.PV>>04742000
            RS0 = RS1+1,                                       <<23.PV>>04744000
            REFCNTR,                                           <<51.PV>>04746000
            FIPNTR,                                            <<51.PV>>04748000
            TEMP;                                              <<23.PV>>04750000
       LOGICAL                                                 <<23.PV>>04752000
           PMASK = Q-4;                                        <<23.PV>>04754000
        DEFINE                                                 <<23.PV>>04756000
            MVTABX'M = (15:1) #,                               <<23.PV>>04758000
            MVTABX'P = PMASK.MVTABX'M #;                       <<23.PV>>04760000
        ARRAY                                                  <<23.PV>>04762000
            PARR (*) = TYPE;                                   <<23.PV>>04764000
                                                               <<23.PV>>04766000
        INTEGER SUBROUTINE GETENTRY (MVTABX');                 <<50.PV>>04768000
            VALUE   MVTABX';                                   <<50.PV>>04770000
            INTEGER MVTABX';                                   <<50.PV>>04772000
            BEGIN                                              <<23.PV>>04774000
                IF (RESULT :=                                  <<23.PV>>04776000
                   DIRSTARTOFF (PARR,,,,MVTABX')) <> 0D THEN   <<23.PV>>04778000
                 TOS := 0                                      <<50.PV>>04780000
                ELSE                                           <<23.PV>>04782000
                BEGIN <<FIND REQUIRED ENTRY AND/OR TREE>>      <<51.PV>>04784000
                    TOS := DIRFIND (XINDEXP);                  <<23.PV>>04786000
                    ASMB (DTST, DELB);                         <<23.PV>>04788000
                    IF = THEN RESULT := [16/1, 16/2] D;        <<50.PV>>04790000
                END;                                           <<23.PV>>04792000
                TEMP := TOS;                                   <<23.PV>>04794000
                GETENTRY := TEMP;                              <<23.PV>>04796000
            END;<<OF GETENTRY>>                                <<23.PV>>04798000
                                                               <<23.PV>>04800000
        SUBROUTINE LOCKTREE (REFCNTR');                        <<51.PV>>04802000
            VALUE   REFCNTR';                                  <<51.PV>>04804000
            INTEGER REFCNTR';                                  <<51.PV>>04806000
            BEGIN                                              <<51.PV>>04808000
                EXCHANGEDB (0);                                <<51.PV>>04810000
                TYPE := FILELEVEL & LSL (3);                   <<51.PV>>04812000
                GETENTRY (MVTABX);                             <<51.PV>>04814000
                DBPCOUNT := REFCNTR';                          <<51.PV>>04816000
                DIRWRITE (B);                                  <<51.PV>>04818000
            END;<<OF LOCKTREE>>                                <<51.PV>>04820000
                                                               <<51.PV>>04822000
        CC := CCG;                                             <<23.PV>>04824000
        TYPE := GROUPLEVEL & LSL (3);  <<FORCE IT>>            <<23.PV>>04826000
        IF (TOS := GETENTRY (MVTABX)) = 0 THEN                 <<50.PV>>04828000
        BEGIN  <<NOT FOUND IN PV DIRECTORY>>                   <<50.PV>>04830000
            DEL;                                               <<50.PV>>04832000
            RS1 := -RS1; <<INDICATE WHICH DIRECTORY>>          <<50.PV>>04834000
            <<CALLERS RESPONSIBILITY TO DISMOUNT>>             <<50.PV>>04836000
        END ELSE                                               <<50.PV>>04838000
        BEGIN  <<FOUND IN PV DIRECTORY>>                       <<50.PV>>04840000
            DSIR := SIRRETURN; <<MOST ACCURATE COPY FOR EXIT>> <<56.PV>>04842000
            TOS := PS0 (GFIPNTR);  <<DIR ADDR IN PV>>          <<50.PV>>04844000
            DELB;                <<ENTRY POINTER>>             <<50.PV>>04846000
            EXCHANGEDB (0);                                    <<50.PV>>04848000
            IF (TOS := GETENTRY (0)) <> 0 THEN                 <<50.PV>>04850000
            BEGIN  <<FOUND IN SYSTEM DIRECTORY>>               <<50.PV>>04852000
                IF PS0 (GLINKAGE).(MVTABXF) <> 0 THEN          <<50.PV>>04854000
                BEGIN <<ALREADY MOUNTED?>>                     <<50.PV>>04856000
                    IF PS0 (GMOUNTREFCNTR) <= 0 THEN           <<50.PV>>04858000
                       SYSABORT (DIRPVBINDERR);                <<DE>>   04860000
                    IF PS0 (GLINKAGE).(MVTABXF) <> MVTABX      <<01420>>04862000
                       THEN SYSABORT (DIRPVBINDERR);           <<DE>>   04864000
                    FIPNTR := PS0 (GFIPNTR);                   <<51.PV>>04866000
                END ELSE                                       <<50.PV>>04868000
                BEGIN                                          <<50.PV>>04870000
                    PS0 (GLINKAGE).(MVTABXF) := MVTABX;        <<50.PV>>04872000
                    PS0 (GSAVEFIPNTR) := PS0 (GFIPNTR);        <<50.PV>>04874000
                    FIPNTR := PS0 (GFIPNTR) := S1;             <<50.PV>>04876000
                END;                                           <<50.PV>>04878000
                REFCNTR := PS0 (XREG) := PS0 (GMOUNTREFCNTR)+1;<<51.PV>>04880000
                DDEL;                                          <<50.PV>>04882000
                DIRWRITE (A);  <<UPDATE ENTRY BLOCK>>          <<50.PV>>04884000
                LOCKTREE (REFCNTR);                            <<51.PV>>04886000
                CC := CCE;                                     <<50.PV>>04888000
            END ELSE DEL;                                      <<50.PV>>04890000
            SIRRETURN := DSIR;                                 <<56.PV>>04892000
        END;                                                   <<50.PV>>04894000
        RELSIR (DIRSIR,SIRRETURN);                             <<56.PV>>04896000
        EXCHANGEDB (0);  <<TO STACK>>                          <<23.PV>>04898000
        GIPNTR := FIPNTR;                                      <<51.PV>>04900000
    END;<<OF DIRECBIND>>                                       <<23.PV>>04902000
DOUBLE PROCEDURE DIRECUNBIND (TYPE, LINKAGE'INDEXP, ANAME,     <<38.PV>>04904000
                              GUNAME, MVTABX);                 <<23.PV>>04906000
    VALUE   TYPE, LINKAGE'INDEXP, MVTABX;                      <<38.PV>>04908000
    INTEGER TYPE, MVTABX;                                      <<38.PV>>04910000
    DOUBLE  LINKAGE'INDEXP;                                    <<38.PV>>04912000
    ARRAY   ANAME, GUNAME;                                     <<23.PV>>04914000
    OPTION  PRIVILEGED, UNCALLABLE, VARIABLE;                  <<23.PV>>04916000
    COMMENT                                                    <<23.PV>>04918000
        DB MUST BE AT STACK WHEN CALLED.                       <<23.PV>>04920000
        RETURNS:                                               <<23.PV>>04922000
                                                               <<23.PV>>04924000
                 CONDITION CODE :                              <<23.PV>>04926000
                     CCE - SUCCESSFULL                         <<23.PV>>04928000
                     CCG - SEARCH FAILURE                      <<23.PV>>04930000
                           FUNCTION (RESULT) CONTAINS ERROR    <<23.PV>>04932000
                           CODE (SEARCH FAILURE) AND ENTRY     <<23.PV>>04934000
                           TYPE NOT FOUND.                     <<23.PV>>04936000
                     CCL - NOT RETURNED                        <<23.PV>>04938000
    ;                                                          <<23.PV>>04940000
    BEGIN                                                      <<23.PV>>04942000
        DOUBLE                                                 <<23.PV>>04944000
            RESULT = DIRECUNBIND;                              <<23.PV>>04946000
        INTEGER                                                <<23.PV>>04948000
            DSIR,                                              <<56.PV>>04950000
            RS1 = RESULT,                                      <<23.PV>>04952000
            RS0 = RS1+1,                                       <<23.PV>>04954000
            REFCNTR,                                           <<51.PV>>04956000
            TEMP;                                              <<23.PV>>04958000
        LOGICAL                                                <<23.PV>>04960000
            PMASK = Q-4;                                       <<23.PV>>04962000
        DEFINE                                                 <<23.PV>>04964000
            MVTABX'M = (15:1) #,                               <<23.PV>>04966000
            MVTABX'P = PMASK.MVTABX'M #;                       <<23.PV>>04968000
        ARRAY                                                  <<23.PV>>04970000
            PARR (*) = TYPE;                                   <<23.PV>>04972000
                                                               <<23.PV>>04974000
        INTEGER SUBROUTINE GETENTRY (MVTABX');                 <<50.PV>>04976000
            VALUE   MVTABX';                                   <<51.PV>>04978000
            INTEGER MVTABX';                                   <<51.PV>>04980000
            BEGIN                                              <<23.PV>>04982000
                IF (RESULT :=                                  <<23.PV>>04984000
                    DIRSTARTOFF (PARR,,,,MVTABX')) <> 0D THEN  <<51.PV>>04986000
                     TOS := 0                                  <<51.PV>>04988000
                ELSE                                           <<23.PV>>04990000
                BEGIN <<FIND REQUIRED ENTRY AND/OR TREE>>      <<51.PV>>04992000
                    TOS := DIRFIND (XINDEXP);                  <<23.PV>>04994000
                    ASMB (DTST, DELB);                         <<23.PV>>04996000
                    IF = THEN RESULT := [16/1, 16/2] D;        <<50.PV>>04998000
                END;                                           <<23.PV>>05000000
                TEMP := TOS;                                   <<23.PV>>05002000
                GETENTRY := TEMP;                              <<23.PV>>05004000
            END;<<OF GETENTRY>>                                <<23.PV>>05006000
                                                               <<23.PV>>05008000
        SUBROUTINE UNLOCKTREE (REFCNTR');                      <<51.PV>>05010000
            VALUE   REFCNTR';                                  <<51.PV>>05012000
            INTEGER REFCNTR';                                  <<51.PV>>05014000
            BEGIN                                              <<51.PV>>05016000
                EXCHANGEDB (0);                                <<51.PV>>05018000
                TYPE := FILELEVEL & LSL (3);                   <<51.PV>>05020000
                GETENTRY (MVTABX);                             <<51.PV>>05022000
                DBPCOUNT := REFCNTR';                          <<51.PV>>05024000
                DIRWRITE (B);                                  <<51.PV>>05026000
            END;<<OF UNLOCKTREE>>                              <<51.PV>>05028000
                                                               <<51.PV>>05030000
        CC := CCG;                                             <<23.PV>>05032000
        TYPE := GROUPLEVEL & LSL (3);  <<FORCE IT>>            <<23.PV>>05034000
        IF (TOS := GETENTRY (0)) <> 0 THEN                     <<50.PV>>05036000
        BEGIN <<FOUND>>                                        <<48.PV>>05038000
            DSIR := SIRRETURN; <<MOST ACCURATE COPY FOR EXIT>> <<56.PV>>05040000
            REFCNTR := PS0 (XREG) := PS0 (GMOUNTREFCNTR) - 1;  <<51.PV>>05042000
            IF PS0 (XREG) <= 0 THEN                            <<48.PV>>05044000
            BEGIN                                              <<48.PV>>05046000
                IF < THEN SYSABORT (DIRPVBINDERR);             <<DE>>   05048000
                PS0 (GFIPNTR) := PS0 (GSAVEFIPNTR);            <<48.PV>>05050000
                PS0 (GLINKAGE).(MVTABXF) := 0;                 <<48.PV>>05052000
                PS0 (GSAVEFIPNTR) := 0;                        <<48.PV>>05054000
            END;                                               <<48.PV>>05056000
            DEL;                                               <<48.PV>>05058000
            DIRWRITE (A);  <<UPDATE ENTRY BLOCK>>              <<48.PV>>05060000
            UNLOCKTREE (REFCNTR);                              <<51.PV>>05062000
            CC := CCE;                                         <<48.PV>>05064000
            SIRRETURN := DSIR;                                 <<56.PV>>05066000
        END ELSE DEL;                                          <<50.PV>>05068000
        RELSIR (DIRSIR,SIRRETURN);                             <<23.PV>>05070000
        EXCHANGEDB (0);  <<TO STACK>>                          <<23.PV>>05072000
    END;<<OF DIRECUNBIND>>                                     <<23.PV>>05074000
                                                                        05076000
                                                                        05078000
                                                                        05080000
                                                                        05082000
<< *** PURGE ROUTINES *** >>                                            05084000
                                                                        05086000
                                                                        05088000
                                                                        05090000
                                                                        05092000
                                                                        05094000
<< THESE PROCEDURES RETURN THE NUMBER OF SECTORS REMOVED. >>            05096000
<< CARRY SET IF ENTRY (OR TREE) ENTIRELY REMOVED. >>                    05098000
                                                                        05100000
                                                                        05102000
                                                                        05104000
                                                                        05106000
DOUBLE PROCEDURE DIRPURGESCAN (PURGER, MVTABX);                <<26.PV>>05108000
   VALUE MVTABX;                                               <<26.PV>>05110000
   DOUBLE PROCEDURE PURGER;                                             05112000
   INTEGER MVTABX;                                             <<26.PV>>05114000
                                                                        05116000
   OPTIONS;                                                             05118000
<< B CONTAINS INDEX TO BE CLEANSED.                                     05120000
   THIS ROUTINE RESTORES A.                                             05122000
   <PURGER> MUST AT MOST ONLY REMOVE ENTRY FROM A  (I.E. RETURN A       05124000
   ALMOST- AND B EXACTLY- INTACT).  >>                                  05126000
BEGIN                                                                   05128000
   DOUBLE RESULT = DIRPURGESCAN;                                        05130000
   POINTER                                                              05132000
      IPNTR, IEND,                                                      05134000
      EPNTR, EEND;                                                      05136000
                                                                        05138000
   TOS := DACONTENTS;    <<SAVE FOR RESTORE OF A>>                      05140000
   TOS := A;                                                            05142000
   TOS := DAXCOUNT;                                                     05144000
   TOS := DAMISCWD;                                                     05146000
   TOS := DADIRBASE; <<DIRECTORY BASE FOR DACONTENTS>>         <<01055>>05148000
   @IEND := (@IPNTR := @DBLPNTR) + DBUSED;                              05150000
   WHILE @IPNTR < @IEND DO    <<SCAN THRU INDICES>>                     05152000
      BEGIN                                                             05154000
      DIRREAD (IPNTR (IEPNTR), A, IPNTR (IECOUNT), DBEMISCWD);          05156000
      @EEND := (@EPNTR := @DALPNTR) + DAUSED;                           05158000
      WHILE @EPNTR < @EEND DO    <<SCAN THRU ENTRIES>>                  05160000
         BEGIN                                                          05162000
         TOS := 0D;                                                     05164000
         TOS := @EPNTR;                                                 05166000
         TOS := MVTABX;                                        <<26.PV>>05168000
         TOS := PURGER (*, *);                                 <<26.PV>>05170000
         IF CARRY THEN                                                  05172000
            BEGIN    <<ACTUALLY REMOVED; WAS NOT BEING USED>>           05174000
            DBETOTAL := DBETOTAL-1;                                     05176000
            IPNTR(IECOUNT) := IPNTR(IECOUNT)-1;                         05178000
            IF @EPNTR = @DALPNTR THEN                                   05180000
               MOVE IPNTR := DALPNTR, (NAMESIZE);                       05182000
            DIRWRITE (B);                                      <<53.PV>>05184000
            DIRWRITE (A);                                      <<53.PV>>05186000
            @EEND := @EEND-DAXSIZE;                                     05188000
            END                                                         05190000
         ELSE                                                           05192000
            @EPNTR := @EPNTR+DAXSIZE;                                   05194000
         DIRPURGESCAN := TOS +RESULT;                                   05196000
         END;<<OF ENTRY BLOCK SCAN>>                           <<53.PV>>05198000
      IF DAXCOUNT = 0 THEN                                              05200000
         BEGIN    <<ENTRY BLOCK DEPLETED>>                              05202000
         DIRREMOVE (IPNTR, B);                                          05204000
         DIRWRITE (B);                                         <<53.PV>>05206000
         @IEND := @IEND-DBXSIZE;                                        05208000
         END                                                            05210000
      ELSE                                                              05212000
         BEGIN                                                          05214000
         IF DADIRTY THEN DIRWRITE (A);                         <<53.PV>>05216000
         @IPNTR := @IPNTR+DBXSIZE;                                      05218000
         END;                                                           05220000
      END;<<OF INDEX BLOCK SCAN>>                              <<53.PV>>05222000
   DIRBASE := TOS; <<AS IT WAS UPON ENTRY>>                    <<01055>>05224000
   DIRREAD (*, *, *, *);                                                05226000
   CARRYX:= IF (DBXCOUNT +DBPCOUNT) = 0 THEN 1 ELSE 0;                  05228000
   END    <<DIRPURGESCAN>>;                                             05230000
                                                                        05232000
                                                                        05234000
                                                                        05236000
                                                                        05238000
DOUBLE PROCEDURE DDELFILE (NTRY, MVTABX);                      <<26.PV>>05240000
   VALUE MVTABX;                                               <<26.PV>>05242000
   ARRAY NTRY;                                                          05244000
   INTEGER MVTABX;                                             <<26.PV>>05246000
   OPTIONS;                                                             05248000
BEGIN                                                                   05250000
   DOUBLE ARRAY DENTRY (*) = NTRY;                                      05252000
   EQUATE VTABDST = 29;                                                 05254000
   INTEGER ARRAY VTAB (*) = DB+0;                                       05256000
                                                                        05258000
   TOS := 0D;                                                           05260000
   TOS := DENTRY (2);                                                   05262000
   TOS := LUN (S1.(0:8),MVTABX);                               <<26.PV>>05264000
   S2.(0:8) := 0;                                              <<26.PV>>05266000
   ASSEMBLE (CAB, CAB);                                        <<26.PV>>05268000
   EXCHANGEDB (0);                                             <<26.PV>>05270000
                                                                        05272000
   TOS := FRELSPACE (*, *, MVTABX);                            <<00630>>05274000
   EXCHANGEDB (DDSDST);                                                 05276000
   IF (DDELFILE := TOS) <> 0D THEN                                      05278000
      BEGIN                                                             05280000
      DIRREMOVE (NTRY, A);                                              05282000
      TOS := 1;                                                         05284000
      END                                                               05286000
   ELSE TOS := 0;                                                       05288000
   CARRYX := TOS;                                                       05290000
   END    <<DDELFILE>>;                                                 05292000
                                                                        05294000
                                                                        05296000
                                                                        05298000
                                                                        05300000
DOUBLE PROCEDURE DDELVSD (NTRY, MVTABX);                       <<26.PV>>05302000
    VALUE MVTABX;                                              <<26.PV>>05304000
    ARRAY NTRY;                                                <<10.PV>>05306000
    INTEGER MVTABX;                                            <<26.PV>>05308000
    OPTIONS;                                                   <<10.PV>>05310000
                                                               <<32.PV>>05312000
    BEGIN                                                      <<10.PV>>05314000
        IF NTRY (GVSLINKAGEW).(MVTABXF) = 0 THEN               <<34.PV>>05316000
        BEGIN  <<NOT IN USE>>                                  <<32.PV>>05318000
            DIRREMOVE (NTRY, A);                               <<32.PV>>05320000
            CARRYX := 1;                                       <<32.PV>>05322000
        END ELSE CARRYX := 0;                                  <<33.PV>>05324000
    END;<<OF DDELVSD>>                                         <<10.PV>>05326000
                                                               <<10.PV>>05328000
                                                               <<10.PV>>05330000
                                                               <<10.PV>>05332000
                                                               <<10.PV>>05334000
                                                               <<15.PV>>05336000
                                                               <<15.PV>>05338000
                                                               <<15.PV>>05340000
                                                               <<15.PV>>05342000
DOUBLE PROCEDURE DDELUSER (NTRY, MVTABX);                      <<26.PV>>05344000
   VALUE MVTABX;                                               <<26.PV>>05346000
   ARRAY NTRY;                                                          05348000
   INTEGER MVTABX;                                             <<26.PV>>05350000
   OPTIONS;                                                             05352000
BEGIN                                                                   05354000
   IF NTRY (ULOGCOUNT) = 0 THEN                                         05356000
      BEGIN                                                             05358000
      DIRREMOVE (NTRY, A);                                              05360000
      TOS := 1;                                                         05362000
      END                                                               05364000
   ELSE                                                                 05366000
      BEGIN                                                             05368000
      NTRY (UPURGEFLAGW).(UPURGEFLAGF) := GONEFLAG;                     05370000
      DADIRTY := TRUE;                                                  05372000
      TOS := 0;                                                         05374000
      END;                                                              05376000
   CARRYX := TOS;                                                       05378000
   DDELUSER := 0D;                                                      05380000
   END    <<DDELUSER>>;                                                 05382000
                                                                        05384000
                                                                        05386000
                                                                        05388000
                                                                        05390000
DOUBLE PROCEDURE DDELGROUP (NTRY, MVTABX);                     <<26.PV>>05392000
   VALUE MVTABX;                                               <<26.PV>>05394000
   ARRAY NTRY;                                                          05396000
   INTEGER MVTABX;                                             <<26.PV>>05398000
   OPTIONS;                                                             05400000
BEGIN                                                                   05402000
   DOUBLE POINTER DNTRY = NTRY;                                         05404000
   DOUBLE                                                      <<15.PV>>05406000
       SECTORS,                                                <<01055>>05408000
       PVDIRBASE,                                              <<01055>>05410000
       SAVEVSD;                                                <<15.PV>>05412000
   LOGICAL                                                     <<15.PV>>05414000
       VSDGONE := FALSE,                                       <<43.PV>>05416000
       BOUNDTOHVS;                                             <<43.PV>>05418000
   TOS := DBCONTENTS;                                                   05420000
   TOS := DBDIRBASE; <<DIRECTORY BASE FOR DBCONTENTS>>         <<45.PV>>05422000
   DIRREAD (NTRY (GVSDIPNTR), B, 0, 0);                        <<15.PV>>05424000
   DIRPURGESCAN (DDELVSD, MVTABX);                             <<26.PV>>05426000
   IF CARRY THEN                                               <<15.PV>>05428000
   BEGIN                                                       <<15.PV>>05430000
       TOS := DBCONTENTS;                                      <<15.PV>>05432000
       TOS := DBBSIZE;                                         <<15.PV>>05434000
       SAVEVSD := TOS;                                         <<15.PV>>05436000
       VSDGONE := TRUE;                                        <<15.PV>>05438000
   END;                                                        <<15.PV>>05440000
   IF BOUNDTOHVS := (NTRY (GLINKAGE).(PVF) = PV LAND           <<45.PV>>05442000
                     NTRY (XREG).(MVTABXF) <> 0) THEN          <<45.PV>>05444000
   BEGIN                                                       <<45.PV>>05446000
       MVTABX := NTRY (XREG).(MVTABXF);                        <<45.PV>>05448000
       TOS := DDSDST;                 <<E: TARGET>>            <<45.PV>>05450000
       TOS := @DIRBASE;               <<D: TARGET OFFSET>>     <<45.PV>>05452000
       TOS := MVTABDST;               <<C: SOURCE>>            <<45.PV>>05454000
       TOS := (MVTABX*MVTABSZ)+2;     <<B: SOURCE OFFSET>>     <<45.PV>>05456000
       TOS := 2;                      <<A: COUNT>>             <<45.PV>>05458000
       ASSEMBLE (MDS);                                         <<45.PV>>05460000
       PVDIRBASE := DIRBASE; <<MAY NEED IT LATER>>             <<01055>>05462000
   END;                                                        <<45.PV>>05464000
   DIRREAD (NTRY(GFIPNTR), B, 0, 0);                                    05466000
   << *** DELETE ALL FILES NOT BEING USED *** >>                        05468000
   SECTORS := DIRPURGESCAN (DDELFILE, MVTABX);                 <<01055>>05470000
   IF CARRY AND VSDGONE AND NOT BOUNDTOHVS THEN                <<43.PV>>05472000
      BEGIN    <<FULLY SUCCESSFUL DELETION: REMOVE ENTRY & ITS INDEX>>  05474000
      DIRDEALLOCATE (DBCONTENTS, DBBSIZE);                              05476000
      <<EMIT LOG RECORD>>                                               05478000
      DBDIRTY := DBCONTENTS := 0;                                       05480000
      TOS := SAVEVSD;                                          <<15.PV>>05482000
      DIRDEALLOCATE (*, *);                                    <<15.PV>>05484000
      DIRREMOVE (NTRY, A);                                              05486000
      TOS := 1;                                                         05488000
      END                                                               05490000
   ELSE                                                                 05492000
      BEGIN    <<ENTRY WAS IN-USE>>                            <<61.PV>>05494000
          IF BOUNDTOHVS THEN                                   <<61.PV>>05496000
          BEGIN                                                <<61.PV>>05498000
              TOS := DACONTENTS;  <<SAVE THE ENVIRONMENT>>     <<01055>>05500000
              TOS := A;           <<FOR RESTORING BUFFER (A)>> <<01055>>05502000
              TOS := DAXCOUNT;    <<AFTER ACCOUNTING HOUSE- >> <<01055>>05504000
              TOS := DAMISCWD;    <<KEEPING (DIRRESET) IN>>    <<01055>>05506000
              TOS := DADIRBASE;   <<PV'S DIRECTORY>>           <<01055>>05508000
              DIRBASE := PVDIRBASE; <<SET UP FOR SWITCH>>      <<01055>>05510000
              DIRREAD (NTRY (GFIPNTR),B,0,0);                  <<01055>>05512000
              DIRRESET (SECTORS);                              <<01055>>05514000
              DIRBASE := TOS;    <<SET UP FOR SWITCH BACK>>    <<01055>>05516000
              DIRREAD (*,*,*,*); <<RESTORE ENTRY BUFFER (A)>>  <<01055>>05518000
              SECTORS := 0D; <<ALREADY UPDATED. FAKE IT>>      <<01055>>05520000
          END ELSE                                             <<61.PV>>05522000
          BEGIN                                                <<61.PV>>05524000
              DBMISCWD.(IPURGEFLAGF) := GONEFLAG;              <<61.PV>>05526000
              NTRY (GPURGEFLAGW).(GPURGEFLAGF) := GONEFLAG;    <<61.PV>>05528000
              @NTRY := @NTRY + GDFSCOUNT;                      <<61.PV>>05530000
              DNTRY := DNTRY - SECTORS;                        <<01055>>05532000
              DIRWRITE (B);                                    <<61.PV>>05534000
              DADIRTY := TRUE;                                 <<61.PV>>05536000
              <<CALLER MUST WRITE OUT THIS GROUP>>             <<61.PV>>05538000
          END;                                                 <<61.PV>>05540000
          TOS := 0; <<TO SET CARRY>>                           <<61.PV>>05542000
      END;                                                              05544000
   CARRYX := TOS;                                                       05546000
   DDELGROUP := SECTORS;                                       <<01055>>05548000
   DIRBASE := TOS; <<AS IT WAS UPON ENTRY>>                    <<45.PV>>05550000
   DIRREAD (*, B, 0, 0);    <<RESTORE INCOMING INDEX>>                  05552000
   END    <<DDELGROUP>>;                                                05554000
                                                                        05556000
                                                                        05558000
                                                                        05560000
DOUBLE PROCEDURE DDELACCT (NTRY, MVTABX);                      <<26.PV>>05562000
   VALUE MVTABX;                                               <<26.PV>>05564000
   ARRAY NTRY;                                                          05566000
   INTEGER MVTABX;                                             <<26.PV>>05568000
   OPTIONS;                                                             05570000
BEGIN                                                                   05572000
   DOUBLE POINTER DNTRY = NTRY;                                         05574000
   DOUBLE                                                      <<15.PV>>05576000
       SAVEU;                                                           05578000
   LOGICAL                                                     <<15.PV>>05580000
       FREEUSERS := FALSE;                                              05582000
                                                                        05584000
   TOS := DBCONTENTS;                                                   05586000
   DIRREAD (NTRY(AUIPNTR), B, 0, 0);                                    05588000
   DIRPURGESCAN (DDELUSER, MVTABX);                            <<26.PV>>05590000
   IF CARRY THEN                                                        05592000
      BEGIN                                                             05594000
      TOS := DBCONTENTS;                                                05596000
      TOS := DBBSIZE;                                                   05598000
      SAVEU := TOS;                                                     05600000
      FREEUSERS := TRUE;                                                05602000
      END;                                                              05604000
   DBMISCWD.(IPURGEFLAGF) := GONEFLAG;                                  05606000
   DIRWRITE (B);                                                        05608000
   DIRREAD (NTRY(AGIPNTR), B, 0, 0);                                    05610000
   TOS := DIRPURGESCAN (DDELGROUP, MVTABX);                    <<26.PV>>05612000
   IF CARRY AND FREEUSERS THEN                                          05614000
      BEGIN                                                             05616000
      DIRDEALLOCATE (DBCONTENTS, DBBSIZE);                              05618000
      DBDIRTY := DBCONTENTS := 0;                                       05620000
      TOS := SAVEU;                                                     05622000
      DIRDEALLOCATE (*, *);                                             05624000
      <<EMIT LOG RECORD>>                                               05626000
      DIRREMOVE (NTRY, A);                                              05628000
      TOS := 1;                                                         05630000
      END                                                               05632000
   ELSE                                                                 05634000
      BEGIN                                                             05636000
      DBMISCWD.(IPURGEFLAGF) := GONEFLAG;                               05638000
      DNTRY (ADFSCOUNTD) := -DS1 +DNTRY (ADFSCOUNTD);                   05640000
      DIRWRITE (B);                                                     05642000
      DADIRTY := TRUE;                                                  05644000
      TOS := 0;                                                         05646000
      END;                                                              05648000
   CARRYX := TOS;                                                       05650000
   DDELACCT := TOS;                                                     05652000
   DIRREAD (*, B, 0, 0);                                                05654000
   END    <<DDELACCT>>;                                                 05656000
                                                                        05658000
                                                                        05660000
                                                                        05662000
DOUBLE PROCEDURE DIRECPURGE (TYPE, LINKAGE'INDEXP, ANAME,      <<38.PV>>05664000
                             GUNAME, FNAME, MVTABX);           <<38.PV>>05666000
   VALUE TYPE, LINKAGE'INDEXP, MVTABX;                         <<38.PV>>05668000
   INTEGER TYPE, MVTABX;                                       <<38.PV>>05670000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>05672000
   ARRAY ANAME, GUNAME, FNAME;                                          05674000
   OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                    <<21.PV>>05676000
                                                                        05678000
<< GENERAL PURGE ROUTINE                                                05680000
                                                                        05682000
DOUBLE PROCEDURE DIRECPURGEFILE                                         05684000
      (NUMSECTS, DUMMY, ANAME, GNAME, FNAME);                    43.PV  05686000
   VALUE NUMSECTS, DUMMY;                                        43.PV  05688000
   DOUBLE NUMSECTS;                                                     05690000
   INTEGER DUMMY;                                                43.PV  05692000
   ...                                                                  05694000
   PURGE FILE ENTRY AND ADJUST ACCT & GROUP SPACE COUNTS                05696000
   BY <NUMSECTS>.                                                       05698000
   >>                                                                   05700000
BEGIN                                                                   05702000
   ENTRY DIRECPURGEFILE;                                                05704000
   ARRAY PARR (*) = TYPE;                                               05706000
   DOUBLE NUMSECTS = TYPE;                                              05708000
   DOUBLE LNUMSECTS;                                                    05710000
   LOGICAL FFLAG := FALSE;                                              05712000
   INTEGER SAVEFSIR = LNUMSECTS;                                        05714000
   EQUATE FSIR = 37;                                                    05716000
   DOUBLE GROUPSPACEGONE := 0D;                                         05718000
   LOGICAL                                                     <<21.PV>>05720000
       PMASK = Q-4;                                            <<21.PV>>05722000
       DEFINE                                                  <<21.PV>>05724000
           MVTABX'M = (15:1) #,                                <<21.PV>>05726000
           MVTABX'P = PMASK.MVTABX'M #;                        <<21.PV>>05728000
                                                                        05730000
                                                                        05732000
   IF TYPE.(ENDLEVELF) <> 3 THEN SAVEFSIR := GETSIR(FSIR);     <<03.PV>>05734000
   IF MVTABX'P THEN                                            <<21.PV>>05736000
    TOS := DIRSTARTOFF (PARR,,,,MVTABX)                        <<21.PV>>05738000
   ELSE                                                        <<21.PV>>05740000
   BEGIN                                                       <<26.PV>>05742000
       MVTABX := 0;                                            <<26.PV>>05744000
       TOS := DIRSTARTOFF (PARR);                              <<26.PV>>05746000
   END;                                                        <<26.PV>>05748000
   GOTO START;                                                          05750000
                                                                        05752000
                                                                        05754000
DIRECPURGEFILE:                                                         05756000
   FFLAG := TRUE;                                                       05758000
   LNUMSECTS := NUMSECTS;                                               05760000
   NUMSECTS := 0D;                                                      05762000
   IF MVTABX'P THEN                                            <<42.PV>>05764000
    TOS := DIRSTARTOFF (PARR, LNUMSECTS, , ,MVTABX)            <<42.PV>>05766000
   ELSE                                                        <<42.PV>>05768000
   BEGIN                                                       <<42.PV>>05770000
       MVTABX := 0;                                            <<42.PV>>05772000
       TOS := DIRSTARTOFF (PARR, LNUMSECTS);                   <<42.PV>>05774000
   END;                                                        <<42.PV>>05776000
                                                                        05778000
                                                                        05780000
START:                                                                  05782000
   IF DS1 <> 0D THEN GOTO BADEXIT;                                      05784000
   ASSEMBLE (DDEL);                                                     05786000
   TOS := DIRFIND (XINDEXP);                                            05788000
   ASSEMBLE (DTST);                                                     05790000
   IF = THEN                                                            05792000
      BEGIN                                                             05794000
      DDEL;                                                             05796000
      TOS := TYPE.(ENDLEVELF);                                          05798000
      TOS := 2;                                                         05800000
      GOTO BADEXIT0;                                                    05802000
      END;                                                              05804000
   ASSEMBLE (DDUP, ZROB);                                               05806000
   ASSEMBLE (DUP, ZROB);                                                05808000
   CASE *TYPE.(ENDLEVELF) OF                                   <<16.PV>>05810000
      BEGIN                                                             05812000
         BEGIN                                                          05814000
         DIRREMOVE (*, A);                                              05816000
         ASSEMBLE (NEG, DDEL);    <<SET CARRY>>                         05818000
         END;                                                           05820000
      GROUPSPACEGONE := DDELGROUP (*, MVTABX);                 <<26.PV>>05822000
      DDELACCT (*, MVTABX);                                    <<26.PV>>05824000
      DDELUSER (*, MVTABX);                                    <<26.PV>>05826000
      DDELVSD (*, MVTABX);                                     <<26.PV>>05828000
                                                                        05830000
      END;                                                              05832000
   IF CARRY THEN                                                        05834000
      BEGIN                                                             05836000
      XREG := IECOUNT;                                                  05838000
      DBETOTAL := DBETOTAL-1;                                           05840000
      IF TOS = @DALPNTR THEN                                            05842000
         BEGIN                                                          05844000
         ASSEMBLE (DUP);                                                05846000
         MOVE * := DALPNTR, (NAMESIZE);                                 05848000
         END;                                                           05850000
      S0IPNTR(XREG) := S0IPNTR(XREG)-1;                                 05852000
      IF = THEN                                                         05854000
         BEGIN                                                          05856000
         DIRREMOVE (*, B);                                              05858000
         TOS := 0;                                                      05860000
         END;                                                           05862000
      ASSEMBLE (ZERO, ZROB);                                            05864000
      TOS := CCE;                                                       05866000
      DIRWRITE (B);                                                     05868000
      IF DADIRTY THEN DIRWRITE (A);                            <<53.PV>>05870000
      DIRXXXBITMAP (WRITE);                                    <<28.PV>>05872000
      END                                                               05874000
   ELSE                                                                 05876000
      BEGIN                                                             05878000
      IF DADIRTY THEN DIRWRITE (A);                            <<53.PV>>05880000
      DIRXXXBITMAP (WRITE);                                    <<43.PV>>05882000
      ASSEMBLE (ZROB, DEL);                                             05884000
      TOS := 7;                                                         05886000
BADEXIT0:                                                               05888000
      IF FFLAG THEN DIRRESET (LNUMSECTS);                               05890000
BADEXIT:                                                                05892000
      TOS := CCG;                                                       05894000
      END;                                                              05896000
   CC := TOS;                                                           05898000
   DIRECPURGE := TOS;                                                   05900000
   TOS := GROUPSPACEGONE;                                               05902000
   IF <> THEN DIRRESET (*) ELSE ASSEMBLE (DDEL);                        05904000
   RELSIR (DIRSIR, SIRRETURN);                                          05906000
   IF NOT (FFLAG)                                                       05908000
      AND TYPE.(ENDLEVELF) <> 3 THEN RELSIR (FSIR, SAVEFSIR);  <<03.PV>>05910000
   EXCHANGEDB (0);                                                      05912000
   END    <<DIRECPURGE>>;                                               05914000
                                                                        05916000
                                                                        05918000
                                                                        05920000
                                                                        05922000
                                                                        05924000
DOUBLE PROCEDURE DIRECADJUST (NUMSECTS, DUMMY,                 <<39.PV>>05926000
                              ANAME, GNAME, MVTABX);           <<39.PV>>05928000
   VALUE NUMSECTS, DUMMY, MVTABX;                              <<39.PV>>05930000
   DOUBLE NUMSECTS;                                                     05932000
   INTEGER DUMMY, MVTABX;                                      <<39.PV>>05934000
   ARRAY ANAME, GNAME;                                                  05936000
   OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                    <<39.PV>>05938000
<< ADJUSTS THA ACCT AND GROUP SPACE COUNTS BY NUMSECTS >>               05940000
BEGIN                                                                   05942000
   LOGICAL                                                     <<39.PV>>05944000
       PMASK = Q-4;                                            <<39.PV>>05946000
   DEFINE                                                      <<39.PV>>05948000
       MVTABX'M = (15:1) #,                                    <<39.PV>>05950000
       MVTABX'P = PMASK.MVTABX'M #;                            <<39.PV>>05952000
   ARRAY PARR (*) = NUMSECTS;                                           05954000
   DOUBLE LNUMSECTS;                                                    05956000
   LNUMSECTS := NUMSECTS;                                               05958000
   TOS := 0;  TOS.(ALLFLAG) := TRUE;                           <<26.PV>>05960000
   TOS := 0;                                                            05962000
   NUMSECTS := TOS;                                                     05964000
   DUMMY := 0;                                                 <<38.PV>>05966000
   IF NOT MVTABX'P THEN MVTABX := 0;                           <<39.PV>>05968000
   IF (DIRECADJUST :=                                          <<39.PV>>05970000
       DIRSTARTOFF (PARR,LNUMSECTS,,,MVTABX)) <> 0D THEN       <<39.PV>>05972000
      TOS := CCG                                                        05974000
   ELSE TOS := CCE;                                                     05976000
   CC := TOS;                                                           05978000
   RELSIR (DIRSIR, SIRRETURN);                                          05980000
   EXCHANGEDB (0);                                             << ... >>05982000
   END    <<PROCEDURE DIRECADJUST>>;                                    05984000
                                                                        05986000
                                                                        05988000
                                                                        05990000
                                                                        05992000
LOGICAL PROCEDURE DIRDOENTRY (ELEMENT, LEAFLEVEL, RECIP,       <<56.PV>>05994000
                              PARMS, VISIT);                   <<56.PV>>05996000
   VALUE LEAFLEVEL, PARMS, VISIT;                              <<56.PV>>05998000
   ARRAY ELEMENT;                                                       06000000
   INTEGER LEAFLEVEL, PARMS;                                            06002000
   LOGICAL VISIT;                                              <<56.PV>>06004000
   INTEGER PROCEDURE RECIP;                                             06006000
   OPTION PRIVILEGED, UNCALLABLE, FORWARD;                              06008000
                                                                        06010000
                                                                        06012000
                                                                        06014000
                                                                        06016000
PROCEDURE DIRSCANTREE (INDEX, LEAFLEVEL, RECIP, PARMS);                 06018000
   VALUE INDEX, LEAFLEVEL, PARMS;                                       06020000
   INTEGER INDEX, LEAFLEVEL, PARMS;                                     06022000
   INTEGER PROCEDURE RECIP;                                             06024000
   OPTIONS;                                                             06026000
BEGIN                                                                   06028000
   INTEGER                                                     <<56.PV>>06030000
       VISIT := TRUE;                                          <<56.PV>>06032000
   INTEGER POINTER                                                      06034000
      IP,                                                               06036000
      EP;                                                               06038000
   DOUBLE POINTER                                                       06040000
      DIP = IP,                                                         06042000
      DEP = EP,                                                         06044000
      DDBLPNTR = DBLPNTR;                                               06046000
   DOUBLE ARRAY DDDSENTRY (*) = DDSENTRY;                               06048000
<< >>                                                                   06050000
   DIRREAD (INDEX, B, 0, 0);     << GET TREE >>                         06052000
   DBPCOUNT := DBPCOUNT +1;      << MARK AS UNDELETABLE >>              06054000
   DIRWRITE (B);                                                        06056000
   TOS := DDBLPNTR;              << START SCAN: INITIAL NAME >>         06058000
   TOS := DDBLPNTR (1) & DLSL (1) & DLSR (1);                           06060000
   PARMS := PARMS -DELTAQ;                                              06062000
                                                                        06064000
NEXTNAME:                                                               06066000
   << INDEX IN BLOCK B; TARGET NAME ON TOS >>                           06068000
   DDDSENTRY (1) := TOS;                                                06070000
   DDDSENTRY := TOS;                                                    06072000
   @IP := DIRSCAN (DDSENTRY, EPB);  << FIND CONTAINING BLOCK >>         06074000
   IF = THEN                                                            06076000
      BEGIN    <<OK. SO FIND NEXT BLOCK FOR THIS DUMMY ENTRY>>          06078000
      @IP := DIRSCAN (DDSENTRY, ENB);                                   06080000
      IF = THEN GOTO LEAVE;                                             06082000
      END;                                                              06084000
NEXTBLOCK:                                                              06086000
   DIRREAD (IP (IEPNTR), A, IP (IECOUNT), DBEMISCWD);                   06088000
   @EP := DIRSCAN (DDSENTRY, ENA);  << FIND ENTRY IN BLOCK >>           06090000
   IF = THEN                                                            06092000
      BEGIN                      << NOT IN ENTRY BLOCK >>               06094000
      IF (@IP := @IP +DBXSIZE) >= @DBLPNTR +DBUSED THEN GOTO LEAVE;     06096000
                                                                        06098000
                                                                        06100000
      GOTO NEXTBLOCK;                                                   06102000
      END;                                                              06104000
   TOS := DEP;                                                          06106000
   TOS := DEP (1) & DLSL (1) & DLSR (1);                                06108000
   DABADELM := EP (2) < 0;  <<FLAGGED ENTRY?>>                 <<00175>>06110000
   TOS := DIRDOENTRY (EP, LEAFLEVEL, RECIP, PARMS, VISIT);     <<56.PV>>06112000
   << DIRECTORY MAY BE COMPLETELY MODIFIED, EXCEPT THAT                 06114000
      INDEX BLOCK <INDEX> STILL EXISTS.     THE DIRECTORY IS LOCKED >>  06116000
   DIRREAD (INDEX, B, 0, 0);                                            06118000
   IF TOS <= 0 THEN                                            <<56.PV>>06120000
   BEGIN  <<CONTINUE SCAN>>                                    <<56.PV>>06122000
       IF = THEN                                               <<56.PV>>06124000
       BEGIN  <<NEXT TARGET NAME & VISIT ENTRY>>               <<56.PV>>06126000
           TOS := TOS+1;  <<NEXT TARGET NAME>>                 <<56.PV>>06128000
           VISIT := TRUE;                                      <<56.PV>>06130000
       END ELSE <<REDO ENTRY - NO VISIT>> VISIT := FALSE;      <<56.PV>>06132000
       GO TO NEXTNAME;                                         <<56.PV>>06134000
   END;                                                        <<56.PV>>06136000
                                                                        06138000
LEAVE:                                                                  06140000
   DBPCOUNT := DBPCOUNT -1;            <<ALLOW DELETION>>               06142000
   DIRWRITE (B);                                                        06144000
   END    <<DIRSCANTREE>>;                                              06146000
                                                                        06148000
                                                                        06150000
                                                                        06152000
                                                                        06154000
LOGICAL PROCEDURE DIRDOENTRY (ELEMENT, LEAFLEVEL, RECIP,       <<56.PV>>06156000
                    PARMS, VISIT);                             <<56.PV>>06158000
   VALUE LEAFLEVEL, PARMS, VISIT;                              <<56.PV>>06160000
   ARRAY ELEMENT;                                                       06162000
   INTEGER LEAFLEVEL, PARMS;                                            06164000
   LOGICAL VISIT;                                              <<56.PV>>06166000
   INTEGER PROCEDURE RECIP;                                             06168000
   OPTIONS;                                                             06170000
BEGIN                                                                   06172000
   ARRAY SAVEGLOB1 (0:10) = Q;    <<ASSUME AT Q+1>>            <<38.PV>>06174000
   DOUBLE SAVEDIRBASE;                                         <<11.PV>>06176000
   INTEGER                                                     <<11.PV>>06178000
       ADDR,                                                   <<11.PV>>06180000
       MVTABX := 0; <<WHEN NON-ZERO, SWITCH "DIRBASE">>        <<11.PV>>06182000
<< >>                                                                   06184000
   XREG := 0;                                                  <<10.PV>>06186000
   CASE *DAMISCWD.(LEVELF) OF  <<CURRENT SUBTREE>>             <<16.PV>>06188000
   BEGIN                                                       <<07.PV>>06190000
       ;                                               <<0>>   <<10.PV>>06192000
       BEGIN                                           <<1>>   <<11.PV>>06194000
           IF LEAFLEVEL = FILELEVEL THEN                       <<11.PV>>06196000
           BEGIN  <<SET UP FOR POSSIBLE "DIRBASE" SWITCH>>     <<11.PV>>06198000
               IF ELEMENT (GLINKAGE).(PVF) = PV THEN           <<11.PV>>06200000
                MVTABX := ELEMENT (GLINKAGE).(MVTABXF);        <<11.PV>>06202000
               XREG := GFIPNTR;                                <<11.PV>>06204000
           END                                                 <<11.PV>>06206000
           ELSE XREG := GVSDIPNTR;                             <<11.PV>>06208000
       END;                                            <<1>>   <<11.PV>>06210000
       CASE *LEAFLEVEL OF                              <<2>>   <<16.PV>>06212000
       BEGIN                                                   <<07.PV>>06214000
           XREG := AGIPNTR;   <<0>>                            <<07.PV>>06216000
           XREG := AGIPNTR;   <<1>>                            <<07.PV>>06218000
           ;                  <<2>>                            <<10.PV>>06220000
           XREG := AUIPNTR;   <<3>>                            <<07.PV>>06222000
           XREG := AGIPNTR;   <<4>>                            <<07.PV>>06224000
       END;                                                    <<07.PV>>06226000
       ;                                               <<3>>   <<10.PV>>06228000
       ;                                               <<4>>   <<10.PV>>06230000
   END;                                                        <<07.PV>>06232000
   TOS := IF XREG = 0 THEN 0 ELSE ELEMENT (XREG);              <<07.PV>>06234000
   TOS := DAMISCWD.(LEVELF);                                            06236000
   TOS := SETCRITICAL;    <<DISALLOW ABORTION IN RECIP>>                06238000
   PARMS := PARMS - DELTAQ;                                    <<56.PV>>06240000
   IF VISIT THEN                                               <<56.PV>>06242000
   BEGIN                                                       <<56.PV>>06244000
       TOS := 0;     << GET READY FOR VISIT VIA RECIP >>       <<56.PV>>06246000
       TOS := @ELEMENT;                                        <<56.PV>>06248000
       TOS := S3;                                              <<56.PV>>06250000
       TOS := PARMS;                                           <<56.PV>>06252000
       TOS := DIRSIR;                                          <<56.PV>>06254000
       TOS := SIRRETURN;                                       <<56.PV>>06256000
       PUSH (Q, DL);                                           <<56.PV>>06258000
       ASSEMBLE(LSUB,INCA,DUP);                                <<DE>>   06260000
       ADDR := TOS;                                            <<DE>>   06262000
       TOS := @WORKAREA;                                       <<56.PV>>06264000
       TOS := 11;                                              <<56.PV>>06266000
       ASSEMBLE (MVBL);                                        <<56.PV>>06268000
       SAVEDIRBASE := DIRBASE;                                 <<56.PV>>06270000
       TOS := RECIP (*, *, *, *);    << VISIT ENTRY >>         <<56.PV>>06272000
       IF NOT (LS0) OR S0 < 0 THEN                             <<56.PV>>06274000
       BEGIN                                                   <<56.PV>>06276000
           IF NOT LS0 THEN GETSIR (DIRSIR) <<SIR WAS RELEASED>><<58.PV>>06278000
            ELSE S0.(15:1) := 0; <<RESET SIR FLAG>>            <<58.PV>>06280000
           TOS := @WORKAREA;                                   <<56.PV>>06282000
           TOS := ADDR;                                        <<56.PV>>06284000
           TOS := 11;                                          <<56.PV>>06286000
           ASSEMBLE (MVLB);                                    <<56.PV>>06288000
           DIRBASE := SAVEDIRBASE;                             <<56.PV>>06290000
           IF S0 < 0 THEN                                      <<56.PV>>06292000
           BEGIN <<REQUESTED TO REDO ENTRY>>                   <<56.PV>>06294000
               DIRDOENTRY := TOS;                              <<56.PV>>06296000
               RESETCRITICAL (*);                              <<56.PV>>06298000
               RETURN;                                         <<56.PV>>06300000
           END;                                                <<56.PV>>06302000
       END ELSE S0.(15:1) := 0; <<RESET SIR FLAG>>             <<58.PV>>06304000
   END <<OF VISITING ENTRY>> ELSE                              <<56.PV>>06306000
   BEGIN <<NO VISIT>>                                          <<56.PV>>06308000
       SAVEDIRBASE := DIRBASE;                                 <<56.PV>>06310000
       TOS := 0;  <<SET UP FOR NEXT TEST ON TOS>>              <<56.PV>>06312000
   END;                                                        <<56.PV>>06314000
   IF TOS & LSR(1) > 1 THEN                                             06316000
      DIRDOENTRY := 1;           << STOP SCAN >>                        06318000
   RESETCRITICAL(*);                                                    06320000
   IF < THEN                     << CONTINUE SCAN >>                    06322000
      IF TOS <> LEAFLEVEL THEN                                          06324000
      BEGIN                                                    <<11.PV>>06326000
          IF MVTABX <> 0 THEN  <<NEXT SUBTREE ON MOUNTED PV>>  <<11.PV>>06328000
          BEGIN                                                <<11.PV>>06330000
              TOS := DDSDST;            <<E: TARGET>>          <<45.PV>>06332000
              TOS := @DIRBASE;          <<D: TARGET OFFSET>>   <<45.PV>>06334000
              TOS := MVTABDST;          <<C: SOURCE>>          <<45.PV>>06336000
              TOS := (MVTABX*MVTABSZ)+2;<<B: SOURCE OFFSET>>   <<45.PV>>06338000
              TOS := 2;                 <<A: COUNT>>           <<45.PV>>06340000
              ASSEMBLE (MDS);                                  <<45.PV>>06342000
          END;                                                 <<11.PV>>06344000
          DIRSCANTREE (*, LEAFLEVEL, RECIP, PARMS);            <<11.PV>>06346000
      END;                                                     <<11.PV>>06348000
   DIRBASE := SAVEDIRBASE;                                     <<11.PV>>06350000
   END    <<DIRDOENTRY>>;                                               06352000
                                                                        06354000
                                                                        06356000
                                                                        06358000
                                                                        06360000
DOUBLE PROCEDURE DIRECSCAN (TYPE, LINKAGE'INDEXP, ANAME,       <<38.PV>>06362000
                          GUNAME, FNAME, RECIP, PARMS, MVTABX);<<38.PV>>06364000
   VALUE TYPE, LINKAGE'INDEXP, MVTABX;                         <<38.PV>>06366000
   INTEGER TYPE, MVTABX;                                       <<38.PV>>06368000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>06370000
   INTEGER PROCEDURE RECIP;                                             06372000
   ARRAY ANAME, GUNAME, FNAME, PARMS;                                   06374000
   OPTION PRIVILEGED, UNCALLABLE, VARIABLE;                    <<35.PV>>06376000
BEGIN                                                                   06378000
   ARRAY PARR (*) = TYPE;                                               06380000
   LOGICAL                                                     <<35.PV>>06382000
       DSIR,                                                   <<56.PV>>06384000
       LTYPE = TYPE,                                           <<35.PV>>06386000
       PMASK = Q-4;                                            <<35.PV>>06388000
   DEFINE                                                      <<35.PV>>06390000
       MVTABX'M = (15:1) #,                                    <<35.PV>>06392000
       MVTABX'P = PMASK.MVTABX'M #;                            <<35.PV>>06394000
                                                                        06396000
<< >>                                                                   06398000
                                                                        06400000
                                                                        06402000
   TOS := @PARMS;                                                       06404000
   PUSH (Q);                                                            06406000
   @PARMS := TOS -TOS;                                                  06408000
   IF LTYPE.(HITFLAG) THEN                                     <<56.PV>>06410000
   BEGIN                                                       <<56.PV>>06412000
       IF MVTABX'P THEN                                        <<56.PV>>06414000
        TOS := DIRSTARTOFF (PARR,,RECIP,@PARMS,MVTABX)         <<56.PV>>06416000
       ELSE                                                    <<56.PV>>06418000
        TOS := DIRSTARTOFF (PARR, ,RECIP, @PARMS);             <<56.PV>>06420000
       IF DS1 < 0D THEN                                        <<56.PV>>06422000
       BEGIN  <<NEED TO REDO STARTOFF - DDS WAS DISTURBED>>    <<56.PV>>06424000
           DDEL; <<RETURN FROM DIRSTARTOFF>>                   <<56.PV>>06426000
           DSIR := SIRRETURN; <<MOST ACCURATE COPY FOR EXIT>>  <<56.PV>>06428000
           EXCHANGEDB (0);                                     <<56.PV>>06430000
           IF MVTABX'P THEN                                    <<56.PV>>06432000
            TOS := DIRSTARTOFF (PARR,,,,MVTABX)                <<56.PV>>06434000
           ELSE                                                <<56.PV>>06436000
            TOS := DIRSTARTOFF (PARR);                         <<56.PV>>06438000
           SIRRETURN := DSIR;                                  <<56.PV>>06440000
       END;                                                    <<56.PV>>06442000
   END                                                         <<56.PV>>06444000
   ELSE                                                        <<42.PV>>06446000
    IF MVTABX'P THEN                                           <<42.PV>>06448000
     TOS := DIRSTARTOFF (PARR,,,,MVTABX)                       <<42.PV>>06450000
    ELSE                                                       <<42.PV>>06452000
     TOS := DIRSTARTOFF (PARR);                                <<42.PV>>06454000
   IF DS1 <> 0D THEN GOTO BADEXIT;                                      06456000
   IF CARRY THEN GOTO GOODEXIT;                                         06458000
   << (2 ZEROS ON STACK) >>                                             06460000
   IF LOGICAL (TYPE.(ALLFLAG)) THEN                                     06462000
      DIRSCANTREE (XINDEXP, TYPE.(TOLEVELF), RECIP, @PARMS)             06464000
   ELSE                                                                 06466000
      BEGIN                                                             06468000
      TOS := XINDEXP;            << MAKE USE OF 2 ZEROS >>              06470000
      TOS := DIRFIND (*);        << VISIT ROOT >>                       06472000
      ASSEMBLE (DTST, ZROB);     << SETUP FOR DIRDOENTRY >>             06474000
      IF = THEN                                                         06476000
         BEGIN                                                          06478000
         ASSEMBLE (DDEL);                                               06480000
         TOS := TYPE.(ENDLEVELF);                                       06482000
         TOS := 2;                                                      06484000
BADEXIT: TOS := CCG;                                                    06486000
         GOTO EXIT;                                                     06488000
         END;                                                           06490000
      DIRDOENTRY (*, TYPE.(TOLEVELF), RECIP, @PARMS, TRUE);    <<56.PV>>06492000
      TOS := 0D;                                                        06494000
      END;                                                              06496000
                                                                        06498000
GOODEXIT:                                                               06500000
   IF DADIRTY THEN DIRWRITE (A);                                        06502000
   IF DBDIRTY THEN DIRWRITE (B);                                        06504000
   TOS := CCE;                                                          06506000
EXIT:                                                                   06508000
   CC := TOS;                                                           06510000
   DIRECSCAN := TOS;                                                    06512000
   RELSIR (DIRSIR, SIRRETURN);                                          06514000
   EXCHANGEDB (0);                                                      06516000
   END    <<DIRECSCAN>>;                                                06518000
                                                                        06520000
INTEGER PROCEDURE DIRECLOGON(MASK,JMATENTRY,CONTIME,CPUTIME,   <<02.EB>>06522000
      AENTRY,UENTRY,GENTRY);                                   <<02.EB>>06524000
   VALUE MASK, CONTIME, CPUTIME;                                        06526000
   INTEGER MASK;                                                        06528000
   ARRAY JMATENTRY,AENTRY,UENTRY,GENTRY;                       <<02.EB>>06530000
   DOUBLE CONTIME, CPUTIME;                                             06532000
   OPTION PRIVILEGED, UNCALLABLE;                                       06534000
BEGIN                                                                   06536000
   ENTRY DIRECLOGOFF;                                                   06538000
                                                                        06540000
COMMENT THESE ROUTINES DO DIRECTORY JUGGLING FOR LOGON AND     <<05.EB>>06542000
   LOGOFF.  ESSENTIALLY, THIS INCLUDES:                                 06544000
   1. FINDING (RETURNING FOR LOGON) THE ACCOUNT, GROUP AND USER ENTRIES.06546000
   2. DECREMENTING (INCREMENTING FOR LOGON) THEN FOLLOWING:             06548000
      A. USER ENTRY LOGON COUNT,                                        06550000
      B. ACCT/GROUP INDEX POINTER COUNT,                                06552000
      C. GROUP/FILE INDEX POINTER COUNT.                                06554000
   3. FOR LOGOFF, UPDATE THE ACCT AND GROUP CONNECT AND CPU TIMES.      06556000
   INPUT PARAMETERS:                                                    06558000
      <MASK>                                                            06560000
         LOGON - MUST BE 0.                                             06562000
         LOGOFF                                                         06564000
            = 0 ACCT/USER/GROUP EXIST,                                  06566000
            = 1 ACCT/USER EXIST, NO GROUP,                     <<05.EB>>06568000
            = 2 NO ACCT,                                       <<05.EB>>06570000
            = 3 ACCT EXISTS, NO USER,                          <<05.EB>>06572000
            = 4 ACCT/USER EXIST, NO HOME GROUP SPEC.,          <<05.EB>>06574000
      <JMATENTRY> THE FULL JMATENTRY IN STACK.  USED TO GET THE ACCOUNT,06576000
         GROUP AND USER NAMES.                                          06578000
      <CONTIME> AND <CPUTIME>                                           06580000
         LOGON - IGNORED,                                               06582000
         LOGOFF - TIMES USED FOR UPDATE (IF MASK = 0).                  06584000
   RETURNS:                                                             06586000
      LOGON - SAME AS <MASK>, LOGOFF.                                   06588000
      LOGOFF                                                            06590000
            .(15:1) ACCT CONNECT EXCEEDED,                              06592000
            .(14:1) ACCT CPU                                            06594000
            .(13:1) GROUP CONNECT                                       06596000
            .(12:1) GROUP CPU.                                          06598000
            .(11:1)         ACCT CONNECT TIME NEGATIVE         <<04282>>06600000
            .(10:1)         GROUP CONNECT TIME NEGATIVE        <<04282>>06602000
            .( 9:1)         ACCT CPU TIME NEGATIVE             <<04282>>06604000
            .( 8:1)         GROUP CPU TIME NEGATIVE            <<04282>>06606000
;                                                              <<05.EB>>06608000
                                                                        06610000
   INTEGER POINTER   PS0               = S-0;                           06612000
   INTEGER           ADJUST            = WORKAREA;                      06614000
   DOUBLE            DDDSENTRY1        = DDS,                           06616000
                     DDDSENTRY2        = DDS +2;                        06618000
                                                                        06620000
   INTEGER           SAVESIR,                                           06622000
                     SAVEAGI,                                           06624000
                     RESULT            = DIRECLOGON,                    06626000
                     INCRDECR          := +1;                           06628000
   LOGICAL           OFFLAG            := FALSE;                        06630000
   ARRAY             LOCALAGU (0:15) = Q;                               06632000
   DOUBLE            LAN1              = LOCALAGU +4,                   06634000
                     LAN2              = LOCALAGU +6,                   06636000
                     LUN1              = LOCALAGU,                      06638000
                     LUN2              = LOCALAGU +2,                   06640000
                     LGN1              = LOCALAGU +12,                  06642000
                     LGN2              = LOCALAGU +14;                  06644000
   INTEGER                                                     <<02.EB>>06646000
      DLOFFSET,                                                <<02.EB>>06648000
      AENTRYDL,                                                <<02.EB>>06650000
      UENTRYDL,                                                <<02.EB>>06652000
      GENTRYDL;                                                <<02.EB>>06654000
   LOGICAL LOGONGROUP = LGN1;                                  <<05.EB>>06656000
                                                                        06658000
                                                                        06660000
   GOTO START;                                                          06662000
                                                                        06664000
                                                                        06666000
DIRECLOGOFF:                                                            06668000
   OFFLAG := TRUE;                                                      06670000
   INCRDECR := -1;                                                      06672000
                                                                        06674000
                                                                        06676000
START:                                                                  06678000
   RESULT := 0;                                                         06680000
   IF MASK = 2 THEN RETURN; << NO ACCT >>                      <<05.EB>>06682000
   MOVE LOCALAGU := JMATENTRY(2), (16);                                 06684000
   PUSH (DL);                                                           06686000
   DLOFFSET := S0;                                             <<02.EB>>06688000
   AENTRYDL := @AENTRY -DLOFFSET;                              <<02.EB>>06690000
   UENTRYDL := @UENTRY -DLOFFSET;                              <<02.EB>>06692000
   GENTRYDL := @GENTRY -DLOFFSET;                              <<02.EB>>06694000
   IF EXCHANGEDB(DDSDST) <> 0 THEN SYSABORT(DIRBADDST);        <<DE>>   06696000
   SAVESIR := GETSIR (DIRSIR);                                          06698000
   SYSVSDIRBASE;                                               <<32.PV>>06700000
   DIRBASE := TOS;                                             <<32.PV>>06702000
   XTYPE := GROUPLEVEL & LSL (3); <<PREVENT DIRBASE SWITCH>>   <<52.PV>>06704000
   IF DADIRTY OR DBDIRTY THEN SYSABORT (DIRABERR);             <<DE>>   06706000
   ADJUST := -TOS;                                                      06708000
   DDDSENTRY1 := LAN1;                 <<FIND ACCT>>                    06710000
   DDDSENTRY2 := LAN2;                                                  06712000
   TOS := DIRFIND (SYSACCTINDEX);                                       06714000
   ASSEMBLE (DTST, DELB);                                               06716000
   IF = THEN                                                            06718000
      BEGIN                                                             06720000
      IF OFFLAG THEN SYSABORT (DIRLOGERR);                     <<DE>>   06722000
      RESULT := 2; << NO ACCT >>                               <<05.EB>>06724000
      GOTO EXIT;                                                        06726000
      END;                                                              06728000
   SAVEAGI := PS0 (AGIPNTR);              <<SAVE AGI INDEX P>>          06730000
   IF OFFLAG THEN                                                       06732000
      BEGIN                                                             06734000
      IF MASK = 0 THEN                                                  06736000
         BEGIN                                                          06738000
         IF (DPS0 (ACPUCOUNTD) := DPS0 (ACPUCOUNTD) +CPUTIME) >         06740000
            DPS0 (ACPULIMITD) THEN RESULT.(14:1) := 1;                  06742000
         IF CONTIME < 0D THEN                                  <<04282>>06744000
              BEGIN                                            <<04282>>06746000
              RESULT.(11:1) := 1;  << ACCT CONNECT NEGATIVE >> <<04282>>06748000
              CONTIME := 0D;  << RESET CONNECT TIME FOR ACCOUNT<<04282>>06750000
              END;                                             <<04282>>06752000
         IF CPUTIME < 0D THEN                                  <<04282>>06754000
              BEGIN                                            <<04282>>06756000
              RESULT.(9:1) := 1;  << THIS IS A HOOK INTO SYSTEM<<04282>>06758000
              CPUTIME := 0D; <<RESET CPU TIME >>               <<04282>>06760000
              END;                                             <<04282>>06762000
         IF (DPS0 (ACONTIMECOUNTD) := DPS0 (ACONTIMECOUNTD) +           06764000
            CONTIME) > DPS0 (ACONTIMELIMITD) THEN                       06766000
               RESULT.(15:1) := 1;                                      06768000
         DIRWRITE (A);                                                  06770000
         END;                                                           06772000
      END                                                               06774000
   ELSE                                                                 06776000
      BEGIN                            <<LOGON: RETURN ENTRY>>          06778000
      TOS := AENTRYDL;                                         <<02.EB>>06780000
      ASSEMBLE (DDUP, DEL);                                             06782000
      TOS := ASIZE;                                                     06784000
      ASSEMBLE (MVBL);                                                  06786000
      END;                                                              06788000
                                                                        06790000
   IF MASK = 3 THEN GO EXIT;<<LOGOFF:NO USER AT LOGON>>        <<05.EB>>06792000
   DDDSENTRY1 := LUN1;                 <<FIND USER>>                    06794000
   DDDSENTRY2 := LUN2;                                                  06796000
   TOS := DIRFIND (PS0(AUIPNTR));                                       06798000
   ASSEMBLE (DTST, DELB);                                               06800000
   IF = THEN                                                            06802000
      BEGIN                                                             06804000
      IF OFFLAG THEN SYSABORT (DIRLOGERR);                     <<DE>>   06806000
      RESULT := 3; << NO USER>>                                <<05.EB>>06808000
      GOTO EXIT;                                                        06810000
      END;                                                              06812000
   PS0 (ULOGCOUNT) := PS0(ULOGCOUNT) +INCRDECR;    <<ADJUST LOGON CNT>> 06814000
   DIRWRITE (A);                                                        06816000
   IF MASK >= 1 THEN GO EXIT;<<LOGOFF:NO GROUP AT LOGON >>     <<05.EB>>06818000
   IF NOT (OFFLAG) THEN                                                 06820000
      BEGIN                            <<LOGON: RETURN USER ENTRY>>     06822000
      TOS := UENTRYDL;                                         <<02.EB>>06824000
      ASSEMBLE (DDUP, DEL);                                             06826000
      TOS := USIZE;                                                     06828000
      ASSEMBLE (MVBL);                                                  06830000
      IF LOGONGROUP = "  " THEN                                <<05.EB>>06832000
         BEGIN <<NO GRP., USE HOME GRP. IN U. ENTRY>>          <<05.EB>>06834000
         LGN1 := DPS0(UHGROUP/2);                              <<05.EB>>06836000
         LGN2 := DPS0(UHGROUP/2 +1);                           <<05.EB>>06838000
         IF LOGONGROUP = "  " THEN                             <<05.EB>>06840000
            BEGIN << NO HOME GROUP EXISTS >>                   <<05.EB>>06842000
            RESULT := 4;                                       <<05.EB>>06844000
            GO EXIT;                                           <<05.EB>>06846000
            END;                                               <<05.EB>>06848000
         END;                                                  <<05.EB>>06850000
      END;                                                              06852000
                                                                        06854000
   DDDSENTRY1 := LGN1;                 <<FIND GROUP>>                   06856000
   DDDSENTRY2 := LGN2;                                                  06858000
   TOS := DIRFIND (SAVEAGI);                                            06860000
   ASSEMBLE (DTST, DELB);                                               06862000
   IF = THEN                                                            06864000
      BEGIN                                                             06866000
      IF OFFLAG THEN SYSABORT (DIRLOGERR);                     <<DE>>   06868000
      RESULT := 1; << NO GROUP >>                              <<05.EB>>06870000
      GOTO EXIT;                                                        06872000
      END;                                                              06874000
   IF OFFLAG THEN                                                       06876000
      BEGIN                                                             06878000
         IF CONTIME < 0D THEN                                  <<04282>>06880000
              BEGIN                                            <<04282>>06882000
              RESULT.(10:1) := 1; << GROUP CONNECT TIME NEGATIV<<04282>>06884000
              CONTIME := 0D;  << RESET CON. TIME FOR ACCOUNTING<<04282>>06886000
              END;                                             <<04282>>06888000
         IF CPUTIME < 0D THEN                                  <<04282>>06890000
              BEGIN                                            <<04282>>06892000
              RESULT.(8:1) := 1; << THIS IS A HOOK INTO SYSTEM <<04282>>06894000
              CPUTIME := 0D; <<RESET CPUTIME >>                <<04282>>06896000
              END;                                             <<04282>>06898000
      TOS := TOS +GCPUCOUNT;                                            06900000
      IF (DPS0 := DPS0 +CPUTIME) > DPS0(1) THEN                         06902000
         RESULT.(12:1) := 1;                                            06904000
      IF (DPS0(2) := DPS0(2) +CONTIME) > DPS0(3) THEN                   06906000
         RESULT.(13:1) := 1;                                            06908000
      TOS := TOS -GCPUCOUNT;                                            06910000
      DIRWRITE (A);                                                     06912000
      END                                                               06914000
   ELSE                                                                 06916000
      BEGIN                               <<LOGON: RETURN ENTRY>>       06918000
      TOS := GENTRYDL;                                         <<02.EB>>06920000
      ASSEMBLE (DDUP, DEL);                                             06922000
      TOS := GSIZE;                                                     06924000
      ASSEMBLE (MVBL);                                                  06926000
      END;                                                              06928000
   DBPCOUNT := DBPCOUNT +INCRDECR;     <<ADJUST INDEX POINTER COUNTERS>>06930000
   DIRWRITE (B);                                                        06932000
   TOS := IF PS0 (GLINKAGE).(PVF) = PV AND                     <<37.PV>>06934000
             PS0 (GLINKAGE).(MVTABXF) <> 0 THEN                <<37.PV>>06936000
           PS0 (GSAVEFIPNTR) ELSE                              <<37.PV>>06938000
           PS0 (GFIPNTR);                                      <<37.PV>>06940000
   DIRREAD (*, B, 0, 0);                                       <<37.PV>>06942000
   DBPCOUNT := DBPCOUNT + INCRDECR;                                     06944000
   DIRWRITE (B);                                                        06946000
                                                                        06948000
EXIT:                                                                   06950000
   RELSIR (DIRSIR, SAVESIR);                                            06952000
   EXCHANGEDB (0);                                                      06954000
   END    <<DIRECLOGON / DIRECLOGOFF>>;                                 06956000
$CONTROL SEGMENT=MAIN                                                   06958000
                                                                        06960000
                                                                        06962000
                                                                        06964000
END.    << OUTER BLOCK >>                                      <<DE>>   06966000
