<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00000001
<<==============================================================        00010000
                                                                        00012000
                           INCLFREE - B1                                00014000
                                                                        00016000
      This include file has the code that is common to VINIT and        00018000
   FREE2, which is the procedure PFRE.                                  00020000
                                                                        00022000
==============================================================>>        00024000
PROCEDURE pfre(fn,all,which'ldev);                                      00026000
   VALUE fn,all,which'ldev;                                             00028000
   INTEGER fn,which'ldev;                                               00030000
   LOGICAL all;                                                         00032000
   OPTION PRIVILEGED,UNCALLABLE;                                        00034000
                                                                        00036000
<<===================================================                   00038000
                                                                        00040000
                                                                        00042000
   Procedure to print out a histogram of free space. Options are        00044000
   for all discs(mounted pv or sys disc) or a single LDEV. PFRE         00046000
   operates part of the time in SPLIT STACK MODE. This is why           00048000
   any arrays which are used in split stack mode are defined to be      00050000
   direct(not DB relative). Note that because it operates partially     00052000
   in split stack mode, it will gather information for 1 LDEV           00054000
   and then print it out.  This means that if the print file            00056000
   is on that LDEV, the print file space wil NOT show as free space.    00058000
   To modify PFRE to include spoolfile space implies that all the       00060000
   information for all LDEVs must be gathered BEFORE creating the       00062000
   printfile.  THis would mean that there would be                      00064000
   (#entries-in-vol-tbl * space'info'sz) words on the stack.            00066000
   This is too much overhead for something trivial.  If the spooler     00068000
   is ever modified to allow easy access to the file label of the       00070000
   spool file, then this modification can be considered.                00072000
   IF any errors occur on writting then will print out                  00074000
   print'file'info. If any error occurs accessing the DFSM,             00076000
   it will print out the rel addr where error occured and               00078000
   status word(returned from DFSM routines).                            00080000
                                                                        00082000
   Parameters:                                                          00084000
      fn-integer,filenumber of printfile which has already been         00086000
         opened                                                         00088000
      all-logical,has value TRUE when you want a histogram for all      00090000
          LDEVs                                                         00092000
      which'ldev-integer,print a histogram for this LDEV only.          00094000
                 Only has meaning if "all" is FALSE                     00096000
                                                                        00098000
   Assumptions on entry:                                                00100000
      print file has already been opened                                00102000
      IF there are any errors in accessing the DFSM or writting         00104000
      the print file SUBROUTINE err'pfre will EXIT. If calling          00106000
      procedure is changed, this subroutine must be changed.            00108000
                                                                        00110000
   Globals:                                                             00112000
      MODIFIES-ds'page'ptr,ds'word'number,ds'bit'number,                00114000
      USES-ds'io'status,ds'starting'word'number                         00116000
           ,ds'starting'bit'number,ds'descriptor'table                  00118000
      CONSTANTS-ok'io'status,largest'space,true,false                   00120000
      vol'table-ldev,scratch,unformatted                                00122000
      lpdt-lpdt'entry'size,nsd,ser'forn                                 00124000
                                                                        00126000
   Externals:                                                           00128000
      setcritical,getsir,relsir,Lock'Dfs'Data'Seg,Scan'Page             00130000
      ,Rel'Dfs'Data'Seg,resetcritical                                   00132000
                                                                        00134000
   Intrinsics:                                                          00136000
      fwrite,print'file'info,terminate,quit,ascii,dascii                00138000
                                                                        00140000
   Resources:                                                           00142000
      vol tbl sir, uses sys global ptr to access LPDT(does not get      00144000
      LPDT sir before accessing)                                        00146000
      MVTAB sir (table not actually accessed)                  ((DFS02))00148000
                                                                        00150000
   Callers:                                                             00152000
      print'free2, pfspace(VINIT)                                       00154000
                                                                        00156000
   Fixid:                                                               00158000
      This procedure was added for support of the new disc free         00160000
      space map.                                                        00162000
                                                                        00164000
   Changes:                                                             00166000
                                                               ((DFS02))00168000
      Fix to only print free space for private volumes that    ((DFS02))00170000
      are logically mounted.  This is to keep a physical       ((DFS02))00172000
      dismount from happening while free space is being        ((DFS02))00174000
      listed.                                                  ((DFS02))00176000
                                                               ((DFS02))00178000
                                                                        00180000
      Changes to print out the number of DFSM pages on a       ((DFS01))00182000
      volume.                                                  ((DFS01  00184000
                                                               ((DFS01  00186000
====================================================>>                  00188000
BEGIN                                                                   00190000
                                                                        00192000
   EQUATE space'info'sz = 32                                            00194000
          ;                                                             00196000
                                                                        00198000
   DEFINE zero'space'info = space'info:=0;                              00200000
                            MOVE space'info(1):=space'info,             00202000
                                                 (space'info'sz-1)#;    00204000
                                                                        00206000
   ARRAY         space'info(0:space'info'sz-1)=Q;                       00208000
   DOUBLE ARRAY  dspace'info(*)=space'info;                             00210000
   ARRAY         vol'name(*)=         space'info;                       00212000
   DOUBLE ARRAY  bucket(*)=           dspace'info(%2);                  00214000
   DOUBLE ARRAY  bucket'cnt(*)=       dspace'info(%10);                 00216000
   DEFINE        disc'max=            dspace'info(%16)#;                00218000
   DEFINE        disc'total=          dspace'info(%17)#;                00220000
                                                                        00222000
   DOUBLE        tot'sys'space;                                         00224000
                                                                        00226000
   INTEGER       dummy1,dummy2;    <<temp variables>>                   00228000
   INTEGER ARRAY dummya(*)=dummy1;                                      00230000
   DOUBLE        ddummy;                                                00232000
                                                                        00234000
   INTEGER       index;        << for put'into'array >>                 00236000
   DOUBLE        size;         << and create'the'printout >>            00238000
                                                                        00240000
   EQUATE        print'len=18;   << for create'the'printout >>          00242000
                                                                        00244000
   ARRAY         print'line(0:print'len-1);                             00246000
   BYTE ARRAY    bprint'line(*)=print'line;                             00248000
                                                                        00250000
   DEFINE        blank'print = print'line:="  ";                        00252000
                               MOVE print'line(1):=print'line,          00254000
                                                        (print'len-1)#; 00256000
   DEFINE        print'stars = blank'print;                             00258000
                               print'line:="**";                        00260000
                               move print'line(1):=print'line,          00262000
                                                        (print'len-1);  00264000
                               fwrite(fn,print'line,print'len,%40);     00266000
                               IF <> THEN err'pfre(write'error)#;       00268000
                                                                        00270000
                                                                        00272000
   <<  volume table definitions  >>                                     00274000
                                                                        00276000
   EQUATE         vol'tbl'sir=22                                        00278000
                 ,vol'tbl'dst=29                                        00280000
                 ;                                                      00282000
                                                                        00284000
   POINTER        vol'table;                                            00286000
   INTEGER        vol'ent'sz                                            00288000
                 ,vol'index                                             00290000
                 ,num'vol'ent  << tot # ent,not incl header >>          00292000
                 ,num'vol'cntr << run through vol tbl >>                00294000
                 ;                                                      00296000
                                                                        00298000
   LOGICAL        volsir'flag                                           00300000
                 ;                                                      00302000
                                                                        00304000
   DEFINE         volumename=vol'table#;                                00306000
   DEFINE         ldev=INT( vol'table(%14).(0:8) )#;                    00308000
   DEFINE         scratch=vol'table(%14).(15:1)=1#;                     00310000
   DEFINE         unformatted=vol'table(%14).(13:1)=1#;                 00312000
   DEFINE                                                      <<*1239>>00313000
      turn'traps'off =                                         <<*1239>>00313100
           PUSH(STATUS);tos.(2:1):=0;SET(STATUS)#,             <<*1239>>00313200
      turn'traps'on  =                                         <<*1239>>00313300
           PUSH(STATUS);tos.(2:1):=1;SET(STATUS)#;             <<*1239>>00313400
                                                                        00314000
   <<  mask for states which are allowable for ldev. For   >>           00316000
   <<  more info, see PVSYS                                >>           00318000
                                                                        00320000
   EQUATE ok'mask=%007470;   << mounted,downpending,down,               00322000
                                reserved,sysdomain,                     00324000
                                notpvtype,notremoveable                 00326000
                             >>                                         00328000
                                                                        00330000
   LOGICAL  lstatus;                                                    00332000
                                                                        00334000
   <<     local definitions for  DFSM usage >>                          00336000
                                                                        00338000
   INTEGER       lpage    << to tell "get'page" what page >>            00340000
                ;                                                       00342000
                                                                        00344000
   LOGICAL       ldone    << done with this ldev         >>             00346000
                ,lpg'end  << done with this page         >>             00348000
                ,ldfs'locked << DFSM locked and SPLIT stack >>          00350000
                ,ldev'found  << when only printing one LDEV >>          00352000
                ,lcrit       << setcritical value >>                    00354000
                ,lcrit'set   << flag to show did setcrit >>             00356000
                ,traps'off   << flag to show traps off   >>    <<*1239>>00357000
                ,cantfind    << Descrs say all pages bad  >>            00358000
                ,cont                                                   00360000
                ,proc'status                                            00362000
                ;                                                       00364000
                                                                        00366000
   DOUBLE        lsectcnt   << sect cnt, may span pages >>              00368000
                ;                                                       00370000
                                                                        00372000
$EDIT VOID=00386000                                            <<01239>>00374000
                                                               <<01239>>00388000
   LOGICAL mvtab'sir'flag,                                     <<01239>>00390000
           have'mvtab'sir := FALSE;                            <<01239>>00392000
                                                               <<01239>>00394000
                                                                        00396000
      << see if Descriptor entry for page flagged as bad >>             00398000
                                                                        00400000
   DEFINE        flagged'bad = ds'descriptor'table(                     00402000
                             (lpage*dt'entry'size) +                    00404000
                              largest'space ) = bad'page#;              00406000
                                                                        00408000
   EQUATE write'error = %01;  << for err'pfre >>                        00410000
                                                                        00412000
   << use this when subroutine exits from procedure >>                  00414000
                                                                        00416000
   DEFINE exit'procedure = ASSEMBLE(exit 3)#;                           00418000
                                                                        00420000
   INTEGER bad'page'count;                                     <<01239>>00422000
   BYTE POINTER bps0 = S - 0;                                  <<01239>>00424000
$PAGE                                                                   00426000
<<        ARRAY SPACE'INFO                                              00428000
                                                                        00430000
      **************************************                            00432000
    0 *                                    *  vol'name(BA)              00434000
      *                                    *                            00436000
      *                                    *                            00438000
      **************************************                            00440000
    5 *         100000 >                   *  bucket(DBL)               00442000
      **************************************                            00444000
      *         10000 - 99999              *                            00446000
      **************************************                            00448000
      *         1000  - 9999               *                            00450000
      **************************************                            00452000
      *         100   - 999                *                            00454000
      **************************************                            00456000
      *         10    - 99                 *                            00458000
      **************************************                            00460000
      *         1     - 9                  *                            00462000
      **************************************                            00464000
  %20 *  count    100000                   *  bucket'cnt(DBL)           00466000
      **************************************                            00468000
      *           10000                    *                            00470000
      **************************************                            00472000
      *           1000                     *                            00474000
      **************************************                            00476000
      *           100                      *                            00478000
      **************************************                            00480000
      *           10                       *                            00482000
      **************************************                            00484000
      *           1                        *                            00486000
      **************************************                            00488000
  %34 *       max free size                *  disc'max(DBL)             00490000
      **************************************                            00492000
  %36 *     total space on disc            *  disc'total(DBL)           00494000
      **************************************                            00496000
                                                                        00498000
      Total size of array =%40                                          00500000
>>                                                                      00502000
$PAGE "HEWLETT-PACKARD   SUBROUTINE REL'MVTAB"                 <<01239>>00504000
SUBROUTINE rel'mvtab;                                          <<01239>>00506000
BEGIN                                                          <<01239>>00508000
   IF have'mvtab'sir THEN                                      <<01239>>00510000
      BEGIN                                                    <<01239>>00512000
      relsir (mvtab'sir,mvtab'sir'flag);                       <<01239>>00514000
      have'mvtab'sir := FALSE;                                 <<01239>>00516000
      END;                                                     <<01239>>00518000
   IF lcrit'set THEN                                           <<01239>>00520000
      BEGIN                                                    <<01239>>00522000
      resetcritical(lcrit);                                    <<01239>>00524000
      lcrit'set := FALSE;                                      <<01239>>00526000
      END;                                                     <<01239>>00528000
   IF traps'off THEN                                           <<*1239>>00528100
      BEGIN                                                    <<*1239>>00528200
      turn'traps'on;                                           <<*1239>>00528300
      traps'off := FALSE;                                      <<*1239>>00528400
      END;                                                     <<*1239>>00528500
END;                                                           <<01239>>00530000
$PAGE " SUBROUTINE ERR'PFRE"                                            00532000
SUBROUTINE err'pfre(err);                                               00534000
   VALUE err;                                                           00536000
   LOGICAL err;                                                         00538000
                                                                        00540000
<<===================================================                   00542000
                                                                        00544000
   Handles any errors on any access to the print file which returned    00546000
   CCG/CCL. It will either print out a tombstone or status word         00548000
   with relative address, depending on type of error.                   00550000
                                                                        00552000
   Parameters:                                                          00554000
      Take liberties w DFSM status word. Assumes that %01               00556000
      is ok status, therefore if you call this routine                  00558000
      w %01 it's an I/O error on list dev                               00560000
                                                                        00562000
   Returns:                                                             00564000
      NEVER returns to caller, does an EXIT                             00566000
                                                                        00568000
   Calling id:                                                          00570000
              2.2                                                       00572000
              This subroutine was added for DFSM support                00574000
                                                                        00576000
   Fixid:                                                               00578000
                                                                        00580000
   Changes:                                                             00582000
                                                                        00584000
====================================================>>                  00586000
BEGIN                                                                   00588000
   IF ldfs'locked THEN Unlock'Dfs'Data'Seg;                             00590000
rel'mvtab;                                                     <<01239>>00592000
   IF err=write'error THEN print'file'info(fn)                          00594000
   ELSE                                                                 00596000
      BEGIN                                                             00598000
         blank'print;                                                   00600000
         MOVE bprint'line:="Error status=";                             00602000
         dummy1:=ascii(err,8,bprint'line(13));                          00604000
         MOVE bprint'line(22):="Rel Adr=";                              00606000
         dummy2:=s0;   << rel addr of where error occured >>            00608000
         dummy1:=ascii(dummy2,8,bprint'line(30));                       00610000
         fwrite(fn,print'line,print'len,%40);                           00612000
      END;                                                              00614000
$IF X3=ON                                                               00616000
      debug;                                                            00618000
$IF                                                                     00620000
   exit'procedure;                                                      00622000
END;                                                                    00624000
                                                                        00626000
<<----------------------------------------->>                           00628000
                                                                        00630000
SUBROUTINE movefromdataseg(dest,srcdst,offset,cnt);                     00632000
   VALUE dest,srcdst,offset,cnt;                                        00634000
   LOGICAL dest,srcdst,offset,cnt;                                      00636000
                                                                        00638000
<<===================================================                   00640000
                                                                        00642000
         This is a subroutine to do a MFDS.                             00644000
         Because you are passing args                                   00646000
         SPL will convert all the argument's                            00648000
         addresses to DB relative addresses-                            00650000
         MFDS expects this                                              00652000
         NEVER CALL THIS IN SPLIT STACK MODE                            00654000
         NOTICE ALSO THAT IT DESTROYS X, BUT YOU                        00656000
         SHOULD NEVER DEPEND ON X AFTER SUBR CALLS                      00658000
                                                                        00660000
                                                                        00662000
   Parameters:                                                          00664000
      dest-ADDRESS of destination                                       00666000
      srcdst-data seg # of source                                       00668000
      offset-offset into srcdst                                         00670000
      cnt-words to transfer                                             00672000
                                                                        00674000
   Returns:                                                             00676000
      data is returned in "dest"                                        00678000
                                                                        00680000
   Assumptions on entry:                                                00682000
      allowed to clobber X register                                     00684000
                                                                        00686000
   Calling id:                                                          00688000
      2.1                                                               00690000
      This subroutine was added for DFSM support                        00692000
                                                                        00694000
   Fixid:                                                               00696000
                                                                        00698000
   Changes:                                                             00700000
====================================================>>                  00702000
                                                                        00704000
BEGIN                                                                   00706000
                                                                        00708000
   X:=TOS;      << save return addr >>                                  00710000
   ASSEMBLE(MFDS 0);                                                    00712000
   TOS:=X;      << restore return addr >>                               00714000
                                                                        00716000
END;                                                                    00718000
$PAGE "SUBROUTINE PUT'INTO'ARRAY"                                       00720000
SUBROUTINE put'into'array;                                              00722000
                                                                        00724000
<<===================================================                   00726000
                                                                        00728000
      puts lsectcnt into the array space'info -                         00730000
      both in bucket and bucket'cnt                                     00732000
      also finds the maximum free space size                            00734000
      When done zero out lsectcnt because have                          00736000
      already put into array space'info                                 00738000
      NEVER references anything in DFSM DST                             00740000
      THIS IS CALLED IN SPLIT STACK MODE                                00742000
                                                                        00744000
   Parameters:                                                          00746000
      none                                                              00748000
                                                                        00750000
   Assumptions on entry:                                                00752000
     called in split stack mode                                         00754000
                                                                        00756000
   Calling id:                                                          00758000
                2.3                                                     00760000
                This subroutine was added for DFSM support              00762000
                                                                        00764000
   Globals:                                                             00766000
      MODIFIES-space'info(bucket,bucket'cnt,disc'max,disc'total)        00768000
                                                                        00770000
   Fixid:                                                               00772000
                                                                        00774000
   Changes:                                                             00776000
                                                                        00778000
====================================================>>                  00780000
                                                                        00782000
BEGIN                                                                   00784000
                                                                        00786000
   <<     figure out the bucket index for lsectcnt    >>                00788000
                                                                        00790000
   size:=100000D;        << initialize >>                               00792000
   index:=0;                                                            00794000
                                                                        00796000
   WHILE lsectcnt < size DO                                             00798000
      BEGIN                                                             00800000
         size:=size/10D;                                                00802000
         index:=index+1;                                                00804000
      END;                                                              00806000
                                                                        00808000
   <<    put into array bucket and incr bucket'cnt   >>                 00810000
                                                                        00812000
   bucket(index):=bucket(index)+lsectcnt;                               00814000
   bucket'cnt(index):=bucket'cnt(index) + 1D;                           00816000
                                                                        00818000
  <<     is  this the max value for this ldev?   >>                     00820000
                                                                        00822000
   IF lsectcnt > disc'max THEN  disc'max:=lsectcnt;                     00824000
                                                                        00826000
   disc'total:=disc'total + lsectcnt;                                   00828000
                                                                        00830000
   lsectcnt:=0D;          << re-initialize >>                           00832000
END;  << put'into'array >>                                              00834000
$PAGE "CREATE'THE'PRINTOUT"                                             00836000
SUBROUTINE create'the'printout;                                         00838000
BEGIN                                                                   00840000
                                                                        00842000
<<===================================================                   00844000
                                                                        00846000
       prints out the FREE2 format for each ldev                        00848000
       gets the information from space'info                             00850000
       uses array print'line                                            00852000
       also incr  tot'sys'space                                         00854000
       assumes NOT called in split stack mode                           00856000
                                                                        00858000
   Parameters:                                                          00860000
      none                                                              00862000
                                                                        00864000
   Assumptions on entry:                                                00866000
      NOT in split stack mode                                           00868000
                                                                        00870000
   Globals:                                                             00872000
      USES-space'info(bucket,bucket'cnt,disc'total),all                 00874000
      MODIFIES-print'line,tot'sys'space                                 00876000
                                                                        00878000
   Externals:                                                           00880000
                                                                        00882000
   Intrinsics:                                                          00884000
      ascii,fwrite,dascii                                               00886000
                                                                        00888000
   Calling id:                                                          00890000
              2.4                                                       00892000
              This subroutine was added for DFSM support                00894000
                                                                        00896000
   Fixid:                                                               00898000
                                                                        00900000
   Changes:                                                             00902000
                                                                        00904000
====================================================>>                  00906000
                                                                        00908000
rel'mvtab;                                                     <<01239>>00910000
   blank'print;    << blank out the line >>                             00912000
   MOVE bprint'line:="VOLUME";                                          00914000
   MOVE print'line(4):=vol'name,(4);                                    00916000
   MOVE bprint'line(27):="LDEV";                                        00918000
   dummy1:=ascii(ldev,10,bprint'line(32));                              00920000
   fwrite(fn,print'line,print'len,%40);                                 00922000
   IF <> THEN err'pfre(write'error);                                    00924000
                                                                        00926000
   blank'print;                                                         00928000
   MOVE bprint'line:="LARGEST FREE AREA=";                              00930000
   dummy1:=dascii(disc'max,10,bprint'line(19));                         00932000
   fwrite(fn,print'line,print'len,%40);                                 00934000
   IF <> THEN err'pfre(write'error);                                    00936000
                                                                        00938000
   blank'print;                                                         00940000
   MOVE bprint'line:="  SIZE  COUNT  SPACE   AVERAGE";                  00942000
   fwrite(fn,print'line,print'len,%40);                                 00944000
   IF <> THEN err'pfre(write'error);                                    00946000
                                                                        00948000
   <<   loop for all the buckets   >>                                   00950000
   size:=100000D;     << initialize >>                                  00952000
   index:=0;                                                            00954000
                                                                        00956000
   DO BEGIN                                                             00958000
      blank'print;                                                      00960000
      MOVE bprint'line:=">";                                            00962000
      dummy1:=dascii(size,10,bprint'line(1));                           00964000
      dummy1:=dascii(bucket'cnt(index),10,bprint'line(8));  << cnt >>   00966000
      dummy1:=dascii(bucket(index),10,bprint'line(14));                 00968000
      ddummy:=IF bucket'cnt(index) = 0D THEN 0D  << ave >>              00970000
                 ELSE bucket(index) / bucket'cnt(index);                00972000
      dummy1:=dascii(ddummy,10,bprint'line(23));                        00974000
      fwrite(fn,print'line,print'len,%40);                              00976000
      IF <> THEN err'pfre(write'error);                                 00978000
      index:=index + 1;  << incr >>                                     00980000
      size:=size / 10D;                                                 00982000
   END UNTIL index > 5;                                                 00984000
                                                                        00986000
   blank'print;                                                         00988000
   MOVE bprint'line:="TOTAL FREE SPACE=";                               00990000
   dummy1:=dascii(disc'total,10,bprint'line(17));                       00992000
   fwrite(fn,print'line,print'len,%40);                                 00994000
   IF <> THEN err'pfre(write'error);                                    00996000
                                                                        00998000
   print'stars;                                                         01000000
                                                                        01002000
   << Print out number of bad pages, if any >>                 <<01239>>01004000
                                                               <<01239>>01006000
   IF bad'page'count <> 0 THEN                                 <<01239>>01008000
      BEGIN  << Print bad pages >>                             <<01239>>01010000
                                                               <<01239>>01012000
         blank'print;                                          <<01239>>01014000
         MOVE bprint'line := "LDEV ", 2;                       <<01239>>01016000
         TOS := TOS + Ascii (ldev, 10 ,bps0);                  <<01239>>01018000
         MOVE * := " has ", 2;                                 <<01239>>01020000
         TOS := TOS + Ascii (bad'page'count, 10, bps0);        <<01239>>01022000
         MOVE * := " pages of the Disc Free Space Map ", 2;    <<01239>>01024000
         dummy1 := -(TOS - @bprint'line);                      <<01239>>01026000
         Fwrite (fn, print'line, dummy1, 0);                   <<01239>>01028000
         IF <> THEN err'pfre (write'error);                    <<01239>>01030000
         blank'print;                                          <<01239>>01032000
         MOVE bprint'line := "marked as bad.  Up to ", 2;      <<01239>>01034000
         TOS := TOS + Dascii (DOUBLE (bits'per'page) *         <<01239>>01036000
                              DOUBLE (bad'page'count), 10,     <<01239>>01038000
                              bps0);                           <<01239>>01040000
         MOVE * := " sectors of disc space may be lost.", 2;   <<01239>>01042000
         dummy1 := -(TOS - @bprint'line);                      <<01239>>01044000
         Fwrite (fn, print'line, dummy1, 0);                   <<01239>>01046000
         IF <> THEN err'pfre (write'error);                    <<01239>>01048000
         print'stars;                                          <<01239>>01050000
                                                               <<01239>>01052000
      END;   << Print bad pages >>                             <<01239>>01054000
                                                               <<01239>>01056000
   IF all THEN tot'sys'space:=tot'sys'space + disc'total;               01058000
                                                                        01060000
END;  << create'the'printout >>                                         01062000
$PAGE "PFRE"                                                            01064000
                                                                        01066000
   ldev'found:=false;    << initialize >>                               01068000
   tot'sys'space:=0D;                                                   01070000
                                                                        01072000
   <<   get the initial info from the Vol tbl  >>                       01074000
                                                                        01076000
   lcrit:=setcritical;                                                  01078000
   lcrit'set:=true;                                                     01080000
                                                                        01082000
      << get wd 0 from vol tbl header >>                                01084000
                                                                        01086000
   movefromdataseg(@dummy1,vol'tbl'dst,0,1);                            01088000
                                                                        01090000
   resetcritical(lcrit);                                                01092000
   lcrit'set:=false;                                                    01094000
                                                                        01096000
   vol'ent'sz:=dummy1.(8:8);                                            01098000
   num'vol'ent:=dummy1.(0:8);                                           01100000
                                                                        01102000
$PAGE                                                                   01104000
   <<  get the space for the Vol tbl ent on stack >>                    01106000
                                                                        01108000
   PUSH(S);                                                             01110000
   TOS:=TOS+1;                                                          01112000
   @vol'table:=TOS;                                                     01114000
   TOS:=vol'ent'sz;                                                     01116000
   ASSEMBLE(ADDS 0);                                                    01118000
   vol'index:=vol'ent'sz;   << initialize >>                            01120000
   num'vol'cntr:=0;                                                     01122000
                                                                        01124000
   <<                                                                   01126000
     Now gather info and print it for each LDEV                         01128000
     For each sys disc or pv:                                           01130000
                                                                        01132000
     1. set critical so no interrupts honored while accessing           01134000
        the DFSM                                                        01136000
     2. get Vol tbl sir                                                 01138000
     3. copy Vol tbl entry and release vol tbl sir                      01140000
     4. find out if a sys disc or mounted pv from LPDT                  01142000
     5. find the 1st good page by looking at the Descriptor             01144000
        table. If the whole Descriptor table is flagged                 01146000
        as bad, print out a message and then look at next               01148000
        vol entry                                                       01150000
     6. call Lock'Dfs'Data'Seg to get the DFSM DST                      01152000
        ***                                 ***                         01154000
        *   now in split stack mode           *                         01156000
        *   DB at DFSM DST                    *                         01158000
        ***                                 ***                         01160000
     7. run through the DFSM bit map using routines                     01162000
        "get'page" and "scan'page" who use the DFSM                     01164000
        DST work area                                                   01166000
     8. call "Unlock'Dfs'Data'Seg"                                      01168000
        ***                                 ***                         01170000
        *  NOT in split stack mode            *                         01172000
        ***                                 ***                         01174000
     9. create the printout for this LDEV                               01176000
   >>                                                                   01178000
   DO BEGIN                                                             01180000
                                                                        01182000
      lcrit:=setcritical;                                               01184000
      lcrit'set:=true;                                                  01186000
      turn'traps'off;                                          <<*1239>>01186100
      traps'off := TRUE;                                       <<*1239>>01186200
      volsir'flag:=getsir(vol'tbl'sir);                                 01188000
      movefromdataseg(@vol'table,vol'tbl'dst,vol'index,vol'ent'sz);     01190000
      relsir(vol'tbl'sir,volsir'flag);                                  01192000
      bad'page'count := 0;                                     <<01239>>01194000
                                                                        01196000
      << check the bit setting in the vol tbl before going >>           01198000
      <<  to the LPDT                                      >>           01200000
                                                                        01202000
      IF ldev = 0 OR scratch OR unformatted THEN                        01204000
         GO TO next'vol;                                                01206000
                                                                        01208000
      << check to see if deleted vol - vol table entry >>               01210000
      << wd 0 = 0                                      >>               01212000
                                                                        01214000
      IF vol'table = 0 THEN GO TO next'vol;                             01216000
                                                                        01218000
                                                                        01220000
      << do the same kind of checking as pfentries does  >>             01222000
      << This is different from what free2 used to do     >>            01224000
                                                                        01226000
                                                                        01228000
      checkdisc(ldev,lstatus);                                          01230000
      IF (lstatus LOR ok'mask) <> ok'mask THEN GO TO next'vol;          01232000
                                                                        01234000
      << is it a foreign or serial disc ? >>                            01236000
                                                                        01238000
      IF LPDT'NON'SYS'DOMAIN AND LPDT'RDY'SER'FRN'DISC THEN    <<01239>>01240000
         GOTO NEXT'VOL;                                        <<01239>>01242000
                                                               <<01239>>01244000
                                                               <<01239>>01246000
                                                                        01248000
      IF NOT all THEN << is this the correct ldev? >>                   01250000
         BEGIN                                                          01252000
            IF ldev = which'ldev                                        01254000
               THEN                                                     01256000
                  ldev'found:=true                                      01258000
            ELSE                                                        01260000
               GO TO next'vol;                                          01262000
         END;                                                           01264000
          << good vol, get the information >>                           01266000
                                                                        01268000
      zero'space'info;                                                  01270000
      MOVE vol'name:=volumename,(4);  << into space'info >>             01272000
      lpage:=0;    << start at page 0 >>                                01274000
                                                                        01276000
         <<===============================                              01278000
           GOING INTO SPLIT STACK MODE                                  01280000
           Be very careful about refs                                   01282000
           Any name that begins with                                    01284000
           "ds" is from the DFSM DST                                    01286000
           =============================>>                              01288000
      << If the LDEV is a PV, then it must be logically >>     <<01239>>01290000
      << mounted to list the free space (so it can not  >>     <<01239>>01292000
      << be physically dismounted under us).  If it is  >>     <<01239>>01294000
      << logically mounted we hold the MVTAB sir until  >>     <<01239>>01296000
      << listing of free space is complete to prevent   >>     <<01239>>01298000
      << a dismount.                                    >>     <<01239>>01300000
                                                               <<01239>>01302000
      IF LPDT'NON'SYS'DOMAIN THEN                              <<01239>>01304000
         BEGIN  << Its a PV >>                                 <<01239>>01306000
                                                               <<01239>>01308000
            mvtab'sir'flag := Getsir (mvtab'sir);              <<01239>>01310000
            have'mvtab'sir := TRUE;                            <<01239>>01312000
            IF NOT LPDT'MOUNTED'PV THEN                        <<01239>>01314000
                                                               <<01239>>01316000
               BEGIN  << Not logically mounted >>              <<01239>>01318000
                                                               <<01239>>01320000
              rel'mvtab;                                       <<01239>>01322000
                  IF NOT all THEN                              <<01239>>01324000
                     Genmsg (pvmsgset, 34);                    <<01239>>01326000
                                                               <<01239>>01330000
                  GOTO next'vol;                               <<01239>>01332000
                                                               <<01239>>01334000
               END;   << Not logically mounted >>              <<01239>>01336000
                                                               <<01239>>01338000
         END;   << Its a PV >>                                 <<01239>>01340000
                                                               <<01239>>01342000
                                                                        01344000
      proc'status:=Lock'Dfs'Data'Seg(ldev);                             01346000
      IF NOT(proc'status) THEN                                          01348000
         BEGIN                                                          01350000
         rel'mvtab;                                            <<01239>>01352000
            blank'print;                                                01354000
            MOVE bprint'line:=                                          01356000
            "Allocation has been ";                                     01358000
            fwrite(fn,print'line,print'len,%40);                        01360000
            IF <> THEN err'pfre(write'error);                           01362000
            blank'print;                                                01364000
            MOVE bprint'line:="disabled on LDEV";                       01366000
            dummy1:=ascii(ldev,10,bprint'line(17));                     01368000
            fwrite(fn,print'line,print'len,%40);                        01370000
            IF <> THEN err'pfre(write'error);                           01372000
            print'stars;                                                01374000
            GO TO next'vol;                                             01376000
         END;                                                           01378000
      ldfs'locked:=true;                                                01380000
                                                                        01382000
        << get the DFSM set up                                          01384000
          find the first page which has good                            01386000
          Descriptors                                                   01388000
        >>                                                              01390000
      cantfind:=false;                                                  01392000
      cont:=true;                                                       01394000
      While cont DO                                                     01396000
         BEGIN                                                          01398000
            IF flagged'bad THEN                                         01400000
               BEGIN                                                    01402000
                  lpage:=lpage+1;                                       01404000
                  bad'page'count := bad'page'count + 1;        <<01239>>01406000
                  IF lpage > ds'last'page'of'map THEN                   01408000
                     BEGIN                                              01410000
                        cantfind:=true;                                 01412000
                        cont:=false;                                    01414000
                     END;                                               01416000
               END                                                      01418000
            ELSE    cont:=false;                                        01420000
         END;                                                           01422000
      IF cantfind THEN                                                  01424000
         BEGIN                                                          01426000
            << whole Descriptor table marked bad >>                     01428000
            << still in split stack mode         >>                     01430000
            Unlock'Dfs'Data'Seg;                                        01432000
            ldfs'locked:=false;                                         01434000
                               << not in split stack >>                 01436000
         rel'mvtab;                                            <<01239>>01438000
            blank'print;                                                01440000
            move bprint'line:="LDEV ";                                  01442000
            dummy1:=ascii(ldev,10,bprint'line(5));                      01444000
            dummy1:=dummy1<<ldev>> +1<<sp>> + 5<<"LDEV">>;              01446000
            move bprint'line(dummy1):="has bad DFSM";                   01448000
            fwrite(fn,print'line,print'len,%40);                        01450000
            IF <> THEN err'pfre(write'error);                           01452000
            print'stars;                                                01454000
            GO TO next'vol;                                             01456000
         END;                                                           01458000
                                                                        01460000
        << initialize values for "Scan'Page" >>                         01462000
      @ds'page'ptr:=Get'Page(lpage);                                    01464000
      IF not(ds'error'status) THEN err'pfre(ds'error'status);           01466000
      ds'word'number:=0;                                                01468000
      ds'bit'number:=0;                                                 01470000
      lsectcnt:=0D;                                                     01472000
      ldone:=false;                                                     01474000
                                                                        01476000
           << now loop on pages for this ldev                           01478000
              lsectcnt is the local number of                           01480000
              sectors. Have to have this because                        01482000
              "scan'page" doesnt handle disc space                      01484000
              which spans page boundaries.                              01486000
              lsectcnt is what "put'into'array" puts                    01488000
              into bucket                             >>                01490000
                                                                        01492000
      << while scanning pages have to worry about encountering          01494000
         bad pages, if space really does span pages...                  01496000
      >>                                                                01498000
                                                                        01500000
      DO BEGIN                                                          01502000
         lpg'end:=Scan'Page;                                            01504000
         IF lsectcnt = 0D AND ds'bit'count = 0 THEN                     01506000
            GO TO next'ent;    << didnt find anything >>                01508000
         IF lpg'end THEN       << at end of a page    >>                01510000
            BEGIN                                                       01512000
               IF lpage = ds'last'page'of'map  << last pg     >>        01514000
                  THEN BEGIN                                            01516000
                     <<  last pg, last entry  >>                        01518000
                     lsectcnt:=lsectcnt + DBL(ds'bit'count);            01520000
                     put'into'array;                                    01522000
                  END                                                   01524000
               ELSE             << not last pg >>                       01526000
                  BEGIN                                                 01528000
                     IF ds'bit'count = 0 THEN                           01530000
                        BEGIN                                           01532000
                           << space from prev pg >>                     01534000
                           put'into'array;                              01536000
                        END                                             01538000
                     ELSE    << maybe more contg sp on next pg >>       01540000
                        lsectcnt:=lsectcnt + DBL(ds'bit'count);         01542000
               END;           << lpage = ds'last'page'of'map >>         01544000
            END               << lpg'end = true      >>                 01546000
         ELSE                                                           01548000
            BEGIN             << space somewhere in middle of pg >>     01550000
               IF lsectcnt = 0D THEN                                    01552000
                  BEGIN                                                 01554000
                     << found space in middle >>                        01556000
                     lsectcnt:=DBL(ds'bit'count);                       01558000
                     put'into'array;                                    01560000
                  END                                                   01562000
               ELSE            << lsectcnt <> 0 >>                      01564000
                  BEGIN                                                 01566000
                     IF ds'starting'word'number = 0 AND                 01568000
                        ds'starting'bit'number  = 0                     01570000
                        THEN BEGIN                                      01572000
                           << sp on prev pg and at front current >>     01574000
                           << but havent hit the end of the page >>     01576000
                           lsectcnt:=lsectcnt + DBL(ds'bit'count);      01578000
                           put'into'array;                              01580000
                        END                                             01582000
                     ELSE                                               01584000
                        BEGIN                                           01586000
                           << had sp on prev pg, none in front >>       01588000
                           << but found some somewhere in pg   >>       01590000
                           put'into'array;                              01592000
                           lsectcnt:=DBL(ds'bit'count);                 01594000
                           put'into'array;                              01596000
                     END;      << ds'starting'word... >>                01598000
               END;            << lsectcnt = AND <> 0 >>                01600000
            END;               << lpg'end  T AND F    >>                01602000
next'ent:                                                               01604000
                << didnt find anything from "Scan'Page" >>              01606000
                                                                        01608000
         << see if have to swap pages; find the next good page          01610000
            if the next page is marked as bad in the Descriptor         01612000
            table, then any space that is in lsectcnt must be           01614000
            put into space'info since there will be no contiguous       01616000
            space across pages                                          01618000
         >>                                                             01620000
         IF lpg'end THEN                                                01622000
            BEGIN                                                       01624000
               IF lpage = ds'last'page'of'map THEN ldone:=true          01626000
               ELSE                                                     01628000
                  BEGIN                                                 01630000
                     ldone:=false;   << more pages to go >>             01632000
                     lpage:=lpage+1;                                    01634000
                     cantfind:=true;                                    01636000
                     DO BEGIN  << find pg w good Descr entry >>         01638000
                        IF flagged'bad THEN                             01640000
                           BEGIN                                        01642000
                              IF lsectcnt <> 0D THEN put'into'array;    01644000
                              lpage:=lpage+1;                           01646000
                              bad'page'count :=                <<01239>>01648000
                                       bad'page'count + 1;     <<01239>>01650000
                           END                                          01652000
                        ELSE                                            01654000
                           BEGIN                                        01656000
                              @ds'page'ptr:=get'page(lpage);            01658000
                              IF ds'error'status THEN  << good status >>01660000
                                 BEGIN                                  01662000
                                    cantfind:=false;                    01664000
                                    ds'word'number:=0; << init  >>      01666000
                                    ds'bit'number:=0;                   01668000
                                 END                                    01670000
                              ELSE   lpage:=lpage+1;                    01672000
                        END;    << flagged'bad  T F >>                  01674000
                     END UNTIL lpage > ds'last'page'of'map              01676000
                            OR NOT(cantfind);                           01678000
                     IF lpage > ds'last'page'of'map THEN ldone:=true;   01680000
                  END;    << lpage = <> last page >>                    01682000
               END;       << lpg'end  T           >>                    01684000
                                                                        01686000
      END UNTIL ldone;         << done with this disc >>                01688000
                                                                        01690000
      Unlock'Dfs'Data'Seg;                                              01692000
      ldfs'locked:=false;  << not locked and no SPLIT stack >>          01694000
                                                                        01696000
             <<===============================                          01698000
               NOT in split stack mode anymore                          01700000
               ===============================>>                        01702000
                                                                        01706000
      create'the'print'out;                                             01708000
                                                                        01710000
next'vol:                                                               01712000
                        << look at next vol entry in vol tbl >>         01714000
      rel'mvtab;                                               <<01239>>01716000
      vol'index:=vol'index + vol'ent'sz;  << offset into vol tbl >>     01720000
                                                                        01722000
   END UNTIL ldev'found<< only 1 dev>>  OR                              01724000
             (num'vol'cntr:=num'vol'cntr + 1) = num'vol'ent;            01726000
                                                                        01728000
           << now print out the system total  >>                        01730000
                                                                        01732000
   IF all THEN << print total because printing for all discs >>         01734000
      BEGIN                                                             01736000
         blank'print;                                                   01738000
         move bprint'line:="SYSTEM TOTAL FREE SPACE=";                  01740000
         dummy1:=dascii(tot'sys'space,10,bprint'line(24));              01742000
         fwrite(fn,print'line,print'len,%40);                           01744000
         IF <> THEN err'pfre(write'error);                              01746000
      END                                                               01748000
   ELSE                                                                 01750000
      BEGIN                                                             01752000
         IF NOT ldev'found  << only 1 dev, didnt find it >>             01754000
            THEN BEGIN                                                  01756000
               blank'print;                                             01758000
               MOVE bprint'line:="LDEV ";                               01760000
               dummy1:=ascii(which'ldev,10,bprint'line(5));             01762000
               dummy1:=dummy1<<ldev>> + 5<<"LDEV">> + 1<<sp>>;          01764000
               MOVE bprint'line(dummy1):=                               01766000
                  "not mounted or has no DFSM";                         01768000
               fwrite(fn,print'line,print'len,%40);                     01770000
               IF <> THEN err'pfre(write'error);                        01772000
            END;                                                        01774000
     END;        << all  NOT ldev'found >>                              01776000
                                                                        01778000
END;  << pfre >>                                                        01780000
<<==============================================================        01782000
                                                                        01784000
                       End of INCLFREE - B1                             01786000
                                                                        01788000
==============================================================>>        01790000
