Skip to content

Commit

Permalink
remove any direct call to mormot.core.fpcx64mm methods
Browse files Browse the repository at this point in the history 
- because it triggered some weird GPF problems on some conditions
- because FPC_X64MM is usually not set when compiling the mORMot package, and only enabled at project level
- with still RTL redirections on FPC x86_64
  • Loading branch information
Arnaud Bouchez committed Jul 15, 2022
1 parent 94f486b commit 99f9a27
Show file tree
Hide file tree
Showing 5 changed files with 47 additions and 74 deletions.
28 changes: 10 additions & 18 deletions src/core/mormot.core.base.asmx64.inc
View file
Expand Up @@ -569,10 +569,7 @@ end;

{$ifdef FPC}

{$ifndef FPC_X64MM}
procedure _Getmem; external name 'FPC_GETMEM'; // call standard FPC MM
procedure _Freemem; external name 'FPC_FREEMEM';
{$endif FPC_X64MM}
procedure fpc_freemem; external name 'FPC_FREEMEM'; // access to RTL from asm

procedure FastAssignNew(var d; s: pointer); nostackframe; assembler;
asm
Expand All @@ -584,15 +581,14 @@ asm
{$ifdef STRCNT32}
cmp dword ptr [rax - _STRCNT], 0 // refcnt=-1 for const
jl @z
lock dec dword ptr [rax - _STRCNT]
lock dec dword ptr [rax - _STRCNT]
{$else}
cmp qword ptr [rax - _STRCNT], 0 // refcnt=-1 for const
jl @z
lock dec qword ptr [rax - _STRCNT]
lock dec qword ptr [rax - _STRCNT]
{$endif STRCNT32}
jbe @free
@z: ret
@free: jmp _Freemem
jbe fpc_freemem
@z:
end;

{$endif FPC}
Expand Down Expand Up @@ -630,8 +626,7 @@ asm // Windows x64 calling convention expects to preserve XMM6-XMM15
movups dqword ptr [bak6], xmm6
movups dqword ptr [bak7], xmm7
movups dqword ptr [bak8], xmm8
{$else}
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
{$else} {$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif}
mov r8, rdx
mov rcx, rdi
mov rdx, rsi
Expand Down Expand Up @@ -730,8 +725,7 @@ asm // Windows x64 calling convention expects to preserve XMM6-XMM15
movups dqword ptr [bak6], xmm6
movups dqword ptr [bak7], xmm7
movups dqword ptr [bak8], xmm8
{$else}
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
{$else} {$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif}
mov r8, rdx
mov rcx, rdi
mov rdx, rsi
Expand Down Expand Up @@ -1085,8 +1079,7 @@ asm // Windows x64 calling convention expects to preserve XMM6-XMM15
mov rsi, r8 // rsi = b64
mov r8, rdx // r8 = blen
mov rdi, rcx // rdi = b
{$else}
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
{$else} {$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif}
mov r8, rsi // r8 = blen
mov rsi, rdx // rsi = b64 rdi = b
{$endif WIN64ABI}
Expand Down Expand Up @@ -1272,9 +1265,8 @@ asm // Windows x64 calling convention expects to preserve XMM6-XMM15
mov rsi, rdx
mov rdx, r8
mov rdi, rcx
{$else}
{$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif FPC}
{$endif WIN64ABI}
{$else} {$ifdef FPC}nostackframe; assembler; asm {$else} asm .noframe {$endif}
{$endif WIN64ABI}
// rcx/rdi=b64 rdx/rsi=b64len r8/rdx=b
// on decoding error, b64 will point to the faulty input
mov r8, qword ptr [rsi]
Expand Down
15 changes: 3 additions & 12 deletions src/core/mormot.core.base.pas
View file
Expand Up @@ -3840,15 +3840,6 @@ implementation
Windows; // circumvent unexpected warning about inlining (WTF!)
{$endif ISDELPHI20062007}

{$ifdef FPC_X64MM} // for direct string access to our fpcx64mm Memory Manager
{$ifdef CPUX64}
uses
mormot.core.fpcx64mm;
{$else}
{$undef FPC_X64MM}
{$endif CPUX64}
{$endif FPC_X64MM}

{$ifdef FPC}
// globally disable some FPC paranoid warnings - rely on x86_64 as reference
{$WARN 4056 off : Conversion between ordinals and pointers is not portable }
Expand Down Expand Up @@ -4157,14 +4148,14 @@ function FastNewString(len, codepage: PtrInt): PAnsiChar;
result := nil;
if len > 0 then
begin
{$ifdef FPC_X64MM}
P := _GetMem(len + (_STRRECSIZE + 4));
{$ifdef FPC}
P := GetMem(len + (_STRRECSIZE + 4));
result := PAnsiChar(P) + _STRRECSIZE;
{$else}
GetMem(result, len + (_STRRECSIZE + 4));
P := pointer(result);
inc(PStrRec(result));
{$endif FPC_X64MM}
{$endif FPC}
{$ifdef HASCODEPAGE} // also set elemSize := 1
{$ifdef FPC}
P^.codePageElemSize := codepage + (1 shl 16);
Expand Down
61 changes: 32 additions & 29 deletions src/core/mormot.core.rtti.fpc.inc
View file
Expand Up @@ -626,24 +626,23 @@ procedure fpc_dynarray_incr_ref; external name 'FPC_DYNARRAY_INCR_REF';
procedure fpc_dynarray_decr_ref; external name 'FPC_DYNARRAY_DECR_REF';
procedure fpc_dynarray_clear; external name 'FPC_DYNARRAY_CLEAR';
procedure fpc_variant_init; external name 'FPC_VARIANT_INIT';
{$ifdef FPC_X64MM}
function fpc_getmem(size: PtrUInt): pointer; external name 'FPC_GETMEM';
procedure fpc_freemem; external name 'FPC_FREEMEM';
{$else}
procedure _Freemem(p: pointer); external name 'FPC_FREEMEM';
{$endif FPC_X64MM}
procedure fpc_getmem; external name 'FPC_GETMEM';
procedure fpc_freemem(p: pointer); external name 'FPC_FREEMEM';

procedure PatchJmp(old, new: PByteArray; size: PtrInt; jmp: PtrUInt = 0);
var
rel: PCardinal;
begin
PatchCode(old, new, size, nil, {unprotected=}true);
if jmp = 0 then
jmp := PtrUInt(@_Freemem);
repeat // search and fix "jmp rel _Freemem"
jmp := PtrUInt(@fpc_freemem);
repeat // search and fix "jmp rel fpc_freemem"
dec(size);
if size = 0 then
begin
//writeln('not found');
exit;
end;
rel := @old[size + 1];
until (old[size] = $e9) and
(rel^ = cardinal(jmp - PtrUInt(@new[size]) - 5));
Expand All @@ -670,7 +669,7 @@ asm
jbe @free
@z: ret
@free: sub p, _STRRECSIZE
jmp _Freemem
jmp fpc_freemem
end;

procedure _ansistr_incr_ref(p: pointer); nostackframe; assembler;
Expand Down Expand Up @@ -723,7 +722,7 @@ asm
{$endif STRCNT32}
ja @n
@free: sub d, _STRRECSIZE
jmp _Freemem
jmp fpc_freemem
@n:
end;

Expand Down Expand Up @@ -838,7 +837,7 @@ begin
if Info <> nil then
FastFinalizeArray(pointer(PAnsiChar(p) + SizeOf(p^)), Info, p^.high + 1);
end;
_Freemem(p);
fpc_freemem(p);
end;

procedure _dynarray_decr_ref(var p: Pointer; info: pointer); nostackframe; assembler;
Expand Down Expand Up @@ -870,8 +869,6 @@ begin // the caller ensured s := ''
MoveFast(buf^, s^, len);
end;

{$ifdef FPC_X64MM}

procedure _ansistr_setlength_new(var s: pointer; len: PtrInt; cp: cardinal);
var
p, new: PAnsiChar;
Expand Down Expand Up @@ -909,16 +906,14 @@ asm
push s
sub qword ptr [s], _STRRECSIZE
add len, _STRRECSIZE + 1
call _reallocmem // rely on MM in-place detection
call ReallocMem // rely on MM in-place detection
pop s
pop len
add qword ptr [s], _STRRECSIZE
mov qword ptr [rax].TStrRec.length, len
mov byte ptr [rax + len + _STRRECSIZE], 0
end;

{$endif FPC_X64MM}

procedure _ansistr_concat_convert(var dest: RawByteString;
const s1, s2: RawByteString; cp, cp1, cp2: cardinal);
var
Expand Down Expand Up @@ -1001,12 +996,7 @@ begin
if pointer(s1) = pointer(dest) then
begin
// dest := dest+s2 -> self-resize dest
{$ifdef FPC_X64MM}
_ansistr_setlength(dest, l1 + _lstrlen(s2), cp);
{$else}
SetLength(dest, l1 + _lstrlen(s2));
{$endif FPC_X64MM}
PStrRec(PtrUInt(dest) - _STRRECSIZE)^.codePage := cp;
MoveFast(pointer(s2)^, PByteArray(dest)[l1], _lstrlen(s2));
end
else
Expand Down Expand Up @@ -1144,6 +1134,16 @@ begin // = call fpc_ansistr_decr_ref + call fpc_setstring_ansistr_pansichar
SetString(s, buf, len, cp);
end;

function _fpc_getmem(size: PtrInt): pointer;
begin
result := Getmem(size);
end;

procedure _fpc_freemem(p: pointer);
begin
Freemem(p);
end;

procedure RedirectRtlCall(dummy, dest: PByteArray; offset: PtrInt);
begin
dummy := @dummy[offset]; // offset to ignore e.g. call fpc_ansistr_decr_ref
Expand All @@ -1160,7 +1160,6 @@ end;

procedure RedirectRtlUtf8(dummy, dest: PByteArray);
begin
// POSIX only ABI: Windows is never natively UTF-8
repeat
if (dummy[0] = $b9) and
(PCardinal(@dummy[1])^ = CP_UTF8) then
Expand All @@ -1187,6 +1186,10 @@ end;
{$endif FPC_HAS_CPSTRING}

procedure RedirectRtl;
{$ifndef NOPATCHRTL}
var
mm: TMemoryManager;
{$endif NOPATCHRTL}
begin
{$ifndef NOPATCHRTL}
RedirectCode(@system.Move, @MoveFast);
Expand All @@ -1206,21 +1209,21 @@ begin
PatchCode(@fpc_variant_init, @_variant_init, $0f); // fpclen=$1f
{$ifdef FPC_HAS_CPSTRING}
RedirectRtlCall(@_fpc_setstring_ansistr, @_setstring_ansistr_pansichar, $2d);
// Delphi/Windows is never natively UTF-8, but FPC+Lazarus may be :)
// Delphi/Windows is never natively UTF-8, but FPC+Lazarus is very likely :)
if DefaultSystemCodePage = CP_UTF8 then
begin
// dedicated UTF-8 concatenation RTL function replacements
RedirectRtlUtf8(@_fpc_ansistr_concat, @_ansistr_concat_utf8);
RedirectRtlUtf8(@_fpc_ansistr_concat_multi, @_ansistr_concat_multi_utf8);
end;
{$ifdef FPC_X64MM}
RedirectCode(@fpc_ansistr_setlength, @_ansistr_setlength);
{$endif FPC_X64MM}
{$endif FPC_HAS_CPSTRING}
{$ifdef FPC_X64MM}
RedirectCode(@fpc_getmem, @_Getmem);
RedirectCode(@fpc_freemem, @_Freemem);
{$endif FPC_X64MM}
GetMemoryManager(mm); // will work with mormot.core.fpcx64mm and any other MM
RedirectRtlCall(@_fpc_getmem, @mm.Getmem, 0); // RTL calls
RedirectRtlCall(@_fpc_freemem, @mm.Freemem, 0);
RedirectCode(@fpc_getmem, @mm.Getmem); // asm calls
RedirectCode(@fpc_freemem, @mm.Freemem);
Freemem(nil);
{$endif NOPATCHRTL}
end;

Expand Down
15 changes: 1 addition & 14 deletions src/core/mormot.core.rtti.pas
View file
Expand Up @@ -2808,15 +2808,6 @@ function TObjectWithIDDynArrayHashOne(const Elem; Hasher: THasher): cardinal;

implementation

{$ifdef FPC_X64MM}
{$ifdef CPUX64}
uses
mormot.core.fpcx64mm; // for direct call of _getmem/_freemem in x86_64 asm
{$else}
{$undef FPC_X64MM}
{$endif CPUX64}
{$endif FPC_X64MM}


{ some inlined definitions which should be declared before $include code }

Expand Down Expand Up @@ -5333,11 +5324,7 @@ procedure StringClearSeveral(v: PPointer; n: PtrInt);
dec(p);
if (p^.refCnt >= 0) and
StrCntDecFree(p^.refCnt) then
{$ifdef FPC_X64MM}
_Freemem(p); // works for both rkLString + rkUString
{$else}
Freemem(p);
{$endif FPC_X64MM}
Freemem(p); // works for both rkLString + rkUString
end;
inc(v);
dec(n);
Expand Down
2 changes: 1 addition & 1 deletion src/mormot.commit.inc
View file
@@ -1 +1 @@
'2.0.3668'
'2.0.3669'

0 comments on commit 99f9a27

Please sign in to comment.