$PAGE "CBT'STACK: Isolate Control Block Table"                          40000000
$CONTROL SEGMENT=INIT                                          <<03078>>40002000
$CONTROL WARN                                                  <<03078>>40004000
                                                               <<03078>>40006000
PROCEDURE CBT'STACK(STACKADDR,BLOCKADDR,VECTINDX);             <<03078>>40008000
DOUBLE  STACKADDR,                                             <<03078>>40010000
        BLOCKADDR;                                             <<03078>>40012000
INTEGER VECTINDX;                                              <<03078>>40014000
                                                               <<03078>>40016000
COMMENT                                                                 40018000
                                                                        40020000
Purpose:                                                                40022000
         If it was determined that the file control block was           40024000
         in the pxfile area of the stack this procedure is call         40026000
         to find the base address of the block in the control           40028000
         block area which the vector addresses.                         40030000
                                                                        40032000
                                                                        40034000
Input parameters:                                                       40036000
                                                                        40038000
Output parameters:                                                      40040000
                                                                        40042000
Globals Referenced:                                                     40044000
                                                                        40046000
Globals Altered:                                                        40048000
                                                                        40050000
Data Structures:                                                        40052000
                                                                        40054000
Algorithm:                                                              40056000
                                                                        40058000
;                                                                       40060000
BEGIN                                                          <<03078>>40062000
  DOUBLE CBTADDR,                                              <<03078>>40064000
         VECTADDR;                                             <<03078>>40066000
                                                               <<03078>>40068000
  CBTADDR:=STACKADDR + 8D + DOUBLE(CORE(STACKADDR+8D)) + %16D; <<03078>>40070000
  VECTADDR:=CBTADDR + 5D + DOUBLE(VECTINDX * 4);               <<03078>>40072000
  BLOCKADDR:=DOUBLE(CORE(VECTADDR)) + CBTADDR;                 <<03078>>40074000
END;                                                           <<03078>>40076000
$PAGE "SEARCH'PACB : Search for the FCB vector"                         40078000
$CONTROL SEGMENT=INIT                                                   40080000
PROCEDURE SEARCH'PACB(DSTNO,PACBADDR);                         <<03078>>40082000
LOGICAL DSTNO;                                                 <<03078>>40084000
DOUBLE  PACBADDR;                                              <<03078>>40086000
                                                               <<03078>>40088000
COMMENT                                                                 40090000
                                                                        40092000
Purpose:                                                                40094000
         When a pacb is found this procedure sets the array to          40096000
         record this and then the fcb vector in the pacb is             40098000
         found and if a fcb is present its array position is            40100000
         set if it has not already been done.                           40102000
                                                                        40104000
Input parameters:                                                       40106000
                                                                        40108000
Output parameters:                                                      40110000
                                                                        40112000
Globals Referenced:                                                     40114000
                                                                        40116000
Globals Altered:                                                        40118000
                                                                        40120000
Data Structures:                                                        40122000
                                                                        40124000
Algorithm:                                                              40126000
                                                                        40128000
;                                                                       40130000
BEGIN                                                          <<03078>>40132000
                                                               <<03078>>40134000
  IF DST'TYPE(DSTNO) = 0 THEN                                  <<03078>>40136000
     DST'TYPE(DSTNO):= 5;                                      <<03078>>40138000
  DSTNO:=(CORE(PACBADDR + %32D)).(6:10);                       <<03078>>40140000
  IF DST'TYPE(DSTNO) = 0 THEN                                  <<03078>>40142000
     DST'TYPE(DSTNO):= 3;                                      <<03078>>40144000
                                                               <<03078>>40146000
END;                                                           <<03078>>40148000
$PAGE "CBT'EXDS : Isolate Control Block in Extra Data Segment"          40150000
$CONTROL SEGMENT=INIT                                                   40152000
PROCEDURE CBT'EXDS(BLOCKADDR,VECTINDX,DSTNO);                  <<03078>>40154000
DOUBLE  BLOCKADDR;                                             <<03078>>40156000
INTEGER VECTINDX;                                              <<03078>>40158000
LOGICAL DSTNO;                                                 <<03078>>40160000
COMMENT                                                                 40162000
                                                                        40164000
Purpose:                                                                40166000
         If it was determined that the file control block               40168000
         was not in the pxfile area but rather in another data          40170000
         segment this procedure is called.  It first finds the          40172000
         base of this data segment and then calculates the base         40174000
         of the control block for the file needed. If the data          40176000
         segment is absent the procedure will return a base             40178000
         address of zero indicating this case.                          40180000
                                                                        40182000
                                                                        40184000
Input parameters:                                                       40186000
                                                                        40188000
Output parameters:                                                      40190000
                                                                        40192000
Globals Referenced:                                                     40194000
                                                                        40196000
Globals Altered:                                                        40198000
                                                                        40200000
Data Structures:                                                        40202000
                                                                        40204000
Algorithm:                                                              40206000
                                                                        40208000
;                                                                       40210000
BEGIN                                                          <<03078>>40212000
  DOUBLE DSTENTRY,                                             <<03078>>40214000
         CBTADDR,                                              <<03078>>40216000
         VECTADDR;                                             <<03078>>40218000
                                                               <<03078>>40220000
  DSTENTRY:=DOUBLE(DSTNO * 4) + DSTDEFIN;                      <<03078>>40222000
  IF CORE(DSTENTRY).(0:1) = 0 AND                              <<03078>>40224000
     CORE(DSTENTRY + 1D).(3:1) <> 1                            <<03078>>40226000
     OR CORE(DSTENTRY+1D).(1:1) =1 THEN                        <<03078>>40228000
     BEGIN                                                     <<03078>>40230000
     TOS:= CORE(DSTENTRY + 2D);                                <<03078>>40232000
     TOS:= CORE(DSTENTRY + 3D);                                <<03078>>40234000
     CBTADDR:=TOS;                                             <<03078>>40236000
     VECTADDR:=CBTADDR + 5D + DOUBLE(VECTINDX * 4);            <<03078>>40238000
     BLOCKADDR:=DOUBLE(CORE(VECTADDR)) + CBTADDR;              <<03078>>40240000
     END                                                       <<03078>>40242000
  ELSE                                                         <<03078>>40244000
     BLOCKADDR:= 0D;                                           <<03078>>40246000
END;                                                           <<03078>>40248000
$PAGE "FORMATFCB : Format the File Control Block"                       40250000
$CONTROL SEGMENT=MEMORY                                                 40252000
PROCEDURE FORMATFCB(DSTNO);                                    <<03077>>40254000
VALUE DSTNO;                                                   <<03077>>40256000
LOGICAL DSTNO;                                                 <<03077>>40258000
COMMENT                                                                 40260000
                                                                        40262000
Purpose:                                                                40264000
     This procedure will produce a human readable listing of            40266000
     a file control block.                                              40268000
                                                                        40270000
Input parameters:                                                       40272000
     DSTNO is the data segment number of the stack containing           40274000
     the file control block to be formatted.                            40276000
                                                                        40278000
Output parameters:                                                      40280000
     <none>                                                             40282000
                                                                        40284000
Globals Referenced:                                                     40286000
     <none>                                                             40288000
                                                                        40290000
Globals Altered:                                                        40292000
     BBUF is the buffer for the listing out routines.                   40294000
                                                                        40296000
Data Structures:                                                        40298000
     List of tables accessed as well as descriptions of tables          40300000
     used internally.                                                   40302000
                                                                        40304000
Algorithm:                                                              40306000
     The overhead area, vector table, and control block area            40308000
     of the file control block are formatted in sequence.               40310000
     Some componant parts are symbolically identified.                  40312000
                                                                        40314000
;                                                                       40316000
                                                               <<03077>>40318000
BEGIN                                                          <<03077>>40320000
  INTEGER VECTSIZE,                                            <<03077>>40322000
          COUNT,                                               <<03077>>40324000
          INDX,                                                <<03077>>40326000
          I;                                                   <<03077>>40328000
  LOGICAL GOODFLAG;                                            <<03077>>40330000
  DOUBLE  DSTADDR,                                             <<03077>>40332000
          CONTROLBLOCKBASE,                                    <<03077>>40334000
          VECTORADDR,                                          <<03077>>40336000
          ENDOFTABLE;                                          <<03077>>40338000
  LOGICAL ARRAY OFFSET(*)=VECTORADDR;                          <<03077>>40340000
  LOGICAL ARRAY VECTOR(0:3);                                   <<03077>>40342000
                                                               <<03077>>40344000
  DSTADDR:=DSTTOADDR(DSTNO);                                   <<03077>>40346000
  MOVE BBUF:="********** OVERHEAD AREA **********";            <<03077>>40348000
  PRINTLINE;                                                   <<03077>>40350000
  OCTALDUMP(DSTADDR,DSTADDR + 4D);                             <<03077>>40352000
  COUNT:=0;                  <<ENTRY COUNTER>>                 <<03077>>40354000
  INDX:=0;                   <<FOR COUNTING WORDS>>            <<03077>>40356000
  MOVE BBUF:="********** VECTOR TABLE:";                       <<03077>>40358000
  MOVE BBUF(38):="ENTRY  ADDRESS  LOCK  BRK";                  <<03077>>40360000
  MOVE BBUF(65):="LOCK COUNT/PIN   HIPRI TAIL";                <<03077>>40362000
  MOVE BBUF(94):="HIPRI HEAD  LOPRI TAIL  LOPRI HEAD";         <<03077>>40364000
  PRINTLINE;                 <<PRINT HEADER>>                  <<03077>>40366000
  VECTORADDR:=DSTADDR + 5D;                                    <<03077>>40368000
  VECTSIZE:=INTEGER(CORE(DSTADDR + 2D).(7:9));                 <<03077>>40370000
  DO                                                           <<03077>>40372000
  BEGIN                      <<FOR ALL OF TABLE>>              <<03077>>40374000
    I:=0;                                                      <<03077>>40376000
    GOODFLAG:=FALSE;         <<NO ENTRY YET>>                  <<03077>>40378000
    DO                                                         <<03077>>40380000
    BEGIN                    <<LOAD AND CHECK FOR ENTRY>>      <<03077>>40382000
      VECTOR(I):=CORE(VECTORADDR + DOUBLE(I));                 <<03077>>40384000
      IF VECTOR(I) <> 0 THEN GOODFLAG:=TRUE;                   <<03077>>40386000
      END                                                      <<03077>>40388000
      UNTIL (I:=I+1) = 4;   <<LOAD ALL OF ENTRY>>              <<03077>>40390000
    IF GOODFLAG THEN        <<IF ENTRY EXISTS>>                <<03077>>40392000
       BEGIN                                                   <<03077>>40394000
       @PBUF:=@BBUF;                                           <<03077>>40396000
       PUTNUM(OFFSET(1));   <<PRINT OFFSET>>                   <<03077>>40398000
       PBUF(-1):=":";  @PBUF:=@PBUF+1;                         <<03077>>40400000
       I:=0;                <<INIT SCAN>>                      <<03077>>40402000
       DO PUTNUM(VECTOR(I)) UNTIL (I:=I+1) = 4;                <<03077>>40404000
       @PBUF:=@BBUF+36;                                        <<03077>>40406000
       PUTNUMP(COUNT);      <<ENTRY NUMBER>>                   <<03077>>40408000
       @PBUF:=@BBUF+44;                                        <<03077>>40410000
       PUTNUMP(VECTOR(0));  <<DST OFFSET>>                     <<03077>>40412000
       IF VECTOR(1).(0:1)=1 THEN MOVE BBUF(54):="LOCK";        <<03077>>40414000
       IF VECTOR(1).(1:1)=1 THEN MOVE BBUF(60):="BRK";         <<03077>>40416000
       @PBUF:=@BBUF+69;                                        <<03077>>40418000
       PUTNUMP(VECTOR(1).(2:6));   <<LOCK COUNT>>              <<03077>>40420000
       @PBUF:=@BBUF+73;                                        <<03077>>40422000
       PUTNUMP(VECTOR(1).(8:8));   <<LOCK PIN>>                <<03077>>40424000
       IF VECTOR(2) <> 0 THEN                                  <<03077>>40426000
          BEGIN             <<PRINT HI PRI PINS>>              <<03077>>40428000
          @PBUF:=@BBUF+82;                                     <<03077>>40430000
          PUTNUMP(VECTOR(2).(0:8));<<HIPRI TAIL>>              <<03077>>40432000
          @PBUF:=@BBUF+94;                                     <<03077>>40434000
          PUTNUMP(VECTOR(2).(8:8));<<HIPRI HEAD>>              <<03077>>40436000
          END;               <<PRINT HI PRI PINS>>             <<03077>>40438000
       IF VECTOR(3) <> 0 THEN                                  <<03077>>40440000
          BEGIN              <<PRINT LOPRI PINS>>              <<03077>>40442000
          @PBUF:=@BBUF+106;                                    <<03077>>40444000
          PUTNUMP(VECTOR(2).(0:8));<<LOPRI TAIL>>              <<03077>>40446000
          @PBUF:=@BBUF+118;                                    <<03077>>40448000
          PUTNUMP(VECTOR(2).(8:8));<<LOPRI HEAD>>              <<03077>>40450000
          END;               <<PRINT LO PRI PINS>>             <<03077>>40452000
       PRINTLINE;                                              <<03077>>40454000
       END;                                                    <<03077>>40456000
    COUNT:=COUNT+1;          <<NEXT ENTRY>>                    <<03077>>40458000
    VECTORADDR:=VECTORADDR + 4D;                               <<03077>>40460000
    END                                                        <<03077>>40462000
    UNTIL (INDX:=INDX+4) = VECTSIZE;  <<TILL DONE>>            <<03077>>40464000
  MOVE BBUF:="********** CONTROL BLOCK AREA **********";       <<03077>>40466000
  PRINTLINE;                                                   <<03077>>40468000
  CONTROLBLOCKBASE:=DSTADDR+5D+DOUBLE(VECTSIZE);               <<03077>>40470000
  ENDOFTABLE:=DSTADDR + DOUBLE(CORE(DSTADDR)) - 1D;            <<03077>>40472000
  CHARFLAG:=TRUE;                                              <<03077>>40474000
  OCTALDUMP(CONTROLBLOCKBASE,ENDOFTABLE);                      <<03077>>40476000
  CHARFLAG:=FALSE;                                             <<03077>>40478000
END;                                                           <<03077>>40480000
                                                                        40482000
$PAGE "List'dfs'data'seg'info : List Disc Free Space info"              40484000
$CONTROL SEGMENT=TABLESDA                                               40486000
PROCEDURE List'Dfs'Data'Seg'Info (ldev, dfs'dst, error'status);<<03556>>40488000
   VALUE ldev, dfs'dst, error'status;                          <<03556>>40490000
   INTEGER ldev, dfs'dst;                                      <<03556>>40492000
   LOGICAL error'status;                                       <<03556>>40494000
COMMENT                                                                 40496000
                                                                        40498000
Purpose:                                                                40500000
   This procedure, passed the ldev number of a disc and                 40502000
   the disc free space management DST number and error                  40504000
   status from the LDTX entry for that ldev, will format                40506000
   the information, plus print the address of the DST, if               40508000
   it is present.                                                       40510000
                                                                        40512000
Input parameters:                                                       40514000
                                                                        40516000
Output parameters:                                                      40518000
                                                                        40520000
Globals Referenced:                                                     40522000
                                                                        40524000
Globals Altered:                                                        40526000
                                                                        40528000
Data Structures:                                                        40530000
                                                                        40532000
Algorithm:                                                              40534000
                                                                        40536000
;                                                                       40538000
BEGIN                                                          <<03556>>40540000
                                                               <<03556>>40542000
   ARRAY dfs'dst'entry (0:3);                                  <<03556>>40544000
                                                               <<03556>>40546000
$INCLUDE INCLDFS2                                              <<03556>>40548000
                                                               <<03556>>40550000
   << - - - - - - - - - - >>                                   <<03556>>40552000
                                                               <<03556>>40554000
   << Get DST entry for the data segment >>                    <<03556>>40556000
                                                               <<03556>>40558000
   Get'Dst'Entry (dfs'dst, dfs'dst'entry);                     <<03556>>40560000
                                                               <<03556>>40562000
   << List ldev and DST # >>                                   <<03556>>40564000
                                                               <<03556>>40566000
   Putnz (ldev, 5);                                            <<03556>>40568000
   Putnz (dfs'dst, 11);                                        <<03556>>40570000
                                                               <<03556>>40572000
   << If DST is present, list bank & address, otherwise say >> <<03556>>40574000
   << that it is absent                                     >> <<03556>>40576000
                                                               <<03556>>40578000
   IF dfs'dst'entry (0).(0:1) THEN                             <<03556>>40580000
      MOVE bbuf (16) := "Absent"                               <<03556>>40582000
   ELSE                                                        <<03556>>40584000
      BEGIN  << List bank & address >>                         <<03556>>40586000
                                                               <<03556>>40588000
         Putnz (dfs'dst'entry (2), 18);                        <<03556>>40590000
         bbuf (19) := "/";                                     <<03556>>40592000
         Putoctal (dfs'dst'entry (3), 27);                     <<03556>>40594000
                                                               <<03556>>40596000
      END;   << List bank & address >>                         <<03556>>40598000
                                                               <<03556>>40600000
   << List error status and print some info >>                 <<03556>>40602000
                                                               <<03556>>40604000
   Putoctal (error'status, 36);                                <<03556>>40606000
   IF error'status.error'type = no'error THEN                  <<03556>>40608000
      MOVE pbuf := "  No fatal errors"                         <<03556>>40610000
   ELSE                                                        <<03556>>40612000
      BEGIN  << Allocation was disabled >>                     <<03556>>40614000
                                                               <<03556>>40616000
         MOVE pbuf := ("  Allocation is disabled - error ",    <<03556>>40618000
                       "type "), 2;                            <<03556>>40620000
         @pbuf := TOS;                                         <<03556>>40622000
         Putnump (error'status.error'type);                    <<03556>>40624000
         IF error'status.attach'io'status <> 0 THEN            <<03556>>40626000
            BEGIN  << Attachio status set >>                   <<03556>>40628000
                                                               <<03556>>40630000
               MOVE pbuf := ", I/O status ", 2;                <<03556>>40632000
               @pbuf := TOS;                                   <<03556>>40634000
               Putnump (error'status.attach'io'status);        <<03556>>40636000
                                                               <<03556>>40638000
            END;   << Attachio status set >>                   <<03556>>40640000
                                                               <<03556>>40642000
      END;   << Allocation was disabled >>                     <<03556>>40644000
                                                               <<03556>>40646000
   Printline;                                                  <<03556>>40648000
                                                               <<03556>>40650000
END;  << List'Dfs'Data'Seg'Info >>                             <<03556>>40652000
                                                                        40654000
$PAGE "Print'DFS'Data'Seg'info : Format Disk Free Space info"           40656000
$CONTROL SEGMENT=TABLESDA                                               40658000
PROCEDURE Print'Dfs'Data'Seg'List;                             <<03556>>40660000
COMMENT                                                                 40662000
                                                                        40664000
Purpose:                                                                40666000
   This procedure formats the information about the disc                40668000
   free space management data segments that is in the LDTX,             40670000
   if the LDTX is present in memory.                                    40672000
                                                                        40674000
Input parameters:                                                       40676000
                                                                        40678000
Output parameters:                                                      40680000
                                                                        40682000
Globals Referenced:                                                     40684000
                                                                        40686000
Globals Altered:                                                        40688000
                                                                        40690000
Data Structures:                                                        40692000
                                                                        40694000
Algorithm:                                                              40696000
                                                                        40698000
;                                                                       40700000
BEGIN                                                          <<03556>>40702000
                                                               <<03556>>40704000
   EQUATE ldt'dst = 14;                                        <<03556>>40706000
   EQUATE ldt'entry'size = 5;                                  <<03556>>40708000
                                                               <<03556>>40710000
   ARRAY ldt'dst'entry (0:3);  << DST entry for #14 (LDT) >>   <<03556>>40712000
   DOUBLE ldt'address;                                         <<03556>>40714000
   INTEGER ldt'segment'length;                                 <<03556>>40716000
   INTEGER highest'ldev'number;                                <<03556>>40718000
   INTEGER ldtx'offset;                                        <<03556>>40720000
   ARRAY ldt'entry (0:ldt'entry'size-1);                       <<03556>>40722000
   ARRAY ldtx'entry (0:ldt'entry'size-1);                      <<03556>>40724000
                                                               <<03556>>40726000
   INTEGER ldev;                                               <<03556>>40728000
   INTEGER i;   << for use by subroutines ONLY >>              <<03556>>40730000
                                                               <<03556>>40732000
   << - - - - - - - - - - >>                                   <<03556>>40734000
                                                               <<03556>>40736000
   SUBROUTINE Get'Ldt'Entry (ldev'num, ldev'entry);            <<03556>>40738000
      VALUE ldev'num;                                          <<03556>>40740000
      INTEGER ldev'num;                                        <<03556>>40742000
      ARRAY ldev'entry;                                        <<03556>>40744000
                                                               <<03556>>40746000
   <<                                                       >> <<03556>>40748000
   << Returns the contents of the LDT entry for ldev'num in >> <<03556>>40750000
   << ldev'entry.  Ldt'address must be initialized.         >> <<03556>>40752000
   <<                                                       >> <<03556>>40754000
                                                               <<03556>>40756000
   BEGIN                                                       <<03556>>40758000
                                                               <<03556>>40760000
      i := 0;                                                  <<03556>>40762000
      WHILE i < ldt'entry'size DO                              <<03556>>40764000
         BEGIN  << Get entry >>                                <<03556>>40766000
                                                               <<03556>>40768000
            ldev'entry (i) := Core (ldt'address +              <<03556>>40770000
                      DOUBLE((ldev'num * ldt'entry'size) + i));<<03556>>40772000
            i := i + 1;                                        <<03556>>40774000
                                                               <<03556>>40776000
         END;   << Get entry >>                                <<03556>>40778000
                                                               <<03556>>40780000
   END;  << Get'Ldt'Entry >>                                   <<03556>>40782000
                                                               <<03556>>40784000
   << - - - - - - - - - - >>                                   <<03556>>40786000
                                                               <<03556>>40788000
   SUBROUTINE Get'Ldtx'Entry (ldev'num, ldev'entry);           <<03556>>40790000
      VALUE ldev'num;                                          <<03556>>40792000
      INTEGER ldev'num;                                        <<03556>>40794000
      ARRAY ldev'entry;                                        <<03556>>40796000
                                                               <<03556>>40798000
   <<                                                        >><<03556>>40800000
   << Returns the contents of the LDTX entry for ldev'num in >><<03556>>40802000
   << ldev'entry.  Ldt'address and ldtx'offset must be       >><<03556>>40804000
   << initialized.                                           >><<03556>>40806000
   <<                                                          <<03556>>40808000
                                                               <<03556>>40810000
   BEGIN                                                       <<03556>>40812000
                                                               <<03556>>40814000
      i := 0;                                                  <<03556>>40816000
      WHILE i < ldt'entry'size DO                              <<03556>>40818000
         BEGIN  << Get the entry >>                            <<03556>>40820000
                                                               <<03556>>40822000
            ldev'entry (i) := Core (ldt'address +              <<03556>>40824000
                           DOUBLE (ldtx'offset +               <<03556>>40826000
                           (ldev'num * ldt'entry'size) + i));  <<03556>>40828000
            i := i + 1;                                        <<03556>>40830000
                                                               <<03556>>40832000
         END;   << Get the entry >>                            <<03556>>40834000
                                                               <<03556>>40836000
   END;  << Get'Ldtx'Entry >>                                  <<03556>>40838000
                                                               <<03556>>40840000
   << - - - - - - - - - >>                                     <<03556>>40842000
                                                               <<03556>>40844000
   Newpage;                                                    <<03556>>40846000
   indxaray ((lstsysdst + 2) * 2) := pageno;                   <<03556>>40848000
   MOVE bbuf (15) := "= = = = Disc Free Space Management ",2;  <<03556>>40850000
   MOVE * := "Data Segments (all numbers are octal)",2;        <<03556>>40852000
   MOVE * := " = = = =";                                       <<03556>>40854000
   Printline;                                                  <<03556>>40856000
   Printline;                                                  <<03556>>40858000
                                                               <<03556>>40860000
   << We need to run through the LDT & LDTX to find all >>     <<03556>>40862000
   << discs have disc free space maps.                  >>     <<03556>>40864000
                                                               <<03556>>40866000
   << Get LDT DST entry >>                                     <<03556>>40868000
                                                               <<03556>>40870000
   Get'Dst'Entry (ldt'dst, ldt'dst'entry);                     <<03556>>40872000
                                                               <<03556>>40874000
   IF ldt'dst'entry (0).(0:1) THEN                             <<03556>>40876000
      BEGIN  << LDT not present >>                             <<03556>>40878000
                                                               <<03556>>40880000
         Printline;                                            <<03556>>40882000
         Printline;                                            <<03556>>40884000
         MOVE bbuf := (" Can not list Disc Free Space",        <<03556>>40886000
                       " management data segments ",           <<03556>>40888000
                       "because the ");                        <<03556>>40890000
         Printline;                                            <<03556>>40892000
         MOVE bbuf := ("Logical Device Table (LDT - DST %16)", <<03556>>40894000
                       " is absent from main memory ");        <<03556>>40896000
         Printline;                                            <<03556>>40898000
         Printline;                                            <<03556>>40900000
         Return;                                               <<03556>>40902000
                                                               <<03556>>40904000
      END;    << LDT not present >>                            <<03556>>40906000
                                                               <<03556>>40908000
   << Get address of the LDT data segment >>                   <<03556>>40910000
                                                               <<03556>>40912000
   TOS := ldt'dst'entry (2);                                   <<03556>>40914000
   TOS := ldt'dst'entry (3);                                   <<03556>>40916000
   ldt'address := TOS;                                         <<03556>>40918000
   ldt'segment'length := ldt'dst'entry (0).(3:13) * 4;         <<03556>>40920000
                                                               <<03556>>40922000
   << Get LDT/LDTX header info >>                              <<03556>>40924000
                                                               <<03556>>40926000
   Get'Ldt'Entry (0, ldt'entry);                               <<03556>>40928000
                                                               <<03556>>40930000
   highest'ldev'number := ldt'entry (0).(0:8);                 <<03556>>40932000
   ldtx'offset := ldt'entry (1) + ldt'entry (3);               <<03556>>40934000
                                                               <<03556>>40936000
   << Test if the info we got out of the header seems good >>  <<03556>>40938000
                                                               <<03556>>40940000
   IF (ldtx'offset + (highest'ldev'number *                    <<03556>>40942000
   ldt'entry'size - 1)) > ldt'segment'length THEN              <<03556>>40944000
      BEGIN  << LDT header looks bad >>                        <<03556>>40946000
                                                               <<03556>>40948000
         Printline;                                            <<03556>>40950000
         Printline;                                            <<03556>>40952000
         MOVE bbuf := (" * * * * * * The LDT header appears",  <<03556>>40954000
                       " to have invalid data, can not list ", <<03556>>40956000
                       "Disc Free Space management data ",     <<03556>>40958000
                       "segments * * * * * *");                <<03556>>40960000
         Printline;                                            <<03556>>40962000
         Printline;                                            <<03556>>40964000
         RETURN;                                               <<03556>>40966000
                                                               <<03556>>40968000
      END;   << LDT header looks bad >>                        <<03556>>40970000
                                                               <<03556>>40972000
   << Print the list header >>                                 <<03556>>40974000
                                                               <<03556>>40976000
   MOVE bbuf (2) := "Ldev";                                    <<03556>>40978000
   MOVE bbuf (8) := "DST #";                                   <<03556>>40980000
   MOVE bbuf (15) := "Bank/Address";                           <<03556>>40982000
   MOVE bbuf (29) := "Error status";                           <<03556>>40984000
   Printline;                                                  <<03556>>40986000
                                                               <<03556>>40988000
   MOVE bbuf (2) := "----";                                    <<03556>>40990000
   MOVE bbuf (8) := "-----";                                   <<03556>>40992000
   MOVE bbuf (15) := "------------";                           <<03556>>40994000
   MOVE bbuf (29) := "------------";                           <<03556>>40996000
   Printline;                                                  <<03556>>40998000
   Printline;                                                  <<03556>>41000000
                                                               <<03556>>41002000
   << Run through LDT & LDTX and find all discs that have >>   <<03556>>41004000
   << the ldtx'dfs'dst'word or ldtx'dfs'error'word non-   >>   <<03556>>41006000
   << zero print out info about it.                       >>   <<03556>>41008000
                                                               <<03556>>41010000
   FOR ldev := 1 UNTIL highest'ldev'number DO                  <<03556>>41012000
      BEGIN  << Look for discs with a free space map >>        <<03556>>41014000
                                                               <<03556>>41016000
         Get'Ldt'Entry (ldev, ldt'entry);                      <<03556>>41018000
                                                               <<03556>>41020000
         << Check if its a disc (type < 8) >>                  <<03556>>41022000
                                                               <<03556>>41024000
         IF ldt'entry (2).(10:6) < 8 AND                       <<03556>>41026000
            ldt'entry (2) <> 0 THEN                            <<03556>>41028000
            BEGIN  << Its a disc >>                            <<03556>>41030000
                                                               <<03556>>41032000
               Get'Ldtx'Entry (ldev, ldtx'entry);              <<03556>>41034000
                                                               <<03556>>41036000
               IF ldtx'entry (2) <> 0 OR                       <<03556>>41038000
               ldtx'entry (3) <> 0 THEN                        <<03556>>41040000
                  BEGIN  << Some DFS info in LDTX >>           <<03556>>41042000
                                                               <<03556>>41044000
                     List'Dfs'Data'Seg'Info (ldev,             <<03556>>41046000
                             ldtx'entry (2), ldtx'entry (3));  <<03556>>41048000
                                                               <<03556>>41050000
                  END;   << Some DFS info in LDTX >>           <<03556>>41052000
                                                               <<03556>>41054000
            END;   << Its a disc >>                            <<03556>>41056000
                                                               <<03556>>41058000
      END;   << Look for discs with a free space map >>        <<03556>>41060000
                                                               <<03556>>41062000
END;   << Print'Dfs'Data'Seg'List >>                           <<03556>>41064000
                                                                        41066000
$PAGE "PRINTPXFILE : Format the PXFILE area"                            41068000
$CONTROL SEGMENT=MEMORY                                                 41070000
PROCEDURE PRINTPXFILE(DSTNUM,PXFADDR);                         <<00221>>41072000
   VALUE DSTNUM,PXFADDR;                                       <<00221>>41074000
   LOGICAL DSTNUM;            <<DST NUMBER OF DST FORMATTED>>  <<00221>>41076000
   DOUBLE PXFADDR;            <<ADDRESS IN CORE OF PXFILE>>    <<00221>>41078000
COMMENT                                                                 41080000
                                                                        41082000
Purpose:                                                                41084000
       This procedure will verify the construction of the               41086000
       pxfile area of the pcbx and print the pxfile area                41088000
       formatting the vector table, control block area, and             41090000
       aft.  If anything is not correct, an octal dump of               41092000
       pxfile area is produced.                                         41094000
                                                                        41096000
Input parameters:                                                       41098000
                                                                        41100000
Output parameters:                                                      41102000
                                                                        41104000
Globals Referenced:                                                     41106000
                                                                        41108000
Globals Altered:                                                        41110000
                                                                        41112000
Data Structures:                                                        41114000
                                                                        41116000
Algorithm:                                                              41118000
                                                                        41120000
;                                                                       41122000
 BEGIN             <<BEGIN PROCEDURE PXFILEPRINT>>             <<00221>>41124000
   LOGICAL ARRAY WORK(0:3);       <<FOR CONTAINING ENTRY>>     <<00221>>41126000
   LOGICAL ARRAY WORK1(*)=WORK;                                <<00221>>41128000
   LOGICAL ARRAY WORK2(*)=WORK(1);                             <<00221>>41130000
   LOGICAL ARRAY WORK3(*)=WORK(2);                             <<00221>>41132000
   LOGICAL ARRAY WORK4(*)=WORK(3);                             <<00221>>41134000
   LOGICAL INDX,COUNT,I;          <<FOR TABLE ENTRY PRINTING>> <<00221>>41136000
   DOUBLE SCRATCH,SCRATCHX;       <<FOR ADDRESS CALCULATION>>  <<00221>>41138000
    LOGICAL ARRAY SCR(*)=SCRATCHX;                             <<00221>>41140000
   LOGICAL PXFILSIZE;             <<SIZE OF PXFILE AREA>>      <<00221>>41142000
   LOGICAL PXFCBTSIZE;            <<SIZE OF CONTROL BLOCK>>    <<00221>>41144000
   LOGICAL VECTSIZE;              <<SIZE OF VECTOR TABLE>>     <<00221>>41146000
   LOGICAL AFTSIZE;               <<SIZE OF AFT AREA>>         <<00221>>41148000
   LOGICAL DSTPXFCBT;             <<DST OF TABLE>>             <<00221>>41150000
   LOGICAL GOODFLAG;              <<ENTRY IS GOOD FLAG>>       <<00221>>41152000
                                                               <<00221>>41154000
   PXFILSIZE:=CORE(PXFADDR);      <<GET TABLE SIZE>>           <<00221>>41156000
   IF PXFILSIZE > %22 THEN                                     <<00221>>41158000
    BEGIN                         <<BIG ENOUGH TO FORMAT>>     <<00221>>41160000
     AFTSIZE:=CORE(PXFADDR+5D);   <<GET AFTSIZE>>              <<00221>>41162000
     PXFCBTSIZE:=CORE(PXFADDR+%20D); <<CONTROL BLOCK SIZE>>    <<00221>>41164000
     DSTPXFCBT:=CORE(PXFADDR+%21D);<<DST NUMBER CONTAINING>>   <<00221>>41166000
     VECTSIZE:=CORE(PXFADDR+%22D); <<SIZE OF THE VECTOR>>      <<00221>>41168000
     IF AFTSIZE = 0 LAND PXFCBTSIZE = 0 THEN                   <<00221>>41170000
      BEGIN                       <<EMPTY PXFILE>>             <<00221>>41172000
       MOVE BBUF(11):="(CONTAINS NO CONTROL BLOCKS)";          <<00221>>41174000
       PRINTLINE;                                              <<00221>>41176000
       OCTALDUMP(PXFADDR,PXFADDR+DOUBLE(PXFILSIZE)-1D);        <<00221>>41178000
      END                         <<EMPTY PXFILE>>             <<00221>>41180000
     ELSE                                                      <<00221>>41182000
      BEGIN                       <<CONTAINS DATA>>            <<00221>>41184000
       IF PXFILSIZE > (%20+AFTSIZE+PXFCBTSIZE)                 <<00221>>41186000
          LAND VECTSIZE+5 < PXFCBTSIZE  THEN                   <<00221>>41188000
        BEGIN                     <<PUT TOGETHER OK>>          <<00221>>41190000
         IF DSTNUM = DSTPXFCBT THEN                            <<00221>>41192000
         BEGIN                    <<TABLES ARE IN STACK>>      <<00221>>41194000
        MOVE BBUF(11):="(ZERO TABLE ENTRIES ARE NOT PRINTED)"; <<00221>>41196000
         PRINTLINE;                                            <<00221>>41198000
         OCTALDUMP(PXFADDR,PXFADDR+%24D); <<DUMP OVERFHEAD>>   <<00221>>41200000
                                                               <<00221>>41202000
         IF VECTSIZE > 0 LAND VECTSIZE < PXFCBTSIZE THEN       <<00221>>41204000
          BEGIN                           <<POSSIBLE VECTOR>>  <<00221>>41206000
           IF VECTSIZE.(14:2) <> 0 THEN                        <<00221>>41208000
            BEGIN                       <<BAD SIZE>>           <<00221>>41210000
             MOVE BBUF:="???? INVALID VECTOR TABLE SIZE:";     <<00221>>41212000
             @PBUF:=@BBUF+31;                                  <<00221>>41214000
             PUTNUM(VECTSIZE);          <<PRINT BAD SIZE>>     <<00221>>41216000
             PRINTLINE;                                        <<00221>>41218000
             OCTALDUMP(PXFADDR+%25D,                           <<00221>>41220000
                       PXFADDR+%24D+DOUBLE(VECTSIZE));         <<00221>>41222000
            END                         <<BAD SIZE>>           <<00221>>41224000
           ELSE                                                <<00221>>41226000
            BEGIN                       <<VECTOR TABLE OK>>    <<00221>>41228000
             COUNT:=0;                  <<SCAN COUNTER>>       <<00221>>41230000
             SCRATCH:=PXFADDR+%25D;     <<VECTOR ADDRESS>>     <<00221>>41232000
             DO                                                <<00221>>41234000
              WORK1:=CORE(SCRATCH+DOUBLE(COUNT))               <<00221>>41236000
             UNTIL (GOODFLAG:=(WORK1<>0)) LOR                  <<00221>>41238000
                   (COUNT:=COUNT+1)=VECTSIZE;  <<EMPTY CHECK>> <<00221>>41240000
             IF GOODFLAG THEN                                  <<00221>>41242000
             BEGIN                 <<VECTOR TABLE NOT EMPTY>>  <<00221>>41244000
             COUNT:=0;                  <<ENTRY COUNTER>>      <<00221>>41246000
             INDX:=0;                   <<FOR COUNTING WORDS>> <<00221>>41248000
             MOVE BBUF:="------- FILE VECTOR TABLE:";          <<00221>>41250000
             MOVE BBUF(38):="ENTRY  ADDRESS  LOCK  BRK";       <<00221>>41252000
             MOVE BBUF(65):="LOCK COUNT/PIN   HIPRI TAIL";     <<00221>>41254000
          MOVE BBUF(94):="HIPRI HEAD  LOPRI TAIL  LOPRI HEAD"; <<00221>>41256000
             PRINTLINE;                 <<PRINT HEADER>>       <<00221>>41258000
             SCRATCHX:=PXFADDR+%25D;  <<ADDR OF VECTOR TABLE>> <<00221>>41260000
             DO                                                <<00221>>41262000
              BEGIN                     <<FOR ALL OF TABLE>>   <<00221>>41264000
               I:=0;                                           <<00221>>41266000
               GOODFLAG:=FALSE;      <<NO ENTRY YET>>          <<00221>>41268000
               DO                                              <<00221>>41270000
                BEGIN        <<LOAD AND CHECK FOR ENTRY>>      <<00221>>41272000
                WORK(I):=CORE(SCRATCHX+DOUBLE(I));             <<00221>>41274000
                IF WORK(I) <> 0 THEN GOODFLAG:=TRUE;           <<00221>>41276000
                END                                            <<00221>>41278000
                  UNTIL (I:=I+1) = 4;  <<LOAD ALL OF ENTRY>>   <<00221>>41280000
               IF GOODFLAG THEN        <<IF ENTRY EXISTS>>     <<00221>>41282000
               BEGIN                   <<GO AHEAD AND PRINT>>  <<00221>>41284000
               @PBUF:=@BBUF;                                   <<00221>>41286000
               PUTNUM(SCR(1));          <<PRINT OFFSET>>       <<00221>>41288000
               PBUF(-1):=":";  @PBUF:=@PBUF+1;                 <<00221>>41290000
               I:=0;              <<INIT SCAN>>                <<00221>>41292000
               DO                                              <<00221>>41294000
                PUTNUM(WORK(I))  UNTIL (I:=I+1) = 4;           <<00221>>41296000
               @PBUF:=@BBUF+36;                                <<00221>>41298000
               PUTNUMP(COUNT);        <<ENTRY NUMBER>>         <<00221>>41300000
               @PBUF:=@BBUF+44;                                <<00221>>41302000
               PUTNUMP(WORK1);        <<DST OFFSET>>           <<00221>>41304000
               IF WORK2.(0:1)=1 THEN MOVE BBUF(54):="LOCK";    <<00221>>41306000
               IF WORK2.(1:1)=1 THEN MOVE BBUF(60):="BRK";     <<00221>>41308000
               @PBUF:=@BBUF+69;                                <<00221>>41310000
               PUTNUMP(WORK2.(2:6));   <<LOCK COUNT>>          <<00221>>41312000
               @PBUF:=@BBUF+73;                                <<00221>>41314000
               PUTNUMP(WORK2.(8:8));  <<LOCK PIN>>             <<00221>>41316000
               IF WORK3 <> 0 THEN                              <<00221>>41318000
                BEGIN                 <<PRINT HI PRI PINS>>    <<00221>>41320000
                 @PBUF:=@BBUF+82;                              <<00221>>41322000
                 PUTNUMP(WORK3.(0:8));<<HIPRI TAIL>>           <<00221>>41324000
                 @PBUF:=@BBUF+94;                              <<00221>>41326000
                 PUTNUMP(WORK3.(8:8));<<HIPRI HEAD>>           <<00221>>41328000
                END;                  <<PRINT HI PRI PINS>>    <<00221>>41330000
               IF WORK4 <> 0 THEN                              <<00221>>41332000
                BEGIN                 <<PRINT LOPRI PINS>>     <<00221>>41334000
                 @PBUF:=@BBUF+106;                             <<00221>>41336000
                 PUTNUMP(WORK3.(0:8));<<LOPRI TAIL>>           <<00221>>41338000
                 @PBUF:=@BBUF+118;                             <<00221>>41340000
                 PUTNUMP(WORK3.(8:8));<<LOPRI HEAD>>           <<00221>>41342000
                END;                  <<PRINT LO PRI PINS>>    <<00221>>41344000
               PRINTLINE;            <<PRINT THE LINE>>        <<00221>>41346000
               END;                    <<GO AHEAD AND PRINT>>  <<00221>>41348000
               COUNT:=COUNT+1;       <<NEXT ENTRY>>            <<00221>>41350000
               SCRATCHX:=SCRATCHX+4D;  <<TO NEXT ENTRY>>       <<00221>>41352000
              END                       <<FOR ALL OF TABLE>>   <<00221>>41354000
               UNTIL (INDX:=INDX+4) = VECTSIZE;  <<TILL DONE>> <<00221>>41356000
             END                                               <<00221>>41358000
             ELSE                                              <<00221>>41360000
             BEGIN                 <<EMPTY VECTOR TABLE>>      <<00221>>41362000
              MOVE BBUF:="-- VECTOR TABLE EMPTY (ALL ZERO)";   <<00221>>41364000
              PRINTLINE;                                       <<00221>>41366000
             END;                  <<EMPTY VECTOR TABLE>>      <<00221>>41368000
            END;                        <<VECTOR TABLE OK>>    <<00221>>41370000
             <<FORMAT AND PRINT CB AREA>>                      <<00221>>41372000
             MOVE BBUF:="------- CONTROL BLOCKS:";             <<00221>>41374000
             PRINTLINE;                                        <<00221>>41376000
             SCRATCHX:=DBADR;           <<SAVE DB ADDRESS>>    <<00221>>41378000
             INDX:=CORE(PXFADDR+DOUBLE(PXFILSIZE)+3D);         <<00221>>41380000
             DBADR:=DOUBLE(INDX-PXFILSIZE+%14);                <<00221>>41382000
             CHARFLAG:=TRUE;            <<CHARACTER FLAG ON>>  <<00221>>41384000
             SCRATCH:=PXFADDR+%25D+DOUBLE(VECTSIZE);<<START>>  <<00221>>41386000
           OCTALDUMP(SCRATCH,PXFADDR+DOUBLE(PXFCBTSIZE)+%17D); <<00221>>41388000
             CHARFLAG:=FALSE;                                  <<00221>>41390000
             DBADR:=SCRATCHX;        <<RESTORE DB,CHARFLAG>>   <<00221>>41392000
                                                               <<00221>>41394000
             <<DUMP OUT AVAILABLE AREA>>                       <<00221>>41396000
             SCRATCH:=PXFADDR+DOUBLE(PXFCBTSIZE)+%20D;<<STRT>> <<00221>>41398000
             SCRATCHX:=PXFADDR+DOUBLE(PXFILSIZE-AFTSIZE)-1D;   <<00221>>41400000
             OCTALDUMP(SCRATCH,SCRATCHX);                      <<00221>>41402000
                                                               <<00221>>41404000
             <<DUMP AFT AREA>>                                 <<00221>>41406000
             IF AFTSIZE.(14:2) = 0 THEN                        <<00221>>41408000
              BEGIN                        <<AFT SIZE IS OK>>  <<00221>>41410000
               IF AFTSIZE > 0 THEN                             <<00221>>41412000
                BEGIN                      <<ENTRIES IN AFT>>  <<00221>>41414000
                 COUNT:=0;                 <<NUM WORDS>>       <<00221>>41416000
                 SCRATCH:=SCRATCHX+1D;     <<CORE LOC>>        <<00221>>41418000
                 DO                                            <<00221>>41420000
                  WORK1:=CORE(SCRATCH+DOUBLE(COUNT))           <<00221>>41422000
                 UNTIL (GOODFLAG:=(WORK1<>0)) LOR              <<00221>>41424000
                       (COUNT:=COUNT+1) =AFTSIZE;  <<EMPTY??>> <<00221>>41426000
                 IF GOODFLAG THEN                              <<00221>>41428000
                 BEGIN                      <<AFT NOT EMPTY>>  <<00221>>41430000
                 MOVE BBUF:="------- AVAILABLE FILE TABLE:";   <<00221>>41432000
                 MOVE BBUF(37):="FNUM   FTYPE  $NULL   PACB";  <<00221>>41434000
                 MOVE BBUF(64):="V     LACB V   IOQX";         <<00221>>41436000
                 PRINTLINE;                                    <<00221>>41438000
                 SCRATCHX:=SCRATCHX+1D;    <<POINT TO ENTRY>>  <<00221>>41440000
                 COUNT:=AFTSIZE/4;         <<FILE NUMBER>>     <<00221>>41442000
                 DO                                            <<00221>>41444000
                  BEGIN                    <<FOR EACH FILE>>   <<00221>>41446000
                   I:=0;                   <<LOAD ENTRY>>      <<00221>>41448000
                   GOODFLAG:=FALSE;        <<NO ENTRY YET>>    <<00221>>41450000
                   DO                                          <<00221>>41452000
                    BEGIN                  <<LOAD AND CHECK>>  <<00221>>41454000
                    WORK(I):=CORE(SCRATCHX+DOUBLE(I));         <<00221>>41456000
                    IF WORK(I) <> 0 THEN GOODFLAG:=TRUE;       <<00221>>41458000
                    END                    <<LOAD AND CHECK>>  <<00221>>41460000
                     UNTIL  (I:=I+1) = 4;                      <<00221>>41462000
                  IF GOODFLAG THEN        <<ENTRY NON ZERO?>>  <<00221>>41464000
                   BEGIN                  <<PRINT THE ENTRY>>  <<00221>>41466000
                   @PBUF:=@BBUF;                               <<00221>>41468000
                   PUTNUM(SCR(1));   <<OFFSET IN BANK>>        <<00221>>41470000
                     PBUF(-1):=":";  @PBUF:=@PBUF+1;           <<00221>>41472000
                   I:=0;                                       <<00221>>41474000
                   DO                                          <<00221>>41476000
                    PUTNUM(WORK(I))  UNTIL (I:=I+1) = 4;       <<00221>>41478000
                   @PBUF:=@BBUF+35;                            <<00221>>41480000
                   PUTNUMP(COUNT);         <<FILE NUMBER>>     <<00221>>41482000
                   PUTNUMP(WORK1.(0:4));   <<FILE TYPE>>       <<00221>>41484000
                   CASE WORK1.(0:4) OF                         <<00221>>41486000
                    BEGIN                  <<FILE TYPES>>      <<00221>>41488000
                      MOVE BBUF(44):=" FILE ";                 <<00221>>41490000
                      MOVE BBUF(44):="REMOTE";                 <<00221>>41492000
                      MOVE BBUF(44):="  DS  ";                 <<00221>>41494000
                      MOVE BBUF(44):="  DS  ";                 <<00221>>41496000
                      MOVE BBUF(44):="  CS  ";                 <<00221>>41498000
                      MOVE BBUF(44):="  CS  ";                 <<00221>>41500000
                      MOVE BBUF(44):=" KSAM ";                 <<00221>>41502000
                    END;                   <<FILE TYPES>>      <<00221>>41504000
                   IF WORK1.(4:1)=1 THEN                       <<00221>>41506000
                     MOVE BBUF(51):="$NULL";                   <<00221>>41508000
                   @PBUF:=@BBUF+54;                            <<00221>>41510000
                   PUTNUMP(WORK2.(0:6));  <<OFFSET IN VECTOR>> <<00221>>41512000
                   @PBUF:=@PBUF-2;                             <<00221>>41514000
                   PUTNUMP(WORK2.(6:10));<<DST NUMBER VECTOR>> <<00221>>41516000
                   @PBUF:=@BBUF+65;                            <<00221>>41518000
                   PUTNUMP(WORK3.(0:6)); <<OFFSET IN VECTOR>>  <<00221>>41520000
                   @PBUF:=@PBUF-2;                             <<00221>>41522000
                   PUTNUMP(WORK3.(6:10));<<DST NUMBER VECTOR>> <<00221>>41524000
                   @PBUF:=@BBUF+78;                            <<00221>>41526000
                   IF WORK4 <> 0 THEN PUTNUM(WORK4);           <<00221>>41528000
                    PRINTLINE;                                 <<00221>>41530000
                   END;                   <<PRINT THE ENTRY>>  <<00221>>41532000
                   SCRATCHX:=SCRATCHX+4D;     <<NEXT ENTRY>>   <<00221>>41534000
                  END                      <<FOR EACH FILE>>   <<00221>>41536000
                   UNTIL (COUNT:=COUNT-1) = 0;                 <<00221>>41538000
                 END                        <<AFT NOT EMPTY>>  <<00221>>41540000
                 ELSE                                          <<00221>>41542000
                 BEGIN                      <<ALL ZERO AFT>>   <<00221>>41544000
                 MOVE BBUF:="-- AFT IS EMPTY (ALL ZERO)";      <<00221>>41546000
                 PRINTLINE;                                    <<00221>>41548000
                 END;                       <<ALL ZERO AFT>>   <<00221>>41550000
                END                        <<ENTRIES IN AFT>>  <<00221>>41552000
               ELSE                                            <<00221>>41554000
                BEGIN                      <<AFT EMPTY>>       <<00221>>41556000
                 MOVE BBUF:="--- AFT TABLE EMPTY";             <<00221>>41558000
                 PRINTLINE;                                    <<00221>>41560000
                END;                       <<AFT EMPTY>>       <<00221>>41562000
              END                          <<AFT SIZE IS OK>>  <<00221>>41564000
             ELSE                                              <<00221>>41566000
              BEGIN                    <<INVALID AFT SIZE>>    <<00221>>41568000
               MOVE BBUF:="???? INVALID AFT SIZE:";            <<00221>>41570000
               @PBUF:=@BBUF+22;                                <<00221>>41572000
               PUTNUM(AFTSIZE);                                <<00221>>41574000
             OCTALDUMP(SCRATCHX,PXFADDR+DOUBLE(PXFILSIZE)-1D); <<00221>>41576000
              END;                     <<INVALID AFT SIZE>>    <<00221>>41578000
          END                             <<POSSIBLE VECTOR>>  <<00221>>41580000
         ELSE                                                  <<00221>>41582000
          BEGIN                           <<BAD CBT AREA>>     <<00221>>41584000
           MOVE BBUF:="???? (BAD VECTOR TABLE SIZE) ????";     <<00221>>41586000
           PRINTLINE;                                          <<00221>>41588000
           OCTALDUMP(PXFADDR,PXFADDR+DOUBLE(PXFILSIZE)-1D);    <<00221>>41590000
          END;                                                 <<00221>>41592000
         END                      <<TABLES ARE IN STACK>>      <<00221>>41594000
         ELSE                                                  <<00221>>41596000
         BEGIN                    <<;NOCB ON RUN>>             <<00221>>41598000
          MOVE BBUF(11):="(CONTROL BLOCKS ARE IN DST";         <<00221>>41600000
          @PBUF:=@BBUF(34);       <<FOR DST DISPLAY>>          <<00221>>41602000
          PUTNUMP(DSTPXFCBT);     <<PUT DST OF CB>>            <<00221>>41604000
          PBUF(-1):=")";                                       <<00221>>41606000
          PRINTLINE;              <<PRINT THE MSG>>            <<00221>>41608000
          OCTALDUMP(PXFADDR,PXFADDR+DOUBLE(PXFILSIZE)-1D);     <<00221>>41610000
         END;                     <<;NOCB ON RUN>>             <<00221>>41612000
        END                       <<PUT TOGETHER OK>>          <<00221>>41614000
       ELSE                                                    <<00221>>41616000
        BEGIN                     <<TABLE SIZES ERROR>>        <<00221>>41618000
         MOVE BBUF(11):="???? (TABLE SIZES OVERLAP) ????";     <<00221>>41620000
         PRINTLINE;                                            <<00221>>41622000
         OCTALDUMP(PXFADDR,PXFADDR+DOUBLE(PXFILSIZE)-1D);      <<00221>>41624000
        END;                      <<TABLE SIZES ERROR>>        <<00221>>41626000
      END;                        <<CONTAINS DATA>>            <<00221>>41628000
    END                           <<BIG ENOUGH TO FORMAT>>     <<00221>>41630000
   ELSE                                                        <<00221>>41632000
    BEGIN                         <<TOO SMALL TO FORMAT>>      <<00221>>41634000
     MOVE BBUF(11):="???? (PXFILE TOO SMALL TO FORMAT) ????";  <<00221>>41636000
     PRINTLINE;                                                <<00221>>41638000
     OCTALDUMP(PXFADDR,PXFADDR+DOUBLE(PXFILSIZE)-1D);          <<00221>>41640000
    END;                           <<TOO SMALL TO FORMAT>>     <<00221>>41642000
 END;              <<END   PROCEDURE PXFILEPRINT>>             <<00221>>41644000
$PAGE "CATEGORIZE'DST: Classify DSTs in array DST'TYPE"                 41646000
$CONTROL SEGMENT=INIT                                                   41648000
PROCEDURE CATEGORIZE'DST;                                      <<03078>>41650000
COMMENT                                                                 41652000
                                                                        41654000
Purpose:                                                                41656000
            This procedure and its related procedures --                41658000
            search'cbts, search'pacb, cbt'stack, cbt'exds,              41660000
            curr'process --  are designed to categorize a               41662000
            limited set of dst. This procedure searches the             41664000
            pcb finding assigned entries and using the                  41666000
            information in the pcb finds its stack and the              41668000
            corresponding dst's.  The byte array dst'type is            41670000
            set in the following manner to classify the dst's.          41672000
                                                                        41674000
              array entry            dst type                           41676000
              -----------            --------                           41678000
                   0                 array position not set             41680000
                   1                 process stack                      41682000
                   2                 extra ds of curr process           41684000
                   3                 fcb                                41686000
                   4                                                    41688000
                   5                 fcb                                41690000
                   6                 fcb                                41692000
                   7                 jit of current process             41694000
                   8                 jdt of current process             41696000
                   9                 user logging of curr proc          41698000
                  10                 udc of current process             41700000
                  11                 current process stack              41702000
                  12                 terminal buffer & dit              41704000
                  13                 system dst                         41706000
                  14                 requested dst                      41708000
                  15                 dev/process xds                    41710000
                  16                 ds job xds                         41712000
                  17                 cs misc dst                        41714000
                                                                        41716000
                                                                        41718000
           currently 9 and 10 are not searched for and others           41720000
           can be added when the need arises.                           41722000
                                                                        41724000
Input parameters:                                                       41726000
                                                                        41728000
Output parameters:                                                      41730000
                                                                        41732000
Globals Referenced:                                                     41734000
                                                                        41736000
Globals Altered:                                                        41738000
                                                                        41740000
Data Structures:                                                        41742000
                                                                        41744000
Algorithm:                                                              41746000
                                                                        41748000
;                                                                       41750000
BEGIN                                                          <<03078>>41752000
  INTEGER PCBENTRIES,                                          <<03078>>41754000
          ENTRYCOUNT,                                          <<03078>>41756000
          PCBSIZE,                                             <<03078>>41758000
          INDX;                                                <<03078>>41760000
  LOGICAL CURR'PIN,                                            <<03078>>41762000
          DSTENTRIES,                                          <<03670>>41764000
          DSTNO;                                               <<03078>>41766000
  DOUBLE  LOCPCB,                                              <<03078>>41768000
          DSTENTRY,                                            <<03078>>41770000
          STACKADDR,                                           <<03078>>41772000
          DLREG;                                               <<03078>>41774000
                                                               <<03078>>41776000
  MOVE DST'TYPE:=1024(0);                                      <<03078>>41778000
  INDX:= 0;                                                    <<03078>>41780000
  DO BEGIN                                                     <<03078>>41782000
     MOVE DST'TYPE(INDX):= 13;                                 <<03078>>41784000
     INDX:=INDX + 1;                                           <<03078>>41786000
     END                                                       <<03078>>41788000
     UNTIL INDX > LSTSYSDST;                                   <<03078>>41790000
  MOVE DST'TYPE(%14):= 12;                                     <<03078>>41792000
                                                               <<03078>>41794000
  CURR'PIN:=CORE(4D);                                          <<03078>>41796000
  PCBENTRIES:=CORE(PCBDEFIN) - CORE(PCBDEFIN + 2D);            <<03078>>41798000
  DSTENTRIES := CORE(DSTDEFIN);                                <<03670>>41800000
  LOCPCB:=PCBDEFIN;                                            <<03078>>41802000
  INDX:= 1;                                                    <<03078>>41804000
                                                                        41806000
  PCBSIZE:= %20;                                               <<03078>>41808000
  ENTRYCOUNT:= 0;                                              <<03078>>41810000
                                                               <<03078>>41812000
  WHILE ENTRYCOUNT < PCBENTRIES DO                             <<03078>>41814000
    BEGIN                                                      <<03078>>41816000
    IF PCB15 = %177777 THEN                                    <<03670>>41818000
       INDX:=INDX + 1                                          <<03078>>41820000
    ELSE                                                       <<03078>>41822000
       BEGIN                                                   <<03078>>41824000
       DSTNO:=PCB03.(1:10);                                    <<03078>>41826000
                                                               <<03670>>41828000
       IF DSTNO <> 0 AND DSTNO <= DSTENTRIES  THEN  BEGIN      <<03670>>41830000
       DST'TYPE(DSTNO):= 1;                                    <<03078>>41832000
       DSTENTRY:=DOUBLE(DSTNO * 4) + DSTDEFIN;                 <<03078>>41834000
       IF CORE(DSTENTRY).(0:1)=0 OR                            <<03078>>41836000
          CORE(DSTENTRY+1D).(1:1)=1 THEN                       <<03078>>41838000
          IF LOGICAL(LOCPCB+DOUBLE(INDX*PCBSIZE))= CURR'PIN OR <<03078>>41840000
             NOT MINI'DUMP THEN                                <<03078>>41842000
             BEGIN                                             <<03078>>41844000
             TOS:=CORE(DSTENTRY + 2D);                         <<03078>>41846000
             TOS:=CORE(DSTENTRY + 3D);                         <<03078>>41848000
             STACKADDR:=TOS;                                   <<03078>>41850000
             DLREG:=STACKADDR + DOUBLE(CORE(STACKADDR));       <<03078>>41852000
             CURR'PROCESS(STACKADDR,DSTNO,LOCPCB,INDX,PCBSIZE);<<03078>>41854000
             SEARCH'CBTS(STACKADDR,DLREG,DSTNO);               <<03078>>41856000
             END;                                              <<03078>>41858000
       END;                                                    <<03670>>41860000
                                                               <<03670>>41862000
       INDX:=INDX + 1;                                         <<03078>>41864000
       ENTRYCOUNT:=ENTRYCOUNT + 1;                             <<03078>>41866000
       END;                                                    <<03078>>41868000
     END;                                                      <<03078>>41870000
END;                                                           <<03078>>41872000
$PAGE "SEARCH'CBTS : Search the AFT and analyze "                       41874000
$CONTROL SEGMENT=INIT                                                   41876000
PROCEDURE SEARCH'CBTS(STACKADDR,DLREG,STACKDST);               <<03078>>41878000
DOUBLE  DLREG,                                                 <<03078>>41880000
        STACKADDR;                                             <<03078>>41882000
LOGICAL STACKDST;                                              <<03078>>41884000
                                                               <<03078>>41886000
COMMENT                                                                 41888000
                                                                        41890000
Purpose:                                                                41892000
         This procedure searches through the aft of a given             41894000
         stack.  When each new aft entry is found the lacb and          41896000
         pacb vectors are analysed.  If a lacb is present but           41898000
         the stack nothing is set but if present and in another         41900000
         data segment the array position for this data segment          41902000
         is set to the correct value.  If a pacb is present its         41904000
         base is always calculated so that any fcb may be found         41906000
         the procedure checks for null files, ignoring these            41908000
         afts.                                                          41910000
                                                                        41912000
Input parameters:                                                       41914000
                                                                        41916000
Output parameters:                                                      41918000
                                                                        41920000
Globals Referenced:                                                     41922000
                                                                        41924000
Globals Altered:                                                        41926000
                                                                        41928000
Data Structures:                                                        41930000
                                                                        41932000
Algorithm:                                                              41934000
                                                                        41936000
;                                                                       41938000
BEGIN                                                          <<03078>>41940000
  DEFINE FSTYPE=(0:4)#,                                        <<03078>>41942000
         LEMISC'DST=(6:10)#,                                   <<03078>>41944000
         DSDST=(6:10)#;                                        <<03078>>41946000
  EQUATE LFILE=0,                                              <<03078>>41948000
         DSNUM=2,                                              <<03078>>41950000
         DSNUMNW=3,                                            <<03078>>41952000
         CSFILE=4,                                             <<03078>>41954000
         CSFILEAD=5,                                           <<03078>>41956000
         DSDSJOBXDS=%11;                                       <<03078>>41958000
  INTEGER INDX,                                                <<03078>>41960000
          VECTINDX,                                            <<03078>>41962000
          AFTENTRIES,                                          <<03078>>41964000
          ENTRYCOUNT;                                          <<03078>>41966000
  LOGICAL CBTDST;                                              <<03078>>41968000
  LOGICAL DSTNUM;                                              <<04284>>41970000
  DOUBLE  DSTADDR;                                             <<04154>>41972000
  DOUBLE  AFTBASE,                                             <<03078>>41974000
          BLOCKADDR;                                           <<03078>>41976000
                                                               <<03078>>41978000
  AFTBASE:=DLREG - 5D;                                         <<03078>>41980000
  INDX:=0;                                                     <<03078>>41982000
  AFTENTRIES:=INTEGER(CORE(STACKADDR + 8D + 5D +               <<03078>>41984000
                  DOUBLE(CORE(STACKADDR + 8D))))  / 4;         <<03078>>41986000
  ENTRYCOUNT:= 1;                                              <<03078>>41988000
  WHILE ENTRYCOUNT <= AFTENTRIES DO                            <<03078>>41990000
    BEGIN                                                      <<03078>>41992000
    IF AFT00=0 AND AFT01=0 AND AFT02=0 AND AFT03=0 THEN        <<03078>>41994000
       ENTRYCOUNT:=ENTRYCOUNT + 1                              <<03078>>41996000
    ELSE                                                       <<03078>>41998000
       BEGIN                                                   <<03078>>42000000
       IF AFT00.FSTYPE = LFILE THEN                            <<03078>>42002000
          BEGIN                                                <<03078>>42004000
          IF AFT02.(6:10) <> 0 THEN                            <<03078>>42006000
             BEGIN                                             <<03078>>42008000
             CBTDST:=AFT02.(6:10);                             <<03078>>42010000
             VECTINDX:=INTEGER(AFT02.(0:6));                   <<03078>>42012000
             IF CBTDST <> STACKDST THEN                        <<03078>>42014000
                CBT'EXDS(BLOCKADDR,VECTINDX,CBTDST);           <<03078>>42016000
             IF BLOCKADDR <> 0D THEN                           <<03078>>42018000
                IF DST'TYPE(CBTDST) = 0 THEN                   <<03078>>42020000
                   DST'TYPE(CBTDST):= 6;                       <<03078>>42022000
             END;                                              <<03078>>42024000
          IF AFT01.(6:10) <> 0 THEN                            <<03078>>42026000
             BEGIN                                             <<03078>>42028000
             CBTDST:=AFT01.(6:10);                             <<03078>>42030000
             VECTINDX:=INTEGER(AFT01.(0:6));                   <<03078>>42032000
             IF CBTDST = STACKDST THEN                         <<03078>>42034000
                CBT'STACK(STACKADDR,BLOCKADDR,VECTINDX)        <<03078>>42036000
             ELSE                                              <<03078>>42038000
                CBT'EXDS(BLOCKADDR,VECTINDX,CBTDST);           <<03078>>42040000
             IF BLOCKADDR <> 0D THEN SEARCH'PACB(CBTDST,       <<03078>>42042000
                BLOCKADDR);                                    <<03078>>42044000
             END;                                              <<03078>>42046000
          END                                                  <<03078>>42048000
       ELSE                                                    <<03078>>42050000
       IF AFT00.FSTYPE=DSNUM OR                                <<03078>>42052000
          AFT00.FSTYPE=DSNUMNW THEN BEGIN                      <<03078>>42054000
          DST'TYPE(AFT01.DSDST) := 15;                         <<03078>>42056000
          DSTADDR:=DSTTOADDR(AFT01.DSDST);                     <<04154>>42058000
          IF = THEN                                            <<04154>>42060000
            DSTNUM:=CORE(DSTADDR+DOUBLE(DSDSJOBXDS));          <<04284>>42062000
            IF DSTNUM <= MAX'DSTNUM THEN                       <<04284>>42064000
               DST'TYPE(DSTNUM):=16; END                       <<04284>>42066000
       ELSE                                                    <<04284>>42068000
       IF AFT00.FSTYPE=CSFILE OR                               <<04284>>42070000
          AFT00.FSTYPE=CSFILEAD THEN                           <<04284>>42072000
          DST'TYPE(AFT02.LEMISC'DST) := 17;                    <<04284>>42074000
       ENTRYCOUNT:=ENTRYCOUNT + 1;                             <<03078>>42076000
       END;                                                    <<03078>>42078000
    INDX:=INDX + 4;                                            <<03078>>42080000
    END;                                                       <<03078>>42082000
END;                                                           <<03078>>42084000
$PAGE "CURR'PROCESS: Find JIT and JDT entries for a process"            42086000
$CONTROL SEGMENT=INIT                                                   42088000
PROCEDURE CURR'PROCESS(STACKADDR,DSTNO,LOCPCB,INDX,PCBSIZE);   <<03078>>42090000
INTEGER INDX,                                                  <<03078>>42092000
        PCBSIZE;                                               <<03078>>42094000
DOUBLE  STACKADDR,                                             <<03078>>42096000
        LOCPCB;                                                <<03078>>42098000
LOGICAL DSTNO;                                                 <<03078>>42100000
COMMENT                                                                 42102000
                                                                        42104000
Purpose:                                                                42106000
     This procedure will find jit and jdt entries for a                 42108000
     given process when the stack address is found in the               42110000
     calling procedure.   It will also find a current                   42112000
     extra data segment if one is present. The procedure                42114000
     may be expanded in the future to find other data seg-              42116000
     ments associated with certain processes.                           42118000
     It is currently simply a subroutine of CATEGORIZE'DST.             42120000
                                                                        42122000
Input parameters:                                                       42124000
                                                                        42126000
Output parameters:                                                      42128000
                                                                        42130000
Globals Referenced:                                                     42132000
                                                                        42134000
Globals Altered:                                                        42136000
                                                                        42138000
Data Structures:                                                        42140000
                                                                        42142000
Algorithm:                                                              42144000
                                                                        42146000
;                                                                       42148000
                                                               <<03078>>42150000
BEGIN                                                          <<03078>>42152000
  LOGICAL STACKLOC;                                            <<03078>>42154000
                                                               <<03078>>42156000
  STACKLOC:=(CORE(STACKADDR+5D)).(6:10);                       <<03078>>42158000
  IF DST'TYPE(STACKLOC) = 0 THEN                               <<03078>>42160000
     DST'TYPE(STACKLOC):= 8;                                   <<03078>>42162000
  STACKLOC:=(CORE(STACKADDR+6D)).(6:10);                       <<03078>>42164000
  IF DST'TYPE(STACKLOC) = 0 THEN                               <<03078>>42166000
     DST'TYPE(STACKLOC):= 7;                                   <<03078>>42168000
  IF PCB02.(1:10) <> 0 THEN                                    <<03078>>42170000
     DST'TYPE(PCB02.(1:10)):= 2;                               <<03078>>42172000
  IF CORE(4D) = DSTNO THEN                                     <<03078>>42174000
     DST'TYPE(DSTNO):= 11;                                     <<03078>>42176000
                                                               <<03078>>42178000
END;                                                           <<03078>>42180000
