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

fix(codegen): native passes float method/constructor args via xmm registers

Browse source 
The native x86-64 backend marshalled float arguments correctly for free
functions (SysV: floats -> %xmm0..7) but not for instance-method, constructor,
or inherited calls: those push every arg through the integer-register model, so
a Double/Single argument was either a codegen crash (literal -> "unsupported
expression form TFloatLiteral") or a silent ABI miscompile (variable bits
landed in an integer register while the callee read %xmm).

Fix, all in blaise.codegen.native.x86_64.pas:
- EmitMethodArgPush: a by-value float scalar arg is now materialised via
  EmitExprToXmm0 (handles literals through the .LF constant path), width-
  adjusted to the param type, and pushed as its 8-byte bit pattern.
- New EmitPopMethodArgsToRegs: replaces the integer-only `popq SysVArg64(I+1)`
  loops in the <=6-slot path of EmitMethodCallExpr, EmitMethodCallStmt, the
  constructor arg loop, EmitInheritedCallSeq, and the sret method path. It
  classifies each slot and routes floats to %xmm0.. and integers to the
  integer registers, advancing independent counters per SysV (Self still
  occupies integer slot 0/1).
- The rare >6-register-slot overflow path remains integer-only; a by-value
  float there now raises a clear "not yet supported" error (GuardNoFloatInOverflow)
  instead of crashing cryptically or silently miscompiling.

Tests: 6 e2e cases in cp.test.e2e.classes2 (method/ctor x literal/variable,
mixed int+float+string interleaving, multiple floats across xmm0/xmm1) run on
both backends, plus an IR assertion in cp.test.nativeconstarg that the call
site emits movsd into %xmm0.
This commit is contained in:
Graeme Geldenhuys 2026-06-22 14:16:34 +01:00
parent ef19c01cb7
commit 9607ca388e
3 changed files with 263 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -630,6 +630,21 @@ type
spilling any overflow to the stack. Returns overflow bytes to clean up
after the call. Used by the interface/class sret call emitters. }
function EmitSretRegArgs(ASlots, ABase: Integer): Integer;
{ Pop already-pushed method-call arg slots (slot 0 pushed first, on top is
the last slot) into the System V argument registers, routing float-family
params to %xmm0.. and everything else to the integer registers starting
at AIntBase (1 when only Self/%rdi is reserved). Mirrors EmitCall's SysV
classification so a Double/Single method or constructor argument lands in
its xmm register instead of being mis-passed in an integer register. }
procedure EmitPopMethodArgsToRegs(AParams, AArgs: TObjectList;
AIntBase: Integer);
{ Raise a clear error if a by-value float-family param appears in a call
whose total slots exceed the 6 integer arg registers. The >6-slot
method/ctor overflow emitters use an integer-only flat-slot layout; a
float arg there would be mis-classified into the integer overflow region
instead of an xmm register. The <=6-slot path handles floats correctly
(EmitPopMethodArgsToRegs); only the rare overflow path is unsupported. }
procedure GuardNoFloatInOverflow(AParams: TObjectList; const AWhat: string);
{ Emit a method-pointer (of-object) call: load Code from offset 0 and Data
from offset 8 of the TMethod block at APtrOperand; call Code with Data as
Self (%rdi) and the remaining args shifted. }
@ -7794,8 +7809,7 @@ begin
for I := 0 to ACall.Args.Count - 1 do
Self.PushCallArg(TMethodParam(MD.Params.Items[I]),
TASTExpr(ACall.Args.Items[I]), I);
for I := UserSlots - 1 downto 0 do
Self.Emit(#9'popq ' + SysVArg64(I + 1));
Self.EmitPopMethodArgsToRegs(MD.Params, ACall.Args, 1);
Self.Emit(#9'movq %rbx, %rdi');
if ACall.IsMetaclassDispatch and (MD.VTableSlot >= 0) then
begin
@ -7816,6 +7830,7 @@ begin
HD := TList<Integer>.Create();
HK := TList<Integer>.Create();
HTotal := Self.EmitArgHoist(MD.Params, nil, True, '', ACall.Args, HD, HK);
Self.GuardNoFloatInOverflow(MD.Params, 'constructor call');
OverflowSlots := TotalSlots - 6;
AllocSz := (((6 * 8 + OverflowSlots * 8) + 15) and (-16)) + 8;
CleanUp := AllocSz - 6 * 8;
@ -7959,8 +7974,7 @@ begin
else
Self.Emit(Format(#9'movq %s, %%r10', [Self.VarOperand('Self')]));
for I := UserSlots - 1 downto 0 do
Self.Emit(#9'popq ' + SysVArg64(I + 1));
Self.EmitPopMethodArgsToRegs(MD.Params, ACall.Args, 1);
Self.Emit(#9'movq %r10, %rdi');
if MD.VTableSlot >= 0 then
begin
@ -7994,6 +8008,7 @@ begin
Self.EmitRecordCallSretAt(ACall.ObjExpr, '(%rsp)');
Self.Emit(#9'movq %rsp, %rbx');
end;
Self.GuardNoFloatInOverflow(MD.Params, 'method call');
OverflowSlots := TotalSlots - 6;
CleanUp := ((OverflowSlots * 8 + 15) and (-16));
AllocSz := 6 * 8 + CleanUp;
@ -8315,6 +8330,19 @@ begin
Self.Emit(#9'pushq %rax');
end;
end
else if (APar <> nil) and IsFloatFamily(APar.ResolvedType) then
begin
{ Float scalar argument: materialise to %xmm0 (handles literals via the
.LF constant path, variables, expressions), adjust to the param's width,
and push its 8-byte bit pattern onto the stack as one slot. The pop loop
(EmitPopMethodArgsToRegs) routes this slot into an xmm argument register
per the SysV ABI instead of an integer register. }
Self.EmitExprToXmm0(AArg);
Self.EmitXmm0WidthAdjust(AArg.ResolvedType,
APar.ResolvedType.Kind = tySingle);
Self.Emit(#9'subq $8, %rsp');
Self.Emit(#9'movsd %xmm0, 0(%rsp)');
end
else
begin
Self.EmitExprToEax(AArg);
@ -8449,6 +8477,110 @@ begin
Result := OverflowSlots * 8;
end;
procedure TX86_64Backend.EmitPopMethodArgsToRegs(AParams, AArgs: TObjectList;
AIntBase: Integer);
var
I, NParams, IntIdx, XmmIdx: Integer;
P: TMethodParam;
PT: TTypeDesc;
IsFloatSlot: TList<Integer>; { 1 = float (xmm) slot, 0 = integer slot,
in stack-slot order (slot 0 pushed first) }
Dest: TStringList; { target register per slot, parallel to above }
Slots: Integer;
begin
{ Determine the param backing each logical arg. AParams may be nil (no
declared params): then every arg is a plain integer slot. }
NParams := 0;
if AParams <> nil then NParams := AParams.Count;
IsFloatSlot := TList<Integer>.Create();
Dest := TStringList.Create();
try
{ Forward pass: one entry per stack slot, in push order (slot 0 first). }
for I := 0 to AArgs.Count - 1 do
begin
P := nil;
if I < NParams then P := TMethodParam(AParams.Items[I]);
PT := nil;
if P <> nil then PT := P.ResolvedType;
if (PT = nil) and (TASTExpr(AArgs.Items[I]).ResolvedType <> nil) then
PT := TASTExpr(AArgs.Items[I]).ResolvedType;
if (P <> nil) and P.IsOpenArray then
begin
IsFloatSlot.Add(0); IsFloatSlot.Add(0); { ptr + high }
end
else if (PT <> nil) and (PT.Kind = tyInterface) and
((P = nil) or not P.IsVarParam) then
begin
IsFloatSlot.Add(0); IsFloatSlot.Add(0); { obj + itab }
end
else if IsFloatFamily(PT) and ((P = nil) or
(not P.IsVarParam and not P.IsOpenArray)) then
IsFloatSlot.Add(1) { float scalar -> xmm }
else
IsFloatSlot.Add(0); { integer/ptr scalar }
end;
{ Assign a register to each slot in forward order: integers consume the
SysV integer registers from AIntBase, floats consume xmm0.. — the two
sequences advance independently, per SysV. }
IntIdx := AIntBase;
XmmIdx := 0;
for I := 0 to IsFloatSlot.Count - 1 do
begin
if IsFloatSlot.Get(I) = 1 then
begin
Dest.Add(SysVXmmArgRegs[XmmIdx]);
Inc(XmmIdx);
end
else
begin
Dest.Add(Self.SysVArg64(IntIdx));
Inc(IntIdx);
end;
end;
{ Reverse pass: the top of the stack is the LAST slot. Pop from the last
slot down to slot 0, moving each into its precomputed register. Every
slot is 8 bytes and consumed in turn, so the current slot is always at
0(%rsp) — a float reads it then raises %rsp by 8, an integer pops it. }
Slots := IsFloatSlot.Count;
for I := Slots - 1 downto 0 do
begin
if IsFloatSlot.Get(I) = 1 then
begin
Self.Emit(Format(#9'movsd 0(%%rsp), %s', [Dest.Strings[I]]));
Self.Emit(#9'addq $8, %rsp');
end
else
Self.Emit(#9'popq ' + Dest.Strings[I]);
end;
finally
Dest.Free();
IsFloatSlot.Free();
end;
end;
procedure TX86_64Backend.GuardNoFloatInOverflow(AParams: TObjectList;
const AWhat: string);
var
I: Integer;
P: TMethodParam;
begin
if AParams = nil then Exit;
for I := 0 to AParams.Count - 1 do
begin
P := TMethodParam(AParams.Items[I]);
if IsFloatFamily(P.ResolvedType) and not P.IsVarParam and
not P.IsOpenArray then
raise ENativeCodeGenError.Create(
'native backend: by-value float argument in a ' + AWhat +
' with more than 6 register slots is not yet supported (the >6-arg ' +
'overflow path is integer-only); reduce the argument count or pass ' +
'the float earlier in the list');
end;
end;
{ Emit a TMethodCallStmt (class method call in statement position).
Same as EmitMethodCallExpr but for statement nodes. }
procedure TX86_64Backend.EmitMethodCallStmt(ACall: TMethodCallStmt);
@ -8493,8 +8625,7 @@ begin
for I := 0 to ACall.Args.Count - 1 do
Self.PushCallArg(TMethodParam(MD.Params.Items[I]),
TASTExpr(ACall.Args.Items[I]), I);
for I := UserSlots - 1 downto 0 do
Self.Emit(#9'popq ' + SysVArg64(I + 1));
Self.EmitPopMethodArgsToRegs(MD.Params, ACall.Args, 1);
Self.Emit(#9'movq %rbx, %rdi');
if MD.VTableSlot >= 0 then
begin
@ -8515,6 +8646,7 @@ begin
HD := TList<Integer>.Create();
HK := TList<Integer>.Create();
HTotal := Self.EmitArgHoist(MD.Params, nil, True, '', ACall.Args, HD, HK);
Self.GuardNoFloatInOverflow(MD.Params, 'constructor call');
OverflowSlots := TotalSlots - 6;
AllocSz := (((6 * 8 + OverflowSlots * 8) + 15) and (-16)) + 8;
CleanUp := AllocSz - 6 * 8;
@ -8698,12 +8830,12 @@ begin
else
Self.Emit(Format(#9'movq %s, %%r10', [Self.VarOperand('Self')]));
for I := UserSlots - 1 downto 0 do
Self.Emit(#9'popq ' + SysVArg64(I + 1));
Self.EmitPopMethodArgsToRegs(MD.Params, ACall.Args, 1);
Self.Emit(#9'movq %r10, %rdi');
end
else
begin
Self.GuardNoFloatInOverflow(MD.Params, 'method call');
OverflowSlots := TotalSlots - 6;
CleanUp := ((OverflowSlots * 8 + 15) and (-16));
AllocSz := 6 * 8 + CleanUp;
@ -8820,8 +8952,7 @@ begin
end;
{ Self is the current method's Self slot. }
Self.Emit(Format(#9'movq %s, %%r10', [Self.VarOperand('Self')]));
for I := UserSlots - 1 downto 0 do
Self.Emit(#9'popq ' + SysVArg64(I + 1));
Self.EmitPopMethodArgsToRegs(MD.Params, AArgs, 1);
Self.Emit(#9'movq %r10, %rdi');
Self.Emit(#9'callq ' + Sym);
Self.EndCallArgs();
@ -8834,6 +8965,7 @@ begin
6-register prefix so the overflow sits at the callee's [rsp+0..], then
static-dispatch to the parent. Mirrors EmitMethodCallStmt's >6 path
(the inherited call is always a direct callq, never vtable). }
Self.GuardNoFloatInOverflow(MD.Params, 'inherited call');
OverflowSlots := TotalSlots - 6;
CleanUp := ((OverflowSlots * 8 + 15) and (-16));
AllocSz := 6 * 8 + CleanUp;
@ -14533,8 +14665,7 @@ begin
{ Pop one register per SLOT (interface args occupy two), into the integer
registers after %rdi (sret) and %rsi (Self): %rdx, %rcx, %r8, %r9. }
for I := UserSlots - 1 downto 0 do
Self.Emit(#9'popq ' + SysVArg64(I + 2));
Self.EmitPopMethodArgsToRegs(MD.Params, ACall.Args, 2);
{ The saved dest sits just below the call frame's hoist region. }
Self.Emit(Format(#9'movq %d(%%rsp), %%rdi', [Self.TopFrameTotal()]));
if MD.VTableSlot >= 0 then

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

@ -54,6 +54,15 @@ type
procedure TestRun_Supports_TwoArg_BooleanResult;
procedure TestRun_Supports_ThreeArg_AssignsAndCalls;
procedure TestRun_ConstructorOverload_PicksCorrectArity;
{ Regression: native backend passed float args to methods/constructors via
integer registers instead of the SysV xmm registers — a literal crashed
codegen, a variable silently used the wrong register. }
procedure TestRun_MethodFloatArg_Literal_PassedInXmm;
procedure TestRun_MethodFloatArg_Variable_PassedInXmm;
procedure TestRun_ConstructorFloatArg_Literal_StoredCorrectly;
procedure TestRun_ConstructorFloatArg_Variable_StoredCorrectly;
procedure TestRun_MethodMixedIntFloatString_RegistersInterleave;
procedure TestRun_MethodMultipleFloats_UseXmm0AndXmm1;
procedure TestRun_MethodReadsProgramGlobal;
procedure TestRun_VarParam_ClassFields_WritebackVisible;
{ Name-resolution priority for unqualified calls inside a class
@ -1246,6 +1255,90 @@ begin
AssertEquals('1-arg constructor body ran', '42' + LE, Output);
end;
procedure TE2EClasses2Tests.TestRun_MethodFloatArg_Literal_PassedInXmm;
begin
AssertRunsOnAll(
'''
program c;
type TX = class procedure Take(d: Double); end;
procedure TX.Take(d: Double); begin WriteLn(d); end;
var x: TX;
begin x := TX.Create(); x.Take(1.5); end.
''',
'1.5' + LE, 0);
end;
procedure TE2EClasses2Tests.TestRun_MethodFloatArg_Variable_PassedInXmm;
begin
AssertRunsOnAll(
'''
program f;
type TX = class procedure Take(d: Double); end;
procedure TX.Take(d: Double); begin WriteLn(d); end;
var x: TX; y: Double;
begin x := TX.Create(); y := 1.5; x.Take(y); end.
''',
'1.5' + LE, 0);
end;
procedure TE2EClasses2Tests.TestRun_ConstructorFloatArg_Literal_StoredCorrectly;
begin
AssertRunsOnAll(
'''
program ctl;
type TN = class V: Double; constructor CreateFloat(d: Double); end;
constructor TN.CreateFloat(d: Double); begin V := d; end;
var n: TN;
begin n := TN.CreateFloat(2.5); WriteLn(n.V); end.
''',
'2.5' + LE, 0);
end;
procedure TE2EClasses2Tests.TestRun_ConstructorFloatArg_Variable_StoredCorrectly;
begin
AssertRunsOnAll(
'''
program ct;
type TN = class V: Double; constructor CreateFloat(d: Double); end;
constructor TN.CreateFloat(d: Double); begin V := d; end;
var n: TN; y: Double;
begin y := 2.5; n := TN.CreateFloat(y); WriteLn(n.V); end.
''',
'2.5' + LE, 0);
end;
procedure TE2EClasses2Tests.TestRun_MethodMixedIntFloatString_RegistersInterleave;
begin
{ Exercises int + float + string interleaving: the string and Int64 take
integer arg registers, the Double takes an xmm register, independently. }
AssertRunsOnAll(
'''
program mix;
type TX = class procedure M(const s: string; i: Int64; d: Double); end;
procedure TX.M(const s: string; i: Int64; d: Double);
begin WriteLn('s=', s, ' i=', i, ' d=', d); end;
var x: TX;
begin x := TX.Create(); x.M('hi', 7, 3.5); end.
''',
's=hi i=7 d=3.5' + LE, 0);
end;
procedure TE2EClasses2Tests.TestRun_MethodMultipleFloats_UseXmm0AndXmm1;
begin
{ Two Double/Single args must land in distinct xmm registers (xmm0, xmm1),
interleaved with an integer arg that consumes an integer register. }
AssertRunsOnAll(
'''
program mf;
type TX = class procedure M(a: Double; i: Int64; b: Double; c: Single); end;
procedure TX.M(a: Double; i: Int64; b: Double; c: Single);
begin WriteLn('a=', a, ' i=', i, ' b=', b, ' c=', c); end;
var x: TX;
begin x := TX.Create(); x.M(1.5, 9, 2.5, 3.5); end.
''',
'a=1.5 i=9 b=2.5 c=3.5' + LE, 0);
end;
procedure TE2EClasses2Tests.TestRun_MethodReadsProgramGlobal;
var Output: string; RCode: Integer;
begin

27
compiler/src/test/pascal/cp.test.nativeconstarg.pas
View file

@ -61,6 +61,10 @@ type
{ Self is typed as the owning class; value record params present the
'_data' shadow slot (the inline copy) so field drilldown works. }
procedure TestOpdf_Facts_SelfAndRecordParamTyping;
{ Regression: a float argument to an instance method must be marshalled
into an SSE (xmm) argument register per the System V ABI, not an integer
register. Asserts the call site emits movsd into %xmm0. }
procedure TestMethodFloatArg_LoadedIntoXmm;
end;
implementation
@ -626,6 +630,29 @@ begin
CG.Free();
end;
procedure TNativeConstArgTests.TestMethodFloatArg_LoadedIntoXmm;
const
Src = '''
program P;
type TX = class procedure Take(d: Double); end;
procedure TX.Take(d: Double); begin end;
var x: TX;
begin
x := TX.Create();
x.Take(1.5)
end.
''';
var
Asm: string;
begin
Asm := GenAsm(Src);
{ The Double argument must reach the SSE arg register, not an integer one. }
AssertTrue('float method arg loaded into %xmm0',
Pos('movsd', Asm) >= 0);
AssertTrue('float method arg targets the SSE arg register',
Pos('%xmm0', Asm) >= 0);
end;
initialization
RegisterTest(TNativeConstArgTests);