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

fix(codegen): allocate sret buffer for discarded record-returning method calls

Browse source 
Calling a record-returning method as a statement (result discarded) omitted
the hidden sret pointer required by the SysV x86-64 ABI.  Self was passed
in %rdi where the sret buffer should be, so the callee wrote the returned
record through the object pointer, corrupting its fields.

Semantic pass: set ResolvedReturnTypeDesc on TMethodCallStmt at all three
class-method resolution sites so both backends can detect the record return.

QBE backend: allocate a temporary buffer via alloc8, zero it, route through
EmitRecordReturnCallSite, then release any managed fields (strings, classes,
interfaces, dynamic arrays).  Both the regular and ObjExpr receiver paths.

Native backend: reserve an aligned stack buffer, shift Self from %rdi to
%rsi, place the sret pointer in %rdi, and clean up managed fields after the
call.  Handles the <=6-slot path.
This commit is contained in:
Graeme Geldenhuys 2026-06-26 14:13:10 +01:00
parent 09c2d1a0b9
commit af59423f11
4 changed files with 215 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -9023,6 +9023,9 @@ var
HK: TList<Integer>;
HTotal: Integer;
RT: TRecordTypeDesc;
IsSretDiscard: Boolean;
SretBufSize: Integer;
SretRT: TRecordTypeDesc;
begin
{ Metaclass-var constructor dispatch in statement position: C.Create(args)
where C is a 'class of' variable and the result is discarded. Only the
@ -9224,12 +9227,36 @@ begin
'native backend: TMethodCallStmt has no ResolvedMethod (' + ACall.Name + ')');
Sym := MethodEmitNameNative(MD, MD.OwnerTypeName, ACall.Name);
IsSretDiscard := (ACall.ResolvedReturnTypeDesc <> nil) and
(ACall.ResolvedReturnTypeDesc.Kind = tyRecord) and
(ClassifyRecordReturn(TRecordTypeDesc(ACall.ResolvedReturnTypeDesc)) = rcSret);
SretBufSize := 0;
SretRT := nil;
if IsSretDiscard then
begin
SretRT := TRecordTypeDesc(ACall.ResolvedReturnTypeDesc);
SretBufSize := (SretRT.TotalSize() + 15) and (-16);
end;
UserSlots := Self.CountArgSlots(MD.Params);
TotalSlots := UserSlots + 1;
if TotalSlots <= 6 then
begin
{ ≤6 total slots: push/pop strategy (Self in %rdi, args in %rsi..%r9). }
{ ≤6 total slots: push/pop strategy (Self in %rdi, args in %rsi..%r9).
When IsSretDiscard is set, %rdi holds the throwaway buffer and Self
shifts to %rsi, so user args start at %rdx (IntBase = 2). }
if IsSretDiscard then
begin
Self.Emit(#9'pushq %rbx');
Self.Emit(Format(#9'subq $%d, %%rsp', [SretBufSize]));
Self.Emit(#9'movq %rsp, %rbx');
Self.Emit(#9'movq %rbx, %rdi');
Self.Emit(#9'xorl %esi, %esi');
Self.Emit(Format(#9'movq $%d, %%rdx', [SretRT.TotalSize()]));
Self.Emit(#9'callq memset');
end;
Self.BeginCallArgs(MD.Params, ACall.Args);
for I := 0 to ACall.Args.Count - 1 do
begin
@ -9276,8 +9303,17 @@ begin
else
Self.Emit(Format(#9'movq %s, %%r10', [Self.VarOperand('Self')]));
Self.EmitPopMethodArgsToRegs(MD.Params, ACall.Args, 1);
Self.Emit(#9'movq %r10, %rdi');
if IsSretDiscard then
begin
Self.EmitPopMethodArgsToRegs(MD.Params, ACall.Args, 2);
Self.Emit(#9'movq %r10, %rsi');
Self.Emit(#9'movq %rbx, %rdi');
end
else
begin
Self.EmitPopMethodArgsToRegs(MD.Params, ACall.Args, 1);
Self.Emit(#9'movq %r10, %rdi');
end;
end
else
begin
@ -9359,7 +9395,10 @@ begin
if MD.VTableSlot >= 0 then
begin
Self.Emit(#9'movq (%rdi), %rax');
if IsSretDiscard then
Self.Emit(#9'movq (%rsi), %rax')
else
Self.Emit(#9'movq (%rdi), %rax');
Self.Emit(Format(#9'movq %d(%%rax), %%rax', [(MD.VTableSlot + 1) * 8]));
Self.Emit(#9'callq *%rax');
end
@ -9374,6 +9413,14 @@ begin
end
else
Self.EndCallArgs();
if IsSretDiscard then
begin
if not Self.IsRecordManagedClean(SretRT) then
Self.EmitRecordFieldReleases(SretRT, '%rbx');
Self.Emit(Format(#9'addq $%d, %%rsp', [SretBufSize]));
Self.Emit(#9'popq %rbx');
end;
end;
{ Shared static-dispatch call sequence for both inherited forms. Marshals

57
compiler/src/main/pascal/blaise.codegen.qbe.pas
View file

@ -6784,22 +6784,30 @@ begin
ArgTemp := AllocTemp();
EmitLine(Format(' %s =l add %s, %d', [ArgTemp, VTblTemp, SlotOff]));
EmitLine(Format(' %s =l loadl %s', [FPtrTemp, ArgTemp]));
EmitLine(Format(' call %s(%s)', [FPtrTemp, ArgLine]));
FlushPendingReleases(PMark);
EmitOwnedArgReleases(ACall.Args, ArgTemps, MDecl.Params);
ReleaseConstStringArgs(ACall.Args, ArgTemps, MDecl.Params);
ArgTemps.Free();
{ Receiver was a +1-owned temporary (function/property return) used
transiently — release it so the temporary does not leak. }
if ExprOwnsRef(ACall.ObjExpr) then
EmitLine(Format(' call $_ClassRelease(l %s)', [SelfTemp]));
Exit;
end;
if MDecl.OwnerTypeName <> '' then
FuncName := '$' + MethodEmitName(MDecl, MDecl.OwnerTypeName, ACall.Name)
FuncName := FPtrTemp;
end
else
FuncName := '$' + MethodEmitName(MDecl, RT.Name, ACall.Name);
EmitLine(Format(' call %s(%s)', [FuncName, ArgLine]));
begin
if MDecl.OwnerTypeName <> '' then
FuncName := '$' + MethodEmitName(MDecl, MDecl.OwnerTypeName, ACall.Name)
else
FuncName := '$' + MethodEmitName(MDecl, RT.Name, ACall.Name);
end;
if (ACall.ResolvedReturnTypeDesc <> nil) and
(ACall.ResolvedReturnTypeDesc.Kind = tyRecord) then
begin
SretTemp := AllocTemp();
EmitLine(Format(' %s =l alloc8 %d',
[SretTemp, TRecordTypeDesc(ACall.ResolvedReturnTypeDesc).TotalSize()]));
EmitLine(Format(' call $memset(l %s, w 0, l %d)',
[SretTemp, TRecordTypeDesc(ACall.ResolvedReturnTypeDesc).TotalSize()]));
Self.EmitRecordReturnCallSite(FuncName, ArgLine,
TRecordTypeDesc(ACall.ResolvedReturnTypeDesc), SretTemp);
if not Self.IsRecordManagedClean(TRecordTypeDesc(ACall.ResolvedReturnTypeDesc)) then
Self.EmitRecordReleaseFields(TRecordTypeDesc(ACall.ResolvedReturnTypeDesc), SretTemp);
end
else
EmitLine(Format(' call %s(%s)', [FuncName, ArgLine]));
FlushPendingReleases(PMark);
EmitOwnedArgReleases(ACall.Args, ArgTemps, MDecl.Params);
ReleaseConstStringArgs(ACall.Args, ArgTemps, MDecl.Params);
@ -6995,7 +7003,7 @@ begin
ArgTemp := AllocTemp();
EmitLine(Format(' %s =l add %s, %d', [ArgTemp, VTblTemp, SlotOff]));
EmitLine(Format(' %s =l loadl %s', [FPtrTemp, ArgTemp]));
EmitLine(Format(' call %s(%s)', [FPtrTemp, ArgLine]));
FuncName := FPtrTemp;
end
else
begin
@ -7004,8 +7012,23 @@ begin
FuncName := '$' + MethodEmitName(MDecl, MDecl.OwnerTypeName, ACall.Name)
else
FuncName := '$' + MethodEmitName(MDecl, RT.Name, ACall.Name);
EmitLine(Format(' call %s(%s)', [FuncName, ArgLine]));
end;
if (ACall.ResolvedReturnTypeDesc <> nil) and
(ACall.ResolvedReturnTypeDesc.Kind = tyRecord) then
begin
SretTemp := AllocTemp();
EmitLine(Format(' %s =l alloc8 %d',
[SretTemp, TRecordTypeDesc(ACall.ResolvedReturnTypeDesc).TotalSize()]));
EmitLine(Format(' call $memset(l %s, w 0, l %d)',
[SretTemp, TRecordTypeDesc(ACall.ResolvedReturnTypeDesc).TotalSize()]));
Self.EmitRecordReturnCallSite(FuncName, ArgLine,
TRecordTypeDesc(ACall.ResolvedReturnTypeDesc), SretTemp);
if not Self.IsRecordManagedClean(TRecordTypeDesc(ACall.ResolvedReturnTypeDesc)) then
Self.EmitRecordReleaseFields(TRecordTypeDesc(ACall.ResolvedReturnTypeDesc), SretTemp);
end
else
EmitLine(Format(' call %s(%s)', [FuncName, ArgLine]));
FlushPendingReleases(PMark);
EmitOwnedArgReleases(ACall.Args, ArgTemps, MDecl.Params);
ReleaseConstStringArgs(ACall.Args, ArgTemps, MDecl.Params);

9
compiler/src/main/pascal/uSemantic.pas
View file

@ -7536,6 +7536,9 @@ begin
AppendDefaultArgs(ACall.Args, MDecl, ACall.Name, ACall.Line, ACall.Col);
ACall.ResolvedClassType := RT;
ACall.ResolvedMethod := MDecl;
if (MDecl.ResolvedReturnType <> nil) and
(MDecl.ResolvedReturnType.Kind = tyRecord) then
ACall.ResolvedReturnTypeDesc := MDecl.ResolvedReturnType;
Exit;
end;
@ -7588,6 +7591,9 @@ begin
AppendDefaultArgs(ACall.Args, MDecl, ACall.Name, ACall.Line, ACall.Col);
ACall.ResolvedClassType := RT;
ACall.ResolvedMethod := MDecl;
if (MDecl.ResolvedReturnType <> nil) and
(MDecl.ResolvedReturnType.Kind = tyRecord) then
ACall.ResolvedReturnTypeDesc := MDecl.ResolvedReturnType;
Exit;
end;
end;
@ -7700,6 +7706,9 @@ begin
ACall.ResolvedMethod := MDecl;
ACall.IsGlobal := ObjSym.IsGlobal;
ACall.IsVarParam := (ObjSym.Kind = skVarParameter);
if (MDecl.ResolvedReturnType <> nil) and
(MDecl.ResolvedReturnType.Kind = tyRecord) then
ACall.ResolvedReturnTypeDesc := MDecl.ResolvedReturnType;
end;
{ If AExpr is a diamond constructor call (RecordName ends with '<>'), replace

115
compiler/src/test/pascal/cp.test.e2e.recordret.pas
View file

@ -142,6 +142,18 @@ type
lives in the inline-asm commit; this test, from Andrew's parallel fix,
locks it in.) }
procedure TestRun_SretResult_ReadModifyOffsetZeroField;
{ Regression: calling a record-returning METHOD as a statement (result
discarded) with no assignment target. The SysV sret ABI puts the sret
pointer in %rdi and Self in %rsi, but without a buffer the callee wrote
the record through Self, corrupting the object. Both backends. }
procedure TestRun_DiscardedRecordReturn_ManagedField;
{ Same for a small record with only scalar fields (register-returned,
not sret) — the return value goes to %rax and is harmlessly discarded,
but we must verify codegen doesn't crash. }
procedure TestRun_DiscardedRecordReturn_ScalarOnly;
{ Discarded record-returning call via an expression receiver
(Obj.RecordMethod();). Tests the ObjExpr path. }
procedure TestRun_DiscardedRecordReturn_ObjExprReceiver;
end;
implementation
@ -1104,6 +1116,109 @@ begin
AssertRunsOnAll(Src, '11 hi 20' + LE, 0);
end;
procedure TE2ERecordReturnTests.TestRun_DiscardedRecordReturn_ManagedField;
const
Src = '''
program P;
type
TToken = record
Kind: Integer;
Value: string;
end;
TLexer = class
FName: string;
function Next(): TToken;
function GetName(): string;
end;
function TLexer.Next(): TToken;
begin
Result.Kind := 42;
Result.Value := 'hello'
end;
function TLexer.GetName(): string;
begin
Result := FName
end;
var L: TLexer;
begin
L := TLexer.Create();
L.FName := 'mylex';
L.Next();
WriteLn(L.GetName());
L.Free()
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(Src, 'mylex' + LE, 0);
end;
procedure TE2ERecordReturnTests.TestRun_DiscardedRecordReturn_ScalarOnly;
const
Src = '''
program P;
type
TPoint = record X, Y: Integer; end;
TObj = class
function Pos(): TPoint;
end;
function TObj.Pos(): TPoint;
begin
Result.X := 10;
Result.Y := 20
end;
var O: TObj;
begin
O := TObj.Create();
O.Pos();
WriteLn('ok');
O.Free()
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(Src, 'ok' + LE, 0);
end;
procedure TE2ERecordReturnTests.TestRun_DiscardedRecordReturn_ObjExprReceiver;
const
Src = '''
program P;
type
TRec = record N: Integer; S: string; end;
TFactory = class
FTag: string;
function Make(): TRec;
function GetTag(): string;
end;
THolder = class
F: TFactory;
end;
function TFactory.Make(): TRec;
begin
Result.N := 7;
Result.S := 'test'
end;
function TFactory.GetTag(): string;
begin
Result := FTag
end;
var H: THolder;
begin
H := THolder.Create();
H.F := TFactory.Create();
H.F.FTag := 'mytag';
H.F.Make();
WriteLn(H.F.GetTag());
H.F.Free();
H.Free()
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(Src, 'mytag' + LE, 0);
end;
initialization
RegisterTest(TE2ERecordReturnTests);