XOR Double linked list with multiple types

[idle]

XOR Double linked list with multiple types in same list
thread safe and lock free for single writer with multiple readers

integers
doubles
strings
pointers

integer, double and strings are deep copies, pointers are just copies of the pointer address
the types are stored on the 2 LSB of the value pointer which is heap allocated separate to the node pointers
this works on x86 and x64 as memory is at a minimum 4 bytes aligned which allows for 4 types 0,1,2,3

XOR_AddElement is always the last element
XOR_InsertElement is the current
Both use the typed functions

XOR_AddElement_I(MyList, 30)
XOR_AddElement_D(MyList, #PI)
XOR_AddElement_S(MyList, "Hello")
XOR_AddElement(mylist,@myfoo)

Traversal functions with a callback
XOR_WalkForeward()
XOR_WalkBackward()

Regular Traversal functions
XOR_FirstElement()
XOR_LastElement()
XOR_NextElement()
XOR_PreviousElement()

Delete Item by value via type
XOR_DeleteItem_D(MyList,#PI)
XOR_DeleteItem_I(MyList,10)
XOR_DeleteItem_S(MyList,"Hello")

Delete at current position
XOR_DeleteElement()

Code: Select all

;XOR Double Linked List (Thread-Safe)
;Author IDLE
;licence MIT
;Supports Multiple types so you can store integers doubles strings or pointers
;nodes are 2 integers wide value and ptr, a value of integer, double and strings are copies, pointers are just pointers
;Thread safe lock free 
;EnableExplicit

#XOR_PTR = 0
#XOR_INTEGER = 1
#XOR_DOUBLE = 2
#XOR_STRING = 3
#XOR_MASK = (-1 << 2)

Prototype pCBElement(*value,type.i,*userdata1=0,*userdata2=0)

Structure XORNode Align #PB_Structure_AlignC
  StructureUnion
    *Value
    Type.i
  EndStructureUnion
  Ptr.i
EndStructure

Structure XORList Align #PB_Structure_AlignC
  *Head.XORNode
  *Tail.XORNode
EndStructure

Structure XORNodePTR  Align #PB_Structure_AlignC
  *CurrentNode.XORNode 
  *NextNode.XORNode 
  *PrevNode.XORNode 
EndStructure  

Global XOR_Mutex = CreateMutex()  

CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
  
  Procedure XORLIST_AtomicCAS(*target.XORList, *old.XORList, *new.XORList)
    CompilerIf #PB_Compiler_Backend = #PB_Backend_C 
      Protected result.a 
      !struct m128 {
      ! unsigned long long lo;
      ! unsigned long long hi;
      !};
      ! struct m128 *old = p_old;  
      ! struct m128 *new = p_new;  
      ! struct m128 *target = p_target; 
      ! unsigned long long dummy;
      ! asm volatile
      !("lfence\n\t"
      ! "lock cmpxchg16b %0; setz %1\n\t"       
      ! "sfence"
      !: "+m" ( *target )  
      !, "=a" ( v_result )   
      !, "=d" ( dummy )
      !: "d" ( old->hi )
      !, "a" ( old->lo)
      !, "c" ( new->hi )
      !, "b" ( new->lo )
      !: "cc", "memory"
      !);
      ProcedureReturn result 
    CompilerElse 
      
      Protected rbx,rdi
      !lfence 
      !mov [p.v_rbx], rbx
      !xor rbx,rbx 
      !mov [p.v_rdi], rdi
      
      !mov rdi, [p.p_old]
      !mov rax, [rdi]    
      !mov rdx, [rdi+8]  
      
      !mov rdi, [p.p_new]
      !mov rbx, [rdi]    
      !mov rcx, [rdi+8]  
      
      !mov rdi, [p.p_target]
      !lock cmpxchg16b [rdi]
      !setz al
      !test al, al
      !jnz .cas_success
      !sfence 
      !mov rdi, [p.p_old]
      !mov [rdi], rax    
      !mov [rdi+8], rdx  
      
      !.cas_success:
      !sfence 
      !movzx rax, al     
      !mov rdi, [p.v_rdi]
      !mov rbx, [p.v_rbx] 
      ProcedureReturn 
    CompilerEndIf
  EndProcedure
  
CompilerElse 
  
  Procedure XORLIST_AtomicCAS(*target.XORList, *old.XORList, *new.XORList)
    CompilerIf #PB_Compiler_Backend = #PB_Backend_C 
      Protected result.a 
      !struct m64 {
      ! unsigned long lo;
      ! unsigned long hi;
      !};
      ! struct m64 *old = p_old;  
      ! struct m64 *new = p_new;  
      ! struct m64 *target = p_target; 
      ! unsigned long dummy;
      ! asm volatile
      !("lfence\n\t"
      ! "lock cmpxchg8b %0; setz %1\n\t"       
      ! "sfence"
      !: "+m" ( *target )  
      !, "=a" ( v_result )   
      !, "=d" ( dummy )
      !: "d" ( old->hi )
      !, "a" ( old->lo)
      !, "c" ( new->hi )
      !, "b" ( new->lo )
      !: "cc", "memory"
      !);
      ProcedureReturn result 
    CompilerElse 
      
      Protected ebx,edi
      !lfence 
      !mov [p.v_ebx], ebx
      !xor ebx,ebx 
      !mov [p.v_edi], edi
      
      !mov edi, [p.p_old]
      !mov eax, [edi]    
      !mov edx, [edi+8]  
      
      !mov edi, [p.p_new]
      !mov ebx, [edi]    
      !mov ecx, [edi+4]  
      
      !mov edi, [p.p_target]
      !lock cmpxchg8b [edi]
      !setz al
      !test al, al
      !jnz .cas_success
      !sfence 
      !mov edi, [p.p_old]
      !mov [edi], eax    
      !mov [edi+4], edx  
      
      !.cas_success:
      !sfence 
      !movzx eax, al     
      !mov edi, [p.v_edi]
      !mov ebx, [p.v_ebx] 
      ProcedureReturn 
      
    CompilerEndIf
  EndProcedure
    
CompilerEndIf   

Procedure.i AllocateAligned(size.i, align.i)
  Protected *mem, *aligned
  *mem = AllocateMemory(size + align+8)
  If *mem
    *aligned = (*mem + 8 + align - 1) & ~(align-1)
    PokeI(*aligned - SizeOf(Integer), *mem) 
    ProcedureReturn *aligned
  EndIf
  ProcedureReturn 0
EndProcedure

Procedure FreeAligned(*aligned)
  If *aligned
    Protected *original = PeekI(*aligned - SizeOf(Integer))
    FreeMemory(*original)
  EndIf
EndProcedure 

Procedure XOR_XCHG(*ptr.Integer,v1) 
  
  CompilerIf #PB_Compiler_Backend = #PB_Backend_C 
    !__atomic_exchange_n(&p_ptr->f_i,v_v1,__ATOMIC_SEQ_CST); 
  CompilerElse 
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
      !mov ecx,[p.p_ptr]
      !mov eax,[p.v_v1]
      !xchg dword [ecx],eax
    CompilerElse 
      !mov rcx, [p.p_ptr]
      !mov rax, [p.v_v1 ] 
      !xchg qword [rcx],rax
    CompilerEndIf
  CompilerEndIf 
  
EndProcedure 

Threaded *lpt.XORList
Threaded *ptr.XORNodePTR

Procedure XOR_ElementType(element)
  Protected *ele.XORNodePTR = element
  ProcedureReturn (*ele\CurrentNode\type & 3)
EndProcedure

Procedure XOR_ElemmentValue_I(element)
  Protected *ele.XORNodePTR = element
  ProcedureReturn PeekI(*ele\CurrentNode\value & #XOR_MASK)
EndProcedure

Procedure.d XOR_ElemmentValue_D(element)
  Protected *ele.XORNodePTR = element
  ProcedureReturn PeekD(*ele\CurrentNode\value & #XOR_MASK)
EndProcedure

Procedure.s XOR_ElemmentValue_S(element)
  Protected *ele.XORNodePTR = element
  ProcedureReturn PeekS(*ele\CurrentNode\value & #XOR_MASK)
EndProcedure

Procedure.i XOR_NextElement(*List.XORList,element)
  
  If *ptr.XORNodePTR = #Null 
    *ptr.XORNodePTR = AllocateStructure(XORNodePTR) 
  EndIf 
  
  If *lpt.XORList = #Null 
    *lpt.XORList = AllocateAligned(SizeOf(XORList),16) 
  EndIf   
  If *lpt   
    Protected success 
       
    If element = #Null
         
    Repeat 
      success = XORLIST_AtomicCAS(*lpt,*lpt,*list) 
      Delay(0)  
    Until success     
    
    Else   
      *ptr.XORNodePTR = element 
    EndIf    
    
    If *ptr
      
      If *ptr\CurrentNode = #Null
        *ptr\CurrentNode = *lpt\Head 
        *ptr\PrevNode = #Null
         ProcedureReturn *ptr
      EndIf
      
      *ptr\NextNode = *ptr\PrevNode ! *ptr\CurrentNode\Ptr
      *ptr\PrevNode = *ptr\CurrentNode
      *ptr\CurrentNode = *ptr\NextNode
      
      If *ptr\CurrentNode <> #Null 
        ProcedureReturn *ptr
      Else 
        ClearStructure(*ptr,XORNodePTR) 
        ProcedureReturn 0 
      EndIf   
      
    EndIf 
  EndIf 
EndProcedure

Declare XOR_AddElement_I(*List.XORList,value.i)

Procedure.i XOR_PreviousElement(*List.XORList,element)
  
  Protected success 
  
  If *ptr.XORNodePTR = #Null 
    *ptr.XORNodePTR = AllocateStructure(XORNodePTR) 
  EndIf 
  
  If *lpt.XORList = #Null  
    *lpt.XORList = AllocateAligned(SizeOf(XORList),16) 
  EndIf   
  If *lpt 
        
    If element = #Null 
      
      Repeat 
        success = XORLIST_AtomicCAS(*lpt,*lpt,*list) 
        Delay(0)  
      Until success 
    Else   
      
      *ptr.XORNodePTR = element 
    EndIf
    
    If *ptr 
      
      If *ptr\CurrentNode = #Null
        *ptr\CurrentNode = *lpt\Tail
        *ptr\NextNode = #Null
         ProcedureReturn *ptr
      EndIf
      
      If XORLIST_AtomicCAS(*lpt,*lpt,*list)
        If *ptr\NextNode = 0 Or *ptr\PrevNode = 0
          *ptr\CurrentNode = *lpt\Tail
        EndIf   
      EndIf   
      
      *ptr\PrevNode = *ptr\NextNode ! *ptr\CurrentNode\Ptr
      *ptr\NextNode = *ptr\CurrentNode
      *ptr\CurrentNode = *ptr\PrevNode
      
      If *ptr\CurrentNode <> #Null 
         ProcedureReturn *ptr
      Else 
        ClearStructure(*ptr,XORNodePTR) 
        ProcedureReturn 0 
      EndIf   
      
    EndIf
     
  EndIf 
EndProcedure

Macro XOR_FirstElement(XORList)
   XOR_NextElement(XORList,0)
EndMacro 

Macro XOR_LastElement(XORList)
  XOR_PreviousElement(XORList,0) 
EndMacro 

Procedure XOR_WalkForward(*List.XORList,*cb.pCBElement,*userdata1=0,*userdata2=0)
    
  *ptr = XOR_FirstElement(*List)
  If *ptr 
    Repeat
      If *cb
        *cb(*ptr\CurrentNode\Value & #XOR_MASK,*ptr\CurrentNode\Type & 3,*userdata1,*userdata2)
      EndIf 
      *ptr = XOR_NextElement(*List,*ptr) 
    Until *ptr = #Null
  EndIf 
  
EndProcedure

Procedure XOR_WalkBackward(*List.XORList,*cb.pCBElement,*userdata1=0,*userdata2=0)
      
  *ptr = XOR_LastElement(*List)
  If *ptr 
    Repeat
      If *cb
        *cb(*ptr\CurrentNode\Value & #XOR_MASK,*ptr\CurrentNode\Type & 3,*userdata1,*userdata2)
      EndIf 
      *ptr = XOR_PreviousElement(*List,*ptr) 
    Until *ptr = #Null
  EndIf
  
EndProcedure

Procedure XOR_DeleteElement(*list.XORList,element)
  
  
  Protected *tempNode.XORNode
  Protected *ptr.XORNodePTR = element 
  Protected *lpt.XORList = AllocateAligned(SizeOf(XORList),16) 
  
  XORLIST_AtomicCAS(*lpt,*lpt,*list) 
    
  *ptr\NextNode = *ptr\PrevNode ! *ptr\CurrentNode\Ptr
  If *ptr\PrevNode <> #Null
    *ptr\PrevNode\Ptr = (*ptr\PrevNode\Ptr ! *ptr\CurrentNode ! *ptr\NextNode)
  Else
    *lpt\Head = *ptr\NextNode 
  EndIf
  If *ptr\NextNode <> #Null
    *ptr\NextNode\Ptr = (*ptr\NextNode\Ptr ! *ptr\CurrentNode ! *ptr\PrevNode)
  Else
    *lpt\Tail = *ptr\PrevNode 
  EndIf
    
  XORLIST_AtomicCAS(*list,*list,*lpt) 
    
  *tempNode = *ptr\CurrentNode

  If *ptr\NextNode <> #Null
    *ptr\CurrentNode = *ptr\NextNode
  Else
    *ptr\CurrentNode = *ptr\PrevNode
  EndIf

  FreeMemory(*tempNode\value & #XOR_MASK)
  FreeStructure(*tempNode)

  If *lpt\Head = #Null
    *ptr\CurrentNode = #Null
    *ptr\PrevNode = #Null
    *ptr\NextNode = #Null
  EndIf 
  
  FreeAligned(*lpt) 
  
  ProcedureReturn *ptr  
   
EndProcedure

Macro _XOR_DeleteItem(XList,item,type)
  
  Protected *PrevNode.XORNode 
  Protected *nextNode.XORNode
  Protected *currentNode.XORNode 
  Protected found  
  
  Protected *lpt.XORList = AllocateAligned(SizeOf(XORList),16) 
    
  *CurrentNode = *lpt\Head 
  
  While *CurrentNode <> #Null
    CompilerSelect Type
      CompilerCase #XOR_INTEGER
        If PeekI(*CurrentNode\Value & #XOR_MASK) = item
          found = 1
        EndIf
      CompilerCase #XOR_DOUBLE
        If PeekD(*CurrentNode\Value & #XOR_MASK) = item
          found = 1
        EndIf
      CompilerCase #XOR_STRING
        If PeekS(*CurrentNode\Value & #XOR_MASK) = item
          found = 1
        EndIf
      CompilerDefault
        If *CurrentNode\Value & #XOR_MASK = item
          found = 1
        EndIf
    CompilerEndSelect
    If found
      *NextNode = *PrevNode ! *CurrentNode\Ptr
      If *PrevNode <> #Null
        *PrevNode\Ptr = (*PrevNode\Ptr ! *CurrentNode ! *NextNode)
      Else
        XList\Head = *NextNode 
      EndIf
      If *NextNode <> #Null
        *NextNode\Ptr = (*NextNode\Ptr ! *CurrentNode ! *PrevNode)
      Else
        XList\Tail = *PrevNode 
      EndIf
      FreeMemory(*currentNode\value & #XOR_MASK)
      FreeStructure(*CurrentNode)
      ProcedureReturn #True
    EndIf

    *NextNode = *PrevNode ! *CurrentNode\Ptr
    *PrevNode = *CurrentNode
    *CurrentNode = *NextNode
  Wend
  ProcedureReturn #False
EndMacro

Procedure XOR_DeleteItem_I(*List.XORList,item.i)
   _XOR_DeleteItem(*List,item,#XOR_INTEGER)
EndProcedure

Procedure XOR_DeleteItem_D(*List.XORList,item.d)
  _XOR_DeleteItem(*List,item,#XOR_DOUBLE)
EndProcedure

Procedure XOR_DeleteItem_S(*List.XORList,item.s)
  _XOR_DeleteItem(*List,item, #XOR_STRING)
EndProcedure

Procedure XOR_DeleteItem(*List.XORList,*item)
 _XOR_DeleteItem(*List,*item, #XOR_PTR)
EndProcedure

Procedure _XOR_AddElement(*List.XORList,item,Type)
  
  Protected *XorNode.XORNode
  Protected *XORItem
  Protected success 
  Protected ct 
  
  If Not *lpt.XORList
    *lpt.XORList = AllocateAligned(SizeOf(XORList),16) 
  EndIf   
    
  *XorNode.XORNode = AllocateStructure(XORNode)
  
  If *XorNode
    Select type
      Case #XOR_INTEGER
        *XORItem = AllocateMemory(SizeOf(integer))
        PokeI(*XORItem,item)
        *XorNode\Value = (*XORItem | #XOR_INTEGER)

      Case #XOR_DOUBLE
        *XORItem = AllocateMemory(SizeOf(Double))
        PokeD(*XORItem,PeekD(item))
        *XorNode\Value = (*XORItem | #XOR_DOUBLE)

      Case #XOR_STRING
        *XORItem = AllocateMemory(SizeOf(integer)+StringByteLength(PeekS(item)))
        PokeS(*XORItem,PeekS(item))
        *XorNode\Value = (*XORItem | #XOR_STRING)

      Default
        *XORItem = AllocateMemory(SizeOf(integer))
        *XORItem = item
        *XorNode\Value = *XORItem
    EndSelect
    
    LockMutex(XOR_Mutex) ;for write sync ABA 
    
    Repeat 
      success = XORLIST_AtomicCAS(*lpt,*lpt,*list) 
      Delay(0)   
    Until success  
        
    *XorNode\Ptr = *lpt\Tail   
    
    If (*lpt\Tail )<> #Null
      *lpt\Tail\Ptr = *lpt\Tail\Ptr ! *XorNode
    Else
      *lpt\Head = *XorNode  
    EndIf
    
    *lpt\tail = *XorNode   
       
    Repeat 
      success = XORLIST_AtomicCAS(*list,*list,*lpt) 
      Delay(0)  
    Until success 
    
    UnlockMutex(XOR_Mutex)
    
  EndIf

EndProcedure

Procedure XOR_AddElement_I(*List.XORList,value.i)
   _XOR_AddElement(*List,value, #XOR_INTEGER)
 EndProcedure

Procedure XOR_AddElement_D(*List.XORList,value.d)
   _XOR_AddElement(*List,@value,#XOR_DOUBLE)
 EndProcedure

Procedure XOR_AddElement_S(*List.XORList,value.s)
   _XOR_AddElement(*List,@value,#XOR_STRING)
 EndProcedure

Procedure XOR_AddElement(*List.XORList,*value)
  _XOR_AddElement(*List,*value,#XOR_PTR)
EndProcedure

Macro _XOR_InsertElement(XList, item,element,Type=0)
  
  Protected *XORNode.XORNode = AllocateStructure(XORNode)
  Protected *ptr.XORNodePTR = element 
  Protected *XORitem 
    
  If *XORNode 
    CompilerSelect type
      CompilerCase #XOR_INTEGER
        *XORItem = AllocateMemory(SizeOf(integer))
        PokeI(*XORItem, item)
        *XorNode\Value = (*XORItem | #XOR_INTEGER)

      CompilerCase #XOR_DOUBLE
        *XORItem = AllocateMemory(SizeOf(Double))
        PokeD(*XORItem, item)
        *XorNode\Value = (*XORItem | #XOR_DOUBLE)

      CompilerCase #XOR_STRING
        *XORItem = AllocateMemory(SizeOf(integer)+StringByteLength(item))
        PokeS(*XORItem, item)
        *XorNode\Value = (*XORItem | #XOR_STRING)

      CompilerDefault
        *XORItem = AllocateMemory(SizeOf(integer))
        *XORItem = item
        *XorNode\Value = *XORItem
    CompilerEndSelect
    
    LockMutex(XOR_Mutex) 
    
    If XList\Head = #Null
      *XorNode\Ptr = #Null
      XList\Head = *XorNode 
      XList\Tail = *XorNode 
    Else
      If *ptr\CurrentNode <> #Null
        *XorNode\Ptr = *ptr\PrevNode ! *ptr\CurrentNode

        If *ptr\PrevNode <> #Null
          *ptr\PrevNode\Ptr = *ptr\PrevNode\Ptr ! *ptr\CurrentNode ! *XorNode
        Else
          XList\Head = *XorNode 
        EndIf

        *ptr\CurrentNode\Ptr = *ptr\CurrentNode\Ptr ! *ptr\PrevNode ! *XorNode

        *ptr\PrevNode = *XorNode
      Else
        
        *XorNode\Ptr = XList\Tail

        If XList\Tail <> #Null
          XList\Tail\Ptr = XList\Tail\Ptr ! *XorNode 
        Else
          XList\Head = *XorNode
        EndIf

        XList\Tail = *XorNode 
      EndIf
    EndIf 
    
    UnlockMutex(XOR_Mutex) 
    
  EndIf
EndMacro

Procedure XOR_InsertElement_I(*List.XORList, value.i,element)
 
  _XOR_InsertElement(*List, value, element, #XOR_INTEGER)
 
EndProcedure

Procedure XOR_InsertElement_D(*List.XORList, value.d,element)
 
  _XOR_InsertElement(*List, value, element,#XOR_DOUBLE)
 
EndProcedure

Procedure XOR_InsertElement_S(*List.XORList, value.s,element)
 
  _XOR_InsertElement(*List, value, element,#XOR_STRING)
  
EndProcedure

Procedure XOR_InsertElement(*List.XORList, *value,element)
 
  _XOR_InsertElement(*List, *value,element, #XOR_PTR)
 
EndProcedure

Procedure XOR_Free(*List.XORList)
  
  Protected *last.XORNode = *list\Tail
  Protected *PrevNode.XORNode 
  Protected *CurrentNode.XORNode 
  
  *CurrentNode = *List\Head 

  While *CurrentNode <> #Null
    *NextNode = *PrevNode ! *CurrentNode\Ptr
    If *PrevNode <> #Null
      FreeMemory(*PrevNode\value & #XOR_MASK)
      FreeStructure(*PrevNode)
    EndIf
    *PrevNode = *CurrentNode
    *CurrentNode = *NextNode
  Wend
    
  ClearStructure(*List,XORList)
  
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  
    
  CompilerIf #PB_Compiler_Debugger 
    
  OpenConsole()  
    
  Structure foo Align 16
    a.i
    s.s
  EndStructure

  Procedure ListCb(*value,type.i,*userdata1=0,*userdata2=0) ;process values from XOR_Walk
    Protected *ptr.foo
    If *value
      Select type
        Case #XOR_INTEGER
          Debug PeekI(*value)
        Case #XOR_DOUBLE
          Debug PeekD(*value)
        Case #XOR_STRING
          Debug PeekS(*value)
        Case #XOR_PTR
          *ptr.foo = *value
          Debug *ptr\s
      EndSelect
    EndIf
  EndProcedure  
   
 
  Global myfoo.foo

  Global a.i = 20
  Global b.i=30

  myfoo\a = 123
  myfoo\s = "hello foo "
  
  Global *MyList.XORList = AllocateAligned(SizeOf(XORList),16) ;make list
  
  ; Add elements to the list
  XOR_AddElement_I(*MyList, 10)
  XOR_AddElement_I(*MyList, a)
  XOR_AddElement_I(*MyList, b)
  XOR_AddElement_D(*MyList, #PI)
  XOR_AddElement_S(*MyList, "Hello")
  XOR_AddElement_S(*MyList, "World")
  XOR_AddElement(*mylist,@myfoo)

  Debug "Walk Forward:"
  XOR_WalkForward(*MyList,@Listcb())

  Debug "Walk Backward:"
  XOR_WalkBackward(*MyList,@Listcb())

  Debug "next element"
  ele = XOR_FirstElement(*MyList)
  Repeat
    Select XOR_ElementType(ele)
      Case #XOR_INTEGER
        Debug XOR_ElemmentValue_I(ele)
      Case #XOR_DOUBLE
        Debug XOR_ElemmentValue_D(ele)
      Case #XOR_STRING
        Debug XOR_ElemmentValue_S(ele)
    EndSelect
  ele = XOR_NextElement(*MyList,ele)
  Until ele = #Null  
  Debug "previous element"
  
  ele = XOR_LastElement(*MyList)
  Repeat
    Select XOR_ElementType(ele)
      Case #XOR_INTEGER
        Debug XOR_ElemmentValue_I(ele)
      Case #XOR_DOUBLE
        Debug XOR_ElemmentValue_D(ele)
      Case #XOR_STRING
        Debug XOR_ElemmentValue_S(ele)
    EndSelect
    ele = XOR_PreviousElement(*MyList,ele) 
  Until ele = #Null

  Debug "Delete Items by value"
  XOR_DeleteItem_D(*MyList,#PI)
  XOR_DeleteItem_I(*MyList,10)
  XOR_DeleteItem_S(*MyList,"Hello")

  Debug "repeat previous element with PI 10 and Hello deleted"
  ele = XOR_LastElement(*MyList)

  Repeat
    Select XOR_ElementType(ele)
      Case #XOR_INTEGER
        Debug XOR_ElemmentValue_I(ele)
      Case #XOR_DOUBLE
        Debug XOR_ElemmentValue_D(ele)
      Case #XOR_STRING
        Debug XOR_ElemmentValue_S(ele)
    EndSelect
    ele = XOR_PreviousElement(*MyList,ele)
  Until ele = #Null

  Debug "delete element"
  ele = XOR_FirstElement(*mylist)
  Debug XOR_ElemmentValue_I(ele)
  ele = XOR_DeleteElement(*mylist,ele) ;deleats 30
  XOR_InsertElement_I(*mylist,42,ele)
  Debug "Walk Forward:"
  XOR_WalkForward(*MyList,@Listcb())

  Debug "Free "
  XOR_Free(*MyList)
  
  Input()
  
CompilerElse 
  
  OpenConsole() 
  
  Global gquit,sem = CreateSemaphore() 
  Global gct,c 
  Global *mylist.XORList = AllocateAligned(SizeOf(XORList),16) 
  
  
  Procedure ThreadAddElements(void) 
    
    WaitSemaphore(sem) 
    Repeat 
      XOR_AddElement_I(*MyList,gct)
      gct+1 
      Delay(0)    
    Until gquit   
     
  EndProcedure   
  
  Procedure ListCbT(*value,type.i,*userdata1=0,*userdata2=0) ;process values from XOR_Walk
    
    If *value
      PrintN(PeekS(*userdata1) + " " + PeekI(*value))
    EndIf
  EndProcedure  
    
  Procedure ThreadWalkForward(void) 
    
    WaitSemaphore(sem)
    Delay(20)
    XOR_WalkForward(*MyList,@ListCbT(),@"Forward")
      
  EndProcedure   
  
  Procedure ThreadWalkBackward(mylist) 
    
    WaitSemaphore(sem)
    Delay(20) 
    XOR_WalkBackward(MyList,@ListCbT(),@"Backward")
    
  EndProcedure   
  
  Procedure ThreadDeleteElement(void) 
    
    WaitSemaphore(sem) 
    Repeat 
      XOR_DeleteItem_I(*MyList,Random(gct))
    Until gquit   
     
  EndProcedure   
  
  CreateThread(@ThreadAddElements(),0) 
  CreateThread(@ThreadAddElements(),0) 
  CreateThread(@ThreadWalkForward(),0) 
  CreateThread(@ThreadWalkBackward(),*mylist) 
  ;CreateThread(@ThreadDeleteElement(),0) 
  
  SignalSemaphore(sem)
  SignalSemaphore(sem) 
  SignalSemaphore(sem) 
  SignalSemaphore(sem) 
  ;SignalSemaphore(sem) 
  
  Delay(100) 
    
  gquit = 1 
   
  Input() 
  
  CloseConsole()
  
  
 CompilerEndIf  
  
  
CompilerEndIf

[idle]

added XOR_InsertElement() functions

[idle]

Made thread safe, its a temporary solution!

[benubi]

Heheheh

Here's what that "black magic" means. It's pretty tricky and an interesting subject again - like always. Didn't know such things existed but I suspected it somehow.

https://en.wikipedia.org/wiki/XOR_linked_list

Even tho it's off topic I wonder, idle: have you ever written a working skip-list code in PB, yet? I read a bit in the infamous dragon book, and I wondered if it wouldn't be the best option for a (dynamic) symbol table. The list itself would point to (next) array members (I suggest a .l index to save space and quickly reallocate the array in case it needs to be), all indices to parent/next/child would be array indices. What I don't like about some implementations is the probabilistic approach, because it needs to call a function to get a random number; I wonder if this call could be omitted, or perhaps the probability could be deduced by using counters somewhere. I can have a little byte stinginess, too. Too much maybe, I don't even write code and remain in analysis paralysis most of the time (not at 100% since my mind continues sculpting ideas)

[idle]

I thought someone here had done a skiplist but I don't recall where it was.

[idle]

Almost there have made it lock free for readers, concurrent writes still require a mutex for add element which is the only way i can avoid ABA issues, Walks forward and backwards are now working in threads with concurrent writers
but I still need to work out a strategy for deletes and inserts which will take some time and then maybe I can also remove the mutex.
next is to test Previous and next elements in threads, they should work now as it's the same as walks

Also I can't find a lock free implementation of an xor linked lists, so maybe this will be a first.
In case any of you are wondering why I would want to make a lock free xor linked list in the first place it's because of the memory alignment of the nodes as a node is two integers wide rather than three integers wide which will improve the performance.