* sysutils.pp moved to target and merged with disk.inc, filutil.inc

rtl/go32v2/Makefile

@@ -1,5 +1,5 @@
 #
-# Makefile generated by fpcmake v0.99.15 [2000/07/02]
+# Makefile generated by fpcmake v1.00 [2000/08/14]
 #
 
 defaultrule: all
@@ -926,7 +926,7 @@ ifdef INSTALLPPUFILES
 ifdef PPUFILES
 INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
 else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
+INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))))
 endif
 endif
 
@@ -1091,7 +1091,7 @@ ifdef CLEANPPUFILES
 ifdef PPUFILES
 CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
 else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
+CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))))
 endif
 endif
 
@@ -1271,9 +1271,9 @@ graph$(PPUEXT) : graph.pp go32$(PPUEXT) ports$(PPUEXT) $(SYSTEMPPU) \
 # Delphi Compatible Units
 #
 
-sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
-		    filutil.inc disk.inc objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT)
-	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
+		    objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT)
+	$(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR)
 
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
 	$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)

rtl/go32v2/Makefile.fpc

@@ -143,9 +143,9 @@ graph$(PPUEXT) : graph.pp go32$(PPUEXT) ports$(PPUEXT) $(SYSTEMPPU) \
 # Delphi Compatible Units
 #
 
-sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
-                    filutil.inc disk.inc objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT)
-        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
+                    objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT)
+        $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR)
 
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
         $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)

rtl/go32v2/disk.inc

@@ -1,143 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    Disk functions from Delphi's sysutils.pas
-
-    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.
-
- **********************************************************************}
-
-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;
-BEGIN
- if (swap(dosversion)>=$070A) AND LFNSupport then
-  begin
-   DosError:=0;
-   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;
-   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.ax<>$ffff then
-    begin
-      copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
-      if Free then
-       Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec
-      else
-       Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec;
-    end
-   else
-    Do_DiskData:=-1;
-  end
- else
-  begin
-   DosError:=0;
-   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;
-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);
-  result := (IOResult = 0);
-  {$I+}
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-  MkDir(NewDir);
-  result := (IOResult = 0);
-  {$I+}
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-  RmDir(Dir);
-  result := (IOResult = 0);
-  {$I+}
-end;
-
-
-{
-  $Log$
-  Revision 1.3  2000-07-14 10:33:09  michael
-  + Conditionals fixed
-
-  Revision 1.2  2000/07/13 11:33:39  michael
-  + removed logs
- 
-}

rtl/go32v2/filutil.inc

@@ -1,466 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    File utility calls
-
-    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.
-
- **********************************************************************}
-
-{******************************************************************************}
-{ private 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 }
-
-
-{  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: longint; Mode, Action: word): longint;
-var
-   Regs: registers;
-begin
-result := 0;
-Handle := 0;
-StringToTB(FileName);
-if LFNSupport then Regs.Eax:=$716c
-else Regs.Eax:=$6c00;
-Regs.Edx := Action;                   { Action if file exists/not exists }
-Regs.Ds := tb_segment;
-Regs.Esi := tb_offset;
-Regs.Ebx := $2000 + (Mode and $ff);   { file open mode }
-Regs.Ecx := $20;                      { Attributes }
-RealIntr($21, Regs);
-if Regs.Flags and CarryFlag <> 0 then result := Regs.Ax
-else Handle := Regs.Ax;
-end ;
-
-{******************************************************************************}
-{ Public functions                                                             }
-{******************************************************************************}
-
-
-Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
-var e: integer;
-Begin
-e := OpenFile(FileName, result, Mode, faOpen);
-if e <> 0 then result := -1;
-end ;
-
-
-Function FileCreate (Const FileName : String) : Longint;
-var e: integer;
-begin
-e := OpenFile(FileName, result, ofReadWrite, faCreate or faOpenReplace);
-if e <> 0 then result := -1;
-end;
-
-
-Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
-begin
-result := Do_Read(Handle, longint(@Buffer), Count);
-end;
-
-
-Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
-begin
-result := Do_Write(Handle, longint(@Buffer), Count);
-end;
-
-
-Function FileSeek (Handle, FOffset, Origin : Longint) : Longint;
-var Regs: registers;
-begin
-Regs.Eax := $4200;
-Regs.Al := Origin;
-Regs.Edx := Lo(FOffset);
-Regs.Ecx := Hi(FOffset);
-Regs.Ebx := Handle;
-RealIntr($21, Regs);
-if Regs.Flags and CarryFlag <> 0 then
-   result := -1
-else begin
-   LongRec(result).Lo := Regs.Ax;
-   LongRec(result).Hi := Regs.Dx;
-   end ;
-end;
-
-
-Procedure FileClose (Handle : Longint);
-var Regs: registers;
-begin
-  if Handle<=4 then
-   exit;
-Regs.Eax := $3e00;
-Regs.Ebx := Handle;
-RealIntr($21, Regs);
-end;
-
-Function FileTruncate (Handle,Size: Longint) : boolean;
-var
-  regs : trealregs;
-begin
-  FileSeek(Handle,Size,0);
-  Regs.realecx := 0;
-  Regs.realedx := tb_offset;
-  Regs.ds := tb_segment;
-  Regs.ebx := Handle;
-  Regs.eax:=$4000;
-  RealIntr($21, Regs);
-  FileTruncate:=(regs.realflags and carryflag)=0;
-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 Handle: longint;
-begin
-  //!!   This can be done quicker, need to find out how
-Result := (OpenFile(FileName, Handle, ofRead, faOpen) = 0);
-if Handle <> 0 then
-   FileClose(Handle);
-end;
-
-Type PSearchrec = ^Searchrec;
-
-
-Function FindFirst (Const Path : String; Attr : Longint; Var 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 : Longint) : Longint;
-var Regs: registers;
-begin
-  //!! for win95 an alternative function is available.
-Regs.Ebx := Handle;
-Regs.Eax := $5700;
-RealIntr($21, Regs);
-if Regs.Flags and CarryFlag <> 0 then result := -1
-else begin
-   LongRec(result).Lo := Regs.cx;
-   LongRec(result).Hi := Regs.dx;
-   end ;
-end;
-
-
-Function FileSetDate (Handle, Age : Longint) : Longint;
-var Regs: registers;
-begin
-Regs.Ebx := Handle;
-Regs.Eax := $5701;
-Regs.Ecx := Lo(Age);
-Regs.Edx := Hi(Age);
-RealIntr($21, Regs);
-if Regs.Flags and CarryFlag <> 0 then result := -Regs.Ax
-else result := 0;
-end;
-
-
-Function FileGetAttr (Const FileName : String) : Longint;
-
-var Regs: registers;
-
-begin
-  StringToTB(FileName);
-  Regs.Edx := tb_offset;
-  Regs.Ds := tb_segment;
-  if LFNSupport then
-    begin
-    Regs.Ax := $7143;
-    Regs.Bx := 0;
-    end
-  else
-    Regs.Ax := $4300;
-  RealIntr($21, Regs);
-  if Regs.Flags and CarryFlag <> 0 then
-    result := -1
-  else
-    result := Regs.Cx;
-end;
-
-
-Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
-
-var Regs: registers;
-
-begin
-  StringToTB(FileName);
-  Regs.Edx := tb_offset;
-  Regs.Ds := tb_segment;
-  if LFNSupport then
-    begin
-    Regs.Ax := $7143;
-    Regs.Bx := 1;
-    end
-  else
-    Regs.Ax := $4301;
-  Regs.Cx := Attr;
-  RealIntr($21, Regs);
-  if Regs.Flags and CarryFlag <> 0 then result := -Regs.Ax
-  else result := 0;
-end;
-
-
-Function DeleteFile (Const FileName : String) : Boolean;
-
-var Regs: registers;
-
-begin
-  StringToTB(FileName);
-  Regs.Edx := tb_offset;
-  Regs.Ds := tb_segment;
-  if LFNSupport then
-    Regs.Eax := $7141
-  else
-    Regs.Eax := $4100;
-  Regs.Esi := 0;
-  Regs.Ecx := 0;
-  RealIntr($21, Regs);
-  result := (Regs.Flags and CarryFlag = 0);
-end;
-
-
-Function RenameFile (Const OldName, NewName : String) : Boolean;
-
-var Regs: registers;
-
-begin
-  StringToTB(OldName + #0 + NewName);
-  Regs.Edx := tb_offset;
-  Regs.Ds := tb_segment;
-  Regs.Edi := tb_offset + Length(OldName) + 1;
-  Regs.Es := tb_segment;
-  if LFNSupport then
-    Regs.Eax := $7156
-  else
-    Regs.Eax := $5600;
-  Regs.Ecx := $ff;
-  RealIntr($21, Regs);
-  result := (Regs.Flags and CarryFlag = 0);
-end;
-
-
-Function FileSearch (Const Name, DirList : String) : String;
-
-begin
-  result := DOS.FSearch(Name, DirList);
-end;
-
-Procedure GetLocalTime(var SystemTime: TSystemTime);
-
-var Regs: Registers;
-
-begin
-Regs.ah := $2C;
-RealIntr($21, Regs);
-SystemTime.Hour := Regs.Ch;
-SystemTime.Minute := Regs.Cl;
-SystemTime.Second := Regs.Dh;
-SystemTime.MilliSecond := Regs.Dl;
-Regs.ah := $2A;
-RealIntr($21, Regs);
-SystemTime.Year := Regs.Cx;
-SystemTime.Month := Regs.Dh;
-SystemTime.Day := Regs.Dl;
-end ;
-
-{ ---------------------------------------------------------------------
-    Internationalization settings
-  ---------------------------------------------------------------------}
-
-
-{  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;
-  Regs.DI := transfer_buffer and 15;
-  Regs.CX := SizeOf(TCountryInfo);
-  RealIntr($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);
-  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;
-
-{ This routine is called by the unit startup code. }
-
-begin
-  { Init upper/lowercase tables }
-  InitAnsi
-end;
-
-{
-  $Log$
-  Revision 1.2  2000-07-13 11:33:40  michael
-  + removed logs
- 
-}

rtl/go32v2/sysutils.pp

@@ -0,0 +1,641 @@
+{
+    $Id$
+    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.
+
+ **********************************************************************}
+unit sysutils;
+interface
+
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses
+  go32,dos;
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+implementation
+
+{ 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: longint; Mode, Action: word): longint;
+var
+   Regs: registers;
+begin
+  result := 0;
+  Handle := 0;
+  StringToTB(FileName);
+  if LFNSupport then Regs.Eax:=$716c
+  else Regs.Eax:=$6c00;
+  Regs.Edx := Action;                   { Action if file exists/not exists }
+  Regs.Ds := tb_segment;
+  Regs.Esi := tb_offset;
+  Regs.Ebx := $2000 + (Mode and $ff);   { file open mode }
+  Regs.Ecx := $20;                      { Attributes }
+  RealIntr($21, Regs);
+  if Regs.Flags and CarryFlag <> 0 then result := Regs.Ax
+  else Handle := Regs.Ax;
+end ;
+
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+var
+  e: integer;
+Begin
+  e := OpenFile(FileName, result, Mode, faOpen);
+  if e <> 0 then
+    result := -1;
+end;
+
+
+Function FileCreate (Const FileName : String) : Longint;
+var
+  e: integer;
+begin
+  e := OpenFile(FileName, result, ofReadWrite, faCreate or faOpenReplace);
+  if e <> 0 then
+    result := -1;
+end;
+
+
+Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
+begin
+  result := Do_Read(Handle, longint(@Buffer), Count);
+end;
+
+
+Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
+begin
+  result := Do_Write(Handle, longint(@Buffer), Count);
+end;
+
+
+Function FileSeek (Handle, FOffset, Origin : Longint) : Longint;
+var
+  Regs: registers;
+begin
+  Regs.Eax := $4200;
+  Regs.Al := Origin;
+  Regs.Edx := Lo(FOffset);
+  Regs.Ecx := Hi(FOffset);
+  Regs.Ebx := Handle;
+  RealIntr($21, Regs);
+  if Regs.Flags and CarryFlag <> 0 then
+     result := -1
+  else begin
+     LongRec(result).Lo := Regs.Ax;
+     LongRec(result).Hi := Regs.Dx;
+     end ;
+end;
+
+
+Procedure FileClose (Handle : Longint);
+var
+  Regs: registers;
+begin
+  if Handle<=4 then
+   exit;
+  Regs.Eax := $3e00;
+  Regs.Ebx := Handle;
+  RealIntr($21, Regs);
+end;
+
+
+Function FileTruncate (Handle,Size: Longint) : boolean;
+var
+  regs : trealregs;
+begin
+  FileSeek(Handle,Size,0);
+  Regs.realecx := 0;
+  Regs.realedx := tb_offset;
+  Regs.ds := tb_segment;
+  Regs.ebx := Handle;
+  Regs.eax:=$4000;
+  RealIntr($21, Regs);
+  FileTruncate:=(regs.realflags and carryflag)=0;
+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 Handle: longint;
+begin
+  //!!   This can be done quicker, need to find out how
+  Result := (OpenFile(FileName, Handle, ofRead, faOpen) = 0);
+  if Handle <> 0 then
+    FileClose(Handle);
+end;
+
+
+Function FindFirst (Const Path : String; Attr : Longint; Var 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 : Longint) : Longint;
+var
+  Regs: registers;
+begin
+  //!! for win95 an alternative function is available.
+  Regs.Ebx := Handle;
+  Regs.Eax := $5700;
+  RealIntr($21, Regs);
+  if Regs.Flags and CarryFlag <> 0 then
+   result := -1
+  else
+   begin
+     LongRec(result).Lo := Regs.cx;
+     LongRec(result).Hi := Regs.dx;
+   end ;
+end;
+
+
+Function FileSetDate (Handle, Age : Longint) : Longint;
+var
+  Regs: registers;
+begin
+  Regs.Ebx := Handle;
+  Regs.Eax := $5701;
+  Regs.Ecx := Lo(Age);
+  Regs.Edx := Hi(Age);
+  RealIntr($21, Regs);
+  if Regs.Flags and CarryFlag <> 0 then
+   result := -Regs.Ax
+  else
+   result := 0;
+end;
+
+
+Function FileGetAttr (Const FileName : String) : Longint;
+var
+  Regs: registers;
+begin
+  StringToTB(FileName);
+  Regs.Edx := tb_offset;
+  Regs.Ds := tb_segment;
+  if LFNSupport then
+   begin
+     Regs.Ax := $7143;
+     Regs.Bx := 0;
+   end
+  else
+   Regs.Ax := $4300;
+  RealIntr($21, Regs);
+  if Regs.Flags and CarryFlag <> 0 then
+    result := -1
+  else
+    result := Regs.Cx;
+end;
+
+
+Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
+var
+  Regs: registers;
+begin
+  StringToTB(FileName);
+  Regs.Edx := tb_offset;
+  Regs.Ds := tb_segment;
+  if LFNSupport then
+    begin
+      Regs.Ax := $7143;
+      Regs.Bx := 1;
+    end
+  else
+    Regs.Ax := $4301;
+  Regs.Cx := Attr;
+  RealIntr($21, Regs);
+  if Regs.Flags and CarryFlag <> 0 then
+   result := -Regs.Ax
+  else
+   result := 0;
+end;
+
+
+Function DeleteFile (Const FileName : String) : Boolean;
+var
+  Regs: registers;
+begin
+  StringToTB(FileName);
+  Regs.Edx := tb_offset;
+  Regs.Ds := tb_segment;
+  if LFNSupport then
+    Regs.Eax := $7141
+  else
+    Regs.Eax := $4100;
+  Regs.Esi := 0;
+  Regs.Ecx := 0;
+  RealIntr($21, Regs);
+  result := (Regs.Flags and CarryFlag = 0);
+end;
+
+
+Function RenameFile (Const OldName, NewName : String) : Boolean;
+var
+  Regs: registers;
+begin
+  StringToTB(OldName + #0 + NewName);
+  Regs.Edx := tb_offset;
+  Regs.Ds := tb_segment;
+  Regs.Edi := tb_offset + Length(OldName) + 1;
+  Regs.Es := tb_segment;
+  if LFNSupport then
+    Regs.Eax := $7156
+  else
+    Regs.Eax := $5600;
+  Regs.Ecx := $ff;
+  RealIntr($21, Regs);
+  result := (Regs.Flags and CarryFlag = 0);
+end;
+
+
+Function FileSearch (Const Name, DirList : String) : String;
+begin
+  result := DOS.FSearch(Name, DirList);
+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;
+BEGIN
+ if (swap(dosversion)>=$070A) AND LFNSupport then
+  begin
+   DosError:=0;
+   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;
+   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.ax<>$ffff then
+    begin
+      copyfromdos(rec,Sizeof(ExtendedFat32FreeSpaceRec));
+      if Free then
+       Do_DiskData:=int64(rec.AvailAllocUnits)*rec.SecPerClus*rec.BytePerSec
+      else
+       Do_DiskData:=int64(rec.TotalAllocUnits)*rec.SecPerClus*rec.BytePerSec;
+    end
+   else
+    Do_DiskData:=-1;
+  end
+ else
+  begin
+   DosError:=0;
+   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;
+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;
+  RealIntr($21, Regs);
+  SystemTime.Hour := Regs.Ch;
+  SystemTime.Minute := Regs.Cl;
+  SystemTime.Second := Regs.Dh;
+  SystemTime.MilliSecond := Regs.Dl;
+  Regs.ah := $2A;
+  RealIntr($21, Regs);
+  SystemTime.Year := Regs.Cx;
+  SystemTime.Month := Regs.Dh;
+  SystemTime.Day := Regs.Dl;
+end ;
+
+
+{****************************************************************************
+                              Misc Functions
+****************************************************************************}
+
+procedure Beep;
+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;
+  Regs.DI := transfer_buffer and 15;
+  Regs.CX := SizeOf(TCountryInfo);
+  RealIntr($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);
+    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
+  InitAnsi;
+end;
+
+
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+Initialization
+  InitExceptions;       { Initialize exceptions. OS independent }
+  InitInternational;    { Initialize internationalization settings }
+Finalization
+  OutOfMemory.Free;
+  InValidPointer.Free;
+end.
+{
+  $Log$
+  Revision 1.2  2000-08-20 15:46:46  peter
+    * sysutils.pp moved to target and merged with disk.inc, filutil.inc
+
+}

rtl/linux/Makefile

@@ -1,5 +1,5 @@
 #
-# Makefile generated by fpcmake v1.00 [2000/07/11]
+# Makefile generated by fpcmake v1.00 [2000/08/14]
 #
 
 defaultrule: all
@@ -928,7 +928,7 @@ ifdef INSTALLPPUFILES
 ifdef PPUFILES
 INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
 else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
+INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))))
 endif
 endif
 
@@ -1093,7 +1093,7 @@ ifdef CLEANPPUFILES
 ifdef PPUFILES
 CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
 else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
+CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))))
 endif
 endif
 
@@ -1251,7 +1251,7 @@ ports$(PPUEXT) : ports.pp linux$(PPUEXT) objpas$(PPUEXT)
 
 dl$(PPUEXT) : dl.pp
 
-dynlibs$(PPUEXT) : $(INC)/dynlibs.pp dynlibs.inc dl$(PPUEXT)
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
 
 
 #
@@ -1285,9 +1285,9 @@ ggigraph$(PPUEXT) : ggigraph.pp linux$(PPUEXT) $(SYSTEMPPU) \
 # Delphi Compatible Units
 #
 
-sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
 		    filutil.inc disk.inc objpas$(PPUEXT) linux$(PPUEXT)
-	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR)
+	$(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR)
 
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
 	$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)

rtl/linux/Makefile.fpc

@@ -166,9 +166,9 @@ ggigraph$(PPUEXT) : ggigraph.pp linux$(PPUEXT) $(SYSTEMPPU) \
 # Delphi Compatible Units
 #
 
-sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
                     filutil.inc disk.inc objpas$(PPUEXT) linux$(PPUEXT)
-        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR)
+        $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR)
 
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
         $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)

rtl/linux/disk.inc

@@ -1,120 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    Disk functions from Delphi's sysutils.pas
-
-    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.
-
- **********************************************************************}
-
-{
-  The Diskfree and Disksize functions need a file on the specified drive, since this
-  is required for the statfs system call.
-  These filenames are set in drivestr[0..26], and have been preset to :
-   0 - '.'      (default drive - hence current dir is ok.)
-   1 - '/fd0/.'  (floppy drive 1 - should be adapted to local system )
-   2 - '/fd1/.'  (floppy drive 2 - should be adapted to local system )
-   3 - '/'       (C: equivalent of dos is the root partition)
-   4..26          (can be set by you're own applications)
-  ! Use AddDisk() to Add new drives !
-  They both return -1 when a failure occurs.
-}
-Const
-  FixDriveStr : array[0..3] of pchar=(
-    '.',
-    '/fd0/.',
-    '/fd1/.',
-    '/.'
-    );
-var
-  Drives   : byte;
-  DriveStr : array[4..26] of pchar;
-
-Procedure AddDisk(const path:string);
-begin
-  if not (DriveStr[Drives]=nil) then
-   FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
-  GetMem(DriveStr[Drives],length(Path)+1);
-  StrPCopy(DriveStr[Drives],path);
-  inc(Drives);
-  if Drives>26 then
-   Drives:=4;
-end;
-
-
-
-
-Function DiskFree(Drive: Byte): int64;
-var
-  fs : statfs;
-Begin
-  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
-     ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
-   Diskfree:=int64(fs.bavail)*int64(fs.bsize)
-  else
-   Diskfree:=-1;
-End;
-
-
-
-Function DiskSize(Drive: Byte): int64;
-var
-  fs : statfs;
-Begin
-  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
-     ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
-   DiskSize:=int64(fs.blocks)*int64(fs.bsize)
-  else
-   DiskSize:=-1;
-End;
-
-
-Function GetCurrentDir : String;
-begin
-  GetDir (0,Result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-  ChDir(NewDir);
-  result := (IOResult = 0);
-  {$I+}
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-  MkDir(NewDir);
-  result := (IOResult = 0);
-  {$I+}
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-  RmDir(Dir);
-  result := (IOResult = 0);
-  {$I+}
-end;
-
-
-{
-  $Log$
-  Revision 1.3  2000-07-14 10:33:10  michael
-  + Conditionals fixed
-
-  Revision 1.2  2000/07/13 11:33:48  michael
-  + removed logs
- 
-}

rtl/linux/filutil.inc → rtl/linux/sysutils.pp

@@ -1,9 +1,10 @@
 {
     $Id$
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    member of the Free Pascal development team
 
-    File utility calls
+    Sysutils unit for linux
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -13,7 +14,29 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+unit sysutils;
+interface
 
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses
+  linux;
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+implementation
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+                              File Functions
+****************************************************************************}
 
 Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
 
@@ -95,9 +118,8 @@ begin
   FileExists:=fstat(filename,Info);
 end;
 
-Function LinuxToWinAttr (FN : Char; Const Info : Stat) : Longint;
-
 
+Function LinuxToWinAttr (FN : Char; Const Info : Stat) : Longint;
 
 begin
   Result:=faArchive;
@@ -107,9 +129,9 @@ begin
     Result:=Result or faDirectory;
   If (Info.Mode and STAT_IWUSR)=0 Then
      Result:=Result or faReadOnly;
-  If (Info.Mode and 
+  If (Info.Mode and
       (STAT_IFSOCK or STAT_IFBLK or STAT_IFCHR or STAT_IFIFO))<>0 then
-     Result:=Result or faSysFile;  
+     Result:=Result or faSysFile;
 end;
 
 {
@@ -244,46 +266,168 @@ begin
   FileSearch:=Linux.FSearch(Name,Dirlist);
 end;
 
-Procedure GetLocalTime(var SystemTime: TSystemTime);
 
+{****************************************************************************
+                              Disk Functions
+****************************************************************************}
+
+{
+  The Diskfree and Disksize functions need a file on the specified drive, since this
+  is required for the statfs system call.
+  These filenames are set in drivestr[0..26], and have been preset to :
+   0 - '.'      (default drive - hence current dir is ok.)
+   1 - '/fd0/.'  (floppy drive 1 - should be adapted to local system )
+   2 - '/fd1/.'  (floppy drive 2 - should be adapted to local system )
+   3 - '/'       (C: equivalent of dos is the root partition)
+   4..26          (can be set by you're own applications)
+  ! Use AddDisk() to Add new drives !
+  They both return -1 when a failure occurs.
+}
+Const
+  FixDriveStr : array[0..3] of pchar=(
+    '.',
+    '/fd0/.',
+    '/fd1/.',
+    '/.'
+    );
+var
+  Drives   : byte;
+  DriveStr : array[4..26] of pchar;
+
+Procedure AddDisk(const path:string);
 begin
-linux.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second);
-linux.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
-SystemTime.MilliSecond := 0;
-end ;
+  if not (DriveStr[Drives]=nil) then
+   FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
+  GetMem(DriveStr[Drives],length(Path)+1);
+  StrPCopy(DriveStr[Drives],path);
+  inc(Drives);
+  if Drives>26 then
+   Drives:=4;
+end;
 
-Procedure InitAnsi;
 
-Var i : longint;
+Function DiskFree(Drive: Byte): int64;
+var
+  fs : statfs;
+Begin
+  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
+     ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
+   Diskfree:=int64(fs.bavail)*int64(fs.bsize)
+  else
+   Diskfree:=-1;
+End;
+
+
+
+Function DiskSize(Drive: Byte): int64;
+var
+  fs : statfs;
+Begin
+  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and fsstat(StrPas(fixdrivestr[drive]),fs)) or
+     ((not (drivestr[Drive]=nil)) and fsstat(StrPas(drivestr[drive]),fs)) then
+   DiskSize:=int64(fs.blocks)*int64(fs.bsize)
+  else
+   DiskSize:=-1;
+End;
+
 
+Function GetCurrentDir : String;
 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 191 do
-  UpperCaseTable[i] := chr(i);
-Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-
-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 191 do
-  LowerCaseTable[i] := chr(i);
-Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+  GetDir (0,Result);
 end;
 
-Procedure InitInternational;
 
+Function SetCurrentDir (Const NewDir : String) : Boolean;
 begin
- InitAnsi;
+  {$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;
+
+
+{****************************************************************************
+                              Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+end;
+
+
+{****************************************************************************
+                              Locale Functions
+****************************************************************************}
+
+Procedure GetLocalTime(var SystemTime: TSystemTime);
+begin
+  linux.GetTime(SystemTime.Hour, SystemTime.Minute, SystemTime.Second);
+  linux.GetDate(SystemTime.Year, SystemTime.Month, SystemTime.Day);
+  SystemTime.MilliSecond := 0;
+end ;
+
+
+Procedure InitAnsi;
+Var
+  i : longint;
+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 191 do
+    UpperCaseTable[i] := chr(i);
+  Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+  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 191 do
+    LowerCaseTable[i] := chr(i);
+  Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+end;
+
+
+Procedure InitInternational;
+begin
+  InitAnsi;
+end;
+
+
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+Initialization
+  InitExceptions;       { Initialize exceptions. OS independent }
+  InitInternational;    { Initialize internationalization settings }
+Finalization
+  OutOfMemory.Free;
+  InValidPointer.Free;
+end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:48  michael
-  + removed logs
- 
-}
+  Revision 1.2  2000-08-20 15:46:46  peter
+    * sysutils.pp moved to target and merged with disk.inc, filutil.inc
+
+}

rtl/objpas/datih.inc

@@ -101,12 +101,14 @@ function StrToDateTime(const S: string): TDateTime;
 function FormatDateTime(FormatStr: string; DateTime: TDateTime):string;
 procedure DateTimeToString(var Result: string; const FormatStr: string; const DateTime: TDateTime);
 Function DateTimeToFileDate(DateTime : TDateTime) : Longint;
-Function FileDateToDateTime (Filedate : Longint) : TDateTime;
+Function FileDateToDateTime (Filedate : Longint) :TDateTime;
 
-{
+{ FPC Extra }
+Procedure GetLocalTime(var SystemTime: TSystemTime);
 
+{
   $Log$
-  Revision 1.2  2000-07-13 11:33:51  michael
-  + removed logs
- 
+  Revision 1.3  2000-08-20 15:46:46  peter
+    * sysutils.pp moved to target and merged with disk.inc, filutil.inc
+
 }

rtl/objpas/sysutilh.inc

@@ -0,0 +1,136 @@
+{
+    $Id$
+    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
+
+    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.
+
+ **********************************************************************}
+
+
+  { Read String Handling functions declaration }
+  {$i sysstrh.inc}
+
+type
+   { some helpful data types }
+
+   tprocedure = procedure;
+
+   tfilename = string;
+
+   tsyscharset = set of char;
+
+   longrec = packed record
+      lo,hi : word;
+   end;
+
+   wordrec = packed record
+      lo,hi : byte;
+   end;
+
+   TMethod = packed record
+     Code, Data: Pointer;
+   end;
+
+   { exceptions }
+   Exception = class(TObject)
+    private
+      fmessage : string;
+      fhelpcontext : longint;
+    public
+      constructor Create(const msg : string);
+      constructor CreateFmt(const msg : string; const args : array of const);
+      constructor CreateRes(ResString: PString);
+      constructor CreateResFmt(ResString: PString; const Args: array of const);
+      constructor CreateHelp(const Msg: string; AHelpContext: Integer);
+      constructor CreateFmtHelp(const Msg: string; const Args: array of const;
+        AHelpContext: Integer);
+      constructor CreateResHelp(ResString: PString; AHelpContext: Integer);
+      constructor CreateResFmtHelp(ResString: PString; const Args: array of const;
+        AHelpContext: Integer);
+      { !!!! }
+      property helpcontext : longint read fhelpcontext write fhelpcontext;
+      property message : string read fmessage write fmessage;
+   end;
+
+   ExceptClass = class of Exception;
+
+   { integer math exceptions }
+   EInterror    = Class(Exception);
+   EDivByZero   = Class(EIntError);
+   ERangeError  = Class(EIntError);
+   EIntOverflow = Class(EIntError);
+
+   { General math errors }
+   EMathError  = Class(Exception);
+   EInvalidOp  = Class(EMathError);
+   EZeroDivide = Class(EMathError);
+   EOverflow   = Class(EMathError);
+   EUnderflow  = Class(EMathError);
+
+   { Run-time and I/O Errors }
+   EInOutError = class(Exception)
+     public
+     ErrorCode : Longint;
+     end;
+   EInvalidPointer  = Class(Exception);
+   EOutOfMemory     = Class(Exception);
+   EAccessViolation = Class(Exception);
+   EInvalidCast = Class(Exception);
+
+
+   { String conversion errors }
+   EConvertError = class(Exception);
+
+   { Other errors }
+   EAbort           = Class(Exception);
+   EAbstractError   = Class(Exception);
+   EAssertionFailed = Class(Exception);
+
+   { Exception handling routines }
+   function ExceptObject: TObject;
+   function ExceptAddr: Pointer;
+   function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer;
+                                  Buffer: PChar; Size: Integer): Integer;
+   procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
+   procedure Abort;
+   procedure OutOfMemoryError;
+   procedure Beep;
+
+Var
+   OnShowException : Procedure (Msg : ShortString);
+
+  { FileRec/TextRec }
+  {$i filerec.inc}
+  {$i textrec.inc}
+
+  { Read internationalization settings }
+  {$i sysinth.inc}
+
+  { Read date & Time function declarations }
+  {$i datih.inc}
+
+  { Read pchar handling functions declration }
+  {$i syspchh.inc}
+
+  { Read filename handling functions declaration }
+  {$i finah.inc}
+
+  { Read other file handling function declarations }
+  {$i filutilh.inc}
+
+  { Read disk function declarations }
+  {$i diskh.inc}
+
+{
+  $Log$
+  Revision 1.2  2000-08-20 15:46:46  peter
+    * sysutils.pp moved to target and merged with disk.inc, filutil.inc
+
+}

rtl/objpas/sysutils.pp → rtl/objpas/sysutils.inc

@@ -12,147 +12,6 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
-unit sysutils;
-interface
-
-{$MODE objfpc}
-{ force ansistrings }
-{$H+}
-
-    uses
-    {$ifdef linux}
-       linux
-    {$endif}
-    {$ifdef win32}
-       dos,windows
-    {$endif}
-    {$ifdef go32v1}
-       go32,dos
-    {$endif}
-    {$ifdef go32v2}
-       go32,dos
-    {$endif}
-    {$ifdef os2}
-       doscalls,dos
-    {$endif}
-       ;
-
-
-  { Read String Handling functions declaration }
-  {$i sysstrh.inc}
-
-type
-   { some helpful data types }
-
-   tprocedure = procedure;
-
-   tfilename = string;
-
-   tsyscharset = set of char;
-
-   longrec = packed record
-      lo,hi : word;
-   end;
-
-   wordrec = packed record
-      lo,hi : byte;
-   end;
-
-   TMethod = packed record
-     Code, Data: Pointer;
-   end;
-
-   { exceptions }
-   Exception = class(TObject)
-    private
-      fmessage : string;
-      fhelpcontext : longint;
-    public
-      constructor Create(const msg : string);
-      constructor CreateFmt(const msg : string; const args : array of const);
-      constructor CreateRes(ResString: PString);
-      constructor CreateResFmt(ResString: PString; const Args: array of const);
-      constructor CreateHelp(const Msg: string; AHelpContext: Integer);
-      constructor CreateFmtHelp(const Msg: string; const Args: array of const;
-        AHelpContext: Integer);
-      constructor CreateResHelp(ResString: PString; AHelpContext: Integer);
-      constructor CreateResFmtHelp(ResString: PString; const Args: array of const;
-        AHelpContext: Integer);
-      { !!!! }
-      property helpcontext : longint read fhelpcontext write fhelpcontext;
-      property message : string read fmessage write fmessage;
-   end;
-
-   ExceptClass = class of Exception;
-
-   { integer math exceptions }
-   EInterror    = Class(Exception);
-   EDivByZero   = Class(EIntError);
-   ERangeError  = Class(EIntError);
-   EIntOverflow = Class(EIntError);
-
-   { General math errors }
-   EMathError  = Class(Exception);
-   EInvalidOp  = Class(EMathError);
-   EZeroDivide = Class(EMathError);
-   EOverflow   = Class(EMathError);
-   EUnderflow  = Class(EMathError);
-
-   { Run-time and I/O Errors }
-   EInOutError = class(Exception)
-     public
-     ErrorCode : Longint;
-     end;
-   EInvalidPointer  = Class(Exception);
-   EOutOfMemory     = Class(Exception);
-   EAccessViolation = Class(Exception);
-   EInvalidCast = Class(Exception);
-
-
-   { String conversion errors }
-   EConvertError = class(Exception);
-
-   { Other errors }
-   EAbort           = Class(Exception);
-   EAbstractError   = Class(Exception);
-   EAssertionFailed = Class(Exception);
-
-   { Exception handling routines }
-   function ExceptObject: TObject;
-   function ExceptAddr: Pointer;
-   function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer;
-                                  Buffer: PChar; Size: Integer): Integer;
-   procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);
-   procedure Abort;
-   procedure OutOfMemoryError;
-   procedure Beep;
-
-Var
-   OnShowException : Procedure (Msg : ShortString);
-
-  { FileRec/TextRec }
-  {$i filerec.inc}
-  {$i textrec.inc}
-
-  { Read internationalization settings }
-  {$i sysinth.inc}
-
-  { Read date & Time function declarations }
-  {$i datih.inc}
-
-  { Read pchar handling functions declration }
-  {$i syspchh.inc}
-
-  { Read filename handling functions declaration }
-  {$i finah.inc}
-
-  { Read other file handling function declarations }
-  {$i filutilh.inc}
-
-  { Read disk function declarations }
-  {$i diskh.inc}
-
-  implementation
 
   { Read message string definitions }
   {
@@ -172,12 +31,6 @@ Var
   { Read String Handling functions implementation }
   {$i sysstr.inc}
 
-  { Read other file handling function implementations }
-  {$i filutil.inc}
-
-  { Read disk function implementations }
-  {$i disk.inc}
-
   { Read date & Time function implementations }
   {$i dati.inc}
 
@@ -328,7 +181,7 @@ begin
   else
    E:=Exception.CreateFmt (SUnKnownRunTimeError,[Errno]);
   end;
-  Raise E at longint(Address),longint(Frame);
+  Raise E at longint(Address){$ifdef ENHANCEDRAISE},longint(Frame){$endif};
 end;
 
 
@@ -434,39 +287,9 @@ begin
   Raise OutOfMemory;
 end;
 
-procedure Beep;
-
-begin
-  {$ifdef win32}
-  MessageBeep(0);
-  {$else}
-
-  {$endif}
-end;
-
-{  Initialization code. }
-
-Initialization
-  InitExceptions;       { Initialize exceptions. OS independent }
-  InitInternational;    { Initialize internationalization settings }
-Finalization
-  OutOfMemory.Free;
-  InValidPointer.Free;
-end.
 {
   $Log$
-  Revision 1.5  2000-08-06 14:19:06  peter
-    * overload directives removed (merged)
-
-  Revision 1.4  2000/07/27 16:20:52  sg
-  * Applied patch by Markus Kaemmerer with minor modifications: More methods
-    of the Exception class are now implemented (in a manner so that they can
-    be used as in Delphi, although the declarations are somewhat different)
-
-  Revision 1.3  2000/07/14 10:33:10  michael
-  + Conditionals fixed
-
-  Revision 1.2  2000/07/13 11:33:51  michael
-  + removed logs
+  Revision 1.2  2000-08-20 15:46:46  peter
+    * sysutils.pp moved to target and merged with disk.inc, filutil.inc
 
 }

rtl/os2/Makefile

@@ -1,5 +1,5 @@
 #
-# Makefile generated by fpcmake v0.99.15 [2000/07/02]
+# Makefile generated by fpcmake v1.00 [2000/08/14]
 #
 
 defaultrule: all
@@ -916,7 +916,7 @@ ifdef INSTALLPPUFILES
 ifdef PPUFILES
 INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
 else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
+INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))))
 endif
 endif
 
@@ -1081,7 +1081,7 @@ ifdef CLEANPPUFILES
 ifdef PPUFILES
 CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
 else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
+CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))))
 endif
 endif
 
@@ -1246,7 +1246,7 @@ dive$(PPUEXT) : dive.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMPPU)
 #
 
 dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
-	       $(SYSTEMPPU)
+	       doscalls$(PPUEXT) $(SYSTEMPPU)
 
 crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMPPU)
 
@@ -1260,9 +1260,9 @@ printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMPPU)
 # Delphi Compatible Units
 #
 
-sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
-		    filutil.inc disk.inc objpas$(PPUEXT)
-	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
+		    objpas$(PPUEXT) dos$(PPUEXT) doscalls$(PPUEXT)
+	$(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR)
 
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
 	$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)

rtl/os2/Makefile.fpc

@@ -119,7 +119,7 @@ dive$(PPUEXT) : dive.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMPPU)
 #
 
 dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
-               $(SYSTEMPPU)
+               doscalls$(PPUEXT) $(SYSTEMPPU)
 
 crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMPPU)
 
@@ -133,9 +133,9 @@ printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMPPU)
 # Delphi Compatible Units
 #
 
-sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
-                    filutil.inc disk.inc objpas$(PPUEXT)
-        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
+                    objpas$(PPUEXT) dos$(PPUEXT) doscalls$(PPUEXT)
+        $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR)
 
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
         $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)

rtl/os2/disk.inc

@@ -1,139 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    Disk functions from Delphi's sysutils.pas
-        
-    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.
-
- **********************************************************************}
-
-{$ASMMODE ATT}
-
-function DiskFree (Drive: byte): int64;
-
-var FI: TFSinfo;
-    RC: longint;
-
-begin
-    if (os_mode = osDOS) or (os_mode = osDPMI) then
-    {Function 36 is not supported in OS/2.}
-        asm
-            movb 8(%ebp),%dl
-            movb $0x36,%ah
-            call syscall
-            cmpw $-1,%ax
-            je .LDISKFREE1
-            mulw %cx
-            mulw %bx
-            shll $16,%edx
-            movw %ax,%dx
-            xchgl %edx,%eax
-            leave
-            ret
-         .LDISKFREE1:
-            cltd
-            leave
-            ret
-        end
-    else
-        {In OS/2, we use the filesystem information.}
-        begin
-            RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
-            if RC = 0 then
-                DiskFree := int64 (FI.Free_Clusters) *
-                   int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
-            else
-                DiskFree := -1;
-        end;
-end;
-
-function DiskSize (Drive: byte): int64;
-
-var FI: TFSinfo;
-    RC: longint;
-
-begin
-    if (os_mode = osDOS) or (os_mode = osDPMI) then
-        {Function 36 is not supported in OS/2.}
-        asm
-            movb 8(%ebp),%dl
-            movb $0x36,%ah
-            call syscall
-            movw %dx,%bx
-            cmpw $-1,%ax
-            je .LDISKSIZE1
-            mulw %cx
-            mulw %bx
-            shll $16,%edx
-            movw %ax,%dx
-            xchgl %edx,%eax
-            leave
-            ret
-        .LDISKSIZE1:
-            cltd
-            leave
-            ret
-        end
-    else
-        {In OS/2, we use the filesystem information.}
-        begin
-            RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
-            if RC = 0 then
-                DiskSize := int64 (FI.Total_Clusters) *
-                   int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
-            else
-                DiskSize := -1;
-        end;
-end;
-
-
-function GetCurrentDir: string;
-begin
- GetDir (0, Result);
-end;
-
-
-function SetCurrentDir (const NewDir: string): boolean;
-begin
-{$I-}
- ChDir (NewDir);
- Result := (IOResult = 0);
-{$I+}
-end;
-
-
-function CreateDir (const NewDir: string): boolean;
-begin
-{$I-}
- MkDir (NewDir);
- Result := (IOResult = 0);
-{$I+}
-end;
-
-
-function RemoveDir (const Dir: string): boolean;
-begin
-{$I-}
- RmDir (Dir);
- Result := (IOResult = 0);
- {$I+}
-end;
-
-
-
-{
-  $Log$
-  Revision 1.3  2000-07-14 10:33:10  michael
-  + Conditionals fixed
-
-  Revision 1.2  2000/07/13 11:33:52  michael
-  + removed logs
- 
-}

rtl/os2/filutil.inc → rtl/os2/sysutils.pp

@@ -1,9 +1,10 @@
 {
     $Id$
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    member of the Free Pascal development team
 
-    File utility calls
+    Sysutils unit for OS/2
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -13,7 +14,29 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+unit sysutils;
+interface
 
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
+
+uses
+  doscalls,dos;
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+
+implementation
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
+
+
+{****************************************************************************
+                              File Functions
+****************************************************************************}
 
 {This is the correct way to call external assembler procedures.}
 procedure syscall;external name '___SYSCALL';
@@ -488,6 +511,128 @@ begin
 end;
 
 
+{****************************************************************************
+                              Disk Functions
+****************************************************************************}
+
+{$ASMMODE ATT}
+
+function DiskFree (Drive: byte): int64;
+
+var FI: TFSinfo;
+    RC: longint;
+
+begin
+    if (os_mode = osDOS) or (os_mode = osDPMI) then
+    {Function 36 is not supported in OS/2.}
+        asm
+            movb 8(%ebp),%dl
+            movb $0x36,%ah
+            call syscall
+            cmpw $-1,%ax
+            je .LDISKFREE1
+            mulw %cx
+            mulw %bx
+            shll $16,%edx
+            movw %ax,%dx
+            xchgl %edx,%eax
+            leave
+            ret
+         .LDISKFREE1:
+            cltd
+            leave
+            ret
+        end
+    else
+        {In OS/2, we use the filesystem information.}
+        begin
+            RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI));
+            if RC = 0 then
+                DiskFree := int64 (FI.Free_Clusters) *
+                   int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+            else
+                DiskFree := -1;
+        end;
+end;
+
+function DiskSize (Drive: byte): int64;
+
+var FI: TFSinfo;
+    RC: longint;
+
+begin
+    if (os_mode = osDOS) or (os_mode = osDPMI) then
+        {Function 36 is not supported in OS/2.}
+        asm
+            movb 8(%ebp),%dl
+            movb $0x36,%ah
+            call syscall
+            movw %dx,%bx
+            cmpw $-1,%ax
+            je .LDISKSIZE1
+            mulw %cx
+            mulw %bx
+            shll $16,%edx
+            movw %ax,%dx
+            xchgl %edx,%eax
+            leave
+            ret
+        .LDISKSIZE1:
+            cltd
+            leave
+            ret
+        end
+    else
+        {In OS/2, we use the filesystem information.}
+        begin
+            RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI));
+            if RC = 0 then
+                DiskSize := int64 (FI.Total_Clusters) *
+                   int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector)
+            else
+                DiskSize := -1;
+        end;
+end;
+
+
+function GetCurrentDir: string;
+begin
+ GetDir (0, Result);
+end;
+
+
+function SetCurrentDir (const NewDir: string): boolean;
+begin
+{$I-}
+ ChDir (NewDir);
+ Result := (IOResult = 0);
+{$I+}
+end;
+
+
+function CreateDir (const NewDir: string): boolean;
+begin
+{$I-}
+ MkDir (NewDir);
+ Result := (IOResult = 0);
+{$I+}
+end;
+
+
+function RemoveDir (const Dir: string): boolean;
+begin
+{$I-}
+ RmDir (Dir);
+ Result := (IOResult = 0);
+ {$I+}
+end;
+
+
+{****************************************************************************
+                              Time Functions
+****************************************************************************}
+
+{$asmmode intel}
 procedure GetLocalTime (var SystemTime: TSystemTime); assembler;
 asm
 (* Expects the default record alignment (DWord)!!! *)
@@ -516,6 +661,21 @@ asm
     mov al, dl
     stosd
 end;
+{$asmmode default}
+
+
+{****************************************************************************
+                              Misc Functions
+****************************************************************************}
+
+procedure Beep;
+begin
+end;
+
+
+{****************************************************************************
+                              Locale Functions
+****************************************************************************}
 
 procedure InitAnsi;
 var I: byte;
@@ -538,6 +698,7 @@ begin
             LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I);
 end;
 
+
 procedure InitInternational;
 var Country: TCountryCode;
     CtryInfo: TCountryInfo;
@@ -575,9 +736,20 @@ begin
 end;
 
 
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+Initialization
+  InitExceptions;       { Initialize exceptions. OS independent }
+  InitInternational;    { Initialize internationalization settings }
+Finalization
+  OutOfMemory.Free;
+  InValidPointer.Free;
+end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:52  michael
-  + removed logs
- 
+  Revision 1.2  2000-08-20 15:46:46  peter
+    * sysutils.pp moved to target and merged with disk.inc, filutil.inc
+
 }

rtl/win32/Makefile

@@ -1,5 +1,5 @@
 #
-# Makefile generated by fpcmake v1.00 [2000/07/11]
+# Makefile generated by fpcmake v1.00 [2000/08/14]
 #
 
 defaultrule: all
@@ -921,7 +921,7 @@ ifdef INSTALLPPUFILES
 ifdef PPUFILES
 INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
 else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
+INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))))
 endif
 endif
 
@@ -1086,7 +1086,7 @@ ifdef CLEANPPUFILES
 ifdef PPUFILES
 CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
 else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
+CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(LIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))))
 endif
 endif
 
@@ -1276,9 +1276,9 @@ graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMPPU) \
 # Delphi Compatible Units
 #
 
-sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
-		    filutil.inc disk.inc objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT)
-	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
+		    objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT)
+	$(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR)
 
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
 	$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)

rtl/win32/Makefile.fpc

@@ -150,9 +150,9 @@ graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMPPU) \
 # Delphi Compatible Units
 #
 
-sysutils$(PPUEXT) : $(OBJPASDIR)/sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
-                    filutil.inc disk.inc objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT)
-        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/sysutils.pp $(REDIR)
+sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/*.inc) \
+                    objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT)
+        $(COMPILER) -I$(OBJPASDIR) sysutils.pp $(REDIR)
 
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
         $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp $(REDIR)

rtl/win32/disk.inc

@@ -1,139 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
-
-    Disk functions from Delphi's sysutils.pas
-
-    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.
-
- **********************************************************************}
-
-   function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
-                             freeclusters,totalclusters:longint):longbool;
-     external 'kernel32' name 'GetDiskFreeSpaceA';
-type
-   TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,
-                             total,free):longbool;stdcall;
-
-var
-   GetDiskFreeSpaceEx : TGetDiskFreeSpaceEx;
-
-function diskfree(drive : byte) : int64;
-var
-  disk : array[1..4] of char;
-  secs,bytes,
-  free,total : longint;
-  qwtotal,qwfree,qwcaller : int64;
-
-
-begin
-  if drive=0 then
-   begin
-     disk[1]:='\';
-     disk[2]:=#0;
-   end
-  else
-   begin
-     disk[1]:=chr(drive+64);
-     disk[2]:=':';
-     disk[3]:='\';
-     disk[4]:=#0;
-   end;
-  if assigned(GetDiskFreeSpaceEx) then
-    begin
-       if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
-         diskfree:=qwfree
-       else
-         diskfree:=-1;
-    end
-  else
-    begin
-       if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
-         diskfree:=int64(free)*secs*bytes
-       else
-         diskfree:=-1;
-    end;
-end;
-
-
-function disksize(drive : byte) : int64;
-var
-  disk : array[1..4] of char;
-  secs,bytes,
-  free,total : longint;
-  qwtotal,qwfree,qwcaller : int64;
-
-begin
-  if drive=0 then
-   begin
-     disk[1]:='\';
-     disk[2]:=#0;
-   end
-  else
-   begin
-     disk[1]:=chr(drive+64);
-     disk[2]:=':';
-     disk[3]:='\';
-     disk[4]:=#0;
-   end;
-  if assigned(GetDiskFreeSpaceEx) then
-    begin
-       if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
-         disksize:=qwtotal
-       else
-         disksize:=-1;
-    end
-  else
-    begin
-       if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
-         disksize:=int64(total)*secs*bytes
-       else
-         disksize:=-1;
-    end;
-end;
-
-
-Function GetCurrentDir : String;
-begin
-  GetDir(0, result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-  ChDir(NewDir);
-  result := (IOResult = 0);
-  {$I+}
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-  MkDir(NewDir);
-  result := (IOResult = 0);
-  {$I+}
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-  RmDir(Dir);
-  result := (IOResult = 0);
-  {$I+}
-end;
-
-{
-  $Log$
-  Revision 1.2  2000-07-13 11:33:57  michael
-  + removed logs
- 
-}

rtl/win32/filutil.inc → rtl/win32/sysutils.pp

@@ -1,9 +1,10 @@
 {
     $Id$
     This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team
+    Copyright (c) 1999-2000 by Florian Klaempfl
+    member of the Free Pascal development team
 
-    File utility calls
+    Sysutils unit for win32
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -13,10 +14,37 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+unit sysutils;
+interface
 
+{$MODE objfpc}
+{ force ansistrings }
+{$H+}
 
-Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
+uses
+  dos,windows;
+
+
+{ Include platform independent interface part }
+{$i sysutilh.inc}
+
+{ platform dependent functions }
+
+function SysErrorMessage(ErrorCode: Integer): String;
+
+
+
+implementation
+
+{ Include platform independent implementation part }
+{$i sysutils.inc}
 
+
+{****************************************************************************
+                              File Functions
+****************************************************************************}
+
+Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
 const
   AccessMode: array[0..2] of Integer = (
     GENERIC_READ,
@@ -28,65 +56,61 @@ const
                FILE_SHARE_READ,
                FILE_SHARE_WRITE,
                FILE_SHARE_READ or FILE_SHARE_WRITE);
-
-Var FN : string;
-
+Var
+  FN : string;
 begin
   FN:=FileName+#0;
-  Result := CreateFile(@FN[1], AccessMode[Mode and 3],
-                         ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
+  result := CreateFile(@FN[1], AccessMode[Mode and 3],
+                       ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
                        FILE_ATTRIBUTE_NORMAL, 0);
 end;
 
 
 Function FileCreate (Const FileName : String) : Longint;
-
-Var FN : string;
-
+Var
+  FN : string;
 begin
   FN:=FileName+#0;
- Result := CreateFile(@FN[1], GENERIC_READ or GENERIC_WRITE,
-     0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
+  Result := CreateFile(@FN[1], GENERIC_READ or GENERIC_WRITE,
+                       0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
 end;
 
 
 Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
-
-Var res : Longint;
-
+Var
+  res : Longint;
 begin
-  if not ReadFile(Handle, Buffer, Count, res, nil) then res := -1;
+  if not ReadFile(Handle, Buffer, Count, res, nil) then
+   res := -1;
   FileRead:=Res;
 end;
 
 
 Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
-
-Var Res : longint;
-
+Var
+  Res : longint;
 begin
-  if not WriteFile(Handle, Buffer, Count, Res, nil) then Res:= -1;
+  if not WriteFile(Handle, Buffer, Count, Res, nil) then
+   Res:= -1;
   FileWrite:=Res;
 end;
 
 
 Function FileSeek (Handle,FOffset,Origin : Longint) : Longint;
-
 begin
   Result := SetFilePointer(Handle, FOffset, nil, Origin);
 end;
 
 
 Procedure FileClose (Handle : Longint);
-
 begin
   if Handle<=4 then
    exit;
   CloseHandle(Handle);
 end;
 
-Function FileTruncate (Handle,Size: Longint) : boolean;
 
+Function FileTruncate (Handle,Size: Longint) : boolean;
 begin
   Result:=SetFilePointer(handle,Size,nil,FILE_BEGIN)<>-1;
   If Result then
@@ -112,25 +136,23 @@ end;
 
 
 Function FileAge (Const FileName : String): Longint;
-
 var
   Handle: THandle;
   FindData: TWin32FindData;
-
 begin
   Handle := FindFirstFile(Pchar(FileName), @FindData);
   if Handle <> INVALID_HANDLE_VALUE then
     begin
-    Windows.FindClose(Handle);
-    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
-      If WinToDosTime(FindData.ftLastWriteTime,Result) then exit;
+      Windows.FindClose(Handle);
+      if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
+        If WinToDosTime(FindData.ftLastWriteTime,Result) then
+          exit;
     end;
   Result := -1;
 end;
 
 
 Function FileExists (Const FileName : String) : Boolean;
-
 var
   Handle: THandle;
   FindData: TWin32FindData;
@@ -141,16 +163,16 @@ begin
     Windows.FindClose(Handle);
 end;
 
-Function FindMatch(var f: TSearchRec) : Longint;
 
+Function FindMatch(var f: TSearchRec) : Longint;
 begin
   { Find file with correct attribute }
   While (F.FindData.dwFileAttributes and F.ExcludeAttr)<>0 do
    begin
      if not FindNextFile (F.FindHandle,@F.FindData) then
       begin
-      Result:=GetLastError;
-      exit;
+        Result:=GetLastError;
+        exit;
       end;
    end;
   { Convert some attributes back }
@@ -161,8 +183,8 @@ begin
   Result:=0;
 end;
 
-Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
 
+Function FindFirst (Const Path : String; Attr : Longint; Var Rslt : TSearchRec) : Longint;
 begin
   Rslt.Name:=Path;
   Rslt.Attr:=attr;
@@ -171,17 +193,16 @@ begin
   { FindFirstFile is a Win32 Call }
   Rslt.FindHandle:=FindFirstFile (PChar(Path),@Rslt.FindData);
   If Rslt.FindHandle=Invalid_Handle_value then
-     begin
+   begin
      Result:=GetLastError;
      exit;
-     end;
+   end;
   { Find file with correct attribute }
   Result:=FindMatch(Rslt);
 end;
 
 
 Function FindNext (Var Rslt : TSearchRec) : Longint;
-
 begin
   if FindNextFile(Rslt.FindHandle, @Rslt.FindData) then
     Result := FindMatch(Rslt)
@@ -191,46 +212,42 @@ end;
 
 
 Procedure FindClose (Var F : TSearchrec);
-
 begin
    if F.FindHandle <> INVALID_HANDLE_VALUE then
     Windows.FindClose(F.FindHandle);
 end;
 
 
-
 Function FileGetDate (Handle : Longint) : Longint;
-
-Var FT : TFileTime;
-
+Var
+  FT : TFileTime;
 begin
   If GetFileTime(Handle,nil,nil,@ft) and
-     WinToDosTime(FT,Result) then exit;
+     WinToDosTime(FT,Result) then
+    exit;
   Result:=-1;
 end;
 
 
 Function FileSetDate (Handle,Age : Longint) : Longint;
-
-Var FT: TFileTime;
-
+Var
+  FT: TFileTime;
 begin
   Result := 0;
   if DosToWinTime(Age,FT) and
-     SetFileTime(Handle, ft, ft, FT) then Exit;
+     SetFileTime(Handle, ft, ft, FT) then
+    Exit;
   Result := GetLastError;
 end;
 
 
 Function FileGetAttr (Const FileName : String) : Longint;
-
 begin
   Result:=GetFileAttributes(PChar(FileName));
 end;
 
 
 Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
-
 begin
   if not SetFileAttributes(PChar(FileName), Attr) then
     Result := GetLastError
@@ -240,24 +257,21 @@ end;
 
 
 Function DeleteFile (Const FileName : String) : Boolean;
-
 begin
   DeleteFile:=Windows.DeleteFile(Pchar(FileName));
 end;
 
 
 Function RenameFile (Const OldName, NewName : String) : Boolean;
-
 begin
   Result := MoveFile(PChar(OldName), PChar(NewName));
 end;
 
 
 Function FileSearch (Const Name, DirList : String) : String;
-
-Var I : longint;
-    Temp : String;
-
+Var
+  I : longint;
+  Temp : String;
 begin
   Result:='';
   temp:=Dirlist;
@@ -265,13 +279,13 @@ begin
     I:=pos(';',Temp);
     If I<>0 then
       begin
-      Result:=Copy (Temp,1,i-1);
-      system.Delete(Temp,1,I);
+        Result:=Copy (Temp,1,i-1);
+        system.Delete(Temp,1,I);
       end
     else
       begin
-      Result:=Temp;
-      Temp:='';
+        Result:=Temp;
+        Temp:='';
       end;
     If result[length(result)]<>'\' then
       Result:=Result+'\';
@@ -281,49 +295,188 @@ begin
   until (length(temp)=0) or (length(result)<>0);
 end;
 
-Procedure GetLocalTime(var ST: TSystemTime);
 
-Var Syst:Systemtime;
+{****************************************************************************
+                              Disk Functions
+****************************************************************************}
+
+function GetDiskFreeSpace(drive:pchar;var sector_cluster,bytes_sector,
+                          freeclusters,totalclusters:longint):longbool;
+         external 'kernel32' name 'GetDiskFreeSpaceA';
+type
+  TGetDiskFreeSpaceEx = function(drive:pchar;var availableforcaller,total,free):longbool;stdcall;
+
+var
+ GetDiskFreeSpaceEx : TGetDiskFreeSpaceEx;
+
+function diskfree(drive : byte) : int64;
+var
+  disk : array[1..4] of char;
+  secs,bytes,
+  free,total : longint;
+  qwtotal,qwfree,qwcaller : int64;
+
+
+begin
+  if drive=0 then
+   begin
+     disk[1]:='\';
+     disk[2]:=#0;
+   end
+  else
+   begin
+     disk[1]:=chr(drive+64);
+     disk[2]:=':';
+     disk[3]:='\';
+     disk[4]:=#0;
+   end;
+  if assigned(GetDiskFreeSpaceEx) then
+    begin
+       if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
+         diskfree:=qwfree
+       else
+         diskfree:=-1;
+    end
+  else
+    begin
+       if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
+         diskfree:=int64(free)*secs*bytes
+       else
+         diskfree:=-1;
+    end;
+end;
+
+
+function disksize(drive : byte) : int64;
+var
+  disk : array[1..4] of char;
+  secs,bytes,
+  free,total : longint;
+  qwtotal,qwfree,qwcaller : int64;
+begin
+  if drive=0 then
+   begin
+     disk[1]:='\';
+     disk[2]:=#0;
+   end
+  else
+   begin
+     disk[1]:=chr(drive+64);
+     disk[2]:=':';
+     disk[3]:='\';
+     disk[4]:=#0;
+   end;
+  if assigned(GetDiskFreeSpaceEx) then
+    begin
+       if GetDiskFreeSpaceEx(@disk,qwcaller,qwtotal,qwfree) then
+         disksize:=qwtotal
+       else
+         disksize:=-1;
+    end
+  else
+    begin
+       if GetDiskFreeSpace(@disk,secs,bytes,free,total) then
+         disksize:=int64(total)*secs*bytes
+       else
+         disksize:=-1;
+    end;
+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
+  Syst : Windows.TSystemtime;
 begin
   windows.Getlocaltime(@syst);
-  st.year:=syst.wYear;
-  st.month:=syst.wMonth;
-  st.day:=syst.wDay;
-  st.hour:=syst.wHour;
-  st.minute:=syst.wMinute;
-  st.second:=syst.wSecond;
-  st.millisecond:=syst.wMilliSeconds;
+  SystemTime.year:=syst.wYear;
+  SystemTime.month:=syst.wMonth;
+  SystemTime.day:=syst.wDay;
+  SystemTime.hour:=syst.wHour;
+  SystemTime.minute:=syst.wMinute;
+  SystemTime.second:=syst.wSecond;
+  SystemTime.millisecond:=syst.wMilliSeconds;
 end;
-Procedure InitAnsi;
 
-Var i : longint;
 
+{****************************************************************************
+                              Misc Functions
+****************************************************************************}
+
+procedure Beep;
 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 191 do
-  UpperCaseTable[i] := chr(i);
-Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+  MessageBeep(0);
+end;
 
-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 191 do
-  LowerCaseTable[i] := chr(i);
-Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+{****************************************************************************
+                              Locale Functions
+****************************************************************************}
+
+Procedure InitAnsi;
+Var
+  i : longint;
+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 191 do
+    UpperCaseTable[i] := chr(i);
+  Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
+
+  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 191 do
+    LowerCaseTable[i] := chr(i);
+  Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
 end;
 
-function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString;
 
+function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString;
 var
   L: Integer;
   Buf: array[0..255] of Char;
-
 begin
   L := GetLocaleInfo(LID, LT, Buf, SizeOf(Buf));
   if L > 0 then
@@ -332,8 +485,8 @@ begin
     Result := Def;
 end;
 
-function GetLocaleChar(LID, LT: Longint; Def: Char): Char;
 
+function GetLocaleChar(LID, LT: Longint; Def: Char): Char;
 var
   Buf: array[0..1] of Char;
 begin
@@ -342,12 +495,12 @@ begin
   else
     Result := Def;
 end;
-Function GetLocaleInt(LID,TP,Def: LongInt): LongInt;
 
+
+Function GetLocaleInt(LID,TP,Def: LongInt): LongInt;
 Var
   S: String;
   C: Integer;
-
 Begin
   S:=GetLocaleStr(LID,TP,'0');
   Val(S,Result,C);
@@ -355,13 +508,12 @@ Begin
     Result:=Def;
 End;
 
-procedure GetFormatSettings;
 
+procedure GetFormatSettings;
 var
   HF  : Shortstring;
   LID : LCID;
   I,Day,DateOrder : longint;
-
 begin
   LID := GetThreadLocale;
   { Date stuff }
@@ -413,21 +565,60 @@ begin
   CurrencyDecimals:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRDIGITS, '0'), 0);
 end;
 
+
 Procedure InitInternational;
+begin
+  InitAnsi;
+  GetFormatSettings;
+end;
 
-{
- called by sysutils initialization routines to set up
- internationalization support.
-}
 
+{****************************************************************************
+                           Target Dependent
+****************************************************************************}
+
+function FormatMessageA(dwFlags     : DWORD;
+                        lpSource    : Pointer;
+                        dwMessageId : DWORD;
+                        dwLanguageId: DWORD;
+                        lpBuffer    : PCHAR;
+                        nSize       : DWORD;
+                        Arguments   : Pointer): DWORD; external 'kernel32' name 'FormatMessageA';
+
+function SysErrorMessage(ErrorCode: Integer): String;
+const
+  MaxMsgSize = Format_Message_Max_Width_Mask;
+var
+  MsgBuffer: pChar;
 begin
- InitAnsi;
- GetFormatSettings;
+  GetMem(MsgBuffer, MaxMsgSize);
+  FillChar(MsgBuffer^, MaxMsgSize, #0);
+  FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
+                 nil,
+                 ErrorCode,
+                 MakeLangId(LANG_NEUTRAL, SUBLANG_DEFAULT),
+                 MsgBuffer,                 { This function allocs the memory }
+                 MaxMsgSize,                           { Maximum message size }
+                 nil);
+  SysErrorMessage := StrPas(MsgBuffer);
+  FreeMem(MsgBuffer, MaxMsgSize);
 end;
 
+
+{****************************************************************************
+                              Initialization code
+****************************************************************************}
+
+Initialization
+  InitExceptions;       { Initialize exceptions. OS independent }
+  InitInternational;    { Initialize internationalization settings }
+Finalization
+  OutOfMemory.Free;
+  InValidPointer.Free;
+end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:57  michael
-  + removed logs
- 
+  Revision 1.2  2000-08-20 15:46:46  peter
+    * sysutils.pp moved to target and merged with disk.inc, filutil.inc
+
 }