Media Share 9/MEDIASHARE_09.ISO/pascal/tsrsrc.zip/RELNET.PAS

Pascal/Delphi Source File | 1992-02-14 | 44KB | 1,374 lines

{**************************************************************************
*   RELNET - releases memory above the last MARKNET call made.            *
*   Copyright (c) 1986,1991 Kim Kokkonen, TurboPower Software.            *
*   May be freely distributed and used but not sold except by permission. *
***************************************************************************
*   Version 2.7 3/4/89                                                    *
*     first public release                                                *
*     (based on RELEASE 2.6)                                              *
*   Version 2.8 3/10/89                                                   *
*     restore the DOS environment                                         *
*     restore the async ports                                             *
*   Version 2.9 5/4/89                                                    *
*     ignore file marks                                                   *
*   Version 3.0 9/25/91                                                   *
*     make compatible with DOS 5                                          *
*     handle NetWare IPX better, allowing release of NETBIOS TSR          *
*     add Quiet option                                                    *
*     update for new WATCH behavior                                       *
*     restore BIOS LPT port data areas                                    *
*     restore XMS allocation                                              *
*     add code for tracking high memory                                   *
*   Version 3.1 11/4/91                                                   *
*     restore less of DOS variables table (more deactivates high memory   *
*       after a release)                                                  *
*     add option to disable IPX socket shutdown                           *
*   Version 3.2 11/22/91                                                  *
*     version 3.1 crashed under DOS 3.3 (RestoreDosTable)                 *
*     change 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                                                   *
*     release HMA when appropriate                                        *
*     fix hang that occurs when QEMM LOADHI didn't have space to          *
*       load a mark high                                                  *
***************************************************************************
*   Telephone: [phone], CompuServe: 76004,2611.                      *
*   Requires Turbo Pascal 6 to compile.                                   *
***************************************************************************}

{$R-,S-,I-,V-,B-,F-,A-,E-,N-,G-,X-}
{$M 16384,0,655360}
{.$DEFINE Debug}

program RelNet;

uses
  Dos,
  MemU,
  Ipx,
  Xms,
  Ems;

const
  MarkFOpen : Boolean = False;       {True while mark file is open}
  VectorsRestored : Boolean = False; {True after old vector table restored}

var
  Blocks : BlockArray;
  markBlock : BlockType;
  BlockMax : BlockType;
  markPsp : Word;

  MarkName : PathStr;

  ReturnCode : Word;
  StartMCB : Word;
  HiMemSeg : Word;

  Revector8259 : Boolean;
  DealWithIpx : Boolean;
  DealWithEMS : Boolean;
  DealWithXMS : Boolean;
  KeepMark : Boolean;
  RestoreEnvir : Boolean;
  ResetTimer : Boolean;
  RestoreComm : Boolean;
  MemMark : Boolean;
  FilMark : Boolean;
  Verbose : Boolean;
  Quiet : Boolean;
  OptUseHiMem, UseHiMem : Boolean;

  Keys : string[16];

  MarkEHandles : Word;
  CurrEHandles : Word;
  MarkEmsHandles : PageArrayPtr;
  CurrEmsHandles : PageArrayPtr;

  TrappedBytes : LongInt;

  MarkXHandles : Word;
  CurrXHandles : Word;
  MarkXmsHandles : XmsHandlesPtr;
  CurrXmsHandles : XmsHandlesPtr;
  MarkHmaStatus : Byte;
  CurHmaStatus : Byte;

  {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;
  BiosPrintTable : array[0..9] of Byte;
  DevA : DeviceArray;             {Temporary array of device headers}
  DevCnt : Word;                  {Number of device headers}
  CommandPsp : array[1..$100] of Byte; {Buffer for COMMAND.COM PSP}
  DosData : array[1..$200] of Byte; {Buffer for DOS data area}
  DosTableSize : Word;
  DosTable : Pointer;             {Dos internal variables}
  FileTableA : array[1..5] of SftRecPtr; {Points to system file table buffers}
  FileTableCnt : Word;            {Number of system file table blocks}
  FileRecSize : Word;             {Bytes in internal DOS file record}
  PatchOfst : Word;               {Address of COMMAND.COM patch}
  PatchSegm : Word;
  EnvLen : Word;                  {Bytes in DOS environment}
  EnvPtr : Pointer;               {Pointer to copy of DOS environment}
  PicMask : Byte;                 {8259 interrupt mask}
  ComData : ComArray;             {Communications data array}
  McbG : McbGroup;                {Allocated Mcbs}

  TestPtr : DeviceHeaderPtr;      {Test pointer while getting started on chain}
  DevicePtr : DeviceHeaderPtr;    {Pointer to the next device header}
  DeviceSegment : Word;           {Current device segment}
  DeviceOffset : Word;            {Current device offset}
  MarkF : file;                   {Saved system information file}
  DosPtr : ^DosRec;               {Pointer to internal DOS variable table}
  CommandSeg : Word;              {Segment of primary COMMAND.COM}

  procedure NoRestoreHalt(ReturnCode : Word);
    {-Replace Turbo halt with one that doesn't restore any interrupts}
  begin
    if VectorsRestored then begin
      Close(Output);
      asm
        mov ah,$4C
        mov al,byte(ReturnCode)
        int $21
      end;
    end else
      System.Halt(ReturnCode);
  end;

  procedure RemoveMarkFile;
    {-Close and remove the mark file}
  begin
    Close(MarkF);
    if IoResult = 0 then
      if not KeepMark then begin
        Erase(MarkF);
        if IoResult = 0 then ;
      end;
    MarkFOpen := False;
  end;

  procedure Abort(Msg : String);
    {-Halt in case of error}
  begin
    if MarkFOpen then
      RemoveMarkFile;
    WriteLn(Msg);
    Halt(255);
  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;

    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;

    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
      {Check the mark name stored in the PSP of the mark block}
      Tstring := GetMarkName(Segment);
      FoundIt := (Tstring = MarkName);
      if not FoundIt then begin
        if (Tstring <> '') and (Tstring[1] = ProtectChar) then
          {Current mark is protected, stop searching}
          B := 1;
        Dec(B);
      end;
      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
      {Check the mark name stored in the PSP of the mark block}
      FoundIt := (GetMarkName(Segment) = MarkName);
      if FoundIt then begin
        {Assure named file exists}
        if Verbose then
          WriteLn('Finding mark file ', MarkName);
        FoundIt := ExistFile(MarkName);
      end;
      if not FoundIt then
        {Net marks are protected marks; stop checking if non-match found}
        B := 0;
      MatchFilMark := FoundIt;
    end;

    function MatchExactFilMark(Segment : Word;
                               MarkName : String;
                               var B : BlockType) : Boolean;
      {-Return true if FilMark matches current name}
    var
      FoundIt : Boolean;
    begin
      {Check the mark name stored in the PSP of the mark block}
      FoundIt := (GetMarkName(Segment) = MarkName);
      if FoundIt then begin
        {Assure named file exists}
        if Verbose then
          WriteLn('Finding mark file ', MarkName);
        FoundIt := ExistFile(MarkName);
      end;
      if not FoundIt then
        dec(B);
      MatchExactFilMark := FoundIt;
    end;

  begin
    B := BlockMax;
    MemMark := False;
    FilMark := False;
    if UseHiMem then begin
      {Scan for an exact match to the specified net mark}
      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
          {A net mark}
          FilMark := MatchExactFilMark(BPsp, MarkName, B)
        else
          {Not a net mark}
          Dec(B);
      until (B < 1) or FilMark;

    end else begin
      {Scan from the last block down to find the last MARK TSR}
      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, MarkID, MarkOffset) then
          {An in-memory mark}
          MemMark := MatchMemMark(BPsp, MarkName, B)
        else if HasIDstring(BPsp, NmarkID, NmarkOffset) then
          {A net mark}
          FilMark := MatchFilMark(BPsp, MarkName, B)
        else
          {Ignore normal file marks}
          {Not a mark}
          Dec(B);
      until (B < 1) or MemMark or FilMark;
    end;
    FindMark := MemMark or FilMark;
  end;

  procedure CheckReadError;
    {-Check previous I/O operation}
  begin
    if IoResult = 0 then
      Exit;
    Abort('Error reading '+MarkName);
  end;

  function PhysicalAddress(P : Pointer) : LongInt;
  begin
    PhysicalAddress := LongInt(OS(P).S) shl 4+OS(P).O;
  end;

  procedure ValidateMarkFile;
    {-Open mark file and assure it's valid}
  type
    IDArray = array[1..4] of Char;
  var
    ID : IDArray;
    ExpectedID : IDArray;
  begin
    Assign(MarkF, MarkName);
    Reset(MarkF, 1);
    if IoResult <> 0 then
      Abort('Mark file '+MarkName+' not found');
    MarkFOpen := True;

    {Check the ID at the start of the file}
    ExpectedID := NetMarkID;
    BlockRead(MarkF, ID, SizeOf(IDArray));
    CheckReadError;
    if ID <> ExpectedID then
      Abort(MarkName+' is not a valid net mark file');

    {Read the NUL device address}
    BlockRead(MarkF, TestPtr, SizeOf(Pointer));
    CheckReadError;
    if PhysicalAddress(TestPtr) <> PhysicalAddress(DevicePtr) then begin
      if Verbose then
        WriteLn('Old NUL addr:', HexPtr(TestPtr),
                '   Current NUL addr:', HexPtr(DevicePtr));
      Abort('Unexpected error. NUL device moved');
    end;
  end;

  procedure BufferFileTable;
    {-Read the file table from the mark file into memory}
  type
    SftRecStub =
      record
        Next : SftRecPtr;
        Count : Word;
      end;
  var
    I : Word;
    Size : Word;
    P : Pointer;
    S : SftRecStub;
  begin
    BlockRead(MarkF, FileTableCnt, SizeOf(Word));
    for I := 1 to FileTableCnt do begin
      BlockRead(MarkF, S, SizeOf(SftRecStub));
      Size := 6+S.Count*FileRecSize;
      GetMem(FileTableA[I], Size);
      P := FileTableA[I];
      Move(S, P^, SizeOf(SftRecStub));
      Inc(OS(P).O, SizeOf(SftRecStub));
      BlockRead(MarkF, P^, Size-SizeOf(SftRecStub));
    end;
    CheckReadError;
  end;

  procedure ReadReg(var B : Byte);
    {-Read a communications register from the mark file}
  begin
    BlockRead(MarkF, B, SizeOf(Byte));
    CheckReadError;
  end;

  procedure ReadMarkFile;
    {-Read the mark file info into memory}
  var
    DevPtr : DeviceHeaderPtr;
    Com : Byte;
  begin
    {Read the vector table from the mark file, into a temporary memory area}
    BlockRead(MarkF, Vectors, 1024);
    CheckReadError;

    {Read the BIOS miscellaneous save areas into temporary tables}
    BlockRead(MarkF, EGAsavTable, 8);
    BlockRead(MarkF, IntComTable, 16);
    BlockRead(MarkF, ParentSeg, 2);
    BlockRead(MarkF, ParentLen, 2);
    BlockRead(MarkF, BiosPrintTable, 10);
    CheckReadError;

    {Read the stored EMS handles, if any}
    BlockRead(MarkF, MarkEHandles, SizeOf(Word));
    GetMem(MarkEmsHandles, SizeOf(HandlePageRecord)*MarkEHandles);
    BlockRead(MarkF, MarkEmsHandles^, SizeOf(HandlePageRecord)*MarkEHandles);
    CheckReadError;

    {Read the stored XMS info, if any}
    BlockRead(MarkF, MarkXHandles, SizeOf(Word));
    GetMem(MarkXmsHandles, SizeOf(XmsHandleRecord)*MarkXHandles);
    BlockRead(MarkF, MarkXmsHandles^, SizeOf(XmsHandleRecord)*MarkXHandles);
    BlockRead(MarkF, MarkHmaStatus, SizeOf(Byte));
    CheckReadError;

    {Read the device driver chain}
    DevPtr := DevicePtr;
    DevCnt := 0;
    while OS(DevPtr).O <> $FFFF do begin
      Inc(DevCnt);
      GetMem(DevA[DevCnt], SizeOf(DeviceHeader));
      BlockRead(MarkF, DevA[DevCnt]^, SizeOf(DeviceHeader));
      CheckReadError;
      with DevA[DevCnt]^ do
        DevPtr := Ptr(NextHeaderSegment, NextHeaderOffset);
    end;

    {Read the DOS data area table}
    BlockRead(MarkF, DosData, $200);
    CheckReadError;

    {Read the DOS internal variables table}
    BlockRead(MarkF, DosTableSize, SizeOf(Word));
    if DosTableSize <> 0 then begin
      GetMem(DosTable, DosTableSize);
      BlockRead(MarkF, DosTable^, DosTableSize);
    end;
    CheckReadError;

    {Read the internal file table}
    BufferFileTable;

    {Read in the copy of COMMAND.COM's PSP}
    BlockRead(MarkF, CommandPsp, $100);
    CheckReadError;

    {Read in the address used for COMMAND.COM patching by NetWare}
    BlockRead(MarkF, PatchOfst, SizeOf(Word));
    BlockRead(MarkF, PatchSegm, SizeOf(Word));
    CheckReadError;

    {Read in the DOS master environment}
    BlockRead(MarkF, EnvLen, SizeOf(Word));
    GetMem(EnvPtr, EnvLen);
    BlockRead(MarkF, EnvPtr^, EnvLen);
    CheckReadError;

    {Read in the communications data area}
    BlockRead(MarkF, PicMask, SizeOf(Byte));
    CheckReadError;
    for Com := 1 to 2 do
      with ComData[Com] do begin
        BlockRead(MarkF, Base, SizeOf(Word));
        CheckReadError;
        if Base <> 0 then begin
          ReadReg(IERReg);
          ReadReg(LCRReg);
          ReadReg(MCRReg);
          ReadReg(BRLReg);
          ReadReg(BRHreg);
        end;
      end;

    {Read in the allocated Mcb chain}
    BlockRead(MarkF, McbG.Count, SizeOf(Word));
    BlockRead(MarkF, McbG.Mcbs, 2*SizeOf(Word)*McbG.Count);
    CheckReadError;

    {Close and possibly erase mark file}
    RemoveMarkFile;
  end;

  procedure RestoreCommState;
    {-Restore the communications chips to their previous state}
  var
    Com : Byte;
  begin
    for Com := 1 to 2 do
      with ComData[Com] do
        if Base <> 0 then begin
          Port[Base+IER] := IERReg; {Interrupt enable register}
          NullJump;
          Port[Base+MCR] := MCRReg; {Modem control register}
          NullJump;
          Port[Base+LCR] := LCRReg or $80; {Enable baud rate divisor registers}
          NullJump;
          Port[Base+BRL] := BRLReg; {Baud rate low}
          NullJump;
          Port[Base+BRH] := BRHReg; {Baud rate high}
          NullJump;
          Port[Base+LCR] := LCRReg; {Line control register}
          NullJump;
        end;
    {Restore the interrupt mask}
    Port[$21] := PicMask;
  end;

  procedure CopyVectors;
    {-Put interrupt vectors back into table}

    procedure Reset8259;
      {-Reset the 8259 interrupt controller to its powerup state}
      {-Interrupts assumed OFF prior to calling this routine}

      function ATmachine : Boolean;
        {-Return true if machine is AT class}
      var
        MachType : Byte absolute $FFFF : $000E;
      begin
        case MachType of
          $F8, $FC : ATmachine := True;
        else
          ATmachine := False;
        end;
      end;

      procedure Reset8259PC;
        {-Reset the 8259 on a PC class machine}
      begin
        inline(
          $E4/$21/                { in      al,$21}
          $88/$C4/                { mov     ah,al}
          $B0/$13/                { mov     al,$13}
          $E6/$20/                { out     $20,al}
          $B0/$08/                { mov     al,8}
          $E6/$21/                { out     $21,al}
          $B0/$09/                { mov     al,9}
          $E6/$21/                { out     $21,al}
          $88/$E0/                { mov     al,ah}
          $E6/$21                 { out     $21,al}
          );
      end;

      procedure Reset8259AT;
        {-Reset the 8259 interrupt controllers on an AT machine}
      begin
        inline(
          $32/$C0/                { xor       al,al }
          $E6/$F1/                { out       0f1h,al         ; Switch off an 80287 if necessary}
          {Set up master 8259 }
          $E4/$21/                { in        al,21h          ; Get current interrupt mask }
          $8A/$E0/                { mov       ah,al           ; save it }
          $B0/$11/                { mov       al,11h }
          $E6/$20/                { out       20h,al }
          $EB/$00/                { jmp       short $+2 }
          $B0/$08/                { mov       al,8            ; Set up main interrupt vector number}
          $E6/$21/                { out       21h,al }
          $EB/$00/                { jmp       short $+2 }
          $B0/$04/                { mov       al,4 }
          $E6/$21/                { out       21h,al }
          $EB/$00/                { jmp       short $+2 }
          $B0/$01/                { mov       al,1 }
          $E6/$21/                { out       21h,al }
          $EB/$00/                { jmp       short $+2 }
          $8A/$C4/                { mov       al,ah }
          $E6/$21/                { out       21h,al }
          {Set up slave 8259 }
          $E4/$A1/                { in        al,0a1h         ; Get current interrupt mask }
          $8A/$E0/                { mov       ah,al           ; save it }
          $B0/$11/                { mov       al,11h }
          $E6/$A0/                { out       0a0h,al }
          $EB/$00/                { jmp       short $+2 }
          $B0/$70/                { mov       al,70h }
          $E6/$A1/                { out       0a1h,al }
          $B0/$02/                { mov       al,2 }
          $EB/$00/                { jmp       short $+2 }
          $E6/$A1/                { out       0a1h,al }
          $EB/$00/                { jmp       short $+2 }
          $B0/$01/                { mov       al,1 }
          $E6/$A1/                { out       0a1h,al }
          $EB/$00/                { jmp       short $+2 }
          $8A/$C4/                { mov       al,ah           ; Reset previous interrupt state }
          $E6/$A1                 { out       0a1h,al }
          );
      end;

    begin
      if ATmachine then
        Reset8259AT
      else
        Reset8259PC;
    end;

  begin
    {Interrupts off}
    IntsOff;

    {Reset 8259 if requested}
    if Revector8259 then
      Reset8259;

    {Reset the communications state if requested}
    if RestoreComm then
      RestoreCommState;

    {Restore the main interrupt vector table}
    Move(Vectors, Mem[0:0], 1024);

    {Interrupts on}
    IntsOn;

    {Flag that we don't want system restoring vectors for us}
    VectorsRestored := True;

    Move(EGAsavTable, Mem[$40:$A8], 8); {EGA table}
    Move(IntComTable, Mem[$40:$F0], 16); {Interapplications communication area}
    {$IFDEF Debug}
    writeln('Parent address: ', HexW(ParentSeg), ' Length: ', ParentLen);
    {$ENDIF}
    if ValidPsp(HiMemSeg, ParentSeg, ParentLen) then begin
      {Don't restore parent if it no longer exists (applies to QEMM LOADHI)}
      MemW[PrefixSeg:$16] := ParentSeg;
      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(BiosPrintTable, Mem[$40:$08], 10); {BIOS Printer Table}
    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
      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 <= McbG.Count) do
        if McbG.Mcbs[m].mcb >= TopSeg then
          Found := True
        else
          inc(m);

      {Mark out all mcbs associated with psp of last low memory mcb}
      TopSeg := McbG.Mcbs[m-1].psp;
      if TopSeg <> markPsp then
        for m := 1 to McbG.Count do
          with McbG.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 <= McbG.Count) do begin
            Found := (McbG.Mcbs[m].psp <> 0) and (McbG.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
    if Verbose then begin
      WriteLn('Releasing DOS memory');
      {$IFDEF Debug}
      ReadLn;
      {$ENDIF}
    end;
    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;
    if Verbose then begin
      WriteLn('Merging free blocks in high memory');
      {$IFDEF Debug}
      ReadLn;
      {$ENDIF}
    end;
    MergeHiMemBlocks(HiMemSeg);
  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 RELNET -- no action taken')
    else if CurrEHandles <> 0 then begin
      {See how many handles were active when MARK was installed}
      if Verbose then begin
        WriteLn('Releasing EMS memory allocated since MARK');
        {$IFDEF Debug}
        ReadLn;
        {$ENDIF}
      end;
      {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 RestoreXmsmap;
    {-Restore Xms to state at time of mark}
  var
    O, N, NHandle : Word;

    procedure XmsError;
    begin
      WriteLn('Program error or XMS device not responding');
      Abort('XMS memory may be a mess... Please reboot');
    end;

  begin
    CurrXHandles := GetXmsHandles(CurrXmsHandles);
    if CurrXHandles <> 0 then begin
      {See how many handles were active when MARK was installed}
      if Verbose then begin
        WriteLn('Releasing XMS memory allocated since MARK');
        {$IFDEF Debug}
        ReadLn;
        {$ENDIF}
      end;
      if MarkXHandles = 0 then begin
        {Release all current XMS Handles}
        for N := 1 to CurrXHandles do
          if FreeExtMem(CurrXmsHandles^[N].Handle) <> 0 then
            XmsError;
      end else begin
        {Compare the two maps and deallocate pages not in the stored map}
        for N := 1 to CurrXHandles do begin
          {Scan all current handles}
          NHandle := CurrXmsHandles^[N].Handle;
          {See if current handle matches one stored by MARK}
          O := 1;
          while (MarkXmsHandles^[O].Handle <> NHandle) and (O <= MarkXHandles) do
            Inc(O);
          {If not, deallocate the current handle}
          if (O > MarkXHandles) then
            if FreeExtMem(NHandle) <> 0 then
              XmsError;
        end;
      end;
    end;

    {Free the HMA if appropriate}
    CurHmaStatus := AllocateHma($FFFF);
    if (CurHMAStatus = 0) or (MarkHMAStatus = 0) then
      if FreeHma = 0 then ;
  end;

  procedure GetOptions;
    {-Analyze command line for options}

    procedure WriteCopyright;
    begin
      WriteLn('RELNET ', Version, ', Copyright 1991 TurboPower Software');
    end;

    procedure WriteHelp;
      {-Show the options}
    begin
      WriteCopyright;
      WriteLn;
      WriteLn('RELNET removes memory-resident programs from memory, particularly network');
      WriteLn('shells like Novell''s NetWare, although it will also release normal memory');
      WriteLn('resident programs. In combination with MARKNET it thoroughly restores the');
      WriteLn('system to its state at the time MARKNET was called.');
      WriteLn;
      WriteLn('RELNET accepts the following command line syntax:');
      WriteLn;
      WriteLn('  RELNET NetMarkFile [Options]');
      WriteLn;
      WriteLn('Options may be preceded by either / or -. Valid options are:');
      WriteLn;
      WriteLn('  /C         do NOT restore communications state.');
      WriteLn('  /E         do NOT access EMS memory.');
      WriteLn('  /H         work with upper memory if available.');
      WriteLn('  /I         do NOT shut down IPX events and sockets.');
      WriteLn('  /K         release memory, but keep the mark in place.');
      WriteLn('  /P         do NOT restore DOS environment.');
      WriteLn('  /Q         write no screen output.');
      WriteLn('  /R         revector 8259 interrupt controller to powerup state.');
      WriteLn('  /S chars   stuff string (<16 chars) into keyboard buffer on exit.');
      WriteLn('  /T         do NOT reset system timer chip to default rate.');
      WriteLn('  /U         work with upper memory, but halt if none found.');
      WriteLn('  /V         verbose: show each step of the restore.');
      WriteLn('  /X         do NOT access XMS memory.');
      WriteLn('  /?         write this help screen.');
      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
                  'C' : RestoreComm := False;
                  'E' : DealWithEMS := False;
                  'H' : OptUseHiMem := True;
                  'I' : DealWithIPX := False;
                  'K' : KeepMark := True;
                  'P' : RestoreEnvir := False;
                  'Q' : Quiet := True;
                  'R' : Revector8259 := 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;
                  'T' : ResetTimer := False;
                  'U' : UseHiMem := True;
                  'V' : Verbose := True;
                  'X' : DealWithXMS := False;
                  '?' : WriteHelp;
                else
                  Abort('Unknown command option: '+Arg);
                end;
          else
            Abort('Unknown command option: '+Arg);
          end
        else if Length(MarkName) = 0 then
          {Mark file}
          MarkName := StUpcase(Arg)
        else
          Abort('Too many mark files specified');
      until False;
    end;

  begin
    {Initialize defaults}
    MarkName := '';
    Keys := '';

    Revector8259 := False;
    KeepMark := False;
    DealWithIPX := True;
    DealWithEMS := True;
    DealWithXMS := True;
    ResetTimer := True;
    Verbose := False;
    Quiet := False;
    RestoreEnvir := True;
    RestoreComm := True;
    UseHiMem := False;
    OptUseHiMem := False;

    ReturnCode := 0;
    TrappedBytes := 00;

    {Get arguments from the command line and the environment}
    GetArgs(StringPtr(Ptr(PrefixSeg, $80))^);
    GetArgs(GetEnv('RELNET'));

    if Length(MarkName) = 0 then begin
      WriteLn('No mark file specified');
      WriteHelp;
    end;
    if Verbose then
      Quiet := False;
    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;
  end;

  function MemoryRelease(P : Pointer) : Boolean;
    {-Return True if address P is in a block to be released}
  var
    B : BlockType;
    PL : LongInt;
    PSPL : LongInt;
  begin
    PL := PhysicalAddress(P);
    for B := 1 to BlockMax do
      with Blocks[B] do
        if ReleaseIt then begin
          PSPL := LongInt(Psp) shl 4;
          if (PL >= PSPL) and (PL < PSPL+LongInt(MemW[Mcb:3]) shl 4) then begin
            MemoryRelease := True;
            Exit;
          end;
        end;
    MemoryRelease := False;
  end;

  procedure CloseIpxSockets;
  const
    Retf : Byte = $CB; {Return instruction}
  var
    This, Next : IpxEcbPtr;
    Ecb : IpxEcb;
    Status : Byte;
  begin
    {Create a new Ecb to find start of linked list of Ecb's}
    FillChar(Ecb, SizeOf(IpxEcb), 0);
    Ecb.EsrAddress := @RetF;
    ScheduleSpecialEvent(182, Ecb);

    {Scan the list of Ecb's}
    This := Ecb.Link;
    while This <> nil do begin
      if Verbose then
        Write('Ecb: ', HexPtr(This),
              ' Esr: ', HexPtr(This^.EsrAddress),
              ' InUse: ', HexW(This^.InUse),
              ' Socket: ', HexW(This^.SocketNumber));
      Next := This^.Link;
      if MemoryRelease(This) or MemoryRelease(This^.ESRAddress) then
        {Memory of this Ecb will be released}
        if This^.InUse <> 0 then begin
          {This Ecb is in use}
          Status := CancelEvent(This^);
          if Verbose then
            Write(' [cancelled]');
          if This^.SocketNumber <> 0 then begin
            CloseSocket(This^.SocketNumber);
            if Verbose then
              Write(' [closed]');
          end;
        end;
      if Verbose then
        Writeln;
      This := Next;
    end;

    {Cancel the special event we started}
    Status := CancelEvent(Ecb);
  end;

  procedure FindDevChain;
    {-Return segment, offset and pointer to NUL device}
  begin
    DosPtr := Ptr(OS(DosList).S, OS(DosList).O-2);
    DevicePtr := @DosPtr^.NullDevice;
    DeviceSegment := OS(DevicePtr).S;
    DeviceOffset := OS(DevicePtr).O;
  end;

  procedure RestoreDosTable;
    {-Restore the DOS variables table, except for the buffer pointer}
  type
    ByteArray = array[0..32767] of Byte;
    ByteArrayPtr = ^ByteArray;
  var
    DosBase : Pointer;
    SPtr : Pointer;
    DPtr : Pointer;
  begin
    if Verbose then begin
      WriteLn('Restoring DOS data area at 0050:0000');
      {$IFDEF Debug}
      ReadLn;
      {$ENDIF}
    end;
    DPtr := Ptr($50, 0);
    Move(DosData, DPtr^, $200);

    DosBase := Ptr(OS(DosPtr).S, 0);
    if Verbose then begin
      WriteLn('Restoring ', DosTableSize,
              ' bytes of DOS variables table at ', HexPtr(DosBase));
      {$IFDEF Debug}
      ReadLn;
      {$ENDIF}
    end;

    {patch up DosTable to reflect current items that must be maintained}
    {CachePtr}
    SPtr := @DosPtr^.CachePtr;
    DPtr := @ByteArrayPtr(DosTable)^[Ofs(DosPtr^.CachePtr)];
    {$IFDEF Debug}
    writeln('cacheptr ', hexptr(sptr), '->', hexptr(dptr), ' ', SizeOf(Pointer));
    {$ENDIF}

    move(SPtr^, DPtr^, SizeOf(Pointer));
    if DosV = 5 then begin
      {Other unknown areas}
      SPtr := Ptr(OS(DosPtr).S, OS(DosPtr).O+SizeOf(DosRec));
      DPtr := @ByteArrayPtr(DosTable)^[OS(DosPtr).O+SizeOf(DosRec)];
      {$IFDEF Debug}
      writeln('unknown  ', hexptr(sptr), '->', hexptr(dptr), ' ',
              OS(DosPtr^.FirstSFT).O-OS(DosPtr).O-SizeOf(DosRec)-$3C);
      {$ENDIF}
      move(SPtr^, DPtr^, OS(DosPtr^.FirstSFT).O-OS(DosPtr).O-SizeOf(DosRec)-$3C);
    end;

    {Restore DOS table}
    move(DosTable^, DosBase^, DosTableSize);
  end;

  procedure RestoreFileTable;
    {-Copy the internal file table from our memory buffer to its DOS location}
  var
    S : SftRecPtr;
    I : Word;
  begin
    S := DosPtr^.FirstSFT;
    if Verbose then begin
      WriteLn('Restoring DOS file table at ', HexPtr(S));
      {$IFDEF Debug}
      ReadLn;
      {$ENDIF}
    end;
    for I := 1 to FileTableCnt do begin
      Move(FileTableA[I]^, S^, 6+FileTableA[I]^.Count*FileRecSize);
      S := S^.Next;
    end;
  end;

  procedure RestoreDeviceDrivers;
    {-Restore the device driver chain to its original state}
  var
    D : Word;
    DevPtr : DeviceHeaderPtr;
  begin
    if Verbose then begin
      WriteLn('Restoring device driver chain');
      {$IFDEF Debug}
      ReadLn;
      {$ENDIF}
    end;
    DevPtr := DevicePtr;
    for D := 1 to DevCnt do begin
      DevPtr^ := DevA[D]^;
      with DevA[D]^ do
        DevPtr := Ptr(NextHeaderSegment, NextHeaderOffset);
    end;
  end;

  procedure RestoreCommandPSP;
    {-Copy COMMAND.COM's PSP back into place}
  var
    PspPtr : Pointer;
  begin
    PspPtr := Ptr(CommandSeg, 0);
    if Verbose then begin
      WriteLn('Restoring COMMAND.COM PSP at ', HexPtr(PspPtr));
      {$IFDEF Debug}
      ReadLn;
      {$ENDIF}
    end;
    Move(CommandPsp, PspPtr^, $100);
  end;

  procedure RestoreCommandPatch;
    {-Restore the patch that NetWare applies to COMMAND.COM}
  begin
    if (PatchSegm <> 0) or (PatchOfst <> 0) then
      if (Mem[PatchSegm:PatchOfst+$01] <> Byte('/')) or
      (Mem[PatchSegm:PatchOfst+$11] <> Byte('/')) then begin
        if Verbose then begin
          WriteLn('Removing patch at ', HexW(PatchSegm), ':', HexW(PatchOfst));
          {$IFDEF Debug}
          ReadLn;
          {$ENDIF}
        end;
        Mem[PatchSegm:PatchOfst+$01] := Byte('/');
        Mem[PatchSegm:PatchOfst+$11] := Byte('/');
      end;
  end;

  procedure FindEnv(CommandSeg : Word; var EnvSeg, EnvLen : Word);
    {-Return the segment and length of the master environment}
  var
    Mcb : Word;
  begin
    Mcb := CommandSeg-1;
    EnvSeg := MemW[CommandSeg:$2C];
    if EnvSeg = 0 then
      {Master environment is next block past COMMAND}
      EnvSeg := Commandseg+MemW[Mcb:3]+1;
    EnvLen := MemW[(EnvSeg-1):3] shl 4;
  end;

  procedure RestoreDosEnvironment;
    {-Restore the master copy of the DOS environment}
  var
    EnvSeg : Word;
    CurLen : Word;
    P : Pointer;
  begin
    if RestoreEnvir then begin
      FindEnv(CommandSeg, EnvSeg, CurLen);
      if CurLen <> EnvLen then
        Abort('Environment length changed');
      if Verbose then begin
        WriteLn('Restoring DOS environment, ', EnvLen, ' bytes at ', HexW(EnvSeg), ':0000');
        {$IFDEF Debug}
        ReadLn;
        {$ENDIF}
      end;
      P := Ptr(EnvSeg, 0);
      move(EnvPtr^, P^, EnvLen);
    end;
  end;

  procedure SetTimerRate(Rate : Word);
    {-Program system 8253 timer number 0 to run at specified rate}
  begin
    IntsOff;
    Port[$43] := $36;
    NullJump;
    Port[$40] := Lo(Rate);
    NullJump;
    Port[$40] := Hi(Rate);
    IntsOn;
  end;

  procedure RestoreTimer;
    {-Set the system timer to its normal rate}
  begin
    if Verbose then begin
      WriteLn('Restoring system timer to normal rate');
      {$IFDEF Debug}
      ReadLn;
      {$ENDIF}
    end;
    SetTimerRate(0);
  end;

  function CompaqDOS30 : Boolean; assembler;
    {-Return true if Compaq DOS 3.0}
  asm
    mov ah,$34
    int $21
    cmp bx,$019C
    mov al,1
    jz @Done
    dec al
@Done:
  end;

  procedure ValidateDosVersion;
    {-Assure supported version of DOS and compute size of DOS internal filerec}
  var
    DosVer : Word;
  begin
    DosVer := DosVersion;
    case Hi(DosVer) of
      3 : if (Hi(DosVer) < $0A) and not CompaqDOS30 then
            {IBM DOS 3.0}
            FileRecSize := 56
          else
            {DOS 3.1+ or Compaq DOS 3.0}
            FileRecSize := 53;
      4, 5 : FileRecSize := 59;
    else
      Abort('Requires DOS 3, 4, or 5');
    end;
  end;

begin
  {Assure supported version of DOS}
  ValidateDosVersion;

  {Analyze command line for options}
  GetOptions;

  {Find the start of the device driver chain via the NUL device}
  FindDevChain;

  {Get all allocated memory blocks in normal memory}
  FindTheBlocks(True, HiMemSeg, Blocks, BlockMax, StartMcb, CommandSeg);

  {Find the block 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.');
  if MemMark then
    Abort('Marker must have been placed by MARKNET');
  markPsp := Blocks[markBlock].psp;

  {Open and validate the mark file}
  ValidateMarkFile;

  {Close IPX sockets and cancel IPX ECBs}
  if DealWithIpx then
    if IpxInstalled then
      CloseIpxSockets;

  {Get file mark information into memory}
  ReadMarkFile;

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

  {Copy the vector table from the MARK copy}
  CopyVectors;

  {Restore the device driver chain}
  RestoreDeviceDrivers;

  {Restore the COMMAND.COM patch possibly made by NetWare}
  RestoreCommandPatch;

  {Restore the DOS variables table}
  RestoreDosTable;

  {Restore the DOS file table}
  RestoreFileTable;

  {Restore the COMMAND.COM PSP}
  RestoreCommandPSP;

  {Restore the master DOS environment}
  RestoreDosEnvironment;

  {Set the timer to normal rate}
  if ResetTimer then
    RestoreTimer;

(*
  this isn't necessary, and in fact is harmful, when the DOS file table
  is being restored above.
  {Close open file handles}
  CloseHandles;
*)

  {Release normal memory}
  ReleaseMem;

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

  {Deal with extended memory}
  if DealWithXMS then
    if XMSInstalled then
      RestoreXMSMap;

  {Write success message}
  if not Quiet then
    WriteLn('Memory released after ', StUpcase(MarkName));

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

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

  NoRestoreHalt(ReturnCode);
end.