         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
$PAGE "CBT'STACK: Isolate Control Block Table"                          28000000
$CONTROL SEGMENT=INIT                                          <<03078>>28002000
$CONTROL WARN                                                  <<03078>>28004000
                                                               <<03078>>28006000
PROCEDURE CBT'STACK(STACKADDR,BLOCKADDR,VECTINDX);             <<03078>>28008000
DOUBLE  STACKADDR,                                             <<03078>>28010000
        BLOCKADDR;                                             <<03078>>28012000
INTEGER VECTINDX;                                              <<03078>>28014000
                                                               <<03078>>28016000
COMMENT                                                                 28018000
                                                                        28020000
Purpose:                                                                28022000
         If it was determined that the file control block was           28024000
         in the pxfile area of the stack this procedure is call         28026000
         to find the base address of the block in the control           28028000
         block area which the vector addresses.                         28030000
                                                                        28032000
                                                                        28034000
Input parameters:                                                       28036000
                                                                        28038000
Output parameters:                                                      28040000
                                                                        28042000
Globals Referenced:                                                     28044000
                                                                        28046000
Globals Altered:                                                        28048000
                                                                        28050000
Data Structures:                                                        28052000
                                                                        28054000
Algorithm:                                                              28056000
                                                                        28058000
;                                                                       28060000
BEGIN                                                          <<03078>>28062000
  DOUBLE CBTADDR,                                              <<03078>>28064000
         VECTADDR;                                             <<03078>>28066000
                                                               <<03078>>28068000
  CBTADDR:=STACKADDR + 12D+ DOUBLE(CORE(STACKADDR+12D)) + %22D;<< MCW >>28070000
  VECTADDR:=CBTADDR + 8D + DOUBLE(VECTINDX * 8);               << MCW >>28072000
  BLOCKADDR:=DOUBLE(CORE(VECTADDR)) + CBTADDR;                 <<03078>>28074000
END;                                                           <<03078>>28076000
$PAGE "SEARCH'PACB : Search for the FCB vector"                         28078000
$CONTROL SEGMENT=INIT                                                   28080000
PROCEDURE SEARCH'PACB(DSTNO,PACBADDR);                         <<03078>>28082000
LOGICAL DSTNO;                                                 <<03078>>28084000
DOUBLE  PACBADDR;                                              <<03078>>28086000
                                                               <<03078>>28088000
COMMENT                                                                 28090000
                                                                        28092000
Purpose:                                                                28094000
         When a pacb is found this procedure sets the array to          28096000
         record this and then the fcb vector in the pacb is             28098000
         found and if a fcb is present its array position is            28100000
         set if it has not already been done.                           28102000
                                                                        28104000
Input parameters:                                                       28106000
                                                                        28108000
Output parameters:                                                      28110000
                                                                        28112000
Globals Referenced:                                                     28114000
                                                                        28116000
Globals Altered:                                                        28118000
                                                                        28120000
Data Structures:                                                        28122000
                                                                        28124000
Algorithm:                                                              28126000
                                                                        28128000
;                                                                       28130000
BEGIN                                                          <<03078>>28132000
  IF DSTNO<4096 AND DSTNO>0 THEN                               << MCW >>28134000
                                                               <<03078>>28136000
  IF DST'TYPE(DSTNO) = 0 THEN                                  <<03078>>28138000
     DST'TYPE(DSTNO):= 5;                                      <<03078>>28140000
  DSTNO:=(CORE(PACBADDR + %32D));                              << MCW >>28142000
  IF DSTNO<4095 AND DSTNO>0 THEN                               << MCW >>28144000
  IF DST'TYPE(DSTNO) = 0 THEN                                  <<03078>>28146000
     DST'TYPE(DSTNO):= 3;                                      <<03078>>28148000
                                                               <<03078>>28150000
END;                                                           <<03078>>28152000
$PAGE "CBT'EXDS : Isolate Control Block in Extra Data Segment"          28154000
$CONTROL SEGMENT=INIT                                                   28156000
PROCEDURE CBT'EXDS(BLOCKADDR,VECTINDX,DSTNO);                  <<03078>>28158000
DOUBLE  BLOCKADDR;                                             <<03078>>28160000
INTEGER VECTINDX;                                              <<03078>>28162000
LOGICAL DSTNO;                                                 <<03078>>28164000
COMMENT                                                                 28166000
                                                                        28168000
Purpose:                                                                28170000
         If it was determined that the file control block               28172000
         was not in the pxfile area but rather in another data          28174000
         segment this procedure is called.  It first finds the          28176000
         base of this data segment and then calculates the base         28178000
         of the control block for the file needed. If the data          28180000
         segment is absent the procedure will return a base             28182000
         address of zero indicating this case.                          28184000
                                                                        28186000
                                                                        28188000
Input parameters:                                                       28190000
                                                                        28192000
Output parameters:                                                      28194000
                                                                        28196000
Globals Referenced:                                                     28198000
                                                                        28200000
Globals Altered:                                                        28202000
                                                                        28204000
Data Structures:                                                        28206000
                                                                        28208000
Algorithm:                                                              28210000
                                                                        28212000
;                                                                       28214000
BEGIN                                                          <<03078>>28216000
  DOUBLE DSTENTRY,                                             <<03078>>28218000
         CBTADDR,                                              <<03078>>28220000
         VECTADDR;                                             <<03078>>28222000
                                                               <<03078>>28224000
  DSTENTRY:=DOUBLE(DSTNO * 4) + DSTDEFIN;                      <<03078>>28226000
  IF CORE(DSTENTRY).(0:1) = 0 AND                              <<03078>>28228000
     CORE(DSTENTRY + 1D).(3:1) <> 1                            <<03078>>28230000
     OR CORE(DSTENTRY+1D).(1:1) =1 THEN                        <<03078>>28232000
     BEGIN                                                     <<03078>>28234000
     TOS:= CORE(DSTENTRY + 2D);                                <<03078>>28236000
     TOS:= CORE(DSTENTRY + 3D);                                <<03078>>28238000
     CBTADDR:=TOS;                                             <<03078>>28240000
     VECTADDR:=CBTADDR + 8D + DOUBLE(VECTINDX * 8);            << MCW >>28242000
     BLOCKADDR:=DOUBLE(CORE(VECTADDR)) + CBTADDR;              <<03078>>28244000
     END                                                       <<03078>>28246000
  ELSE                                                         <<03078>>28248000
     BLOCKADDR:= 0D;                                           <<03078>>28250000
END;                                                           <<03078>>28252000
$PAGE "FORMATFCB : Format the File Control Block"                       28254000
$CONTROL SEGMENT=MEMORY                                                 28256000
PROCEDURE FORMATFCB(DSTNO);                                    <<03077>>28258000
VALUE DSTNO;                                                   <<03077>>28260000
LOGICAL DSTNO;                                                 <<03077>>28262000
COMMENT                                                                 28264000
                                                                        28266000
Purpose:                                                                28268000
     This procedure will produce a human readable listing of            28270000
     a file control block.                                              28272000
                                                                        28274000
Input parameters:                                                       28276000
     DSTNO is the data segment number of the stack containing           28278000
     the file control block to be formatted.                            28280000
                                                                        28282000
Output parameters:                                                      28284000
     <none>                                                             28286000
                                                                        28288000
Globals Referenced:                                                     28290000
     <none>                                                             28292000
                                                                        28294000
Globals Altered:                                                        28296000
     BBUF is the buffer for the listing out routines.                   28298000
                                                                        28300000
Data Structures:                                                        28302000
     List of tables accessed as well as descriptions of tables          28304000
     used internally.                                                   28306000
                                                                        28308000
Algorithm:                                                              28310000
     The overhead area, vector table, and control block area            28312000
     of the file control block are formatted in sequence.               28314000
     Some componant parts are symbolically identified.                  28316000
                                                                        28318000
;                                                                       28320000
                                                               <<03077>>28322000
BEGIN                                                          <<03077>>28324000
  INTEGER VECTSIZE,                                            <<03077>>28326000
          COUNT,                                               <<03077>>28328000
          INDX,                                                <<03077>>28330000
          I;                                                   <<03077>>28332000
  LOGICAL GOODFLAG;                                            <<03077>>28334000
  DOUBLE  DSTADDR,                                             <<03077>>28336000
          CONTROLBLOCKBASE,                                    <<03077>>28338000
          VECTORADDR,                                          <<03077>>28340000
          ENDOFTABLE;                                          <<03077>>28342000
  LOGICAL ARRAY OFFSET(*)=VECTORADDR;                          <<03077>>28344000
  LOGICAL ARRAY VECTOR(0:7);                                   << MCW >>28346000
                                                               <<03077>>28348000
  DSTADDR:=DSTTOADDR(DSTNO);                                   <<03077>>28350000
  MOVE BBUF:="********** OVERHEAD AREA **********";            <<03077>>28352000
  PRINTLINE;                                                   <<03077>>28354000
  OCTALDUMP(DSTADDR,DSTADDR + 7D);                             << MCW >>28356000
  COUNT:=0;                  <<ENTRY COUNTER>>                 <<03077>>28358000
  INDX:=0;                   <<FOR COUNTING WORDS>>            <<03077>>28360000
  MOVE BBUF:="********** VECTOR TABLE:";                       <<03077>>28362000
  MOVE BBUF(65):="ENTRY  ADDR  LK  BK";                        << MCW >>28364000
  MOVE BBUF(86):="LOCK COUNT/PIN  HPHEAD";                     << MCW >>28366000
  MOVE BBUF(110):="HPTAIL  LPHEAD  LPTAIL";                    << MCW >>28368000
  PRINTLINE;                 <<PRINT HEADER>>                  <<03077>>28370000
  VECTORADDR:=DSTADDR + 8D;                                    << MCW >>28372000
  VECTSIZE:=INTEGER(CORE(DSTADDR + 2D).(2:14));                <<*9111>>28374000
  DO                                                           <<03077>>28376000
  BEGIN                      <<FOR ALL OF TABLE>>              <<03077>>28378000
    I:=0;                                                      <<03077>>28380000
    GOODFLAG:=FALSE;         <<NO ENTRY YET>>                  <<03077>>28382000
    DO                                                         <<03077>>28384000
    BEGIN                    <<LOAD AND CHECK FOR ENTRY>>      <<03077>>28386000
      VECTOR(I):=CORE(VECTORADDR + DOUBLE(I));                 <<03077>>28388000
      IF VECTOR(I) <> 0 THEN GOODFLAG:=TRUE;                   <<03077>>28390000
      END                                                      <<03077>>28392000
      UNTIL (I:=I+1) = 8;   <<LOAD ALL OF ENTRY>>              << MCW >>28394000
    IF GOODFLAG THEN        <<IF ENTRY EXISTS>>                <<03077>>28396000
       BEGIN                                                   <<03077>>28398000
       @PBUF:=@BBUF;                                           <<03077>>28400000
       PUTNUM(OFFSET(1));   <<PRINT OFFSET>>                   <<03077>>28402000
       PBUF(-1):=":";  @PBUF:=@PBUF+1;                         <<03077>>28404000
       I:=0;                <<INIT SCAN>>                      <<03077>>28406000
       DO PUTNUM(VECTOR(I)) UNTIL (I:=I+1) = 8;                << MCW >>28408000
       @PBUF:=@BBUF+62;                                        << MCW >>28410000
       PUTNUMP(COUNT*8+8);      <<ENTRY NUMBER>>               << MCW >>28412000
       @PBUF:=@BBUF+70;                                        << MCW >>28414000
       PUTNUMP(VECTOR(0));  <<DST OFFSET>>                     <<03077>>28416000
       IF VECTOR(1).(0:1)=1 THEN MOVE BBUF(78):="LK";          << MCW >>28418000
       IF VECTOR(1).(1:1)=1 THEN MOVE BBUF(82):="BK";          << MCW >>28420000
       @PBUF:=@BBUF+88;                                        << MCW >>28422000
       PUTNUMP(VECTOR(1).(2:6));   <<LOCK COUNT>>              <<03077>>28424000
       @PBUF:=@BBUF+94;                                        << MCW >>28426000
       PUTNUMP(VECTOR(2)/21);   <<LOCK PIN>>                   << MCW >>28428000
                                                               << MCW >>28430000
                                                               << MCW >>28432000
          @PBUF:=@BBUF+101;                                    << MCW >>28434000
          PUTNUMP(VECTOR(3)/21); << HIPRI HEAD >>              << MCW >>28436000
          @PBUF:=@BBUF+109;                                    << MCW >>28438000
          PUTNUMP(VECTOR(2)/21);<<HIPRI TAIL>>                 << MCW >>28440000
                                                               << MCW >>28442000
                                                               << MCW >>28444000
                                                               << MCW >>28446000
          @PBUF:=@BBUF+117;                                    << MCW >>28448000
          PUTNUMP(VECTOR(5)/21);<<LOPRI HEAD>>                 << MCW >>28450000
          @PBUF:=@BBUF+125;                                    << MCW >>28452000
          PUTNUMP(VECTOR(6)/21);<<LOPRI TAIL>>                 << MCW >>28454000
                                                               << MCW >>28456000
       PRINTLINE;                                              <<03077>>28458000
       END;                                                    <<03077>>28460000
    COUNT:=COUNT+1;          <<NEXT ENTRY>>                    <<03077>>28462000
    VECTORADDR:=VECTORADDR + 8D;                               << MCW >>28464000
    END                                                        <<03077>>28466000
    UNTIL (INDX:=INDX+8) >= VECTSIZE;  <<TILL DONE>>           << MCW >>28468000
  MOVE BBUF:="********** CONTROL BLOCK AREA **********";       <<03077>>28470000
  PRINTLINE;                                                   <<03077>>28472000
  CONTROLBLOCKBASE:=DSTADDR+8D+DOUBLE(VECTSIZE);               << MCW >>28474000
  ENDOFTABLE:=DSTADDR + DOUBLE(CORE(DSTADDR)) - 1D;            <<03077>>28476000
  CHARFLAG:=TRUE;                                              <<03077>>28478000
  OCTALDUMP(CONTROLBLOCKBASE,ENDOFTABLE);                      <<03077>>28480000
  CHARFLAG:=FALSE;                                             <<03077>>28482000
END;                                                           <<03077>>28484000
                                                                        28486000
$PAGE "List'dfs'data'seg'info : List Disc Free Space info"              28488000
$CONTROL SEGMENT=TABLESDA                                               28490000
PROCEDURE List'Dfs'Data'Seg'Info (ldev, dfs'dst, error'status);<<03556>>28492000
   VALUE ldev, dfs'dst, error'status;                          <<03556>>28494000
   INTEGER ldev, dfs'dst;                                      <<03556>>28496000
   LOGICAL error'status;                                       <<03556>>28498000
COMMENT                                                                 28500000
                                                                        28502000
Purpose:                                                                28504000
   This procedure, passed the ldev number of a disc and                 28506000
   the disc free space management DST number and error                  28508000
   status from the LDTX entry for that ldev, will format                28510000
   the information, plus print the address of the DST, if               28512000
   it is present.                                                       28514000
                                                                        28516000
Input parameters:                                                       28518000
                                                                        28520000
Output parameters:                                                      28522000
                                                                        28524000
Globals Referenced:                                                     28526000
                                                                        28528000
Globals Altered:                                                        28530000
                                                                        28532000
Data Structures:                                                        28534000
                                                                        28536000
Algorithm:                                                              28538000
                                                                        28540000
;                                                                       28542000
BEGIN                                                          <<03556>>28544000
                                                               <<03556>>28546000
   ARRAY dfs'dst'entry (0:3);                                  <<03556>>28548000
                                                               <<03556>>28550000
$INCLUDE INCLDFS2                                              <<03556>>28552000
                                                               <<03556>>28554000
   << - - - - - - - - - - >>                                   <<03556>>28556000
                                                               <<03556>>28558000
   << Get DST entry for the data segment >>                    <<03556>>28560000
                                                               <<03556>>28562000
   Get'Dst'Entry (dfs'dst, dfs'dst'entry);                     <<03556>>28564000
                                                               <<03556>>28566000
   << List ldev and DST # >>                                   <<03556>>28568000
                                                               <<03556>>28570000
   Putnz (ldev, 5);                                            <<03556>>28572000
   Putnz (dfs'dst, 11);                                        <<03556>>28574000
                                                               <<03556>>28576000
   << If DST is present, list bank & address, otherwise say >> <<03556>>28578000
   << that it is absent                                     >> <<03556>>28580000
                                                               <<03556>>28582000
   IF dfs'dst'entry (0).(0:1) THEN                             <<03556>>28584000
      MOVE bbuf (16) := "Absent"                               <<03556>>28586000
   ELSE                                                        <<03556>>28588000
      BEGIN  << List bank & address >>                         <<03556>>28590000
                                                               <<03556>>28592000
         Putnz (dfs'dst'entry (2), 18);                        <<03556>>28594000
         bbuf (19) := "/";                                     <<03556>>28596000
         Putoctal (dfs'dst'entry (3), 27);                     <<03556>>28598000
                                                               <<03556>>28600000
      END;   << List bank & address >>                         <<03556>>28602000
                                                               <<03556>>28604000
   << List error status and print some info >>                 <<03556>>28606000
                                                               <<03556>>28608000
   Putoctal (error'status, 36);                                <<03556>>28610000
   IF error'status.error'type = no'error THEN                  <<03556>>28612000
      MOVE pbuf := "  No fatal errors"                         <<03556>>28614000
   ELSE                                                        <<03556>>28616000
      BEGIN  << Allocation was disabled >>                     <<03556>>28618000
                                                               <<03556>>28620000
         MOVE pbuf := ("  Allocation is disabled - error ",    <<03556>>28622000
                       "type "), 2;                            <<03556>>28624000
         @pbuf := TOS;                                         <<03556>>28626000
         Putnump (error'status.error'type);                    <<03556>>28628000
         IF error'status.attach'io'status <> 0 THEN            <<03556>>28630000
            BEGIN  << Attachio status set >>                   <<03556>>28632000
                                                               <<03556>>28634000
               MOVE pbuf := ", I/O status ", 2;                <<03556>>28636000
               @pbuf := TOS;                                   <<03556>>28638000
               Putnump (error'status.attach'io'status);        <<03556>>28640000
                                                               <<03556>>28642000
            END;   << Attachio status set >>                   <<03556>>28644000
                                                               <<03556>>28646000
      END;   << Allocation was disabled >>                     <<03556>>28648000
                                                               <<03556>>28650000
   Printline;                                                  <<03556>>28652000
                                                               <<03556>>28654000
END;  << List'Dfs'Data'Seg'Info >>                             <<03556>>28656000
                                                                        28658000
$PAGE "Print'DFS'Data'Seg'info : Format Disk Free Space info"           28660000
$CONTROL SEGMENT=TABLESDA                                               28662000
PROCEDURE Print'Dfs'Data'Seg'List;                             <<03556>>28664000
COMMENT                                                                 28666000
                                                                        28668000
Purpose:                                                                28670000
   This procedure formats the information about the disc                28672000
   free space management data segments that is in the LDTX,             28674000
   if the LDTX is present in memory.                                    28676000
                                                                        28678000
Input parameters:                                                       28680000
                                                                        28682000
Output parameters:                                                      28684000
                                                                        28686000
Globals Referenced:                                                     28688000
                                                                        28690000
Globals Altered:                                                        28692000
                                                                        28694000
Data Structures:                                                        28696000
                                                                        28698000
Algorithm:                                                              28700000
                                                                        28702000
;                                                                       28704000
BEGIN                                                          <<03556>>28706000
                                                               <<03556>>28708000
   EQUATE ldt'dst = 14;                                        <<03556>>28710000
   EQUATE ldt'entry'size = 7;                                  << MCW >>28712000
   EQUATE ldtx'entry'size = 5;                                 << MCW >>28714000
                                                               <<03556>>28716000
   ARRAY ldt'dst'entry (0:3);  << DST entry for #14 (LDT) >>   <<03556>>28718000
   DOUBLE ldt'address;                                         <<03556>>28720000
   INTEGER ldt'segment'length;                                 <<03556>>28722000
   INTEGER highest'ldev'number;                                <<03556>>28724000
   INTEGER ldtx'offset;                                        <<03556>>28726000
   ARRAY ldt'entry (0:ldt'entry'size-1);                       <<03556>>28728000
   ARRAY ldtx'entry (0:ldt'entry'size-1);                      <<03556>>28730000
                                                               <<03556>>28732000
   INTEGER ldev;                                               <<03556>>28734000
   INTEGER i;   << for use by subroutines ONLY >>              <<03556>>28736000
                                                               <<03556>>28738000
   << - - - - - - - - - - >>                                   <<03556>>28740000
                                                               <<03556>>28742000
   SUBROUTINE Get'Ldt'Entry (ldev'num, ldev'entry);            <<03556>>28744000
      VALUE ldev'num;                                          <<03556>>28746000
      INTEGER ldev'num;                                        <<03556>>28748000
      ARRAY ldev'entry;                                        <<03556>>28750000
                                                               <<03556>>28752000
   <<                                                       >> <<03556>>28754000
   << Returns the contents of the LDT entry for ldev'num in >> <<03556>>28756000
   << ldev'entry.  Ldt'address must be initialized.         >> <<03556>>28758000
   <<                                                       >> <<03556>>28760000
                                                               <<03556>>28762000
   BEGIN                                                       <<03556>>28764000
                                                               <<03556>>28766000
      i := 0;                                                  <<03556>>28768000
      WHILE i < ldt'entry'size DO                              <<03556>>28770000
         BEGIN  << Get entry >>                                <<03556>>28772000
                                                               <<03556>>28774000
            ldev'entry (i) := Core (ldt'address +              <<03556>>28776000
                      DOUBLE((ldev'num * ldt'entry'size) + i));<<03556>>28778000
            i := i + 1;                                        <<03556>>28780000
                                                               <<03556>>28782000
         END;   << Get entry >>                                <<03556>>28784000
                                                               <<03556>>28786000
   END;  << Get'Ldt'Entry >>                                   <<03556>>28788000
                                                               <<03556>>28790000
   << - - - - - - - - - - >>                                   <<03556>>28792000
                                                               <<03556>>28794000
   SUBROUTINE Get'Ldtx'Entry (ldev'num, ldev'entry);           <<03556>>28796000
      VALUE ldev'num;                                          <<03556>>28798000
      INTEGER ldev'num;                                        <<03556>>28800000
      ARRAY ldev'entry;                                        <<03556>>28802000
                                                               <<03556>>28804000
   <<                                                        >><<03556>>28806000
   << Returns the contents of the LDTX entry for ldev'num in >><<03556>>28808000
   << ldev'entry.  Ldt'address and ldtx'offset must be       >><<03556>>28810000
   << initialized.                                           >><<03556>>28812000
   <<                                                          <<03556>>28814000
                                                               <<03556>>28816000
   BEGIN                                                       <<03556>>28818000
                                                               <<03556>>28820000
      i := 0;                                                  <<03556>>28822000
      WHILE i < ldt'entry'size DO                              <<03556>>28824000
         BEGIN  << Get the entry >>                            <<03556>>28826000
                                                               <<03556>>28828000
            ldev'entry (i) := Core (ldt'address +              <<03556>>28830000
                           DOUBLE (ldtx'offset +               <<03556>>28832000
                           (ldev'num * ldtx'entry'size) + i)); << MCW >>28834000
            i := i + 1;                                        <<03556>>28836000
                                                               <<03556>>28838000
         END;   << Get the entry >>                            <<03556>>28840000
                                                               <<03556>>28842000
   END;  << Get'Ldtx'Entry >>                                  <<03556>>28844000
                                                               <<03556>>28846000
   << - - - - - - - - - >>                                     <<03556>>28848000
                                                               <<03556>>28850000
   Newpage;                                                    <<03556>>28852000
   indxaray ((lstsysdst + 2) * 2) := pageno;                   <<03556>>28854000
   MOVE bbuf (15) := "= = = = Disc Free Space Management ",2;  <<03556>>28856000
   MOVE * := "Data Segments (all numbers are octal)",2;        <<03556>>28858000
   MOVE * := " = = = =";                                       <<03556>>28860000
   Printline;                                                  <<03556>>28862000
   Printline;                                                  <<03556>>28864000
                                                               <<03556>>28866000
   << We need to run through the LDT & LDTX to find all >>     <<03556>>28868000
   << discs have disc free space maps.                  >>     <<03556>>28870000
                                                               <<03556>>28872000
   << Get LDT DST entry >>                                     <<03556>>28874000
                                                               <<03556>>28876000
   Get'Dst'Entry (ldt'dst, ldt'dst'entry);                     <<03556>>28878000
                                                               <<03556>>28880000
   IF ldt'dst'entry (0).(0:1) THEN                             <<03556>>28882000
      BEGIN  << LDT not present >>                             <<03556>>28884000
                                                               <<03556>>28886000
         Printline;                                            <<03556>>28888000
         Printline;                                            <<03556>>28890000
         MOVE bbuf := (" Can not list Disc Free Space",        <<03556>>28892000
                       " management data segments ",           <<03556>>28894000
                       "because the ");                        <<03556>>28896000
         Printline;                                            <<03556>>28898000
         MOVE bbuf := ("Logical Device Table (LDT - DST %16)", <<03556>>28900000
                       " is absent from main memory ");        <<03556>>28902000
         Printline;                                            <<03556>>28904000
         Printline;                                            <<03556>>28906000
         Return;                                               <<03556>>28908000
                                                               <<03556>>28910000
      END;    << LDT not present >>                            <<03556>>28912000
                                                               <<03556>>28914000
   << Get address of the LDT data segment >>                   <<03556>>28916000
                                                               <<03556>>28918000
   TOS := ldt'dst'entry (2);                                   <<03556>>28920000
   TOS := ldt'dst'entry (3);                                   <<03556>>28922000
   ldt'address := TOS;                                         <<03556>>28924000
   ldt'segment'length := ldt'dst'entry (0).(3:13) * 4;         <<03556>>28926000
                                                               <<03556>>28928000
   << Get LDT/LDTX header info >>                              <<03556>>28930000
                                                               <<03556>>28932000
   Get'Ldt'Entry (0, ldt'entry);                               <<03556>>28934000
                                                               <<03556>>28936000
   highest'ldev'number := ldt'entry (0);                       << MCW >>28938000
   ldtx'offset := (ldt'entry(0) + 1) * ldt'entry'size;         << MCW >>28940000
                                                               <<03556>>28942000
   << Test if the info we got out of the header seems good >>  <<03556>>28944000
                                                               <<03556>>28946000
   IF (ldtx'offset + (highest'ldev'number *                    <<03556>>28948000
   ldtx'entry'size - 1)) > ldt'segment'length THEN             << MCW >>28950000
      BEGIN  << LDT header looks bad >>                        <<03556>>28952000
                                                               <<03556>>28954000
         Printline;                                            <<03556>>28956000
         Printline;                                            <<03556>>28958000
         MOVE bbuf := (" * * * * * * The LDT header appears",  <<03556>>28960000
                       " to have invalid data, can not list ", <<03556>>28962000
                       "Disc Free Space management data ",     <<03556>>28964000
                       "segments * * * * * *");                <<03556>>28966000
         Printline;                                            <<03556>>28968000
         Printline;                                            <<03556>>28970000
         RETURN;                                               <<03556>>28972000
                                                               <<03556>>28974000
      END;   << LDT header looks bad >>                        <<03556>>28976000
                                                               <<03556>>28978000
   << Print the list header >>                                 <<03556>>28980000
                                                               <<03556>>28982000
   MOVE bbuf (2) := "Ldev";                                    <<03556>>28984000
   MOVE bbuf (8) := "DST #";                                   <<03556>>28986000
   MOVE bbuf (15) := "Bank/Address";                           <<03556>>28988000
   MOVE bbuf (29) := "Error status";                           <<03556>>28990000
   Printline;                                                  <<03556>>28992000
                                                               <<03556>>28994000
   MOVE bbuf (2) := "----";                                    <<03556>>28996000
   MOVE bbuf (8) := "-----";                                   <<03556>>28998000
   MOVE bbuf (15) := "------------";                           <<03556>>29000000
   MOVE bbuf (29) := "------------";                           <<03556>>29002000
   Printline;                                                  <<03556>>29004000
   Printline;                                                  <<03556>>29006000
                                                               <<03556>>29008000
   << Run through LDT & LDTX and find all discs that have >>   <<03556>>29010000
   << the ldtx'dfs'dst'word or ldtx'dfs'error'word non-   >>   <<03556>>29012000
   << zero print out info about it.                       >>   <<03556>>29014000
                                                               <<03556>>29016000
   FOR ldev := 1 UNTIL highest'ldev'number DO                  <<03556>>29018000
      BEGIN  << Look for discs with a free space map >>        <<03556>>29020000
                                                               <<03556>>29022000
         Get'Ldt'Entry (ldev, ldt'entry);                      <<03556>>29024000
                                                               <<03556>>29026000
         << Check if its a disc (type < 8) >>                  <<03556>>29028000
                                                               <<03556>>29030000
         IF ldt'entry (2).(10:6) < 8 AND                       <<03556>>29032000
            ldt'entry (2) <> 0 THEN                            <<03556>>29034000
            BEGIN  << Its a disc >>                            <<03556>>29036000
                                                               <<03556>>29038000
               Get'Ldtx'Entry (ldev, ldtx'entry);              <<03556>>29040000
                                                               <<03556>>29042000
               IF ldtx'entry (2) <> 0 OR                       <<03556>>29044000
               ldtx'entry (3) <> 0 THEN                        <<03556>>29046000
                  BEGIN  << Some DFS info in LDTX >>           <<03556>>29048000
                                                               <<03556>>29050000
                     List'Dfs'Data'Seg'Info (ldev,             <<03556>>29052000
                             ldtx'entry (2), ldtx'entry (3));  <<03556>>29054000
                                                               <<03556>>29056000
                  END;   << Some DFS info in LDTX >>           <<03556>>29058000
                                                               <<03556>>29060000
            END;   << Its a disc >>                            <<03556>>29062000
                                                               <<03556>>29064000
      END;   << Look for discs with a free space map >>        <<03556>>29066000
                                                               <<03556>>29068000
END;   << Print'Dfs'Data'Seg'List >>                           <<03556>>29070000
                                                                        29072000
$PAGE "PRINTPXFILE : Format the PXFILE area"                            29074000
$CONTROL SEGMENT=MEMORY                                                 29076000
PROCEDURE PRINTPXFILE(DSTNUM,PXFADDR);                         <<00221>>29078000
   VALUE DSTNUM,PXFADDR;                                       <<00221>>29080000
   LOGICAL DSTNUM;            <<DST NUMBER OF DST FORMATTED>>  <<00221>>29082000
   DOUBLE PXFADDR;            <<ADDRESS IN CORE OF PXFILE>>    <<00221>>29084000
COMMENT                                                                 29086000
                                                                        29088000
Purpose:                                                                29090000
       This procedure will verify the construction of the               29092000
       pxfile area of the pcbx and print the pxfile area                29094000
       formatting the vector table, control block area, and             29096000
       aft.  If anything is not correct, an octal dump of               29098000
       pxfile area is produced.                                         29100000
                                                                        29102000
Input parameters:                                                       29104000
                                                                        29106000
Output parameters:                                                      29108000
                                                                        29110000
Globals Referenced:                                                     29112000
                                                                        29114000
Globals Altered:                                                        29116000
                                                                        29118000
Data Structures:                                                        29120000
                                                                        29122000
Algorithm:                                                              29124000
                                                                        29126000
;                                                                       29128000
 BEGIN             <<BEGIN PROCEDURE PXFILEPRINT>>             <<00221>>29130000
   LOGICAL ARRAY WORK(0:7);       <<FOR CONTAINING ENTRY>>     << MCW >>29132000
   LOGICAL ARRAY WORK1(*)=WORK;                                <<00221>>29134000
   LOGICAL ARRAY WORK2(*)=WORK(1);                             <<00221>>29136000
   LOGICAL ARRAY WORK3(*)=WORK(2);                             <<00221>>29138000
   LOGICAL ARRAY WORK4(*)=WORK(3);                             <<00221>>29140000
   LOGICAL ARRAY WORK5(*)=WORK(4);                             << MCW >>29142000
   LOGICAL ARRAY WORK6(*)=WORK(5);                             << MCW >>29144000
   LOGICAL ARRAY WORK7(*)=WORK(6);                             << MCW >>29146000
   LOGICAL INDX,COUNT,I;          <<FOR TABLE ENTRY PRINTING>> <<00221>>29148000
   DOUBLE SCRATCH,SCRATCHX;       <<FOR ADDRESS CALCULATION>>  <<00221>>29150000
    LOGICAL ARRAY SCR(*)=SCRATCHX;                             <<00221>>29152000
   LOGICAL PXFILSIZE;             <<SIZE OF PXFILE AREA>>      <<00221>>29154000
   LOGICAL PXFCBTSIZE;            <<SIZE OF CONTROL BLOCK>>    <<00221>>29156000
   LOGICAL VECTSIZE;              <<SIZE OF VECTOR TABLE>>     <<00221>>29158000
   LOGICAL AFTSIZE;               <<SIZE OF AFT AREA>>         <<00221>>29160000
   LOGICAL DSTPXFCBT;             <<DST OF TABLE>>             <<00221>>29162000
   LOGICAL GOODFLAG;              <<ENTRY IS GOOD FLAG>>       <<00221>>29164000
                                                               <<00221>>29166000
   PXFILSIZE:=CORE(PXFADDR);      <<GET TABLE SIZE>>           <<00221>>29168000
   IF PXFILSIZE > %22 THEN                                     <<00221>>29170000
    BEGIN                         <<BIG ENOUGH TO FORMAT>>     <<00221>>29172000
     AFTSIZE:=CORE(PXFADDR+6D);   <<GET AFTSIZE>>              << MCW >>29174000
     PXFCBTSIZE:=CORE(PXFADDR+%22D); <<CONTROL BLOCK SIZE>>    << MCW >>29176000
     DSTPXFCBT:=CORE(PXFADDR+%23D);<<DST NUMBER CONTAINING>>   << MCW >>29178000
     VECTSIZE:=CORE(PXFADDR+%24D); <<SIZE OF THE VECTOR>>      << MCW >>29180000
     IF AFTSIZE = 0 LAND PXFCBTSIZE = 0 THEN                   <<00221>>29182000
      BEGIN                       <<EMPTY PXFILE>>             <<00221>>29184000
       MOVE BBUF(11):="(CONTAINS NO CONTROL BLOCKS)";          <<00221>>29186000
       PRINTLINE;                                              <<00221>>29188000
       OCTALDUMP(PXFADDR,PXFADDR+DOUBLE(PXFILSIZE)-1D);        <<00221>>29190000
      END                         <<EMPTY PXFILE>>             <<00221>>29192000
     ELSE                                                      <<00221>>29194000
      BEGIN                       <<CONTAINS DATA>>            <<00221>>29196000
       IF PXFILSIZE > (%22+AFTSIZE+PXFCBTSIZE)                 << MCW >>29198000
          LAND VECTSIZE+8 < PXFCBTSIZE  THEN                   << MCW >>29200000
        BEGIN                     <<PUT TOGETHER OK>>          <<00221>>29202000
         IF DSTNUM = DSTPXFCBT THEN                            <<00221>>29204000
         BEGIN                    <<TABLES ARE IN STACK>>      <<00221>>29206000
        MOVE BBUF(11):="(ZERO TABLE ENTRIES ARE NOT PRINTED)"; <<00221>>29208000
         PRINTLINE;                                            <<00221>>29210000
         OCTALDUMP(PXFADDR,PXFADDR+%21D); <<DUMP OVERFHEAD>>   << MCW >>29212000
         MOVE BBUF:="******** OVERHEAD AREA ********";                  29214000
         PRINTLINE;                                                     29216000
         OCTALDUMP(PXFADDR+%22D, PXFADDR+%22D + 7D);                    29218000
                                                                        29220000
                                                               <<00221>>29222000
         IF VECTSIZE > 0 LAND VECTSIZE < PXFCBTSIZE THEN       <<00221>>29224000
          BEGIN                           <<POSSIBLE VECTOR>>  <<00221>>29226000
           IF VECTSIZE.(15:3) <> 0 THEN                        << MCW >>29228000
            BEGIN                       <<BAD SIZE>>           <<00221>>29230000
             MOVE BBUF:="???? INVALID VECTOR TABLE SIZE:";     <<00221>>29232000
             @PBUF:=@BBUF+31;                                  <<00221>>29234000
             PUTNUM(VECTSIZE);          <<PRINT BAD SIZE>>     <<00221>>29236000
             PRINTLINE;                                        <<00221>>29238000
             OCTALDUMP(PXFADDR+%32D,                           << MCW >>29240000
                       PXFADDR+%31D+DOUBLE(VECTSIZE));         << MCW >>29242000
            END                         <<BAD SIZE>>           <<00221>>29244000
           ELSE                                                <<00221>>29246000
            BEGIN                       <<VECTOR TABLE OK>>    <<00221>>29248000
             COUNT:=0;                  <<SCAN COUNTER>>       <<00221>>29250000
             SCRATCH:=PXFADDR+%32D;     <<VECTOR ADDRESS>>     << MCW >>29252000
             DO                                                <<00221>>29254000
              WORK1:=CORE(SCRATCH+DOUBLE(COUNT))               <<00221>>29256000
             UNTIL (GOODFLAG:=(WORK1<>0)) LOR                  <<00221>>29258000
                   (COUNT:=COUNT+1)=VECTSIZE;  <<EMPTY CHECK>> <<00221>>29260000
             IF GOODFLAG THEN                                  <<00221>>29262000
             BEGIN                 <<VECTOR TABLE NOT EMPTY>>  <<00221>>29264000
             COUNT:=0;                  <<ENTRY COUNTER>>      <<00221>>29266000
             INDX:=0;                   <<FOR COUNTING WORDS>> <<00221>>29268000
             MOVE BBUF:="------- FILE VECTOR TABLE:";          <<00221>>29270000
             MOVE BBUF(65):="ENTRY  ADDR  LK  BK";             << MCW >>29272000
             MOVE BBUF(86):="LOCK COUNT/PIN  HPHEAD";          << MCW >>29274000
          MOVE BBUF(110):="HPTAIL  LPHEAD  LPTAIL";            << MCW >>29276000
             PRINTLINE;                 <<PRINT HEADER>>       <<00221>>29278000
             SCRATCHX:=PXFADDR+%32D;  <<ADDR OF VECTOR TABLE>> << MCW >>29280000
             DO                                                <<00221>>29282000
              BEGIN                     <<FOR ALL OF TABLE>>   <<00221>>29284000
               I:=0;                                           <<00221>>29286000
               GOODFLAG:=FALSE;      <<NO ENTRY YET>>          <<00221>>29288000
               DO                                              <<00221>>29290000
                BEGIN        <<LOAD AND CHECK FOR ENTRY>>      <<00221>>29292000
                WORK(I):=CORE(SCRATCHX+DOUBLE(I));             <<00221>>29294000
                IF WORK(I) <> 0 THEN GOODFLAG:=TRUE;           <<00221>>29296000
                END                                            <<00221>>29298000
                  UNTIL (I:=I+1) = 8;  <<LOAD ALL OF ENTRY>>   << MCW >>29300000
               IF GOODFLAG THEN        <<IF ENTRY EXISTS>>     <<00221>>29302000
               BEGIN                   <<GO AHEAD AND PRINT>>  <<00221>>29304000
               @PBUF:=@BBUF;                                   <<00221>>29306000
               PUTNUM(SCR(1));          <<PRINT OFFSET>>       <<00221>>29308000
               PBUF(-1):=":";  @PBUF:=@PBUF+1;                 <<00221>>29310000
               I:=0;              <<INIT SCAN>>                <<00221>>29312000
               DO                                              <<00221>>29314000
                PUTNUM(WORK(I))  UNTIL (I:=I+1) = 8;           << MCW >>29316000
               @PBUF:=@BBUF+62;                                << MCW >>29318000
               PUTNUMP(COUNT*8+8);        <<ENTRY NUMBER>>     << MCW >>29320000
               @PBUF:=@BBUF+70;                                << MCW >>29322000
               PUTNUMP(WORK1);        <<DST OFFSET>>           <<00221>>29324000
               IF WORK2.(0:1)=1 THEN MOVE BBUF(78):="LK";      << MCW >>29326000
               IF WORK2.(1:1)=1 THEN MOVE BBUF(82):="BK";      << MCW >>29328000
               @PBUF:=@BBUF+88;                                << MCW >>29330000
               PUTNUMP(WORK2.(2:6));   <<LOCK COUNT>>          <<00221>>29332000
               @PBUF:=@BBUF+94;                                << MCW >>29334000
               PUTNUMP(WORK3/21);  <<LOCK PIN>>                << MCW >>29336000
                                                               << MCW >>29338000
                                                               << MCW >>29340000
                 @PBUF:=@BBUF+101;                             << MCW >>29342000
                 PUTNUMP(WORK4/21);<<HIPRI HEAD>>              << MCW >>29344000
                 @PBUF:=@BBUF+109;                             << MCW >>29346000
                 PUTNUMP(WORK5/21);<<HIPRI TAIL>>              << MCW >>29348000
                                                               << MCW >>29350000
                                                               << MCW >>29352000
                                                               << MCW >>29354000
                 @PBUF:=@BBUF+117;                             << MCW >>29356000
                 PUTNUMP(WORK6/21);<<LOPRI HEAD>>              << MCW >>29358000
                 @PBUF:=@BBUF+125;                             << MCW >>29360000
                 PUTNUMP(WORK7/21);<<LOPRI TAIL>>              << MCW >>29362000
                                                               << MCW >>29364000
               PRINTLINE;            <<PRINT THE LINE>>        <<00221>>29366000
               END;                    <<GO AHEAD AND PRINT>>  <<00221>>29368000
               COUNT:=COUNT+1;       <<NEXT ENTRY>>            <<00221>>29370000
               SCRATCHX:=SCRATCHX+8D;  <<TO NEXT ENTRY>>       << MCW >>29372000
              END                       <<FOR ALL OF TABLE>>   <<00221>>29374000
               UNTIL (INDX:=INDX+8) >= VECTSIZE; <<TILL DONE>> << MCW >>29376000
             END                                               <<00221>>29378000
             ELSE                                              <<00221>>29380000
             BEGIN                 <<EMPTY VECTOR TABLE>>      <<00221>>29382000
              MOVE BBUF:="-- VECTOR TABLE EMPTY (ALL ZERO)";   <<00221>>29384000
              PRINTLINE;                                       <<00221>>29386000
             END;                  <<EMPTY VECTOR TABLE>>      <<00221>>29388000
            END;                        <<VECTOR TABLE OK>>    <<00221>>29390000
             <<FORMAT AND PRINT CB AREA>>                      <<00221>>29392000
             MOVE BBUF:="------- CONTROL BLOCKS:";             <<00221>>29394000
             PRINTLINE;                                        <<00221>>29396000
             SCRATCHX:=DBADR;           <<SAVE DB ADDRESS>>    <<00221>>29398000
             INDX:=CORE(PXFADDR+DOUBLE(PXFILSIZE)+3D);         <<00221>>29400000
             DBADR:=DOUBLE(INDX-PXFILSIZE+%16);                <<00221>>29402000
             CHARFLAG:=TRUE;            <<CHARACTER FLAG ON>>  <<00221>>29404000
             SCRATCH:=PXFADDR+%32D+DOUBLE(VECTSIZE);<<START>>  << MCW >>29406000
           OCTALDUMP(SCRATCH,PXFADDR+DOUBLE(PXFCBTSIZE)+%21D); << MCW >>29408000
             CHARFLAG:=FALSE;                                  <<00221>>29410000
             DBADR:=SCRATCHX;        <<RESTORE DB,CHARFLAG>>   <<00221>>29412000
                                                               <<00221>>29414000
             <<DUMP OUT AVAILABLE AREA>>                       <<00221>>29416000
             SCRATCH:=PXFADDR+DOUBLE(PXFCBTSIZE)+%22D;<<STRT>> << MCW >>29418000
             SCRATCHX:=PXFADDR+DOUBLE(PXFILSIZE-AFTSIZE)-1D;   <<00221>>29420000
             OCTALDUMP(SCRATCH,SCRATCHX);                      <<00221>>29422000
                                                               <<00221>>29424000
             <<DUMP AFT AREA>>                                 <<00221>>29426000
             IF (AFTSIZE MOD 6) = 0 THEN                       << MCW >>29428000
              BEGIN                        <<AFT SIZE IS OK>>  <<00221>>29430000
               IF AFTSIZE > 0 THEN                             <<00221>>29432000
                BEGIN                      <<ENTRIES IN AFT>>  <<00221>>29434000
                 COUNT:=0;                 <<NUM WORDS>>       <<00221>>29436000
                 SCRATCH:=SCRATCHX+1D;     <<CORE LOC>>        <<00221>>29438000
                 DO                                            <<00221>>29440000
                  WORK1:=CORE(SCRATCH+DOUBLE(COUNT))           <<00221>>29442000
                 UNTIL (GOODFLAG:=(WORK1<>0)) LOR              <<00221>>29444000
                       (COUNT:=COUNT+1) =AFTSIZE;  <<EMPTY??>> <<00221>>29446000
                 IF GOODFLAG THEN                              <<00221>>29448000
                 BEGIN                      <<AFT NOT EMPTY>>  <<00221>>29450000
                 MOVE BBUF:="------- AVAILABLE FILE TABLE:";   <<00221>>29452000
                 MOVE BBUF(51):="FNUM   FTYPE  $NULL   PACB";  << MCW >>29454000
                 MOVE BBUF(78):="V     LACB V   IOQX";         << MCW >>29456000
                 PRINTLINE;                                    <<00221>>29458000
                 SCRATCHX:=SCRATCHX+1D;    <<POINT TO ENTRY>>  <<00221>>29460000
                 COUNT:=AFTSIZE/6;         <<FILE NUMBER>>     << MCW >>29462000
                 DO                                            <<00221>>29464000
                  BEGIN                    <<FOR EACH FILE>>   <<00221>>29466000
                   I:=0;                   <<LOAD ENTRY>>      <<00221>>29468000
                   GOODFLAG:=FALSE;        <<NO ENTRY YET>>    <<00221>>29470000
                   DO                                          <<00221>>29472000
                    BEGIN                  <<LOAD AND CHECK>>  <<00221>>29474000
                    WORK(I):=CORE(SCRATCHX+DOUBLE(I));         <<00221>>29476000
                    IF WORK(I) <> 0 THEN GOODFLAG:=TRUE;       <<00221>>29478000
                    END                    <<LOAD AND CHECK>>  <<00221>>29480000
                     UNTIL  (I:=I+1) = 6;                      << MCW >>29482000
                  IF GOODFLAG THEN        <<ENTRY NON ZERO?>>  <<00221>>29484000
                   BEGIN                  <<PRINT THE ENTRY>>  <<00221>>29486000
                   @PBUF:=@BBUF;                               <<00221>>29488000
                   PUTNUM(SCR(1));   <<OFFSET IN BANK>>        <<00221>>29490000
                     PBUF(-1):=":";  @PBUF:=@PBUF+1;           <<00221>>29492000
                   I:=0;                                       <<00221>>29494000
                   DO                                          <<00221>>29496000
                    PUTNUM(WORK(I))  UNTIL (I:=I+1) = 6;       << MCW >>29498000
                   @PBUF:=@BBUF+49;                            << MCW >>29500000
                   PUTNUMP(COUNT);         <<FILE NUMBER>>     <<00221>>29502000
                   PUTNUMP(WORK1.(0:4));   <<FILE TYPE>>       <<00221>>29504000
                   CASE WORK1.(0:4) OF                         <<00221>>29506000
                    BEGIN                  <<FILE TYPES>>      <<00221>>29508000
                      MOVE BBUF(58):=" FILE ";                 << MCW >>29510000
                      MOVE BBUF(58):="REMOTE";                 << MCW >>29512000
                      MOVE BBUF(58):="  DS  ";                 << MCW >>29514000
                      MOVE BBUF(58):="  DS  ";                 << MCW >>29516000
                      MOVE BBUF(58):="  CS  ";                 << MCW >>29518000
                      MOVE BBUF(58):="  CS  ";                 << MCW >>29520000
                      MOVE BBUF(58):=" KSAM ";                 << MCW >>29522000
                      MOVE BBUF(58):="  IMF ";                 << MCW >>29524000
                      MOVE BBUF(58):="MSG FL";                 << MCW >>29526000
                      MOVE BBUF(58):="PORTS ";                 << MCW >>29528000
                    END;                   <<FILE TYPES>>      <<00221>>29530000
                   IF WORK1.(4:1)=1 THEN                       <<00221>>29532000
                     MOVE BBUF(65):="$NULL";                   << MCW >>29534000
                   @PBUF:=@BBUF+68;                            << MCW >>29536000
                   PUTNUMP(WORK3);  <<OFFSET IN VECTOR>>       << MCW >>29538000
                   @PBUF:=@PBUF-2;                             <<00221>>29540000
                   PUTNUMP(WORK2);<<DST NUMBER VECTOR>>        << MCW >>29542000
                   @PBUF:=@BBUF+79;                            << MCW >>29544000
                   PUTNUMP(WORK5); <<OFFSET IN VECTOR>>        << MCW >>29546000
                   @PBUF:=@PBUF-2;                             <<00221>>29548000
                   PUTNUMP(WORK4);<<DST NUMBER VECTOR>>        << MCW >>29550000
                   @PBUF:=@BBUF+92;                            << MCW >>29552000
                   IF WORK6 <> 0 THEN PUTNUM(WORK6);           << MCW >>29554000
                    PRINTLINE;                                 <<00221>>29556000
                   END;                   <<PRINT THE ENTRY>>  <<00221>>29558000
                   SCRATCHX:=SCRATCHX+6D;     <<NEXT ENTRY>>   << MCW >>29560000
                  END                      <<FOR EACH FILE>>   <<00221>>29562000
                   UNTIL (COUNT:=COUNT-1) = 0;                 <<00221>>29564000
                 END                        <<AFT NOT EMPTY>>  <<00221>>29566000
                 ELSE                                          <<00221>>29568000
                 BEGIN                      <<ALL ZERO AFT>>   <<00221>>29570000
                 MOVE BBUF:="-- AFT IS EMPTY (ALL ZERO)";      <<00221>>29572000
                 PRINTLINE;                                    <<00221>>29574000
                 END;                       <<ALL ZERO AFT>>   <<00221>>29576000
                END                        <<ENTRIES IN AFT>>  <<00221>>29578000
               ELSE                                            <<00221>>29580000
                BEGIN                      <<AFT EMPTY>>       <<00221>>29582000
                 MOVE BBUF:="--- AFT TABLE EMPTY";             <<00221>>29584000
                 PRINTLINE;                                    <<00221>>29586000
                END;                       <<AFT EMPTY>>       <<00221>>29588000
              END                          <<AFT SIZE IS OK>>  <<00221>>29590000
             ELSE                                              <<00221>>29592000
              BEGIN                    <<INVALID AFT SIZE>>    <<00221>>29594000
               MOVE BBUF:="???? INVALID AFT SIZE:";            <<00221>>29596000
               @PBUF:=@BBUF+22;                                <<00221>>29598000
               PUTNUM(AFTSIZE);                                <<00221>>29600000
             OCTALDUMP(SCRATCHX,PXFADDR+DOUBLE(PXFILSIZE)-1D); <<00221>>29602000
              END;                     <<INVALID AFT SIZE>>    <<00221>>29604000
          END                             <<POSSIBLE VECTOR>>  <<00221>>29606000
         ELSE                                                  <<00221>>29608000
          BEGIN                           <<BAD CBT AREA>>     <<00221>>29610000
           MOVE BBUF:="???? (BAD VECTOR TABLE SIZE) ????";     <<00221>>29612000
           PRINTLINE;                                          <<00221>>29614000
           OCTALDUMP(PXFADDR,PXFADDR+DOUBLE(PXFILSIZE)-1D);    <<00221>>29616000
          END;                                                 <<00221>>29618000
         END                      <<TABLES ARE IN STACK>>      <<00221>>29620000
         ELSE                                                  <<00221>>29622000
         BEGIN                    <<;NOCB ON RUN>>             <<00221>>29624000
          MOVE BBUF(11):="(CONTROL BLOCKS ARE IN DST";         <<00221>>29626000
          @PBUF:=@BBUF(34);       <<FOR DST DISPLAY>>          <<00221>>29628000
          PUTNUMP(DSTPXFCBT);     <<PUT DST OF CB>>            <<00221>>29630000
          PBUF(-1):=")";                                       <<00221>>29632000
          PRINTLINE;              <<PRINT THE MSG>>            <<00221>>29634000
          OCTALDUMP(PXFADDR,PXFADDR+DOUBLE(PXFILSIZE)-1D);     <<00221>>29636000
         END;                     <<;NOCB ON RUN>>             <<00221>>29638000
        END                       <<PUT TOGETHER OK>>          <<00221>>29640000
       ELSE                                                    <<00221>>29642000
        BEGIN                     <<TABLE SIZES ERROR>>        <<00221>>29644000
         MOVE BBUF(11):="???? (TABLE SIZES OVERLAP) ????";     <<00221>>29646000
         PRINTLINE;                                            <<00221>>29648000
         OCTALDUMP(PXFADDR,PXFADDR+DOUBLE(PXFILSIZE)-1D);      <<00221>>29650000
        END;                      <<TABLE SIZES ERROR>>        <<00221>>29652000
      END;                        <<CONTAINS DATA>>            <<00221>>29654000
    END                           <<BIG ENOUGH TO FORMAT>>     <<00221>>29656000
   ELSE                                                        <<00221>>29658000
    BEGIN                         <<TOO SMALL TO FORMAT>>      <<00221>>29660000
     MOVE BBUF(11):="???? (PXFILE TOO SMALL TO FORMAT) ????";  <<00221>>29662000
     PRINTLINE;                                                <<00221>>29664000
     OCTALDUMP(PXFADDR,PXFADDR+DOUBLE(PXFILSIZE)-1D);          <<00221>>29666000
    END;                           <<TOO SMALL TO FORMAT>>     <<00221>>29668000
 END;              <<END   PROCEDURE PXFILEPRINT>>             <<00221>>29670000
$PAGE "CATEGORIZE'DST: Classify DSTs in array DST'TYPE"                 29672000
$CONTROL SEGMENT=INIT                                                   29674000
PROCEDURE CATEGORIZE'DST;                                      <<03078>>29676000
COMMENT                                                                 29678000
                                                                        29680000
Purpose:                                                                29682000
            This procedure and its related procedures --                29684000
            search'cbts, search'pacb, cbt'stack, cbt'exds,              29686000
            curr'process --  are designed to categorize a               29688000
            limited set of dst. This procedure searches the             29690000
            pcb finding assigned entries and using the                  29692000
            information in the pcb finds its stack and the              29694000
            corresponding dst's.  The byte array dst'type is            29696000
            set in the following manner to classify the dst's.          29698000
                                                                        29700000
              array entry            dst type                           29702000
              -----------            --------                           29704000
                   0                 array position not set             29706000
                   1                 process stack                      29708000
                   2                 extra ds of curr process           29710000
                   3                 fcb                                29712000
                   4                                                    29714000
                   5                 fcb                                29716000
                   6                 fcb                                29718000
                   7                 jit of current process             29720000
                   8                 jdt of current process             29722000
                   9                 user logging of curr proc          29724000
                  10                 udc of current process             29726000
                  11                 current process stack              29728000
                  12                 terminal buffer & dit              29730000
                  13                 system dst                         29732000
                  14                 requested dst                      29734000
                  15                 dev/process xds                    29736000
                  16                 ds job xds                         29738000
                  17                 cs misc dst                        29740000
                  18                 LSTT                      << MCW >>29742000
                                                                        29744000
                                                                        29746000
           currently 9 and 10 are not searched for and others           29748000
           can be added when the need arises.                           29750000
                                                                        29752000
Input parameters:                                                       29754000
                                                                        29756000
Output parameters:                                                      29758000
                                                                        29760000
Globals Referenced:                                                     29762000
                                                                        29764000
Globals Altered:                                                        29766000
                                                                        29768000
Data Structures:                                                        29770000
                                                                        29772000
Algorithm:                                                              29774000
                                                                        29776000
;                                                                       29778000
BEGIN                                                          <<03078>>29780000
  INTEGER PCBENTRIES,                                          <<03078>>29782000
          ENTRYCOUNT,                                          <<03078>>29784000
          PCBSIZE,                                             <<03078>>29786000
          INDX;                                                <<03078>>29788000
  INTEGER CURR'PIN,                                            <<*8118>>29790000
          DSTENTRIES,                                          <<03670>>29792000
          DSTNUM,                                              << MCW >>29794000
          NUM,                                                 << MCW >>29796000
          IND,                                                 << MCW >>29798000
          DSTNO;                                               <<03078>>29800000
  DOUBLE  LOCPCB,                                              <<03078>>29802000
          DSTENTRY,                                            <<03078>>29804000
          STACKADDR,                                           <<03078>>29806000
          FCBDST,                                              << MCW >>29808000
          DLREG;                                               <<03078>>29810000
                                                               <<03078>>29812000
  DST'TYPE:=0; MOVE DST'TYPE(1):=DST'TYPE,(4095);              <<*8910>>29814000
  INDX:= 0;                                                    <<03078>>29816000
  DO BEGIN                                                     <<03078>>29818000
     MOVE DST'TYPE(INDX):= 13;                                 <<03078>>29820000
     INDX:=INDX + 1;                                           <<03078>>29822000
     END                                                       <<03078>>29824000
     UNTIL INDX > LSTSYSDST;                                   <<03078>>29826000
  MOVE DST'TYPE(%14):= 12;                                     <<03078>>29828000
                                                               <<03078>>29830000
  CURR'PIN:=CORE(4D);                                          <<03078>>29832000
  PCBENTRIES:=CORE(PCBDEFIN) - CORE(PCBDEFIN + 2D);            <<03078>>29834000
  DSTENTRIES := CORE(DSTDEFIN);                                <<03670>>29836000
  LOCPCB:=PCBDEFIN;                                            <<03078>>29838000
  INDX:= 1;                                                    <<03078>>29840000
                                                                        29842000
  PCBSIZE:= %25;                                               << MCW >>29844000
  ENTRYCOUNT:= 0;                                              <<03078>>29846000
  FCBDST:=DSTTOADDR(CORE(%1076D));                             << MCW >>29848000
  NUM:=CORE(FCBDST);                                           << MCW >>29850000
  IND:=%10;                                                    << MCW >>29852000
  WHILE IND<NUM DO                                             << MCW >>29854000
  BEGIN                                                        << MCW >>29856000
    DSTNUM:=CORE(FCBDST+DOUBLE(IND));                          << MCW >>29858000
    IF DSTNUM<4096 AND DSTNUM>0 THEN                           << MCW >>29860000
      DST'TYPE(DSTNUM):=3;                                     << MCW >>29862000
    IF DSTNUM=0 THEN IND:=NUM;                                 << MCW >>29864000
    IND:=IND+1;                                                << MCW >>29866000
  END;                                                         << MCW >>29868000
                                                               <<03078>>29870000
     WHILE (ENTRYCOUNT<PCBENTRIES) AND (ENTRYCOUNT<1025) DO    <<*8816>>29872000
    BEGIN                                                      <<03078>>29874000
    IF PCB20 = %177777 THEN                                    << MCW >>29876000
       INDX:=INDX + 1                                          <<03078>>29878000
    ELSE                                                       <<03078>>29880000
       BEGIN                                                   <<03078>>29882000
       DSTNO:=PCB03.(2:14);                                    << MCW >>29884000
       IF PCB15>0 AND PCB15<4096 THEN DST'TYPE(PCB15):=18;     <<sknew>>29886000
                                                               <<03670>>29888000
       IF DSTNO <> 0 AND DSTNO <= DSTENTRIES  THEN  BEGIN      <<03670>>29890000
       DST'TYPE(DSTNO):= 1;                                    <<03078>>29892000
       DSTENTRY:=DOUBLE(DSTNO * 4) + DSTDEFIN;                 <<03078>>29894000
       IF CORE(DSTENTRY).(0:1)=0 OR                            <<03078>>29896000
          CORE(DSTENTRY+1D).(1:1)=1 THEN                       <<03078>>29898000
          IF (INDX*PCBSIZE)= INTEGER(CURR'PIN) OR              << MCW >>29900000
             NOT MINI'DUMP THEN                                <<03078>>29902000
             BEGIN                                             <<03078>>29904000
             TOS:=CORE(DSTENTRY + 2D);                         <<03078>>29906000
             TOS:=CORE(DSTENTRY + 3D);                         <<03078>>29908000
             STACKADDR:=TOS;                                   <<03078>>29910000
             DLREG:=STACKADDR + DOUBLE(CORE(STACKADDR));       <<03078>>29912000
             CURR'PROCESS(STACKADDR,DSTNO,LOCPCB,INDX,PCBSIZE);<<03078>>29914000
             SEARCH'CBTS(STACKADDR,DLREG,DSTNO);               <<03078>>29916000
             END;                                              <<03078>>29918000
       END;                                                    <<03670>>29920000
                                                               <<03670>>29922000
       INDX:=INDX + 1;                                         <<03078>>29924000
       ENTRYCOUNT:=ENTRYCOUNT + 1;                             <<03078>>29926000
       END;                                                    <<03078>>29928000
     END;                                                      <<03078>>29930000
END;                                                           <<03078>>29932000
$PAGE "SEARCH'CBTS : Search the AFT and analyze "                       29934000
$CONTROL SEGMENT=INIT                                                   29936000
PROCEDURE SEARCH'CBTS(STACKADDR,DLREG,STACKDST);               <<03078>>29938000
DOUBLE  DLREG,                                                 <<03078>>29940000
        STACKADDR;                                             <<03078>>29942000
LOGICAL STACKDST;                                              <<03078>>29944000
                                                               <<03078>>29946000
COMMENT                                                                 29948000
                                                                        29950000
Purpose:                                                                29952000
         This procedure searches through the aft of a given             29954000
         stack.  When each new aft entry is found the lacb and          29956000
         pacb vectors are analysed.  If a lacb is present but           29958000
         the stack nothing is set but if present and in another         29960000
         data segment the array position for this data segment          29962000
         is set to the correct value.  If a pacb is present its         29964000
         base is always calculated so that any fcb may be found         29966000
         the procedure checks for null files, ignoring these            29968000
         afts.                                                          29970000
                                                                        29972000
Input parameters:                                                       29974000
                                                                        29976000
Output parameters:                                                      29978000
                                                                        29980000
Globals Referenced:                                                     29982000
                                                                        29984000
Globals Altered:                                                        29986000
                                                                        29988000
Data Structures:                                                        29990000
                                                                        29992000
Algorithm:                                                              29994000
                                                                        29996000
;                                                                       29998000
BEGIN                                                          <<03078>>30000000
  DEFINE FSTYPE=(0:4)#,                                        <<03078>>30002000
         LEMISC'DST=(6:10)#,                                   <<03078>>30004000
         DSDST=(6:10)#;                                        <<03078>>30006000
  EQUATE LFILE=0,                                              <<03078>>30008000
         DSNUM=2,                                              <<03078>>30010000
         DSNUMNW=3,                                            <<03078>>30012000
         CSFILE=4,                                             <<03078>>30014000
         CSFILEAD=5,                                           <<03078>>30016000
         DSDSJOBXDS=%11;                                       <<03078>>30018000
  INTEGER INDX,                                                <<03078>>30020000
          VECTINDX,                                            <<03078>>30022000
          AFTENTRIES,                                          <<03078>>30024000
          ENTRYCOUNT;                                          <<03078>>30026000
  LOGICAL CBTDST;                                              <<03078>>30028000
  LOGICAL DSTNUM;                                              <<04284>>30030000
  DOUBLE  DSTADDR;                                             <<04154>>30032000
  DOUBLE  AFTBASE,                                             <<03078>>30034000
          BLOCKADDR;                                           <<03078>>30036000
                                                               <<03078>>30038000
  AFTBASE:=DLREG - 5D;                                         <<03078>>30040000
  INDX:=0;                                                     <<03078>>30042000
  AFTENTRIES:=INTEGER(CORE(STACKADDR + 12D + 6D +              << MCW >>30044000
                 DOUBLE(CORE(STACKADDR + 12D))))  / 6;         << MCW >>30046000
  ENTRYCOUNT:= 1;                                              <<03078>>30048000
  WHILE ENTRYCOUNT <= AFTENTRIES DO                            <<03078>>30050000
    BEGIN                                                      <<03078>>30052000
    IF AFT00=0 AND AFT01=0 AND AFT02=0 AND AFT03=0  AND        << MCW >>30054000
    AFT04=0 AND AFT05=0 THEN                                   << MCW >>30056000
       ENTRYCOUNT:=ENTRYCOUNT + 1                              <<03078>>30058000
    ELSE                                                       <<03078>>30060000
       BEGIN                                                   <<03078>>30062000
       IF AFT00.FSTYPE = LFILE THEN                            <<03078>>30064000
          BEGIN                                                <<03078>>30066000
          IF AFT03 <> 0 THEN                                   << MCW >>30068000
             BEGIN                                             <<03078>>30070000
             CBTDST:=AFT03;                                    << MCW >>30072000
             VECTINDX:=INTEGER(AFT04);                         << MCW >>30074000
             IF CBTDST <> STACKDST THEN                        <<03078>>30076000
                CBT'EXDS(BLOCKADDR,VECTINDX,CBTDST);           <<03078>>30078000
             IF BLOCKADDR <> 0D                                << MCW >>30080000
             AND CBTDST<>0 AND CBTDST<=4095 THEN               << MCW >>30082000
                IF DST'TYPE(CBTDST) = 0 THEN                   <<03078>>30084000
                   DST'TYPE(CBTDST):= 6;                       <<03078>>30086000
             END;                                              <<03078>>30088000
          IF AFT01 <> 0 THEN                                   << MCW >>30090000
             BEGIN                                             <<03078>>30092000
             CBTDST:=AFT01;                                    << MCW >>30094000
             VECTINDX:=INTEGER(AFT02);                         << MCW >>30096000
             IF CBTDST = STACKDST THEN                         <<03078>>30098000
                CBT'STACK(STACKADDR,BLOCKADDR,VECTINDX)        <<03078>>30100000
             ELSE                                              <<03078>>30102000
                CBT'EXDS(BLOCKADDR,VECTINDX,CBTDST);           <<03078>>30104000
             IF BLOCKADDR <> 0D THEN SEARCH'PACB(CBTDST,       <<03078>>30106000
                BLOCKADDR);                                    <<03078>>30108000
             END;                                              <<03078>>30110000
          END                                                  <<03078>>30112000
       ELSE                                                    <<03078>>30114000
       IF AFT00.FSTYPE=DSNUM OR                                <<03078>>30116000
          AFT00.FSTYPE=DSNUMNW THEN BEGIN                      <<03078>>30118000
          IF AFT01<>0 AND AFT01<=4095 THEN BEGIN               << MCW >>30120000
          DST'TYPE(AFT01) := 15;                               << MCW >>30122000
          DSTADDR:=DSTTOADDR(AFT01);                           << MCW >>30124000
          END;                                                 << MCW >>30126000
          IF = THEN                                            <<04154>>30128000
            DSTNUM:=CORE(DSTADDR+DOUBLE(DSDSJOBXDS));          <<04284>>30130000
            IF DSTNUM <= MAX'DSTNUM THEN                       <<04284>>30132000
               DST'TYPE(DSTNUM):=16; END                       <<04284>>30134000
       ELSE                                                    <<04284>>30136000
       IF AFT00.FSTYPE=CSFILE OR                               <<04284>>30138000
          AFT00.FSTYPE=CSFILEAD THEN                           <<04284>>30140000
          IF AFT04>0 AND AFT04<MAX'DSTNUM THEN                 << MCW >>30142000
          DST'TYPE(AFT04) := 17;                               << MCW >>30144000
       ENTRYCOUNT:=ENTRYCOUNT + 1;                             <<03078>>30146000
       END;                                                    <<03078>>30148000
    INDX:=INDX + 6;                                            << MCW >>30150000
    END;                                                       <<03078>>30152000
END;                                                           <<03078>>30154000
$PAGE "CURR'PROCESS: Find JIT and JDT entries for a process"            30156000
$CONTROL SEGMENT=INIT                                                   30158000
PROCEDURE CURR'PROCESS(STACKADDR,DSTNO,LOCPCB,INDX,PCBSIZE);   <<03078>>30160000
INTEGER INDX,                                                  <<03078>>30162000
        PCBSIZE;                                               <<03078>>30164000
DOUBLE  STACKADDR,                                             <<03078>>30166000
        LOCPCB;                                                <<03078>>30168000
LOGICAL DSTNO;                                                 <<03078>>30170000
COMMENT                                                                 30172000
                                                                        30174000
Purpose:                                                                30176000
     This procedure will find jit and jdt entries for a                 30178000
     given process when the stack address is found in the               30180000
     calling procedure.   It will also find a current                   30182000
     extra data segment if one is present. The procedure                30184000
     may be expanded in the future to find other data seg-              30186000
     ments associated with certain processes.                           30188000
     It is currently simply a subroutine of CATEGORIZE'DST.             30190000
                                                                        30192000
Input parameters:                                                       30194000
                                                                        30196000
Output parameters:                                                      30198000
                                                                        30200000
Globals Referenced:                                                     30202000
                                                                        30204000
Globals Altered:                                                        30206000
                                                                        30208000
Data Structures:                                                        30210000
                                                                        30212000
Algorithm:                                                              30214000
                                                                        30216000
;                                                                       30218000
                                                               <<03078>>30220000
BEGIN                                                          <<03078>>30222000
  LOGICAL STACKLOC;                                            <<03078>>30224000
                                                               <<03078>>30226000
  STACKLOC:=(CORE(STACKADDR+10D));                             << MCW >>30228000
  IF STACKLOC > 0 AND STACKLOC < MAX'DSTNUM THEN                        30230000
  IF DST'TYPE(STACKLOC) = 0 THEN                               <<03078>>30232000
     DST'TYPE(STACKLOC):= 8;                                   <<03078>>30234000
  STACKLOC:=(CORE(STACKADDR+11D));                             << MCW >>30236000
  IF STACKLOC > 0 AND STACKLOC < MAX'DSTNUM THEN                        30238000
  IF DST'TYPE(STACKLOC) = 0 THEN                               <<03078>>30240000
     DST'TYPE(STACKLOC):= 7;                                   <<03078>>30242000
  IF PCB02.(2:14) <> 0 AND PCB02.(2:14) < 4095 THEN            << MCW >>30244000
     DST'TYPE(PCB02.(2:14)):= 2;                               << MCW >>30246000
  IF CORE(4D) = LOGICAL(INDX*PCBSIZE) THEN                     << MCW >>30248000
     DST'TYPE(DSTNO):= 11;                                     <<03078>>30250000
                                                               <<03078>>30252000
END;                                                           <<03078>>30254000
