瀏覽代碼

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

git-svn-id: trunk@1861 -
Tomas Hajny 19 年之前
父節點
當前提交
f9e28f363d
共有 2 個文件被更改,包括 28 次插入12 次删除
  1. 14 6
      rtl/os2/dos.pas
  2. 14 6
      rtl/os2/sysutils.pp

+ 14 - 6
rtl/os2/dos.pas

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

+ 14 - 6
rtl/os2/sysutils.pp

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