fix(codegen): metaclass constructor call in statement position
Calling a constructor through a metaclass-typed variable as a statement, with the result discarded — `C.Create(args);` where `C: class of TBase` — compiled cleanly but segfaulted at runtime on both the QBE and native x86-64 backends. The same call in expression position (`o := C.Create();`) worked. The semantic pass flags the statement node with IsConstructorCall and IsMetaclassDispatch, but only the expression-position lowering acted on them (allocating via _ClassCreate and dispatching the ctor through the new instance's vtable). The statement-position emitters had no such branch, so the call fell through to the ordinary virtual-method path: it loaded the metaclass value (a typeinfo pointer) as if it were the receiver object, read a bogus vtable from the typeinfo's first word, and called a garbage slot — crashing. Add the metaclass-constructor branch to both statement emitters (TCodeGenQBE.EmitMethodCall and TX86_64Backend.EmitMethodCallStmt): load the metaclass, allocate via _ClassCreate, marshal the args, dispatch the ctor indirectly through vtable[(slot+1)*8], then release the freshly built (refcount 1) instance so the discarded result is freed rather than leaked. A non-metaclass constructor as a statement (TFoo.Create();) is still rejected earlier by the semantic pass as 'not a variable', so only the metaclass shape reaches the new branch. Adds an e2e regression (cp.test.e2e.classes2) covering zero-arg and multi-arg dispatch and asserting the instance is freed (destructor count). (cherry picked from commit 3f719213a838ab886b5db74847e7bef8894c404a)
This commit is contained in:
parent
fa106ceeee
commit
b5573e5377
|
|
@ -8301,7 +8301,104 @@ var
|
|||
HD: TList<Integer>;
|
||||
HK: TList<Integer>;
|
||||
HTotal: Integer;
|
||||
RT: 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
|
||||
expression-position path (EmitExpr) allocated the instance and dispatched
|
||||
the ctor through the vtable; without this branch the generic dispatch
|
||||
below loads the metaclass typeinfo pointer as the object and calls a
|
||||
garbage vtable slot — crashing at runtime. (A non-metaclass ctor as a
|
||||
statement, TFoo.Create();, is rejected by the semantic pass as 'not a
|
||||
variable', so only the metaclass shape reaches here.) The instance comes
|
||||
back from _ClassCreate at refcount 1; the result is discarded, so we
|
||||
release it once afterwards to free rather than leak it. }
|
||||
if ACall.IsConstructorCall and ACall.IsMetaclassDispatch then
|
||||
begin
|
||||
RT := TRecordTypeDesc(ACall.ResolvedClassType);
|
||||
MD := TMethodDecl(ACall.ResolvedMethod);
|
||||
Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand(ACall.ObjectName)]));
|
||||
Self.Emit(#9'callq _ClassCreate');
|
||||
if MD <> nil then
|
||||
begin
|
||||
UserSlots := Self.CountArgSlots(MD.Params);
|
||||
TotalSlots := UserSlots + 1;
|
||||
Sym := MethodEmitNameNative(MD, RT.Name, ACall.Name);
|
||||
if TotalSlots <= 6 then
|
||||
begin
|
||||
Self.Emit(#9'pushq %rbx');
|
||||
Self.Emit(#9'movq %rax, %rbx');
|
||||
Self.BeginCallArgs(MD.Params, ACall.Args);
|
||||
for I := 0 to ACall.Args.Count - 1 do
|
||||
Self.PushCallArg(TMethodParam(MD.Params.Items[I]),
|
||||
TASTExpr(ACall.Args.Items[I]), I);
|
||||
for I := UserSlots - 1 downto 0 do
|
||||
Self.Emit(#9'popq ' + SysVArg64(I + 1));
|
||||
Self.Emit(#9'movq %rbx, %rdi');
|
||||
if MD.VTableSlot >= 0 then
|
||||
begin
|
||||
Self.Emit(#9'movq (%rdi), %rax');
|
||||
Self.Emit(Format(#9'movq %d(%%rax), %%rax', [(MD.VTableSlot + 1) * 8]));
|
||||
Self.Emit(#9'callq *%rax');
|
||||
end
|
||||
else
|
||||
Self.Emit(#9'callq ' + Sym);
|
||||
Self.EndCallArgs();
|
||||
Self.Emit(#9'movq %rbx, %rax');
|
||||
Self.Emit(#9'popq %rbx');
|
||||
end
|
||||
else
|
||||
begin
|
||||
Self.Emit(#9'pushq %rbx');
|
||||
Self.Emit(#9'movq %rax, %rbx');
|
||||
HD := TList<Integer>.Create();
|
||||
HK := TList<Integer>.Create();
|
||||
HTotal := Self.EmitArgHoist(MD.Params, nil, True, '', ACall.Args, HD, HK);
|
||||
OverflowSlots := TotalSlots - 6;
|
||||
AllocSz := (((6 * 8 + OverflowSlots * 8) + 15) and (-16)) + 8;
|
||||
CleanUp := AllocSz - 6 * 8;
|
||||
Self.Emit(Format(#9'subq $%d, %%rsp', [AllocSz]));
|
||||
for I := 0 to ACall.Args.Count - 1 do
|
||||
begin
|
||||
Arg := TASTExpr(ACall.Args.Items[I]);
|
||||
if I + 1 < 6 then
|
||||
Dest := I * 8 + 8
|
||||
else
|
||||
Dest := 6 * 8 + (I + 1 - 6) * 8;
|
||||
if HK.Get(I) >= akRecCall then
|
||||
Self.Emit(Format(#9'movq %d(%%rsp), %%rax',
|
||||
[AllocSz + HTotal - HD.Get(I)]))
|
||||
else if TMethodParam(MD.Params.Items[I]).IsVarParam then
|
||||
Self.EmitVarArgAddrToRax(Arg)
|
||||
else
|
||||
Self.EmitExprToEax(Arg);
|
||||
Self.Emit(Format(#9'movq %%rax, %d(%%rsp)', [Dest]));
|
||||
end;
|
||||
Self.Emit(Format(#9'movq %%rbx, 0(%%rsp)', []));
|
||||
for I := 0 to 5 do
|
||||
Self.Emit(Format(#9'movq %d(%%rsp), %s', [I * 8, SysVArg64(I)]));
|
||||
Self.Emit(Format(#9'addq $%d, %%rsp', [6 * 8]));
|
||||
if MD.VTableSlot >= 0 then
|
||||
begin
|
||||
Self.Emit(#9'movq (%rdi), %rax');
|
||||
Self.Emit(Format(#9'movq %d(%%rax), %%rax', [(MD.VTableSlot + 1) * 8]));
|
||||
Self.Emit(#9'callq *%rax');
|
||||
end
|
||||
else
|
||||
Self.Emit(#9'callq ' + Sym);
|
||||
Self.EmitHoistEpilogue(ACall.Args, HD, HK, HTotal, CleanUp, True);
|
||||
HD.Free();
|
||||
HK.Free();
|
||||
Self.Emit(#9'movq %rbx, %rax');
|
||||
Self.Emit(#9'popq %rbx');
|
||||
end;
|
||||
end;
|
||||
{ Discarded result: free the rc=1 instance. }
|
||||
Self.Emit(#9'movq %rax, %rdi');
|
||||
Self.Emit(#9'callq _ClassRelease');
|
||||
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
|
||||
|
|
|
|||
|
|
@ -6307,6 +6307,102 @@ var
|
|||
PMark: Integer;
|
||||
begin
|
||||
PMark := PendingReleaseMark();
|
||||
|
||||
{ Metaclass-var constructor dispatch in statement position: C.Create(args)
|
||||
where C is a 'class of' variable and the result is discarded. Only the
|
||||
expression-position path (EmitExpr) allocated the instance and dispatched
|
||||
the ctor through the vtable; here we must do the same. Without this
|
||||
branch the code fell through to the regular virtual-dispatch path below,
|
||||
which loads the metaclass typeinfo pointer as if it were the object and
|
||||
calls a garbage vtable slot — crashing at runtime. The freshly built
|
||||
instance comes back from _ClassCreate at refcount 1; since the result is
|
||||
discarded we release it once so it is freed rather than leaked. }
|
||||
if ACall.IsConstructorCall and ACall.IsMetaclassDispatch then
|
||||
begin
|
||||
RT := TRecordTypeDesc(ACall.ResolvedClassType);
|
||||
MDecl := TMethodDecl(ACall.ResolvedMethod);
|
||||
SelfTemp := AllocTemp();
|
||||
FPtrTemp := AllocTemp();
|
||||
EmitLine(Format(' %s =l loadl %s',
|
||||
[FPtrTemp, VarRef(ACall.ObjectName, ACall.IsGlobal)]));
|
||||
EmitLine(Format(' %s =l call $_ClassCreate(l %s)', [SelfTemp, FPtrTemp]));
|
||||
if MDecl <> nil then
|
||||
begin
|
||||
ArgLine := Format('l %s', [SelfTemp]);
|
||||
ArgTemps := TStringList.Create();
|
||||
try
|
||||
for I := 0 to ACall.Args.Count - 1 do
|
||||
begin
|
||||
Par := TMethodParam(MDecl.Params.Items[I]);
|
||||
if Par.IsOpenArray then
|
||||
begin
|
||||
ArgTemps.Add('');
|
||||
ArgLine := ArgLine + ', ' +
|
||||
OpenArrayArgFragment(TASTExpr(ACall.Args.Items[I]));
|
||||
end
|
||||
else if Par.IsVarParam then
|
||||
begin
|
||||
ArgTemps.Add('');
|
||||
ArgLine := ArgLine + Format(', l %s',
|
||||
[EmitLValueAddr(TASTExpr(ACall.Args.Items[I]))]);
|
||||
end
|
||||
else if (Par.ResolvedType <> nil) and (Par.ResolvedType.Kind = tyInterface) then
|
||||
begin
|
||||
ArgTemps.Add('');
|
||||
if TASTExpr(ACall.Args.Items[I]).ResolvedType.Kind = tyClass then
|
||||
begin
|
||||
ArgTemp := EmitExpr(TASTExpr(ACall.Args.Items[I]));
|
||||
ItabName := '$itab_' +
|
||||
ClassSymName(QBEMangle(TASTExpr(ACall.Args.Items[I]).ResolvedType.Name))
|
||||
+ '_' + QBEMangle(Par.ResolvedType.Name);
|
||||
ArgLine := ArgLine + Format(', l %s, l %s', [ArgTemp, ItabName]);
|
||||
end
|
||||
else
|
||||
ArgLine := ArgLine + InterfaceArgFragment(TASTExpr(ACall.Args.Items[I]));
|
||||
end
|
||||
else
|
||||
begin
|
||||
ArgTemp := EmitExpr(TASTExpr(ACall.Args.Items[I]));
|
||||
ArgTemps.Add(ArgTemp);
|
||||
EnsureConstStringRef(ArgTemp, Par, TASTExpr(ACall.Args.Items[I]), MDecl.Params);
|
||||
ArgTemp := CoerceArg(ArgTemp, TASTExpr(ACall.Args.Items[I]),
|
||||
QbeTypeOf(Par.ResolvedType));
|
||||
ArgLine := ArgLine + Format(', %s %s',
|
||||
[QbeParamTypeOf(Par.ResolvedType), ArgTemp]);
|
||||
end;
|
||||
end;
|
||||
if MDecl.VTableSlot >= 0 then
|
||||
begin
|
||||
{ Indirect ctor call via vtable: load vptr from instance[0],
|
||||
then load ctor address from vtable[ctorSlot]. }
|
||||
VTblTemp := AllocTemp();
|
||||
EmitLine(Format(' %s =l loadl %s', [VTblTemp, SelfTemp]));
|
||||
SlotOff := (MDecl.VTableSlot + 1) * 8;
|
||||
ArgTemp := AllocTemp();
|
||||
EmitLine(Format(' %s =l add %s, %d', [ArgTemp, VTblTemp, SlotOff]));
|
||||
FPtrTemp := AllocTemp();
|
||||
EmitLine(Format(' %s =l loadl %s', [FPtrTemp, ArgTemp]));
|
||||
EmitLine(Format(' call %s(%s)', [FPtrTemp, ArgLine]));
|
||||
end
|
||||
else
|
||||
begin
|
||||
if MDecl.OwnerTypeName <> '' then
|
||||
FuncName := '$' + MethodEmitName(MDecl, MDecl.OwnerTypeName, ACall.Name)
|
||||
else
|
||||
FuncName := '$' + MethodEmitName(MDecl, RT.Name, ACall.Name);
|
||||
EmitLine(Format(' call %s(%s)', [FuncName, ArgLine]));
|
||||
end;
|
||||
EmitOwnedArgReleases(ACall.Args, ArgTemps, MDecl.Params);
|
||||
ReleaseConstStringArgs(ACall.Args, ArgTemps, MDecl.Params);
|
||||
finally
|
||||
ArgTemps.Free();
|
||||
end;
|
||||
end;
|
||||
EmitLine(Format(' call $_ClassRelease(l %s)', [SelfTemp]));
|
||||
FlushPendingReleases(PMark);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
{ Interface method dispatch: load obj + itab, index by method slot }
|
||||
if (ACall.ResolvedClassType <> nil) and
|
||||
(ACall.ResolvedClassType.Kind = tyInterface) then
|
||||
|
|
|
|||
|
|
@ -123,6 +123,9 @@ type
|
|||
procedure TestRun_MetaclassCreate_DispatchesToDerived;
|
||||
{ Metaclass-var ctor with args: cls.Create(N) passes args correctly. }
|
||||
procedure TestRun_MetaclassCreate_WithArgs;
|
||||
{ Metaclass-var ctor in statement position (result discarded): allocates,
|
||||
dispatches the most-derived ctor, then frees the instance. }
|
||||
procedure TestRun_MetaclassCreate_StatementDiscardsResult;
|
||||
{ Direct TFoo.Create stays static (no vtable dispatch). }
|
||||
procedure TestRun_DirectCreate_StaysStatic;
|
||||
{ ClassCreate builtin still works (backwards compat) and now dispatches
|
||||
|
|
@ -1788,6 +1791,42 @@ const SrcMetaclassCreateArgs = '''
|
|||
end.
|
||||
''';
|
||||
|
||||
{ Metaclass-var constructor in STATEMENT position (result discarded):
|
||||
cls.Create(); must allocate, run the most-derived ctor for its side
|
||||
effects, then free the unreachable instance — not crash. Regression:
|
||||
the statement-call lowering used to treat the metaclass typeinfo pointer
|
||||
as the object and call a garbage vtable slot. Destroy bumps gFreed, so
|
||||
the trailing '1' proves the discarded instance was freed, not leaked. }
|
||||
const SrcMetaclassCreateStatement = '''
|
||||
program Prg;
|
||||
type
|
||||
TBase = class(TObject)
|
||||
constructor Create(N: Integer); virtual;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
TChild = class(TBase)
|
||||
constructor Create(N: Integer); override;
|
||||
end;
|
||||
TBaseClass = class of TBase;
|
||||
var gVal: Integer;
|
||||
var gFreed: Integer;
|
||||
constructor TBase.Create(N: Integer);
|
||||
begin gVal := N end;
|
||||
destructor TBase.Destroy;
|
||||
begin gFreed := gFreed + 1; inherited Destroy() end;
|
||||
constructor TChild.Create(N: Integer);
|
||||
begin inherited Create(N); gVal := gVal * 10 end;
|
||||
procedure Run(C: TBaseClass; N: Integer);
|
||||
begin
|
||||
C.Create(N)
|
||||
end;
|
||||
begin
|
||||
Run(TBase, 4); WriteLn(gVal);
|
||||
Run(TChild, 4); WriteLn(gVal);
|
||||
WriteLn(gFreed)
|
||||
end.
|
||||
''';
|
||||
|
||||
const SrcDirectCreateStatic = '''
|
||||
program Prg;
|
||||
type
|
||||
|
|
@ -1843,6 +1882,13 @@ begin
|
|||
'3' + LE + '30' + LE, 0);
|
||||
end;
|
||||
|
||||
procedure TE2EClasses2Tests.TestRun_MetaclassCreate_StatementDiscardsResult;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertRunsOnAll(SrcMetaclassCreateStatement,
|
||||
'4' + LE + '40' + LE + '2' + LE, 0);
|
||||
end;
|
||||
|
||||
procedure TE2EClasses2Tests.TestRun_DirectCreate_StaysStatic;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
|
|
|
|||
Loading…
Reference in a new issue