home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TUR6_102.ZIP / MAPMEM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-01-16  |  6.7 KB  |  221 lines
  1. {************************************************************************
  2. * maps system memory blocks for PCDOS 3.0 and higher.                   *
  3. * may work on other versions of DOS but hasn't been tested.             *
  4. * copyright (c) K. Kokkonen, TurboPower Software.                       *
  5. * released to the public domain for personal, non-commercial use only.  *
  6. * written 1/2/86.                                                       *
  7. * telephone :  408-378-3672, CompuServe :  72457,2131.                  *
  8. * requires Turbo version 3 to compile                                   *
  9. * BE SURE to compile with mAx dynamic memory = A000                     *
  10. * limited to environment sizes of 255 bytes (default is 128 bytes)      *
  11. ************************************************************************}
  12.  
  13. PROGRAM MapMem;
  14.  {-look at the system memory map using DOS memory control blocks}
  15.  
  16. TYPE
  17.  address = RECORD
  18.             offset,segment  :  Integer;
  19.            END;
  20.  
  21. VAR
  22.  mcbseg    :  Integer;  {potential segment address of an MCB}
  23.  nextseg   :  Integer;  {computed segment address for the next MCB}
  24.  prevseg   :  Integer;  {segment address of the previous PSP}
  25.  pspadd    :  Integer;  {segment address of the current PSP}
  26.  mcblen    :  Integer;  {size of the current memory block in paragraphs}
  27.  gotfirst  :  Boolean;  {true after first MCB is found}
  28.  gotlast   :  Boolean;  {true after last MCB is found}
  29.  idbyte    :  Byte;     {byte that DOS uses to identify an MCB}
  30.  vectors   :  ARRAY[0..$FF] OF address ABSOLUTE 0:0;
  31.  
  32.  PROCEDURE ShowTheBlock(VAR mcbseg,prevseg,nextseg : Integer;
  33.                         VAR gotfirst,gotlast : Boolean);
  34.   {-display information regarding the memory block}
  35.  TYPE
  36.   pathname = STRING[64];
  37.   hexstring = STRING[4];
  38.  VAR
  39.   st : pathname;
  40.  
  41.   FUNCTION Hex(i : Integer): hexstring;
  42.    {-return the hex equivalent of an integer}
  43.   CONST
  44.    hc : STRING[16] = '0123456789ABCDEF';
  45.   VAR
  46.    l,h : Byte;
  47.   BEGIN
  48.    l := Lo(i); h := Hi(i);
  49.    Hex :=
  50.    hc[Succ(h SHR 4)]+hc[Succ(h AND $F)]+hc[Succ(l SHR 4)]+hc[Succ(l AND $F)];
  51.   END;{hex}
  52.  
  53.   FUNCTION Cardinal(i : Integer): Real;
  54.    {-return an unsigned integer 0..65535}
  55.   VAR
  56.    r : Real;
  57.   BEGIN
  58.    r := i;
  59.    IF r<0 THEN r := r+65536.0;
  60.    Cardinal := r;
  61.   END;{cardinal}
  62.  
  63.   FUNCTION Owner(startadd : Integer): pathname;
  64.    {-return the name of the owner program of an MCB}
  65.   VAR
  66.    e : STRING[255];
  67.    i : Integer;
  68.    t : pathname;
  69.  
  70.    PROCEDURE StripPathname(VAR pname : pathname);
  71.     {-remove leading drive or path name from the input}
  72.    VAR
  73.     spos,cpos,rpos : Byte;
  74.    BEGIN
  75.     spos := Pos('\',pname);
  76.     cpos := Pos(':',pname);
  77.     IF spos+cpos = 0 THEN Exit;
  78.     IF spos<>0 THEN
  79.       BEGIN
  80.         {find the last slash in the pathname}
  81.         rpos := Length(pname);
  82.         WHILE (rpos>0) AND (pname[rpos]<>'\') DO
  83.           rpos := Pred(rpos);
  84.       END
  85.     ELSE
  86.       rpos := cpos;
  87.     Delete(pname,1,rpos);
  88.    END;{strippathname}
  89.  
  90.   BEGIN
  91.    {get the environment string to scan}
  92.    e[0] := #255;
  93.    Move(Mem[startadd:0],e[1],255);
  94.  
  95.    {find end of the standard environment}
  96.    i := Pos(#0#0,e);
  97.    IF i = 0 THEN
  98.      BEGIN
  99.        {something's wrong, exit gracefully}
  100.        Owner := '';
  101.        Exit;
  102.      END;
  103.  
  104.    {end of environment found, get the program name that follows it}
  105.    t := '';
  106.    i := i+5;
  107.    REPEAT
  108.     t := t+Chr(Mem[startadd:i]);
  109.     i := Succ(i);
  110.    UNTIL Chr(Mem[startadd:i]) = #0;
  111.    StripPathname(t);
  112.    Owner := t;
  113.  
  114.   END;{owner}
  115.  
  116.   PROCEDURE WriteHooks(start,stop : Integer);
  117.    {-show the trapped interrupt vectors}
  118.   VAR
  119.    v : Byte;
  120.    vadd,sadd,eadd : Real;
  121.  
  122.    FUNCTION RealAdd(a : address) : Real;
  123.     {-return the real equivalent of an address (pointer)}
  124.    BEGIN
  125.     WITH a DO
  126.      RealAdd := 16.0*Cardinal(segment)+Cardinal(offset);
  127.    END;{realadd}
  128.  
  129.   BEGIN{writehooks}
  130.    sadd := 16.0*Cardinal(start);
  131.    eadd := 16.0*Cardinal(stop);
  132.    FOR v := 0 TO $40 DO
  133.      BEGIN
  134.        vadd := RealAdd(vectors[v]);
  135.        IF (vadd >= sadd) AND (vadd <= eadd) THEN
  136.        Write(Copy(Hex(v),3,2),' ');
  137.      END;
  138.   END;{writehooks}
  139.  
  140.  BEGIN{showtheblock}
  141.  
  142.   mcblen := MemW[mcbseg:3];       {size of the MCB in paragraphs}
  143.   nextseg := Succ(mcbseg+mcblen); {where the next MCB should be}
  144.   pspadd := MemW[mcbseg:1];       {address of program segment prefix for MCB}
  145.  
  146.   IF (gotlast OR (Mem[nextseg:0] = $4D)) AND (pspadd<>0) THEN
  147.     BEGIN
  148.       {found part of MCB chain}
  149.  
  150.       IF gotlast OR (pspadd = prevseg) THEN
  151.         BEGIN
  152.  
  153.           {this is the MCB for the program, not for its environment}
  154.           Write(
  155.           ' ',Hex(mcbseg),'    ',          {MCB address}
  156.           Hex(pspadd),'    ',              {PSP address}
  157.           Hex(mcblen),'   ',               {size of block in paragraphs}
  158.           16.0*Cardinal(mcblen):6:0,'  '); {size of block in bytes}
  159.  
  160.           {get the program owning this block by scanning the environment}
  161.           IF gotfirst THEN
  162.             st := Owner(MemW[pspadd:$2C])
  163.           ELSE
  164.             st := '(DOS)';
  165.           WHILE Length(st)<13 DO
  166.             st := st+' ';
  167.           Write(st);
  168.  
  169.           {show any interrupt vectors trapped by the program}
  170.           IF gotfirst THEN
  171.             WriteHooks(pspadd,nextseg);
  172.  
  173.           WriteLn;
  174.           gotfirst := True;
  175.         END;
  176.         prevseg := pspadd;
  177.     END;
  178.  END;{showtheblock}
  179.  
  180. BEGIN{main}
  181.  
  182.  WriteLn;
  183.  WriteLn('                         Allocated Memory Map');
  184.  WriteLn;
  185.  WriteLn('MCB adr PSP adr  paras   bytes   owner        hooked vectors');
  186.  WriteLn('------- ------- ------- ------- ----------   -----------------------------');
  187.  
  188.  {start above the Basic work area, could probably start even higher}
  189.  mcbseg := $50;
  190.  prevseg := 0;
  191.  gotfirst := False;
  192.  gotlast := False;
  193.  
  194.  {scan all memory until the last block is found}
  195.  WHILE mcbseg<>$A000 DO
  196.  BEGIN
  197.    idbyte := Mem[mcbseg:0];
  198.    IF idbyte = $4D THEN
  199.      BEGIN
  200.        {an allocated block}
  201.        ShowTheBlock(mcbseg,prevseg,nextseg,gotfirst,gotlast);
  202.        IF gotfirst THEN
  203.          mcbseg := nextseg
  204.        ELSE
  205.          mcbseg := Succ(mcbseg);
  206.      END
  207.    ELSE
  208.      IF (idbyte = $5A) AND gotfirst THEN
  209.        BEGIN
  210.          {last block, exit}
  211.          gotlast := True;
  212.          ShowTheBlock(mcbseg,prevseg,nextseg,gotfirst,gotlast);
  213.          mcbseg := $A000;
  214.        END
  215.      ELSE
  216.        {still looking for first block, try every paragraph boundary}
  217.        mcbseg := Succ(mcbseg);
  218.  END; {while}
  219.  
  220. END.{main}
  221.