still - or again - at the heap-stuff. I added another, very small unit: Heap_Stack.
It's a common stack that you can define to hold any type of (fixed-sized) data. It has only 4 functions as there are
_.Create to assign the type
_.Current to retrieve a pointer to the current element (on top of stack)
_._Push to do what it says
_._Pop to pop, sorry for the underscore but keywords as Push & Pop are somehow not available for this
it has to work with pointers so it allows any type without having to cast using MKx$() nor Memory_Get(cumbersome calculation)
they are all so small, i post them altogether including the manager-type which enables all dimensioned stacks to enumerate types due Extends...
Heap_Manager.tBasicU
#MINVERSION 1.9.14.0
' ------------------------------------------------------------------------
' "alien-function" inside this unit but i need it all the time when using heap:
Function HEAP_ReAllocByStr(ByVal hPtr As DWord, _
ByVal s As String, _
Optional ByVal allowEmptyStringAllocation As Boolean _
) As DWord
' very useful, i suggested it already...
HEAP_Free(hPtr)
Function = HEAP_AllocByStr(s, allowEmptyStringAllocation)
End Function
' ------------------------------------------------------------------------
Type Heap_Manager ' this is the very basetype
Static hAllTypes As DWord ' store all typenames at the very basetype
Static hAllNames As DWord ' organized data can get accessed by name
EnumType As Function
EnumName As Function
End Type
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function Heap_Manager.EnumType(ByVal sType As String, _
Optional ByVal TestExist As Boolean _
) As DWord
' returns pointer to heap where the type-name can be read out
Local i As Long
' usually this would check If Type_Exists(sType) but sadly not working correct on standard variables...
' so just check if any string-content...
If StrPtrLen(StrPtr(sType)) < 1 Then Return 0
Local vPtr() As DWord At 0
sType = Ucase$(sType)
If HEAP_Size(Me.hAllTypes) Then
ReDim vPtr(HEAP_Size(Me.hAllTypes)/4) At Me.hAllTypes
i = Array Scan vPtr Ptr, Collate Ucase, = sType
If i Then
Return vPtr(i)
Else
If TestExist Then Return 0
EndIf
Else
If TestExist Then Return 0
EndIf
Me.hAllTypes = HEAP_ReAllocByStr(Me.hAllTypes, HEAP_Get(Me.hAllTypes) & MKDWD$(0) )
ReDim vPtr(HEAP_Size(Me.hAllTypes)/4) At Me.hAllTypes
vPtr(UBound(vPtr)) = HEAP_AllocByStr(sType)
Function = vPtr(UBound(vPtr))
End Function
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function Heap_Manager.EnumName(ByVal sName As String, _
Optional ByVal TestExist As Boolean _
) As DWord
Local i As Long
' names (if any used) must meet file-name & variable-name requirements
' have to start with a char, no spaces, no special chars, only chars,
' numerals, underscore allowed
If StrPtrLen(StrPtr(sName)) < 1 Then Return 0
Local vPtr() As DWord At 0
If HEAP_Size(Me.hAllNames) Then
ReDim vPtr(HEAP_Size(Me.hAllNames)/4) At Me.hAllNames
i = Array Scan vPtr Ptr, Collate Ucase, = Ucase$(sName)
If i Then
Return vPtr(i)
Else
If TestExist Then Return 0
EndIf
Else
If TestExist Then Return 0
EndIf
Local lChar(StrPtrLen(StrPtr(sName))) As Byte At StrPtr(sName)
For i = 1 To UBound(lChar)
Select Case lChar(i)
Case < 48
' invalid char
Return 0
Case 48 To 57
' have to start with a char!
If i = 1 Then Return 0
Case 58 To 64
' invalid char
Return 0
Case 91, 92, 93, 94, 96
' invalid char
Return 0
Case 95
' have to start with a char!
If i = 1 Then Return 0
Case > 122
' invalid char
Return 0
End Select
Next
Me.hAllNames = HEAP_ReAllocByStr(Me.hAllNames, HEAP_Get(Me.hAllNames) & MKDWD$(0))
ReDim vPtr(HEAP_Size(Me.hAllNames)/4) At Me.hAllNames
vPtr(UBound(vPtr)) = HEAP_AllocByStr(sName)
Function = vPtr(UBound(vPtr))
End Function
Heap_Stack.tBasicU
#MINVERSION 1.9.14.0
#INCLUDE Once "Heap_Manager.tBasicU" ' the depending basetype
Type Heap_Stack Extends Heap_Manager
pData As DWord ' the actual stack at heap
pType As DWord ' the type-name can be read out at this heap_ptr
Create As Function
current As Function
_Push As Function
_Pop As Function
End Type
Function Heap_Stack.Create(ByVal sType As String) As String
' assign the type once
Me.pType = Me.EnumType(sType)
Function = HEAP_Get(Me.pType)
End Function
Function Heap_Stack.Current() As DWord
' returns pointer to top-element on this stack or 0 if none
If HEAP_Size( Me.pData ) Then
Local data Like HEAP_Get(Me.pType) At 0
Function = HEAP_End(Me.pData) - SizeOf(data) + 1
EndIf
End Function
Function Heap_Stack._Push(ByVal pData As DWord)
' pass pointer where to find the data to push
If Me.pType Then
Local data Like HEAP_Get(Me.pType) At 0
Me.pData = Heap_ReAllocByStr(Me.pData, HEAP_Get(Me.pData) & Memory_Get(pData, SizeOf(data) ))
EndIf
End Function
Function Heap_Stack._Pop()
' just call...
If Me.pType Then
Local data Like HEAP_Get(Me.pType) At 0
If HEAP_Size(Me.pData) > SizeOf(data) Then
Me.pData = Heap_ReAllocbyStr(Me.pData, HEAP_Left(Me.pData, HEAP_Size(Me.pData)-SizeOf(data)))
Else
HEAP_Free(Me.pData)
Me.pData = 0
EndIf
EndIf
End Function
Heap_Stack_test01.tBasic
#MINVERSION 1.9.14.0
Uses "console"
#INCLUDE "Heap_Stack.tBasicU"
Function TBMain()
' dim a stack
Local lStack As Heap_Stack
' create this one for type long, the same as i
Local i Like lStack.Create("Long")
' push a few values into a variable
For i = 1 To 50 Step 7
PrintL i
' and tell stack where to find data
lStack._Push( VarPtr i )
Next
PrintL
' read out from top to bottom
Local lRead Like HEAP_Get(lStack.pType) At lStack.Current()
While VarPtr(lRead)
PrintL lRead
' pop the top-value:
lStack._Pop()
SetAt( lRead, lStack.Current )
Wend
PrintL $CRLF & "----------------------------key to end"
WaitKey
End Function
Why the Stack-idea came?
I was trying something out (very succesful) to create Private variables...(see attachement!) where i needed to emulate a function-pointer-stack...
Bookmarks