$CONTROL MAP,CODE,USLINIT                                               00010000
<< dirc - module 53 >>                                                  00012000
<< hp32002c mpe source c.00.00 >>                                       00014000
$copyright     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$set x0=off << if on then debug code compiled >>                        00028000
$set x8=on                                                     <<l7749>>00030000
$control segment= dirc                                                  00032000
$control uncallable                                                     00034000
$thirty                                                                 00036000
begin                                                                   00038000
                                                                        00040000
equate                                                         <<de>>   00042000
   namesize        = 4;  << unpacked representation >>         <<de>>   00044000
                                                               <<de>>   00046000
                                                               <<de>>   00048000
           << directory suddendeath errors >>                  <<de>>   00050000
                                                               <<de>>   00052000
define  sysabort     = suddendeath#;                           <<de>>   00054000
equate  dirioab      = 400,   << directory i/o disc error   >> <<de>>   00056000
        dirbaddst    = 401,   << bad dst number             >> <<de>>   00058000
        diraberr     = 402,   << process error in dds buff  >> <<de>>   00060000
        dirbiterr    = 403,   << directory bitmap error     >> <<de>>   00062000
                    << 404       from file system           >> <<de>>   00064000
        dirinerr     = 405,   << error adding new ent or inx>> <<de>>   00066000
        dirlogerr    = 406,   << directory error log on/off >> <<de>>   00068000
        dirallocerr  = 407,   << bad bitmap alloc/dealloc   >> <<de>>   00070000
        dirvsderr    = 415,   << error adding vsd ent or inx>> <<de>>   00072000
        dirpvbinderr = 418,   << pv bind or ref cnt error   >> <<de>>   00074000
                                                               <<de>>   00076000
                                                               <<de>>   00078000
          <<  directory block sizes >>                         <<de>>   00080000
                                                               <<de>>   00082000
        syssaibsize  =  3,    << sysaccount index block size>> <<de>>   00084000
        sysauibsize  =  1,    << account/user  index block  >> <<de>>   00086000
        sysagibsize  =  1,    << account/group index block  >> <<de>>   00088000
        sysgfibsize  =  2,    << group/files   index block  >> <<de>>   00090000
        sysgvsibsize =  1,    << group/vsd     index block  >> <<de>>   00092000
        sysaebsize   =  3,    << account entry block size   >> <<de>>   00094000
        sysuebsize   =  2,    << user    entry block size   >> <<de>>   00096000
        sysgebsize   =  2,    << group   entry block size   >> <<de>>   00098000
        sysfebsize   =  2,    << files   entry block size   >> <<de>>   00100000
        sysvsebsize  =  1,    << vsd     etnry block size   >> <<de>>   00102000
                                                                        00104000
        ddsbsize     =  3,    << maximum block sector size  >> <<de>>   00106000
        ddsbwsize    = %600;  << maximum block word  size   >> <<de>>   00108000
$page "DIRECTORY DATA STRUCTURE"                               <<de>>   00110000
equate                                                         <<de>>   00112000
                                                                        00114000
<< account entry >>                                                     00116000
   aname           = 0,                  <<name>>                       00118000
   agipntr         = aname+namesize,     <<group index pntr>>           00120000
   auipntr         = agipntr+1,          <<user index pntr>>            00122000
   acap            = auipntr+1,          <<capability>>                 00124000
   alattr          = acap+2,                                            00126000
   apass           = alattr+2,                                          00128000
   adfscount       = apass+namesize,     <<disc file space>>            00130000
   adfscountd      = adfscount /2,                                      00132000
   adfslimit       = adfscount+2,                                       00134000
   adfslimitd      = adfslimit /2,                                      00136000
   acpucount       = adfslimit+2,        <<cpu time>>                   00138000
   acpucountd      = acpucount /2,                                      00140000
   acpulimit       = acpucount+2,                                       00142000
   acpulimitd      = acpulimit /2,                                      00144000
   acontimecount   = acpulimit+2,        <<connect time>>               00146000
   acontimecountd  = acontimecount /2,                                  00148000
   acontimelimit   = acontimecount+2,                                   00150000
   acontimelimitd  = acontimelimit /2,                                  00152000
   asecw           = acontimelimit+2,                                   00154000
   apurgeflagw     = asecw,                                             00156000
   amaxjobw        = asecw+1,            <<max. job priority (byte) >>  00158000
   aspare1         = amaxjobw+1,                                        00160000
   aspare2         = aspare1+1,                                         00162000
   asize           = aspare2 +1,                                        00164000
                                                                        00166000
<<group entry>>                                                         00168000
   gname           = 0,                  <<name>>                       00170000
   gfipntr         = gname+namesize,     <<file index (or volume) pntr>>00172000
   gpass           = gfipntr+1,          <<password>>                   00174000
   gdfscount       = gpass+namesize,     <<disc file space>>            00176000
   gdfslimit       = gdfscount+2,                                       00178000
   gcpucount       = gdfslimit+2,        <<cpu time>>                   00180000
   gcpulimit       = gcpucount+2,                                       00182000
   gcontimecount   = gcpulimit+2,                                       00184000
   gcontimelimit   = gcontimecount+2,                                   00186000
   gsec            = gcontimelimit+2,                                   00188000
   gpurgeflagw     = gsec,                                              00190000
   gcap            = gsec +2,                                           00192000
   glinkage        = gcap+1,                                   <<01.pv>>00194000
   gvsdipntr       = glinkage+1,         <<vs def index pntr>> <<02.pv>>00196000
   ghvsname        = gvsdipntr+1,        <<home vs name>>      <<02.pv>>00198000
   ghvsaname       = ghvsname,           << "   "  acct name>> <<02.pv>>00200000
   ghvsgname       = ghvsaname+namesize, << "   "  grp  name>> <<02.pv>>00202000
   ghvsvsname      = ghvsgname+namesize, << "   "  vs   name>> <<02.pv>>00204000
   gsavefipntr     = ghvsvsname+namesize,<<saves gfipntr>>     <<13.pv>>00206000
   gmountrefcntr   = gsavefipntr+1,      <<mount use counter>> <<13.pv>>00208000
   gspare          = gmountrefcntr+1,                          <<13.pv>>00210000
   gsize           = gspare+1;                                 <<16.pv>>00212000
<<glinkage definitions>>                                       <<01.pv>>00214000
define                                                         <<01.pv>>00216000
   pvf             = 0:1 #,                                    <<01.pv>>00218000
   mvtabxf         = 8:8 #;                                    <<01.pv>>00220000
equate                                                         <<01.pv>>00222000
   pv              = 1,                                        <<01.pv>>00224000
   vmax            = 8,                  <<vs membership max>> <<43.pv>>00226000
                                                                        00228000
<<file entry >>                                                         00230000
   fname           = 0,                  <<name>>                       00232000
   fvolpntrw       = fname+namesize,     <<volume table pointer>>       00234000
   flabelpntrw     = fvolpntrw,          <<file label pointer>>         00236000
   fsize           = flabelpntrw+2,                                     00238000
                                                                        00240000
<<user entry>>                                                          00242000
   uname           = 0,                  <<name>>                       00244000
   ucap            = uname+namesize,     <<capability>>                 00246000
   ulattr          = ucap+2,                                            00248000
   upass           = ulattr+2,                                          00250000
   uhgroup         = upass+namesize,     <<home group>>                 00252000
   ulogcount       = uhgroup+namesize,   <<# of users logged on under>> 00254000
   umaxjob         = ulogcount+1,                                       00256000
   upurgeflagw     = umaxjob,                                           00258000
   uspare          = umaxjob +1,                                        00260000
   usize           = uspare +1,                                         00262000
                                                                        00264000
<<volume set definition entry>>                                <<02.pv>>00266000
   gvsname         = 0,                  <<volume set name>>   <<02.pv>>00268000
   gvslinkagew     = gvsname+namesize,   <<mvtab linkage>>     <<02.pv>>00270000
   gvsinfo         = gvslinkagew+1,      <<definition info>>   <<02.pv>>00272000
   gvsmembers      = gvsinfo+1,          <<vmax members>>      <<02.pv>>00274000
                                         <<member info>>       <<02.pv>>00276000
                                         <<vmax members>>      <<02.pv>>00278000
   gvsvolname      = gvsmembers,         <<member name>>       <<02.pv>>00280000
   gvsvolflags     = gvsvolname+namesize,<<member stat flags>> <<02.pv>>00282000
   gvsvolinfo      = gvsvolflags+1,      <<member attribs>>    <<02.pv>>00284000
   gvsmembsz       = gvsinfo-gvsname+1,                        <<15.pv>>00286000
   gvsdrefcnt      = gvsmembsz*(vmax+1),                       <<58.pv>>00288000
   gvsdspare2      = gvsdrefcnt+1,                             <<58.pv>>00290000
   gvsdsize        = gvsdspare2+1,                             <<58.pv>>00292000
<<volume class definition entry>>                              <<02.pv>>00294000
   gvcname        = 0,                   <<volume class name>> <<02.pv>>00296000
   gvclinkagew     = gvcname+namesize,                         <<02.pv>>00298000
   gvcinfo         = gvclinkagew+1,      <<definition info>>   <<02.pv>>00300000
   gvcpname        = gvcinfo+1,          <<parent def  name>>  <<02.pv>>00302000
   gvcpaname       = gvcpname,           <<  "    ACCT   " >>  <<02.pv>>00304000
   gvcpgname       = gvcpaname+namesize, <<  "    GRP    " >>  <<02.pv>>00306000
   gvcpvsname      = gvcpgname+namesize, <<  "    VS     " >>  <<02.pv>>00308000
   gvcunused       = gvcpvsname+namesize,                      <<02.pv>>00310000
   gvcdsize        = gvsdsize,                                 <<02.pv>>00312000
                                                               <<02.pv>>00314000
   maxentrysize    = gvsdsize,                                 <<02.pv>>00316000
                                                                        00318000
                   <<index>>                                            00320000
                                                                        00322000
                                                                        00324000
   ie1stname       = 0,                  <<1st name of entry block>>    00326000
   iepntr          = ie1stname+namesize, <<pntr to it >>                00328000
   iecount         = iepntr+1,           <<# of entries in it>>         00330000
   isize           = iecount+1;                                         00332000
                                                                        00334000
                                                                        00336000
define                                                                  00338000
   apurgeflagf     = 0:1 #,                                             00340000
   gpurgeflagf     = 0:1 #,                                             00342000
   upurgeflagf     = 0:1 #;                                             00344000
equate                                                                  00346000
   goneflag        = 1;                                                 00348000
                                                                        00350000
                                                                        00352000
                      <<index block prefix>>                            00354000
                                                                        00356000
                                                                        00358000
equate                                                                  00360000
   premiscwd       = 0;                                                 00362000
define                                                                  00364000
   typef           = 0:1 #;                                             00366000
equate                                                                  00368000
   indextype       = 1,                                                 00370000
   entrytype       = 0;                                                 00372000
define                                                                  00374000
   ipurgeflagf     = 1:1 #,                                             00376000
   levelf          = 2:3 #;                                    <<02.pv>>00378000
equate                                                                  00380000
   filelevel       = 0,                                                 00382000
   grouplevel      = 1,                                                 00384000
   accountlevel    = 2,                                                 00386000
   userlevel       = 3,                                        <<02.pv>>00388000
   vsdeflevel      = 4;                                                 00390000
define                                                                  00392000
   xsizef          = 5:7 #,                                    <<02.pv>>00394000
   bsizef          = 12:4 #;                                   <<02.pv>>00396000
equate                                                                  00398000
   prexcount       = premiscwd+1,        <<element count>>              00400000
   prepcount       = prexcount+1,        <<pointer ref. count>>         00402000
   preetotal       = prepcount+1,        <<total entries count >>       00404000
   preemiscwd      = preetotal+1,                                       00406000
   prepindexp      = preemiscwd+1,       <<index pntr in which father>> 00408000
   prepname        = prepindexp+1,       <<father's name (if any)>>     00410000
   presize         = prepname+namesize;                                 00412000
                                                                        00414000
define                                                                  00416000
   sysglobdirbase  = absolute (%1130)#,                                 00418000
   sgdirbase1      = absolute (%1130)#,                                 00420000
   sgdirbase2      = absolute (%1131)#,                                 00422000
   asmb            = assemble#;                                         00424000
equate                                                                  00426000
   xx              = 22,                                                00428000
   zz              = 139,                                      <<38.pv>>00430000
   sysldev         = 1,                                                 00432000
   dirsir          = 8;                                                 00434000
define                                                                  00436000
   dirioaddr       = sysldev#;                                          00438000
define                                                         <<32.pv>>00440000
    sysvsdirbase = tos := sgdirbase1;                          <<32.pv>>00442000
                   tos.(0:8) := sysldev;                       <<32.pv>>00444000
                   tos := sgdirbase2 #;                        <<32.pv>>00446000
$page "DIRECTORY DATA SEGMENT BUFFERS"                         <<de>>   00448000
                   <<directory data segment (dds)>>                     00450000
                                                                        00452000
                                                                        00454000
equate                                                                  00456000
   ddsdst          = 20;                                                00458000
array                                                                   00460000
   dds(*)          = db+0,                                              00462000
   ddsentry(*)     = dds,                                               00464000
   ddsname(*)      = dds,                                               00466000
   workarea (*)    = dds(128);                                          00468000
integer           << variables set by dirstartoff >>                    00470000
   adjust         = workarea,            <<dl-db>>                      00472000
   xtype          = adjust +1;           <<input parm>>        <<38.pv>>00474000
double                                                         <<38.pv>>00476000
   xlinkage'indexp= xtype+1;                                   <<38.pv>>00478000
integer                                                        <<38.pv>>00480000
   xmvtabx        = xlinkage'indexp,                           <<38.pv>>00482000
   xindexp        = xmvtabx+1,           <<final index pntr>>  <<38.pv>>00484000
   xaname         = xindexp +1,          <<db-rel addrs>>               00486000
   xguname        = xaname +1,                                          00488000
   xfname         = xguname +1,                                         00490000
   xasec          = xfname +1;           <<acct security>>              00492000
double                                                                  00494000
   xgsec          = xasec +1;            <<group security>>             00496000
logical                                                                 00498000
   sirreturn      = xgsec +2;            <<from getsir>>                00500000
equate                                   <<disps into prepre>>          00502000
   dirbase'        = 0,                  <<ldev of contents>>  <<01.pv>>00504000
   dirbase1'       = dirbase',                                 <<01.pv>>00506000
   dirbase2'       = dirbase1'+1,                              <<01.pv>>00508000
   contents        = dirbase2'+1,        <<directory p. pntr>> <<01.pv>>00510000
   lpntr           = contents+1,         <<db addr of 1st element>>     00512000
   iopntr          = lpntr+1,            <<block starting addr>>        00514000
   numvalid        = iopntr+1,           <<# valid dir pp after iopntr>>00516000
   dirty           = numvalid+1,                                        00518000
   flags           = dirty,                                             00520000
   xsize           = dirty+1,                                           00522000
   used            = xsize+1,            <<=xsize * xcount>>            00524000
   bsize           = used+1,             <<block size (pp.)>>           00526000
   bwsize          = bsize+1,            <<= bsize & lsr(7)>>           00528000
   bfactor         = bwsize+1,           <<= bwsize/xsize>>             00530000
   miscwd          = bfactor+1,                                         00532000
   xcount          = miscwd+1,                                          00534000
   pcount          = xcount+1,                                          00536000
   etotal          = pcount+1,                                          00538000
   emiscwd         = etotal+1,                                          00540000
   pindexp         = emiscwd+1,                                         00542000
   pname           = pindexp+1;                                         00544000
                                                                        00546000
                                                                        00548000
array                                                                   00550000
   daprepre(*)     = dds(zz);                                           00552000
double                                                         <<01.pv>>00554000
   dadirbase       = daprepre+dirbase';                        <<01.pv>>00556000
logical                                                                 00558000
   dacontents      = daprepre+contents;                                 00560000
logical pointer                                                         00562000
   dalpntr         = daprepre+lpntr,                                    00564000
   daiopntr        = daprepre+iopntr;                                   00566000
integer                                                                 00568000
   danumvalid      = daprepre+numvalid;                                 00570000
logical                                                                 00572000
   daflags'dirty   = daprepre+dirty;                                    00574000
define                                                                  00576000
    flagsf         = (0:8) #,                                           00578000
    dirtyf         = (15:1) #,                                 <<06.pv>>00580000
    badelmf        = (0:1) #,                                           00582000
    daflags        = daflags'dirty.flagsf #,                            00584000
    dadirty        = daflags'dirty.dirtyf #,                            00586000
    dabadelm       = daflags'dirty.badelmf#;                            00588000
integer                                                                 00590000
   daxsize         = daprepre+xsize,                                    00592000
   daused          = daprepre+used,                                     00594000
   dabsize         = daprepre+bsize,                                    00596000
   dabwsize        = daprepre+bwsize,                                   00598000
   dabfactor       = daprepre+bfactor,                                  00600000
   damiscwd        = daprepre+miscwd;                                   00602000
define                                                                  00604000
   datype          = integer (damiscwd.(typef)) #,             <<02.pv>>00606000
   dalevel         = integer (damiscwd.(levelf)) #;            <<02.pv>>00608000
array                                                                   00610000
   dapre (*)       = daprepre(miscwd);                                  00612000
integer                                                                 00614000
   daxcount        = daprepre+xcount,                                   00616000
   dapcount        = daprepre+pcount;                                   00618000
logical                                                                 00620000
   daetotal        = daprepre+etotal,                                   00622000
   daemiscwd       = daprepre+emiscwd;                                  00624000
define                                                                  00626000
   daetype         = integer (daemiscwd.(typef)) #,                     00628000
   daelevel        = integer (daemiscwd.(levelf)) #,                    00630000
   daexsize        = integer (daemiscwd.(xsizef)) #,                    00632000
   daebsize        = integer (daemiscwd.(bsizef)) #;                    00634000
logical                                                                 00636000
   dapindexp       = daprepre+pindexp;                                  00638000
array                                                                   00640000
   dapname (*)     = daprepre(pname);                                   00642000
array                                                                   00644000
   dbprepre (*)    = daprepre(xx);                                      00646000
double                                                         <<01.pv>>00648000
   dbdirbase       = dbprepre+dirbase';                        <<01.pv>>00650000
logical                                                                 00652000
   dbcontents      = dbprepre+contents;                                 00654000
logical pointer                                                         00656000
   dblpntr         = dbprepre+lpntr,                                    00658000
   dbiopntr        = dbprepre+iopntr;                                   00660000
integer                                                                 00662000
   dbnumvalid      = dbprepre+numvalid;                                 00664000
logical                                                                 00666000
   dbflags'dirty   = dbprepre+dirty;                                    00668000
define                                                                  00670000
    dbflags        = dbflags'dirty.flagsf #,                            00672000
    dbdirty        = dbflags'dirty.dirtyf #,                            00674000
    dbbadelm       = dbflags'dirty.badelmf#;                            00676000
integer                                                                 00678000
   dbxsize         = dbprepre+xsize,                                    00680000
   dbused          = dbprepre+used,                                     00682000
   dbbsize         = dbprepre+bsize,                                    00684000
   dbbwsize        = dbprepre+bwsize,                                   00686000
   dbbfactor       = dbprepre+bfactor,                                  00688000
   dbmiscwd        = dbprepre+miscwd;                                   00690000
define                                                                  00692000
   dbtype          = integer (dbmiscwd.(typef)) #,             <<02.pv>>00694000
   dblevel         = integer (dbmiscwd.(levelf)) #;            <<02.pv>>00696000
array                                                                   00698000
   dbpre (*)       = dbprepre(miscwd);                                  00700000
integer                                                                 00702000
   dbxcount        = dbprepre+xcount,                                   00704000
   dbpcount        = dbprepre+pcount;                                   00706000
logical                                                                 00708000
   dbetotal        = dbprepre+etotal,                                   00710000
   dbemiscwd       = dbprepre+emiscwd;                                  00712000
define                                                                  00714000
   dbetype         = integer (dbemiscwd.(typef)) #,                     00716000
   dbelevel        = integer (dbemiscwd.(levelf)) #,                    00718000
   dbexsize        = integer (dbemiscwd.(xsizef)) #,                    00720000
   dbebsize        = integer (dbemiscwd.(bsizef)) #;                    00722000
logical                                                                 00724000
   dbpindexp       = dbprepre+pindexp;                                  00726000
array                                                                   00728000
   dbpname (*)     = dbprepre(pname);                                   00730000
                                                                        00732000
                                                                        00734000
integer                                                        <<01.pv>>00736000
   sysacctindex    = dbprepre+xx;                              <<de>>   00738000
double                                                                  00740000
   dirbase         = sysacctindex+1;                           <<de>>   00742000
integer                                                        <<01.pv>>00744000
   dirbase1        = dirbase,                                  <<01.pv>>00746000
   dirbase2        = dirbase1+1;                               <<01.pv>>00748000
define                                                         <<01.pv>>00750000
   dirldev         = dirbase1.(0:8) #;                         <<01.pv>>00752000
logical                                                        <<07103>>00754000
   pv'dir'size     = dirbase + 2,                              <<07103>>00756000
   dds'cnt         = pv'dir'size + 1;                          <<07103>>00758000
double                                                         <<de>>   00760000
   dds'cnt1        = dds'cnt+1,                                <<de>>   00762000
   dds'cnt2        = dds'cnt1+2,                               <<de>>   00764000
   dds'cnt3        = dds'cnt2+2,                               <<de>>   00766000
   dds'cnt4        = dds'cnt3+2,                               <<de>>   00768000
   dds'cnt5        = dds'cnt4+2;                               <<de>>   00770000
real                                                           <<de>>   00772000
   goodpercent     = dds'cnt5+2;                               <<de>>   00774000
logical pointer                                                         00776000
   base            = goodpercent+2;                                     00778000
integer pointer                                                         00780000
   ibase           = base;                                              00782000
double pointer                                                 <<07.pv>>00784000
   dbase           = base;                                     <<07.pv>>00786000
define                                                                  00788000
   whichdirty = base(dirty) #;                                          00790000
                                                                        00792000
<<----------------------------------------------------------->><<07103>>00794000
<< directory space management data segment defines           >><<07103>>00796000
<<----------------------------------------------------------->><<07103>>00798000
                                                               <<07103>>00800000
<< directory space management control data                   >><<07103>>00802000
                                                               <<07103>>00804000
logical  ds'base         = db + 0;                             <<07103>>00806000
double   ds'dir'addr     = ds'base;            << dir. addr. >><<07103>>00808000
define   ds'ldev         = ds'base.(0:8)#;     << dir. ldev  >><<07103>>00810000
logical  ds'last'word    = ds'dir'addr + 2;    << buf. last w>><<07103>>00812000
pointer  ds'first'word   = ds'last'word + 1;   << buf. firs.w>><<07103>>00814000
logical  ds'dir'size     = ds'first'word + 1;  << dir. size  >><<07103>>00816000
logical  ds'flags        = ds'dir'size + 1;    << dsm flags  >><<07103>>00818000
define   ds'dirty        = ds'flags.(0:1)#;    << buf. mod.  >><<07103>>00820000
define   ds'err'in'prog  = ds'flags.(1:1)#;    << in progress>><<07103>>00822000
define   ds'dir'disabled = ds'flags.(2:1)#;    << sys. disabl>><<07103>>00824000
define   ds'perm'disable = ds'flags.(3:1)#;    << perm. dis. >><<07103>>00826000
logical  ds'cur'sector   = ds'flags + 1;       << sec. in buf>><<07103>>00828000
double   ds'addr         = ds'cur'sector + 1;  << sec. addr. >><<07103>>00830000
integer  ds'addr1        = ds'addr;                            <<07103>>00832000
integer  ds'addr2        = ds'addr + 1;                        <<07103>>00834000
integer  ds'size         = ds'addr + 2;        << buf data sz>><<07103>>00836000
logical  ds'req'sector   = ds'size + 1;        << requested s>><<07103>>00838000
logical  ds'last'sector  = ds'req'sector + 1;  << bm last sec>><<07103>>00840000
logical  ds'sys'last     = ds'last'sector + 1; << saved buf p>><<07103>>00842000
logical  ds'sys'first    = ds'sys'last + 1;    << saved buf p>><<07103>>00844000
logical  ds'sys'cur      = ds'sys'first + 1;   << saved buf s>><<07103>>00846000
logical  ds'sys'size     = ds'sys'cur + 1;     << sys dir siz>><<07103>>00848000
logical  ds'error'ldev   = ds'sys'size + 1;    << bad dir ldv>><<07103>>00850000
logical  ds'error'type   = ds'error'ldev + 1;  << dir err typ>><<07103>>00852000
define   ds'header       = 18#;                << ds head sz >><<07103>>00854000
                                                               <<07103>>00856000
<< buffer area                                               >><<07103>>00858000
                                                               <<07103>>00860000
array    ds'buffer (*)   = db + ds'header;     << buffer     >><<07103>>00862000
logical  ds'dir'last     = ds'buffer;          << sector 0 lw>><<07103>>00864000
logical  ds'dir'first    = ds'dir'last + 1;    << sector 0 fw>><<07103>>00866000
define   ds'dir'header   = 2#;                 << bm header  >><<07103>>00868000
define   ds'buf'size's   = 3#;                 << buf sz sec.>><<07103>>00870000
define   ds'buf'size'w   = %600#;              << buf sz word>><<07103>>00872000
define   ds'dst          = %25#;               << dsm dst    >><<07103>>00874000
                                                               <<07103>>00876000
<<----------------------------------------------------------->><<07103>>00878000
                                                                        00880000
$page "INCLPXG - PXGLOBAL INCLUDE FILE"                        <<l7749>>00882000
$include inclpxg                                               <<06560>>00884000
$page "INCLCAP - USER CAPABILITIES INCLUDE FILE"               <<l7749>>00886000
$include inclcap                                               <<06560>>00888000
$page "INCLJMAT - JOB MASTER TABLE INCLUDE FILE"               <<l7749>>00890000
$include incljmat                                              <<06560>>00892000
$page "INCLJIT - JOB INFORMATION TABLE INCLUDE FILE"           <<l7749>>00894000
$include incljit                                               <<06560>>00896000
$page "INCLSIR - SIR INCLUDE FILE"                             <<l7749>>00898000
$include inclsir                                               <<07102>>00900000
$page "INCLPCB - PROCESS CONTROL BLOCK INCLUDE FILE"           <<l7749>>00902000
$include inclpcb5                                              <<07102>>00904000
$page  "        "                                              <<de>>   00906000
<< flags to directory routines >>                                       00908000
equate                                                                  00910000
   a               = 0,                  <<block a>>                    00912000
   b               = 1,                                                 00914000
   e               = 0,                  <<exact search>>               00916000
   en              = 2,                  <<exact or next search>>       00918000
   ep              = 4,                  <<exact or preceeding search>> 00920000
   ea              = e+a,                                               00922000
   eb              = e+b,                                               00924000
   ena             = en+a,                                              00926000
   enb             = en+b,                                              00928000
   epa             = ep+a,                                              00930000
   epb             = ep+b;                                              00932000
define                                                                  00934000
   startlevelf     = 13:3 #,                                            00936000
   endlevelf       = 10:3 #,                                   <<03.pv>>00938000
   allflag         =  9:1 #,                                   <<03.pv>>00940000
   endlevelfx      =  9:4 #,                                   <<03.pv>>00942000
   tolevelf        =  6:3 #,                                   <<03.pv>>00944000
   hitflag         =  5:1 #;                                   <<03.pv>>00946000
equate                                                                  00948000
   allxxx          = %(2) 1000,                                <<07.pv>>00950000
   allaccts        = allxxx + accountlevel,                    <<07.pv>>00952000
   allgroups       = allxxx + grouplevel,                      <<07.pv>>00954000
   allusers        = allxxx + userlevel,                       <<07.pv>>00956000
   allfiles        = allxxx + filelevel,                       <<07.pv>>00958000
   allvsds         = allxxx + vsdeflevel;                               00960000
                                                                        00962000
                                                                        00964000
<< miscellaneous declarations >>                                        00966000
   integer                                                              00968000
      s0 = s-0,                                                         00970000
      s1 = s-1,                                                         00972000
      s2 = s-2,                                                         00974000
      s3 = s-3,                                                         00976000
      s4 = s-4,                                                         00978000
      s5 = s-5,                                                         00980000
      s6 = s-6,                                                <<28.pv>>00982000
      xreg = x;                                                         00984000
logical xr = x;                                                <<07103>>00986000
   integer deltaq = q-0;                                                00988000
   logical                                                              00990000
      ls0 = s-0,                                                        00992000
      ls1 = s-1,                                                        00994000
   ls2 = s-2,                                                           00996000
   ls3 = s-3,                                                           00998000
   ls4 = s-4,                                                  <<58.pv>>01000000
   ls5 = s-5;                                                  <<58.pv>>01002000
   integer pointer                                                      01004000
      ps6 = s-6,                                               <<58.pv>>01006000
      ps5 = s-5,                                               <<58.pv>>01008000
      ps4 = s-4,                                                        01010000
      ps3 = s-3,                                               <<58.pv>>01012000
      ps1 = s-1,                                                        01014000
      ps0 = s-0;                                                        01016000
   double                                                               01018000
      ds5 = s-5,                                                        01020000
      ds2 = s-2,                                                        01022000
      ds1 = s-1;                                                        01024000
   logical status = q-1;                                                01026000
   define                                                               01028000
      carryx = status.(5:1) #,                                          01030000
      cc = status.(6:2) #;                                              01032000
   equate                                                               01034000
      read  = 0,                                               <<43.pv>>01036000
      write = 1,                                               <<43.pv>>01038000
      dirio = %031001,                                         <<07329>>01040000
      cce = 2,                                                          01042000
      ccg = 0,                                                          01044000
      ccl = 1;                                                          01046000
   pointer s0pntr = s-0;                                                01048000
   double pointer                                                       01050000
      dps0 = s-0,                                                       01052000
      dps2 = s-2;                                                       01054000
   integer pointer s0ipntr = s-0;                                       01056000
   integer s0i     = s-0;                                               01058000
                                                                        01060000
   << mvtab definitions >>                                     <<de>>   01062000
   integer array mvtab (*)  =  db+0;                           <<de>>   01064000
   define                                                      <<de>>   01066000
           mvtabdst         =  53 #,                           <<de>>   01068000
           mvtabsz          =  %25 #,                          <<de>>   01070000
           acctindex        =  (0:8) #;  << of word 6 >>       <<de>>   01072000
                                                               <<de>>   01074000
   define                                                      <<de>>   01076000
      options = option privileged, uncallable #;               <<00175>>01078000
logical pointer pcb = 3;                                       <<07102>>01080000
                                                               <<06560>>01082000
   define                                                      <<06560>>01084000
      def'move'from'dst =                                      <<06560>>01086000
      move'from'dst (dbtarget, dstn, dstoffset, word'count);   <<06560>>01088000
      value          dbtarget, dstn, dstoffset, word'count;    <<06560>>01090000
      logical        dbtarget, dstn, dstoffset, word'count;    <<06560>>01092000
      begin                                                    <<06560>>01094000
      xreg := tos;      << save return address               >><<06560>>01096000
      assemble (mfds 0);                                       <<06560>>01098000
      tos := xreg;                                             <<06560>>01100000
      end#;                                                    <<06560>>01102000
                                                                        01104000
                                                                        01106000
intrinsic debug, ascii;                                        <<07103>>01108000
procedure help; option external;                               <<01.pv>>01110000
                                                               <<01.pv>>01112000
                                                               <<01.pv>>01114000
integer procedure lun (vtabinx, mvtabx);                       <<26.pv>>01116000
    value   vtabinx, mvtabx;                                   <<26.pv>>01118000
    integer vtabinx, mvtabx;                                   <<26.pv>>01120000
    option external;                                           <<26.pv>>01122000
                                                               <<26.pv>>01124000
                                                               <<26.pv>>01126000
procedure sysabort (n);                                                 01128000
   value n;                                                             01130000
   integer n;                                                           01132000
   option external;                                                     01134000
                                                                        01136000
                                                                        01138000
integer procedure exchangedb (dstnum);                         <<01.pv>>01140000
   value dstnum;                                                        01142000
   logical dstnum;                                                      01144000
   option external;                                                     01146000
                                                                        01148000
                                                                        01150000
integer procedure setsysdb;                                             01152000
   option external;                                                     01154000
                                                                        01156000
                                                                        01158000
procedure resetdb (a);                                                  01160000
   value a;                                                             01162000
   integer a;                                                           01164000
   option external;                                                     01166000
                                                               <<07102>>01168000
double procedure dirfind (index);                              <<07102>>01170000
   value   index;                                              <<07102>>01172000
   logical index;                                              <<07102>>01174000
   option  forward;                                            <<07102>>01176000
                                                               <<de>>   01178000
                                                               <<de>>   01180000
double procedure attachio ( ldev, qmisc, dx, t, func,          <<de>>   01182000
                            cnt, p1, p2, flgs);                <<de>>   01184000
   value   ldev, qmisc, dx, t, func, cnt, p1, p2, flgs;        <<de>>   01186000
   integer ldev, qmisc, dx, t, func, cnt, p1, p2, flgs;        <<de>>   01188000
   option  external;                                           <<de>>   01190000
                                                               <<de>>   01192000
                                                               <<de>>   01194000
double procedure frelspace (ldev, fpntr, mvtabx);              <<de>>   01196000
   value ldev, fpntr, mvtabx;                                  <<de>>   01198000
   integer ldev, mvtabx;                                       <<de>>   01200000
   double  fpntr;                                              <<de>>   01202000
   option  external, variable;                                 <<de>>   01204000
                                                               <<de>>   01206000
logical procedure getsir (num);                                <<de>>   01208000
   value num;                                                  <<de>>   01210000
   integer num;                                                <<de>>   01212000
   option external;                                            <<de>>   01214000
                                                               <<de>>   01216000
procedure relsir (num, a);                                     <<de>>   01218000
   value num, a;                                               <<de>>   01220000
   integer num;  logical a;                                    <<de>>   01222000
   option external;                                            <<de>>   01224000
                                                               <<de>>   01226000
logical procedure setcritical;                                 <<de>>   01228000
   option external;                                            <<de>>   01230000
                                                               <<de>>   01232000
procedure resetcritical (p);                                   <<de>>   01234000
   value p;                                                    <<de>>   01236000
   logical p;                                                  <<de>>   01238000
   option external;                                            <<de>>   01240000
                                                               <<07103>>01242000
procedure genmsg(setn,msg,m,p1,p2,p3,p4,p5,dest,r1,off,dst,io);<<07103>>01244000
   value         setn,msg,m,p1,p2,p3,p4,p5,dest,r1,off,dst,io; <<07103>>01246000
   integer       setn,msg,dest,dst,r1;                         <<07103>>01248000
   logical       m,p1,p2,p3,p4,p5,off,io;                      <<07103>>01250000
   option  external,variable;                                  <<07103>>01252000
                                                               <<07103>>01254000
procedure soft'death (n);                                      <<07103>>01256000
   value   n;                                                  <<07103>>01258000
   integer n;                                                  <<07103>>01260000
   option  external;                                           <<07103>>01262000
                                                               <<07103>>01264000
procedure dirxxxbitmap (func);                                 <<07103>>01266000
   value   func;                                               <<07103>>01268000
   integer func;                                               <<07103>>01270000
   option  forward;                                            <<07103>>01272000
                                                               <<07103>>01274000
$page "Directory Space Management"                             <<07103>>01276000
<<***********************************************************>><<07103>>01278000
<<                                                           >><<07103>>01280000
<<                directory  space  management               >><<07103>>01282000
<<                                                           >><<07103>>01284000
<<***********************************************************>><<07103>>01286000
                                                               <<07103>>01288000
<<----------------------------------------------------------->><<07103>>01290000
<< the directory space management is a set of procedures     >><<07103>>01292000
<< which allows to allocate or deallocate directory space.   >><<07103>>01294000
<< to allocate the directory space the dirallocate procedure >><<07103>>01296000
<< with parameter size must be invoked. it will return the   >><<07103>>01298000
<< sector start address relative to the directory base. to   >><<07103>>01300000
<< deallocate the directory space the dirdeallocate procedure>><<07103>>01302000
<< should be invoked with two parameters (sector address and >><<07103>>01304000
<< size). if any io errors occurs during allocation or       >><<07103>>01306000
<< deallocation then the dsm of specific directory will be   >><<07103>>01308000
<< disabled.                                                 >><<07103>>01310000
<< the directory occupies contigious space on the disc. if it>><<07103>>01312000
<< is system directory it will be located on ldev 1 otherwise>><<07103>>01314000
<< on master volume of private volume set. the first sectors >><<07103>>01316000
<< (up to 32) are occupied by the directory bit map. the dir->><<07103>>01318000
<< rectory data (index and entry blocks) follows directory   >><<07103>>01320000
<< bit map. each bit in the directory bit map represents one >><<07103>>01322000
<< sector of the directory (that includes the directory bit  >><<07103>>01324000
<< map itself). the bit value of "1" in the directory bit map>><<07103>>01326000
<< indicates available sector. the dsm maintains the dir-    >><<07103>>01328000
<< rectory in the directory space data segment (%25). this   >><<07103>>01330000
<< data segment can handle up to 3 contigious sector of the  >><<07103>>01332000
<< directory bit map.                                        >><<07103>>01334000
<< if the dir. size is less than 6112 sectors then the dir.  >><<07103>>01336000
<< bit map will occupy 3 sectors. the dir. address will point>><<07103>>01338000
<< to the beginning of directory space. however if the dir.  >><<07103>>01340000
<< size is greater than 6112 sectors then the dir. bit map   >><<07103>>01342000
<< will use 32 sectors. the dir. address will point to 29-th >><<07103>>01344000
<< sector of the directory space. the dir. size is used as a >><<07103>>01346000
<< triger to obtain the address of the dir. bit map. in this >><<07103>>01348000
<< approach the account index block will be always at sector >><<07103>>01350000
<< 3 (relative to dir. addr.). it also implies that only 3   >><<07103>>01352000
<< sectors of the bit map are represented in the bit map.    >><<07103>>01354000
<<                                                           >><<07103>>01356000
<< in the ds data segment residue following control data:    >><<07103>>01358000
<< ds'dir'addr     - directory disc address including ldev,  >><<07103>>01360000
<< ds'last'word    - last available word in the buffer,      >><<07103>>01362000
<< ds'first'word   - first available word in the buffer,     >><<07103>>01364000
<< ds'dir'size     - directory size,                         >><<07103>>01366000
<< ds'dirty        - flag indicating modified data in buffer,>><<07103>>01368000
<< ds'err'in'prog  - erorr procedure in progress,            >><<07103>>01370000
<< ds'dir'disabled - system directory disabled,              >><<07103>>01372000
<< ds'perm'disable - permantently disable directory alloc.,  >><<07103>>01374000
<< ds'cur'sector   - sector start address in the buffer,     >><<07103>>01376000
<< ds'addr         - real address of sector in the buffer,   >><<07103>>01378000
<< ds'size         - size of data in the buffer,             >><<07103>>01380000
<< ds'req'sector   - requested sector to be read,            >><<07103>>01382000
<< ds'last'sector  - directory bit map last sector,          >><<07103>>01384000
<< ds'sys'last     - saved system directory last word,       >><<07103>>01386000
<< ds'sys'first    - saved system directory first word,      >><<07103>>01388000
<< ds'sys'cur      - saved system dircetory current sector,  >><<07103>>01390000
<< ds'error'ldev   - ldev of disabled directory,             >><<07103>>01392000
<< ds'error'type   - type of error when disabled.            >><<07103>>01394000
<< the buffer follows the above control data.                >><<07103>>01396000
<<----------------------------------------------------------->><<07103>>01398000
$page "Directory Space Management - DSM'ERROR"                 <<07103>>01400000
procedure dsm'error (sf, err);                                 <<07103>>01402000
   value   sf, err;                                            <<07103>>01404000
   logical sf, err;                                            <<07103>>01406000
   option  privileged, uncallable;                             <<07103>>01408000
                                                               <<07103>>01410000
<<----------------------------------------------------------->><<07103>>01412000
<< this procedure disables directory space allocation or     >><<07103>>01414000
<< deallocation of system directory when io error occured or >><<07103>>01416000
<< deallocating space which is already free. warmstart or    >><<07103>>01418000
<< coolstart will enable the directory space allocation/     >><<07103>>01420000
<< deallocation. for private volume directory only message is>><<07103>>01422000
<< printed. however if ds'perm'disable is set by initial then>><<07103>>01424000
<< the directory will be disabled permanently.               >><<07103>>01426000
<< it will modify the last and first available pointers in   >><<07103>>01428000
<< sector 0 of the directory bit map. the value of 2 of      >><<07103>>01430000
<< these pointers will indicate that dsm is diabled.         >><<07103>>01432000
<< additionaly the flag in the directory space dst will      >><<07103>>01434000
<< indicate if the system directory is disabled. when the    >><<07103>>01436000
<< dsm of specific directory becomes disabled then a         >><<07103>>01438000
<< following message will be printed on operator console:    >><<07103>>01440000
<< disc space management on ldev xx is disabled; err = y     >><<07103>>01442000
<< where err indicates error type (1-write, 2-read and       >><<07103>>01444000
<< 3-space already deallocated, 4-dsm is already disabled).  >><<07103>>01446000
<< this procedure calls also soft'death, so for debbuging    >><<07103>>01448000
<< purposes it can be turn to sudden'death when an absolute  >><<07103>>01450000
<< location %1350 bit 15 is set to 1.                        >><<07103>>01452000
<< some information about error status will be also kept in  >><<07103>>01454000
<< ds data segment.                                          >><<07103>>01456000
<<----------------------------------------------------------->><<07103>>01458000
                                                               <<07103>>01460000
begin                                                          <<07103>>01462000
integer ldev;                                                  <<07103>>01464000
logical perm'disable;                                          <<07103>>01466000
byte pointer buffd;                                            <<07103>>01468000
                                                               <<07103>>01470000
if not ds'err'in'prog then                                     <<07103>>01472000
   begin                                                       <<07103>>01474000
   ldev := ds'ldev;                                            <<07103>>01476000
   perm'disable := ds'perm'disable;                            <<07103>>01478000
                                                               <<07103>>01480000
   <<-------------------------------------------------------->><<07103>>01482000
   << printing message                                       >><<07103>>01484000
   <<-------------------------------------------------------->><<07103>>01486000
   exchangedb (0);                                             <<07103>>01488000
   tos := 0;                                                   <<07103>>01490000
   @buffd := @s0 &lsl(1);                                      <<07103>>01492000
   assemble (adds 50);                                         <<07103>>01494000
   if (ldev = 1) or perm'disable then                          <<07103>>01496000
      begin                                                    <<07103>>01498000
      move buffd := "Directory space allocation/",2;           <<07103>>01500000
      move * := "deallocation is disabled on LDEV         ",2; <<07103>>01502000
      end                                                      <<07103>>01504000
   else                                                        <<07103>>01506000
      begin                                                    <<07103>>01508000
      move buffd := "Problem with directory space ",2;         <<07103>>01510000
      move * := "allocation/deallocation on LDEV         ",2;  <<07103>>01512000
      end;                                                     <<07103>>01514000
   ascii (ldev, -10, buffd (s0 - @buffd - 8));                 <<07103>>01516000
   case * err of                                               <<07103>>01518000
      begin                                                    <<07103>>01520000
      ;                                                        <<07103>>01522000
      move * := "(IO error - write)",2;                        <<07103>>01524000
      move * := "(IO error - read)",2;                         <<07103>>01526000
      move * := "(deallocating free space)",2;                 <<07103>>01528000
      ;                                                        <<07103>>01530000
      end;                                                     <<07103>>01532000
   buffd (s0 - @buffd) := 0;                                   <<07103>>01534000
   genmsg (-1, @buffd,,,,,,,0);                                <<07103>>01536000
   exchangedb (ds'dst);                                        <<07103>>01538000
                                                               <<07103>>01540000
   if ds'error'ldev <> 1 and ds'error'type < 4 then            <<07103>>01542000
      << save only first error if system directory           >><<07103>>01544000
      begin                                                    <<07103>>01546000
      ds'error'ldev := ds'ldev;                                <<07103>>01548000
      ds'error'type := err;                                    <<07103>>01550000
      end;                                                     <<07103>>01552000
                                                               <<07103>>01554000
   ds'dirty := false;                                          <<07103>>01556000
   if ds'perm'disable then                                     <<07103>>01558000
      begin                                                    <<07103>>01560000
      <<----------------------------------------------------->><<07103>>01562000
      << disable space allocation and deallocation on disc   >><<07103>>01564000
      <<----------------------------------------------------->><<07103>>01566000
      ds'cur'sector := 0;                                      <<07103>>01568000
      ds'req'sector := 1;                                      <<07103>>01570000
      ds'err'in'prog := true;                                  <<07103>>01572000
      dirxxxbitmap (read);                                     <<07103>>01574000
      if <= then                                               <<07103>>01576000
         begin                                                 <<07103>>01578000
         ds'dirty := true;                                     <<07103>>01580000
         ds'dir'first := ds'dir'last := 2;                     <<07103>>01582000
         dirxxxbitmap (write);                                 <<07103>>01584000
         end;                                                  <<07103>>01586000
      ds'err'in'prog := false;                                 <<07103>>01588000
      end;                                                     <<07103>>01590000
                                                               <<07103>>01592000
   if ds'ldev = 1 then                                         <<07103>>01594000
      ds'dir'disabled := true      << only system directory  >><<07103>>01596000
   else                                                        <<07103>>01598000
      ds'ldev := 0;                << removable media - p.v. >><<07103>>01600000
                                                               <<07103>>01602000
   soft'death (sf);                                            <<07103>>01604000
   end;                                                        <<07103>>01606000
end;                                                           <<07103>>01608000
$page "Directory Space Management - DSM'INIT"                  <<07103>>01610000
logical procedure dsm'init (dir'addr, size);                   <<07103>>01612000
   value   dir'addr, size;                                     <<07103>>01614000
   logical size;            << p.v. dir. size                >><<07103>>01616000
   double  dir'addr;                                           <<07103>>01618000
   option  privileged, uncallable;                             <<07103>>01620000
                                                               <<07103>>01622000
<<----------------------------------------------------------->><<07103>>01624000
<< this procedure initializes directory space data segment   >><<07103>>01626000
<< when the directory is switched. if old directory is       >><<07103>>01628000
<< a system directory, then it will save all pointer i.e.    >><<07103>>01630000
<< ds'cur'sector, ds'last'word, ds'first'word and ds'dir'size>><<07103>>01632000
<< if new directory is a p.v. directory then the first sec-  >><<07103>>01634000
<< tors of the directory bit map are read into the buffer    >><<07103>>01636000
<< and the directory size is extracted from the disc label.  >><<07103>>01638000
<< procedure will return false if the directory is diabled.  >><<07103>>01640000
<<----------------------------------------------------------->><<07103>>01642000
                                                               <<07103>>01644000
begin                                                          <<07103>>01646000
integer                                                        <<g7489>>01648000
   dir'bit'map'words, << number of words in the bit map.    >> <<g7489>>01650000
   dir'addr0 = dir'addr;                                       <<g7489>>01652000
define dir'ldev = dir'addr0.(0:8)#;                            <<g7489>>01654000
define exit' = dsm'init := false;                              <<07103>>01656000
               tos := exchangedb (ddsdst);                     <<07103>>01658000
               return#;                                        <<07103>>01660000
                                                               <<07103>>01662000
dsm'init := true;          << directory is o.k.              >><<07103>>01664000
if ds'dirty then                                               <<07103>>01666000
   dirxxxbitmap (write);                                       <<07103>>01668000
                                                               <<07103>>01670000
if dir'ldev = 1 then                                           <<07103>>01672000
   <<-------------------------------------------------------->><<07103>>01674000
   << switch to system directory                             >><<07103>>01676000
   <<-------------------------------------------------------->><<07103>>01678000
   if ds'dir'disabled then                                     <<07103>>01680000
      begin                                                    <<07103>>01682000
      exit';               << return to caller               >><<07103>>01684000
      end                                                      <<07103>>01686000
   else                                                        <<07103>>01688000
      begin                                                    <<07103>>01690000
      ds'req'sector := ds'sys'cur;                             <<07103>>01692000
      ds'dir'size := ds'sys'size;                              <<07103>>01694000
      end                                                      <<07103>>01696000
else                                                           <<07103>>01698000
   <<-------------------------------------------------------->><<07103>>01700000
   << switch to private volume directory                     >><<07103>>01702000
   <<-------------------------------------------------------->><<07103>>01704000
   begin                                                       <<07103>>01706000
   if ds'ldev = 1 then                                         <<07103>>01708000
      <<----------------------------------------------------->><<07103>>01710000
      << save system directory pointers                      >><<07103>>01712000
      <<----------------------------------------------------->><<07103>>01714000
      begin                                                    <<07103>>01716000
      ds'sys'cur := ds'cur'sector;                             <<07103>>01718000
      ds'sys'last := ds'last'word;                             <<07103>>01720000
      ds'sys'first := @ds'first'word;                          <<07103>>01722000
      ds'sys'size := ds'dir'size;                              <<07103>>01724000
      end;                                                     <<07103>>01726000
                                                               <<07103>>01728000
   <<-------------------------------------------------------->><<07103>>01730000
   << if directory size > 6112 sectors then the dircectory   >><<07103>>01732000
   << bit map occupies 32 sectors and only last 3 sectors of >><<07103>>01734000
   << the bit map are represented in directory bit map there->><<07103>>01736000
   << for the ds'dir'size must be lowered by 29 ( 32 - 3 ).  >><<07103>>01738000
   <<-------------------------------------------------------->><<07103>>01740000
   ds'dir'size := size;    << set p.v. dir. size             >><<07103>>01742000
   if ds'dir'size > 6112 then                                  <<07103>>01744000
      ds'dir'size := ds'dir'size - 29;                         <<07103>>01746000
                                                               <<07103>>01748000
   ds'req'sector := 1;     << start from first sector        >><<07103>>01750000
   end;                                                        <<07103>>01752000
                                                               <<07103>>01754000
<<----------------------------------------------------------->><<07103>>01756000
<< read sectors into the buffer                              >><<07103>>01758000
<<----------------------------------------------------------->><<07103>>01760000
ds'cur'sector := 0;        << indicate empty buffer          >><<07103>>01762000
ds'dir'addr := dir'addr;                                       <<07103>>01764000
                                                               <<07103>>01766000
<<----------------------------------------------------------->><<07103>>01768000
<< the dir. address pointed to last 3 sectors of the dir. bit>><<07103>>01770000
<< map. if dir. size is > 6112 (dir. bit map size > 3 sect.) >><<07103>>01772000
<< then the dir. bit map occupies 32 sectors and the dir. bit>><<07103>>01774000
<< map address must be calulated as follow:                  >><<07103>>01776000
<< dir. bit map disc address = dir. disc addr - (32 - 3)     >><<07103>>01778000
<<----------------------------------------------------------->><<07103>>01780000
if ds'dir'size > 6112 then                                     <<07103>>01782000
   begin                                                       <<07103>>01784000
   dir'ldev := 0;                                              <<07103>>01786000
   dir'addr := dir'addr - 29d;                                 <<07103>>01788000
   dir'ldev := ds'ldev;                                        <<07103>>01790000
   ds'dir'addr := dir'addr;                                    <<07103>>01792000
   end;                                                        <<g7489>>01794000
                                                               <<g7489>>01796000
                                                               <<g7489>>01798000
dir'bit'map'words := ((ds'dir'size+15)/16)+ds'dir'header;      <<g7489>>01800000
ds'last'sector := (dir'bit'map'words+127)/128;                 <<g7489>>01802000
                                                               <<g7489>>01804000
dirxxxbitmap (read);       << read sectors into the buffer   >><<07103>>01806000
if > then                                                      <<07103>>01808000
   begin                                                       <<07103>>01810000
   exit';                  << return to caller               >><<07103>>01812000
   end;                                                        <<07103>>01814000
if (ds'cur'sector = 1) and (ds'dir'last <= 2) then             <<07103>>01816000
   << directory is disabled                                  >><<07103>>01818000
   begin                                                       <<07103>>01820000
   dsm'error (dirallocerr, 4);                                 <<07103>>01822000
   exit';                  << return to caller               >><<07103>>01824000
   end;                                                        <<07103>>01826000
                                                               <<07103>>01828000
if ds'ldev = 1 and ds'sys'last <> 0 then                       <<07103>>01830000
   << reset system directory pointers                        >><<07103>>01832000
   begin                                                       <<07103>>01834000
   ds'last'word := ds'sys'last;                                <<07103>>01836000
   @ds'first'word := ds'sys'first;                             <<07103>>01838000
   end;                                                        <<07103>>01840000
end;                                                           <<07103>>01842000
$page "Directory Space Management - DIRXXXBITMAP"              <<07103>>01844000
procedure dirxxxbitmap (function);                             <<07103>>01846000
   value   function;                                           <<07103>>01848000
   integer function;                                           <<07103>>01850000
   option  privileged, uncallable;                             <<07103>>01852000
                                                               <<07103>>01854000
<<----------------------------------------------------------->><<07103>>01856000
<< this procedure performs directory bit map io functions.   >><<07103>>01858000
<< the directory bit map which defines allocated/deallocated >><<07103>>01860000
<< space of directory proceeds the directory contents (index >><<07103>>01862000
<< and entry blocks). each bit in the bit map represents one >><<07103>>01864000
<< sector of the directory including the directory bit map.  >><<07103>>01866000
<< the bit set to "1" indicates that sector is not used and  >><<07103>>01868000
<< consequently bit set to "0" indicates that sector is used.>><<07103>>01870000
<< the directory can be up to 65000 sectors long i.e. the    >><<07103>>01872000
<< directory bit map can occupied up to 32 sectors on disc.  >><<07103>>01874000
<< the directory space management maintains the bit map in   >><<07103>>01876000
<< dst # %25 called directory space data segment (ds dst).   >><<07103>>01878000
<< the ds data segment have a buffer which can handle up to  >><<07103>>01880000
<< 3 contigious directory bit map sectors. the ds'first'word >><<07103>>01882000
<< and ds'last'word offsets relative to the begining of ds   >><<07103>>01884000
<< data segment represents the limits of the buffer. the     >><<07103>>01886000
<< two words in the begining of the first sector of the bit  >><<07103>>01888000
<< map represent the last and first available word in the    >><<07103>>01890000
<< directory. however, because they are not consistent in    >><<07103>>01892000
<< diffrent mits we stop using them. they must be kept in    >><<07103>>01894000
<< this sector for compatibility reason. to determine the end>><<07103>>01896000
<< of the directory we will use a directory size value which >><<07103>>01898000
<< can be obtain for the system directory from cold load info>><<07103>>01900000
<< (ldev 1, sector 28, word 20) or from disc label for       >><<07103>>01902000
<< private volumes (master volume ldev, sector 0, word 16).  >><<07103>>01904000
<< the ds'cur'sector pointer (relative offset to the begin-  >><<07103>>01906000
<< ning of the directory starting from 1) indicates the start>><<07103>>01908000
<< address of current sectors in the ds buffer.              >><<07103>>01910000
<< the ds'req'sector pointer indicates (use only when read)  >><<07103>>01912000
<< the sector to be requested by the reader. two consequtive >><<07103>>01914000
<< reads will overalp last sector i.e. if setors 2, 3 and 4  >><<07103>>01916000
<< are in buffer then the next sectors to be read into the   >><<07103>>01918000
<< buffer, will be 4, 5 and 6. this will allow to handle     >><<07103>>01920000
<< sector spans.                                             >><<07103>>01922000
<< the dirxxxbitmap procedure returns following condition    >><<07103>>01924000
<< code:                                                     >><<07103>>01926000
<< - cce - o.k.                                              >><<07103>>01928000
<< - ccl - requested sectors are beyond the bit map; first   >><<07103>>01930000
<<         sectors of the bit map are placed in the buffer,  >><<07103>>01932000
<< - ccg - io error and the directory space management for   >><<07103>>01934000
<<         this directory is disabled.                       >><<07103>>01936000
<<----------------------------------------------------------->><<07103>>01938000
                                                               <<07103>>01940000
                                                               <<07103>>01942000
begin                                                          <<07103>>01944000
logical out = function;                                        <<07103>>01946000
                                                               <<07103>>01948000
subroutine dirdisc (func, addr, buff, size);                   <<07103>>01950000
   value   func, addr, buff, size;                             <<07103>>01952000
   integer func, buff, size;                                   <<07103>>01954000
   double  addr;                                               <<07103>>01956000
                                                               <<07103>>01958000
   begin                                                       <<07103>>01960000
   tos := attachio (ds'ldev, 0, ds'dst, buff, func, size,      <<07103>>01962000
              ds'addr1, ds'addr2, %10001);<< cache serial io >><<07103>>01964000
   assemble (stbx, del);                                       <<07103>>01966000
   if tos.(13:3) <> 1 then                                     <<07103>>01968000
      begin                                                    <<07103>>01970000
      cc := ccg;                                               <<07103>>01972000
      tos := dirioab;                                          <<07103>>01974000
      if out then                                              <<07103>>01976000
         tos := 1                                              <<07103>>01978000
      else                                                     <<07103>>01980000
         tos := 2;                                             <<07103>>01982000
      dsm'error (*,*);                                         <<07103>>01984000
      end;                                                     <<07103>>01986000
   end;                                                        <<07103>>01988000
                                                               <<07103>>01990000
logical subroutine discwrite;                                  <<07103>>01992000
   begin                                                       <<07103>>01994000
   discwrite := true;                                          <<07103>>01996000
   ds'dirty := false;                                          <<07103>>01998000
   dirdisc (write, ds'addr, @ds'buffer, ds'size);              <<07103>>02000000
   if cc <> cce then                                           <<07103>>02002000
      discwrite := false;                                      <<07103>>02004000
   end;                                                        <<07103>>02006000
                                                               <<07103>>02008000
                                                               <<07103>>02010000
cc := cce;                                                     <<07103>>02012000
                                                               <<07103>>02014000
<<----------------------------------------------------------->><<07103>>02016000
<< switch to directory space management data segment         >><<07103>>02018000
<<----------------------------------------------------------->><<07103>>02020000
tos := exchangedb (ds'dst);                                    <<07103>>02022000
if not (ddsdst <= s0 <= ds'dst) then                           <<07103>>02024000
   sysabort (dirbaddst);                                       <<07103>>02026000
                                                               <<07103>>02028000
<<----------------------------------------------------------->><<07103>>02030000
<< write current buffer contents when flag dirty is set on.  >><<07103>>02032000
<<----------------------------------------------------------->><<07103>>02034000
if out and ds'dirty then                                       <<07103>>02036000
   begin                                                       <<07103>>02038000
   discwrite;                                                  <<07103>>02040000
   if ds'ldev <> 1 then                                        <<07103>>02042000
      ds'ldev := 0;        << removable media                >><<07103>>02044000
   end;                                                        <<07103>>02046000
                                                               <<07103>>02048000
<<----------------------------------------------------------->><<07103>>02050000
<< read bit map sectors into the directory space data segment>><<07103>>02052000
<<----------------------------------------------------------->><<07103>>02054000
if not out then                                                <<07103>>02056000
   begin                                                       <<07103>>02058000
                                                               <<07103>>02060000
   if ds'req'sector > ds'last'sector then                      <<07103>>02062000
      <<----------------------------------------------------->><<07103>>02064000
      << start from the beginnig of the bit map              >><<07103>>02066000
      <<----------------------------------------------------->><<07103>>02068000
      begin                                                    <<07103>>02070000
      cc := ccl;                                               <<07103>>02072000
      ds'req'sector := 1;                                      <<07103>>02074000
      end;                                                     <<07103>>02076000
                                                               <<07103>>02078000
   <<-------------------------------------------------------->><<07103>>02080000
   << set pointer to the first available word in buffer      >><<07103>>02082000
   <<-------------------------------------------------------->><<07103>>02084000
   if ds'req'sector = 1 then                                   <<07103>>02086000
      @ds'first'word := ds'header + ds'dir'header              <<07103>>02088000
   else                                                        <<07103>>02090000
      @ds'first'word := ds'header;                             <<07103>>02092000
                                                               <<07103>>02094000
   if (ds'last'sector > ds'buf'size's) and                     <<07103>>02096000
      ((ds'req'sector < ds'cur'sector) or                      <<07103>>02098000
      ((ds'last'sector - ds'cur'sector) >= ds'buf'size's) land <<07103>>02100000
      (ds'req'sector - ds'cur'sector) >= (ds'buf'size's - 1))  <<07103>>02102000
      or (ds'cur'sector = 0) then                              <<07103>>02104000
      begin                                                    <<07103>>02106000
                                                               <<07103>>02108000
      <<----------------------------------------------------->><<07103>>02110000
      << new sectors are read into the buffer when:          >><<07103>>02112000
      << directory size > 6000 sectors and requested sector  >><<07103>>02114000
      << has lower address than current segment or the last  >><<07103>>02116000
      << sector of bit map is not in the buffer and the      >><<07103>>02118000
      << requested sector is last in the buffer or initial.  >><<07103>>02120000
      <<----------------------------------------------------->><<07103>>02122000
                                                               <<07103>>02124000
      <<----------------------------------------------------->><<07103>>02126000
      << note. it is potential problem with directory > 6000 >><<07103>>02128000
      << sectors. in such case if the system crash while     >><<07103>>02130000
      << delete account/group is in progress the directory   >><<07103>>02132000
      << bit map and the directory itself can be in inconsis->><<07103>>02134000
      << tent state. the directory deallocates space but     >><<07103>>02136000
      << without forcing updates to be written to the disc.  >><<07103>>02138000
      << however, if the deallocation procedure will require >><<07103>>02140000
      << new sectors to be read into the buffer, the modified>><<07103>>02142000
      << sectors from the buffer will be written to the disc.>><<07103>>02144000
      <<----------------------------------------------------->><<07103>>02146000
                                                               <<07103>>02148000
      if ds'dirty then                                         <<07103>>02150000
         discwrite;                                            <<07103>>02152000
                                                               <<07103>>02154000
      <<----------------------------------------------------->><<07103>>02156000
      << set pointer to last word in buffer                  >><<07103>>02158000
      <<----------------------------------------------------->><<07103>>02160000
      if (ds'last'sector - ds'req'sector) >= ds'buf'size's then<<07103>>02162000
         <<-------------------------------------------------->><<07103>>02164000
         << directory bit map > 3 sectors (not last sector)  >><<07103>>02166000
         <<-------------------------------------------------->><<07103>>02168000
         ds'last'word := ds'header + ds'buf'size'w - 1         <<07103>>02170000
      else                                                     <<07103>>02172000
         ds'last'word := ds'header + ds'dir'header - 1 +       <<g7489>>02174000
                         (ds'dir'size + 15)/16 -               <<g7489>>02176000
                         (ds'req'sector-1)*128;                <<g7489>>02178000
                                                               <<07103>>02180000
      <<----------------------------------------------------->><<07103>>02182000
      << read sectors into the buffer.                       >><<07103>>02184000
      <<----------------------------------------------------->><<07103>>02186000
      ds'cur'sector := ds'req'sector;                          <<07103>>02188000
      ds'addr := ds'dir'addr;                                  <<07103>>02190000
      ds'addr1 := ds'addr1 &lsl(8) &lsr(8);   << remove ldev >><<07103>>02192000
      ds'addr := ds'addr + double (ds'cur'sector - 1);         <<07103>>02194000
      ds'size := (((ds'last'word-ds'header+1)+127)/128)*128;   <<g7489>>02196000
                                                               <<g7489>>02198000
      dirdisc (read, ds'addr, @ds'buffer, ds'size);            <<07103>>02200000
      end;                                                     <<07103>>02202000
   end;                                                        <<07103>>02204000
                                                               <<07103>>02206000
<<----------------------------------------------------------->><<07103>>02208000
<< switch back to caller dst                                 >><<07103>>02210000
<<----------------------------------------------------------->><<07103>>02212000
assemble (zero, xch);         << reserve word on stack       >><<07103>>02214000
exchangedb (*);                                                <<07103>>02216000
end;                                                           <<07103>>02218000
$page "Directory Space Management - DIRXXXLLOCATE"             <<07103>>02220000
                                                               <<07103>>02222000
procedure dirxxxllocate (pntr, ppsize, set1);                  <<07103>>02224000
   value   pntr, ppsize, set1;                                 <<07103>>02226000
   logical pntr, set1;                                         <<07103>>02228000
   integer ppsize;                                             <<07103>>02230000
   option  privileged, uncallable;                             <<07103>>02232000
                                                               <<07103>>02234000
<<----------------------------------------------------------->><<07103>>02236000
<< this procedure sets and resets bits in the buffer.        >><<07103>>02238000
<< input arguments:                                          >><<07103>>02240000
<< pntr   - sector address relative to ds'dir,               >><<07103>>02242000
<< ppsize - space size,                                      >><<07103>>02244000
<< set1   - "1" when deallocate or "0" when allocate space.  >><<07103>>02246000
<<----------------------------------------------------------->><<07103>>02248000
                                                               <<07103>>02250000
begin                                                          <<07103>>02252000
logical pointer pntrx = pntr;                                  <<07103>>02254000
                                                               <<07103>>02256000
<<----------------------------------------------------------->><<07103>>02258000
<< set buffer word pointer and word bit pointer (x reg.)     >><<07103>>02260000
<<----------------------------------------------------------->><<07103>>02262000
xr := pntr &lsl(12) &lsr(12);    << bit offset in the word   >><<07103>>02264000
@pntrx := ds'header + ds'dir'header + pntr &lsr(4) -           <<07103>>02266000
   (ds'cur'sector - 1) &lsl(7);                                <<07103>>02268000
                                                               <<07103>>02270000
tos := pntrx;                << fetch word from buffer       >><<07103>>02272000
                                                               <<07103>>02274000
while (ppsize := ppsize - 1) >= 0 do                           <<07103>>02276000
   begin                                                       <<07103>>02278000
   if xr = 16 then                                             <<07103>>02280000
      <<----------------------------------------------------->><<07103>>02282000
      << fetch new word                                      >><<07103>>02284000
      <<----------------------------------------------------->><<07103>>02286000
      begin                                                    <<07103>>02288000
      pntrx := tos;          << saved a modified word        >><<07103>>02290000
      @pntrx := @pntrx + 1;                                    <<07103>>02292000
      tos := pntrx;          << get new word                 >><<07103>>02294000
      xr := 0;                                                 <<07103>>02296000
      end;                                                     <<07103>>02298000
                                                               <<07103>>02300000
   if set1 then                                                <<07103>>02302000
      <<----------------------------------------------------->><<07103>>02304000
      << deallocate - set bit to "1"                         >><<07103>>02306000
      <<----------------------------------------------------->><<07103>>02308000
      begin                                                    <<07103>>02310000
      assemble (tsbc 0, x);                                    <<07103>>02312000
      if <> then                                               <<07103>>02314000
         <<-------------------------------------------------->><<07103>>02316000
         << error exit - space already deallocated           >><<07103>>02318000
         <<-------------------------------------------------->><<07103>>02320000
         begin                                                 <<07103>>02322000
         dsm'error (dirallocerr, 3);                           <<07103>>02324000
         return;                                               <<07103>>02326000
         end;                                                  <<07103>>02328000
      end                                                      <<07103>>02330000
   else                                                        <<07103>>02332000
                                                               <<07103>>02334000
      <<----------------------------------------------------->><<07103>>02336000
      << allocate - set bit to "0"                           >><<07103>>02338000
      <<----------------------------------------------------->><<07103>>02340000
      assemble (trbc 0, x);                                    <<07103>>02342000
                                                               <<07103>>02344000
   xr := xr + 1;        << advance bit pointer               >><<07103>>02346000
   end;                                                        <<07103>>02348000
                                                               <<07103>>02350000
pntrx := tos;          << store modified word                >><<07103>>02352000
ds'dirty := true;                                              <<07103>>02354000
end;                                                           <<07103>>02356000
$page "Directory Space Management - DIRALLOCATE"               <<07103>>02358000
logical procedure dirallocate (ppsize);                        <<07103>>02360000
   value   ppsize;                                             <<07103>>02362000
   logical ppsize;                                             <<07103>>02364000
   option  privileged, uncallable;                             <<07103>>02366000
                                                               <<07103>>02368000
<<----------------------------------------------------------->><<07103>>02370000
<< this procedure is looking for a contigious space (size =  >><<07103>>02372000
<< ppsize). it starts to exam the bit map sectors which are  >><<07103>>02374000
<< currently in the ds'buffer. the relative pointers to dst  >><<07103>>02376000
<< (ds'first'word and ds'last'word) indicate buffer limits.  >><<07103>>02378000
<< if it cannot find the requested space then it will try to >><<07103>>02380000
<< read the next bit map sectors into the buffer. however, it>><<07103>>02382000
<< starts to read from the address of the last sector in the >><<07103>>02384000
<< buffer. this will allow to allocate space between the     >><<07103>>02386000
<< sector bounds. if this procedure reaches the end of the   >><<07103>>02388000
<< directory bit map it will make another pass through the   >><<07103>>02390000
<< directory bit map. if for some reason the directory bit   >><<07103>>02392000
<< map is trashed at the beginnig (space allocated for the   >><<07103>>02394000
<< directory bit map) or at the end (beyond the directory),  >><<07103>>02396000
<< it will not encounter as a valid allocation.              >><<07103>>02398000
<<                                                           >><<07103>>02400000
<< this procedure returns:                                   >><<07103>>02402000
<< - start address of allocated space (relative to the       >><<07103>>02404000
<<   beginning of the directory address).                    >><<07103>>02406000
<< - cce - o.k.                                              >><<07103>>02408000
<< - ccl - space not available; returns zero address,        >><<07103>>02410000
<< - ccg - requested size too big or directory space         >><<07103>>02412000
<<         allocation disabled; returns zero address.        >><<07103>>02414000
<<----------------------------------------------------------->><<07103>>02416000
                                                               <<07103>>02418000
                                                               <<07103>>02420000
begin                                                          <<07103>>02422000
logical size;                                                  <<07103>>02424000
double dir'addr;                                               <<07103>>02426000
logical addr = dir'addr;                                       <<07103>>02428000
define  dir'ldev = addr.(0:8)#;                                <<07103>>02430000
logical word  = s0;     << tested word from bit map          >><<07103>>02432000
logical words = s2;     << tested word from bit map          >><<07103>>02434000
logical result = dirallocate;                                  <<07103>>02436000
logical only'one'pass;                                         <<07103>>02438000
define  exit' = exchangedb (ddsdst);                           <<07103>>02440000
                return#;                                       <<07103>>02442000
                                                               <<07103>>02444000
logical subroutine get'word;                                   <<07103>>02446000
                                                               <<07103>>02448000
   <<-------------------------------------------------------->><<07103>>02450000
   << this subroutine returns non zero word from buffer and  >><<07103>>02452000
   << status true or status false when words in buffer are   >><<07103>>02454000
   << null. the ds'first'word and ds'last'word are the buffer>><<07103>>02456000
   << limits.                                                >><<07103>>02458000
   <<-------------------------------------------------------->><<07103>>02460000
                                                               <<07103>>02462000
   begin                                                       <<07103>>02464000
   while (logical (@ds'first'word) <= ds'last'word) and        <<07103>>02466000
         (ds'first'word = 0) do                                <<07103>>02468000
      @ds'first'word := @ds'first'word + 1;                    <<07103>>02470000
                                                               <<07103>>02472000
   if logical (@ds'first'word) <= ds'last'word then            <<07103>>02474000
      begin                                                    <<07103>>02476000
      words := ds'first'word;                                  <<07103>>02478000
      get'word := true;                                        <<07103>>02480000
      end                                                      <<07103>>02482000
   else                                                        <<07103>>02484000
      begin                                                    <<07103>>02486000
      words := 0;                                              <<07103>>02488000
      get'word := false;                                       <<07103>>02490000
      end;                                                     <<07103>>02492000
   end;                                                        <<07103>>02494000
                                                               <<07103>>02496000
                                                               <<07103>>02498000
<<----------------------------------------------------------->><<07103>>02500000
<< switch to directory space data segment                    >><<07103>>02502000
<<----------------------------------------------------------->><<07103>>02504000
size := pv'dir'size;   << extract p.v. dir. size in case     >><<07103>>02506000
dir'addr := dirbase;   << directory address from dst # %24   >><<07103>>02508000
if exchangedb (ds'dst) <> ddsdst then                          <<07103>>02510000
   sysabort (dirbaddst);                                       <<07103>>02512000
                                                               <<07103>>02514000
<<----------------------------------------------------------->><<07103>>02516000
<< switch to new directory if necessary                      >><<07103>>02518000
<<----------------------------------------------------------->><<07103>>02520000
if (dir'ldev <> ds'ldev) then                                  <<07103>>02522000
   if not dsm'init (dir'addr, size) then                       <<07103>>02524000
      begin                                                    <<07103>>02526000
      cc := ccg;                                               <<07103>>02528000
      return;          << directory disabled                 >><<07103>>02530000
      end;                                                     <<07103>>02532000
                                                               <<07103>>02534000
size := 0;             << initialize size                    >><<07103>>02536000
result := 0;           << initialize sector address          >><<07103>>02538000
                                                               <<07103>>02540000
<<----------------------------------------------------------->><<07103>>02542000
<< if system directory then check if it is not disabled      >><<07103>>02544000
<<----------------------------------------------------------->><<07103>>02546000
if (ds'ldev = 1) and ds'dir'disabled then                      <<07103>>02548000
   begin                                                       <<07103>>02550000
   dsm'error (dirallocerr, 4);       << msg. - dir. disabled >><<07103>>02552000
   cc := ccg;                                                  <<07103>>02554000
   exit';                            << return to caller     >><<07103>>02556000
   end;                                                        <<07103>>02558000
                                                               <<07103>>02560000
                                                               <<07103>>02562000
tos := 0;              << reserved word on stack for testing >><<07103>>02564000
                                                               <<07103>>02566000
do                                                             <<07103>>02568000
   begin                                                       <<07103>>02570000
   if (ds'cur'sector = 1) and (logical (@ds'first'word) =      <<07103>>02572000
      ds'header + ds'dir'header) then                          <<07103>>02574000
      <<----------------------------------------------------->><<07103>>02576000
      << only one pass through directory bit map             >><<07103>>02578000
      <<----------------------------------------------------->><<07103>>02580000
      only'one'pass := true                                    <<07103>>02582000
   else                                                        <<07103>>02584000
      <<----------------------------------------------------->><<07103>>02586000
      << two passes through directory bit map if necessary   >><<07103>>02588000
      <<----------------------------------------------------->><<07103>>02590000
      only'one'pass := false;                                  <<07103>>02592000
                                                               <<07103>>02594000
   do                                                          <<07103>>02596000
      <<----------------------------------------------------->><<07103>>02598000
      << scan the bit map directory                          >><<07103>>02600000
      <<----------------------------------------------------->><<07103>>02602000
      begin                                                    <<07103>>02604000
      while get'word do                                        <<07103>>02606000
         <<-------------------------------------------------->><<07103>>02608000
         << scan words in the buffer                         >><<07103>>02610000
         <<-------------------------------------------------->><<07103>>02612000
         begin                                                 <<07103>>02614000
         <<-------------------------------------------------->><<07103>>02616000
         << set sector address ds'dir relative               >><<07103>>02618000
         <<-------------------------------------------------->><<07103>>02620000
         xr := ((ds'cur'sector - 1) &lsl(7) - ds'dir'header +  <<07103>>02622000
            logical (@ds'first'word) - ds'header) &lsl(4) - 1; <<07103>>02624000
         while word <> 0 do  << while does not modify x reg. >><<07103>>02626000
            begin                                              <<07103>>02628000
            <<----------------------------------------------->><<07103>>02630000
            << scan word                                     >><<07103>>02632000
            <<----------------------------------------------->><<07103>>02634000
            assemble (scan ,x);                                <<07103>>02636000
            <<----------------------------------------------->><<07103>>02638000
            << check results                                 >><<07103>>02640000
            <<----------------------------------------------->><<07103>>02642000
            if 3 <= xr and xr < ds'dir'size then  << valid ? >><<07103>>02644000
               begin                                           <<07103>>02646000
               if (result + size) = xr then    << contigious >><<07103>>02648000
                  size := size + 1                             <<07103>>02650000
               else                                            <<07103>>02652000
                  begin                << reset pointers     >><<07103>>02654000
                  result := xr;                                <<07103>>02656000
                  size := 1;                                   <<07103>>02658000
                  end;                                         <<07103>>02660000
               if size = ppsize then   << allocate           >><<07103>>02662000
                  <<----------------------------------------->><<07103>>02664000
                  << exit - space allocated                  >><<07103>>02666000
                  <<----------------------------------------->><<07103>>02668000
                  begin                                        <<07103>>02670000
                  dirxxxllocate (result, ppsize, 0);           <<07103>>02672000
                  cc := cce;                                   <<07103>>02674000
                  exit';         << return to caller         >><<07103>>02676000
                  end;                                         <<07103>>02678000
               end;                                            <<07103>>02680000
            end;                                               <<07103>>02682000
         @ds'first'word := @ds'first'word + 1;  << next word >><<07103>>02684000
         end;                                                  <<07103>>02686000
      <<----------------------------------------------------->><<07103>>02688000
      << read next sectors into the buffer                   >><<07103>>02690000
      <<----------------------------------------------------->><<07103>>02692000
      ds'req'sector := ds'cur'sector + ds'buf'size's;          <<07103>>02694000
      if ((ds'header + ds'dir'header + result &lsr(4) -        <<07103>>02696000
         (ds'cur'sector - 1) &lsl(7)) = ds'last'word) and      <<07103>>02698000
         (ds'req'sector <= ds'last'sector) then                <<07103>>02700000
         begin                                                 <<07103>>02702000
         <<-------------------------------------------------->><<07103>>02704000
         << sectors span - valid only for ppsize <= 16       >><<07103>>02706000
         <<-------------------------------------------------->><<07103>>02708000
         ds'req'sector := ds'req'sector - 1;                   <<07103>>02710000
         result := size := 0;      << start from beginning   >><<07103>>02712000
         end;                                                  <<07103>>02714000
      dirxxxbitmap (read);                                     <<07103>>02716000
      end                                                      <<07103>>02718000
   until <>;           << until reach the end of the bit map >><<07103>>02720000
   if > then                                                   <<07103>>02722000
      <<----------------------------------------------------->><<07103>>02724000
      << exit - space is not allocated - io error            >><<07103>>02726000
      <<----------------------------------------------------->><<07103>>02728000
      begin                                                    <<07103>>02730000
      result := 0;                                             <<07103>>02732000
      cc := ccg;                                               <<07103>>02734000
      exit';               << return to caller               >><<07103>>02736000
      end;                                                     <<07103>>02738000
                                                               <<07103>>02740000
   end                                                         <<07103>>02742000
until only'one'pass;                                           <<07103>>02744000
<<----------------------------------------------------------->><<07103>>02746000
<< exit - space is not available                             >><<07103>>02748000
<<----------------------------------------------------------->><<07103>>02750000
result := 0;                                                   <<07103>>02752000
cc := ccl;                                                     <<07103>>02754000
exchangedb (ddsdst);            << switch back to dst # %24  >><<07103>>02756000
end;                                                           <<07103>>02758000
$page "Directory Space Management - DIRDEALLOCATE"             <<07103>>02760000
                                                               <<07103>>02762000
procedure dirdeallocate (pntr, ppsize);                        <<07103>>02764000
   value    pntr, ppsize;                                      <<07103>>02766000
   logical  pntr, ppsize;                                      <<07103>>02768000
   option   privileged, uncallable;                            <<07103>>02770000
                                                               <<07103>>02772000
<<----------------------------------------------------------->><<07103>>02774000
<< this procedure deallocates directory space                >><<07103>>02776000
<< input arguments:                                          >><<07103>>02778000
<< pntr - sector address relative to ds'dir,                 >><<07103>>02780000
<< ppsize - size of deallocated space.                       >><<07103>>02782000
<<----------------------------------------------------------->><<07103>>02784000
                                                               <<07103>>02786000
begin                                                          <<07103>>02788000
double dir'addr;                                               <<07103>>02790000
logical addr = dir'addr;                                       <<07103>>02792000
define  dir'ldev = addr.(0:8)#;                                <<07103>>02794000
logical word'pntr;      << word offset into diretory bit map >><<07103>>02796000
logical size = word'pntr;    << used for p.v. dir. size      >><<07103>>02798000
define  exit' = exchangedb (ddsdst);                           <<07103>>02800000
                return#;                                       <<07103>>02802000
                                                               <<07103>>02804000
<<----------------------------------------------------------->><<07103>>02806000
<< switch to directory space data segment                    >><<07103>>02808000
<<----------------------------------------------------------->><<07103>>02810000
size := pv'dir'size;   << extract p.v. dir. size in case     >><<07103>>02812000
dir'addr := dirbase;                                           <<07103>>02814000
if exchangedb (ds'dst) <> ddsdst then                          <<07103>>02816000
   sysabort (dirbaddst);                                       <<07103>>02818000
                                                               <<07103>>02820000
<<----------------------------------------------------------->><<07103>>02822000
<< switch to new directory if necessary                      >><<07103>>02824000
<<----------------------------------------------------------->><<07103>>02826000
if (dir'ldev <> ds'ldev) then                                  <<07103>>02828000
   if not dsm'init (dir'addr, size) then                       <<07103>>02830000
      return;                                                  <<07103>>02832000
                                                               <<07103>>02834000
<<----------------------------------------------------------->><<07103>>02836000
<< if system directory then check if it not disabled or if   >><<07103>>02838000
<< pntr points to bit map or beyond directory then exit.     >><<07103>>02840000
<<----------------------------------------------------------->><<07103>>02842000
if (ds'ldev = 1) and ds'dir'disabled or                        <<07103>>02844000
   (pntr + ppsize) > ds'dir'size or                            <<07103>>02846000
   (pntr < 3) then                                             <<07103>>02848000
   begin                                                       <<07103>>02850000
   dsm'error (dirallocerr, 4);                                 <<07103>>02852000
   exit';               << return to caller                  >><<07103>>02854000
   end;                                                        <<07103>>02856000
                                                               <<07103>>02858000
word'pntr := pntr &lsr(4) + ds'dir'header;  << buffer pntr   >><<07103>>02860000
                                                               <<07103>>02862000
<<----------------------------------------------------------->><<07103>>02864000
<< check if returned space belongs to sectors in the buffer  >><<07103>>02866000
<<----------------------------------------------------------->><<07103>>02868000
if not (((word'pntr &lsr(7) + 1) >= ds'cur'sector) land        <<07103>>02870000
   (((pntr + ppsize - 1) &lsr(4) + ds'dir'header) &lsr(7) + 1) <<07103>>02872000
   < (ds'cur'sector + ds'buf'size's)) then                     <<07103>>02874000
   <<-------------------------------------------------------->><<07103>>02876000
   << read new sectors into the buffer if necessary          >><<07103>>02878000
   <<-------------------------------------------------------->><<07103>>02880000
   begin                                                       <<07103>>02882000
   ds'req'sector := word'pntr &lsr(7) + 1;                     <<07103>>02884000
   dirxxxbitmap (read);                                        <<07103>>02886000
   if > then                                                   <<07103>>02888000
      <<----------------------------------------------------->><<07103>>02890000
      << exit error                                          >><<07103>>02892000
      <<----------------------------------------------------->><<07103>>02894000
      begin                                                    <<07103>>02896000
      exit';                << return to caller              >><<07103>>02898000
      end;                                                     <<07103>>02900000
   end;                                                        <<07103>>02902000
                                                               <<07103>>02904000
<<----------------------------------------------------------->><<07103>>02906000
<< reset bits in the buffer                                  >><<07103>>02908000
<<----------------------------------------------------------->><<07103>>02910000
dirxxxllocate (pntr, ppsize, 1);                               <<07103>>02912000
                                                               <<07103>>02914000
if (logical (@ds'first'word) - ds'header) >                    <<07103>>02916000
   (word'pntr - (ds'cur'sector - 1) &lsl(7)) then              <<07103>>02918000
   <<-------------------------------------------------------->><<07103>>02920000
   << reset the ds'first'word pointer                        >><<07103>>02922000
   <<-------------------------------------------------------->><<07103>>02924000
   @ds'first'word := word'pntr - (ds'cur'sector - 1) &lsl(7) + <<07103>>02926000
      ds'header;                                               <<07103>>02928000
                                                               <<07103>>02930000
exchangedb (ddsdst);      << return to directory dst (%24)   >><<07103>>02932000
end;                                                           <<07103>>02934000
$page "Directory Data Management Routines"                     <<07103>>02936000
<<***********************************************************>><<07103>>02938000
<<                                                           >><<07103>>02940000
<<              directory  data  management                  >><<07103>>02942000
<<                                                           >><<07103>>02944000
<<***********************************************************>><<07103>>02946000
                                                               <<07103>>02948000
                                                               <<07103>>02950000
                                                                        02952000
procedure dirwrite (which);                                             02954000
   value which;                                                         02956000
   logical which;                                                       02958000
   options;                                                             02960000
                                                                        02962000
begin                                                                   02964000
   integer temp = which;                                                02966000
   logical pointer tempp;                                               02968000
<< >>                                                                   02970000
   @base := if which then @dbprepre else @daprepre;                     02972000
   whichdirty := false;                                                 02974000
   @tempp := base(iopntr);                                              02976000
   tos := base(used);                                                   02978000
   if base(miscwd).(typef) = indextype then                             02980000
      begin                                                             02982000
      move tempp := base(miscwd), (presize);                            02984000
      tos := tos+presize;                                               02986000
      end;                                                              02988000
   assemble (test);                                                     02990000
   if = then return;                                                    02992000
   temp := tos;                                                         02994000
   tos := 0d;                                                           02996000
   tos := base (dirbase').(0:8);                               <<01.pv>>02998000
   tos := 0;                                                            03000000
   tos := ddsdst;                                                       03002000
   tos := @tempp;                                                       03004000
   tos := 1;                                                            03006000
   tos := temp;                                                         03008000
   tos := base (dirbase1').(8:8);                              <<01.pv>>03010000
   tos := base (dirbase2');                                    <<01.pv>>03012000
   tos := 0;          tos := ibase(contents);                           03014000
   asmb(dadd);                                                          03016000
$if x0=on                                                      <<debug>>03018000
   if ibase (contents) <= 0 then debug;                        <<debug>>03020000
$if                                                            <<debug>>03022000
   tos := attachio (*,*,*,*,*,*,*,*,dirio);                    <<de>>   03024000
   assemble (stbx, del);                                                03026000
   if tos.(13:3) <> 1 then sysabort(dirioab);                           03028000
   end    <<dirwrite>>;                                                 03030000
                                                                        03032000
                                                                        03034000
                                                                        03036000
                                                                        03038000
procedure dirread (pntr, which, excount, eemiscwd);                     03040000
   value pntr, which, excount, eemiscwd;                                03042000
   logical pntr, which, eemiscwd;                                       03044000
   integer excount;                                                     03046000
   options;                                                             03048000
                                                               <<de>>   03050000
begin                                                          <<de>>   03052000
   logical temp;                                                        03054000
   logical pointer tempp;                                               03056000
<< >>                                                                   03058000
   @base := if which then @dbprepre else @daprepre;                     03060000
   if base (contents) = pntr and                               <<43.pv>>03062000
      dbase (dirbase') = dirbase then return;                  <<43.pv>>03064000
   if whichdirty then dirwrite (which);                                 03066000
   @tempp := base(iopntr);                                              03068000
readin:                                                                 03070000
   tos := 0d;                                                           03072000
   tos := dirldev;                                             <<01.pv>>03074000
   tos := 0;                                                            03076000
   tos := ddsdst;                                                       03078000
   tos := @tempp;                                                       03080000
   tos := 0;                                                            03082000
   tos := ddsbwsize;                                                    03084000
   tos := dirbase1.(8:8);                                      <<01.pv>>03086000
   tos := dirbase2;                                            <<01.pv>>03088000
   tos := 0;                                                   <<de>>   03090000
   tos := pntr;                                                <<de>>   03092000
   asmb(dadd);                                                          03094000
$if x0=on                                                      <<debug>>03096000
   if ipntr <= 0 then debug;                                   <<debug>>03098000
$if                                                            <<debug>>03100000
   tos := attachio (*,*,*,*,*,*,*,*,dirio);                    <<de>>   03102000
   assemble (stbx, del);                                                03104000
   if tos.(13:3) <> 1 then sysabort(dirioab);                           03106000
   temp := ddsbsize;                                                    03108000
setup:                                                                  03110000
   dbase (dirbase') := dirbase;                                <<10.pv>>03112000
   base (contents) := pntr;                                             03114000
   base (numvalid) := temp;                                             03116000
   if tempp.(typef) = indextype then                                    03118000
      begin                                                             03120000
      move base(miscwd) := tempp, (presize);                            03122000
      temp := presize;                                                  03124000
      end                                                               03126000
   else                                                                 03128000
      begin                                                             03130000
      base(xcount) := excount;                                          03132000
      base(miscwd) := eemiscwd;                                         03134000
      temp := 0;                                                        03136000
      end;                                                              03138000
   base (lpntr) := @tempp+integer(temp);                                03140000
   base(used) := (base(xsize) := base(miscwd).(xsizef)) * base(xcount); 03142000
   base(bfactor) := ((base(bwsize) := (base(bsize)                      03144000
      := base(miscwd).(bsizef)) & lsl(7)) - temp) / base(xsize);        03146000
   end <<dirread>>;                                                     03148000
                                                               <<07102>>03150000
procedure dir'gr'link (index);                                 <<07102>>03152000
   value   index;                                              <<07102>>03154000
   logical index;           << old group index pointer       >><<07102>>03156000
   options;                                                    <<07102>>03158000
                                                               <<07102>>03160000
<<----------------------------------------------------------->><<07102>>03162000
<< this procedure updates the group index (father) pointer in>><<07102>>03164000
<< file index blocks belonging to the same account. it also  >><<07102>>03166000
<< updates the group index pointer in the jits of all pro-   >><<07102>>03168000
<< cesses logon to the same account. the directory area b    >><<07102>>03170000
<< conteined a new group index block when exit from this pro->><<07102>>03172000
<< cedure. the area a contents will be undefined.            >><<07102>>03174000
<<----------------------------------------------------------->><<07102>>03176000
                                                               <<07102>>03178000
begin                                                          <<07102>>03180000
integer pcbpt;                                                 <<07102>>03182000
integer cnt;                                                   <<07102>>03184000
integer jmatinx = cnt;                                         <<07102>>03186000
define  pcbglobloc = 0#;                                       <<07102>>03188000
integer jmsize;             << jmat size in words            >><<07102>>03190000
integer xtcount;            << number of accessors           >><<07102>>03192000
logical new'index;          << new group index pointer       >><<07102>>03194000
logical misc;               << miscw word from index block   >><<07102>>03196000
integer ind'count;          << number of indexes in index blk>><<07102>>03198000
logical a'pntr;             << addr. of a contents           >><<07102>>03200000
logical a'count;            << # of entries in a             >><<07102>>03202000
logical pointer pntr;       << working pointer               >><<07102>>03204000
integer pointer ecnt;       << entry count                   >><<07102>>03206000
logical pointer link;                                          <<07102>>03208000
logical array jmatarr (*) = db + 0;                            <<07102>>03210000
logical array jitarr (*)  = db + 0;                            <<07102>>03212000
logical array qarray (*)  = db + 0;                            <<07102>>03214000
equate                << jmat job states >>                    <<*8805>>03216000
   free'entry = 0,                                             <<*8805>>03218000
   wait'state = %40;                                           <<*8805>>03220000
                                                               <<07102>>03222000
new'index := dbcontents;    << index block address           >><<07102>>03224000
ind'count := dbxcount;                                         <<07102>>03226000
xtcount := dbpcount;        << number of accessors           >><<07102>>03228000
misc := dbemiscwd;          << save b misc. word             >><<07102>>03230000
a'pntr := dacontents;       << save addr. of a contents      >><<07102>>03232000
a'count := daxcount;        << save count of a               >><<07102>>03234000
                                                               <<07102>>03236000
<<----------------------------------------------------------->><<07102>>03238000
<< examine all entries in index block                        >><<07102>>03240000
<<----------------------------------------------------------->><<07102>>03242000
while (ind'count := ind'count - 1) >= 0 do                     <<07102>>03244000
   begin                                                       <<07102>>03246000
   @pntr := @dblpntr + ind'count * isize;           << entry >><<07102>>03248000
   @ecnt := @pntr + iecount;  << # of entries in entry block >><<07102>>03250000
   @pntr := @pntr + iepntr;   << entry block address         >><<07102>>03252000
   <<-------------------------------------------------------->><<07102>>03254000
   << read entry block                                       >><<07102>>03256000
   <<-------------------------------------------------------->><<07102>>03258000
   dirread (pntr, a, ecnt, misc);                              <<07102>>03260000
   <<-------------------------------------------------------->><<07102>>03262000
   << update father pointers in the file index blocks        >><<07102>>03264000
   <<-------------------------------------------------------->><<07102>>03266000
   cnt := ecnt;      << saved count because b will be dstr   >><<07102>>03268000
   while (cnt := cnt - 1) >= 0 do                              <<07102>>03270000
      begin                                                    <<07102>>03272000
      @pntr := @dalpntr + cnt * gsize;             << entry  >><<07102>>03274000
      @link := @pntr + glinkage;                               <<07102>>03276000
      <<----------------------------------------------------->><<07102>>03278000
      << if system group entry of private volume and active  >><<07102>>03280000
      << then use saved system file index pointer.           >><<07102>>03282000
      <<----------------------------------------------------->><<07102>>03284000
      if link.(pvf) and (link.(mvtabxf) <> 0) then             <<07102>>03286000
         @pntr := @pntr + gsavefipntr                          <<07102>>03288000
      else                                                     <<07102>>03290000
         @pntr := @pntr + gfipntr;                             <<07102>>03292000
      if pntr <> 0 then                                        <<07102>>03294000
         <<-------------------------------------------------->><<07102>>03296000
         << read and update the file index block             >><<07102>>03298000
         <<-------------------------------------------------->><<07102>>03300000
         begin                                                 <<07102>>03302000
         dirread (pntr, b, 0, 0);                              <<07102>>03304000
         dbpindexp := new'index;                               <<07102>>03306000
         dirwrite (b);                                         <<07102>>03308000
         end;                                                  <<07102>>03310000
      end;                                                     <<07102>>03312000
   <<-------------------------------------------------------->><<07102>>03314000
   << restore in b the group index block                     >><<07102>>03316000
   <<-------------------------------------------------------->><<07102>>03318000
   dirread (new'index, b, 0, 0);                               <<07102>>03320000
   end;                                                        <<07102>>03322000
dirread (a'pntr, a, a'count, dbemiscwd);  << restore a       >><<07102>>03324000
                                                               <<07102>>03326000
if dirldev = sysldev then                                      <<07102>>03328000
   begin                                                       <<07102>>03330000
   <<-------------------------------------------------------->><<07102>>03332000
   << for system group index blocks check all main processes >><<07102>>03334000
   << if they belong to the same account and if so update    >><<07102>>03336000
   << group index pointer in jit.                            >><<07102>>03338000
   <<-------------------------------------------------------->><<07102>>03340000
   exchangedb (jmatdst);                                       <<07102>>03342000
   jmsize := jmatcursize &lsl(7);   << jmat size in words    >><<07102>>03344000
   jmatinx := jmatentryptr;                                    <<07102>>03346000
                                                               <<07102>>03348000
   do                                                          <<07102>>03350000
      if (jmatjobstate <> free'entry land                      <<*8805>>03352000
          jmatjobstate <> wait'state) then                     <<*8805>>03354000
         begin                                                 <<07102>>03356000
         pcbpt := jmatmainpin * pcbsize;                       <<07102>>03358000
         exchangedb (spcbstkdst);   << switch to process stk >><<07102>>03360000
         exchangedb (pxg'jitdst);   << switch to jit dst     >><<07102>>03362000
         if jitaip2 = index then   << update sys. gr. index p>><<07102>>03364000
            begin                                              <<07102>>03366000
            xtcount := xtcount - 1;                            <<07102>>03368000
            jitaip2 := new'index;                              <<07102>>03370000
            end;                                               <<07102>>03372000
         exchangedb (jmatdst);   << switch back to jmat dst  >><<07102>>03374000
         end                                                   <<07102>>03376000
      until ((jmatinx := jmatinx + jmatentrysize) > jmsize or  <<07102>>03378000
            xtcount = 0);                                      <<07102>>03380000
   end;                                                        <<07102>>03382000
                                                               <<07102>>03384000
exchangedb (ddsdst);             << switch back to dir dst   >><<07102>>03386000
end;   << dir'gr'link >>                                       <<07102>>03388000
                                                               <<07102>>03390000
logical procedure dir'exp'index'blk (link);                    <<07102>>03392000
   value   link;                                               <<07102>>03394000
   logical link;                                               <<07102>>03396000
   options;                                                    <<07102>>03398000
                                                               <<07102>>03400000
<<----------------------------------------------------------->><<07102>>03402000
<< this procedure expands index block and links the block to >><<07102>>03404000
<< the father. if space for new index block is not available >><<07102>>03406000
<< or existing block has already maximum size, it returns    >><<07102>>03408000
<< false. the consider index block must be in directory a    >><<07102>>03410000
<< area. this procedure uses a and b area. when exit the b   >><<07102>>03412000
<< area will contain the new index block and the a area will >><<07102>>03414000
<< have father group block (account).                        >><<07102>>03416000
<<----------------------------------------------------------->><<07102>>03418000
                                                               <<07102>>03420000
begin                                                          <<07102>>03422000
integer new'index;                                             <<07102>>03424000
logical index;                                                 <<07102>>03426000
logical pointer pntr;                                          <<07102>>03428000
logical a'pntr;             << addr. of a contents           >><<07102>>03430000
logical a'count;            << # of entries in a             >><<07102>>03432000
logical return'value = dir'exp'index'blk;                      <<07102>>03434000
array   name (0 : namesize - 1) = q;                           <<07102>>03436000
                                                               <<07102>>03438000
return'value := true;                                          <<07102>>03440000
if dbbsize >= ddsbsize then                                    <<07102>>03442000
   begin                                                       <<07102>>03444000
   return'value := false;                                      <<07102>>03446000
   return;                                                     <<07102>>03448000
   end;                                                        <<07102>>03450000
                                                               <<07102>>03452000
<<----------------------------------------------------------->><<07102>>03454000
<< allocate space for new index block and write to disc      >><<07102>>03456000
<<----------------------------------------------------------->><<07102>>03458000
new'index := dirallocate (dbbsize + 1);                        <<07102>>03460000
if <> then                                                     <<07102>>03462000
   begin                                                       <<07102>>03464000
   return'value := false;                                      <<07102>>03466000
   return;                                                     <<07102>>03468000
   end;                                                        <<07102>>03470000
index := dbcontents;                 << save old index pnt   >><<07102>>03472000
dbcontents := new'index;             << set new index pointer>><<07102>>03474000
dbmiscwd.(bsizef) := dbbsize + 1;    << set new size         >><<07102>>03476000
dirwrite (b);                        << write block on disc  >><<07102>>03478000
dirxxxbitmap (write);                << update bit map       >><<07102>>03480000
a'pntr := dacontents;                << save addr. of a      >><<07102>>03482000
a'count := daxcount;                 << save count of a      >><<07102>>03484000
                                                               <<07102>>03486000
<<----------------------------------------------------------->><<07102>>03488000
<< link father to index block                                >><<07102>>03490000
<<----------------------------------------------------------->><<07102>>03492000
move name := ddsname, (namesize);    << save name            >><<07102>>03494000
move ddsname := dbpname, (namesize); << extract father name  >><<07102>>03496000
tos := dirfind (dbpindexp);          << find father          >><<07102>>03498000
move ddsname := name, (namesize);    << restore name         >><<07102>>03500000
@pntr := tos + link;                 << addr. of index pntr  >><<07102>>03502000
pntr := new'index;                   << set new index pntr   >><<07102>>03504000
dirwrite (a);                        << update on disc       >><<07102>>03506000
dirread (new'index, b, 0, 0);        << new index block in b >><<07102>>03508000
dirread (a'pntr, a, a'count, dbemiscwd); << restore a        >><<07102>>03510000
dirdeallocate (index, (dbbsize - 1));<< return old space     >><<07102>>03512000
dirxxxbitmap (write);                                          <<07102>>03514000
end;                                                           <<07102>>03516000
                                                               <<07102>>03518000
logical procedure dir'expand'index;                            <<07102>>03520000
   option uncallable;                                          <<*7869>>03522000
                                                               <<07102>>03524000
<<----------------------------------------------------------->><<07102>>03526000
<< this procedure allows to expand number of groups and users>><<07102>>03528000
<< per account. it can be done by increasing size of group or>><<07102>>03530000
<< user index block. increasing size of file index block is  >><<07102>>03532000
<< far more difficult (very complicated for private volumes).>><<07102>>03534000
<< when the group index block is increased the jmat must be  >><<07102>>03536000
<< locked prior to the directory (dir sir).                  >><<07102>>03538000
<<----------------------------------------------------------->><<07102>>03540000
                                                               <<07102>>03542000
begin                                                          <<07102>>03544000
define  sirtabinx = jmatsir * sirtabentrylength#;              <<07102>>03546000
logical old'index;                 << old index block pointer>><<07102>>03548000
logical return'value = dir'expand'index;                       <<07102>>03550000
                                                               <<07102>>03552000
return'value := false;                                         <<07102>>03554000
old'index := dbcontents;                                       <<07102>>03556000
case * dbelevel of                                             <<07102>>03558000
   begin                                                       <<07102>>03560000
   <<-------------------------------------------------------->><<07102>>03562000
   << file level - expansion disallowed                      >><<07102>>03564000
   <<-------------------------------------------------------->><<07102>>03566000
   ;                                                           <<07102>>03568000
   <<-------------------------------------------------------->><<07102>>03570000
   << group level                                            >><<07102>>03572000
   <<-------------------------------------------------------->><<07102>>03574000
   if sir'holder = curprc and                                  <<07102>>03576000
      <<----------------------------------------------------->><<07102>>03578000
      <<this is a heavy restriction which allow only one user>><<07102>>03580000
      <<(the group creator) to be logged on in this account. >><<07102>>03582000
      <<this restriction is caused by lack of synchronization>><<07102>>03584000
      <<between any fopen (extracts group index block pointer>><<07102>>03586000
      <<from jit) and the processing of group index block    >><<07102>>03588000
      <<expansion.                                           >><<07102>>03590000
      <<----------------------------------------------------->><<07102>>03592000
      dbpcount <= 1 and          << number of accressors     >><<07102>>03594000
      dir'exp'index'blk (agipntr) then                         <<07102>>03596000
      begin                                                    <<07102>>03598000
      dir'gr'link (old'index);                                 <<07102>>03600000
      return'value := true;                                    <<07102>>03602000
      end;                                                     <<07102>>03604000
   <<-------------------------------------------------------->><<07102>>03606000
   << account index already has maximum size                 >><<07102>>03608000
   <<-------------------------------------------------------->><<07102>>03610000
   ;                                                           <<07102>>03612000
   <<-------------------------------------------------------->><<07102>>03614000
   << user level                                             >><<07102>>03616000
   <<-------------------------------------------------------->><<07102>>03618000
   if dir'exp'index'blk (auipntr) then                         <<07102>>03620000
      return'value := true;                                    <<07102>>03622000
   <<-------------------------------------------------------->><<07102>>03624000
   << volume set definition level - expansion disallowed     >><<07102>>03626000
   <<-------------------------------------------------------->><<07102>>03628000
   ;                                                           <<07102>>03630000
   end;                                                        <<07102>>03632000
end;   << dir'expand'index >>                                  <<07102>>03634000
                                                               <<07102>>03636000
                                                                        03638000
                                                                        03640000
logical procedure dirnewindex (ibsize, ilevel, ebsize, esize);          03642000
   value ibsize, ilevel, ebsize, esize;                                 03644000
   integer ibsize, ilevel, ebsize, esize;                               03646000
   options;                                                             03648000
<< caller must move pindexp and pname into dbpindexp and dbpname >>     03650000
begin                                                                   03652000
                                                                        03654000
   if ebsize > ddsbsize then goto never;                                03656000
   tos := dirallocate (ibsize);                                         03658000
   if <> then                                                           03660000
      begin                                                             03662000
      if < then xreg := ccl                                             03664000
      else                                                              03666000
never:   xreg := ccg;                                                   03668000
      cc := xreg;                                                       03670000
      dirnewindex := 0;                                                 03672000
      return;                                                           03674000
      end;                                                              03676000
   cc := cce;                                                           03678000
   dbdirbase := dirbase;                                       <<02.pv>>03680000
   dbcontents := (dirnewindex := tos);                                  03682000
   @dblpntr := @dbiopntr+presize;                                       03684000
   dbnumvalid := ibsize;                                                03686000
   dbused := 0;                                                         03688000
   dbbfactor := (dbbwsize := (dbbsize := ibsize) & lsl(7)) / isize;     03690000
   tos := 0;                                                            03692000
   tos.(typef) := indextype;                                            03694000
   tos.(levelf) := ilevel;                                              03696000
   tos.(xsizef) := (dbxsize := isize);                                  03698000
   tos.(bsizef) := dbbsize;                                             03700000
   dbmiscwd := tos;                                                     03702000
   dbxcount := (dbpcount := (dbetotal := 0));                           03704000
   tos := 0;                                                            03706000
   tos.(typef) := entrytype;                                            03708000
   tos.(levelf) := ilevel;                                              03710000
   tos.(xsizef) := esize;                                               03712000
   tos.(bsizef) := ebsize;                                              03714000
   dbemiscwd := tos;                                                    03716000
   dirxxxbitmap (write);                                       <<28.pv>>03718000
   dirwrite (b);                                                        03720000
   end    <<dirnewindex>>;                                              03722000
                                                                        03724000
                                                                        03726000
                                                                        03728000
                                                                        03730000
integer procedure dirscan (entryname, type'which);                      03732000
   value type'which;                                                    03734000
   array entryname;                                                     03736000
   logical type'which;                                                  03738000
   options;                                                             03740000
   << assumes namesize = 4 >>                                           03742000
<< returns:                                                             03744000
   ccg - exact entry returned.                                          03746000
   ccl - preceeding or next entry returned                              03748000
   cce - "PSEUDO" preceeding or next entry returned (outside bounds)  >>03750000
                                                                        03752000
begin                                                                   03754000
   double pointer dentryname = entryname;                               03756000
   define                                                               03758000
      whichfield  = 15:1 #,                                             03760000
      typefield  = 13:2 #;                                              03762000
   double pointer endx;                                                 03764000
   double pointer pntr;                                                 03766000
   integer pointer ipntr = pntr;                                        03768000
<< >>                                                                   03770000
   @base := if (type'which) then @dbprepre else @daprepre;              03772000
   base (flags).flagsf := 0; <<cleanup old residue>>                    03774000
   @endx := (@pntr := ibase(lpntr))+ibase(used);                        03776000
   << change to binary search later >>                                  03778000
   while @pntr < @endx do                                               03780000
      begin                                                             03782000
      if dentryname = pntr then                                         03784000
         if dentryname (1) & dlsl (1) & dlsr (1) =                      03786000
            pntr (xreg) & dlsl (1) & dlsr (1)                           03788000
         then go to exactone;                                           03790000
      if < then goto nextone;                                           03792000
      @pntr := @pntr+ibase(xsize);                                      03794000
      end;                                                              03796000
   @endx := 0;                                                          03798000
nextone:                                                                03800000
   if type'which.(typefield) <= 1 then                                  03802000
      << exact or exact/next request >>                                 03804000
         begin                                                          03806000
         tos := @pntr;                                                  03808000
         xreg := if @endx <> 0 then ccl else cce;                       03810000
         end                                                            03812000
   else                                                                 03814000
      << exact/preceeding request >>                                    03816000
         begin                                                          03818000
         tos := @pntr-ibase(xsize);                                     03820000
         xreg := if @pntr <> ibase(lpntr) then ccl else cce;            03822000
         end;                                                           03824000
   goto exit;                                                           03826000
exactone:                                                               03828000
   base (flags).badelmf := ipntr (2) < 0; <<flagged entry?>>            03830000
   tos := @pntr;                                                        03832000
   xreg := ccg;                                                         03834000
exit:                                                                   03836000
   cc := xreg;                                                          03838000
   dirscan := tos;                                                      03840000
   end    <<dirscan>>;                                                  03842000
                                                                        03844000
                                                                        03846000
                                                                        03848000
                                                                        03850000
double procedure dirinsert (indexpointer);                              03852000
   value indexpointer;                                                  03854000
   logical indexpointer;                                                03856000
   options;                                                             03858000
<< when called:                                                         03860000
   1. directory is locked,                                              03862000
   2. entry has been moved to the data segment (at 0),                  03864000
   3. db is set at the data segment.  >>                                03866000
<< returns:                                                             03868000
   (s-0)                  (s-1)                                         03870000
   0 - successful            0                                          03872000
   1 - duplicate name        0                                          03874000
   4 - no user room          n         n% used.  no index room          03876000
   5 - no user room          0         > 65k entries                    03878000
   6 - no system room        n         for n contiguous blocks        >>03880000
                                                                        03882000
begin                                                                   03884000
   logical newpreietotal;                                               03886000
   integer stemp;                                                       03888000
   integer stemp2;                                                      03890000
   integer stemp3, stemp4;                                              03892000
   integer                                                              03894000
      zt,                                                               03896000
      ztotal,                                                           03898000
      zh1,                                                              03900000
      zhalf1,                                                           03902000
      zh2,                                                              03904000
      zhalf2;                                                           03906000
   logical pointer                                                      03908000
      ipntr,                                                            03910000
      ipntr2;                                                           03912000
   integer pointer                                                      03914000
      iipntr = ipntr,                                                   03916000
      iipntr2 = ipntr2;                                                 03918000
   integer temp;                                                        03920000
   logical pointer tempp = temp;                                        03922000
   integer esize;                                                       03924000
   logical pointer s2pntr = s-2;                                        03926000
   logical pointer s4pntr = s-4;                                        03928000
                                                                        03930000
                                                                        03932000
                                                                        03934000
logical subroutine zinsert (element, which, pntr);                      03936000
   value which;                                                         03938000
   array element, pntr;                                                 03940000
   logical which;                                                       03942000
begin                                                                   03944000
   @base := if which then @dbprepre else @daprepre;                     03946000
   if @pntr = 0 then                                                    03948000
                                                                        03950000
      << *** find previous element *** >>                               03952000
      begin                                                             03954000
      @pntr := dirscan (element, en lor which);                         03956000
      if > then                                                         03958000
         begin                                                          03960000
         zinsert := 0;                                                  03962000
         return;                                                        03964000
         end;                                                           03966000
      end;                                                              03968000
   stemp2 := base(xsize);                                               03970000
   stemp := ibase(lpntr) + ibase(used) - @pntr;                         03972000
   if <> then                                                           03974000
      << ******** check code for following 2 statements **************>>03976000
      move pntr (stemp+stemp2-1) := pntr(stemp-1), (-stemp);            03978000
   move pntr := element, (stemp2);                                      03980000
   zinsert := @pntr;                                                    03982000
   end    <<zinsert>>;                                                  03984000
                                                                        03986000
                                                                        03988000
                                                                        03990000
logical subroutine znewentryblock (name, indexplace);                   03992000
   array name, indexplace;                                              03994000
begin                                                                   03996000
   if (stemp3 := dbxcount+1) > dbbfactor then                           03998000
      if not dir'expand'index then                             <<07102>>04000000
      begin                                                             04002000
      tos := integer (fixr ((real(dbetotal)/real((dbxcount) *           04004000
         ((dbebsize & lsl(7))/esize)))*100.));                          04006000
      tos := 4;                                                         04008000
      << *********** check this branch ***********>>                    04010000
      goto badexit;                                                     04012000
      end;                                                              04014000
   stemp4 := dirallocate (dbebsize);                                    04016000
   if < then                                                            04018000
      begin                                                             04020000
      tos := dbebsize;                                                  04022000
      tos := 6;                                                         04024000
      << *********** check this branch ***********>>                    04026000
      goto badexit;                                                     04028000
      end;                                                              04030000
   dirxxxbitmap (write);                                       <<28.pv>>04032000
                                                                        04034000
   << *** index has room and we have a block *** >>                     04036000
   << ******* check code for folllowing statement **************>>      04038000
   zinsert (name, b, indexplace);                                       04040000
   dbxcount := stemp3;                                                  04042000
   dbused := dbused+isize;                                              04044000
   indexplace (iepntr) := (znewentryblock := stemp4);                   04046000
   end    <<znewentryblock>>;                                           04048000
                                                                        04050000
                                                                        04052000
                                                                        04054000
subroutine zset;                                                        04056000
begin                                                                   04058000
   ztotal := zt * (xreg := esize);                                      04060000
   zhalf1 := (zh1 := zt & lsr(1)) * xreg;                               04062000
   zhalf2 := (zh2 := (zt+1) & lsr(1)) * xreg;                           04064000
   end    <<zset>>;                                                     04066000
                                                                        04068000
                                                                        04070000
                                                                        04072000
subroutine zdistribute;                                                 04074000
begin                                                                   04076000
   move dblpntr (zhalf2-1) := dalpntr (ztotal-1), (-zhalf2);            04078000
   dbused := zhalf2;                                                    04080000
   dbxcount := zh2;                                                     04082000
   dirwrite (b);                                                        04084000
   daused := zhalf1;                                                    04086000
   daxcount := zh1;                                                     04088000
   dirwrite (a);                                                        04090000
   end    <<zdistribute>>;                                              04092000
                                                                        04094000
                                                                        04096000
                                                                        04098000
                                                                        04100000
<< >>                                                                   04102000
   dirread (indexpointer, b, 0, 0);                                     04104000
   esize := dbexsize;                                                   04106000
   newpreietotal := dbetotal+1;                                         04108000
   if carry then                                                        04110000
      begin                                                             04112000
      tos := 5;                                                         04114000
      goto badexitz;                                                    04116000
      end;                                                              04118000
   @ipntr := dirscan (ddsentry, epb);                                   04120000
   if > then                                                            04122000
dupname:                                                                04124000
      begin                                                             04126000
      tos := 1;                                                         04128000
badexitz:                                                               04130000
      assemble (zrob);                                                  04132000
badexit:                                                                04134000
      cc := ccg;                                                        04136000
      goto exit;                                                        04138000
      end;                                                              04140000
   if = then                                                            04142000
                                                                        04144000
      <<*** no containing block: allocate 1 or insert in first one ***>>04146000
      begin                                                             04148000
      @ipntr := @dblpntr;                                               04150000
      if dbxcount > 0 then goto checkfit;                               04152000
      tos := znewentryblock (ddsentry, ipntr);                          04154000
      ipntr (iecount) := 0;                                             04156000
      << *** set up null block *** >>                                   04158000
      dbnumvalid := dbbsize;    <<procect against inaccurate copy in b>>04160000
      dadirbase := dirbase;                                    <<02.pv>>04162000
      dacontents := tos;                                                04164000
      @dalpntr := @daiopntr;                                            04166000
      danumvalid := dbebsize;                                           04168000
      daxsize := dbexsize;                                              04170000
      daused := 0;                                                      04172000
      dabwsize := (dabsize := dbebsize) & lsl(7);                       04174000
      dabfactor := dabwsize/daxsize;                                    04176000
      damiscwd := dbemiscwd;                                            04178000
      daxcount := 0;                                                    04180000
      goto normalinsert;                                                04182000
      end;                                                              04184000
checkfit:                                                               04186000
   if iipntr (iecount) < (temp := (dbebsize & lsl(7)) / esize) then     04188000
                                                                        04190000
      << *** a normal insertion *** >>                                  04192000
      begin                                                             04194000
      dirread (ipntr (iepntr), a, ipntr(iecount), dbemiscwd);           04196000
normalinsert:                                                           04198000
      if zinsert (ddsentry, a, dds) = 0 then goto dupname;              04200000
      daused := daused+esize;                                           04202000
      daxcount := daxcount+1;                                           04204000
      dirwrite (a);                                                     04206000
      dbetotal := newpreietotal;                                        04208000
      move ipntr := dalpntr, (namesize);                                04210000
      iipntr (iecount) := iipntr (iecount) + 1;                         04212000
      dirwrite (b);                                                     04214000
      end                                                               04216000
   else                                                                 04218000
                                                                        04220000
      << *** distribution required *** >>                               04222000
      begin                                                             04224000
      if dbxcount = 1 then goto newdistribute;                          04226000
      if @ipntr = @dblpntr then goto upper;                             04228000
      if @ipntr = @dblpntr (dbused-isize) then goto lower;              04230000
      if iipntr (isize+iecount) <= iipntr (-isize+iecount) then         04232000
upper:   xreg := isize                                                  04234000
      else                                                              04236000
lower:   xreg := -isize;                                                04238000
      @ipntr2 := @ipntr (xreg);                                         04240000
      tos := (zt := iipntr (iecount) + iipntr2 (xreg) + 1);             04242000
      if real (tos & lsr(1)) / real (temp) < goodpercent then           04244000
                                                                        04246000
         << *** distribute among neighbors *** >>                       04248000
         begin                                                          04250000
         zset;                                                          04252000
         if @ipntr > @ipntr2 then                                       04254000
            begin  <<make ipntr lower one>>                             04256000
            tos := @ipntr2;                                             04258000
            @ipntr2 := @ipntr;                                          04260000
            @ipntr := tos;                                              04262000
            end;                                                        04264000
         << read in lower block >>                                      04266000
         dirread (ipntr (iepntr), a, ipntr (iecount), dbemiscwd);       04268000
         << kluge to read in upper block right on top of lower >>       04270000
         danumvalid := dbebsize;                                        04272000
         tos := @dbiopntr;                                              04274000
         @dbiopntr := @dalpntr (daused);                                04276000
         dirread (ipntr2 (iepntr), b, ipntr2 (iecount), dbemiscwd);     04278000
         @dbiopntr := (@dblpntr := tos);                                04280000
         << (kluge a's size for zinsert) >>                             04282000
         tos := daxcount;                                               04284000
         tos := daused;                                                 04286000
         daused := ztotal-esize;                                        04288000
         daxcount := zt-1;                                              04290000
         if (temp := zinsert (ddsentry, a,  dds)) = 0 then              04292000
            begin                                                       04294000
            daused := tos;                                              04296000
            daxcount := tos;                                            04298000
            dbcontents := 0;                                            04300000
            goto dupname;                                               04302000
            end;                                                        04304000
         dbnumvalid := danumvalid;                                      04306000
         zdistribute;                                                   04308000
         move dapname := dblpntr, (namesize);   <<dapname not used>>    04310000
         dirread (indexpointer, b, 0, 0);                               04312000
         dbetotal := newpreietotal;                                     04314000
         if temp = @dalpntr then                                        04316000
            move ipntr := dalpntr, (namesize);                          04318000
         ipntr (iecount) := zh1;                                        04320000
         move ipntr2 := dapname, (namesize);                            04322000
         ipntr2 (xreg) := zh2;                                          04324000
         dirwrite (b);                                                  04326000
         end                                                            04328000
      else                                                              04330000
newdistribute:                                                          04332000
                                                                        04334000
         << *** distribute with new block *** >>                        04336000
         begin                                                          04338000
         zt := ipntr (iecount) +1;                                      04340000
         zset;                                                          04342000
         dirread (ipntr (iepntr), a, ipntr(iecount), dbemiscwd);        04344000
         temp := dirscan (ddsentry, ena);                               04346000
         if > then goto dupname;                                        04348000
         @ipntr2 := @ipntr+isize;                                       04350000
         xreg := @dalpntr(zhalf1);                                      04352000
         if temp <= xreg then                                           04354000
            if < then xreg := xreg-daxsize                              04356000
            else xreg := @ddsentry;                                     04358000
         tos := znewentryblock (dds(xreg), ipntr2);                     04360000
         ipntr2 (iecount) := zh2;                                       04362000
         dbetotal := newpreietotal;                                     04364000
         ipntr (xreg) := zh1;                                           04366000
         if temp = @dalpntr then                                        04368000
            move ipntr := ddsentry, (namesize);                         04370000
         dirwrite (b);                                                  04372000
         << *** set up null block in b *** >>                           04374000
         danumvalid := dbebsize;    <<protect against inaccurate copya>>04376000
         dbcontents := tos;                                             04378000
         @dblpntr := @dbiopntr;                                         04380000
         dbnumvalid := dbebsize;                                        04382000
         dbxsize := dbexsize;                                           04384000
         dbused := 0;                                                   04386000
         dbbfactor := (dbbwsize := (dbbsize := dbebsize) & lsl(7))      04388000
            / dbxsize;                                                  04390000
         dbmiscwd := dbemiscwd;                                         04392000
         dbxcount := 0;                                                 04394000
         zinsert (ddsentry, a, tempp);                                  04396000
         zdistribute;                                                   04398000
         end;                                                           04400000
      end;                                                              04402000
   tos := 0d;    <<successfil return>>                                  04404000
   cc := cce;                                                           04406000
exit:                                                                   04408000
   dirinsert := tos;                                                    04410000
   end    <<dirinsert>>;                                                04412000
                                                                        04414000
                                                                        04416000
                                                                        04418000
                                                                        04420000
double procedure dirfind (indexpointer);                                04422000
   value indexpointer;                                                  04424000
   logical indexpointer;                                                04426000
   options;                                                             04428000
<< return:                                                              04430000
   high order  =  db addr of index (in b).                              04432000
   low order   =  db addr of entry (in a).    >>                        04434000
begin                                                                   04436000
   integer                                                     <<61.pv>>04438000
       mvtabx;                                                 <<61.pv>>04440000
   dirread (indexpointer, b, 0, 0);                                     04442000
   tos := dirscan (ddsentry, epb);                                      04444000
   if = then                                                            04446000
notfound:                                                               04448000
      begin                                                             04450000
      dirfind := 0d;                                                    04452000
      return;                                                           04454000
      end;                                                              04456000
   dirread (s0pntr(iepntr), a, s0pntr(iecount), dbemiscwd);             04458000
   tos := dirscan (ddsentry, ea);                                       04460000
   if <= then goto notfound;                                            04462000
   if base (miscwd).(levelf) = grouplevel and                  <<09.pv>>04464000
      xtype.(endlevelf) = filelevel then                       <<09.pv>>04466000
    if (tos := s0pntr (glinkage)).(pvf) = pv then              <<09.pv>>04468000
     if (mvtabx := tos.(mvtabxf)) <> 0 then                    <<61.pv>>04470000
     begin     <<pv and mounted>>                              <<09.pv>>04472000
         tos := ddsdst;                 <<e: target>>          <<61.pv>>04474000
         tos := @dirbase;               <<d: target offset>>   <<61.pv>>04476000
         tos := mvtabdst;               <<c: source>>          <<61.pv>>04478000
         tos := (mvtabx*mvtabsz)+2;     <<b: source offset>>   <<61.pv>>04480000
         tos := 2;                      <<a: count>>           <<61.pv>>04482000
         assemble (mds);                <<dirbase switch>>     <<61.pv>>04484000
     end                                                       <<09.pv>>04486000
     else <<pv and not mounted>>                               <<61.pv>>04488000
    else <<not pv>> del;                                       <<16.pv>>04490000
   dirfind := tos;                                                      04492000
   end    <<dirfind>>;                                                  04494000
                                                                        04496000
                                                                        04498000
                                                                        04500000
                                                                        04502000
procedure dirremove (element, which);                                   04504000
   value which;                                                         04506000
   logical which;                                                       04508000
   array element;                                                       04510000
   options;                                                             04512000
<< decrements <used> and <xcount>;                                      04514000
   removes element;                                                     04516000
   deallocates block when an entry block is depleted.  >>               04518000
begin                                                                   04520000
   @base := if which then @dbprepre else @daprepre;                     04522000
   whichdirty := true;                                                  04524000
   ibase(used) := ibase(used) - ibase(xsize);                           04526000
   ibase(xcount) := ibase(xcount)-1;                                    04528000
   if = then                                                            04530000
      begin                                                             04532000
      if base(miscwd).(typef) = entrytype then                          04534000
         begin                                                          04536000
         dirdeallocate (base(contents), base(bsize));                   04538000
         base (contents) := (whichdirty := 0);                          04540000
         end;                                                           04542000
      return;                                                           04544000
      end;                                                              04546000
   move element := element (base(xsize)),                               04548000
      (ibase(lpntr)+ibase(used)-@element);                              04550000
   end    <<dirremove>>;                                                04552000
                                                                        04554000
                                                                        04556000
                                                                        04558000
logical procedure acccheck (level, acctname, acctsec,groupname,         04560000
      groupsec, creator, filesec, userinfo);                            04562000
   value level, acctsec, groupsec, filesec;                    << ... >>04564000
   integer level;                                                       04566000
   byte array acctname;                <<not opt.>>                     04568000
   logical acctsec;                    <<not opt.>>                     04570000
   byte array groupname;               <<not opt. if level <= 1>>       04572000
   double groupsec;                    <<not opt. if level <= 1>>       04574000
   byte array creator;                 <<not opt. if level = 0>>        04576000
   double filesec;                     <<not opt. if level = 0>>        04578000
   byte array userinfo;                <<opt.                           04580000
                                       (0:7) = uacct (always),          04582000
                                       (8:15)= uhgroup (if level <= 1)  04584000
                                       (16:23)=ulgroup (if level <= 1)  04586000
                                       (24:31)=uname (if level =0) >>   04588000
   option variable, privileged, uncallable;                             04590000
<<                                                                      04592000
   returns access  (acccheck.(10:6) = rawlxs)                           04594000
   at level    (0/1/2 = file/group/acct)                                04596000
   db must be at stack.                                                 04598000
   parameters required indicated aboce (depends on level)               04600000
   if <userinfo> omittedd, jit accessed to get info.                    04602000
   note: <userinfo> = jit1(8:23).                                       04604000
   >>                                                                   04606000
begin                                                                   04608000
<< misc. decl >>                                                        04610000
   integer           xreg              = x,                             04612000
                     s15               = s-15,                          04614000
                     s2                = s-2,                           04616000
                     s0                = s-0;                           04618000
   define            asm               = assemble #;                    04620000
<< parameter breakdown >>                                               04622000
   logical           pmask             = q-4;                           04624000
   integer           gsec1             = groupsec,                      04626000
                     gsec2             = gsec1 +1,                      04628000
                     filesec1          = filesec,                       04630000
                     filesec2          = filesec1 +1;                   04632000
   define            uacct             = userinfo #,                    04634000
                     uhgroup           = userinfo (8) #,                04636000
                     ulgroup           = userinfo (16) #,               04638000
                     uname             = userinfo (24) #;               04640000
   logical           accessx           = acccheck;                      04642000
<< locals >>                                                            04644000
   integer           jit'dst;                                  <<06560>>04646000
   logical array     jitarr (*)        = db + 0;               <<06560>>04648000
   logical array qarray (*) = q + 0;   <<define pxglobal area>><<06560>>04650000
   integer pcbglobloc;                 <<required for pxglob >><<06560>>04652000
   logical pointer ucapptr;            <<user attr. from pxg >><<06560>>04654000
   logical           accessor          := %60;    <<init any and ac>>   04656000
   define            acaccr            = accessor.(11:1) #,             04658000
                     alaccr            = accessor.(12:1) #,             04660000
                     guaccr            = accessor.(13:1) #,             04662000
                     glaccr            = accessor.(14:1) #,             04664000
                     craccr            = accessor.(15:1) #;             04666000
                                                                        04668000
   subroutine def'move'from'dst;                               <<06560>>04670000
                                                               <<06560>>04672000
                                                               <<06560>>04674000
                                                               <<06560>>04676000
                                                                        04678000
                                                                        04680000
   << get user capability attributes and jit dst >>                     04682000
   pxglobal;   <<initialize pointers to pxglobal             >><<06560>>04684000
   @ucapptr := @pxg'userattributes;    <<set ptr to user attr>><<06560>>04686000
   jit'dst := pxg'jitdst;                                      <<06560>>04688000
   if not (pmask) then                                                  04690000
      begin    <<get user info from jit.  caller didn't supply>>        04692000
      asm (adds 16);                                                    04694000
      tos := @s15;                                                      04696000
      @userinfo := s0 &lsl(1);                                          04698000
      move'from'dst ( *, jit'dst, @jithacctname, 16);          <<06560>>04700000
      end;                                                              04702000
   if uacct <> acctname, (8) then                                       04704000
      begin                                                             04706000
      acaccr := 0;                                                      04708000
      tos := %76;                                                       04710000
      end                                                               04712000
   else tos := %77;                                                     04714000
   if not (ucapsf) then tos.(15:1) := 0;                       <<06560>>04716000
   acccheck := tos;                                                     04718000
   if not (ucapsm) then                                        <<06560>>04720000
      begin                                                             04722000
      if not (acaccr) or not (ucapam) then                     <<06560>>04724000
         begin    <<not am or sm>>                                      04726000
         << determine user's accessor categories >>                     04728000
         << any and ac already set >>                                   04730000
         if level <> 2 and acaccr then                                  04732000
            begin    << mem of acct >>                                  04734000
            alaccr := ucapal;                                  <<06560>>04736000
            tos := 1;                                                   04738000
            if uhgroup = groupname, (8) then                            04740000
               <<home group>>                                           04742000
               glaccr := ucapgl                                <<06560>>04744000
            else if ulgroup <> groupname, (8) then tos := tos-1;        04746000
            guaccr := tos;                                              04748000
            if level = 0 and uname = creator, (8) then craccr := true;  04750000
            end;                                                        04752000
         << user's accessor categories determined >>                    04754000
                                                                        04756000
         << apply to acct security matrix >>                            04758000
         tos := accessor & lsr(4);                                      04760000
         tos := acctsec.(4:12);                                         04762000
         xreg := 5;                                                     04764000
         do begin                                                       04766000
            asm (ddup;  and, del);                                      04768000
            if = then                                                   04770000
               begin                                                    04772000
               tos := accessx;                                          04774000
               asm (trbc 10, x);                                        04776000
               acccheck := tos;                                         04778000
               end;                                                     04780000
            tos := tos & lsr(2);                                        04782000
            xreg := xreg -1;                                            04784000
            end                                                         04786000
         until <;                                                       04788000
         if level <> 2 and accessx <> 0 then                            04790000
            begin                                                       04792000
                                                                        04794000
            << apply accessor to group security >>                      04796000
            tos := accessor & lsr(1);                                   04798000
            tos := gsec1.(2:14);                                        04800000
            tos := gsec2;                                               04802000
            xreg := 5;                                                  04804000
            do begin                                                    04806000
               tos := s2;                                               04808000
               asm (ddup, and;  ddel);                                  04810000
               if = then                                                04812000
                  begin                                                 04814000
                  tos := accessx;                                       04816000
                  asm (trbc 10, x);                                     04818000
                  acccheck := tos;                                      04820000
                  end;                                                  04822000
               tos := tos & dlsr(5);                                    04824000
               xreg := xreg -1;                                         04826000
               end                                                      04828000
            until <;                                                    04830000
            if level = 0 and accessx <> 0 then                          04832000
               begin                                                    04834000
                                                                        04836000
               << apply accessor to file security >>                    04838000
               tos := filesec1.(2:14);                                  04840000
               tos := filesec2;                                         04842000
               xreg := 4;                                               04844000
               do begin                                                 04846000
                  tos := accessor;                                      04848000
                  asm (ddup, and;  ddel);                               04850000
                  if = then                                             04852000
                     begin                                              04854000
                     tos := accessx;                                    04856000
                     asm (trbc 10, x);                                  04858000
                     acccheck := tos;                                   04860000
                     end;                                               04862000
                  tos := tos & dlsr(6);                                 04864000
                  xreg := xreg -1;                                      04866000
                  end                                                   04868000
               until <;                                                 04870000
               end;                                                     04872000
            end;                                                        04874000
         end;                                                           04876000
      end;                                                     << ... >>04878000
   end    <<access>>;                                                   04880000
                                                                        04882000
                                                                        04884000
                                                                        04886000
                                                                        04888000
procedure dirreset (numsects);                                          04890000
   value numsects;                                             << ... >>04892000
   double numsects;                                                     04894000
   options;                                                             04896000
<< called to subtract <numsects> from father (and grandfather) when     04898000
   error detected after they are bumped.  assumes b contains current    04900000
   index (thus pointer to father)                                       04902000
   >>                                                                   04904000
   while dbpindexp <> 0 do                                              04906000
      begin                                                             04908000
      move ddsname := dbpname, (namesize);                              04910000
      tos := dirfind (dbpindexp);                                       04912000
      if damiscwd.(levelf) = grouplevel then tos := tos +gdfscount      04914000
      else tos := tos +adfscount;                                       04916000
      dps0 := dps0 -numsects;                                           04918000
      dirwrite (a);                                            << ... >>04920000
      end;                                                              04922000
                                                                        04924000
                                                                        04926000
                                                                        04928000
                                                                        04930000
                                                                        04932000
double procedure dirstartoff (parr, numsects, recip, parms,    <<01.pv>>04934000
                              mvtabx);                         <<01.pv>>04936000
   value numsects, parms, mvtabx;                              <<01.pv>>04938000
   array parr;                         <<db addr of spec part>>         04940000
   double numsects;                    <<to adjust acct/group>>         04942000
   integer procedure recip;            <<for visit of @ hit>>           04944000
   integer parms;                      <<for visit of @ hit>>           04946000
   integer mvtabx;                                             <<01.pv>>04948000
   option variable, privileged, internal, uncallable;                   04950000
<<                                                                      04952000
   analyzes the specification part for directory routines, and          04954000
   goes down tree until just before hit of target, leaving:             04956000
      adjust, xtype, linkage'xindexp, xaname, xguname,           43.pv  04958000
      xfname, xasec and xgsec;                                   43.pv  04960000
      db thru db+3 to final name.                                       04962000
   if <numsects> specified, then it's added to acct and group.          04964000
   if <recip> and <parms> specified, then @ entry hit is visited.       04966000
      carry set on return => recip said stop or don't scan my tree.     04968000
   if just <parms> specified, then s access to group checked.           04970000
   type return is directory error pair.                                 04972000
   >>                                                                   04974000
begin                                                                   04976000
   logical pmask = q-4;                                                 04978000
   integer ipmask = pmask;                                              04980000
   switch startswitch := noindex, aindex, gindex, noindex;              04982000
   define                                                      <<01.pv>>04984000
       mvtabx'm       = (15:1) #,                              <<01.pv>>04986000
       parms'm        = (14:1) #,                              <<01.pv>>04988000
       recip'm        = (13:1) #,                              <<01.pv>>04990000
       numsects'm     = (12:1) #,                              <<01.pv>>04992000
       parr'm         = (11:1) #,                              <<01.pv>>04994000
       mvtabx'p       = pmask.mvtabx'm #,                      <<01.pv>>04996000
       parms'p        = pmask.parms'm #,                       <<01.pv>>04998000
       recip'p        = pmask.recip'm #,                       <<01.pv>>05000000
       numsects'p     = pmask.numsects'm #,                    <<01.pv>>05002000
       parr'p         = pmask.parr'm #;                        <<03.pv>>05004000
   define                                                               05006000
      movlb1 =                                                          05008000
         tos := 0;                                                      05010000
         tos := #,                                                      05012000
      movlb2 =                                                          05014000
                +adjust;                                                05016000
         tos := namesize;                                               05018000
         assemble (mvlb) #;                                             05020000
                                                                        05022000
                                                                        05024000
subroutine visit (needsir);                                    <<58.pv>>05026000
   << s-0 = pointer to entry >>                                <<58.pv>>05028000
   value needsir;                                              <<58.pv>>05030000
   logical needsir;                                            <<58.pv>>05032000
   if recip'p and parms'p then                                 <<09.pv>>05034000
      begin                                                             05036000
      tos := if needsir then getsir (dirsir) else sirreturn;   <<58.pv>>05038000
      tos := dirsir;                                           <<58.pv>>05040000
      tos := sirreturn; <<save it>>                            <<58.pv>>05042000
      asmb (cab, cab; xch);                                    <<58.pv>>05044000
      tos := 0;                                                         05046000
      tos := @ps6;                                             <<58.pv>>05048000
      tos := damiscwd.(levelf);                                         05050000
      tos := parms;                                                     05052000
      tos := ds5;                                                       05054000
      tos := recip (*, *, *, *);  <<visit>>                             05056000
      if ls5 then <<needsir: extra getsir invoked>>            <<58.pv>>05058000
       if ls0 then                                             <<58.pv>>05060000
       begin <<extra was not released>>                        <<58.pv>>05062000
           tos := ds2;                                         <<58.pv>>05064000
           relsir (*, *);                                      <<58.pv>>05066000
       end else                                                <<58.pv>>05068000
      else <<extra getsir not invoked>>                        <<58.pv>>05070000
       if not ls0 then                                         <<62.pv>>05072000
       begin                                                   <<62.pv>>05074000
           getsir (dirsir);                                    <<62.pv>>05076000
           s0.(0:1) := true; <<force redo>>                    <<62.pv>>05078000
       end;                                                    <<62.pv>>05080000
      sirreturn := s3;                                         <<60.pv>>05082000
      if s0 < 0 then                                           <<56.pv>>05084000
      begin  <<cause startoff to be redone>>                   <<56.pv>>05086000
          tos := 0;                                            <<56.pv>>05088000
          go to exit;                                          <<56.pv>>05090000
      end;                                                     <<56.pv>>05092000
      if tos &lsr(1) > 0 then    <<stop or goto brother>>               05094000
         begin        <<so stop entire scan>>                           05096000
         carryx := 1;                                                   05098000
         goto okayexit;                                                 05100000
         end;                                                           05102000
      assemble (ddel, del);                                    <<57.pv>>05104000
      end;                                                              05106000
                                                                        05108000
                                                                        05110000
subroutine badexit (num);                                               05112000
   value num;                                                           05114000
   integer num;                                                         05116000
begin                                                                   05118000
   tos := dbelevel;                                                     05120000
   tos := s2;                                                           05122000
   if numsects'p then dirreset (numsects);                     <<01.pv>>05124000
   goto exit;                                                           05126000
   end    <<subroutine badexit>>;                                       05128000
                                                                        05130000
                                                                        05132000
<< >>                                                                   05134000
   push (dl);                                                           05136000
$if x0=on                                                      <<debug>>05138000
   asmb (rsw;del); if < then debug;                            <<debug>>05140000
$if                                                            <<debug>>05142000
   if exchangedb(ddsdst) <> 0 then sysabort(dirbaddst);        <<de>>   05144000
   sirreturn := getsir (dirsir);                               <<56.pv>>05146000
   if dadirty or dbdirty then sysabort (diraberr);             <<de>>   05148000
   adjust := -tos;                                                      05150000
   xasec := -1;                                                         05152000
   xgsec := -1d;                                                        05154000
   if recip'p and parms'p then parms := parms - deltaq;        <<01.pv>>05156000
   carryx := 0;                                                         05158000
   tos := @workarea+1;                                                  05160000
   tos := @parr+adjust;                                                 05162000
   tos := 6;                                                   <<38.pv>>05164000
   assemble (mvlb);                                                     05166000
   if mvtabx'p then xmvtabx:= mvtabx else mvtabx:= xmvtabx;    <<38.pv>>05168000
   if mvtabx = 0 then                                          <<38.pv>>05170000
   begin  <<default to sysvs directory base>>                  <<38.pv>>05172000
       sysvsdirbase;                                           <<38.pv>>05174000
       dirbase := tos;                                         <<38.pv>>05176000
   end else                                                    <<38.pv>>05178000
   begin  <<switch to appropriate directory base>>             <<38.pv>>05180000
       tos := ddsdst;                 <<e: target>>            <<38.pv>>05182000
       tos := @dirbase;               <<d: target offset>>     <<38.pv>>05184000
       tos := mvtabdst;               <<c: source>>            <<38.pv>>05186000
       tos := (mvtabx*mvtabsz)+2;     <<b: source offset>>     <<38.pv>>05188000
       tos := 2;                      <<a: count>>             <<38.pv>>05190000
       assemble (mds);                                         <<38.pv>>05192000
       <<---------------------------------------------------->><<07103>>05194000
       << extract dir. size from first word of mounted vol.  >><<07103>>05196000
       << table entry. the dir. size in mvtab entry used only>><<07103>>05198000
       << 11 bits i.e. must be multiply by 32 to obtain a    >><<07103>>05200000
       << real dir. size. the dir. size saved in ddsdst is   >><<07103>>05202000
       << used by directory space management.                >><<07103>>05204000
       <<---------------------------------------------------->><<07103>>05206000
       tos := ddsdst;                                          <<de>>   05208000
       tos := @pv'dir'size;                                    <<07103>>05210000
       tos := mvtabdst;                                        <<de>>   05212000
       tos := mvtabx * mvtabsz;                                <<07103>>05214000
       tos := 1;                                               <<de>>   05216000
       assemble (mds);                                         <<de>>   05218000
       pv'dir'size := pv'dir'size &lsl (5);                    <<07103>>05220000
   end;                                                        <<38.pv>>05222000
   goto startswitch (xtype.(startlevelf));                              05224000
noindex:                                                                05226000
   xindexp := sysacctindex;                                             05228000
   if xtype.(endlevelfx) = allaccts then goto okayexit;                 05230000
   movlb1 xaname movlb2;                                                05232000
   if xtype.(endlevelf) = accountlevel then goto okayexit;              05234000
   tos := dirfind (sysacctindex); <<get ptr to acct entry>>    <<47.pv>>05236000
   assemble (dtst, delb);                                               05238000
                                                                        05240000
   if = then goto nonexist;                                             05242000
   xasec := ps0 (asecw);                                                05244000
   if not recip'p and parms'p then                             <<01.pv>>05246000
      begin    <<check for save access>>                                05248000
      tos := 0;                                                         05250000
      tos := accountlevel;                                              05252000
      tos := xaname &lsl(1);                                            05254000
      tos := xasec;                                                     05256000
      exchangedb (0);                                                   05258000
      tos := acccheck (*, *, *);                                        05260000
      exchangedb (ddsdst);                                              05262000
      if not (tos) then goto nosave;                                    05264000
      end;                                                              05266000
   if numsects'p then                                          <<01.pv>>05268000
      begin    <<bump sector count>>                                    05270000
      tos := tos +adfscount;                                            05272000
      if (tos := dps0 +numsects) > dps0(1) then goto noroom;            05274000
      dps2 := tos;                                                      05276000
      dirwrite (a);                                                     05278000
      tos := tos -adfscount;                                            05280000
      end;                                                              05282000
   visit (true); <<account entry>>                             <<58.pv>>05284000
   case *xtype.(endlevelf) of                                  <<16.pv>>05286000
   begin                                                       <<07.pv>>05288000
       xreg := agipntr;    <<0 : file>>                        <<07.pv>>05290000
       xreg := agipntr;    <<1 : group>>                       <<07.pv>>05292000
       go to okayexit;     <<2 : acct - never get here>>       <<47.pv>>05294000
       xreg := auipntr;    <<3 : user>>                        <<07.pv>>05296000
       xreg := agipntr;    <<4 : vsd>>                         <<07.pv>>05298000
   end;                                                        <<07.pv>>05300000
   xindexp := s0pntr (xreg);                                            05302000
   del; <<ptr to acct entry>>                                  <<47.pv>>05304000
aindex:                                                                 05306000
   movlb1 xguname movlb2;                                               05308000
   case *xtype.(endlevelf) of                                  <<16.pv>>05310000
   begin                                                       <<08.pv>>05312000
       ; <<keep going>>    <<0 : file>>                        <<08.pv>>05314000
       go to okayexit;     <<1 : group>>                       <<08.pv>>05316000
       go to okayexit;     <<2 : acct - never get here>>       <<47.pv>>05318000
       go to okayexit;     <<3 : user - never get here>>       <<08.pv>>05320000
       ; <<keep going>>    <<4>>                               <<08.pv>>05322000
   end;                                                        <<08.pv>>05324000
   tos := dirfind (xindexp); <<get ptr to group entry>>        <<47.pv>>05326000
   assemble (dtst, delb);                                               05328000
                                                                        05330000
   if = then                                                            05332000
nonexist:    badexit (2);                                               05334000
   tos := ps0(gsec);                                                    05336000
   tos := ps1(gsec+1);                                                  05338000
   xgsec := tos;                                                        05340000
   if not recip'p and parms'p then                             <<01.pv>>05342000
      begin    <<check save access to group>>                           05344000
      tos := 0;                                                         05346000
      tos := grouplevel;                                                05348000
      tos := xaname &lsl(1);                                            05350000
      tos := xasec;                                                     05352000
      tos := xguname &lsl(1);                                           05354000
      tos := xgsec;                                                     05356000
      exchangedb (0);                                                   05358000
      tos := acccheck (*, *, *, *, *);                                  05360000
      exchangedb (ddsdst);                                              05362000
      if not (tos) then                                                 05364000
nosave:    badexit (3);                                                 05366000
      end;                                                              05368000
   if numsects'p then                                          <<01.pv>>05370000
      begin    <<adjust by numsects>>                                   05372000
      tos := tos +gdfscount;                                            05374000
      if (tos := dps0 +numsects) > dps0(1) then                         05376000
noroom:    badexit (8);                                                 05378000
      dps2 := tos;                                                      05380000
      dirwrite (a);                                                     05382000
      tos := tos -gdfscount;                                            05384000
      end;                                                              05386000
   visit (false); <<group entry>>                              <<58.pv>>05388000
   case *xtype.(endlevelf) of                                  <<16.pv>>05390000
   begin                                                       <<07.pv>>05392000
       xreg := gfipntr;    <<0 : file>>                        <<07.pv>>05394000
       go to okayexit;     <<1 : group>>                       <<47.pv>>05396000
       go to okayexit;     <<2 : acct - never get here>>       <<47.pv>>05398000
       go to okayexit;     <<3 : user - never get here>>       <<47.pv>>05400000
       xreg := gvsdipntr;  <<4 : vsd>>                         <<07.pv>>05402000
   end;                                                        <<07.pv>>05404000
   xindexp := s0pntr (xreg);                                   <<07.pv>>05406000
   del; <<ptr to group entry>>                                 <<47.pv>>05408000
gindex:                                                                 05410000
   if not logical (xtype.(allflag)) then                       <<07.pv>>05412000
      begin                                                             05414000
      movlb1 xfname movlb2;                                             05416000
      end;                                                              05418000
okayexit:                                                               05420000
   tos := 0d;                                                           05422000
exit:                                                                   05424000
   dirstartoff := tos;                                                  05426000
   end    <<simplestartoff>>;                                           05428000
                                                                        05430000
                                                                        05432000
                                                                        05434000
                                                                        05436000
double procedure direcinsert (type, linkage'indexp, aname,     <<38.pv>>05438000
                              guname, fname, insert, mvtabx);  <<38.pv>>05440000
    value   type, linkage'indexp, mvtabx;                      <<38.pv>>05442000
    logical type, mvtabx;                                      <<38.pv>>05444000
    double  linkage'indexp;                                    <<38.pv>>05446000
    array   aname, guname, fname, insert;                               05448000
    option privileged, uncallable, variable;                            05450000
<< <insert> points to word after <name> in then entry  (i.e. to         05452000
   an indexpointer or file pointer cell).                               05454000
   allocates and initializes appropriate indices for account and group  05456000
   entries  (the corresponding index cells of <insert> are ignored).  >>05458000
    begin                                                               05460000
        array parr (*) = type;                                          05462000
        logical                                                         05464000
            pmask = q-4;                                                05466000
            define                                                      05468000
                mvtabx'm = (15:1) #,                                    05470000
                mvtabx'p = pmask.mvtabx'm #;                            05472000
            double                                                      05474000
                junkd;                                                  05476000
            integer                                                     05478000
                junk1 = junkd,                                          05480000
                junk0 = junk1+1;                                        05482000
        logical jmat'sir'alloc := false;                       <<07102>>05484000
        logical jmat'sir'ret;                                  <<07102>>05486000
        double  return'value = direcinsert;                    <<07102>>05488000
<<>>                                                                    05490000
        double subroutine newtree (level, ibsize, ebsize,               05492000
                                   esize, xipntr, sd);                  05494000
            value   level, ibsize, ebsize, esize, xipntr, sd;           05496000
            integer level, ibsize, ebsize, esize, xipntr, sd;           05498000
            begin                                                       05500000
                dbpindexp := xindexp;                                   05502000
                move dbpname := ddsentry ,(namesize);                   05504000
                tos := dirnewindex (ibsize,                             05506000
                    level, ebsize, esize);                              05508000
                if <> then                                              05510000
                   begin                                       <<de>>   05512000
                     del;                                               05514000
                     cc := ccg;                                         05516000
                     junk1 := ibsize;                                   05518000
                     junk0 := 6;                                        05520000
                     newtree := junkd;                                  05522000
                   end                                         <<de>>   05524000
                else                                                    05526000
                begin                                                   05528000
                    exchangedb (0);                                     05530000
                    insert (s3<<xipntr>>-namesize) := tos;              05532000
                    exchangedb (ddsdst);                                05534000
                end;                                                    05536000
            end;<<of newtree>>                                          05538000
                                                                        05540000
                                                                        05542000
        subroutine returntree (xipntr, ibsize);                         05544000
            value   xipntr, ibsize;                                     05546000
            integer xipntr, ibsize;                                     05548000
            begin                                                       05550000
                exchangedb (0);                                         05552000
                tos := insert (xipntr-namesize);                        05554000
                exchangedb (ddsdst);                                    05556000
                dirdeallocate (*, s2<<ibsize>>);                        05558000
            end;<<of returntree>>                                       05560000
                                                                        05562000
                                                                        05564000
        double subroutine insertentry (level);                          05566000
            value   level;                                              05568000
            integer level;                                              05570000
            begin                                                       05572000
                tos := namesize;                                        05574000
                tos := @insert+adjust;                                  05576000
                case *s3 <<level>> of                          <<16.pv>>05578000
                begin                                                   05580000
                    tos := fsize;                                       05582000
                    tos := gsize;                                       05584000
                    tos := asize;                                       05586000
                    tos := usize;                                       05588000
                    tos := gvsdsize;                                    05590000
                end;                                                    05592000
                tos := tos - namesize;                                  05594000
                asmb (mvlb);                                            05596000
                if (insertentry := dirinsert (xindexp)) <> 0d then      05598000
                begin  <<need to return dir space>>                     05600000
                    case *level of                             <<16.pv>>05602000
                    begin                                               05604000
                        ;      <<0: file>>                              05606000
                        begin  <<1: group>>                             05608000
                            returntree (gfipntr, sysgfibsize);          05610000
                            returntree (gvsdipntr, sysgvsibsize);       05612000
                        end;<<of group>>                                05614000
                        begin  <<2: acct>>                              05616000
                            returntree (agipntr, sysagibsize);          05618000
                            returntree (auipntr, sysauibsize);          05620000
                        end;<<of acct>>                                 05622000
                        ;       <<3: user>>                             05624000
                        ;       <<4: vsd>>                              05626000
                    end;<<of level>>                                    05628000
                    cc := ccg;  <<failure>>                             05630000
                end;                                                    05632000
            end;<<of insertentry>>                                      05634000
                                                                        05636000
                                                                        05638000
start :                                                        <<07102>>05640000
        cc := cce;  <<ok until any failure>>                            05642000
        if mvtabx'p then                                                05644000
             tos := dirstartoff (parr,,,,mvtabx)                        05646000
        else tos := dirstartoff (parr);                                 05648000
        asmb (dtst);                                                    05650000
        if = then                                                       05652000
        begin <<found required level>>                                  05654000
            ddel;                                                       05656000
            case *type.(endlevelf) of                          <<16.pv>>05658000
            begin                                                       05660000
                tos := insertentry (filelevel);                         05662000
                begin  <<group>>                                        05664000
                    tos := newtree (filelevel, sysgfibsize,             05666000
                                    sysfebsize, fsize,                  05668000
                                    gfipntr, dirinerr);        <<de>>   05670000
                    asmb (dtst);                                        05672000
                    if = then  <<successfull?>>                         05674000
                    begin                                               05676000
                        ddel;                                           05678000
                        tos := newtree (vsdeflevel,                     05680000
                             sysgvsibsize,sysvsebsize,                  05682000
                             gvsdsize, gvsdipntr, dirvsderr);  <<de>>   05684000
                        asmb (dtst);                                    05686000
                        if <> then                                      05688000
                         returntree (gfipntr, sysgfibsize)              05690000
                        else                                            05692000
                        begin                                           05694000
                            ddel;                                       05696000
                            tos := insertentry (grouplevel);            05698000
                        end;                                            05700000
                    end;                                                05702000
                end;<<of group>>                                        05704000
                begin  <<acct>>                                         05706000
                    tos := newtree (grouplevel, sysagibsize,            05708000
                           sysgebsize,gsize,agipntr,dirinerr); <<de>>   05710000
                    asmb (dtst);                                        05712000
                    if = then <<successfull?>>                          05714000
                    begin                                               05716000
                        ddel;                                           05718000
                        tos := newtree (userlevel, sysauibsize,         05720000
                                        sysuebsize, usize,              05722000
                                        auipntr, dirinerr);    <<de>>   05724000
                        asmb (dtst);                                    05726000
                        if <> then returntree (agipntr, sysagibsize)    05728000
                        else                                            05730000
                        begin <<successfull>>                           05732000
                            ddel;                                       05734000
                            tos := insertentry (accountlevel);          05736000
                        end;                                            05738000
                    end;                                                05740000
                end;<<of acct>>                                         05742000
                tos := insertentry (userlevel);                         05744000
                tos := insertentry (vsdeflevel);                        05746000
            end;<<of endlevel>>                                         05748000
        end else cc := ccg;                                             05750000
        direcinsert := tos;                                             05752000
        relsir (dirsir,sirreturn);                                      05754000
        exchangedb (0);                                                 05756000
                                                               <<07102>>05758000
<<----------------------------------------------------------->><<07102>>05760000
<< this test is valid only for groups.                       >><<07102>>05762000
<< to expand number of groups per account by the expansion   >><<07102>>05764000
<< index block procedure, the jmat sir must be locked prior  >><<07102>>05766000
<< to the dir sir.                                           >><<07102>>05768000
<<----------------------------------------------------------->><<07102>>05770000
                                                               <<07102>>05772000
    if return'value <> 0d and          << if error           >><<07102>>05774000
       type.(endlevelf) = grouplevel and                       <<07102>>05776000
       not jmat'sir'alloc then                                 <<07102>>05778000
       begin                                                   <<07102>>05780000
       jmat'sir'ret := getsir (jmatsir);                       <<07102>>05782000
       jmat'sir'alloc := true;                                 <<07102>>05784000
       goto start;                                             <<07102>>05786000
       end;                                                    <<07102>>05788000
                                                               <<07102>>05790000
    if jmat'sir'alloc then                                     <<07102>>05792000
       relsir (jmatsir, jmat'sir'ret);                         <<07102>>05794000
                                                               <<07102>>05796000
    end;<<of direcinsert>>                                              05798000
                                                                        05800000
                                                                        05802000
                                                                        05804000
                                                                        05806000
                                                                        05808000
double procedure direcinsertfile (numsects, dummy, aname,      <<38.pv>>05810000
                          gname, fname, faddr, mvtabx);        <<38.pv>>05812000
   value numsects, dummy, faddr, mvtabx;                       <<38.pv>>05814000
   double numsects, faddr;                                              05816000
   integer dummy, mvtabx;                                      <<38.pv>>05818000
   array aname, gname, fname;                                           05820000
   option privileged, uncallable, variable;                    <<18.pv>>05822000
<<                                                                      05824000
   inserts file entry under acct and group.                             05826000
   increments acct and group space counts by <numsects>.                05828000
   checks that user has save access to group.                           05830000
   (always global access).                                              05832000
   >>                                                                   05834000
begin                                                                   05836000
   entry direcresetfile;  <<no security check>>                <<00091>>05838000
   array parr (*) = numsects;                                           05840000
   array filentry (0:5);                                       <<18.pv>>05842000
   double array dfilentry (*) = filentry;                      <<18.pv>>05844000
   double lnumsects;                                                    05846000
   double ddb4 = db+4;                                                  05848000
   logical                                                     <<18.pv>>05850000
       pmask = q-4;                                            <<18.pv>>05852000
   define                                                      <<18.pv>>05854000
       mvtabx'm = (15:1) #,                                    <<18.pv>>05856000
       mvtabx'p = pmask.mvtabx'm #;                            <<18.pv>>05858000
   integer                                                     <<18.pv>>05860000
       type = numsects;                                        <<38.pv>>05862000
   double                                                      <<38.pv>>05864000
       linkage'indexp = type+1;                                <<38.pv>>05866000
   logical checksec;                                           <<00091>>05868000
                                                               <<00091>>05870000
   if not (checksec:=true) then                                <<00091>>05872000
      begin                                                    <<00091>>05874000
direcresetfile:                                                <<00091>>05876000
      checksec:=false;                                         <<00091>>05878000
      end;                                                     <<00091>>05880000
<< >>                                                                   05882000
   lnumsects := numsects;                                               05884000
   numsects := double (dummy := 0);                            <<43.pv>>05886000
   if checksec then <<do security check>>                      <<00091>>05888000
      begin                                                    <<00091>>05890000
      tos:=if not mvtabx'p then dirstartoff(parr,lnumsects,,0) <<00091>>05892000
           else dirstartoff(parr,lnumsects,,0,mvtabx);         <<00091>>05894000
      end                                                      <<00091>>05896000
   else <<no security check>>                                  <<00091>>05898000
      begin                                                    <<00091>>05900000
      tos:=if not mvtabx'p then dirstartoff(parr,lnumsects)    <<00091>>05902000
           else dirstartoff(parr,lnumsects,,,mvtabx);          <<00091>>05904000
      end;                                                     <<00091>>05906000
   assemble (dtst);                                            <<43.pv>>05908000
   if <> then go to badexit;                                   <<43.pv>>05910000
   ddb4 := faddr;                                                       05912000
   tos := dirinsert (xindexp);                                          05914000
   assemble (dtst);                                                     05916000
   if <> then                                                           05918000
      begin                                                             05920000
      dirreset (lnumsects);                                             05922000
badexit:                                                                05924000
      tos := ccg;                                                       05926000
      end                                                               05928000
   else                                                                 05930000
      tos := cce;                                                       05932000
   cc := tos;                                                           05934000
   direcinsertfile := tos;                                              05936000
   relsir (dirsir, sirreturn);                                          05938000
   exchangedb (0);                                             << ... >>05940000
   end    <<procedure direcinsertfile>>;                                05942000
                                                                        05944000
                                                                        05946000
                                                                        05948000
                                                                        05950000
double procedure direcfind (type, linkage'indexp, aname,guname,<<38.pv>>05952000
                            fname, preturn);                   <<38.pv>>05954000
   value type, linkage'indexp;                                 <<38.pv>>05956000
   integer type;                                               <<38.pv>>05958000
   double  linkage'indexp;                                     <<38.pv>>05960000
   array aname, guname, fname, preturn;                                 05962000
   option privileged, uncallable;                                       05964000
<< <preturn> will contain full final entry .  >>                        05966000
begin                                                                   05968000
   logical ltype = type;                                                05970000
                                                                        05972000
   array parr (*) = type;                                               05974000
   if (tos := dirstartoff (parr)) <> 0d then goto badexit;              05976000
   assemble (ddel);                                                     05978000
   tos := @preturn+adjust;                                              05980000
   tos := dirfind (xindexp);                                            05982000
   assemble (dtst, delb);                                               05984000
   if = then                                                            05986000
      begin                                                             05988000
      ddel;                                                             05990000
      tos := ltype.(endlevelf);                                         05992000
      tos := 2;                                                         05994000
badexit:                                                                05996000
      tos := ccg;                                                       05998000
      goto exit;                                                        06000000
      end;                                                              06002000
   case *type.(endlevelf) of                                   <<16.pv>>06004000
      begin                                                             06006000
      tos := fsize;                                                     06008000
      tos := gsize;                                                     06010000
      tos := asize;                                                     06012000
      tos := usize;                                                     06014000
      tos := gvsdsize;                                         <<05.pv>>06016000
      end;                                                              06018000
   assemble (mvbl);                                                     06020000
   tos := 0d;                                                           06022000
   tos := cce;                                                          06024000
exit:                                                                   06026000
   cc := tos;                                                           06028000
   direcfind := tos;                                                    06030000
   relsir (dirsir, sirreturn);                                          06032000
   exchangedb (0);                                                      06034000
   end    <<direcfind>>;                                                06036000
                                                                        06038000
                                                                        06040000
                                                                        06042000
                                                                        06044000
                                                                        06046000
double procedure direcfindfile (type, linkage'indexp, aname,   <<38.pv>>06048000
                                gname, fname, preturn, mvtabx);<<38.pv>>06050000
   value   type, linkage'indexp, mvtabx;                       <<38.pv>>06052000
   logical type, mvtabx;                                       <<38.pv>>06054000
   double  linkage'indexp;                                     <<38.pv>>06056000
   array aname, gname, fname, preturn;                                  06058000
   option privileged, uncallable, variable;                    <<38.pv>>06060000
<< returns in <preturn> then file pointer; and asec/gsec                06062000
      depending on the type of search. >>                               06064000
begin                                                                   06066000
   logical                                                     <<38.pv>>06068000
       pmask = q-4;                                            <<38.pv>>06070000
   define                                                      <<38.pv>>06072000
       mvtabx'm = (15:1) #,                                    <<38.pv>>06074000
       mvtabx'p = pmask.mvtabx'm #;                            <<38.pv>>06076000
   array parr (*) = type;                                               06078000
   if mvtabx'p then                                            <<42.pv>>06080000
    tos := dirstartoff (parr,,,,mvtabx)                        <<42.pv>>06082000
   else                                                        <<42.pv>>06084000
    tos := dirstartoff (parr);                                 <<42.pv>>06086000
   assemble (dtst);                                            <<42.pv>>06088000
   if <> then go to badexit;                                   <<42.pv>>06090000
   << 2 zeroes on stack >>                                              06092000
   tos := dirfind (xindexp);                                            06094000
   assemble (dtst, delb);                                               06096000
   if = then                                                            06098000
      begin                                                             06100000
      << 3 zeros on stack >>                                   <<28.pv>>06102000
      del; <<one of them. only need 2>>                        <<28.pv>>06104000
      tos := tos +2;  <<not found : file>>                     <<28.pv>>06106000
badexit:                                                                06108000
      relsir (dirsir, sirreturn);                                       06110000
      exchangedb (0);                                                   06112000
      tos := ccg;                                                       06114000
      goto exit;                                                        06116000
      end;                                                              06118000
   tos := dps0(2);                                                      06120000
   tos := xgsec;                                                        06122000
   tos := xasec;                                                        06124000
   carryx := if dabadelm then 1 else 0;                                 06126000
   relsir (dirsir, sirreturn);                                          06128000
   exchangedb (0);                                                      06130000
   tos := @preturn;                                                     06132000
   tos := @s5;                                                          06134000
   if integer (type.(startlevelf)) = 1 then tos := 4                    06136000
   else if < then tos := 5                                              06138000
      else tos := 2;                                                    06140000
   assemble (move);                                                     06142000
   assemble (subs 6);                                                   06144000
   tos := cce;                                                          06146000
exit:                                                                   06148000
   cc := tos;                                                           06150000
   direcfindfile := tos;                                       << ... >>06152000
   end    <<procedure direcfindfile>>;                                  06154000
double procedure direcsetflag (type,linkage'indexp,aname,      <<38.pv>>06156000
                               gname,fname,mvtabx);            <<32.pv>>06158000
    value   type,linkage'indexp,mvtabx;                        <<38.pv>>06160000
    logical type, mvtabx;                                      <<38.pv>>06162000
    double  linkage'indexp;                                    <<38.pv>>06164000
    array   aname,gname,fname;                                 <<32.pv>>06166000
    option  privileged,uncallable,variable;                    <<32.pv>>06168000
    comment                                                             06170000
        returns condition code only.                                    06172000
            cce - file entry flagged                                    06174000
            ccl - file not foung                                        06176000
            ccg - file entry already flagged;                           06178000
    begin                                                               06180000
        entry direcresetflag;                                           06182000
        logical                                                <<32.pv>>06184000
            setflag := true,                                   <<32.pv>>06186000
            pmask = q-4;                                       <<32.pv>>06188000
        array parr (*) = type;                                          06190000
       define                                                  <<32.pv>>06192000
           mvtabx'm = (15:1) #,                                <<32.pv>>06194000
           mvtabx'p = pmask.mvtabx'm #;                        <<32.pv>>06196000
        if false then                                                   06198000
direcresetflag:                                                         06200000
         setflag := false;                                              06202000
        if mvtabx'p then                                       <<42.pv>>06204000
         tos := dirstartoff (parr,,,,mvtabx)                   <<42.pv>>06206000
        else                                                   <<42.pv>>06208000
         tos := dirstartoff (parr);                            <<42.pv>>06210000
        assemble (dtst);                                       <<42.pv>>06212000
        if <> then go to nfound;                               <<42.pv>>06214000
        tos := dirfind (xindexp);                                       06216000
        assemble (dtst,delb);                                           06218000
        if = then                                                       06220000
        begin                                                           06222000
            del;  ddel;                                        <<43.pv>>06224000
            tos := [16/0, 16/2] d;                             <<32.pv>>06226000
nfound:                                                                 06228000
            tos := ccg;                                                 06230000
            go exit;                                                    06232000
        end;                                                            06234000
        if dabadelm and setflag then                           <<32.pv>>06236000
        begin <<already set>>                                  <<32.pv>>06238000
            del;                                               <<32.pv>>06240000
            tos := ccl;                                        <<32.pv>>06242000
            go exit;                                           <<32.pv>>06244000
        end;                                                   <<32.pv>>06246000
        s0pntr (2) := if setflag then s0pntr (2) lor %100000            06248000
                          else s0pntr (2) land %77777;                  06250000
        del;                                                            06252000
        dirwrite (a); <<write entry buffer>>                            06254000
        tos := cce;                                                     06256000
exit:                                                                   06258000
        cc := tos;                                                      06260000
        direcsetflag := tos;                                   <<32.pv>>06262000
        relsir (dirsir,sirreturn);                                      06264000
        exchangedb (0);  <<back to stack>>                              06266000
        end;<<of direcsetflag/direcresetflag>>                          06268000
double procedure direcbind (type, linkage'indexp, aname,       <<38.pv>>06270000
                          guname, gipntr, mvtabx);             <<41.pv>>06272000
    value   type, linkage'indexp, mvtabx;                      <<38.pv>>06274000
    integer type, gipntr, mvtabx;                              <<41.pv>>06276000
    double  linkage'indexp;                                    <<38.pv>>06278000
    array   aname, guname;                                     <<23.pv>>06280000
    option  privileged, uncallable, variable;                  <<23.pv>>06282000
    comment                                                    <<23.pv>>06284000
        db must be at stack when called.                       <<23.pv>>06286000
        returns: 0d if mount (logical) successfull.            <<23.pv>>06288000
                 failure cause via function if unsuccessfull.  <<23.pv>>06290000
                 condition code :                              <<23.pv>>06292000
                     cce - successfull                         <<23.pv>>06294000
                     ccg - search failure                      <<23.pv>>06296000
                           function (result) contains error    <<23.pv>>06298000
                           code (search failure) and entry     <<23.pv>>06300000
                           type not found.                     <<23.pv>>06302000
                     ccl - not returned                        <<23.pv>>06304000
    ;                                                          <<23.pv>>06306000
    begin                                                      <<23.pv>>06308000
        double                                                 <<23.pv>>06310000
            result = direcbind;                                <<23.pv>>06312000
        integer                                                <<23.pv>>06314000
            dsir,                                              <<50.pv>>06316000
            rs1 = result,                                      <<23.pv>>06318000
            rs0 = rs1+1,                                       <<23.pv>>06320000
            refcntr,                                           <<51.pv>>06322000
            fipntr,                                            <<51.pv>>06324000
            temp;                                              <<23.pv>>06326000
       logical                                                 <<23.pv>>06328000
           pmask = q-4;                                        <<23.pv>>06330000
        define                                                 <<23.pv>>06332000
            mvtabx'm = (15:1) #,                               <<23.pv>>06334000
            mvtabx'p = pmask.mvtabx'm #;                       <<23.pv>>06336000
        array                                                  <<23.pv>>06338000
            parr (*) = type;                                   <<23.pv>>06340000
                                                               <<23.pv>>06342000
        integer subroutine getentry (mvtabx');                 <<50.pv>>06344000
            value   mvtabx';                                   <<50.pv>>06346000
            integer mvtabx';                                   <<50.pv>>06348000
            begin                                              <<23.pv>>06350000
                if (result :=                                  <<23.pv>>06352000
                   dirstartoff (parr,,,,mvtabx')) <> 0d then   <<23.pv>>06354000
                 tos := 0                                      <<50.pv>>06356000
                else                                           <<23.pv>>06358000
                begin <<find required entry and/or tree>>      <<51.pv>>06360000
                    tos := dirfind (xindexp);                  <<23.pv>>06362000
                    asmb (dtst, delb);                         <<23.pv>>06364000
                    if = then result := [16/1, 16/2] d;        <<50.pv>>06366000
                end;                                           <<23.pv>>06368000
                temp := tos;                                   <<23.pv>>06370000
                getentry := temp;                              <<23.pv>>06372000
            end;<<of getentry>>                                <<23.pv>>06374000
                                                               <<23.pv>>06376000
        subroutine locktree (refcntr');                        <<51.pv>>06378000
            value   refcntr';                                  <<51.pv>>06380000
            integer refcntr';                                  <<51.pv>>06382000
            begin                                              <<51.pv>>06384000
                exchangedb (0);                                <<51.pv>>06386000
                type := filelevel & lsl (3);                   <<51.pv>>06388000
                getentry (mvtabx);                             <<51.pv>>06390000
                dbpcount := refcntr';                          <<51.pv>>06392000
                dirwrite (b);                                  <<51.pv>>06394000
            end;<<of locktree>>                                <<51.pv>>06396000
                                                               <<51.pv>>06398000
        cc := ccg;                                             <<23.pv>>06400000
        type := grouplevel & lsl (3);  <<force it>>            <<23.pv>>06402000
        if (tos := getentry (mvtabx)) = 0 then                 <<50.pv>>06404000
        begin  <<not found in pv directory>>                   <<50.pv>>06406000
            del;                                               <<50.pv>>06408000
            rs1 := -rs1; <<indicate which directory>>          <<50.pv>>06410000
            <<callers responsibility to dismount>>             <<50.pv>>06412000
        end else                                               <<50.pv>>06414000
        begin  <<found in pv directory>>                       <<50.pv>>06416000
            dsir := sirreturn; <<most accurate copy for exit>> <<56.pv>>06418000
            tos := ps0 (gfipntr);  <<dir addr in pv>>          <<50.pv>>06420000
            delb;                <<entry pointer>>             <<50.pv>>06422000
            exchangedb (0);                                    <<50.pv>>06424000
            if (tos := getentry (0)) <> 0 then                 <<50.pv>>06426000
            begin  <<found in system directory>>               <<50.pv>>06428000
                if ps0 (glinkage).(mvtabxf) <> 0 then          <<50.pv>>06430000
                begin <<already mounted?>>                     <<50.pv>>06432000
                    if ps0 (gmountrefcntr) <= 0 then           <<50.pv>>06434000
                       sysabort (dirpvbinderr);                <<de>>   06436000
                    if ps0 (glinkage).(mvtabxf) <> mvtabx      <<01420>>06438000
                       then sysabort (dirpvbinderr);           <<de>>   06440000
                    fipntr := ps0 (gfipntr);                   <<51.pv>>06442000
                end else                                       <<50.pv>>06444000
                begin                                          <<50.pv>>06446000
                    ps0 (glinkage).(mvtabxf) := mvtabx;        <<50.pv>>06448000
                    ps0 (gsavefipntr) := ps0 (gfipntr);        <<50.pv>>06450000
                    fipntr := ps0 (gfipntr) := s1;             <<50.pv>>06452000
                end;                                           <<50.pv>>06454000
                refcntr := ps0 (xreg) := ps0 (gmountrefcntr)+1;<<51.pv>>06456000
                ddel;                                          <<50.pv>>06458000
                dirwrite (a);  <<update entry block>>          <<50.pv>>06460000
                locktree (refcntr);                            <<51.pv>>06462000
                cc := cce;                                     <<50.pv>>06464000
            end else del;                                      <<50.pv>>06466000
            sirreturn := dsir;                                 <<56.pv>>06468000
        end;                                                   <<50.pv>>06470000
        relsir (dirsir,sirreturn);                             <<56.pv>>06472000
        exchangedb (0);  <<to stack>>                          <<23.pv>>06474000
        gipntr := fipntr;                                      <<51.pv>>06476000
    end;<<of direcbind>>                                       <<23.pv>>06478000
double procedure direcunbind (type, linkage'indexp, aname,     <<38.pv>>06480000
                              guname, mvtabx);                 <<23.pv>>06482000
    value   type, linkage'indexp, mvtabx;                      <<38.pv>>06484000
    integer type, mvtabx;                                      <<38.pv>>06486000
    double  linkage'indexp;                                    <<38.pv>>06488000
    array   aname, guname;                                     <<23.pv>>06490000
    option  privileged, uncallable, variable;                  <<23.pv>>06492000
    comment                                                    <<23.pv>>06494000
        db must be at stack when called.                       <<23.pv>>06496000
        returns:                                               <<23.pv>>06498000
                                                               <<23.pv>>06500000
                 condition code :                              <<23.pv>>06502000
                     cce - successfull                         <<23.pv>>06504000
                     ccg - search failure                      <<23.pv>>06506000
                           function (result) contains error    <<23.pv>>06508000
                           code (search failure) and entry     <<23.pv>>06510000
                           type not found.                     <<23.pv>>06512000
                     ccl - not returned                        <<23.pv>>06514000
    ;                                                          <<23.pv>>06516000
    begin                                                      <<23.pv>>06518000
        double                                                 <<23.pv>>06520000
            result = direcunbind;                              <<23.pv>>06522000
        integer                                                <<23.pv>>06524000
            dsir,                                              <<56.pv>>06526000
            rs1 = result,                                      <<23.pv>>06528000
            rs0 = rs1+1,                                       <<23.pv>>06530000
            refcntr,                                           <<51.pv>>06532000
            temp;                                              <<23.pv>>06534000
        logical                                                <<23.pv>>06536000
            pmask = q-4;                                       <<23.pv>>06538000
        define                                                 <<23.pv>>06540000
            mvtabx'm = (15:1) #,                               <<23.pv>>06542000
            mvtabx'p = pmask.mvtabx'm #;                       <<23.pv>>06544000
        array                                                  <<23.pv>>06546000
            parr (*) = type;                                   <<23.pv>>06548000
                                                               <<23.pv>>06550000
        integer subroutine getentry (mvtabx');                 <<50.pv>>06552000
            value   mvtabx';                                   <<51.pv>>06554000
            integer mvtabx';                                   <<51.pv>>06556000
            begin                                              <<23.pv>>06558000
                if (result :=                                  <<23.pv>>06560000
                    dirstartoff (parr,,,,mvtabx')) <> 0d then  <<51.pv>>06562000
                     tos := 0                                  <<51.pv>>06564000
                else                                           <<23.pv>>06566000
                begin <<find required entry and/or tree>>      <<51.pv>>06568000
                    tos := dirfind (xindexp);                  <<23.pv>>06570000
                    asmb (dtst, delb);                         <<23.pv>>06572000
                    if = then result := [16/1, 16/2] d;        <<50.pv>>06574000
                end;                                           <<23.pv>>06576000
                temp := tos;                                   <<23.pv>>06578000
                getentry := temp;                              <<23.pv>>06580000
            end;<<of getentry>>                                <<23.pv>>06582000
                                                               <<23.pv>>06584000
        subroutine unlocktree (refcntr');                      <<51.pv>>06586000
            value   refcntr';                                  <<51.pv>>06588000
            integer refcntr';                                  <<51.pv>>06590000
            begin                                              <<51.pv>>06592000
                exchangedb (0);                                <<51.pv>>06594000
                type := filelevel & lsl (3);                   <<51.pv>>06596000
                getentry (mvtabx);                             <<51.pv>>06598000
                dbpcount := refcntr';                          <<51.pv>>06600000
                dirwrite (b);                                  <<51.pv>>06602000
            end;<<of unlocktree>>                              <<51.pv>>06604000
                                                               <<51.pv>>06606000
        cc := ccg;                                             <<23.pv>>06608000
        type := grouplevel & lsl (3);  <<force it>>            <<23.pv>>06610000
        if (tos := getentry (0)) <> 0 then                     <<50.pv>>06612000
        begin <<found>>                                        <<48.pv>>06614000
            dsir := sirreturn; <<most accurate copy for exit>> <<56.pv>>06616000
            refcntr := ps0 (xreg) := ps0 (gmountrefcntr) - 1;  <<51.pv>>06618000
            if ps0 (xreg) <= 0 then                            <<48.pv>>06620000
            begin                                              <<48.pv>>06622000
                if < then sysabort (dirpvbinderr);             <<de>>   06624000
                ps0 (gfipntr) := ps0 (gsavefipntr);            <<48.pv>>06626000
                ps0 (glinkage).(mvtabxf) := 0;                 <<48.pv>>06628000
                ps0 (gsavefipntr) := 0;                        <<48.pv>>06630000
            end;                                               <<48.pv>>06632000
            del;                                               <<48.pv>>06634000
            dirwrite (a);  <<update entry block>>              <<48.pv>>06636000
            unlocktree (refcntr);                              <<51.pv>>06638000
            cc := cce;                                         <<48.pv>>06640000
            sirreturn := dsir;                                 <<56.pv>>06642000
        end else del;                                          <<50.pv>>06644000
        relsir (dirsir,sirreturn);                             <<23.pv>>06646000
        exchangedb (0);  <<to stack>>                          <<23.pv>>06648000
    end;<<of direcunbind>>                                     <<23.pv>>06650000
                                                                        06652000
                                                                        06654000
                                                                        06656000
                                                                        06658000
<< *** purge routines *** >>                                            06660000
                                                                        06662000
                                                                        06664000
                                                                        06666000
                                                                        06668000
                                                                        06670000
<< these procedures return the number of sectors removed. >>            06672000
<< carry set if entry (or tree) entirely removed. >>                    06674000
                                                                        06676000
                                                                        06678000
                                                                        06680000
                                                                        06682000
double procedure dirpurgescan (purger, mvtabx);                <<26.pv>>06684000
   value mvtabx;                                               <<26.pv>>06686000
   double procedure purger;                                             06688000
   integer mvtabx;                                             <<26.pv>>06690000
                                                                        06692000
   options;                                                             06694000
<< b contains index to be cleansed.                                     06696000
   this routine restores a.                                             06698000
   <purger> must at most only remove entry from a  (i.e. return a       06700000
   almost- and b exactly- intact).  >>                                  06702000
begin                                                                   06704000
   double result = dirpurgescan;                                        06706000
   pointer                                                              06708000
      ipntr, iend,                                                      06710000
      epntr, eend;                                                      06712000
                                                                        06714000
   tos := dacontents;    <<save for restore of a>>                      06716000
   tos := a;                                                            06718000
   tos := daxcount;                                                     06720000
   tos := damiscwd;                                                     06722000
   tos := dadirbase; <<directory base for dacontents>>         <<01055>>06724000
   @iend := (@ipntr := @dblpntr) + dbused;                              06726000
   while @ipntr < @iend do    <<scan thru indices>>                     06728000
      begin                                                             06730000
      dirread (ipntr (iepntr), a, ipntr (iecount), dbemiscwd);          06732000
      @eend := (@epntr := @dalpntr) + daused;                           06734000
      while @epntr < @eend do    <<scan thru entries>>                  06736000
         begin                                                          06738000
         tos := 0d;                                                     06740000
         tos := @epntr;                                                 06742000
         tos := mvtabx;                                        <<26.pv>>06744000
         tos := purger (*, *);                                 <<26.pv>>06746000
         if carry then                                                  06748000
            begin    <<actually removed; was not being used>>           06750000
            dbetotal := dbetotal-1;                                     06752000
            ipntr(iecount) := ipntr(iecount)-1;                         06754000
            if @epntr = @dalpntr then                                   06756000
               move ipntr := dalpntr, (namesize);                       06758000
            dirwrite (b);                                      <<53.pv>>06760000
            dirwrite (a);                                      <<53.pv>>06762000
            @eend := @eend-daxsize;                                     06764000
            end                                                         06766000
         else                                                           06768000
            @epntr := @epntr+daxsize;                                   06770000
         dirpurgescan := tos +result;                                   06772000
         end;<<of entry block scan>>                           <<53.pv>>06774000
      if daxcount = 0 then                                              06776000
         begin    <<entry block depleted>>                              06778000
         dirremove (ipntr, b);                                          06780000
         dirwrite (b);                                         <<53.pv>>06782000
         @iend := @iend-dbxsize;                                        06784000
         end                                                            06786000
      else                                                              06788000
         begin                                                          06790000
         if dadirty then dirwrite (a);                         <<53.pv>>06792000
         @ipntr := @ipntr+dbxsize;                                      06794000
         end;                                                           06796000
      end;<<of index block scan>>                              <<53.pv>>06798000
   dirbase := tos; <<as it was upon entry>>                    <<01055>>06800000
   dirread (*, *, *, *);                                                06802000
   carryx:= if (dbxcount +dbpcount) = 0 then 1 else 0;                  06804000
   end    <<dirpurgescan>>;                                             06806000
                                                                        06808000
                                                                        06810000
                                                                        06812000
                                                                        06814000
double procedure ddelfile (ntry, mvtabx);                      <<26.pv>>06816000
   value mvtabx;                                               <<26.pv>>06818000
   array ntry;                                                          06820000
   integer mvtabx;                                             <<26.pv>>06822000
   options;                                                             06824000
begin                                                                   06826000
   double array dentry (*) = ntry;                                      06828000
   equate vtabdst = 29;                                                 06830000
   integer array vtab (*) = db+0;                                       06832000
                                                                        06834000
   tos := 0d;                                                           06836000
   tos := dentry (2);                                                   06838000
   tos := lun (s1.(0:8),mvtabx);                               <<26.pv>>06840000
   s2.(0:8) := 0;                                              <<26.pv>>06842000
   assemble (cab, cab);                                        <<26.pv>>06844000
   exchangedb (0);                                             <<26.pv>>06846000
                                                                        06848000
   tos := frelspace (*, *, mvtabx);                            <<00630>>06850000
   exchangedb (ddsdst);                                                 06852000
   if (ddelfile := tos) <> 0d then                                      06854000
      begin                                                             06856000
      dirremove (ntry, a);                                              06858000
      tos := 1;                                                         06860000
      end                                                               06862000
   else tos := 0;                                                       06864000
   carryx := tos;                                                       06866000
   end    <<ddelfile>>;                                                 06868000
                                                                        06870000
                                                                        06872000
                                                                        06874000
                                                                        06876000
double procedure ddelvsd (ntry, mvtabx);                       <<26.pv>>06878000
    value mvtabx;                                              <<26.pv>>06880000
    array ntry;                                                <<10.pv>>06882000
    integer mvtabx;                                            <<26.pv>>06884000
    options;                                                   <<10.pv>>06886000
                                                               <<32.pv>>06888000
    begin                                                      <<10.pv>>06890000
        if ntry (gvslinkagew).(mvtabxf) = 0 then               <<34.pv>>06892000
        begin  <<not in use>>                                  <<32.pv>>06894000
            dirremove (ntry, a);                               <<32.pv>>06896000
            carryx := 1;                                       <<32.pv>>06898000
        end else carryx := 0;                                  <<33.pv>>06900000
    end;<<of ddelvsd>>                                         <<10.pv>>06902000
                                                               <<10.pv>>06904000
                                                               <<10.pv>>06906000
                                                               <<10.pv>>06908000
                                                               <<10.pv>>06910000
                                                               <<15.pv>>06912000
                                                               <<15.pv>>06914000
                                                               <<15.pv>>06916000
                                                               <<15.pv>>06918000
double procedure ddeluser (ntry, mvtabx);                      <<26.pv>>06920000
   value mvtabx;                                               <<26.pv>>06922000
   array ntry;                                                          06924000
   integer mvtabx;                                             <<26.pv>>06926000
   options;                                                             06928000
begin                                                                   06930000
   if ntry (ulogcount) = 0 then                                         06932000
      begin                                                             06934000
      dirremove (ntry, a);                                              06936000
      tos := 1;                                                         06938000
      end                                                               06940000
   else                                                                 06942000
      begin                                                             06944000
      ntry (upurgeflagw).(upurgeflagf) := goneflag;                     06946000
      dadirty := true;                                                  06948000
      tos := 0;                                                         06950000
      end;                                                              06952000
   carryx := tos;                                                       06954000
   ddeluser := 0d;                                                      06956000
   end    <<ddeluser>>;                                                 06958000
                                                                        06960000
                                                                        06962000
                                                                        06964000
                                                                        06966000
double procedure ddelgroup (ntry, mvtabx);                     <<26.pv>>06968000
   value mvtabx;                                               <<26.pv>>06970000
   array ntry;                                                          06972000
   integer mvtabx;                                             <<26.pv>>06974000
   options;                                                             06976000
begin                                                                   06978000
   double pointer dntry = ntry;                                         06980000
   double                                                      <<15.pv>>06982000
       sectors,                                                <<01055>>06984000
       pvdirbase,                                              <<01055>>06986000
       savevsd;                                                <<15.pv>>06988000
   logical                                                     <<15.pv>>06990000
       vsdgone := false,                                       <<43.pv>>06992000
       boundtohvs;                                             <<43.pv>>06994000
   tos := dbcontents;                                                   06996000
   tos := dbdirbase; <<directory base for dbcontents>>         <<45.pv>>06998000
   dirread (ntry (gvsdipntr), b, 0, 0);                        <<15.pv>>07000000
   dirpurgescan (ddelvsd, mvtabx);                             <<26.pv>>07002000
   if carry then                                               <<15.pv>>07004000
   begin                                                       <<15.pv>>07006000
       tos := dbcontents;                                      <<15.pv>>07008000
       tos := dbbsize;                                         <<15.pv>>07010000
       savevsd := tos;                                         <<15.pv>>07012000
       vsdgone := true;                                        <<15.pv>>07014000
   end;                                                        <<15.pv>>07016000
   if boundtohvs := (ntry (glinkage).(pvf) = pv land           <<45.pv>>07018000
                     ntry (xreg).(mvtabxf) <> 0) then          <<45.pv>>07020000
   begin                                                       <<45.pv>>07022000
       mvtabx := ntry (xreg).(mvtabxf);                        <<45.pv>>07024000
       tos := ddsdst;                 <<e: target>>            <<45.pv>>07026000
       tos := @dirbase;               <<d: target offset>>     <<45.pv>>07028000
       tos := mvtabdst;               <<c: source>>            <<45.pv>>07030000
       tos := (mvtabx*mvtabsz)+2;     <<b: source offset>>     <<45.pv>>07032000
       tos := 2;                      <<a: count>>             <<45.pv>>07034000
       assemble (mds);                                         <<45.pv>>07036000
       pvdirbase := dirbase; <<may need it later>>             <<01055>>07038000
   end;                                                        <<45.pv>>07040000
   dirread (ntry(gfipntr), b, 0, 0);                                    07042000
   << *** delete all files not being used *** >>                        07044000
   sectors := dirpurgescan (ddelfile, mvtabx);                 <<01055>>07046000
   if carry and vsdgone and not boundtohvs then                <<43.pv>>07048000
      begin    <<fully successful deletion: remove entry & its index>>  07050000
      dirdeallocate (dbcontents, dbbsize);                              07052000
      <<emit log record>>                                               07054000
      dbdirty := dbcontents := 0;                                       07056000
      tos := savevsd;                                          <<15.pv>>07058000
      dirdeallocate (*, *);                                    <<15.pv>>07060000
      dirremove (ntry, a);                                              07062000
      tos := 1;                                                         07064000
      end                                                               07066000
   else                                                                 07068000
      begin    <<entry was in-use>>                            <<61.pv>>07070000
          if boundtohvs then                                   <<61.pv>>07072000
          begin                                                <<61.pv>>07074000
              tos := dacontents;  <<save the environment>>     <<01055>>07076000
              tos := a;           <<for restoring buffer (a)>> <<01055>>07078000
              tos := daxcount;    <<after accounting house- >> <<01055>>07080000
              tos := damiscwd;    <<keeping (dirreset) in>>    <<01055>>07082000
              tos := dadirbase;   <<pv's directory>>           <<01055>>07084000
              dirbase := pvdirbase; <<set up for switch>>      <<01055>>07086000
              dirread (ntry (gfipntr),b,0,0);                  <<01055>>07088000
              dirreset (sectors);                              <<01055>>07090000
              dirbase := tos;    <<set up for switch back>>    <<01055>>07092000
              dirread (*,*,*,*); <<restore entry buffer (a)>>  <<01055>>07094000
              sectors := 0d; <<already updated. fake it>>      <<01055>>07096000
          end else                                             <<61.pv>>07098000
          begin                                                <<61.pv>>07100000
              dbmiscwd.(ipurgeflagf) := goneflag;              <<61.pv>>07102000
              ntry (gpurgeflagw).(gpurgeflagf) := goneflag;    <<61.pv>>07104000
              @ntry := @ntry + gdfscount;                      <<61.pv>>07106000
              dntry := dntry - sectors;                        <<01055>>07108000
              dirwrite (b);                                    <<61.pv>>07110000
              dadirty := true;                                 <<61.pv>>07112000
              <<caller must write out this group>>             <<61.pv>>07114000
          end;                                                 <<61.pv>>07116000
          tos := 0; <<to set carry>>                           <<61.pv>>07118000
      end;                                                              07120000
   carryx := tos;                                                       07122000
   ddelgroup := sectors;                                       <<01055>>07124000
   dirbase := tos; <<as it was upon entry>>                    <<45.pv>>07126000
   dirread (*, b, 0, 0);    <<restore incoming index>>                  07128000
   end    <<ddelgroup>>;                                                07130000
                                                                        07132000
                                                                        07134000
                                                                        07136000
double procedure ddelacct (ntry, mvtabx);                      <<26.pv>>07138000
   value mvtabx;                                               <<26.pv>>07140000
   array ntry;                                                          07142000
   integer mvtabx;                                             <<26.pv>>07144000
   options;                                                             07146000
begin                                                                   07148000
   double pointer dntry = ntry;                                         07150000
   double                                                      <<15.pv>>07152000
       saveu;                                                           07154000
   logical                                                     <<15.pv>>07156000
       freeusers := false;                                              07158000
                                                                        07160000
   tos := dbcontents;                                                   07162000
   dirread (ntry(auipntr), b, 0, 0);                                    07164000
   dirpurgescan (ddeluser, mvtabx);                            <<26.pv>>07166000
   if carry then                                                        07168000
      begin                                                             07170000
      tos := dbcontents;                                                07172000
      tos := dbbsize;                                                   07174000
      saveu := tos;                                                     07176000
      freeusers := true;                                                07178000
      end;                                                              07180000
   dbmiscwd.(ipurgeflagf) := goneflag;                                  07182000
   dirwrite (b);                                                        07184000
   dirread (ntry(agipntr), b, 0, 0);                                    07186000
   tos := dirpurgescan (ddelgroup, mvtabx);                    <<26.pv>>07188000
   if carry and freeusers then                                          07190000
      begin                                                             07192000
      dirdeallocate (dbcontents, dbbsize);                              07194000
      dbdirty := dbcontents := 0;                                       07196000
      tos := saveu;                                                     07198000
      dirdeallocate (*, *);                                             07200000
      <<emit log record>>                                               07202000
      dirremove (ntry, a);                                              07204000
      tos := 1;                                                         07206000
      end                                                               07208000
   else                                                                 07210000
      begin                                                             07212000
      dbmiscwd.(ipurgeflagf) := goneflag;                               07214000
      dntry (adfscountd) := -ds1 +dntry (adfscountd);                   07216000
      dirwrite (b);                                                     07218000
      dadirty := true;                                                  07220000
      tos := 0;                                                         07222000
      end;                                                              07224000
   carryx := tos;                                                       07226000
   ddelacct := tos;                                                     07228000
   dirread (*, b, 0, 0);                                                07230000
   end    <<ddelacct>>;                                                 07232000
                                                                        07234000
                                                                        07236000
                                                                        07238000
double procedure direcpurge (type, linkage'indexp, aname,      <<38.pv>>07240000
                             guname, fname, mvtabx);           <<38.pv>>07242000
   value type, linkage'indexp, mvtabx;                         <<38.pv>>07244000
   integer type, mvtabx;                                       <<38.pv>>07246000
   double  linkage'indexp;                                     <<38.pv>>07248000
   array aname, guname, fname;                                          07250000
   option privileged, uncallable, variable;                    <<21.pv>>07252000
                                                                        07254000
<< general purge routine                                                07256000
                                                                        07258000
double procedure direcpurgefile                                         07260000
      (numsects, dummy, aname, gname, fname);                    43.pv  07262000
   value numsects, dummy;                                        43.pv  07264000
   double numsects;                                                     07266000
   integer dummy;                                                43.pv  07268000
   ...                                                                  07270000
   purge file entry and adjust acct & group space counts                07272000
   by <numsects>.                                                       07274000
   >>                                                                   07276000
begin                                                                   07278000
   entry direcpurgefile;                                                07280000
   array parr (*) = type;                                               07282000
   double numsects = type;                                              07284000
   double lnumsects;                                                    07286000
   logical fflag := false;                                              07288000
   integer savefsir = lnumsects;                                        07290000
   equate fsir = 37;                                                    07292000
   double groupspacegone := 0d;                                         07294000
   logical                                                     <<21.pv>>07296000
       pmask = q-4;                                            <<21.pv>>07298000
       define                                                  <<21.pv>>07300000
           mvtabx'm = (15:1) #,                                <<21.pv>>07302000
           mvtabx'p = pmask.mvtabx'm #;                        <<21.pv>>07304000
                                                                        07306000
                                                                        07308000
   if type.(endlevelf) <> 3 then savefsir := getsir(fsir);     <<03.pv>>07310000
   if mvtabx'p then                                            <<21.pv>>07312000
    tos := dirstartoff (parr,,,,mvtabx)                        <<21.pv>>07314000
   else                                                        <<21.pv>>07316000
   begin                                                       <<26.pv>>07318000
       mvtabx := 0;                                            <<26.pv>>07320000
       tos := dirstartoff (parr);                              <<26.pv>>07322000
   end;                                                        <<26.pv>>07324000
   goto start;                                                          07326000
                                                                        07328000
                                                                        07330000
direcpurgefile:                                                         07332000
   fflag := true;                                                       07334000
   lnumsects := numsects;                                               07336000
   numsects := 0d;                                                      07338000
   if mvtabx'p then                                            <<42.pv>>07340000
    tos := dirstartoff (parr, lnumsects, , ,mvtabx)            <<42.pv>>07342000
   else                                                        <<42.pv>>07344000
   begin                                                       <<42.pv>>07346000
       mvtabx := 0;                                            <<42.pv>>07348000
       tos := dirstartoff (parr, lnumsects);                   <<42.pv>>07350000
   end;                                                        <<42.pv>>07352000
                                                                        07354000
                                                                        07356000
start:                                                                  07358000
   if ds1 <> 0d then goto badexit;                                      07360000
   assemble (ddel);                                                     07362000
   tos := dirfind (xindexp);                                            07364000
   assemble (dtst);                                                     07366000
   if = then                                                            07368000
      begin                                                             07370000
      ddel;                                                             07372000
      tos := type.(endlevelf);                                          07374000
      tos := 2;                                                         07376000
      goto badexit0;                                                    07378000
      end;                                                              07380000
   assemble (ddup, zrob);                                               07382000
   assemble (dup, zrob);                                                07384000
   case *type.(endlevelf) of                                   <<16.pv>>07386000
      begin                                                             07388000
         begin                                                          07390000
         dirremove (*, a);                                              07392000
         assemble (neg, ddel);    <<set carry>>                         07394000
         end;                                                           07396000
      groupspacegone := ddelgroup (*, mvtabx);                 <<26.pv>>07398000
      ddelacct (*, mvtabx);                                    <<26.pv>>07400000
      ddeluser (*, mvtabx);                                    <<26.pv>>07402000
      ddelvsd (*, mvtabx);                                     <<26.pv>>07404000
                                                                        07406000
      end;                                                              07408000
   if carry then                                                        07410000
      begin                                                             07412000
      xreg := iecount;                                                  07414000
      dbetotal := dbetotal-1;                                           07416000
      if tos = @dalpntr then                                            07418000
         begin                                                          07420000
         assemble (dup);                                                07422000
         move * := dalpntr, (namesize);                                 07424000
         end;                                                           07426000
      s0ipntr(xreg) := s0ipntr(xreg)-1;                                 07428000
      if = then                                                         07430000
         begin                                                          07432000
         dirremove (*, b);                                              07434000
         tos := 0;                                                      07436000
         end;                                                           07438000
      assemble (zero, zrob);                                            07440000
      tos := cce;                                                       07442000
      dirwrite (b);                                                     07444000
      if dadirty then dirwrite (a);                            <<53.pv>>07446000
      dirxxxbitmap (write);                                    <<28.pv>>07448000
      end                                                               07450000
   else                                                                 07452000
      begin                                                             07454000
      if dadirty then dirwrite (a);                            <<53.pv>>07456000
      dirxxxbitmap (write);                                    <<43.pv>>07458000
      assemble (zrob, del);                                             07460000
      tos := 7;                                                         07462000
badexit0:                                                               07464000
      if fflag then dirreset (lnumsects);                               07466000
badexit:                                                                07468000
      tos := ccg;                                                       07470000
      end;                                                              07472000
   cc := tos;                                                           07474000
   direcpurge := tos;                                                   07476000
   tos := groupspacegone;                                               07478000
   if <> then dirreset (*) else assemble (ddel);                        07480000
   relsir (dirsir, sirreturn);                                          07482000
   if not (fflag)                                                       07484000
      and type.(endlevelf) <> 3 then relsir (fsir, savefsir);  <<03.pv>>07486000
   exchangedb (0);                                                      07488000
   end    <<direcpurge>>;                                               07490000
                                                                        07492000
                                                                        07494000
                                                                        07496000
                                                                        07498000
                                                                        07500000
double procedure direcadjust (numsects, dummy,                 <<39.pv>>07502000
                              aname, gname, mvtabx);           <<39.pv>>07504000
   value numsects, dummy, mvtabx;                              <<39.pv>>07506000
   double numsects;                                                     07508000
   integer dummy, mvtabx;                                      <<39.pv>>07510000
   array aname, gname;                                                  07512000
   option privileged, uncallable, variable;                    <<39.pv>>07514000
<< adjusts tha acct and group space counts by numsects >>               07516000
begin                                                                   07518000
   logical                                                     <<39.pv>>07520000
       pmask = q-4;                                            <<39.pv>>07522000
   define                                                      <<39.pv>>07524000
       mvtabx'm = (15:1) #,                                    <<39.pv>>07526000
       mvtabx'p = pmask.mvtabx'm #;                            <<39.pv>>07528000
   array parr (*) = numsects;                                           07530000
   double lnumsects;                                                    07532000
   lnumsects := numsects;                                               07534000
   tos := 0;  tos.(allflag) := true;                           <<26.pv>>07536000
   tos := 0;                                                            07538000
   numsects := tos;                                                     07540000
   dummy := 0;                                                 <<38.pv>>07542000
   if not mvtabx'p then mvtabx := 0;                           <<39.pv>>07544000
   if (direcadjust :=                                          <<39.pv>>07546000
       dirstartoff (parr,lnumsects,,,mvtabx)) <> 0d then       <<39.pv>>07548000
      tos := ccg                                                        07550000
   else tos := cce;                                                     07552000
   cc := tos;                                                           07554000
   relsir (dirsir, sirreturn);                                          07556000
   exchangedb (0);                                             << ... >>07558000
   end    <<procedure direcadjust>>;                                    07560000
                                                                        07562000
                                                                        07564000
                                                                        07566000
                                                                        07568000
logical procedure dirdoentry (element, leaflevel, recip,       <<56.pv>>07570000
                              parms, visit);                   <<56.pv>>07572000
   value leaflevel, parms, visit;                              <<56.pv>>07574000
   array element;                                                       07576000
   integer leaflevel, parms;                                            07578000
   logical visit;                                              <<56.pv>>07580000
   integer procedure recip;                                             07582000
   option privileged, uncallable, forward;                              07584000
                                                                        07586000
                                                                        07588000
                                                                        07590000
                                                                        07592000
procedure dirscantree (index, leaflevel, recip, parms);                 07594000
   value index, leaflevel, parms;                                       07596000
   integer index, leaflevel, parms;                                     07598000
   integer procedure recip;                                             07600000
   options;                                                             07602000
begin                                                                   07604000
   integer                                                     <<56.pv>>07606000
       visit := true;                                          <<56.pv>>07608000
   integer pointer                                                      07610000
      ip,                                                               07612000
      ep;                                                               07614000
   double pointer                                                       07616000
      dip = ip,                                                         07618000
      dep = ep,                                                         07620000
      ddblpntr = dblpntr;                                               07622000
   double array dddsentry (*) = ddsentry;                               07624000
<< >>                                                                   07626000
   dirread (index, b, 0, 0);     << get tree >>                         07628000
   dbpcount := dbpcount +1;      << mark as undeletable >>              07630000
   dirwrite (b);                                                        07632000
   tos := ddblpntr;              << start scan: initial name >>         07634000
   tos := ddblpntr (1) & dlsl (1) & dlsr (1);                           07636000
   parms := parms -deltaq;                                              07638000
                                                                        07640000
nextname:                                                               07642000
   << index in block b; target name on tos >>                           07644000
   dddsentry (1) := tos;                                                07646000
   dddsentry := tos;                                                    07648000
   @ip := dirscan (ddsentry, epb);  << find containing block >>         07650000
   if = then                                                            07652000
      begin    <<ok. so find next block for this dummy entry>>          07654000
      @ip := dirscan (ddsentry, enb);                                   07656000
      if = then goto leave;                                             07658000
      end;                                                              07660000
nextblock:                                                              07662000
   dirread (ip (iepntr), a, ip (iecount), dbemiscwd);                   07664000
   @ep := dirscan (ddsentry, ena);  << find entry in block >>           07666000
   if = then                                                            07668000
      begin                      << not in entry block >>               07670000
      if (@ip := @ip +dbxsize) >= @dblpntr +dbused then goto leave;     07672000
                                                                        07674000
                                                                        07676000
      goto nextblock;                                                   07678000
      end;                                                              07680000
   tos := dep;                                                          07682000
   tos := dep (1) & dlsl (1) & dlsr (1);                                07684000
   dabadelm := ep (2) < 0;  <<flagged entry?>>                 <<00175>>07686000
   tos := dirdoentry (ep, leaflevel, recip, parms, visit);     <<56.pv>>07688000
   << directory may be completely modified, except that                 07690000
      index block <index> still exists.     the directory is locked >>  07692000
   dirread (index, b, 0, 0);                                            07694000
   if tos <= 0 then                                            <<56.pv>>07696000
   begin  <<continue scan>>                                    <<56.pv>>07698000
       if = then                                               <<56.pv>>07700000
       begin  <<next target name & visit entry>>               <<56.pv>>07702000
           tos := tos+1;  <<next target name>>                 <<56.pv>>07704000
           visit := true;                                      <<56.pv>>07706000
       end else <<redo entry - no visit>> visit := false;      <<56.pv>>07708000
       go to nextname;                                         <<56.pv>>07710000
   end;                                                        <<56.pv>>07712000
                                                                        07714000
leave:                                                                  07716000
   dbpcount := dbpcount -1;            <<allow deletion>>               07718000
   dirwrite (b);                                                        07720000
   end    <<dirscantree>>;                                              07722000
                                                                        07724000
                                                                        07726000
                                                                        07728000
                                                                        07730000
logical procedure dirdoentry (element, leaflevel, recip,       <<56.pv>>07732000
                    parms, visit);                             <<56.pv>>07734000
   value leaflevel, parms, visit;                              <<56.pv>>07736000
   array element;                                                       07738000
   integer leaflevel, parms;                                            07740000
   logical visit;                                              <<56.pv>>07742000
   integer procedure recip;                                             07744000
   options;                                                             07746000
begin                                                                   07748000
   array saveglob1 (0:10) = q;    <<assume at q+1>>            <<38.pv>>07750000
   double savedirbase;                                         <<11.pv>>07752000
   integer                                                     <<11.pv>>07754000
       addr,                                                   <<11.pv>>07756000
       mvtabx := 0; <<when non-zero, switch "DIRBASE">>        <<11.pv>>07758000
<< >>                                                                   07760000
   xreg := 0;                                                  <<10.pv>>07762000
   case *damiscwd.(levelf) of  <<current subtree>>             <<16.pv>>07764000
   begin                                                       <<07.pv>>07766000
       ;                                               <<0>>   <<10.pv>>07768000
       begin                                           <<1>>   <<11.pv>>07770000
           if leaflevel = filelevel then                       <<11.pv>>07772000
           begin  <<set up for possible "DIRBASE" switch>>     <<11.pv>>07774000
               if element (glinkage).(pvf) = pv then           <<11.pv>>07776000
                mvtabx := element (glinkage).(mvtabxf);        <<11.pv>>07778000
               xreg := gfipntr;                                <<11.pv>>07780000
           end                                                 <<11.pv>>07782000
           else xreg := gvsdipntr;                             <<11.pv>>07784000
       end;                                            <<1>>   <<11.pv>>07786000
       case *leaflevel of                              <<2>>   <<16.pv>>07788000
       begin                                                   <<07.pv>>07790000
           xreg := agipntr;   <<0>>                            <<07.pv>>07792000
           xreg := agipntr;   <<1>>                            <<07.pv>>07794000
           ;                  <<2>>                            <<10.pv>>07796000
           xreg := auipntr;   <<3>>                            <<07.pv>>07798000
           xreg := agipntr;   <<4>>                            <<07.pv>>07800000
       end;                                                    <<07.pv>>07802000
       ;                                               <<3>>   <<10.pv>>07804000
       ;                                               <<4>>   <<10.pv>>07806000
   end;                                                        <<07.pv>>07808000
   tos := if xreg = 0 then 0 else element (xreg);              <<07.pv>>07810000
   tos := damiscwd.(levelf);                                            07812000
   tos := setcritical;    <<disallow abortion in recip>>                07814000
   parms := parms - deltaq;                                    <<56.pv>>07816000
   if visit then                                               <<56.pv>>07818000
   begin                                                       <<56.pv>>07820000
       tos := 0;     << get ready for visit via recip >>       <<56.pv>>07822000
       tos := @element;                                        <<56.pv>>07824000
       tos := s3;                                              <<56.pv>>07826000
       tos := parms;                                           <<56.pv>>07828000
       tos := dirsir;                                          <<56.pv>>07830000
       tos := sirreturn;                                       <<56.pv>>07832000
       push (q, dl);                                           <<56.pv>>07834000
       assemble(lsub,inca,dup);                                <<de>>   07836000
       addr := tos;                                            <<de>>   07838000
       tos := @workarea;                                       <<56.pv>>07840000
       tos := 11;                                              <<56.pv>>07842000
       assemble (mvbl);                                        <<56.pv>>07844000
       savedirbase := dirbase;                                 <<56.pv>>07846000
       tos := recip (*, *, *, *);    << visit entry >>         <<56.pv>>07848000
       if not (ls0) or s0 < 0 then                             <<56.pv>>07850000
       begin                                                   <<56.pv>>07852000
           if not ls0 then getsir (dirsir) <<sir was released>><<58.pv>>07854000
            else s0.(15:1) := 0; <<reset sir flag>>            <<58.pv>>07856000
           tos := @workarea;                                   <<56.pv>>07858000
           tos := addr;                                        <<56.pv>>07860000
           tos := 11;                                          <<56.pv>>07862000
           assemble (mvlb);                                    <<56.pv>>07864000
           dirbase := savedirbase;                             <<56.pv>>07866000
           if s0 < 0 then                                      <<56.pv>>07868000
           begin <<requested to redo entry>>                   <<56.pv>>07870000
               dirdoentry := tos;                              <<56.pv>>07872000
               resetcritical (*);                              <<56.pv>>07874000
               return;                                         <<56.pv>>07876000
           end;                                                <<56.pv>>07878000
       end else s0.(15:1) := 0; <<reset sir flag>>             <<58.pv>>07880000
   end <<of visiting entry>> else                              <<56.pv>>07882000
   begin <<no visit>>                                          <<56.pv>>07884000
       savedirbase := dirbase;                                 <<56.pv>>07886000
       tos := 0;  <<set up for next test on tos>>              <<56.pv>>07888000
   end;                                                        <<56.pv>>07890000
   if tos & lsr(1) > 1 then                                             07892000
      dirdoentry := 1;           << stop scan >>                        07894000
   resetcritical(*);                                                    07896000
   if < then                     << continue scan >>                    07898000
      if tos <> leaflevel then                                          07900000
      begin                                                    <<11.pv>>07902000
          if mvtabx <> 0 then  <<next subtree on mounted pv>>  <<11.pv>>07904000
          begin                                                <<11.pv>>07906000
              tos := ddsdst;            <<e: target>>          <<45.pv>>07908000
              tos := @dirbase;          <<d: target offset>>   <<45.pv>>07910000
              tos := mvtabdst;          <<c: source>>          <<45.pv>>07912000
              tos := (mvtabx*mvtabsz)+2;<<b: source offset>>   <<45.pv>>07914000
              tos := 2;                 <<a: count>>           <<45.pv>>07916000
              assemble (mds);                                  <<45.pv>>07918000
          end;                                                 <<11.pv>>07920000
          dirscantree (*, leaflevel, recip, parms);            <<11.pv>>07922000
      end;                                                     <<11.pv>>07924000
   dirbase := savedirbase;                                     <<11.pv>>07926000
   end    <<dirdoentry>>;                                               07928000
                                                                        07930000
                                                                        07932000
                                                                        07934000
                                                                        07936000
double procedure direcscan (type, linkage'indexp, aname,       <<38.pv>>07938000
                          guname, fname, recip, parms, mvtabx);<<38.pv>>07940000
   value type, linkage'indexp, mvtabx;                         <<38.pv>>07942000
   integer type, mvtabx;                                       <<38.pv>>07944000
   double  linkage'indexp;                                     <<38.pv>>07946000
   integer procedure recip;                                             07948000
   array aname, guname, fname, parms;                                   07950000
   option privileged, uncallable, variable;                    <<35.pv>>07952000
begin                                                                   07954000
   array parr (*) = type;                                               07956000
   logical                                                     <<35.pv>>07958000
       dsir,                                                   <<56.pv>>07960000
       ltype = type,                                           <<35.pv>>07962000
       pmask = q-4;                                            <<35.pv>>07964000
   define                                                      <<35.pv>>07966000
       mvtabx'm = (15:1) #,                                    <<35.pv>>07968000
       mvtabx'p = pmask.mvtabx'm #;                            <<35.pv>>07970000
                                                                        07972000
<< >>                                                                   07974000
                                                                        07976000
                                                                        07978000
   tos := @parms;                                                       07980000
   push (q);                                                            07982000
   @parms := tos -tos;                                                  07984000
   if ltype.(hitflag) then                                     <<56.pv>>07986000
   begin                                                       <<56.pv>>07988000
       if mvtabx'p then                                        <<56.pv>>07990000
        tos := dirstartoff (parr,,recip,@parms,mvtabx)         <<56.pv>>07992000
       else                                                    <<56.pv>>07994000
        tos := dirstartoff (parr, ,recip, @parms);             <<56.pv>>07996000
       if ds1 < 0d then                                        <<56.pv>>07998000
       begin  <<need to redo startoff - dds was disturbed>>    <<56.pv>>08000000
           ddel; <<return from dirstartoff>>                   <<56.pv>>08002000
           dsir := sirreturn; <<most accurate copy for exit>>  <<56.pv>>08004000
           exchangedb (0);                                     <<56.pv>>08006000
           if mvtabx'p then                                    <<56.pv>>08008000
            tos := dirstartoff (parr,,,,mvtabx)                <<56.pv>>08010000
           else                                                <<56.pv>>08012000
            tos := dirstartoff (parr);                         <<56.pv>>08014000
           sirreturn := dsir;                                  <<56.pv>>08016000
       end;                                                    <<56.pv>>08018000
   end                                                         <<56.pv>>08020000
   else                                                        <<42.pv>>08022000
    if mvtabx'p then                                           <<42.pv>>08024000
     tos := dirstartoff (parr,,,,mvtabx)                       <<42.pv>>08026000
    else                                                       <<42.pv>>08028000
     tos := dirstartoff (parr);                                <<42.pv>>08030000
   if ds1 <> 0d then goto badexit;                                      08032000
   if carry then goto goodexit;                                         08034000
   << (2 zeros on stack) >>                                             08036000
   if logical (type.(allflag)) then                                     08038000
      dirscantree (xindexp, type.(tolevelf), recip, @parms)             08040000
   else                                                                 08042000
      begin                                                             08044000
      tos := xindexp;            << make use of 2 zeros >>              08046000
      tos := dirfind (*);        << visit root >>                       08048000
      assemble (dtst, zrob);     << setup for dirdoentry >>             08050000
      if = then                                                         08052000
         begin                                                          08054000
         assemble (ddel);                                               08056000
         tos := type.(endlevelf);                                       08058000
         tos := 2;                                                      08060000
badexit: tos := ccg;                                                    08062000
         goto exit;                                                     08064000
         end;                                                           08066000
      dirdoentry (*, type.(tolevelf), recip, @parms, true);    <<56.pv>>08068000
      tos := 0d;                                                        08070000
      end;                                                              08072000
                                                                        08074000
goodexit:                                                               08076000
   if dadirty then dirwrite (a);                                        08078000
   if dbdirty then dirwrite (b);                                        08080000
   tos := cce;                                                          08082000
exit:                                                                   08084000
   cc := tos;                                                           08086000
   direcscan := tos;                                                    08088000
   relsir (dirsir, sirreturn);                                          08090000
   exchangedb (0);                                                      08092000
   end    <<direcscan>>;                                                08094000
                                                                        08096000
integer procedure direclogon(mask,jmatarr,contime,cputime,     <<06560>>08098000
      aentry,uentry,gentry);                                   <<02.eb>>08100000
   value mask, contime, cputime;                                        08102000
   integer mask;                                                        08104000
   array jmatarr,aentry,uentry,gentry;                         <<06560>>08106000
   double contime, cputime;                                             08108000
   option privileged, uncallable;                                       08110000
begin                                                                   08112000
   entry direclogoff;                                                   08114000
                                                                        08116000
comment these routines do directory juggling for logon and     <<05.eb>>08118000
   logoff.  essentially, this includes:                                 08120000
   1. finding (returning for logon) the account, group and user entries.08122000
   2. decrementing (incrementing for logon) then following:             08124000
      a. user entry logon count,                                        08126000
      b. acct/group index pointer count,                                08128000
      c. group/file index pointer count.                                08130000
   3. for logoff, update the acct and group connect and cpu times.      08132000
   input parameters:                                                    08134000
      <mask>                                                            08136000
         logon - must be 0.                                             08138000
         logoff                                                         08140000
            = 0 acct/user/group exist,                                  08142000
            = 1 acct/user exist, no group,                     <<05.eb>>08144000
            = 2 no acct,                                       <<05.eb>>08146000
            = 3 acct exists, no user,                          <<05.eb>>08148000
            = 4 acct/user exist, no home group spec.,          <<05.eb>>08150000
      <jmatentry> the full jmatentry in stack.  used to get the account,08152000
         group and user names.                                          08154000
      <contime> and <cputime>                                           08156000
         logon - ignored,                                               08158000
         logoff - times used for update (if mask = 0).                  08160000
   returns:                                                             08162000
      logon - same as <mask>, logoff.                                   08164000
      logoff                                                            08166000
            .(15:1) acct connect exceeded,                              08168000
            .(14:1) acct cpu                                            08170000
            .(13:1) group connect                                       08172000
            .(12:1) group cpu.                                          08174000
            .(11:1)         acct connect time negative         <<04282>>08176000
            .(10:1)         group connect time negative        <<04282>>08178000
            .( 9:1)         acct cpu time negative             <<04282>>08180000
            .( 8:1)         group cpu time negative            <<04282>>08182000
;                                                              <<05.eb>>08184000
                                                                        08186000
   integer pointer   ps0               = s-0;                           08188000
   integer           adjust            = workarea;                      08190000
   double            dddsentry1        = dds,                           08192000
                     dddsentry2        = dds +2;                        08194000
                                                                        08196000
   integer           savesir,                                           08198000
                     saveagi,                                           08200000
                     result            = direclogon,                    08202000
                     incrdecr          := +1;                           08204000
   logical           offlag            := false;                        08206000
   array             localagu (0:15) = q;                               08208000
   double            lan1              = localagu +4,                   08210000
                     lan2              = localagu +6,                   08212000
                     lun1              = localagu,                      08214000
                     lun2              = localagu +2,                   08216000
                     lgn1              = localagu +12,                  08218000
                     lgn2              = localagu +14;                  08220000
   integer                                                     <<02.eb>>08222000
      dloffset,                                                <<02.eb>>08224000
      aentrydl,                                                <<02.eb>>08226000
      uentrydl,                                                <<02.eb>>08228000
      gentrydl;                                                <<02.eb>>08230000
   logical logongroup = lgn1;                                  <<05.eb>>08232000
   define jmatinx = 0#;                                        <<06560>>08234000
                                                                        08236000
                                                                        08238000
   goto start;                                                          08240000
                                                                        08242000
                                                                        08244000
direclogoff:                                                            08246000
   offlag := true;                                                      08248000
   incrdecr := -1;                                                      08250000
                                                                        08252000
                                                                        08254000
start:                                                                  08256000
   result := 0;                                                         08258000
   if mask = 2 then return; << no acct >>                      <<05.eb>>08260000
   move localagu := jmatusername, (16);                        <<06560>>08262000
   push (dl);                                                           08264000
   dloffset := s0;                                             <<02.eb>>08266000
   aentrydl := @aentry -dloffset;                              <<02.eb>>08268000
   uentrydl := @uentry -dloffset;                              <<02.eb>>08270000
   gentrydl := @gentry -dloffset;                              <<02.eb>>08272000
   if exchangedb(ddsdst) <> 0 then sysabort(dirbaddst);        <<de>>   08274000
   savesir := getsir (dirsir);                                          08276000
   sysvsdirbase;                                               <<32.pv>>08278000
   dirbase := tos;                                             <<32.pv>>08280000
   xtype := grouplevel & lsl (3); <<prevent dirbase switch>>   <<52.pv>>08282000
   if dadirty or dbdirty then sysabort (diraberr);             <<de>>   08284000
   adjust := -tos;                                                      08286000
   dddsentry1 := lan1;                 <<find acct>>                    08288000
   dddsentry2 := lan2;                                                  08290000
   tos := dirfind (sysacctindex);                                       08292000
   assemble (dtst, delb);                                               08294000
   if = then                                                            08296000
      begin                                                             08298000
      if offlag then sysabort (dirlogerr);                     <<de>>   08300000
      result := 2; << no acct >>                               <<05.eb>>08302000
      goto exit;                                                        08304000
      end;                                                              08306000
   saveagi := ps0 (agipntr);              <<save agi index p>>          08308000
   if offlag then                                                       08310000
      begin                                                             08312000
      if mask = 0 then                                                  08314000
         begin                                                          08316000
         if (dps0 (acpucountd) := dps0 (acpucountd) +cputime) >         08318000
            dps0 (acpulimitd) then result.(14:1) := 1;                  08320000
         if contime < 0d then                                  <<04282>>08322000
              begin                                            <<04282>>08324000
              result.(11:1) := 1;  << acct connect negative >> <<04282>>08326000
              contime := 0d;  << reset connect time for account<<04282>>08328000
              end;                                             <<04282>>08330000
         if cputime < 0d then                                  <<04282>>08332000
              begin                                            <<04282>>08334000
              result.(9:1) := 1;  << this is a hook into system<<04282>>08336000
              cputime := 0d; <<reset cpu time >>               <<04282>>08338000
              end;                                             <<04282>>08340000
         if (dps0 (acontimecountd) := dps0 (acontimecountd) +           08342000
            contime) > dps0 (acontimelimitd) then                       08344000
               result.(15:1) := 1;                                      08346000
         dirwrite (a);                                                  08348000
         end;                                                           08350000
      end                                                               08352000
   else                                                                 08354000
      begin                            <<logon: return entry>>          08356000
      tos := aentrydl;                                         <<02.eb>>08358000
      assemble (ddup, del);                                             08360000
      tos := asize;                                                     08362000
      assemble (mvbl);                                                  08364000
      end;                                                              08366000
                                                                        08368000
   if mask = 3 then go exit;<<logoff:no user at logon>>        <<05.eb>>08370000
   dddsentry1 := lun1;                 <<find user>>                    08372000
   dddsentry2 := lun2;                                                  08374000
   tos := dirfind (ps0(auipntr));                                       08376000
   assemble (dtst, delb);                                               08378000
   if = then                                                            08380000
      begin                                                             08382000
      if offlag then sysabort (dirlogerr);                     <<de>>   08384000
      result := 3; << no user>>                                <<05.eb>>08386000
      goto exit;                                                        08388000
      end;                                                              08390000
   ps0 (ulogcount) := ps0(ulogcount) +incrdecr;    <<adjust logon cnt>> 08392000
   dirwrite (a);                                                        08394000
   if mask >= 1 then go exit;<<logoff:no group at logon >>     <<05.eb>>08396000
   if not (offlag) then                                                 08398000
      begin                            <<logon: return user entry>>     08400000
      tos := uentrydl;                                         <<02.eb>>08402000
      assemble (ddup, del);                                             08404000
      tos := usize;                                                     08406000
      assemble (mvbl);                                                  08408000
      if logongroup = "  " then                                <<05.eb>>08410000
         begin <<no grp., use home grp. in u. entry>>          <<05.eb>>08412000
         lgn1 := dps0(uhgroup/2);                              <<05.eb>>08414000
         lgn2 := dps0(uhgroup/2 +1);                           <<05.eb>>08416000
         if logongroup = "  " then                             <<05.eb>>08418000
            begin << no home group exists >>                   <<05.eb>>08420000
            result := 4;                                       <<05.eb>>08422000
            go exit;                                           <<05.eb>>08424000
            end;                                               <<05.eb>>08426000
         end;                                                  <<05.eb>>08428000
      end;                                                              08430000
                                                                        08432000
   dddsentry1 := lgn1;                 <<find group>>                   08434000
   dddsentry2 := lgn2;                                                  08436000
   tos := dirfind (saveagi);                                            08438000
   assemble (dtst, delb);                                               08440000
   if = then                                                            08442000
      begin                                                             08444000
      if offlag then sysabort (dirlogerr);                     <<de>>   08446000
      result := 1; << no group >>                              <<05.eb>>08448000
      goto exit;                                                        08450000
      end;                                                              08452000
   if offlag then                                                       08454000
      begin                                                             08456000
         if contime < 0d then                                  <<04282>>08458000
              begin                                            <<04282>>08460000
              result.(10:1) := 1; << group connect time negativ<<04282>>08462000
              contime := 0d;  << reset con. time for accounting<<04282>>08464000
              end;                                             <<04282>>08466000
         if cputime < 0d then                                  <<04282>>08468000
              begin                                            <<04282>>08470000
              result.(8:1) := 1; << this is a hook into system <<04282>>08472000
              cputime := 0d; <<reset cputime >>                <<04282>>08474000
              end;                                             <<04282>>08476000
      tos := tos +gcpucount;                                            08478000
      if (dps0 := dps0 +cputime) > dps0(1) then                         08480000
         result.(12:1) := 1;                                            08482000
      if (dps0(2) := dps0(2) +contime) > dps0(3) then                   08484000
         result.(13:1) := 1;                                            08486000
      tos := tos -gcpucount;                                            08488000
      dirwrite (a);                                                     08490000
      end                                                               08492000
   else                                                                 08494000
      begin                               <<logon: return entry>>       08496000
      tos := gentrydl;                                         <<02.eb>>08498000
      assemble (ddup, del);                                             08500000
      tos := gsize;                                                     08502000
      assemble (mvbl);                                                  08504000
      end;                                                              08506000
   dbpcount := dbpcount +incrdecr;     <<adjust index pointer counters>>08508000
   dirwrite (b);                                                        08510000
   tos := if ps0 (glinkage).(pvf) = pv and                     <<37.pv>>08512000
             ps0 (glinkage).(mvtabxf) <> 0 then                <<37.pv>>08514000
           ps0 (gsavefipntr) else                              <<37.pv>>08516000
           ps0 (gfipntr);                                      <<37.pv>>08518000
   dirread (*, b, 0, 0);                                       <<37.pv>>08520000
   dbpcount := dbpcount + incrdecr;                                     08522000
   dirwrite (b);                                                        08524000
                                                                        08526000
exit:                                                                   08528000
   relsir (dirsir, savesir);                                            08530000
   exchangedb (0);                                                      08532000
   end    <<direclogon / direclogoff>>;                                 08534000
$control segment=main                                                   08536000
                                                                        08538000
                                                                        08540000
                                                                        08542000
end.    << outer block >>                                      <<de>>   08544000
