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

feat(codegen): function-returning-interface via sret convention

Browse source 
Both QBE and native backends now support functions/methods that return
an interface type.  The return uses sret (struct-return) convention:
the caller allocates a 16-byte buffer (obj+itab), passes its address as
a hidden first argument, and the callee writes both fat-pointer slots
into the buffer.

QBE backend:
- Function signature adds hidden l %_par__sret, function becomes void
- Result_obj aliases sret+0, Result_itab aliases sret+8
- Epilogue is plain ret (no return value)
- Caller-side: alloc 16-byte buffer, EmitRecordCallSret, load obj+itab
- New IsInterfaceCall() helper and assignment handler for the sret path

Native backend:
- BuildFrame marks interface returns as FSretFunc (same as records)
- EmitIntfSretCall: allocates stack buffer, passes as %rdi, calls func
- EmitInterfaceAssign: new sret-Result path dereferences the Result
  pointer to write obj+itab into the caller's buffer
- Assignment handler loads obj+itab from sret buffer after the call

Previously, functions returning interfaces crashed the QBE backend
(undeclared split-slot names in IR) and were unsupported in native.
This commit is contained in:
Graeme Geldenhuys 2026-06-10 08:54:59 +01:00
parent 4eaec15e67
commit c8ce6f7bbe
3 changed files with 286 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -308,6 +308,10 @@ type
ASretIsIndirect: Boolean);
procedure EmitMethodSretCall(ACall: TMethodCallExpr; const ASretAddr: string;
ASretIsIndirect: Boolean);
{ Emit a call to a function that returns an interface via sret. The 16-byte
buffer (obj+itab) is left on the stack; caller is responsible for loading
the slots and cleaning up (addq $16, %rsp). }
procedure EmitIntfSretCall(ACall: TFuncCallExpr);
{ Indirect call: load a bare function pointer from APtrOperand (an AT&T
memory operand, e.g. "-8(%rbp)"), set up args as for EmitCall, then
dispatch via callq *%r10. AProcType supplies the param list for
@ -2004,6 +2008,60 @@ begin
Exit;
end;
{ sret interface Result: the Result slot holds a pointer to the caller's
16-byte buffer. Dereference it into %r15 so that (%r15)=obj, 8(%r15)=itab. }
if FSretFunc and SameText(AAsgn.Name, 'Result') then
begin
Self.Emit(#9'pushq %r15');
Self.Emit(Format(#9'movq %s, %%r15', [Self.VarOperand('Result')]));
ObjOp := '(%r15)';
ItabOp := '8(%r15)';
if AAsgn.Expr.ResolvedType.Kind = tyClass then
begin
ClassRT := TRecordTypeDesc(AAsgn.Expr.ResolvedType);
ItabSym := 'itab_' + Self.ClassSymName(ClassRT.Name) + '_' + Self.IntfTypeInfoName(Intf.Name);
Self.EmitExprToEax(AAsgn.Expr);
Self.Emit(#9'pushq %rax');
Self.Emit(#9'movq %rax, %rdi');
Self.Emit(#9'callq _ClassAddRef');
Self.Emit(#9'movq (%r15), %rdi');
Self.Emit(#9'callq _ClassRelease');
Self.Emit(#9'popq %rax');
Self.Emit(#9'movq %rax, (%r15)');
Self.Emit(Format(#9'leaq %s(%%rip), %%rax', [ItabSym]));
Self.Emit(#9'movq %rax, 8(%r15)');
end
else if AAsgn.Expr is TNilLiteral then
begin
Self.Emit(#9'movq (%r15), %rdi');
Self.Emit(#9'callq _ClassRelease');
Self.Emit(#9'movq $0, (%r15)');
Self.Emit(#9'movq $0, 8(%r15)');
end
else if (AAsgn.Expr.ResolvedType.Kind = tyInterface) and (AAsgn.Expr is TIdentExpr) then
begin
Self.Emit(Format(#9'movq %s, %%rax',
[Self.IntfItabOperand(TIdentExpr(AAsgn.Expr).Name, TIdentExpr(AAsgn.Expr).IsGlobal)]));
Self.Emit(#9'pushq %rax');
Self.Emit(Format(#9'movq %s, %%rax',
[Self.IntfObjOperand(TIdentExpr(AAsgn.Expr).Name, TIdentExpr(AAsgn.Expr).IsGlobal)]));
Self.Emit(#9'pushq %rax');
Self.Emit(#9'movq %rax, %rdi');
Self.Emit(#9'callq _ClassAddRef');
Self.Emit(#9'movq (%r15), %rdi');
Self.Emit(#9'callq _ClassRelease');
Self.Emit(#9'popq %rax');
Self.Emit(#9'movq %rax, (%r15)');
Self.Emit(#9'popq %rax');
Self.Emit(#9'movq %rax, 8(%r15)');
end
else
raise ENativeCodeGenError.Create(
'native backend: unsupported sret interface Result assignment RHS');
Self.Emit(#9'popq %r15');
Exit;
end;
{ Register a global LHS so EmitDataSection emits its _obj/_itab labels. }
if not Self.IsLocal(AAsgn.Name) then
begin
@ -2125,8 +2183,29 @@ begin
Exit;
end;
{ F := FuncReturningInterface() — sret convention: allocate a 16-byte buffer
on the stack, pass its address as the hidden first arg (%rdi), call the
function (which writes obj+itab into the buffer), then move the result to
the LHS with ARC. }
if (AAsgn.Expr is TFuncCallExpr) and
(TFuncCallExpr(AAsgn.Expr).ResolvedDecl <> nil) and
(TMethodDecl(TFuncCallExpr(AAsgn.Expr).ResolvedDecl).ResolvedReturnType <> nil) and
(TMethodDecl(TFuncCallExpr(AAsgn.Expr).ResolvedDecl).ResolvedReturnType.Kind = tyInterface) then
begin
Self.EmitIntfSretCall(TFuncCallExpr(AAsgn.Expr));
{ Sret buffer at (%rsp): obj at 0(%rsp), itab at 8(%rsp). }
Self.Emit(Format(#9'movq %s, %%rdi', [ObjOp])); { old obj }
Self.Emit(#9'callq _ClassRelease');
Self.Emit(#9'movq (%rsp), %rax');
Self.Emit(Format(#9'movq %%rax, %s', [ObjOp]));
Self.Emit(#9'movq 8(%rsp), %rax');
Self.Emit(Format(#9'movq %%rax, %s', [ItabOp]));
Self.Emit(#9'addq $16, %rsp');
Exit;
end;
raise ENativeCodeGenError.Create(
'native backend: unsupported interface assignment RHS');
'native backend: unsupported interface-field assignment RHS');
end;
procedure TX86_64Backend.EmitInterfaceToFieldSlotsAt(AExpr: TASTExpr;
@ -2579,7 +2658,7 @@ begin
VarOperand returns the slot address (not the record address). }
if ADecl.ResolvedReturnType <> nil then
begin
if ADecl.ResolvedReturnType.Kind = tyRecord then
if ADecl.ResolvedReturnType.Kind in [tyRecord, tyInterface] then
begin
FSretFunc := True;
Self.AddSlot('Result', nil, Offset); { nil = pointer-size (8 bytes) }
@ -9579,6 +9658,58 @@ begin
end;
end;
{ Emit a standalone function call that returns an interface via sret.
Allocates a 16-byte buffer on the stack, passes its address as the first
hidden arg (%rdi), calls the function, and leaves the buffer on the stack
(caller loads obj at 0(%rsp) and itab at 8(%rsp), then addq $16, %rsp). }
procedure TX86_64Backend.EmitIntfSretCall(ACall: TFuncCallExpr);
var
I: Integer;
MD: TMethodDecl;
FSym: string;
Arg: TASTExpr;
ArgCnt: Integer;
begin
MD := TMethodDecl(ACall.ResolvedDecl);
FSym := FuncSymbolOf(ACall);
ArgCnt := ACall.Args.Count;
{ Allocate the 16-byte sret buffer on the stack and zero it. }
Self.Emit(#9'subq $16, %rsp');
Self.Emit(#9'movq $0, (%rsp)');
Self.Emit(#9'movq $0, 8(%rsp)');
if ACall.IsImplicitSelfMethod then
begin
FMethodArgExtraStack := 0;
for I := 0 to ArgCnt - 1 do
Self.EmitMethodArgPush(TMethodParam(MD.Params.Items[I]),
TASTExpr(ACall.Args.Items[I]));
Self.Emit(Format(#9'movq %s, %%r10', [Self.VarOperand('Self')]));
for I := Self.CountArgSlots(MD.Params) - 1 downto 0 do
Self.Emit(#9'popq ' + SysVArgRegs64[I + 2]);
Self.Emit(#9'movq %r10, %rsi');
Self.Emit(#9'movq %rsp, %rdi');
Self.Emit(#9'callq ' + FSym);
if FMethodArgExtraStack > 0 then
Self.Emit(Format(#9'addq $%d, %%rsp', [FMethodArgExtraStack]));
end
else if ArgCnt <= 5 then
begin
for I := 0 to ArgCnt - 1 do
begin
Arg := TASTExpr(ACall.Args.Items[I]);
Self.EmitExprToEax(Arg);
Self.Emit(#9'pushq %rax');
end;
for I := ArgCnt - 1 downto 0 do
Self.Emit(#9'popq ' + SysVArgRegs64[I + 1]);
Self.Emit(#9'movq %rsp, %rdi');
Self.Emit(#9'callq ' + FSym);
end
else
raise ENativeCodeGenError.Create(
'native backend: interface sret with >5 args not yet supported');
end;
{ Emit a method-pointer (of-object) call through a TMethod block.
APtrOperand is the AT&T memory operand for the 16-byte Code+Data block.
Load Code into %r10, Data into %rdi, push/pop other args, then callq *%r10. }

122
compiler/src/main/pascal/uCodeGenQBE.pas
View file

@ -320,6 +320,9 @@ type
{ Returns True if AExpr is a function or method call that returns a record.
Used in EmitAssignment to choose the sret path over a storel. }
function IsRecordCall(AExpr: TASTExpr): Boolean;
{ Returns True if AExpr is a function or method call that returns an
interface. Used in EmitAssignment to choose the sret path. }
function IsInterfaceCall(AExpr: TASTExpr): Boolean;
{ Release every ARC-managed field of a record at AAddr in-line (no copy).
Used before overwriting a record slot to prevent reference leaks. }
procedure EmitRecordReleaseFields(ARec: TRecordTypeDesc; const AAddr: string);
@ -3691,6 +3694,7 @@ var
ISFld: TFieldInfo;
ISAddrT: string;
ExtTemp: string;
SretBuf: string;
begin
if AAssign.Expr.ResolvedType = nil then
raise ECodeGenError.Create(Format(
@ -3950,6 +3954,39 @@ begin
Exit;
end;
{ Interface := FuncReturningInterface() — the callee writes the fat pointer
(obj+itab) into a caller-supplied 16-byte sret buffer. Load both slots
from the buffer and store into the LHS split slots with ARC. }
if (AAssign.ResolvedLhsType <> nil) and
(AAssign.ResolvedLhsType.Kind = tyInterface) and
IsInterfaceCall(AAssign.Expr) then
begin
SretBuf := AllocTemp();
EmitLine(Format(' %s =l alloc8 16', [SretBuf]));
EmitLine(Format(' call $memset(l %s, w 0, l 16)', [SretBuf]));
EmitRecordCallSret(AAssign.Expr, SretBuf);
ObjTemp := AllocTemp();
ItabTemp := AllocTemp();
EmitLine(Format(' %s =l loadl %s', [ObjTemp, SretBuf]));
ValTemp := AllocTemp();
EmitLine(Format(' %s =l add %s, 8', [ValTemp, SretBuf]));
EmitLine(Format(' %s =l loadl %s', [ItabTemp, ValTemp]));
if AAssign.IsWeakLhs then
begin
EmitLine(Format(' call $_WeakAssign(l %s_obj, l %s)',
[VarRef(AAssign.Name, AAssign.IsGlobal), ObjTemp]));
end
else
begin
OldTemp := AllocTemp();
EmitLine(Format(' %s =l loadl %s_obj', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal)]));
EmitLine(Format(' call $_ClassRelease(l %s)', [OldTemp]));
EmitLine(Format(' storel %s, %s_obj', [ObjTemp, VarRef(AAssign.Name, AAssign.IsGlobal)]));
end;
EmitLine(Format(' storel %s, %s_itab', [ItabTemp, VarRef(AAssign.Name, AAssign.IsGlobal)]));
Exit;
end;
if AAssign.IsVarParam then
begin
PtrTemp := AllocTemp();
@ -4586,6 +4623,37 @@ begin
end;
end;
function TCodeGenQBE.IsInterfaceCall(AExpr: TASTExpr): Boolean;
var
MDecl: TMethodDecl;
FldA: TFieldAccessExpr;
begin
Result := False;
if AExpr is TFuncCallExpr then
begin
if TFuncCallExpr(AExpr).ResolvedDecl = nil then Exit;
MDecl := TMethodDecl(TFuncCallExpr(AExpr).ResolvedDecl);
Result := (MDecl.ResolvedReturnType <> nil) and
(MDecl.ResolvedReturnType.Kind = tyInterface);
end
else if AExpr is TMethodCallExpr then
begin
if TMethodCallExpr(AExpr).ResolvedMethod = nil then Exit;
MDecl := TMethodDecl(TMethodCallExpr(AExpr).ResolvedMethod);
Result := (MDecl.ResolvedReturnType <> nil) and
(MDecl.ResolvedReturnType.Kind = tyInterface);
end
else if AExpr is TFieldAccessExpr then
begin
FldA := TFieldAccessExpr(AExpr);
if not FldA.IsMethodCall then Exit;
if FldA.ResolvedMethod = nil then Exit;
MDecl := TMethodDecl(FldA.ResolvedMethod);
Result := (MDecl.ResolvedReturnType <> nil) and
(MDecl.ResolvedReturnType.Kind = tyInterface);
end;
end;
procedure TCodeGenQBE.EmitRecordCopy(ARec: TRecordTypeDesc;
const ADestAddr, ASrcAddr: string);
var
@ -5841,7 +5909,7 @@ begin
{ Build parameter signature.
sret functions: l %_par__sret comes first, then l %_par_Self.
Regular methods: just l %_par_Self first. }
if IsFunc and (AMethod.ResolvedReturnType.Kind = tyRecord) then
if IsFunc and (AMethod.ResolvedReturnType.Kind in [tyRecord, tyInterface]) then
Sig := 'l %_par__sret, l %_par_Self'
else
Sig := 'l %_par_Self';
@ -5869,7 +5937,7 @@ begin
if IsFunc then
begin
RetQType := QbeTypeOf(AMethod.ResolvedReturnType);
if AMethod.ResolvedReturnType.Kind = tyRecord then
if AMethod.ResolvedReturnType.Kind in [tyRecord, tyInterface] then
EmitLine(Format('%sfunction %s(%s) {', [ExportPrefix(), FuncName, Sig]))
else
EmitLine(Format('%sfunction %s %s(%s) {', [ExportPrefix(), RetQType, FuncName, Sig]));
@ -5927,6 +5995,15 @@ begin
if AMethod.ResolvedReturnType.Kind = tyRecord then
{ sret: Result IS the caller's buffer — no allocation needed }
EmitLine(' %_var_Result =l copy %_par__sret')
else if AMethod.ResolvedReturnType.Kind = tyInterface then
begin
{ sret: interface Result is a 16-byte fat pointer (obj+itab) in the
caller's buffer. Alias the two split slots to sret+0 and sret+8. }
EmitLine(' %_var_Result_obj =l copy %_par__sret');
EmitLine(' storel 0, %_var_Result_obj');
EmitLine(' %_var_Result_itab =l add %_par__sret, 8');
EmitLine(' storel 0, %_var_Result_itab');
end
else if RetQType = 'w' then
begin
EmitLine(' %_var_Result =l alloc4 1');
@ -5992,7 +6069,7 @@ begin
if IsFunc then
begin
if AMethod.ResolvedReturnType.Kind = tyRecord then
if AMethod.ResolvedReturnType.Kind in [tyRecord, tyInterface] then
EmitLine(' ret') { sret: caller's buffer already holds result }
else
begin
@ -6687,7 +6764,7 @@ begin
if IsFunc then
begin
RetQType := QbeTypeOf(ADecl.ResolvedReturnType);
if ADecl.ResolvedReturnType.Kind = tyRecord then
if ADecl.ResolvedReturnType.Kind in [tyRecord, tyInterface] then
begin
{ sret: prepend hidden result-buffer pointer; function becomes void }
if Sig <> '' then Sig := 'l %_par__sret, ' + Sig
@ -6823,6 +6900,15 @@ begin
if ADecl.ResolvedReturnType.Kind = tyRecord then
{ sret: Result IS the caller's buffer — no allocation needed }
EmitLine(' %_var_Result =l copy %_par__sret')
else if ADecl.ResolvedReturnType.Kind = tyInterface then
begin
{ sret: interface Result is a 16-byte fat pointer (obj+itab) in the
caller's buffer. Alias the two split slots to sret+0 and sret+8. }
EmitLine(' %_var_Result_obj =l copy %_par__sret');
EmitLine(' storel 0, %_var_Result_obj');
EmitLine(' %_var_Result_itab =l add %_par__sret, 8');
EmitLine(' storel 0, %_var_Result_itab');
end
else if RetQType = 'w' then
begin
EmitLine(' %_var_Result =l alloc4 1');
@ -6895,7 +6981,7 @@ begin
if IsFunc then
begin
if ADecl.ResolvedReturnType.Kind = tyRecord then
if ADecl.ResolvedReturnType.Kind in [tyRecord, tyInterface] then
EmitLine(' ret') { sret: caller's buffer already holds result }
else
begin
@ -8789,6 +8875,15 @@ begin
EmitRecordCallSret(AExpr, SretBuf);
Exit(SretBuf);
end;
{ sret: interface-returning function — 16-byte buffer for obj+itab. }
if MDecl.ResolvedReturnType.Kind = tyInterface then
begin
SretBuf := AllocTemp();
EmitLine(Format(' %s =l alloc8 16', [SretBuf]));
EmitLine(Format(' call $memset(l %s, w 0, l 16)', [SretBuf]));
EmitRecordCallSret(AExpr, SretBuf);
Exit(SretBuf);
end;
if FC.IsImplicitSelfMethod then
begin
ArgTemp := AllocTemp();
@ -9212,6 +9307,15 @@ begin
EmitRecordCallSret(AExpr, SretBuf);
Exit(SretBuf);
end;
{ sret: interface-returning method }
if MDecl.ResolvedReturnType.Kind = tyInterface then
begin
SretBuf := AllocTemp();
EmitLine(Format(' %s =l alloc8 16', [SretBuf]));
EmitLine(Format(' call $memset(l %s, w 0, l 16)', [SretBuf]));
EmitRecordCallSret(AExpr, SretBuf);
Exit(SretBuf);
end;
{ Load the object pointer (Self): either from a named variable or from
evaluating the receiver expression (e.g. a typecast). }
@ -9710,6 +9814,14 @@ begin
EmitRecordCallSret(AExpr, SretBuf);
Result := SretBuf;
end
else if MDecl.ResolvedReturnType.Kind = tyInterface then
begin
SretBuf := AllocTemp();
EmitLine(Format(' %s =l alloc8 16', [SretBuf]));
EmitLine(Format(' call $memset(l %s, w 0, l 16)', [SretBuf]));
EmitRecordCallSret(AExpr, SretBuf);
Result := SretBuf;
end
else
begin
{ For class variables, load the object pointer from the variable.

36
compiler/src/test/pascal/cp.test.e2e.native.pas
View file

@ -327,6 +327,8 @@ type
procedure TestRun_Native_IntfFieldNilAssign;
{ M8b — dynarray element ARC: A[I] := 'new' releases old string at A[I]. }
procedure TestRun_Native_DynArrayElemArc_String;
{ M8b — function returning interface: sret convention, obj+itab propagated. }
procedure TestRun_Native_IntfFuncReturn;
end;
implementation
@ -2878,6 +2880,34 @@ const
end.
''';
SrcIntfFuncReturn = '''
program P;
type
IVal = interface
function Get(): Integer;
end;
TVal = class(TObject, IVal)
V: Integer;
function Get(): Integer;
end;
function TVal.Get(): Integer;
begin
Result := V
end;
function MakeVal(N: Integer): IVal;
var T: TVal;
begin
T := TVal.Create();
T.V := N;
Result := T
end;
var I: IVal;
begin
I := MakeVal(42);
WriteLn(I.Get())
end.
''';
{ Dyn-array field inside a class: the field must be ARC-refcounted on store
and released when the holder is destroyed (f74e5cc). Observed by reading an
element back after the field assignment — a dropped/garbled buffer would
@ -4816,6 +4846,12 @@ begin
'first' + LE + 'second' + LE + 'replaced' + LE + 'second' + LE, 0);
end;
procedure TE2ENativeTests.TestRun_Native_IntfFuncReturn;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnBoth(SrcIntfFuncReturn, '42' + LE, 0);
end;
initialization
RegisterTest(TE2ENativeTests);