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

fix(semantic,codegen): allow direct invocation of proc-typed class fields

Browse source 
Calling a method-pointer field directly — `F.Handler;` or `F.Handler()` —
previously failed with "Class 'TFoo' has no method 'Handler'" because
AnalyseMethodCall went straight to ResolveMethodOverload without first
checking whether the name resolved to a procedural-typed field.

Fix: before the ResolveMethodOverload/error path, detect a tyProcedural
field on the receiver class and set IsProcFieldCall on the TMethodCallStmt.
EmitMethodCall then loads Code from the field slot (Self+Offset) and Data
from slot+8, emitting the same indirect (Code,Data) ABI used everywhere
else for method-pointer dispatch.

New fields on TMethodCallStmt: IsProcFieldCall, ProcFieldInfo,
ResolvedProcType.  No AST node is needed for TMethodCallExpr yet (the
expression form is a separate gap).

Closes: https://github.com/graemeg/blaise/issues/57

Tests added: IR unit test asserting indirect-call emission; E2E test
compiling and running both `F.Handler;` and `F.Handler();` forms.
2240 tests pass; fixpoint OK.
This commit is contained in:
Graeme Geldenhuys 2026-05-31 16:44:55 +01:00
parent 8b524340ce
commit 5d6abdac61
4 changed files with 134 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
compiler/src/main/pascal/uAST.pas
View file

@ -434,6 +434,12 @@ type
IsGlobal: Boolean; { set by uSemantic — ObjectName is a program-level global }
IsVarParam: Boolean; { set by uSemantic — ObjectName is a var/out parameter }
IsBuiltinToString: Boolean; { set by uSemantic — built-in TObject.ToString virtual dispatch }
IsProcFieldCall: Boolean; { set by uSemantic — Name is a procedural-typed field of
the receiver, invoked directly (F.Handler;). Codegen
loads the (Code, Data) pair from the field slot and
dispatches indirectly instead of calling a method. }
ProcFieldInfo: TFieldInfo; { not owned — the procedural field, when IsProcFieldCall }
ResolvedProcType: TObject; { TProceduralTypeDesc — not owned; the field's signature }
constructor Create;
destructor Destroy; override;
end;

44
compiler/src/main/pascal/uCodeGenQBE.pas
View file

@ -4204,6 +4204,9 @@ var
FPtrTemp: string;
SlotOff: Integer;
IntfDesc: TInterfaceTypeDesc;
PT: TProceduralTypeDesc;
SlotAddr: string;
DataTemp: string;
begin
{ Interface method dispatch: load obj + itab, index by method slot }
if (ACall.ResolvedClassType <> nil) and
@ -4373,6 +4376,47 @@ begin
EmitLine(Format(' call $_CheckNil(l %s)', [SelfTemp]));
end;
{ Direct invocation of a procedural-typed field (F.Handler; / F.Handler();).
The field slot lives at Self + Offset. For a method-pointer field it is a
16-byte (Code, Data) block — Code at slot+0, Data at slot+8; the loaded
Data is passed as the implicit first argument so the callee sees its Self.
A bare procedural field (not 'of object') holds a single function pointer
and takes no implicit Self. Mirrors EmitProcCall's indirect-call path. }
if ACall.IsProcFieldCall then
begin
PT := TProceduralTypeDesc(ACall.ResolvedProcType);
if ACall.ProcFieldInfo.Offset > 0 then
begin
SlotAddr := AllocTemp;
EmitLine(Format(' %s =l add %s, %d',
[SlotAddr, SelfTemp, ACall.ProcFieldInfo.Offset]));
end
else
SlotAddr := SelfTemp;
FPtrTemp := AllocTemp;
EmitLine(Format(' %s =l loadl %s', [FPtrTemp, SlotAddr]));
if PT.IsMethodPtr then
begin
ArgTemp := AllocTemp;
EmitLine(Format(' %s =l add %s, 8', [ArgTemp, SlotAddr]));
DataTemp := AllocTemp;
EmitLine(Format(' %s =l loadl %s', [DataTemp, ArgTemp]));
ArgLine := Format('l %s', [DataTemp]);
end
else
ArgLine := '';
for I := 0 to ACall.Args.Count - 1 do
begin
if ArgLine <> '' then ArgLine := ArgLine + ', ';
ArgTemp := EmitExpr(TASTExpr(ACall.Args.Items[I]));
QType := QbeTypeOf(TProcParamInfo(PT.Params.Items[I]).TypeDesc);
ArgTemp := CoerceArg(ArgTemp, TASTExpr(ACall.Args.Items[I]), QType);
ArgLine := ArgLine + Format('%s %s', [QType, ArgTemp]);
end;
EmitLine(Format(' call %s(%s)', [FPtrTemp, ArgLine]));
Exit;
end;
{ Build argument string: l Self, then each explicit arg }
ArgLine := Format('l %s', [SelfTemp]);
for I := 0 to ACall.Args.Count - 1 do

22
compiler/src/main/pascal/uSemantic.pas
View file

@ -4137,6 +4137,7 @@ var
ArgType: TTypeDesc;
I: Integer;
ObjType: TTypeDesc;
FldInfo: TFieldInfo;
begin
{ Call on a receiver expression: AProg.UsedUnits.Add(UName) }
if ACall.ObjExpr <> nil then
@ -4252,6 +4253,27 @@ begin
for I := 0 to ACall.Args.Count - 1 do
AnalyseExpr(TASTExpr(ACall.Args.Items[I]));
{ Direct invocation of a procedural-typed field (e.g. an event-handler
field): F.Handler; or F.Handler();. Resolve this before reporting a
missing method so the call dispatches through the (Code, Data) pair
stored in the field, mirroring the indirect-call path used for a
procedural-typed local variable. }
FldInfo := RT.FindField(ACall.Name);
if (FldInfo <> nil) and (FldInfo.TypeDesc <> nil) and
(FldInfo.TypeDesc.Kind = tyProcedural) and
(FindMethodDecl(RT.Name, ACall.Name) = nil) then
begin
ACall.IsProcFieldCall := True;
ACall.ProcFieldInfo := FldInfo;
ACall.ResolvedProcType := FldInfo.TypeDesc;
ACall.ResolvedClassType := RT;
ACall.ResolvedMethod := nil;
ACall.IsGlobal := ObjSym.IsGlobal;
ACall.IsVarParam := (ObjSym.Kind = skVarParameter);
Exit;
end;
MDecl := ResolveMethodOverload(RT.Name, ACall.Name, ACall.Args,
ACall.Line, ACall.Col);
if MDecl = nil then

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

@ -53,11 +53,14 @@ type
procedure TestCodegen_MethodPtrField_AssignUsesMemcpy16;
procedure TestCodegen_MethodPtrField_RecordTotalSizeIncludes16;
procedure TestCodegen_MethodPtrField_DirectCall_LoadsCodeAndData;
{ End-to-end }
procedure TestE2E_MethodPtr_NoArgs;
procedure TestE2E_MethodPtr_WithArgs;
procedure TestE2E_MethodPtr_PreservesSelf;
procedure TestE2E_MethodPtrField_RoundTrip;
procedure TestE2E_MethodPtrField_DirectCall_StmtForm;
end;
implementation
@ -656,6 +659,65 @@ begin
'field-ok', CompileAndRun(Src));
end;
procedure TProcTypesOfObjectTests.TestCodegen_MethodPtrField_DirectCall_LoadsCodeAndData;
const
Src =
'''
program P;
type
TGreet = procedure of object;
THolder = class(TObject)
Handler: TGreet;
end;
var H: THolder;
begin
H := THolder.Create;
H.Handler;
H.Free
end.
''';
var IR: string;
begin
IR := GenIR(Src);
{ Direct field call emits: load Code from slot, load Data from slot+8,
then call %Code(l %Data, ...). There must be NO static '$THolder_Handler'
symbol — it dispatches indirectly through the field. }
AssertTrue('IR contains indirect call pattern (call %',
StrPos('call %', IR) >= 0);
AssertFalse('IR does not static-dispatch $THolder_Handler',
StrPos('$THolder_Handler', IR) >= 0);
end;
procedure TProcTypesOfObjectTests.TestE2E_MethodPtrField_DirectCall_StmtForm;
const
Src =
'''
program P;
type
TGreet = procedure of object;
TFoo = class(TObject)
Handler: TGreet;
published
procedure SayHi;
end;
procedure TFoo.SayHi;
begin WriteLn('field-direct') end;
var F: TFoo; M: TMethod;
begin
F := TFoo.Create;
M.Code := MethodAddress(F, 'SayHi');
M.Data := F;
F.Handler := TGreet(M);
F.Handler;
F.Handler();
F.Free
end.
''';
begin
AssertEquals('direct proc-field call (bare and with parens) invokes the method',
'field-direct' + #10 + 'field-direct', CompileAndRun(Src));
end;
initialization
RegisterTest(TProcTypesOfObjectTests);
end.