home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / EXCSWT.ZIP / EXECSWA2.PAS
Encoding:
Pascal/Delphi Source File  |  1989-04-27  |  4.7 KB  |  138 lines
  1. {
  2. Copyright (c) 1988 TurboPower Software
  3. May be used freely as long as due credit is given
  4. Version 1.1 - 3/15/89
  5.   save and restore EMS page map
  6. Version 1.2 - 3/29/89
  7.   add more compiler directives (far calls off, boolean short-circuiting)
  8.   add UseEmsIfAvailable to disable EMS usage when desired
  9. }
  10.  
  11. {
  12. Patch: Bill Burleigh | Rich Cromer | Azatar Microsystems
  13.  
  14.   LIM intensive applications may want to free up the memory used by the
  15.   ExecWithSwap function. The most logical approach is to execute the
  16.   InitExecSwap/ExecSwap/ShutdownExecSwap triplet. Our program hung when
  17.   we executed this triplet more than once because the ShutdownExecSwap
  18.   procedure did not restore Turbo's original exit procedure. We moved the
  19.   restoration from ExecSwapExit to ShutdownExecSwap. This allows users
  20.   to use the single initialization/exit procedure approach or the manual
  21.   init/swap/shutdown approach. We thought others might find this helpful.
  22. }
  23. {$R-,S-,F-,O-,I-,B-}
  24.  
  25. unit ExecSwap;
  26.   {-Memory-efficient DOS EXEC call}
  27. interface
  28.  
  29. const
  30.   UseEmsIfAvailable : Boolean = True;     {True to use EMS if available}
  31.   BytesSwapped : LongInt = 0;             {Bytes to swap to EMS/disk}
  32.   EmsAllocated : Boolean = False;         {True when EMS allocated for swap}
  33.   FileAllocated : Boolean = False;        {True when file allocated for swap}
  34.  
  35. function ExecWithSwap(Path, CmdLine : String) : Word;
  36.   {-DOS EXEC supporting swap to EMS or disk}
  37.  
  38. function InitExecSwap(LastToSave : Pointer; SwapFileName : String) : Boolean;
  39.   {-Initialize for swapping, returning TRUE if successful}
  40.  
  41. procedure ShutdownExecSwap;
  42.   {-Deallocate swap area}
  43.  
  44. implementation
  45.  
  46. var
  47.   EmsHandle : Word;               {Handle of EMS allocation block}
  48.   FrameSeg : Word;                {Segment of EMS page frame}
  49.   FileHandle : Word;              {DOS handle of swap file}
  50.   SwapName : String[80];          {ASCIIZ name of swap file}
  51.   SaveExit : Pointer;             {Exit chain pointer}
  52.  
  53.   {$L EXECSWAP}
  54.   function ExecWithSwap(Path, CmdLine : String) : Word; external;
  55.   procedure FirstToSave; external;
  56.   function AllocateSwapFile : Boolean; external;
  57.   procedure DeallocateSwapFile; external;
  58.  
  59.   {$F+}     {These routines could be interfaced for general use}
  60.   function EmsInstalled : Boolean; external;
  61.   function EmsPageFrame : Word; external;
  62.   function AllocateEmsPages(NumPages : Word) : Word; external;
  63.   procedure DeallocateEmsHandle(Handle : Word); external;
  64.   function DefaultDrive : Char; external;
  65.   function DiskFree(Drive : Byte) : LongInt; external;
  66.  
  67.   procedure ExecSwapExit;
  68.   begin
  69. (*   ExitProc := SaveExit;           <- moved to ShutdownExecSwap *)
  70.     ShutdownExecSwap;
  71.   end;
  72.   {$F-}
  73.  
  74.   procedure ShutdownExecSwap;
  75.   begin
  76.     ExitProc := SaveExit;         (* <- moved from ShutdownExecSwap *)
  77.     if EmsAllocated then begin
  78.       DeallocateEmsHandle(EmsHandle);
  79.       EmsAllocated := False;
  80.     end else if FileAllocated then begin
  81.       DeallocateSwapFile;
  82.       FileAllocated := False;
  83.     end;
  84.   end;
  85.  
  86.   function PtrDiff(H, L : Pointer) : LongInt;
  87.   type
  88.     OS = record O, S : Word; end;   {Convenient typecast}
  89.   begin
  90.     PtrDiff := (LongInt(OS(H).S) shl 4+OS(H).O)-
  91.                (LongInt(OS(L).S) shl 4+OS(L).O);
  92.   end;
  93.  
  94.   function InitExecSwap(LastToSave : Pointer;
  95.                         SwapFileName : String) : Boolean;
  96.   const
  97.     EmsPageSize = 16384;            {Bytes in a standard EMS page}
  98.   var
  99.     PagesInEms : Word;              {Pages needed in EMS}
  100.     BytesFree : LongInt;            {Bytes free on swap file drive}
  101.     DriveChar : Char;               {Drive letter for swap file}
  102.   begin
  103.     InitExecSwap := False;
  104.  
  105.     if EmsAllocated or FileAllocated then
  106.       Exit;
  107.     BytesSwapped := PtrDiff(LastToSave, @FirstToSave);
  108.     if BytesSwapped <= 0 then
  109.       Exit;
  110.     SaveExit := ExitProc;
  111.     ExitProc := @ExecSwapExit;
  112.  
  113.     if UseEmsIfAvailable and EmsInstalled then begin
  114.       PagesInEms := (BytesSwapped+EmsPageSize-1) div EmsPageSize;
  115.       EmsHandle := AllocateEmsPages(PagesInEms);
  116.       if EmsHandle <> $FFFF then begin
  117.         EmsAllocated := True;
  118.         FrameSeg := EmsPageFrame;
  119.         if FrameSeg <> 0 then begin
  120.           InitExecSwap := True;
  121.           Exit;
  122.         end;
  123.       end;
  124.     end;
  125.     if Length(SwapFileName) <> 0 then begin
  126.       SwapName := SwapFileName+#0;
  127.       if Pos(':', SwapFileName) = 2 then
  128.         DriveChar := Upcase(SwapFileName[1])
  129.       else
  130.         DriveChar := DefaultDrive;
  131.       BytesFree := DiskFree(Byte(DriveChar)-$40);
  132.       FileAllocated := (BytesFree > BytesSwapped) and AllocateSwapFile;
  133.       if FileAllocated then
  134.         InitExecSwap := True;
  135.     end;
  136.   end;
  137. end.
  138.