# This implements a new pointer set. Access time O(1). For 32 bit systems, we
# currently need 3 memory accesses.
const
PageSize = 1024 * sizeof(int)
MemAlignment = 8 # minimal memory block that can be allocated
BitsPerUnit = sizeof(int)*8
# a "unit" is a word, i.e. 4 bytes
# on a 32 bit system; I do not use the term "word" because under 32-bit
# Windows it is sometimes only 16 bits
BitsPerPage = PageSize div MemAlignment
UnitsPerPage = BitsPerPage div BitsPerUnit
# how many units do we need to describe a page:
# on 32 bit systems this is only 16 (!)
type
PPointer = ptr pointer
TCollectorData = int
TCell {.final.} = object
refcount: TCollectorData # the refcount and bit flags
typ: PNimType
stackcount: int # stack counter for debugging
drefc: int # real reference counter for debugging
PCell = ptr TCell
proc cellToUsr(cell: PCell): pointer {.inline.} =
# convert object (=pointer to refcount) to pointer to userdata
result = cast[pointer](cast[TAddress](cell)+%TAddress(sizeof(TCell)))
proc usrToCell(usr: pointer): PCell {.inline.} =
# convert pointer to userdata to object (=pointer to refcount)
result = cast[PCell](cast[TAddress](usr)-%TAddress(sizeof(TCell)))
proc gcAlloc(size: int): pointer =
result = alloc0(size)
if result == nil: raiseOutOfMem()
# ------------------ Zero count table (ZCT) and any table (AT) -------------
# this that has to equals zero, otherwise we have to round up UnitsPerPage:
when BitsPerPage mod BitsPerUnit != 0:
{.error: "(BitsPerPage mod BitsPerUnit) should be zero!".}
# ------------------- cell set handling ------------------------------
# A cellset consists of a hash table of page descriptors. A page
# descriptor has a bit for
# every Memalignment'th byte in the page.
# However, only bits corresponding to addresses that start memory blocks
# are set.
# Page descriptors are also linked to a list; the list
# is used for easy traversing of all page descriptors; this allows a
# fast iterator.
# We use a specialized hashing scheme; the formula is :
# hash = Page bitand max
# We use linear probing with the formular: (5*h)+1
# Thus we likely get no collisions at all if the pages are given to us
# in a sequential manner by the operating system!
const
bitsPerNode = 10 # we use 10 bits per node; this means 3 memory accesses on
# 32 bit systems
type
PPageDesc = ptr TPageDesc
TBitIndex = range[0..UnitsPerPage-1]
TPageDesc {.final.} = object
next: PPageDesc # all nodes are connected with this pointer
key: TAddress # start address at bit 0
bits: array[TBitIndex, int] # a bit vector
PPageDescArray = ptr array[0..1000_000, PPageDesc]
TCellSet {.final.} = object
counter, max: int
head: PPageDesc
data: PPageDescArray
TSetNode {.final.} = object
n: array[0.. (1 shl bitsPerNode)-1, PSetNode]
PSetNode = ptr TSetNode
const
InitCellSetSize = 1024 # must be a power of two!
proc CellSetInit(s: var TCellSet) =
s.data = gcAlloc(InitCellSetSize * sizeof(PPageDesc))
s.max = InitCellSetSize-1
s.counter = 0
s.head = nil
proc CellSetDeinit(s: var TCellSet) =
var it = s.head
while it != nil:
var n = it.next
dealloc(it)
it = n
s.head = nil # play it safe here
dealloc(s.data)
s.data = nil
s.counter = 0
proc CellSetGet(t: TCellSet, key: TAddress): PPageDesc =
var h = cast[int](key) and t.max
while t.data[h] != nil:
if t.data[h].key == key: return t.data[h]
h = nextTry(h, t.max)
return nil
proc CellSetRawInsert(t: TCellSet, data: PPageDescArray,
desc: PPageDesc) =
var h = cast[int](desc.key) and t.max
while data[h] != nil:
assert(data[h] != desc)
h = nextTry(h, t.max)
assert(data[h] == nil)
data[h] = desc
proc CellSetEnlarge(t: var TCellSet) =
var
n: PPageDescArray
oldMax = t.max
t.max = ((t.max+1)*2)-1
n = gcAlloc((t.max + 1) * sizeof(PPageDesc))
for i in 0 .. oldmax:
if t.data[i] != nil:
CellSetRawInsert(t, n, t.data[i])
dealloc(t.data)
t.data = n
proc CellSetPut(t: var TCellSet, key: TAddress): PPageDesc =
var h = cast[int](key) and t.max
while true:
var x = t.data[h]
if x == nil: break
if x.key == key: return x
h = nextTry(h, t.max)
if (t.max+1) * 2 < t.counter * 3: CellSetEnlarge(t)
inc(t.counter)
h = cast[int](key) and t.max
while t.data[h] != nil: h = nextTry(h, t.max)
assert(t.data[h] == nil)
# the new page descriptor goes into result
result = gcAlloc(sizeof(TPageDesc))
result.next = t.head
result.key = key
t.head = result
t.data[h] = result
# ---------- slightly higher level procs ----------------------------------
proc in_Operator(s: TCellSet, cell: PCell): bool =
var
u: TAddress
t: PPageDesc
u = cast[TAddress](cell)
t = CellSetGet(s, u /% PageSize)
if t != nil:
u = (u %% PageSize) /% MemAlignment
result = (t.bits[u /% BitsPerUnit] and (1 shl (u %% BitsPerUnit))) != 0
else:
result = false
proc incl(s: var TCellSet, cell: PCell) =
var
u: TAddress
t: PPageDesc
u = cast[TAddress](cell)
t = CellSetPut(s, u /% PageSize)
u = (u %% PageSize) /% MemAlignment
t.bits[u /% BitsPerUnit] = t.bits[u /% BitsPerUnit] or
(1 shl (u %% BitsPerUnit))
proc excl(s: var TCellSet, cell: PCell) =
var
u: TAddress
t: PPageDesc
u = cast[TAddress](cell)
t = CellSetGet(s, u /% PageSize)
if t != nil:
u = (u %% PageSize) /% MemAlignment
t.bits[u %% BitsPerUnit] = (t.bits[u /% BitsPerUnit] and
not (1 shl (u %% BitsPerUnit)))
iterator elements(t: TCellSet): PCell {.inline.} =
# while traversing it is forbidden to add pointers to the tree!
var r = t.head
while r != nil:
var i = 0
while i <= high(r.bits):
var w = r.bits[i] # taking a copy of r.bits[i] here is correct, because
# modifying operations are not allowed during traversation
var j = 0
while w != 0: # test all remaining bits for zero
if (w and 1) != 0: # the bit is set!
yield cast[PCell]((r.key *% PageSize) +%
(i*%BitsPerUnit+%j) *% MemAlignment)
inc(j)
w = w shr 1
inc(i)
r = r.next