paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 18:08:08 +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 dosLock(const name: String;
accessmode: Longint) : LongInt;
accessmode: Longint) : BPTR;
var
buffer: array[0..255] of Char;
begin
@ -111,7 +111,7 @@ end;
function BADDR(bval: PtrInt): Pointer; Inline;
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);
{$else}
BADDR:=Pointer(bval Shl 2);
@ -491,7 +491,7 @@ procedure Exec(const Path: PathStr; const ComLine: ComStr);
var
tmpPath: array[0..515] of char;
result : longint;
tmpLock: longint;
tmpLock: BPTR;
begin
DosError:= 0;
LastDosExitCode:=0;
@ -563,10 +563,10 @@ end;
var
DeviceList: array[0..26] of string[20];
NumDevices: Integer = 0;
const
IllegalDevices: array[0..12] of string =(
'PED:',
'PED:',
'PRJ:',
'PIPE:', // Pipes
'XPIPE:', // Extented Pipe
@ -649,7 +649,7 @@ end;
//
function DiskSize(Drive: AnsiString): Int64;
var
DirLock: LongInt;
DirLock: BPTR;
Inf: TInfoData;
OldWinPtr: Pointer;
begin
@ -679,7 +679,7 @@ end;
//
function DiskFree(Drive: AnsiString): Int64;
var
DirLock: LongInt;
DirLock: BPTR;
Inf: TInfoData;
OldWinPtr: Pointer;
begin
@ -820,17 +820,17 @@ begin
repeat
p1:=pos(';',dirlist);
if p1<>0 then
if p1<>0 then
begin
newdir:=Copy(dirlist,1,p1-1);
Delete(dirlist,1,p1);
end
else
end
else
begin
newdir:=dirlist;
dirlist:='';
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;
FindFirst(newdir+path,anyfile and not(directory),tmpSR);
if doserror=0 then
@ -851,7 +851,7 @@ Procedure getftime (var f; var time : longint);
var
FInfo : pFileInfoBlock;
FTime : Longint;
FLock : Longint;
FLock : BPTR;
Str : String;
i : integer;
begin
@ -889,7 +889,7 @@ end;
Str: String;
i: Integer;
Days, Minutes,Ticks: longint;
FLock: longint;
FLock: BPTR;
Begin
new(DateStamp);
{$ifdef FPC_ANSI_TEXTFILEREC}
@ -920,7 +920,7 @@ end;
procedure getfattr(var f; var attr : word);
var
info : pFileInfoBlock;
MyLock : Longint;
MyLock : BPTR;
flags: word;
Str: String;
i: integer;
@ -968,7 +968,7 @@ begin
procedure setfattr(var f; attr : word);
var
flags: longint;
tmpLock : longint;
tmpLock : BPTR;
{$ifndef FPC_ANSI_TEXTFILEREC}
r : rawbytestring;
{$endif not FPC_ANSI_TEXTFILEREC}
@ -1024,7 +1024,7 @@ begin
{ Alternatively, this could use PIPE: handler on systems which
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) }
assign(f,'T:'+HexStr(FindTask(nil))+'_path.tmp');
rewrite(f);
@ -1162,7 +1162,7 @@ begin
if EnvList[Index].Local then
EnvStr := EnvList[Index].Name + '=' + EnvList[Index].Value
else
EnvStr := EnvList[Index].Name + '=' + GetEnvFromEnv(EnvList[Index].Name);
EnvStr := EnvList[Index].Name + '=' + GetEnvFromEnv(EnvList[Index].Name);
end;
end;
@ -1179,8 +1179,8 @@ begin
StrOfPaths := GetPathString;
GetEnv := StrOfPaths;
end else
begin
InitEnvironmentStrings;
begin
InitEnvironmentStrings;
for i := 0 to High(EnvList) do
begin
if EnvVarName = UpCase(EnvList[i].Name) then
@ -1190,9 +1190,9 @@ begin
else
GetEnv := GetEnvFromEnv(EnvList[i].Name);
Break;
end;
end;
end;
end;
end;
end;
begin

6
rtl/amicommon/sysdir.inc
View File

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

28
rtl/amicommon/sysfile.inc
View File

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

6
rtl/amicommon/sysosh.inc
View File

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

18
rtl/amicommon/sysutils.pp
View File

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