del@pilchuck.Data-IO.COM (Erik Lindberg) (11/21/86)
The requests for the sources to trace DOS memory block allocations have
been pouring in, so I decided to post. I will not be mailing to the
individuals that requested it. Sorry, but .... well, you know...
# This is a shell archive.
# Remove everything above and including the cut line.
# Then run the rest of the file through sh.
#----cut here-----cut here-----cut here-----cut here----#
#!/bin/sh
# shar: Shell Archiver
# Run the following text with /bin/sh to create:
# clrtsr.doc
# mapmem.pas
# mark.asm
# oldmark.asm
# read.me
# release.pas
# This archive created: Thu Nov 20 18:23:42 1986
echo shar: extracting clrtsr.doc
sed 's/^XX//' << \SHAR_EOF > clrtsr.doc
XX{**************************************************************************
XX* Copyright (c) 1986 Kim Kokkonen, TurboPower Software. *
XX* Released to the public domain for personal, non-commercial use only. *
XX***************************************************************************
XX* written 2/8/86 *
XX***************************************************************************
XX* telephone: 408-378-3672, CompuServe: 72457,2131. *
XX***************************************************************************}
XX
XXClrTSR is a small system of two programs that can be used
XXto manage memory-resident programs. TSR stands for "Terminate
XXand Stay Resident". The two programs are are used simply
XXas follows:
XX
XX1) Call the program MARK.COM before installing any memory-
XX resident program that you may wish to deinstall later.
XX This marks the current position in memory and stores the
XX DOS interrupt vector table (all interrupts from 0 to FFH).
XX
XX2) Install whatever TSRs that you want to use in the normal
XX way that you install them.
XX
XX3) When you want to deinstall all TSRs above the last MARK,
XX call the program RELEASE.COM. This will release all of the
XX memory above (and including) the last MARK, and restore
XX all interrupt vectors taken over by the memory resident
XX programs.
XX
XXMARK and RELEASE can be "stacked" as many times as desired.
XXRELEASE always releases the memory above the last MARK called.
XX
XXMARK and RELEASE should work on any system running PCDOS or
XXMSDOS 2.0 or later. They were developed on a Compaq Deskpro
XX286 running Compaq DOS 3.0.
XX
XXGet the program MAPMEM.COM (or MAPMEM.PAS) to display the
XXcurrent DOS memory map at any time. Get the program EATMEM.COM
XXor EATMEM.ASM for development work where you want to test
XXsoftware in an environment with a desired amount of available
XXmemory.
XX
XXWritten by Kim Kokkonen, TurboPower Software,
XXVersion 1.0 - 2/8/86.
XXTelephone: 408-378-3672, Compuserve: 72457,2131
SHAR_EOF
if test 2024 -ne "`wc -c clrtsr.doc`"
then
echo shar: error transmitting clrtsr.doc '(should have been 2024 characters)'
fi
echo shar: extracting mapmem.pas
sed 's/^XX//' << \SHAR_EOF > mapmem.pas
XX{**************************************************************************
XX* Maps system memory blocks for MS/PCDOS 2.0 and higher. *
XX* Copyright (c) 1986 Kim Kokkonen, TurboPower Software. *
XX* Released to the public domain for personal, non-commercial use only. *
XX***************************************************************************
XX* written 1/2/86 *
XX* revised 1/10/86 for *
XX* running under DOS 2.X, where block owner names are unknown *
XX* revised 1/22/86 for *
XX* a bug in parsing the owner name of the block *
XX* a quirk in the way that the DOS PRINT buffer installs itself *
XX* minor cosmetic changes *
XX* revised 2/6/86 for (version 1.3) *
XX* smarter filtering for processes that deallocate their environment *
XX***************************************************************************
XX* telephone: 408-378-3672, CompuServe: 72457,2131. *
XX* requires Turbo version 3 to compile. *
XX* Compile with mAx dynamic memory = A000. *
XX* limited to environment sizes of 255 bytes (default is 128 bytes) *
XX***************************************************************************}
XX
XX{$P128}
XX
XXPROGRAM MapMem;
XX {-look at the system memory map using DOS memory control blocks}
XXCONST
XX MaxBlocks = 100;
XX Version = '1.3';
XXTYPE
XX Block = RECORD {store info about each memory block as it is found}
XX idbyte : Byte;
XX mcb : Integer;
XX psp : Integer;
XX len : Integer;
XX psplen : Integer;
XX env : Integer;
XX cnt : Integer;
XX END;
XX BlockType = 0..MaxBlocks;
XX BlockArray = ARRAY[BlockType] OF Block;
XX
XXVAR
XX Blocks : BlockArray;
XX BlockNum : BlockType;
XX
XX PROCEDURE FindTheBlocks;
XX {-scan memory for the allocated memory blocks}
XX CONST
XX MidBlockID = $4D; {byte DOS uses to identify part of MCB chain}
XX EndBlockID = $5A; {byte DOS uses to identify last block of MCB chain}
XX VAR
XX mcbSeg : Integer; {potential segment address of an MCB}
XX nextSeg : Integer; {computed segment address for the next MCB}
XX gotFirst : Boolean; {true after first MCB is found}
XX gotLast : Boolean; {true after last MCB is found}
XX idbyte : Byte; {byte that DOS uses to identify an MCB}
XX
XX PROCEDURE StoreTheBlock(VAR mcbSeg, nextSeg : Integer;
XX VAR gotFirst, gotLast : Boolean);
XX {-store information regarding the memory block}
XX VAR
XX nextID : Byte;
XX pspAdd : Integer; {segment address of the current PSP}
XX mcbLen : Integer; {size of the current memory block in paragraphs}
XX BEGIN
XX
XX mcbLen := MemW[mcbSeg:3]; {size of the MCB in paragraphs}
XX nextSeg := Succ(mcbSeg+mcbLen); {where the next MCB should be}
XX pspAdd := MemW[mcbSeg:1]; {address of program segment prefix for MCB}
XX nextID := Mem[nextSeg:0];
XX
XX IF gotLast OR (nextID = EndBlockID) OR (nextID = MidBlockID) THEN BEGIN
XX BlockNum := Succ(BlockNum);
XX gotFirst := True;
XX WITH Blocks[BlockNum] DO BEGIN
XX idbyte := Mem[mcbSeg:0];
XX mcb := mcbSeg;
XX psp := pspAdd;
XX env := MemW[pspAdd:$2C];
XX len := mcbLen;
XX psplen := 0;
XX cnt := 1;
XX END;
XX END;
XX
XX END {storetheblock} ;
XX
XX BEGIN
XX {start above the Basic work area, could probably start even higher}
XX {there must be a magic address to start from, but it is not documented}
XX mcbSeg := $50;
XX gotFirst := False;
XX gotLast := False;
XX BlockNum := 0;
XX
XX {scan all memory until the last block is found}
XX REPEAT
XX idbyte := Mem[mcbSeg:0];
XX IF idbyte = MidBlockID THEN BEGIN
XX StoreTheBlock(mcbSeg, nextSeg, gotFirst, gotLast);
XX IF gotFirst THEN mcbSeg := nextSeg ELSE mcbSeg := Succ(mcbSeg);
XX END ELSE IF gotFirst AND (idbyte = EndBlockID) THEN BEGIN
XX gotLast := True;
XX StoreTheBlock(mcbSeg, nextSeg, gotFirst, gotLast);
XX END ELSE
XX {still looking for first block, try every paragraph boundary}
XX mcbSeg := Succ(mcbSeg);
XX UNTIL gotLast;
XX
XX END {findtheblocks} ;
XX
XX
XX PROCEDURE ShowTheBlocks;
XX {-analyze and display the blocks found}
XX CONST
XX MaxVector = $40; {highest interrupt vector checked for trapping}
XX TYPE
XX Pathname = STRING[64];
XX HexString = STRING[4];
XX Address = RECORD
XX offset, segment : Integer;
XX END;
XX VectorType = 0..MaxVector;
XX VAR
XX st : Pathname;
XX b : BlockType;
XX dosV : Byte;
XX Vectors : ARRAY[VectorType] OF Address ABSOLUTE 0 : 0;
XX vTable : ARRAY[VectorType] OF Real;
XX SumBlocks : BlockType;
XX Sum : BlockArray;
XX
XX FUNCTION Hex(i : Integer) : HexString;
XX {-return hex representation of integer}
XX CONST
XX hc : ARRAY[0..15] OF Char = '0123456789ABCDEF';
XX VAR
XX l, h : Byte;
XX BEGIN
XX l := Lo(i); h := Hi(i);
XX Hex := hc[h SHR 4]+hc[h AND $F]+hc[l SHR 4]+hc[l AND $F];
XX END {hex} ;
XX
XX FUNCTION DOSversion : Byte;
XX {-return the major version number of DOS}
XX VAR
XX reg : RECORD
XX CASE Byte OF
XX 1 : (ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer);
XX 2 : (al, ah, bl, bh, cl, ch, dl, dh : Byte);
XX END;
XX BEGIN
XX reg.ah := $30;
XX MsDos(reg);
XX DOSversion := reg.al;
XX END {dosversion} ;
XX
XX FUNCTION Cardinal(i : Integer) : Real;
XX {-return an unsigned integer 0..65535}
XX BEGIN
XX Cardinal := 256.0*Hi(i)+Lo(i);
XX END {cardinal} ;
XX
XX FUNCTION Owner(startadd : Integer) : Pathname;
XX {-return the name of the owner program of an MCB}
XX VAR
XX e : STRING[255];
XX i : Integer;
XX t : Pathname;
XX
XX PROCEDURE StripNonAscii(VAR t : Pathname);
XX {-return an empty string if t contains any non-printable characters}
XX VAR
XX ipos : Byte;
XX goodname : Boolean;
XX BEGIN
XX goodname := True;
XX FOR ipos := 1 TO Length(t) DO
XX IF (t[ipos] < ' ') OR (t[ipos] > '}') THEN
XX goodname := False;
XX IF NOT(goodname) THEN t := '';
XX END {stripnonascii} ;
XX
XX PROCEDURE StripPathname(VAR pname : Pathname);
XX {-remove leading drive or path name from the input}
XX VAR
XX spos, cpos, rpos : Byte;
XX BEGIN
XX spos := Pos('\', pname);
XX cpos := Pos(':', pname);
XX IF spos+cpos = 0 THEN Exit;
XX IF spos <> 0 THEN BEGIN
XX {find the last slash in the pathname}
XX rpos := Length(pname);
XX WHILE (rpos > 0) AND (pname[rpos] <> '\') DO rpos := Pred(rpos);
XX END ELSE
XX rpos := cpos;
XX Delete(pname, 1, rpos);
XX END {strippathname} ;
XX
XX BEGIN
XX {get the environment string to scan}
XX e[0] := #255;
XX Move(Mem[startadd:0], e[1], 255);
XX
XX {find end of the standard environment}
XX i := Pos(#0#0, e);
XX IF i = 0 THEN BEGIN
XX {something's wrong, exit gracefully}
XX Owner := '';
XX Exit;
XX END;
XX
XX {end of environment found, get the program name that follows it}
XX t := '';
XX i := i+3; {skip over #0#0#args}
XX REPEAT
XX t := t+Chr(Mem[startadd:i]);
XX i := Succ(i);
XX UNTIL (Length(t) > 64) OR (Mem[startadd:i] = 0);
XX
XX StripNonAscii(t);
XX IF Length(t) = 0 THEN
XX Owner := 'N/A'
XX ELSE BEGIN
XX StripPathname(t);
XX IF t = '' THEN t := 'N/A';
XX Owner := t;
XX END;
XX
XX END {owner} ;
XX
XX PROCEDURE InitVectorTable;
XX {-build real equivalent of vector addresses}
XX VAR
XX v : VectorType;
XX
XX FUNCTION RealAdd(a : Address) : Real;
XX {-return the real equivalent of an address (pointer)}
XX BEGIN
XX WITH a DO
XX RealAdd := 16.0*Cardinal(segment)+Cardinal(offset);
XX END {realadd} ;
XX
XX BEGIN
XX FOR v := 0 TO MaxVector DO
XX vTable[v] := RealAdd(Vectors[v]);
XX END {initvectortable} ;
XX
XX PROCEDURE WriteHooks(start, stop : Integer);
XX {-show the trapped interrupt vectors}
XX VAR
XX v : VectorType;
XX sadd, eadd : Real;
XX BEGIN
XX sadd := 16.0*Cardinal(start);
XX eadd := 16.0*Cardinal(stop);
XX FOR v := 0 TO MaxVector DO BEGIN
XX IF (vTable[v] >= sadd) AND (vTable[v] <= eadd) THEN
XX Write(Copy(Hex(v), 3, 2), ' ');
XX END;
XX END {writehooks} ;
XX
XX PROCEDURE SortByPSP(VAR Blocks : BlockArray; BlockNum : BlockType);
XX {-sort in order of ascending PSP}
XX VAR
XX i, j : BlockType;
XX temp : Block;
XX BEGIN
XX FOR i := 1 TO Pred(BlockNum) DO
XX FOR j := BlockNum DOWNTO Succ(i) DO
XX IF Cardinal(Blocks[j].psp) < Cardinal(Blocks[Pred(j)].psp) THEN BEGIN
XX temp := Blocks[j];
XX Blocks[j] := Blocks[Pred(j)];
XX Blocks[Pred(j)] := temp;
XX END;
XX END {SortByPSP} ;
XX
XX PROCEDURE SumTheBlocks(VAR Blocks : BlockArray;
XX BlockNum : BlockType;
XX VAR Sum : BlockArray;
XX VAR SumBlocks : BlockType);
XX {-combine the blocks with equivalent PSPs}
XX VAR
XX prevpsp : Integer;
XX b : BlockType;
XX BEGIN
XX SumBlocks := 0;
XX prevpsp := $FFFF;
XX FOR b := 1 TO BlockNum DO BEGIN
XX IF Blocks[b].psp <> prevpsp THEN BEGIN
XX SumBlocks := Succ(SumBlocks);
XX Sum[SumBlocks] := Blocks[b];
XX prevpsp := Blocks[b].psp;
XX END ELSE
XX WITH Sum[SumBlocks] DO BEGIN
XX cnt := Succ(cnt);
XX len := len+Blocks[b].len;
XX END;
XX {get length of the block which owns the executable program}
XX {for checking vector trapping next}
XX IF Succ(Blocks[b].mcb) = Blocks[b].psp THEN
XX Sum[SumBlocks].psplen := Blocks[b].len;
XX END;
XX END {sumblocks} ;
XX
XX BEGIN
XX WriteLn;
XX WriteLn(' Allocated Memory Map - by TurboPower Software - Version ', Version);
XX WriteLn;
XX WriteLn('PSP adr MCB adr paras bytes owner hooked vectors');
XX WriteLn('------- ------- ------- ------- ---------- ------------------------------');
XX
XX dosV := DOSversion;
XX InitVectorTable;
XX SortByPSP(Blocks, BlockNum);
XX SumTheBlocks(Blocks, BlockNum, Sum, SumBlocks);
XX
XX FOR b := 1 TO SumBlocks DO WITH Sum[b] DO BEGIN
XX Write(' ',
XX Hex(psp), ' ', {PSP address}
XX Hex(mcb), ' ', {MCB address}
XX Hex(len), ' ', {size of block in paragraphs}
XX 16.0*Cardinal(len):6:0, ' '); {size of block in bytes}
XX
XX {get the program owning this block by scanning the environment}
XX IF (dosV >= 3) AND (cnt > 1) THEN
XX st := Owner(env)
XX ELSE
XX st := 'N/A';
XX WHILE Length(st) < 13 DO st := st+' ';
XX Write(st);
XX WriteHooks(psp, psp+psplen);
XX WriteLn;
XX END;
XX
XX END {showtheblocks} ;
XX
XXBEGIN
XX FindTheBlocks;
XX ShowTheBlocks;
XXEND.
SHAR_EOF
if test 11160 -ne "`wc -c mapmem.pas`"
then
echo shar: error transmitting mapmem.pas '(should have been 11160 characters)'
fi
echo shar: extracting mark.asm
sed 's/^XX//' << \SHAR_EOF > mark.asm
XX;_ mark.asm Sun Jul 13 1986 */
XX;MARK.ASM - mark a position in memory,
XX; above which TSRs will later be cleared by RELEASE.PAS/COM
XX; MARK can be called multiple times, each RELEASE will clear
XX; above the last MARK called
XX;
XX; written for CHASM (CHeap ASseMbler)
XX; by Kim Kokkonen, TurboPower Software
XX; telephone: 408-378-3672, Compuserve 72457,2131
XX;
XXcseg segment
XXassume cs:cseg,ds:cseg
XXorg 100h
XXmark proc near
XX jmp install
XX
XXidstr db "MARK PARAMETER BLOCK FOLLOWS" ;used to find this TSR
XXdummy db 0 ;puts vector table on an even paragraph boundary
XXvector db 400H dup(0) ;holds vector table (0..FF)*4 at invocation
XX
XX;store the interrupt vector table
XXinstall:
XX push ds
XX cli ;interrupts of
XX cld ;copy up
XX mov cx,200H ;512 integers to store
XX xor ax,ax
XX mov ds,ax ;source address segment 0
XX xor si,si ;offset 0
XX mov di,offset vector ;destination offset, es=cs already
XX rep movsw ;copy vectors to our table
XX sti ;interrupts on
XX
XX;print message and TSR
XX pop ds
XX mov dx,offset didit ;get end of code
XX mov ah,9
XX int 21H ;write success message
XX mov cx,4
XX shr dx,cl ;convert to paragraphs
XX inc dx ;round up
XX mov ax,3100H
XX int 21H ;terminate and stay resident
XX
XX;used to mark end of this TSR
XXdidit db 13,10,'Marked current memory position',13,10,36
XXmark endp
XXcseg ends
XX end mark
XX
SHAR_EOF
if test 1615 -ne "`wc -c mark.asm`"
then
echo shar: error transmitting mark.asm '(should have been 1615 characters)'
fi
echo shar: extracting oldmark.asm
sed 's/^XX//' << \SHAR_EOF > oldmark.asm
XX;MARK.ASM - mark a position in memory,
XX; above which TSRs will later be cleared by RELEASE.PAS/COM
XX; MARK can be called multiple times, each RELEASE will clear
XX; above the last MARK called
XX;
XX; written for CHASM (CHeap ASseMbler)
XX; by Kim Kokkonen, TurboPower Software
XX; telephone: 408-378-3672, Compuserve 72457,2131
XX;
XXmark proc near
XX jmp install
XX
XXidstr db 'MARK PARAMETER BLOCK FOLLOWS' ;used to find this TSR
XXdummy db 0 ;puts vector table on an even paragraph boundary
XXvector ds 400H,0 ;holds vector table (0..FF)*4 at invocation
XX
XX;store the interrupt vector table
XXinstall
XX push ds
XX cli ;interrupts of
XX cld ;copy up
XX mov cx,200H ;512 integers to store
XX xor ax,ax
XX mov ds,ax ;source address segment 0
XX xor si,si ;offset 0
XX mov di,offset(vector) ;destination offset, es=cs already
XX rep
XX movsw ;copy vectors to our table
XX sti ;interrupts on
XX
XX;print message and TSR
XX pop ds
XX mov dx,offset(didit) ;get end of code
XX mov ah,9
XX int 21H ;write success message
XX mov cx,4
XX shr dx,cl ;convert to paragraphs
XX inc dx ;round up
XX mov ax,3100H
XX int 21H ;terminate and stay resident
XX
XX;used to mark end of this TSR
XXdidit db 13,10,'Marked current memory position',13,10,36
XX endp
SHAR_EOF
if test 1590 -ne "`wc -c oldmark.asm`"
then
echo shar: error transmitting oldmark.asm '(should have been 1590 characters)'
fi
echo shar: extracting read.me
sed 's/^XX//' << \SHAR_EOF > read.me
XXThis distribution contains a modified version of MARK.ASM. It has been
XXmodified to run with the Microsoft MASM assembler, since the chasm
XXassembler is distributed in non-ASCII basic format. Some of us poor
XXsouls do not have IBM machines, and have no interest in buying a ^&$(%^&@
XXbasic interpreter!!!!!
XX
XXNot wanting to cause problems for anyone, the original CHASM compatible
XXversion is still in the archive, under the name OLDMARK.ASM.
XX
XXI have not tried this code on DOS 2.0.
XX
XXThis stuff works very well on DOS 3.1, but seems to have some trouble
XXunder *some* conditions in DOS 3.2. There are newer versions of this stuff
XXavailable, but the author seems to be no longer distributing source, so I
XXcan't give you the latest and greatest. Incidently, the binaries for this
XXwere posted recently.
XX
XXdel (Erik Lindberg)
XXuw-beaver!tikal!pilchuck!del
SHAR_EOF
if test 844 -ne "`wc -c read.me`"
then
echo shar: error transmitting read.me '(should have been 844 characters)'
fi
echo shar: extracting release.pas
sed 's/^XX//' << \SHAR_EOF > release.pas
XX{**************************************************************************
XX* Releases memory above the last MARK call made. *
XX* Copyright (c) 1986 Kim Kokkonen, TurboPower Software. *
XX* Released to the public domain for personal, non-commercial use only. *
XX***************************************************************************
XX* written 2/8/86 *
XX***************************************************************************
XX* telephone: 408-378-3672, CompuServe: 72457,2131. *
XX* requires Turbo version 3 to compile. *
XX* Compile with mAx dynamic memory = A000. *
XX***************************************************************************}
XX
XX{$P128}
XX
XXPROGRAM ReleaseTSR;
XX {-release system memory above the last mark call}
XXCONST
XX MaxBlocks = 100;
XX Version = '1.0';
XX markID = 'MARK PARAMETER BLOCK FOLLOWS'; {marking string for TSR}
XX markOffset = $103; {offset into MARK.COM where markID is found in TSR}
XX vectoroffset = $120; {offset into MARK.COM where vector table is stored}
XXTYPE
XX Block = RECORD {store info about each memory block as it is found}
XX mcb : Integer;
XX psp : Integer;
XX END;
XX BlockType = 0..MaxBlocks;
XX BlockArray = ARRAY[BlockType] OF Block;
XX allstrings = STRING[255];
XX
XXVAR
XX Blocks : BlockArray;
XX BottomBlock, BlockNum : BlockType;
XX
XX PROCEDURE FindTheBlocks;
XX {-scan memory for the allocated memory blocks}
XX CONST
XX MidBlockID = $4D; {byte DOS uses to identify part of MCB chain}
XX EndBlockID = $5A; {byte DOS uses to identify last block of MCB chain}
XX VAR
XX mcbSeg : Integer; {potential segment address of an MCB}
XX nextSeg : Integer; {computed segment address for the next MCB}
XX gotFirst : Boolean; {true after first MCB is found}
XX gotLast : Boolean; {true after last MCB is found}
XX idbyte : Byte; {byte that DOS uses to identify an MCB}
XX
XX PROCEDURE StoreTheBlock(VAR mcbSeg, nextSeg : Integer;
XX VAR gotFirst, gotLast : Boolean);
XX {-store information regarding the memory block}
XX VAR
XX nextID : Byte;
XX pspAdd : Integer; {segment address of the current PSP}
XX mcbLen : Integer; {size of the current memory block in paragraphs}
XX BEGIN
XX
XX mcbLen := MemW[mcbSeg:3]; {size of the MCB in paragraphs}
XX nextSeg := Succ(mcbSeg+mcbLen); {where the next MCB should be}
XX pspAdd := MemW[mcbSeg:1]; {address of program segment prefix for MCB}
XX nextID := Mem[nextSeg:0];
XX
XX IF gotLast OR (nextID = EndBlockID) OR (nextID = MidBlockID) THEN BEGIN
XX BlockNum := Succ(BlockNum);
XX gotFirst := True;
XX WITH Blocks[BlockNum] DO BEGIN
XX mcb := mcbSeg;
XX psp := pspAdd;
XX END;
XX END;
XX
XX END {storetheblock} ;
XX
XX BEGIN
XX {start above the Basic work area, could probably start even higher}
XX {there must be a magic address to start from, but it is not documented}
XX mcbSeg := $50;
XX gotFirst := False;
XX gotLast := False;
XX BlockNum := 0;
XX
XX {scan all memory until the last block is found}
XX REPEAT
XX idbyte := Mem[mcbSeg:0];
XX IF idbyte = MidBlockID THEN BEGIN
XX StoreTheBlock(mcbSeg, nextSeg, gotFirst, gotLast);
XX IF gotFirst THEN mcbSeg := nextSeg ELSE mcbSeg := Succ(mcbSeg);
XX END ELSE IF gotFirst AND (idbyte = EndBlockID) THEN BEGIN
XX gotLast := True;
XX StoreTheBlock(mcbSeg, nextSeg, gotFirst, gotLast);
XX END ELSE
XX {still looking for first block, try every paragraph boundary}
XX mcbSeg := Succ(mcbSeg);
XX UNTIL gotLast;
XX
XX END {findtheblocks} ;
XX
XX FUNCTION findmark(idstring : allstrings; idoffset : Integer) : Integer;
XX {-find the last memory block matching idstring at offset idoffset}
XX VAR
XX b : BlockType;
XX foundit : Boolean;
XX
XX FUNCTION MatchString(segment : Integer; idstring : allstrings; idoffset : Integer)
XX : Boolean;
XX {-return true if idstring is found at segment:idoffset}
XX VAR
XX tstring : allstrings;
XX len : Byte;
XX BEGIN
XX len := Length(idstring);
XX tstring[0] := Chr(len);
XX Move(Mem[segment:idoffset], tstring[1], len);
XX MatchString := (tstring = idstring);
XX END {matchstring};
XX
XX BEGIN
XX {scan from the last block-1 down to find the last MARK TSR}
XX b := Pred(BlockNum);
XX REPEAT
XX foundit := MatchString(Blocks[b].psp, idstring, idoffset);
XX IF NOT(foundit) THEN
XX b := Pred(b);
XX UNTIL (b < 1) OR foundit;
XX IF NOT(foundit) THEN BEGIN
XX WriteLn('No memory marker found. Mark memory by calling MARK.COM');
XX Halt(1);
XX END;
XX findmark := b;
XX END {findmark} ;
XX
XX PROCEDURE CopyVectors(BottomBlock : BlockType; vectoroffset : Integer);
XX {-put interrupt vectors back into table}
XX BEGIN
XX {interrupts off}
XX INLINE($FA);
XX {replace vectors}
XX Move(Mem[Blocks[BottomBlock].psp:vectoroffset], Mem[0:0], 1024);
XX {interrupts on}
XX INLINE($FB);
XX END {copyvectors} ;
XX
XX PROCEDURE ReleaseMem(BottomBlock : BlockType);
XX {release memory starting at block b, up to but not including this program}
XX TYPE
XX hexstring = STRING[4];
XX VAR
XX b : BlockType;
XX regs : RECORD
XX CASE Byte OF
XX 1 : (ax, bx, cx, dx, bp, si, di, ds, es, flags : Integer);
XX 2 : (al, ah, bl, bh, cl, ch, dl, dh : Byte);
XX END;
XX
XX FUNCTION Hex(i : Integer) : hexstring;
XX {-return hex representation of integer}
XX CONST
XX hc : ARRAY[0..15] OF Char = '0123456789ABCDEF';
XX VAR
XX l, h : Byte;
XX BEGIN
XX l := Lo(i); h := Hi(i);
XX Hex := hc[h SHR 4]+hc[h AND $F]+hc[l SHR 4]+hc[l AND $F];
XX END {hex} ;
XX
XX BEGIN
XX WITH regs DO
XX FOR b := BottomBlock TO BlockNum DO
XX IF Blocks[b].psp <> CSeg THEN BEGIN
XX ah := $49;
XX {the block is always 1 paragraph above the MCB}
XX es := Succ(Blocks[b].mcb);
XX MsDos(regs);
XX IF Odd(flags) THEN BEGIN
XX WriteLn('Could not release block at segment ', Hex(es));
XX WriteLn('Memory is now a mess... Please reboot');
XX Halt(1);
XX END;
XX END;
XX END {releasemem} ;
XX
XXBEGIN
XX WriteLn;
XX {get all allocated memory blocks}
XX FindTheBlocks;
XX {find the last one marked with the MARK idstring}
XX BottomBlock := findmark(markID, markOffset);
XX {copy the vector table from the MARK resident}
XX CopyVectors(BottomBlock, vectoroffset);
XX {release memory at and above the mark resident}
XX ReleaseMem(Pred(BottomBlock));
XX {DOS will release this program's memory when it exits}
XX {write success message}
XX WriteLn('Memory released above last MARK');
XXEND.
SHAR_EOF
if test 6785 -ne "`wc -c release.pas`"
then
echo shar: error transmitting release.pas '(should have been 6785 characters)'
fi
# End of shell archive
exit 0
--
del (Erik Lindberg) aka Hugable
uw-beaver!tikal!pilchuck!del
Hugs: One of the few good things in life that are still free.