<<  LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION  >>            00000001
$page "PortDST formatting routines"                                     39634000
$control segment=tables                                                 39636000
integer procedure dseg(dst,offset);                                     39638000
  value dst,offset;                                                     39640000
  integer dst,offset;                                                   39642000
  begin                                                                 39644000
  own integer last'dst := 0;                                            39646000
  own double AbsDSTaddr;                                                39648000
  integer AbsDSTbank = AbsDSTaddr,                                      39650000
          AbsDSToffset = AbsDSTaddr +1;                                 39652000
                                                                        39654000
  cc := cce;                                                            39656000
  if last'dst <> dst then                                               39658000
    begin  << switched DSTs >>                                          39660000
    tos := DSTTOADDR(dst);                                              39662000
    if <> then                                                          39664000
      begin                                                             39666000
      dseg := 0;                                                        39668000
      cc := ccg;                                                        39670000
      return;                                                           39672000
      end;                                                              39674000
    AbsDSTaddr := tos;                                                  39676000
    last'dst := dst;                                                    39678000
    end;                                                                39680000
                                                                        39682000
  dseg := core(AbsDSTaddr + double(offset));                            39684000
  end;   << procedure dseg >>                                           39686000
                                                                        39688000
procedure mfds(dest,srcdst,src'offset,length);                          39690000
  value srcdst,src'offset,length;                                       39692000
  integer array dest;                                                   39694000
  integer srcdst,src'offset,length;                                     39696000
  begin                                                                 39698000
  for x := 0 until length-1 do                                          39700000
    dest(x) :=dseg(srcdst,src'offset + x);                              39702000
  end;                                                                  39704000
                                                                        39706000
procedure tsbc(ptr,index);                                              39708000
  value ptr,index;                                                      39710000
  integer pointer ptr;                                                  39712000
  integer index;                                                        39714000
  begin                                                                 39716000
  integer ccode, x=x,                                                   39718000
          status = Q-1,                                                 39720000
          j,k;                                                          39722000
                                                                        39724000
  j := index/16;                                                        39726000
  k := index mod 16;                                                    39728000
  tos := ptr(j);                                                        39730000
  x := k;                                                               39732000
  assemble( TSBC 0,X );                                                 39734000
  push(status);                                                         39736000
  ccode := tos.(6:2);                                                   39738000
  ptr(j) := tos;                                                        39740000
  status.(6:2) := ccode;                                                39742000
  end;                                                                  39744000
                                                                        39746000
comment                                                                 39748000
                                                                        39750000
Purpose:                                                                39752000
              dst'offset'dump                                           39754000
    This procedure will print a region of a DST from start'addr         39756000
    to stop'addr with both the bank-offset and dst-offset on the        39758000
    left edge (the dst-offset will be in parens).                       39760000
    The region is dumped in 2x8 format, with no ascii on the right.     39762000
endcomment;                                                             39764000
                                                                        39766000
procedure dst'offset'dump(start'addr,end'addr,dst'num);                 39768000
  value start'addr,end'addr,dst'num;                                    39770000
  integer start'addr,end'addr,dst'num;                                  39772000
  begin                                                                 39774000
  integer cnt,index;                                                    39776000
  own integer last'dst := 0;                                            39778000
  own integer dst'base;                                                 39780000
                                                                        39782000
  if dst'num <> last'dst then                                           39784000
    begin   << switched DSTs >>                                         39786000
    tos := DSTTOADDR(dst'num);                                          39788000
    if <> then return;   << absent >>                                   39790000
    dst'base := tos;  del;  << save offset, delete bank >>              39792000
    last'dst := dst'num;                                                39794000
    end;                                                                39796000
                                                                        39798000
  index := (end'addr - start'addr)/16 +1;  << lines needed >>           39800000
  if index <= 5 and (linecount + index) > lnsperpg then newpage;        39802000
                                                                        39804000
  @pbuf := @bbuf;                                                       39806000
                                                                        39808000
  while start'addr <= end'addr do                                       39810000
    begin                                                               39812000
    if vm'inuse and DSTTOADDR(dst'num) > max'real'mem then              39812200
      @pbuf := @bbuf + 7                                                39812300
    else                                                                39812400
      putnum(dst'base + start'addr);                                    39814000
    pbuf(-1) := "(";                                                    39816000
    putnum(start'addr);                                                 39818000
    move pbuf(-1) := "): ",2;  @pbuf := tos;                            39820000
    if (cnt := end'addr - start'addr +1) > 16 then cnt := 16;           39822000
    index := 0;                                                         39824000
    while cnt > 0 do                                                    39826000
      begin                                                             39828000
      putnum(dseg(dst'num,start'addr));                                 39830000
      start'addr := start'addr +1;                                      39832000
      cnt := cnt -1;                                                    39834000
      if (index := index +1) = 8 then @pbuf := @pbuf +2;                39836000
      end;                                                              39838000
    printline;                                                          39840000
  end;                                                                  39842000
end;  << dst'offset'dump >>                                             39844000
                                                                        39846000
PROCEDURE DumpPortDST(PortDST);                                         39848000
  value PortDST;                                                        39850000
  integer PortDST;                                                      39852000
  begin                                                                 39854000
  define asmb = assemble#;                                              39856000
                                                                        39858000
  integer DST'Size;                                                     39860000
  integer offset, i,j;                                                  39862000
  logical msg'flag;                                                     39864000
  double queue'cb;                                                      39866000
  integer queuehead = queue'cb,                                         39868000
          queuetail = queue'cb +1;                                      39870000
  integer maxmsgs;                                                      39872000
  equate PCB'size = %25,                                                39874000
         IQptr = %21;                                                   39876000
  double PCB'base := 0D;    << zero indicates not initialized >>        39878000
  integer numPINs;                                                      39880000
  integer PortCBSize;                                                   39882000
                                                                        39884000
  integer first, last; << used for range checking >>                    39886000
  integer unitsize;                                                     39888000
  integer link,                                                         39890000
          prev'link;                                                    39892000
  integer reg1,  << begin PortCB >>                                     39894000
          reg2,  << begin Context >>                                    39896000
          reg3,  << begin Msg Pools >>                                  39898000
          reg4;  << PortDSTSize >>                                      39900000
                                                                        39902000
  logical fatal := false;                                               39904000
  integer msg'cnt := 0;                                                 39906000
  equate msg01 =  1,                                                    39908000
         msg02 =  2,                                                    39910000
         msg03 =  3,                                                    39912000
         msg04 =  4,                                                    39914000
         msg05 =  5,                                                    39916000
         msg06 =  6,                                                    39918000
         msg07 =  7,                                                    39920000
         msg08 =  8,                                                    39922000
         msg09 =  9,                                                    39924000
         msg10 = 10,                                                    39926000
         msg11 = 11,                                                    39928000
         msg12 = 12,                                                    39930000
         msg13 = 13,                                                    39932000
         msg14 = 14,                                                    39934000
         msg15 = 15,                                                    39936000
         msg16 = 16,                                                    39938000
         msg17 = 17,                                                    39940000
         msg18 = 18,                                                    39942000
         msg19 = 19,                                                    39944000
         msg20 = 20,                                                    39946000
         msg21 = 21,                                                    39948000
         msg22 = 22,                                                    39950000
         msg23 = 23,                                                    39952000
         msg24 = 24,                                                    39954000
         msg25 = 25,                                                    39956000
         msg26 = 26,                                                    39958000
         msg27 = 27,                                                    39960000
         msg28 = 28,                                                    39962000
         msg29 = 29,                                                    39964000
         msg30 = 30,                                                    39966000
         msg31 = 31,                                                    39968000
         msg32 = 32,                                                    39970000
         msg33 = 33,                                                    39972000
         msg34 = 34,                                                    39974000
         msg35 = 35,                                                    39976000
         msg36 = 36,                                                    39978000
         msg37 = 37,                                                    39980000
         msg38 = 38,                                                    39982000
         msg39 = 39,                                                    39984000
         msg40 = 40,                                                    39986000
         msg41 = 41;                                                    39988000
                                                                        39990000
                                                                        39992000
  integer array PortCB(0:37);   << maximum PortCB size >>               39994000
  equate SubqueuesOffset = 3;   << double index >>                      39996000
                                                                        39998000
  define PortCB'flags   = PortCB#,                                      40000000
         PortCB'mask    = PortCB(1)#,                                   40002000
         PortCB'pin     = PortCB(2)#,                                   40004000
         PortCB'context = PortCB(3)#,                                   40006000
         PortCB'subtype = PortCB(4).(0:4)#,                             40008000
         PortCB'OffICS  = PortCB(4).(9:1)#,                             40010000
         PortCB'delete  = PortCB(4).(10:1)#,                            40012000
         PortCB'active  = PortCB(4).(11:1)#,                            40014000
         PortCB'enabled = PortCB(4).(12:1)#,                            40016000
         PortCB'free    = PortCB(4).(13:1)#,                            40018000
         PortCB'DB'PortDST = PortCB(4).(14:1)#,                         40020000
         PortCB'pdisabled = PortCB(4).(15:1)#,                          40022000
         PortCB'plabel  = PortCB(5)#;                                   40024000
                                                                        40026000
  integer pointer msg'visited,  << dynamically allocated arrays >>      40028000
                  visited;                                              40030000
                                                                        40032000
  double elapsed'time,                                                  40034000
         TRL'time := 0D;   <<set from TRL in low core>>                 40036000
  integer TRL'time0 = TRL'time,                                         40038000
          TRL'time1 = TRL'time +1;                                      40040000
  equate TRL'dst = %23;    << MPE Timer Request List DST# >>            40042000
  double rollover := 2073600000D;   << 24days, in milliseconds >>       40044000
                                                                        40046000
  << PortDST header declarations >>                                     40048000
  equate MsgHarbHeaderSize = 13,  << PortDST header size, DST %71 >>    40050000
         PortDSTHeaderSize = 24;  << all other PortDSTs >>              40052000
                                                                        40054000
  integer array PortHeader(0:PortDSTHeaderSize-1) = Q;                  40056000
  integer PortDSTNum =      PortHeader + 0,                             40058000
          PortDSTSize =     PortHeader + 1,                             40060000
          UserRegionPtr =   PortHeader + 2,                             40062000
          PortDSTMaxSubqueues = PortHeader + 3,                         40064000
          PortDSTMsgSize =  PortHeader + 4,                             40066000
          PortDSTContextSize = PortHeader + 5,                          40068000
          MsgPoolHead =     PortHeader + 6,                             40070000
          MsgPoolTail =     PortHeader + 7,                             40072000
          PoolCnt =         PortHeader + 8,                             40074000
          ProcHead =        PortHeader + 9,                             40076000
          ProcTail =        PortHeader + 10,                            40078000
          TimeHead =        PortHeader + 11,                            40080000
          TimeTRLX =        PortHeader + 12,                            40082000
<< end of common header, PortDST = %71 >>                               40084000
          PortCBPoolHead =  PortHeader + 13,                            40086000
          PortCBPoolTail =  PortHeader + 14,                            40088000
          CtxPoolHead =     PortHeader + 15,                            40090000
          CtxPoolTail =     PortHeader + 16,                            40092000
          PrimaryCount =    PortHeader + 17,                            40094000
          SecondaryCount =  PortHeader + 18,                            40096000
          PortDSTMaxPorts = PortHeader + 19,                            40098000
          PortDSTNumPorts = PortHeader + 20,                            40100000
          PortDSTUserSize = PortHeader + 21;                            40102000
  double last'start'time = PortHeader + 22;                             40104000
                                                                        40106000
  integer subroutine pcb(offset);                                       40108000
    value offset;                                                       40110000
    integer offset;                                                     40112000
    begin                                                               40114000
    if PCB'base = 0D then                                               40116000
      PCB'base := dsttoaddr(3);  << PCB= DST #3>>;                      40118000
    pcb := core(PCB'base + double(offset));                             40120000
    end;                                                                40122000
                                                                        40124000
  subroutine genmsg(msgnum);                                            40126000
    value msgnum;                                                       40128000
    integer msgnum;                                                     40130000
    begin                                                               40132000
    if @pbuf <> @bbuf then printline;                                   40134000
    skiplines(1);                                                       40136000
    <<+*+>><< msg'cnt := msg'cnt +1; >>                                 40138000
    case msgnum of                                                      40140000
      begin                                                             40142000
<< 0>>tos := @pbuf;                                                     40144000
<< 1>>move pbuf := "PortDST absent!",2;                                 40146000
<< 2>>move pbuf := "PortDST word zero is <> DST number",2;              40148000
<< 3>>tos := @pbuf;                                                     40150000
<< 4>>move pbuf := "System PortDST MaxSubqueues <> 4",2;                40152000
<< 5>>move pbuf := "System PortDST Msg size <> 6",2;                    40154000
<< 6>>move pbuf := "System PortDST context size <> 0",2;                40156000
<< 7>>move pbuf := "TimeHead <> 0 in System PortDST",2;                 40158000
<< 8>>move pbuf := "Bad User Region pointer",2;                         40160000
<< 9>>move pbuf := "Invalid user Region Size",2;                        40162000
<<10>>move pbuf := "Invalid MaxSubqueues",2;                            40164000
<<11>>move pbuf := "Invalid Msg frame size",2;                          40166000
<<12>>move pbuf := "Invalid Context size",2;                            40168000
<<13>>move pbuf := "Invalid max Ports",2;                               40170000
<<14>>move pbuf := "Invalid num Ports",2;                               40172000
<<15>>move pbuf := "Too many errors in header region",2;                40174000
<<16>>move pbuf := "PoolCnt and ProcHead disagree",2;                   40176000
<<17>>move pbuf := "Process Waiting on Message list",2;                 40178000
<<18>>move pbuf := "Invalid PIN on list",2;                             40180000
<<19>>move pbuf := "Last PIN in chain <> ProcTail",2;                   40182000
<<20>>tos := @pbuf;                                                     40184000
<<21>>move pbuf := "No Timers ever active in this PortDST",2;           40186000
<<22>>move pbuf := "No Timers currently active",2;                      40188000
<<23>>move pbuf := "No PortCBs in Free Pool",2;                         40190000
<<24>>move pbuf := "List of PortCBs in free pool:",2;                   40192000
<<25>>move pbuf := "Bad link addr for this pool",2;                     40194000
<<26>>move pbuf := "This addr. already visited, must be a loop!",2;     40196000
<<27>>move pbuf := "Last PortCB in chain <> PortCBPoolTail",2;          40198000
<<28>>move pbuf := "No Context areas in free pool",2;                   40200000
<<29>>move pbuf := "List of Context Areas in free pool:",2;             40202000
<<30>>move pbuf := "Last Context in chain <> CtxPoolTail",2;            40204000
<<31>>move pbuf := "Msg Free Pool is empty",2;                          40206000
<<32>>move pbuf := "List of Msg frames in free pool:",2;                40208000
<<33>>move pbuf := "Last Msg frame in list <> MsgPoolTail",2;           40210000
<<34>>move pbuf := "No User region",2;                                  40212000
<<35>>move pbuf := "Dump of UserRegion",2;                              40214000
<<36>>move pbuf := "Formatted PortCBs",2;                               40216000
<<37>>move pbuf := "Last Msg in list <> TailPtr",2;                     40218000
<<38>>move pbuf := "No Subqueue has data",2;                            40220000
<<39>>move pbuf := "Dump of Context areas",2;                           40222000
<<40>>move pbuf := "*** List of Message Frames Not on any queue!",2;    40224000
<<41>>move pbuf := "Dump of Message frames",2;                          40226000
      end;  << end case stmt >>                                         40228000
    @pbuf := tos;                                                       40230000
    printline;                                                          40232000
    end;                                                                40234000
  subroutine validate'links(first,last,unitsize,link);                  40236000
    value first,last,unitsize,link;                                     40238000
    integer first,last,unitsize,link;                                   40240000
    begin                                                               40242000
    visited := 0;                                                       40244000
    move visited(1) := visited,(((last - first)/unitsize)/16);          40246000
    prev'link := 0;                                                     40248000
    while link > 0 do                                                   40250000
      begin                                                             40252000
      putnum(link);                                                     40254000
      if (@pbuf - @bbuf) >= 125 then printline;                         40256000
      if not (first <= link <= (last -1)) or                            40258000
         (link - first) mod unitsize <> 0 then                          40260000
        begin   << bad link addr >>                                     40262000
        genmsg(msg25);                                                  40264000
        link := 0;                                                      40266000
        end                                                             40268000
      else                                                              40270000
        begin  << link OK >>                                            40272000
        << keep track of all "found" message frames >>                  40274000
        if first = reg3 then                                            40276000
          tsbc(msg'visited,(link-first)/unitsize);                      40278000
        << now test for circular linked lists >>                        40280000
        tsbc(visited,(link - first)/unitsize);                          40282000
        if <> then                                                      40284000
          begin   << already visited, must be a loop! >>                40286000
          genmsg(msg26);                                                40288000
          link := 0;                                                    40290000
          end                                                           40292000
        else                                                            40294000
          begin                                                         40296000
          prev'link := link;                                            40298000
          link := dseg(PortDST,link);                                   40300000
          end;                                                          40302000
        end;                                                            40304000
      end;                                                              40306000
    if @pbuf <> @bbuf then printline;                                   40308000
    end;  << end validate'links >>                                      40310000
                                                                        40312000
  << DumpPortDST procedure mainline >>                                  40314000
  newpage;                                                              40316000
  move bbuf := "$$$$$$$$ PortDST(",2;  @pbuf := tos;                    40318000
  putnump(PortDST);                                                     40320000
  move pbuf := ") $$$$$$$$";                                            40322000
  printline;                                                            40324000
  skiplines(1);                                                         40326000
                                                                        40328000
  push(status);  tos.(2:1) := 0;  set(status);   << turn traps off >>   40330000
  DST'size := core(double(core(2D) + logical(PortDST*4)));              40332000
  DST'size := (DST'size.(3:13))*4;                                      40334000
  PortCB := dseg(PortDST,0);                                            40336000
  if <> then                                                            40338000
    begin   << PortDST absent >>                                        40340000
    genmsg(msg01);                                                      40342000
    return;                                                             40344000
    end;                                                                40346000
                                                                        40348000
  mfds(PortHeader,PortDST,0,PortDSTHeaderSize);                         40350000
                                                                        40352000
  if PortDSTnum <> PortDST then                                         40354000
    genmsg(msg02);                                                      40356000
                                                                        40358000
  if DST'size/4 <> (PortDSTSize +3)/4 then                              40360000
    begin                                                               40362000
    move bbuf := "PortDST'size <> DST table (DST'size = ",2;            40364000
    @pbuf := tos;                                                       40366000
    putnump(DST'size);                                                  40368000
    pbuf(-1) := ")";                                                    40370000
    printline;                                                          40372000
    end;                                                                40374000
  PortDSTSize := DST'size;                                              40376000
                                                                        40378000
  numPINs := pcb(0);                                                    40380000
                                                                        40382000
<< format PortDST Header region >>                                      40384000
  dst'offset'dump(0,PortDSTHeaderSize-1,PortDST);                       40386000
  skiplines(2);                                                         40388000
  move bbuf := "PortDSTnum";        putoctalp(PortDST,18);              40390000
  move bbuf(21) := "UserRegionPtr"; putoctalp(UserRegionPtr,41);        40392000
  unitsize := if PortDST = %71 then numPINs                             40394000
                               else PortDSTMaxPorts;                    40396000
  move bbuf(44) := "MaxPorts";      putoctalp(unitsize,63);             40398000
  move bbuf(66) := "MaxMsgSize";    putoctalp(PortDSTMsgSize,84);       40400000
  printline;                                                            40402000
                                                                        40404000
  move bbuf := "PortDSTsize";       putoctalp(PortDSTsize,18);          40406000
  if PortDST <> %71 then                                                40408000
    begin                                                               40410000
    move bbuf(21) := "UserRegionSize"; putoctalp(PortDSTUserSize,41);   40412000
    move bbuf(44) := "NumPorts";    putoctalp(PortDSTNumPorts,63);      40414000
    end;                                                                40416000
  move bbuf(66) := "MsgPoolHead";   putoctalp(MsgPoolHead,84);          40418000
  printline;                                                            40420000
                                                                        40422000
  move bbuf(44) := "MaxSubqueues";  putoctalp(PortDSTmaxSubqueues,63);  40424000
  move bbuf(66) := "MsgPoolTail";   putoctalp(MsgPoolTail,84);          40426000
  printline;                                                            40428000
                                                                        40430000
  move bbuf(21) := "ProcHead";      putoctalp(Prochead,41);             40432000
  move bbuf(44) := "MaxContext";    putoctalp(PortDSTcontextSize,63);   40434000
  move bbuf(66) := "PoolCnt";       putoctalp(PoolCnt,84);              40436000
  printline;                                                            40438000
                                                                        40440000
  move bbuf := "TimeHead";          putoctalp(TimeHead,18);             40442000
  move bbuf(21) := "ProcTail";      putoctalp(ProcTail,41);             40444000
  if PortDST <> %71 then                                                40446000
    begin                                                               40448000
    move bbuf(44) := "PortCBHead";  putoctalp(PortCBPoolHead,63);       40450000
    move bbuf(66) := "PrimaryCount";putoctalp(PrimaryCount,84);         40452000
    end;                                                                40454000
  printline;                                                            40456000
                                                                        40458000
  move bbuf := "TimeTRLX";          putoctalp(TimeTRLX,18);             40460000
  if PortDST <> %71 then                                                40462000
    begin                                                               40464000
    move bbuf(44) := "PortCBTail";  putoctalp(PortCBPoolTail,63);       40466000
    move bbuf(66) := "SecondaryCount";putoctalp(SecondaryCount,84);     40468000
    end;                                                                40470000
  printline;                                                            40472000
                                                                        40474000
  if PortDST <> %71 then                                                40476000
    begin                                                               40478000
    move bbuf := "StartTime";                                           40480000
    @pbuf := @bbuf(12);                                                 40482000
    putdnum(last'start'time);                                           40484000
    move bbuf(44) := "CtxPoolHead"; putoctalp(CtxPoolHead,63);          40486000
    printline;                                                          40488000
                                                                        40490000
    move bbuf(44) := "CtxPoolTail"; putoctalp(CtxPoolTail,63);          40492000
    printline;                                                          40494000
    end;                                                                40496000
                                                                        40498000
<< verify, and try to fixup, the Port Header >>                         40500000
  if PortDST = %71 then                                                 40502000
    begin  << System PortDST has a special format >>                    40504000
    if UserRegionPtr <> PortDSTsize then                                40506000
      genmsg(msg08);                                                    40508000
    UserRegionPtr := MsgHarbHeaderSize;                                 40510000
    PortDSTUserSize := 0;                                               40512000
    PortCBPoolHead := PortCBPoolTail := 0;                              40514000
    CtxPoolHead := CtxPoolTail := 0;                                    40516000
    PrimaryCount := SecondaryCount := 0;                                40518000
    PortDSTMaxPorts := numPINs;                                         40520000
    PortDSTnumPorts := PortDSTMaxPorts;                                 40522000
    last'start'time := 0D;                                              40524000
                                                                        40526000
    if PortDSTmaxSubqueues <> 4 then                                    40528000
      genmsg(msg04);                                                    40530000
    PortDSTmaxSubqueues := 4;                                           40532000
    PortCBSize := (PortDSTmaxSubqueues + SubqueuesOffset +1)*2;         40534000
    if PortDSTMsgSize <> 6 then                                         40536000
      genmsg(msg05);                                                    40538000
    PortDSTMsgSize := 6;                                                40540000
    if PortDSTContextSize <> 0 then                                     40542000
      genmsg(msg06);                                                    40544000
    PortDSTContextSize := 0;                                            40546000
    if TimeHead <> 0 then                                               40548000
      genmsg(msg07);                                                    40550000
    TimeHead := 0;                                                      40552000
    end                                                                 40554000
  else                                                                  40556000
    begin  << PortDST <> %71;  i.e., a "normal" PortDST >>              40558000
<<+*+>><<  if UserRegionPtr <> PortDSTHeaderSize then   >>              40560000
<<+*+>><<    genmsg(msg08);                             >>              40562000
<<+*+>><<  UserRegionPtr := PortDSTHeaderSize;          >>              40564000
    if not (0<= PortDSTUserSize <= (DST'size - UserRegionPtr)) then     40566000
      begin                                                             40568000
      genmsg(msg09);                                                    40570000
      PortDSTUserSize := 0;                                             40572000
      fatal := true;                                                    40574000
      end;                                                              40576000
    if not (0<= PortDSTmaxSubqueues <= 15) then                         40578000
      begin                                                             40580000
      genmsg(msg10);                                                    40582000
      fatal := true;                                                    40584000
      end;                                                              40586000
    PortCBSize := (PortDSTmaxSubqueues + SubqueuesOffset +1)*2;         40588000
    if not (3<= PortDSTMsgSize <= 256) then                             40590000
      begin                                                             40592000
      genmsg(msg11);                                                    40594000
      fatal := true;                                                    40596000
      end;                                                              40598000
    << calculate PortCB and context area size and limits >>             40600000
    if not (0<= PortDSTContextSize <= 1024) then                        40602000
      begin                                                             40604000
      genmsg(msg12);                                                    40606000
      fatal := true;                                                    40608000
      PortDSTContextSize := 0;                                          40610000
      end;                                                              40612000
    unitsize := PortCBSize + PortDSTContextSize;                        40614000
    unitsize := (DST'size - UserRegionPtr - PortDSTUserSize)/unitsize;  40616000
    if not (1 <= PortDSTmaxPorts <= unitsize) then                      40618000
      begin                                                             40620000
      genmsg(msg13);                                                    40622000
      fatal := true;                                                    40624000
      PortDSTmaxPorts := unitsize;                                      40626000
      end;                                                              40628000
    if not (0 <= PortDSTnumPorts <= PortDSTmaxPorts) then               40630000
      begin                                                             40632000
      genmsg(msg14);                                                    40634000
      PortDSTnumPorts := 0;                                             40636000
      end;                                                              40638000
    end;                                                                40640000
  if fatal or msg'cnt > 3 then                                          40642000
    begin                                                               40644000
    genmsg(msg15);                                                      40646000
    return;                                                             40648000
    end;                                                                40650000
                                                                        40652000
  reg1 := UserRegionPtr + PortDSTUserSize;                              40654000
  reg2 := reg1 + PortDSTmaxPorts*PortCBsize;                            40656000
  reg3 := reg2 + portDSTmaxPorts*PortDSTContextSize;                    40658000
  reg4 := PortDSTSize;                                                  40660000
  maxmsgs := (reg4 - reg3)/PortDSTmsgSize;                              40662000
                                                                        40664000
  << allocate dynamic arrays >>                                         40666000
  if maxmsgs > PortDSTmaxPorts   << max(Maxmsgs,maxports)/16 +1 >>      40668000
    then tos := maxmsgs/16 +1                                           40670000
    else tos := PortDSTmaxPorts/16 +1;                                  40672000
  @visited := @S0;                                                      40674000
  asmb( adds 0 );                                                       40676000
                                                                        40678000
  tos := maxmsgs/16 +1;                                                 40680000
  @msg'visited := @S0;                                                  40682000
  asmb( adds 0 );                                                       40684000
  msg'visited := 0;                                                     40686000
  move msg'visited(1) := msg'visited,(maxmsgs/16);                      40688000
                                                                        40690000
  << print impeded process list >>                                      40692000
  if (PoolCnt >= 0) xor (ProcHead = 0) then                             40694000
    genmsg(msg16);                                                      40696000
                                                                        40698000
  link := ProcHead;                                                     40700000
  if link <> 0 then                                                     40702000
    begin                                                               40704000
    genmsg(msg17);  << processes impeded message >>                     40706000
    prev'link := link;                                                  40708000
    while 1 <= link <= numPINs do                                       40710000
      begin                                                             40712000
      putnump(link);                                                    40714000
      if (@pbuf - @bbuf) >= 125 then printline;                         40716000
      prev'link := link;                                                40718000
      link := pcb(link*pcb'size+iqptr);                                 40720000
      end;                                                              40722000
    if not (0 <= link <= numPINs) then                                  40724000
      genmsg(msg18);                                                    40726000
    if prev'link <> ProcTail then                                       40728000
      genmsg(msg19);                                                    40730000
    end;                                                                40732000
                                                                        40734000
                                                                        40736000
<< format timer list >>                                                 40738000
  if last'start'time = 0D then genmsg(msg21) << no timers ever active >>40740000
  else                                                                  40742000
    begin                                                               40744000
    TRL'time0 := dseg(TRL'dst,5);                                       40746000
    TRL'time1 := dseg(TRL'dst,6);                                       40748000
    elapsed'time := TRL'time - last'start'time;                         40750000
    if < then elapsed'time := elapsed'time + rollover;                  40752000
  <<+*+>>  << should print last'start'time >>                           40754000
    link := TimeHead;                                                   40756000
    if link = 0 then genmsg(msg22)  << no timers currently active >>    40758000
    else                                                                40760000
      begin                                                             40762000
      << print "timer request queue" >>                                 40764000
      validate'links(reg3,reg4,PortDSTmsgSize,link);                    40766000
      end;                                                              40768000
    end;                                                                40770000
                                                                        40772000
<< print list of free PortCBs >>                                        40774000
  unitsize := PortCBSize;                                               40776000
  link := PortCBPoolHead;                                               40778000
  if link = 0                                                           40780000
    then genmsg(msg23)  << no PortCBs in free pool >>                   40782000
    else genmsg(msg24);  << PortCB free pool dump header >>             40784000
  validate'links(reg1,reg2,unitsize,link);  << sets prevlink >>         40786000
  if prev'link <> PortCBPoolTail then genmsg(msg27);                    40788000
                                                                        40790000
<< print list of free Context areas >>                                  40792000
  if PortDSTContextSize > 0 then                                        40794000
    begin                                                               40796000
    link := CtxPoolHead;                                                40798000
    if link = 0                                                         40800000
      then genmsg(msg28)                                                40802000
      else genmsg(msg29);                                               40804000
    validate'links(reg2,reg3,PortDSTContextSize,link);                  40806000
    if prev'link <> CtxPoolTail then genmsg(msg30);                     40808000
    end;                                                                40810000
                                                                        40812000
  link := MsgPoolHead;                                                  40814000
  if link = 0                                                           40816000
    then genmsg(msg31)                                                  40818000
    else genmsg(msg32);                                                 40820000
  validate'links(reg3,reg4,PortDSTmsgSize,link);                        40822000
  if prev'link <> MsgPoolTail then genmsg(msg33);                       40824000
                                                                        40826000
<< print user region >>                                                 40828000
  if PortDSTuserSize = 0 then genmsg(msg34)                             40830000
  else                                                                  40832000
    begin                                                               40834000
    genmsg(msg35);                                                      40836000
    dst'offset'dump(UserRegionPtr,UserRegionPtr + PortDSTuserSize-1,    40838000
                     PortDST);                                          40840000
    end;                                                                40842000
                                                                        40844000
  << print PortCB areas >>                                              40846000
  genmsg(msg36);                                                        40848000
  for i := 1 until PortDSTMaxPorts do                                   40850000
    begin                                                               40852000
    offset := reg1 + (i-1)*PortCBSize;                                  40854000
    mfds(PortCB,PortDST,offset,PortCBSize);                             40856000
    skiplines(1);                                                       40858000
    move bbuf := "PortID ",2;  @pbuf := tos;                            40860000
    putnump(PortDST);                                                   40862000
    putnum(offset);                                                     40864000
    if logical(PortCB'free) then                                        40866000
      begin   << don't format PortCBs in Free Pool >>                   40868000
      move pbuf(2) := "PortCB is in free pool",2;                       40870000
      @pbuf := tos;                                                     40872000
      printline;                                                        40874000
      for j := 0 until PortDSTmaxSubqueues do                           40876000
        if PortCB((j + SubqueuesOffset)*2) <> 0 then                    40878000
          begin                                                         40880000
          move bbuf := "Messages present on Subqueue ",2;               40882000
          @pbuf := tos;                                                 40884000
          putnump(j);                                                   40886000
          move pbuf(-1) := ", Msglink = ",2;  @pbuf := tos;             40888000
          putnump(PortCB((j + SubqueuesOffset)*2));                     40890000
          printline;                                                    40892000
          end;                                                          40894000
      end                                                               40896000
    else                                                                40898000
      begin   << format In Use PortCBs >>                               40900000
      << format PortCB >>                                               40902000
      move bbuf(21) := "Flags";       putoctal(PortCB'flags,41);        40904000
      move bbuf(44) := "Context Ptr"; putoctal(PortCB'context,63);      40906000
      if logical(PortCB'OffICS)                                         40908000
        then move bbuf(66) := "Run in own process"                      40910000
        else move bbuf(66) := "Run in SysPort server";                  40912000
      printline;                                                        40914000
      move bbuf(21) := "Mask";        putoctal(PortCB'mask,41);         40916000
      move bbuf(44) := "Plabel";      putoctal(PortCB'plabel,63);       40918000
      if PortCB'plabel.(8:8) <> 0 then                                  40920000
        begin                                                           40922000
        @pbuf := @bbuf(66);                                             40924000
        namecst(PortCB'plabel.(8:8));                                   40926000
        end;                                                            40928000
      if logical(PortCB'delete) then                                    40930000
        move bbuf(88) := "Delete Pending";                              40932000
      printline;                                                        40934000
      if logical(PortCB'enabled)                                        40936000
        then move bbuf(21) := "Enabled"                                 40938000
        else move bbuf(21) := "Disabled";                               40940000
      move bbuf(44) := "PIN";         putoctalp(PortCB'pin,63);         40942000
      if logical(PortCB'pdisabled)                                      40944000
        then move bbuf(66) := "Pdisabled"                               40946000
        else move bbuf(66) := "Penabled";                               40948000
      printline;                                                        40950000
      if logical(PortCB'active)                                         40952000
        then move bbuf(21) := "Port Active"                             40954000
        else move bbuf(21) := "Port Not Active";                        40956000
      move bbuf(44) := "Subtype";     putoctal(PortCB'subtype,63);      40958000
      if logical(PortCB'DB'PortDST)                                     40960000
        then move bbuf(66) := "DB @ XDS"                                40962000
        else move bbuf(66) := "StackDB";                                40964000
      printline;                                                        40966000
                                                                        40968000
      msg'flag := false;                                                40970000
      for j := 0 until PortDSTmaxSubqueues do                           40972000
        begin                                                           40974000
        queuehead := PortCB((j + SubqueuesOffset)*2);                   40976000
        queuetail := PortCB((j + SubqueuesOffset)*2 + 1);               40978000
        if queuehead <> 0 then                                          40980000
          begin                                                         40982000
          skiplines(1);                                                 40984000
          msg'flag := true;                                             40986000
          move bbuf := "Subqueue ",2;  @pbuf := tos;                    40988000
          putnump(j);                                                   40990000
          pbuf(-1) := ":";                                              40992000
          printline;                                                    40994000
          validate'links(reg3,reg4,PortDSTmsgSize,queuehead);           40996000
          if prev'link <> queuetail then genmsg(msg37);                 40998000
          end;                                                          41000000
        end;                                                            41002000
      if not msg'flag then genmsg(msg38);                               41004000
      end;    << end formatting InUse PortCBs >>                        41006000
    end;                                                                41008000
                                                                        41010000
  if PortDSTContextSize > 0 then                                        41012000
    begin   << print context areas >>                                   41014000
    genmsg(msg39);                                                      41016000
    for i := 1 until PortDSTMaxPorts do                                 41018000
      begin                                                             41020000
      offset := reg2 + (i-1)*PortDSTContextSize;                        41022000
      dst'offset'dump(offset,offset + PortDSTContextSize -1,PortDST);   41024000
      end;                                                              41026000
    end;                                                                41028000
                                                                        41030000
<< print list of any Messages not on any queue >>                       41032000
  msg'flag := true;   << first time flag >>                             41034000
  for i := 0 until maxmsgs -1 do                                        41036000
    begin                                                               41038000
    tsbc(msg'visited,i);                                                41040000
    if = then                                                           41042000
      begin  << not visited before! >>                                  41044000
      if msg'flag then genmsg(msg40);                                   41046000
      msg'flag := false;                                                41048000
      putnum(i*PortDSTmsgSize + reg3);                                  41050000
      if (@pbuf - @bbuf) >= 125 then printline;                         41052000
      end;                                                              41054000
    end;                                                                41056000
  if @pbuf <> @bbuf then printline;                                     41058000
                                                                        41060000
<< print msg frames >>                                                  41062000
  genmsg(msg41);                                                        41064000
  for i := 1 until maxmsgs do                                           41066000
    begin                                                               41068000
    offset := reg3 + (i-1)*PortDSTmsgSize;                              41070000
    dst'offset'dump(offset,offset + PortDSTmsgSize -1,PortDST);         41072000
    end;                                                                41074000
                                                                        41076000
  end;                                                                  41078000
