home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / INFOP125.ZIP / PAGE_04.INC < prev    next >
Encoding:
Text File  |  1990-08-10  |  2.8 KB  |  118 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:='IBMDOS.COM'
  28.   else if ownerPID = parent then
  29.     xstring:='COMMAND.COM'
  30. (*  BIX ms.dos/secrets #1496  *)
  31. (*  Software Tools #145, p. 56  *)
  32.   else if (ownerPID = $0000) or (ownerPID = prefixseg) then
  33.     xstring:='(free)'
  34.   else begin
  35.     i:=0;
  36.     while memw[xword : i] > $0000 do
  37.       inc(i);
  38.     inc(i, 4);
  39.     xstring:='';
  40.     xbool:=false;
  41.     repeat
  42.       xchar:=chr(mem[xword : i]);
  43.       if xchar in pchar then begin
  44.         if xchar in dirsep then
  45.           xstring:=''
  46.         else
  47.           xstring:=xstring + xchar;
  48.         inc(i)
  49.       end else begin
  50.         xbool:=true;
  51.         if xchar > #0 then
  52.           xstring:=''
  53.       end
  54.     until xbool;
  55.   end;
  56.   write(hex(MCB, 4), '   ', hex(ownerPID, 4), '   ', hex(parent, 4), '  '
  57.     , '   ', xlong1 : 6, '   ');
  58.   if xword = MCB + 1 then
  59.     write(' ■ ')
  60.   else
  61.     write('   ');
  62.   write('   ', xstring);
  63.   if MCB + 1 = ownerPID then begin
  64.     for i:=length(xstring) + 1 to 12 do
  65.       write(' ');
  66.     write('  ');
  67.     xlong2:=longint(ownerPID) shl 4;
  68.     for i:=$00 to $FF do begin
  69.       xlong3:=longint(intvec[i]) and $FFFF0000 shr 12
  70.         + longint(intvec[i]) and $0000FFFF;
  71.       if (xlong2 <= xlong3) and (xlong3 <= xlong2 + xlong1) then begin
  72.         if wherex > twidth - 3 then begin
  73.           writeln;
  74.           pause2;
  75.           if endit then
  76.             Exit;
  77.           write('                                                  '
  78.             , '  ');
  79.         end;
  80.         write(' ', hex(i, 2))
  81.       end
  82.     end
  83.   end;
  84.   writeln
  85. end;
  86.  
  87. begin (* procedure page_04 *)
  88.   caption1('MCB    PSP    Parent     Size   Env   Owner'
  89.     + '          Interrupts');
  90.   window(1, 4, twidth, tlength - 2);
  91.   xword1:=memw[devseg : devofs - $0002];
  92.   xbool:=false;
  93.   repeat
  94.     xbyte:=mem[xword1 : $0000];
  95.     xword2:=memw[xword1 : $0001];
  96.     xword3:=memw[xword2 : $0016];
  97.     pause2;
  98.     if endit then
  99.       Exit;
  100.     case xbyte of
  101.       $4D : begin
  102.         xword4:=memw[xword1 : $0003];
  103.         showMCB(xword1, xword2, xword3, xword4);
  104.         inc(xword1, 1 + xword4)
  105.       end;
  106.       $5A : begin
  107.         xword4:=DOSmem shr 4 - xword1 - 1;
  108.         showMCB(xword1, xword2, xword3, xword4);
  109.         xbool:=true
  110.       end else begin
  111.         unknown('MCB status', xbyte, 2);
  112.         xbool:=true
  113.       end
  114.     end
  115.   until xbool
  116. (*  PC Magazine 6:14 p.425  *)
  117. end;
  118.