Anders Melander

That's not how you do it. You need to let the message handler return with the status you've set, and then call SaveData. You also seem to be confused about the meaning of the WM_QUERYENDSESSION result value. False means you wish to postpone the shutdown. Something like this: const MSG_SAVEDATA = WM_USER; type TForm3 = class(TForm) ... protected procedure MsgSaveData(var Msg: TMessage); message MSG_SAVEDATA; ... end; procedure TForm3.WMQueryEndSession(var Msg: TWMQueryEndSession); begin Msg.Result := lResult(not DataToBeSaved); if (DataToBeSaved) then PostMessage(Handle, MSG_SAVEDATA, 0, 0); end; procedure TForm3.MsgSaveData(var Msg: TMessage); begin SaveData; end;

Isn't that supposed to be a no-no. I seem to recall there's a problem with premature release when creating an instance as a parameter if the parameter is declared const. Edit: Never mind. The as takes care of that problem.

Then I'm afraid I can't reproduce the problem. Can you attach a minimal project (just the dpr, dproj and two datamodule units) which reproduces the problem. And please state what version of Delphi you're using.

https://stackoverflow.com/questions/4518521/delphi-how-to-get-rid-of-ancestor-of-tmyform-not-found-error TL;DR Make sure all data modules (and forms) are declared in the DPR uses list on the form: <unit name> in '<file name>' {<instance variable name>: <base type>}, e.g. ModuleFoo in 'datamodules\ModuleFoo.pas' {DataModuleFoo: TDataModule}, I'm guessing this should work too: ModuleFoo in 'datamodules\ModuleFoo.pas' {TDataModule},

Yes. You are right. As I read it .NOFRAME tells the compiler that I'm not calling anything and don't need a stack frame. Of course that means I'm relying on the existing stack frame having room for the single register we're pushing. I guess removing .NOFRAME would be the safe thing to do.

Aaaaand there's an additional problem with InterlockedCompareExchange128: It doesn't return any value in the ComparandResult parameter. It's supposed to return the new value on success and the current value on failure. Anyway, here's my final (hopefully) fixed version of InterlockedCompareExchange128 which conforms to the Win32 API documentation: {$IFDEF Win64} function InterlockedCompareExchange128(Destination: Pointer; ExchangeHigh, ExchangeLow: Int64; ComparandResult: Pointer): boolean; // The parameters are in the RCX, RDX, R8 and R9 registers per the MS x64 calling convention: // RCX Destination // RDX ExchangeHigh // R8 ExchangeLow // R9 ComparandResult // // CMPXCHG16B requires the following register setup: // RDX:RAX ComparandResult.High:ComparandResult.Low // RCX:RBX ExchangeHigh:ExchangeLow // See: https://www.felixcloutier.com/x86/cmpxchg8b:cmpxchg16b asm .NOFRAME .PUSHNV RBX MOV R10,Destination // RCX MOV RBX,ExchangeLow // R8 MOV RCX,ExchangeHigh // RDX MOV RDX,[ComparandResult+8] // R9 MOV RAX,[ComparandResult] // R9 LOCK CMPXCHG16B [R10] MOV [ComparandResult+8],RDX // R9 MOV [ComparandResult],RAX // R9 SETZ BL XOR EAX, EAX MOV AL,BL end; {$ENDIF Win64} and here's the test I used against it: type T128 = record Low: pointer; High: pointer; end; procedure TestInterlockedCompareExchange128; const Value: T128 = (low: pointer($0010203040506070); high: pointer($8090A0B0C0D0E0F)); var Dest, OldValue, NewValue: T128; begin (* ** Test success *) Dest := Value; OldValue := Value; NewValue.Low := pointer($ABABABABABABABAB); NewValue.High := pointer($1212121212121212); // InterlockedCompareExchange128 should return True Assert(InterlockedCompareExchange128(@Dest, Int64(NewValue.High), Int64(NewValue.Low), @OldValue), 'Success expected'); // Dest contains new value Assert(Dest.Low = NewValue.Low); Assert(Dest.High = NewValue.High); // Comparand contains new value = old value Assert(OldValue.Low = Value.Low); Assert(OldValue.High = Value.High); (* ** Test failure *) Dest := Value; OldValue.Low := pointer($ABABABABABABABAB); OldValue.High := pointer($1212121212121212); NewValue.Low := nil; NewValue.High := nil; // InterlockedCompareExchange128 should return False Assert(not InterlockedCompareExchange128(@Dest, Int64(NewValue.High), Int64(NewValue.Low), @OldValue), 'Failure expected'); // Dest contains original value Assert(Dest.Low = Value.Low); Assert(Dest.High = Value.High); // Comparand contains original value Assert(OldValue.Low = Value.Low); Assert(OldValue.High = Value.High); end; With this fix my event stack test passes no matter how hard I hit it.

There's one thing that bothers me with both InterlockedCompareExchange128 and CAS. They both return a boolean indicating if the swap was performed or not. They correctly do so by examining ZF after calling CMPXCHG16B. If the flag is set they set AL to 1, otherwise clear it to zero: CMPXCHG16B [...] SETZ AL The problem is that the caller examines the value of AX to get the boolean result: call InterlockedCompareExchange128 test eax,eax jnz ... Now what about the value that just happens to be in AH? I would think that we'd need to clear AX before calling SETZ: CMPXCHG16B [...] XOR EAX, EAX SETZ AL Edit: Whoops. XOR EAX,EAX sets ZF.

I've looked at several but they just wrap CMPXCHG16B like CAS does. I think I have an old version of msvc installed somewhere but I think it predates InterlockedCompareExchange128.

Thanks but that can't be the only problem with it. My tests fail even with that detail fixed but passes with the OmniThreadLibrary CAS. I can't spot what the problem is.

Ah, that was why I couldn't get the alignment working. The "packed" wasn't there from the start but at some point I think I must have copied your changes back into my own.

Well, I just tried it anyway. With the CAS version my test passes with 100 threads each doing 10 million operations. I'll have to compare the assembler of the calling code - but first I have some large quantities of pizza to prepare and eat and then I'm watching Astralis anihilate G2.

Probably. It's not a problem but of course it would be nice it we had access now that we're hacking at the problem.

That function is too obscure; I'm not using it. The oldReference parameter is unused and as I said it's not setting the RDX register.

No access.

I got rid of the AV in CMPXCHG16B by allocating the stack head on the heap thus ensuring correct alignment, but I'm still experiencing problems with 64-bit. At some point, when freeing a block returned by Pop, I get an EInvalidPointer exception from FastMM. Other times I end up with a negative count of items on the stack. I can reproduce with just two threads! Occasionally the error occurs after less than 20 operations. Test source attached. UnitEventStackTest.pas UnitEventStackTest.dfm

There's RSP-23333 which is about this problem. I've already posted a link to the original article and this thread to the report. Beyond that it would be nice if someone on the 10.4 field test could bring it to the attention of those that can do something about it.

I'm aware that it's a noop in this case and I was leaving that detail to the compiler... ...but that's a good point. I get your point but I always start with registers and then refactor the code to use symbols to make it readable. I guess I should keep the register names in a comment.

As far as I can tell that's a coincidence. RDX needs a value: https://www.felixcloutier.com/x86/cmpxchg8b:cmpxchg16b

Beware that this does not align memory allocated from the heap. For that you can use the following: {$ifdef CPUX64} SetMinimumBlockAlignment(mba16Byte); {$else CPUX64} SetMinimumBlockAlignment(mba8Byte); {$endif CPUX64} This works for me: function InterlockedCompareExchange128(Destination: Pointer; ExchangeHigh, ExchangeLow: Int64; ComparandResult: Pointer): Bool; stdcall; asm .NOFRAME .PUSHNV R10 .PUSHNV RAX .PUSHNV RBX .PUSHNV RCX MOV R10,Destination MOV RBX,ExchangeLow MOV RCX,ExchangeHigh MOV RDX,[ComparandResult+8] MOV RAX,[ComparandResult] LOCK CMPXCHG16B [R10] SETZ AL end; The PUSHNV RBX is translated to push RBX + pop RBX. The others do nothing.

Here's a simple test of the queue only. I have only shown the test of the old code. The test of the new is similar. Old stack code fails after a short while [*] on 32-bit and 64 bit with an invalid pointer operation on freeing an item popped from the stack (a short while = ~4 seconds, approximately 1 million stack operations by 100 threads on a 4 core system). The reason it fails so quickly is that I have tried to limit the calls to the memory manager as that is a bottleneck which tends to serialize the operations a bit. New stack code succeeds on 32 bit but fails immediately on 64-bit with an AV on the LOCK CMPXCHG16B [R10] in InterlockedCompareExchange128. uses System.SyncObjs; const THREAD_COUNT = 100; ITERATIONS = 1000000; var Threads: array[0..THREAD_COUNT-1] of TThread; type PEventItemHolder = ^TEventItemHolder; TEventItemHolder = record Next: PEventItemHolder; Event: Pointer; end; TSyncEventItem = record Lock: Integer; Event: Pointer; end; procedure Push(var Stack: PEventItemHolder; EventItem: PEventItemHolder); var LStack: PEventItemHolder; begin repeat LStack := Stack; EventItem.Next := LStack; until AtomicCmpExchange(Pointer(Stack), EventItem, LStack) = LStack; end; function Pop(var Stack: PEventItemHolder): PEventItemHolder; begin repeat Result := Stack; if Result = nil then Exit; until AtomicCmpExchange(Pointer(Stack), Result.Next, Result) = Result; end; type TPushPopThread = class(TThread) private class var FEventCache: PEventItemHolder; class var FStackCount: integer; class var FReadyCount: integer; class var FLiveCount: integer; class var FOperations: int64; class var FFailure: boolean; private FEvent: TEvent; protected procedure Execute; override; public constructor Create(AEvent: TEvent); class property StackCount: integer read FStackCount; class property ReadyCount: integer read FReadyCount; class property LiveCount: integer read FLiveCount; class property Failure: boolean read FFailure; class property Operations: int64 read FOperations; end; constructor TPushPopThread.Create(AEvent: TEvent); begin inherited Create; FEvent := AEvent; end; procedure TPushPopThread.Execute; var Item, PoppedItem: PEventItemHolder; begin TInterlocked.Increment(FReadyCount); try FEvent.WaitFor(INFINITE); TInterlocked.Increment(FLiveCount); try try Item := nil; try for var i := 0 to ITERATIONS-1 do begin if (Terminated) or (FFailure) then exit; if (Random(4) = 0) then // A lot more Pops that Pushes begin if (Item = nil) then New(Item); Item.Event := pointer(TInterlocked.Increment(FStackCount)); Push(FEventCache, Item); Item := nil; end else begin PoppedItem := Pop(FEventCache); if (PoppedItem <> nil) then begin TInterlocked.Decrement(FStackCount); if (Item <> nil) then FreeMem(Item); Item := PoppedItem; end; end; TInterlocked.Increment(FOperations); end; // Pop and free remaining items PoppedItem := Pop(FEventCache); while (PoppedItem <> nil) do begin TInterlocked.Decrement(FStackCount); FreeMem(PoppedItem); PoppedItem := Pop(FEventCache); end; finally if (Item <> nil) then FreeMem(Item); end; except FFailure := True; raise; end; finally TInterlocked.Decrement(FLiveCount); end; finally TInterlocked.Decrement(FReadyCount); end; end; procedure TForm11.ButtonOldStartClick(Sender: TObject); begin var Event := TEvent.Create(nil, True, False, ''); try for var i := 0 to THREAD_COUNT-1 do if (Threads[i] = nil) then Threads[i] := TPushPopThread.Create(Event); // Wait for all threads ready to execute while (TPushPopThread.ReadyCount < THREAD_COUNT) do Sleep(1); // Start all threads Event.SetEvent; // Wait for thread completion while (TPushPopThread.LiveCount > 0) do Sleep(1); finally Event.Free; end; if (TPushPopThread.Failure) then ShowMessage('Failed') else if (TPushPopThread.StackCount > 0) then ShowMessage('Stack lost items') else ShowMessage('Success'); for var i := 0 to THREAD_COUNT-1 do if (Threads[i] <> nil) then begin Threads[i].WaitFor; FreeAndNil(Threads[i]); end; end;

The test is IMO doing too much so it's hard to tell where the problem originates. Since we've been focusing on the TEventItemHolder stack I would start by verifying that the original code fails (although it's obvious that is has the ABA problem) and the new code doesn't fail. Then I would validate TMonitor.Wait and only then would I validate TThreadedQueue.PopItem.

Not in this single case, I agree, but beware of tunnel vision. Regardless the obstacle is probably more a question of resources and priorities. It might also not be easy to shoehorn something like this into the existing compiler. If it's implemented like a traditional one-pass compiler it will be using various optimizations that can only be made because it's a one-pass compiler.

It isn't. The type and offset of the members needs to be known too: type TMyRecord = record Foo: integer; Bar: string; end; TMyClass = class private FFooBar: TMyRecord; public property Foo: integer read FFooBar.Foo; property Bar: string read FFooBar.Bar; end;

You're missing an "n" in Exchange and the NewValue and CurrentValue parameters should be declared as const or [ref].