experimental script & tB-bug

[ReneMiner]

Here i have some script where i was trying out some stuff with heap & different subtypes.
There might be some new view of things, thats why it ended in this forums section, #MinVersion 1.9.12

The contained bug is strange, the script is currently modified so the bug does not occur.

To have it occur you can comment line 97 ("more As Long" within Type t_Type) as first, then run!

You can track it down backwards then in the next run when you comment line 43 ("GetUbound As Function" within Type own)
- then the script works again... has something to do with the amount of UDT-elements? really strange



' #######################################################################

Uses "console" , "TBGL" ' TBGL just for the built-in types...

Function EnumType( ByVal sType As String, _
Optional ByVal TestExist As Boolean = FALSE _
) As DWord


' this function will store all passed type-names in Ucase
' it will return a pointer to heap where the type-name
' can be read out. It will return 0 for non-existing if TestExist

Static allTypes(&H1FFF) As DWord
Static numTypes As Long

Static i As Long

If StrPtrLen(StrPtr(sType)) < 1 Then Return 0

If numTypes Then
For i = 1 To numTypes
If Ucase$(sType) = HEAP_Get(allTypes(i)) Then Return allTypes(i)
Next
EndIf

If TestExist Then Return 0

numTypes += 1
allTypes(numTypes) = HEAP_AllocByStr(Ucase$(sType))

Function = allTypes(numTypes)

End Function
' ----------------------------------------------------------------------

Type own
pData As DWord
pType As DWord

Is As Function
Be As Function
GetUbound As Function ' (<<< comment this later)
End Type
' - - -
Function own.Is() As String

Select Case HEAP_Get(Me.pType)
Case "HEAP", "STRING"
Function = HEAP_Get(Me.pData)
Case Else
Local data Like HEAP_Get(Me.pType) At Me.pData
Function = data
End Select

End Function
' - - -
Function own.Be(ByVal someData As String, _
Optional ByVal sType As String _
) As String

If Function_CParams = 2 Then Me.pType = EnumType(sType)

Select Case StrPtrLen(StrPtr(someData))
Case 0
If HEAP_Size(Me.pData) Then
Select Case HEAP_Get(Me.pType)
Case "HEAP", "STRING"
HEAP_Free(Me.pData)
Me.pData = 0
Case Else
Memory_Set( Me.pData, Repeat$(HEAP_Size(Me.pData), MKBYT$(0)) )
End Select
EndIf

Case HEAP_Size(Me.pData)
Memory_Set(Me.pData, someData)

Case Else
If HEAP_Size(Me.pData) Then HEAP_Free(Me.pData)
Me.pData = HEAP_AllocByStr(someData)
End Select


End Function
' - - -
Function own.GetUBound() As Long

Local lData Like HEAP_Get(Me.pType) At Me.pData
Function = HEAP_Size(Me.pData)/SizeOf(lData)

End Function

' - - - - - - - - - - - - - - - - -
Type t_Type
own
more As Long ' tB crashes if this not present... comment first
End Type

Dim foo As t_Type

foo.Be( MKBYT$(255,128,64,0), "TBGL_TRGBA" )

Local lData Like HEAP_Get(foo.pType) At foo.pData

PrintL "R:" & lData.R
PrintL "G:" & lData.G
PrintL "B:" & lData.B
PrintL "A:" & lData.A

PrintL


Local lVec As TBGL_TVECTOR3F
lVec.X = 1.23
lVec.Y = 2.34
lVec.Z = 3.45

foo.Be( lVec, "TBGL_tVector3F" )

String sResult = foo.Is()

Local vVec As TBGL_TVECTOR3F At StrPtr(sResult)
PrintL "X " & vVec.X
PrintL "Y " & vVec.Y
PrintL "Z " & vVec.Z

lVec.X = -3.45
lVec.Y = -2.34
lVec.Z = -1.23

foo.Be( lVec )
PrintL


SetAt( vVec, foo.pData )

PrintL "X " & vVec.X
PrintL "Y " & vVec.Y
PrintL "Z " & vVec.Z
PrintL

foo.Be("Hello DWord!", "STRING")

PrintL foo.Is()

foo.be("1234567890", "HEAP")
PrintL foo.Is()

' now loading up an array...

Long i, lArray(9)
For i = 1 To UBound(lArray)
' fill the array with something
lArray(i) = 10 - i
Next

foo.Be(Memory_Get(VarPtr(lArray(1)), SizeOf(lArray)) , "Long")

' now read out one-by-one:
Local surfer Like HEAP_Get(foo.pType) At foo.pData

While VarPtr(surfer) <= foo.pData + HEAP_Size(foo.pData) - SizeOf(surfer)
Print surfer & $TAB
SetAt( surfer, VarPtr(surfer) + SizeOf(surfer) )
Wend

PrintL
' or place virtual array upon:
' uncomment only if Function own.GetUBound() is present:

'Local vData(foo.GetUBound) Like HEAP_Get(foo.pType) At foo.pData
'For i = 1 To UBound(vData)
' Print vData(i) & $TAB
'Next
'PrintL

PrintL $CRLF & Repeat$(42, "*")
PrintL $CRLF & "Any key to end"
WaitKey


:unsure:

[Petr Schreiber]

Hi Rene,

this is something really strange, I can confirm the behavior in 1.9.13.0.
I tried to workaround via Extends, but the issue still appears.

The issue manifests during initial parsing phase, when types and functions are analysed.


Petr

[ReneMiner]

yes I'm using 1.9.13 too but for the used keywords & stuff it only would need 1.9.12 to run. I did not test under 1.9.12.

[ErosOlmi]

Fixed.

Definitive fix will come when I will come back from holidays (current Internet connection does not allow me to upload files larger than few MB)
In the meantime please find here attached a revised thinCore.dll (thinBasic Core Engine) 1.9.13.0
Be sure to have thinBasic 1.9.13.0 installed, then unzip the file under your .\thinBasic\ directory replacing thinCore.dll


Problem was caused by a new feature I was implementing in 1.9.12.0 regarding an UDT being reflexive: possibility to define inside the UDT an element that is a PTR tot the UDT itself. This is used, for example, in Linked Lists where you need a PTR to another UDT of the same type.


In any case ... :D your script was not supposed to work in any case so I'm checking why it is working.
I mean, I didn't developed the possibility to have an UDT with UDT methods inside an UDT and at the same time having methods working.
It is a nice feature but ... who has developed it :confused:

I will investigate :cool:

[ReneMiner]

great :) many thanks.

As you see i try to find a way to hide "private" data but i always fail since there's always a way to access the data from outside a type-function... it did not get any better and finally ended as some Heap-unit which makes Heap how i imagine the first native to thincore built-in functional type that allows to dynamically extend variables & udts with different types in different sizes (attachement)

However, i can't get it done without the EnumType-Function that cares for unique stored type-names - else there would be much more memory needed. I know there should be some faster way to compare - probably storing all the strings to a local static string-array to enable Array Scan then and return a StrPtr and read it later using Memory_Get(sPtr, Peek(Dword, sPtr-4)) ... but Heap_Get(hPtr) on the other hand is much simpler to use & read - also I fear if using a string-array single strings could change theirs pointers when array gets resized so older assigned pointers become invalid. But not sure about this. Great would be some function equal to Array Scan for dynamic strings - concerning speed - that would work like



Dword myPtrs = Heap_AllocByStr(MKDwd$(Heap_AllocByStr("this"), Heap_AllocByStr("is an"), Heap_AllocByStr("array")))

Dim vPtrs(Heap_Size(myPtrs)/4) As Dword At myPtrs

PrintL Array Scan_Heap vPtrs, Collate Ucase, = "ARRAY" ' should print 3

[ErosOlmi]

Private UDT members is on the ToDo list of next improvements.

[ReneMiner]

sounds good :)

still experimenting since its currrently more interesting to me than to continue my gui-project - i'd love to have private udt-members for that - but to keep it short, i polished & added a little and sperated the heap-unit from the testing-script. the heap-unit allows simple to attach data of any type to any 8 bytes, also dynamic arrays (even dynamic arrays of dynamic strings with a little effort)

This time I used another approach to enumerate types - using dictionary now. It's a little waste of memory since all is stored twice:

the dictionary-Key (which is the type-name) gives access to the bucket that holds a Dword$ - which is the pointer to some allocated heap where one can read out the type-name... a little cumbersome but i'm certain dictionary works faster then simple for-next and comparing the heap-content with string-comparison-methods.

So here's the function for nosy readers - contains also a way to destroy dictionary & data @heap.


Uses "dictionary"

Function EnumType( ByVal sType As String, _
Optional ByVal TestExist As Boolean _
) As DWord


' this function will store all passed type-names in Ucase
' it will return a pointer to heap where the type-name
' can be read out. It will return 0 for non-existing if TestExist

Static pDict, pKey As DWord

If Not pDict Then
pDict = Dictionary_Create(&H1FFF, TRUE)
EndIf

If StrPtrLen(StrPtr(sType)) < 1 Then Return 0

sType = Ucase$(sType)

' --- destroy all enumerated data ---
If sType = "DESTROY" Then
Local s As String = Dictionary_ListKeys(pDict, $CRLF)
Local sKey() As String
Local i As Long
i = Parse s, sKey, $CRLF
If i Then
For i = 1 To UBound(sKey)
pKey = Dictionary_Exists(pDict, sKey(i))
If pKey Then
pKey = Peek(DWord, pKey)
HEAP_Free( Peek(DWord, pKey) )
EndIf
Next
EndIf
Dictionary_Free(pDict)
pDict = 0
Return 0
EndIf
' ---

pKey = Dictionary_Exists(pDict, sType)

If pKey Then
pKey = Peek(DWord, pKey)
Return Peek(DWord, pKey)
Else
If testExist Then Return 0
EndIf

pKey = HEAP_AllocByStr(sType)
Dictionary_Add(pDict, sType, MKDWD$(pKey) )

Function = pKey

End Function


Of course better would be some internal method to find out a pointer where one can read out the types-names...

also a function to retrieve the REAL type-name from a variable would be very useful, imagine you have a basetype and an extended type of the basetype, a basetype-function gets called and within the basetype-function you now want the REAL (extended) type-name to create the fitting overlay and call a function of the extended type. ...confusing on first read - but if one could determine the type from VarPtr... ;)

_____________________________________________________________________________________

attached heap-functions-testscript and the needed unit - which is still an "unclean" unit in my eyes since it contains some "foreign function".
of course there are far more ways thinkeable to use the unit...
MinVersion still 1.9.12. i guess... but better use the latest