--- Recording mergeinfo for merge of r29419 into '.':

 U   .
--- Recording mergeinfo for merge of r29429 into '.':
 U   .
--- Recording mergeinfo for merge of r31463 into '.':
 U   .
--- Merging r32084 into '.':
U    utils/pas2jni/ppuparser.pas
--- Recording mergeinfo for merge of r32084 into '.':
 U   .
--- Merging r32539 into '.':
U    utils/pas2jni/writer.pas
--- Recording mergeinfo for merge of r32539 into '.':
 G   .
--- Merging r32560 into '.':
G    utils/pas2jni/ppuparser.pas
G    utils/pas2jni/writer.pas
U    utils/pas2jni/def.pas
--- Recording mergeinfo for merge of r32560 into '.':
 G   .
--- Merging r32561 into '.':
G    utils/pas2jni/writer.pas
--- Recording mergeinfo for merge of r32561 into '.':
 G   .
--- Merging r32563 into '.':
G    utils/pas2jni/writer.pas
G    utils/pas2jni/ppuparser.pas
--- Recording mergeinfo for merge of r32563 into '.':
 G   .
--- Merging r32578 into '.':
G    utils/pas2jni/writer.pas
G    utils/pas2jni/def.pas
G    utils/pas2jni/ppuparser.pas
--- Recording mergeinfo for merge of r32578 into '.':
 G   .
--- Merging r32607 into '.':
G    utils/pas2jni/writer.pas
G    utils/pas2jni/def.pas
G    utils/pas2jni/ppuparser.pas
--- Recording mergeinfo for merge of r32607 into '.':
 G   .
--- Merging r32609 into '.':
G    utils/pas2jni/writer.pas
G    utils/pas2jni/ppuparser.pas
--- Recording mergeinfo for merge of r32609 into '.':
 G   .
--- Merging r32611 into '.':
G    utils/pas2jni/writer.pas
--- Recording mergeinfo for merge of r32611 into '.':
 G   .
--- Merging r32612 into '.':
G    utils/pas2jni/writer.pas
--- Recording mergeinfo for merge of r32612 into '.':
 G   .
--- Merging r32615 into '.':
G    utils/pas2jni/writer.pas
G    utils/pas2jni/def.pas
G    utils/pas2jni/ppuparser.pas
--- Recording mergeinfo for merge of r32615 into '.':
 G   .
--- Merging r32616 into '.':
G    utils/pas2jni/writer.pas
--- Recording mergeinfo for merge of r32616 into '.':
 G   .
--- Merging r32620 into '.':
G    utils/pas2jni/writer.pas
--- Recording mergeinfo for merge of r32620 into '.':
 G   .
--- Merging r32669 into '.':
G    utils/pas2jni/writer.pas
--- Recording mergeinfo for merge of r32669 into '.':
 G   .
--- Merging r32733 into '.':
G    utils/pas2jni/writer.pas
--- Recording mergeinfo for merge of r32733 into '.':
 G   .
--- Merging r32744 into '.':
G    utils/pas2jni/ppuparser.pas
U    utils/pas2jni/pas2jni.pas
--- Recording mergeinfo for merge of r32744 into '.':
 G   .
--- Merging r32747 into '.':
G    utils/pas2jni/ppuparser.pas
--- Recording mergeinfo for merge of r32747 into '.':
 G   .
--- Merging r33005 into '.':
G    utils/pas2jni/writer.pas
--- Recording mergeinfo for merge of r33005 into '.':
 G   .
--- Merging r33072 into '.':
G    utils/pas2jni/writer.pas
--- Recording mergeinfo for merge of r33072 into '.':
 G   .
--- Merging r33083 into '.':
G    utils/pas2jni/def.pas
G    utils/pas2jni/writer.pas
--- Recording mergeinfo for merge of r33083 into '.':
 G   .

# revisions: 29419,29429,31463,32084,32539,32560,32561,32563,32578,32607,32609,32611,32612,32615,32616,32620,32669,32733,32744,32747,33005,33072,33083

git-svn-id: branches/fixes_3_0@33400 -

utils/pas2jni/def.pas

@@ -29,8 +29,9 @@ uses
   Classes, SysUtils, contnrs;
 
 type
-  TDefType = (dtNone, dtUnit, dtClass, dtRecord, dtProc, dtField, dtProp, dtParam, dtVar,
-              dtType, dtConst, dtProcType, dtEnum, dtSet);
+  TDefType = (dtNone, dtUnit, dtClass, dtProc, dtField, dtProp, dtParam, dtVar,
+              dtType, dtConst, dtProcType, dtEnum, dtSet, dtPointer, dtArray,
+              dtJniObject, dtJniEnv);
 
   TDefClass = class of TDef;
   { TDef }
@@ -77,6 +78,8 @@ type
     property AliasName: string read GetAliasName write FAliasName;
   end;
 
+  TClassType = (ctClass, ctInterface, ctObject, ctRecord);
+
   { TClassDef }
 
   TClassDef = class(TDef)
@@ -85,20 +88,17 @@ type
   protected
     procedure SetIsUsed(const AValue: boolean); override;
   public
+    CType: TClassType;
     AncestorClass: TClassDef;
     HasAbstractMethods: boolean;
     HasReplacedItems: boolean;
     ImplementsReplacedItems: boolean;
-    procedure ResolveDefs; override;
-  end;
-
-  TRecordDef = class(TDef)
-  public
     Size: integer;
+    procedure ResolveDefs; override;
   end;
 
   TBasicType = (btVoid, btByte, btShortInt, btWord, btSmallInt, btLongWord, btLongInt, btInt64,
-                btSingle, btDouble, btString, btWideString, btBoolean, btChar, btWideChar, btEnum, btPointer,
+                btSingle, btDouble, btString, btWideString, btBoolean, btChar, btWideChar, btEnum,
                 btGuid);
 
   { TTypeDef }
@@ -110,6 +110,19 @@ type
     BasicType: TBasicType;
   end;
 
+  { TPointerDef }
+
+  TPointerDef = class(TDef)
+  private
+    FHasPtrRef: boolean;
+  protected
+    procedure SetIsUsed(const AValue: boolean); override;
+  public
+    PtrType: TDef;
+    procedure ResolveDefs; override;
+    function IsObjPtr: boolean;
+  end;
+
   { TReplDef }
 
   TReplDef = class(TDef)
@@ -193,6 +206,20 @@ type
     ElType: TTypeDef;
   end;
 
+  { TArrayDef }
+
+  TArrayDef = class(TDef)
+  private
+    FHasElTypeRef: boolean;
+    FHasRTypeRef: boolean;
+  protected
+    procedure SetIsUsed(const AValue: boolean); override;
+  public
+    ElType: TDef;
+    RangeType: TDef;
+    RangeLow, RangeHigh: integer;
+  end;
+
 const
   ReplDefs  = [dtField, dtProp, dtProc];
 
@@ -210,6 +237,41 @@ begin
   Result:=TTypeDef(t1).BasicType = TTypeDef(t2).BasicType;
 end;
 
+{ TArrayDef }
+
+procedure TArrayDef.SetIsUsed(const AValue: boolean);
+begin
+  inherited SetIsUsed(AValue);
+  SetExtUsed(ElType, AValue, FHasElTypeRef);
+  SetExtUsed(RangeType, AValue, FHasRTypeRef);
+end;
+
+{ TPointerDef }
+
+procedure TPointerDef.SetIsUsed(const AValue: boolean);
+begin
+  if IsObjPtr then begin
+    inherited SetIsUsed(AValue);
+    SetExtUsed(PtrType, AValue, FHasPtrRef);
+  end
+  else
+    if AValue then
+      AddRef
+    else
+      DecRef;
+end;
+
+procedure TPointerDef.ResolveDefs;
+begin
+  inherited ResolveDefs;
+  PtrType:=ResolveDef(PtrType);
+end;
+
+function TPointerDef.IsObjPtr: boolean;
+begin
+  Result:=(PtrType <> nil) and (PtrType.DefType in [dtClass]);
+end;
+
 { TReplDef }
 
 procedure TReplDef.SetIsUsed(const AValue: boolean);
@@ -299,7 +361,7 @@ begin
     exit;
   if AValue and (RefCnt = 0) then begin
     for i:=0 to Count - 1 do
-      if TVarDef(Items[i]).VarType = nil then
+      if (Items[i].DefType = dtParam) and (TVarDef(Items[i]).VarType = nil) then
         exit; // If procedure has unsupported parameters, don't use it
   end;
   inherited SetIsUsed(AValue);
@@ -437,7 +499,7 @@ begin
     f:=FRefCnt = 0;
   end;
   if f then begin
-    // Update userd mark of children only once
+    // Update used mark of children only once
     FInSetUsed:=True;
     try
       for i:=0 to Count - 1 do
@@ -456,14 +518,15 @@ end;
 
 function TDef.ResolveDef(d: TDef; ExpectedClass: TDefClass): TDef;
 begin
-  if (d = nil) or (d.DefType <> dtNone) then begin
-    Result:=d;
-    exit;
+  if (d = nil) or (d.DefType <> dtNone) then
+    Result:=d
+  else begin
+    Result:=d.Parent.FindDef(d.DefId);
+    if (ExpectedClass <> nil) and (Result <> nil) then
+      if not (Result is ExpectedClass) then
+        raise Exception.CreateFmt('Unexpected class. Expected: %s, got: %s', [ExpectedClass.ClassName, Result.ClassName]);
+
   end;
-  Result:=d.Parent.FindDef(d.DefId);
-  if (ExpectedClass <> nil) and (Result <> nil) then
-    if not (Result is ExpectedClass) then
-      raise Exception.CreateFmt('Unexpected class. Expected: %s, got: %s', [ExpectedClass.ClassName, Result.ClassName]);
 end;
 
 procedure TDef.AddRef;

utils/pas2jni/pas2jni.pas

@@ -67,15 +67,17 @@ begin
   Result.Text:=r;
 end;
 
-procedure ParseCmdLine;
+function ParseCmdLine: boolean;
 var
   i: integer;
   s, ss: string;
   sl: TStringList;
 begin
+  Result:=False;
   if ParamCount = 0 then begin
     ShowUsage;
-    Halt(1);
+    ErrorCode:=1;
+    exit;
   end;
   for i:=1 to Paramcount do begin
     s:=ParamStr(i);
@@ -151,12 +153,13 @@ begin
         '?', 'H':
           begin
             ShowUsage;
-            Halt(0);
+            exit;
           end;
         else
           begin
             writeln('Illegal parameter: -', s);
-            Halt(1);
+            ErrorCode:=1;
+            exit;
           end;
       end;
     end
@@ -170,20 +173,21 @@ begin
       w.Units.Add(ExtractFileName(s));
     end;
   end;
+  Result:=True;
 end;
 
 begin
   try
     w:=TWriter.Create;
     try
-      ParseCmdLine;
-      w.ProcessUnits;
+      if ParseCmdLine then
+        w.ProcessUnits;
     finally
       w.Free;
     end;
   except
     writeln(Exception(ExceptObject).Message);
-    Halt(2);
+    ErrorCode:=2;
   end;
 end.
 

utils/pas2jni/ppuparser.pas

@@ -36,9 +36,13 @@ type
   TPPUParser = class
   private
     FOnCheckItem: TOnCheckItem;
+    FDefaultSearchPathAdded: boolean;
     function FindUnit(const AName: string): string;
     function ReadUnit(const AName: string): string;
     function InternalParse(const AUnitName: string): TUnitDef;
+    procedure AddSearchPath(const ASearchPath: string);
+    function ReadProcessOutput(const AExeName, AParams: string; var AOutput, AError: string): integer;
+    procedure AddDefaultSearchPath(const ACPU, AOS: string);
   public
     SearchPath: TStringList;
     Units: TDef;
@@ -55,7 +59,7 @@ var
 
 implementation
 
-uses process, pipes, fpjson, jsonparser;
+uses process, pipes, fpjson, jsonparser, jsonscanner;
 
 const
   OnExceptionProcName = 'JNI_OnException';
@@ -112,32 +116,10 @@ end;
 { TPPUParser }
 
 constructor TPPUParser.Create(const ASearchPath: string);
-var
-  i, j: integer;
-  s, d: string;
-  sr: TSearchRec;
 begin
   SearchPath:=TStringList.Create;
-  SearchPath.Delimiter:=';';
-  SearchPath.DelimitedText:=ASearchPath;
-  i:=0;
-  while i < SearchPath.Count do begin
-    s:=SearchPath[i];
-    if (Pos('*', s) > 0) or (Pos('?', s) > 0) then begin
-      d:=ExtractFilePath(s);
-      j:=FindFirst(s, faDirectory, sr);
-      while j = 0 do begin
-        if (sr.Name <> '.') and (sr.Name <> '..') then
-          SearchPath.Add(d + sr.Name);
-        j:=FindNext(sr);
-      end;
-      FindClose(sr);
-      SearchPath.Delete(i);
-    end
-    else
-      Inc(i);
-  end;
-  Units:=TDef.Create(nil, dtNone);
+  AddSearchPath(ASearchPath);
+  Units:=TDef.Create;
 end;
 
 destructor TPPUParser.Destroy;
@@ -171,68 +153,31 @@ begin
 end;
 
 function TPPUParser.ReadUnit(const AName: string): string;
-
-  procedure _ReadOutput(o: TInputPipeStream; var s: string);
-  var
-    i, j: integer;
-  begin
-    with o do
-      while NumBytesAvailable > 0 do begin
-        i:=NumBytesAvailable;
-        j:=Length(s);
-        SetLength(s, j + i);
-        ReadBuffer(s[j + 1], i);
-      end;
-  end;
-
 var
-  p: TProcess;
   s, un, err: ansistring;
   ec: integer;
 begin
   un:=FindUnit(AName);
-  p:=TProcess.Create(nil);
-  try
-    if ppudumpprog = '' then begin
-      ppudumpprog:='ppudump';
-      // Check for ppudump in the same folder as pas2jni
-      s:=ExtractFilePath(ParamStr(0));
-      if s <> '' then begin
-        s:=s + ppudumpprog + ExtractFileExt(ParamStr(0));
-        if FileExists(s) then
-          ppudumpprog:=s;
-      end;
+  if ppudumpprog = '' then begin
+    ppudumpprog:='ppudump';
+    // Check for ppudump in the same folder as pas2jni
+    s:=ExtractFilePath(ParamStr(0));
+    if s <> '' then begin
+      s:=s + ppudumpprog + ExtractFileExt(ParamStr(0));
+      if FileExists(s) then
+        ppudumpprog:=s;
     end;
-    p.Executable:=ppudumpprog;
-    p.Parameters.Add('-Fj');
-    p.Parameters.Add(un);
-    p.Options:=[poUsePipes, poNoConsole];
-    p.ShowWindow:=swoHIDE;
-    p.StartupOptions:=[suoUseShowWindow];
-    try
-      p.Execute;
-    except
-      raise Exception.CreateFmt('Unable to run "%s".'+LineEnding+'%s', [p.Executable, Exception(ExceptObject).Message]);
-    end;
-    s:='';
-    err:='';
-    repeat
-      _ReadOutput(p.Output, s);
-      _ReadOutput(p.Stderr, err);
-    until not p.Running and (p.Output.NumBytesAvailable = 0) and (p.Stderr.NumBytesAvailable = 0);
-    ec:=p.ExitStatus;
-    if Copy(s, 1, 1) <> '[' then begin
-      ec:=-1;
-      err:='Output of ppudump is not in JSON format.' + LineEnding + 'Probably old version of ppudump has been used.';
-    end;
-    if ec <> 0 then begin
-      if err = '' then
-        if Length(s) < 300 then
-          err:=s;
-      raise Exception.CreateFmt('Error reading contents of unit "%s" using "%s".'+LineEnding+'Error code: %d'+LineEnding+'%s', [un, ppudumpprog, ec, err]);
-    end;
-  finally
-    p.Free;
+  end;
+  ec:=ReadProcessOutput(ppudumpprog, '-Fj' + LineEnding + un, s, err);
+  if Copy(s, 1, 1) <> '[' then begin
+    ec:=-1;
+    err:='Output of ppudump is not in JSON format.' + LineEnding + 'Probably old version of ppudump has been used.';
+  end;
+  if ec <> 0 then begin
+    if err = '' then
+      if Length(s) < 300 then
+        err:=s;
+    raise Exception.CreateFmt('Error reading contents of unit "%s" using "%s".'+LineEnding+'Error code: %d'+LineEnding+'%s', [un, ppudumpprog, ec, err]);
   end;
   Result:=s;
 {$ifopt D+}
@@ -243,7 +188,6 @@ end;
 function TPPUParser.InternalParse(const AUnitName: string): TUnitDef;
 var
   junit: TJSONObject;
-  jp: TJSONParser;
   deref: array of TUnitDef;
   CurUnit: TUnitDef;
   IsSystemUnit: boolean;
@@ -300,6 +244,7 @@ var
     d: TDef;
     it: TJSONObject;
     jarr, arr: TJSONArray;
+    ct: TClassType;
   begin
     jarr:=jobj.Get(ItemsName, TJSONArray(nil));
     if jarr = nil then
@@ -310,9 +255,19 @@ var
         CurObjName:=it.Get('Name', '');
         jt:=it.Strings['Type'];
         if jt = 'obj' then begin
-          if it.Strings['ObjType'] <> 'class' then
+          s:=it.Strings['ObjType'];
+          if s = 'class' then
+            ct:=ctClass
+          else
+          if s = 'interface' then
+            ct:=ctInterface
+          else
+          if s = 'object' then
+            ct:=ctObject
+          else
             continue;
           d:=TClassDef.Create(CurDef, dtClass);
+          TClassDef(d).CType:=ct;
         end
         else
         if jt = 'rec' then begin
@@ -320,8 +275,10 @@ var
             d:=TTypeDef.Create(CurDef, dtType);
             TTypeDef(d).BasicType:=btGuid;
           end
-          else
-            d:=TRecordDef.Create(CurDef, dtRecord);
+          else begin
+            d:=TClassDef.Create(CurDef, dtClass);
+            TClassDef(d).CType:=ctRecord;
+          end;
         end
         else
         if jt = 'proc' then
@@ -419,16 +376,18 @@ var
           d:=TSetDef.Create(CurDef, dtSet)
         else
         if jt = 'ptr' then begin
-          d:=TTypeDef.Create(CurDef, dtType);
-          TTypeDef(d).BasicType:=btPointer;
+          d:=TPointerDef.Create(CurDef, dtPointer);
         end
         else
         if jt = 'const' then
           d:=TConstDef.Create(CurDef, dtConst)
+        else
+        if jt = 'array' then
+          d:=TArrayDef.Create(CurDef, dtArray)
         else
           continue;
 
-        if (CurObjName = '') and (d.DefType <> dtEnum) then begin
+        if (CurObjName = '') and not (d.DefType in [dtEnum, dtArray]) then begin
           d.Free;
           continue;
         end;
@@ -446,12 +405,10 @@ var
         case d.DefType of
           dtClass:
             with TClassDef(d) do begin
-              AncestorClass:=TClassDef(_GetRef(it.Get('Ancestor', TJSONObject(nil)), TClassDef));
-              _ReadDefs(d, it, 'Fields');
-            end;
-          dtRecord:
-            with TRecordDef(d) do begin
-              Size:=it.Integers['Size'];
+              if CType <> ctRecord then
+                AncestorClass:=TClassDef(_GetRef(it.Get('Ancestor', TJSONObject(nil)), TClassDef));
+              if CType in [ctObject, ctRecord] then
+                Size:=it.Integers['Size'];
               _ReadDefs(d, it, 'Fields');
             end;
           dtProc, dtProcType:
@@ -499,6 +456,15 @@ var
                   Name:='Int';
 
               _ReadDefs(d, it, 'Params');
+
+              for j:=0 to d.Count - 1 do
+                with d[j] do begin
+                  if DefType <> dtParam then
+                    continue;
+                  s:=Name;
+                  Name:=Format('p%d', [j + 1]);
+                  AliasName:=s;
+                end;
               // Check for user exception handler proc
               if AMainUnit and (Parent = CurUnit) and (OnExceptionProc = nil) and (AnsiCompareText(Name, OnExceptionProcName) = 0) then
                 OnExceptionProc:=TProcDef(d);
@@ -561,6 +527,20 @@ var
               else
                 FreeAndNil(d);
             end;
+          dtPointer:
+            with TPointerDef(d) do begin
+              PtrType:=_GetRef(it.Get('Ptr', TJSONObject(nil)));;
+              if AMainUnit and (Parent = CurUnit) and (CompareText(Name, 'TJavaObject') = 0) then
+                DefType:=dtJniObject;
+            end;
+          dtArray:
+            with TArrayDef(d) do begin
+              _ReadDefs(d, it, 'Types');
+              RangeLow:=it.Get('Low', -1);
+              RangeHigh:=it.Get('High', -1);
+              RangeType:=_GetRef(it.Get('RangeType', TJSONObject(nil)));
+              ElType:=_GetRef(it.Get('ElType', TJSONObject(nil)));
+            end;
         end;
       end;
   end;
@@ -568,6 +548,9 @@ var
 var
   i, j: integer;
   s: string;
+  chkres: TCheckItemResult;
+  jp: TJSONParser;
+  jdata: TJSONData;
 begin
   Result:=nil;
   for i:=0 to Units.Count - 1 do
@@ -576,20 +559,24 @@ begin
       exit;
     end;
 
-  AMainUnit:=FOnCheckItem(AUnitName) = crInclude;
+  chkres:=FOnCheckItem(AUnitName);
+  if chkres = crExclude then
+    exit;
 
-  if not AMainUnit and ( (CompareText(AUnitName, 'windows') = 0) or (CompareText(AUnitName, 'unix') = 0) ) then begin
-    Result:=nil;
+  AMainUnit:=chkres = crInclude;
+
+  if not AMainUnit and ( (CompareText(AUnitName, 'windows') = 0) or (CompareText(AUnitName, 'unix') = 0) ) then
     exit;
-  end;
 
   s:=ReadUnit(AUnitName);
   try
-    junit:=nil;
+    jdata:=nil;
     try
-      jp:=TJSONParser.Create(s);
+      jp:=TJSONParser.Create(s, [joUTF8]);
       try
-        junit:=TJSONObject(jp.Parse.Items[0]);
+        s:='';
+        jdata:=jp.Parse;
+        junit:=TJSONObject(jdata.Items[0]);
       finally
         jp.Free;
       end;
@@ -602,8 +589,19 @@ begin
       Result.PPUVer:=junit.Integers['Version'];
       Result.CPU:=junit.Strings['TargetCPU'];
       Result.OS:=junit.Strings['TargetOS'];
+      j:=Length(Result.CPU);
+      if AnsiLowerCase(Copy(Result.OS, Length(Result.OS) - j, j + 1)) =  AnsiLowerCase('-' + Result.CPU) then
+        Result.OS:=Copy(Result.OS, 1, Length(Result.OS) - j - 1);
       Result.IntfCRC:=junit.Strings['InterfaceCRC'];
 
+      if IsSystemUnit then
+        Result.IsUsed:=True;
+
+      if not FDefaultSearchPathAdded then begin
+        FDefaultSearchPathAdded:=True;
+        AddDefaultSearchPath(AnsiLowerCase(Result.CPU), AnsiLowerCase(Result.OS));
+      end;
+
       if junit.Find('Units') <> nil then
         with junit.Arrays['Units'] do begin
           SetLength(deref, Count);
@@ -618,6 +616,13 @@ begin
 
       Result.ResolveDefs;
 
+      if CompareText(AUnitName, 'jni') = 0 then begin
+        for i:=0 to Result.Count - 1 do
+          with Result[i] do
+            if CompareText(Name, 'PJNIEnv') = 0 then
+              DefType:=dtJniEnv;
+      end;
+
       if AMainUnit then
         Result.IsUsed:=True;
 
@@ -632,7 +637,7 @@ begin
         end;
       SetLength(Result.UsedUnits, j);
     finally
-      junit.Free;
+      jdata.Free;
     end;
   except
     if CurObjName <> '' then
@@ -641,5 +646,129 @@ begin
   end;
 end;
 
+procedure TPPUParser.AddSearchPath(const ASearchPath: string);
+var
+  i, j: integer;
+  s, d: string;
+  sr: TSearchRec;
+  sl: TStringList;
+begin
+  sl:=TStringList.Create;
+  try
+    sl.Delimiter:=';';
+    sl.DelimitedText:=ASearchPath;
+    i:=0;
+    while i < sl.Count do begin
+      s:=sl[i];
+      if (Pos('*', s) > 0) or (Pos('?', s) > 0) then begin
+        d:=ExtractFilePath(s);
+        j:=FindFirst(s, faDirectory, sr);
+        while j = 0 do begin
+          if (sr.Name <> '.') and (sr.Name <> '..') then
+            sl.Add(d + sr.Name);
+          j:=FindNext(sr);
+        end;
+        FindClose(sr);
+        sl.Delete(i);
+      end
+      else
+        Inc(i);
+    end;
+    SearchPath.AddStrings(sl);
+  finally
+    sl.Free;
+  end;
+end;
+
+function TPPUParser.ReadProcessOutput(const AExeName, AParams: string; var AOutput, AError: string): integer;
+
+  procedure _ReadOutput(o: TInputPipeStream; var s: string; var idx: integer);
+  var
+    i: integer;
+  begin
+    with o do
+      while NumBytesAvailable > 0 do begin
+        i:=NumBytesAvailable;
+        if idx + i > Length(s) then
+          SetLength(s, idx + i*10 + idx div 10);
+        ReadBuffer(s[idx + 1], i);
+        Inc(idx, i);
+      end;
+  end;
+
+var
+  p: TProcess;
+  oidx, eidx: integer;
+begin
+  AOutput:='';
+  AError:='';
+  oidx:=0;
+  eidx:=0;
+  p:=TProcess.Create(nil);
+  try
+    p.Executable:=AExeName;
+    p.Parameters.Text:=AParams;
+    p.Options:=[poUsePipes, poNoConsole];
+    p.ShowWindow:=swoHIDE;
+    p.StartupOptions:=[suoUseShowWindow];
+    try
+      p.Execute;
+    except
+      raise Exception.CreateFmt('Unable to run "%s".'+LineEnding+'%s', [p.Executable, Exception(ExceptObject).Message]);
+    end;
+    repeat
+      if p.Output.NumBytesAvailable = 0 then
+        TThread.Yield;
+      _ReadOutput(p.Output, AOutput, oidx);
+      _ReadOutput(p.Stderr, AError, eidx);
+    until not p.Running and (p.Output.NumBytesAvailable = 0) and (p.Stderr.NumBytesAvailable = 0);
+    SetLength(AOutput, oidx);
+    SetLength(AError, eidx);
+    Result:=p.ExitStatus;
+  finally
+    p.Free;
+  end;
+end;
+
+procedure TPPUParser.AddDefaultSearchPath(const ACPU, AOS: string);
+var
+  fpc, s, e: string;
+  sl: TStringList;
+  i, j: integer;
+begin
+  try
+    fpc:=ExtractFilePath(ppudumpprog) + 'fpc' + ExtractFileExt(ppudumpprog);
+    if not FileExists(fpc) then
+      exit;
+    // Find the compiler binary
+    if ReadProcessOutput(fpc, '-P' + ACPU + LineEnding + '-T' + AOS + LineEnding + '-PB', s, e) <> 0 then
+      exit;
+    fpc:=Trim(s);
+    // Get units path from the compiler output
+    ReadProcessOutput(fpc, '-P' + ACPU + LineEnding + '-T' + AOS + LineEnding + '-vt' + LineEnding + '.', s, e);
+    sl:=TStringList.Create;
+    try
+      sl.Text:=s;
+      s:='';
+      for i:=0 to sl.Count - 1 do begin
+        s:=sl[i];
+        j:=Pos(':', s);
+        if j > 0 then begin
+          s:=Trim(Copy(s, j + 1, MaxInt));
+          s:=ExcludeTrailingPathDelimiter(s);
+          if (Copy(s, Length(s) - 3, 4) = DirectorySeparator + 'rtl') and DirectoryExists(s) then begin
+            AddSearchPath(ExtractFilePath(s) + '*');
+            exit;
+          end;
+        end;
+      end;
+    finally
+      sl.Free;
+    end;
+  except
+    // Ignore exceptions
+  end;
+end;
+
 end.