administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

fix(codegen): convert integer to float on class-field stores

Browse source 
A store into a Double or Single class field never converted an integer
right-hand side to floating point, on either backend:

  * QBE never emitted swtof/sltof — the field-store paths only handled
    integer widening (w->l) and float-width adjustment (s<->d).  An Int64
    or Integer RHS was deposited into the float slot as raw integer bits;
    on the explicit-field path QBE rejected the `stored` of an integer SSA
    value, and on the implicit-Self path a hardcoded `storel` silently
    wrote garbage.

  * The native x86-64 backend converted an integer RHS to a DOUBLE in
    %xmm0 (cvtsi2sdq) but then stored it into a Single field with a bare
    movss — writing only the low 32 bits of the double, i.e. garbage.  A
    Single field needs the value narrowed (cvtsd2ss) first; the Double
    field happened to work.

Both backends now promote/convert to the field's width.  QBE: swtof/sltof
for an integer RHS plus exts/truncd for a float-width mismatch, in
EmitFieldAssignment and the implicit-Self field branch of EmitAssignment.
Native: an EmitXmm0WidthAdjust after EmitExprToXmm0 in both the
TFieldAssignment and implicit-Self float field-store paths, narrowing a
Double/integer RHS to the Single field width before the movss.

Tests: cp.test.codegen IR assertions for the Self.Field, bare-field and
Single targets; cp.test.e2e.classes2 end-to-end coverage of Int64->Double
and Integer->Single through both Self.Field and bare implicit-Self forms,
verified on QBE and native.
This commit is contained in:
Andrew Haines 2026-06-24 18:16:56 -04:00 committed by Graeme Geldenhuys
parent bfbcfb0489
commit ff2d73f70d
4 changed files with 200 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
compiler/src/main/pascal/blaise.codegen.native.x86_64.pas
View file

@ -10781,6 +10781,10 @@ begin
if IsFloatFamily(Asgn.ResolvedLhsType) then
begin
Self.EmitExprToXmm0(Asgn.Expr);
{ Narrow a Double/integer RHS to Single before the movss store
(see the TFieldAssignment float path). }
Self.EmitXmm0WidthAdjust(Asgn.Expr.ResolvedType,
Asgn.ResolvedLhsType.Kind = tySingle);
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('Self')]));
if ISFld.Offset > 0 then
Self.Emit(Format(#9'addq $%d, %%rcx', [ISFld.Offset]));
@ -12260,6 +12264,12 @@ begin
if IsFloatFamily(FA.FieldInfo.TypeDesc) then
begin
Self.EmitExprToXmm0(FA.Expr);
{ An integer RHS (and any Double sub-expression) lands in %xmm0 as a
DOUBLE; a Single field needs it narrowed (cvtsd2ss) before the movss
store, else only the low 32 bits of the double are written — garbage.
Mirrors the QBE swtof/truncd field-store conversion. }
Self.EmitXmm0WidthAdjust(FA.Expr.ResolvedType,
FA.FieldInfo.TypeDesc.Kind = tySingle);
if FA.ObjExpr <> nil then
begin
Self.Emit(#9'subq $8, %rsp');

92
compiler/src/main/pascal/blaise.codegen.qbe.pas
View file

@ -4051,6 +4051,42 @@ begin
QType := QbeTypeOf(ISFld.TypeDesc);
if QType = 'w' then
EmitLine(Format(' %s %s, %s', [StoreInstrFor(ISFld.TypeDesc), ValTemp, ObjTemp]))
else if (QType = 'd') or (QType = 's') then
begin
{ Float-typed field via implicit Self.Field: convert an integer RHS
(swtof/sltof) or adjust float width (exts/truncd) before storing, and
use the float store instruction — never the bare storel below, which
would deposit the raw integer/wrong-width bits into the float slot. }
if (AAssign.Expr.ResolvedType <> nil) and
(QbeTypeOf(AAssign.Expr.ResolvedType) = 'w') and
not AAssign.Expr.ResolvedType.IsFloat() then
begin
ExtTemp := AllocTemp();
EmitLine(Format(' %s =%s swtof %s', [ExtTemp, QType, ValTemp]));
ValTemp := ExtTemp;
end
else if (AAssign.Expr.ResolvedType <> nil) and
(QbeTypeOf(AAssign.Expr.ResolvedType) = 'l') and
not AAssign.Expr.ResolvedType.IsFloat() then
begin
ExtTemp := AllocTemp();
EmitLine(Format(' %s =%s sltof %s', [ExtTemp, QType, ValTemp]));
ValTemp := ExtTemp;
end
else if (QType = 's') and (QbeTypeOf(AAssign.Expr.ResolvedType) = 'd') then
begin
ExtTemp := AllocTemp();
EmitLine(Format(' %s =s truncd %s', [ExtTemp, ValTemp]));
ValTemp := ExtTemp;
end
else if (QType = 'd') and (QbeTypeOf(AAssign.Expr.ResolvedType) = 's') then
begin
ExtTemp := AllocTemp();
EmitLine(Format(' %s =d exts %s', [ExtTemp, ValTemp]));
ValTemp := ExtTemp;
end;
EmitLine(Format(' %s %s, %s', [StoreInstrFor(ISFld.TypeDesc), ValTemp, ObjTemp]));
end
else
begin
if QbeTypeOf(AAssign.Expr.ResolvedType) = 'w' then
@ -6336,9 +6372,45 @@ begin
begin
QType := QbeTypeOf(AAssign.FieldInfo.TypeDesc);
StoreInstr := StoreInstrFor(AAssign.FieldInfo.TypeDesc);
if QType <> 'w' then
if (QType = 'd') or (QType = 's') then
begin
{ Sign-extend if the value is word-typed but the field needs l }
{ Float-typed field: an integer RHS must be converted (swtof/sltof),
not merely sign-extended — otherwise 'rec.d := i' emits
'stored <l>, ...', an integer value into a float slot the assembler
rejects. A float RHS of the wrong width is adjusted (exts/truncd).
Mirrors the scalar-variable assignment path. }
if (AAssign.Expr.ResolvedType <> nil) and
(QbeTypeOf(AAssign.Expr.ResolvedType) = 'w') and
not AAssign.Expr.ResolvedType.IsFloat() then
begin
ExtTemp := AllocTemp();
EmitLine(Format(' %s =%s swtof %s', [ExtTemp, QType, ValTemp]));
ValTemp := ExtTemp;
end
else if (AAssign.Expr.ResolvedType <> nil) and
(QbeTypeOf(AAssign.Expr.ResolvedType) = 'l') and
not AAssign.Expr.ResolvedType.IsFloat() then
begin
ExtTemp := AllocTemp();
EmitLine(Format(' %s =%s sltof %s', [ExtTemp, QType, ValTemp]));
ValTemp := ExtTemp;
end
else if (QType = 's') and (QbeTypeOf(AAssign.Expr.ResolvedType) = 'd') then
begin
ExtTemp := AllocTemp();
EmitLine(Format(' %s =s truncd %s', [ExtTemp, ValTemp]));
ValTemp := ExtTemp;
end
else if (QType = 'd') and (QbeTypeOf(AAssign.Expr.ResolvedType) = 's') then
begin
ExtTemp := AllocTemp();
EmitLine(Format(' %s =d exts %s', [ExtTemp, ValTemp]));
ValTemp := ExtTemp;
end;
end
else if QType <> 'w' then
begin
{ Integer/pointer field wider than word: sign-extend a word RHS to l. }
if QbeTypeOf(AAssign.Expr.ResolvedType) = 'w' then
begin
ExtTemp := AllocTemp();
@ -6346,22 +6418,6 @@ begin
ValTemp := ExtTemp;
end;
end;
{ Float-width coercion: real-typed literals and double sub-exprs land
in the SSA as 'd' even when the destination field is a 32-bit
'Single' ('s'). Without this, 'rec.s := 1.5' emits
'stores d_1.5, ...' — a type mismatch the assembler rejects. }
if (QType = 's') and (QbeTypeOf(AAssign.Expr.ResolvedType) = 'd') then
begin
ExtTemp := AllocTemp();
EmitLine(Format(' %s =s truncd %s', [ExtTemp, ValTemp]));
ValTemp := ExtTemp;
end
else if (QType = 'd') and (QbeTypeOf(AAssign.Expr.ResolvedType) = 's') then
begin
ExtTemp := AllocTemp();
EmitLine(Format(' %s =d exts %s', [ExtTemp, ValTemp]));
ValTemp := ExtTemp;
end;
EmitLine(Format(' %s %s, %s', [StoreInstr, ValTemp, Ptr]));
end;
end;

66
compiler/src/test/pascal/cp.test.codegen.pas
View file

@ -81,6 +81,13 @@ type
procedure TestInt64AssignDouble_EmitsSltof;
procedure TestIntAssignSingle_EmitsSwtof;
{ Integer→float conversion on a CLASS-FIELD store target (not just a
simple variable). Regression: the field-store path emitted a bare
integer store into the float slot. }
procedure TestInt64AssignDoubleField_EmitsSltof;
procedure TestIntAssignSingleField_EmitsSwtof;
procedure TestInt64AssignDoubleFieldBare_EmitsSltof;
{ Mixed Single×Double arithmetic }
procedure TestSingleMulDouble_PromotesSingleToDouble;
procedure TestSingleAddSingle_EmitsSTypedOp;
@ -667,6 +674,65 @@ begin
IRContains(IR, 'swtof'));
end;
procedure TCodeGenTests.TestInt64AssignDoubleField_EmitsSltof;
var IR: string;
begin
IR := GenerateIR('''
program P;
type TFoo = class
FD: Double;
procedure SetIt(AValue: Int64);
begin Self.FD := AValue end;
end;
var F: TFoo;
begin
F := TFoo.Create()
end.
''');
AssertTrue('Int64→Double field store should emit sltof',
IRContains(IR, 'sltof'));
AssertFalse('Int64→Double field store must not bare-store the integer',
IRContains(IR, 'storel %_t2, %_t1'));
end;
procedure TCodeGenTests.TestIntAssignSingleField_EmitsSwtof;
var IR: string;
begin
IR := GenerateIR('''
program P;
type TFoo = class
FS: Single;
procedure SetIt(AValue: Integer);
begin Self.FS := AValue end;
end;
var F: TFoo;
begin
F := TFoo.Create()
end.
''');
AssertTrue('Integer→Single field store should emit swtof',
IRContains(IR, 'swtof'));
end;
procedure TCodeGenTests.TestInt64AssignDoubleFieldBare_EmitsSltof;
var IR: string;
begin
IR := GenerateIR('''
program P;
type TFoo = class
FD: Double;
procedure SetIt(AValue: Int64);
begin FD := AValue end;
end;
var F: TFoo;
begin
F := TFoo.Create()
end.
''');
AssertTrue('Int64→Double bare implicit-Self field store should emit sltof',
IRContains(IR, 'sltof'));
end;
procedure TCodeGenTests.TestSingleMulDouble_PromotesSingleToDouble;
var IR: string;
begin

50
compiler/src/test/pascal/cp.test.e2e.classes2.pas
View file

@ -163,6 +163,13 @@ type
stub must complete into the same type so the full class — including its
ARC field — compiles and runs correctly. }
procedure TestRun_ForwardClass_MutualRefRuns;
{ Implicit Int64/Integer→float conversion when the assignment target is a
class FIELD (both Self.Field and bare implicit-Self forms), for Double
and Single fields. Regression: QBE deposited the raw integer bits into
the float slot; native stored a Double into a Single slot (movss of a
double) without narrowing. }
procedure TestRun_IntToFloatField_Converts;
procedure TestRun_SelfIndexedRecordFieldAssign;
end;
@ -2327,6 +2334,49 @@ begin
AssertEquals('forward-declared TNode field read back', 'hello', Trim(Output));
end;
const
SrcIntToFloatField =
'''
program Prg;
type
TFoo = class
FD: Double;
FS: Single;
procedure SetD(AValue: Int64);
begin Self.FD := AValue end; { Int64 -> Double, Self.Field }
procedure SetDBare(AValue: Int64);
begin FD := AValue end; { Int64 -> Double, implicit Self }
procedure SetS(AValue: Integer);
begin Self.FS := AValue end; { Integer -> Single, Self.Field }
procedure SetSBare(AValue: Integer);
begin FS := AValue end; { Integer -> Single, implicit Self }
end;
var F: TFoo;
begin
F := TFoo.Create();
F.SetD(7);
WriteLn(Format('%g', [F.FD]));
F.SetDBare(42);
WriteLn(Format('%g', [F.FD]));
F.SetS(5);
WriteLn(Format('%g', [F.FS]));
F.SetSBare(9);
WriteLn(Format('%g', [F.FS]))
end.
''';
procedure TE2EClasses2Tests.TestRun_IntToFloatField_Converts;
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ All four forms convert the integer to the field's float width — including
Integer->Single, where the native backend had stored a Double into the
4-byte Single slot. }
AssertTrue('compile+run', CompileAndRun(SrcIntToFloatField, Output, RCode));
AssertEquals('Int64/Integer→float field stores convert',
'7' + LE + '42' + LE + '5' + LE + '9', Trim(Output));
end;
initialization
RegisterTest(TE2EClasses2Tests);