Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/PASCAL.ZIP/MAPMEM.PAS

Pascal/Delphi Source File | 1986-01-05 | 5.9 KB | 203 lines

{************************************************************************
* maps system memory blocks for PCDOS 3.0 and higher.                   *
* may work on other versions of DOS but hasn't been tested.             *
* copyright (c) K. Kokkonen, TurboPower Software.                       *
* released to the public domain for personal, non-commercial use only.  *
* written 1/2/86.                                                       *
* telephone: [phone], CompuServe: 72457,2131.                      *
* requires Turbo version 3 to compile                                   *
* BE SURE to compile with mAx dynamic memory = A000                     *
* limited to environment sizes of 255 bytes (default is 128 bytes)      *
************************************************************************}

PROGRAM MapMem;
 {-look at the system memory map using DOS memory control blocks}

TYPE
 address=RECORD
          offset,segment:Integer;
         END;
VAR
 mcbseg:Integer;{potential segment address of an MCB}
 nextseg:Integer;{computed segment address for the next MCB}
 prevseg:Integer;{segment address of the previous PSP}
 pspadd:Integer;{segment address of the current PSP}
 mcblen:Integer;{size of the current memory block in paragraphs}
 gotfirst:Boolean;{true after first MCB is found}
 gotlast:Boolean;{true after last MCB is found}
 idbyte:Byte;{byte that DOS uses to identify an MCB}
 vectors:ARRAY[0..$FF] OF address ABSOLUTE 0:0;

 PROCEDURE ShowTheBlock(VAR mcbseg,prevseg,nextseg:Integer;
                        VAR gotfirst,gotlast:Boolean);
  {-display information regarding the memory block}
 TYPE
  pathname=STRING[64];
  hexstring=STRING[4];
 VAR
  st:pathname;

  FUNCTION Hex(i:Integer):hexstring;
   {-return the hex equivalent of an integer}
  CONST
   hc:STRING[16]='0123456789ABCDEF';
  VAR
   l,h:Byte;
  BEGIN
   l:=Lo(i);h:=Hi(i);
   Hex:=
   hc[Succ(h SHR 4)]+hc[Succ(h AND $F)]+hc[Succ(l SHR 4)]+hc[Succ(l AND $F)];
  END;{hex}

  FUNCTION Cardinal(i:Integer):Real;
   {-return an unsigned integer 0..65535}
  VAR
   r:Real;
  BEGIN
   r:=i;
   IF r<0 THEN r:=r+65536.0;
   Cardinal:=r;
  END;{cardinal}

  FUNCTION Owner(startadd:Integer):pathname;
   {-return the name of the owner program of an MCB}
  VAR
   e:STRING[255];
   i:Integer;
   t:pathname;

   PROCEDURE StripPathname(VAR pname:pathname);
    {-remove leading drive or path name from the input}
   VAR
    spos,cpos,rpos:Byte;
   BEGIN
    spos:=Pos('\',pname);
    cpos:=Pos(':',pname);
    IF spos+cpos=0 THEN Exit;
    IF spos<>0 THEN BEGIN
     {find the last slash in the pathname}
     rpos:=Length(pname);
     WHILE (rpos>0) AND (pname[rpos]<>'\') DO rpos:=Pred(rpos);
    END ELSE
     rpos:=cpos;
    Delete(pname,1,rpos);
   END;{strippathname}

  BEGIN
   {get the environment string to scan}
   e[0]:=#255;
   Move(Mem[startadd:0],e[1],255);

   {find end of the standard environment}
   i:=Pos(#0#0,e);
   IF i=0 THEN BEGIN
    {something's wrong, exit gracefully}
    Owner:='';
    Exit;
   END;

   {end of environment found, get the program name that follows it}
   t:='';
   i:=i+5;
   REPEAT
    t:=t+Chr(Mem[startadd:i]);
    i:=Succ(i);
   UNTIL Chr(Mem[startadd:i])=#0;
   StripPathname(t);
   Owner:=t;

  END;{owner}

  PROCEDURE WriteHooks(start,stop:Integer);
   {-show the trapped interrupt vectors}
  VAR
   v:Byte;
   vadd,sadd,eadd:Real;

   FUNCTION RealAdd(a:address):Real;
    {-return the real equivalent of an address (pointer)}
   BEGIN
    WITH a DO
     RealAdd:=16.0*Cardinal(segment)+Cardinal(offset);
   END;{realadd}

  BEGIN
   sadd:=16.0*Cardinal(start);
   eadd:=16.0*Cardinal(stop);
   FOR v:=0 TO $40 DO BEGIN
    vadd:=RealAdd(vectors[v]);
    IF (vadd>=sadd) AND (vadd<=eadd) THEN
     Write(Copy(Hex(v),3,2),' ');
   END;
  END;{writehooks}

 BEGIN{showtheblock}

  mcblen:=MemW[mcbseg:3];{size of the MCB in paragraphs}
  nextseg:=Succ(mcbseg+mcblen);{where the next MCB should be}
  pspadd:=MemW[mcbseg:1];{address of program segment prefix for MCB}

  IF (gotlast OR (Mem[nextseg:0]=$4D)) AND (pspadd<>0) THEN BEGIN
   {found part of MCB chain}

   IF gotlast OR (pspadd=prevseg) THEN BEGIN

    {this is the MCB for the program, not for its environment}
    Write(
    ' ',Hex(mcbseg),'    ',{MCB address}
    Hex(pspadd),'    ',{PSP address}
    Hex(mcblen),'   ',{size of block in paragraphs}
    16.0*Cardinal(mcblen):6:0,'  ');{size of block in bytes}

    {get the program owning this block by scanning the environment}
    IF gotfirst THEN
     st:=Owner(MemW[pspadd:$2C])
    ELSE
     st:='(DOS)';
    WHILE Length(st)<13 DO st:=st+' ';
    Write(st);

    {show any interrupt vectors trapped by the program}
    IF gotfirst THEN
     WriteHooks(pspadd,nextseg);

    WriteLn;
    gotfirst:=True;
   END;
   prevseg:=pspadd;
  END;
 END;{showtheblock}

BEGIN{main}

 WriteLn;
 WriteLn('                         Allocated Memory Map');
 WriteLn;
 WriteLn('MCB adr PSP adr  paras   bytes   owner        hooked vectors');
 WriteLn('------- ------- ------- ------- ----------   ------------------------------');

 {start above the Basic work area, could probably start even higher}
 mcbseg:=$50;
 prevseg:=0;
 gotfirst:=False;
 gotlast:=False;

 {scan all memory until the last block is found}
 WHILE mcbseg<>$A000 DO BEGIN
  idbyte:=Mem[mcbseg:0];
  IF idbyte=$4D THEN BEGIN
   {an allocated block}
   ShowTheBlock(mcbseg,prevseg,nextseg,gotfirst,gotlast);
   IF gotfirst THEN mcbseg:=nextseg ELSE mcbseg:=Succ(mcbseg);
  END ELSE IF (idbyte=$5A) AND gotfirst THEN BEGIN
   {last block, exit}
   gotlast:=True;
   ShowTheBlock(mcbseg,prevseg,nextseg,gotfirst,gotlast);
   mcbseg:=$A000;
  END ELSE
   {still looking for first block, try every paragraph boundary}
   mcbseg:=Succ(mcbseg);
 END;

END.