From 91b7354c8f28e6eee43fc2c911e7196f7a5b34cf Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Fri, 19 Jun 2026 17:33:39 +0100 Subject: [PATCH] fix(native): SetLength(A, N) must evaluate N before loading the array pointer MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The native dynamic-array SetLength lowering loaded the array's current data pointer into %rdi (the first argument to _DynArraySetLength) BEFORE evaluating the new-length expression. When that expression itself emitted a call — most commonly SetLength(Result, Length(A)), where Length(A) lowers to a _DynArrayLength call — the call clobbered %rdi, so _DynArraySetLength resized the wrong array (the length-expression's operand) instead of the intended one. The visible symptom: a function taking a dynamic-array parameter and returning a dynamic array had its Result aliased to the first array parameter's buffer. SetLength(Result, Length(A)) resized A instead of Result, every Result[I] write was lost, and the caller got back the first argument unchanged. QBE was correct throughout; this was a native-only parity divergence. Fix: evaluate the length expression into %esi first, then load the array pointer into %rdi immediately before the call — matching the safe ordering the string and field-receiver SetLength paths already used. Adds five e2e regression tests (cp.test.e2e.dynarray.pas) covering the result- from-param-length case, the const-array-param subtract, global-from-global length, local-from-local length, and length-from-a-user-function-call. All run on both backends via AssertRunsOnAll; the native arm would have failed before this fix. This closes a test-coverage gap: no existing test exercised a SetLength whose length argument emitted a call. --- .../pascal/blaise.codegen.native.x86_64.pas | 11 +- .../src/test/pascal/cp.test.e2e.dynarray.pas | 127 ++++++++++++++++++ 2 files changed, 134 insertions(+), 4 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 2ea3f18..49243c8 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -10573,14 +10573,17 @@ begin FDynArgName := TIdentExpr(TASTExpr(PC.Args.Items[0])).Name; FDynElemSz := TDynArrayTypeDesc(TASTExpr(PC.Args.Items[0]).ResolvedType).ElementType.RawSize(); - { Load current data ptr into %rdi. } + { Evaluate the new-length expression FIRST. It may itself emit a call + (e.g. SetLength(Result, Length(A)) lowers Length(A) to a + _DynArrayLength call) which clobbers %rdi, so the array pointer must + be loaded into %rdi only after this expression is fully evaluated. } + Self.EmitExprToEax(TASTExpr(PC.Args.Items[1])); + Self.Emit(#9'movl %eax, %esi'); + { Load current data ptr into %rdi (after N is evaluated). } if Self.IsLocal(FDynArgName) then Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand(FDynArgName)])) else Self.Emit(Format(#9'movq %s(%%rip), %%rdi', [FDynArgName])); - { New length into %esi. } - Self.EmitExprToEax(TASTExpr(PC.Args.Items[1])); - Self.Emit(#9'movl %eax, %esi'); { Element size into %edx. } Self.Emit(Format(#9'movl $%d, %%edx', [FDynElemSz])); Self.Emit(#9'callq _DynArraySetLength'); diff --git a/compiler/src/test/pascal/cp.test.e2e.dynarray.pas b/compiler/src/test/pascal/cp.test.e2e.dynarray.pas index 8ec0f80..533654c 100644 --- a/compiler/src/test/pascal/cp.test.e2e.dynarray.pas +++ b/compiler/src/test/pascal/cp.test.e2e.dynarray.pas @@ -37,6 +37,16 @@ type procedure TestRun_ChainedWrite_Int2D; procedure TestRun_ChainedWrite_String2D; procedure TestRun_ChainedWrite_Int3D; + { SetLength(dest, Length(src)) where the length sub-expression itself + emits a call (_DynArrayLength) — must not clobber the dest pointer + register before the resize call. Regression for the native backend + Result-aliases-param bug: writes to Result[i] were lost because + SetLength resized the parameter, not Result. } + procedure TestRun_SetLengthResultFromParamLength; + procedure TestRun_DiffOfConstArrayParams; + procedure TestRun_SetLengthGlobalFromGlobalLength; + procedure TestRun_SetLengthLocalFromLocalLength; + procedure TestRun_SetLengthFromUserFuncCall; end; implementation @@ -148,6 +158,93 @@ const end. '''; + { SetLength(Result, Length(A)) inside a dynarray-returning function whose + parameter is also a dynarray. Stores a constant 7 — output must be 7, + not A[0] (=5). This is the minimal native Result-aliases-param repro. } + SrcResultFromParamLen = ''' + program Prg; + type TA = array of UInt32; + function F(const A, B: TA): TA; + var I: Integer; + begin + SetLength(Result, Length(A)); + I := 0; + while I < Length(A) do begin Result[I] := 7; I := I + 1 end; + end; + var X, Y, Z: TA; + begin + SetLength(X, 1); X[0] := 5; + SetLength(Y, 1); Y[0] := 3; + Z := F(X, Y); + WriteLn(Z[0]) + end. + '''; + + { The original symptom: store the difference of two indexed const-array-param + loads. Result[0] must be 2 (=5-3), not 5. } + SrcDiffConstParams = ''' + program Prg; + type TA = array of UInt32; + function Diff(const A, B: TA): TA; + var I: Integer; + begin + SetLength(Result, Length(A)); + I := 0; + while I < Length(A) do begin Result[I] := A[I] - B[I]; I := I + 1 end; + end; + var R, X, Y: TA; + begin + SetLength(X, 1); X[0] := 5; + SetLength(Y, 1); Y[0] := 3; + R := Diff(X, Y); + WriteLn(R[0]) + end. + '''; + + { Global-array target: SetLength(G, Length(H)) at program scope exercises + the global (%rip-relative) store-back path, not the local one. } + SrcGlobalFromGlobalLen = ''' + program Prg; + var G, H: array of Integer; I: Integer; + begin + SetLength(H, 4); + for I := 0 to 3 do H[I] := I + 1; + SetLength(G, Length(H)); + for I := 0 to High(G) do G[I] := 9; + for I := 0 to High(G) do Write(G[I]); + WriteLn + end. + '''; + + { Two local arrays: SetLength(A, Length(B)) where B is a local — the length + call must not clobber A's pointer before the resize. } + SrcLocalFromLocalLen = ''' + program Prg; + var A, B: array of Integer; I: Integer; + begin + SetLength(B, 3); + SetLength(A, Length(B)); + for I := 0 to High(A) do A[I] := 8; + for I := 0 to High(A) do Write(A[I]); + WriteLn + end. + '''; + + { Length expression is a user-function call (the most general rdi-clobber): + SetLength(A, Pick()) where Pick() returns an Integer via its own call. } + SrcFromUserFuncCall = ''' + program Prg; + var A: array of Integer; I: Integer; + function Pick: Integer; + begin Result := 3 end; + begin + SetLength(A, Pick()); + for I := 0 to High(A) do A[I] := 6; + for I := 0 to High(A) do Write(A[I]); + WriteLn + end. + '''; + procedure TE2EDynArrayTests.TestRun_SetLengthFillSum; begin if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; @@ -214,6 +311,36 @@ begin AssertRunsOnAll(SrcChainedInt3D, '01234567' + LE, 0); end; +procedure TE2EDynArrayTests.TestRun_SetLengthResultFromParamLength; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcResultFromParamLen, '7' + LE, 0); +end; + +procedure TE2EDynArrayTests.TestRun_DiffOfConstArrayParams; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcDiffConstParams, '2' + LE, 0); +end; + +procedure TE2EDynArrayTests.TestRun_SetLengthGlobalFromGlobalLength; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcGlobalFromGlobalLen, '9999' + LE, 0); +end; + +procedure TE2EDynArrayTests.TestRun_SetLengthLocalFromLocalLength; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcLocalFromLocalLen, '888' + LE, 0); +end; + +procedure TE2EDynArrayTests.TestRun_SetLengthFromUserFuncCall; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcFromUserFuncCall, '666' + LE, 0); +end; + initialization RegisterTest(TE2EDynArrayTests);