#2 mORMot 1 » [patch] SynFPCCMemAligned for support jemalloc,tbbmalloc on windows » 2019-02-19 12:29:38

witya
Replies: 3

--- SynFPCCMemAligned.pa_    2019-02-19 17:09:00.794997800 +0700
+++ SynFPCCMemAligned.pas    2019-02-19 19:24:42.010596200 +0700
@@ -117,11 +117,14 @@

{$else}

+{$ifndef MSWINDOWS}
uses
   {$ifdef LINUXNOTBSD}
   cthreads, // as required by libraries - will also link needed glibc
   {$endif LINUXNOTBSD}
   dl;
+{$endif}
+

// late-binding API calls to the external malloc libraries

@@ -198,7 +201,11 @@
var
   OldMM: TMemoryManager;
   {$ifndef FPC_SYNCMEM}
-  lib: pointer;
+    {$ifdef MSWINDOWS}
+      lib:THandle;
+    {$else}
+      lib: pointer;
+    {$endif}
   {$endif FPC_SYNCMEM}

{$I-}
@@ -208,30 +215,59 @@
   //writeln('using glibc');
   {$else}
   {$ifdef FPC_SYNJEMALLOC} // jemalloc 3.6 seems slower, but maybe less fragmented
-  lib := dlopen('libjemalloc.so.1', RTLD_LAZY);
-  if lib <> nil then begin
-    pointer(@malloc)  := dlsym(lib, 'malloc');
-    pointer(@calloc)  := dlsym(lib, 'calloc');
-    pointer(@free)    := dlsym(lib, 'free');
-    pointer(@realloc) := dlsym(lib, 'realloc');
-    pointer(@msize)   := dlsym(lib, 'malloc_usable_size');
-    //writeln('using jemalloc');
-  end else
-    writeln(StdErr, dlerror, '  [apt-get install libjemalloc1]');
+    {$ifdef MSWINDOWS}
+    lib:=LoadLibrary('jemalloc.dll');
+    if lib = 0 then
+      writeln(StdErr, dlerror, '  [install jemalloc.dll]')
+    else begin
+      pointer(@malloc)  := GetProcAddress(lib, 'malloc');
+      pointer(@calloc)  := GetProcAddress(lib, 'calloc');
+      pointer(@free)    := GetProcAddress(lib, 'free');
+      pointer(@realloc) := GetProcAddress(lib, 'realloc');
+      pointer(@msize)   := GetProcAddress(lib, 'malloc_usable_size');
+      //writeln('using jemalloc');
+    end;
+    {$else}
+    lib := dlopen('libjemalloc.so.1', RTLD_LAZY);
+    if lib = nil then
+      writeln(StdErr, dlerror, '  [apt-get install libjemalloc1]')
+    else begin
+      pointer(@malloc)  := dlsym(lib, 'malloc');
+      pointer(@calloc)  := dlsym(lib, 'calloc');
+      pointer(@free)    := dlsym(lib, 'free');
+      pointer(@realloc) := dlsym(lib, 'realloc');
+      pointer(@msize)   := dlsym(lib, 'malloc_usable_size');
+      //writeln('using jemalloc');
+    end;
+    {$endif}
   {$else}
-  lib := dlopen('libtbbmalloc.so.2', RTLD_LAZY);
-  if lib = nil then
-   lib := dlopen('libtbbmalloc.so', RTLD_LAZY);
-  if lib = nil then
-    writeln(StdErr, dlerror, '  [apt-get install libtbb2]')
-  else begin
-    pointer(@malloc)  := dlsym(lib, 'scalable_malloc');
-    pointer(@calloc)  := dlsym(lib, 'scalable_calloc');
-    pointer(@free)    := dlsym(lib, 'scalable_free');
-    pointer(@realloc) := dlsym(lib, 'scalable_realloc');
-    pointer(@msize)   := dlsym(lib, 'scalable_msize');
+    {$ifdef MSWINDOWS}
+     lib:=LoadLibrary('tbbmalloc.dll');
+     if lib = 0 then
+       writeln(StdErr, dlerror, '  [install tbbmalloc.dll]')
+     else begin
+       pointer(@malloc)  := GetProcAddress(lib, 'scalable_malloc');
+       pointer(@calloc)  := GetProcAddress(lib, 'scalable_calloc');
+       pointer(@free)    := GetProcAddress(lib, 'scalable_free');
+       pointer(@realloc) := GetProcAddress(lib, 'scalable_realloc');
+       pointer(@msize)   := GetProcAddress(lib, 'scalable_msize');
+       //writeln('using Intel TBB');
+     end;
+    {$else}
+    lib := dlopen('libtbbmalloc.so.2', RTLD_LAZY);
+    if lib = nil then
+     lib := dlopen('libtbbmalloc.so', RTLD_LAZY);
+    if lib = nil then
+      writeln(StdErr, dlerror, '  [apt-get install libtbb2]')
+    else begin
+      pointer(@malloc)  := dlsym(lib, 'scalable_malloc');
+      pointer(@calloc)  := dlsym(lib, 'scalable_calloc');
+      pointer(@free)    := dlsym(lib, 'scalable_free');
+      pointer(@realloc) := dlsym(lib, 'scalable_realloc');
+      pointer(@msize)   := dlsym(lib, 'scalable_msize');
     //writeln('using Intel TBB');
-  end;
+    end;
+    {$endif}
   {$endif FPC_SYNJEMALLOC}
   {$endif FPC_SYNCMEM}
   if pointer(@msize) <> nil then begin
@@ -253,8 +289,13 @@
   if pointer(@msize) <> nil then begin
     SetMemoryManager(OldMM);
     {$ifndef FPC_SYNCMEM}
-    if lib <> nil then
-      dlclose(lib);
+      {$ifdef MSWINDOWS}
+      if lib <> 0 then
+        FreeLibrary(lib);
+      {$else}
+      if lib <> nil then
+        dlclose(lib);
+      {$endif}
     {$endif FPC_SYNCMEM}
   end;
end.

#3 mORMot 1 » [patch] SynCrossPlatformJSON InitFrom VariantDynArray » 2017-01-03 02:03:01

witya
Replies: 1

--- SynCrossPlatformJSON.pas.bak    2017-01-03 08:44:28.709044000 +0700
+++ SynCrossPlatformJSON.pas    2017-01-03 08:52:29.788560100 +0700
@@ -1655,6 +1655,7 @@
   Init;
   VKind := jvArray;
   Values := aValues;
+  VCount := Length(aValues);
end;

procedure TJSONVariantData.AddNameValue(const aName: string;

#4 mORMot 1 » Patch json for boolean type support » 2016-03-18 21:39:58

witya
Replies: 0

json.org

value.gif

--- SynCrossPlatformJSON.pas    2016-03-17 15:44:50.000000000 +0700
+++ SynCrossPlatformJSON_patch.pas    2016-03-19 15:17:54.000000000 +0700
@@ -803,6 +803,12 @@
     result := ValueToJSON(PVariant(TVarData(Value).VPointer)^) else
   if TVarData(Value).VType<=varNull then
     result := 'null' else
+  if TVarData(Value).VType=varBoolean then begin
+    if Value then
+      result := 'true'
+    else
+      Result := 'false'
+  end else       
   if VarIsOrdinal(Value) then begin
     I64 := Value;
     result := IntToStr(I64);
@@ -835,7 +841,7 @@
   {$endif}
   vtPWideChar:  result := string(VPWideChar);
   vtWideChar:   result := string(VWideChar);
-  vtBoolean:    if VBoolean then result := '1' else result := '0';
+  vtBoolean:    if VBoolean then result := 'true' else result := 'false';
   vtInteger:    result := IntToStr(VInteger);
   vtInt64:      result := IntToStr(VInt64^);
   vtCurrency:   DoubleToJSON(VCurrency^,result);


Sample Test

doc:=JSONVariant('{}');
doc.Name:='John';
doc.Active:=True;
println(doc)

result before path
{"Name":"John","Active":-1}

result after patch
{"Name":"John","Active":true}

#5 mORMot 1 » Bug in StringToJSON with control character » 2015-09-25 11:21:52

witya
Replies: 1

Fix

if Text[i]<' ' then
      result := result+'\'+IntToHex(ord(Text[i]),4)

with

if Text[i]<' ' then
      result := result+'\u'+IntToHex(ord(Text[i]),4)

reference www.json.org

char
any-Unicode-character-
    except-"-or-\-or-
    control-character
\"
\\
\/
\b
\f
\n
\r
\t
\u four-hex-digits

string.gif

Board footer

Powered by FluxBB