CD Actual 14/CDACTUAL.iso/cdactual/demobin/share/program/Pascal/TSRSRC30.ZIP/MAPMEM.PAS

Pascal/Delphi Source File | 1991-10-15 | 26.7 KB | 959 lines

{**************************************************************************
*   MAPMEM - Reports system memory blocks.                                *
*   Copyright (c) 1986,1991 Kim Kokkonen, TurboPower Software.            *
*   May be freely distributed and used but not sold except by permission. *
***************************************************************************
*   version 1.0 1/2/86                                                    *
*   :                                                                     *
*   long intervening history                                              *
*   :                                                                     *
*   version 3.0 9/24/91                                                   *
*     completely rewritten for DOS 5 compatibility                        *
*     add upper memory reporting                                          *
*     add XMS reporting                                                   *
*     add free memory report                                              *
*     report on EMS handle names                                          *
*     change command line switches                                        *
*     add check for TSR feature                                           *
*     add Quiet option (useful with "check for" option only)              *
*     add summary report                                                  *
***************************************************************************
*   telephone: [phone], CompuServe: 76004,2611.                      *
*   requires Turbo Pascal version 6 to compile.                           *
***************************************************************************}

{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 2048,0,655360}

program MapMem;

uses
  Dos,
  MemU,
  Xms,
  Ems;

const
  Version = '3.0';
  CheckTSR : Boolean = False;          {'C'}
  ShowEmsMem : Boolean = False;        {'E'}
  ShowFree : Boolean = False;          {'F'}
  UseWatch : Boolean = True;           {'H'}
  Quiet : Boolean = False;             {'Q'}
  ShowSummary : Boolean = False;       {'S'}
  ShowHiMem : Boolean = False;         {'U'}
  Verbose : Boolean = False;           {'V'}
  ShowExtMem : Boolean = False;        {'X'}

  VerboseIndent = 5;

var
  TotalMem : LongInt;
  TopSeg : Word;
  WatchPsp : Word;
  ShowDevices : Boolean;
  ShowSegments : Boolean;
  ShowBlocks : Boolean;
  ShowFiles : Boolean;
  ShowVectors : Boolean;
  GotXms : Boolean;
  SizeLen : Byte;
  NameLen : Byte;
  CmdLen : Byte;
  UmbLinkStatus : Boolean;
  SaveExit : Pointer;
  TsrName : string[79];

const
  FreeName  : string[10] = '---free---';
  TotalName : string[10] = '---total--';

const
  NoShowVecSeg = $FFFE;
  ShowVecSeg   = $FFFF;

  procedure SafeExit; far;
  var
    Status : Word;
  begin
    ExitProc := SaveExit;
    if HiMemAvailable(DosV) then
      Status := SetUmbLinkStatus(UmbLinkStatus);
  end;

  function GetName(M : McbPtr; var Devices : Boolean) : String;
    {-Return a name for Mcb M}
  const
    EnvName : array[boolean] of string[4] = ('', 'env');
    DatName : array[boolean] of string[4] = ('', 'data');
  var
    PspSeg : Word;
    IsCmd : Boolean;
  begin
    Devices := False;
    PspSeg := M^.Psp;

    if (PspSeg = 0) or (PspSeg = PrefixSeg) then
      GetName := FreeName
    else if PspSeg = 8 then begin
      GetName := 'system data';
      if DosV = 5 then
        if (M^.Name[1] = 'S') and (M^.Name[2] = 'D') then begin
          GetName := 'config info';
          Devices := True;
        end;
    end else if PspSeg >= $FFF0 then
      GetName := 'unavailable'
    else if PspSeg = OS(M).S+1 then begin
      {program block}
      IsCmd := (PspSeg = MemW[PspSeg:$16]);
      if (not IsCmd) and (DosV > 2) and HasEnvironment(M) then
        GetName := NameFromEnv(M)
      else if DosV >= 5 then
        GetName := NameFromMcb(M)
      else if IsCmd then
        GetName := 'command'
      else
        GetName := 'n/a';
    end else if MemW[PspSeg:$2C] = OS(M).S+1 then
      GetName := EnvName[Verbose]+'('+GetName(Ptr(PspSeg-1, 0), Devices)+')'
    else
      GetName := DatName[Verbose]+'('+GetName(Ptr(PspSeg-1, 0), Devices)+')';
  end;

  function ValidPsp(PspSeg : Word) : Boolean;
    {-Return True if PspSeg is a valid Psp}
  begin
    if (PspSeg = 0) or (PspSeg = PrefixSeg) or
    (PspSeg = 8) or (PspSeg >= $FFF0) then
      ValidPsp := False
    else
      {First two bytes of PSP should be $CD $20}
      ValidPsp := (MemW[PspSeg:0] = $20CD);
  end;

  function GetFiles(M : McbPtr) : Word;
    {-Return number of open files for given Mcb's Psp}
  type
    HandleTable = array[0..65520] of Byte;
  var
    PspSeg : Word;
    O : Word;
    Files : Word;
    FileMax : Word;
    TablePtr : ^HandleTable;
  begin
    PspSeg := M^.Psp;
    if not ValidPsp(PspSeg) or (PspSeg <> OS(M).S+1) then begin
      GetFiles := 0;
      Exit;
    end;
    {Deal with expanded handle tables in DOS 3.0 and later}
    if DosV >= 3 then begin
      FileMax := MemW[M^.Psp:$32];
      TablePtr := Pointer(MemL[M^.Psp:$34]);
    end else begin
      FileMax := 20;
      TablePtr := Ptr(M^.Psp, $18);
    end;

    Files := 0;
    for O := 0 to FileMax-1 do
      case TablePtr^[O] of
        0, 1, 2, $FF : {standard handle or not open} ;
      else
        Inc(Files);
      end;
    GetFiles := Files;
  end;

  function GetCmdLine(M : McbPtr) : String;
    {-Return command line for program}
  var
    PspSeg : Word;
    S : String[127];
  begin
    PspSeg := M^.Psp;
    if not ValidPsp(PspSeg) or (PspSeg <> OS(M).S+1) then begin
      GetCmdLine := '';
      Exit;
    end;
    Move(Mem[PspSeg:$80], S, 127);
    if S <> '' then begin
      StripNonAscii(S);
      if S = '' then
        S := 'n/a';
    end;
    while (Length(S) > 0) and (S[1] = ' ') do
      Delete(S, 1, 1);
    GetCmdLine := S;
  end;

  procedure WriteChained(LowSeg, HighSeg : Word; StartCol, WrapCol : Byte);
    {-Write vectors that point into specified region of memory}
  var
    Vectors : array[0..255] of Pointer absolute 0:0;
    Vec : Pointer;
    LoL : LongInt;
    HiL : LongInt;
    VeL : LongInt;
    V : Byte;
    Col : Byte;
  begin
    LoL := LongInt(LowSeg) shl 4;
    HiL := LongInt(HighSeg) shl 4;
    Col := StartCol;
    for V := 0 to 255 do begin
      Vec := Vectors[V];
      VeL := (LongInt(OS(Vec).S) shl 4)+OS(Vec).O;
      if (VeL >= LoL) and (VeL < HiL) then begin
        if Col+3 > WrapCol then begin
          {wrap to next line}
          Write(^M^J, '':StartCol-1);
          Col := StartCol;
        end;
        Write(HexB(V), ' ');
        inc(Col, 3);
      end;
    end;
  end;

  procedure WriteHooked(PspSeg : Word; StartCol, WrapCol : Byte);
    {-Write vectors that WATCH found taken over by a block}
  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
          $00 :           {ChangeBlock describes an active vector takeover}
            if Found then begin
              if Col+3 > WrapCol then begin
                {wrap to next line}
                Write(^M^J, '':StartCol-1);
                Col := StartCol;
              end;
              Write(HexB(Lo(VecNum)), ' ');
              inc(Col, 3);
            end;
          $01 :           {ChangeBlock specifies a disabled takeover}
            if Found then begin
              Write('disabled');
              {Don't write this more than once}
              Exit;
            end;
          $FF :           {ChangeBlock starts a new PSP}
            Found := (PspSeg = PspAdd);
        end;
      inc(I, SizeOf(ChangeBlock));
    end;
  end;

  procedure WriteVectors(LowSeg, HighSeg : Word; StartCol, WrapCol : Byte);
    {-Write interrupt vectors either hooked or chained}
  begin
    if UseWatch then
      WriteHooked(LowSeg, StartCol, WrapCol)
    else
      WriteChained(LowSeg, HighSeg, StartCol, WrapCol);
  end;

  procedure WriteMcb(McbSeg, PspSeg, Paras, Blocks, Files : Word;
                     Name : String; CmdLine : String);
    {-Write information about one Mcb or group of mcbs}
  var
    Col : Byte;
  begin
    Col := 1;

    if ShowSegments then begin
      case McbSeg of
        NoShowVecSeg, ShowVecSeg : ;
      else
        Write(HexW(McbSeg), ' ');
        inc(Col, 5);
      end;

      if (PspSeg = 0) or (PspSeg = 8) then
        Write('    ')
      else
        Write(HexW(PspSeg));
      inc(Col, 4);
    end else
      Write('  ');

    if ShowBlocks then begin
      Write(' ', Blocks:2);
      inc(Col, 3);
    end;

    if ShowFiles then begin
      if Files = 0 then
        Write('   ')
      else
        Write(' ', Files:2);
      inc(Col, 3);
    end;

    Write(' ', CommaIze(LongInt(Paras) shl 4, SizeLen),
          ' ', Extend(Name, NameLen),
          ' ', SmartExtend(CmdLine, CmdLen));
    inc(Col, 3+SizeLen+NameLen+CmdLen);

    if ShowVectors then
      if ValidPsp(PspSeg) and
      ((PspSeg = McbSeg+1) or (McbSeg = ShowVecSeg)) then begin
        Write(' ');
        WriteVectors(PspSeg, PspSeg+Paras, Col+1, 79);
      end;

    WriteLn;

    {keep track of total reported memory}
    Inc(TotalMem, Paras);
    Inc(TotalMem, Blocks);        {for the mcbs themselves}
  end;

  procedure WriteDevices(DevSeg, NextSeg : Word);
    {-Write the DOS 5 device list}
  var
    D : McbPtr;
    Name : String[79];
  begin
    D := Ptr(DevSeg, 0);
    while OS(D).S < NextSeg do begin
      case D^.Id of
        'B' : Name := 'buffers';
        'C' : Name := 'ems buffers';
        'D' : Name := 'device='+Asc2Str(D^.Name);
        'E' : Name := 'device ext';
        'F' : Name := 'files';
        'I' : Name := 'ifs='+Asc2Str(D^.Name);
        'L' : Name := 'lastdrive';
        'S' : Name := 'stacks';
        'X' : Name := 'fcbs';
      else
        Name := '';
      end;
      if Name <> '' then
        WriteLn('':20, (LongInt(D^.Len+1) shl 4):6, ' ', Name);
      D := Ptr(OS(D).S+D^.Len+1, 0);
    end;
  end;

  procedure WriteTotalMem;
    {-Write total reported memory with leading space PreSpace}
  var
    PreSpace : Word;
  begin
    if TotalMem <> 0 then begin
      PreSpace := 7;
      if Verbose then
        inc(PreSpace, VerboseIndent);
      WriteLn('':PreSpace, CommaIze(LongInt(TotalMem) shl 4, 8), ' ', TotalName);
      TotalMem := 0;
    end;
  end;

  procedure FindTSR;
    {-Find TSRName, report if appropriate, and halt}
  var
    M : McbPtr;
    PspSeg : Word;
    Done : Boolean;
    Devices : Boolean;
    IsCmd : Boolean;
    Name : String[79];
  begin
    M := Mcb1;
    repeat
      PspSeg := M^.Psp;
      if OS(M).S+1 = PspSeg then begin
        IsCmd := (PspSeg = MemW[PspSeg:$16]);
        if (not IsCmd) and (DosV > 2) and HasEnvironment(M) then
          Name := NameFromEnv(M)
        else if DosV >= 4 then
          Name := NameFromMcb(M)
        else
          Name := '';
        if Name = TsrName then begin
          if not Quiet then
            WriteLn('Found ', TsrName, ' at ', HexW(PspSeg));
          Halt(0);
        end;
      end;
      Done := (M^.Id = 'Z');
      M := Ptr(OS(M).S+M^.Len+1, 0);
    until Done;
    {Not found if we get here}
    Halt(2);
  end;

  procedure WriteVerbose;
    {-Report on each Mcb individually}
  var
    M : McbPtr;
    Done : Boolean;
    Pending : Boolean;
  begin
    Write('Mcb  Psp  Hdl   Size Name           Command Line        ');
    if UseWatch then
      Write('Chained')
    else
      Write('Hooked');
    WriteLn(' Vectors');
    WriteLn('---- ---- --- ------ -------------- ------------------- -----------------------');

    {fake Mcb's used by dos itself}
    WriteMcb($0000, $0000, $0040, 0, 0, 'vectors', '');
    WriteMcb($0040, $0000, $0010, 0, 0, 'BIOS data', '');
    WriteMcb($0050, $0000, $0020, 0, 0, 'DOS data', '');
    WriteMcb($0070, $0000, OS(DosList).S-$70, 0, 0, 'system data', '');
    WriteMcb(OS(DosList).S, $0000, OS(Mcb1).S-OS(DosList).S, 0, 0, 'system code', '');

    M := Mcb1;
    Pending := True;
    repeat
      if Pending and (OS(M).S+1 >= TopSeg) then begin
        WriteTotalMem;
        WriteLn(^M^J'High Memory');
        Pending := False;
      end;
      WriteMcb(OS(M).S, M^.Psp, M^.Len, 1,
               GetFiles(M), GetName(M, ShowDevices), GetCmdLine(M));
      if ShowDevices then
        WriteDevices(OS(M).S+1, OS(M).S+M^.Len+1);
      Done := (M^.Id = 'Z');
      M := Ptr(OS(M).S+M^.Len+1, 0);
    until Done;
    WriteTotalMem;
  end;

  function McbsInHiMem : Boolean;
    {-Return True if any Mcbs found in high memory}
  var
    M : McbPtr;
    Done : Boolean;
  begin
    M := Mcb1;
    repeat
      if OS(M).S >= TopSeg-1 then begin
        McbsInHiMem := True;
        Exit;
      end;
      Done := (M^.Id = 'Z');
      M := Ptr(OS(M).S+M^.Len+1, 0);
    until Done;
    McbsInHiMem := False;
  end;

  procedure SummarizePsp(TPsp, LoMcb, HiMcb : Word);
    {-Write info about all Mcbs in range LoMcb..HiMcb with the specified Psp}
  var
    TM : McbPtr;
    M : McbPtr;
    Size : Word;
    Blocks : Word;
    FakeSeg : Word;
    MPsp : Word;
    Done : Boolean;
    HaveCodeBlock : Boolean;
  begin
    Size := 0;
    Blocks := 0;
    M := Mcb1;
    TM := nil;
    HaveCodeBlock := False;
    repeat
      MPsp := M^.Psp;
      if MPsp = 0 then
        MPsp := OS(M).S;
      if MPsp = TPsp then begin
        if (OS(M).S >= LoMcb) and (OS(M).S < HiMcb) then begin
          Inc(Size, M^.Len);
          Inc(Blocks);
          if OS(M).S+1 = TPsp then
            HaveCodeBlock := True;
        end;
        if TM = nil then
          TM := M
        else if M^.Psp = OS(M).S+1 then
          TM := M;
      end;
      Done := (M^.Id = 'Z');
      M := Ptr(OS(M).S+M^.Len+1, 0);
    until Done;

    if Blocks > 0 then begin
      if HaveCodeBlock then
        FakeSeg := ShowVecSeg
      else
        FakeSeg := NoShowVecSeg;
      WriteMcb(FakeSeg, TM^.Psp, Size, Blocks, 0,
               GetName(TM, ShowDevices), GetCmdLine(TM));
    end;
  end;

  procedure SummarizeRange(LoMcb, HiMcb : Word);
    {-Summarize Psps in the range LoMcb..HiMcb,
      for Psp > 8, Psp < $FFF0, and Psp <> PrefixSeg}
  var
    M : McbPtr;
    MinPsp : Word;
    TPsp : Word;
    PrvPsp : Word;
    Done : Boolean;
  begin
    PrvPsp := 8;
    repeat
      {find the smallest Psp not yet summarized}
      MinPsp := $FFFF;
      M := Mcb1;
      repeat
        TPsp := M^.Psp;
        if TPsp = 0 then
          TPsp := OS(M).S;
        if TPsp < MinPsp then
          if (TPsp > PrvPsp) and (TPsp < $FFF0) and (TPsp <> PrefixSeg) then
            MinPsp := TPsp;
        Done := (M^.Id = 'Z');
        M := Ptr(OS(M).S+M^.Len+1, 0);
      until Done;

      if MinPsp <> $FFFF then begin
        {add up info about this Psp}
        SummarizePsp(MinPsp, LoMcb, HiMcb);
        {"mark out" this Psp}
        PrvPsp := MinPsp;
      end;
    until MinPsp = $FFFF;
  end;

  procedure SummarizeDos(LoMcb, HiMcb : Word);
    {-Sum up memory attributed to DOS}
  var
    M : McbPtr;
    Size : Word;
    Blocks : Word;
    FakeSeg : Word;
    Done : Boolean;
  begin
    M := Mcb1;
    Size := 0;
    Blocks := 0;
    repeat
      if M^.Psp = 8 then
        if (OS(M).S >= LoMcb) and (OS(M).S < HiMcb) then begin
          Inc(Size, M^.Len);
          Inc(Blocks);
        end;
      Done := (M^.Id = 'Z');
      M := Ptr(OS(M).S+M^.Len+1, 0);
    until Done;
    if Blocks > 0 then begin
      if HiMcb > TopSeg then
        FakeSeg := NoShowVecSeg
      else
        FakeSeg := ShowVecSeg;
      WriteMcb(FakeSeg, $00, OS(Mcb1).S+Size, Blocks, 0, 'DOS', '');
    end;
  end;

  procedure SummarizeFree(LoMcb, HiMcb : Word);
    {-Write the free memory blocks in specified range of Mcbs}
  var
    M : McbPtr;
    Done : Boolean;
  begin
    M := Mcb1;
    repeat
      if (M^.Psp = 0) and (M^.Len > 0) and
         (OS(M).S >= LoMcb) and (OS(M).S < HiMcb) then
        WriteMcb(NoShowVecSeg, $0000, M^.Len, 1, 0, FreeName, '');
      Done := (M^.Id = 'Z');
      M := Ptr(OS(M).S+M^.Len+1, 0);
    until Done;
  end;

  procedure WriteCondensed;
    {-Report on Mcb's by Psp}
  begin
    Write('Psp  Cnt   Size Name       Command Line        ');
    if UseWatch then
      Write('Chained')
    else
      Write('Hooked');
    WriteLn(' Vectors');
    WriteLn('---- --- ------ ---------- ------------------- --------------------------------');

    SummarizeDos(0, TopSeg-1);          {DOS memory usage}
    SummarizeRange(0, TopSeg-1);        {programs loaded in low memory}
    SummarizePsp(PrefixSeg, 0, $FFFF);  {current program free space}
    WriteTotalMem;                      {sum of memory so far}

    if ShowHiMem and McbsInHiMem then begin
      WriteLn(^M^J'High Memory');
      SummarizeDos(TopSeg-1, $FFFF);
      SummarizeRange(TopSeg-1, $FFFF);
      WriteTotalMem;
    end;
  end;

  procedure WriteFree;
    {-Show just the free blocks in conventional memory}
  begin
    WriteLn('Normal Memory');
    SummarizeFree(0, TopSeg-1);         {free blocks in low memory}
    SummarizePsp(PrefixSeg, 0, $FFFF);  {current program free space}

    if ShowHiMem and McbsInHiMem then begin
      WriteLn(^M^J'High Memory');
      SummarizeFree(TopSeg-1, $FFFF);
    end;
  end;

  procedure WriteSummary;
    {-Write "summary" report for conventional memory}
  begin
    WriteLn('      Size Name       Command Line');
    WriteLn('---------- ---------- --------------------------------------------------------');

    SummarizeDos(0, TopSeg-1);          {DOS memory usage}
    SummarizeRange(0, TopSeg-1);        {programs loaded in low memory}
    SummarizePsp(PrefixSeg, 0, $FFFF);  {current program free space}

    if ShowHiMem and McbsInHiMem then begin
      WriteLn(^M^J'High Memory');
      SummarizeDos(TopSeg-1, $FFFF);
      SummarizeRange(TopSeg-1, $FFFF);
    end;
  end;

  procedure ShowConventionalMem;
    {-Report on conventional memory, low and high}
  begin
    {Default values for display}
    ShowSegments := True;
    ShowBlocks := False;
    ShowFiles := False;
    ShowVectors := True;
    SizeLen := 7;
    NameLen := 10;
    CmdLen := 19;

    if ShowFree then begin
      ShowSegments := False;
      ShowVectors := False;
      WriteFree;
    end else if ShowSummary then begin
      ShowSegments := False;
      ShowVectors := False;
      CmdLen := 56;
      WriteSummary;
    end else if Verbose then begin
      ShowFiles := True;
      NameLen := 14;
      WriteVerbose;
    end else begin
      ShowBlocks := True;
      WriteCondensed;
    end;
  end;

  procedure ShowTheEmsMem;
  var
    Handles : Word;
    H : Word;
    P : Word;
    Pages : LongInt;
    EmsV : Byte;
    PreSpace : Byte;
    Name : string[9];
    PageMap : PageArray;
  begin
    if not EmsPresent then
      Exit;
    WriteLn;
    WriteLn('EMS Memory');
    if not(ShowFree or ShowSummary) then begin
      EmsV := EmsVersion;
      Handles := EmsHandles(PageMap);
      if Handles > 0 then
        for H := 0 to Handles-1 do begin
          P := PageMap[H].NumPages;
          if P <> 0 then begin
            Write(HexW(H), ' ');
            if Verbose then
              Write('':VerboseIndent);
            Write(CommaIze(LongInt(P) shl 14, 10));
            if EmsV >= $40 then begin
              GetHandleName(PageMap[H].Handle, Name);
              if Name = '' then
                Name := 'n/a';
            end else
              Name := 'n/a';
            WriteLn(' ', Name);
          end;
        end;
    end;
    Pages := EmsPagesAvailable;
    if ShowFree or ShowSummary then
      PreSpace := 0
    else
      PreSpace := 5;
    if Verbose then
      inc(PreSpace, VerboseIndent);
    WriteLn('':PreSpace, CommaIze(LongInt(OS(Pages).O) shl 14, 10), ' ', FreeName);
    if ShowSummary or (not ShowFree) then
      WriteLn('':PreSpace, CommaIze(LongInt(OS(Pages).S) shl 14, 10), ' ', TotalName);
  end;

  procedure ShowTheXmsMem;
    {-Show what we can about XMS}
  label
    ExitPoint;
  var
    FMem : Word;
    FMax : Word;
    XHandles : Word;
    H : Word;
    HMem : Word;
    Total : Word;
    XmsPages : XmsHandlesPtr;
    Status : Byte;
    PreSpace : Byte;
  begin
    if not XmsInstalled then
      Exit;
    Status := QueryFreeExtMem(FMem, FMax);
    if Status = $A0 then begin
      FMem := 0;
      FMax := 0;
    end else if Status <> 0 then
      Exit;

    {Total will count total XMS memory}
    Total := 0;

    WriteLn(^M^J'XMS Memory');
    GotXms := not Verbose;

    if ShowFree then
      goto ExitPoint;

    {Get an array containing handles}
    XHandles := GetXmsHandles(XmsPages);

    {Report all the handles}
    for H := 1 to XHandles do begin
      HMem := XmsPages^[H].NumPages;
      if not ShowSummary then begin
        Write(HexW(H), ' ');
        if Verbose then
          Write('':VerboseIndent);
        WriteLn(CommaIze(LongInt(HMem) shl 10, 10), ' n/a');
      end;
      inc(Total, HMem);
    end;

    {Add the free memory to the total}
    inc(Total, FMem);

ExitPoint:
    if ShowFree or ShowSummary then
      PreSpace := 0
    else
      PreSpace := 5;
    if Verbose then
      inc(PreSpace, VerboseIndent);
    WriteLn('':PreSpace, CommaIze(LongInt(FMem) shl 10, 10), ' ', FreeName);
    if Total <> 0 then
      WriteLn('':PreSpace, CommaIze(LongInt(Total) shl 10, 10), ' ', TotalName);
  end;

  procedure ShowTheExtendedMem;
  var
    Total : LongInt;
    PreSpace : Byte;
  begin
    if GotXms or ShowFree then
      Exit;
    if ExtMemPossible then
      Total := ExtMemTotalPrim
    else
      Total := 0;
    if Total = 0 then
      Exit;

    WriteLn(^M^J'Raw Extended Memory');
    PreSpace := 5;
    if Verbose then
      inc(PreSpace, VerboseIndent);
    WriteLn('':PreSpace, CommaIze(Total, 10), ' ', TotalName);
  end;

  procedure WriteCopyright;
    {-Write a copyright message}
  begin
    Write('MAPMEM ', Version, ', Copyright 1991 TurboPower Software'^M^J^M^J);
  end;

  procedure Initialize;
    {-Initialize various global variables}
  begin
    GotXms := False;
    TotalMem := 0;
    TopSeg := TopOfMemSeg;
  end;

  procedure GetOptions;
    {-Parse command line and set options}
  var
    I : Word;
    Status : Word;
    Arg : String[127];

    procedure WriteHelp;
    begin
      WriteCopyright;
      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('     /C name  check whether TSR "name" is loaded.');
      WriteLn('     /E       report expanded (EMS) memory.');
      WriteLn('     /F       report free areas only.');
      WriteLn('     /H       do not use WATCH information for vectors.');
      WriteLn('     /Q       write no screen output with /C option.');
      WriteLn('     /S       show summary of all memory areas.');
      WriteLn('     /U       report upper memory blocks (DOS 5).');
      WriteLn('     /V       verbose report.');
      WriteLn('     /X       report extended (XMS) memory.');
      WriteLn('     /?       write this help screen.');
      Halt(1);
    end;

    procedure UnknownOption;
    begin
      WriteCopyright;
      WriteLn('Unknown command line option: ', Arg);
      Halt(1);
    end;

    procedure BadOption;
    begin
      WriteCopyright;
      WriteLn('Invalid command line option: ', Arg);
      Halt(1);
    end;

  begin
    TsrName := '';

    I := 1;
    while I <= ParamCount do begin
      Arg := ParamStr(I);
      if Arg = '?' then
        WriteHelp
      else
        case Arg[1] of
          '-', '/' :
            case Length(Arg) of
              1 : BadOption;
              2 : case Upcase(Arg[2]) of
                    '?' : WriteHelp;
                    'C' : begin
                            CheckTSR := not CheckTSR;
                            if CheckTSR then begin
                              if I = ParamCount then begin
                                WriteCopyright;
                                WriteLn('TSR name to check for is missing');
                                Halt(1);
                              end;
                              inc(I);
                              TsrName := StUpcase(ParamStr(I));
                            end;
                          end;
                    'E' : ShowEmsMem := not ShowEmsMem;
                    'F' : ShowFree := not ShowFree;
                    'H' : UseWatch := not UseWatch;
                    'Q' : Quiet := not Quiet;
                    'S' : ShowSummary := not ShowSummary;
                    'U' : ShowHiMem := not ShowHiMem;
                    'V' : Verbose := not Verbose;
                    'X' : ShowExtMem := not ShowExtMem;
                  else
                    BadOption;
                  end;
            else
              UnknownOption;
            end;
        else
          UnknownOption;
        end;
      Inc(I);
    end;

    {Account for related options}
    if ShowFree then
      ShowSummary := False;
    if ShowFree or ShowSummary then begin
      ShowHiMem := True;
      ShowEmsMem := True;
      ShowExtMem := True;
      Verbose := False;
    end;
    if not CheckTSR then
      Quiet := False;

    {Initialize for high memory access}
    if HiMemAvailable(DosV) then begin
      UmbLinkStatus := GetUmbLinkStatus;
      if SetUmbLinkStatus(ShowHiMem) <> 0 then
        ShowHiMem := False;
    end else
      ShowHiMem := False;
    SaveExit := ExitProc;
    ExitProc := @SafeExit;

    {Find WATCH in memory if requested}
    if UseWatch then begin
      WatchPsp := WatchPspSeg;
      if WatchPsp = 0 then
        UseWatch := False;
    end;

    if not Quiet then
      WriteCopyright;
  end;

begin
  Initialize;
  GetOptions;
  SwapVectors;
  if CheckTSR then
    FindTSR
  else begin
    ShowConventionalMem;
    if ShowEmsMem then
      ShowTheEmsMem;
    if ShowExtMem then begin
      ShowTheXmsMem;
      ShowTheExtendedMem;
    end;
  end;
end.