fix(qbe): record copy must use field-width loads/stores

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).
This commit is contained in:
Graeme Geldenhuys 2026-06-20 09:34:19 +01:00
parent 077f13b669
commit 62331de986
2 changed files with 54 additions and 6 deletions

View file

@ -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;

View file

@ -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);