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

Fix EMX rtl compilation

Browse Source 
git-svn-id: trunk@36864 -
This commit is contained in:
pierre 2017-08-08 22:36:16 +00:00
parent fed07e6643
commit d5b314ca52
2 changed files with 59 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
rtl/emx/system.pas
View File

@ -22,9 +22,18 @@ interface
{Link the startup code.}
{$l prt1.o}
{$define FPC_SYSTEM_HAS_SYSDLH}
{$I systemh.inc}
const
(* Are file sizes > 2 GB (64-bit) supported on the current system? *)
FSApi64: boolean = false;
(* Is full Unicode support provided by the underlying OS/2 version available *)
(* and successfully initialized (otherwise dummy routines need to be used). *)
UniAPI: boolean = false;
DosCallsHandle: THandle = THandle (-1);
LineEnding = #13#10;
{ LFNSupport is defined separately below!!! }
DirectorySeparator = '\';
@ -115,6 +124,34 @@ procedure SetDefaultOS2FileType (FType: ShortString);
procedure SetDefaultOS2Creator (Creator: ShortString);
(* Support for tracking I/O errors returned by OS/2 API calls - emulation *)
(* of GetLastError / fpGetError functionality used e.g. in Sysutils. *)
type
TOSErrorWatch = procedure (Error: cardinal);
procedure NoErrorTracking (Error: cardinal);
(* This shall be invoked whenever a non-zero error is returned by OS/2 APIs *)
(* used in the RTL. Direct OS/2 API calls in user programs are not covered! *)
const
OSErrorWatch: TOSErrorWatch = @NoErrorTracking;
type
TDosOpenL = function (FileName: PChar; var Handle: THandle;
var Action: cardinal; InitSize: int64;
Attrib, OpenFlags, FileMode: cardinal;
EA: pointer): cardinal; cdecl;
TDosSetFilePtrL = function (Handle: THandle; Pos: int64; Method: cardinal;
var PosActual: int64): cardinal; cdecl;
TDosSetFileSizeL = function (Handle: THandle; Size: int64): cardinal; cdecl;
var
Sys_DosOpenL: TDosOpenL;
Sys_DosSetFilePtrL: TDosSetFilePtrL;
Sys_DosSetFileSizeL: TDosSetFileSizeL;
implementation
@ -439,6 +476,10 @@ begin
DefaultCreator := Creator;
end;
(* The default handler does not store the OS/2 API error codes. *)
procedure NoErrorTracking (Error: cardinal);
begin
end;
function GetFileHandleCount: longint;
var L1: longint;

37
rtl/emx/sysutils.pp
View File

@ -34,6 +34,8 @@ uses
{ OS has an ansistring/single byte environment variable API }
{$define SYSUTILS_HAS_ANSISTR_ENVVAR_IMPL}
{$DEFINE executeprocuni} (* Only 1 byte version of ExecuteProcess is provided by the OS *)
{ Include platform independent interface part }
{$i sysutilh.inc}
@ -535,7 +537,7 @@ var
SystemFileName: RawByteString;
begin
SystemFileName := ToSingleByteFileSystemEncodedFileName(FileName);
FileOpen := FileCreate(pointer(SystemFileName),ShareMode,Rights);
FileCreate := FileCreate(pointer(SystemFileName),ShareMode,Rights);
end;
function FileRead (Handle: longint; Out Buffer; Count: longint): longint;
@ -693,7 +695,7 @@ var
begin
if os_mode = osOS2 then
begin
SystemEncodedPath:=ToSingleByteEncodedFileName(Path);
SystemEncodedPath:=ToSingleByteFileSystemEncodedFileName(Path);
New (FStat);
Rslt.FindHandle := THandle ($FFFFFFFF);
Count := 1;
@ -705,7 +707,7 @@ begin
Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard);
if (Err = 0) and (Count = 0) then
Err := 18;
FindFirst := -Err;
InternalFindFirst := -Err;
if Err = 0 then
begin
Rslt.ExcludeAttr := 0;
@ -726,7 +728,7 @@ begin
SetCodePage(Name, DefaultFileSystemCodePage, false);
end
else
FindClose (Rslt);
InternalFindClose (Rslt.FindHandle);
Dispose (FStat);
end
else
@ -735,7 +737,7 @@ begin
GetMem (SR, SizeOf (SearchRec));
Rslt.FindHandle := longint(SR);
DOS.FindFirst (Path, Attr, SR^);
FindFirst := -DOS.DosError;
InternalFindFirst := -DOS.DosError;
if DosError = 0 then
begin
Rslt.Time := SR^.Time;
@ -767,7 +769,7 @@ begin
Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^), Count);
if (Err = 0) and (Count = 0) then
Err := 18;
FindNext := -Err;
InternalFindNext := -Err;
if Err = 0 then
begin
Rslt.ExcludeAttr := 0;
@ -795,7 +797,7 @@ begin
if SR <> nil then
begin
DOS.FindNext (SR^);
FindNext := -DosError;
InternalFindNext := -DosError;
if DosError = 0 then
begin
Rslt.Time := SR^.Time;
@ -892,7 +894,7 @@ begin
end;
function FileGetAttr (const FileName: string): longint; assembler;
function FileGetAttr (const FileName: rawbytestring): longint; assembler;
asm
{$IFDEF REGCALL}
mov edx, eax
@ -924,7 +926,7 @@ begin
end ['eax', 'ecx', 'edx'];
end;
function DeleteFile (const FileName: string): boolean;
function DeleteFile (const FileName: rawbytestring): boolean;
var
SystemFileName: RawByteString;
begin
@ -935,12 +937,12 @@ begin
call syscall
mov @result, 0
jc @FDeleteEnd
moc @result, 1
mov @result, 1
@FDeleteEnd:
end ['eax', 'edx'];
end;
function RenameFile (const OldName, NewName: string): boolean;
function RenameFile (const OldName, NewName: rawbytestring): boolean;
var
OldSystemFileName, NewSystemFileName: RawByteString;
Begin
@ -1125,9 +1127,6 @@ end {['eax', 'ecx', 'edx', 'edi']};
Misc Functions
****************************************************************************}
procedure Beep;
begin
end;
{****************************************************************************
@ -1240,7 +1239,7 @@ end;
{$ASMMODE DEFAULT}
function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString;Flags:TExecuteFlags=[]):
function ExecuteProcess (const Path: RawByteString; const ComLine: RawByteString;Flags:TExecuteFlags=[]):
integer;
var
HQ: THandle;
@ -1252,7 +1251,7 @@ var
CISize: cardinal;
Prio: byte;
E: EOSError;
CommandLine: ansistring;
CommandLine: rawbytestring;
begin
if os_Mode = osOS2 then
@ -1308,11 +1307,11 @@ begin
end;
function ExecuteProcess (const Path: AnsiString;
const ComLine: array of AnsiString;Flags:TExecuteFlags=[]): integer;
function ExecuteProcess (const Path: RawByteString;
const ComLine: array of RawByteString;Flags:TExecuteFlags=[]): integer;
var
CommandLine: AnsiString;
CommandLine: RawByteString;
I: integer;
begin