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