Category : Pascal Source Code
Archive   : TSRSRC33.ZIP
Filename : RELEASE.PAS
* RELEASE - Releases memory above the last MARK call made. *
* Copyright (c) 1986,1991 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 *
***************************************************************************
* telephone: 719-260-6641, CompuServe: 76004,2611. *
* requires Turbo version 6 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;
CommandSeg : 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
{Don't restore parent if it no longer exists (applies to QEMM LOADHI)}
MemW[PrefixSeg:$16] := PSeg;
{Move the old termination/break/error addresses into this program}
if not UseHiMem then
{Programs loaded into high memory have strange termination addresses}
Move(Mem[0:$88], Mem[PrefixSeg:$0A], 12);
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 (psp = CommandSeg) 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 psp = CommandSeg then
{Don't release blocks owned by master COMMAND.COM}
releaseIt := False
else
{not allocated at time of mark}
releaseIt := (psp <> 0) and (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;
procedure EmsError;
begin
WriteLn('Program error or EMS device not responding');
Abort('EMS memory may be a mess... Please reboot');
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
if not FreeEms(NHandle) then
EmsError;
end else
{No handles stored by MARK, deallocate all current handles}
if not FreeEms(NHandle) then
EmsError;
end;
end;
end;
procedure GetOptions;
{-Analyze command line for options}
procedure WriteCopyright;
begin
WriteLn('RELEASE ', Version, ', Copyright 1991 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(HiMemSeg, Blocks, BlockMax, StartMcb, CommandSeg);
{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.
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/