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.  
  3. * maps system memory blocks for PCDOS 3.0 and higher.                   *
  4.  
  5. * may work on other versions of DOS but hasn't been tested.             *
  6.  
  7. * copyright (c) K. Kokkonen, TurboPower Software.                       *
  8.  
  9. * released to the public domain for personal, non-commercial use only.  *
  10.  
  11. * written 1/2/86.                                                       *
  12.  
  13. * telephone :  408-378-3672, CompuServe :  72457,2131.                  *
  14.  
  15. * requires Turbo version 3 to compile                                   *
  16.  
  17. * BE SURE to compile with mAx dynamic memory = A000                     *
  18.  
  19. * limited to environment sizes of 255 bytes (default is 128 bytes)      *
  20.  
  21. ************************************************************************}
  22.  
  23.  
  24.  
  25. PROGRAM MapMem;
  26.  
  27.  {-look at the system memory map using DOS memory control blocks}
  28.  
  29.  
  30.  
  31. TYPE
  32.  
  33.  address = RECORD
  34.  
  35.             offset,segment  :  Integer;
  36.  
  37.            END;
  38.  
  39.  
  40. VAR
  41.  
  42.  mcbseg    :  Integer;  {potential segment address of an MCB}
  43.  
  44.  nextseg   :  Integer;  {computed segment address for the next MCB}
  45.  
  46.  prevseg   :  Integer;  {segment address of the previous PSP}
  47.  
  48.  pspadd    :  Integer;  {segment address of the current PSP}
  49.  
  50.  mcblen    :  Integer;  {size of the current memory block in paragraphs}
  51.  
  52.  gotfirst  :  Boolean;  {true after first MCB is found}
  53.  
  54.  gotlast   :  Boolean;  {true after last MCB is found}
  55.  
  56.  idbyte    :  Byte;     {byte that DOS uses to identify an MCB}
  57.  
  58.  vectors   :  ARRAY[0..$FF] OF address ABSOLUTE 0:0;
  59.  
  60.  
  61.  
  62.  PROCEDURE ShowTheBlock(VAR mcbseg,prevseg,nextseg : Integer;
  63.  
  64.                         VAR gotfirst,gotlast : Boolean);
  65.  
  66.   {-display information regarding the memory block}
  67.  
  68.  TYPE
  69.  
  70.   pathname = STRING[64];
  71.  
  72.   hexstring = STRING[4];
  73.  
  74.  VAR
  75.  
  76.   st : pathname;
  77.  
  78.  
  79.  
  80.   FUNCTION Hex(i : Integer): hexstring;
  81.  
  82.    {-return the hex equivalent of an integer}
  83.  
  84.   CONST
  85.  
  86.    hc : STRING[16] = '0123456789ABCDEF';
  87.  
  88.   VAR
  89.  
  90.    l,h : Byte;
  91.  
  92.   BEGIN
  93.  
  94.    l := Lo(i); h := Hi(i);
  95.  
  96.    Hex :=
  97.  
  98.    hc[Succ(h SHR 4)]+hc[Succ(h AND $F)]+hc[Succ(l SHR 4)]+hc[Succ(l AND $F)];
  99.  
  100.   END;{hex}
  101.  
  102.  
  103.  
  104.   FUNCTION Cardinal(i : Integer): Real;
  105.  
  106.    {-return an unsigned integer 0..65535}
  107.  
  108.   VAR
  109.  
  110.    r : Real;
  111.  
  112.   BEGIN
  113.  
  114.    r := i;
  115.  
  116.    IF r<0 THEN r := r+65536.0;
  117.  
  118.    Cardinal := r;
  119.  
  120.   END;{cardinal}
  121.  
  122.  
  123.  
  124.   FUNCTION Owner(startadd : Integer): pathname;
  125.  
  126.    {-return the name of the owner program of an MCB}
  127.  
  128.   VAR
  129.  
  130.    e : STRING[255];
  131.  
  132.    i : Integer;
  133.  
  134.    t : pathname;
  135.  
  136.  
  137.  
  138.    PROCEDURE StripPathname(VAR pname : pathname);
  139.  
  140.     {-remove leading drive or path name from the input}
  141.  
  142.    VAR
  143.  
  144.     spos,cpos,rpos : Byte;
  145.  
  146.    BEGIN
  147.  
  148.     spos := Pos('\',pname);
  149.  
  150.     cpos := Pos(':',pname);
  151.  
  152.     IF spos+cpos = 0 THEN Exit;
  153.  
  154.     IF spos<>0 THEN
  155.       BEGIN
  156.  
  157.         {find the last slash in the pathname}
  158.  
  159.         rpos := Length(pname);
  160.  
  161.         WHILE (rpos>0) AND (pname[rpos]<>'\') DO
  162.           rpos := Pred(rpos);
  163.  
  164.       END
  165.     ELSE
  166.  
  167.       rpos := cpos;
  168.  
  169.     Delete(pname,1,rpos);
  170.  
  171.    END;{strippathname}
  172.  
  173.  
  174.  
  175.   BEGIN
  176.  
  177.    {get the environment string to scan}
  178.  
  179.    e[0] := #255;
  180.  
  181.    Move(Mem[startadd:0],e[1],255);
  182.  
  183.  
  184.  
  185.    {find end of the standard environment}
  186.  
  187.    i := Pos(#0#0,e);
  188.  
  189.    IF i = 0 THEN
  190.      BEGIN
  191.  
  192.        {something's wrong, exit gracefully}
  193.  
  194.        Owner := '';
  195.  
  196.        Exit;
  197.  
  198.      END;
  199.  
  200.  
  201.  
  202.    {end of environment found, get the program name that follows it}
  203.  
  204.    t := '';
  205.  
  206.    i := i+5;
  207.  
  208.    REPEAT
  209.  
  210.     t := t+Chr(Mem[startadd:i]);
  211.  
  212.     i := Succ(i);
  213.  
  214.    UNTIL Chr(Mem[startadd:i]) = #0;
  215.  
  216.    StripPathname(t);
  217.  
  218.    Owner := t;
  219.  
  220.  
  221.  
  222.   END;{owner}
  223.  
  224.  
  225.  
  226.   PROCEDURE WriteHooks(start,stop : Integer);
  227.  
  228.    {-show the trapped interrupt vectors}
  229.  
  230.   VAR
  231.  
  232.    v : Byte;
  233.  
  234.    vadd,sadd,eadd : Real;
  235.  
  236.  
  237.  
  238.    FUNCTION RealAdd(a : address) : Real;
  239.  
  240.     {-return the real equivalent of an address (pointer)}
  241.  
  242.    BEGIN
  243.  
  244.     WITH a DO
  245.  
  246.      RealAdd := 16.0*Cardinal(segment)+Cardinal(offset);
  247.  
  248.    END;{realadd}
  249.  
  250.  
  251.  
  252.   BEGIN{writehooks}
  253.  
  254.    sadd := 16.0*Cardinal(start);
  255.  
  256.    eadd := 16.0*Cardinal(stop);
  257.  
  258.    FOR v := 0 TO $40 DO
  259.      BEGIN
  260.  
  261.        vadd := RealAdd(vectors[v]);
  262.  
  263.        IF (vadd >= sadd) AND (vadd <= eadd) THEN
  264.  
  265.        Write(Copy(Hex(v),3,2),' ');
  266.  
  267.      END;
  268.  
  269.   END;{writehooks}
  270.  
  271.  
  272.  
  273.  BEGIN{showtheblock}
  274.  
  275.  
  276.  
  277.   mcblen := MemW[mcbseg:3];       {size of the MCB in paragraphs}
  278.  
  279.   nextseg := Succ(mcbseg+mcblen); {where the next MCB should be}
  280.  
  281.   pspadd := MemW[mcbseg:1];       {address of program segment prefix for MCB}
  282.  
  283.  
  284.  
  285.   IF (gotlast OR (Mem[nextseg:0] = $4D)) AND (pspadd<>0) THEN
  286.     BEGIN
  287.  
  288.       {found part of MCB chain}
  289.  
  290.  
  291.  
  292.       IF gotlast OR (pspadd = prevseg) THEN
  293.         BEGIN
  294.  
  295.  
  296.  
  297.           {this is the MCB for the program, not for its environment}
  298.  
  299.           Write(
  300.  
  301.           ' ',Hex(mcbseg),'    ',          {MCB address}
  302.  
  303.           Hex(pspadd),'    ',              {PSP address}
  304.  
  305.           Hex(mcblen),'   ',               {size of block in paragraphs}
  306.  
  307.           16.0*Cardinal(mcblen):6:0,'  '); {size of block in bytes}
  308.  
  309.  
  310.  
  311.           {get the program owning this block by scanning the environment}
  312.  
  313.           IF gotfirst THEN
  314.  
  315.             st := Owner(MemW[pspadd:$2C])
  316.  
  317.           ELSE
  318.  
  319.             st := '(DOS)';
  320.  
  321.           WHILE Length(st)<13 DO
  322.             st := st+' ';
  323.  
  324.           Write(st);
  325.  
  326.  
  327.  
  328.           {show any interrupt vectors trapped by the program}
  329.  
  330.           IF gotfirst THEN
  331.  
  332.             WriteHooks(pspadd,nextseg);
  333.  
  334.  
  335.  
  336.           WriteLn;
  337.  
  338.           gotfirst := True;
  339.  
  340.         END;
  341.  
  342.         prevseg := pspadd;
  343.  
  344.     END;
  345.  
  346.  END;{showtheblock}
  347.  
  348.  
  349.  
  350. BEGIN{main}
  351.  
  352.  
  353.  
  354.  WriteLn;
  355.  
  356.  WriteLn('                         Allocated Memory Map');
  357.  
  358.  WriteLn;
  359.  
  360.  WriteLn('MCB adr PSP adr  paras   bytes   owner        hooked vectors');
  361.  
  362.  WriteLn('------- ------- ------- ------- ----------   -----------------------------');
  363.  
  364.  
  365.  
  366.  {start above the Basic work area, could probably start even higher}
  367.  
  368.  mcbseg := $50;
  369.  
  370.  prevseg := 0;
  371.  
  372.  gotfirst := False;
  373.  
  374.  gotlast := False;
  375.  
  376.  
  377.  
  378.  {scan all memory until the last block is found}
  379.  
  380.  WHILE mcbseg<>$A000 DO
  381.  BEGIN
  382.  
  383.    idbyte := Mem[mcbseg:0];
  384.  
  385.    IF idbyte = $4D THEN
  386.      BEGIN
  387.  
  388.        {an allocated block}
  389.  
  390.        ShowTheBlock(mcbseg,prevseg,nextseg,gotfirst,gotlast);
  391.  
  392.        IF gotfirst THEN
  393.          mcbseg := nextseg
  394.        ELSE
  395.          mcbseg := Succ(mcbseg);
  396.  
  397.      END
  398.    ELSE
  399.      IF (idbyte = $5A) AND gotfirst THEN
  400.        BEGIN
  401.  
  402.          {last block, exit}
  403.  
  404.          gotlast := True;
  405.  
  406.          ShowTheBlock(mcbseg,prevseg,nextseg,gotfirst,gotlast);
  407.  
  408.          mcbseg := $A000;
  409.  
  410.        END
  411.      ELSE
  412.  
  413.        {still looking for first block, try every paragraph boundary}
  414.  
  415.        mcbseg := Succ(mcbseg);
  416.  
  417.  END; {while}
  418.  
  419.  
  420.  
  421. END.{main}
  422.  
  423.  
  424.  
  425.  
  426.