From 43a0d7c3a8c3e689b95f4987e00d0dbf37f4548c Mon Sep 17 00:00:00 2001 From: Tobias Giesen Date: Wed, 25 Mar 2026 13:28:16 +0100 Subject: [PATCH 1/4] Native ARM64 Implementation Using Assembler Native ARM64 Implementation Using Assembler Tested on Linux / ARM64 and macOS / M1 --- Source/PascalScript.inc | 2 +- Source/PascalScriptFPC.inc | 4 +- Source/arm64.inc | 375 +++++++++++++++++++++++++++++++++++++ Source/arm64sysv-linux.o | Bin 0 -> 1048 bytes Source/arm64sysv-macos.o | Bin 0 -> 696 bytes Source/arm64sysv.S | 114 +++++++++++ Source/uPSRuntime.pas | 52 +++-- 7 files changed, 524 insertions(+), 23 deletions(-) create mode 100644 Source/arm64.inc create mode 100644 Source/arm64sysv-linux.o create mode 100644 Source/arm64sysv-macos.o create mode 100644 Source/arm64sysv.S diff --git a/Source/PascalScript.inc b/Source/PascalScript.inc index 6ed5c1b8..3abb6ffb 100644 --- a/Source/PascalScript.inc +++ b/Source/PascalScript.inc @@ -11,7 +11,7 @@ {$INCLUDE eDefines.inc} -{$IFDEF FPC}{$H+}{$ENDIF} +{$IFDEF FPC}{$MODE DELPHI}{$H+}{$ENDIF} {$IFDEF VER125}{C4}{$B-}{$X+}{$T-}{$H+}{$ENDIF} {$IFDEF VER110}{C3}{$B-}{$X+}{$T-}{$H+}{$ENDIF} diff --git a/Source/PascalScriptFPC.inc b/Source/PascalScriptFPC.inc index 269a9d28..fe74951a 100644 --- a/Source/PascalScriptFPC.inc +++ b/Source/PascalScriptFPC.inc @@ -4,11 +4,11 @@ {$MODE DELPHIUNICODE} {$DEFINE UNICODE} {$ELSE} - {$MODE DELPHI} + // {$MODE DELPHI} // FPC 3.2.4: mode switch not allowed here {$ENDIF} {$IF (defined(cpuaarch64) or defined(cpuarm))} - {$DEFINE USEINVOKECALL} + // {$DEFINE USEINVOKECALL} // InvokeCall.inc does not compile on FPC due to missing Rtti features {$IFEND} diff --git a/Source/arm64.inc b/Source/arm64.inc new file mode 100644 index 00000000..7398a384 --- /dev/null +++ b/Source/arm64.inc @@ -0,0 +1,375 @@ +{$IFDEF CPUARM64} + {$IFDEF MSWINDOWS} + {$L arm64win.obj} + {$ELSE} + {$IFDEF MACOS} + {$L arm64sysv-macos.o} + {$ELSE} + {$L arm64sysv-linux.o} + {$ENDIF} + {$ENDIF} +{$ELSE} + {$IFDEF CPUAARCH64} + {$IFDEF DARWIN} + {$L arm64sysv-macos.o} + {$ELSE} + {$L arm64sysv-linux.o} + {$ENDIF} + {$ENDIF} +{$ENDIF} + +type + TARM64Registers = packed record + X1, X2, X3, X4, X5, X6, X7: IPointer; + X8: IPointer; // indirect result register for AArch64 ABI + D1, D2, D3, D4, D5, D6, D7: Double; + FloatBits: Integer; // bits 0..7 = single args in D0..D7, bit 8 = single result + end; + +const EmptyPChar:PChar=''; + +procedure arm64call( + Address: Pointer; + out _X0: IPointer; + var _D0: Double; + constref Registers: TARM64Registers; + Stack: Pointer; + Items: NativeInt); external {$IFDEF DARWIN}name '_arm64call'{$ENDIF}; + +function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean; +var + Stack: array of Byte; + _X0: IPointer; + _D0: Double; + Registers: TARM64Registers; + IntRegUsage: Byte; + FloatRegUsage: Byte; + CallData: TPSList; + I: Integer; + pp: ^Byte; +{$IFDEF FPC} + IsConstructor, IsVirtualCons: Boolean; +{$ENDIF} + + function rp(p: PPSVariantIFC): PPSVariantIFC; + begin + if p = nil then + Exit(nil); + if p.aType.BaseType = btPointer then + begin + p^.aType := Pointer(Pointer(IPointer(p^.dta) + PointerSize)^); + p^.Dta := Pointer(p^.dta^); + end; + Result := p; + end; + + procedure StoreIntReg(Data: IPointer); + var + p: Pointer; + begin + case IntRegUsage of + 0: begin Inc(IntRegUsage); _X0 := Data; end; + 1: begin Inc(IntRegUsage); Registers.X1 := Data; end; + 2: begin Inc(IntRegUsage); Registers.X2 := Data; end; + 3: begin Inc(IntRegUsage); Registers.X3 := Data; end; + 4: begin Inc(IntRegUsage); Registers.X4 := Data; end; + 5: begin Inc(IntRegUsage); Registers.X5 := Data; end; + 6: begin Inc(IntRegUsage); Registers.X6 := Data; end; + 7: begin Inc(IntRegUsage); Registers.X7 := Data; end; + else + begin + SetLength(Stack, Length(Stack) + 8); + p := @Stack[Length(Stack) - 8]; + IPointer(p^) := Data; + end; + end; + end; + + procedure StoreFloatReg(const Data: Double; IsSingle: Boolean); + var + p: Pointer; + Bit: Integer; + begin + if FloatRegUsage < 8 then + begin + Bit := 1 shl FloatRegUsage; + if IsSingle then + Registers.FloatBits := Registers.FloatBits or Bit; + case FloatRegUsage of + 0: _D0 := Data; + 1: Registers.D1 := Data; + 2: Registers.D2 := Data; + 3: Registers.D3 := Data; + 4: Registers.D4 := Data; + 5: Registers.D5 := Data; + 6: Registers.D6 := Data; + 7: Registers.D7 := Data; + end; + Inc(FloatRegUsage); + end else begin + SetLength(Stack, Length(Stack) + 8); + p := @Stack[Length(Stack) - 8]; + Double(p^) := Data; + end; + end; + + procedure StoreStack(const aData; Len: Integer); + var + p: Pointer; + begin + if (Len > 8) and ((Length(Stack) mod 16) <> 0) then + SetLength(Stack, Length(Stack) + (16 - (Length(Stack) mod 16))); + SetLength(Stack, Length(Stack) + Len); + p := @Stack[Length(Stack) - Len]; + Move(aData, p^, Len); + end; + + function GetPtr(fVar: PPSVariantIFC): Boolean; + var + VarPtr: Pointer; + p: Pointer; + begin + Result := False; + if FVar = nil then + Exit; + + if fVar.VarParam then + begin + case fvar.aType.BaseType of + btArray: + begin + if Copy(fvar.aType.ExportName, 1, 10) = '!OPENARRAY' then + begin + p := CreateOpenArray(True, Self, FVar); + if p = nil then + Exit; + CallData.Add(p); + StoreIntReg(IPointer(POpenArray(p)^.Data)); + StoreIntReg(IPointer(POpenArray(p)^.ItemCount - 1)); + Result := True; + Exit; + end; + VarPtr := fvar.Dta; + end; + btVariant, btSet, btStaticArray, btRecord, btInterface, btClass, + {$IFNDEF PS_NOWIDESTRING}btUnicodeString, btWideString, btWideChar,{$ENDIF} + btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, + btExtended, btString, btPChar, btChar, btCurrency + {$IFNDEF PS_NOINT64}, btS64, btU64{$ENDIF}: + VarPtr := fvar.Dta; + else + Exit; + end; + StoreIntReg(IPointer(VarPtr)); + end else begin + case fVar^.aType.BaseType of + btSet: + case TPSTypeRec_Set(fvar.aType).aByteSize of + 1: StoreIntReg(IPointer(Byte(fvar.dta^))); + 2: StoreIntReg(IPointer(Word(fvar.dta^))); + 3, 4: StoreIntReg(IPointer(Cardinal(fvar.dta^))); + 5, 6, 7, 8: StoreIntReg(IPointer(fVar.Dta^)); + else + StoreIntReg(IPointer(fvar.Dta)); + end; + btArray: + begin + if Copy(fvar^.aType.ExportName, 1, 10) = '!OPENARRAY' then + begin + p := CreateOpenArray(False, Self, FVar); + if p = nil then + Exit; + CallData.Add(p); + StoreIntReg(IPointer(POpenArray(p)^.Data)); + StoreIntReg(IPointer(POpenArray(p)^.ItemCount - 1)); + Result := True; + Exit; + end; + {$IFDEF FPC} + StoreIntReg(IPointer(FVar.Dta)); + {$ELSE} + StoreIntReg(IPointer(FVar.Dta^)); + {$ENDIF} + end; + btRecord: + begin + if fvar^.aType.RealSize <= SizeOf(IPointer) then + StoreIntReg(IPointer(fvar.dta^)) + else if fvar^.aType.RealSize <= 16 then + StoreStack(fvar.Dta^, fvar^.aType.RealSize) + else + StoreIntReg(IPointer(fVar.Dta)); + end; + btVariant, btStaticArray: + StoreIntReg(IPointer(fVar.Dta)); + btExtended, btDouble: + StoreFloatReg(Double(fvar.dta^), False); + btCurrency: + StoreIntReg(IPointer(fvar.dta^)); + btSingle: + StoreFloatReg(Single(fvar.dta^), True); + btChar, btU8, btS8: + StoreIntReg(IPointer(Byte(fVar^.dta^))); + {$IFNDEF PS_NOWIDESTRING} + btWideChar, + {$ENDIF} + btU16, btS16: + StoreIntReg(IPointer(Word(FVar^.dta^))); + btU32, btS32: + StoreIntReg(IPointer(Cardinal(FVar^.dta^))); + btPChar: + if Pointer(fvar^.dta^) = nil then + StoreIntReg(IPointer(@EmptyPChar)) + else + StoreIntReg(IPointer(fvar^.dta^)); + btClass, btInterface, btString{$IFNDEF PS_NOWIDESTRING}, btWideString, btUnicodeString{$ENDIF}: + StoreIntReg(IPointer(fvar^.dta^)); + btProcPtr: + begin + GetMem(p, PointerSize2); + TMethod(p^) := MKMethod(Self, Longint(FVar.Dta^)); + StoreStack(p^, PointerSize2); + FreeMem(p); + end; + {$IFNDEF PS_NOINT64} + btS64: + StoreIntReg(IPointer(Int64(fvar^.dta^))); + btU64: + StoreIntReg(IPointer(UInt64(fvar^.dta^))); + {$ENDIF} + else + Exit; + end; + end; + Result := True; + end; +begin +{$IFDEF FPC} + if (Integer(CallingConv) and 128) <> 0 then + begin + IsVirtualCons := True; + CallingConv := TPSCallingConvention(Integer(CallingConv) and not 128); + end else + IsVirtualCons := False; + if (Integer(CallingConv) and 64) <> 0 then + begin + IsConstructor := True; + CallingConv := TPSCallingConvention(Integer(CallingConv) and not 64); + end else + IsConstructor := False; +{$ENDIF} + + InnerfuseCall := False; + if Address = nil then + Exit; + + SetLength(Stack, 0); + CallData := TPSList.Create; + res := rp(res); + if res <> nil then + res.VarParam := True; + try + FillChar(Registers, SizeOf(Registers), 0); + _X0 := 0; + _D0 := 0; + IntRegUsage := 0; + FloatRegUsage := 0; + + {$IF DEFINED(FPC) and (FPC_VERSION >= 3)} + if IsConstructor then + begin + if not GetPtr(rp(Params[0])) then + Exit; + DisposePPSVariantIFC(Params[0]); + Params.Delete(0); + end; + {$ENDIF} + + if Assigned(_Self) then + StoreIntReg(IPointer(_Self)); + + if Assigned(res) then + begin + case res^.aType.BaseType of + btRecord, btSet: + if res.aType.RealSize > 16 then + begin + Registers.X8 := IPointer(res.Dta); + {$IFNDEF MSWINDOWS} + // FPC AArch64 managed-result ABI uses a hidden first argument in x0. + StoreIntReg(IPointer(res.Dta)); + {$ENDIF} + end; + btString, {$IFNDEF PS_NOWIDESTRING}btWideString, btUnicodeString,{$ENDIF} + btInterface, btArray, btVariant, btStaticArray: + begin + Registers.X8 := IPointer(res.Dta); + {$IFNDEF MSWINDOWS} + // Keep x8 for C-style ABI while also passing hidden result in x0 for Pascal ABI. + StoreIntReg(IPointer(res.Dta)); + {$ENDIF} + end; + end; + if res^.aType.BaseType = btSingle then + Registers.FloatBits := Registers.FloatBits or 256; + end; + + for I := 0 to Params.Count - 1 do + if not GetPtr(rp(Params[I])) then + Exit; + + if (Length(Stack) mod 16) <> 0 then + SetLength(Stack, Length(Stack) + (16 - (Length(Stack) mod 16))); + + if Length(Stack) = 0 then + pp := nil + else + pp := @Stack[0]; + + arm64call(Address, _X0, _D0, Registers, pp, Length(Stack) div 8); + + if Assigned(res) then + begin + case res^.aType.BaseType of + btRecord, btSet: + if res.aType.RealSize <= 8 then + case res.aType.RealSize of + 1: Byte(res.Dta^) := _X0; + 2: Word(res.Dta^) := _X0; + 3, 4: Cardinal(res.Dta^) := _X0; + 5, 6, 7, 8: IPointer(res.Dta^) := _X0; + end; + btSingle: tbtsingle(res.Dta^) := _D0; + btDouble: tbtdouble(res.Dta^) := _D0; + btExtended: tbtextended(res.Dta^) := _D0; + btChar, btU8, btS8: tbtu8(res.dta^) := _X0; + {$IFNDEF PS_NOWIDESTRING} + btWideChar, + {$ENDIF} + btU16, btS16: tbtu16(res.dta^) := _X0; + btClass: IPointer(res.dta^) := _X0; + btU32, btS32: tbtu32(res.dta^) := _X0; + btPChar: pansichar(res.dta^) := Pansichar(_X0); + {$IFNDEF PS_NOINT64} + btS64: tbts64(res.dta^) := Int64(_X0); + {$ENDIF} + btCurrency: tbts64(res.Dta^) := Int64(_X0); + btInterface, btVariant, btStaticArray, btArray, + btString{$IFNDEF PS_NOWIDESTRING}, btWideString, btUnicodeString{$ENDIF}: ; + else + Exit; + end; + end; + + Result := True; + finally + for I := CallData.Count - 1 downto 0 do + begin + pp := CallData[I]; + case pp^ of + 0: DestroyOpenArray(Self, Pointer(pp)); + end; + end; + CallData.Free; + end; +end; diff --git a/Source/arm64sysv-linux.o b/Source/arm64sysv-linux.o new file mode 100644 index 0000000000000000000000000000000000000000..1385ddc6cfa16aec9d426be243f18067a364b48a GIT binary patch literal 1048 zcmbVJJ4*vW5T3hD&PNfVh>AkcAn}0&5y^>-tD*?nX(3pcOB4*m#$2HW(MGY1KOw&F zDhojbK?^%eA^$-;jWM|*#JSC$InJcXz}`3W-F!PcGY7MabD|)CWdhtoC9+t66|v$| z=2BXNjPH6H(6*qW=(=o+oa-Lx8*Yul=`Dbnx{9 zHLu6Cuy6#0yab==QfXP+qYp6v`B0>ICA6gwVLIXqi_}QtIg_Yy-b{@P4>c}Zsd3d# zjq5II-1w*wgGM>+FY9g*1=PjBE1v~8hbS_xQ$8Q!oQaIc^lF yPrZ7xOttM;^;5i<8__&wEz>&708NO_+U!5S)Wh>EaJJP_Lm%M!VN1x-ss9Czbd%2j literal 0 HcmV?d00001 diff --git a/Source/arm64sysv-macos.o b/Source/arm64sysv-macos.o new file mode 100644 index 0000000000000000000000000000000000000000..e31b19e475971dab4b2a5faf2c669a39a62eaf28 GIT binary patch literal 696 zcmbV}ze_?<6vxkd*B?<~5mDA4;SkjjBH@#kZblHa1UUo^Pm=~gA;KY&z@=u}8uPdB zO${wUkVBh8L*V~V&`@Uj0<&}PyAK_jy70ZZb3tE`iJDuB5g0Wvv|}T8Dt%B$EC~WW7a*{zYth zo7nYf32t9L&YpX*#riAu)Gugf`y4uL2fXKcy|8vl@8SSTMy5CtCbQ@eI`BkfYUEIP z2Q>=A)F`^BQJSDed5Rj9S!z^0)QH27lJlB`g(V*@#;(c@%bB^FI2AdyNQ`FIt;FL~IF0{{R3 literal 0 HcmV?d00001 diff --git a/Source/arm64sysv.S b/Source/arm64sysv.S new file mode 100644 index 00000000..40388503 --- /dev/null +++ b/Source/arm64sysv.S @@ -0,0 +1,114 @@ +.text +.align 2 +#ifdef __APPLE__ +.globl _arm64call +.p2align 2 +_arm64call: +#else +.globl arm64call +.type arm64call, %function +arm64call: +#endif + stp x29, x30, [sp, #-64]! + mov x29, sp + stp x19, x20, [sp, #16] + stp x21, x22, [sp, #32] + stp x23, x24, [sp, #48] + + mov x24, x0 + mov x19, x1 + mov x20, x2 + mov x21, x3 + mov x22, x4 + mov x23, x5 + + cbz x23, 1f + lsl x9, x23, #3 + sub sp, sp, x9 + mov x10, sp +0: + ldr x11, [x22], #8 + str x11, [x10], #8 + subs x23, x23, #1 + b.ne 0b +1: + ldr w9, [x21, #120] + + tbnz w9, #0, 2f + ldr d0, [x20] + b 3f +2: + ldr d16, [x20] + fcvt s0, d16 +3: + ldr x0, [x19] + ldr x1, [x21, #0] + ldr x2, [x21, #8] + ldr x3, [x21, #16] + ldr x4, [x21, #24] + ldr x5, [x21, #32] + ldr x6, [x21, #40] + ldr x7, [x21, #48] + ldr x8, [x21, #56] + + tbnz w9, #1, 4f + ldr d1, [x21, #64] + b 5f +4: ldr d16, [x21, #64] + fcvt s1, d16 +5: + tbnz w9, #2, 6f + ldr d2, [x21, #72] + b 7f +6: ldr d16, [x21, #72] + fcvt s2, d16 +7: + tbnz w9, #3, 8f + ldr d3, [x21, #80] + b 9f +8: ldr d16, [x21, #80] + fcvt s3, d16 +9: + tbnz w9, #4, 10f + ldr d4, [x21, #88] + b 11f +10: ldr d16, [x21, #88] + fcvt s4, d16 +11: + tbnz w9, #5, 12f + ldr d5, [x21, #96] + b 13f +12: ldr d16, [x21, #96] + fcvt s5, d16 +13: + tbnz w9, #6, 14f + ldr d6, [x21, #104] + b 15f +14: ldr d16, [x21, #104] + fcvt s6, d16 +15: + tbnz w9, #7, 16f + ldr d7, [x21, #112] + b 17f +16: ldr d16, [x21, #112] + fcvt s7, d16 +17: + blr x24 + + str x0, [x19] + tbnz w9, #8, 18f + str d0, [x20] + b 19f +18: + fcvt d16, s0 + str d16, [x20] +19: + mov sp, x29 + ldp x19, x20, [sp, #16] + ldp x21, x22, [sp, #32] + ldp x23, x24, [sp, #48] + ldp x29, x30, [sp], #64 + ret +#ifndef __APPLE__ +.size arm64call, .-arm64call +#endif diff --git a/Source/uPSRuntime.pas b/Source/uPSRuntime.pas index 3f28be64..adc43540 100644 --- a/Source/uPSRuntime.pas +++ b/Source/uPSRuntime.pas @@ -10538,9 +10538,13 @@ procedure DestroyOpenArray(Sender: TPSExec; V: POpenArray); {$IFDEF Delphi6UP} {$IFDEF CPUX64} {$include x64.inc} - {$ELSE} - {$include x86.inc} - {$ENDIF} + {$ELSE} + {$IFDEF CPUARM64} + {$include arm64.inc} + {$ELSE} + {$include x86.inc} + {$ENDIF} + {$ENDIF} {$ELSE} {$include x86.inc} {$ENDIF} @@ -10556,6 +10560,8 @@ procedure DestroyOpenArray(Sender: TPSExec; V: POpenArray); {$include x86.inc} {$elseif defined(cpupowerpc)} {$include powerpc.inc} + {$elseif defined(cpuaarch64)} + {$include arm64.inc} {$elseif defined(cpuarm)} {$include arm.inc} {$elseif defined(CPUX86_64)} @@ -12348,10 +12354,33 @@ function BGRFW(var s: tbtString): tbtString; s := ''; end; +function AlwaysAsVariable(aType: TPSTypeRec): Boolean; +begin + case atype.BaseType of + btVariant: Result := true; + btSet: Result := atype.RealSize > PointerSize; + btRecord: Result := atype.RealSize > PointerSize; + btStaticArray: Result := atype.RealSize > PointerSize; + else + Result := false; + end; +end; + +function ParamAsVariable(const Modifier: tbtchar; aType: TPSTypeRec): Boolean; +begin + Result := (Modifier = '%') or (Modifier = '!') or AlwaysAsVariable(aType); +end; + + + {$ifdef fpc} {$if defined(cpupowerpc) or defined(cpuarm) or defined(cpu64)} {$define empty_methods_handler} {$ifend} +{$else} + {$if defined(cpuarm)} + {$define empty_methods_handler} + {$ifend} {$endif} {$ifdef empty_methods_handler} @@ -12537,23 +12566,6 @@ function SupportsRegister(b: TPSTypeRec): Boolean; end; end; -function AlwaysAsVariable(aType: TPSTypeRec): Boolean; -begin - case atype.BaseType of - btVariant: Result := true; - btSet: Result := atype.RealSize > PointerSize; - btRecord: Result := atype.RealSize > PointerSize; - btStaticArray: Result := atype.RealSize > PointerSize; - else - Result := false; - end; -end; - -function ParamAsVariable(const Modifier: tbtchar; aType: TPSTypeRec): Boolean; -begin - Result := (Modifier = '%') or (Modifier = '!') or AlwaysAsVariable(aType); -end; - procedure PutOnFPUStackExtended(ft: extended); asm // fstp tbyte ptr [ft] From 656543a25452a7074ea1820363c9a31c3aefbe94 Mon Sep 17 00:00:00 2001 From: Tobias Giesen Date: Thu, 26 Mar 2026 14:50:00 +0100 Subject: [PATCH 2/4] Undo less relevant changes Undo less relevant changes --- Source/PascalScript.inc | 2 +- Source/PascalScriptFPC.inc | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/Source/PascalScript.inc b/Source/PascalScript.inc index 3abb6ffb..6ed5c1b8 100644 --- a/Source/PascalScript.inc +++ b/Source/PascalScript.inc @@ -11,7 +11,7 @@ {$INCLUDE eDefines.inc} -{$IFDEF FPC}{$MODE DELPHI}{$H+}{$ENDIF} +{$IFDEF FPC}{$H+}{$ENDIF} {$IFDEF VER125}{C4}{$B-}{$X+}{$T-}{$H+}{$ENDIF} {$IFDEF VER110}{C3}{$B-}{$X+}{$T-}{$H+}{$ENDIF} diff --git a/Source/PascalScriptFPC.inc b/Source/PascalScriptFPC.inc index fe74951a..cd97ada1 100644 --- a/Source/PascalScriptFPC.inc +++ b/Source/PascalScriptFPC.inc @@ -4,7 +4,7 @@ {$MODE DELPHIUNICODE} {$DEFINE UNICODE} {$ELSE} - // {$MODE DELPHI} // FPC 3.2.4: mode switch not allowed here + {$MODE DELPHI} {$ENDIF} {$IF (defined(cpuaarch64) or defined(cpuarm))} From e286965d822093af4a75246997cf1771045ebaa2 Mon Sep 17 00:00:00 2001 From: Tobias Giesen Date: Thu, 26 Mar 2026 14:51:32 +0100 Subject: [PATCH 3/4] Undo bogus reference to Windows arm64 include Undo bogus reference to Windows arm64 include --- Source/uPSRuntime.pas | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/Source/uPSRuntime.pas b/Source/uPSRuntime.pas index adc43540..d212cb26 100644 --- a/Source/uPSRuntime.pas +++ b/Source/uPSRuntime.pas @@ -10538,13 +10538,9 @@ procedure DestroyOpenArray(Sender: TPSExec; V: POpenArray); {$IFDEF Delphi6UP} {$IFDEF CPUX64} {$include x64.inc} - {$ELSE} - {$IFDEF CPUARM64} - {$include arm64.inc} - {$ELSE} - {$include x86.inc} - {$ENDIF} - {$ENDIF} + {$ELSE} + {$include x86.inc} + {$ENDIF} {$ELSE} {$include x86.inc} {$ENDIF} From e8e03505f8a3ad95361566cc1f4af4896ba6d6bd Mon Sep 17 00:00:00 2001 From: Tobias Giesen Date: Thu, 26 Mar 2026 18:54:16 +0100 Subject: [PATCH 4/4] Add Comments and clean-up unused lines for Windows Add Comments and clean-up unused lines for Windows --- Source/arm64.inc | 27 +++++++++++++++------------ Source/arm64sysv.S | 18 ++++++++++++++++++ 2 files changed, 33 insertions(+), 12 deletions(-) diff --git a/Source/arm64.inc b/Source/arm64.inc index 7398a384..ae1616d3 100644 --- a/Source/arm64.inc +++ b/Source/arm64.inc @@ -1,14 +1,17 @@ -{$IFDEF CPUARM64} - {$IFDEF MSWINDOWS} - {$L arm64win.obj} - {$ELSE} - {$IFDEF MACOS} - {$L arm64sysv-macos.o} - {$ELSE} - {$L arm64sysv-linux.o} - {$ENDIF} - {$ENDIF} -{$ELSE} +{ ARM64 runtime call bridge (FPC + Linux/macOS SysV only) + + This include contains the Pascal-side marshalling logic used by TPSExec.InnerfuseCall + on AArch64 targets. The low-level indirect call is delegated to arm64call in + arm64sysv.S. + + High-level flow: + 1) Convert TPSVariant arguments to ABI-ready integer/float register values. + 2) Spill overflow arguments to an aligned stack buffer. + 3) Prepare hidden-result arguments/registers for managed/indirect result types. + 4) Call arm64call, which performs the actual register+stack setup and BLR. + 5) Copy return values back into Pascal Script result storage. +} + {$IFDEF CPUAARCH64} {$IFDEF DARWIN} {$L arm64sysv-macos.o} @@ -16,7 +19,7 @@ {$L arm64sysv-linux.o} {$ENDIF} {$ENDIF} -{$ENDIF} + type TARM64Registers = packed record diff --git a/Source/arm64sysv.S b/Source/arm64sysv.S index 40388503..88643ad4 100644 --- a/Source/arm64sysv.S +++ b/Source/arm64sysv.S @@ -1,3 +1,21 @@ +/* + arm64sysv.S - AArch64 SysV indirect call shim for Pascal Script + + Inputs (from arm64.inc arm64call declaration): + x0 = Address (target function pointer) + x1 = &_X0 (integer return storage) + x2 = &_D0 (floating return storage) + x3 = &TARM64Registers (pre-marshalled integer/float register block) + x4 = Stack (pointer to overflow arguments, 8-byte slots) + x5 = Items (number of stack slots) + + Steps performed: + 1) Preserve callee-saved registers and keep stable frame pointers. + 2) Copy overflow slots from x4 into the real call stack (maintaining ABI alignment). + 3) Load x0..x8 and d0..d7 from marshalling buffers (including single/double conversion bits). + 4) BLR to the target function pointer. + 5) Store x0/d0 back via x1/x2 output pointers, restoring single->double when needed. +*/ .text .align 2 #ifdef __APPLE__