PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

BitArray class v1.04

https://www.purebasic.fr/english/viewtopic.php?t=47559

Page 1 of 1

BitArray class v1.04

Posted: Thu Sep 15, 2011 5:30 am
by wilbert
BitArray.pbi

Code: Select all

;
; BitArray v1.04
;
; memory is dynamically allocated 16 KiB at a time
;
;   *b.BitArray_Class = BitArray_New()
;
;   *b\Clear()
;   *b\Free()
;   v = *b\Count()
;   v = *b\Get(index)
;   *b\Set(index)
;   *b\Reset(index)
;   v = *b\Toggle(index)
;   *b\Walk(*callback [, userInfo])
;   *result.BitArray = *b\Intersect(*b2.BitArray)
;   *result.BitArray = *b\Union(*b2.BitArray)
;   *result.BitArray = *b\Except(*b2.BitArray)
;   s.s = *b\GetSize()
;

Structure BitArray_Root
  m.l[32768]
EndStructure

Structure BitArray
  *vt.l               ; offset 0
  *b32.BitArray_Root  ; offset 4
  b18.l[8192]         ; offset 8
EndStructure

Declare BitArray_Clear(*this.BitArray)
Declare BitArray_Free(*this.BitArray)
Declare.l BitArray_Count(*this.BitArray)
Declare.l BitArray_Get(*this.BitArray, index.l)
Declare BitArray_Set(*this.BitArray, index.l)
Declare BitArray_Reset(*this.BitArray, index.l)
Declare.l BitArray_Toggle(*this.BitArray, index.l)
Declare BitArray_Walk(*this.BitArray, *callback.l, userInfo.l = 0)
Declare.l BitArray_Intersect(*this.BitArray, *b.BitArray)
Declare.l BitArray_Union(*this.BitArray, *b.BitArray)
Declare.l BitArray_Except(*this.BitArray, *b.BitArray)
Declare.s BitArray_GetMemSize(*this.BitArray)

Interface BitArray_Class 
  Clear()
  Free()
  Count.l()
  Get.l(index.l)
  Set(index.l)
  Reset(index.l)
  Toggle.l(index.l)
  Walk(*callback.l, userInfo.l = 0)
  Intersect.l(*b.BitArray)
  Union.l(*b.BitArray)
  Except.l(*b.BitArray)
  GetSize.s()
EndInterface

DataSection:
  vt_BitArray: 
  Data.l @BitArray_Clear()
  Data.l @BitArray_Free()
  Data.l @BitArray_Count()
  Data.l @BitArray_Get()
  Data.l @BitArray_Set()
  Data.l @BitArray_Reset()
  Data.l @BitArray_Toggle()
  Data.l @BitArray_Walk()
  Data.l @BitArray_Intersect()
  Data.l @BitArray_Union()
  Data.l @BitArray_Except()
  Data.l @BitArray_GetMemSize()
  
  t_BitArrayCount:
  Data.l 0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5
  Data.l 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6
  Data.l 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6
  Data.l 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7
  Data.l 1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6
  Data.l 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7
  Data.l 2,3,3,4,3,4,4,5,3,4,4,5,4,5,5,6,3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7
  Data.l 3,4,4,5,4,5,5,6,4,5,5,6,5,6,6,7,4,5,5,6,5,6,6,7,5,6,6,7,6,7,7,8
EndDataSection

Procedure BitArray_New()
  Protected *this.BitArray
  *this = AllocateMemory(SizeOf(BitArray))
  If *this
    *this\vt = ?vt_BitArray 
  EndIf  
  ProcedureReturn *this 
EndProcedure

Procedure BitArray_Clear(*this.BitArray)
  Protected i.l, m.l
  If *this
    If *this\b32
      For i = 0 To $7fff
        m = *this\b32\m[i]
        If m : FreeMemory(m) : EndIf
      Next
      FreeMemory(*this\b32)
    EndIf
    FillMemory(*this + 4, SizeOf(BitArray) - 4)
  EndIf
EndProcedure

Procedure BitArray_Free(*this.BitArray)
  If *this
    BitArray_Clear(*this)
    FreeMemory(*this)
  EndIf
  ProcedureReturn 0
EndProcedure

Procedure.l BitArray_CountBlock(source.l, bytes.l)
  EnableASM
  MOV edx, source
  MOV ecx, bytes
  !push ebx
  !push esi
  !lea ebx, [edx + ecx]
  !mov esi, edx
  !xor eax, eax
  !xor edx, edx
  !bitarray_count_block_loop:
  !mov ecx, [esi]
  !mov dl, cl
  !add eax, [l_t_bitarraycount + edx*4]
  !mov dl, ch
  !add eax, [l_t_bitarraycount + edx*4]
  !bswap ecx
  !mov dl, cl
  !add eax, [l_t_bitarraycount + edx*4]
  !mov dl, ch
  !add eax, [l_t_bitarraycount + edx*4]
  !add esi, 4
  !cmp esi, ebx
  !jb bitarray_count_block_loop
  !pop esi
  !pop ebx
  DisableASM
  ProcedureReturn
EndProcedure

Procedure.l BitArray_Count(*this.BitArray)
  Protected c.l, i.l, m.l, count.l = 0
  If *this
    If *this\b32
      For i = 0 To $7fff
        m = *this\b32\m[i]
        If m
          c = BitArray_CountBlock(m, $4000)
          If c
            count + c
          Else
            FreeMemory(m)
            *this\b32\m[i] = 0
          EndIf
        EndIf
      Next
      If count = 0
        FreeMemory(*this\b32)
        *this\b32 = 0
      EndIf
    EndIf
    count + BitArray_CountBlock(@*this\b18, $8000)
  EndIf
  ProcedureReturn count
EndProcedure

Procedure.l BitArray_Get(*this.BitArray, index.l)
  EnableASM
  MOV eax, *this
  MOV ecx, index
  !and eax, eax
  !jnz bitarray_get_ok
  ProcedureReturn
  !bitarray_get_ok:
  !lea edx, [eax + 8]
  !test ecx, 0xfffc0000
  !jz bitarray_get18
  !sub edx, 4
  !mov eax, [edx]
  !and eax, eax
  !jz bitarray_get_exit
  !mov edx, ecx
  !shr edx, 17
  !mov eax, [eax + edx*4]
  !and eax, eax
  !jz bitarray_get_exit
  !mov edx, eax
  !and ecx, 0x1ffff  
  !bitarray_get18:
  !mov eax, ecx
  !shr eax, 5
  !and ecx, 31
  !bt [edx + eax*4], ecx
  !rcl eax, 1
  !and eax, 1
  !bitarray_get_exit:
  DisableASM
  ProcedureReturn
EndProcedure

Macro BitArray_AllocMem(n)
  !push ecx
  !push edx
  !push ebp
  !mov ebp, esp
  !and esp, 0xfffffff0
  AllocateMemory(n)
  !mov esp, ebp
  !pop ebp
  !pop edx
  !pop ecx
EndMacro

Macro BitArray_MacroOp(op)
  EnableASM
  MOV eax, *this
  MOV ecx, index
  !and eax, eax
  !jnz bitarray_#op#_ok
  ProcedureReturn
  !bitarray_#op#_ok:
  !lea edx, [eax + 8]
  !test ecx, 0xfffc0000
  !jz bitarray_#op#18
  !sub edx, 4
  !mov eax, [edx]
  !and eax, eax
  !jnz bitarray_#op#_root_ok
  BitArray_AllocMem($20000)
  !mov [edx], eax
  !bitarray_#op#_root_ok:
  !mov edx, ecx
  !shr edx, 17
  !lea edx, [eax + edx*4]
  !mov eax, [edx]
  !and eax, eax
  !jnz bitarray_#op#_sub_ok
  BitArray_AllocMem($4000)
  !mov [edx], eax
  !bitarray_#op#_sub_ok:
  !mov edx, eax
  !and ecx, 0x1ffff
  !bitarray_#op#18:
  !mov eax, ecx
  !shr eax, 5
  !and ecx, 31
  DisableASM
EndMacro

Procedure BitArray_Set(*this.BitArray, index.l)
  BitArray_MacroOp(set)
  !bts [edx + eax*4], ecx
  ProcedureReturn
EndProcedure

Procedure BitArray_Reset(*this.BitArray, index.l)
  BitArray_MacroOp(reset)
  !btr [edx + eax*4], ecx
  ProcedureReturn
EndProcedure

Procedure.l BitArray_Toggle(*this.BitArray, index.l)
  BitArray_MacroOp(toggle)
  !btc [edx + eax*4], ecx
  !sbb eax, eax
  !inc eax
  ProcedureReturn
EndProcedure

Procedure BitArray_Walk(*this.BitArray, *callback.l, userInfo.l = 0)
  EnableASM
  MOV eax, *this
  MOV ecx, *callback
  MOV edx, userInfo
  !and eax, eax
  !jnz ba_walk_ok
  ProcedureReturn
  !ba_walk_ok:
  !push ebx
  !push esi
  !push edi
  !push ebp
  !mov edi, edx                 ; edi = userInfo
  !lea edx, [eax + 8]           ; edx = *this\b18
  !xor ebx, ebx                 ; ebx = start index
  !mov ebp, 0x8000              ; ebp = num bytes
  !push edx
  !call ba_walk_block
  !pop edx
  !mov eax, [edx - 4]
  !and eax, eax
  !jz ba_walk_noroot
  !sub esp, 12
  !mov [esp], eax
  !mov dword [esp + 4], 0x8000  ; block counter
  !mov dword [esp + 8], 0       ; start index
  !ba_walk_loop:
  !mov eax, [esp]
  !mov edx, [eax]
  !and edx, edx
  !jz ba_walk_nosub
  !mov ebx, [esp + 8]
  !mov ebp, 0x4000
  !call ba_walk_block
  !ba_walk_nosub:
  !add dword [esp], 4
  !add dword [esp + 8], 0x20000
  !dec dword [esp + 4]
  !jnz ba_walk_loop
  !add esp, 12
  !ba_walk_noroot:
  !pop ebp
  !pop edi
  !pop esi
  !pop ebx
  ProcedureReturn
  ; edx = block start
  ; ebx = start index
  ; ebp = byte counter
  ; ecx = callback
  ; edi = userinfo
  !ba_walk_block:
  !add ebx, 32
  !mov eax, [edx]
  !and eax, eax
  !jz ba_walk_skip32
  !sub ebx, 32
  !xor esi, esi
  !ba_walk_l32:
  !bt eax, esi
  !jnc ba_walk_no_call
  !push eax
  !push ecx
  !push edx
  !push ebp
  !mov ebp, esp
  !and esp, 0xfffffff0
  !sub esp, 8
  !push edi
  !push ebx
  !call ecx
  !mov esp, ebp
  !pop ebp
  !pop edx
  !pop ecx
  !pop eax
  !ba_walk_no_call:
  !inc ebx
  !inc esi
  !bt esi, 5
  !jnc ba_walk_l32
  !ba_walk_skip32:
  !add edx, 4
  !sub ebp, 4
  !jnz ba_walk_block
  !ret
EndProcedure

Macro BitArray_Logic(operation, opcode)
  If *this\b32 And *b\b32
    *result\b32 = AllocateMemory($20000)
    For i = 0 To $7fff
      If *this\b32\m[i] And *b\b32\m[i]
        *result\b32\m[i] = AllocateMemory($4000)  
      EndIf
    Next
  EndIf
  EnableASM
  MOV eax, *this
  MOV ecx, *b
  MOV edx, *result
  !push ebx
  !mov ebx, 8
  !ba_#operation#_loop0:
  !movq mm0, [ecx + ebx]
  opcode mm0, [eax + ebx]
  !movq [edx + ebx], mm0
  !add ebx, 8
  !cmp ebx, 0x8008
  !jb ba_#operation#_loop0
  !mov edx, [edx + 4]
  !and edx, edx
  !jz ba_#operation#_noroot
  !mov ecx, [ecx + 4]
  !mov eax, [eax + 4]
  !xor ebx, ebx
  !push esi
  !ba_#operation#_loop1:
  !push edx
  !mov edx, [edx + ebx]
  !and edx, edx
  !jz ba_#operation#_skip
  !push ecx
  !push eax
  !mov ecx, [ecx + ebx]
  !mov eax, [eax + ebx]
  !xor esi, esi
  !ba_#operation#_loop2:
  !movq mm0, [ecx + esi]
  opcode mm0, [eax + esi]
  !movq [edx + esi], mm0
  !add esi, 8
  !cmp esi, 0x4000
  !jb ba_#operation#_loop2
  !pop eax
  !pop ecx
  !ba_#operation#_skip:
  !pop edx
  !add ebx, 4
  !cmp ebx, 0x20000
  !jb ba_#operation#_loop1
  !pop esi
  !ba_#operation#_noroot:
  !pop ebx
  !ba_#operation#_exit:
  !emms
  DisableASM
EndMacro

Procedure.l BitArray_Intersect(*this.BitArray, *b.BitArray)
  Protected i.l, *result.BitArray = BitArray_New()
  If *this And *b And *result
    BitArray_Logic(intersect, pand)
  EndIf
  ProcedureReturn *result
EndProcedure

Procedure.l BitArray_Union(*this.BitArray, *b.BitArray)
  Protected i.l, *result.BitArray = BitArray_New()
  If *this And *b And *result
    BitArray_Logic(union, pxor)
  EndIf
  If *result
    If *this
      If Not *b : CopyMemory(@*this\b18, @*result\b18, $8000) : EndIf 
      If *this\b32
        If Not *result\b32 : *result\b32 = AllocateMemory($20000) : EndIf
        For i = 0 To $7fff
          If *this\b32\m[i] And Not *result\b32\m[i]
            *result\b32\m[i] = AllocateMemory($4000)
            CopyMemory(*this\b32\m[i], *result\b32\m[i], $4000)
          EndIf
        Next
      EndIf
    EndIf
    If *b
      If Not *this : CopyMemory(@*b\b18, @*result\b18, $8000) : EndIf 
      If *b\b32
        If Not *result\b32 : *result\b32 = AllocateMemory($20000) : EndIf
        For i = 0 To $7fff
          If *b\b32\m[i] And Not *result\b32\m[i]
            *result\b32\m[i] = AllocateMemory($4000)
            CopyMemory(*b\b32\m[i], *result\b32\m[i], $4000)
          EndIf
        Next
      EndIf
    EndIf
  EndIf
  ProcedureReturn *result
EndProcedure

Procedure.l BitArray_Except(*this.BitArray, *b.BitArray)
  Protected i.l, *result.BitArray = BitArray_New()
  If *this And *b And *result
    BitArray_Logic(except, pandn)
  EndIf
  If *result
    If *this
      If Not *b : CopyMemory(@*this\b18, @*result\b18, $8000) : EndIf 
      If *this\b32
        If Not *result\b32 : *result\b32 = AllocateMemory($20000) : EndIf
        For i = 0 To $7fff
          If *this\b32\m[i] And Not *result\b32\m[i]
            *result\b32\m[i] = AllocateMemory($4000)
            CopyMemory(*this\b32\m[i], *result\b32\m[i], $4000)
          EndIf
        Next
      EndIf
    EndIf
  EndIf
  ProcedureReturn *result
EndProcedure

Procedure.s BitArray_GetMemSize(*this.BitArray)
  Protected i.l, sz.s, size.l
  If *this
    size = SizeOf(BitArray)
    If *this\b32
      size + $20000
      For i = 0 To $7fff
        If *this\b32\m[i] : size + $4000 : EndIf
      Next
    EndIf
    If size < 1048576
      sz = Str(size/1024) + " KiB"
    Else
      sz = Str(size/1048576) + " MiB"
    EndIf
  EndIf
  ProcedureReturn sz
EndProcedure

Re: BitArray class v1.03

Posted: Thu Sep 15, 2011 5:31 am
by wilbert
Performance test (compile without debugger)

Code: Select all

IncludeFile "BitArray.pbi"

Procedure CB(index.l)
EndProcedure

Global size = 1024*1024*32
Global *b.BitArray_Class = BitArray_New()
Global *b2.BitArray_Class = BitArray_New()
Global *b3.BitArray_Class

start = ElapsedMilliseconds()
For i = 0 To size
  *b\Set(i)
Next i  

stop = ElapsedMilliseconds()
BitArray_Set = stop-start

start = ElapsedMilliseconds()
For i = 0 To size
  x = *b\Reset(i)
Next i  

stop = ElapsedMilliseconds()
BitArray_Reset = stop-start

start = ElapsedMilliseconds()
For i = 0 To size
  x = *b\Get(i)
Next i 

stop = ElapsedMilliseconds()
BitArray_Get = stop-start

start = ElapsedMilliseconds()
For i = 0 To size
  x = *b\Toggle(i)
Next i 

stop = ElapsedMilliseconds()
BitArray_Toggle = stop-start

start = ElapsedMilliseconds()
*b\Walk(@CB())

stop = ElapsedMilliseconds()
BitArray_Walk = stop-start

For i = 0 To size
  *b2\Set(i)
Next i  

start = ElapsedMilliseconds()
*b3 = *b\Intersect(*b2)

stop = ElapsedMilliseconds()
BitArray_Intersect = stop-start

*b3\Free()

start = ElapsedMilliseconds()
*b3 = *b\Union(*b2)

stop = ElapsedMilliseconds()
BitArray_Union = stop-start

*b3\Free()

start = ElapsedMilliseconds()
*b3 = *b\Except(*b2)

stop = ElapsedMilliseconds()
BitArray_Except = stop-start

start = ElapsedMilliseconds()
count = *b\Count()

stop = ElapsedMilliseconds()
BitArray_Count = stop-start

times.s = "BitArray Set = " + Str(BitArray_Set) + #CRLF$
times   + "BitArray Reset = " + Str(BitArray_Reset) + #CRLF$
times   + "BitArray Get = " + Str(BitArray_Get) + #CRLF$
times   + "BitArray Toggle = " + Str(BitArray_Toggle) + #CRLF$
times   + "BitArray Walk = " + Str(BitArray_Walk) + #CRLF$
times   + "BitArray Intersect = " + Str(BitArray_Intersect) + #CRLF$
times   + "BitArray Union = " + Str(BitArray_Union) + #CRLF$
times   + "BitArray Except = " + Str(BitArray_Except) + #CRLF$
times   + "BitArray Count = " + Str(BitArray_Count) + #CRLF$
MessageRequester("Times", times)

mem.s = *b\GetSize()
MessageRequester("", mem)

*b\Free()
*b2\Free()
*b3\Free()
Simple example

Code: Select all

IncludeFile "BitArray.pbi"

Procedure Callback(index.l)
  Debug index
EndProcedure

*b1.BitArray_Class = BitArray_New()
*b2.BitArray_Class = BitArray_New()

For i = 0 To 99
  
  ; fill *b1 with indexes dividable by 3 
  If i % 3 = 0
    *b1\Set(i)
  EndIf
  
  ; fill *b2 with indexes dividable by 5 
  If i % 5 = 0
    *b2\Set(i)
  EndIf
  
Next i  

*b3.BitArray_Class = *b1\Intersect(*b2)
*b4.BitArray_Class = *b1\Union(*b2)
*b5.BitArray_Class = *b1\Except(*b2)

Debug "Intersect (" + Str(*b3\Count()) + " results)"

*b3\Walk(@Callback())

Debug "Union (" + Str(*b4\Count()) + " results)"

*b4\Walk(@Callback())

Debug "Except (" + Str(*b5\Count()) + " results)"

*b5\Walk(@Callback())

*b1\Free()
*b2\Free()
*b3\Free()
*b4\Free()
*b5\Free()

Re: BitArray class v1.03

Posted: Thu Sep 15, 2011 8:57 pm
by idle
Thats great work.

Re: BitArray class v1.03

Posted: Fri Sep 16, 2011 6:14 pm
by Zach
Wow, this is way, way, way beyond me.... :|

Re: BitArray class v1.03

Posted: Fri Sep 16, 2011 7:55 pm
by wilbert
Zach wrote:Wow, this is way, way, way beyond me.... :|
It's just an array of bits :wink:
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited