From 62331de98636783095d89a7ebebc620b7b78d972 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Sat, 20 Jun 2026 09:34:19 +0100 Subject: [PATCH] fix(qbe): record copy must use field-width loads/stores MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit EmitRecordCopy copied every non-managed scalar field with loadw/storew (or loadl/storel), ignoring the field's actual width. A sub-word field — Boolean or Byte (1 byte), SmallInt or Word (2 bytes) — was therefore stored with a 4-byte storew that overran into the following field. When a Boolean sat immediately before a managed (string / class / dynarray) field, the wide store clobbered the low bytes of that pointer; the subsequent _StringRelease / _DynArrayRelease then dereferenced a garbage address and crashed. This is exactly TDecimal's layout (FNegative/FInflated Booleans ahead of a carrier with a managed field), so it blocked Numerics.Money on QBE: MakeMoney rounds into a TDecimal local and stores it into TMoney.FAmount, copying the record by value. The native backend was always width-correct. Fix: route scalar field copies through LoadInstrFor/StoreInstrFor (the same width-correct helpers already used for element and variable loads), and copy inline aggregate fields (static array / jumbo-set bitmap) with memcpy. Regression test in cp.test.e2e.records.pas reproduces the TDecimal-shaped layout (Boolean flags before a string field, copied through an sret Result field) and asserts QBE/native parity via AssertRunsOnAll. Verified: FIXPOINT_OK, NATIVE_FIXPOINT_OK, NATIVE_INTERNAL_OK; full suite green on both the QBE-built and native-built runners (3625 tests). --- .../src/main/pascal/blaise.codegen.qbe.pas | 21 +++++++--- .../src/test/pascal/cp.test.e2e.records.pas | 39 +++++++++++++++++++ 2 files changed, 54 insertions(+), 6 deletions(-) diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index 1f92d1c..812083d 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -5051,17 +5051,26 @@ begin else if F.TypeDesc.Kind = tyRecord then { Nested record field: recurse into sub-fields } Self.EmitRecordCopy(TRecordTypeDesc(F.TypeDesc), DstField, SrcField) - else if QbeTypeOf(F.TypeDesc) = 'w' then + else if (F.TypeDesc.Kind = tyStaticArray) or + ((F.TypeDesc.Kind = tySet) and (F.TypeDesc.RawSize() > 8)) then begin - ValTemp := AllocTemp(); - EmitLine(Format(' %s =w loadw %s', [ValTemp, SrcField])); - EmitLine(Format(' storew %s, %s', [ValTemp, DstField])); + { Inline aggregate field (fixed-size array / jumbo-set bitmap): copy the + raw bytes — there is no single scalar load/store width. } + EmitLine(Format(' call $memcpy(l %s, l %s, l %d)', + [DstField, SrcField, F.TypeDesc.RawSize()])); end else begin + { Scalar field: use the width-correct load/store so a sub-word field + (Boolean/Byte = 1 byte, SmallInt/Word = 2 bytes) does NOT over-write + the adjacent field. Using loadw/storew unconditionally corrupted the + next field (e.g. a Boolean at offset 21 clobbering a string pointer at + offset 24), which surfaced as a double-free in _StringRelease. } ValTemp := AllocTemp(); - EmitLine(Format(' %s =l loadl %s', [ValTemp, SrcField])); - EmitLine(Format(' storel %s, %s', [ValTemp, DstField])); + EmitLine(Format(' %s =%s %s %s', + [ValTemp, QbeTypeOf(F.TypeDesc), Self.LoadInstrFor(F.TypeDesc), SrcField])); + EmitLine(Format(' %s %s, %s', + [Self.StoreInstrFor(F.TypeDesc), ValTemp, DstField])); end; end; end; diff --git a/compiler/src/test/pascal/cp.test.e2e.records.pas b/compiler/src/test/pascal/cp.test.e2e.records.pas index d2d60b6..43efd7b 100644 --- a/compiler/src/test/pascal/cp.test.e2e.records.pas +++ b/compiler/src/test/pascal/cp.test.e2e.records.pas @@ -57,6 +57,14 @@ type procedure TestRun_RecordReturnFieldInline; procedure TestRun_RecordWithStaticArrayField_DeepCopy; procedure TestRun_NestedRecordMethod; + { Regression: copying a record whose layout has a sub-word field (Boolean / + Byte / SmallInt) immediately before a managed field. EmitRecordCopy used + loadw/storew unconditionally, so the 4-byte store over a 1-byte Boolean + clobbered the low bytes of the following pointer field — a later + _StringRelease / _DynArrayRelease then crashed on QBE. Native was always + width-correct. This is the shape of TDecimal (Boolean flags before a + string-bearing carrier), which blocked Numerics.Money on QBE. } + procedure TestRun_RecordCopy_BooleanBeforeManagedField; end; implementation @@ -1138,6 +1146,37 @@ begin AssertRunsOnAll(SrcNestedRecMethod, '88' + LE, 0); end; +procedure TE2ERecordsTests.TestRun_RecordCopy_BooleanBeforeManagedField; +const + { TDec mirrors TDecimal's shape: a dynarray and Boolean flags packed before + the outer record's managed (string) field. Mk copies a LOCAL TDec into the + sret Result's record field, then sets a string field — exactly the path that + over-wrote the string pointer with a wide store. } + Src = ''' + program P; + type + TDec = record FC: Int64; FM: array of UInt32; FS: Integer; FN: Boolean; FI: Boolean; end; + TM = record A: TDec; C: string; end; + function MkDec: TDec; + begin SetLength(Result.FM, 2); Result.FM[0] := 5; Result.FC := 99; Result.FI := True end; + function Mk: TM; + var L: TDec; + begin + L := MkDec(); + Result.A := L; + Result.C := 'USD'; + end; + var M: TM; + begin + M := Mk(); + WriteLn(M.C, ' ', M.A.FC, ' ', M.A.FM[0], ' ', M.A.FI) + end. + '''; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(Src, 'USD 99 5 True' + LE, 0); +end; + initialization RegisterTest(TE2ERecordsTests);