From e950814a342869143f797f3fb8428cd8c059cbd3 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Mon, 29 Jun 2026 01:01:25 +0100 Subject: [PATCH] fix(codegen): interface-typed static var store via static methods A static var of interface type round-tripped through static methods (THolder.SetIt(X: IThing) / THolder.GetIt: IThing) was miscompiled on both backends. The 2-slot fat-pointer global slot itself was correct; the bugs were in the static-CALL path. QBE: a static method whose first parameter is interface-typed emitted 'call $T_M(, l obj, l itab)'. The interface argument fragment carries a leading ', ' (it is normally appended after Self or a preceding arg), and the static-call argument loop did not strip it, so the first argument began with a comma and QBE rejected it as an invalid class specifier. Strip the leading ', ' in that branch, matching the existing EmitMethodCall var-arg/interface precedent. Native: a static method returning an interface routed through EmitClassIntfSretMethodCall (ResolvedClassType is the owning class, a class type), which loaded the bare type name as a global Self and emitted an undefined reference to the class symbol at external-cc link time (the internal/driver linker masked it). Add an IsStaticCall branch that emits the plain free-function interface-sret ABI with no receiver, mirroring the non-Self arm of EmitIntfSretCall. Tests: TestIR_StaticCall_InterfaceArg_NoLeadingComma asserts the QBE call has no leading comma; TestRun_StaticVar_InterfaceStore compiles and runs the SetIt/GetIt round-trip on both backends. --- .../pascal/blaise.codegen.native.x86_64.pas | 56 +++++++++++++++++++ .../src/main/pascal/blaise.codegen.qbe.pas | 10 +++- .../test/pascal/cp.test.e2e.staticmembers.pas | 53 ++++++++++++++++++ .../src/test/pascal/cp.test.staticmembers.pas | 48 ++++++++++++++++ 4 files changed, 165 insertions(+), 2 deletions(-) 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 a049bf2..0cca0ac 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -16276,6 +16276,62 @@ begin 'native backend: class sret interface call has no ResolvedMethod (' + ACall.Name + ')'); Sym := MethodEmitNameNative(MD, MD.OwnerTypeName, ACall.Name); + + { Static method returning an interface (TypeName.GetIt: IFoo): there is NO + receiver, so the call follows the plain free-function interface-sret ABI — + sret buffer in %rdi, user args from %rsi (base 1), and a direct callq to the + mangled static symbol. Without this branch the code below would treat the + bare TypeName (ACall.ObjectName) as a global Self and emit a load of an + undefined `TypeName` symbol. Mirrors the non-Self `else` arm of + EmitIntfSretCall. } + if ACall.IsStaticCall then + begin + Sym := MethodEmitNameNative(MD, + TRecordTypeDesc(ACall.ResolvedClassType).Name, ACall.Name); + UserSlots := Self.CountArgSlots(MD.Params); + HD := TList.Create(); + HK := TList.Create(); + HTotal := Self.EmitArgHoist(MD.Params, nil, True, '', ACall.Args, HD, HK); + Self.Emit(#9'subq $16, %rsp'); + Self.Emit(#9'movq $0, (%rsp)'); + Self.Emit(#9'movq $0, 8(%rsp)'); + Pushed := 0; + for I := 0 to ACall.Args.Count - 1 do + begin + Par := TMethodParam(MD.Params.Items[I]); + Arg := TASTExpr(ACall.Args.Items[I]); + if HK.Get(I) >= akRecCall then + begin + Self.Emit(Format(#9'movq %d(%%rsp), %%rax', + [16 + HTotal - HD.Get(I) + Pushed])); + Self.Emit(#9'pushq %rax'); + Pushed := Pushed + 8; + end + else + begin + Self.EmitMethodArgPush(Par, Arg); + if Par.IsOpenArray or + ((Par.ResolvedType <> nil) and (Par.ResolvedType.Kind = tyInterface)) then + Pushed := Pushed + 16 + else + Pushed := Pushed + 8; + end; + end; + { Base 1: %rdi = sret buffer, user args from %rsi; no Self register. } + OverflowBytes := Self.EmitSretRegArgs(UserSlots, 1); + Self.Emit(#9'movq %rsp, %rdi'); + if OverflowBytes > 0 then + Self.Emit(Format(#9'addq $%d, %%rdi', [OverflowBytes])); + Self.Emit(#9'callq ' + Sym); + if OverflowBytes > 0 then + Self.Emit(Format(#9'addq $%d, %%rsp', [OverflowBytes])); + Self.EmitHoistEpilogue(ACall.Args, HD, HK, HTotal, 16, False); + Self.EmitSretBufferSlideDown(HTotal); + HD.Free(); + HK.Free(); + Exit; + end; + UserSlots := Self.CountArgSlots(MD.Params); { %rdi = sret buffer, %rsi = Self leave four integer arg registers; further slots spill to the stack via EmitSretRegArgs (ABase = 2). } diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index 772ee61..1c9c673 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -6855,8 +6855,14 @@ begin else if (Par.ResolvedType <> nil) and (Par.ResolvedType.Kind = tyInterface) then begin ArgTemps.Add(''); - ArgLine := ArgLine + - InterfaceArgFragment(TASTExpr(ACall.Args.Items[I]), Par.ResolvedType); + { InterfaceArgFragment returns a leading-comma pair ', l obj, l itab' + (designed to be appended directly after a preceding arg). This + loop already inserts the ', ' separator at the top (line ~6843), + so strip the fragment's own leading ', ' to avoid a double comma — + and to avoid a leading comma when the interface is the FIRST arg of + a static call (which QBE rejects as "invalid class specifier"). } + ArgLine := ArgLine + Copy(InterfaceArgFragment( + TASTExpr(ACall.Args.Items[I]), Par.ResolvedType), 2, MaxInt); end else begin diff --git a/compiler/src/test/pascal/cp.test.e2e.staticmembers.pas b/compiler/src/test/pascal/cp.test.e2e.staticmembers.pas index 470cf70..846a85a 100644 --- a/compiler/src/test/pascal/cp.test.e2e.staticmembers.pas +++ b/compiler/src/test/pascal/cp.test.e2e.staticmembers.pas @@ -31,6 +31,7 @@ type procedure TestRun_StaticVar_QualifiedRead; procedure TestRun_StaticVar_QualifiedWrite_Scalar; procedure TestRun_StaticVar_QualifiedWrite_ClassARC; + procedure TestRun_StaticVar_InterfaceStore; procedure TestRun_StaticProperty_QualifiedRead; procedure TestRun_Singleton_LazyGetInstance; procedure TestRun_StaticConst_OnClass; @@ -169,6 +170,58 @@ begin AssertRunsOnAll(Src, '99' + LineEnding + 'released' + LineEnding, 0); end; +procedure TE2EStaticMembersTests.TestRun_StaticVar_InterfaceStore; +{ Interface-typed static var: the bare store inside a static method + (FCache := X) must write BOTH slots of the 2-slot fat pointer (obj + itab) + with correct ARC, and the bare read (Result := FCache) must reconstruct it. + Regression for the static-call interface-arg leading-comma bug that made + THolder.SetIt(T) emit an invalid QBE call and segfault native. } +const Src = + ''' + program P; + type + IThing = interface + procedure Speak; + end; + TThing = class(IThing) + public + Tag: Integer; + procedure Speak; + end; + THolder = class + public static var + FCache: IThing; + static procedure SetIt(X: IThing); + static function GetIt: IThing; + end; + procedure TThing.Speak; + begin + WriteLn('thing ', Tag); + end; + static procedure THolder.SetIt(X: IThing); + begin + FCache := X; + end; + static function THolder.GetIt: IThing; + begin + Result := FCache; + end; + var + T: TThing; + Got: IThing; + begin + T := TThing.Create(); + T.Tag := 7; + THolder.SetIt(T); + Got := THolder.GetIt(); + Got.Speak(); + end. + '''; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end; + AssertRunsOnAll(Src, 'thing 7' + LineEnding, 0); +end; + procedure TE2EStaticMembersTests.TestRun_StaticProperty_QualifiedRead; const Src = ''' diff --git a/compiler/src/test/pascal/cp.test.staticmembers.pas b/compiler/src/test/pascal/cp.test.staticmembers.pas index 7cfe782..f87fa38 100644 --- a/compiler/src/test/pascal/cp.test.staticmembers.pas +++ b/compiler/src/test/pascal/cp.test.staticmembers.pas @@ -587,6 +587,7 @@ type procedure TestIR_StaticVar_QualifiedRead_LoadsGlobal; procedure TestIR_StaticProperty_QualifiedRead_CallsGetter; procedure TestIR_ClassStaticVar_ReleasedAtExit; + procedure TestIR_StaticCall_InterfaceArg_NoLeadingComma; end; function TStaticMembersSemTests.AnalyseSrc(const ASrc: string): TProgram; @@ -993,6 +994,53 @@ begin (Pos('@main_exit', IR) >= 0) and (Pos('loadl $TFoo_FInst', IR) >= 0)); end; +procedure TStaticMembersSemTests.TestIR_StaticCall_InterfaceArg_NoLeadingComma; +{ A static method whose FIRST parameter is interface-typed must be CALLED with + a well-formed argument list: 'call $T_M(l obj, l itab)'. The interface arg + fragment carries a leading ', ' (it is normally appended after Self/a prior + arg); in a static call it is the first arg, so the codegen must strip that + comma — otherwise QBE rejects 'call $T_M(, l obj, l itab)' as an invalid + class specifier. } +const + Src = + ''' + program P; + type + IThing = interface + procedure Speak; + end; + TThing = class(IThing) + public + procedure Speak; + end; + THolder = class + public + static procedure SetIt(X: IThing); + end; + procedure TThing.Speak; + begin + end; + static procedure THolder.SetIt(X: IThing); + begin + end; + var T: TThing; + begin + T := TThing.Create(); + THolder.SetIt(T); + end. + '''; +var IR: string; CallPos: Integer; +begin + IR := GenIR(Src); + CallPos := Pos('call $THolder_SetIt(', IR); + AssertTrue('static interface-arg call emitted', CallPos >= 0); + { The call must not begin its argument list with a comma. } + AssertFalse('no leading comma in static interface-arg call', + Pos('call $THolder_SetIt(,', IR) >= 0); + AssertTrue('call passes obj+itab pair', + Pos('call $THolder_SetIt(l ', IR) >= 0); +end; + initialization RegisterTest(TStaticMembersParseTests); RegisterTest(TStaticMembersSemTests);