Power-Programmierung/CD1.mdf/pascal/library/dos/dossys/execswap/execwswp.pas

Pascal/Delphi Source File | 1990-11-05 | 6.0 KB | 209 lines

{
Copyright (c) 1988,1990 TurboPower Software
May be used freely as long as due credit is given

Version 1.1 - 3/15/89
  save and restore EMS page map
Version 1.2 - 3/29/89
  add more compiler directives (far calls off, boolean short-circuiting)
  add UseEmsIfAvailable to disable EMS usage when desired
Version 1.3 - 5/02/89
  fix problem with exit chain when InitExecSwap/ShutdownExecSwap called
    more than once in a program
  flush swap file before execing
Version 1.4 - 10/11/89
  created new PAS/ASM series called EXECWSWP (ExecWinWithSwap)
  combines the features of EXECWIN and EXECSWAP
Version 1.5 - 11/5/90
  TP6 changes (to int21)
}

{$R-,S-,F-,O-,I-,B-}
unit ExecWSwp;
  {-Memory-efficient Windowed DOS EXEC call}

interface

uses
  Dos, OpDos;

const
  UseEmsIfAvailable : Boolean = True;     {True to use EMS if available}
  BytesSwapped : LongInt = 0;             {Bytes to swap to EMS/disk}
  EmsAllocated : Boolean = False;         {True when EMS allocated for swap}
  FileAllocated : Boolean = False;        {True when file allocated for swap}
  NewInt21Addr : Pointer = nil;           {Filled in by InstallInt21}

function ExecWinWithSwap(Path, CmdLine : String;
                         Xlo, Ylo, Xhi, Yhi : Byte;
                         Attr : Byte) : Word;
  {-Windowed DOS EXEC supporting swap to EMS or disk}

function InitExecSwap(LastToSave : Pointer; SwapFileName : String) : Boolean;
  {-Initialize for swapping, returning TRUE if successful}

procedure ShutdownExecSwap;
  {-Deallocate swap area}

function ExecWindow(Command : string; UseSecond : Boolean;
                    Xlo, Ylo, Xhi, Yhi : Byte;
                    Attr : Byte) : Integer;
  {-Exec a program in a window}

implementation

var
  EmsHandle : Word;               {Handle of EMS allocation block}
  FrameSeg : Word;                {Segment of EMS page frame}
  FileHandle : Word;              {DOS handle of swap file}
  SwapName : String[80];          {ASCIIZ name of swap file}
  SaveExit : Pointer;             {Exit chain pointer}

  WindPos : Word;
  WindLo : Word;
  WindHi : Word;
  WindAttr : Byte;

{$IFDEF Ver60}
  var
    TmpInt21 : Pointer;
{$ENDIF}

type
  ByteCast =
    record
      LoB, HiB : Byte;
    end;

  {$L EXECWSWP}
  function ExecWinWithSwap(Path, CmdLine : String;
                           Xlo, Ylo, Xhi, Yhi : Byte;
                           Attr : Byte) : Word; external;
  procedure FirstToSave; external;
  function AllocateSwapFile : Boolean; external;
  procedure DeallocateSwapFile; external;
  procedure CheckCursor; external;
  procedure InstallInt21; external;
  procedure RestoreInt21; external;
  procedure UpdateCsVars(Xlo, Ylo, Xhi, Yhi, Attr : Byte); external;

  {$F+}     {These routines could be interfaced for general use}
  function EmsInstalled : Boolean; external;
  function EmsPageFrame : Word; external;
  function AllocateEmsPages(NumPages : Word) : Word; external;
  procedure DeallocateEmsHandle(Handle : Word); external;
  function DefaultDrive : Char; external;
  function DiskFree(Drive : Byte) : LongInt; external;

  procedure ExecSwapExit;
  begin
    ExitProc := SaveExit;
    ShutdownExecSwap;
  end;
  {$F-}

  procedure ShutdownExecSwap;
  begin
    if EmsAllocated then begin
      DeallocateEmsHandle(EmsHandle);
      EmsAllocated := False;
    end else if FileAllocated then begin
      DeallocateSwapFile;
      FileAllocated := False;
    end;
  end;

  function PtrDiff(H, L : Pointer) : LongInt;
  type
    OS = record O, S : Word; end;   {Convenient typecast}
  begin
    PtrDiff := (LongInt(OS(H).S) shl 4+OS(H).O)-
               (LongInt(OS(L).S) shl 4+OS(L).O);
  end;

  function InitExecSwap(LastToSave : Pointer;
                        SwapFileName : String) : Boolean;
  const
    EmsPageSize = 16384;            {Bytes in a standard EMS page}
  var
    PagesInEms : Word;              {Pages needed in EMS}
    BytesFree : LongInt;            {Bytes free on swap file drive}
    DriveChar : Char;               {Drive letter for swap file}
  begin
    InitExecSwap := False;

    if EmsAllocated or FileAllocated then
      Exit;
    BytesSwapped := PtrDiff(LastToSave, @FirstToSave);
    if BytesSwapped <= 0 then
      Exit;

    if UseEmsIfAvailable and EmsInstalled then begin
      PagesInEms := (BytesSwapped+EmsPageSize-1) div EmsPageSize;
      EmsHandle := AllocateEmsPages(PagesInEms);
      if EmsHandle <> $FFFF then begin
        EmsAllocated := True;
        FrameSeg := EmsPageFrame;
        if FrameSeg <> 0 then begin
          InitExecSwap := True;
          Exit;
        end;
      end;
    end;
    if Length(SwapFileName) <> 0 then begin
      SwapName := SwapFileName+#0;
      if Pos(':', SwapFileName) = 2 then
        DriveChar := Upcase(SwapFileName[1])
      else
        DriveChar := DefaultDrive;
      BytesFree := DiskFree(Byte(DriveChar)-$40);
      FileAllocated := (BytesFree > BytesSwapped) and AllocateSwapFile;
      if FileAllocated then
        InitExecSwap := True;
    end;
  end;

  function ExecWindow(Command : string; UseSecond : Boolean;
                      Xlo, Ylo, Xhi, Yhi : Byte;
                      Attr : Byte) : Integer;
    {-Exec a program in a window}
  begin
    {Validate window}
    if (Xlo > Xhi) or (Ylo > Yhi) or (Xlo < 1) or (Ylo < 1) then begin
      ExecWindow := 99;
      Exit;
    end;

    {Store global copies of window data for interrupt handler}
    UpdateCsVars(Xlo, Ylo, Xhi, Yhi, Attr);

    {Assure cursor is in window}
    CheckCursor;

    {Take over interrupt}
    InstallInt21;

  {$IFDEF Ver60}
    {Prevent SwapVectors from undoing our int21 change}
    TmpInt21 := SaveInt21;
    SaveInt21 := NewInt21Addr;
  {$ENDIF}

    {Exec the program}
    ExecWindow := ExecDos(Command, UseSecond, NoExecDosProc);

  {$IFDEF Ver60}
    SaveInt21 := TmpInt21;
  {$ENDIF}

    {Restore interrupt}
    RestoreInt21;
  end;

begin
  SaveExit := ExitProc;
  ExitProc := @ExecSwapExit;
end.