More exactly, the test project in question uses the TThreadedQueue class. Having experimented a bit more with TMonitor and found it seemingly OK, I thought I’d investigate the TThreadedQueue implementation. My initial idea was to test its logic distinct from TMonitor’s by replacing use of TMonitor with calls to equivalent Windows APIs (a monitor combines a critical section and a ‘conditional variable’, and the Windows API acquired a condition variable primitive in Vista). However, on inspecting the code, I found it using the (to me) rather tricky-to-comprehend 3 parameter overload of TMonitor.Wait – and in my usage, I’ve stuck to the simpler, 2 parameter overload. This made me think: if I just rewrote TThreadedQueue similarly, would that fix the problem? I think it has, but I would be grateful if anyone else could verify:

1. Download the problem project from the Windows QC client – browse to report number 101114, and get the DPR from the ‘attachments’ tab.

2. Open the project in the IDE, and add a new unit to it.

3. Copy the code for TThreadedQueue from System.Generics.Collections.pas. As it is almost completely self-contained, you need only System.SyncObjs in the new unit’s uses clause.

4. In the copied class definition, remove FQueueNotEmpty and FQueueNotFull. Everything else in the interface stays the same however.

5. Remove the lines constructing and freeing FQueueNotEmpty and FQueueNotFull in Create and Destroy.

6. Change the implementation of the substantive PopItem variant to this:

function TThreadedQueue<T>.PopItem(var AQueueSize: Integer; var AItem: T): TWaitResult;
begin
  AItem := Default(T);
  TMonitor.Enter(FQueueLock);
  try
    while (FQueueSize = 0) and not FShutDown do
      if not TMonitor.Wait(FQueueLock, FPopTimeout) then Exit(wrTimeout);
    if FShutDown then Exit(wrAbandoned);   
    Result := wrSignaled;                                                  
    AItem := FQueue[FQueueOffset];
    if FQueueSize = Length(FQueue) then
      TMonitor.PulseAll(FQueueLock);
    Dec(FQueueSize);
    Inc(FQueueOffset);
    Inc(FTotalItemsPopped);
    if FQueueOffset = Length(FQueue) then
      FQueueOffset := 0;
  finally
    AQueueSize := FQueueSize;
    TMonitor.Exit(FQueueLock);
  end;
end;

The main thing here is that we are now using the simpler variant of Wait. As an aside, it’s OK to ‘pulse’ as early as we do, since waiting threads only get notified once we’ve exited the monitor.

7. Change the implementation of the substantive PushItem overload to this:

function TThreadedQueue<T>.PushItem(const AItem: T; var AQueueSize: Integer): TWaitResult;
begin
  TMonitor.Enter(FQueueLock);
  try
    while (Length(FQueue) = FQueueSize) and not FShutDown do
      if not TMonitor.Wait(FQueueLock, FPushTimeout) then Exit(wrTimeout);
    if FShutDown then Exit(wrAbandoned);
    Result := wrSignaled;
    if FQueueSize = 0 then TMonitor.PulseAll(FQueueLock);
    FQueue[(FQueueOffset + FQueueSize) mod Length(FQueue)] := AItem;
    Inc(FQueueSize);
    Inc(FTotalItemsPushed);
  finally
    AQueueSize := FQueueSize;
    TMonitor.Exit(FQueueLock);
  end;
end;

8. Change DoShutdown to this:

procedure TThreadedQueue<T>.DoShutDown;
begin
  FShutDown := True;
  TMonitor.PulseAll(FQueueLock);
end;

I’ve removed the locking around setting FShutdown since I don’t see what good it does (no one will be trying to set it to False).

9. Rerun the problem project: hopefully, it will now work (meaning, it will count up to 1000 without crashing), notwithstanding the fact we haven’t actually fixed the bug in TMonitor itself…

1. TBitmap.LoadFromFile does not raise an exception when the file does not exist – instead, it just silently returns (see QC 102636).
2. TFmxObject.Children (which is equivalent to TWinControl.Controls in the the VCL) always returns nil on an out-of-range index rather than raising an exception. Combined with the fact the ‘as’ operator accepts a nil source, this causes typos to generate nasty, generic access violations rather than exceptions that tell you what the error actually is (see QC 102747).

For what it’s worth, I run applications built with XE2 on OSX Lion just fine. Other people do too.

I think it’s unlikely that Carbon APIs would cause this. This error normally occurs for a OS9 application, i.e. something is probably making the loader think it is not a OSX app. They have very different executable formats. This is guesswork, but makes more sense than an old API somehow drawn in – I don’t see how Embarcadero could have done that, given they provide translations of the Apple-provided headers / APIs and were probably working with those same translations themselves.

Some googling would have turned up threads like this: http://forums.digitalspy.co.uk/showthread.php?p=39579653 where other new apps, in this case iTunes itself (!) gives this error. The solutions imply it’s due to corruption of some sort: possibly of the app, the app bundle, permissions, or even the OS.

Things to try would be:
- Clean and rebuild the app (and completely remove it from where it’s located on OSX, to be sure to make the IDE moves everything across again.)
- Open the app bundle and compare it to a working app. What’s different? Can he execute the program located in the bundle from the command line? If not, what error does it give?
- Reinstall the remote debugger. Maybe it’s this thats corrupted, not even his app…? It’s impossible to know from his post when this error occurs (running from the IDE, i.e. debugging? Running the app normally on OSX? …?)
- Open Disk Utility and verify the disk, and check / fix file permissions.

After that, if he still has problems, I’ll admit it’s more complicated. The next appropriate move would be to post on the Embarcadero forums or open a support request.

Thanks to David M for the advice.

In fact, in the main, XE2′s RTL and FMX sources keep well away from legacy Mac APIs. Despite some (probably unintentional) misinformation around, the frame of an FMX form is a Cocoa window, not a Carbon one (‘Carbon’ was/is the API Apple provided to allow C and C++ applications to cross compile for OS 9 and OS X, ‘Cocoa’ the ‘modern’ Objective-C and OS X-only API). As for the RTL, this delegates to the POSIX layer as much as possible, and failing that CoreFoundation, which is C-based but OS X specific API layer. There is however one exception – due to OS X’s apparently incomplete implementation of POSIX threading (it doesn’t support unnamed semaphores), the Carbon ‘Multiprocessing Services’ API is used instead for TSemaphore, TEvent and TMonitor. This then brings in TCriticalSection and a few other things, which are based on TMonitor when targeting OS X. While the RTL team should probably be at least investigating an alternative to the Carbon API here pretty sharpish, surely use of an API only recently marked ‘deprecated’ (‘v10.7′ = Lion) wouldn’t have caused Mr Hater’s problem…?

In practical terms, Win64 took as long as it took to add ‘Win64′ as a target for each of the demos; OS X was somewhat longer for a mixture of reasons, primarily because the code had some entanglement with the VCL graphics classes, and there’s no ‘clean’ way for the same code to work with both VCL and FMX on that score. By far the biggest waste of time effort was managing project files across an array of Delphi versions though, with battling Subversion a close second, i.e. not actual coding at all. As I wanted to make running the demos as newbie-friendly as possible, I’ve ended up with separate project files for D2006, D2007, D2009-10 and XE+ – just open the appropriate project group located at the top of the trunk and do a Project|Compile All. If compiling under D2007 or later, executables will then be outputted in a sub-directory off the Bin folder next to the individual projects, and DCUs in a ‘DCUs’ folder off of the main trunk.

Anyhow, the Google Code page is here; if using the File|Open From Version Control… command in the XE or XE2 IDE, the URL to enter is http://ccr-exif.googlecode.com/svn/trunk/; choose either Console Demos (XE+).groupproj or VCL Demos (XE+).groupproj as appropriate when prompted.

• If a application isn’t on the system PATH, then you always need to provide a path when running the program on the command line. Happily, relative paths are acceptable, and the symbol for ‘the current directory’ (i.e., a single full stop) is the same on Unix and Windows. For example, say you have a console program called MyUtil that has been put in ~/Applications. If in a Terminal window you go into that folder, the command for running the program will involve prefixing its name with a full stop and a forward slash:

  cd ~/Applications
  ./myutil

• There are numerous ‘standard’ locations to put console applications where they will be globally available — on my iMac, the system path (with no changes to it on my part) is composed of /opt/local/bin, opt/local/sbin, /usr/bin, /usr/sbin, /sbin, /usr/local/bin and /usr/X11/bin! Of the main Linux-y stuff I’ve installed, Wine has dumped a load of things in /opt/local/bin and Mono has liberally fly-tipped /usr/bin. Since out of the root directories, only /opt isn’t hidden by default in Finder (well, at least for me), I’ve put things of my own in /opt/local/bin. This still requires getting past the equivalent of a UAC prompt, though that isn’t a bad thing IMO.
• When distributing a Delphi-produced console application, remember there is one dependency you can’t avoid – libcgunwind.1.0.dylib. This must be placed in the same directory as the executable. However, it is only 25KB. The much bigger, and program-specific, .rsm file the compiler produces should not be required – this is just for debugging.
• When the user passes a parameter to a console application that contains a wildcard, the command-line interpreter will expand it before the application gets a chance to do anything. For example, say the command myutil *.jpg is entered, where MyUtil is a console application written in Delphi; inside of the application, ParamCount will return the number of *.jpg files in the current directory, ParamStr(1) the first *.jpg file, ParamStr(2) the second and so on.
• If you want to prevent wildcard auto-expansion, wrap the parameter in quotes, just as you would wrap a parameter that contains one or more spaces in quotes:

  myutil "*.jpg"

• ParamStr(0) on OS X will return whatever was typed by the user to start the program. If that was ./myutil , then ./myutil will be returned (you won’t notice this in a FireMonkey application, since a graphical OS X application is ‘bundled’, and so never run directly by the user). If you want a path, you can use GetModuleName(0) instead (as you can on Windows in fact). This however is likely to return the executable’s path concatenated with whatever ParamStr(0) returns, meaning both a superfluous ./ could be embedded and the ‘wrong’ casing used (on Windows, ParamStr(0) will return the file name with the case of the actual EXE file – MyUtil.exe not myutil.exe). To fix both, pass whatever GetModuleName returns to ExpandFileNameCase:

  function GetExecutableName: string;
  var
    MatchedCase: TFilenameCaseMatch;
  begin
    Result := ExpandFileNameCase(GetModuleName(0), MatchedCase);
  end;

While unnecessary, this extra handling is harmless when targeting Windows, so you don’t need to IFDEF it when targeting both platforms.

uses 
  System.SysUtils, Macapi.Foundation;
begin
  NSDefaultRunLoopMode;
  //actually do stuff...

Once done, there is nevertheless a second thing you’ll need to do, which is to set up an Objective-C/Cocoa ‘auto-release pool’. This probably sounds more grand than in actually is – just create an instance of NSAutoRelease pool at the head of your code, and ‘drain’ it at its foot:

program CocoaConsoleTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, Macapi.Foundation;
var
  Pool: NSAutoreleasePool;
  Host: NSHost;
begin
  NSDefaultRunLoopMode; //just something to ensure the Cocoa Foundation framework is loaded
  Pool := TNSAutoreleasePool.Create;
  try
    Host := TNSHost.Wrap(TNSHost.OCClass.currentHost);
    WriteLn('This computer is called ' + UTF8ToUnicodeString(Host.localizedName.UTF8String));
  finally
    Pool.drain;
  end;
end.

In essence, there are two problems to solve: taking the actual screenshot, and getting the image taken into a TBitmap. With respect to the second step, the general approach must be to write the image data to a memory stream, which can then be read by a TBitmap. This was the method I used in the clipboard case, though the specifics in the screenshot one are quite different.

To actually take a screenshot in the first place, the CGWindowListCreateImage API function can be used. This is part of the Core Graphics API layer, which like Core Foundation has a straight C interface which tries to be as object oriented as is reasonably possible, to the extent a purely procedural interface can be. As a result, what CGWindowListCreateImage returns is an opaque pointer (CGImageRef) to an object that needs releasing after we’ve done with it. Unfortunately, there is no CFImage ‘method’ to directly extract the image bytes however: instead, we must create a CGDataConsumer object, to pass to CGImageDestination object, which should then have the CFImage ‘added’ to it before being ‘finalised’. The last step will cause the bitmap bytes to be written to the data consumer, which we connect to a TMemoryStream via a procedural callback. Small mercies there’s no need to write a Cocoa-style delegate class too, eh?

To see this all in practice, create a new FireMonkey HD application, and add to the form a TButton and a suitable sized TImageControl. Caption the button ‘Take Screenshot’, then head for the form’s PAS file. Here, add the following as the implementation section’s uses clause:

uses
  Macapi.CoreFoundation, Macapi.CocoaTypes, Macapi.CoreGraphics, Macapi.ImageIO;

First thing we’ll implement is the code to output the image data held by a CGImageRef to a TStream:

function PutBytesCallback(Stream: TStream; NewBytes: Pointer;
  Count: LongInt): LongInt; cdecl;
begin
  Result := Stream.Write(NewBytes^, Count);
end;

procedure ReleaseConsumerCallback(Dummy: Pointer); cdecl;
begin
end;

procedure WriteCGImageToStream(const AImage: CGImageRef; AStream: TStream;
  const AType: string = 'public.png'; AOptions: CFDictionaryRef = nil);
var
  Callbacks: CGDataConsumerCallbacks;
  Consumer: CGDataConsumerRef;
  ImageDest: CGImageDestinationRef;
  TypeCF: CFStringRef;
begin
  Callbacks.putBytes := @PutBytesCallback;
  Callbacks.releaseConsumer := ReleaseConsumerCallback;
  ImageDest := nil;
  TypeCF := nil;
  Consumer := CGDataConsumerCreate(AStream, @Callbacks);
  if Consumer = nil then RaiseLastOSError;
  try
    TypeCF := CFStringCreateWithCharactersNoCopy(nil, PChar(AType), Length(AType),
      kCFAllocatorNull); //wrap the Delphi string in a CFString shell
    ImageDest := CGImageDestinationCreateWithDataConsumer(Consumer, TypeCF, 1, AOptions);
    if ImageDest = nil then RaiseLastOSError;
    CGImageDestinationAddImage(ImageDest, AImage, nil);
    if CGImageDestinationFinalize(ImageDest) = 0 then RaiseLastOSError;
  finally
    if ImageDest <> nil then CFRelease(ImageDest);
    if TypeCF <> nil then CFRelease(TypeCF);
    CGDataConsumerRelease(Consumer);
  end;
end;

When extracting image data, we need to request a specific graphic type via an appropriate ‘Uniform Type Identifier’. PNG is an appropriate default since it will definitely be available, and is lossless.

Now we need to implement the routine to actually take the screenshot:

procedure TakeScreenshot(Dest: TBitmap);
var
  Screenshot: CGImageRef;
  Stream: TMemoryStream;
begin
  Stream := nil;
  ScreenShot := CGWindowListCreateImage(CGRectInfinite,
    kCGWindowListOptionOnScreenOnly, kCGNullWindowID, kCGWindowImageDefault);
  if ScreenShot = nil then RaiseLastOSError;
  try
    Stream := TMemoryStream.Create;
    WriteCGImageToStream(ScreenShot, Stream);
    Stream.Position := 0;
    Dest.LoadFromStream(Stream);
  finally
    CGImageRelease(ScreenShot);
    Stream.Free;
  end;
end;

As the number of arguments passed to CGWindowListCreateImage indicates, the API is quite flexible. We’ll just take a straight screenshot however.

If you now try to compile the code, you’ve find it barfs at CGRectInfinite – while all the functions and types we require are translated by the stock Macapi.* units, the CGRectInfinite constant is missing for some reason. So, add it like this:

{$IF NOT DECLARED(CGRectInfinite)}
const
  CGRectInfinite: CGRect = (origin: (x: -8.98847e+30; y: -8.98847e+307);
    size: (width: 1.79769e+308; height: 1.79769e+308));
{$IFEND}

Lastly, handle the button’s OnClick event as the following, where imgDest is the name of the image control:

procedure TfrmMacScreenshot.btnTakeScreenshotClick(Sender: TObject);
begin
  TakeScreenshot(imgDest.Bitmap);
end;

Run the application, and clicking the button should output a screenshot to the control:

uses
  SysUtils, Classes, TypInfo, RTTI;

type
  IVirtualMethodLogger = interface
    procedure StopLogging(ObjectStillAlive: Boolean = True);
  end;

function LogVirtualMethodCalls(Obj: TObject; Output: TTextWriter;
  OwnOutput: Boolean = False): IVirtualMethodLogger; overload;
function LogVirtualMethodCalls(Obj: TObject; const LogFile: string;
  Append: Boolean = True): IVirtualMethodLogger; overload;

And the implementation like this:

type
  TVirtualMethodLogger = class(TInterfacedObject, IVirtualMethodLogger)
  strict private
    FInterceptor: TVirtualMethodInterceptor;
    FObject: TObject;
    FOwnOutput: Boolean;
    FOutput: TTextWriter;
  public
    constructor Create(Obj: TObject; Output: TTextWriter;
      OwnOutput: Boolean);
    destructor Destroy; override;
    procedure StopLogging(ObjectStillAlive: Boolean = True);
  end;

constructor TVirtualMethodLogger.Create(Obj: TObject; Output: TTextWriter;
  OwnOutput: Boolean);
begin
  inherited Create;
  FObject := Obj;
  FOutput := Output;
  FOwnOutput := OwnOutput;
  FInterceptor := TVirtualMethodInterceptor.Create(Obj.ClassType);
  FInterceptor.OnBefore :=
    procedure(Instance: TObject; Method: TRttiMethod;
      const Args: TArray<TValue>; out DoInvoke: Boolean; out Result: TValue)
    begin
      Output.Write(DateTimeToStr(Now));
      Output.WriteLine(' %s.%s called with %d argument(s)',
        [Obj.ClassName, Method.Name, Length(Args)]);
    end;
  FInterceptor.OnException :=
    procedure(Instance: TObject; Method: TRttiMethod;
      const Args: TArray<TValue>; out RaiseException: Boolean;
      AException: Exception; out Result: TValue)
    begin
      Output.WriteLine('Exception raised (' + AException.ClassName +
        '): ' + AException.Message);
    end;
  FInterceptor.Proxify(Obj);
end;

destructor TVirtualMethodLogger.Destroy;
begin
  StopLogging;
  inherited Destroy;
end;

procedure TVirtualMethodLogger.StopLogging(ObjectStillAlive: Boolean = True);
begin
  if FInterceptor = nil then Exit;
  try
    if ObjectStillAlive then
    {$IF RTLVersion >= 23}
      FInterceptor.Unproxify(FObject);
    {$ELSE}
      PPointer(FObject)^ := FInterceptor.OriginalClass;
    {$IFEND}
    FreeAndNil(FInterceptor);
    FOutput.Flush;
  finally
    if FOwnOutput then FOutput.Free;
  end;
end;

function LogVirtualMethodCalls(Obj: TObject; Output: TTextWriter;
  OwnOutput: Boolean = False): IVirtualMethodLogger;
begin
  Result := TVirtualMethodLogger.Create(Obj, Output, OwnOutput);
end;

function LogVirtualMethodCalls(Obj: TObject; const LogFile: string;
  Append: Boolean = True): IVirtualMethodLogger;
begin
  Result := TVirtualMethodLogger.Create(Obj, TStreamWriter.Create(LogFile, Append), True);
end;

The idea was then to use it with a VCL form:

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, VMLog;

type
  TForm1 = class(TForm)
    btnShowMessage: TButton;
    btnRaiseException: TButton;
    procedure btnShowMessageClick(Sender: TObject);
    procedure btnRaiseExceptionClick(Sender: TObject);
  strict private
    FLogger: IVirtualMethodLogger;
  public
    constructor Create(AOwner: TComponent); override;
    procedure MsgProc; virtual;
    procedure BadProc; virtual;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TForm1.Create(AOwner: TComponent);
begin
  FLogger := LogVirtualMethodCalls(Self, ChangeFileExt(ParamStr(0), '.log'), False);
  inherited;
end;

procedure TForm1.MsgProc;
begin
  ShowMessage('Hello virtual method logging world');
end;

procedure TForm1.btnShowMessageClick(Sender: TObject);
begin
  MsgProc;
end;

procedure TForm1.BadProc;
begin
  raise EProgrammerNotFound.Create('Dozy, dozy...');
end;

procedure TForm1.btnRaiseExceptionClick(Sender: TObject);
begin
  BadProc;
end;

Unfortunately, this didn’t work as expected: the application just hung!

Motivated more recently to look at it again, I found the problem – the ordinary life of a VCL form involves frequent calls to virtual methods that have untyped parameters (in particular, DefaultHandler and Dispatch), and TVirtualMethodInterceptor doesn’t handle these properly. Since TVirtualMethodInterceptor already filters out various things, the easiest fix is just to have it filter out such methods too.

To do this, take a copy of Rtti.pas (XE1) or System.Rtti.pas (XE2), open it up, and add the following helper function immediately before the implementation for TVirtualMethodInterceptor.CreateProxyClass:

function HasUntypedParameter(AMethod: TRttiMethod): Boolean;
var
  Param: TRttiParameter;
begin
  for Param in AMethod.GetParameters do
    if Param.ParamType = nil then Exit(True);
  Exit(False);
end;

Next, amend TVirtualMethodInterceptor.CreateProxyClass itself. Specifically, immediately after

    if not m.HasExtendedInfo then
      Continue;

add

    if HasUntypedParameter(m) then
      Continue;

This wil now allow the class to at least run when hooking a form. Nonetheless, you should keep in mind that my demo won’t actually log that much, even if you have the form do lots more things. This is due to TVirtualMethodInterceptor relying upon extended RTTI, and RTTI only being generated for public and published methods by default. Since virtual methods (especially in the VCL) tend to have protected visibility, TVirtualMethodInterceptor simply won’t be able to hook a good fair few.

PS: I’ve QCed the bug (see report no. 101873).