From 96514eeca49a9bd7bdacf39f194c2875bece70af Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Mon, 8 Jun 2026 17:25:23 +0100 Subject: [PATCH] fix(qbe): stop double-retaining ARC return values on assignment MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A function or method returning a String or dynamic array transfers a +1 reference to the caller (the callee AddRef'd on `Result := x` and did not release Result at scope exit). The string and dyn-array assignment branches nonetheless emitted an unconditional _StringAddRef / _DynArrayAddRef on the call result, so every `r := MakeString()` / `r := MakeArray()` leaked one buffer per call. Argument passing leaked the same way: a string/dyn-array call-result passed by value was never released after the call. Root cause: ExprOwnsRef — the helper that detects an already-owned +1 transient so the assignment site can skip the retain — was gated to tyClass only. For strings and dyn-arrays it always returned False, so the retain was never elided. This commit: * Broadens ExprOwnsRef to tyString and tyDynArray. The body logic (function/method/property-getter calls own +1; variable/field reads and casts are borrowed) is type-agnostic and already correct for these kinds. * Guards the AddRef with `if not ExprOwnsRef` in the string and dyn-array branches of variable assignment, var-param assignment, implicit-Self field assignment, and field assignment — mirroring the class branches. * Rewrites EmitOwnedArgReleases to dispatch the transient release on the argument's ARC kind (_StringRelease / _DynArrayRelease / _ClassRelease — the headers sit at different offsets, so a wrong-kind release corrupts the heap) and to skip const-string params, which are already balanced by EnsureConstStringRef + ReleaseConstStringArgs. Threads the param list through all call sites. The class field-assignment retain is deliberately left unconditional: some method calls return a borrowed class reference without an AddRef yet ExprOwnsRef reports them as owning, so guarding that retain would release a reference the field never acquired (a use-after-free the self-hosting compiler hits in its own codegen). That remaining transient leak is the safe direction and is tracked among the known-leak backlog. Verified: string-return leak 14MB->1.3MB, dyn-array-return leak 207MB->1.3MB, string-arg leak bounded, all at 100k iterations. Full suite OK (2668 tests), self-compile clean, FIXPOINT_OK. Adds four IR regression tests in cp.test.arc.pas asserting the call-result assignment elides the retain while a borrowed variable assignment still retains, for both String and dyn-array. --- compiler/src/main/pascal/uCodeGenQBE.pas | 86 +++++++++++--- compiler/src/test/pascal/cp.test.arc.pas | 140 +++++++++++++++++++++++ 2 files changed, 209 insertions(+), 17 deletions(-) diff --git a/compiler/src/main/pascal/uCodeGenQBE.pas b/compiler/src/main/pascal/uCodeGenQBE.pas index cba452d..90aad9a 100644 --- a/compiler/src/main/pascal/uCodeGenQBE.pas +++ b/compiler/src/main/pascal/uCodeGenQBE.pas @@ -243,7 +243,8 @@ type at scope exit, so the caller's temporary would otherwise leak. AArgs and AArgTemps are parallel: AArgTemps.Strings[i] is the temp for AArgs.Items[i], or '' if that arg was not a value temp (e.g. var param). } - procedure EmitOwnedArgReleases(AArgs: TObjectList; AArgTemps: TStringList); + procedure EmitOwnedArgReleases(AArgs: TObjectList; AArgTemps: TStringList; + AParams: TObjectList); { Caller-side retain/release for a const-string param. A const param skips the callee-side _StringAddRef/_StringRelease pair (see 5a5b5d4), so a fresh transient (rc=0 from _StringConcat or a function returning string) @@ -3517,7 +3518,16 @@ begin Result := False; if AExpr = nil then Exit; if AExpr.ResolvedType = nil then Exit; - if AExpr.ResolvedType.Kind <> tyClass then Exit; + { Ownership transfer applies to every ARC-managed return value, not just + classes: a function/method returning a String or dynamic array leaves + its Result at refcount +1 (the callee AddRef'd on `Result := x` and did + not release Result at scope exit). The caller's assignment site must + therefore NOT AddRef again — it consumes that transferred reference. + Without covering tyString/tyDynArray here the assignment branches below + emit a spurious _StringAddRef/_DynArrayAddRef on the call result, which + is never balanced and leaks one buffer per call. } + if not (AExpr.ResolvedType.Kind in [tyClass, tyDynArray]) + and not AExpr.ResolvedType.IsString() then Exit; if AExpr is TIdentExpr then begin IE := TIdentExpr(AExpr); @@ -3557,15 +3567,40 @@ begin end; procedure TCodeGenQBE.EmitOwnedArgReleases(AArgs: TObjectList; - AArgTemps: TStringList); + AArgTemps: TStringList; AParams: TObjectList); var I: Integer; + Arg: TASTExpr; + Par: TMethodParam; begin for I := 0 to AArgs.Count - 1 do begin if I >= AArgTemps.Count then Break; if AArgTemps.Strings[I] = '' then Continue; - if ExprOwnsRef(TASTExpr(AArgs.Items[I])) then + Arg := TASTExpr(AArgs.Items[I]); + if not ExprOwnsRef(Arg) then Continue; + Par := nil; + if (AParams <> nil) and (I < AParams.Count) then + Par := TMethodParam(AParams.Items[I]); + { The argument is a call result that already owns +1 and is passed by + value; release that transient after the call. Dispatch on the actual + ARC kind — _ClassRelease/_StringRelease/_DynArrayRelease read the + refcount at different header offsets (16/12/8 bytes), so releasing a + String or dyn-array via _ClassRelease would corrupt the heap. } + if Arg.ResolvedType = nil then + EmitLine(Format(' call $_ClassRelease(l %s)', [AArgTemps.Strings[I]])) + else if Arg.ResolvedType.IsString() then + begin + { Const-string params already balance the transient via + EnsureConstStringRef (AddRef before) + ReleaseConstStringArgs + (Release after). Emitting another release here would release the + same temporary twice and corrupt the heap, so skip it. } + if not ((Par <> nil) and Par.IsConstParam) then + EmitLine(Format(' call $_StringRelease(l %s)', [AArgTemps.Strings[I]])); + end + else if Arg.ResolvedType.Kind = tyDynArray then + EmitLine(Format(' call $_DynArrayRelease(l %s)', [AArgTemps.Strings[I]])) + else EmitLine(Format(' call $_ClassRelease(l %s)', [AArgTemps.Strings[I]])); end; end; @@ -3729,7 +3764,8 @@ begin begin OldTemp := AllocTemp(); EmitLine(Format(' %s =l loadl %s', [OldTemp, ObjTemp])); - EmitLine(Format(' call $_StringAddRef(l %s)', [ValTemp])); + if not ExprOwnsRef(AAssign.Expr) then + EmitLine(Format(' call $_StringAddRef(l %s)', [ValTemp])); EmitLine(Format(' call $_StringRelease(l %s)', [OldTemp])); end else if ISFld.TypeDesc.Kind = tyClass then @@ -3880,7 +3916,8 @@ begin OldTemp := AllocTemp(); EmitLine(Format(' %s =l loadl %s', [OldTemp, PtrTemp])); ValTemp := EmitExpr(AAssign.Expr); - EmitLine(Format(' call $_StringAddRef(l %s)', [ValTemp])); + if not ExprOwnsRef(AAssign.Expr) then + EmitLine(Format(' call $_StringAddRef(l %s)', [ValTemp])); EmitLine(Format(' call $_StringRelease(l %s)', [OldTemp])); EmitLine(Format(' storel %s, %s', [ValTemp, PtrTemp])); end @@ -3965,7 +4002,8 @@ begin else EmitLine(Format(' %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); ValTemp := EmitExpr(AAssign.Expr); - EmitLine(Format(' call $_StringAddRef(l %s)', [ValTemp])); + if not ExprOwnsRef(AAssign.Expr) then + EmitLine(Format(' call $_StringAddRef(l %s)', [ValTemp])); EmitLine(Format(' call $_StringRelease(l %s)', [OldTemp])); if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %%_var_%s =l copy %s', [AAssign.Name, ValTemp])) @@ -3984,7 +4022,8 @@ begin else EmitLine(Format(' %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); ValTemp := EmitExpr(AAssign.Expr); - EmitLine(Format(' call $_DynArrayAddRef(l %s)', [ValTemp])); + if not ExprOwnsRef(AAssign.Expr) then + EmitLine(Format(' call $_DynArrayAddRef(l %s)', [ValTemp])); EmitLine(Format(' call $_DynArrayRelease(l %s)', [OldTemp])); if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %%_var_%s =l copy %s', [AAssign.Name, ValTemp])) @@ -4975,18 +5014,31 @@ begin old field contents before overwriting, so neither reference leaks. } OldTemp := AllocTemp(); EmitLine(Format(' %s =l loadl %s', [OldTemp, Ptr])); + { When the RHS already owns +1 (a function/method/property-getter call + result), the field consumes that transferred reference and must NOT + AddRef again — otherwise the buffer/object leaks one reference per + store. The old field contents are released unconditionally. } if IsStr then begin - EmitLine(Format(' call $_StringAddRef(l %s)', [ValTemp])); + if not ExprOwnsRef(AAssign.Expr) then + EmitLine(Format(' call $_StringAddRef(l %s)', [ValTemp])); EmitLine(Format(' call $_StringRelease(l %s)', [OldTemp])); end else if AAssign.FieldInfo.TypeDesc.Kind = tyDynArray then begin - EmitLine(Format(' call $_DynArrayAddRef(l %s)', [ValTemp])); + if not ExprOwnsRef(AAssign.Expr) then + EmitLine(Format(' call $_DynArrayAddRef(l %s)', [ValTemp])); EmitLine(Format(' call $_DynArrayRelease(l %s)', [OldTemp])); end else begin + { Class field keeps an unconditional retain. ExprOwnsRef-guarding this + is unsafe: some method calls return a borrowed class reference without + an AddRef (ExprOwnsRef reports them as owning), so skipping the retain + would release a reference the field never acquired — a heap-corrupting + use-after-free that the self-hosting compiler hits in its own codegen. + The transient-leak this leaves for genuine +1 class returns assigned to + a field is the safe direction and matches long-standing behaviour. } EmitLine(Format(' call $_ClassAddRef(l %s)', [ValTemp])); EmitLine(Format(' call $_ClassRelease(l %s)', [OldTemp])); end; @@ -5207,7 +5259,7 @@ begin EmitLine(Format(' %s =l add %s, %d', [ArgTemp, VTblTemp, SlotOff])); EmitLine(Format(' %s =l loadl %s', [FPtrTemp, ArgTemp])); EmitLine(Format(' call %s(%s)', [FPtrTemp, ArgLine])); - EmitOwnedArgReleases(ACall.Args, ArgTemps); + EmitOwnedArgReleases(ACall.Args, ArgTemps, MDecl.Params); ReleaseConstStringArgs(ACall.Args, ArgTemps, MDecl.Params); ArgTemps.Free(); { Receiver was a +1-owned temporary (function/property return) used @@ -5221,7 +5273,7 @@ begin else FuncName := '$' + MethodEmitName(MDecl, RT.Name, ACall.Name); EmitLine(Format(' call %s(%s)', [FuncName, ArgLine])); - EmitOwnedArgReleases(ACall.Args, ArgTemps); + EmitOwnedArgReleases(ACall.Args, ArgTemps, MDecl.Params); ReleaseConstStringArgs(ACall.Args, ArgTemps, MDecl.Params); ArgTemps.Free(); if ExprOwnsRef(ACall.ObjExpr) then @@ -5410,7 +5462,7 @@ begin FuncName := '$' + MethodEmitName(MDecl, RT.Name, ACall.Name); EmitLine(Format(' call %s(%s)', [FuncName, ArgLine])); end; - EmitOwnedArgReleases(ACall.Args, ArgTemps); + EmitOwnedArgReleases(ACall.Args, ArgTemps, MDecl.Params); ReleaseConstStringArgs(ACall.Args, ArgTemps, MDecl.Params); finally ArgTemps.Free(); @@ -6975,7 +7027,7 @@ begin EmitLine(Format(' call $%s(%s)', [QBEMangle(MDecl.ResolvedQbeName), ArgLine])) else EmitLine(Format(' call $%s(%s)', [QBEMangle(ACall.Name), ArgLine])); - EmitOwnedArgReleases(ACall.Args, ArgTemps); + EmitOwnedArgReleases(ACall.Args, ArgTemps, MDecl.Params); ReleaseConstStringArgs(ACall.Args, ArgTemps, MDecl.Params); finally ArgTemps.Free(); @@ -8709,7 +8761,7 @@ begin end; T := AllocTemp(); EmitLine(Format(' %s =%s call %s(%s)', [T, QType, FuncName, ArgLine])); - EmitOwnedArgReleases(FC.Args, ArgTemps); + EmitOwnedArgReleases(FC.Args, ArgTemps, MDecl.Params); ReleaseConstStringArgs(FC.Args, ArgTemps, MDecl.Params); Result := MaybeNormalizeExtReturn(T, MDecl); finally @@ -8895,7 +8947,7 @@ begin else FuncName := '$' + MethodEmitName(MDecl, RT.Name, MCallExpr.Name); EmitLine(Format(' call %s(%s)', [FuncName, ArgLine])); - EmitOwnedArgReleases(MCallExpr.Args, ArgTemps); + EmitOwnedArgReleases(MCallExpr.Args, ArgTemps, MDecl.Params); ReleaseConstStringArgs(MCallExpr.Args, ArgTemps, MDecl.Params); finally ArgTemps.Free(); @@ -9065,7 +9117,7 @@ begin end else EmitLine(Format(' %s =%s call %s(%s)', [T, QType, FuncName, ArgLine])); - EmitOwnedArgReleases(MCallExpr.Args, ArgTemps); + EmitOwnedArgReleases(MCallExpr.Args, ArgTemps, MDecl.Params); ReleaseConstStringArgs(MCallExpr.Args, ArgTemps, MDecl.Params); ArgTemps.Free(); { Receiver was a +1-owned temporary (function/property return) used as diff --git a/compiler/src/test/pascal/cp.test.arc.pas b/compiler/src/test/pascal/cp.test.arc.pas index 89998dc..cca2a5c 100644 --- a/compiler/src/test/pascal/cp.test.arc.pas +++ b/compiler/src/test/pascal/cp.test.arc.pas @@ -90,6 +90,15 @@ type { Pointer-to-class coercion: assigning a Pointer-typed expression to a class-typed variable must emit _ClassAddRef (the LHS is ARC-managed). } procedure TestARC_PointerToClass_AssignEmitsAddRef; + + { Return-value ownership transfer: a string/dyn-array function result + already owns +1, so assigning it to a variable must NOT emit a second + AddRef (that spurious retain leaks one buffer per call). Assigning a + plain variable (borrowed) still retains. } + procedure TestARC_StringAssignFromCall_NoSpuriousAddRef; + procedure TestARC_StringAssignFromVar_StillAddRef; + procedure TestARC_DynArrayAssignFromCall_NoSpuriousAddRef; + procedure TestARC_DynArrayAssignFromVar_StillAddRef; end; implementation @@ -801,6 +810,137 @@ begin Pos('call $_ClassAddRef', FnBody) > 0); end; +{ ------------------------------------------------------------------ } +{ Return-value ownership transfer (string / dyn-array) } +{ ------------------------------------------------------------------ } + +const + { Caller does `r := Make()` where Make returns a string. Make's Result + already owns +1, so the assignment must NOT AddRef again. The callee + Make emits its own _StringAddRef calls, so the assertion scopes to the + caller (Run) function body. } + SrcStringAssignFromCall = + ''' + program P; + function Make: string; + begin + Result := 'x' + end; + procedure Run; + var r: string; + begin + r := Make() + end; + begin + Run + end. + '''; + + { Caller does `b := a` between two string variables. `a` is borrowed, so + the assignment MUST AddRef. } + SrcStringAssignFromVar = + ''' + program P; + procedure Run; + var a, b: string; + begin + a := 'x'; + b := a + end; + begin + Run + end. + '''; + + SrcDynArrayAssignFromCall = + ''' + program P; + type TIntArr = array of Integer; + function Make: TIntArr; + var a: TIntArr; + begin + SetLength(a, 1); + Result := a + end; + procedure Run; + var r: TIntArr; + begin + r := Make() + end; + begin + Run + end. + '''; + + SrcDynArrayAssignFromVar = + ''' + program P; + type TIntArr = array of Integer; + procedure Run; + var a, b: TIntArr; + begin + SetLength(a, 1); + b := a + end; + begin + Run + end. + '''; + +function CallerBody(const AIR: string): string; +var + P: Integer; +begin + { Return the IR of the Run procedure (the caller), excluding the callee + Make whose own AddRef/Release calls would confuse the assertion. } + P := Pos('function $Run', AIR); + if P <= 0 then + P := Pos('$Run(', AIR); + if P <= 0 then + Exit(AIR); + Result := Copy(AIR, P, Length(AIR) - P + 1); +end; + +procedure TARCTests.TestARC_StringAssignFromCall_NoSpuriousAddRef; +var + Body: string; +begin + Body := CallerBody(GenIR(SrcStringAssignFromCall)); + AssertTrue('string call-result assignment does not AddRef the transient', + Pos('call $_StringAddRef', Body) <= 0); + AssertTrue('old slot is still released', + Pos('call $_StringRelease', Body) > 0); +end; + +procedure TARCTests.TestARC_StringAssignFromVar_StillAddRef; +var + Body: string; +begin + Body := CallerBody(GenIR(SrcStringAssignFromVar)); + AssertTrue('borrowed string variable assignment still AddRefs', + Pos('call $_StringAddRef', Body) > 0); +end; + +procedure TARCTests.TestARC_DynArrayAssignFromCall_NoSpuriousAddRef; +var + Body: string; +begin + Body := CallerBody(GenIR(SrcDynArrayAssignFromCall)); + AssertTrue('dyn-array call-result assignment does not AddRef the transient', + Pos('call $_DynArrayAddRef', Body) <= 0); + AssertTrue('old slot is still released', + Pos('call $_DynArrayRelease', Body) > 0); +end; + +procedure TARCTests.TestARC_DynArrayAssignFromVar_StillAddRef; +var + Body: string; +begin + Body := CallerBody(GenIR(SrcDynArrayAssignFromVar)); + AssertTrue('borrowed dyn-array variable assignment still AddRefs', + Pos('call $_DynArrayAddRef', Body) > 0); +end; + initialization RegisterTest(TARCTests);