list.bas

Go to the documentation of this file.

'' generic double-linked list
''
'' chng: jan/2005 written [v1ctor]
''

#include once "list.bi"

sub fatalOutOfMemory()
	'' Abort right now, the rtlib will show the error
	error(4)
end sub

function xallocate(byval size as long) as any ptr
	dim as any ptr p = allocate(size)
	if (p = NULL) then
		fatalOutOfMemory()
	end if
	return p
end function

function xcallocate(byval size as long) as any ptr
	dim as any ptr p = callocate(size)
	if (p = NULL) then
		fatalOutOfMemory()
	end if
	return p
end function

function xreallocate(byval old as any ptr, byval size as long) as any ptr
	dim as any ptr p = reallocate(old, size)
	if (p = NULL) then
		fatalOutOfMemory()
	end if
	return p
end function

sub listInit _
	( _
		byval list as TLIST ptr, _
		byval nodes as integer, _
		byval nodelen as integer, _
		byval flags as LIST_FLAGS _
	)

	'' fill ctrl struct
	list->tbhead = NULL
	list->tbtail = NULL
	list->nodes	= 0
	list->nodelen = nodelen + len( TLISTNODE )
	list->head = NULL
	list->tail = NULL
	list->flags	= flags

	'' allocate the initial pool
	listAllocTB( list, nodes )

end sub

sub listEnd(byval list as TLIST ptr)
	dim as TLISTTB ptr tb = any, nxt = any

	'' for each pool, free the mem block and the pool ctrl struct
	tb = list->tbhead
	do while( tb <> NULL )
		nxt = tb->next
		deallocate( tb->nodetb )
		deallocate( tb )
		tb = nxt
	loop

	list->tbhead = NULL
	list->tbtail = NULL
	list->nodes	= 0
end sub

sub listAllocTB _
	( _
		byval list as TLIST ptr, _
		byval nodes as integer _
	)

	dim as TLISTNODE ptr nodetb = any, node = any, prv = any
	dim as TLISTTB ptr tb = any
	dim as integer i = any

	assert(nodes >= 1)

	'' allocate the pool
	if( (list->flags and LIST_FLAGS_CLEARNODES) <> 0 ) then
		nodetb = xcallocate( nodes * list->nodelen )
	else
		nodetb = xallocate( nodes * list->nodelen )
	end if

	'' and the pool ctrl struct
	tb = xallocate( len( TLISTTB ) )

	'' add the ctrl struct to pool list
	if( list->tbhead = NULL ) then
		list->tbhead = tb
	end if
	if( list->tbtail <> NULL ) then
		list->tbtail->next = tb
	end if
	list->tbtail = tb

	tb->next = NULL
	tb->nodetb = nodetb
	tb->nodes = nodes

	'' add new nodes to the free list
	list->fhead = nodetb
	list->nodes += nodes

	''
	if( (list->flags and LIST_FLAGS_LINKFREENODES) <> 0 ) then
		prv = NULL
		node = list->fhead

		for i = 1 to nodes-1
			node->prev	= prv
			node->next	= cast( TLISTNODE ptr, cast( byte ptr, node ) + list->nodelen )

			prv = node
			node = node->next
		next

		node->prev = prv
		node->next = NULL
	end if

end sub

'':::::
function listNewNode _
	( _
		byval list as TLIST ptr _
	) as any ptr

	dim as TLISTNODE ptr node = any, tail = any

	'' alloc new node list if there are no free nodes
	if( list->fhead = NULL ) Then
		listAllocTB( list, cunsg(list->nodes) \ 4 )
	end if

	'' take from free list
	node = list->fhead
	list->fhead = node->next

	if( (list->flags and LIST_FLAGS_LINKUSEDNODES) <> 0 ) then
		'' add to used list
		tail = list->tail
		list->tail = node
		if( tail <> NULL ) then
			tail->next = node
		else
			list->head = node
		end If

		node->prev = tail
		node->next = NULL

		function = cast( byte ptr, node ) + len( TLISTNODE )

	else
		function = node
	end if

end function

'':::::
sub listDelNode _
	( _
		byval list as TLIST ptr, _
		byval node_ as any ptr _
	)

	dim as TLISTNODE ptr node = any, prv = any, nxt = any

	if( node_ = NULL ) then
		exit sub
	end if

	if( (list->flags and LIST_FLAGS_LINKUSEDNODES) <> 0 ) then
		node = cast( TLISTNODE ptr, cast( byte ptr, node_ ) - len( TLISTNODE ) )

		'' remove from used list
		prv = node->prev
		nxt = node->next
		if( prv <> NULL ) then
			prv->next = nxt
		else
			list->head = nxt
		end If

		if( nxt <> NULL ) then
			nxt->prev = prv
		else
			list->tail = prv
		end If

	else
		node = cast( TLISTNODE ptr, node_ )
	end if

	'' add to free list
	node->next = list->fhead
	list->fhead = node

	'' node can contain strings descriptors, so, erase it..
	if( (list->flags and LIST_FLAGS_CLEARNODES) <> 0 ) then
		clear( byval node_, 0, list->nodelen - len( TLISTNODE ) )
	end if

end sub

'':::::
function listGetHead _
	( _
		byval list as TLIST ptr _
	) as any ptr

	assert( (list->flags and LIST_FLAGS_LINKUSEDNODES) <> 0 )

	if( list->head = NULL ) then
		function = NULL
	else
		function = cast( byte ptr, list->head ) + len( TLISTNODE )
	end if

end function

'':::::
function listGetTail _
	( _
		byval list as TLIST ptr _
	) as any ptr

	assert( (list->flags and LIST_FLAGS_LINKUSEDNODES) <> 0 )

	if( list->tail = NULL ) then
		function = NULL
	else
		function = cast( byte ptr, list->tail ) + len( TLISTNODE )
	end if

end function

'':::::
function listGetPrev _
	( _
		byval node as any ptr _
	) as any ptr

    dim as TLISTNODE ptr prev = any

	assert( node <> NULL )

	prev = cast( TLISTNODE ptr, _
				 cast( byte ptr, node ) - len( TLISTNODE ) )->prev

	if( prev = NULL ) then
		function = NULL
	else
		function = cast( byte ptr, prev ) + len( TLISTNODE )
	end if

end function

'':::::
function listGetNext _
	( _
		byval node as any ptr _
	) as any ptr

    dim as TLISTNODE ptr nxt = any

	assert( node <> NULL )

	nxt = cast( TLISTNODE ptr, _
				cast( byte ptr, node ) - len( TLISTNODE ) )->next

	if( nxt = NULL ) then
		function = NULL
	else
		function = cast( byte ptr, nxt ) + len( TLISTNODE )
	end if

end function

sub strlistAppend(byval list as TLIST ptr, byref s as string)
	dim as string ptr p = listNewNode(list)
	*p = s
end sub

sub strlistInit(byval list as TLIST ptr, byval nodes as integer)
	listInit(list, nodes, sizeof(string))
end sub