fix(codegen): itab dispatch of a record-returning method (both backends)
An interface (itab-dispatched) method returning a RECORD was broken on both backends, both when the result was assigned and when discarded in statement position, for memory-class (sret) and register-class records alike. The itab dispatch had no record-return ABI: it emitted a scalar call, so for a memory-class return the first argument register doubled as the sret pointer (the callee received a garbage argument and wrote the record over caller memory — "_StringRelease corrupted header"), and a register-class return was dereferenced as a pointer. Assignment was equally broken because IsRecordCall / IsNativeRecordCall keyed off ResolvedMethod, which is nil for itab dispatch. QBE: * IsRecordCall recognises an itab record call (ResolvedClassType = interface + ResolvedType in [record, static-array]) for both the args form (TMethodCallExpr) and the zero-arg form (TFieldAccessExpr.IsInterfaceCall). * EmitIntfSretDispatch builds the visible args (Self, method args) and delegates to EmitRecordReturnCallSite, which applies the correct ABI from ClassifyRecordReturn (sret pointer vs register capture) — instead of always passing an sret buffer. * The discarded-statement path (EmitMethodCall) gained a record/static-array branch: a throwaway zeroed buffer, the classified call, then EmitRecordReleaseFields on the buffer. Native: * IsNativeRecordCall recognises the itab record case. * New EmitIntfRecordSretDispatch performs itab dispatch with the full record-return ABI: an sret buffer in %rdi for a memory-class record, or EmitRecordRegReturnCapture (a new helper covering rcInt1/rcInt2/rcSSE1/ rcSSE2/rcIntSSE/rcSSEInt) storing the register result into the destination. Wired into EmitRecordCallSretAt, both record-assignment branches (implicit-Self field and plain local/var/global), and the discarded-statement path. E2E regressions (both backends, via AssertRunsOnAll): TE2EInterfaceTests.TestRun_InterfaceMethod_ReturnsSretRecord and _ReturnsRegisterRecord — each exercises an assigned and a discarded call.
This commit is contained in:
parent
4bd52cd96a
commit
a4d178b52c
|
|
@ -547,6 +547,15 @@ type
|
|||
EmitIntfSretCall: the 16-byte buffer is left at (%rsp); the caller loads
|
||||
the slots and pops it (addq $16, %rsp). }
|
||||
procedure EmitIntfSretMethodCall(ACall: TMethodCallExpr);
|
||||
{ Interface-method call (itab dispatch) RETURNING a RECORD: dispatch through
|
||||
the itab and write the record result into the caller-supplied ADest,
|
||||
honouring the full record-return ABI (hidden sret pointer for a
|
||||
memory-class record; register capture for a register-class one). Mirrors
|
||||
the QBE EmitIntfSretDispatch helper. ADestIsIndirect: ADest holds a
|
||||
pointer to the destination buffer (var/out / Result), not the buffer. }
|
||||
procedure EmitIntfRecordSretDispatch(ACall: TMethodCallExpr;
|
||||
const ADest: string;
|
||||
ADestIsIndirect: Boolean);
|
||||
{ Class-receiver method call RETURNING an interface (Obj.Make() where Obj
|
||||
is class-typed): sret hidden first arg (%rdi), receiver in %rsi, static
|
||||
or vtable dispatch from the receiver's class. Same caller contract as
|
||||
|
|
@ -4550,6 +4559,18 @@ end;
|
|||
function TX86_64Backend.IsNativeRecordCall(AExpr: TASTExpr): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
{ Interface (itab) dispatch has no ResolvedMethod — classify by the call's
|
||||
resolved return type instead, so a record-returning itab call routes
|
||||
through the sret/record-return path (EmitIntfRecordSretDispatch) like a
|
||||
direct record method call. Mirrors the QBE IsRecordCall interface case. }
|
||||
if (AExpr is TMethodCallExpr) and
|
||||
(TMethodCallExpr(AExpr).ResolvedClassType <> nil) and
|
||||
(TMethodCallExpr(AExpr).ResolvedClassType.Kind = tyInterface) then
|
||||
begin
|
||||
Result := (TMethodCallExpr(AExpr).ResolvedType <> nil) and
|
||||
(TMethodCallExpr(AExpr).ResolvedType.Kind = tyRecord);
|
||||
Exit;
|
||||
end;
|
||||
if (AExpr is TMethodCallExpr) and
|
||||
(TMethodCallExpr(AExpr).ResolvedMethod <> nil) and
|
||||
(TMethodDecl(TMethodCallExpr(AExpr).ResolvedMethod).ResolvedReturnType <> nil) and
|
||||
|
|
@ -4616,7 +4637,13 @@ end;
|
|||
|
||||
procedure TX86_64Backend.EmitRecordCallSretAt(AExpr: TASTExpr; const ADest: string);
|
||||
begin
|
||||
if AExpr is TMethodCallExpr then
|
||||
if (AExpr is TMethodCallExpr) and
|
||||
(TMethodCallExpr(AExpr).ResolvedClassType <> nil) and
|
||||
(TMethodCallExpr(AExpr).ResolvedClassType.Kind = tyInterface) then
|
||||
{ Interface (itab) record-returning dispatch — EmitMethodSretCall raises on
|
||||
a nil ResolvedMethod, so route through the itab record-return helper. }
|
||||
Self.EmitIntfRecordSretDispatch(TMethodCallExpr(AExpr), ADest, False)
|
||||
else if AExpr is TMethodCallExpr then
|
||||
Self.EmitMethodSretCall(TMethodCallExpr(AExpr), ADest, False)
|
||||
else if AExpr is TInheritedCallExpr then
|
||||
Self.EmitInheritedRecordSret(
|
||||
|
|
@ -9061,6 +9088,7 @@ var
|
|||
IsSretDiscard: Boolean;
|
||||
SretBufSize: Integer;
|
||||
SretRT: TRecordTypeDesc;
|
||||
SretShim: TMethodCallExpr;
|
||||
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
|
||||
|
|
@ -9139,6 +9167,57 @@ begin
|
|||
Exit;
|
||||
end;
|
||||
|
||||
{ Discarded interface (itab) method call returning a RECORD: the callee
|
||||
follows the record-return ABI (sret pointer for a memory-class record,
|
||||
register return for a register-class one). The plain EmitInterfaceCall
|
||||
path below treats the return as a scalar / fat pointer and hands the callee
|
||||
no sret buffer, so an sret record is written over caller memory. Allocate
|
||||
a zeroed throwaway buffer, dispatch into it, then release its managed
|
||||
fields. Mirrors the QBE EmitMethodCall record-discard branch. }
|
||||
if (ACall.ResolvedClassType <> nil) and
|
||||
(ACall.ResolvedClassType.Kind = tyInterface) and
|
||||
(ACall.ResolvedReturnTypeDesc <> nil) and
|
||||
(ACall.ResolvedReturnTypeDesc.Kind = tyRecord) then
|
||||
begin
|
||||
SretRT := TRecordTypeDesc(ACall.ResolvedReturnTypeDesc);
|
||||
SretBufSize := (SretRT.TotalSize() + 15) and (-16);
|
||||
Self.Emit(#9'pushq %rbx');
|
||||
Self.Emit(Format(#9'subq $%d, %%rsp', [SretBufSize]));
|
||||
Self.Emit(#9'movq %rsp, %rbx');
|
||||
{ Zero the buffer so EmitRecordFieldReleases sees nil managed fields if the
|
||||
callee leaves any unset. }
|
||||
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');
|
||||
{ EmitIntfRecordSretDispatch takes the expression form; build a transient
|
||||
TMethodCallExpr view of this statement node (the relevant fields are the
|
||||
same). Args are borrowed and detached before Free. }
|
||||
SretShim := TMethodCallExpr.Create();
|
||||
try
|
||||
SretShim.ObjectName := ACall.ObjectName;
|
||||
SretShim.Name := ACall.Name;
|
||||
SretShim.Args := ACall.Args;
|
||||
SretShim.ObjExpr := ACall.ObjExpr;
|
||||
SretShim.ResolvedClassType := ACall.ResolvedClassType;
|
||||
SretShim.ResolvedType := ACall.ResolvedReturnTypeDesc;
|
||||
SretShim.IsGlobal := ACall.IsGlobal;
|
||||
SretShim.IsVarParam := ACall.IsVarParam;
|
||||
Self.EmitIntfRecordSretDispatch(SretShim, '(%rbx)', False);
|
||||
finally
|
||||
SretShim.Args := nil; { borrowed — do not free }
|
||||
SretShim.ObjExpr := nil; { borrowed — do not free }
|
||||
SretShim.Free();
|
||||
end;
|
||||
{ The dispatch may clobber %rbx during arg evaluation; %rsp is balanced and
|
||||
still points at the buffer, so re-derive the buffer address. }
|
||||
Self.Emit(#9'movq %rsp, %rbx');
|
||||
Self.EmitRecordFieldReleases(SretRT, '%rbx');
|
||||
Self.Emit(Format(#9'addq $%d, %%rsp', [SretBufSize]));
|
||||
Self.Emit(#9'popq %rbx');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Interface method dispatch (statement position): route through the itab.
|
||||
Pass ObjExpr so receivers that are interface-typed fields (H.S.Note())
|
||||
load obj/itab from the field's fat pointer instead of bogus _obj/_itab
|
||||
|
|
@ -10791,6 +10870,24 @@ begin
|
|||
Self.Emit(#9'movq %rax, (%r15)');
|
||||
Self.Emit(#9'popq %r15');
|
||||
end
|
||||
else if (Asgn.ResolvedLhsType.Kind = tyRecord) and
|
||||
(Asgn.Expr is TMethodCallExpr) and
|
||||
(TMethodCallExpr(Asgn.Expr).ResolvedClassType <> nil) and
|
||||
(TMethodCallExpr(Asgn.Expr).ResolvedClassType.Kind = tyInterface) and
|
||||
(TMethodCallExpr(Asgn.Expr).ResolvedType <> nil) and
|
||||
(TMethodCallExpr(Asgn.Expr).ResolvedType.Kind = tyRecord) then
|
||||
begin
|
||||
{ Interface (itab) record-returning dispatch into an implicit-Self
|
||||
field — EmitRecordCallSretAt routes the itab case to the record-
|
||||
return helper. }
|
||||
Self.Emit(#9'pushq %rbx');
|
||||
Self.Emit(Format(#9'movq %s, %%rbx', [Self.VarOperand('Self')]));
|
||||
if ISFld.Offset > 0 then
|
||||
Self.Emit(Format(#9'addq $%d, %%rbx', [ISFld.Offset]));
|
||||
Self.EmitRecordFieldReleases(TRecordTypeDesc(Asgn.ResolvedLhsType), '%rbx');
|
||||
Self.EmitIntfRecordSretDispatch(TMethodCallExpr(Asgn.Expr), '(%rbx)', False);
|
||||
Self.Emit(#9'popq %rbx');
|
||||
end
|
||||
else if (Asgn.ResolvedLhsType.Kind = tyRecord) and
|
||||
(Asgn.Expr is TMethodCallExpr) and
|
||||
(TMethodCallExpr(Asgn.Expr).ResolvedMethod <> nil) and
|
||||
|
|
@ -10976,6 +11073,41 @@ begin
|
|||
end;
|
||||
Exit;
|
||||
end;
|
||||
{ sret assignment: interface (itab) method call returning a record. The
|
||||
itab call has no ResolvedMethod, so it is classified by ResolvedClassType
|
||||
= interface + ResolvedType = record. EmitIntfRecordSretDispatch writes
|
||||
the record straight into the destination, honouring the record-return ABI
|
||||
(hidden sret pointer for a memory-class record; register capture for a
|
||||
register-class one). Mirrors the QBE EmitIntfSretDispatch path. }
|
||||
if (Asgn.ResolvedLhsType <> nil) and
|
||||
(Asgn.ResolvedLhsType.Kind = tyRecord) and
|
||||
(Asgn.Expr is TMethodCallExpr) and
|
||||
(TMethodCallExpr(Asgn.Expr).ResolvedClassType <> nil) and
|
||||
(TMethodCallExpr(Asgn.Expr).ResolvedClassType.Kind = tyInterface) and
|
||||
(TMethodCallExpr(Asgn.Expr).ResolvedType <> nil) and
|
||||
(TMethodCallExpr(Asgn.Expr).ResolvedType.Kind = tyRecord) then
|
||||
begin
|
||||
{ Release the destination's prior managed fields before overwriting it,
|
||||
then dispatch. The dispatch writes the constructed record (which owns
|
||||
its managed fields +1) over the dest, so ownership transfers cleanly. }
|
||||
Self.Emit(#9'pushq %rbx');
|
||||
if FSretFunc and SameText(Asgn.Name, 'Result') then
|
||||
Self.Emit(Format(#9'movq %s, %%rbx', [Self.VarOperand('Result')]))
|
||||
else if Asgn.IsVarParam then
|
||||
Self.Emit(Format(#9'movq %s, %%rbx', [Self.VarOperand(Asgn.Name)]))
|
||||
else if Self.IsLocal(Asgn.Name) then
|
||||
Self.Emit(Format(#9'leaq %s, %%rbx', [Self.VarOperand(Asgn.Name)]))
|
||||
else
|
||||
begin
|
||||
Self.AddGlobal(Asgn.Name, Asgn.ResolvedLhsType);
|
||||
if Asgn.IsThreadVar then Self.MarkThreadVar(Asgn.Name);
|
||||
Self.EmitLeaqGlobal(Asgn.Name, '%rbx');
|
||||
end;
|
||||
Self.EmitRecordFieldReleases(TRecordTypeDesc(Asgn.ResolvedLhsType), '%rbx');
|
||||
Self.EmitIntfRecordSretDispatch(TMethodCallExpr(Asgn.Expr), '(%rbx)', False);
|
||||
Self.Emit(#9'popq %rbx');
|
||||
Exit;
|
||||
end;
|
||||
{ sret assignment: method call returning a record (or jumbo set).
|
||||
%rdi = sret ptr, %rsi = Self, %rdx.. = user args. }
|
||||
if (Asgn.ResolvedLhsType <> nil) and
|
||||
|
|
@ -15756,6 +15888,209 @@ begin
|
|||
HK.Free();
|
||||
end;
|
||||
|
||||
procedure TX86_64Backend.EmitIntfRecordSretDispatch(ACall: TMethodCallExpr;
|
||||
const ADest: string; ADestIsIndirect: Boolean);
|
||||
var
|
||||
I, SlotOff, ArgN, Slots: Integer;
|
||||
Arg: TASTExpr;
|
||||
IntfD: TInterfaceTypeDesc;
|
||||
HD: TList<Integer>;
|
||||
HK: TList<Integer>;
|
||||
HTotal, Pushed: Integer;
|
||||
VFlags: string;
|
||||
IE: TIdentExpr;
|
||||
OverflowBytes, ABase: Integer;
|
||||
RC: TRecReturnClass;
|
||||
RetRec: TRecordTypeDesc;
|
||||
begin
|
||||
IntfD := TInterfaceTypeDesc(ACall.ResolvedClassType);
|
||||
RetRec := TRecordTypeDesc(ACall.ResolvedType);
|
||||
RC := ClassifyRecordReturn(RetRec);
|
||||
ArgN := 0;
|
||||
if ACall.Args <> nil then ArgN := ACall.Args.Count;
|
||||
|
||||
{ Resolve the destination to an ABSOLUTE pointer FIRST, in callee-saved %r14,
|
||||
before any %rsp movement (arg pushes / overflow spill) can drift a
|
||||
%rsp-relative ADest. }
|
||||
Self.Emit(#9'pushq %r14');
|
||||
if ADestIsIndirect then
|
||||
Self.Emit(Format(#9'movq %s, %%r14', [ADest]))
|
||||
else
|
||||
Self.Emit(Format(#9'leaq %s, %%r14', [ADest]));
|
||||
|
||||
{ Same unknown-signature hoist as EmitIntfSretMethodCall; the region sits
|
||||
BELOW any sret buffer space we reserve. }
|
||||
HD := TList<Integer>.Create();
|
||||
HK := TList<Integer>.Create();
|
||||
VFlags := IntfD.MethodParamVarFlagsStr(IntfD.MethodIndex(ACall.Name));
|
||||
HTotal := Self.EmitArgHoist(nil, nil, False, VFlags, ACall.Args, HD, HK);
|
||||
Pushed := 0;
|
||||
{ Push args left-to-right; interface args push obj then itab (2 slots). }
|
||||
for I := 0 to ArgN - 1 do
|
||||
begin
|
||||
Arg := TASTExpr(ACall.Args.Items[I]);
|
||||
if HK.Get(I) >= akRecCall then
|
||||
begin
|
||||
Self.Emit(Format(#9'movq %d(%%rsp), %%rax', [HTotal - HD.Get(I) + Pushed]));
|
||||
Self.Emit(#9'pushq %rax');
|
||||
end
|
||||
else if Self.VarFlagAt(VFlags, I) then
|
||||
begin
|
||||
Self.EmitVarArgAddrToRax(Arg);
|
||||
Self.Emit(#9'pushq %rax');
|
||||
end
|
||||
else if (Arg.ResolvedType <> nil) and (Arg.ResolvedType.Kind = tyInterface) then
|
||||
begin
|
||||
if Arg is TIdentExpr then
|
||||
begin
|
||||
if TIdentExpr(Arg).IsImplicitSelf and
|
||||
(TIdentExpr(Arg).ImplicitFieldInfo <> nil) then
|
||||
begin
|
||||
Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand('Self')]));
|
||||
if TFieldInfo(TIdentExpr(Arg).ImplicitFieldInfo).Offset > 0 then
|
||||
Self.Emit(Format(#9'addq $%d, %%rax',
|
||||
[TFieldInfo(TIdentExpr(Arg).ImplicitFieldInfo).Offset]));
|
||||
Self.Emit(#9'movq (%rax), %rcx');
|
||||
Self.Emit(#9'movq 8(%rax), %rdx');
|
||||
Self.Emit(#9'pushq %rcx');
|
||||
Self.Emit(#9'pushq %rdx');
|
||||
end
|
||||
else
|
||||
begin
|
||||
Self.Emit(Format(#9'movq %s, %%rax',
|
||||
[Self.IntfObjOperand(TIdentExpr(Arg).Name, TIdentExpr(Arg).IsGlobal)]));
|
||||
Self.Emit(Format(#9'movq %s, %%rcx',
|
||||
[Self.IntfItabOperand(TIdentExpr(Arg).Name, TIdentExpr(Arg).IsGlobal)]));
|
||||
Self.Emit(#9'pushq %rax');
|
||||
Self.Emit(#9'pushq %rcx');
|
||||
end;
|
||||
end
|
||||
else if Arg is TFieldAccessExpr then
|
||||
begin
|
||||
Self.EmitInterfaceFieldAddr(TFieldAccessExpr(Arg), '%rax');
|
||||
Self.Emit(#9'movq (%rax), %rcx');
|
||||
Self.Emit(#9'movq 8(%rax), %rdx');
|
||||
Self.Emit(#9'pushq %rcx');
|
||||
Self.Emit(#9'pushq %rdx');
|
||||
end
|
||||
else
|
||||
raise ENativeCodeGenError.Create(
|
||||
'native backend: unsupported interface arg expression in sret interface record dispatch');
|
||||
end
|
||||
else
|
||||
begin
|
||||
Self.EmitExprToEax(Arg);
|
||||
Self.Emit(#9'pushq %rax');
|
||||
end;
|
||||
if (HK.Get(I) < akRecCall) and (not Self.VarFlagAt(VFlags, I)) and
|
||||
(Arg.ResolvedType <> nil) and
|
||||
(Arg.ResolvedType.Kind = tyInterface) then
|
||||
Pushed := Pushed + 16
|
||||
else
|
||||
Pushed := Pushed + 8;
|
||||
end;
|
||||
{ Resolve the receiver: obj into %r10, itab into %rax. }
|
||||
if (ACall.ObjExpr <> nil) and (ACall.ObjExpr is TFieldAccessExpr) then
|
||||
begin
|
||||
Self.EmitInterfaceFieldAddr(TFieldAccessExpr(ACall.ObjExpr), '%r10');
|
||||
Self.Emit(#9'movq 8(%r10), %rax');
|
||||
Self.Emit(#9'movq (%r10), %r10');
|
||||
end
|
||||
else if (ACall.ObjExpr <> nil) and (ACall.ObjExpr is TIdentExpr) and
|
||||
TIdentExpr(ACall.ObjExpr).IsImplicitSelf and
|
||||
(TIdentExpr(ACall.ObjExpr).ImplicitFieldInfo <> nil) then
|
||||
begin
|
||||
IE := TIdentExpr(ACall.ObjExpr);
|
||||
Self.Emit(Format(#9'movq %s, %%r10', [Self.VarOperand('Self')]));
|
||||
if TFieldInfo(IE.ImplicitFieldInfo).Offset > 0 then
|
||||
Self.Emit(Format(#9'addq $%d, %%r10',
|
||||
[TFieldInfo(IE.ImplicitFieldInfo).Offset]));
|
||||
Self.Emit(#9'movq 8(%r10), %rax');
|
||||
Self.Emit(#9'movq (%r10), %r10');
|
||||
end
|
||||
else if (ACall.ObjExpr <> nil) and (ACall.ObjExpr is TIdentExpr) then
|
||||
begin
|
||||
IE := TIdentExpr(ACall.ObjExpr);
|
||||
Self.Emit(Format(#9'movq %s, %%r10',
|
||||
[Self.IntfObjOperand(IE.Name, IE.IsGlobal)]));
|
||||
Self.Emit(Format(#9'movq %s, %%rax',
|
||||
[Self.IntfItabOperand(IE.Name, IE.IsGlobal)]));
|
||||
end
|
||||
else if ACall.ObjExpr <> nil then
|
||||
raise ENativeCodeGenError.Create(
|
||||
'native backend: unsupported receiver expression in sret interface record dispatch')
|
||||
else if ACall.IsVarParam then
|
||||
begin
|
||||
Self.Emit(Format(#9'movq %s, %%r10', [Self.VarOperand(ACall.ObjectName)]));
|
||||
Self.Emit(#9'movq 8(%r10), %rax');
|
||||
Self.Emit(#9'movq (%r10), %r10');
|
||||
end
|
||||
else
|
||||
begin
|
||||
Self.Emit(Format(#9'movq %s, %%r10',
|
||||
[Self.IntfObjOperand(ACall.ObjectName, ACall.IsGlobal)]));
|
||||
Self.Emit(Format(#9'movq %s, %%rax',
|
||||
[Self.IntfItabOperand(ACall.ObjectName, ACall.IsGlobal)]));
|
||||
end;
|
||||
SlotOff := IntfD.MethodIndex(ACall.Name) * 8;
|
||||
if SlotOff = 0 then
|
||||
Self.Emit(#9'movq (%rax), %r11')
|
||||
else
|
||||
Self.Emit(Format(#9'movq %d(%%rax), %%r11', [SlotOff]));
|
||||
|
||||
{ Count the arg SLOTS (var positions one slot; interface args two). }
|
||||
Slots := 0;
|
||||
for I := 0 to ArgN - 1 do
|
||||
begin
|
||||
Arg := TASTExpr(ACall.Args.Items[I]);
|
||||
if (not Self.VarFlagAt(VFlags, I)) and (Arg.ResolvedType <> nil) and
|
||||
(Arg.ResolvedType.Kind = tyInterface) then
|
||||
Inc(Slots, 2)
|
||||
else
|
||||
Inc(Slots);
|
||||
end;
|
||||
|
||||
if RC = rcSret then
|
||||
begin
|
||||
{ Memory-class record: hidden sret pointer in %rdi, receiver obj in %rsi,
|
||||
visible args from %rdx (base index 2). The dest buffer is %r14. }
|
||||
Self.Emit(#9'movq %r14, %rdi');
|
||||
Self.Emit(#9'xorl %esi, %esi');
|
||||
Self.Emit(Format(#9'movq $%d, %%rdx', [RetRec.TotalSize()]));
|
||||
Self.Emit(#9'pushq %r10'); { preserve receiver obj across memset }
|
||||
Self.Emit(#9'pushq %r11'); { preserve fptr across memset }
|
||||
Self.Emit(#9'callq memset');
|
||||
Self.Emit(#9'popq %r11');
|
||||
Self.Emit(#9'popq %r10');
|
||||
ABase := 2;
|
||||
OverflowBytes := Self.EmitSretRegArgs(Slots, ABase);
|
||||
Self.Emit(#9'movq %r10, %rsi');
|
||||
Self.Emit(#9'movq %r14, %rdi');
|
||||
Self.Emit(#9'callq *%r11');
|
||||
if OverflowBytes > 0 then
|
||||
Self.Emit(Format(#9'addq $%d, %%rsp', [OverflowBytes]));
|
||||
Self.EmitHoistEpilogue(ACall.Args, HD, HK, HTotal, 0, True);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Register-class record: NO hidden sret arg. Receiver obj in %rdi,
|
||||
visible args from %rsi (base index 1). Capture the register return
|
||||
into the dest buffer (%r14). }
|
||||
ABase := 1;
|
||||
OverflowBytes := Self.EmitSretRegArgs(Slots, ABase);
|
||||
Self.Emit(#9'movq %r10, %rdi');
|
||||
Self.Emit(#9'callq *%r11');
|
||||
if OverflowBytes > 0 then
|
||||
Self.Emit(Format(#9'addq $%d, %%rsp', [OverflowBytes]));
|
||||
{ %r14 still holds the dest pointer (callee-saved across the call). }
|
||||
Self.EmitRecordRegReturnCapture('%r14', RetRec, RC, True);
|
||||
Self.EmitHoistEpilogue(ACall.Args, HD, HK, HTotal, 0, True);
|
||||
end;
|
||||
HD.Free();
|
||||
HK.Free();
|
||||
Self.Emit(#9'popq %r14');
|
||||
end;
|
||||
|
||||
procedure TX86_64Backend.EmitClassIntfSretMethodCall(ACall: TMethodCallExpr);
|
||||
var
|
||||
I: Integer;
|
||||
|
|
|
|||
|
|
@ -5077,15 +5077,34 @@ begin
|
|||
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 in [tyRecord, tyStaticArray]);
|
||||
{ Interface (itab) dispatch has no ResolvedMethod — classify by the call's
|
||||
resolved return type instead, so a record-returning itab call routes
|
||||
through the sret/record-return path (EmitIntfSretDispatch) like a direct
|
||||
record method call. }
|
||||
if (TMethodCallExpr(AExpr).ResolvedClassType <> nil) and
|
||||
(TMethodCallExpr(AExpr).ResolvedClassType.Kind = tyInterface) then
|
||||
Result := (TMethodCallExpr(AExpr).ResolvedType <> nil) and
|
||||
(TMethodCallExpr(AExpr).ResolvedType.Kind in [tyRecord, tyStaticArray])
|
||||
else
|
||||
begin
|
||||
if TMethodCallExpr(AExpr).ResolvedMethod = nil then Exit;
|
||||
MDecl := TMethodDecl(TMethodCallExpr(AExpr).ResolvedMethod);
|
||||
Result := (MDecl.ResolvedReturnType <> nil) and
|
||||
(MDecl.ResolvedReturnType.Kind in [tyRecord, tyStaticArray]);
|
||||
end;
|
||||
end
|
||||
else if AExpr is TFieldAccessExpr then
|
||||
begin
|
||||
FldA := TFieldAccessExpr(AExpr);
|
||||
if not FldA.IsMethodCall then Exit;
|
||||
{ Zero-arg interface (itab) dispatch (G.GetThing): no ResolvedMethod —
|
||||
classify by the resolved return type, as for the args form above. }
|
||||
if FldA.IsInterfaceCall then
|
||||
begin
|
||||
Result := (FldA.ResolvedType <> nil) and
|
||||
(FldA.ResolvedType.Kind in [tyRecord, tyStaticArray]);
|
||||
Exit;
|
||||
end;
|
||||
if FldA.ResolvedMethod = nil then Exit;
|
||||
MDecl := TMethodDecl(FldA.ResolvedMethod);
|
||||
Result := (MDecl.ResolvedReturnType <> nil) and
|
||||
|
|
@ -5563,9 +5582,11 @@ var
|
|||
ArgLine: string;
|
||||
SlotOff: Integer;
|
||||
PMark: Integer;
|
||||
RetType: TRecordTypeDesc;
|
||||
begin
|
||||
PMark := PendingReleaseMark();
|
||||
AArgs := nil;
|
||||
RetType := TRecordTypeDesc(TASTExpr(ACall).ResolvedType);
|
||||
if ACall is TMethodCallExpr then
|
||||
begin
|
||||
MCall := TMethodCallExpr(ACall);
|
||||
|
|
@ -5610,11 +5631,15 @@ begin
|
|||
EmitLine(Format(' %s =l add %s, %d', [ArgTemp, VTblTemp, SlotOff]));
|
||||
EmitLine(Format(' %s =l loadl %s', [FPtrTemp, ArgTemp]));
|
||||
end;
|
||||
{ Callee signature is (sret, Self, args...) — the same shape every
|
||||
interface-returning method body declares (`l %_par__sret, l %_par_Self`). }
|
||||
ArgLine := Format('l %s, l %s', [ASretAddr, SelfTemp]) +
|
||||
{ The visible arguments are (Self, method-args...). The RECORD-RETURN ABI
|
||||
(sret vs register-class) is decided by EmitRecordReturnCallSite from the
|
||||
return type's classification — exactly as for a direct record-returning
|
||||
call. Passing an sret pointer unconditionally (the old behaviour) is only
|
||||
correct for memory-class records; a register-class record return then
|
||||
mismatched the callee ABI, shifting Self/args and corrupting memory. }
|
||||
ArgLine := Format('l %s', [SelfTemp]) +
|
||||
IntfDispatchArgFragment(IntfDesc, IntfDesc.MethodIndex(MethName), AArgs);
|
||||
EmitLine(Format(' call %s(%s)', [FPtrTemp, ArgLine]));
|
||||
EmitRecordReturnCallSite(FPtrTemp, ArgLine, RetType, ASretAddr);
|
||||
FlushPendingReleases(PMark);
|
||||
end;
|
||||
|
||||
|
|
@ -6506,6 +6531,7 @@ var
|
|||
ItabName: string;
|
||||
SretTemp: string;
|
||||
PMark: Integer;
|
||||
RetTypeRec: TRecordTypeDesc;
|
||||
begin
|
||||
PMark := PendingReleaseMark();
|
||||
|
||||
|
|
@ -6671,6 +6697,33 @@ begin
|
|||
EmitLine(Format(' %s =l loadl %s', [ArgTemp, SretTemp]));
|
||||
EmitLine(Format(' call $_ClassRelease(l %s)', [ArgTemp]));
|
||||
end
|
||||
else if (ACall.ResolvedReturnTypeDesc <> nil) and
|
||||
(ACall.ResolvedReturnTypeDesc.Kind in [tyRecord, tyStaticArray]) then
|
||||
begin
|
||||
{ Discarded RECORD/static-array return through itab dispatch: the callee
|
||||
follows the record-return ABI (sret pointer for a memory-class record,
|
||||
register return for a register-class one). A plain scalar call here
|
||||
(the old fall-through) handed the callee no sret buffer and mis-typed
|
||||
the return, so for an sret record the first ARG register doubled as the
|
||||
sret pointer — the callee received a garbage argument and wrote the
|
||||
record over caller memory. Route through EmitRecordReturnCallSite with
|
||||
a throwaway destination so the correct ABI is used, then release the
|
||||
throwaway's managed fields. }
|
||||
RetTypeRec := TRecordTypeDesc(ACall.ResolvedReturnTypeDesc);
|
||||
SretTemp := AllocTemp();
|
||||
if ACall.ResolvedReturnTypeDesc.Kind = tyStaticArray then
|
||||
EmitLine(Format(' %s =l alloc8 %d',
|
||||
[SretTemp, ACall.ResolvedReturnTypeDesc.RawSize()]))
|
||||
else if RetTypeRec.MaxAlign() >= 8 then
|
||||
EmitLine(Format(' %s =l alloc8 %d', [SretTemp, RetTypeRec.TotalSize()]))
|
||||
else
|
||||
EmitLine(Format(' %s =l alloc4 %d', [SretTemp, RetTypeRec.TotalSize()]));
|
||||
EmitLine(Format(' call $memset(l %s, w 0, l %d)',
|
||||
[SretTemp, ACall.ResolvedReturnTypeDesc.RawSize()]));
|
||||
EmitRecordReturnCallSite(FPtrTemp, ArgLine, RetTypeRec, SretTemp);
|
||||
if ACall.ResolvedReturnTypeDesc.Kind = tyRecord then
|
||||
EmitRecordReleaseFields(RetTypeRec, SretTemp);
|
||||
end
|
||||
else
|
||||
EmitLine(Format(' call %s(%s)', [FPtrTemp, ArgLine]));
|
||||
FlushPendingReleases(PMark);
|
||||
|
|
|
|||
|
|
@ -49,6 +49,14 @@ type
|
|||
procedure TestRun_InheritedInterface_DescendantToVar;
|
||||
procedure TestRun_InheritedInterface_OverrideAndInheritedMethod;
|
||||
procedure TestRun_InheritedInterface_NonVirtualMethod;
|
||||
{ An itab-dispatched method returning a RECORD. Two ABI shapes:
|
||||
a memory-class record (has a managed field -> sret) and a register-class
|
||||
record (all-scalar, returned in registers). Both must work when the
|
||||
result is ASSIGNED and when DISCARDED in statement position — the
|
||||
discarded statement and the assignment used to mis-handle the
|
||||
record-return ABI and corrupt memory (bug #5). }
|
||||
procedure TestRun_InterfaceMethod_ReturnsSretRecord;
|
||||
procedure TestRun_InterfaceMethod_ReturnsRegisterRecord;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
|
@ -406,6 +414,77 @@ begin
|
|||
AssertRunsOnAll(Src, 'hello' + LE + 'hello' + LE, 0);
|
||||
end;
|
||||
|
||||
procedure TE2EInterfaceTests.TestRun_InterfaceMethod_ReturnsSretRecord;
|
||||
const
|
||||
{ TRect has a managed (string) field, so ClassifyRecordReturn => sret. }
|
||||
Src = '''
|
||||
program P;
|
||||
type
|
||||
TRect = record Name: string; N: Integer; end;
|
||||
IShape = interface
|
||||
function MakeRect(AN: Integer): TRect;
|
||||
end;
|
||||
TShape = class(IShape)
|
||||
function MakeRect(AN: Integer): TRect;
|
||||
end;
|
||||
function TShape.MakeRect(AN: Integer): TRect;
|
||||
begin
|
||||
Result.Name := 'r';
|
||||
Result.N := AN;
|
||||
WriteLn('callee ', AN)
|
||||
end;
|
||||
var
|
||||
M: IShape;
|
||||
R: TRect;
|
||||
begin
|
||||
M := TShape.Create();
|
||||
R := M.MakeRect(5); { assigned sret record return }
|
||||
WriteLn('assigned ', R.N);
|
||||
M.MakeRect(7) { discarded sret record return }
|
||||
end.
|
||||
''';
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertRunsOnAll(Src,
|
||||
'callee 5' + LE + 'assigned 5' + LE + 'callee 7' + LE, 0);
|
||||
end;
|
||||
|
||||
procedure TE2EInterfaceTests.TestRun_InterfaceMethod_ReturnsRegisterRecord;
|
||||
const
|
||||
{ TPt is all-scalar, so ClassifyRecordReturn => a register-class return
|
||||
(no sret buffer); the itab dispatch must capture the register result. }
|
||||
Src = '''
|
||||
program P;
|
||||
type
|
||||
TPt = record X, Y: Integer; end;
|
||||
IShape = interface
|
||||
function MakePt(AN: Integer): TPt;
|
||||
end;
|
||||
TShape = class(IShape)
|
||||
function MakePt(AN: Integer): TPt;
|
||||
end;
|
||||
function TShape.MakePt(AN: Integer): TPt;
|
||||
begin
|
||||
Result.X := AN;
|
||||
Result.Y := AN * 2;
|
||||
WriteLn('callee ', AN)
|
||||
end;
|
||||
var
|
||||
M: IShape;
|
||||
R: TPt;
|
||||
begin
|
||||
M := TShape.Create();
|
||||
R := M.MakePt(5); { assigned register-class record return }
|
||||
WriteLn('assigned ', R.X, ' ', R.Y);
|
||||
M.MakePt(9) { discarded register-class record return }
|
||||
end.
|
||||
''';
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertRunsOnAll(Src,
|
||||
'callee 5' + LE + 'assigned 5 10' + LE + 'callee 9' + LE, 0);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TE2EInterfaceTests);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue