unit swap;

interface

uses DOS, Ems, WadDecl, Crt;

function ExecPrg    ( Command : string ) : byte;
function ExecCommand( Command : string ) : byte;

const SwapPath : string[ 80 ] = 'c:\';

      SwapErrOk       = 0;                     { no error, everything O.K. }
      SwapErrStore    = 1;      { Turbo Pascal program could not be stored }
      SwapErrNotFound = 2;                             { program not found }
      SwapErrNoAccess = 5;                      { access to program denied }
		SwapErrNoRAM    = 8;                             { not enough memory }

		AllowEMSswap:boolean = True;

implementation

{$L swapa}                                      { include assembler module }

function SwapOutAndExec( Command,
                         CmdPara : string;
                         ToDisk  : boolean;
                         Handle  : word;
                         Len     : longint ) : byte ; external;

function InitSwapa : word ; external;


var Len : longint;                          { number of bytes to be stored }

function NewExec( CmdLine, CmdPara : string ) : byte;

var Regs,                          { processor register for interrupt call }
	 Regs1    : Registers;
	 SwapFile : string[ 81 ];             { name of the temporary Swap-file }
	 ToDisk   : boolean;                 { store on disk or in EMS-memory ? }
	 Handle   : integer;                               { EMS or file handle }
	 Pages    : integer;                     { number of EMS pages required }

begin

  ToDisk := TRUE;                                          { store on disk }
  if AllowEMSswap then begin
	  if ( EmsInst ) then                                  { is EMS available? }
		 begin                                                            { Yes }
			Pages  := ( Len + 16383 ) div 16384;        { determine pages needed }
			Handle := EmsAlloc( Pages );                        { allocate pages }
			ToDisk := ( EmsError <> EmsErrOk );        { allocation successful ? }
			if not ToDisk then
			  EmsSaveMapping( Handle );                           { save mapping }
		 end;
  end;

  if ToDisk then                                    { store in EMS memory? }
	 begin                                                    { no, on disk }


		SwapFile := SwapPath;
		SwapFile[ byte(SwapFile[0]) + 1 ] := #0;{ conv. string to DOS format }
		Regs.AH := $5A;            { function number for "create temp. file" }
		Regs.CX := Hidden or SysFile;                       { file attribute }
		Regs.DS := seg( SwapFile );           { address of SwapPath to DS:DX }
		Regs.DX := ofs( SwapFile ) + 1;
		MsDos( Regs );                              { call DOS interrupt $21 }
		if ( Regs.Flags and FCarry = 0 ) then                 { file opened? }
		  Handle := Regs.AX                               { yes, note handle }
		else                            { no, terminate function prematurely }
		  begin
			 NewExec := SwapErrStore;   { error during storage of the program }
			 exit;                                       { terminate function }
		  end;
	 end;

	 SwapVectors;                                 { reset interrupt vectors }
    NewExec := SwapOutAndExec( CmdLine, CmdPara, ToDisk, Handle, Len );
    SwapVectors;                         { install Turbo-Int-Handler again }

    if ToDisk then                                { was it stored on disk? }
		begin                                                          { yes }

		  Regs1.AH := $3E;                { function number for "close file" }
		  Regs1.BX := Regs.AX;                         { load handle into BX }
		  MsDos( Regs1 );                           { call DOS interrupt $21 }
		  Regs.AH := $41;                 { function number for "erase file" }
		  MsDos( Regs );
		end
	 else                                       { no, storage in EMS memory }
		begin
		  EmsRestoreMapping( Handle );               { restore mapping again }
		  EmsFree( Handle );            { release allocated EMS memory again }
		end;
end;

function ExecCommand( Command : string ) : byte;

var ComSpec : string;                             { command processor path }

begin
  ComSpec := GetEnv( 'COMSPEC' );             { get command processor path }
  ExecCommand := NewExec( ComSpec, '/c'+ Command  ); { execute prg/command }
end;

function ExecPrg( Command : string ) : byte;

const Text_Sep : set of char = [ ' ',#9,'-','/','>','<',#0,'|' ];

var i        : integer;                           { index in source string }
	 CmdLine,                                             { accepts command }
	 Para     : string;                                 { accepts parameter }

begin

  CmdLine := '';                                        { clear the string }
  i := 1;               { begin with the first letter in the source string }
  while not ( (Command[i] in Text_Sep) or ( i > length( Command ) ) ) do
	 begin                                      { character is not Text_Sep }
		CmdLine := CmdLine + Command[ i ];                { accept in string }
		inc( i );                    { set I to next character in the string }
	 end;

  Para := '';                                      { no parameter detected }

  while (i<=length(Command)) and ( (Command[i]=#9) or (Command[i]=' ') ) do
	 inc( i );

  while i <= length( Command ) do
	 begin
		Para := Para + Command[ i ];
		inc( i );
	 end;

  ExecPrg := NewExec( CmdLine, Para );   { execute command through NewExec }
end;

var TempStr:string;

begin
  Len := ( longint(Seg(HeapEnd^)-(PrefixSeg+$10)) * 16 ) - (InitSwapa + (Ofs (HeapEnd^)));
  Str(Len, TempStr);
  {$IFDEF DFE}
  writeln('SysSwap_Init: Progam Swap Init '+TempStr);
  delay(300);
  Writeln('   HDD_Check: ',Hex_String(DiskFree(3)),'  ');
  IF DiskFree(3) < Len then begin
		writeln('   HDD_Check: Insufficient Drive Space for Init_Swap');
		halt(1);
  end;
  {$ENDIF}
end.