home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Masterblend / cdsharewaremasterblend.iso / utils / infoplus / page_04.pas < prev    next >
Pascal/Delphi Source File  |  1990-12-08  |  3KB  |  139 lines
  1. procedure page_04;
  2.  
  3. var
  4.   xbool : boolean;
  5.   xbyte : byte;
  6.   xword1 : word;
  7.   xword2 : word;
  8.   xword3 : word;
  9.   xword4 : word;
  10.  
  11. procedure showMCB(MCB, ownerPID, parent, size : word);
  12.  
  13. var
  14.   i : word;
  15.   xbool : boolean;
  16.   xchar : char;
  17.   xlong1 : longint;
  18.   xlong2 : longint;
  19.   xlong3 : longint;
  20.   xstring : string;
  21.   xword : word;
  22.  
  23.   begin
  24.   xlong1:=longint(size) shl 4;
  25.   xword:=MemW[ownerPID:$002C];
  26.   if ownerPID = $0008 then
  27.     xstring:='DOS'
  28.   else
  29.     if ownerPID = parent then
  30.       with regs do
  31.         begin
  32.         AX:=$D44D;
  33.         BX:=0;
  34.         Intr($2F, regs);
  35.         if AX = $44DD then
  36.           xstring:='4DOS.COM'
  37.         else
  38.           xstring:='COMMAND.COM';
  39.         end
  40. (*  BIX ms.dos/secrets #1496  *)
  41. (*  Software Tools #145, p. 56  *)
  42.     else
  43.       if (ownerPID = $0000) or (ownerPID = PrefixSeg) then
  44.         xstring:='(free)'
  45.       else
  46.         begin
  47.         i:=0;
  48.         while MemW[xword:i] > $0000 do
  49.           Inc(i);
  50.         Inc(i, 4);
  51.         xstring:='';
  52.         xbool:=false;
  53.         repeat
  54.           xchar:=Chr(Mem[xword:i]);
  55.           if xchar in pchar then
  56.             begin
  57.             if xchar in dirsep then
  58.               xstring:=''
  59.             else
  60.               xstring:=xstring + xchar;
  61.             Inc(i)
  62.             end
  63.           else
  64.             begin
  65.             xbool:=true;
  66.             if xchar > #0 then
  67.               xstring:=''
  68.             end
  69.         until xbool;
  70.         end;
  71.   Write(hex(MCB, 4), '   ', hex(ownerPID, 4), '   ', hex(parent, 4), '  '
  72.     , '   ', xlong1 : 6, '   ');
  73.   if xword = MCB + 1 then
  74.     write(' ■ ')
  75.   else
  76.     write('   ');
  77.   Write('   ', xstring);
  78.   if MCB + 1 = ownerPID then
  79.     begin
  80.     for i:=length(xstring) + 1 to 12 do
  81.       Write(' ');
  82.     Write('  ');
  83.     xlong2:=longint(ownerPID) shl 4;
  84.     for i:=$00 to $FF do
  85.       begin
  86.       xlong3:=longint(intvec[i]) and $FFFF0000 shr 12
  87.         + longint(intvec[i]) and $0000FFFF;
  88.       if (xlong2 <= xlong3) and (xlong3 <= xlong2 + xlong1) then
  89.         begin
  90.         if wherex > twidth - 3 then
  91.           begin
  92.           writeln;
  93.           pause2;
  94.           if endit then
  95.             Exit;
  96.           Write('                                                  '
  97.             , '  ');
  98.           end;
  99.         Write(' ', hex(i, 2))
  100.         end
  101.       end
  102.     end;
  103.   writeln
  104.   end;
  105.  
  106.   begin (* procedure page_04 *)
  107.   caption1('MCB    PSP    Parent     Size   Env   Owner'
  108.     + '          Interrupts');
  109.   window(1, 4, twidth, tlength - 2);
  110.   xword1:=MemW[devseg : devofs - $0002];
  111.   xbool:=false;
  112.   repeat
  113.     xbyte:=Mem[xword1 : $0000];
  114.     xword2:=MemW[xword1 : $0001];
  115.     xword3:=MemW[xword2 : $0016];
  116.     pause2;
  117.     if endit then
  118.       Exit;
  119.     case xbyte of
  120.       $4D : begin
  121.             xword4:=MemW[xword1 : $0003];
  122.             showMCB(xword1, xword2, xword3, xword4);
  123.             Inc(xword1, 1 + xword4)
  124.             end;
  125.       $5A : begin
  126.             xword4:=DOSmem shr 4 - xword1 - 1;
  127.             showMCB(xword1, xword2, xword3, xword4);
  128.             xbool:=true
  129.             end
  130.     else
  131.       begin
  132.       unknown('MCB status', xbyte, 2);
  133.       xbool:=true
  134.       end
  135.     end {case}
  136.   until xbool
  137.   (*  PC Magazine 6:14 p.425  *)
  138.   end;
  139.