浏览代码

* Kylix fixes, mostly case names of units

peter 24 年之前
父节点
当前提交
add30a428e
共有 8 个文件被更改,包括 245 次插入232 次删除
  1. 7 4
      compiler/crc.pas
  2. 1 0
      compiler/defines.inc
  3. 175 218
      compiler/dmisc.pas
  4. 6 3
      compiler/globals.pas
  5. 5 2
      compiler/i386/cpuinfo.pas
  6. 7 4
      compiler/messages.pas
  7. 39 0
      compiler/ppc.conf
  8. 5 1
      compiler/systems.pas

+ 7 - 4
compiler/crc.pas

@@ -20,14 +20,14 @@
 
  ****************************************************************************
 }
-Unit CRC;
+Unit crc;
 
 {$i defines.inc}
 
 Interface
 
 Function Crc32(Const HStr:String):cardinal;
-Function UpdateCrc32(InitCrc:cardinal;var InBuf;InLen:integer):cardinal;
+Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:integer):cardinal;
 Function UpdCrc32(InitCrc:cardinal;b:byte):cardinal;
 
 
@@ -73,7 +73,7 @@ end;
 
 
 
-Function UpdateCrc32(InitCrc:cardinal;var InBuf;InLen:Integer):cardinal;
+Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:Integer):cardinal;
 var
   i : integer;
   p : pchar;
@@ -101,7 +101,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2001-05-09 14:11:10  jonas
+  Revision 1.6  2001-06-03 20:21:08  peter
+    * Kylix fixes, mostly case names of units
+
+  Revision 1.5  2001/05/09 14:11:10  jonas
     * range check error fixes from Peter
 
   Revision 1.4  2000/09/24 15:06:14  peter

+ 1 - 0
compiler/defines.inc

@@ -20,6 +20,7 @@
 
 {$ifdef DELPHI}
   {$H-}
+  {$J+}
 
   {$Z1}
 

+ 175 - 218
compiler/dmisc.pas

@@ -27,7 +27,12 @@ unit dmisc;
 interface
 
 uses
-  windows,sysutils;
+{$ifdef linux}
+  Libc,
+{$else}
+  windows,
+{$endif}
+  sysutils;
 
 Const
   Max_Path = 255;
@@ -57,6 +62,8 @@ Const
 
 
 Type
+  DWord   = Cardinal;
+
 { Needed for Win95 LFN Support }
   ComStr  = String[255];
   PathStr = String[255];
@@ -75,29 +82,7 @@ Type
     Sec   : word;
   End;
 
-  PWin32FindData = ^TWin32FindData;
-  TWin32FindData = packed record
-    dwFileAttributes: Cardinal;
-    ftCreationTime: TFileTime;
-    ftLastAccessTime: TFileTime;
-    ftLastWriteTime: TFileTime;
-    nFileSizeHigh: Cardinal;
-    nFileSizeLow: Cardinal;
-    dwReserved0: Cardinal;
-    dwReserved1: Cardinal;
-    cFileName: array[0..MAX_PATH - 1] of Char;
-    cAlternateFileName: array[0..13] of Char;
-  end;
-
-  Searchrec = Packed Record
-    FindHandle  : THandle;
-    W32FindData : TWin32FindData;
-    time : longint;
-    size : longint;
-    attr : longint;
-    name : string;
-  end;
-
+  SearchRec = Sysutils.TSearchRec;
 
   registers = packed record
     case i : integer of
@@ -117,8 +102,6 @@ Procedure MSDos(var regs: registers);
 Function  DosVersion: Word;
 Procedure GetDate(var year, month, mday, wday: word);
 Procedure GetTime(var hour, minute, second, sec100: word);
-procedure SetDate(year,month,day: word);
-Procedure SetTime(hour,minute,second,sec100: word);
 Procedure UnpackTime(p: longint; var t: datetime);
 Procedure PackTime(var t: datetime; var p: longint);
 
@@ -127,15 +110,15 @@ Procedure Exec(const path: pathstr; const comline: comstr);
 Function  DosExitCode: word;
 
 {Disk}
-Function  DiskFree(drive: byte) : longint;
-Function  DiskSize(drive: byte) : longint;
+Function  DiskFree(drive: byte) : int64;
+Function  DiskSize(drive: byte) : int64;
 Procedure FindFirst(const path: pathstr; attr: word; var f: searchRec);
 Procedure FindNext(var f: searchRec);
 Procedure FindClose(Var f: SearchRec);
 
 {File}
 Procedure GetFAttr(var f; var attr: word);
-Procedure GetFTime(var f; var time: longint);
+Procedure GetFTime(var f; var tim: longint);
 Function  FSearch(path: pathstr; dirlist: string): pathstr;
 Function  FExpand(const path: pathstr): pathstr;
 Procedure FSplit(path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
@@ -180,6 +163,7 @@ implementation
                            --- Conversion ---
 ******************************************************************************}
 
+{$ifdef MSWindows}
    function GetLastError : DWORD;stdcall;
      external 'Kernel32.dll' name 'GetLastError';
    function FileTimeToDosDateTime(const ft :TFileTime;var data,time : word) : boolean;stdcall;
@@ -230,6 +214,7 @@ begin
   WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
                 FileTimeToDosDateTime(lft,longrec(dtime).hi,longrec(dtime).lo);
 end;
+{$endif}
 
 
 {******************************************************************************
@@ -251,72 +236,22 @@ end;
                         --- Info / Date / Time ---
 ******************************************************************************}
 
-   function GetVersion : longint;stdcall;
-     external 'Kernel32.dll' name 'GetVersion';
-   procedure GetLocalTime(var t : Windows.TSystemTime);stdcall;
-     external 'Kernel32.dll' name 'GetLocalTime';
-   function SetLocalTime(const t : Windows.TSystemTime) : boolean;stdcall;
-     external 'Kernel32.dll' name 'SetLocalTime';
-
 function dosversion : word;
 begin
-  dosversion:=GetVersion;
+  dosversion:=0;
 end;
 
 
 procedure getdate(var year,month,mday,wday : word);
-var
-  t : Windows.TSystemTime;
 begin
-  GetLocalTime(t);
-  year:=t.wYear;
-  month:=t.wMonth;
-  mday:=t.wDay;
-  wday:=t.wDayOfWeek;
-end;
-
-
-procedure setdate(year,month,day : word);
-var
-  t : Windows.TSystemTime;
-begin
-  { we need the time set privilege   }
-  { so this function crash currently }
-  {!!!!!}
-  GetLocalTime(t);
-  t.wYear:=year;
-  t.wMonth:=month;
-  t.wDay:=day;
-  { only a quite good solution, we can loose some ms }
-  SetLocalTime(t);
+  DecodeDateFully(Now,Year,Month,MDay,WDay);
 end;
 
 
 procedure gettime(var hour,minute,second,sec100 : word);
-var
-  t : Windows.TSystemTime;
 begin
-   GetLocalTime(t);
-   hour:=t.wHour;
-   minute:=t.wMinute;
-   second:=t.wSecond;
-   sec100:=t.wMilliSeconds div 10;
-end;
-
-
-procedure settime(hour,minute,second,sec100 : word);
-var
-   t : Windows.TSystemTime;
-begin
-   { we need the time set privilege   }
-   { so this function crash currently }
-   {!!!!!}
-   GetLocalTime(t);
-   t.wHour:=hour;
-   t.wMinute:=minute;
-   t.wSecond:=second;
-   t.wMilliSeconds:=sec100*10;
-   SetLocalTime(t);
+  DecodeTime(Now,Hour,Minute,Second,Sec100);
+  Sec100:=Sec100 div 10;
 end;
 
 
@@ -346,6 +281,7 @@ End;
 var
   lastdosexitcode : word;
 
+{$ifdef MSWindows}
 procedure exec(const path : pathstr;const comline : comstr);
 var
   SI: TStartupInfo;
@@ -380,7 +316,36 @@ begin
   CloseHandle(Proc);
   LastDosExitCode:=l;
 end;
-
+{$endif MSWindows}
+{$ifdef Linux}
+Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
+var
+  pid,status : longint;
+Begin
+  LastDosExitCode:=0;
+  pid:=Fork;
+  if pid=0 then
+   begin
+   {The child does the actual exec, and then exits}
+     Execl(@Path[1],@ComLine[1]);
+   {If the execve fails, we return an exitvalue of 127, to let it be known}
+     __exit(127);
+   end
+  else
+   if pid=-1 then         {Fork failed}
+    begin
+      DosError:=8;
+      exit
+    end;
+{We're in the parent, let's wait.}
+  WaitPid(Pid,@Status,0);
+  LastDosExitCode:=Status; // WaitPid and result-convert
+  if (LastDosExitCode>=0) and (LastDosExitCode<>127) then
+   DosError:=0
+  else
+   DosError:=8; // perhaps one time give an better error
+End;
+{$endif Linux}
 
 function dosexitcode : word;
 begin
@@ -388,6 +353,11 @@ begin
 end;
 
 
+procedure swapvectors;
+begin
+end;
+
+
 procedure getcbreak(var breakvalue : boolean);
 begin
 { !! No Win32 Function !! }
@@ -416,141 +386,98 @@ end;
                                --- Disk ---
 ******************************************************************************}
 
-function diskfree(drive : byte) : longint;
+{$ifdef Linux]
+{
+  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
-  disk : array[1..4] of char;
-  secs,bytes,
-  free,total : DWord;
+  Drives   : byte = 4;
+var
+  DriveStr : array[4..26] of pchar;
+
+Procedure AddDisk(const path:string);
 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 GetDiskFreeSpace(@disk,secs,bytes,free,total) then
-   diskfree:=free*secs*bytes
-  else
-   diskfree:=-1;
+  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 disksize(drive : byte) : longint;
+Function DiskFree(Drive: Byte): int64;
 var
-  disk : array[1..4] of char;
-  secs,bytes,
-  free,total : DWord;
-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 GetDiskFreeSpace(@disk,secs,bytes,free,total) then
-   disksize:=total*secs*bytes
+  fs : tstatfs;
+Begin
+  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (statfs(fixdrivestr[drive],fs)=0)) or
+     ((not (drivestr[Drive]=nil)) and (statfs(drivestr[drive],fs)=0)) then
+   Diskfree:=int64(fs.f_bavail)*int64(fs.f_bsize)
   else
-   disksize:=-1;
-end;
-
+   Diskfree:=-1;
+End;
 
-{******************************************************************************
-                         --- Findfirst FindNext ---
-******************************************************************************}
+Function DiskSize(Drive: Byte): int64;
+var
+  fs : tstatfs;
+Begin
+  if ((Drive<4) and (not (fixdrivestr[Drive]=nil)) and (statfs(fixdrivestr[drive],fs)=0)) or
+     ((not (drivestr[Drive]=nil)) and (statfs(drivestr[drive],fs)=0)) then
+   Disksize:=int64(fs.f_blocks)*int64(fs.f_bsize)
+  else
+   Disksize:=-1;
+End;
 
-{ Needed kernel calls }
-   function FindFirstFile (lpFileName: PChar; var lpFindFileData: TWIN32FindData): THandle;stdcall;
-     external 'Kernel32.dll' name 'FindFirstFileA';
-   function FindNextFile  (hFindFile: THandle; var lpFindFileData: TWIN32FindData): Boolean;stdcall;
-     external 'Kernel32.dll' name 'FindNextFileA';
-   function FindCloseFile (hFindFile: THandle): Boolean;stdcall;
-     external 'Kernel32.dll' name 'FindClose';
+{$else linux}
 
-Procedure StringToPchar (Var S : String);
-Var L : Longint;
+function diskfree(drive : byte) : int64;
 begin
-  L:=ord(S[0]);
-  Move (S[1],S[0],L);
-  S[L]:=#0;
+  DiskFree:=SysUtils.DiskFree(drive);
 end;
 
 
-procedure FindMatch(var f:searchrec);
-Var
-  TheAttr : Longint;
+function disksize(drive : byte) : int64;
 begin
-  TheAttr:=DosToWinAttr(F.Attr);
-{ Find file with correct attribute }
-  While (F.W32FindData.dwFileAttributes and TheAttr)=0 do
-   begin
-     if not FindNextFile (F.FindHandle,F.W32FindData) then
-      begin
-        DosError:=Last2DosError(GetLastError);
-        exit;
-      end;
-   end;
-{ Convert some attributes back }
-  f.size:=F.W32FindData.NFileSizeLow;
-  f.attr:=WinToDosAttr(F.W32FindData.dwFileAttributes);
-  WinToDosTime(F.W32FindData.ftLastWriteTime,f.Time);
-  f.Name:=StrPas(@F.W32FindData.cFileName);
+  DiskSize:=SysUtils.DiskSize(drive);
 end;
 
+{$endif linux}
+
+{******************************************************************************
+                         --- Findfirst FindNext ---
+******************************************************************************}
 
 procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
 begin
-{ no error }
-  doserror:=0;
-  F.Name:=Path;
-  F.Attr:=attr;
-  StringToPchar(f.name);
-{ FindFirstFile is a Win32 Call. }
-  F.FindHandle:=FindFirstFile (pchar(@f.Name),F.W32FindData);
-  If longint(F.FindHandle)=longint(Invalid_Handle_value) then
-   begin
-     DosError:=Last2DosError(GetLastError);
-     exit;
-   end;
-{ Find file with correct attribute }
-  FindMatch(f);
+  DosError:=SysUtils.FindFirst(Path,Attr,f);
 end;
 
 
 procedure findnext(var f : searchRec);
 begin
-{ no error }
-  doserror:=0;
-  if not FindNextFile (F.FindHandle,F.W32FindData) then
-   begin
-     DosError:=Last2DosError(GetLastError);
-     exit;
-   end;
-{ Find file with correct attribute }
-  FindMatch(f);
-end;
-
-
-procedure swapvectors;
-begin
+  DosError:=Sysutils.FindNext(f);
 end;
 
 
 Procedure FindClose(Var f: SearchRec);
 begin
-  If longint(F.FindHandle)<>longint(Invalid_Handle_value) then
-   FindCloseFile(F.FindHandle);
+  Sysutils.FindClose(f);
 end;
 
 
@@ -558,15 +485,6 @@ end;
                                --- File ---
 ******************************************************************************}
 
-   function GetFileTime(h : longint;creation,lastaccess,lastwrite : PFileTime) : boolean;stdcall;
-     external 'Kernel32.dll' name 'GetFileTime';
-   function SetFileTime(h : longint;creation,lastaccess,lastwrite : PFileTime) : boolean;stdcall;
-     external 'Kernel32.dll' name 'SetFileTime';
-   function SetFileAttributes(lpFileName : pchar;dwFileAttributes : longint) : boolean;stdcall;
-     external 'Kernel32.dll' name 'SetFileAttributesA';
-   function GetFileAttributes(lpFileName : pchar) : longint;stdcall;
-     external 'Kernel32.dll' name 'GetFileAttributesA';
-
 procedure fsplit(path : pathstr;var dir : dirstr;var name : namestr;var ext : extstr);
 var
    p1,i : longint;
@@ -728,43 +646,58 @@ begin
 end;
 
 
-procedure getftime(var f;var time : longint);
-var
-   ft : TFileTime;
+procedure getftime(var f;var tim : longint);
 begin
-  if GetFileTime(filerec(f).Handle,nil,nil,@ft) and
-     WinToDosTime(ft,time) then
-    exit
-  else
-    time:=0;
+  tim:=FileGetDate(filerec(f).handle);
 end;
 
 
 procedure setftime(var f;time : longint);
-var
-  ft : TFileTime;
 begin
-  if DosToWinTime(time,ft) then
-   SetFileTime(filerec(f).Handle,nil,nil,@ft);
+  FileSetDate(filerec(f).name,Time);
 end;
 
 
+{$ifdef linux}
+procedure getfattr(var f;var attr : word);
+Var
+  info : tstatbuf;
+  LinAttr : longint;
+Begin
+  DosError:=0;
+  if (FStat(filerec(f).handle,info)<>0) then
+   begin
+     Attr:=0;
+     DosError:=3;
+     exit;
+   end
+  else
+   LinAttr:=Info.st_Mode;
+  if S_ISDIR(LinAttr) then
+   Attr:=$10
+  else
+   Attr:=$20;
+  if Access(@filerec(f).name,W_OK)<>0 then
+   Attr:=Attr or $1;
+  if (not S_ISDIR(LinAttr)) and (filerec(f).name[0]='.')  then
+   Attr:=Attr or $2;
+end;
+{$else}
 procedure getfattr(var f;var attr : word);
 var
    l : longint;
 begin
-  l:=GetFileAttributes(filerec(f).name);
-  if l=longint($ffffffff) then
-   doserror:=getlasterror;
+  l:=FileGetAttr(filerec(f).handle);
   attr:=l;
 end;
+{$endif}
 
 
 procedure setfattr(var f;attr : word);
 begin
-  doserror:=0;
-  if not(SetFileAttributes(filerec(f).name,attr)) then
-    doserror:=getlasterror;
+{$ifndef linux}
+  FileSetAttr(filerec(f).handle,attr);
+{$endif}
 end;
 
 
@@ -777,6 +710,7 @@ end;
   terminated by a #0
 }
 
+{$ifdef MSWindows}
    function GetEnvironmentStrings : pchar;stdcall;
      external 'Kernel32.dll' name 'GetEnvironmentStringsA';
    function FreeEnvironmentStrings(p : pchar) : boolean;stdcall;
@@ -850,6 +784,26 @@ begin
      end;
    FreeEnvironmentStrings(p);
 end;
+{$else}
+
+function envcount : longint;
+begin
+   envcount:=0;
+end;
+
+
+Function  EnvStr(index: integer): string;
+begin
+   envstr:='';
+end;
+
+
+Function  GetEnv(envvar: string): string;
+begin
+   getenv:=GetEnvironmentVariable(envvar);
+end;
+
+{$endif}
 
 
 {******************************************************************************
@@ -872,7 +826,10 @@ End;
 end.
 {
   $Log$
-  Revision 1.4  2000-09-24 21:19:50  peter
+  Revision 1.5  2001-06-03 20:21:08  peter
+    * Kylix fixes, mostly case names of units
+
+  Revision 1.4  2000/09/24 21:19:50  peter
     * delphi compile fixes
 
   Revision 1.3  2000/09/24 15:06:15  peter

+ 6 - 3
compiler/globals.pas

@@ -41,7 +41,7 @@ interface
       doscalls,
 {$endif}
 {$ifdef Delphi}
-      sysutils,
+      SysUtils,
       dmisc,
 {$else}
       strings,
@@ -972,7 +972,7 @@ implementation
       {$ifdef GETENVOK}
         {$undef GETENVOK}
       {$else}
-        GetEnvPchar:=StrPNew(Dos.Getenv(envname));
+        GetEnvPchar:=StrPNew({$ifdef delphi}DMisc{$else}Dos{$endif}.Getenv(envname));
       {$endif}
       end;
 
@@ -1282,7 +1282,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.35  2001-05-30 21:35:48  peter
+  Revision 1.36  2001-06-03 20:21:08  peter
+    * Kylix fixes, mostly case names of units
+
+  Revision 1.35  2001/05/30 21:35:48  peter
     * netware patches for copyright, screenname, threadname directives
 
   Revision 1.34  2001/05/12 12:11:31  peter

+ 5 - 2
compiler/i386/cpuinfo.pas

@@ -20,7 +20,7 @@
 
  ****************************************************************************
 }
-Unit CPUInfo;
+Unit cpuinfo;
 
 {$i defines.inc}
 
@@ -52,7 +52,10 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.2  2001-02-08 13:09:03  jonas
+  Revision 1.3  2001-06-03 20:21:08  peter
+    * Kylix fixes, mostly case names of units
+
+  Revision 1.2  2001/02/08 13:09:03  jonas
     * fixed web bug 1396: tpointerord is now a cardinal instead of a longint,
       but added a hack in ncnv so that pointer(-1) still works
 

+ 7 - 4
compiler/messages.pas

@@ -20,7 +20,7 @@
 
  ****************************************************************************
 }
-unit Messages;
+unit messages;
 
 {$i defines.inc}
 
@@ -443,15 +443,18 @@ end;
 end.
 {
   $Log$
-  Revision 1.9  2001-05-27 14:30:55  florian
+  Revision 1.10  2001-06-03 20:21:08  peter
+    * Kylix fixes, mostly case names of units
+
+  Revision 1.9  2001/05/27 14:30:55  florian
     + some widestring stuff added
 
   Revision 1.8  2001/04/21 13:32:07  peter
     * remove endless loop with replacements (merged)
 
   Revision 1.7  2001/04/14 16:05:41  jonas
-    * allow a single replacement string to be substituted more than once per
-      message (already used in assembler reader messages for "fsub x" etc.
+    * allow a single replacement string to be substituted more than once per
+      message (already used in assembler reader messages for "fsub x" etc.
       transformations) (merged)
 
   Revision 1.6  2001/03/10 13:19:10  peter

+ 39 - 0
compiler/ppc.conf

@@ -0,0 +1,39 @@
+-$A8
+-$B-
+-$C+
+-$D+
+-$E-
+-$F-
+-$G+
+-$H+
+-$I+
+-$J-
+-$K-
+-$L+
+-$M-
+-$N+
+-$O+
+-$P+
+-$Q-
+-$R-
+-$S-
+-$T-
+-$U-
+-$V+
+-$W-
+-$X+
+-$YD
+-$Z1
+-cg
+-H+
+-W+
+-M
+-$M16384,1048576
+-K$00400000
+-E"."
+-N"."
+-U"i386:targets"
+-O"i386:targets"
+-I"i386:targets"
+-R"i386:targets"
+-DDELPHI;i386

+ 5 - 1
compiler/systems.pas

@@ -569,12 +569,16 @@ begin
 end;
 
 
+initialization
 finalization
   DeregisterInfos;
 end.
 {
   $Log$
-  Revision 1.18  2001-06-03 15:15:31  peter
+  Revision 1.19  2001-06-03 20:21:08  peter
+    * Kylix fixes, mostly case names of units
+
+  Revision 1.18  2001/06/03 15:15:31  peter
     * dllprt0 stub for linux shared libs
     * pass -init and -fini for linux shared libs
     * libprefix splitted into staticlibprefix and sharedlibprefix