fix(native): double-deref var-param class receivers in method calls

When a class variable is passed as a var parameter and a method is called
on it (e.g. AList.Add inside a procedure taking var AList: TStringList),
the stack slot holds the address of the caller's variable, not the object
pointer.  Class method dispatch requires dereferencing twice: once to get
the caller's variable address, once to get the heap-allocated object.

The native backend was only dereferencing once, passing the address of the
global/local variable as Self.  This corrupted memory when the method wrote
to fields at offsets from the wrong base address — manifesting as adjacent
globals being overwritten (e.g. TStringList.Grow corrupting DumpAST).

Fixed all seven receiver-loading sites: EmitMethodCallExpr (<=6 and >6 slot
paths), EmitMethodCallStmt (<=6 and >6 paths, plus the Free handler),
EmitMethodSretCall, and the zero-arg TFieldAccessExpr.IsMethodCall path.
Also added record-var-param cases for consistency with the QBE backend.
This commit is contained in:
Graeme Geldenhuys 2026-06-10 06:31:02 +01:00
parent b0aa8b2701
commit d267bbc7fc
2 changed files with 82 additions and 3 deletions

View file

@ -4766,6 +4766,8 @@ begin
Self.EmitExprToEax(FAE.Base);
Self.Emit(#9'movq %rax, %rdi');
end
else if MD.IsRecordMethod and FAE.IsVarParam then
Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand(FAE.RecordName)]))
else if MD.IsRecordMethod then
begin
if Self.IsLocal(FAE.RecordName) then
@ -4773,6 +4775,11 @@ begin
else
Self.Emit(Format(#9'leaq %s(%%rip), %%rdi', [FAE.RecordName]));
end
else if FAE.IsVarParam then
begin
Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand(FAE.RecordName)]));
Self.Emit(#9'movq (%rdi), %rdi');
end
else
begin
if Self.IsLocal(FAE.RecordName) then
@ -5325,13 +5332,20 @@ begin
if ACall.ObjectName <> '' then
begin
if MD.IsRecordMethod then
if MD.IsRecordMethod and ACall.IsVarParam then
Self.Emit(Format(#9'movq %s, %%r10', [Self.VarOperand(ACall.ObjectName)]))
else if MD.IsRecordMethod then
begin
if Self.IsLocal(ACall.ObjectName) then
Self.Emit(Format(#9'leaq %s, %%r10', [Self.VarOperand(ACall.ObjectName)]))
else
Self.Emit(Format(#9'leaq %s(%%rip), %%r10', [ACall.ObjectName]));
end
else if ACall.IsVarParam then
begin
Self.Emit(Format(#9'movq %s, %%r10', [Self.VarOperand(ACall.ObjectName)]));
Self.Emit(#9'movq (%r10), %r10');
end
else
begin
if Self.IsLocal(ACall.ObjectName) then
@ -5394,13 +5408,20 @@ begin
if ACall.ObjectName <> '' then
begin
if MD.IsRecordMethod then
if MD.IsRecordMethod and ACall.IsVarParam then
Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand(ACall.ObjectName)]))
else if MD.IsRecordMethod then
begin
if Self.IsLocal(ACall.ObjectName) then
Self.Emit(Format(#9'leaq %s, %%rax', [Self.VarOperand(ACall.ObjectName)]))
else
Self.Emit(Format(#9'leaq %s(%%rip), %%rax', [ACall.ObjectName]));
end
else if ACall.IsVarParam then
begin
Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand(ACall.ObjectName)]));
Self.Emit(#9'movq (%rax), %rax');
end
else
begin
if Self.IsLocal(ACall.ObjectName) then
@ -5598,6 +5619,15 @@ begin
Self.Emit(#9'movq %rax, %rdi');
Self.Emit(#9'callq _ClassRelease');
end
else if ACall.IsVarParam then
begin
Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand(ACall.ObjectName)]));
Self.Emit(#9'pushq %rax');
Self.Emit(#9'movq (%rax), %rdi');
Self.Emit(#9'callq _ClassRelease');
Self.Emit(#9'popq %rax');
Self.Emit(#9'movq $0, (%rax)');
end
else
begin
if Self.IsLocal(ACall.ObjectName) then
@ -5650,6 +5680,11 @@ begin
else
Self.Emit(Format(#9'leaq %s(%%rip), %%r10', [ACall.ObjectName]));
end
else if ACall.IsVarParam then
begin
Self.Emit(Format(#9'movq %s, %%r10', [Self.VarOperand(ACall.ObjectName)]));
Self.Emit(#9'movq (%r10), %r10');
end
else if ACall.ObjectName <> '' then
begin
if Self.IsLocal(ACall.ObjectName) then
@ -5719,6 +5754,11 @@ begin
else
Self.Emit(Format(#9'leaq %s(%%rip), %%rax', [ACall.ObjectName]));
end
else if ACall.IsVarParam then
begin
Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand(ACall.ObjectName)]));
Self.Emit(#9'movq (%rax), %rax');
end
else if ACall.ObjectName <> '' then
begin
if Self.IsLocal(ACall.ObjectName) then
@ -9106,13 +9146,20 @@ begin
if ACall.ObjectName <> '' then
begin
if MD.IsRecordMethod then
if MD.IsRecordMethod and ACall.IsVarParam then
Self.Emit(Format(#9'movq %s, %%rsi', [Self.VarOperand(ACall.ObjectName)]))
else if MD.IsRecordMethod then
begin
if Self.IsLocal(ACall.ObjectName) then
Self.Emit(Format(#9'leaq %s, %%rsi', [Self.VarOperand(ACall.ObjectName)]))
else
Self.Emit(Format(#9'leaq %s(%%rip), %%rsi', [ACall.ObjectName]));
end
else if ACall.IsVarParam then
begin
Self.Emit(Format(#9'movq %s, %%rsi', [Self.VarOperand(ACall.ObjectName)]));
Self.Emit(#9'movq (%rsi), %rsi');
end
else
begin
if Self.IsLocal(ACall.ObjectName) then

View file

@ -307,6 +307,9 @@ type
procedure TestRun_Native_ImplicitSelfMethodCall;
procedure TestRun_Native_RecordFieldCopy;
procedure TestRun_Native_SretFieldARC;
{ M8b — method call on a var-param class receiver (double dereference). }
procedure TestRun_Native_VarParam_MethodCall;
end;
implementation
@ -4579,6 +4582,35 @@ begin
'42:hello' + LE + '99:world' + LE, 0);
end;
procedure TE2ENativeTests.TestRun_Native_VarParam_MethodCall;
begin
Self.AssertRunsOnBoth(
'program TestVarParamMethodCall; '
+ 'type '
+ ' TBox = class '
+ ' public '
+ ' FValue: Integer; '
+ ' procedure SetVal(AV: Integer); '
+ ' function GetVal(): Integer; '
+ ' end; '
+ 'procedure TBox.SetVal(AV: Integer); '
+ 'begin FValue := AV end; '
+ 'function TBox.GetVal(): Integer; '
+ 'begin Result := FValue end; '
+ 'procedure Bump(var B: TBox); '
+ 'begin B.SetVal(B.GetVal() + 10) end; '
+ 'var '
+ ' X: TBox; '
+ 'begin '
+ ' X := TBox.Create(); '
+ ' X.SetVal(5); '
+ ' Bump(X); '
+ ' WriteLn(X.GetVal()); '
+ ' X.Free() '
+ 'end.',
'15' + LE, 0);
end;
initialization
RegisterTest(TE2ENativeTests);