{$TITLE:'Implementation of DOS Interface Routines for Pascal'}
{$SYMTAB-}

{$INCLUDE:'DOSIF.INC'}

IMPLEMENTATION of DOSIF;

TYPE Register = record
	Case Boolean of
		true:		(L:byte; H:byte);
		false:	(X:word)
end;


VAR
	A,B,C,D,SI,DI  :  Register;
	erflag			:  boolean;		{DOS error flag}



Procedure DOSCALL(var error:boolean;
                  var A,B,C,D,SI,DI:Register); EXTERN;

{	ERROR is set true if the cary flag is set upon return from DOS    }
{	This may not indicate an error for all DOS calls; the manual      }
{	   (pg D-14) is typically vague on this.                          }
{	The caller must set the variables to the values required by DOS   }
{     in the registers for the call; A.H is the DOS function code.   }
{	All variables are returned with the register contents as          }
{     returned by DOS.	 }


PROCEDURE SetDTA;
var A,B,C,D : Register;
begin
	A.H := 16#1A;				{ DOS function code for "set DTA address"}
	D.X := DTABuffer;
	DOSCALL(erflag,A,B,C,D,SI,DI);
end;

PROCEDURE FindFirstFile;
begin
	SetDTA(WRD(ADR Directory));
	D.X := WRD(ADR FileSpec[1]);
	A.H := 16#4E;				{ DOS function for "find first filename" }
	DOSCALL(NoneFound,A,B,C,D,SI,DI);
	if NoneFound then Error := retype(integer,A.X)
	else Error := 0
end;


PROCEDURE FindNextFile;
begin
	SetDTA(WRD(ADR Directory));
	A.H := 16#4F;	{ DOS function for "find next filename" }
	DOSCALL(NoMore,A,B,C,D,SI,DI);
end;


	PROCEDURE Rename;
{Rename a file; OldName and NewName must be in ASCIIZ form.}
begin
	A.H := 16#56;
	D.X := WRD(ADR OldName[1]);
	DI.X := WRD(ADR NewName[1]);
	DOSCALL(erflag,A,B,C,D,SI,DI);
	if erflag then Error := retype(integer,A.X)
	else Error := 0
end;


	PROCEDURE Delete;
{Delete a file; Name is a full path name in ASCIIZ format.}
begin
	A.H := 16#41;
	D.X := WRD(ADR Name[1]);
	DOSCALL(erflag,A,B,C,D,SI,DI);
	if erflag then writeln('delete error');
	if erflag then Error := retype(integer,A.X)
	else Error := 0;
	writeln('delete error before return =',error);
end;


	PROCEDURE GetDirectory;
{Get the pathname of the current directory; drive = 0 for default, A = 1, etc.
 string does not contain drive letter or initial \; it is in ASCIIZ format}
{Dir must be at least 64 bytes long}
begin
	A.H := 16#47;
	D.X := WRD(Drive);
	SI.X := WRD(ADR Dir[1]);
	DOSCALL(erflag,A,B,C,D,SI,DI);
end;


	PROCEDURE Chdir;
{Changes the current directory; string is in ASCIIZ format.}
begin
	A.H := 16#3B;
	D.X := WRD(ADR Name[1]);
	DOSCALL(erflag,A,B,C,D,SI,DI);
	if erflag then Error := retype(integer,A.X)
	else Error := 0
end;


	PROCEDURE GetDiskSpace;
{Gets the number Kbytes on disk and number that are not used. 
 Drive = 0 for default, A = 1, etc.}

var temp:word;
begin
	A.H := 16#36;
	D.X := WRD(Drive);
	DOSCALL(erflag,A,B,C,D,SI,DI);
	if A.X = 16#FFFF then {error} TotalKB := 0
	else begin
		temp := (C.X * A.X) div 512;		{ number of 512 bytes per cluster }
		TotalKB := (D.X * temp) div 2;
		FreeKB := (B.X * temp) div 2;
	end
end;


	PROCEDURE CurrentDisk;
{Returns both the code (A = 0, B = 1, etc.) and letter (A,B, etc.)
 of the current default drive. Note that the code is offset by one from 
 scheme used in other DOS calls!}
begin
	A.H := 16#19;
	DOSCALL(erflag,A,B,C,D,SI,DI);
	A.H := 0;
	DiskCode := retype(integer,A.X);
	Drive := chr( ord('A') + DiskCode)
end;


	PROCEDURE GetTime;
{Beware of arithmetic overflow in calculations!}
begin
	A.H := 16#2C;
	DOSCALL(erflag,A,B,C,D,SI,DI);
	Hours := retype(integer,C.H);
	Minutes := retype(integer,C.L);
	Seconds := retype(integer,D.H)
end;


	FUNCTION DeltaSecs;
{Computes the number of seconds between two times. Times 2 must be
 later than Times 1.  It is possible to overflow DeltaSecs in one day.}

begin
	DeltaSecs := WRD( ( (H2-H1)*60 + (M2-M1)) * 60 + (S2-S1) );
end;


	FUNCTION InKey;
{Return next keystroke - char is echoed at current cursor position}
begin
	A.H := 16#1;
	DOSCALL(erflag,A,B,C,D,SI,DI);
	Inkey := chr( A.L );
end;


	FUNCTION CheckKey;
{True if key contains a char; else no char typed. Char is NOT echoed to screen}
begin
	A.H := 16#B;
	DOSCALL(erflag,A,B,C,D,SI,DI);
	CheckKey := (A.L <> 0);		{key is present if not = 0}
end;


	PROCEDURE ClearKey;
{Read all keys from keyboard buffer and throw out.}
begin
	while CheckKey do begin
		A.H := 16#8;				 {read without echo}
		DOSCALL(erflag,A,B,C,D,SI,DI)
	end;
end;


BEGIN
END.                  {END OF IMPLEMENTATION OF DOS INTERFACE}