This particular implementation of a bitarray was taken from coco/r ( http://ssw.jku.at/Coco/ ). coco/r is a compiler compiler that, given the description of a language, creates a top down parser and a scanner to recognize the described language.
Copyright notice has been copied verbose from the original source code (original source code can be found at the coco/r website).
Code: Select all
/'-------------------------------------------------------------------------
Compiler Generator Coco/R,
Copyright (c) 1990, 2004 Hanspeter Moessenboeck, University of Linz
extended by M. Loeberbauer & A. Woess, Univ. of Linz
ported to C++ by Csaba Balazs, University of Szeged
with improvements by Pat Terry, Rhodes University
This program is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 2, or (at your option) any
later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
for more details.
You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
As an exception, it is allowed to write an extension of Coco/R that is
used as a plugin in non-free software.
If not otherwise stated, any source code generated by Coco/R (other than
Coco/R itself) does not fall under the GNU General Public License.
-------------------------------------------------------------------------'/
#ifndef COCO_BITARRAY_H__
#define COCO_BITARRAY_H__
#ifdef NIL
#undef NIL
#endif
#define NIL 0
type bitarray_
public:
dim count as integer
dim data as ubyte ptr
end type
declare function bitarray_create(byval length as integer, byval defaultvalue as byte) as bitarray_ ptr
declare function bitarray_create_copy(byval copy as bitarray_ ptr) as bitarray_ ptr
declare sub bitarray_destroy(byref bitarray as bitarray_ ptr)
declare function bitarray_getcount(byval bitarray as bitarray_ ptr) as integer
declare function bitarray_get(byval bitarray as bitarray_ ptr, byval index as integer) as byte
declare sub bitarray_set(byval bitarray as bitarray_ ptr,byval index as integer, byval value as byte)
declare sub bitarray_setall(byval bitarray as bitarray_ ptr, byval value as byte)
declare function bitarray_equal(byval bitarray as bitarray_ ptr, byval right_ as bitarray_ ptr) as byte
declare function bitarray_itemat(byval bitarray as bitarray_ ptr, byval index as integer) as byte
declare function bitarray_assign(byval bitarray as bitarray_ ptr, byval right_ as bitarray_ ptr) as bitarray_ ptr
declare sub bitarray_not(byval bitarray as bitarray_ ptr)
declare sub bitarray_and(byval bitarray as bitarray_ ptr, byval value as bitarray_ ptr)
declare sub bitarray_or(byval bitarray as bitarray_ ptr, byval value as bitarray_ ptr)
declare sub bitarray_xor(byval bitarray as bitarray_ ptr, byval value as bitarray_ ptr)
declare function bitarray_clone(byval bitarray as bitarray_ ptr) as bitarray_ ptr
#endif '' ifndef COCO_BITARRAY_H__
#include "crt/string.bi"
#include "crt/stdio.bi"
function bitarray_create(byval length as integer, byval defaultvalue as byte) as bitarray_ ptr
dim bitarray as bitarray_ ptr
if (length < 0) then
return NIL
end if
bitarray = callocate(sizeof(bitarray_),1)
bitarray->count = length
bitarray->data = callocate(sizeof(ubyte),(length+7) shr 3)
if (defaultvalue) then
memset(bitarray->data, &hFF, (length+7) shr 3)
else
memset(bitarray->data, 0, (length+7) shr 3)
end if
return bitarray
end function
'bitarray_create_copy will return NIL when copy equals NIL
function bitarray_create_copy(byval copy as bitarray_ ptr) as bitarray_ ptr
if (copy = NIL) then
return NIL
end if
dim bitarray as bitarray_ ptr
bitarray = callocate(sizeof(bitarray_),1)
bitarray->count = copy->count
bitarray->data = callocate(sizeof(ubyte),(copy->count+7) shr 3)
memcpy(bitarray->data, copy->data, (copy->count+7) shr 3)
return bitarray
end function
sub bitarray_destroy(byref bitarray as bitarray_ ptr)
if (bitarray = NIL) then
return
end if
if (bitarray->data = NIL) then
deallocate(bitarray)
bitarray = NIL
return
end if
deallocate(bitarray->data)
bitarray->data = NIL
deallocate(bitarray)
bitarray = NIL
end sub
'returns -1 when bitarray equals NIL
function bitarray_getcount(byval bitarray as bitarray_ ptr) as integer
if (bitarray = NIL) then
return -1
end if
return bitarray->count
end function
'returns -1 if bitarray is NIL
function bitarray_get(byval bitarray as bitarray_ ptr, byval index as integer) as byte
if (bitarray = NIL) then
return -1
end if
if ((bitarray->data[(index shr 3)] and (1 shl (index and 7))) <> 0) then
return 1
else
return 0
end if
end function
sub bitarray_set(byval bitarray as bitarray_ ptr,byval index as integer, byval value as byte)
if (bitarray = NIL) then
return
end if
if (value) then
bitarray->data[(index shr 3)] or= (1 shl (index and 7))
else
dim mask as ubyte = &hFF
mask xor= (1 shl (index and 7))
bitarray->data[(index shr 3)] and= mask
end if
end sub
sub bitarray_setall(byval bitarray as bitarray_ ptr, byval value as byte)
if (bitarray = NIL) then
return
end if
if (value) then
memset(bitarray->data, &hFF, (bitarray->count+7) shr 3)
else
memset(bitarray->data, 0, (bitarray->count+7) shr 3)
end if
end sub
sub bitarray_not(byval bitarray as bitarray_ ptr)
if (bitarray = NIL) then
return
end if
for i as integer = 0 to ((bitarray->count+7) shr 3)
bitarray->data[i] xor= &hff
next i
end sub
sub bitarray_and(byval bitarray as bitarray_ ptr, byval value as bitarray_ ptr)
if (bitarray = NIL) then
return
end if
var i = 0l
while ( i < ((bitarray->count+7) shr 3) andalso i < ((value->count+7) shr 3))
bitarray->data[i] = (bitarray->data[i] and value->data[i])
i += 1
wend
end sub
sub bitarray_or(byval bitarray as bitarray_ ptr, byval value as bitarray_ ptr)
if (bitarray = NIL) then
return
end if
var i = 0l
while ( i < ((bitarray->count+7) shr 3) andalso i < ((value->count+7) shr 3))
bitarray->data[i] = (bitarray->data[i] or value->data[i])
i += 1
wend
end sub
sub bitarray_xor(byval bitarray as bitarray_ ptr, byval value as bitarray_ ptr)
if (bitarray = NIL) then
return
end if
var i = 0l
while ( i < ((bitarray->count+7) shr 3) andalso i < ((value->count+7) shr 3))
bitarray->data[i] = (bitarray->data[i] or value->data[i])
i += 1
wend
end sub
'returns NIL if bitarray equals NIL. Allocates a new bitarray and copies
'content of bitarray to the new bitarray otherwise.
function bitarray_clone(byval bitarray as bitarray_ ptr) as bitarray_ ptr
if (bitarray = NIL) then
return NIL
end if
dim newbitarray as bitarray_ ptr = bitarray_create(bitarray->count,0)
newbitarray->count = bitarray->count
memcpy(newbitarray->data, bitarray->data, (bitarray->count+7) shr 3)
return newbitarray
end function
function bitarray_equal(byval bitarray as bitarray_ ptr, byval right_ as bitarray_ ptr) as byte
if (bitarray = NIL) then
if (right_ = NIL) then
return 1
else
return 0
end if
end if
if (right_ = NIL) then
if (bitarray = NIL) then
return 1
else
return 0
end if
end if
if (bitarray->count <> right_->count) then
return 0
end if
for i as integer = 0 to bitarray->count
if ((bitarray->data[(i shr 3)] and (1 shl (i and 7))) <> (right_->data[(i shr 3)] and (1 shl (i and 7)))) then
return 0
end if
next i
return 1
end function
'bitarray should be created before calling bitarray_assign.
'bitarray_assign fails when either bitarray or right_ equals NIL
function bitarray_assign(byval bitarray as bitarray_ ptr, byval right_ as bitarray_ ptr) as bitarray_ ptr
if (bitarray = NIL) then
return NIL
end if
if (right_ = NIL) then
return NIL
end if
if ( right_ <> bitarray ) then '' avoid self assignment
if (bitarray->data <> NIL) then
deallocate(bitarray->data) '' prevents memory leak
end if
bitarray->count = right_->count
bitarray->data = callocate(sizeof(ubyte), (bitarray->count+7) shr 3)
memcpy(bitarray->data, right_->data, (bitarray->count+7) shr 3)
end if
return bitarray
end function
function bitarray_itemat(byval bitarray as bitarray_ ptr, byval index as integer) as byte
if (bitarray = NIL) then
return -1
end if
return bitarray_get(bitarray,index)
end function
sub bitarray_dump(byval bitarray as bitarray_ ptr)
if (bitarray = NIL) then
return
end if
var i = bitarray_getcount(bitarray)
for j as integer = 0 to i - 1
if (j mod 8 = 0 andalso j <> 0) then
print
end if
print bitarray_itemat(bitarray,j);" ";
next j
end sub
dim bitarray as bitarray_ ptr
dim right_ as bitarray_ ptr
dim copy_ as bitarray_ ptr
bitarray = bitarray_create(32,0)
assertwarn(bitarray <> NIL)
var count = bitarray_getcount(bitarray)
dim l as byte
for i as integer = 0 to count - 1
l = bitarray_get(bitarray,i)
assertwarn(l = 0)
l = bitarray_itemat(bitarray,i)
assertwarn(l = 0)
next i
right_ = bitarray_create(32,0)
assertwarn(right_ <> NIL)
bitarray_set(right_,0,1)
l = bitarray_get(right_,0)
assertwarn(l = 1)
bitarray_setall(right_,1)
bitarray_setall(bitarray,0)
count = bitarray_getcount(right_)
assertwarn(count = 32)
for i as integer = 0 to count - 1
l = bitarray_get(right_,i)
assertwarn(l = 1)
next i
for i as integer = 0 to count - 1
l = bitarray_get(bitarray,i)
assertwarn(l = 0)
next i
bitarray_and(right_,bitarray)
for i as integer = 0 to bitarray_getcount(right_) - 1
l = bitarray_get(right_,i)
assertwarn(l = 0)
next i
bitarray_not(right_)
for i as integer = 0 to bitarray_getcount(right_) - 1
l = bitarray_get(right_,i)
assertwarn(l = 1)
next i
bitarray_or(bitarray,right_)
for i as integer = 0 to bitarray_getcount(bitarray) - 1
l = bitarray_get(bitarray,i)
assertwarn(l = 1)
next i
copy_ = bitarray_create_copy(bitarray)
for i as integer = 0 to bitarray_getcount(copy_) - 1
l = bitarray_get(copy_,i)
assertwarn(l = 1)
next i
bitarray_xor(copy_,copy_)
for i as integer = 0 to bitarray_getcount(copy_) - 1
l = bitarray_get(copy_,i)
assertwarn(l = 1)
next i
bitarray_setall(right_,0)
l = bitarray_equal(right_,copy_)
assertwarn(l=0)
bitarray_destroy(copy_)
assertwarn(copy_=NIL)
copy_ = bitarray_clone(right_)
assertwarn(bitarray_getcount(copy_) = bitarray_getcount(right_))
bitarray_destroy(bitarray)
assertwarn(bitarray=NIL)
bitarray_destroy(right_)
assertwarn(right_=NIL)
bitarray_destroy(copy_)
assertwarn(copy_=NIL)
bitarray = bitarray_create(32,0)
right_ = bitarray_create(32,0)
bitarray_setall(right_,1)
copy_ = bitarray_assign(bitarray, right_)
l = bitarray_getcount(copy_)
assertwarn(l = bitarray_getcount(bitarray))
bitarray_destroy(bitarray)
assertwarn(bitarray=NIL)
bitarray_destroy(right_)
assertwarn(right_=NIL)
bitarray_destroy(copy_)
assertwarn(copy_=NIL)