Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TSRUTILS.ZIP/RELNET.PAS

Pascal/Delphi Source File | 1989-05-04 | 44.2 KB | 1,462 lines

{**************************************************************************
*   RELNET - releases memory above the last MARKNET call made.            *
*   Copyright (c) 1986,1989 Kim Kokkonen, TurboPower Software.            *
*   May be distributed freely, but not for a profit except with written   *
*   permission from TurboPower Software.                                  *
***************************************************************************
*   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                                                   *
***************************************************************************
*   Telephone: [phone], CompuServe: 72457,2131.                      *
*   Requires Turbo version 5 to compile.                                  *
***************************************************************************}

{$R-,S-,I-}

program ReleaseNet;

uses
  {$IFDEF ReleaseSocket}
  NetWare,                        {This unit is part of TurboPower's
                                   commercial package B-Tree Filer.
                                   It isn't really needed here.}
  {$ENDIF}
  Dos;

const
  Version = '2.9';
  NmarkID = 'MN2.9 TSR';          {Marking string for TSR file mark}
  NetMarkID = 'MN29';             {ID at start of net mark file}
  MarkID = 'M2.9 PARAMETER BLOCK FOLLOWS'; {Marking string for TSR MARK,
                                            just for WATCH here}
  FmarkID = 'FM2.9 TSR';          {Marking string for TSR 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}
  NmarkOffset = $60;              {Where NmarkID is found in FMARK TSR}
  FmarkOffset = $60;              {Where FmarkID is found in FMARK TSR}

  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 deltas in WATCH}

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

  Digits : array[0..$F] of Char = '0123456789ABCDEF';

  RBR = 0; {Receiver buffer register offset}
  THR = 0; {Transmitter buffer register offset}
  BRL = 0; {Baud rate low}
  BRH = 1; {Baud rate high}
  IER = 1; {Interrupt enable register}
  IIR = 2; {Interrupt identification register}
  LCR = 3; {Line control register}
  MCR = 4; {Modem control register}
  LSR = 5; {Line status register}
  MSR = 6; {Modem status register}

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;

  {Structure of a device driver header}
  DeviceHeader =
    record
      NextHeaderOffset : Word;    {Offset address of next device in chain}
      NextHeaderSegment : Word;   {Segment address of next device in chain}
      Attributes : Word;          {Device attributes}
      StrategyEntPt : Word;       {Offset in current segment - strategy}
      InterruptEntPt : Word;      {Offset in current segment - interrupt}
      DeviceName : array[1..8] of Char; {Name of the device}
    end;
  DeviceHeaderPtr = ^DeviceHeader;
  DeviceArray = array[1..256] of DeviceHeaderPtr;

  SO =
    record
      O, S : Word;
    end;

  FileRec =
    record
      OpenCnt : Word;
      OpenMode : Word;
      Attribute : Byte;
      Unknown1 : Word;
      DCB : Pointer;
      InitCluster : Word;
      Time : Word;
      Date : Word;
      Size : LongInt;
      Pos : LongInt;
      BeginCluster : Word;
      CurCluster : Word;
      Block : Word;
      Unknown2 : Byte;            {Varies with DOS version beyond here}
      Name : array[0..7] of Char;
      Ext : array[0..2] of Char;
      Unknown3 : array[0..5] of Byte;
      Owner : Word;
      Unknown4 : Word;
    end;

  SftRecPtr = ^SftRec;
  SftRec =
    record
      Next : SftRecPtr;
      Count : Word;
      Files : array[1..255] of FileRec;
    end;

  DosRec =
    record
      McbSeg : Word;
      FirstDPB : Pointer;
      FirstSFT : SftRecPtr;
      ClockDriver : Pointer;
      ConDriver : Pointer;
      MaxBlockBytes : Word;
      CachePtr : Pointer;
      DriveTable : Pointer;
      Unknown2 : Pointer;
      Unknown3 : Word;
      BlockDevices : Byte;
      LastDrive : Byte;
      NullDevice : DeviceHeader;
    end;

  ComRec =  {State of the communications system}
    record
      Base : Word;
      IERReg : Byte;
      LCRReg : Byte;
      MCRReg : Byte;
      BRLReg : Byte;
      BRHReg : Byte;
    end;
  ComArray = array[1..2] of ComRec;

var
  Blocks : BlockArray;
  WatchBlock : BlockType;
  BottomBlock : BlockType;
  BlockNum : BlockType;

  MarkName : String[79];

  Regs : Registers;

  ReturnCode : Word;
  StartMCB : Word;
  StoredHandles : Word;
  EMShandles : Word;

  UseWatch : Boolean;
  Revector8259 : Boolean;
  DealWithEMS : Boolean;
  KeepMark : Boolean;
  RestoreEnvir : Boolean;
  ResetTimer : Boolean;
  RestoreComm : Boolean;
  MemMark : Boolean;
  FilMark : Boolean;
  Junk : Boolean;
  Verbose : Boolean;
  Keys : string[16];

  FilMarkPageMap : PageArrayPtr;
  Map : PageArrayPtr;
  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;
  FilMarkHandles : Word;
  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}

  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 Halt(ReturnCode : Word);
    {-Replace Turbo halt with one that doesn't restore any interrupts}
  begin
    if VectorsRestored then begin
      Close(Output);
      with Regs do begin
        AH := $4C;
        AL := Lo(ReturnCode);
        MsDos(Regs);
      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 HexW(W : Word) : string;
    {-Return hex string for word}
  begin
    HexW[0] := #4;
    HexW[1] := Digits[hi(W) shr 4];
    HexW[2] := Digits[hi(W) and $F];
    HexW[3] := Digits[lo(W) shr 4];
    HexW[4] := Digits[lo(W) and $F];
  end;

  function HexPtr(P : Pointer) : string;
    {-Return hex string for pointer}
  begin
    HexPtr := HexW(SO(P).S)+':'+HexW(SO(P).O);
  end;

  function StUpcase(S : String) : string;
    {-Return uppercase for string}
  var
    I : Integer;
  begin
    for I := 1 to Length(S) do
      S[I] := Upcase(S[I]);
    StUpcase := S;
  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}

    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
    StartMCB := DosPtr^.McbSeg;
    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 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;

    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 = 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);
        Reset(F);
        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 := MarkName;
        FoundIt := (Tstring = MarkName);
        if FoundIt then begin
          {Assure named file exists}
          if Verbose then
            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
        {Net marks are protected marks}
        {Stop checking if a non-matching net mark is found}
        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)
(* ignore file marks !!!!!!!
      else if HasIDstring(Blocks[b].psp, FmarkID, FmarkOffset) then
        {A file 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, NmarkID, NmarkOffset) then
        {A net 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;

  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(SO(P).S) shl 4+SO(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(SO(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, ParentTable, 2);
    CheckReadError;

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

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

    {Read the device driver chain}
    DevPtr := DevicePtr;
    DevCnt := 0;
    while SO(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;

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

  procedure IntsOff;
    {-Turn off CPU interrupts}
  inline($FA);

  procedure IntsOn;
    {-Turn on CPU interrupts}
  inline($FB);

  procedure NullJump;
    {-Slight delay}
  inline($EB/$00);

  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 and the misc save areas}
    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}
    Move(ParentTable, Mem[PrefixSeg:$16], 2); {Parent address}
    Move(Mem[0:$88], Mem[PrefixSeg:$0A], 12); {Int 22,23,24 addresses}
  end;

  procedure MarkBlocks(BottomBlock : BlockType);
    {-Mark those blocks to be released}
  var
    B : BlockType;
    CommandPsp, MarkPsp : Word;

    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;

  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 RELNET and the mark}
          releaseIt := (psp <> PrefixSeg) and (psp <> markPsp)
        else
          {Release all but RELNET itself}
          ReleaseIt := (Psp <> PrefixSeg);

    {$IFDEF Debug}
    for B := 1 to BlockNum do
      with Blocks[B] do
        WriteLn(B:3, ' ', HexW(Psp), ' ', HexW(Mcb), ' ', ReleaseIt);
    {$ENDIF}
  end;

  procedure ReleaseMem;
    {-Release DOS memory marked for release}
  var
    B : BlockType;
  begin
    if Verbose then
      WriteLn('Releasing DOS memory');
    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 := Mcb+1;
            MsDos(Regs);
            if Odd(Flags) then begin
              WriteLn('Could not release block at segment ', HexW(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
    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');
    Reset(F);
    if IoResult = 0 then begin
      EMSpresent := True;
      Close(F);
    end else
      EMSpresent := False;
  end;

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

    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
        EMShandles := 0
      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 handle count exceeds capacity of RELNET -- no action taken')
    else if EMShandles <> 0 then begin
      {See how many handles were active when MARK was installed}
      if Verbose then
        WriteLn('Releasing EMS memory allocated since mark');
      StoredHandles := FilMarkHandles;
      {Get the stored page map}
      StoredMap := FilMarkPageMap;
      {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('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('  /K         release memory, but keep the mark in place.');
      WriteLn('  /P         do NOT restore DOS environment.');
      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('  /V         verbose: show each step of the restore.');
      WriteLn('  /?         write this help screen.');
      Halt(1);
    end;

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

    Revector8259 := False;
    KeepMark := False;
    DealWithEMS := True;
    ResetTimer := True;
    Verbose := False;
    RestoreEnvir := True;
    RestoreComm := 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
                'C' : RestoreComm := False;
                'E' : DealWithEMS := False;
                'K' : KeepMark := True;
                'P' : RestoreEnvir := False;
                'R' : Revector8259 := 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;
                'T' : ResetTimer := False;
                'V' : Verbose := True;
                '?' : 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');
      Inc(I);
    end;

    if Length(MarkName) = 0 then begin
      WriteLn('No mark file specified');
      WriteHelp;
    end;
  end;

  {$IFDEF ReleaseSocket}
  procedure CloseSockets;
    {-Close IPX sockets. Specific to Novell NetWare}
  var
    Socket : Word;
    Status : Byte;
  begin
    if Verbose then
      Write('Closing sockets ');
    for Socket := 0 to $1000 do begin
      Status := IPXOpenSocket(Socket, False);
      case Status of
        0 : {Socket wasn't open}
          IPXCloseSocket(Socket);
        $FF : {Socket was already open}
          begin
            if Verbose then
              Write(HexW(Socket), ' ');
            IPXCloseSocket(Socket);
          end;
      end;
    end;
    if Verbose then
      WriteLn;
  end;
  {$ENDIF}

  procedure GetDosPtr;
    {-Return pointer to DOS internal variables table}
  begin
    with Regs do begin
      AH := $52;
      MsDos(Regs);
      Dec(BX, 2);
      DosPtr := Ptr(ES, BX);
    end;
  end;

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

  procedure RestoreDosTable;
    {-Restore the DOS variables table, except for the buffer pointer}
  var
    DosBase : Pointer;
    CPtr : Pointer;
  begin
    if Verbose then
      WriteLn('Restoring DOS data area at 0050:0000');
    CPtr := Ptr($50, 0);
    Move(DosData, CPtr^, $200);
    DosBase := Ptr(SO(DosPtr).S, 0);
    if Verbose then
      WriteLn('Restoring DOS variables table at ', HexPtr(DosBase));
    CPtr := DosPtr^.CachePtr;
    move(DosTable^, DosBase^, DosTableSize);
    DosPtr^.CachePtr := CPtr;
  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
      WriteLn('Restoring DOS file table at ', HexPtr(S));
    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
      WriteLn('Restoring device driver chain');
    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}
  type
    McbRec =
      record
        ID : Char;
        PSPSeg : Word;
        Len : Word;
      end;
  var
    McbPtr : ^McbRec;
    PspPtr : Pointer;
  begin
    {First block}
    McbPtr := Ptr(DosPtr^.McbSeg, 0);
    {Next block, which is owned by COMMAND.COM}
    McbPtr := Ptr(SO(McbPtr).S+McbPtr^.Len+1, 0);
    CommandSeg := McbPtr^.PSPSeg;
    PspPtr := Ptr(CommandSeg, 0);
    if Verbose then
      WriteLn('Restoring COMMAND.COM PSP at ', HexPtr(PspPtr));
    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
          WriteLn('Removing patch at ', HexW(PatchSegm), ':', HexW(PatchOfst));
        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
        WriteLn('Restoring DOS environment, ', EnvLen, ' bytes at ', HexW(EnvSeg), ':0000');
      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
      WriteLn('Restoring system timer to normal rate');
    SetTimerRate(0);
  end;

  function CompaqDOS30 : Boolean;
    {-Return true if Compaq DOS 3.0}
  begin
    with Regs do begin
      AH := $34;
      MsDos(Regs);
      CompaqDOS30 := (BX = $19C);
    end;
  end;

  procedure ValidateDosVersion;
    {-Assure supported version of DOS and compute size of DOS internal filerec}
  var
    DosVer : Word;
  begin
    DosVer := DosVersion;
    case Lo(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 : FileRecSize := 59;
    else
      Abort('Requires DOS 3.x or 4.x');
    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('RELNET ', Version, ', by TurboPower Software');

  {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;

  {Find the block 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.');
  if MemMark then
    Abort('Marker must have been placed by NETMARK');

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

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

  {Open and validate the mark file}
  ValidateMarkFile;

  {$IFDEF ReleaseSocket}
  {Close IPX sockets}
  if IPXServicesAvail then
    CloseSockets;
  {$ENDIF}

  {Get file mark information into memory}
  ReadMarkFile;

  {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;

  {Update the watch block if requested}
  if UseWatch then
    if not Blocks[WatchBlock].ReleaseIt then
      {Watch itself won't be released}
      UpdateWatch(WatchBlock);

  {Release normal memory}
  ReleaseMem;

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

  {Write success message}
  WriteLn('Memory released above ', 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);

  Halt(ReturnCode);
end.