freebasic custom type linked list array class

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
objet-a
Posts: 13
Joined: Jul 13, 2021 0:04
Location: Hubei, China

freebasic custom type linked list array class

Post by objet-a »

I apply this class to the language I am developing
test code

Code: Select all

#define UNICODE                 
#lang "FB"                      
#include "fbclass.inc"

    Dim b as FBArray
	b.init 10
	dim ss as string ptr=New String("1")
   b.add(0,Type<vardata>(ss, OTHER))
    dim s2 as string ptr=New String("2")
   b.add(1,Type<vardata>(s2, OTHER))
    dim s3 as string ptr=New String("3")
   b.add(2,Type<vardata>(s3, OTHER))
    dim sChao as string ptr=New String("chaos")
   b.add(0,Type<vardata>(sChao, OTHER))
  print ("FACT"+*b.getdata(1).vstring)
  print ("FACT"+*b.getdata(2).vstring)
  print ("FACT"+*b.getdata(3).vstring)
  print ("FACT"+*b.getdata(4).vstring)
  b.del 1
  Print "---------------DEL THE chaos-------------"
  Print ("FACT"+*b.getdata(1).vstring)
  b.del 2
  Print "---------------DEL THE 2-------------"                                        
  Print ("FACT"+*b.getdata(2).vstring)
  Print "USED:"+str(B.UsedData)
    Print "---------------Destroy-------------" 
  b.Destroy  
  Print "---------------Check if memory leak-------------"
   print ("NEXT ADDESS"+str(b.getdata(1).vptr))
   print ("NEXT ADDESS"+str(b.getdata(2).vptr))
   print ("NEXT ADDESS"+str(b.getdata(3).vptr))
   print ("NEXT ADDESS"+str(b.getdata(4).vptr))       
getkey
Complete project:https://github.com/kaesinol/freebasicAr ... bclass.inc

Code: Select all

dts PTR 9399824  0
dts PTR 9400928  0
dts PTR 9401792  0
dts PTR 9405072  9399824
FACTchaos
FACT1
FACT2
FACT3
---------------DEL THE chaos-------------
FACT1
---------------DEL THE 2-------------
FACT3
USED:2
---------------Destroy-------------
  @2

  @1

  @0

---------------Check if memory leak-------------
NEXT ADDESS0
NEXT ADDESS0
NEXT ADDESS0
NEXT ADDESS0


Code: Select all

#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.
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: freebasic custom type linked list array class

Post by fxm »

Possible small simplification:

Code: Select all

.....
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)
objet-a
Posts: 13
Joined: Jul 13, 2021 0:04
Location: Hubei, China

Re: freebasic custom type linked list array class

Post by objet-a »

fxm wrote:Possible small simplification:

Code: Select all

.....
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.
Post Reply