World of Shareware - Software Farm 2/wosw_2.zip/wosw_2/PASCAL/TSRUTILS.ZIP/RELEASE.PAS

Pascal/Delphi Source File | 1989-05-04 | 30KB | 892 lines

{**************************************************************************
*   Releases memory above the last MARK call made.                        *
*   Copyright (c) 1986 Kim Kokkonen, TurboPower Software.                 *
*   Released to the public domain for personal, non-commercial use only.  *
***************************************************************************
*   Version 1.0 2/8/86                                                    *
*     original public release                                             *
*     (thanks to Neil Rubenking for an outline of the method used)        *
*   Version 1.1 2/11/86                                                   *
*     fixed problem with processes which deallocate their environment     *
*   Version 1.2 2/13/86                                                   *
*     fixed another problem with processes which deallocate environment   *
*   Version 1.3 2/15/86                                                   *
*     add support for "named" marks                                       *
*   Version 1.4 2/23/86                                                   *
*     add support for releasing programs which use Expanded Memory        *
*   Version 1.5 2/28/86                                                   *
*     add more bulletproof method of finding first allocation block       *
*   Version 1.6 3/20/86                                                   *
*     restore all FF interrupts.                                          *
*     restore the termination address to the local process                *
*     reduce number of EMS blocks to 32.                                  *
*     fix bug in number of EMS handles in EMS release step                *
*     restore an undocumented address in the PSP which allows RELEASE of  *
*       a COMMAND shell (emulates the EXIT command)                       *
*   Version 1.7 (date not recorded)                                       *
*     add "protected" marks                                               *
*   Version 1.8 4/21/86                                                   *
*     fix problem when mark is installed as 'MARK '                       *
*   Version 1.9 5/22/86                                                   *
*     release the environment of MARK when it is not contiguous with      *
*       the MARK itself                                                   *
*     capture RELEASE calls from within batch files and don't release the *
*       batch control block                                               *
*     fiddle with different methods of restoring interrupt vectors in     *
*       an attempt to successfully remove DoubleDos. No success, not      *
*       implemented. Note, after more effort: DDos apparently             *
*       reprograms the 8259 as well as patching the operating system      *
*   Version 2.0 6/17/86                                                   *
*     support "file" marks placed by the new program FMARK                *
*   Version 2.1 7/18/86                                                   *
*     fix bug in restoring "parent" address in RELEASE PSP                *
*   Version 2.2 3/3/87                                                    *
*     add option to revector 8259 interrupt controller                    *
*       (thanks to Steve Glynn for this code)                             *
*     add option to leave mark in place when RELEASE is run               *
*     restore save areas for EGA and interapplication communications      *
*   Version 2.3 5/2/87                                                    *
*     update watch area, if any, when releasing                           *
*   Version 2.4 5/17/87                                                   *
*     avoids use of EMS call $4B, which doesn't work in many EMS          *
*       implementations                                                   *
*     adds switch to ignore EMS altogether                                *
*   Version 2.5 6/2/87                                                    *
*     check version number of mark to avoid incompatibilities             *
*   Version 2.6 1/15/89                                                   *
*     fix problem occurring when command processor is EXE file            *
*       (thanks to Tom Rawson for this code)                              *
*     convert to Turbo Pascal 5.0                                         *
*   Version 2.7                                                           *
*     skipped                                                             *
*   Version 2.8                                                           *
*     treat file and net marks as protected marks                         *
*     add key stuffing routine                                            *
*     remove 8259 revector routine                                        *
*   Version 2.9                                                           *
*     don't treat file marks as protected marks                           *
***************************************************************************
*   telephone: [phone], CompuServe: 72457,2131.                      *
*   requires Turbo version 5 to compile.                                  *
*   Compile with mAx dynamic memory = FFFF.                               *
***************************************************************************}

{$R-,S-}

program ReleaseTSR;
  {-Release system memory above the last mark call}
  {-Release expanded memory blocks allocated since the last mark call}
uses
  Dos;

const
  Version = '2.9';
  MarkID = 'M2.9 PARAMETER BLOCK FOLLOWS'; {Marking string for TSR MARK}
  FmarkID = 'FM2.9 TSR';          {Marking string for TSR file mark}
  NmarkID = 'MN2.9 TSR';          {Marking string for TSR NET file mark}

  ProtectChar = '!';          {Marks whose name begins with this will be
                              released ONLY if an exact name match occurs}
  MaxBlocks = 128;            {Max number of DOS allocation blocks supported}
  MaxHandles = 32;            {Max number of EMS allocation blocks supported}
  EMSinterrupt = $67;         {The vector used by the expanded memory manager}

  {Offsets into resident copy of MARK.COM for data storage}
  MarkOffset = $103;          {Where markID is found in MARK TSR}
  FmarkOffset = $60;          {Where FmarkID is found in FMARK TSR}
  NmarkOffset = $60;          {Where NmarkID is found in MARKNET TSR}
  VectorOffset = $120;        {Where vector table is stored}
  EGAsavOffset = $520;        {Where the EGA save save is stored}
  IntComOffset = $528;        {Where the interapps comm area is stored}
  ParentOffset = $538;        {(TER) Where parent's PSP segment is stored}
  EMScntOffset = $53A;        {Where count of EMS active pages is stored}
  EMSmapOffset = $53C;        {Where the page map is stored}

  WatchID = 'TSR WATCHER';    {Marking string for WATCH}

  {Offsets into resident copy of WATCH.COM for data storage}
  WatchOffset = $81;
  NextChange = $104;
  ChangeVectors = $220;
  OrigVectors = $620;
  CurrVectors = $A20;
  MaxChanges = 128;           {Maximum number of vector changes stored in WATCH}

  Debug = False;

type
  HandlePageRecord =
  record
    handle : Word;
    numpages : Word;
  end;

  PageArray = array[1..MaxHandles] of HandlePageRecord;
  PageArrayPtr = ^PageArray;

  Block =
  record                      {Store info about each memory block}
    mcb : Word;
    psp : Word;
    releaseIt : Boolean;
  end;

  BlockType = 0..MaxBlocks;
  BlockArray = array[BlockType] of Block;

  HexString = string[4];
  Pathname = string[79];

var
  Blocks : BlockArray;
  watchBlock, bottomBlock, blockNum : BlockType;

  markName : String;
  Regs : Registers;

  FilMarkHandles, ReturnCode, StartMCB, StoredHandles, EMShandles : Word;
  UseWatch, DealWithEMS,
  KeepMark, MemMark, FilMark, Junk : Boolean;
  Keys : string[16];

  FilMarkPageMap, Map, StoredMap : PageArrayPtr;
  TrappedBytes : LongInt;

  {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;
  ParentTable : array[0..1] of Byte;

  procedure Abort(msg : String);
    {-Halt in case of error}
  begin
    WriteLn(msg);
    Halt(1);
  end;

  procedure Halt(ReturnCode : Word);
    {-Replace Turbo halt with one that doesn't restore any interrupts}
  begin
    Close(Output);
    with Regs do begin
      ah := $4C;
      al := Lo(ReturnCode);
      MsDos(Regs);
    end;
  end;

  procedure FindTheBlocks;
    {-Scan memory for the allocated memory blocks}
  const
    MidBlockID = $4D;         {Byte DOS uses to identify part of MCB chain}
    EndBlockID = $5A;         {Byte DOS uses to identify last block of MCB chain}
  var
    mcbSeg : Word;            {Segment address of current MCB}
    nextSeg : Word;           {Computed segment address for the next MCB}
    gotFirst : Boolean;       {True after first MCB is found}
    gotLast : Boolean;        {True after last MCB is found}
    idbyte : Byte;            {Byte that DOS uses to identify an MCB}

    function GetStartMCB : Word;
      {-Return the first MCB segment}
    begin
      Regs.ah := $52;
      MsDos(Regs);
      GetStartMCB := MemW[Regs.es:(Regs.bx-2)];
    end;

    procedure StoreTheBlock(var mcbSeg, nextSeg : Word;
                            var gotFirst, gotLast : Boolean);
      {-Store information regarding the memory block}
    var
      nextID : Byte;
      pspAdd : Word;          {Segment address of the current PSP}
      mcbLen : Word;          {Size of the current memory block in paragraphs}

    begin

      mcbLen := MemW[mcbSeg:3]; {Size of the MCB in paragraphs}
      nextSeg := Succ(mcbSeg+mcbLen); {Where the next MCB should be}
      pspAdd := MemW[mcbSeg:1]; {Address of program segment prefix for MCB}
      nextID := Mem[nextSeg:0];

      if gotLast or (nextID = EndBlockID) or (nextID = MidBlockID) then begin
        inc(blockNum);
        gotFirst := True;
        with Blocks[blockNum] do begin
          mcb := mcbSeg;
          psp := pspAdd;
        end;
      end;

    end;

  begin

    {Initialize}
    StartMCB := GetStartMCB;
    mcbSeg := StartMCB;
    gotFirst := False;
    gotLast := False;
    blockNum := 0;

    {Scan all memory until the last block is found}
    repeat
      idbyte := Mem[mcbSeg:0];
      if idbyte = MidBlockID then begin
        StoreTheBlock(mcbSeg, nextSeg, gotFirst, gotLast);
        if gotFirst then
          mcbSeg := nextSeg
        else
          inc(mcbSeg);
      end else if gotFirst and (idbyte = EndBlockID) then begin
        gotLast := True;
        StoreTheBlock(mcbSeg, nextSeg, gotFirst, gotLast);
      end else
        {Start block was invalid}
        Abort('Corrupted allocation chain or program error....');
    until gotLast;

  end;

  function StUpcase(s : String) : String;
    {-Return the uppercase string}
  var
    i : Byte;

  begin
    for i := 1 to Length(s) do
      s[i] := UpCase(s[i]);
    StUpcase := s;
  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}

    function HasIDstring(segment : Word;
                         idString : String;
                         idOffset : Word) : Boolean;
      {-Return true if idstring is found at segment:idoffset}
    var
      tString : String;
      len : Byte;
    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;                      {GetMarkName}

    function MatchMemMark(segment : Word;
                          markName : String;
                          var b : BlockType) : Boolean;
      {-Return true if MemMark is unnamed or matches current name}
    var
      tString : String;
      FoundIt : Boolean;
    begin
      {Check the mark name stored in the PSP of the mark block}
      tString := GetMarkName(segment);
      if (markName <> '') then begin
        FoundIt := (tString = StUpcase(markName));
        if not(FoundIt) 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
        {Match any mark}
        FoundIt := True;
      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
      tString : String;
      FoundIt : Boolean;

      function ExistFile(path : String) : Boolean;
        {-Return true if file exists}
      var
        f : file;
      begin
        Assign(f, path);
        {$I-}
        Reset(f);
        {$I+}
        if IoResult = 0 then begin
          ExistFile := True;
          Close(f);
        end else
          ExistFile := False;
      end;

    begin
      {Check the mark name stored in the PSP of the mark block}
      tString := GetMarkName(segment);
      if (markName <> '') then begin
        markName := StUpcase(markName);
        FoundIt := (tString = markName);
        if FoundIt then begin
          {Assure named file exists}
          (*
          WriteLn('Finding mark file ', markName);
          *)
          FoundIt := ExistFile(markName);
        end;
      end else
        {File marks must be named on RELEASE command line}
        FoundIt := False;
      if not(FoundIt) then
        {File marks are like protected marks}
        {Stop checking if a non-matching file mark is found}
        dec(B); {!!!!!!!}
(*
        b := 0;
*)
      MatchFilMark := FoundIt;
    end;

  begin
    {Scan from the last block down to find the last MARK TSR}
    b := blockNum;
    MemMark := False;
    FilMark := False;
    repeat
      if Blocks[b].psp = PrefixSeg then
        {Assure this program's command line is not matched}
        dec(b)
      else if HasIDstring(Blocks[b].psp, NmarkID, NmarkOffset) then
        {A net mark, can't release it here. Stop looking}
        b := 0
      else if HasIDstring(Blocks[b].psp, MarkID, MarkOffset) then
        {An in-memory mark}
        MemMark := MatchMemMark(Blocks[b].psp, markName, b)
      else if HasIDstring(Blocks[b].psp, FmarkID, FmarkOffset) then
        {A file mark}
        FilMark := MatchFilMark(Blocks[b].psp, markName, b)
      else
        {Not a mark}
        dec(b);
    until (b < 1) or MemMark or FilMark;
    FindMark := MemMark or FilMark;
  end;

  function Hex(i : Word) : HexString;
    {-Return hex representation of Word}
  const
    hc : array[0..15] of Char = '0123456789ABCDEF';
  var
    l, h : Byte;
  begin
    l := Lo(i);
    h := Hi(i);
    Hex[0] := #4;
    Hex[1] := hc[h shr 4];
    Hex[2] := hc[h and $F];
    Hex[3] := hc[l shr 4];
    Hex[4] := hc[l and $F];
  end;

  procedure ReadMarkFile(markName : String);
    {-Read the mark file info into memory}
  var
    f : file;
  begin
    Assign(f, markName);
    Reset(f, 1);

    {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, ParentTable, 2);

    {Read the number of EMS handles stored}
    BlockRead(f, FilMarkHandles, 2);

    {Get a page map area and read the page map into it}
    GetMem(FilMarkPageMap, 4*FilMarkHandles);
    BlockRead(f, FilMarkPageMap^, 4*FilMarkHandles);
    Close(f);

    if not(KeepMark) then
      {Delete the mark file so it causes no mischief later}
      Erase(f);
  end;

  procedure CopyVectors(bottomBlock : BlockType);
    {-Put interrupt vectors back into table}
  var
    bottompsp : Word;

  begin

    {Interrupts off}
    inline($FA);

    {Restore the main interrupt vector table and the misc save areas}
    if FilMark then begin
      Move(Vectors, Mem[0:0], 1024);
      Move(EGAsavTable, Mem[$40:$A8], 8);
      Move(IntComTable, Mem[$40:$F0], 16);
      Move(ParentTable, Mem[PrefixSeg:$16], 2);
    end else begin
      bottompsp := Blocks[bottomBlock].psp;
      Move(Mem[bottompsp:VectorOffset], Mem[0:0], 1024);
      Move(Mem[bottompsp:EGAsavOffset], Mem[$40:$A8], 8);
      Move(Mem[bottompsp:IntComOffset], Mem[$40:$F0], 16);
      Move(Mem[bottompsp:ParentOffset], Mem[PrefixSeg:$16], 2);
    end;

    {Interrupts on}
    inline($FB);

    {Move the old termination/break/error addresses into this program}
    Move(Mem[0:$88], Mem[PrefixSeg:$0A], 12);

  end;

  procedure MarkBlocks(bottomBlock : BlockType);
    {-Mark those blocks to be released}
  var
    b : BlockType;
    commandPsp, markPsp : Word;
    ch : Char;

    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;

  begin

    commandPsp := Blocks[2].psp;
    markPsp := Blocks[bottomBlock].psp;

    for b := 1 to blockNum do
      with Blocks[b] do
        if (b < bottomBlock) then begin
          {Release any trapped environment block}
          if KeepMark then
            releaseIt := (psp <> PrefixSeg) and (psp > markPsp)
          else
            releaseIt := (psp <> PrefixSeg) and (psp >= markPsp);
        end else if (psp = commandPsp) then begin
          {Don't release blocks owned by 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
          {Release all but RELEASE itself}
          releaseIt := (psp <> PrefixSeg);

    if Debug then begin
      for b := 1 to blockNum do with Blocks[b] do
        WriteLn(b:3, ' ', Hex(psp), ' ', Hex(mcb), ' ', releaseIt);
      ReadLn;
    end;

  end;

  procedure ReleaseMem;
    {-Release DOS memory marked for release}
  var
    b : BlockType;
  begin
    with Regs do
      for b := 1 to blockNum do
        with Blocks[b] do
          if releaseIt then begin
            ah := $49;
            {The block is always 1 paragraph above the MCB}
            es := Succ(mcb);
            MsDos(Regs);
            if Odd(flags) then begin
              WriteLn('Could not release block at segment ', Hex(es));
              Abort('Memory may be a mess... Please reboot');
            end;
          end;
  end;

  procedure UpdateWatch(watchBlock : BlockType);
    {-Write a new watch data area based on the release and the original watch}
  type
    ChangeBlock =
    record
      VecID : Word;
      VecOfs : Word;
      VecSeg : Word;
      PatchWord : Word;
    end;
  var
    changes : array[0..MaxChanges] of ChangeBlock;
    p : ^ChangeBlock;
    watchseg, c, o, i, actualmax : Word;
    KeepPSP : Boolean;

    function WillKeepPSP(pspAdd : Word) : Boolean;
      {-Return true if this psp address will be kept}
    var
      b : BlockType;
    begin
      for b := 1 to blockNum do
        with Blocks[b] do
          if psp = pspAdd then begin
            WillKeepPSP := not(releaseIt);
            Exit;
          end;
    end;

  begin

    {Initialize}
    watchseg := Blocks[watchBlock].psp;
    actualmax := MemW[watchseg:NextChange];

    {Transfer changes from WATCH into a buffer array}
    i := 0;
    o := 0;
    while i < actualmax do begin
      p := Ptr(watchseg, ChangeVectors+i);
      Move(p^, changes[o], SizeOf(ChangeBlock));
      inc(i, SizeOf(ChangeBlock));
      inc(o);
    end;

    {Determine which change records to keep and transfer them back to WATCH}
    KeepPSP := True;
    i := 0;
    for c := 0 to Pred(o) do begin
      with changes[c] do
        if VecID = $FFFF then
          {This record starts a new PSP. See if PSP is kept in memory}
          KeepPSP := WillKeepPSP(VecOfs);
      if KeepPSP then begin
        p := Ptr(watchseg, ChangeVectors+i);
        Move(changes[c], p^, SizeOf(ChangeBlock));
        i := i+SizeOf(ChangeBlock);
      end;
    end;
    MemW[watchseg:NextChange] := i;

    {Update the WATCH image of the vector table to whatever's current}
    Move(Mem[0:0], Mem[watchseg:CurrVectors], 1024);

  end;

  function EMSpresent : Boolean;
    {-Return true if EMS memory manager is present}
  var
    f : file;
  begin
    {"file handle" defined by the expanded memory manager at installation}
    Assign(f, 'EMMXXXX0');
    {$I-}
    Reset(f);
    {$I+}
    if IOResult = 0 then begin
      EMSpresent := True;
      Close(f);
    end else
      EMSpresent := False;
  end;

  procedure RestoreEMSmap;
    {-Restore EMS to state at time of mark}

    function GetHandles(bottomBlock : BlockType; EMScntOffset : Word) : Word;
      {-Return the number of handles stored by mark}
    begin
      if FilMark then
        GetHandles := FilMarkHandles
      else
        GetHandles := MemW[Blocks[bottomBlock].psp:EMScntOffset];
    end;

    function GetStoredMap(bottomBlock : BlockType; EMSmapOffset : Word) : PageArrayPtr;
      {-Returns a pointer to the stored page array}
    begin
      if FilMark then
        GetStoredMap := FilMarkPageMap
      else
        GetStoredMap := Ptr(Blocks[bottomBlock].psp, EMSmapOffset);
    end;

    procedure EMSpageMap(var PageMap : PageArray; var EMShandles:Word);
      {-return an array of the allocated memory blocks}
    begin
      regs.ah := $4D;
      regs.es := Seg(PageMap);
      regs.di := Ofs(PageMap);
      regs.bx := 0;
      Intr(EMSinterrupt, regs);
      if regs.ah <> 0 then begin
        WriteLn('EMS device not responding');
        emshandles:=0;
      end else
        emshandles:=regs.bx;
    end;

    procedure ReleaseEMSblocks(var oldmap, newmap : PageArray);
      {-Release those EMS blocks allocated since MARK was installed}
    var
      o, n, nhandle : Word;

      procedure EMSdeallocate(EMShandle : Word);
        {-Release the allocated expanded memory}
      begin
        Regs.ah := $45;
        Regs.dx := EMShandle;
        Intr(EMSinterrupt, Regs);
        if Regs.ah <> 0 then begin
          WriteLn('Program error or EMS device not responding');
          Abort('EMS memory may be a mess... Please reboot');
        end;
      end;

    begin
      for n := 1 to EMShandles do begin
        {Scan all current handles}
        nhandle := newmap[n].handle;
        if StoredHandles > 0 then begin
          {See if current handle matches one stored by MARK}
          o := 1;
          while (oldmap[o].handle <> nhandle) and (o <= StoredHandles) do
            inc(o);
          {If not, deallocate the current handle}
          if (o > StoredHandles) then
            EMSdeallocate(nhandle);
        end else
          {No handles stored by MARK, deallocate all current handles}
          EMSdeallocate(nhandle);
      end;
    end;

  begin
    {Get the existing EMS page map}
    GetMem(Map, 2048);
    EMSpageMap(Map^, EMShandles);
    if EMShandles > MaxHandles then
      WriteLn('EMS process count exceeds capacity of RELEASE - no action taken')
    else if EMShandles <> 0 then begin
      {See how many handles were active when MARK was installed}
      StoredHandles := GetHandles(bottomBlock, EMScntOffset);
      {Get the stored page map}
      StoredMap := GetStoredMap(bottomBlock, EMSmapOffset);
      {Compare the two maps and deallocate pages not in the stored map}
      ReleaseEMSblocks(StoredMap^, Map^);
    end;
  end;

  procedure GetOptions;
    {-Analyze command line for options}
  var
    arg : String;
    arglen : Byte absolute arg;
    i : Word;

    procedure WriteHelp;
      {-Show the options}
    begin
      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('  /K         release memory, but keep the mark in place.');
      WriteLn('  /S chars   stuff string (<16 chars) into keyboard buffer on exit.');
      WriteLn('  /?         write this help screen.');
      Halt(1);
    end;

  begin
    {Initialize defaults}
    markName := '';
    Keys := '';
    KeepMark := False;
    DealWithEMS := True;
    ReturnCode := 0;
    TrappedBytes := 00;

    i := 1;
    while i <= ParamCount do begin
      arg := ParamStr(i);
      if (arg[1] = '?') then
        WriteHelp
      else if (arg[1] = '-') or (arg[1] = '/') then
        case arglen of
          1 : Abort('Missing command option following '+arg);
          2 : case UpCase(arg[2]) of
                '?' : WriteHelp;
                'E' : DealWithEMS := False;
                'K' : KeepMark := True;
                'S' : begin
                        if I >= ParamCount then
                          Abort('Key string missing');
                        inc(I);
                        Arg := ParamStr(I);
                        if ArgLen > 15 then
                          Abort('No more than 15 keys may be stuffed');
                        Keys := Arg+^M;
                      end;
              else
                Abort('Unknown command option: '+arg);
              end;
        else
          Abort('Unknown command option: '+arg);
        end
      else
        {Named mark}
        markName := arg;
      inc(i);
    end;

  end;

  const
    KbdStart = $1E;
    KbdEnd = $3C;
  var
    KbdHead : Word absolute $40 : $1A;
    KbdTail : Word absolute $40 : $1C;

  procedure StuffKey(W : Word);
    {-Stuff one key into the keyboard buffer}
  var
    SaveKbdTail : Word;
  begin
    SaveKbdTail := KbdTail;
    if KbdTail = KbdEnd then
      KbdTail := KbdStart
    else
      Inc(KbdTail, 2);
    if KbdTail = KbdHead then
      KbdTail := SaveKbdTail
    else
      MemW[$40:SaveKbdTail] := W;
  end;

  procedure StuffKeys(Keys : string; ClearFirst : Boolean);
    {-Stuff up to 16 keys into keyboard buffer}
  var
    Len : Byte;
    I : Byte;
  begin
    if ClearFirst then
      KbdTail := KbdHead;
    Len := Length(Keys);
    if Len > 16 then
      Len := 16;
    for I := 1 to Length(Keys) do
      StuffKey(Ord(Keys[I]));
  end;

begin
  WriteLn('RELEASE ', Version, ', by TurboPower Software');

  {Analyze command line for options}
  GetOptions;

  {Get all allocated memory blocks in normal memory}
  FindTheBlocks;

  {Find the last one marked with the MARK idstring, and MarkName if specified}
  if not(FindMark(markName, MarkID, MarkOffset, MemMark, FilMark, bottomBlock)) then
    Abort('No matching marker found, or protected marker encountered.');

  {Find the watch block, if any}
  UseWatch := FindMark('', WatchID, WatchOffset, Junk, Junk, watchBlock);

  {Mark those blocks to be released}
  MarkBlocks(bottomBlock);

  {Get file mark information into memory}
  if FilMark then
    ReadMarkFile(markName);

  {Copy the vector table from the MARK copy}
  CopyVectors(bottomBlock);

  {Update the watch block if requested}
  if UseWatch then
    {The WATCH ID was found in memory}
    if not(Blocks[watchBlock].releaseIt) then
      {Watch itself won't be released}
      UpdateWatch(watchBlock);

  {Release normal memory marked for release}
  ReleaseMem;

  {Deal with expanded memory}
  if DealWithEMS then
    if EMSpresent then
      RestoreEMSmap;

  {Write success message}
  Write('Memory released above last MARK');
  if markName <> '' then
    Write(' (', StUpcase(markName), ')');
  WriteLn;

  if ReturnCode <> 0 then
    WriteLn(TrappedBytes, ' bytes temporarily trapped until batch file completes');

  {Stuff keyboard buffer if requested}
  if Length(Keys) > 0 then
    StuffKeys(Keys, True);

  Halt(ReturnCode);
end.