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

Pascal/Delphi Source File | 1986-01-16 | 6.7 KB | 221 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{writehooks}

   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; {while}



END.{main}