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)

compiler/src/main/pascal/blaise.codegen.native.x86_64.pas

@@ -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

compiler/src/main/pascal/blaise.codegen.qbe.pas

@@ -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

compiler/src/test/pascal/cp.test.e2e.classes2.pas

@@ -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;