+ added sysutils.pp to the i8086-msdos rtl

git-svn-id: trunk@24590 -

.gitattributes

@@ -8256,6 +8256,7 @@ rtl/msdos/sysheap.inc svneol=native#text/plain
 rtl/msdos/sysos.inc svneol=native#text/plain
 rtl/msdos/sysosh.inc svneol=native#text/plain
 rtl/msdos/system.pp svneol=native#text/plain
+rtl/msdos/sysutils.pp svneol=native#text/plain
 rtl/nativent/Makefile svneol=native#text/plain
 rtl/nativent/Makefile.fpc svneol=native#text/plain
 rtl/nativent/buildrtl.lpi svneol=native#text/plain

rtl/msdos/sysutils.pp

@@ -0,0 +1,882 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    member of the Free Pascal development team
+
+    Sysutils unit for Go32v2
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+{$inline on}
+
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{$MODESWITCH out}
+{ force ansistrings }
+{$H+}
+
+uses
+  {go32,}dos;
+
+{$DEFINE HAS_SLEEP}
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+implementation
+
+  uses
+    sysconst;
+
+{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
+{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+                              File Functions
+****************************************************************************}
+
+{ some internal constants }
+
+const
+   ofRead        = $0000;    { Open for reading }
+   ofWrite       = $0001;    { Open for writing }
+   ofReadWrite   = $0002;    { Open for reading/writing }
+   faFail        = $0000;    { Fail if file does not exist }
+   faCreate      = $0010;    { Create if file does not exist }
+   faOpen        = $0001;    { Open if file exists }
+   faOpenReplace = $0002;    { Clear if file exists }
+
+Type
+  PSearchrec = ^Searchrec;
+
+{  converts S to a pchar and copies it to the transfer-buffer.   }
+
+{procedure StringToTB(const S: string);
+var
+  P: pchar;
+  Len: integer;
+begin
+  Len := Length(S) + 1;
+  P := StrPCopy(StrAlloc(Len), S);
+  SysCopyToDos(longint(P), Len);
+  StrDispose(P);
+end ;}
+
+
+{  Native OpenFile function.
+   if return value <> 0 call failed.  }
+function OpenFile(const FileName: string; var Handle: THandle; Mode, Action: word): longint;
+var
+   Regs: registers;
+begin
+  result := 0;
+  Handle := UnusedHandle;
+//  StringToTB(FileName);
+  if LFNSupport then
+    begin
+      Regs.ax := $716c;                    { Use LFN Open/Create API }
+      Regs.dx := Action;                   { Action if file does/doesn't exist }
+      Regs.si := Ofs(PChar(FileName)^);
+      Regs.bx := $2000 + (Mode and $ff);   { File open mode }
+    end
+  else
+    begin
+      if (Action and $00f0) <> 0 then
+        Regs.ax := $3c00                   { Map to Create/Replace API }
+      else
+        Regs.ax := $3d00 + (Mode and $ff); { Map to Open_Existing API }
+      Regs.dx := Ofs(PChar(FileName)^);
+    end;
+  Regs.Ds := Seg(PChar(FileName)^);
+  Regs.cx := $20;                          { Attributes }
+  Intr($21, Regs);
+  if (Regs.Flags and fCarry) <> 0 then
+    result := Regs.Ax
+  else
+    Handle := Regs.Ax;
+end;
+
+
+Function FileOpen (Const FileName : string; Mode : Integer) : THandle;
+var
+  e: integer;
+Begin
+  e := OpenFile(FileName, result, Mode, faOpen);
+  if e <> 0 then
+    result := -1;
+end;
+
+
+Function FileCreate (Const FileName : String) : THandle;
+var
+  e: integer;
+begin
+  e := OpenFile(FileName, result, ofReadWrite, faCreate or faOpenReplace);
+  if e <> 0 then
+    result := -1;
+end;
+
+
+Function FileCreate (Const FileName : String; ShareMode:longint; Rights : longint) : THandle;
+begin
+  FileCreate:=FileCreate(FileName);
+end;
+
+
+Function FileCreate (Const FileName : String; Rights:longint) : THandle;
+begin
+  FileCreate:=FileCreate(FileName);
+end;
+
+
+Function FileRead (Handle : THandle; Out Buffer; Count : longint) : Longint;
+var
+  regs     : registers;
+  size,
+  readsize : longint;
+begin
+  readsize:=0;
+  while Count > 0 do
+   begin
+     if Count>65535 then
+      size:=65535
+     else
+      size:=Count;
+     regs.cx:=size;
+     regs.dx:=Ofs(Buffer);
+     regs.ds:=Seg(Buffer);
+     regs.bx:=Handle;
+     regs.ax:=$3f00;
+     Intr($21,regs);
+     if (regs.flags and fCarry) <> 0 then
+      begin
+        Result:=-1;
+        exit;
+      end;
+//     syscopyfromdos(Longint(dword(@Buffer)+readsize),lo(regs.realeax));
+     inc(readsize,regs.ax);
+     dec(Count,regs.ax);
+     { stop when not the specified size is read }
+     if regs.ax<size then
+      break;
+   end;
+  Result:=readsize;
+end;
+
+
+Function FileWrite (Handle : THandle; const Buffer; Count : Longint) : Longint;
+var
+  regs      : registers;
+  size,
+  writesize : longint;
+begin
+  writesize:=0;
+  while Count > 0 do
+   begin
+     if Count>65535 then
+      size:=65535
+     else
+      size:=Count;
+//     syscopytodos(Longint(dword(@Buffer)+writesize),size);
+     regs.cx:=size;
+     regs.dx:=Ofs(Buffer);
+     regs.ds:=Seg(Buffer);
+     regs.bx:=Handle;
+     regs.ax:=$4000;
+     Intr($21,regs);
+     if (regs.flags and fCarry) <> 0 then
+      begin
+        Result:=-1;
+        exit;
+      end;
+     inc(writesize,regs.ax);
+     dec(Count,regs.ax);
+     { stop when not the specified size is written }
+     if regs.ax<size then
+      break;
+   end;
+  Result:=WriteSize;
+end;
+
+
+Function FileSeek (Handle : THandle; FOffset, Origin : Longint) : Longint;
+var
+  Regs: registers;
+begin
+  Regs.ax := $4200;
+  Regs.Al := Origin;
+  Regs.dx := Lo(FOffset);
+  Regs.cx := Hi(FOffset);
+  Regs.bx := Handle;
+  Intr($21, Regs);
+  if Regs.Flags and fCarry <> 0 then
+     result := -1
+  else begin
+     LongRec(result).Lo := Regs.Ax;
+     LongRec(result).Hi := Regs.Dx;
+     end ;
+end;
+
+
+Function FileSeek (Handle : THandle; FOffset: Int64; Origin: Integer) : Int64;
+begin
+  {$warning need to add 64bit call }
+  FileSeek:=FileSeek(Handle,Longint(FOffset),Longint(Origin));
+end;
+
+
+Procedure FileClose (Handle : THandle);
+var
+  Regs: registers;
+begin
+  if Handle<=4 then
+   exit;
+  Regs.ax := $3e00;
+  Regs.bx := Handle;
+  Intr($21, Regs);
+end;
+
+
+Function FileTruncate (Handle: THandle; Size: Int64) : boolean;
+var
+  regs : registers;
+begin
+  if Size > high (longint) then
+   FileTruncate := false
+  else
+   begin
+    FileSeek(Handle,Size,0);
+    Regs.cx := 0;
+    Regs.dx := 0{tb_offset};
+    Regs.ds := 0{tb_segment};
+    Regs.bx := Handle;
+    Regs.ax:=$4000;
+    Intr($21, Regs);
+    FileTruncate:=(regs.flags and fCarry)=0;
+   end;
+end;
+
+
+Function FileAge (Const FileName : String): Longint;
+var Handle: longint;
+begin
+  Handle := FileOpen(FileName, 0);
+  if Handle <> -1 then
+   begin
+     result := FileGetDate(Handle);
+     FileClose(Handle);
+   end
+  else
+   result := -1;
+end;
+
+
+function FileExists (const FileName: string): boolean;
+var
+  L: longint;
+begin
+  if FileName = '' then
+   Result := false
+  else
+   begin
+    L := FileGetAttr (FileName);
+    Result := (L >= 0) and (L and (faDirectory or faVolumeID) = 0);
+(* Neither VolumeIDs nor directories are files. *)
+   end;
+end;
+
+
+Function DirectoryExists (Const Directory : String) : Boolean;
+Var
+  Dir : String;
+  drive : byte;
+  FADir, StoredIORes : longint;
+begin
+  Dir:=Directory;
+  if (length(dir)=2) and (dir[2]=':') and
+     ((dir[1] in ['A'..'Z']) or (dir[1] in ['a'..'z'])) then
+    begin
+      { We want to test GetCurDir }
+      if dir[1] in ['A'..'Z'] then
+        drive:=ord(dir[1])-ord('A')+1
+      else
+        drive:=ord(dir[1])-ord('a')+1;
+{$push}
+{$I-}
+      StoredIORes:=InOutRes;
+      InOutRes:=0;
+      GetDir(drive,dir);
+      if InOutRes <> 0 then
+        begin
+          InOutRes:=StoredIORes;
+          result:=false;
+          exit;
+        end;
+    end;
+{$pop}
+  if (Length (Dir) > 1) and
+    (Dir [Length (Dir)] in AllowDirectorySeparators) and
+(* Do not remove '\' after ':' (root directory of a drive)
+   or in '\\' (invalid path, possibly broken UNC path). *)
+     not (Dir [Length (Dir) - 1] in (AllowDriveSeparators + AllowDirectorySeparators)) then
+    dir:=copy(dir,1,length(dir)-1);
+(* FileGetAttr returns -1 on error *)
+  FADir := FileGetAttr (Dir);
+  Result := (FADir <> -1) and
+            ((FADir and faDirectory) = faDirectory);
+end;
+
+
+Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
+
+Var Sr : PSearchrec;
+
+begin
+  //!! Sr := New(PSearchRec);
+  getmem(sr,sizeof(searchrec));
+  Rslt.FindHandle := longint(Sr);
+  DOS.FindFirst(Path, Attr, Sr^);
+  result := -DosError;
+  if result = 0 then
+   begin
+     Rslt.Time := Sr^.Time;
+     Rslt.Size := Sr^.Size;
+     Rslt.Attr := Sr^.Attr;
+     Rslt.ExcludeAttr := 0;
+     Rslt.Name := Sr^.Name;
+   end ;
+end;
+
+
+Function FindNext (Var Rslt : TSearchRec) : Longint;
+var
+  Sr: PSearchRec;
+begin
+  Sr := PSearchRec(Rslt.FindHandle);
+  if Sr <> nil then
+   begin
+     DOS.FindNext(Sr^);
+     result := -DosError;
+     if result = 0 then
+      begin
+        Rslt.Time := Sr^.Time;
+        Rslt.Size := Sr^.Size;
+        Rslt.Attr := Sr^.Attr;
+        Rslt.ExcludeAttr := 0;
+        Rslt.Name := Sr^.Name;
+      end;
+   end;
+end;
+
+
+Procedure FindClose (Var F : TSearchrec);
+var
+  Sr: PSearchRec;
+begin
+  Sr := PSearchRec(F.FindHandle);
+  if Sr <> nil then
+    begin
+      //!! Dispose(Sr);
+      // This call is non dummy if LFNSupport is true PM
+      DOS.FindClose(SR^);
+      freemem(sr,sizeof(searchrec));
+    end;
+  F.FindHandle := 0;
+end;
+
+
+Function FileGetDate (Handle : THandle) : Longint;
+var
+  Regs: registers;
+begin
+  //!! for win95 an alternative function is available.
+  Regs.bx := Handle;
+  Regs.ax := $5700;
+  Intr($21, Regs);
+  if Regs.Flags and fCarry <> 0 then
+   result := -1
+  else
+   begin
+     LongRec(result).Lo := Regs.cx;
+     LongRec(result).Hi := Regs.dx;
+   end ;
+end;
+
+
+Function FileSetDate (Handle : THandle; Age : Longint) : Longint;
+var
+  Regs: registers;
+begin
+  Regs.bx := Handle;
+  Regs.ax := $5701;
+  Regs.cx := Lo(Age);
+  Regs.dx := Hi(Age);
+  Intr($21, Regs);
+  if Regs.Flags and fCarry <> 0 then
+   result := -Regs.Ax
+  else
+   result := 0;
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+var
+  Regs: registers;
+begin
+  Regs.dx := Ofs(PChar(FileName)^);
+  Regs.Ds := Seg(PChar(FileName)^);
+  if LFNSupport then
+   begin
+     Regs.Ax := $7143;
+     Regs.Bx := 0;
+   end
+  else
+   Regs.Ax := $4300;
+  Intr($21, Regs);
+  if Regs.Flags and fCarry <> 0 then
+    result := -1
+  else
+    result := Regs.Cx;
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+var
+  Regs: registers;
+begin
+  Regs.dx := Ofs(PChar(FileName)^);
+  Regs.Ds := Seg(PChar(FileName)^);
+  if LFNSupport then
+    begin
+      Regs.Ax := $7143;
+      Regs.Bx := 1;
+    end
+  else
+    Regs.Ax := $4301;
+  Regs.Cx := Attr;
+  Intr($21, Regs);
+  if Regs.Flags and fCarry <> 0 then
+   result := -Regs.Ax
+  else
+   result := 0;
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+var
+  Regs: registers;
+begin
+  Regs.dx := Ofs(PChar(FileName)^);
+  Regs.Ds := Seg(PChar(FileName)^);
+  if LFNSupport then
+    Regs.ax := $7141
+  else
+    Regs.ax := $4100;
+  Regs.si := 0;
+  Regs.cx := 0;
+  Intr($21, Regs);
+  result := (Regs.Flags and fCarry = 0);
+end;
+
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+var
+  Regs: registers;
+begin
+//  StringToTB(OldName + #0 + NewName);
+  Regs.dx := Ofs(PChar(OldName)^);
+  Regs.Ds := Seg(PChar(OldName)^);
+  Regs.di := Ofs(PChar(NewName)^);
+  Regs.Es := Seg(PChar(NewName)^);
+  if LFNSupport then
+    Regs.ax := $7156
+  else
+    Regs.ax := $5600;
+  Regs.cx := $ff;
+  Intr($21, Regs);
+  result := (Regs.Flags and fCarry = 0);
+end;
+
+
+{****************************************************************************
+                              Disk Functions
+****************************************************************************}
+
+TYPE  ExtendedFat32FreeSpaceRec=packed Record
+         RetSize           : WORD; { (ret) size of returned structure}
+         Strucversion      : WORD; {(call) structure version (0000h)
+                                    (ret) actual structure version (0000h)}
+         SecPerClus,               {number of sectors per cluster}
+         BytePerSec,               {number of bytes per sector}
+         AvailClusters,            {number of available clusters}
+         TotalClusters,            {total number of clusters on the drive}
+         AvailPhysSect,            {physical sectors available on the drive}
+         TotalPhysSect,            {total physical sectors on the drive}
+         AvailAllocUnits,          {Available allocation units}
+         TotalAllocUnits : DWORD;  {Total allocation units}
+         Dummy,Dummy2    : DWORD;  {8 bytes reserved}
+         END;
+
+function do_diskdata(drive : byte; Free : BOOLEAN) : Int64;
+VAR S    : String;
+    Rec  : ExtendedFat32FreeSpaceRec;
+    regs : registers;
+
+  procedure OldDosDiskData;
+  begin
+   regs.dl:=drive;
+   regs.ah:=$36;
+   msdos(regs);
+   if regs.ax<>$FFFF then
+    begin
+     if Free then
+      Do_DiskData:=int64(regs.ax)*regs.bx*regs.cx
+     else
+      Do_DiskData:=int64(regs.ax)*regs.cx*regs.dx;
+    end
+   else
+    do_diskdata:=-1;
+  end;
+
+BEGIN
+ { TODO: implement }
+ runerror(304);
+(* if LFNSupport then
+  begin
+   S:='C:\'#0;
+   if Drive=0 then
+    begin
+     GetDir(Drive,S);
+     Setlength(S,4);
+     S[4]:=#0;
+    end
+   else
+    S[1]:=chr(Drive+64);
+   Rec.Strucversion:=0;
+   Rec.RetSize := 0;
+   dosmemput(tb_segment,tb_offset,Rec,SIZEOF(ExtendedFat32FreeSpaceRec));
+   dosmemput(tb_segment,tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1,S[1],4);
+   regs.dx:=tb_offset+Sizeof(ExtendedFat32FreeSpaceRec)+1;
+   regs.ds:=tb_segment;
+   regs.di:=tb_offset;
+   regs.es:=tb_segment;
+   regs.cx:=Sizeof(ExtendedFat32FreeSpaceRec);
+   regs.ax:=$7303;
+   msdos(regs);
+   if (regs.flags and fcarry) = 0 then {No error clausule in int except cf}
+    begin
+     copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
+     if Rec.RetSize = 0 then *)(* Error - "FAT32" function not supported! *)
+(*      OldDosDiskData
+     else
+      if Free then
+       Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec
+      else
+       Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec;
+    end
+   else
+    OldDosDiskData;
+  end
+ else
+  OldDosDiskData;*)
+end;
+
+
+function diskfree(drive : byte) : int64;
+begin
+   diskfree:=Do_DiskData(drive,TRUE);
+end;
+
+
+function disksize(drive : byte) : int64;
+begin
+  disksize:=Do_DiskData(drive,false);
+end;
+
+
+Function GetCurrentDir : String;
+begin
+  GetDir(0, result);
+end;
+
+
+Function SetCurrentDir (Const NewDir : String) : Boolean;
+begin
+  {$I-}
+   ChDir(NewDir);
+  {$I+}
+  result := (IOResult = 0);
+end;
+
+
+Function CreateDir (Const NewDir : String) : Boolean;
+begin
+  {$I-}
+   MkDir(NewDir);
+  {$I+}
+  result := (IOResult = 0);
+end;
+
+
+Function RemoveDir (Const Dir : String) : Boolean;
+begin
+  {$I-}
+   RmDir(Dir);
+  {$I+}
+  result := (IOResult = 0);
+end;
+
+
+{****************************************************************************
+                              Time Functions
+****************************************************************************}
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+var
+  Regs: Registers;
+begin
+  Regs.ah := $2C;
+  Intr($21, Regs);
+  SystemTime.Hour := Regs.Ch;
+  SystemTime.Minute := Regs.Cl;
+  SystemTime.Second := Regs.Dh;
+  SystemTime.MilliSecond := Regs.Dl*10;
+  Regs.ah := $2A;
+  Intr($21, Regs);
+  SystemTime.Year := Regs.Cx;
+  SystemTime.Month := Regs.Dh;
+  SystemTime.Day := Regs.Dl;
+end ;
+
+
+{****************************************************************************
+                              Misc Functions
+****************************************************************************}
+
+procedure sysBeep;
+begin
+end;
+
+
+{****************************************************************************
+                              Locale Functions
+****************************************************************************}
+
+{  Codepage constants  }
+const
+   CP_US = 437;
+   CP_MultiLingual = 850;
+   CP_SlavicLatin2 = 852;
+   CP_Turkish = 857;
+   CP_Portugal = 860;
+   CP_IceLand = 861;
+   CP_Canada = 863;
+   CP_NorwayDenmark = 865;
+
+{  CountryInfo   }
+type
+   TCountryInfo = packed record
+      InfoId: byte;
+      case integer of
+         1: ( Size: word;
+              CountryId: word;
+              CodePage: word;
+              CountryInfo: array[0..33] of byte );
+         2: ( UpperCaseTable: longint );
+         4: ( FilenameUpperCaseTable: longint );
+         5: ( FilecharacterTable: longint );
+         6: ( CollatingTable: longint );
+         7: ( DBCSLeadByteTable: longint );
+   end ;
+
+
+procedure GetExtendedCountryInfo(InfoId: integer; CodePage, CountryId: word; var CountryInfo: TCountryInfo);
+
+Var Regs: Registers;
+
+begin
+  Regs.AH := $65;
+  Regs.AL := InfoId;
+  Regs.BX := CodePage;
+  Regs.DX := CountryId;
+  Regs.ES := {transfer_buffer div 16}Seg(CountryInfo);
+  Regs.DI := {transfer_buffer and 15}Ofs(CountryInfo);
+  Regs.CX := SizeOf(TCountryInfo);
+  Intr($21, Regs);
+{  DosMemGet(transfer_buffer div 16,
+            transfer_buffer and 15,
+            CountryInfo, Regs.CX );}
+end;
+
+
+procedure InitAnsi;
+var
+  CountryInfo: TCountryInfo; i: integer;
+begin
+  {  Fill table entries 0 to 127  }
+  for i := 0 to 96 do
+    UpperCaseTable[i] := chr(i);
+  for i := 97 to 122 do
+    UpperCaseTable[i] := chr(i - 32);
+  for i := 123 to 127 do
+    UpperCaseTable[i] := chr(i);
+  for i := 0 to 64 do
+    LowerCaseTable[i] := chr(i);
+  for i := 65 to 90 do
+    LowerCaseTable[i] := chr(i + 32);
+  for i := 91 to 255 do
+    LowerCaseTable[i] := chr(i);
+
+  {  Get country and codepage info  }
+  GetExtendedCountryInfo(1, $FFFF, $FFFF, CountryInfo);
+  if CountryInfo.CodePage = 850 then
+    begin
+    { Special, known case }
+    Move(CP850UCT, UpperCaseTable[128], 128);
+    Move(CP850LCT, LowerCaseTable[128], 128);
+    end
+  else
+    begin
+    { this needs to be checked !!
+    this is correct only if UpperCaseTable is
+    and Offset:Segment word record (PM) }
+    {  get the uppercase table from dosmemory  }
+    GetExtendedCountryInfo(2, $FFFF, $FFFF, CountryInfo);
+    { TODO: implement }
+//    DosMemGet(CountryInfo.UpperCaseTable shr 16, 2 + CountryInfo.UpperCaseTable and 65535, UpperCaseTable[128], 128);
+    for i := 128 to 255 do
+       begin
+       if UpperCaseTable[i] <> chr(i) then
+          LowerCaseTable[ord(UpperCaseTable[i])] := chr(i);
+       end;
+    end;
+end;
+
+
+Procedure InitInternational;
+begin
+  InitInternationalGeneric;
+  InitAnsi;
+end;
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+begin
+  Result:=Format(SUnknownErrorCode,[ErrorCode]);
+end;
+
+{****************************************************************************
+                              Os utils
+****************************************************************************}
+
+Function GetEnvironmentVariable(Const EnvVar : String) : String;
+
+begin
+  Result:=FPCGetEnvVarFromP(envp,EnvVar);
+end;
+
+Function GetEnvironmentVariableCount : Integer;
+
+begin
+  Result:=FPCCountEnvVar(EnvP);
+end;
+
+Function GetEnvironmentString(Index : Integer) : String;
+
+begin
+  Result:=FPCGetEnvStrFromP(Envp,Index);
+end;
+
+
+function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString;Flags:TExecuteFlags=[]):integer;
+var
+  e : EOSError;
+  CommandLine: AnsiString;
+
+begin
+  dos.exec_ansistring(path,comline);
+
+  if (Dos.DosError <> 0) then
+    begin
+      if ComLine <> '' then
+       CommandLine := Path + ' ' + ComLine
+      else
+       CommandLine := Path;
+      e:=EOSError.CreateFmt(SExecuteProcessFailed,[CommandLine,Dos.DosError]);
+      e.ErrorCode:=Dos.DosError;
+      raise e;
+    end;
+  Result := DosExitCode;
+end;
+
+
+function ExecuteProcess (const Path: AnsiString;
+                                  const ComLine: array of AnsiString;Flags:TExecuteFlags=[]): integer;
+
+var
+  CommandLine: AnsiString;
+  I: integer;
+
+begin
+  Commandline := '';
+  for I := 0 to High (ComLine) do
+   if Pos (' ', ComLine [I]) <> 0 then
+    CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
+   else
+    CommandLine := CommandLine + ' ' + Comline [I];
+  ExecuteProcess := ExecuteProcess (Path, CommandLine);
+end;
+
+
+{*************************************************************************
+                                   Sleep
+*************************************************************************}
+
+procedure Sleep (MilliSeconds: Cardinal);
+var
+  R: Registers;
+  T0, T1, T2: int64;
+  DayOver: boolean;
+begin
+(* Sleep is supposed to give up time slice - DOS Idle Interrupt chosen
+   because it should be supported in all DOS versions. Not precise at all,
+   though - the smallest step is 10 ms even in the best case. *)
+  R.AH := $2C;
+  Intr($21, R);
+  T0 := R.CH * 3600000 + R.CL * 60000 + R.DH * 1000 + R.DL * 10;
+  T2 := T0 + MilliSeconds;
+  DayOver := T2 > (24 * 3600000);
+  repeat
+    Intr ($28, R);
+(*    R.AH := $2C; - should be preserved. *)
+    Intr($21, R);
+    T1 := R.CH * 3600000 + R.CL * 60000 + R.DH * 1000 + R.DL * 10;
+    if DayOver and (T1 < T0) then
+     Inc (T1, 24 * 3600000);
+  until T1 >= T2;
+end;
+
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+Initialization
+  InitExceptions;       { Initialize exceptions. OS independent }
+  InitInternational;    { Initialize internationalization settings }
+  OnBeep:=@SysBeep;
+Finalization
+  DoneExceptions;
+end.