Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TSRSRC29.ZIP/MAPMEM.PAS

Pascal/Delphi Source File | 1993-01-04 | 30.2 KB | 953 lines

{$R-,S-,I+}

{**************************************************************************
*   Maps system memory blocks for MS/PCDOS 2.0 and higher.                *
*   Also maps expanded memory allocation blocks                           *
*   Copyright (c) 1986 Kim Kokkonen, TurboPower Software.                 *
*   Released to the public domain for personal, non-commercial use only.  *
***************************************************************************
*   version 1.0 1/2/86                                                    *
*   version 1.1 1/10/86                                                   *
*     running under DOS 2.X, where block owner names are unknown          *
*   version 1.2 1/22/86                                                   *
*     a bug in parsing the owner name of the block                        *
*     a quirk in the way that the DOS PRINT buffer installs itself        *
*     minor cosmetic changes                                              *
*   version 1.3 2/6/86                                                    *
*     smarter filtering for processes that deallocate their environment   *
*   version 1.4 2/23/86                                                   *
*     add a map of Expanded memory (EMS) as well                          *
*   version 1.5 2/26/86                                                   *
*     change format of last memory block                                  *
*     change to more reliable scheme of finding first block               *
*       (thanks to Chris Dunford for pointing out a useful                *
*        undocumented DOS function).                                      *
*     support environment lengths up to 32K                               *
*   version 1.6 3/8/86                                                    *
*     support "verbose" output mode                                       *
*       display open file handles                                         *
*       show command line of each block                                   *
*   version 1.7 3/24/86                                                   *
*     work around Turbo 3.00B bug with Delete procedure and length 255    *
*     filter out command lines of programs which relocate over their      *
*       command line at PSP:$80                                           *
*     fix treatment of handle counts from PSP                             *
*     add display of number of memory blocks per PSP to verbose mode      *
*     accept V, -V, or /V for the verbose switch                          *
*   version 1.8 4/20/86                                                   *
*     change verbose mode to show each block individually                 *
*   version 1.9 5/22/86                                                   *
*     synchronize with RELEASE                                            *
*   version 2.0 6/17/86                                                   *
*     synchronize with RELEASE                                            *
*   version 2.1 7/18/86                                                   *
*     wrap long vector lists                                              *
*   version 2.2 3/4/87                                                    *
*     add support for WATCH files                                         *
*   version 2.3 5/1/87                                                    *
*     use in-memory WATCH data                                            *
*     display disabled status of TSRs                                     *
*   version 2.4 5/17/87                                                   *
*     avoid use of EMS call $4B, which doesn't work in many EMS           *
*       implementations                                                   *
*   version 2.5 5/26/87                                                   *
*     correct problem with MAPMEM run in batch file with WATCH            *                                    *
*   version 2.6 1/15/89                                                   *
*     make changes to deal with 386-to-the-Max                            *
*     convert to Turbo Pascal 5.0                                         *
*   version 2.7                                                           *
*     skipped                                                             *
*   version 2.8 3/10/89                                                   *
*     clean up a few Turbo 3 leftovers                                    *
*     add total extended memory report                                    *
*   version 2.9 5/4/89                                                    *
*     fix bug when no EMS blocks allocated                                *
***************************************************************************
*   telephone: [phone], CompuServe: 72457,2131.                      *
*   requires Turbo version 5 to compile.                                  *
***************************************************************************}

program MapMem;
  {-look at the system memory map using DOS memory control blocks}
uses
  dos;

const
  Version = '2.9';
  MaxBlocks = 100;            {max number of DOS memory blocks checked}
  MaxVector = $FF;            {highest interrupt vector checked for trapping}

  WatchID = 'TSR WATCHER';    {marking string for WATCH}

  {offsets into resident copy of WATCH.COM for data storage}
  WatchOffset = $81;
  NextChange = $104;
  ChangeVectors = $220;
  OrigVectors = $620;
  CurrVectors = $A20;

  ATclass = $FC;              {machine ID bytes}
  Model80 = $F8;

type
  Pathname = string[64];
  AllStrings = string[255];

  BlockType = 0..MaxBlocks;
  Block =
  record                      {store info about each memory block as it is found}
    idbyte : Byte;
    mcb : Word;
    psp : Word;
    len : Word;
    psplen : Word;
    env : Word;
    cnt : Word;
  end;
  BlockArray = array[BlockType] of Block;

var
  Blocks : BlockArray;
  WatchBlock, BlockNum : BlockType;
  WroteHeader, UseHook, Verbose, UseWatch : Boolean;
  MachineId : Byte absolute $FFFF : $000E;

  procedure Abort(msg : AllStrings);
    {-halt in case of error}
  begin
    WriteLn(msg);
    Halt(1);
  end;

  function StUpcase(s : Pathname) : Pathname;
    {-return the upper case of a string}
  var
    i : Byte;
  begin
    for i := 1 to Length(s) do
      s[i] := UpCase(s[i]);
    StUpcase := s;
  end;

  procedure FindTheBlocks;
    {-scan memory for the allocated memory blocks}
  const
    MidBlockID = $4D;         {byte DOS uses to identify part of MCB chain}
    EndBlockID = $5A;         {byte DOS uses to identify last block of MCB chain}
  var
    mcbSeg : Word;         {segment address of current MCB}
    nextSeg : Word;        {computed segment address for the next MCB}
    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}

    function GetStartMCB : Word;
      {-return the first MCB segment}
    var
      reg : registers;
    begin
      reg.ah := $52;
      MsDos(reg);
      GetStartMCB := MemW[reg.es:(reg.bx-2)];
    end;

    procedure StoreTheBlock(var mcbSeg, nextSeg : Word;
                            var gotFirst, gotLast : Boolean);
      {-store information regarding the memory block}
    var
      nextID : Byte;
      pspAdd : Word;       {segment address of the current PSP}
      mcbLen : Word;       {size of the current memory block in paragraphs}

    begin

      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}
      nextID := Mem[nextSeg:0];

      if gotLast or (nextID = EndBlockID) or (nextID = MidBlockID) then begin
        BlockNum := Succ(BlockNum);
        gotFirst := True;
        with Blocks[BlockNum] do begin
          idbyte := Mem[mcbSeg:0];
          mcb := mcbSeg;
          psp := pspAdd;
          env := MemW[pspAdd:$2C];
          len := mcbLen;
          psplen := 0;
          cnt := 1;
        end;
      end;

    end;

  begin

    {initialize}
    mcbSeg := GetStartMCB;
    gotFirst := False;
    gotLast := False;
    BlockNum := 0;

    {scan all memory until the last block is found}
    repeat
      idbyte := Mem[mcbSeg:0];
      if idbyte = MidBlockID then begin
        StoreTheBlock(mcbSeg, nextSeg, gotFirst, gotLast);
        if gotFirst then mcbSeg := nextSeg else mcbSeg := Succ(mcbSeg);
      end else if gotFirst and (idbyte = EndBlockID) then begin
        gotLast := True;
        StoreTheBlock(mcbSeg, nextSeg, gotFirst, gotLast);
      end else
        {start block was invalid}
        Abort('corrupted allocation chain or program error');
    until gotLast;

  end;

  function FindMark(markName : AllStrings; markOffset : Word) : Word;
    {-find the last memory block matching idstring at offset idoffset}
  var
    b : BlockType;
    MemMark : Boolean;

    function HasIDstring(segment : Word;
                         idString : AllStrings;
                         idOffset : Word) : Boolean;
      {-return true if idstring is found at segment:idoffset}
    var
      len : Byte absolute idString;
      tString : AllStrings;
      tlen : Byte absolute tString;

    begin
      tlen := len;
      Move(Mem[segment:idOffset], tString[1], len);
      HasIDstring := (tString = idString);
    end;

  begin
    {scan from the last block down to find the last MARK TSR}
    b := BlockNum;
    MemMark := False;
    repeat
      if Blocks[b].psp = PrefixSeg then
        {assure this program's command line is not matched}
        b := Pred(b)
      else if HasIDstring(Blocks[b].psp, markName, markOffset) then
        {Mark found}
        MemMark := True
      else
        {Keep looking}
        b := Pred(b);
    until (b < 1) or MemMark;

    UseWatch := MemMark;
    FindMark := b;

  end;

  procedure StripNonAscii(var t : Pathname);
    {-return an empty string if t contains any non-printable characters}
  var
    ipos : Byte;
    goodname : Boolean;
  begin
    goodname := True;
    for ipos := 1 to Length(t) do
      if (t[ipos] <> #0) and ((t[ipos] < ' ') or (t[ipos] > '}')) then
        goodname := False;
    if not(goodname) then t := '';
  end;

  function DOSversion : Byte;
    {-return the major version number of DOS}
  var
    reg : registers;
  begin
    reg.ah := $30;
    MsDos(Dos.Registers(reg));
    DOSversion := reg.al;
  end;

  procedure ShowTheBlocks;
    {-analyze and display the blocks found}
  const
    hookst : string[14] = 'hooked vectors';
    chainst : string[15] = 'chained vectors';
  type
    HexString = string[4];
    Address = record
                offset, segment : Word;
              end;
    VectorType = 0..MaxVector;
  var
    st, cline : Pathname;
    b : BlockType;
    StLen, DOSv : Byte;
    CommandPSP, WatchPSP : Word;
    Vectors : array[VectorType] of Address absolute 0 : 0;
    Vtable : array[VectorType] of LongInt;
    SumNum : BlockType;
    Sum : BlockArray;

    function HexB(b : Byte) : HexString;
      {-return hex representation of byte}
    const
      hc : array[0..15] of Char = '0123456789ABCDEF';
    begin
      HexB := hc[b shr 4]+hc[b and $F];
    end;

    function HexW(i : Word) : HexString;
      {-return hex representation of Word}
    begin
      HexW := HexB(Hi(i))+HexB(Lo(i));
    end;

    function Owner(startadd : Word) : Pathname;
      {-return the name of the owner program of an MCB}
    type
      chararray = array[0..32767] of Char;
    var
      e : ^chararray;
      i : Word;
      t : Pathname;

      function LongPos(m : Pathname; var s : chararray) : Word;
        {-return the position number of m in s, or 0 if not found}
      var
        mc : Char;
        ss : Pathname;
        i, maxindex : Word;
        found : Boolean;
      begin
        i := 0;
        maxindex := SizeOf(s)-Length(m);
        ss[0] := m[0];
        if Length(m) > 0 then begin
          mc := m[1];
          repeat
            while (s[i] <> mc) and (i <= maxindex) do
              i := Succ(i);
            if s[i] = mc then begin
              Move(s[i], ss[1], Length(m));
              found := (ss = m);
              if not(found) then i := Succ(i);
            end;
          until found or (i > maxindex);
          if not(found) then i := 0;
        end;
        LongPos := i;
      end;

      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;

      procedure StripExtension(var pname : Pathname);
        {-remove the file extension}
      var
        dotpos : Byte;
      begin
        dotpos := Pos('.', pname);
        if dotpos <> 0 then
          Delete(pname, dotpos, 64); {<255 needed for Turbo version 3.00B bug}
      end;

    begin
      {point to the environment string}
      e := Ptr(startadd, 0);

      {find end of the standard environment}
      i := LongPos(#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+4;               {skip over #0#0#args}
      repeat
        t := t+e^[i];
        i := Succ(i);
      until (Length(t) > 63) or (e^[i] = #0);

      StripNonAscii(t);
      if t = '' then
        Owner := 'N/A'
      else begin
        StripPathname(t);
        StripExtension(t);
        if t = '' then t := 'N/A';
        Owner := StUpcase(t);
      end;

    end;

    procedure InitVectorTable;
      {-build real equivalent of vector addresses}
    var
      v : VectorType;

      function RealAdd(a : Address) : LongInt;
        {-return the real equivalent of an address (pointer)}
      begin
        with a do
          RealAdd := (LongInt(segment) shl 4)+offset;
      end;

    begin
      for v := 0 to MaxVector do
        Vtable[v] := RealAdd(Vectors[v]);
    end;

    procedure WriteVecs(start, stop, startcol, wrapcol : Word);
      {-Show either trapped or chained interrupt vectors}

      procedure WriteHooks(start, stop, startcol, wrapcol : Word);
        {-show the trapped interrupt vectors}
      var
        v : VectorType;
        sadd, eadd : LongInt;
        col : Word;
      begin
        sadd := LongInt(start) shl 4;
        eadd := LongInt(stop) shl 4;
        col := startcol;
        for v := 0 to MaxVector do
          if (Vtable[v] >= sadd) and (Vtable[v] <= eadd) then begin
            if col+3 > wrapcol then begin
              {wrap to next line}
              WriteLn;
              Write('':Pred(startcol));
              col := startcol;
            end;
            Write(HexB(v), ' ');
            col := col+3;
          end;
      end;

      procedure WriteChained(pspA, startcol, wrapcol : Word);
        {-Write Chained interrupts as determined from watch data}
      type
        ChangeBlock =
        record                {Store info about each vector takeover}
          VecNum : Byte;
          case ID : Byte of
            0, 1 : (VecOfs, VecSeg : Word);
            2 : (SaveCode : array[1..6] of Byte);
            $FF : (pspAdd : Word);
        end;
        {
        ID is interpreted as follows:
        00 = ChangeBlock holds the new pointer for vector vecnum
        01 = ChangeBlock holds pointer for vecnum but the block is disabled
        02 = ChangeBlock holds the code underneath the vector patch
        FF = ChangeBlock holds the segment of a new PSP
        }
      var
        p : ^ChangeBlock;
        i, maxchg, col : Word;
        found : Boolean;
      begin
        {Initialize}
        maxchg := MemW[WatchPSP:NextChange];
        col := startcol;
        found := False;
        i := 0;

        while i < maxchg do begin
          p := Ptr(WatchPSP, ChangeVectors+i);
          with p^ do
            case ID of
              $FF :           {ChangeBlock starts a new PSP}
                found := (pspA = pspAdd);
              $00 :           {ChangeBlock describes an active vector takeover}
                if found then begin
                  {ChangeBlock specifies a vector taken over}
                  if col >= wrapcol then begin
                    Write(^M^J, '':Pred(startcol));
                    col := startcol;
                  end;
                  Write(HexB(Lo(VecNum)), ' ');
                  col := col+3;
                end;
              $01 :           {ChangeBlock specifies a disabled takeover}
                if found then begin
                  Write('disabled');
                  {Don't write this more than once}
                  Exit;
                end;
            end;
          i := i+SizeOf(ChangeBlock);
        end;
      end;

    begin
      if start <> stop then
        if UseWatch then
          WriteChained(start, startcol, wrapcol)
        else
          WriteHooks(start, stop, startcol, wrapcol);
    end;

    procedure SortByPSP(var Blocks : BlockArray; BlockNum : BlockType);
      {-sort in order of ascending PSP}
    var
      i, j : BlockType;
      temp : Block;
    begin
      for i := 1 to Pred(BlockNum) do
        for j := BlockNum downto Succ(i) do
          if Blocks[j].psp < Blocks[Pred(j)].psp then begin
            temp := Blocks[j];
            Blocks[j] := Blocks[Pred(j)];
            Blocks[Pred(j)] := temp;
          end;
    end;

    procedure SumTheBlocks(var Blocks : BlockArray;
                           BlockNum : BlockType;
                           var Sum : BlockArray;
                           var SumNum : BlockType);
      {-combine the blocks with equivalent PSPs}
    var
      prevPSP : Word;
      b : BlockType;
    begin
      SumNum := 0;
      prevPSP := 0;
      for b := 1 to BlockNum do begin
        if Blocks[b].psp <> prevPSP then begin
          SumNum := Succ(SumNum);
          Sum[SumNum] := Blocks[b];
          prevPSP := Blocks[b].psp;
          if prevPSP = PrefixSeg then
            {don't include the environment as part of free block's length}
            Sum[SumNum].len := 0;
        end else
          with Sum[SumNum] do begin
            cnt := Succ(cnt);
            len := len+Blocks[b].len;
          end;
        {get length of the block which owns the executable program}
        {for checking vector trapping next}
        if Succ(Blocks[b].mcb) = Blocks[b].psp then
          Sum[SumNum].psplen := Blocks[b].len;
      end;
    end;

    procedure TransferTheBlocks(var Blocks : BlockArray;
                                BlockNum : BlockType;
                                var Sum : BlockArray;
                                var SumNum : BlockType);
      {-fill in the Sum array with a little initialization}
    var
      b : BlockType;
    begin
      for b := 1 to BlockNum do begin
        Sum[b] := Blocks[b];
        with Sum[b] do begin
          cnt := 1;
          if (Succ(mcb) = psp) and (psp <> 0) then
            psplen := len
          else
            psplen := 0;
        end;
      end;
      SumNum := BlockNum;
    end;

    function OpenHandles(psp : Word) : Word;
      {-return the number of open handles owned by a process}
    var
      h, o : Word;
      b : Byte;
    begin
      h := 0;
      if (psp <> 8) and (cline <> 'N/A') then
        for o := 0 to 19 do begin
          b := Mem[psp:$18+o];
          if not(b in [$FF, 0..2]) then
            h := Succ(h);
        end;
      OpenHandles := h;
    end;

    function CommandLine(psp : Word) : Pathname;
      {-return the command line of the PSP}
    var
      t, s : Pathname;
    begin
      if (psp <> 8) then begin
        Move(Mem[psp:$80], t, 65);
        if t[0] > #64 then t[0] := #64;
        s := t;
        StripNonAscii(t);
        if s <> t then
          {command line has been written over}
          t := 'N/A'
        else
          {strip leading blanks}
          while (Length(t) > 0) and (t[1] = #32) do Delete(t, 1, 1);
      end else
        {psp=8 is a special block owned by DOS containing the CONFIG.SYS drivers}
        t := '';
      CommandLine := t;
    end;

    function PrevBlock(b : BlockType; psp : Word) : BlockType;
      {-return highest block with number less than b having a PSP matching psp}
      {-return 0 if none}
    var
      t : BlockType;
      found : Boolean;
    begin
      found := False;
      t := Pred(b);
      while (t > 0) and not(found) do begin
        found := (Sum[t].psp = psp);
        if not(found) then t := Pred(t);
      end;
      PrevBlock := t;
    end;

    procedure WriteTitle;
    begin
      Write('Allocated Memory Map - by TurboPower Software - Version ', Version);

      if Verbose then begin
        WriteLn('  (verbose)');
        WriteLn;
        Write(' PSP  MCB files bytes owner    command line  ');
        if UseWatch then
          WriteLn(chainst)
        else
          WriteLn(hookst);
        WriteLn('---- ---- ----- ----- -------- ------------- -----------------------------');
      end else begin
        WriteLn;
        WriteLn;
        Write(' PSP  blks bytes owner    command line        ');
        if UseWatch then
          WriteLn(chainst)
        else
          WriteLn(hookst);
        WriteLn('----- ---- ----- -------- ------------------- ------------------------------');
      end;
    end;

  begin

    WriteTitle;

    {Get critical PSP addresses before sorting blocks}
    CommandPSP := Blocks[2].psp;
    if UseWatch then
      WatchPSP := Blocks[WatchBlock].psp
    else
      InitVectorTable;

    {Rearrange the blocks for presentation}
    if Verbose then
      TransferTheBlocks(Blocks, BlockNum, Sum, SumNum)
    else begin
      SortByPSP(Blocks, BlockNum);
      SumTheBlocks(Blocks, BlockNum, Sum, SumNum);
    end;

    {Get DOS version number to see whether environment has program names}
    DOSv := DOSversion;

    for b := 1 to SumNum do
    with Sum[b] do begin

      {get the command line which invoked the program}
      if b = SumNum then
        cline := ''
      else
        cline := CommandLine(psp);

      {write out numerical information}
      Write(HexW(psp), ' ');   {PSP address}
      if Verbose then begin
        Write(HexW(mcb), '  ', {MCB address}
        OpenHandles(psp):2, '  '); {number of open file handles}
      end else
        Write(cnt:3, '  ');   {number of blocks}

      Write((LongInt(len) shl 4):6, ' '); {size of block in bytes}

      {get the program owning this block by scanning the environment}
      if psp = PrefixSeg then
        st := 'free'
      else if psp = CommandPSP then
        st := 'command'
      else if psp = Sum[1].psp then
        st := 'config'
      else if (DOSv >= 3) then begin
        if Verbose then begin
          if Succ(mcb) = env then
            {this is the environment block}
            st := Owner(env)
          else if PrevBlock(b, psp) <> 0 then
            {this is the block that goes with the environment}
            st := Owner(Sum[PrevBlock(b, psp)].env)
          else
            st := 'N/A';
        end else if cnt > 1 then
          st := Owner(env)
        else
          st := 'N/A';
      end else
        st := 'N/A';
      while Length(st) < 9 do
        st := st+' ';
      Write(st);

      {write the command line that invoked the program}
      if Verbose then
        StLen := 13
      else
        StLen := 19;
      if Length(cline) > StLen-3 then
        cline := Copy(cline, 1, StLen-3)+'...'
      else
        while Length(cline) < StLen do cline := cline+' ';
      Write(cline, ' ');

      {write the trapped interrupt vectors}
      if Verbose then
        WriteVecs(psp, psp+psplen, 46, 75)
      else if (psp <> PrefixSeg) then
        WriteVecs(psp, psp+psplen, 47, 75);

      WriteLn;
    end;

  end;

  procedure ShowTheEMSblocks;
    {-map out expanded memory, if present}
  const
    EMSinterrupt = $67;       {the vector used by the expanded memory manager}
    MaxHandles = 255;

  type
    HandlePageRecord =
    record
      handle : Word;
      numpages : Word;
    end;

    PageArray = array[0..MaxHandles] of HandlePageRecord;
    PageArrayPtr = ^PageArray;
    Pathname = string[64];

  var
    EMSregs : registers;
    EMShandles : Word;
    Map : PageArrayPtr;
    TotalPages : Word;

    function EMSpresent : Boolean;
      {-Return true if EMS memory manager is present}
    var
      f : file;
    begin
      {"file handle" defined by the expanded memory manager at installation}
      Assign(f, 'EMMXXXX0');
      {$I-}
      Reset(f);
      {$I+}
      if IOResult = 0 then begin
        EMSpresent := True;
        Close(f);
      end else
        EMSpresent := False;
    end;

    function EMSpagesAvailable(var TotalPages : Word) : Word;
      {-return the number of 16K expanded memory pages available and unallocated}
    begin
      EMSregs.ah := $42;
      Intr(EMSinterrupt, Dos.Registers(EMSregs));
      if EMSregs.ah <> 0 then begin
        WriteLn('EMS device not responding');
        EMSpagesAvailable := 0;
        Exit;
      end;
      EMSpagesAvailable := EMSregs.bx;
      TotalPages := EMSregs.dx;
    end;

    procedure EMSpageMap(var PageMap : PageArray; var EMShandles : Word);
      {-return an array of the allocated memory blocks}
    begin
      EMSregs.ah := $4D;
      EMSregs.es := Seg(PageMap);
      EMSregs.di := Ofs(PageMap);
      EMSregs.bx := 0;
      Intr(EMSinterrupt, Dos.Registers(EMSregs));
      if EMSregs.ah <> 0 then begin
        WriteLn('EMS device not responding');
        EMShandles := 0;
      end else
        EMShandles := EMSregs.bx;
    end;

    procedure WriteEMSmap(PageMap : PageArray; handles : Word);
      {-write out the EMS page map}
    var
      h : Word;
    begin
      WroteHeader := True;
      WriteLn('block   bytes   (Expanded Memory)');
      WriteLn('-----   ------');
      if Handles > 0 then
        for h := 0 to Pred(handles) do
          if PageMap[h].numpages <> 0 then
            WriteLn(h:5, '  ', (LongInt(16384)*PageMap[h].numpages):7);
    end;

  begin
    if not(EMSpresent) then
      Exit;
    WriteLn;
    {Get space for the largest possible page map}
    GetMem(Map, 2048);
    EMSpageMap(Map^, EMShandles);
    WriteEMSmap(Map^, EMShandles);
    WriteLn(' free  ', (16384*LongInt(EMSpagesAvailable(TotalPages))):7);
    WriteLn('total  ', (16384*LongInt(TotalPages)):7);
  end;

  function ExtMemTotalPrim : LongInt;
    {-Returns total number of bytes of extended memory in the system.}
  inline(
    $B4/$88/                 {mov ah,$88     ;get extended memory function}
    $CD/$15/                 {int $15        ;returns KB avail in AX}
    $B9/$00/$04/             {mov cx,1024    ;CX = 1024 = bytes per KB}
    $F7/$E1);                {mul cx         ;DX:AX has result}

  function ExtMemPossible : Boolean;
    {-Return true if extended memory is possible}
  begin
    {don't allow allocation if running PC or XT, or under DOS 2.x or OS/2}
    ExtMemPossible := False;
    case DosVersion of
      3..4 :
        case MachineId of
          ATclass, Model80 : ExtMemPossible := True;
        end;
    end;
  end;

  procedure ShowTheExtendedMemory;
    {-Show extended memory, if any}
  var
    Total : LongInt;
  begin
    if ExtMemPossible then
      Total := ExtMemTotalPrim
    else
      Total := 0;
    if Total = 0 then
      Exit;
    if WroteHeader then
      WriteLn('                (Extended Memory)')
    else begin
      WroteHeader := True;
      WriteLn;
      WriteLn('block   bytes   (Extended Memory)');
      WriteLn('-----   ------');
    end;
    WriteLn('total  ', Total:7);
  end;

  procedure GetOptions;
    {-Analyze command line for options}
  const
    unknop : string[24] = 'Unknown command option: ';
  var
    arg : AllStrings;
    arglen : Byte absolute arg;
    i : Word;

    procedure WriteHelp;
      {-Show the options}
    begin
      WriteLn('MAPMEM ', Version, ', by TurboPower Software');
      WriteLn;
      WriteLn('MAPMEM produces a report showing what memory resident programs are installed,');
      WriteLn('how much memory each uses, and what interrupt vectors are taken over.');
      WriteLn;
      WriteLn('MAPMEM accepts the following command line syntax:');
      WriteLn;
      WriteLn('  MAPMEM [Options]');
      WriteLn;
      WriteLn('Options may be preceded by either / or -. Valid options are as follows:');
      WriteLn('     /H     do not use WATCH information.');
      WriteLn('     /V     verbose report.');
      WriteLn('     /?     write this help screen.');
      Halt(1);
    end;

  begin
    {Initialize defaults}
    Verbose := False;
    UseHook := False;
    WroteHeader := False;

    i := 1;
    while i <= ParamCount do begin
      arg := ParamStr(i);
      if (arg[1] = '?') then
        WriteHelp
      else if (arg[1] = '-') or (arg[1] = '/') then
        case arglen of
          1 : Abort('Missing command option following '+arg);
          2 : case UpCase(arg[2]) of
                '?' : WriteHelp;
                'H' : UseHook := True;
                'V' : Verbose := True;
              else
                Abort(unknop+arg);
              end;
        else
          Abort(unknop+arg);
        end
      else
        Abort(unknop+arg);
      i := Succ(i);
    end;

  end;

begin
  GetOptions;
  FindTheBlocks;
  WatchBlock := FindMark(WatchID, WatchOffset);
  UseWatch := UseWatch and not(UseHook);
  ShowTheBlocks;
  ShowTheEMSblocks;
  ShowTheExtendedMemory;
end.