Category : Pascal Source Code
Archive   : TSRSRC33.ZIP
Filename : MAPMEM.PAS
* 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 *
* version 3.1 11/4/91 *
* fix bug in EMS handle reporting *
* fix problem in getting name of TSR that shrinks environment (FSP) *
* prevent from keeping interrupt 0 *
* fix source naming of WriteChained vs WriteHooked *
* show command line and vectors even if lower part of PSP is *
* overwritten (DATAPATH) *
* wouldn't find (using /C) a program whose name was stored in *
* lowercase in the environment (Windows 3.0) *
* version 3.2 11/22/91 *
* generalize high memory support *
* handle some DRDOS 6.0 conventions *
* fix indentation problem in raw extended memory report *
* version 3.3 1/8/92 *
* /C getname wasn't finding TSRs in high memory *
* increase stack space *
* new features for parsing and getting command line options *
***************************************************************************
* telephone: 719-260-6641, CompuServe: 76004,2611. *
* requires Turbo Pascal 6 to compile. *
***************************************************************************}
{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 4096,2048,655360}
{.$DEFINE MeasureStack} {Activate to measure stack usage}
program MapMem;
uses
Dos,
MemU,
Xms,
Ems;
const
CheckTSR : Boolean = False; {'C'}
ShowEmsMem : Boolean = False; {'E'}
ShowFree : Boolean = False; {'F'}
UseWatch : Boolean = True; {'H'}
Quiet : Boolean = False; {'Q'}
ShowSummary : Boolean = False; {'S'}
UseHiMem : Boolean = False; {'U'}
Verbose : Boolean = False; {'V'}
ShowExtMem : Boolean = False; {'X'}
var
TotalMem : LongInt;
TopSeg : Word;
HiMemSeg : 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];
{$IFDEF MeasureStack}
I : Word;
{$ENDIF}
const
FreeName : string[10] = '---free---';
TotalName : string[10] = '---total--';
const
VerboseIndent = 5;
NoShowVecSeg = $FFFE;
ShowVecSeg = $FFFF;
procedure SafeExit; far;
begin
ExitProc := SaveExit;
SwapVectors;
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 := 'sys data';
if DosV = 5 then
if (M^.Name[1] = 'S') and (M^.Name[2] = 'D') then begin
GetName := 'cfg info';
Devices := True;
end;
end else if (PspSeg < 8) or (PspSeg >= $FFF0) then
GetName := 'unknown'
else if PspSeg = OS(M).S+1 then begin
{program block}
IsCmd := (PspSeg = MemW[PspSeg:$16]);
if (not IsCmd) and (DosV > 2) and HasEnvironment(HiMemSeg, M) then
GetName := NameFromEnv(M)
else if DosV >= 4 then
GetName := NameFromMcb(M)
else if IsCmd then
GetName := 'command'
else if DosVT >= $031E then
GetName := NameFromMcb(M)
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) and (PspSeg <= 8)) or
(PspSeg = PrefixSeg) or
(PspSeg >= $FFF0) then
ValidPsp := False
else
ValidPsp := True;
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 (PspSeg <> OS(M).S+1) or not ValidPsp(PspSeg) or
(MemW[PspSeg:$50] <> $21CD) 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 (PspSeg <> OS(M).S+1) or not ValidPsp(PspSeg) 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 WriteHooked(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 WriteChained(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
WriteChained(LowSeg, StartCol, WrapCol)
else
WriteHooked(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 (PspSeg = McbSeg+1) or (McbSeg = ShowVecSeg) then
if ValidPsp(PspSeg) 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, CommaIze(D^.Len+1, 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}
procedure FindOne(Start : McbPtr);
var
M : McbPtr;
PspSeg : Word;
Done : Boolean;
IsCmd : Boolean;
Name : String[79];
begin
M := Start;
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(HiMemSeg, M) then
Name := NameFromEnv(M)
else if DosV >= 4 then
Name := NameFromMcb(M)
else if (not IsCmd) and (DosVT >= $031E) then
Name := NameFromMcb(M)
else
Name := '';
if StUpcase(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;
end;
begin
FindOne(Mcb1);
if HiMemSeg <> 0 then
FindOne(Ptr(HiMemSeg, 0));
{Not found if we get here}
Halt(2);
end;
procedure ShowChain(M : McbPtr);
{-Show chain of blocks starting at M}
var
Done : Boolean;
begin
repeat
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;
procedure WriteVerbose;
{-Report on each Mcb individually}
var
M : McbPtr;
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, 'sys data', '');
WriteMcb(OS(DosList).S, $0000, OS(Mcb1).S-OS(DosList).S, 0, 0, 'sys code', '');
M := Mcb1;
ShowChain(Mcb1);
if UseHiMem then begin
WriteLn(^M^J'High Memory');
ShowChain(Ptr(HiMemSeg, 0));
end;
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 := Ptr(LoMcb, 0);
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 := Ptr(LoMcb, 0);
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 := Ptr(LoMcb, 0);
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 := Ptr(LoMcb, 0); {!!}
{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(OS(Mcb1).S, TopSeg-1); {DOS memory usage}
SummarizeRange(OS(Mcb1).S, TopSeg-1);{programs loaded in low memory}
SummarizePsp(PrefixSeg, OS(Mcb1).S, $FFFF); {current program free space}
WriteTotalMem; {sum of memory so far}
if UseHiMem then begin
WriteLn(^M^J'High Memory');
SummarizeDos(HiMemSeg, $FFFF);
SummarizeRange(HiMemSeg, $FFFF);
WriteTotalMem;
end;
end;
procedure WriteFree;
{-Show just the free blocks in conventional memory}
begin
WriteLn('Normal Memory');
SummarizeFree(OS(Mcb1).S, TopSeg-1); {!!} {free blocks in low memory}
SummarizePsp(PrefixSeg, OS(Mcb1).S, $FFFF); {current program free space}
if UseHiMem then begin
WriteLn(^M^J'High Memory');
SummarizeFree(HiMemSeg, $FFFF); {!!}
end;
end;
procedure WriteSummary;
{-Write "summary" report for conventional memory}
begin
WriteLn(' Size Name Command Line');
WriteLn('---------- ---------- --------------------------------------------------------');
SummarizeDos(OS(Mcb1).S, TopSeg-1); {DOS memory usage}
SummarizeRange(OS(Mcb1).S, TopSeg-1); {programs loaded in low memory}
SummarizePsp(PrefixSeg, OS(Mcb1).S, $FFFF); {current program free space}
if UseHiMem then begin
WriteLn(^M^J'High Memory');
SummarizeDos(HiMemSeg, $FFFF);
SummarizeRange(HiMemSeg, $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 := 1 to Handles 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');
if ShowSummary then
PreSpace := 0
else
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
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;
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 if available.');
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;
procedure GetArgs(S : String);
var
SPos : Word;
begin
SPos := 1;
repeat
Arg := NextArg(S, SPos);
if Arg = '' then
Exit;
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
TSRName := StUpcase(NextArg(S, SPos));
if TSRName = '' then begin
WriteCopyright;
WriteLn('TSR name to check for is missing');
Halt(1);
end;
end;
end;
'E' : ShowEmsMem := not ShowEmsMem;
'F' : ShowFree := not ShowFree;
'H' : UseWatch := not UseWatch;
'Q' : Quiet := not Quiet;
'S' : ShowSummary := not ShowSummary;
'U' : UseHiMem := not UseHiMem;
'V' : Verbose := not Verbose;
'X' : ShowExtMem := not ShowExtMem;
else
BadOption;
end;
else
UnknownOption;
end;
else
UnknownOption;
end;
until False;
end;
begin
TsrName := '';
{Get arguments from the command line and the environment}
GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
GetArgs(GetEnv('MAPMEM'));
{Account for related options}
if ShowFree then
ShowSummary := False;
if ShowFree or ShowSummary then begin
UseHiMem := True;
ShowEmsMem := True;
ShowExtMem := True;
Verbose := False;
end;
if not CheckTSR then
Quiet := False;
{Initialize for high memory access}
HiMemSeg := FindHiMemStart;
if HiMemSeg = 0 then
UseHiMem := False;
{Don't report any vectors normally taken over by SYSTEM}
SwapVectors;
{ExitProc will undo swap and restore high memory access}
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
{$IFDEF MeasureStack}
FillChar(Mem[SSeg:0], SPtr-16, $AA);
{$ENDIF}
Initialize;
GetOptions;
if CheckTSR then
FindTSR
else begin
ShowConventionalMem;
if ShowEmsMem then
ShowTheEmsMem;
if ShowExtMem then begin
ShowTheXmsMem;
ShowTheExtendedMem;
end;
end;
{$IFDEF MeasureStack}
I := 0;
while I < SPtr-16 do
if Mem[SSeg:i] <> $AA then begin
writeln('Unused stack ', i, ' bytes');
I := SPtr;
end else
inc(I);
{$ENDIF}
end.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/