Garbage Collection

Zamaster · Post by **Zamaster** » Mar 29, 2006 16:43

Does FreeBASIC do automatic garbage collection, like if I allocate memory or DIM/REDIM variables or whatever, will it free up the memory automaticly when the program ends or do I have to do that myself?

yetifoot · Post by **yetifoot** » Mar 29, 2006 16:50

If you use DIM/REDIM then memory is cleared up for you.

Only If you use Allocate, CAllocate, ImageCreate do you need to free the memory

anonymous1337 · Post by **anonymous1337** » Mar 29, 2006 17:35

X-x;; I didn't know about ImageCreate!!! Oh no!! X_X:;

cha0s · Post by **cha0s** » Mar 29, 2006 17:40

=D

well, in case you didn't know, theres an ImageDestroy() that you can give all your ImageCreate'd ptrs to deallocate =)

anonymous1337 · Post by **anonymous1337** » Mar 29, 2006 17:55

*is rushing to fix all 10000 of his programs using ImageCreate right now* No wonder my 512 megabytes of RAM has been messed up lately...

jofers · Post by **jofers** » Mar 29, 2006 18:50

If you were terribly concerned about pointer management, you may wish to use your own function for allocating, have it call Allocate, and copy the pointer to a hash table. Deallocate would delete the pointer from the hash table, and a "Deallocate_all" function would deallocate everything in the hash, and could help you find out which pointers you forgot to deallocate.

Hmm... mixed with some memory pool functions, that could be a darn useful library...

cha0s · Post by **cha0s** » Mar 29, 2006 19:46

Code: Select all

Option Explicit

Enum
  list_reverse = -1
  list_dealloc = 1
  list_strlist = 2

  list_search_instr = -1
  
End Enum


#IfNDef Arg_Types
  Enum Arg_Types
  
    ARG_INT = 1
    ARG_UINT
    ARG_STR
    ARG_SNG
    ARG_DBL
    ARG_ULNG
    ARG_LNG
    ARG_PTR
  
  End Enum
  
#EndIf

Union list_value
  i As Integer
  ui As uInteger
  sn As Single
  s As String
  d As Double
  l As LongInt
  ul As uLongInt
  pnt As Any Ptr
  
End Union

Type list_type
  
  dat As list_value
  nxt As list_type Ptr  
  
End Type


Declare Function open_file_dialog( items As list_type Ptr, x As Integer = 1, y As Integer = 1 ) As Integer


'' lists
'' !!!!!!!!!!!!!!!!!!!!!!!!!!!

Declare Function length                   ( node As list_type Ptr ) As Integer                           
Declare Sub      destroy                  ( node As list_type Ptr, dalloc As Integer = 0 )




Declare Function list_Push Overload Alias "ListPush" ( node As list_type Ptr, value As Integer, id As Integer = ARG_INT ) As list_type Ptr
Declare Function list_Push          Alias "ListPush" ( node As list_type Ptr, value As Single,  id As Integer = ARG_SNG ) As list_type Ptr
Declare Function list_Push          Alias "ListPush" ( node As list_type Ptr, value As String,  id As Integer = ARG_STR ) As list_type Ptr
Declare Function list_Push          Alias "ListPush" ( node As list_type Ptr, value As Double,  id As Integer = ARG_DBL ) As list_type Ptr
Declare Function list_Push          Alias "ListPush" ( node As list_type Ptr, value As LongInt, id As Integer = ARG_LNG ) As list_type Ptr
Declare Function list_Push          Alias "ListPush" ( node As list_type Ptr, value As Any Ptr, id As Integer = ARG_PTR ) As list_type Ptr

Declare Function list_Cancel Overload Alias "ListCancel" ( m As list_type Ptr, l As list_type Ptr, value As Integer, id As Integer = ARG_INT ) As list_type Ptr
Declare Function list_Cancel Overload Alias "ListCancel" ( m As list_type Ptr, l As list_type Ptr, value As Single, id As Integer = ARG_SNG ) As list_type Ptr
Declare Function list_Cancel Overload Alias "ListCancel" ( m As list_type Ptr, l As list_type Ptr, value As String, id As Integer = ARG_STR ) As list_type Ptr
Declare Function list_Cancel Overload Alias "ListCancel" ( m As list_type Ptr, l As list_type Ptr, value As Double, id As Integer = ARG_DBL ) As list_type Ptr
Declare Function list_Cancel Overload Alias "ListCancel" ( m As list_type Ptr, l As list_type Ptr, value As LongInt, id As Integer = ARG_LNG ) As list_type Ptr
Declare Function list_Cancel Overload Alias "ListCancel" ( m As list_type Ptr, l As list_type Ptr, value As Any Ptr, id As Integer = ARG_PTR ) As list_type Ptr

                                          
Declare Function list_add Overload Alias "ListAdd" ( lst1 As list_type Ptr, lst2 As list_type Ptr, list_id As Integer, id As Integer = ARG_INT ) As list_type Ptr
Declare Function list_add          Alias "ListAdd" ( lst1 As list_type Ptr, lst2 As list_type Ptr, list_id As Single , id As Integer = ARG_SNG ) As list_type Ptr
Declare Function list_add          Alias "ListAdd" ( lst1 As list_type Ptr, lst2 As list_type Ptr, list_id As String , id As Integer = ARG_STR ) As list_type Ptr
Declare Function list_add          Alias "ListAdd" ( lst1 As list_type Ptr, lst2 As list_type Ptr, list_id As Double , id As Integer = ARG_DBL ) As list_type Ptr
Declare Function list_add          Alias "ListAdd" ( lst1 As list_type Ptr, lst2 As list_type Ptr, list_id As LongInt, id As Integer = ARG_LNG ) As list_type Ptr
Declare Function list_add          Alias "ListAdd" ( lst1 As list_type Ptr, lst2 As list_type Ptr, list_id As Any Ptr, id As Integer = ARG_PTR ) As list_type Ptr

Declare Function list_add_hooked Alias "ListAdd" ( lst1 As list_type Ptr, lst2 As list_type Ptr, list_id As Any Ptr, id As Integer ) As list_type Ptr
        

                                          
Declare Function list_Append  Overload Alias "ListAppend" ( node As list_type Ptr, value As Integer, id As Integer = ARG_INT ) As list_type Ptr
Declare Function list_Append           Alias "ListAppend" ( node As list_type Ptr, value As Single,  id As Integer = ARG_SNG ) As list_type Ptr
Declare Function list_Append           Alias "ListAppend" ( node As list_type Ptr, value As String,  id As Integer = ARG_STR ) As list_type Ptr
Declare Function list_Append           Alias "ListAppend" ( node As list_type Ptr, value As Double,  id As Integer = ARG_DBL ) As list_type Ptr
Declare Function list_Append           Alias "ListAppend" ( node As list_type Ptr, value As LongInt, id As Integer = ARG_LNG ) As list_type Ptr
Declare Function list_Append           Alias "ListAppend" ( node As list_type Ptr, value As Any Ptr, id As Integer = ARG_PTR ) As list_type Ptr


Declare Function list_Pop Overload Alias "ListPop" ( node As list_type Ptr, ret As Integer,  id As Integer = ARG_INT )  As list_type Ptr
Declare Function list_Pop          Alias "ListPop" ( node As list_type Ptr, ret As uInteger, id As Integer = ARG_UINT ) As list_type Ptr
Declare Function list_Pop          Alias "ListPop" ( node As list_type Ptr, ret As String,   id As Integer = ARG_STR )  As list_type Ptr
Declare Function list_Pop          Alias "ListPop" ( node As list_type Ptr, ret As Single,   id As Integer = ARG_SNG )  As list_type Ptr
Declare Function list_Pop          Alias "ListPop" ( node As list_type Ptr, ret As Double,   id As Integer = ARG_DBL )  As list_type Ptr
Declare Function list_Pop          Alias "ListPop" ( node As list_type Ptr, ret As LongInt,  id As Integer = ARG_LNG )  As list_type Ptr
Declare Function list_Pop          Alias "ListPop" ( node As list_type Ptr, ret As uLongInt, id As Integer = ARG_ULNG ) As list_type Ptr
Declare Function list_Pop          Alias "ListPop" ( node As list_type Ptr, ret As Any Ptr,  id As Integer = ARG_PTR )  As list_type Ptr


                                               
Declare Function remove Overload Alias "ListRemove" ( node As list_type Ptr, v As Integer, id As Integer = ARG_INT ) As list_type Ptr
Declare Function remove          Alias "ListRemove" ( node As list_type Ptr, v As Single , id As Integer = ARG_SNG ) As list_type Ptr
Declare Function remove          Alias "ListRemove" ( node As list_type Ptr, v As String , id As Integer = ARG_STR ) As list_type Ptr
Declare Function remove          Alias "ListRemove" ( node As list_type Ptr, v As Double , id As Integer = ARG_DBL ) As list_type Ptr
Declare Function remove          Alias "ListRemove" ( node As list_type Ptr, v As LongInt, id As Integer = ARG_LNG ) As list_type Ptr
Declare Function remove          Alias "ListRemove" ( node As list_type Ptr, v As Any Ptr, id As Integer = ARG_PTR ) As list_type Ptr
                                                
Declare Function remove_hooked Alias "ListRemove" ( node As list_type Ptr, value As Any Ptr, id As Integer ) As list_type Ptr



Declare Function list_search Overload Alias "ListSearch" ( node As list_type Ptr, v As Integer, strt As Integer = 0, id As Integer = ARG_INT ) As Integer
Declare Function list_search Overload Alias "ListSearch" ( node As list_type Ptr, v As Single,  strt As Integer = 0, id As Integer = ARG_SNG ) As Integer
Declare Function list_search Overload Alias "ListSearch" ( node As list_type Ptr, v As String,  strt As Integer = 0, id As Integer = ARG_STR ) As Integer
Declare Function list_search Overload Alias "ListSearch" ( node As list_type Ptr, v As Double,  strt As Integer = 0, id As Integer = ARG_DBL ) As Integer
Declare Function list_search Overload Alias "ListSearch" ( node As list_type Ptr, v As LongInt, strt As Integer = 0, id As Integer = ARG_LNG ) As Integer
Declare Function list_search Overload Alias "ListSearch" ( node As list_type Ptr, v As Any Ptr, strt As Integer = 0, id As Integer = ARG_PTR ) As Integer
                                                                                                          
Declare Function list_search_hooked Alias "ListSearch" ( node As list_type Ptr, v As Any Ptr, strt As Integer = 0, id As Integer ) As Integer





                                          
Declare Sub      display_list Overload    ( node As list_type Ptr Ptr, value As Integer )
Declare Sub      display_list             ( node As list_type Ptr Ptr, value As Single  )
Declare Sub      display_list             ( node As list_type Ptr Ptr, value As String  )
Declare Sub      display_list             ( node As list_type Ptr Ptr, value As Any Ptr )
                                          
                                          
Declare Sub      list2bin     Overload    ( node As list_type Ptr, bina() As Integer,     pol As Integer = 0 ) 
Declare Sub      list2bin                 ( node As list_type Ptr, bina   As Integer Ptr, pol As Integer = 0 ) 
Declare Sub      list2bin                 ( node As list_type Ptr, bina() As Single,      pol As Integer = 0 ) 
Declare Sub      list2bin                 ( node As list_type Ptr, bina   As Single Ptr,  pol As Integer = 0 ) 
Declare Sub      list2bin                 ( node As list_type Ptr, bina() As String,      pol As Integer = 0 ) 
Declare Sub      list2bin                 ( node As list_type Ptr, bina   As String Ptr,  pol As Integer = 0 ) 
Declare Sub      list2bin                 ( node As list_type Ptr, bina() As Any Ptr,     pol As Integer = 0 ) 
Declare Sub      list2bin                 ( node As list_type Ptr, bina   As Any Ptr Ptr, pol As Integer = 0 ) 
                                          
Declare Sub      bin2list     Overload    ( bina() As Integer,     node As list_type Ptr )
Declare Sub      bin2list                 ( bina   As Integer Ptr, node As list_type Ptr, sz As Integer ) 
Declare Sub      bin2list                 ( bina() As Single,     node As list_type  Ptr )
Declare Sub      bin2list                 ( bina   As Single Ptr, node As list_type  Ptr, sz As Integer )
Declare Sub      bin2list                 ( bina() As String,     node As list_type  Ptr )
Declare Sub      bin2list                 ( bina   As String Ptr, node As list_type  Ptr, sz As Integer )
Declare Sub      bin2list                 ( bina() As Any Ptr,     node As list_type Ptr )
Declare Sub      bin2list                 ( bina   As Any Ptr Ptr, node As list_type Ptr, sz As Integer )
                                          
                                          
Declare Function list_files ( pth As String = ".", spec As String = "*.*", mask As Integer = 0 ) As list_type Ptr
                                                                                                          




Declare Function list_node_value Overload ( l As list_type Ptr, n As Integer, id As Integer = 0 ) As Integer
Declare Function list_node_value          ( l As list_type Ptr, n As Integer, id As String ) As String
Declare Function list_node_value          ( l As list_type Ptr, n As Integer, id As Single ) As Single
Declare Function list_node_value          ( l As list_type Ptr, n As Integer, id As Any Ptr ) As Any Ptr



Declare Sub iterate_through_list( l As list_type Ptr, fp As Sub( l As list_type Ptr ) )                


Declare Function push_sub_dirs( l As list_type Ptr, p As zString Ptr = 0 ) As list_type Ptr
Declare Function push_dirs( p As zString Ptr = 0 ) As list_type Ptr
Declare Function push_paths( p As zString Ptr = 0 )  As list_type Ptr


Declare Function c_alloc( ls As list_type Ptr, sz As uInteger ) As Any Ptr
Declare Function r_alloc( ls As list_type Ptr, pnt As Any Ptr, sz As uInteger ) As Any Ptr

Declare Function list_NodeAddress( l As list_type Ptr, i As Integer ) As list_type Ptr


Function remove_hooked( node As list_type Ptr, v As Any Ptr, id As Integer ) As list_type Ptr
  
  If ( node = 0 ) Or ( v = 0 ) Then Return 0
  
  
  Dim As list_type Ptr thr 
  Dim As Integer c, unit_length, i
  Dim As Any Ptr abstraction
  
  thr = node 
  
  Select Case As Const id
    
    Case ARG_INT, ARG_SNG, ARG_PTR
      unit_length = 2 '' ( 2 ^ 2 = 4 )
    
    Case ARG_DBL, ARG_LNG
      unit_length = 3 '' ( 2 ^ 3 = 8 )
      
      
  End Select

  abstraction = CAllocate( 1 Shl unit_length )

  Do While thr <> 0

    Select Case As Const id    
    
      Case ARG_INT
        
        If thr->dat.i <> *cptr( Integer Ptr, v ) Then                                  
        
          cptr( Integer Ptr, abstraction )[ c ] = thr->dat.i   : c += 1 : abstraction = Reallocate( abstraction, ( ( c + 1 ) Shl unit_length ) )
          cptr( Integer Ptr, abstraction )[ c ] = 0
                                                                  
        End If
        
      Case ARG_STR
        
        If thr->dat.s <> *cptr( zString Ptr, v ) Then
          cptr( String Ptr, abstraction )[c] = thr->dat.s : c += 1 : abstraction = Reallocate( abstraction, ( ( c + 1 ) * Len( String ) ) )
          cptr( Integer Ptr, abstraction )[ c ] = 0
                                                                  
        End If
        
      Case ARG_SNG
        
        If thr->dat.sn <> *cptr( Single Ptr, v ) Then
          cptr( Single Ptr, abstraction )[ c ] = thr->dat.sn   : c += 1 : abstraction = Reallocate( abstraction, ( ( c + 1 ) Shl unit_length ) )
          cptr( Integer Ptr, abstraction )[ c ] = 0
                                                                  
        End If
        
      Case ARG_PTR
        
        If thr->dat.pnt <> *cptr( Any Ptr Ptr, v ) Then
          cptr( Any Ptr Ptr, abstraction )[ c ] = thr->dat.pnt : c += 1 : abstraction = Reallocate( abstraction, ( ( c + 1 ) Shl unit_length ) )
          cptr( Integer Ptr, abstraction )[ c ] = 0
                                                                  
        End If
        
      Case ARG_DBL
        
        If thr->dat.d <> *cptr( Double Ptr, v ) Then
          cptr( Double Ptr, abstraction )[ c ] = thr->dat.d    : c += 1 : abstraction = Reallocate( abstraction, ( ( c + 1 ) Shl unit_length ) )
          cptr( Integer Ptr, abstraction )[ c ] = 0
          cptr( Integer Ptr, abstraction )[ c + 1 ] = 0
                                                                  
        End If
        
      Case ARG_LNG
        
        If thr->dat.l <> *cptr( LongInt Ptr, v ) Then
          cptr( LongInt Ptr, abstraction )[ c ] = thr->dat.l   : c += 1 : abstraction = Reallocate( abstraction, ( ( c + 1 ) Shl unit_length ) )
          cptr( Integer Ptr, abstraction )[ c ] = 0
          cptr( Integer Ptr, abstraction )[ c + 1 ] = 0
                                                                  
        End If
        
    End Select

    thr = thr->nxt    

  Loop

  Select Case As Const id    
  
    Case ARG_INT
      bin2list( cptr( Integer Ptr, abstraction ), thr, c )
      
    Case ARG_STR
      bin2list( cptr( String Ptr, abstraction ), thr, c )
      For i = 0 To c -1
        *cptr( String Ptr, abstraction ) = ""
        
      Next
                                     
    Case ARG_SNG
      bin2list( cptr( Single Ptr, abstraction ), thr, c )
      
    Case ARG_PTR
      bin2list( cptr( Any Ptr Ptr, abstraction ), thr, c )
      
    Case ARG_DBL
'      bin2list( cptr( Double Ptr, abstraction ), thr, c )
      
    Case ARG_LNG
'      bin2list( cptr( LongInt Ptr, abstraction ), thr, c )
      
  End Select
  
  Deallocate abstraction
  
  Return thr
  
End Function
  

  
  
Sub destroy ( node As list_type Ptr, dalloc As Integer = 0 )


  If node = 0 Then 
    Exit Sub
    
  End If

  If node->nxt <> 0 Then

    destroy( node->nxt )
  
  
  End If
  
  If dalloc And list_dealloc Then
    Deallocate node->dat.pnt
    node->dat.pnt = 0
    
  End If

  node->nxt = 0  

  Deallocate node
  node = 0


End Sub


Function length( node As list_type Ptr ) As Integer
  

  If node = 0 Then Return 0

  Dim As list_type Ptr throw = node
  Dim As Integer cnt

    While throw->nxt <> 0
    
      throw = throw->nxt
      cnt += 1
    
    Wend
    
    cnt += 1
  
  Return cnt

  
End Function


Function list_add_hooked( lst1 As list_type Ptr, lst2 As list_type Ptr, list_id As Any Ptr, id As Integer ) As list_type Ptr
  
  If ( lst1 = 0 ) Or ( lst2 = 0 ) Or ( list_id = 0 ) Then Return 0

  Dim As list_type Ptr cat_list, thr
  Dim As Integer i
  
  thr = lst1  
  For i = 0 To length( lst1 ) - 1

    Select Case As Const id    
    
      Case ARG_INT
        cat_list = list_append( cat_list, thr->dat.i )
        
      Case ARG_STR
        cat_list = list_append( cat_list, thr->dat.s )
        
      Case ARG_SNG
        cat_list = list_append( cat_list, thr->dat.sn )
        
      Case ARG_PTR
        cat_list = list_append( cat_list, thr->dat.pnt )
        
      Case ARG_DBL
        cat_list = list_append( cat_list, thr->dat.d )
        
      Case ARG_LNG
        cat_list = list_append( cat_list, thr->dat.l )
        
    End Select
    
    thr = thr->nxt

  Next

  thr = lst2
  For i = 0 To length( lst2 ) - 1

    Select Case As Const id    
    
      Case ARG_INT
        cat_list = list_append( cat_list, thr->dat.i )
        
      Case ARG_STR
        cat_list = list_append( cat_list, thr->dat.s )
        
      Case ARG_SNG
        cat_list = list_append( cat_list, thr->dat.sn )
        
      Case ARG_PTR
        cat_list = list_append( cat_list, thr->dat.pnt )
        
      Case ARG_DBL
        cat_list = list_append( cat_list, thr->dat.d )
        
      Case ARG_LNG
        cat_list = list_append( cat_list, thr->dat.l )
        
    End Select
    
    thr = thr->nxt

  Next
  
  Return cat_list

End Function    


Sub list2bin( node As list_type Ptr, bina() As Integer, pol As Integer = 0 ) 


  If node = 0 Then 
    Exit Sub
    
  End If
  
  
  Dim As Integer shift_opt = ( Abs( pol <> 0 ) * ( length( node ) - 1 ) ) 
  Dim As list_type Ptr throw = node
  Dim As Integer cnt = LBound( bina )
  Dim As Integer Ptr s, b
  
    If shift_opt > cnt Then
      b = @shift_opt
      s = @cnt
    Else
    
      b = @cnt
      s = @shift_opt
  
    End If


    While throw->nxt <> 0
    

      bina( *b - *s ) = throw->dat.i
          
      cnt += 1
    
      throw = throw->nxt

    Wend
    
    bina( *b - *s ) = throw->dat.i
        

    cnt += 1
  

End Sub

Sub list2bin( node As list_type Ptr, bina As Integer Ptr, pol As Integer = 0 ) 


  If node = 0 Then 
    Exit Sub
    
  End If
  

  Dim As Integer shift_opt = ( Abs( pol <> 0 ) * ( length( node ) - 1 ) ) 
  
  Dim As list_type Ptr throw = node
  Dim As Integer cnt

  Dim As Integer Ptr s, b
  
    If shift_opt > cnt Then
      b = @shift_opt
      s = @cnt
    Else
    
      b = @cnt
      s = @shift_opt
  
    End If

    While throw->nxt <> 0
    

      bina[*b - *s] = throw->dat.i
          
      cnt += 1
    
      throw = throw->nxt

    Wend
    
    bina[*b - *s] = throw->dat.i
        

    cnt += 1
  

End Sub

Sub list2bin( node As list_type Ptr, bina() As Single, pol As Integer = 0 ) 


  If node = 0 Then 
    Exit Sub
    
  End If

  Dim As Integer shift_opt = ( Abs( pol <> 0 ) * ( length( node ) - 1 ) ) 


  
  Dim As list_type Ptr throw = node
  Dim As Integer cnt = LBound( bina )
  Dim As Integer Ptr s, b
  
    If shift_opt > cnt Then
      b = @shift_opt
      s = @cnt
    Else
    
      b = @cnt
      s = @shift_opt
  
    End If


    While throw->nxt <> 0
    

      bina( *b - *s ) = throw->dat.sn
          
      cnt += 1
    
      throw = throw->nxt

    Wend
    
    bina( *b - *s ) = throw->dat.sn
        

    cnt += 1
  

End Sub

Sub list2bin( node As list_type Ptr, bina As Single Ptr, pol As Integer = 0 ) 


  If node = 0 Then 
    Exit Sub
    
  End If

  Dim As Integer shift_opt = ( Abs( pol <> 0 ) * ( length( node ) - 1 ) ) 


  
  Dim As list_type Ptr throw = node
  Dim As Integer cnt
  Dim As Integer Ptr s, b
  
    If shift_opt > cnt Then
      b = @shift_opt
      s = @cnt
    Else
    
      b = @cnt
      s = @shift_opt
  
    End If


    While throw->nxt <> 0
    

      bina[*b - *s] = throw->dat.sn
          
      cnt += 1
    
      throw = throw->nxt

    Wend
    
    bina[*b - *s] = throw->dat.sn
        

    cnt += 1
  

End Sub

Sub list2bin( node As list_type Ptr, bina() As String, pol As Integer = 0 ) 


  If node = 0 Then 
    Exit Sub
    
  End If


  Dim As Integer shift_opt = ( Abs( pol <> 0 ) * ( length( node ) - 1 ) ) 

  
  Dim As list_type Ptr throw = node
  Dim As Integer cnt = LBound( bina )
  Dim As Integer Ptr s, b
  
    If shift_opt > cnt Then
      b = @shift_opt
      s = @cnt
    Else
    
      b = @cnt
      s = @shift_opt
  
    End If


    While throw->nxt <> 0
    

      bina( *b - *s ) = throw->dat.s
          
      cnt += 1
    
      throw = throw->nxt

    Wend
    
      bina( *b - *s ) = throw->dat.s
        

    cnt += 1
  

End Sub


Sub list2bin( node As list_type Ptr, bina As String Ptr, pol As Integer = 0 ) 


  If node = 0 Then 
    Exit Sub
    
  End If


  Dim As Integer shift_opt = ( Abs( pol <> 0 ) * ( length( node ) - 1 ) ) 

  
  Dim As list_type Ptr throw = node
  Dim As Integer cnt
  Dim As Integer Ptr s, b
  
    If shift_opt > cnt Then
      b = @shift_opt
      s = @cnt
    Else
    
      b = @cnt
      s = @shift_opt
  
    End If


    While throw->nxt <> 0
    

      bina[*b - *s] = throw->dat.s
          
      cnt += 1
    
      throw = throw->nxt

    Wend
    
      bina[*b - *s] = throw->dat.s
        

    cnt += 1
  

End Sub


Sub list2bin( node As list_type Ptr, bina() As Any Ptr, pol As Integer = 0 ) 


  If node = 0 Then 
    Exit Sub
    
  End If


  Dim As Integer shift_opt = ( Abs( pol <> 0 ) * ( length( node ) - 1 ) ) 

  
  Dim As list_type Ptr throw = node
  Dim As Integer cnt = LBound( bina )
  Dim As Integer Ptr s, b
  
    If shift_opt > cnt Then
      b = @shift_opt
      s = @cnt
    Else
    
      b = @cnt
      s = @shift_opt
  
    End If


    While throw->nxt <> 0
    

      bina( *b - *s ) = throw->dat.pnt
          
      cnt += 1
    
      throw = throw->nxt

    Wend
    
      bina( *b - *s ) = throw->dat.pnt
        

    cnt += 1
  

End Sub


Sub list2bin( node As list_type Ptr, bina As Any Ptr Ptr, pol As Integer = 0 ) 


  If node = 0 Then 
    Exit Sub
    
  End If
  

  Dim As Integer shift_opt = ( Abs( pol <> 0 ) * ( length( node ) - 1 ) ) 
  

'  0 -1,-2
  
  Dim As list_type Ptr throw = node
  Dim As Integer cnt
  Dim As Integer Ptr s, b
  
    If shift_opt > cnt Then
      b = @shift_opt
      s = @cnt
    Else
    
      b = @cnt
      s = @shift_opt
  
    End If

    While throw->nxt <> 0
    

      bina[*b - *s] = throw->dat.pnt
          
      cnt += 1
    
      throw = throw->nxt

    Wend
    
      bina[*b - *s] = throw->dat.pnt
        

    cnt += 1
  

End Sub




Function list_Pop_hooked Alias "ListPop" ( node As list_type Ptr, ret As Any Ptr, id As Integer ) As list_type Ptr


  Dim As list_type Ptr kill_node = node
  
  Select Case id 

    Case ARG_INT
      *cptr( Integer Ptr, @ret ) = kill_node->dat.i
    Case ARG_UINT
      *cptr( uInteger Ptr, @ret ) = kill_node->dat.ui
    Case ARG_STR
      *cptr( String Ptr, @ret ) = kill_node->dat.s
    Case ARG_SNG
      *cptr( Single Ptr, @ret ) = kill_node->dat.sn
    Case ARG_DBL
      *cptr( Double Ptr, @ret ) = kill_node->dat.d
    Case ARG_LNG
      *cptr( LongInt Ptr, @ret ) = kill_node->dat.l
    Case ARG_ULNG
      *cptr( uLongInt Ptr, @ret ) = kill_node->dat.ul
    Case ARG_PTR
      *cptr( Any Ptr Ptr, @ret ) = kill_node->dat.pnt
      
  End Select

  node = kill_node->nxt
  Deallocate kill_node

       
End Function

Sub bin2list( bina() As Integer, node As list_type Ptr ) 


  If UBound( bina ) = 0 Then 
    Exit Sub
    
  End If

  destroy( node )


  Dim As Integer lp
    
    For lp = LBound( bina ) To UBound( bina )
    
      node = list_push( node, bina( lp ) )
      
    Next


End Sub

Sub bin2list( bina As Integer Ptr, node As list_type Ptr, sz As Integer ) 


  If ( bina ) = 0 Then 
    Exit Sub
    
  End If

  destroy( node )


  Dim As Integer lp
    
    For lp = 0 To sz - 1
    
      node = list_push( node, bina[lp] )
      
    Next


End Sub




Sub bin2list( bina() As Single, node As list_type Ptr ) 


  If UBound( bina ) = 0 Then 
    Exit Sub
    
  End If

  destroy( node )


  Dim As Integer lp
    
    For lp = LBound( bina ) To UBound( bina )
    
      node = list_push( node, bina( lp ) )
      
    Next


End Sub



Sub bin2list( bina As Single Ptr, node As list_type Ptr, sz ) 


  If ( bina ) = 0 Then 
    Exit Sub
    
  End If

  destroy( node )


  Dim As Integer lp
    
    For lp = 0 To sz - 1
    
      node = list_push( node, bina[lp] )
      
    Next


End Sub





Sub bin2list( bina() As String, node As list_type Ptr ) 


  If UBound( bina ) = 0 Then 
    Exit Sub
    
  End If

  destroy( node, list_strlist )


  Dim As Integer lp
    
    For lp = LBound( bina ) To UBound( bina )
    
      node = list_push( node, bina( lp ) )
      
    Next


End Sub


Sub bin2list( bina As String Ptr, node As list_type Ptr, sz ) 


  If ( bina ) = 0 Then 
    Exit Sub
    
  End If

  destroy( node, list_strlist )


  Dim As Integer lp
    
    For lp = 0 To sz - 1
    
      node = list_push( node, bina[lp] )
      
    Next
    


End Sub


Sub bin2list( bina() As Any Ptr, node As list_type Ptr ) 


  If UBound( bina ) = 0 Then 
    Exit Sub
    
  End If

  destroy( node )


  Dim As Integer lp
    
    For lp = LBound( bina ) To UBound( bina )
    
      node = list_push( node, bina( lp ) )
      
    Next


End Sub


Sub bin2list( bina As Any Ptr Ptr, node As list_type Ptr, sz ) 


  If ( bina ) = 0 Then 
    Exit Sub
    
  End If

  destroy( node )


  Dim As Integer lp
    
    For lp = 0 To sz - 1
    
      node = list_push( node, bina[lp] )
      
    Next


End Sub


Function list_search_hooked( node As list_type Ptr, v As Any Ptr, strt As Integer = 0, id As Integer ) As Integer


  If ( node = 0 ) Or ( v = 0 ) Then Return -1
  If strt >= length( node ) Then Return -1

  Function = -1

  Dim As list_type Ptr thr 
  Dim As Integer c, cond
  
  thr = node 
  For c = 0 To strt - 1
    thr = thr->nxt
  
  Next
  
  c = 0

  
  Do While thr <> 0

    Select Case As Const id    
    
      Case ARG_INT
        cond = ( thr->dat.i = *cptr( Integer Ptr, v ) )
        
      Case ARG_STR
        If strt = -1 Then
          cond = ( thr->dat.s = *cptr( zString Ptr, v ) )
          
        Else
          cond = ( Instr( thr->dat.s, *cptr( zString Ptr, v ) ) <> 0 )
        
        End If
        
      Case ARG_SNG
        cond = ( thr->dat.sn = *cptr( Single Ptr, v ) )
        
      Case ARG_PTR
        cond = ( thr->dat.pnt = v )
        
      Case ARG_DBL
        cond = ( thr->dat.d = *cptr( Double Ptr, v ) )
        
      Case ARG_LNG
        cond = ( thr->dat.l = *cptr( LongInt Ptr, v ) )
        
    End Select

    If cond Then
      
      Return c
      
      c+= 1

      
    End If

    thr = thr->nxt    
    
  Loop
  
End Function
  
  
Function list_node_value( l As list_type Ptr, n As Integer, id As Integer = 0 ) As Integer

  If l = 0 Then Exit Function
  
  Dim As list_type Ptr thr = list_NodeAddress( l, n )
  
  Return thr->dat.i

End Function  

    
Function list_node_value( l As list_type Ptr, n As Integer, id As String ) As String

  If l = 0 Then Exit Function
  
  Dim As list_type Ptr thr = list_NodeAddress( l, n )
  
  Return thr->dat.s

End Function  

    
Function list_node_value( l As list_type Ptr, n As Integer, id As Single ) As Single

  If l = 0 Then Exit Function
  
  Dim As list_type Ptr thr = list_NodeAddress( l, n )
  
  Return thr->dat.sn

End Function  

    
Function list_node_value( l As list_type Ptr, n As Integer, id As Any Ptr ) As Any Ptr

  If l = 0 Then Exit Function
  
  Dim As list_type Ptr thr = list_NodeAddress( l, n )
  
  Return thr->dat.pnt

End Function  


Function list_files ( pth As String = ".", spec As String = "*.*", mask As Integer = 0 ) As list_type Ptr
  
  Dim As list_type Ptr l
  Dim filename As String
  filename = Dir( pth + "\" + spec, mask )
  
  Do
  
    If filename <> "" Then

      l = list_append( l, pth + "\" + filename )
      filename = Dir( "" )

    Else
      Exit Do
  
    End If  
      
  Loop

  Return l

End Function


Function list_Push_hooked Alias "ListPush" ( node As list_type Ptr, value As Any Ptr, id As Integer ) As list_type Ptr

  Dim As list_type Ptr new_node = CAllocate( Len( list_type ) )

    Select Case As Const id

      Case ARG_INT
        new_node->dat.i = *cptr( Integer Ptr, @value )

      Case ARG_DBL
        new_node->dat.d = *cptr( Double Ptr, @value )

      Case ARG_STR
        new_node->dat.s = *cptr( String Ptr, @value )

      Case ARG_LNG
        new_node->dat.l = *cptr( LongInt Ptr, @value )
        
      Case ARG_SNG
        new_node->dat.sn = *cptr( Single Ptr, @value )

      Case ARG_PTR
        new_node->dat.pnt = value

    End Select
  
    new_node->nxt = node
  
  Return new_node 
  
End Function



Function list_Cancel_hooked Alias "ListCancel" ( m As list_type Ptr, n As list_type Ptr, value As Any Ptr, id As Integer ) As list_type Ptr

  Dim As list_type Ptr thr = m, thrr = n, res'= CAllocate( Len( list_type ) )
  Dim As Integer m_vec, n_vec, conf
    Select Case As Const id

      Case ARG_INT
      Case ARG_DBL
      
      Case ARG_STR

        For m_vec = 0 To length( thr ) - 1
          conf And= 0
          For n_vec = 0 To length( thrr ) - 1
            
            If list_node_value( thr, m_vec, " " ) = list_node_value( thrr, n_vec, " " ) Then
              conf = -1

            End If

          Next
          If conf = 0 Then
            
            res = list_push( res, list_node_value( thr, m_vec, " " ) )
            
          End If
          
        Next
              
              
              
      
      Case ARG_LNG
      Case ARG_SNG
      Case ARG_PTR

    End Select
  
  Return res
  
End Function


Function list_Append_hooked Alias "ListAppend" ( node As list_type Ptr, value As Any Ptr, id As Integer ) As list_type Ptr
  
  If node = 0 Then
    Select Case As Const id
  
      Case ARG_INT
        node = list_Push( node, *cptr( Integer Ptr, value ) )
  
      Case ARG_DBL
        node = list_Push( node, *cptr( Double Ptr, value ) )
  
      Case ARG_STR
        node = list_Push( node, *cptr( zString Ptr, value ) )
  
      Case ARG_LNG
        node = list_Push( node, *cptr( LongInt Ptr, value ) )
        
      Case ARG_SNG
        node = list_Push( node, *cptr( Single Ptr, value ) )
  
      Case ARG_PTR
        node = list_Push( node, value )
  
    End Select
    
    Return node
    
  End If

  Dim As Integer it
  Dim As list_type Ptr thr = node
  
  For it = 0 To length( thr ) - 2 
    thr = thr->nxt
    
  Next

  thr->nxt = CAllocate( Len( list_type ) )

  Select Case As Const id

    Case ARG_INT
      thr->nxt->dat.i = *cptr( Integer Ptr, value )

    Case ARG_DBL
      thr->nxt->dat.d = *cptr( Double Ptr, value )

    Case ARG_STR
      thr->nxt->dat.s = *cptr( zString Ptr, value )

    Case ARG_LNG
      thr->nxt->dat.l = *cptr( LongInt Ptr, value )
      
    Case ARG_SNG
      thr->nxt->dat.sn = *cptr( Single Ptr, value )

    Case ARG_PTR
      thr->nxt->dat.pnt = value


  End Select
     
  Return node
  
End Function


Function c_alloc( ls As list_type Ptr, sz As uInteger ) As Any Ptr
  
  Dim As Any Ptr tmp 

    tmp = CAllocate( sz )

    ls = list_append( ls, tmp )


    Return tmp

End Function


Function r_alloc( ls As list_type Ptr, pnt As Any Ptr, sz As uInteger ) As Any Ptr

  ls = remove( ls, pnt )

  pnt = Reallocate( pnt, sz )
  
  ls = list_append( ls, pnt )
  
  Return pnt
    

End Function


Sub iterate_through_list( l As list_type Ptr, fp As Sub( l As list_type Ptr ) )
  
  If ( fp = 0 ) Or ( l = 0 ) Then Exit Sub
    
  Dim As Integer i
  
  Dim As list_type Ptr thr 
  thr = l
  
  For i = 0 To length( thr ) - 1
    
    fp( thr )
    thr = thr->nxt
    
  Next
  
End Sub



Function push_paths( p As zString Ptr = 0 )  As list_type Ptr
  
  Dim As list_type Ptr l

  Dim As String tm

  tm = Dir( *p & "*", 16 ) 

  Do
    If tm = "" Then Exit Do

    If tm <> "." Then

      If tm <> ".." Then
        l = list_push( l, tm )

      End If

    End If
    
    tm = Dir( "", 16 ) 

  Loop
  
  Return l


End Function



Private Function push_sub_dirs( l As list_type Ptr, p As zString Ptr = 0 ) As list_type Ptr

  Dim As list_type Ptr thr
  Dim As Integer d = length( l ), c, iter, stat
  Dim As String tm

  deflect: 
  stat = length( l )

  Do

    Do 
  
      c = length( l )
  
      thr = l
    
      For iter = 0 To d - 1
        tm = Dir( thr->dat.s & "\*", 16 ) 
    
      
        Do
          
          If tm = "" Then Exit Do
      
          If tm <> "." Then
    
            If tm <> ".." Then
              
              l = list_push( l, thr->dat.s & "\" & tm )
      
            End If
          End If
          
          tm = Dir( "", 16 ) 
        
        Loop
        
        thr = thr->nxt
        
      Next
      
      d = length( l ) - c
      
    Loop While c <> length( l )
    
    
    If length( l ) <> stat Then
      Goto deflect
    
    Else
      Return l
      
    End If 
    
  Loop 
  


    
  
End Function  


Function push_dirs( p As zString Ptr = 0 ) As list_type Ptr
  

  Dim As list_type Ptr l, thr
  Dim As Integer iter
  
  If p = 0 Then p = @".\"

  l = push_paths( p )
  thr = l
  
  For iter = 0 To length( l ) - 1

    thr->dat.s = *p & thr->dat.s
    
    thr = thr->nxt
    
  Next

  l = push_sub_dirs( l, p )      
  l = list_push( l, Left( *p, Len( *p ) - 1 ) )
  
  Return l
  
  
End Function



Function list_NodeAddress( l As list_type Ptr, i As Integer ) As list_type Ptr


  Dim As Integer it
  Dim As list_type Ptr thr = l
  
  For it = 0 To i - 1
    thr = thr->nxt
    
  Next
  
  Return thr
  
End Function

example of using this is like

Code: Select all

Dim As list_type Ptr l
Dim As Any Ptr i, j, k

i = c_alloc( l, 20 )
j = c_alloc( l, 40 )
k = c_alloc( l, 750 )

k = r_alloc( l, k, 30 )




destroy( l, list_dealloc )

and yes, i love giving away large amoun ts of code for free, sue me.

Xerol · Post by **Xerol** » Mar 29, 2006 20:05

Just looking at the above code makes me ask this question: Will FB support templates at some point?

cha0s · Post by **cha0s** » Mar 29, 2006 20:51

Xerol wrote:Just looking at the above code makes me ask this question: Will FB support templates at some point?

haha :p well i think with oop that might come.. but i dunno.

tunginobi · Post by **tunginobi** » Mar 30, 2006 3:39

anonymous1337 wrote:*is rushing to fix all 10000 of his programs using ImageCreate right now* No wonder my 512 megabytes of RAM has been messed up lately...

Don't forget, ImageCreate only works when the screen mode has already been set. You might have to shuffle your logic some if you load images before a screen mode is set.

anonymous1337 · Post by **anonymous1337** » Mar 30, 2006 3:48

Yeah I learned about that ImageCreate and such a long while back while reading the FBGFX doc. ^_~ Sooo helpful.

yetifoot · Post by **yetifoot** » Mar 30, 2006 15:20

anonymous1337 wrote:No wonder my 512 megabytes of RAM has been messed up lately...

For a windows user this shouldn't be a problem as windows will free memory associated with a program when it ends. You should still use the free'ing functions though as good practise, and in case you decide to release for another platform that doesn't clean up.

Sterling Christensen · Post by **Sterling Christensen** » Mar 30, 2006 17:36

yetifoot wrote:
anonymous1337 wrote:No wonder my 512 megabytes of RAM has been messed up lately...
For a windows user this shouldn't be a problem as windows will free memory associated with a program when it ends. You should still use the free'ing functions though as good practise, and in case you decide to release for another platform ie linux

I thought Linux did the same thing? At least, when I kill a process I see the memory it was using become free again...

Post by **v1ctor** » Mar 30, 2006 18:36

Any OS letting files opened and memory allocated by some user-mode application screw up with the system *after* the app be closed should be banned. An application leaking memory while running is another story.

I'm pretty sure the glibc (used in DOS and Linux) or msvcrt (Windows) memory managers will release the heap allocated. Any files opened with OPEN will be closed automatically when exiting.

What Windows didn't use to do is release handles (for GDI, mutexes, threads, etc). As you can't assume the rtlib won't allocate them when calling any ___create function, you should always call the ___destroy ones in the end.

zerospeed · Post by **zerospeed** » Mar 31, 2006 6:23

v1ctor wrote:...

I'm pretty sure the glibc (used in DOS and Linux) or msvcrt (Windows) memory managers will release the heap allocated. Any files opened with OPEN will be closed automatically when exiting.

What Windows didn't use to do is release handles (for GDI, mutexes, threads, etc). As you can't assume the rtlib won't allocate them when calling any ___create function, you should always call the ___destroy ones in the end.

That applies to OPEN COM too?

I was trying some code few days back using FB and comparing results with hyperterminal. The problem is that after closing the COM port, it isn't available to hyperterminal until ~30 seconds later.

Weird, but weirdness happens, at least in this side of the world.

Later ;-)