From 175a5cc69269a4719dd5f86f9538c215f9682821 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 24 Jun 2026 17:15:46 +0100 Subject: [PATCH] fix(codegen): self-assigned record method no longer aliases Self (M := M.Method()) Assigning a record-returning method's result back into the same variable that is the receiver (M := M.Method(...)) corrupted the computation: the sret destination buffer aliased Self, so the callee wrote Result (== Self) while still reading Self, clobbering it mid-flight. Affected both backends. Both backends now detect the case where the call's receiver is exactly the destination variable and route the sret call through a fresh zeroed temporary, moving the constructed result into the destination (release old managed fields, raw ownership-transfer memcpy) only after the call returns. Adds an IR unit test (RoutesThroughTemp) and two e2e tests (managed-string field and scalar fields) covering the self-assign and a non-aliasing regression guard. --- .../pascal/blaise.codegen.native.x86_64.pas | 65 +++++++++++++++++++ .../src/main/pascal/blaise.codegen.qbe.pas | 48 +++++++++++++- .../src/test/pascal/cp.test.e2e.recordret.pas | 62 ++++++++++++++++++ .../src/test/pascal/cp.test.recordret.pas | 32 +++++++++ 4 files changed, 206 insertions(+), 1 deletion(-) 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 51c737e..ed58a41 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -436,6 +436,13 @@ type function SretUserSlots(ADecl: TMethodDecl; AArgs: TObjectList): Integer; { True when AExpr is a record-returning function or method call. } function IsNativeRecordCall(AExpr: TASTExpr): Boolean; + { True when AExpr is a record-method call whose receiver is exactly the + variable AName/AIsGlobal — i.e. M := M.Method(...) would have the sret + destination alias Self. Such an assignment must route the result through + a fresh temporary first. } + function RecordCallReceiverIsVar(AExpr: TASTExpr; + const AName: string; + AIsGlobal: Boolean): Boolean; { Sret a record-returning call (function or method) into ADest. } procedure EmitRecordCallSretAt(AExpr: TASTExpr; const ADest: string); { Sret call for a TFuncCallExpr: routes an implicit-Self method through the @@ -4413,6 +4420,23 @@ begin Exit(True); end; +function TX86_64Backend.RecordCallReceiverIsVar(AExpr: TASTExpr; + const AName: string; AIsGlobal: Boolean): Boolean; +var + MCall: TMethodCallExpr; + MDecl: TMethodDecl; +begin + Result := False; + if not (AExpr is TMethodCallExpr) then Exit; + MCall := TMethodCallExpr(AExpr); + if MCall.ResolvedMethod = nil then Exit; + MDecl := TMethodDecl(MCall.ResolvedMethod); + if not MDecl.IsRecordMethod then Exit; + { Only a bare variable receiver (M.Method) can alias the destination var. } + if MCall.ObjExpr <> nil then Exit; + Result := (MCall.ObjectName = AName) and (MCall.IsGlobal = AIsGlobal); +end; + { Emit an sret (record/jumbo-set/static-array-returning) call for a TFuncCallExpr. An implicit-Self method is routed through EmitMethodSretCall (which passes Self and vtable-dispatches a virtual method); a free function @@ -10533,6 +10557,7 @@ var PCUserSlots, PCTotalSlots, PCOverflow, PCCleanUp, PCAllocSz, PCDest: Integer; PCHD, PCHK: TList; PCHTotal: Integer; + AliasBuf: Integer; begin Self.DbgStmtLabel(AStmt); if AStmt is TAssignment then @@ -10803,6 +10828,46 @@ begin [tyRecord, tyStaticArray]) or IsJumboSet(TMethodDecl(TMethodCallExpr(Asgn.Expr).ResolvedMethod).ResolvedReturnType)) then begin + { Self-assigned record method (M := M.Method(...)): the sret destination + would alias the receiver, so the callee would clobber Self while still + reading it. Route the call through a fresh zeroed stack buffer (address + held in callee-saved %r14), then move the result into the destination + (release old fields, raw memcpy — ownership of the constructed managed + fields transfers). } + if (Asgn.ResolvedLhsType.Kind = tyRecord) and + Self.RecordCallReceiverIsVar(Asgn.Expr, Asgn.Name, Asgn.IsGlobal) then + begin + AliasBuf := (TRecordTypeDesc(Asgn.ResolvedLhsType).TotalSize() + 15) and (-16); + Self.Emit(#9'pushq %r14'); + Self.Emit(Format(#9'subq $%d, %%rsp', [AliasBuf])); + Self.Emit(#9'movq %rsp, %r14'); + Self.Emit(#9'movq %r14, %rdi'); + Self.Emit(#9'xorl %esi, %esi'); + Self.Emit(Format(#9'movq $%d, %%rdx', + [TRecordTypeDesc(Asgn.ResolvedLhsType).TotalSize()])); + Self.Emit(#9'callq memset'); + Self.EmitMethodSretCall(TMethodCallExpr(Asgn.Expr), '(%r14)', False); + { %r14 still holds the temp buffer address (callee-saved across the call). + Resolve the destination address into %rbx, release its old managed + fields, then memcpy the constructed result over it. } + Self.Emit(#9'pushq %rbx'); + if Asgn.IsVarParam then + Self.Emit(Format(#9'movq %s, %%rbx', [Self.VarOperand(Asgn.Name)])) + else if Self.IsLocal(Asgn.Name) then + Self.Emit(Format(#9'leaq %s, %%rbx', [Self.VarOperand(Asgn.Name)])) + else + Self.EmitLeaqGlobal(Asgn.Name, '%rbx'); + Self.EmitRecordFieldReleases(TRecordTypeDesc(Asgn.ResolvedLhsType), '%rbx'); + Self.Emit(#9'movq %rbx, %rdi'); + Self.Emit(#9'movq %r14, %rsi'); + Self.Emit(Format(#9'movq $%d, %%rdx', + [TRecordTypeDesc(Asgn.ResolvedLhsType).TotalSize()])); + Self.Emit(#9'callq memcpy'); + Self.Emit(#9'popq %rbx'); + Self.Emit(Format(#9'addq $%d, %%rsp', [AliasBuf])); + Self.Emit(#9'popq %r14'); + Exit; + end; if FSretFunc and SameText(Asgn.Name, 'Result') then Self.EmitMethodSretCall(TMethodCallExpr(Asgn.Expr), Self.VarOperand('Result'), True) diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index f76579f..e7a2f2d 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -434,6 +434,13 @@ type { Returns True if AExpr is a function or method call that returns a record. Used in EmitAssignment to choose the sret path over a storel. } function IsRecordCall(AExpr: TASTExpr): Boolean; + { Returns True if AExpr is a record-method call whose receiver is exactly + the variable AName/AIsGlobal. Such a call assigned back into its own + receiver (M := M.Method(...)) would have the sret destination alias Self, + so the assignment must route the result through a fresh temporary. } + function RecordCallReceiverIsVar(AExpr: TASTExpr; + const AName: string; + AIsGlobal: Boolean): Boolean; { Returns True if AExpr is a function or method call that returns an interface. Used in EmitAssignment to choose the sret path. } function IsInterfaceCall(AExpr: TASTExpr): Boolean; @@ -4333,7 +4340,27 @@ begin (AAssign.ResolvedLhsType.Kind = tyRecord) then begin ClassRT := TRecordTypeDesc(AAssign.ResolvedLhsType); - if IsRecordCall(AAssign.Expr) then + if IsRecordCall(AAssign.Expr) and + RecordCallReceiverIsVar(AAssign.Expr, AAssign.Name, AAssign.IsGlobal) then + begin + { Self-assigned record method (M := M.Method(...)): the sret destination + would alias the receiver, so the callee would clobber Self while still + reading it. Route the call through a fresh zeroed temporary, then move + the constructed result into the destination (release old fields, raw + memcpy — ownership of the constructed managed fields transfers). } + SretBuf := AllocTemp(); + if ClassRT.MaxAlign() >= 8 then + EmitLine(Format(' %s =l alloc8 %d', [SretBuf, ClassRT.TotalSize()])) + else + EmitLine(Format(' %s =l alloc4 %d', [SretBuf, ClassRT.TotalSize()])); + EmitLine(Format(' call $memset(l %s, w 0, l %d)', + [SretBuf, ClassRT.TotalSize()])); + EmitRecordCallSret(AAssign.Expr, SretBuf); + EmitRecordReleaseFields(ClassRT, VarRef(AAssign.Name, AAssign.IsGlobal)); + EmitLine(Format(' call $memcpy(l %s, l %s, l %d)', + [VarRef(AAssign.Name, AAssign.IsGlobal), SretBuf, ClassRT.TotalSize()])); + end + else if IsRecordCall(AAssign.Expr) then begin EmitRecordReleaseFields(ClassRT, VarRef(AAssign.Name, AAssign.IsGlobal)); EmitLine(Format(' call $memset(l %s, w 0, l %d)', @@ -4953,6 +4980,25 @@ begin end; end; +function TCodeGenQBE.RecordCallReceiverIsVar(AExpr: TASTExpr; + const AName: string; AIsGlobal: Boolean): Boolean; +var + MCall: TMethodCallExpr; + MDecl: TMethodDecl; +begin + Result := False; + if not (AExpr is TMethodCallExpr) then Exit; + MCall := TMethodCallExpr(AExpr); + if MCall.ResolvedMethod = nil then Exit; + MDecl := TMethodDecl(MCall.ResolvedMethod); + if not MDecl.IsRecordMethod then Exit; + { Only a bare variable receiver (M.Method) can alias the destination var. + A receiver via ObjExpr (a more complex l-value) is handled conservatively + as non-aliasing here; the explicit-var case is the documented bug. } + if MCall.ObjExpr <> nil then Exit; + Result := (MCall.ObjectName = AName) and (MCall.IsGlobal = AIsGlobal); +end; + function TCodeGenQBE.IsInterfaceCall(AExpr: TASTExpr): Boolean; var MDecl: TMethodDecl; diff --git a/compiler/src/test/pascal/cp.test.e2e.recordret.pas b/compiler/src/test/pascal/cp.test.e2e.recordret.pas index 45480f9..5c3de66 100644 --- a/compiler/src/test/pascal/cp.test.e2e.recordret.pas +++ b/compiler/src/test/pascal/cp.test.e2e.recordret.pas @@ -97,6 +97,14 @@ type procedure TestRun_ChainedRecvManyArgs; procedure TestRun_ChainedRecvDoubleChain; procedure TestRun_ChainedRecvManagedRecord_TDecimalLike; + { Regression: a record-returning method assigned back into the SAME variable + that is its receiver (M := M.Method(...)). The sret destination buffer + would alias Self, so the callee wrote Result (== Self) while still reading + Self — clobbering it mid-flight. Fix routes the call through a fresh temp + and moves the result into the destination only after the call returns. + Both backends; managed (string) and scalar fields both checked. } + procedure TestRun_SelfAssignRecordMethod_ManagedField; + procedure TestRun_SelfAssignRecordMethod_ScalarFields; { Regression: a record-returning method that takes an INTERFACE parameter. An interface is a fat pointer (obj + itab) occupying TWO integer-register slots, but the native sret/record call paths popped one register per @@ -779,6 +787,60 @@ begin AssertRunsOnAll(Src, '15' + LE + '25' + LE, 0); end; +procedure TE2ERecordReturnTests.TestRun_SelfAssignRecordMethod_ManagedField; +const + { Managed (string) field record method assigned back into its own receiver. + The non-aliasing case (C := A.Up(B)) and the receiver staying intact after + the self-assign are both checked as regression guards. } + Src = ''' + program P; + type + TR = record + S: string; + function Up(const X: TR): TR; + end; + function TR.Up(const X: TR): TR; + begin Result.S := Self.S + X.S end; + var A, B, C: TR; + begin + A.S := 'a'; B.S := 'b'; + A := A.Up(B); + WriteLn(A.S); + C := A.Up(B); + WriteLn(C.S); + WriteLn(A.S) + end. + '''; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(Src, 'ab' + LE + 'abb' + LE + 'ab' + LE, 0); +end; + +procedure TE2ERecordReturnTests.TestRun_SelfAssignRecordMethod_ScalarFields; +const + { Two-integer record (register-return class) self-assigned through its own + receiver. } + Src = ''' + program P; + type + TR = record + A, B: Integer; + function Add(const X: TR): TR; + end; + function TR.Add(const X: TR): TR; + begin Result.A := Self.A + X.A; Result.B := Self.B + X.B end; + var R, Q: TR; + begin + R.A := 1; R.B := 10; Q.A := 2; Q.B := 20; + R := R.Add(Q); + WriteLn(R.A, ' ', R.B) + end. + '''; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(Src, '3 30' + LE, 0); +end; + { ------------------------------------------------------------------ } { Record-returning method with an interface (fat-pointer) parameter } { ------------------------------------------------------------------ } diff --git a/compiler/src/test/pascal/cp.test.recordret.pas b/compiler/src/test/pascal/cp.test.recordret.pas index 21b85a2..e936d0b 100644 --- a/compiler/src/test/pascal/cp.test.recordret.pas +++ b/compiler/src/test/pascal/cp.test.recordret.pas @@ -75,6 +75,11 @@ type procedure TestCodegen_IntegerPlusDouble_UsesIntSSE; procedure TestCodegen_DoublePlusInt64_UsesSSEInt; procedure TestCodegen_Int64PlusDouble_UsesIntSSE; + { Self-assigned record method (M := M.Method(...)): the sret destination must + NOT be the receiver variable — the call writes into a fresh temp buffer + that is then memcpy'd into the destination, so the callee sees an intact + Self while constructing Result. } + procedure TestCodegen_SelfAssignRecordMethod_RoutesThroughTemp; end; implementation @@ -779,6 +784,33 @@ begin AssertContains('type :_ffi_TM = align 8 { l, d }', IR); end; +procedure TRecordReturnTests.TestCodegen_SelfAssignRecordMethod_RoutesThroughTemp; +var IR: string; +begin + IR := GenIR( + ''' + program P; + type + TR = record + S: string; + function Up(const X: TR): TR; + end; + function TR.Up(const X: TR): TR; + begin Result.S := Self.S + X.S end; + var A, B: TR; + begin + A.S := 'a'; B.S := 'b'; + A := A.Up(B) + end. + '''); + { The sret call must target a fresh temp (%_t...), not the destination $A — + otherwise the sret buffer aliases Self. } + AssertFalse('sret call aliases receiver $A', + Pos('call $TR_Up(l $A,', IR) <> -1); + { The constructed result is then moved into the destination. } + AssertContains('call $memcpy(l $A,', IR); +end; + initialization RegisterTest(TRecordReturnTests);