paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-22 04:09:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@35030 -
This commit is contained in:
marcus 2016-12-01 17:55:58 +00:00
parent 7eccbad9d3
commit 092244309a
5 changed files with 48 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
rtl/amicommon/dos.pp
View File

@ -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 end
else 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 begin
InitEnvironmentStrings; 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

6
rtl/amicommon/sysdir.inc
View File

@ -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 := '';

28
rtl/amicommon/sysfile.inc
View File

@ -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

6
rtl/amicommon/sysosh.inc
View File

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

18
rtl/amicommon/sysutils.pp
View File

@ -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