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 6ee1659..56bf1d4 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -8640,21 +8640,73 @@ var I: Integer; Sym: string; Par: TMethodParam; + UserSlots, TotalSlots, OverflowSlots, AllocSz, CleanUp, Dest, HTotal: Integer; + Arg: TASTExpr; + HD, HK: TList; begin - Sym := MethodEmitNameNative(MD, MD.OwnerTypeName, AName); - Self.BeginCallArgs(MD.Params, AArgs); - for I := 0 to AArgs.Count - 1 do + Sym := MethodEmitNameNative(MD, MD.OwnerTypeName, AName); + UserSlots := CountArgSlots(MD.Params); + TotalSlots := UserSlots + 1; { + Self } + + if TotalSlots <= 6 then begin - Par := TMethodParam(MD.Params.Items[I]); - Self.PushCallArg(Par, TASTExpr(AArgs.Items[I]), I); + { All of Self + args fit in the 6 integer arg registers: push then pop. } + Self.BeginCallArgs(MD.Params, AArgs); + for I := 0 to AArgs.Count - 1 do + begin + Par := TMethodParam(MD.Params.Items[I]); + Self.PushCallArg(Par, TASTExpr(AArgs.Items[I]), I); + 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.Emit(#9'movq %r10, %rdi'); + Self.Emit(#9'callq ' + Sym); + Self.EndCallArgs(); + end + else + begin + { More than 6 register slots (Self + args): the surplus must spill to the + stack. Build the 6 register slots + overflow region in one frame, place + Self in slot 0, evaluate each arg into its slot, load regs 0..5, drop the + 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). } + OverflowSlots := TotalSlots - 6; + CleanUp := ((OverflowSlots * 8 + 15) and (-16)); + AllocSz := 6 * 8 + CleanUp; + HD := TList.Create(); + HK := TList.Create(); + HTotal := Self.EmitArgHoist(MD.Params, nil, True, '', AArgs, HD, HK); + Self.Emit(Format(#9'subq $%d, %%rsp', [AllocSz])); + for I := 0 to AArgs.Count - 1 do + begin + Arg := TASTExpr(AArgs.Items[I]); + if I + 1 < 6 then + Dest := I * 8 + 8 + else + Dest := 6 * 8 + (I + 1 - 6) * 8; + if HK.Get(I) >= akRecCall then + Self.Emit(Format(#9'movq %d(%%rsp), %%rax', + [AllocSz + HTotal - HD.Get(I)])) + else if TMethodParam(MD.Params.Items[I]).IsVarParam then + Self.EmitVarArgAddrToRax(Arg) + else + Self.EmitExprToEax(Arg); + Self.Emit(Format(#9'movq %%rax, %d(%%rsp)', [Dest])); + end; + { Self into slot 0 (the implicit first integer arg). } + Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand('Self')])); + Self.Emit(Format(#9'movq %%rax, 0(%%rsp)', [])); + for I := 0 to 5 do + Self.Emit(Format(#9'movq %d(%%rsp), %s', [I * 8, SysVArg64(I)])); + Self.Emit(Format(#9'addq $%d, %%rsp', [6 * 8])); + Self.Emit(#9'callq ' + Sym); + Self.EmitHoistEpilogue(AArgs, HD, HK, HTotal, CleanUp, True); + HD.Free(); + HK.Free(); end; - { Self is the current method's Self slot. } - Self.Emit(Format(#9'movq %s, %%r10', [Self.VarOperand('Self')])); - for I := CountArgSlots(MD.Params) - 1 downto 0 do - Self.Emit(#9'popq ' + SysVArg64(I + 1)); - Self.Emit(#9'movq %r10, %rdi'); - Self.Emit(#9'callq ' + Sym); - Self.EndCallArgs(); end; procedure TX86_64Backend.EmitInheritedCall(ACall: TInheritedCallStmt); diff --git a/compiler/src/test/pascal/cp.test.e2e.classes2.pas b/compiler/src/test/pascal/cp.test.e2e.classes2.pas index 16873bd..f3b277f 100644 --- a/compiler/src/test/pascal/cp.test.e2e.classes2.pas +++ b/compiler/src/test/pascal/cp.test.e2e.classes2.pas @@ -40,6 +40,9 @@ type procedure TestRun_Is_WrongClass_False; procedure TestRun_As_DowncastCallsMethod; procedure TestRun_Inherited_CallsParentMethod; + { inherited call whose Self + args exceed 6 integer registers must spill + the overflow args to the stack (native arg-register overflow). } + procedure TestRun_Inherited_ManyArgs_SpillsToStack; procedure TestRun_Inherited_VarParam_PassesByReference; procedure TestRun_Virtual_OverrideDispatch; procedure TestRun_MultiLevel_Inheritance_Chain; @@ -399,6 +402,34 @@ const end. '''; + { Regression: an `inherited Method(args)` call whose Self + args occupy more + than the 6 integer argument registers. The native inherited-call sequence + only handled the all-in-registers case (it popped every slot into a + register, walking past the 6 available), so an inherited call with 6+ args + aborted codegen ("arg register index 6 out of range"). Here Self + 7 ints + = 8 register slots, forcing the overflow to spill to the stack. TBase.Sum + = 1+..+7 = 28; TChild.Sum doubles it via inherited => 56. } + SrcInheritedManyArgs = ''' + program Prg; + type + TBase = class + function Sum(a, b, c, d, e, f, g: Integer): Integer; virtual; + end; + TChild = class(TBase) + function Sum(a, b, c, d, e, f, g: Integer): Integer; override; + end; + function TBase.Sum(a, b, c, d, e, f, g: Integer): Integer; + begin Result := a + b + c + d + e + f + g end; + function TChild.Sum(a, b, c, d, e, f, g: Integer): Integer; + begin Result := inherited Sum(a, b, c, d, e, f, g) * 2 end; + var o: TChild; + begin + o := TChild.Create(); + WriteLn(o.Sum(1, 2, 3, 4, 5, 6, 7)); + o.Free() + end. + '''; + { Regression: `inherited Foo(X)` where the parent method has a var/out param. The inherited-call arg loop had no var-param branch, so it passed the loaded VALUE (a `w`) where the callee expects an address (`l`) — the parent @@ -1109,6 +1140,12 @@ begin AssertEquals('15', '15' + LE, Output); end; +procedure TE2EClasses2Tests.TestRun_Inherited_ManyArgs_SpillsToStack; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcInheritedManyArgs, '56' + LE, 0); +end; + procedure TE2EClasses2Tests.TestRun_Inherited_VarParam_PassesByReference; var Output: string; RCode: Integer; begin