{**************************************************************************
* RELEASE - Releases memory above the last MARK call made. *
* Copyright (c) 1986,1993 Kim Kokkonen, TurboPower Software. *
* May be freely distributed and used but not sold except by permission. *
***************************************************************************
* Version 1.0 2/8/86 *
* original public release *
* (thanks to Neil Rubenking for an outline of the method used) *
* : *
* long intervening history *
* : *
* Version 3.0 9/24/91 *
* make compatible with DOS 5 *
* add Quiet option *
* close open file handles of released blocks *
* update for new WATCH behavior *
* increase number of supported memory blocks to 256 *
* add support for upper memory blocks *
* Version 3.1 11/4/91 *
* no change *
* Version 3.2 11/22/91 *
* generalize method of accessing high memory *
* reverse order in which memory blocks are released to work *
* correctly with the 386MAX high memory manager *
* merge blocks in high memory after release (QEMM doesn't) *
* Version 3.3 1/8/92 *
* add /H to use high memory optionally *
* new features for parsing and getting command line options *
* Version 3.4 2/14/92 *
* fix hang that occurs when QEMM LOADHI didn't have space to *
* load a mark high *
* Version 3.5 10/18/93 *
* modify RestoreEMSMap to deal with EMS blocks for which a mapping *
* context has been stored *
* solve problem with RELEASE /U for a MARK loaded high with QEMM 7.0 *
* solve problem with RELEASE /U for a MARK loaded high with 386MAX *
***************************************************************************
* telephone: 719-260-6641, CompuServe: 76004,2611. *
* requires Turbo version 6 or 7 to compile. *
***************************************************************************}
{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 16384,0,655360}
program ReleaseTSR;
{-Restore system to state it had when a MARK was placed}
uses
Dos,
MemU,
Ems,
Xms;
var
Blocks : BlockArray;
markBlock, BlockMax : BlockType;
markPsp : Word;
StartMcb : Word;
HiMemSeg : Word;
markName : String[127];
ReturnCode : Word;
OptUseHiMem, UseHiMem, DealWithEMS, KeepMark,
MemMark, FilMark, Quiet : Boolean;
Keys : string[16];
TrappedBytes : LongInt;
MarkEHandles : Word;
CurrEHandles : Word;
MarkEmsHandles : PageArrayPtr;
CurrEmsHandles : PageArrayPtr;
{Save areas read in from file mark}
Vectors : array[0..1023] of Byte;
EGAsavTable : array[0..7] of Byte;
IntComTable : array[0..15] of Byte;
ParentSeg : Word;
ParentLen : Word;
McbP : ^McbGroup;
procedure Abort(msg : String);
{-Halt in case of error}
begin
WriteLn(msg);
Halt(1);
end;
procedure NoRestoreHalt(ReturnCode : Word);
{-Replace Turbo halt with one that doesn't restore any interrupts}
begin
Close(Output);
asm
mov ah,$4C
mov al, byte(ReturnCode)
int $21
end;
end;
function FindMark(markName, MarkID : String;
MarkOffset : Word;
var MemMark, FilMark : Boolean;
var b : BlockType) : Boolean;
{-Find the last memory block matching idstring at offset idoffset}
var
BPsp : Word;
PassedFileMark : Boolean;
function HasIDstring(segment : Word;
idString : String;
idOffset : Word) : Boolean;
{-Return true if idstring is found at segment:idoffset}
var
len : Byte;
tString : String;
begin
len := Length(idString);
tString[0] := Chr(len);
Move(Mem[segment:idOffset], tString[1], len);
HasIDstring := (tString = idString);
end;
function GetMarkName(segment : Word) : String;
{-Return a cleaned up mark name from the segment's PSP}
var
tString : String;
tlen : Byte absolute tString;
begin
Move(Mem[segment:$80], tString[0], 128);
while (tlen > 0) and ((tString[1] = ' ') or (tString[1] = ^I)) do
Delete(tString, 1, 1);
while (tlen > 0) and ((tString[tlen] = ' ') or (tString[tlen] = ^I)) do
dec(tlen);
GetMarkName := StUpcase(tString);
end;
function MatchMemMark(segment : Word;
markName : String;
var b : BlockType) : Boolean;
{-Return true if MemMark is unnamed or matches current name}
var
FoundIt : Boolean;
tString : String;
begin
tString := GetMarkName(segment);
if markName <> '' then begin
FoundIt := (tString = markName);
if not FoundIt and not UseHiMem then
if (tString <> '') and (tString[1] = ProtectChar) then
{Current mark is protected, stop searching}
b := 1;
end else if (tString <> '') and (tString[1] = ProtectChar) then begin
{Stored mark name is protected}
FoundIt := False;
{Stop checking}
b := 1;
end else if tString = '' then
{Unnamed release and unnamed mark}
FoundIt := True
else begin
{Unnamed release and named mark, match only if didn't pass file mark}
FoundIt := not PassedFileMark;
{Stop searching if no match}
if not FoundIt then
B := 1;
end;
if not FoundIt then
dec(b);
MatchMemMark := FoundIt;
end;
function MatchFilMark(segment : Word;
markName : String;
var b : BlockType) : Boolean;
{-Return true if FilMark is unnamed or matches current name}
var
FoundIt : Boolean;
begin
if markName <> '' then begin
FoundIt := (GetMarkName(segment) = markName);
if FoundIt then
{Assure named file exists}
FoundIt := ExistFile(markName);
end else begin
{File marks must be named on RELEASE command line}
FoundIt := False;
PassedFileMark := True;
end;
if not FoundIt then
dec(B);
MatchFilMark := FoundIt;
end;
begin
{Scan from the last block down to find the last MARK TSR}
b := BlockMax;
MemMark := False;
FilMark := False;
PassedFileMark := False;
repeat
BPsp := Blocks[B].Psp;
if (Blocks[B].Mcb+1 <> BPsp) or (BPsp = PrefixSeg) then
{Don't match any non-program block or this program}
dec(b)
else if HasIDstring(BPsp, NmarkID, NmarkOffset) then begin
{A net mark, can't release it here}
if UseHiMem then
{Keep looking}
dec(b)
else
{Stop looking}
b := 0;
end else if HasIDstring(BPsp, MarkID, MarkOffset) then
{An in-memory mark}
MemMark := MatchMemMark(BPsp, markName, b)
else if HasIDstring(BPsp, FmarkID, FmarkOffset) then
{A file mark}
FilMark := MatchFilMark(BPsp, markName, b)
else
{Not a mark}
dec(b);
until (b < 1) or MemMark or FilMark;
FindMark := MemMark or FilMark;
end;
procedure ReadMarkFile(markName : String);
{-Read the mark file info into memory}
var
McbCount : Word;
f : file;
begin
Assign(f, markName);
Reset(f, 1);
if IoResult <> 0 then
Abort('Error opening mark file');
{Read the vector table from the mark file, into a temporary memory area}
BlockRead(f, Vectors, 1024);
{Read the BIOS miscellaneous save areas into temporary tables}
BlockRead(f, EGAsavTable, 8);
BlockRead(f, IntComTable, 16);
BlockRead(f, ParentSeg, 2);
BlockRead(f, ParentLen, 2);
{Read the stored EMS handles, if any}
BlockRead(f, MarkEHandles, SizeOf(Word));
GetMem(MarkEmsHandles, SizeOf(HandlePageRecord)*MarkEHandles);
BlockRead(f, MarkEmsHandles^, SizeOf(HandlePageRecord)*MarkEHandles);
{Read the stored Mcb table}
BlockRead(f, McbCount, SizeOf(Word));
GetMem(McbP, SizeOf(Word)+2*SizeOf(Word)*McbCount);
BlockRead(f, McbP^.Mcbs, 2*SizeOf(Word)*McbCount);
McbP^.Count := McbCount;
if IoResult <> 0 then
Abort('Error reading mark file');
Close(f);
if not KeepMark then
{Delete the mark file so it causes no mischief later}
Erase(f);
end;
procedure InitMarkInfo;
{-Set up information from mark in memory}
begin
MarkEHandles := MemW[markPsp:EMScntOffset];
MarkEmsHandles := Ptr(markPsp, EMSmapOffset);
McbP := Ptr(markPsp, EMSmapOffset+4*MarkEHandles);
end;
procedure CopyVectors;
{-Put interrupt vectors back into table}
var
PSeg : Word;
PLen : Word;
begin
IntsOff;
{Restore the main interrupt vector table}
if FilMark then
Move(Vectors, Mem[0:0], 1024)
else
Move(Mem[markPsp:VectorOffset], Mem[0:0], 1024);
IntsOn;
{Restore misc save areas}
if FilMark then begin
Move(EGAsavTable, Mem[$40:$A8], 8);
Move(IntComTable, Mem[$40:$F0], 16);
PSeg := ParentSeg;
PLen := ParentLen;
end else begin
Move(Mem[markPsp:EGAsavOffset], Mem[$40:$A8], 8);
Move(Mem[markPsp:IntComOffset], Mem[$40:$F0], 16);
PSeg := MemW[markPsp:ParentOffset];
PLen := MemW[markPsp:ParLenOffset];
end;
{Restore the parent address}
if ValidPsp(HiMemSeg, PSeg, PLen) then begin
{Don't restore parent if it no longer exists (applies to QEMM LOADHI)}
MemW[PrefixSeg:$16] := PSeg;
if not UseHiMem then
{Programs loaded into high memory have strange termination addresses}
Move(Mem[0:4*$22], Mem[PrefixSeg:$0A], 4); {Int 22 addresses}
end;
{Move the old break/error addresses into this program}
Move(Mem[0:4*$23], Mem[PrefixSeg:$0E], 8); {Int 23,24 addresses}
end;
procedure MarkBlocks(markBlock : BlockType);
{-Mark those blocks to be released}
procedure BatchWarning(b : BlockType);
{-Warn about the trapping effect of batch files}
var
t : BlockType;
begin
{WriteLn('Memory space for TSRs installed prior to batch file');} {!!}
{WriteLn('will not be released until batch file completes.');} {!!}
{WriteLn;} {!!}
ReturnCode := 1;
{Accumulate number of bytes temporarily trapped}
for t := 1 to b do
if Blocks[t].releaseIt then
inc(TrappedBytes, LongInt(MemW[Blocks[t].mcb:3]) shl 4);
end;
procedure MarkBlocksAbove;
{-Mark blocks above the mark}
var
b : BlockType;
begin
for b := 1 to BlockMax do
with Blocks[b] do
if (b >= markBlock) and (mcb+1 = psp) and (memw[psp:$16] = psp) then begin
{Don't release blocks owned by master COMMAND.COM}
releaseIt := False;
BatchWarning(b);
end else if KeepMark then
{Release all but RELEASE and the mark}
releaseIt := (psp <> PrefixSeg) and (psp > markPsp)
else
releaseIt := (psp <> PrefixSeg) and (psp >= markPsp);
end;
procedure MarkUnallocatedBlocks;
{-Mark blocks that weren't allocated at time of mark}
var
TopSeg : Word;
b : BlockType;
m : BlockType;
Found : Boolean;
begin
{Find last low memory mcb}
TopSeg := TopOfMemSeg-1;
m := 1;
Found := False;
while (not Found) and (m <= McbP^.Count) do
if McbP^.Mcbs[m].mcb >= TopSeg then
Found := True
else
inc(m);
{Mark out all mcbs associated with psp of last low memory mcb}
TopSeg := McbP^.Mcbs[m-1].psp;
if TopSeg <> markPsp then
for m := 1 to McbP^.Count do
with McbP^.Mcbs[m] do
if psp = TopSeg then
psp := 0;
for b := 1 to BlockMax do
with Blocks[b] do begin
Found := False;
m := 1;
while (not Found) and (m <= McbP^.Count) do begin
Found := (McbP^.Mcbs[m].psp <> 0) and (McbP^.Mcbs[m].mcb = mcb);
inc(m);
end;
if Found then
{was allocated at time of mark, keep it now unless a mark to be released}
releaseIt := not KeepMark and (psp = markPsp)
else if (mcb+1 = psp) and (memw[psp:$16] = psp) then
{Don't release blocks owned by master COMMAND.COM}
releaseIt := False
else if (psp <= $400) or (psp >= $FFF0) then
{Don't release blocks owned by system or 386MAX}
releaseIt := False
else
{not allocated at time of mark}
releaseIt := (psp <> PrefixSeg);
end;
end;
begin
if UseHiMem then
MarkUnallocatedBlocks
else
MarkBlocksAbove;
{$IFDEF Debug}
for b := 1 to BlockMax do
with Blocks[b] do
WriteLn(b:3, ' ', HexW(psp), ' ', HexW(mcb), ' ', releaseIt);
{$ENDIF}
end;
function ReleaseBlock(Segm : Word) : Word; assembler;
{-Use DOS services to release memory block}
asm
mov ah,$49
mov es,Segm
int $21
jc @Done
xor ax,ax
@Done:
end;
procedure ReleaseMem;
{-Release DOS memory marked for release}
var
B : BlockType;
begin
for B := BlockMax downto 1 do
with Blocks[B] do
if releaseIt then
if ReleaseBlock(mcb+1) <> 0 then begin
WriteLn('Could not release block at segment ', HexW(mcb+1));
Abort('Memory may be a mess... Please reboot');
end;
MergeHiMemBlocks(HiMemSeg);
end;
procedure SetPSP(PSP : Word); assembler;
{-Sets current PSP}
asm
mov bx,psp
mov ax,$5000
int $21
end;
procedure CloseHandles;
{-Close any handles of blocks marked for release}
type
HandleTable = array[0..65520] of Byte;
var
O : Word;
FileMax : Word;
TablePtr : ^HandleTable;
b : BlockType;
H : Byte;
begin
for b := 1 to BlockMax do
with Blocks[b] do
if releaseIt and (psp = mcb+1) and (memw[psp:0] = $20CD) then begin
{A released block with a program segment prefix}
{set psp to this block}
setpsp(psp);
{Deal with expanded handle tables in DOS 3.0 and later}
if DosV >= 3 then begin
FileMax := MemW[Psp:$32];
TablePtr := Pointer(MemL[Psp:$34]);
end else begin
FileMax := 20;
TablePtr := Ptr(Psp, $18);
end;
for O := 0 to FileMax-1 do begin
H := TablePtr^[O];
case H of
0, 1, 2, $FF : {standard handle or not open} ;
else
asm
mov ah,$3E
mov bx,O
int $21 {ignore errors}
end;
end;
end;
end;
{reset psp}
setpsp(prefixseg);
end;
procedure RestoreEMSmap;
{-Restore EMS to state at time of mark}
var
O, N, NHandle : Word;
Status : Byte;
procedure EmsError;
begin
WriteLn('Program error or EMS device not responding');
Abort('EMS memory may be a mess... Please reboot');
end;
procedure MapAndFree(Handle : Word);
var
Status : Byte;
begin
Status := FreeEms(NHandle);
if Status = $86 then
Status := RestorePageMap(NHandle);
if Status <> 0 then
EmsError;
end;
begin
{Get the existing EMS page map}
GetMem(CurrEmsHandles, MaxHandles*SizeOf(HandlePageRecord));
CurrEHandles := EmsHandles(CurrEmsHandles^);
if CurrEHandles > MaxHandles then
WriteLn('EMS handle count exceeds capacity of RELEASE -- no action taken')
else if CurrEHandles <> 0 then begin
{Compare the two maps and deallocate pages not in the stored map}
for N := 1 to CurrEHandles do begin
{Scan all current handles}
NHandle := CurrEmsHandles^[N].Handle;
if MarkEHandles > 0 then begin
{See if current handle matches one stored by MARK}
O := 1;
while (MarkEmsHandles^[O].Handle <> NHandle) and (O <= MarkEHandles) do
Inc(O);
{If not, deallocate the current handle}
if (O > MarkEHandles) then
MapAndFree(NHandle);
end else
{No handles stored by MARK, deallocate all current handles}
MapAndFree(NHandle);
end;
end;
end;
procedure GetOptions;
{-Analyze command line for options}
procedure WriteCopyright;
begin
WriteLn('RELEASE ', Version, ', Copyright 1993 TurboPower Software');
end;
procedure WriteHelp;
{-Show the options}
begin
WriteCopyright;
WriteLn;
WriteLn('RELEASE removes memory-resident programs from memory and restores the');
WriteLn('interrupt vectors to their state as found prior to the installation of a MARK.');
WriteLn('RELEASE manages both normal DOS memory and also Lotus/Intel Expanded Memory.');
WriteLn('If WATCH has been installed, RELEASE will update the WATCH data area for the');
WriteLn('TSRs released.');
WriteLn;
WriteLn('RELEASE accepts the following command line syntax:');
WriteLn;
WriteLn(' RELEASE [MarkName] [Options]');
WriteLn;
WriteLn('Options may be preceded by either / or -. Valid options are as follows:');
WriteLn;
WriteLn(' /E do NOT access EMS memory.');
WriteLn(' /H work with upper memory if available.');
WriteLn(' /K release memory, but keep the mark in place.');
WriteLn(' /Q write no screen output.');
WriteLn(' /S chars stuff string (<16 chars) into keyboard buffer on exit.');
WriteLn(' /U work with upper memory, but halt if none found.');
WriteLn(' /? write this help screen.');
WriteLn;
WriteLn('When /U is requested, a MarkName must always be specified.');
Halt(1);
end;
procedure GetArgs(S : String);
var
SPos : Word;
Arg : String[127];
begin
SPos := 1;
repeat
Arg := NextArg(S, SPos);
if Arg = '' then
Exit;
if Arg[1] = '?' then
WriteHelp
else if (Arg[1] = '-') or (Arg[1] = '/') then
case Length(Arg) of
1 : Abort('Missing command option following '+Arg);
2 : case UpCase(Arg[2]) of
'?' : WriteHelp;
'E' : DealWithEMS := False;
'H' : OptUseHiMem := True;
'K' : KeepMark := True;
'Q' : Quiet := True;
'S' : begin
Arg := NextArg(S, SPos);
if Length(Arg) = 0 then
Abort('Key string missing');
if Length(Arg) > 15 then
Abort('No more than 15 keys may be stuffed');
Keys := Arg+^M;
end;
'U' : UseHiMem := True;
else
Abort('Unknown command option: '+Arg);
end;
else
Abort('Unknown command option: '+Arg);
end
else
{Named mark}
markName := StUpcase(Arg);
until False;
end;
begin
{Initialize defaults}
markName := '';
Keys := '';
ReturnCode := 0;
TrappedBytes := 00;
KeepMark := False;
Quiet := False;
DealWithEMS := True;
UseHiMem := False;
OptUseHiMem := False;
{Get arguments from the command line and the environment}
GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
GetArgs(GetEnv('RELEASE'));
if not Quiet then
WriteCopyright;
{Initialize for high memory access}
if OptUseHiMem or UseHiMem then begin
HiMemSeg := FindHiMemStart;
if HiMemSeg = 0 then begin
if UseHiMem then
Abort('No upper memory blocks found');
end else
UseHiMem := True;
end else
HiMemSeg := 0;
if UseHiMem then
if MarkName = '' then
Abort('Upper memory releases must refer to named marks');
end;
begin
{Analyze command line for options}
GetOptions;
{Get all allocated memory blocks in normal memory}
FindTheBlocks(True, HiMemSeg, Blocks, BlockMax, StartMcb);
{Find the last one marked with the MARK idstring, and MarkName if specified}
if not FindMark(markName, MarkID, MarkOffset, MemMark, FilMark, markBlock) then
Abort('No matching marker found, or protected marker encountered.');
markPsp := Blocks[markBlock].psp;
{Get file mark information into memory}
if FilMark then
ReadMarkFile(markName)
else
InitMarkInfo;
{Mark those blocks to be released}
MarkBlocks(markBlock);
{Copy the vector table from the MARK copy}
CopyVectors;
{Close open file handles}
CloseHandles;
{Release normal memory marked for release}
ReleaseMem;
{Deal with expanded memory}
if DealWithEMS then
if EMSpresent then
RestoreEMSmap;
{Write success message}
if not Quiet then begin
Write('Memory released after MARK');
if markName <> '' then
Write(' (', markName, ')');
WriteLn;
if ReturnCode <> 0 then
WriteLn(TrappedBytes, ' bytes temporarily trapped until batch file completes');
end;
{Stuff keyboard buffer if requested}
if Length(Keys) > 0 then
StuffKeys(Keys, True);
NoRestoreHalt(ReturnCode);
end.
