Garbage Collection

General FreeBASIC programming questions.
Zamaster
Posts: 1025
Joined: Jun 20, 2005 21:40
Contact:

Garbage Collection

Postby 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
Posts: 1710
Joined: Sep 11, 2005 7:08
Location: England
Contact:

Postby 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
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California

Postby anonymous1337 » Mar 29, 2006 17:35

X-x;; I didn't know about ImageCreate!!! Oh no!! X_X:;
cha0s
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby 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
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California

Postby 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
Posts: 1525
Joined: May 27, 2005 17:18
Contact:

Postby 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
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby 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
Posts: 122
Joined: Aug 12, 2005 1:59
Location: Here
Contact:

Postby 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
Site Admin
Posts: 5317
Joined: May 27, 2005 6:42
Location: Illinois
Contact:

Postby 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
Posts: 655
Joined: Jan 10, 2006 0:44
Contact:

Postby 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
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California

Postby 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
Posts: 1710
Joined: Sep 11, 2005 7:08
Location: England
Contact:

Postby 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.
Last edited by yetifoot on Mar 31, 2006 13:25, edited 1 time in total.
Sterling Christensen
Posts: 142
Joined: May 27, 2005 6:13

Postby 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...
v1ctor
Site Admin
Posts: 3801
Joined: May 27, 2005 8:08
Location: SP / Bra[s]il
Contact:

Postby 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
Posts: 227
Joined: Nov 04, 2005 15:29

Postby 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 ;-)

Return to “General”

Who is online

Users browsing this forum: No registered users and 8 guests