Ver Fonte

Amicommon: use THandle/BPTR instead of LongInt (needed for 64 bit)

git-svn-id: trunk@35030 -
marcus há 8 anos atrás
pai
commit
092244309a

+ 21 - 21
rtl/amicommon/dos.pp

@@ -100,7 +100,7 @@ const
 function PathConv(path: string): string; external name 'PATHCONV';
 function PathConv(path: string): string; external name 'PATHCONV';
 
 
 function dosLock(const name: String;
 function dosLock(const name: String;
-                 accessmode: Longint) : LongInt;
+                 accessmode: Longint) : BPTR;
 var
 var
  buffer: array[0..255] of Char;
  buffer: array[0..255] of Char;
 begin
 begin
@@ -111,7 +111,7 @@ end;
 
 
 function BADDR(bval: PtrInt): Pointer; Inline;
 function BADDR(bval: PtrInt): Pointer; Inline;
 begin
 begin
-  {$if defined(AROS)}  // deactivated for now //and (not defined(AROS_FLAVOUR_BINCOMPAT))} 
+  {$if defined(AROS)}  // deactivated for now //and (not defined(AROS_FLAVOUR_BINCOMPAT))}
   BADDR := Pointer(bval);
   BADDR := Pointer(bval);
   {$else}
   {$else}
   BADDR:=Pointer(bval Shl 2);
   BADDR:=Pointer(bval Shl 2);
@@ -491,7 +491,7 @@ procedure Exec(const Path: PathStr; const ComLine: ComStr);
 var
 var
   tmpPath: array[0..515] of char;
   tmpPath: array[0..515] of char;
   result : longint;
   result : longint;
-  tmpLock: longint;
+  tmpLock: BPTR;
 begin
 begin
   DosError:= 0;
   DosError:= 0;
   LastDosExitCode:=0;
   LastDosExitCode:=0;
@@ -563,10 +563,10 @@ end;
 var
 var
   DeviceList: array[0..26] of string[20];
   DeviceList: array[0..26] of string[20];
   NumDevices: Integer = 0;
   NumDevices: Integer = 0;
-  
+
 const
 const
   IllegalDevices: array[0..12] of string =(
   IllegalDevices: array[0..12] of string =(
-                   'PED:',  
+                   'PED:',
                    'PRJ:',
                    'PRJ:',
                    'PIPE:',   // Pipes
                    'PIPE:',   // Pipes
                    'XPIPE:',  // Extented Pipe
                    'XPIPE:',  // Extented Pipe
@@ -649,7 +649,7 @@ end;
 //
 //
 function DiskSize(Drive: AnsiString): Int64;
 function DiskSize(Drive: AnsiString): Int64;
 var
 var
-  DirLock: LongInt;
+  DirLock: BPTR;
   Inf: TInfoData;
   Inf: TInfoData;
   OldWinPtr: Pointer;
   OldWinPtr: Pointer;
 begin
 begin
@@ -679,7 +679,7 @@ end;
 //
 //
 function DiskFree(Drive: AnsiString): Int64;
 function DiskFree(Drive: AnsiString): Int64;
 var
 var
-  DirLock: LongInt;
+  DirLock: BPTR;
   Inf: TInfoData;
   Inf: TInfoData;
   OldWinPtr: Pointer;
   OldWinPtr: Pointer;
 begin
 begin
@@ -820,17 +820,17 @@ begin
 
 
   repeat
   repeat
     p1:=pos(';',dirlist);
     p1:=pos(';',dirlist);
-    if p1<>0 then 
+    if p1<>0 then
     begin
     begin
       newdir:=Copy(dirlist,1,p1-1);
       newdir:=Copy(dirlist,1,p1-1);
       Delete(dirlist,1,p1);
       Delete(dirlist,1,p1);
-    end 
-    else 
+    end
+    else
     begin
     begin
       newdir:=dirlist;
       newdir:=dirlist;
       dirlist:='';
       dirlist:='';
     end;
     end;
-    if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator, DriveSeparator])) then 
+    if (newdir<>'') and (not (newdir[length(newdir)] in [DirectorySeparator, DriveSeparator])) then
       newdir:=newdir+DirectorySeparator;
       newdir:=newdir+DirectorySeparator;
     FindFirst(newdir+path,anyfile and not(directory),tmpSR);
     FindFirst(newdir+path,anyfile and not(directory),tmpSR);
     if doserror=0 then
     if doserror=0 then
@@ -851,7 +851,7 @@ Procedure getftime (var f; var time : longint);
 var
 var
     FInfo : pFileInfoBlock;
     FInfo : pFileInfoBlock;
     FTime : Longint;
     FTime : Longint;
-    FLock : Longint;
+    FLock : BPTR;
     Str   : String;
     Str   : String;
     i     : integer;
     i     : integer;
 begin
 begin
@@ -889,7 +889,7 @@ end;
     Str: String;
     Str: String;
     i: Integer;
     i: Integer;
     Days, Minutes,Ticks: longint;
     Days, Minutes,Ticks: longint;
-    FLock: longint;
+    FLock: BPTR;
   Begin
   Begin
     new(DateStamp);
     new(DateStamp);
 {$ifdef FPC_ANSI_TEXTFILEREC}
 {$ifdef FPC_ANSI_TEXTFILEREC}
@@ -920,7 +920,7 @@ end;
 procedure getfattr(var f; var attr : word);
 procedure getfattr(var f; var attr : word);
 var
 var
     info : pFileInfoBlock;
     info : pFileInfoBlock;
-    MyLock : Longint;
+    MyLock : BPTR;
     flags: word;
     flags: word;
     Str: String;
     Str: String;
     i: integer;
     i: integer;
@@ -968,7 +968,7 @@ begin
 procedure setfattr(var f; attr : word);
 procedure setfattr(var f; attr : word);
 var
 var
   flags: longint;
   flags: longint;
-  tmpLock : longint;
+  tmpLock : BPTR;
 {$ifndef FPC_ANSI_TEXTFILEREC}
 {$ifndef FPC_ANSI_TEXTFILEREC}
   r : rawbytestring;
   r : rawbytestring;
 {$endif not FPC_ANSI_TEXTFILEREC}
 {$endif not FPC_ANSI_TEXTFILEREC}
@@ -1024,7 +1024,7 @@ begin
 
 
    { Alternatively, this could use PIPE: handler on systems which
    { Alternatively, this could use PIPE: handler on systems which
      have this by default (not the case on classic Amiga), but then
      have this by default (not the case on classic Amiga), but then
-     the child process should be started async, which for a simple 
+     the child process should be started async, which for a simple
      Path command probably isn't worth the trouble. (KB) }
      Path command probably isn't worth the trouble. (KB) }
    assign(f,'T:'+HexStr(FindTask(nil))+'_path.tmp');
    assign(f,'T:'+HexStr(FindTask(nil))+'_path.tmp');
    rewrite(f);
    rewrite(f);
@@ -1162,7 +1162,7 @@ begin
     if EnvList[Index].Local then
     if EnvList[Index].Local then
       EnvStr := EnvList[Index].Name + '=' + EnvList[Index].Value
       EnvStr := EnvList[Index].Name + '=' + EnvList[Index].Value
     else
     else
-      EnvStr := EnvList[Index].Name + '=' + GetEnvFromEnv(EnvList[Index].Name);  
+      EnvStr := EnvList[Index].Name + '=' + GetEnvFromEnv(EnvList[Index].Name);
   end;
   end;
 end;
 end;
 
 
@@ -1179,8 +1179,8 @@ begin
       StrOfPaths := GetPathString;
       StrOfPaths := GetPathString;
     GetEnv := StrOfPaths;
     GetEnv := StrOfPaths;
   end else
   end else
-  begin    
-    InitEnvironmentStrings;  
+  begin
+    InitEnvironmentStrings;
     for i := 0 to High(EnvList) do
     for i := 0 to High(EnvList) do
     begin
     begin
       if EnvVarName = UpCase(EnvList[i].Name) then
       if EnvVarName = UpCase(EnvList[i].Name) then
@@ -1190,9 +1190,9 @@ begin
         else
         else
           GetEnv := GetEnvFromEnv(EnvList[i].Name);
           GetEnv := GetEnvFromEnv(EnvList[i].Name);
         Break;
         Break;
-      end;  
+      end;
     end;
     end;
-  end;  
+  end;
 end;
 end;
 
 
 begin
 begin

+ 3 - 3
rtl/amicommon/sysdir.inc

@@ -20,7 +20,7 @@
 procedure do_mkdir(const s : rawbytestring);
 procedure do_mkdir(const s : rawbytestring);
 var
 var
   tmpStr : rawbytestring;
   tmpStr : rawbytestring;
-  tmpLock: LongInt;
+  tmpLock: BPTR;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
   tmpStr:=PathConv(s);
   tmpStr:=PathConv(s);
@@ -50,7 +50,7 @@ end;
 procedure do_ChDir(const s: rawbytestring);
 procedure do_ChDir(const s: rawbytestring);
 var
 var
   tmpStr : rawbytestring;
   tmpStr : rawbytestring;
-  tmpLock: LongInt;
+  tmpLock: BPTR;
   FIB    : PFileInfoBlock;
   FIB    : PFileInfoBlock;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
@@ -86,7 +86,7 @@ end;
 procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 procedure do_GetDir (DriveNr: byte; var Dir: RawByteString);
 var
 var
   tmpbuf: array[0..255] of char;
   tmpbuf: array[0..255] of char;
-  lockDir: LongInt;
+  lockDir: BPTR;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
   Dir := '';
   Dir := '';

+ 14 - 14
rtl/amicommon/sysfile.inc

@@ -25,7 +25,7 @@ type
   { manually on exit.                                                  }
   { manually on exit.                                                  }
   PFileList = ^TFileList;
   PFileList = ^TFileList;
   TFileList = record { no packed, must be correctly aligned }
   TFileList = record { no packed, must be correctly aligned }
-    handle   : LongInt;      { Handle to file     }
+    handle   : THandle;      { Handle to file     }
     next     : PFileList;    { Next file in list  }
     next     : PFileList;    { Next file in list  }
     buffered : boolean;      { used buffered I/O? }
     buffered : boolean;      { used buffered I/O? }
   end;
   end;
@@ -37,7 +37,7 @@ var
 procedure CloseList(l: PFileList);
 procedure CloseList(l: PFileList);
 var
 var
   tmpNext   : PFileList;
   tmpNext   : PFileList;
-  tmpHandle : LongInt;
+  tmpHandle : THandle;
 begin
 begin
   if l=nil then exit;
   if l=nil then exit;
   ObtainSemaphore(ASYS_fileSemaphore);
   ObtainSemaphore(ASYS_fileSemaphore);
@@ -63,7 +63,7 @@ begin
 end;
 end;
 
 
 { Function to be called to add a file to the opened file list }
 { Function to be called to add a file to the opened file list }
-procedure AddToList(var l: PFileList; h: LongInt); alias: 'ADDTOLIST'; [public];
+procedure AddToList(var l: PFileList; h: THandle); alias: 'ADDTOLIST'; [public];
 var
 var
   p     : PFileList;
   p     : PFileList;
   inList: Boolean;
   inList: Boolean;
@@ -101,7 +101,7 @@ begin
 end;
 end;
 
 
 { Function to be called to remove a file from the list }
 { Function to be called to remove a file from the list }
-function RemoveFromList(var l: PFileList; h: LongInt): boolean; alias: 'REMOVEFROMLIST'; [public];
+function RemoveFromList(var l: PFileList; h: THandle): boolean; alias: 'REMOVEFROMLIST'; [public];
 var
 var
   p      : PFileList;
   p      : PFileList;
   inList : Boolean;
   inList : Boolean;
@@ -135,7 +135,7 @@ begin
 end;
 end;
 
 
 { Function to check if file is in the list }
 { Function to check if file is in the list }
-function CheckInList(var l: PFileList; h: LongInt): pointer; alias: 'CHECKINLIST'; [public];
+function CheckInList(var l: PFileList; h: THandle): pointer; alias: 'CHECKINLIST'; [public];
 var
 var
   p      : PFileList;
   p      : PFileList;
   inList : Pointer;
   inList : Pointer;
@@ -169,7 +169,7 @@ end;
 ****************************************************************************}
 ****************************************************************************}
 
 
 { close a file from the handle value }
 { close a file from the handle value }
-procedure do_close(handle : longint);
+procedure do_close(handle : THandle);
 begin
 begin
   if RemoveFromList(ASYS_fileList,handle) then begin
   if RemoveFromList(ASYS_fileList,handle) then begin
     { Do _NOT_ check CTRL_C on Close, because it will conflict
     { Do _NOT_ check CTRL_C on Close, because it will conflict
@@ -202,7 +202,7 @@ begin
     dosError2InOut(IoErr);
     dosError2InOut(IoErr);
 end;
 end;
 
 
-function do_write(h: longint; addr: pointer; len: longint) : longint;
+function do_write(h: THandle; addr: pointer; len: longint) : longint;
 var dosResult: LongInt;
 var dosResult: LongInt;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
@@ -222,7 +222,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-function do_read(h: longint; addr: pointer; len: longint) : longint;
+function do_read(h: THandle; addr: pointer; len: longint) : longint;
 var dosResult: LongInt;
 var dosResult: LongInt;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
@@ -242,7 +242,7 @@ begin
   end
   end
 end;
 end;
 
 
-function do_filepos(handle: longint) : longint;
+function do_filepos(handle: THandle) : longint;
 var dosResult: LongInt;
 var dosResult: LongInt;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
@@ -259,7 +259,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure do_seek(handle, pos: longint);
+procedure do_seek(handle: THandle; pos: longint);
 begin
 begin
   checkCTRLC;
   checkCTRLC;
   if CheckInList(ASYS_fileList,handle)<>nil then begin
   if CheckInList(ASYS_fileList,handle)<>nil then begin
@@ -270,7 +270,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-function do_seekend(handle: longint):longint;
+function do_seekend(handle: THandle):longint;
 var dosResult: LongInt;
 var dosResult: LongInt;
 begin
 begin
   checkCTRLC;
   checkCTRLC;
@@ -332,7 +332,7 @@ begin
 end;
 end;
 
 
 { truncate at a given position }
 { truncate at a given position }
-procedure do_truncate(handle, pos: longint);
+procedure do_truncate(handle: THandle; pos: longint);
 begin
 begin
   checkCTRLC;
   checkCTRLC;
   if CheckInList(ASYS_fileList,handle)<>nil then begin
   if CheckInList(ASYS_fileList,handle)<>nil then begin
@@ -352,7 +352,7 @@ procedure do_open(var f;p:pchar;flags:longint; pchangeable: boolean);
   when (flags and $1000) there is no check for close (needed for textfiles)
   when (flags and $1000) there is no check for close (needed for textfiles)
 }
 }
 var
 var
-  handle   : LongInt;
+  handle   : THandle;
   openflags: LongInt;
   openflags: LongInt;
   tmpStr   : array[0..255] of Char;
   tmpStr   : array[0..255] of Char;
 begin
 begin
@@ -419,7 +419,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-function do_isdevice(handle: thandle): boolean;
+function do_isdevice(handle: THandle): boolean;
 begin
 begin
   if (handle=StdOutputHandle) or (handle=StdInputHandle) or
   if (handle=StdOutputHandle) or (handle=StdInputHandle) or
      (handle=StdErrorHandle) then
      (handle=StdErrorHandle) then

+ 1 - 5
rtl/amicommon/sysosh.inc

@@ -17,11 +17,7 @@
 
 
 {Platform specific information}
 {Platform specific information}
 type
 type
-{$ifdef CPU64}
-  THandle = Int64;
-{$else CPU64}
-  THandle = LongInt;
-{$endif CPU64}
+  THandle = PtrInt;
   TThreadID = THandle;
   TThreadID = THandle;
 
 
   PRTLCriticalSection = ^TRTLCriticalSection;
   PRTLCriticalSection = ^TRTLCriticalSection;

+ 9 - 9
rtl/amicommon/sysutils.pp

@@ -87,7 +87,7 @@ var
   ASYS_FileList: Pointer; external name 'ASYS_FILELIST';
   ASYS_FileList: Pointer; external name 'ASYS_FILELIST';
 
 
 
 
-function BADDR(bval: LongInt): Pointer; Inline;
+function BADDR(bval: BPTR): Pointer; Inline;
 begin
 begin
   {$if defined(AROS)}  // deactivated for now //and (not defined(AROS_FLAVOUR_BINCOMPAT))}
   {$if defined(AROS)}  // deactivated for now //and (not defined(AROS_FLAVOUR_BINCOMPAT))}
   BADDR := Pointer(bval);
   BADDR := Pointer(bval);
@@ -105,7 +105,7 @@ begin
   {$endif}
   {$endif}
 end;
 end;
 
 
-function BSTR2STRING(s : LongInt): PChar; Inline;
+function BSTR2STRING(s : BPTR): PChar; Inline;
 begin
 begin
   {$if defined(AROS)}  // deactivated for now //and (not defined(AROS_FLAVOUR_BINCOMPAT))}
   {$if defined(AROS)}  // deactivated for now //and (not defined(AROS_FLAVOUR_BINCOMPAT))}
   BSTR2STRING:=PChar(s);
   BSTR2STRING:=PChar(s);
@@ -369,7 +369,7 @@ end;
 
 
 function FileAge (const FileName : RawByteString): Longint;
 function FileAge (const FileName : RawByteString): Longint;
 var
 var
-  tmpLock: Longint;
+  tmpLock: BPTR;
   tmpFIB : PFileInfoBlock;
   tmpFIB : PFileInfoBlock;
   tmpDateTime: TDateTime;
   tmpDateTime: TDateTime;
   validFile: boolean;
   validFile: boolean;
@@ -397,7 +397,7 @@ end;
 
 
 function FileExists (const FileName : RawByteString) : Boolean;
 function FileExists (const FileName : RawByteString) : Boolean;
 var
 var
-  tmpLock: LongInt;
+  tmpLock: BPTR;
   tmpFIB : PFileInfoBlock;
   tmpFIB : PFileInfoBlock;
   SystemFileName: RawByteString;
   SystemFileName: RawByteString;
 begin
 begin
@@ -434,7 +434,7 @@ begin
   FillChar(Anchor^,sizeof(TAnchorPath),#0);
   FillChar(Anchor^,sizeof(TAnchorPath),#0);
 
 
   if MatchFirst(pchar(tmpStr),Anchor)<>0 then exit;
   if MatchFirst(pchar(tmpStr),Anchor)<>0 then exit;
-  Rslt.FindHandle := longint(Anchor);
+  Rslt.FindHandle := THandle(Anchor);
 
 
   with Anchor^.ap_Info do begin
   with Anchor^.ap_Info do begin
     Name := fib_FileName;
     Name := fib_FileName;
@@ -629,7 +629,7 @@ end;
 //
 //
 function DiskSize(Drive: AnsiString): Int64;
 function DiskSize(Drive: AnsiString): Int64;
 var
 var
-  DirLock: LongInt;
+  DirLock: BPTR;
   Inf: TInfoData;
   Inf: TInfoData;
   MyProc: PProcess;
   MyProc: PProcess;
   OldWinPtr: Pointer;
   OldWinPtr: Pointer;
@@ -663,7 +663,7 @@ end;
 //
 //
 function DiskFree(Drive: AnsiString): Int64;
 function DiskFree(Drive: AnsiString): Int64;
 var
 var
-  DirLock: LongInt;
+  DirLock: BPTR;
   Inf: TInfoData;
   Inf: TInfoData;
   MyProc: PProcess;
   MyProc: PProcess;
   OldWinPtr: Pointer;
   OldWinPtr: Pointer;
@@ -695,7 +695,7 @@ end;
 
 
 function DirectoryExists(const Directory: RawByteString): Boolean;
 function DirectoryExists(const Directory: RawByteString): Boolean;
 var
 var
-  tmpLock: LongInt;
+  tmpLock: BPTR;
   FIB    : PFileInfoBlock;
   FIB    : PFileInfoBlock;
   SystemDirName: RawByteString;
   SystemDirName: RawByteString;
 begin
 begin
@@ -846,7 +846,7 @@ var
   tmpPath,
   tmpPath,
   convPath: RawByteString;
   convPath: RawByteString;
   CommandLine: AnsiString;
   CommandLine: AnsiString;
-  tmpLock: longint;
+  tmpLock: BPTR;
 
 
   E: EOSError;
   E: EOSError;
 begin
 begin