/' -------------------------------------------------------------------------------- This file is part of TOKGEN source distribution -------------------------------------------------------------------------------- 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 of the License, 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 -------------------------------------------------------------------------------- '/ #Ifndef __TOKGEN_STACK__ #Define __TOKGEN_STACK__ '' DefineStackType macro - defines new type: {Type}Stack (i.e. IntegerStack, StringStack, etc...) #Macro DefineStackType(_TYPE_, _DEFAULT_VALUE_) #Ifndef __TOKGEN_STACK_##_TYPE_##__ #Define __TOKGEN_STACK_##_TYPE_##__ Type _TYPE_##StackItem above As _TYPE_##StackItem Pointer below As _TYPE_##StackItem Pointer value As _TYPE_ End Type Type _TYPE_##Stack Public: Declare Constructor Declare Destructor Declare Function Push(Value As _TYPE_ = 0) As _TYPE_ Declare Function PushBottom(Value As _TYPE_ = _DEFAULT_VALUE_) As _TYPE_ Declare Function Pop As _TYPE_ Declare Function PopBottom As _TYPE_ Declare Property Item(ByVal Index As UInteger) As _TYPE_ Declare Property Item(ByVal Index As UInteger, Value As _TYPE_) Declare Function PeekTop As _TYPE_ Pointer Declare Function PeekBottom As _TYPE_ Pointer Declare Sub Dup(ByVal Copies As UInteger = 1) Declare Sub DupBottom(ByVal Copies As UInteger = 1) Declare Sub PadTop(ByVal Items As UInteger = 1, Value As _TYPE_ = _DEFAULT_VALUE_) Declare Sub PadBottom(ByVal Items As UInteger = 1, Value As _TYPE_ = _DEFAULT_VALUE_) Declare Sub Roll(ByVal Items As UInteger = 1) Declare Sub RollBottom(ByVal Items As UInteger = 1) Declare Sub Erase() Declare Property IsEmpty As Integer Declare Property ItemCount As UInteger Declare Function Clone As _TYPE_##Stack Pointer Declare Sub CloneTo(ByRef Cloned As _TYPE_##Stack) Private: iCount As UInteger mutex As Any Pointer top As _TYPE_##StackItem Pointer bottom As _TYPE_##StackItem Pointer End Type ' implementation '' create mutex to use for thread safety Constructor _TYPE_##Stack() This.mutex = MutexCreate End Constructor '' be sure to free memory on end Destructor _TYPE_##Stack() This.Erase MutexDestroy This.mutex This.mutex = 0 End Destructor '' pushes value on top of the stack Function _TYPE_##Stack.Push(Value As _TYPE_ = _DEFAULT_VALUE_) As _TYPE_ Dim pItem As _TYPE_##StackItem Pointer MutexLock This.mutex pItem = Allocate(SizeOf(_TYPE_##StackItem)) pItem->value = Value If This.iCount > 0 Then pItem->below = This.top This.top->above = pItem This.top = pItem Else This.top = pItem This.bottom = pItem EndIf This.iCount += 1 MutexUnLock This.mutex Return Value End Function '' pushes value on bottom of the stack Function _TYPE_##Stack.PushBottom(Value As _TYPE_ = _DEFAULT_VALUE_) As _TYPE_ Dim pItem As _TYPE_##StackItem Pointer MutexLock This.mutex pItem = Allocate(SizeOf(_TYPE_##StackItem)) pItem->value = Value If This.iCount > 0 Then pItem->above = This.bottom This.bottom->below = pItem This.bottom = pItem Else This.top = pItem This.bottom = pItem EndIf This.iCount += 1 MutexUnLock This.mutex Return Value End Function '' pops value from top of the stack Function _TYPE_##Stack.Pop As _TYPE_ Dim retVal As _TYPE_ = _DEFAULT_VALUE_ Dim newTop As _TYPE_##StackItem Pointer MutexLock This.mutex If This.iCount > 0 Then retVal = This.top->value newTop = This.top->below DeAllocate This.top This.top = newTop This.iCount -= 1 EndIf MutexUnLock This.mutex Return retVal End Function '' pops value from bottom of the stack Function _TYPE_##Stack.PopBottom As _TYPE_ Dim retVal As _TYPE_ = _DEFAULT_VALUE_ Dim newBottom As _TYPE_##StackItem Pointer MutexLock This.mutex If This.iCount > 0 Then retVal = This.bottom->value newBottom = This.bottom->above DeAllocate This.bottom This.bottom = newBottom This.iCount -= 1 EndIf MutexUnLock This.mutex Return retVal End Function '' returns value from specified index on stack Property _TYPE_##Stack.Item(ByVal Index As UInteger) As _TYPE_ Dim retVal As _TYPE_ = _DEFAULT_VALUE_ Dim pItem As _TYPE_##StackItem Pointer MutexLock This.mutex If This.iCount > 0 Then If Index > This.iCount - 1 Then Index = This.iCount - 1 pItem = This.top While Index pItem = pItem->below Index -= 1 Wend retVal = pItem->value EndIf MutexUnLock This.mutex Return retVal End Property '' sets value at specified index on stack Property _TYPE_##Stack.Item(ByVal Index As UInteger, Value As _TYPE_) Dim pItem As _TYPE_##StackItem Pointer MutexLock This.mutex If This.iCount > 0 Then If Index > This.iCount - 1 Then Index = This.iCount - 1 pItem = This.top While Index pItem = pItem->below Index -= 1 Wend pItem->value = Value EndIf MutexUnLock This.mutex End Property '' peek at value on the top of the stack (returns pointer to the value on the stack) Function _TYPE_##Stack.PeekTop As _TYPE_ Pointer Dim retVal As _TYPE_ Pointer = 0 MutexLock This.mutex If This.iCount > 0 Then retVal = VarPtr(This.top->value) EndIf MutexUnLock This.mutex Return retVal End Function '' peek at value on the bottom of the stack (returns pointer to the value on the stack) Function _TYPE_##Stack.PeekBottom As _TYPE_ Pointer Dim retVal As _TYPE_ Pointer = 0 MutexLock This.mutex If This.iCount > 0 Then retVal = VarPtr(This.bottom->value) EndIf MutexUnLock This.mutex Return retVal End Function '' duplicates value on top of the stack specified number of times (default is 1 copy) Sub _TYPE_##Stack.Dup(ByVal Copies As UInteger = 1) Dim pItem As _TYPE_##StackItem Pointer MutexLock This.mutex If This.iCount > 0 Then This.iCount += Copies While Copies pItem = Allocate(SizeOf(_TYPE_##StackItem)) pItem->value = This.top->value pItem->below = This.top This.top->above = pItem This.top = pItem Copies -= 1 Wend EndIf MutexUnLock This.mutex End Sub '' duplicates value on bottom of the stack specified number of times (default is 1 copy) Sub _TYPE_##Stack.DupBottom(ByVal Copies As UInteger = 1) Dim pItem As _TYPE_##StackItem Pointer MutexLock This.mutex If This.iCount > 0 Then This.iCount += Copies While Copies pItem = Allocate(SizeOf(_TYPE_##StackItem)) pItem->value = This.bottom->value pItem->above = This.bottom This.bottom->below = pItem This.bottom = pItem Copies -= 1 Wend EndIf MutexUnLock This.mutex End Sub '' pushes 0 specified number of times (defaults to 1), on top of the stack Sub _TYPE_##Stack.PadTop(ByVal Items As UInteger = 1, Value As _TYPE_ = _DEFAULT_VALUE_) Dim pItem As _TYPE_##StackItem Pointer MutexLock This.mutex This.iCount += Items If This.iCount = Items Then pItem = Allocate(SizeOf(_TYPE_##StackItem)) pItem->value = Value This.top = pItem This.bottom = pItem Items -= 1 EndIf While Items pItem = Allocate(SizeOf(_TYPE_##StackItem)) pItem->value = Value pItem->below = This.top This.top->above = pItem This.top = pItem Items -= 1 Wend MutexUnLock This.mutex End Sub '' pushes 0 specified number of times (defaults to 1), on bottom of the stack Sub _TYPE_##Stack.PadBottom(ByVal Items As UInteger = 1, Value As _TYPE_ = _DEFAULT_VALUE_) Dim pItem As _TYPE_##StackItem Pointer MutexLock This.mutex This.iCount += Items If This.iCount = Items Then pItem = Allocate(SizeOf(_TYPE_##StackItem)) pItem->value = Value This.top = pItem This.bottom = pItem Items -= 1 EndIf While Items pItem = Allocate(SizeOf(_TYPE_##StackItem)) pItem->value = Value pItem->above = This.bottom This.bottom->below = pItem This.bottom = pItem Items -= 1 Wend MutexUnLock This.mutex End Sub '' removes specified number of items from top of the stack Sub _TYPE_##Stack.Roll(ByVal Items As UInteger = 1) Dim newTop As _TYPE_##StackItem Pointer MutexLock This.mutex If This.iCount > 0 Then If Items > This.iCount Then Items = This.iCount This.iCount -= Items While Items newTop = This.top->below DeAllocate This.top This.top = newTop Items -= 1 Wend EndIf MutexUnLock This.mutex End Sub '' removes specified number of items from bottom of the stack Sub _TYPE_##Stack.RollBottom(ByVal Items As UInteger = 1) Dim newBottom As _TYPE_##StackItem Pointer MutexLock This.mutex If This.iCount > 0 Then If Items > This.iCount Then Items = This.iCount This.iCount -= Items While Items newBottom = This.bottom->above DeAllocate This.bottom This.bottom = newBottom Items -= 1 Wend EndIf MutexUnLock This.mutex End Sub '' clears the stack Sub _TYPE_##Stack.Erase Dim pItem As _TYPE_##StackItem Pointer MutexLock This.mutex While This.iCount pItem = This.bottom->above DeAllocate This.bottom This.bottom = pItem This.iCount -= 1 Wend This.top = 0 This.bottom = 0 MutexUnLock This.mutex End Sub '' returns nonzero if there is no items on the stack Property _TYPE_##Stack.IsEmpty As Integer Return This.iCount = 0 End Property '' returns number of items on the stack Property _TYPE_##Stack.ItemCount As UInteger Return This.iCount End Property '' clones entire stack Function _TYPE_##Stack.Clone As _TYPE_##Stack Pointer Dim myClone As _TYPE_##Stack Pointer Dim pItem As _TYPE_##StackItem Pointer Dim Value As _TYPE_ Dim i As UInteger myClone = New _TYPE_##Stack MutexLock This.mutex If This.iCount Then i = 0 pItem = This.bottom While Not i = This.iCount Value = pItem->value myClone->Push Value pItem = pItem->above i += 1 Wend EndIf MutexUnLock This.mutex Return myClone End Function '' clones entire stack into Cloned variable Sub _TYPE_##Stack.CloneTo(ByRef Cloned As _TYPE_##Stack) DeAllocate VarPtr(Cloned) * VarPtr(Cloned) = * This.Clone End Sub #EndIf #EndMacro #EndIf