Runtime structure

Post by **idle** » Mon Jul 15, 2024 10:56 pm

It would be great if we could have runtime structure support mainly for use with json. Currently you have to marshal the jsoninsertStructure with the compile time structure reference when it could easily be done via a runtime mapping to load the structure layout table from a variable.

With the runtime reflection it's then possible to create an in memory object dB that's transparent to users and facilitates persisting data to file transparently with minimal code.

An example windows x64 asm, use the macro to set a json runtime structure

Code: Select all

JsonRuntimeStruct(*mypt,mpoint,"mpoint")     ;add Json runtime structure  
AddDb("mypt","mpoint",*mypt)                          ;uses a map but would in practice use a trie

and then when you go to persist or transfer data across a network you don't need to do a bunch of selects to manually insert a compile time structure

Code: Select all

Select *value\type 
      Case "PB_Integer" 
        index = AddJSONElement(obj) 
        keyval\value = PeekI(*value\value)   
        InsertJSONStructure(index, @keyval, keyval)
      Case "PB_UTF8" 
         index = AddJSONElement(obj)           
         InsertJSONStructure(index, @keyval, keyval)
         index = AddJSONElement(obj) 
         SetJSONString(index,PeekS(*value\value,-1,#PB_UTF8)) 
      Default                                                 ;default type is a strucutre 
        If FindMapElement(JsonRuntime(),*value\type)
          index = AddJSONElement(obj)           
          InsertJSONStructure(index, @keyval,keyval)
          index = AddJSONElement(obj) 
          gJsonAdr = JsonRuntime()\JsonAdr
          gJsonSz = JsonRuntime()\JsonSz
          InsertJSONRuntimeStructure(index,*value\value)  ;macro is specific to this proceddure 
       EndIf     
    EndSelect

Example windows x64 asm
simulates save and restore, Json Runtime structures are declared as UPPERCASE

Code: Select all

;JSonRuntimeStructure 
;x64 asm windows 
;Authour idle 
;Provides a means to serialize a programs state to and from disk 

Structure JsonRuntime
  JsonAdr.i
  JsonSz.i
  StructlayoutAdr.i
EndStructure 

#PB_integer$ = "PB_Integer"
#PB_UTF8$ = "PB_UTF8" 

Global NewMap JsonRuntime.JsonRuntime() 

Structure ara
  a.a[0] 
EndStructure

Procedure BMSearch(*pinput,inlen,*pat.ara,palen,pos=0)
  ;booyer moore search 
  Protected i,t,len,skip,*input, *pa.Ascii,*pb.Ascii   
 
  Structure ST
    a.a[256] 
  EndStructure  
  Static skiptable.ST 
  inlen-pos 
  *input = *pinput+pos 
  len = inlen - palen
  If pos = 0  
    For i = 0 To 255
      Skiptable\a[i] = 255;
    Next  
    t= palen-1
    For i = 0 To t
      skiptable\a[*pat\a[i]] = i
    Next     
  EndIf 
  i=0
  skip=0
  While skip <= len
    i = palen - 1;
    *pa = (*input + skip + i)
    *pb = *pat+i
    While (*pb\a = *pa\a) 
      i-1 
      *pa - 1 
      *pb - 1
    Wend   
    If i > 0 
      t = i - Skiptable\a[*pa\a]   
      If t > 1 
        skip + t 
      Else 
        skip + 1
      EndIf 
    Else   
      ProcedureReturn skip + pos 
    EndIf     
  Wend  
  ProcedureReturn 0
  
EndProcedure 

Global gJsonAdr,gJsonSz, gJsonSt,gJsonEt,gJsonlb,gJsonRet,gStructlayoutAdr

Macro InsertJSONRuntimeStructure(index,value) 
  
  CompilerIf #PB_Compiler_64Bit 
    
    !SUB    rsp,8
    !MOV    rax, [v_gJsonAdr]
    !PUSH   rax
    !PUSH   qword [v_gJsonSz] 
    !MOV    rbp,qword [rsp+PS2+40]
    !PUSH   qword [rbp+8]
    !PUSH   qword [rsp+120]
    !POP    rcx
    !POP    rdx
    !POP    r8
    !POP    r9
    !SUB    rsp,32
    !CALL   PB_InsertJSONStructure
    !ADD    rsp,40
    
  CompilerElse   
    
    !PUSH   [v_gJsonAdr]
    !PUSH   [v_gJsonSz]
    !MOV    ebp,dword [esp+PS2+16]
    !PUSH   dword [ebp+4]
    !PUSH   dword [esp+32]
    !CALL  _PB_InsertJSONStructure@16
    
  CompilerEndIf
  
EndMacro 

Macro ExtractJSONRuntimeStructure(ele,ptr) 
  
  CompilerIf #PB_Compiler_64Bit 
    
    !SUB    rsp,8
    !MOV    rax, [v_gStructlayoutAdr]
    !PUSH   rax
    !PUSH   qword [v_gJsonSz]
    !POP    rcx
    !POP    rdx
    !SUB    rsp,32
    !CALL   PB_AllocateStructure
    !ADD    rsp,40
    !MOV    qword [p.p_ptr],rax 
    !SUB    rsp,8
    !MOV    rax, [v_gJsonAdr]
    !PUSH   rax
    !PUSH   qword [v_gJsonSz]
    !PUSH   qword [p.a_keyval]
    !PUSH   qword [rsp+128]
    !POP    rcx
    !POP    rdx
    !POP    r8
    !POP    r9
    !SUB    rsp,32
    !CALL   PB_ExtractJSONStructure
    !ADD    rsp,40
    
  CompilerElse  
    
  CompilerEndIf
  
EndMacro  

Macro JsonRuntimeStruct(ptr,struct,key) ;generates the structure layout table 
  
  Global ptr.struct = AllocateStructure(struct)
  
  js = CreateJSON(#PB_Any)
  Ar = SetJSONArray(JSONValue(js))
  index = AddJSONElement(Ar)           
  InsertJSONStructure(index,ptr,struct)
  ExtractJSONStructure(index,ptr,struct)
  FreeJSON(js)
  gJsonSz = SizeOf(struct) 
 
  CompilerIf #PB_Compiler_64Bit  
    
    !lea rax,  [_SYS_StaticStringEnd]
    !lea rdx,  [SYS_EndDataSection] 
    !mov [v_gJsonSt], rax ;_SYS_StaticStringEnd
    !mov [v_gJsonEt], rdx ; SYS_EndDataSection 
    
  CompilerElse   
    
    !mov [v_gJsonSt], _SYS_StaticStringEnd
    !mov [v_gJsonEt],  SYS_EndDataSection 
    
  CompilerEndIf  
  
  *pat = Ascii(UCase(key))    
  gJsonlb = BMSearch(gJsonst,gJsonet-gJsonst,*pat,MemorySize(*pat)) 
  gJsonAdr=gJsonst+gJsonlb
  
  AddMapElement(JsonRuntime(),key) 
  JsonRuntime()\JsonAdr = gJsonAdr 
  JsonRuntime()\JsonSz = gJsonSz 
  JsonRuntime()\StructlayoutAdr = PeekI(gJsonAdr+MemorySize(*pat)+1)
  
  FreeMemory(*pat)
  
EndMacro   

;-test keypair store 

Structure dbval 
  type.s 
  value.i
EndStructure  

Structure keyval 
  key.s 
  type.s
  value.i
EndStructure   

Global NewMap DBitems.dbval()  ;use a map as key pair store would actually use a trie in practice 

Procedure CBSave(key.s,*value.dbval=0,*userdata=0) 
  
  Protected keyval.keyval,str.s 
  
  Static obj 
  If obj <> *userdata 
    obj = *userdata
  EndIf 
  
  keyval\key = key 
  keyval\type = *value\type 
  
  If *value   
    
    Select *value\type 
      Case #PB_Integer$ 
        index = AddJSONElement(obj) 
        keyval\value = PeekI(*value\value)   
        InsertJSONStructure(index, @keyval, keyval)
      Case #PB_UTF8$ 
         index = AddJSONElement(obj)           
         InsertJSONStructure(index, @keyval, keyval)
         index = AddJSONElement(obj) 
         SetJSONString(index,PeekS(*value\value,-1,#PB_UTF8)) 
      Default                                                 ;default type is a strucutre 
        If FindMapElement(JsonRuntime(),*value\type)
          index = AddJSONElement(obj)           
          InsertJSONStructure(index, @keyval,keyval)
          index = AddJSONElement(obj) 
          gJsonAdr = JsonRuntime()\JsonAdr
          gJsonSz = JsonRuntime()\JsonSz
          InsertJSONRuntimeStructure(index,*value\value)  ;macro is specific to this proceddure 
       EndIf     
    EndSelect  
    
  EndIf 
  
  ProcedureReturn 1  
  
EndProcedure  

Procedure SetDB(key.s,type.s,*ptr) 
  
  AddMapElement(DBitems(),key) 
  DBitems()\type = type 
  DBitems()\value = *ptr
  
EndProcedure   

Procedure GetDBValue(key.s) 
  
  ProcedureReturn DBitems(key)\value 
  
EndProcedure   

Procedure.s GetDBType(key.s) 
  
  ProcedureReturn DBitems(key)\type 
  
EndProcedure   

Procedure RestoreDB(file.s) 
  
  Protected key.s  
  Protected obj,json 
  Protected *ptr
  Protected a, ele 
  
  Dim keyval.keyval(0) 
  
  json = LoadJSON(#PB_Any,file) 
  
  obj = JSONValue(json)
  ExtractJSONArray(obj,keyval()) 
  sz = ArraySize(keyval())  
  For a = 0 To sz 
    Select keyval(a)\type 
      Case #PB_Integer$ 
        SetDB(keyval(a)\key,keyval(a)\type,keyval(a)\value) 
      Case #PB_UTF8$ 
        key = keyval(a)\key  
        a+1
        ele = GetJSONElement(obj,a)
        *ptr = UTF8(GetJSONString(ele))
        SetDB(keyval(a-1)\key,keyval(a)\type,*ptr) 
      Default  
        key = keyval(a)\key 
        If FindMapElement(JsonRuntime(),keyval(a)\type)
          a+1
          ele = GetJSONElement(obj,a) 
          gJsonAdr = JsonRuntime()\JsonAdr
          gJsonSz = JsonRuntime()\JsonSz
          gStructlayoutAdr = JsonRuntime()\StructlayoutAdr  
          ExtractJSONRuntimeStructure(ele,*ptr) 
          SetDB(key,keyval(a)\type,*ptr) 
        EndIf      
    EndSelect     
    
  Next   
  
  FreeJSON(json) 
  
EndProcedure   

Procedure SaveDB(file.s) 
  Protected res,json,ArrayValue,lock.s,path.s 
  
  json = CreateJSON(#PB_Any)
  ArrayValue = SetJSONArray(JSONValue(json))
  ForEach DBitems()
    cbSave(MapKey(DBitems()),@DBitems(),ArrayValue)
  Next 
  
  SaveJSON(json,file)
  Debug ComposeJSON(json, #PB_JSON_PrettyPrint)
  
  FreeJSON(json)     
    
EndProcedure   

Procedure FreeDB() 
  
  ForEach DBitems() 
    Select DBitems()\type
      Case "PB_Integer"
      Case "PB_UTF8" 
        FreeMemory(DBitems()\value) 
      Default   
        If DBitems()\type <> ""
          FreeStructure(DBitems()\value)
        EndIf   
    EndSelect   
  Next   
  
  ClearMap(DBitems()) 
  
EndProcedure 

;-Test the JsonRuntimeStructures in the keypair store 

Structure MPOINT  ;db structues declare as UPPERCASE 
  x.i
  y.i
EndStructure  

Structure bar
  Map mp.s()
  x.f
  y.f 
EndStructure  

Structure FOO ;db structues declare as UPPERCASE a nested sructure, only need to declare FOO
  x.i
  y.i
  b.bar
  List pt.mpoint() 
EndStructure    

Global *str  = UTF8("Hello Runtime") 
SetDB("mystr",#PB_UTF8$,*str)  

Global int.i = 12345
SetDB("myint",#PB_Integer$,@int)

JsonRuntimeStruct(*mypt,mpoint,"mpoint")     ;add to Json runtime structure allocates item on heap   
SetDB("mypt","mpoint",*mypt)                 ;Set to the db 

JsonRuntimeStruct(*myfoo,foo,"foo")          ;add Json runtime structure  
SetDB("myfoo","foo",*myfoo)                  ;set to the db

*mypt\x = 234                       ;set values  
*mypt\y = 567

*myfoo\x = 123                      ;set its values   
*myfoo\y = 234 

AddElement(*myfoo\pt()) 
*myfoo\pt()\x = 678 
*myfoo\pt()\y = 789 

AddElement(*myfoo\pt()) 
*myfoo\pt()\x = 1678 
*myfoo\pt()\y = 1789                   

AddMapElement(*myfoo\b\mp(),"hello") 
*myfoo\b\mp() = "world" 
*myfoo\b\x = #PI
*myfoo\b\y = 2*#PI 

;-Serialize the runtime strucutres to disk  

Global file.s = GetTemporaryDirectory() + "testdb.json"  

SaveDB(file)                     ;save the serialzied json to file      

Debug "saved DB" 
Debug ""

FreeDB()                         ;free the DB clears the heap allocated items  

;-Reload the the keypair store from disk 

RestoreDB(file)               ;reload the json to DB        

Debug "Restored DB" 

;-debug the restored items 

*mypt = GetDBValue("mypt") 

Debug "mypt\x = " + Str(*mypt\x) 
Debug "mypt\y = " + Str(*mypt\y) 

*myfoo = GetDBValue("myfoo")  ;get an item

ForEach *myfoo\pt()
  Debug "myfoo\pt()\x = " + Str(*myfoo\pt()\x) 
  Debug "myfoo\pt()\y = " + Str(*myfoo\pt()\y) 
Next 
;  
Debug "myfoo\x =" + Str(*myfoo\x) 
Debug "myfoo\y = " + Str(*myfoo\y) 

Debug "myfoo\b\mp(hello) = " + *myfoo\b\mp("hello")  
Debug "myfoo\b\x =" + Str(*myfoo\b\x) 
Debug "*myfoo\b\y =" + Str(*myfoo\b\y)  

*ptr = GetDBValue("mystr") 
Debug "str =" + PeekS(*ptr,-1,#PB_UTF8)  

int = GetDBValue("myint")
Debug "int=" + Str(int) 

FreeDB()

HanPBF · Post by **HanPBF** » Thu Sep 12, 2024 6:47 am

Just stepped over an older blog entry for PureBasic 5.30

To allow this, we needed to support ‘shadow parameters’ in PB function call. Basically, when we declare a command parameter as “Runtime Structure” like in InsertJSONStructure(), one hidden parameter is added to the function call to add more information to the structure.

Just looked up documentation in PureBasic 6.12 - ok, "Runtime Structure" is not possible.

Jst for my understanding, is this what You where asking for?

Post by **idle** » Thu Sep 12, 2024 7:23 am

HanPBF wrote: Thu Sep 12, 2024 6:47 am Just stepped over an older blog entry for PureBasic 5.30

To allow this, we needed to support ‘shadow parameters’ in PB function call. Basically, when we declare a command parameter as “Runtime Structure” like in InsertJSONStructure(), one hidden parameter is added to the function call to add more information to the structure.
Just looked up documentation in PureBasic 6.12 - ok, "Runtime Structure" is not possible.

Jst for my understanding, is this what You where asking for?

yes that's what I'm asking and it is possible to do though it's not entirely clear cut as the structure layout tables differ between what's needed for CopyStructure vs InsertJsonStructure. It could be done as Json structure for instance.
which could then assigns the address of the json structures layout table to a runtime variable.

I could achieve this by writing a compiler driver for instance though it's not ideal.

The objective is to facilitate creating an object in memory database that also provides a 1:1 relationship between Purebasic and Spiderbasic so you can easily sync structures between client and server which works with json and ajax calls.
It's an extension to atomic web server but currently it requires a call back to marshal the user structures which is ok but it could be done transparently is all.

currently I do it like this in a callback, the example is from a yacht race results server

Code: Select all

Procedure CBSave(*key,*value.dbval=0,*userdata=0)
   
   Protected keyval.keyval,str.s 
    
   Static obj 
   If obj <> *userdata 
     obj = *userdata
   EndIf 
   
   If *value   
   
   keyval\key = PeekS(*key,-1,#PB_UTF8) 
   keyval\type = *value\type  
       
     Select *value\type 
       Case #DB_Integer 
         index = AddJSONElement(obj) 
         keyval\value = *value\value 
         InsertJSONStructure(index, @keyval, keyval)
       Case #DB_UTF8 
         index = AddJSONElement(obj)           
         keyval\value = #PB_UTF8 
         InsertJSONStructure(index, @keyval, keyval)
         index = AddJSONElement(obj) 
         SetJSONString(index,PeekS(*value\value,-1,#PB_UTF8)) 
       Case #DB_Boat     
         index = AddJSONElement(obj)           
         keyval\value = #DB_Boat 
         InsertJSONStructure(index, @keyval, keyval)
         index = AddJSONElement(obj) 
         InsertJSONStructure(index, *value\value, Boat)
       Case #DB_RaceResults 
         index = AddJSONElement(obj)           
         keyval\value = #DB_RaceResults 
         InsertJSONStructure(index, @keyval, keyval)
         index = AddJSONElement(obj) 
         InsertJSONStructure(index, *value\value, RaceResults)
       Case #DB_lastRace 
         index = AddJSONElement(obj)           
         keyval\value = #DB_lastRace 
         InsertJSONStructure(index, @keyval, keyval)
         index = AddJSONElement(obj) 
         InsertJSONStructure(index, *value\value, lastrace)
       Case #DB_RegisteredUsers 
         index = AddJSONElement(obj)           
         keyval\value = #DB_RegisteredUsers 
         InsertJSONStructure(index, @keyval, keyval)
         index = AddJSONElement(obj) 
         InsertJSONStructure(index, *value\value, RegisteredUsers)
     EndSelect  
   
   EndIf 
      
 EndProcedure

Post by **idle** » Sat Sep 14, 2024 6:12 am

an x86 asm implementation, uses two macros to set the JSON Runtime structures
so they can be accessed by a string at runtime

Code: Select all



Structure JsonRuntime
  gJsonAdr.i
  gJsonSz.i
EndStructure 

Global NewMap JsonRuntime.JsonRuntime() 

Structure ara
  a.a[0] 
EndStructure

Procedure BMSearch(*pinput,inlen,*pat.ara,palen,pos=0)
  ;booyer moore search 
  Protected i,t,len,skip,*input, *pa.Ascii,*pb.Ascii   
  Structure ST
    a.a[256] 
  EndStructure  
  Static skiptable.ST 
  inlen-pos 
  *input = *pinput+pos 
  len = inlen - palen
  If pos = 0  
    For i = 0 To 255
      Skiptable\a[i] = 255;
    Next  
    t= palen-1
    For i = 0 To t
      skiptable\a[*pat\a[i]] = i
    Next     
  EndIf 
  i=0
  skip=0
  While skip <= len
    i = palen - 1;
    *pa = (*input + skip + i)
    *pb = *pat+i
    While (*pb\a = *pa\a) 
      i-1 
      *pa - 1 
      *pb - 1
    Wend   
    If i > 0 
      t = i - Skiptable\a[*pa\a]   
      If t > 1 
        skip + t 
      Else 
        skip + 1
      EndIf 
    Else   
      ProcedureReturn skip + pos 
    EndIf     
  Wend  
  ProcedureReturn -1
  
EndProcedure 

Global gJsonAdr,gJsonSz, gJsonSt,gJsonEt,gJsonlb

Macro InsertJSONRuntimeStructure(index,value) 
    
  !PUSH   [v_gJsonAdr]
  !PUSH   [v_gJsonSz]
  !MOV    ebp,dword [esp+PS2+16]
  !PUSH   dword [ebp+4]
  !PUSH   dword [esp+32]
  !CALL  _PB_InsertJSONStructure@16
    
EndMacro  

Macro JsonRuntimeStruct(var,struct) 
  
 js = CreateJSON(#PB_Any)
 Ar = SetJSONArray(JSONValue(js))
 index = AddJSONElement(Ar)           
 InsertJSONStructure(index,@var,struct)
 FreeJSON(js)
 gJsonSz = SizeOf(struct) 
  
EndMacro 

Macro SetJsonRuntimeAddress(struct) 
  
 !mov [v_gJsonSt], _SYS_StaticStringEnd
 !mov [v_gJsonEt],  SYS_EndDataSection 
  
 *pat = Ascii(struct)    
 gJsonlb = BMSearch(gJsonst,gJsonet-gJsonst,*pat,MemorySize(*pat)) 
 gJsonAdr=gJsonst+gJsonlb
 
 AddMapElement(JsonRuntime(),struct) 
 JsonRuntime()\gJsonAdr = gJsonAdr 
 JsonRuntime()\gJsonSz = gJsonSz 
 
 FreeMemory(*pat)
 
EndMacro   

;test code 

Structure keyval 
   key.s 
   value.i
   type.s 
EndStructure   

Procedure CBDump(*key,*value.keyval=0,*userdata=0)
  
  Protected keyval.keyval,str.s 
  
  Static obj 
  If obj <> *userdata 
    obj = *userdata
  EndIf 
  
  keyval\key = *value\key 
  keyval\type = *value\type 
  
  If *value   
    
    Select *value\type 
      Case "DB_Integer" 
        index = AddJSONElement(obj) 
        InsertJSONStructure(index, @keyval, keyval)
      Case "DB_UTF8" 
        index = AddJSONElement(obj)           
        InsertJSONStructure(index, @keyval, keyval)
        index = AddJSONElement(obj) 
        SetJSONString(index,PeekS(*value\value,-1,#PB_UTF8)) 
      Default 
        If FindMapElement(JsonRuntime(),*value\type)
          index = AddJSONElement(obj)           
          InsertJSONStructure(index, @keyval,keyval)
          index = AddJSONElement(obj) 
          gJsonAdr = JsonRuntime()\gJsonAdr
          gJsonSz = JsonRuntime()\gJsonSz
          InsertJSONRuntimeStructure(index,*value\value)
        EndIf     
    EndSelect  
    
  EndIf 
  
  ProcedureReturn 1  
  
EndProcedure  

Global NewList items.keyval()

Procedure SaveDB() 
   Protected res,json,ArrayValue,lock.s,path.s 
      
   json = CreateJSON(#PB_Any)
   ArrayValue = SetJSONArray(JSONValue(json))
   ForEach items()
     cbdump(@items(),@items(),ArrayValue)
   Next 
   Debug ComposeJSON(json, #PB_JSON_PrettyPrint)
   FreeJSON(json)     
      
 EndProcedure   
 
 Structure FOO 
   x.i
   y.i
   List pt.POINT() 
 EndStructure    
 
 Global pt.point
 Global myfoo.FOO 
 
 JsonRuntimeStruct(pt,POINT)        ;add a runtime structure 
 SetJsonRuntimeAddress("POINT")     ;sets the runtime address searching the datasection for the structure 
 
 JsonRuntimeStruct(myfoo,FOO) 
 SetJsonRuntimeAddress("FOO") 
   
 AddElement(items())
 items()\key = "pt"
 items()\type = "POINT" 
 items()\value = @pt 
 
 pt\x = 234
 pt\y = 567
  
 AddElement(myfoo\pt()) 
 myfoo\pt()\x = 678 
 myfoo\pt()\y = 789 
 
  AddElement(myfoo\pt()) 
 myfoo\pt()\x = 1678 
 myfoo\pt()\y = 1789 
 
 AddElement(items())
 items()\key = "myfoo"
 items()\type = "FOO" 
 items()\value = @myfoo 
 
 myfoo\x = 123 
 myfoo\y = 234 
  
 savedb()

Post by **idle** » Sat Sep 21, 2024 7:55 am

re done for x64, added restore, macros are currently specific to the procedures

you use it to save and restore a programs state
it can be used as a keypair store or as an in memory database using a trie instead of a map .
if could also be used to synchronize application state between spider basic client and pure basic server

Code: Select all

;JSonRuntimeStructure 
;x64 asm windows 
;Authour idle 
;Provides a means to serialize a programs state to and from disk 

Structure JsonRuntime
  JsonAdr.i
  JsonSz.i
  StructlayoutAdr.i
EndStructure 

#PB_integer$ = "PB_Integer"
#PB_UTF8$ = "PB_UTF8" 

Global NewMap JsonRuntime.JsonRuntime() 

Structure ara
  a.a[0] 
EndStructure

Procedure BMSearch(*pinput,inlen,*pat.ara,palen,pos=0)
  ;booyer moore search 
  Protected i,t,len,skip,*input, *pa.Ascii,*pb.Ascii   
 
  Structure ST
    a.a[256] 
  EndStructure  
  Static skiptable.ST 
  inlen-pos 
  *input = *pinput+pos 
  len = inlen - palen
  If pos = 0  
    For i = 0 To 255
      Skiptable\a[i] = 255;
    Next  
    t= palen-1
    For i = 0 To t
      skiptable\a[*pat\a[i]] = i
    Next     
  EndIf 
  i=0
  skip=0
  While skip <= len
    i = palen - 1;
    *pa = (*input + skip + i)
    *pb = *pat+i
    While (*pb\a = *pa\a) 
      i-1 
      *pa - 1 
      *pb - 1
    Wend   
    If i > 0 
      t = i - Skiptable\a[*pa\a]   
      If t > 1 
        skip + t 
      Else 
        skip + 1
      EndIf 
    Else   
      ProcedureReturn skip + pos 
    EndIf     
  Wend  
  ProcedureReturn 0
  
EndProcedure 

Global gJsonAdr,gJsonSz, gJsonSt,gJsonEt,gJsonlb,gJsonRet,gStructlayoutAdr

Macro InsertJSONRuntimeStructure(index,value) 
  
  CompilerIf #PB_Compiler_64Bit 
    
    !SUB    rsp,8
    !MOV    rax, [v_gJsonAdr]
    !PUSH   rax
    !PUSH   qword [v_gJsonSz] 
    !MOV    rbp,qword [rsp+PS2+40]
    !PUSH   qword [rbp+8]
    !PUSH   qword [rsp+120]
    !POP    rcx
    !POP    rdx
    !POP    r8
    !POP    r9
    !SUB    rsp,32
    !CALL   PB_InsertJSONStructure
    !ADD    rsp,40
    
  CompilerElse   
    
    !PUSH   [v_gJsonAdr]
    !PUSH   [v_gJsonSz]
    !MOV    ebp,dword [esp+PS2+16]
    !PUSH   dword [ebp+4]
    !PUSH   dword [esp+32]
    !CALL  _PB_InsertJSONStructure@16
    
  CompilerEndIf
  
EndMacro 

Macro ExtractJSONRuntimeStructure(ele,ptr) 
  
  CompilerIf #PB_Compiler_64Bit 
    
    !SUB    rsp,8
    !MOV    rax, [v_gStructlayoutAdr]
    !PUSH   rax
    !PUSH   qword [v_gJsonSz]
    !POP    rcx
    !POP    rdx
    !SUB    rsp,32
    !CALL   PB_AllocateStructure
    !ADD    rsp,40
    !MOV    qword [p.p_ptr],rax 
    !SUB    rsp,8
    !MOV    rax, [v_gJsonAdr]
    !PUSH   rax
    !PUSH   qword [v_gJsonSz]
    !PUSH   qword [p.a_keyval]
    !PUSH   qword [rsp+128]
    !POP    rcx
    !POP    rdx
    !POP    r8
    !POP    r9
    !SUB    rsp,32
    !CALL   PB_ExtractJSONStructure
    !ADD    rsp,40
    
  CompilerElse  
    
  CompilerEndIf
  
EndMacro  

Macro JsonRuntimeStruct(ptr,struct,key) ;generates the structure layout table 
  
  Global ptr.struct = AllocateStructure(struct)
  
  js = CreateJSON(#PB_Any)
  Ar = SetJSONArray(JSONValue(js))
  index = AddJSONElement(Ar)           
  InsertJSONStructure(index,ptr,struct)
  ExtractJSONStructure(index,ptr,struct)
  FreeJSON(js)
  gJsonSz = SizeOf(struct) 
 
  CompilerIf #PB_Compiler_64Bit  
    
    !lea rax,  [_SYS_StaticStringEnd]
    !lea rdx,  [SYS_EndDataSection] 
    !mov [v_gJsonSt], rax ;_SYS_StaticStringEnd
    !mov [v_gJsonEt], rdx ; SYS_EndDataSection 
    
  CompilerElse   
    
    !mov [v_gJsonSt], _SYS_StaticStringEnd
    !mov [v_gJsonEt],  SYS_EndDataSection 
    
  CompilerEndIf  
  
  *pat = Ascii(UCase(key))    
  gJsonlb = BMSearch(gJsonst,gJsonet-gJsonst,*pat,MemorySize(*pat)) 
  gJsonAdr=gJsonst+gJsonlb
  
  AddMapElement(JsonRuntime(),key) 
  JsonRuntime()\JsonAdr = gJsonAdr 
  JsonRuntime()\JsonSz = gJsonSz 
  JsonRuntime()\StructlayoutAdr = PeekI(gJsonAdr+MemorySize(*pat)+1)
  
  FreeMemory(*pat)
  
EndMacro   

;-test keypair store 

Structure dbval 
  type.s 
  value.i
EndStructure  

Structure keyval 
  key.s 
  type.s
  value.i
EndStructure   

Global NewMap DBitems.dbval()  ;use a map as key pair store would actually use a trie in practice 

Procedure CBSave(key.s,*value.dbval=0,*userdata=0) 
  
  Protected keyval.keyval,str.s 
  
  Static obj 
  If obj <> *userdata 
    obj = *userdata
  EndIf 
  
  keyval\key = key 
  keyval\type = *value\type 
  
  If *value   
    
    Select *value\type 
      Case #PB_Integer$ 
        index = AddJSONElement(obj) 
        keyval\value = PeekI(*value\value)   
        InsertJSONStructure(index, @keyval, keyval)
      Case #PB_UTF8$ 
         index = AddJSONElement(obj)           
         InsertJSONStructure(index, @keyval, keyval)
         index = AddJSONElement(obj) 
         SetJSONString(index,PeekS(*value\value,-1,#PB_UTF8)) 
      Default                                                 ;default type is a strucutre 
        If FindMapElement(JsonRuntime(),*value\type)
          index = AddJSONElement(obj)           
          InsertJSONStructure(index, @keyval,keyval)
          index = AddJSONElement(obj) 
          gJsonAdr = JsonRuntime()\JsonAdr
          gJsonSz = JsonRuntime()\JsonSz
          InsertJSONRuntimeStructure(index,*value\value)  ;macro is specific to this proceddure 
       EndIf     
    EndSelect  
    
  EndIf 
  
  ProcedureReturn 1  
  
EndProcedure  

Procedure SetDB(key.s,type.s,*ptr) 
  
  AddMapElement(DBitems(),key) 
  DBitems()\type = type 
  DBitems()\value = *ptr
  
EndProcedure   

Procedure GetDBValue(key.s) 
  
  ProcedureReturn DBitems(key)\value 
  
EndProcedure   

Procedure.s GetDBType(key.s) 
  
  ProcedureReturn DBitems(key)\type 
  
EndProcedure   

Procedure RestoreDB(file.s) 
  
  Protected key.s  
  Protected obj,json 
  Protected *ptr
  Protected a, ele 
  
  Dim keyval.keyval(0) 
  
  json = LoadJSON(#PB_Any,file) 
  
  obj = JSONValue(json)
  ExtractJSONArray(obj,keyval()) 
  sz = ArraySize(keyval())  
  For a = 0 To sz 
    Select keyval(a)\type 
      Case #PB_Integer$ 
        SetDB(keyval(a)\key,keyval(a)\type,keyval(a)\value) 
      Case #PB_UTF8$ 
        key = keyval(a)\key  
        a+1
        ele = GetJSONElement(obj,a)
        *ptr = UTF8(GetJSONString(ele))
        SetDB(keyval(a-1)\key,keyval(a)\type,*ptr) 
      Default  
        key = keyval(a)\key 
        If FindMapElement(JsonRuntime(),keyval(a)\type)
          a+1
          ele = GetJSONElement(obj,a) 
          gJsonAdr = JsonRuntime()\JsonAdr
          gJsonSz = JsonRuntime()\JsonSz
          gStructlayoutAdr = JsonRuntime()\StructlayoutAdr  
          ExtractJSONRuntimeStructure(ele,*ptr) 
          SetDB(key,keyval(a)\type,*ptr) 
        EndIf      
    EndSelect     
    
  Next   
  
  FreeJSON(json) 
  
EndProcedure   

Procedure SaveDB(file.s) 
  Protected res,json,ArrayValue,lock.s,path.s 
  
  json = CreateJSON(#PB_Any)
  ArrayValue = SetJSONArray(JSONValue(json))
  ForEach DBitems()
    cbSave(MapKey(DBitems()),@DBitems(),ArrayValue)
  Next 
  
  SaveJSON(json,file)
  Debug ComposeJSON(json, #PB_JSON_PrettyPrint)
  
  FreeJSON(json)     
    
EndProcedure   

Procedure FreeDB() 
  
  ForEach DBitems() 
    Select DBitems()\type
      Case "PB_Integer"
      Case "PB_UTF8" 
        FreeMemory(DBitems()\value) 
      Default   
        If DBitems()\type <> ""
          FreeStructure(DBitems()\value)
        EndIf   
    EndSelect   
  Next   
  
  ClearMap(DBitems()) 
  
EndProcedure 

;-Test the JsonRuntimeStructures in the keypair store 

Structure MPOINT  ;db structues declare as UPPERCASE 
  x.i
  y.i
EndStructure  

Structure bar
  Map mp.s()
  x.f
  y.f 
EndStructure  

Structure FOO ;db structues declare as UPPERCASE a nested sructure, only need to declare FOO
  x.i
  y.i
  b.bar
  List pt.mpoint() 
EndStructure    

Global *str  = UTF8("Hello Runtime") 
SetDB("mystr",#PB_UTF8$,*str)  

Global int.i = 12345
SetDB("myint",#PB_Integer$,@int)

JsonRuntimeStruct(*mypt,mpoint,"mpoint")     ;add to Json runtime structure allocates item on heap   
SetDB("mypt","mpoint",*mypt)                 ;Set to the db 

JsonRuntimeStruct(*myfoo,foo,"foo")          ;add Json runtime structure  
SetDB("myfoo","foo",*myfoo)                  ;set to the db

*mypt\x = 234                       ;set values  
*mypt\y = 567

*myfoo\x = 123                      ;set its values   
*myfoo\y = 234 

AddElement(*myfoo\pt()) 
*myfoo\pt()\x = 678 
*myfoo\pt()\y = 789 

AddElement(*myfoo\pt()) 
*myfoo\pt()\x = 1678 
*myfoo\pt()\y = 1789                   

AddMapElement(*myfoo\b\mp(),"hello") 
*myfoo\b\mp() = "world" 
*myfoo\b\x = #PI
*myfoo\b\y = 2*#PI 

;-Serialize the runtime strucutres to disk  

Global file.s = GetTemporaryDirectory() + "testdb.json"  

SaveDB(file)                     ;save the serialzied json to file      

Debug "saved DB" 
Debug ""

FreeDB()                         ;free the DB clears the heap allocated items  

;-Reload the the keypair store from disk 

RestoreDB(file)               ;reload the json to DB        

Debug "Restored DB" 

;-debug the restored items 

*mypt = GetDBValue("mypt") 

Debug "mypt\x = " + Str(*mypt\x) 
Debug "mypt\y = " + Str(*mypt\y) 

*myfoo = GetDBValue("myfoo")  ;get an item

ForEach *myfoo\pt()
  Debug "myfoo\pt()\x = " + Str(*myfoo\pt()\x) 
  Debug "myfoo\pt()\y = " + Str(*myfoo\pt()\y) 
Next 
;  
Debug "myfoo\x =" + Str(*myfoo\x) 
Debug "myfoo\y = " + Str(*myfoo\y) 

Debug "myfoo\b\mp(hello) = " + *myfoo\b\mp("hello")  
Debug "myfoo\b\x =" + Str(*myfoo\b\x) 
Debug "*myfoo\b\y =" + Str(*myfoo\b\y)  

*ptr = GetDBValue("mystr") 
Debug "str =" + PeekS(*ptr,-1,#PB_UTF8)  

int = GetDBValue("myint")
Debug "int=" + Str(int) 

FreeDB()

Quin · Post by **Quin** » Fri Feb 21, 2025 2:19 am

+1, and thanks for your great work Idle!

PureBasic Forums - English