[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]

    {$M 4000,0,0}
    PROGRAM MemMap;

    {
      (C) Copyright 1995, Jose Antonio Noda, Spain.
      All Rights Reserved.

      I can be reached at the places
      listed below:

      Jose Antonio Noda
      Urb: 80 Viviendas, B-5§, 1§ Izq.
      35620 - Gran Tarajal
      Fuerteventura - (Islas Canarias)
      Spain

      Compuserve ID  100667,2523
    }

    USES DOS;

    CONST
      EnvironmentBlock:  STRING[12] = 'Environment ';
      ProgramBlock    :  STRING[12] = 'Program     ';

    TYPE
      MemoryControlBlock =                    {MCB -- only needed fields are shown}
        RECORD
          Blocktag   :  BYTE;                 {tag is M ($4D) except last is Z ($5A)}
          BlockOwner :  WORD;                 {if nonzero, process identifier, usually PID}
          BlockSize  :  WORD;                 {size in 16-byte paragraphs (excludes MCB)}
          misc       :  ARRAY[1..3] OF BYTE;  {placeholder}
          ProgramName:  ARRAY[1..8] OF CHAR   {only used by DOS 4.0; ASCIIZ}
        END;                                  {PID normally taken from PSP}
      ProgramSegmentPrefix =                  {PSP -- only needed fields are shown}
        RECORD                                { offset }
          PSPtag     :  WORD;  { $20CD or $27CD if PSP}  { 00 $00 }
          misc       :  ARRAY[1..21] OF WORD;            { 02 $02 }
          Environment:  WORD                             { 44 $2C }
        END;
    VAR
      DOSVerNum:  BYTE;                       {major version number, e.g., 3 for 3.X}
      LastSize :  WORD;                       {used to detect multiple null MCBs}
      MCB      :  ^MemoryControlBlock;
      NullMCB  :  WORD;                       {counter of MCBs pointing to 0-length blocks}
      r        :  Registers;                  {TYPE defined in DOS unit}
      segment  :  WORD;

    FUNCTION W2X(w:  WORD):  STRING;          {binary word to hex character string}
    CONST HexDigit:  ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
    BEGIN
      W2X :=  HexDigit[Hi(w) SHR 4] + HexDigit[Hi(w) AND $0F] +
              HexDigit[Lo(w) SHR 4] + HexDigit[Lo(w) AND $0F];
    END;

    PROCEDURE ProcessMCB;                     {Each Memory Control Block}
    VAR                                       {is processed by this PROCEDURE.}
      b        :  CHAR;
      Blocktype:  STRING[12];
      bytes    :  LongInt;
      EnvSize  :  WORD;
      i        :  WORD;
      last     :  CHAR;
      MCBenv   :  ^MemoryControlBlock;
      MCBowner :  ^MemoryControlBlock;
      psp      :  ^ProgramSegmentPrefix;
    BEGIN
      IF   (MCB^.BlockTag <> $4D) AND (MCB^.BlockTag <> $5A) AND
           (MCB^.BlockTag <> $00)
      THEN
      BEGIN
        IF   NullMCB > 0
        THEN WRITELN (NullMCB:6,' contiguous MCBs pointing to empty ','blocks not shown.');
        WRITELN ('Unknown Memory Control Block Tag ''',MCB^.BlockTag,'''.');
        WRITELN ('MemMap scan terminated.');
        HALT
      END;
      IF   (MCB^.BlockSize = 0) AND (LastSize = 0)
      THEN INC (NullMCB)  {Count but don't output multiple null MCBs}
      ELSE
      BEGIN
        LastSize := MCB^.BlockSize;
        IF   NullMCB > 0
        THEN BEGIN
        WRITELN (NullMCB:6,' contiguous MCBs pointing to empty ','blocks not shown.');
          NullMCB := 0
      END
      ELSE
      BEGIN
        bytes := LongInt(MCB^.BlockSize) SHL 4; {size of MCB in bytes}
        WRITE (W2X(segment):6,W2X(MCB^.BlockSize):8,'0',bytes:9,
        W2X(MCB^.BlockOwner):8,'   ');
        IF   MCB^.BlockOwner = 0
        THEN
          WRITELN ('Free Space    <unallocated>')
        ELSE
        BEGIN
          psp := Ptr(MCB^.BlockOwner,0);      {possible PSP}
                                              {Almost all programs have a tag of $20CD; DOS MODE is one
                                               that uses $27CD in some versions.}
          IF   (psp^.PSPtag <> $20CD) AND (psp^.PSPtag <> $27CD)
          THEN WRITELN ('System        ',   {not valid PSP}
                        '<DOS ',DosVerNum,'.',Hi(DOSVersion),'>')
          ELSE
          BEGIN                        {valid program segment prefix}
            MCBenv := Ptr(psp^.Environment-1,0);    {MCB of environment}
            BlockType := 'Data        ';            {assume}
            IF   MCB^.Blockowner = (segment + 1)
            THEN
              BlockType := ProgramBlock
            ELSE
            IF   psp^.Environment = (segment + 1)
            THEN
              BlockType := EnvironmentBlock;
              WRITE (BlockType:12,'  ');
            IF  MCB^.BlockOwner <> MCBenv^.BlockOwner
            THEN
            IF   DOSVerNum <> 4
            THEN WRITELN ('<unknown>')  {different owner; unknown in 3.X}
            ELSE
            BEGIN                  {in DOS 4.0 short name is in MCB}
              MCBowner := Ptr(MCB^.Blockowner-1,0);    {MCB of owner block}
              i := 1;
              WHILE (MCBowner^.ProgramName[i] <> #$00) AND (i < 9) DO BEGIN
              WRITE (MCBowner^.ProgramName[i]);
              INC (i)
            END;
            WRITELN
          END
          ELSE
          BEGIN     {environment must have same owner as MCB}
            IF   DOSVerNum < 3
            THEN
              WRITELN ('<unknown>')       {DOS 1.X or 2.X}
            ELSE
            BEGIN                       {DOS 3.X}
              EnvSize := MCBenv^.BlockSize SHL 4;      {multiply by 16}
              i := 0;
              b := CHAR( Mem[psp^.Environment:i] );
              REPEAT
                last := b;    {skip through ASCIIZ environment variables}
                INC (i);
                b := CHAR( Mem[psp^.Environment:i] );
              UNTIL (i > EnvSize) OR ( (b = #$00) AND (last = #$00));
              INC (i);        {end of environment block is $0000}
              b := CHAR( Mem[psp^.Environment:i] );
              IF   (i >= EnvSize) OR (b <> #$01)  {valid signature?}
              THEN
                WRITE ('<shell>')    {shell is probably COMMAND.COM}
              ELSE
              BEGIN
                INC (i,2);              {skip process signature $0001}
                b := CHAR( Mem[psp^.Environment:i] );
                REPEAT
                  WRITE (b);         {output process name byte-by-byte}
                  INC (i);
                  b := CHAR( Mem[psp^.Environment:i] )
                UNTIL (i > EnvSize) OR (b = #$00);
              END;
              WRITELN
            END
          END;
        END;
       END;
      END;
     END;
    END;

    BEGIN
      DOSVerNum := Lo(DOSVersion);                  {major DOS version number}
      WRITELN ('Memory',' ':41,'MemMap (Version 1.0, Jul 95)');
      Writeln;
      WRITELN ('Control    Block Size');
      WRITELN (' Block       [Bytes]       Owner');
      WRITELN ('Segment    hex   decimal  Segment      Type      ',
               '          Name');
      WRITELN ('-------  ------- -------  -------  ------------  ',
               '------------------------');
      LastSize := $FFFF;
      NullMCB := 0;
      r.AH := $52;                       {undocumented DOS function that returns a pointer}
      Intr ($21,r);                      {to the DOS 'list of lists'                      }
      segment := MemW[r.ES:r.BX-2];      {segment address of first MCB found at}
                                         {offset -2 from List of List pointer  }
      REPEAT
        MCB := Ptr(segment,0);           {MCB^ points to first MCB}
        ProcessMCB;                      {Look at each MCB}
        segment := segment + MCB^.BlockSize + 1
      UNTIL (MCB^.Blocktag = $5A)        {last one is $5A; all others are $4D}
    END.

[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]