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

* workaround for OS/2 bug - check for 64kB border crossing in parameters for DosExecPgm

Browse Source 
git-svn-id: trunk@1861 -
This commit is contained in:
Tomas Hajny 2005-12-01 22:07:32 +00:00
parent 22ff909af8
commit f9e28f363d
2 changed files with 28 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
rtl/os2/dos.pas
View File

@ -143,7 +143,7 @@ end;
procedure Exec (const Path: PathStr; const ComLine: ComStr);
{Execute a program.}
var Args: PByteArray;
var Args0, Args: PByteArray;
ArgSize: word;
Res: TResultCodes;
ObjName: string;
@ -157,15 +157,23 @@ var Args: PByteArray;
CISize: cardinal;
Prio: byte;
const
MaxArgsSize = 2048; (* Amount of memory reserved for arguments in bytes. *)
MaxArgsSize = 3072; (* Amount of memory reserved for arguments in bytes. *)
begin
{ LastDosExitCode := Exec (Path, ExecRunFlags (ExecFlags), efDefault, ComLine);}
QName := FExpand (Path);
if ComLine = '' then
Args := nil
begin
Args0 := nil;
Args := nil;
end
else
begin
GetMem (Args, MaxArgsSize);
GetMem (Args0, MaxArgsSize);
Args := Args0;
(* Work around a bug in OS/2 - argument to DosExecPgm *)
(* should not cross 64K boundary. *)
if ((PtrUInt (Args) + 1024) and $FFFF) < 1024 then
Inc (Args, 1024);
ArgSize := 0;
Move (QName [1], Args^ [ArgSize], Length (QName));
Inc (ArgSize, Length (QName));
@ -230,8 +238,8 @@ begin
if RC <> 0 then
LastDosExitCode := 0; (* Needed for TP/BP compatibility *)
DosError := RC;
if Args <> nil then
FreeMem (Args, MaxArgsSize);
if Args0 <> nil then
FreeMem (Args0, MaxArgsSize);
end;

20
rtl/os2/sysutils.pp
View File

@ -911,14 +911,14 @@ var
Prio: byte;
E: EOSError;
CommandLine: ansistring;
Args: PByteArray;
Args0, Args: PByteArray;
ObjNameBuf: PChar;
ArgSize: word;
Res: TResultCodes;
ObjName: shortstring;
const
MaxArgsSize = 2048; (* Amount of memory reserved for arguments in bytes. *)
MaxArgsSize = 3072; (* Amount of memory reserved for arguments in bytes. *)
ObjBufSize = 512;
begin
@ -926,10 +926,18 @@ begin
GetMem (ObjNameBuf, ObjBufSize);
FillChar (ObjNameBuf^, ObjBufSize, 0);
if ComLine = '' then
Args := nil
begin
Args0 := nil;
Args := nil;
end
else
begin
GetMem (Args, MaxArgsSize);
GetMem (Args0, MaxArgsSize);
Args := Args0;
(* Work around a bug in OS/2 - argument to DosExecPgm *)
(* should not cross 64K boundary. *)
if ((PtrUInt (Args) + 1024) and $FFFF) < 1024 then
Inc (Args, 1024);
ArgSize := 0;
Move (Path [1], Args^ [ArgSize], Length (Path));
Inc (ArgSize, Length (Path));
@ -943,8 +951,8 @@ begin
Args^ [ArgSize] := 0;
end;
Result := DosExecPgm (ObjNameBuf, ObjBufSize, 0, Args, nil, Res, PChar (Path));
if Args <> nil then
FreeMem (Args, MaxArgsSize);
if Args0 <> nil then
FreeMem (Args0, MaxArgsSize);
if Result = 0 then
begin
Result := Res.ExitCode;