From https://pastebin.com/jzLgYeqm via Stefan Glienke with applied patch from http://qc.embarcadero.com/wc/qcmain.aspx?d=119146 that has more patches

PatchInt64Multiplication.pas

unit PatchInt64Multiplication;

interface

implementation

{$IF Defined(MSWINDOWS) and not Defined(CPUX64)}
uses
  SysUtils,
  Windows;

function GetActualAddr(Proc: Pointer): Pointer;
type
  PAbsoluteIndirectJmp = ^TAbsoluteIndirectJmp;
  TAbsoluteIndirectJmp = packed record
    OpCode: Word;
    Addr: PPointer;
  end;
begin
  Result := Proc;
  if (Proc <> nil) and (PAbsoluteIndirectJmp(Proc).OpCode = $25FF) then
    Result := PAbsoluteIndirectJmp(Proc).Addr^;
end;

procedure RedirectFunction(OrgProc, NewProc: Pointer);
type
  TJmpBuffer = packed record
    Jmp: Byte;
    Offset: Integer;
  end;
var
  n: UINT_PTR;
  JmpBuffer: TJmpBuffer;
begin
  JmpBuffer.Jmp := $E9;
  JmpBuffer.Offset := PByte(NewProc) - (PByte(OrgProc) + 5);
  if not WriteProcessMemory(GetCurrentProcess, OrgProc, @JmpBuffer, SizeOf(JmpBuffer), n) then
    RaiseLastOSError;
end;

procedure __llmulo_patch;
asm
  test    edx, edx           {Param1-Hi = 0?}
  jne     @@Large            {No, More than one multiply may be needed}
  cmp     edx, [esp+8]       {Param2-Hi = 0?}
  jne     @@Large            {No, More than one multiply may be needed}
  mul     dword ptr [esp+4]  {Only one multiply needed, Set Result}
  and     eax, eax           {Clear Overflow Flag}
  ret     8
@@Large:
  sub     esp, 28            {allocate local storage}
  mov     [esp], ebx         {save used registers}
  mov     [esp+4], esi
  mov     [esp+8], edi
  mov     [esp+12], ebp
  mov     ebx, [esp+32]      {Param2-Lo}
  mov     ecx, [esp+36]      {Param2-Hi}
  mov     esi, edx
  mov     edi, ecx
  sar     esi, 31
  sar     edi, 31
  xor     eax, esi
  xor     edx, esi
  sub     eax, esi
  sbb     edx, esi           {edx:eax (a1:a0) = abs(Param1)}
  xor     ebx, edi
  xor     ecx, edi
  sub     ebx, edi
  sbb     ecx, edi           {ecx:ebx (b1:b0) = abs(Param2)}
  xor     esi, edi           {Sign Flag, 0 if Params have same sign else -1}
  mov     [esp+16], eax      {a0}
  mov     [esp+20], edx      {a1}
  mov     [esp+24], ecx      {b1}
  mul     ebx                {edx:eax (c1:c0) = a0*b0}
  xchg    ebx, edx           {ebx = c1, edx = b0}
  mov     edi, eax           {abs(Result-Lo) = c0}
  xor     ecx, ecx           {Upper 32 bits of 128 bit result}
  xor     ebp, ebp           {Second 32 bits of 128 bit result}
  mov     eax, [esp+20]      {a1}
  mul     edx                {edx:eax (d1:d0) = a1*b0}
  add     ebx, eax           {c1 + d0}
  adc     ebp, edx           {d1 + carry}
  adc     ecx, 0             {Possible carry into Upper 32 bits}
  mov     eax, [esp+16]      {a0}
  mov     edx, [esp+24]      {b1}
  mul     edx                {edx:eax (e1:e0) = a0*b1}
  add     ebx, eax           {abs(Result-Hi) = c1 + d0 + e0}
  adc     ebp, edx           {d1 + e1 + carry}
  adc     ecx, 0             {Possible carry into Upper 32 bits}
  mov     eax, [esp+20]      {a1}
  mov     edx, [esp+24]      {b1}
  mul     edx                {edx:eax (f1:f0) = a1*b1}
  add     ebp, eax           {d1 + e1 + f0 + carry}
  adc     ecx, edx           {f1 + carry}
  or      ecx, ebp           {Overflow if ecx <> 0 or ebp <> 0}
  jnz     @@Overflow
  mov     edx, ebx           {Set abs(Result-Hi)}
  mov     eax, edi           {Set abs(Result-Lo)}
  cmp     edx, $80000000
  jae     @@CheckRange       {Possible Overflow if edx>=$80000000}
@@SetSign:
  xor     eax, esi           {Correct Sign of Result}
  xor     edx, esi
  sub     eax, esi
  sbb     edx, esi
  mov     ebx, [esp]         {restore used registers}
  mov     esi, [esp+4]
  mov     edi, [esp+8]
  mov     ebp, [esp+12]
  add     esp, 28            {Clears Overflow flag}
  ret     8
@@CheckRange:
  jne     @@Overflow         {Overflow if edx>$80000000}
  test    esi, esi           {edx=$80000000, Is Sign Flag=0?}
  jnz     @@SetSign          {No, Result is Ok (-MaxInt64)}
@@Overflow:
  mov     ebx, [esp]         {restore used registers}
  mov     esi, [esp+4]
  mov     edi, [esp+8]
  mov     ebp, [esp+12]
  add     esp, 28
  mov     ecx, $80000000
  dec     ecx                {Set Overflow Flag}
  ret     8
end;

function GetSystem__llmulo: Pointer;
asm
  mov eax,offset System.@_llmulo
end;

procedure PatchIt;
begin
  RedirectFunction(GetActualAddr(GetSystem__llmulo), @__llmulo_patch);
end;

initialization
  PatchIt;
{$IFEND}

end.