Jump to content

pyscripter

Members
 View Profile  See their activity

  • Content Count

    787

  • Joined

  • Last visited

  • Days Won

    43

Posts posted by pyscripter

  1. Posted

    @Dave NottageThanks for responding I am in Delphi 10.3.3.

     

    Here is what I see in verbose mode when I select Add New SDK as above and then press OK.

     

    image.png.d6f0c8bf2b6039c18de3ea0f7187b3d5.png

     

    The -version -skd happens while the dialog is showing.  Nothing seems to happen when I press OK.

     

    Do I need to download the SDK in the Mac?  The XCode version is 11.4.

     

  2. Posted · Edited by pyscripter

    I am new to MacOS developement.   I have added an new Connection Profile which test successfully, the PAServer is running, XCode has the command line tools,

     

    image.png.5c70c7f8e5a9726a72a6675dc9e2b1aa.png

     

    When I try to add a new SDK nothing happens.

    What am I missing?  Any help?

  5. Posted · Edited by pyscripter

    @Freds

    I see.  There are two ways to grow the pool.  One by GrowWorkerPool and another by TThreadPool.TThreadPoolMonitor.GrowThreadPoolIfStarved, so you create the ThreadPoolMonitor after the initial threads are created and then it undertakes the growing or the Pool.

     

     

    Actually the problem with CPU usage was related to this method: 

    procedure TThreadPool.GrowWorkerPool;
begin
  if ShouldGrowPool then
  begin
    TMonitor.Enter(FQueue);
    try
      if ShouldGrowPool then
        if FRetiredWorkerThreadCount = 0 then
          CreateWorkerThread
        else
          ResurrectRetiredThread;
    finally
      TMonitor.Exit(FQueue);
    end;
  end else
    CreateMonitorThread;
end;

    CreateMonitorThread was never called.  

     

    If you change the above to:

      

    procedure TThreadPool.GrowWorkerPool;
begin
  if ShouldGrowPool then
  begin
    TMonitor.Enter(FQueue);
    try
      if ShouldGrowPool then
        if FRetiredWorkerThreadCount = 0 then
          CreateWorkerThread
        else
          ResurrectRetiredThread;
    finally
      TMonitor.Exit(FQueue);
    end;
    if FMonitorThreadStatus = [] then
      CreateMonitorThread;
  end else
    CreateMonitorThread;
end;

    then CPU usage is reported OK.

  7. Posted

    For me the following change to System.Threading appears to resolve the issue:

      

    function TThreadPool.ShouldGrowPool: Boolean;
begin
  Result := {(FWorkerThreadCount < FMinLimitWorkerThreadCount) and }(FIdleWorkerThreadCount < FQueuedRequestCount) and
    (FWorkerThreadCount < Self.FMaxLimitWorkerThreadCount);
end;

    The condition FWorkerThreadCount < FMinLimitWorkerThreadCount does not appear to make sense.

     

    A slightly modified Load function:

      

      procedure Load;
  Var
    Sum : Double;

  begin
    Sum := 0;
    Monitor := TObject.Create;
    try
      TParallel.For(0, 99999999, procedure(i: Integer)
      var
        T:double;
      begin
        T:=Sin(i/PI);
        TMonitor.Enter(Monitor);
        Sum := Sum + T;
        TMonitor.Exit(Monitor);
      end);
      Writeln('Sum = ', Sum);
    finally
      Monitor.Free;
    end;
  end;

    produced the following results for multiple runs:

      

    PPL Test ---------------
Before: Worker: 0, (Min: 8..Max: 200), Idle: 0, Retired: 0, Suspended: 0, CPU(Avg): 0, CPU: 0
Sum =  1.37111034277419E+0000
Finished in 00:00:03.8990212
After: Worker: 17, (Min: 8..Max: 200), Idle: 17, Retired: 0, Suspended: 0, CPU(Avg): 0, CPU: 0
------------------------
PPL Test ---------------
Before: Worker: 17, (Min: 8..Max: 200), Idle: 17, Retired: 0, Suspended: 0, CPU(Avg): 0, CPU: 0
Sum =  1.37111034276774E+0000
Finished in 00:00:03.8069356
After: Worker: 17, (Min: 8..Max: 200), Idle: 17, Retired: 0, Suspended: 0, CPU(Avg): 0, CPU: 0
------------------------
PPL Test ---------------
Before: Worker: 17, (Min: 8..Max: 200), Idle: 17, Retired: 0, Suspended: 0, CPU(Avg): 0, CPU: 0
Sum =  1.37111034277633E+0000
Finished in 00:00:03.8392113
After: Worker: 17, (Min: 8..Max: 200), Idle: 17, Retired: 0, Suspended: 0, CPU(Avg): 0, CPU: 0
------------------------
PPL Test ---------------
Before: Worker: 17, (Min: 8..Max: 200), Idle: 17, Retired: 0, Suspended: 0, CPU(Avg): 0, CPU: 0
Sum =  1.37111034277271E+0000
Finished in 00:00:03.8729582
After: Worker: 17, (Min: 8..Max: 200), Idle: 17, Retired: 0, Suspended: 0, CPU(Avg): 0, CPU: 0
------------------------

     

  8. Posted

    I am new to DUnitX and I am trying to get stacktraces working, so that when a test case fails, I can see the source code line containing the Assertion that failed.  I have done the following:

    • Added DUnitX.StackTrace.Jcl, to the project uses clause.
    • Edited C:\Program Files (x86)\Embarcadero\Studio\20.0\source\DunitX\DUnitX.Stacktrace.inc to enable the JCL define
    • Compiled generating a full MAP file which was converted to jdbg and inserted into the executable.  The MAP file is also present.

    I still do not get stack traces for failures.  What am I missing?

     

    Another small issue is the XML report shows

    asserts="0"

    despite the fact that there are many Assert.IsTrue in the Test cases.  Is this feature not working?

  13. Posted

    I am getting a bug report with the following stack list.

      

    Exception class: EOSError
Exception message: System Error.  Code: 1400.
Invalid window handle.
Exception address: 004305B8

Stack list, generated 10/12/2019 10:45:33 AM
[004305B3]{PyScripter.exe} Unknown function at __dbk_fcall_wrapper
[005F08C1]{PyScripter.exe} Unknown function at TMethodImplementationIntercept
[005B6961]{PyScripter.exe} Unknown function at TMethodImplementationIntercept
....

    TMethodImplementationIntercept is defined in RTTI.pas but it does not appear to be used anywhere and I am not calling this function. 

    { This function has been added to be used from .s .c files in order to avoid use mangled names}
procedure TMethodImplementationIntercept(const obj:TMethodImplementation; AFrame: Pointer); cdecl;
begin
  obj.Intercept(AFrame);
end;
exports TMethodImplementationIntercept;

    Any idea what might be going on?

  16. Posted · Edited by pyscripter

    The Windows imaging Component contains a wealth of useful features for manipulating images in different formats.  Delphi partially encapsulates this functionality into the TWICImage class of Vcl.Graphics which is a TGraphics descendent.  The following code  resizes pf32bit bitmaps with transparency using TWICImage, at a much better quality than can be achieved with StretchDraw for example or anything else I have tried..

      

    Uses
  Winapi.Wincodec,
  Vcl.Graphics;

procedure ResizeBitmap(Bitmap: TBitmap; const NewWidth, NewHeight: integer);
var
  Factory: IWICImagingFactory;
  Scaler: IWICBitmapScaler;
  Source : TWICImage;
begin
  Bitmap.AlphaFormat := afDefined;
  Source := TWICImage.Create;
  try
    Factory := TWICImage.ImagingFactory;
    Source.Assign(Bitmap);
    Factory.CreateBitmapScaler(Scaler);
    Scaler.Initialize(Source.Handle, NewWidth, NewHeight,
      WICBitmapInterpolationModeHighQualityCubic);
    Source.Handle := IWICBitmap(Scaler);
    Bitmap.Assign(Source);
    Scaler := nil;
    Factory := nil;
  finally
    Source.Free;
  end;
end;

    Some key points:

    • Setting the AlphaFormat to alDefined is crucial for maintaining the transparency.
    • If you do not release the ImageFactory before you destroy the TWICImage you will get access violations next time you call this procedure.  (Have a look at TWICImage .Destroy).
    • Like 3
    • Thanks 2

  18. Posted · Edited by pyscripter

    In case this of use to anyone:

     

    Quite often you find a bug in Delphi RTL :classic_angry: and you come up with a fix.  Patching involves replacing the RTL procedure with a new patched one.  To do that you can use your favorite patching routine or library (I use Detours), but you need the address of the original function/method.

     

    a) Patching a non-virtual public method

    This is quite straight-forward:     

    type
  TMethodType = procedure ... of object

function GetAddress: Pointer;
var
  MethodPtr : TMethodType;
begin
  MethodPtr := TRTLClass(nil).PublicMethod;
  Result := TMethod(MethodPtr).Code;
end;

    Note the type cast TRTLClass(nil).

     

    b) Patching a virtual public method

    If for example PublicMethod is virtual the above type cast TRTLClass(nil) with result in access violation, since to resolve the virtual method you need to access Self which is nil.  You could create a class instance and use that instead of TRTLClass(nil), but apart from not being elegant, in some cases this has side-effects (for example it may require a valid windows handle).  The trick is described in this Stackoverflow question.

      

    function GetAddress: Pointer;
var
  VMT : NativeInt;
  MethodPtr: TMethodType;
begin
  VMT := NativeInt(TRTLClass);
  MethodPtr := TRTLClass(@VMT).PublicMethod;
  Result := TMethod(MethodPtr).Code;
end;

    This is based on two facts.  A class is a pointer to the Virtual Method table (VMT) and an Object structure has as the first field a pointer to the VMT of its class.

     

    c) Patching a private virtual method

     

    The trick this time involves using a class helper to access the private method of the TRTLClass

      

    type
  TPrivateMethodType = procedure ... of object;

TRTLClassHookFix = class helper for TRTLCLass
  function GetPriveMethodAddr: Pointer;
end;

function TRTLClassHookFix.GetPriveMethodAddr: Pointer;
var
  VMT : NativeInt;
  MethodPtr: TPrivateMethodType;
begin
  //  Adjust Self to point to the VMT
  VMT := NativeInt(TRTLCLass);
  Self := TRTLCLass(@VMT);

  with Self do MethodPtr := PrivateMethod;
  Result := TMethod(MethodPtr).Code;
end;

    That's it.

    • Like 6
    • Thanks 1

  19. Posted

    I could reproduce the problem.  However I would suggest that you do not auto-create dialog forms.

     

    In Project, Options, Forms remove the OKRightDlg from the list of auto-created forms (move it to the right).

    Replace TForm1.Button1Click with something like this:
      

    procedure TForm1.Button1Click(Sender: TObject);
begin
  with TOKRightDlg.Create(Self) do
  begin
    PopupParent := Self;
    ShowModal;
    Release;
  end;
end;

     

  21. Posted

    The extended Rtti, available since Delphi XE, is great and has many uses, including serialization and exposing Delphi object to scripting languages.  There have been many discussions about whether you should keep a global RttiContext or not and whether you should call TRttiContext Create and Free every time you access extended Rtti.   For example this article suggests that keeping it in a global variable is a "very bad idea".  However there is a huge performance penalty if you do not do that.   For example in the following code Test1 runs about 100 times slower than Test2.  The reason is that in Test1, hundreds of Rtti objects are created and destroyed every time you access the rtti.

      

    program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
  System.SysUtils,
  System.Classes,
  System.Diagnostics,
  System.Rtti;

Const
  Iterations = 10000;
var
  SL : TStringList;

procedure Test1Inner;
begin
  var RttiContext := TRttiContext.Create;
  var RttiMethod := RttiContext.GetType(SL.ClassType).GetMethod('Clear');
  RttiMethod.Invoke(SL, []);
  RttiContext.Free;
end;

Procedure Test1;
begin
  for var I := 1 to Iterations do begin
    Test1Inner;
  end;
end;

Procedure Test2;
begin
  var RttiContext := TRttiContext.Create;
  for var I := 1 to Iterations do begin
    var RttiMethod := RttiContext.GetType(SL.ClassType).GetMethod('Clear');
    RttiMethod.Invoke(SL, []);
  end;
  RttiContext.Free;
end;

begin
  SL := TStringList.Create;
  try
   var SW := TStopwatch.StartNew;
   Test1;
   SW.Stop;
   WriteLn(SW.ElapsedMilliseconds.ToString);

   SW := TStopwatch.StartNew;
   Test2;
   SW.Stop;
   WriteLn(SW.ElapsedMilliseconds.ToString);
  finally
    SL.Free;
  end;
  ReadLn;
end.

    There is a middle-of-the-road solution to the performance issue, once you realize that there can be many Rtti Contexts but there is just one Rtti Pool as @Stefan Glienke points out at the bottom of this Stackoverflow topic.  (By the way, the bug discussed in this question was fixed in Delphi Rio).  So instead of having a global RttiContext you can instead insert the following code at the bottom of one of your units. 

    Var
_RttiContext: TRttiContext;

procedure _InitRttiPool;
begin
 _RttiContext := TRttiContext.Create;
 _RttiContext.FindType('');
end;

initialization
  _InitRttiPool;
finalization
  _RttiContext.Free();

    Note that _RttiContext is not used anywhere else, but this is enough to keep the rtti pool alive and prevent the performance penalty involved in creating and freeing the RttiContext.  @David Heffernan suggests something similar in the StackOverflow topic mentioned above but for a different reason.   The downside of course is the memory overhead involved in keeping all these rtti objects alive for the lifetime of the application.   Any comments?

×