#define MG_NUM 2126
#define NULL 0
#define DBG
#define OTHER MG_NUM,MG_NUM
Type VarData
Vstring As String ptr
VDou As double
VInt As integer
VPtr As Any ptr
Declare Function GetType()As short
'Declare Function GetData()As string
End type
Function VarData.GetType ( )As SHORT
#define vStr 1
#define vDoub 2
#define vInte 3
#define vPointer 4
#define vEmp 0
If this.VString<>NULL Then
Return vStr
ElseIf this.Vptr<>NULL THEN
Return vPointer
ElseIf this.Vint<>MG_NUM Then
Return vInte
ElseIf this.Vdou<>MG_NUM Then
Return vDoub
else
Return vEmp
End if
End Function
Type FBArray
' **Public**
Declare sub Init(InitSize As UInteger)
Declare sub Add(begin As UInteger,data_ As vardata)
Declare sub Del(num As uinteger)
Declare Sub Destroy()
Declare function GetData(num As uinteger) As vardata
maximum As UInteger
UsedData As uinteger
' **private:**
Declare Function Derefer(ref As vardata ptr,COUNT As integer=-1)As VarData PTR
InnerDatas As vardata ptr
End type
Function FBArray.Derefer(ref As vardata ptr,COUNT As Integer=-1)As VarData PTR
Return IIf(COUNT=0 Or ref->VPTR=null,ref,Derefer(ref->VPtr,count-1))
End function
Sub FBArray.Add(begin As UInteger,data_ As vardata)
DIM NEXT_PTR As Any Ptr=derefer(innerdatas,begin+1)
dim dts as VarData Ptr=New VarData(data_)
dts->VPtr=iif(NEXT_PTR=derefer(innerdatas,begin),NULL,NEXT_PTR)
derefer(innerdatas,begin)->vptr=dts
#IFDEF DBG
Print "dts PTR "+STR(dts)+" "+str (dts->VPtr)
#endif
UsedData += 1
End sub
Function FBArray.GetData(num As uinteger) As vardata
Return *Derefer(InnerDatas,NUM)
End FUNCTION
Sub fbarray.Del(num As uinteger)
Dim DST AS Any Ptr =derefer(innerdatas,num)->vptr
Dim org as Any Ptr =derefer(innerdatas,num)
derefer(innerdatas,num-1)->vptr=DST
Delete CPTRZ(org)->vstring
Delete CPTRZ(org)
useddata-=1
End sub
Sub FBArray.Destroy()
For i As Integer=0 to useddata
Delete derefer(innerdatas,useddata-i)->vstring
Delete derefer(innerdatas,useddata-i)
#IFDEF DBG
Print " @"+Str(useddata-i)+Chr(13,10)
#endif
next
INNERDATAS->VPTR=NULL
Delete INNERDATAS
maximum=0
UsedData=0
End sub
Sub FBArray.Init(InitSize As UInteger)
maximum=InitSize
InnerDatas=New vardata
End sub
Last edited by objet-a on Mar 28, 2022 8:15, edited 3 times in total.
.....
Type VarData
VString As String Ptr
VDou As Double
VInt As Integer
'Vptr As Any Ptr
VPtr As VarData Ptr
Declare Function GetType() As Short
'Declare Function GetData() AS String
End Type
.....
' #define cptrz(ss) Cast(VarData Ptr, ss)
.....
Sub FBArray.Add(begin As Uinteger, data_ As VarData)
'Dim NEXT_PTR As Any Ptr = Derefer(innerDatas, begin + 1)
Dim NEXT_PTR As VarData Ptr = Derefer(innerDatas, begin + 1) '' only for homogeneity
Dim dts As VarData Ptr = New VarData(data_)
dts->VPtr = Iif(NEXT_PTR = Derefer(InnerDatas, begin), NULL, NEXT_PTR)
Derefer(InnerDatas, begin)->VPtr = dts
#if DBG
Print "dts PTR " & Str(dts) + " " Str(dts->VPtr)
#endif
UsedData += 1
End Sub
.....
Sub FBArray.Del(num As Uinteger)
'Dim DST As Any Ptr = Derefer(InnerDatas, num)->VPtr
Dim DST As VarData Ptr = Derefer(InnerDatas, num)->VPtr
'Dim org As Any Ptr = Derefer(InnerDatas, num)
Dim org As VarData Ptr = Derefer(InnerDatas, num)
Derefer(InnerDatas, num - 1)->VPtr = DST
'Delete cptrz(org)->VString
Delete org->VString
'Delete cptrz(org)
Delete org
UsedData -= 1
End Sub
Sub FBArray.Destroy()
For i As Integer = 0 To UsedData
Delete Derefer(InnerDatas, UsedData - i)->VString '' for i = UsedData, 'Delete 0' is useless but inactive
Delete Derefer(InnerDatas, UsedData - i)
#if DBG
Print " @" + Str(UsedData - i) + Chr(13, 10)
#endif
Next i
InnerDatas->VPtr = NULL
End Sub
.....
Remark:
Last line of the test code: Function = False ???
Warning: b.add(0,Type<vardata>(New String("1")))
works, but: b.add(0,Type<vardata>(@"1"))
induces a runtime error 12: "segmentation violation" signal.
(the address given to 'add ()' must be that of a memory allocated dynamically by New)
.....
Type VarData
VString As String Ptr
VDou As Double
VInt As Integer
'Vptr As Any Ptr
VPtr As VarData Ptr
Declare Function GetType() As Short
'Declare Function GetData() AS String
End Type
.....
' #define cptrz(ss) Cast(VarData Ptr, ss)
.....
Sub FBArray.Add(begin As Uinteger, data_ As VarData)
'Dim NEXT_PTR As Any Ptr = Derefer(innerDatas, begin + 1)
Dim NEXT_PTR As VarData Ptr = Derefer(innerDatas, begin + 1) '' only for homogeneity
Dim dts As VarData Ptr = New VarData(data_)
dts->VPtr = Iif(NEXT_PTR = Derefer(InnerDatas, begin), NULL, NEXT_PTR)
Derefer(InnerDatas, begin)->VPtr = dts
#if DBG
Print "dts PTR " & Str(dts) + " " Str(dts->VPtr)
#endif
UsedData += 1
End Sub
.....
Sub FBArray.Del(num As Uinteger)
'Dim DST As Any Ptr = Derefer(InnerDatas, num)->VPtr
Dim DST As VarData Ptr = Derefer(InnerDatas, num)->VPtr
'Dim org As Any Ptr = Derefer(InnerDatas, num)
Dim org As VarData Ptr = Derefer(InnerDatas, num)
Derefer(InnerDatas, num - 1)->VPtr = DST
'Delete cptrz(org)->VString
Delete org->VString
'Delete cptrz(org)
Delete org
UsedData -= 1
End Sub
Sub FBArray.Destroy()
For i As Integer = 0 To UsedData
Delete Derefer(InnerDatas, UsedData - i)->VString '' for i = UsedData, 'Delete 0' is useless but inactive
Delete Derefer(InnerDatas, UsedData - i)
#if DBG
Print " @" + Str(UsedData - i) + Chr(13, 10)
#endif
Next i
InnerDatas->VPtr = NULL
End Sub
.....
Remark:
Last line of the test code: Function = False ???
Warning: b.add(0,Type<vardata>(New String("1")))
works, but: b.add(0,Type<vardata>(@"1"))
induces a runtime error 12: "segmentation violation" signal.
(the address given to 'add ()' must be that of a memory allocated dynamically by New)
Your changes are logical , but in fact I use 'Any Ptr ' in order to accept for my own project future potential different pointer variable.
Futhermore,the project has been updated.