administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

fix(native): nil l-value Free slots; sret record calls into array elements

Browse source 
Two native miscompiles, found chasing the generic-template in-memory
bif round-trip crash (TIfaceIOTests.TestRoundTrip_Generic*_TemplateParams):

1. .Free() on an l-value receiver expression (Def.ClassDef.Free()) only
   released — the slot was not nilled (the QBE lowering stores 0).  The
   stale pointer aliased the next same-size allocation, so the following
   ARC field store double-released the NEW object; its owned lists died
   while still referenced (ReadGenericClassPayload's Free+Create+assign
   dance left ClassDef.Fields freed → nil deref in the test).  Field and
   ident receivers now release AND nil via EmitLValueSlotAddr; other
   expression receivers keep the release-only behaviour.

2. A record-returning call assigned into an array element
   (t[i] := FLexer.Next()) evaluated the RHS via EmitExprToEax, which
   cannot pass the hidden sret pointer — the callee wrote its Result
   record through garbage (TLexerTests crashed; the suite had never run
   natively because the round-trip crash aborted earlier).  Both
   subscript-assign branches now sret record-returning calls directly
   into the element after releasing the old element's managed fields.

The FULL natively-compiled TestRunner passes for the first time:
2944 tests, 0 failures (previously aborted at TIfaceIOTests).

Tests: TNativeConstArgTests.TestFree_FieldReceiver_NilsSlot (asm-level)
+ TE2ERecordsTests.TestRun_RecordCallResult_IntoArrayElement (both
backends).  Suite: 2945 OK; FIXPOINT_OK; NATIVE_FIXPOINT_OK.
This commit is contained in:
Graeme Geldenhuys 2026-06-11 11:50:24 +01:00
parent c62ce5b8b1
commit d6b706ffd3
3 changed files with 173 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

104
compiler/src/main/pascal/blaise.codegen.native.x86_64.pas
View file

@ -353,6 +353,10 @@ type
procedure EmitSretCall(const AFuncSym: string; ADecl: TMethodDecl;
AArgs: TObjectList; const ASretAddr: string;
ASretIsIndirect: Boolean);
{ True when AExpr is a record-returning function or method call. }
function IsNativeRecordCall(AExpr: TASTExpr): Boolean;
{ Sret a record-returning call (function or method) into ADest. }
procedure EmitRecordCallSretAt(AExpr: TASTExpr; const ADest: string);
procedure EmitMethodSretCall(ACall: TMethodCallExpr; const ASretAddr: string;
ASretIsIndirect: Boolean);
{ Compute the address of a record/class field into %rcx. Handles
@ -3182,6 +3186,31 @@ begin
'native backend: unsupported L-value form');
end;
function TX86_64Backend.IsNativeRecordCall(AExpr: TASTExpr): Boolean;
begin
Result := False;
if (AExpr is TMethodCallExpr) and
(TMethodCallExpr(AExpr).ResolvedMethod <> nil) and
(TMethodDecl(TMethodCallExpr(AExpr).ResolvedMethod).ResolvedReturnType <> nil) and
(TMethodDecl(TMethodCallExpr(AExpr).ResolvedMethod).ResolvedReturnType.Kind = tyRecord) then
Exit(True);
if (AExpr is TFuncCallExpr) and
(TFuncCallExpr(AExpr).ResolvedDecl <> nil) and
(TMethodDecl(TFuncCallExpr(AExpr).ResolvedDecl).ResolvedReturnType <> nil) and
(TMethodDecl(TFuncCallExpr(AExpr).ResolvedDecl).ResolvedReturnType.Kind = tyRecord) then
Exit(True);
end;
procedure TX86_64Backend.EmitRecordCallSretAt(AExpr: TASTExpr; const ADest: string);
begin
if AExpr is TMethodCallExpr then
Self.EmitMethodSretCall(TMethodCallExpr(AExpr), ADest, False)
else
Self.EmitSretCall(FuncSymbolOf(TFuncCallExpr(AExpr)),
TMethodDecl(TFuncCallExpr(AExpr).ResolvedDecl),
TFuncCallExpr(AExpr).Args, ADest, False);
end;
procedure TX86_64Backend.EmitIncDec(ACall: TProcCall);
var
Arg0: TASTExpr;
@ -6493,9 +6522,25 @@ begin
end
else if ACall.ObjExpr <> nil then
begin
Self.EmitExprToEax(ACall.ObjExpr);
Self.Emit(#9'movq %rax, %rdi');
Self.Emit(#9'callq _ClassRelease');
if (ACall.ObjExpr is TFieldAccessExpr) or (ACall.ObjExpr is TIdentExpr) then
begin
{ L-value receiver (Def.ClassDef.Free()): release AND nil the slot.
A stale pointer left here aliases the next allocation of the same
size class, and the following ARC field store double-releases it —
the QBE lowering nils the slot, so must we. }
Self.EmitLValueSlotAddr(ACall.ObjExpr);
Self.Emit(#9'pushq %rdx');
Self.Emit(#9'movq (%rdx), %rdi');
Self.Emit(#9'callq _ClassRelease');
Self.Emit(#9'popq %rdx');
Self.Emit(#9'movq $0, (%rdx)');
end
else
begin
Self.EmitExprToEax(ACall.ObjExpr);
Self.Emit(#9'movq %rax, %rdi');
Self.Emit(#9'callq _ClassRelease');
end;
end
else if ACall.IsVarParam then
begin
@ -9574,6 +9619,32 @@ begin
(SSA.ResolvedArrayType.Kind = tyDynArray) then
begin
DAElemType := TDynArrayTypeDesc(SSA.ResolvedArrayType).ElementType;
{ Record-returning call as the RHS: sret directly into the element —
EmitExprToEax cannot evaluate a record call (the callee writes its
Result through the hidden sret pointer, which would be garbage). }
if (DAElemType.Kind = tyRecord) and Self.IsNativeRecordCall(SSA.ValueExpr) then
begin
Self.Emit(#9'pushq %rbx');
Self.EmitExprToEax(SSA.IndexExpr);
Self.Emit(Format(#9'imulq $%d, %%rax', [DAElemType.RawSize()]));
if SSA.IsImplicitSelf then
begin
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('Self')]));
if SSA.ImplicitFieldInfo.Offset > 0 then
Self.Emit(Format(#9'addq $%d, %%rcx', [SSA.ImplicitFieldInfo.Offset]));
Self.Emit(#9'movq (%rcx), %rcx');
end
else if Self.IsLocal(SSA.ArrayName) then
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(SSA.ArrayName)]))
else
Self.Emit(Format(#9'movq %s(%%rip), %%rcx', [SSA.ArrayName]));
Self.Emit(#9'addq %rcx, %rax');
Self.Emit(#9'movq %rax, %rbx');
Self.EmitRecordFieldReleases(TRecordTypeDesc(DAElemType), '%rbx');
Self.EmitRecordCallSretAt(SSA.ValueExpr, '(%rbx)');
Self.Emit(#9'popq %rbx');
Exit;
end;
Self.EmitExprToEax(SSA.ValueExpr);
Self.Emit(#9'pushq %rax');
Self.EmitExprToEax(SSA.IndexExpr);
@ -9646,6 +9717,33 @@ begin
raise ENativeCodeGenError.Create(
'native backend: static subscript assign on non-static-array');
DAElemType := TStaticArrayTypeDesc(SSA.ResolvedArrayType).ElementType;
{ Record-returning call RHS: sret directly into the element (see the
dyn-array branch above). }
if (DAElemType.Kind = tyRecord) and Self.IsNativeRecordCall(SSA.ValueExpr) then
begin
Self.Emit(#9'pushq %rbx');
Self.EmitExprToEax(SSA.IndexExpr);
if TStaticArrayTypeDesc(SSA.ResolvedArrayType).LowBound <> 0 then
Self.Emit(Format(#9'subq $%d, %%rax',
[TStaticArrayTypeDesc(SSA.ResolvedArrayType).LowBound]));
Self.Emit(Format(#9'imulq $%d, %%rax', [DAElemType.RawSize()]));
if SSA.IsImplicitSelf then
begin
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('Self')]));
if SSA.ImplicitFieldInfo.Offset > 0 then
Self.Emit(Format(#9'addq $%d, %%rcx', [SSA.ImplicitFieldInfo.Offset]));
end
else if Self.IsLocal(SSA.ArrayName) then
Self.Emit(Format(#9'leaq %s, %%rcx', [Self.VarOperand(SSA.ArrayName)]))
else
Self.Emit(Format(#9'leaq %s(%%rip), %%rcx', [SSA.ArrayName]));
Self.Emit(#9'addq %rcx, %rax');
Self.Emit(#9'movq %rax, %rbx');
Self.EmitRecordFieldReleases(TRecordTypeDesc(DAElemType), '%rbx');
Self.EmitRecordCallSretAt(SSA.ValueExpr, '(%rbx)');
Self.Emit(#9'popq %rbx');
Exit;
end;
Self.EmitExprToEax(SSA.ValueExpr);
Self.Emit(#9'pushq %rax');
Self.EmitExprToEax(SSA.IndexExpr);

43
compiler/src/test/pascal/cp.test.e2e.records.pas
View file

@ -51,6 +51,7 @@ type
procedure TestRun_SubscriptChain_FieldElemWrite;
procedure TestRun_RecordField_StaticArrayElemWrite;
procedure TestRun_RecordField_DynArrayOfString_ElemWrite_ARC;
procedure TestRun_RecordCallResult_IntoArrayElement;
end;
implementation
@ -1031,6 +1032,48 @@ begin
'bye' + LE + 'world' + LE, 0);
end;
const
SrcRecordCallIntoElem = '''
program P;
type
TTok = record
Kind: Integer;
Text: String;
end;
TLex = class
FN: Integer;
function Next(): TTok;
end;
function TLex.Next(): TTok;
begin
FN := FN + 1;
Result.Kind := FN;
Result.Text := 'tok' + IntToStr(FN);
end;
var
L: TLex;
A: array[0..2] of TTok;
D: array of TTok;
I: Integer;
begin
L := TLex.Create();
for I := 0 to 2 do
A[I] := L.Next();
writeln(A[0].Kind, ' ', A[0].Text);
writeln(A[2].Kind, ' ', A[2].Text);
SetLength(D, 2);
D[1] := L.Next();
writeln(D[1].Kind, ' ', D[1].Text);
end.
''';
procedure TE2ERecordsTests.TestRun_RecordCallResult_IntoArrayElement;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(SrcRecordCallIntoElem,
'1 tok1' + LE + '3 tok3' + LE + '4 tok4' + LE, 0);
end;
initialization
RegisterTest(TE2ERecordsTests);

29
compiler/src/test/pascal/cp.test.nativeconstarg.pas
View file

@ -51,6 +51,9 @@ type
procedure TestConstArg_AddrTakenLocal_Pins;
procedure TestConstArg_CapturedLocal_Pins;
procedure TestConstArg_InterfaceDispatch_ConcatPins;
{ Free on a chained field receiver must nil the slot after the release —
a stale pointer aliases the next allocation (UAF regression). }
procedure TestFree_FieldReceiver_NilsSlot;
end;
implementation
@ -461,6 +464,32 @@ begin
Pos('_StringRelease', Region) >= 0);
end;
procedure TNativeConstArgTests.TestFree_FieldReceiver_NilsSlot;
var
Region: string;
begin
Region := FuncRegion(GenAsm('''
program P;
type
TInner = class
N: Integer;
end;
TOuter = class
Inner: TInner;
end;
procedure Drop(O: TOuter);
begin
O.Inner.Free();
end;
begin
end.
'''), 'Drop');
AssertTrue('releases the field value',
CountOccurrences('callq _ClassRelease', Region) >= 1);
AssertTrue('nils the field slot after the release',
CountOccurrences('movq $0, (%rdx)', Region) >= 1);
end;
initialization
RegisterTest(TNativeConstArgTests);