home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / EXECWS.ZIP / EXECWSWP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-11  |  6.7 KB  |  230 lines
  1. {
  2. Copyright (c) 1988,1990 TurboPower Software
  3. May be used freely as long as due credit is given
  4.  
  5. Version 1.1 - 3/15/89
  6.   save and restore EMS page map
  7. Version 1.2 - 3/29/89
  8.   add more compiler directives (far calls off, boolean short-circuiting)
  9.   add UseEmsIfAvailable to disable EMS usage when desired
  10. Version 1.3 - 5/02/89
  11.   fix problem with exit chain when InitExecSwap/ShutdownExecSwap called
  12.     more than once in a program
  13.   flush swap file before execing
  14. Version 1.4 - 10/11/89
  15.   created new PAS/ASM series called EXECWSWP (ExecWinWithSwap)
  16.   combines the features of EXECWIN and EXECSWAP
  17. Version 1.5 - 11/5/90
  18.   TP6 changes (since TP6 restores old int21 on SwapVectors)
  19.   fixed <Ctlr><Break> hang bug
  20. Version 1.5 - 8/07/92
  21.   Updated for TP7, real and protected mode
  22. Version 1.6 - 1/28/93
  23.   trap int 10 calls to support PKZIP 2.0
  24.   also fixes a problem with backspacing at DOS command line
  25. Version 1.7 - 2/11/93
  26.   trap int 29 calls to support PKZIP 2.0 and fast ANSI drivers
  27. }
  28.  
  29. {$IFDEF Dpmi}
  30.   !! ERROR - This code cannot be used in Protected mode !!
  31. {$ENDIF}
  32.  
  33. {$IFDEF Ver60}
  34.   {$DEFINE Heap6}
  35. {$ENDIF}
  36. {$IFDEF Ver70}
  37.   {$DEFINE Heap6}
  38. {$ENDIF}
  39.  
  40. {$R-,S-,F-,O-,I-,B-}
  41. unit ExecWSwp;
  42.   {-Memory-efficient Windowed DOS EXEC call}
  43.  
  44. interface
  45.  
  46. uses
  47.   Dos, OpDos;
  48.  
  49. const
  50.   UseEmsIfAvailable : Boolean = True;     {True to use EMS if available}
  51.   BytesSwapped : LongInt = 0;             {Bytes to swap to EMS/disk}
  52.   EmsAllocated : Boolean = False;         {True when EMS allocated for swap}
  53.   FileAllocated : Boolean = False;        {True when file allocated for swap}
  54.   NewInt10Addr : Pointer = nil;           {Filled in by InstallInt21}
  55.   NewInt21Addr : Pointer = nil;           {Filled in by InstallInt21}
  56.   NewInt29Addr : Pointer = nil;           {Filled in by InstallInt21}
  57.  
  58. function ExecWinWithSwap(Path, CmdLine : String;
  59.                          Xlo, Ylo, Xhi, Yhi : Byte;
  60.                          Attr : Byte) : Word;
  61.   {-Windowed DOS EXEC supporting swap to EMS or disk}
  62.  
  63. function InitExecSwap(LastToSave : Pointer; SwapFileName : String) : Boolean;
  64.   {-Initialize for swapping, returning TRUE if successful}
  65.  
  66. procedure ShutdownExecSwap;
  67.   {-Deallocate swap area}
  68.  
  69. function ExecWindow(Command : string; UseSecond : Boolean;
  70.                     Xlo, Ylo, Xhi, Yhi : Byte;
  71.                     Attr : Byte) : Integer;
  72.   {-Exec a program in a window}
  73.  
  74. implementation
  75.  
  76. var
  77.   EmsHandle : Word;               {Handle of EMS allocation block}
  78.   FrameSeg : Word;                {Segment of EMS page frame}
  79.   FileHandle : Word;              {DOS handle of swap file}
  80.   SwapName : String[80];          {ASCIIZ name of swap file}
  81.   SaveExit : Pointer;             {Exit chain pointer}
  82.  
  83.   WindPos : Word;
  84.   WindLo : Word;
  85.   WindHi : Word;
  86.   WindAttr : Byte;
  87.  
  88. {$IFDEF Heap6}
  89.   var
  90.     TmpInt21 : Pointer;
  91. {$ENDIF}
  92.  
  93. type
  94.   ByteCast =
  95.     record
  96.       LoB, HiB : Byte;
  97.     end;
  98.  
  99.   {$L EXECWSWP}
  100.   function ExecWinWithSwap(Path, CmdLine : String;
  101.                            Xlo, Ylo, Xhi, Yhi : Byte;
  102.                            Attr : Byte) : Word; external;
  103.   procedure FirstToSave; external;
  104.   function AllocateSwapFile : Boolean; external;
  105.   procedure DeallocateSwapFile; external;
  106.   procedure CheckCursor; external;
  107.   procedure InstallInt21; external;
  108.   procedure RestoreInt21; external;
  109.   procedure UpdateCsVars(Xlo, Ylo, Xhi, Yhi, Attr : Byte); external;
  110.  
  111.   {$F+}     {These routines could be interfaced for general use}
  112.   function EmsInstalled : Boolean; external;
  113.   function EmsPageFrame : Word; external;
  114.   function AllocateEmsPages(NumPages : Word) : Word; external;
  115.   procedure DeallocateEmsHandle(Handle : Word); external;
  116.   function DefaultDrive : Char; external;
  117.   function DiskFree(Drive : Byte) : LongInt; external;
  118.  
  119.   procedure ExecSwapExit;
  120.   begin
  121.     ExitProc := SaveExit;
  122.     ShutdownExecSwap;
  123.   end;
  124.   {$F-}
  125.  
  126.   procedure ShutdownExecSwap;
  127.   begin
  128.     if EmsAllocated then begin
  129.       DeallocateEmsHandle(EmsHandle);
  130.       EmsAllocated := False;
  131.     end else if FileAllocated then begin
  132.       DeallocateSwapFile;
  133.       FileAllocated := False;
  134.     end;
  135.   end;
  136.  
  137.   function PtrDiff(H, L : Pointer) : LongInt;
  138.   type
  139.     OS = record O, S : Word; end;   {Convenient typecast}
  140.   begin
  141.     PtrDiff := (LongInt(OS(H).S) shl 4+OS(H).O)-
  142.                (LongInt(OS(L).S) shl 4+OS(L).O);
  143.   end;
  144.  
  145.   function InitExecSwap(LastToSave : Pointer;
  146.                         SwapFileName : String) : Boolean;
  147.   const
  148.     EmsPageSize = 16384;            {Bytes in a standard EMS page}
  149.   var
  150.     PagesInEms : Word;              {Pages needed in EMS}
  151.     BytesFree : LongInt;            {Bytes free on swap file drive}
  152.     DriveChar : Char;               {Drive letter for swap file}
  153.   begin
  154.     InitExecSwap := False;
  155.  
  156.     if EmsAllocated or FileAllocated then
  157.       Exit;
  158.     BytesSwapped := PtrDiff(LastToSave, @FirstToSave);
  159.     if BytesSwapped <= 0 then
  160.       Exit;
  161.  
  162.     if UseEmsIfAvailable and EmsInstalled then begin
  163.       PagesInEms := (BytesSwapped+EmsPageSize-1) div EmsPageSize;
  164.       EmsHandle := AllocateEmsPages(PagesInEms);
  165.       if EmsHandle <> $FFFF then begin
  166.         EmsAllocated := True;
  167.         FrameSeg := EmsPageFrame;
  168.         if FrameSeg <> 0 then begin
  169.           InitExecSwap := True;
  170.           Exit;
  171.         end;
  172.       end;
  173.     end;
  174.     if Length(SwapFileName) <> 0 then begin
  175.       SwapName := SwapFileName+#0;
  176.       if Pos(':', SwapFileName) = 2 then
  177.         DriveChar := Upcase(SwapFileName[1])
  178.       else
  179.         DriveChar := DefaultDrive;
  180.       BytesFree := DiskFree(Byte(DriveChar)-$40);
  181.       FileAllocated := (BytesFree > BytesSwapped) and AllocateSwapFile;
  182.       if FileAllocated then
  183.         InitExecSwap := True;
  184.     end;
  185.   end;
  186.  
  187.   function ExecWindow(Command : string; UseSecond : Boolean;
  188.                       Xlo, Ylo, Xhi, Yhi : Byte;
  189.                       Attr : Byte) : Integer;
  190.     {-Exec a program in a window}
  191.   begin
  192.     {Validate window}
  193.     if (Xlo > Xhi) or (Ylo > Yhi) or (Xlo < 1) or (Ylo < 1) then begin
  194.       ExecWindow := 99;
  195.       Exit;
  196.     end;
  197.  
  198.     {Store global copies of window data for interrupt handler}
  199.     UpdateCsVars(Xlo, Ylo, Xhi, Yhi, Attr);
  200.  
  201.     {Assure cursor is in window}
  202.     CheckCursor;
  203.  
  204.     {Take over interrupt}
  205.     InstallInt21;
  206.  
  207.   {$IFDEF Heap6}
  208.     {Prevent SwapVectors from undoing our int21 change}
  209.     TmpInt21 := SaveInt21;
  210.     SaveInt21 := NewInt21Addr;
  211.   {$ENDIF}
  212.  
  213.     {Exec the program}
  214.     ExecWindow := ExecDos(Command, UseSecond, NoExecDosProc);
  215.  
  216.   {$IFDEF Heap6}
  217.     SaveInt21 := TmpInt21;
  218.   {$ENDIF}
  219.  
  220.     {Restore interrupt}
  221.     RestoreInt21;
  222.   end;
  223.  
  224. begin
  225.   SaveExit := ExitProc;
  226.   ExitProc := @ExecSwapExit;
  227. end.
  228.  
  229.  
  230.