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

fix(codegen): assign a method pointer to an implicit-Self field

Browse source 
Assigning @Obj.Method to a bare (implicit-Self) method-pointer field —
FFn := @Self.M with no Self. on the left-hand side — was mishandled by
both the QBE and native backends.  The assignment emitter routes all
implicit-Self field stores through a dedicated block that returns before
the method-pointer assignment handler runs, so a 16-byte (Code, Data)
method pointer fell through to the scalar-store path:

  - QBE stored only the 8-byte pointer to the source block, leaving the
    Data half garbage; a later call then dispatched on a bad Self and
    crashed.
  - native reached the @Obj.Method address-of path, which is statement
    level only, and raised "@Obj.Method must be used in assignment
    context".

Add a method-pointer case to the implicit-Self field-assignment path in
each backend, mirroring the existing simple-variable and explicit-field
handlers: copy the whole 16-byte block into Self + field offset, with the
Code half resolved through the instance vtable for a virtual/override
method so the dynamic override is captured.

Explicit Self.FFn := @Self.M and the implicit-Self call FFn(...) were
already correct; only the implicit-Self assignment was affected.

Tests: cp.test.proctypes_ofobject gains an IR test asserting the
implicit-Self method-ptr field store emits a 16-byte memcpy;
cp.test.e2e.misc gains an end-to-end test that assigns via implicit Self
then calls back through the field (reading another field via Self, so a
wrong Data half would crash).  Both fail before this change and pass
after.

# Conflicts:
#	compiler/src/test/pascal/cp.test.e2e.misc.pas
This commit is contained in:
Andrew Haines 2026-06-28 03:01:28 -04:00 committed by Graeme Geldenhuys
parent f6c1cee9fe
commit e2ee936663
4 changed files with 139 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -11045,6 +11045,55 @@ begin
(Asgn.ResolvedLhsType.Kind <> tyInterface) then
begin
ISFld := TFieldInfo(Asgn.ImplicitSelfField);
{ Method-pointer field via implicit Self (bare FFn := @Obj.Method): store
the [CodePtr, ObjPtr] pair into the field's 16-byte slot. Checked before
the ARC/generic stores below, which would route the RHS through
EmitExprToEax(@Obj.Method) and raise "must be used in assignment
context". Destination base is Self + field offset; the rest mirrors the
simple-variable and explicit-field method-ptr assignment cases. }
if (ISFld.TypeDesc.Kind = tyProcedural) and
TProceduralTypeDesc(ISFld.TypeDesc).IsMethodPtr and
(Asgn.Expr is TAddrOfExpr) and
(TAddrOfExpr(Asgn.Expr).Expr is TFieldAccessExpr) and
(TFieldAccessExpr(TAddrOfExpr(Asgn.Expr).Expr).ResolvedType <> nil) and
(TFieldAccessExpr(TAddrOfExpr(Asgn.Expr).Expr).ResolvedType.Kind = tyProcedural) and
TProceduralTypeDesc(TFieldAccessExpr(TAddrOfExpr(Asgn.Expr).Expr).ResolvedType).IsMethodPtr then
begin
FAE := TFieldAccessExpr(TAddrOfExpr(Asgn.Expr).Expr);
MD := TMethodDecl(FAE.ResolvedMethod);
{ Destination field address = Self + field offset → %rcx }
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('Self')]));
if ISFld.Offset > 0 then
Self.Emit(Format(#9'addq $%d, %%rcx', [ISFld.Offset]));
{ Store the captured object pointer at offset 8 first — a virtual method
reads its code pointer from THIS instance's vtable. }
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
Self.EmitVarBaseToReg(FAE.RecordName, False, '%rax');
Self.Emit(#9'movq %rax, 8(%rcx)');
end;
{ Store the code pointer at offset 0, vtable-resolved for a
virtual/override method so @Obj.M captures the dynamic override (slot 0
is typeinfo, method N at (N+1)*8); static label otherwise. }
if MD.VTableSlot >= 0 then
begin
Self.Emit(#9'movq 8(%rcx), %rax');
Self.Emit(#9'movq (%rax), %rax');
Self.Emit(Format(#9'movq %d(%%rax), %%rax', [(MD.VTableSlot + 1) * 8]));
end
else
Self.Emit(Format(#9'leaq %s(%%rip), %%rax',
[MethodEmitNameNative(MD, MD.OwnerTypeName, FAE.FieldName)]));
Self.Emit(#9'movq %rax, (%rcx)');
Exit;
end;
{ ARC-managed implicit-Self field: retain the new value (unless the RHS
already owns +1) and release the old before overwriting. %r15
(callee-saved) holds the slot address across the ARC calls. }

13
compiler/src/main/pascal/blaise.codegen.qbe.pas
View file

@ -4249,6 +4249,19 @@ begin
EmitInterfaceToFieldSlots(AAssign.Expr, ObjTemp, ISAddrT, ISFld.TypeDesc);
Exit;
end;
{ Method-pointer field via implicit Self (bare FFn := @Obj.Method): the RHS
evaluates to the address of a 16-byte [Code, Data] block (vtable-resolved
by EmitAddrOfExpr); copy the whole block into the field slot. Must precede
the scalar store below, which would deposit only the 8-byte block pointer
and leave the Data half garbage — a later call then dispatches on a bad
Self and crashes. Mirrors the simple-variable method-ptr assignment. }
if (ISFld.TypeDesc.Kind = tyProcedural) and
TProceduralTypeDesc(ISFld.TypeDesc).IsMethodPtr then
begin
ValTemp := EmitExpr(AAssign.Expr);
EmitLine(Format(' call $memcpy(l %s, l %s, l 16)', [ObjTemp, ValTemp]));
Exit;
end;
ValTemp := EmitExpr(AAssign.Expr);
QType := QbeTypeOf(ISFld.TypeDesc);
if QType = 'w' then

37
compiler/src/test/pascal/cp.test.e2e.misc.pas
View file

@ -56,6 +56,7 @@ type
procedure TestRun_MethodPtrVirtualCapture_Field;
procedure TestRun_MethodPtrReturn;
procedure TestRun_MethodPtrReturn_ReadsSelf;
procedure TestRun_MethodPtrImplicitSelfFieldAssign;
{ Unqualified call to a procedural-typed field via implicit Self (FFn(...)
with no 'Self.' prefix), as an expression and as a statement. }
procedure TestRun_ImplicitSelfProcField_Expr;
@ -608,6 +609,36 @@ const
end.
''';
{ Assigning @Self.Method to a bare (implicit-Self) method-pointer field:
FFn := @Self.DoIt inside a method, with no 'Self.' on the LHS. DoIt reads
another field through Self, so a wrong Data half (the bug) would crash or
print garbage rather than 'T:x'. }
SrcMethodPtrImplicitSelfFieldAssign = '''
program Prg;
type
TProc = procedure(const S: string) of object;
TA = class
FName: string;
FFn: TProc;
procedure DoIt(const S: string);
procedure Fire;
end;
procedure TA.DoIt(const S: string);
begin WriteLn(FName + ':' + S) end;
procedure TA.Fire;
begin
FFn := @Self.DoIt;
FFn('x')
end;
var A: TA;
begin
A := TA.Create();
A.FName := 'T';
A.Fire();
A.Free()
end.
''';
{ Unqualified (implicit-Self) call to a procedural-typed field, as an
expression — FFn(...) with no 'Self.' prefix. }
SrcImplicitProcFieldExpr = '''
@ -1028,6 +1059,12 @@ begin
'107' + LE + '105' + LE + '103' + LE + '109' + LE, 0);
end;
procedure TE2EMiscTests.TestRun_MethodPtrImplicitSelfFieldAssign;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(SrcMethodPtrImplicitSelfFieldAssign, 'T:x' + LE, 0);
end;
procedure TE2EMiscTests.TestRun_ImplicitSelfProcField_Expr;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;

40
compiler/src/test/pascal/cp.test.proctypes_ofobject.pas
View file

@ -57,6 +57,7 @@ type
procedure TestCodegen_MethodPtrField_DirectCall_LoadsCodeAndData;
procedure TestCodegen_MethodPtrVirtualCapture_LoadsFromVTable;
procedure TestCodegen_MethodPtrReturn_UsesAggregateABI;
procedure TestCodegen_MethodPtrField_ImplicitSelfAssignUsesMemcpy16;
{ End-to-end }
procedure TestE2E_MethodPtr_NoArgs;
@ -764,6 +765,45 @@ begin
StrPos('_ffi__BlaiseMethodPtr', IR) >= 0);
end;
procedure TProcTypesOfObjectTests.TestCodegen_MethodPtrField_ImplicitSelfAssignUsesMemcpy16;
const
Src =
'''
program P;
type
TProc = procedure(const S: string) of object;
TA = class(TObject)
FFn: TProc;
procedure DoIt(const S: string);
procedure Fire;
end;
procedure TA.DoIt(const S: string);
begin WriteLn(S) end;
procedure TA.Fire;
begin
FFn := @Self.DoIt
end;
var A: TA;
begin
A := TA.Create();
A.Fire();
A.Free()
end.
''';
var IR: string;
begin
IR := GenIR(Src);
{ Assigning @Self.Method to a bare (implicit-Self) method-pointer field must
copy the whole 16-byte (Code, Data) block into the field slot. The buggy
codegen fell through to the scalar-store path and deposited only the 8-byte
pointer to the source block, leaving the Data half garbage — a later call
then dispatched on a bad Self and crashed. }
AssertTrue('implicit-Self method-ptr field assignment emits memcpy',
Pos('call $memcpy(', IR) > 0);
AssertTrue('memcpy length is 16',
Pos(', l 16)', IR) > 0);
end;
procedure TProcTypesOfObjectTests.TestE2E_MethodPtrField_DirectCall_StmtForm;
const
Src =