home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBII / ECO_SWAP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-08  |  3.4 KB  |  121 lines
  1. {$R-,S-,F-,O-,I-,B-}
  2.  
  3. unit eco_swap;
  4.  
  5. interface
  6.  
  7. const
  8.   swaploc : array[boolean] of string[7] = ('on disk', 'in EMS');
  9.  
  10.   useemsifavailable : boolean =  true;
  11.   bytesswapped      : longint =     0;   
  12.   emsallocated      : boolean = false; 
  13.   fileallocated     : boolean = false; 
  14.  
  15.  
  16.   
  17.   function execwithswap(path, cmdline: string): word;
  18.   function initexecswap(lasttosave: pointer; swapfilename: string): boolean;
  19.   procedure shutdownexecswap;
  20.  
  21.  
  22.  
  23.  
  24. implementation
  25.  
  26.  
  27.  
  28. var
  29.   emshandle : word;               {handle of ems allocation block}
  30.   frameseg : word;                {segment of ems page frame}
  31.   filehandle : word;              {dos handle of swap file}
  32.   swapname : string[80];          {asciiz name of swap file}
  33.   saveexit : pointer;             {exit chain pointer}
  34.  
  35.   {$L eco_swap}
  36.   function execwithswap(path, cmdline : string) : word; external;
  37.   procedure firsttosave; external;
  38.   function allocateswapfile : boolean; external;
  39.   procedure deallocateswapfile; external;
  40.  
  41.   {$F+}     {These routines could be interfaced for general use}
  42.   function emsinstalled : boolean; external;
  43.   function emspageframe : word; external;
  44.   function allocateemspages(numpages : word) : word; external;
  45.   procedure deallocateemshandle(handle : word); external;
  46.   function defaultdrive : char; external;
  47.   function diskfree(drive : byte) : longint; external;
  48.  
  49.   procedure execswapexit;
  50.   begin
  51.     exitproc := saveexit;
  52.     shutdownexecswap;
  53.   end;
  54.   {$F-}
  55.  
  56.   procedure shutdownexecswap;
  57.   begin
  58.     if emsallocated then begin
  59.       deallocateemshandle(emshandle);
  60.       emsallocated := false;
  61.     end else if fileallocated then begin
  62.       deallocateswapfile;
  63.       fileallocated := false;
  64.     end;
  65.   end;
  66.  
  67.   function ptrdiff(h, l : pointer) : longint;
  68.   type
  69.     os = record o, s : word; end;   {convenient typecast}
  70.   begin
  71.     ptrdiff := (longint(os(h).s) shl 4+os(h).o)-
  72.                (longint(os(l).s) shl 4+os(l).o);
  73.   end;
  74.  
  75.   function initexecswap(lasttosave : pointer;
  76.                         swapfilename : string) : boolean;
  77.   const
  78.     emspagesize = 16384;            {bytes in a standard ems page}
  79.   var
  80.     pagesinems : word;              {pages needed in ems}
  81.     bytesfree : longint;            {bytes free on swap file drive}
  82.     drivechar : char;               {drive letter for swap file}
  83.   begin
  84.     initexecswap := false;
  85.  
  86.     if emsallocated or fileallocated then
  87.       exit;
  88.     bytesswapped := ptrdiff(lasttosave, @firsttosave);
  89.     if bytesswapped <= 0 then
  90.       exit;
  91.  
  92.     if useemsifavailable and emsinstalled then begin
  93.       pagesinems := (bytesswapped+emspagesize-1) div emspagesize;
  94.       emshandle := allocateemspages(pagesinems);
  95.       if emshandle <> $ffff then begin
  96.         emsallocated := true;
  97.         frameseg := emspageframe;
  98.         if frameseg <> 0 then begin
  99.           initexecswap := true;
  100.           exit;
  101.         end;
  102.       end;
  103.     end;
  104.     if length(swapfilename) <> 0 then begin
  105.       swapname := swapfilename+#0;
  106.       if pos(':', swapfilename) = 2 then
  107.         drivechar := upcase(swapfilename[1])
  108.       else
  109.         drivechar := defaultdrive;
  110.       bytesfree := diskfree(byte(drivechar)-$40);
  111.       fileallocated := (bytesfree > bytesswapped) and allocateswapfile;
  112.       if fileallocated then
  113.         initexecswap := true;
  114.     end;
  115.   end;
  116.  
  117. begin
  118.   saveexit := exitproc;
  119.   exitproc := @execswapexit;
  120. end. { originally written by Dr. Dobbs Journal }
  121.