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