home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MEMMAP.ZIP / MEMMAP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-05-17  |  8.9 KB  |  216 lines
  1. {$M 4000,0,0}
  2. PROGRAM MemMap;
  3.  
  4.  {MemMap shows a Memory Map of all programs and environment blocks.
  5.  
  6.   Usage:  MEMMAP       to show all Memory Control Blocks (MCBs)
  7.         or
  8.           MEMMAP /V    to show MCBs and all environment variables
  9.                        (the /V option is ignored in DOS 2.X or lower)
  10.  
  11.   (C) Copyright 1989, Earl F. Glynn, Overland Park, KS.
  12.   All Rights Reserved.
  13.  
  14.   This program may be freely distributed for non-commercial use.
  15.  
  16.   MemMap is based on PCMAP from PC Magazine, SHOWMEM from "The
  17.   Waite's Group MS-DOS Developer's Guide" (Second Edition), and
  18.   the DOS 4.0  MEM /DEBUG  command.
  19.  
  20.   Version 1.0 -- 27 February 1989.
  21.  
  22.   Version 2.0 -- 17 May 1989.
  23.     Modifications were made to handle IBM's INDCIPL program (part of
  24.     the 3270 Workstation Program).  Memory with it has a large number
  25.     of contiguous MCBs each pointing to a zero-length block.  Termination
  26.     conditions were modified to avoid possible problems when an MCB
  27.     is not tagged "correctly".}
  28.  
  29.  
  30.   USES DOS;    {DOSVersion,Intr,Registers}
  31.  
  32.   CONST
  33.     EnvironmentBlock:  STRING[12] = 'Environment ';
  34.     ProgramBlock    :  STRING[12] = 'Program     ';
  35.  
  36.   TYPE
  37.     MemoryControlBlock =     {MCB -- only needed fields are shown}
  38.       RECORD
  39.         Blocktag   :  BYTE;  {tag is M ($4D) except last is Z ($5A)}
  40.         BlockOwner :  WORD;  {if nonzero, process identifier, usually PID}
  41.         BlockSize  :  WORD;  {size in 16-byte paragraphs (excludes MCB)}
  42.         misc       :  ARRAY[1..3] OF BYTE;  {placeholder}
  43.         ProgramName:  ARRAY[1..8] OF CHAR   {only used by DOS 4.0; ASCIIZ}
  44.       END;                   {PID normally taken from PSP}
  45.     ProgramSegmentPrefix =   {PSP -- only needed fields are shown}
  46.       RECORD                                           { offset }
  47.         PSPtag     :  WORD;  { $20CD or $27CD if PSP}  { 00 $00 }
  48.         misc       :  ARRAY[1..21] OF WORD;            { 02 $02 }
  49.         Environment:  WORD                             { 44 $2C }
  50.       END;
  51.  
  52.   VAR
  53.     DOSVerNum:  BYTE;        {major version number, e.g., 3 for 3.X}
  54.     LastSize :  WORD;        {used to detect multiple null MCBs}
  55.     MCB      :  ^MemoryControlBlock;
  56.     NullMCB  :  WORD;        {counter of MCBs pointing to 0-length blocks}
  57.     r        :  Registers;   {TYPE defined in DOS unit}
  58.     segment  :  WORD;
  59.     vflag    :  BOOLEAN;     {Verify flag TRUE when /V specified}
  60.  
  61.   FUNCTION W2X(w:  WORD):  STRING; {binary word to hex character string}
  62.     CONST HexDigit:  ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
  63.   BEGIN                 {similar to REXX standard D2X function}
  64.     W2X :=  HexDigit[Hi(w) SHR 4] + HexDigit[Hi(w) AND $0F] +
  65.             HexDigit[Lo(w) SHR 4] + HexDigit[Lo(w) AND $0F];
  66.   END {W2X};  {change in CONST above suggested by Neil J. Rubenking}
  67.  
  68.   PROCEDURE ProcessMCB;                {Each Memory Control Block}
  69.     VAR                                {is processed by this PROCEDURE.}
  70.       b        :  CHAR;
  71.       Blocktype:  STRING[12];
  72.       bytes    :  LongInt;
  73.       EnvSize  :  WORD;
  74.       i        :  WORD;
  75.       last     :  CHAR;
  76.       MCBenv   :  ^MemoryControlBlock;
  77.       MCBowner :  ^MemoryControlBlock;
  78.       psp      :  ^ProgramSegmentPrefix;
  79.   BEGIN
  80.     IF   (MCB^.BlockTag <> $4D) AND (MCB^.BlockTag <> $5A) AND
  81.          (MCB^.BlockTag <> $00)
  82.     THEN BEGIN
  83.       IF   NullMCB > 0
  84.       THEN WRITELN (NullMCB:6,' contiguous MCBs pointing to empty ',
  85.            'blocks not shown.');
  86.       WRITELN ('Unknown Memory Control Block Tag ''',MCB^.BlockTag,
  87.         '''.');
  88.       WRITELN ('MemMap scan terminated.');
  89.       HALT
  90.     END;
  91.     IF   (MCB^.BlockSize = 0) AND (LastSize = 0)
  92.     THEN INC (NullMCB)  {Count but don't output multiple null MCBs}
  93.     ELSE BEGIN
  94.       LastSize := MCB^.BlockSize;
  95.       IF   NullMCB > 0
  96.       THEN BEGIN
  97.         WRITELN (NullMCB:6,' contiguous MCBs pointing to empty ',
  98.           'blocks not shown.');
  99.         NullMCB := 0
  100.       END
  101.       ELSE BEGIN
  102.         bytes := LongInt(MCB^.BlockSize) SHL 4; {size of MCB in bytes}
  103.         WRITE (W2X(segment):6,W2X(MCB^.BlockSize):8,'0',bytes:9,
  104.           W2X(MCB^.BlockOwner):8,'   ');
  105.  
  106.         IF   MCB^.BlockOwner = 0
  107.         THEN WRITELN ('Free Space    <unallocated>')
  108.         ELSE BEGIN
  109.           psp := Ptr(MCB^.BlockOwner,0);            {possible PSP}
  110.           {Almost all programs have a tag of $20CD; DOS MODE is one
  111.            that uses $27CD in some versions.}
  112.           IF   (psp^.PSPtag <> $20CD) AND (psp^.PSPtag <> $27CD)
  113.           THEN WRITELN ('System        ', {not valid PSP}
  114.                         '<DOS ',DosVerNum,'.',Hi(DOSVersion),' kernel>')
  115.           ELSE BEGIN                      {valid program segment prefix}
  116.             MCBenv := Ptr(psp^.Environment-1,0);    {MCB of environment}
  117.             BlockType := 'Data        ';            {assume}
  118.             IF   MCB^.Blockowner = (segment + 1)
  119.             THEN BlockType := ProgramBlock
  120.             ELSE
  121.               IF   psp^.Environment = (segment + 1)
  122.               THEN BlockType := EnvironmentBlock;
  123.             WRITE (BlockType:12,'  ');
  124.             IF  MCB^.BlockOwner <> MCBenv^.BlockOwner
  125.             THEN
  126.               IF   DOSVerNum <> 4
  127.               THEN WRITELN ('<unknown>')  {different owner; unknown in 3.X}
  128.               ELSE BEGIN                  {in DOS 4.0 short name is in MCB}
  129.                 MCBowner := Ptr(MCB^.Blockowner-1,0);    {MCB of owner block}
  130.                 i := 1;
  131.                 WHILE (MCBowner^.ProgramName[i] <> #$00) AND (i < 9) DO BEGIN
  132.                   WRITE (MCBowner^.ProgramName[i]);
  133.                   INC (i)
  134.                 END;
  135.                 WRITELN
  136.               END
  137.             ELSE BEGIN     {environment must have same owner as MCB}
  138.               IF   DOSVerNum < 3
  139.               THEN WRITELN ('<unknown>')       {DOS 1.X or 2.X}
  140.               ELSE BEGIN                       {DOS 3.X}
  141.                 EnvSize := MCBenv^.BlockSize SHL 4;      {multiply by 16}
  142.                 i := 0;
  143.                 b := CHAR( Mem[psp^.Environment:i] );
  144.                 REPEAT
  145.                   last := b;    {skip through ASCIIZ environment variables}
  146.                   INC (i);
  147.                   b := CHAR( Mem[psp^.Environment:i] );
  148.                 UNTIL (i > EnvSize) OR ( (b = #$00) AND (last = #$00));
  149.                 INC (i);        {end of environment block is $0000}
  150.                 b := CHAR( Mem[psp^.Environment:i] );
  151.                 IF   (i >= EnvSize) OR (b <> #$01)  {valid signature?}
  152.                 THEN WRITE ('<shell>')    {shell is probably COMMAND.COM}
  153.                 ELSE BEGIN
  154.                   INC (i,2);              {skip process signature $0001}
  155.                   b := CHAR( Mem[psp^.Environment:i] );
  156.                   REPEAT
  157.                     WRITE (b);            {output process name byte-by-byte}
  158.                     INC (i);
  159.                     b := CHAR( Mem[psp^.Environment:i] )
  160.                   UNTIL (i > EnvSize) OR (b = #$00);
  161.                 END;
  162.                 WRITELN
  163.               END
  164.             END;
  165.  
  166.             IF   vflag AND (BlockType = EnvironmentBlock)
  167.             THEN BEGIN                    {Display environment variables}
  168.               i := 0;
  169.               b := CHAR( Mem[psp^.Environment:i] );
  170.               WRITELN;
  171.               REPEAT
  172.                 IF   b = #$00
  173.                 THEN WRITELN              {end of ASCIIZ string}
  174.                 ELSE WRITE (b);
  175.                 last := b;
  176.                 INC (i);
  177.                 b := CHAR( Mem[psp^.Environment:i] );
  178.               UNTIL (i > EnvSize) OR ( (b = #$00) AND (last = #$00));
  179.               WRITELN
  180.             END
  181.  
  182.           END
  183.         END
  184.       END
  185.     END
  186.   END {ProcessMCB};
  187.  
  188. BEGIN {MemMap}
  189.    DOSVerNum := Lo(DOSVersion);   {major DOS version number, e.g., 3.X}
  190.        {Note:  OS/2 1.1 DOS mode returns 10.10 for major/minor version}
  191.  
  192.    vflag := (ParamCount > 0) AND
  193.             ((ParamStr(1) = '/v') OR (ParamStr(1) = '/V')) AND
  194.             (DOSVerNum > 2);      {Ignore in DOS 2.X or lower}
  195.    WRITELN ('Memory',' ':41,'MemMap (Version 2, May 89)');
  196.    WRITELN ('Control    Block Size');
  197.    WRITELN (' Block       [Bytes]       Owner');
  198.    WRITELN ('Segment    hex   decimal  Segment      Type      ',
  199.             '          Name');
  200.    WRITELN ('-------  ------- -------  -------  ------------  ',
  201.             '------------------------');
  202.    LastSize := $FFFF;
  203.    NullMCB := 0;
  204.  
  205.    r.AH := $52;    {undocumented DOS function that returns a pointer}
  206.    Intr ($21,r);   {to the DOS 'list of lists'                      }
  207.    segment := MemW[r.ES:r.BX-2];  {segment address of first MCB found at}
  208.                                   {offset -2 from List of List pointer  }
  209.    REPEAT
  210.      MCB := Ptr(segment,0);       {MCB^ points to first MCB}
  211.      ProcessMCB;                  {Look at each MCB}
  212.      segment := segment + MCB^.BlockSize + 1
  213.    UNTIL (MCB^.Blocktag = $5A)    {last one is $5A; all others are $4D}
  214.  
  215. END {MemMap}.
  216.