From aa33103659a3d282bccca6d9cc4e0bb9c39c74ba Mon Sep 17 00:00:00 2001 From: Andrew Haines Date: Wed, 24 Jun 2026 15:34:03 -0400 Subject: [PATCH] fix(codegen): store @Obj.Method into a class field on the native backend Assigning a method pointer (procedure/function of object) captured with @Obj.Method into a class field -- B.FEvt := @S.Handle -- raised "@Obj.Method must be used in assignment context" on the native x86-64 backend. The simple-variable destination was already handled, but a field destination fell through to evaluating @Obj.Method as a general expression, which has no standalone lowering. The field-assignment path now special-cases a method-pointer field whose right-hand side is @Obj.Method: it computes the field's containing-object base per receiver shape (as the interface-field store already does), then stores the code pointer at offset 0 and the captured object pointer at offset 8 of the field's 16-byte slot. This also makes the of-object arm of procedural-field call dispatch reachable on the native backend (a field must be populated before it can be called). Covered end-to-end on both backends: capture @Obj.Method into a field, then dispatch through it. --- .../pascal/blaise.codegen.native.x86_64.pas | 76 +++++++++++++++++++ compiler/src/test/pascal/cp.test.e2e.misc.pas | 38 ++++++++++ 2 files changed, 114 insertions(+) diff --git a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas index 7190db2..952a0d1 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -11987,6 +11987,82 @@ begin FA.FieldInfo.TypeDesc); Exit; end; + { Method-pointer (of object) field assignment from @Obj.Method: store the + [CodePtr, ObjPtr] pair into the field's 16-byte slot. Mirrors the + simple-variable case in EmitAssignment; the only difference is that the + destination is a field, so its containing-object base is computed per + receiver shape (exactly as the interface-field store above does). } + if (FA.FieldInfo.TypeDesc.Kind = tyProcedural) and + TProceduralTypeDesc(FA.FieldInfo.TypeDesc).IsMethodPtr and + (FA.Expr is TAddrOfExpr) and + (TAddrOfExpr(FA.Expr).Expr is TFieldAccessExpr) and + (TFieldAccessExpr(TAddrOfExpr(FA.Expr).Expr).ResolvedType <> nil) and + (TFieldAccessExpr(TAddrOfExpr(FA.Expr).Expr).ResolvedType.Kind = tyProcedural) and + TProceduralTypeDesc(TFieldAccessExpr(TAddrOfExpr(FA.Expr).Expr).ResolvedType).IsMethodPtr then + begin + FAE := TFieldAccessExpr(TAddrOfExpr(FA.Expr).Expr); + MD := TMethodDecl(FAE.ResolvedMethod); + { Destination field's containing-object base → %rcx, per receiver shape. } + if FA.ObjExpr <> nil then + begin + Self.EmitExprToEax(FA.ObjExpr); + Self.Emit(#9'movq %rax, %rcx'); + end + else if FSretFunc and (FA.RecordName = 'Result') then + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('Result')])) + else if FA.IsImplicitSelf then + begin + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('Self')])); + if (FA.ImplicitBaseInfo <> nil) and (FA.ImplicitBaseInfo.Offset > 0) then + Self.Emit(Format(#9'addq $%d, %%rcx', [FA.ImplicitBaseInfo.Offset])); + if FA.IsClassAccess then + Self.Emit(#9'movq (%rcx), %rcx'); + end + else if FA.IsClassAccess then + begin + if Self.IsLocal(FA.RecordName) then + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(FA.RecordName)])) + else + Self.Emit(Format(#9'movq %s(%%rip), %%rcx', [FA.RecordName])); + if FA.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rcx), %rcx'); + end + else if FA.IsVarParam then + begin + if Self.IsLocal(FA.RecordName) then + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(FA.RecordName)])) + else + Self.Emit(Format(#9'movq %s(%%rip), %%rcx', [FA.RecordName])); + end + else if Self.IsLocal(FA.RecordName) then + Self.EmitLocalRecordBase(FA.RecordName, '%rcx') + else + Self.Emit(Format(#9'leaq %s(%%rip), %%rcx', [FA.RecordName])); + if FA.FieldInfo.Offset > 0 then + Self.Emit(Format(#9'addq $%d, %%rcx', [FA.FieldInfo.Offset])); + { Store the code pointer at offset 0. } + Self.Emit(Format(#9'leaq %s(%%rip), %%rax', + [MethodEmitNameNative(MD, MD.OwnerTypeName, FAE.FieldName)])); + Self.Emit(#9'movq %rax, (%rcx)'); + { Store the captured object pointer at offset 8. } + if FAE.Base <> nil then + begin + Self.Emit(#9'pushq %rcx'); + Self.EmitExprToEax(FAE.Base); + Self.Emit(#9'popq %rcx'); + Self.Emit(#9'movq %rax, 8(%rcx)'); + end + else + begin + if Self.IsLocal(FAE.RecordName) then + Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand(FAE.RecordName)])) + else + Self.Emit(Format(#9'movq %s(%%rip), %%rax', [FAE.RecordName])); + Self.Emit(#9'movq %rax, 8(%rcx)'); + end; + Exit; + end; { Field := MethodCall() where the method returns a record via sret. Compute the field address into %rbx (callee-saved), release managed fields of the old record, then call with %rbx as the sret destination. } diff --git a/compiler/src/test/pascal/cp.test.e2e.misc.pas b/compiler/src/test/pascal/cp.test.e2e.misc.pas index afecbdb..0e25daa 100644 --- a/compiler/src/test/pascal/cp.test.e2e.misc.pas +++ b/compiler/src/test/pascal/cp.test.e2e.misc.pas @@ -47,6 +47,9 @@ type procedure TestRun_ProcFieldCall_Statement; procedure TestRun_ProcFieldCall_OutParam; procedure TestRun_ProcFieldCall_MultiArg; + { Method-pointer (of object) field: assign @Obj.Method into a field, then + dispatch through it — exercises the 16-byte (Code, Data) field store. } + procedure TestRun_MethodPtrField_AssignAndCall; { Default parameters } procedure TestRun_DefaultParam_OmitLast; @@ -426,6 +429,35 @@ const end. '''; + { Method-pointer (of object) class field: capture @Obj.Method into a field + and call through it. The capture stores a 16-byte (Code, Data) pair. } + SrcMethodPtrField = ''' + program Prg; + type + TEvt = procedure(const S: string) of object; + TSrc = class + Tag: string; + procedure Handle(const S: string); + end; + TBox = class + FEvt: TEvt; + procedure Fire(const S: string); + end; + procedure TSrc.Handle(const S: string); + begin WriteLn(Self.Tag, ':', S) end; + procedure TBox.Fire(const S: string); + begin Self.FEvt(S) end; + var B: TBox; S: TSrc; + begin + S := TSrc.Create(); S.Tag := 'T'; + B := TBox.Create(); + B.FEvt := @S.Handle; + B.Fire('hello'); + B.Free(); + S.Free() + end. + '''; + SrcDefaultParam = ''' program Prg; function Add(A: Integer; B: Integer = 10): Integer; @@ -767,6 +799,12 @@ begin AssertRunsOnAll(SrcProcFieldMultiArg, '33' + LE, 0); end; +procedure TE2EMiscTests.TestRun_MethodPtrField_AssignAndCall; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcMethodPtrField, 'T:hello' + LE, 0); +end; + procedure TE2EMiscTests.TestRun_DefaultParam_OmitLast; begin if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;