Bug with AllocateMemory

Just starting out? Need help? Post your questions and find answers here.
lionel_om
User
User
Posts: 31
Joined: Wed Jul 18, 2007 4:14 pm
Location: France

Bug with AllocateMemory

Post by lionel_om »

Hi all,
I'm new on this forum but not on the French one.
I'm here because I've a problem with AllocateMemory : an Invalide Memory Access is reported. There is no problem with the Memoty Size (12 bytes).

gnozal gave me this code :

Code: Select all

; The only way AllocateMemory() can crash is if the Memory Heap got invalid.
; This happens when the heap control structures are overwritten by a wrong memory operation.
; The problem is that these kinds of errors are very hard to trace, as the problem
; can be somewhere totally else than the line at which it crashes.
;
; Here is a small procedure/macro to test for Heap invalidation :
;
Procedure ValidatePBHeap(LineNumber)
  Protected Heap
  !mov eax, dword [_PB_MemoryBase]
  !mov [p.v_Heap], eax
  If HeapValidate_(Heap, 0, 0) = 0
    MessageRequester("Error", "PB Memory Heap invalid at Line: "+Str(LineNumber))
  EndIf 
EndProcedure

Macro _validate
  ValidatePBHeap(#PB_Compiler_Line)
EndMacro
;
; Place the _validate macro before the AllocateMemory() lines to confirm if the heap
; is indeed invalid. If so, try to place the _validate macro in various places to
; narrow down the place that causes the invalidation.;
I've placed '_valide' before each AllocateMemory, but the Memory Head seems to be valid. The bugged AllocateMemory is in a Thread. I'm using PB v4.10b.

My code is here :

Code: Select all


;/-------------------------\
;-       Constantes
;\-------------------------/



#Vector_ErrorTitle      = "UserLib Vector Error"
#Vector_Flag_Allocated  = $4AB3   ; a fixed random value
#Vector_CurrentElement  = -2      ; Default value for empty parameter in Select, Add, Delete Functions
#Vector_EmptyParameter  = -500


;{- Type Enumeration
;   Kind of vector : differents types
  #Complex = -1 ; Use this constants to define another type
; #Byte    =  0
; #Word    =  1
; #Long    =  2
; #Float   =  3
; #Quad    =  4
; #String  =  5
; #Double  =  6
  #Vector_Type_Minimum = #Complex
  #Vector_Type_Maximum = #Double
;}


;{- Sort Enumeration
; Sort and comparaisons
  #Vector_Sort_Downward         = $20
  #Vector_Sort_CaseNotSensitive = $40 ; For Strings
  ;{- EncType Enumeration
  ; String encodage
    #Vector_Compare_Ascii       = $00
    #Vector_Compare_UTF8        = $01
    #Vector_Compare_Unicode     = $02
  ;}
;}


;{- Comparator Enumeration
; comparaisons
  #Vector_Compare_Less        = -1
  #Vector_Compare_Equal       =  0
  #Vector_Compare_More        =  1
;}


;{- ScanDirectory Enumeration
  #Vector_Dir_Recursive       = 1
  #Vector_Dir_KeepFolder      = 2
;}


;/-------------------------\
;-       Structures
;\-------------------------/



;{- Structure VNode
;   VNode Structure (Vector Nodes)
;   Object who contains the pointer to the Data
Structure VNode

  *Value                    ; Address of the Element
  *NextElement.VNode        ; Pointer to the next element
  *PreviousElement.VNode    ; Pointer to the previous element
  
EndStructure
;}


;{- Structure Vector
;   Vector Structure
;   Main Object : contains information about the linked list
Structure Vector

  Initilized.w              ; Flag for beeing sure that the Vector is allocated
  
  Type.w                    ; Kind of Vector
  *Constructor              ; Address of the constructor function
  *Destructor               ; Address of the destructor function
  
  *CurrentElement.VNode     ; Pointer to the current element
  Index.l                   ; Index of the current element
  *FirstElement.VNode       ; Pointer to the first element of the Vector
  *LastElement.VNode        ; Pointer to the last element of the Vector
  
  Count.l                   ; Number of element in this vector

  *Comparator               ; Pointer to the comparate function
  
  Mutex.l                   ; Create a Mutex for ThreadSafe Vector
  
EndStructure
;}


;{- Others Structures

Structure VectorScan Extends Vector
  ThreadID.l
  Stop.b
EndStructure


Structure Vector_Dir_Infos
  Name.s
  Size.q
  Type.l
  Attributes.l
  CreationDate.l
  AccessedDate.l
  ModifiedDate.l
EndStructure

Structure Vector_Dir_Params
  *Vector.VectorScan
  Path.s
  Options.l
  Extensions.s
EndStructure

;}



CompilerSelect #PB_Compiler_OS
  CompilerCase #PB_OS_Windows
    #PATH_DELIMITER = "\"
  CompilerDefault
    #PATH_DELIMITER = "/"
    ; This include Mac, Linux and Amiga OS
    ;   But I don't know if it's true...
CompilerEndSelect


Global NewList Vector__GarbageCollector()


EnableExplicit





Procedure ValidatePBHeap(LineNumber)
  Protected Heap
  !mov eax, dword [_PB_MemoryBase]
  !mov [p.v_Heap], eax
  If HeapValidate_(Heap, 0, 0) = 0
    MessageRequester("Error", "PB Memory Heap invalid at Line: "+Str(LineNumber))
  EndIf 
EndProcedure 

Macro _validate
  ValidatePBHeap(#PB_Compiler_Line)
EndMacro 


;/------------------------------------------\
;|                                          |
;-              Privates Functions        
;|                                          |
;\------------------------------------------/



;{- Vector__RaiseError
;   Local Function for displaying errors
;   When this function is called, the program will be exiting
Procedure Vector__RaiseError(Message$, Function$ = #NULL$, Flag.l = #MB_ICONERROR)
  Protected _title$
  If Function$
    _title$ = #Vector_ErrorTitle + " - " + Function$ + "()"
  Else
    _title$ = #Vector_ErrorTitle
  EndIf
  MessageRequester(_title$, Message$, Flag)
  End
EndProcedure
;}

;{- Vector__IsInitialized (Macro)
;   Test if the Vector has been created
;   Otherwise the program will be quiting with an error
Macro Vector__IsInitialized(vector, FunctionName)
  If vector = #Null
    Vector__RaiseError("Try to use Vector Functions from Null Pointer !", FunctionName)
  ElseIf vector\Initilized <> #Vector_Flag_Allocated
    Vector__RaiseError("Vector is not initialized !", FunctionName)
  EndIf
EndMacro
;}


;{- Vector__IsType (Macro)
;   Test if the Vector has been created and if his Type is correct
;   Otherwise the program will be quiting with an error
Macro Vector__IsType(vector, type_, FunctionName)
  Vector__IsInitialized(vector, FunctionName)
  If vector\Type <> type_
    Vector__RaiseError("Not good type !", FunctionName)
  EndIf
EndMacro
;}



;{- Vector__Allocate : Vector AllocateMemory
;   If Can't return a Null Pointer, because the 'Exception' is catched
Procedure.l Vector__Allocate(Size.l)
  Protected *mem
  _validate
  *mem = AllocateMemory(Size)
  If *mem = #Null
    Vector__RaiseError("Can't allocate memory")
  EndIf
  ProcedureReturn *mem
EndProcedure
;}



;{- Vector__GetNextVNode + Vector__GetPreviousVNode
;   Just the Next or Previous Element, or Null if *node=#Null
Procedure Vector__GetNextVNode(*node.VNode)
  If *node
    ProcedureReturn *node\NextElement
  EndIf
EndProcedure
Procedure Vector__GetPreviousVNode(*node.VNode)
  If *node
    ProcedureReturn *node\PreviousElement
  EndIf
EndProcedure
;}

;{- Vector__NextElement + Vector__PreviousElement + Vector_W_NextElement + Vector_W_PreviousElement
;   Change the CurrentElement by the Next or Previous
;   Becarefull : Their must be a CurrentElement
Macro Vector__NextElement(vector)
  vector\CurrentElement = vector\CurrentElement\NextElement
  vector\Index + 1
EndMacro
Macro Vector_W_NextElement()
  \CurrentElement = \CurrentElement\NextElement
  \Index + 1
EndMacro
Macro Vector__PreviousElement(vector)
  vector\CurrentElement = vector\CurrentElement\PreviousElement
  vector\Index - 1
EndMacro
Macro Vector_W_PreviousElement()
  \CurrentElement = \CurrentElement\PreviousElement
  \Index - 1
EndMacro
;}


Macro Vector__SaveContext(vector_, memory_)
  memory_ = Vector__Allocate(SizeOf(Vector))
  CopyMemory(vector_, memory_, SizeOf(Vector))
EndMacro

Macro Vector__RestoreContext(vector_, memory_)
  CopyMemory(memory_, vector_, SizeOf(Vector))
  FreeMemory(memory_)
EndMacro



;/------------------------------------------\
;|                                          |
;-   Constructors and Destructor Functions 
;|                                          |
;\------------------------------------------/



;{- V__Constructor_xxx : String, Byte, Long, Double, etc...
;   The differents constructors
;   For Complex Structures, users have to define their own constructor
;   If the argument is not a Null Pointer, the pointed object is copied to the new memory
;   Otherelse for numbers an empty memory is allocated, for Strings the pointer is Null
Procedure.l V__Constructor_Byte(*param.Byte = #Null)
  Protected *mem.Byte
  *mem = Vector__Allocate(SizeOf(Byte))
  If *param
    *mem\b = *param\b
  EndIf
  ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_Word(*param.Word = #Null)
  Protected *mem.Word
  *mem = Vector__Allocate(SizeOf(Word))
  If *param
    *mem\w = *param\w
  EndIf
  ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_Long(*param.Long = #Null)
  Protected *mem.Long
  *mem = Vector__Allocate(SizeOf(Long))
  If *param
    *mem\l = *param\l
  EndIf
  ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_Float(*param.Float = #Null)
  Protected *mem.Float
  *mem = Vector__Allocate(SizeOf(Float))
  If *param
    *mem\f = *param\f
  EndIf
  ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_Quad(*param.Quad = #Null)
  Protected *mem.Quad
  *mem = Vector__Allocate(SizeOf(Quad))
  If *param
    *mem\q = *param\q
  EndIf
  ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_String(*param = #Null)
  Protected *str.String, *mem.String
  If *param
    *str = @*param
    *mem = Vector__Allocate(SizeOf(String))
    *mem\s = *str\s
  Else
    *mem = Vector__Allocate(1)
    *mem\s = ""
  EndIf
  ProcedureReturn *mem
EndProcedure
Procedure.l V__Constructor_Double(*param.Double = #Null)
  Protected *mem.Double
  *mem = Vector__Allocate(SizeOf(Double))
  If *param
    *mem\d = *param\d
  EndIf
  ProcedureReturn *mem
EndProcedure
;}

;{- V__BasicDestructor
;   Destructor of basic types (not Structures)
ProcedureDLL V__BasicDestructor(*param)
EndProcedure
;}





;/------------------------------------------\
;|                                          |
;-          Comparators Functions 
;|                                          |
;\------------------------------------------/


;{- V__Comparator_xxx : String, Byte, Long, Double, etc...
;   The differents comparators
;   For Complex Structures, users have to define their own coparators
Procedure V__Comparator_Byte(*obj1.Byte, *obj2.Byte)
  If *obj1\b = *obj2\b
    ProcedureReturn #Vector_Compare_Equal
  ElseIf *obj1\b < *obj2\b
    ProcedureReturn #Vector_Compare_Less
  Else
    ProcedureReturn #Vector_Compare_More
  EndIf
EndProcedure
Procedure V__Comparator_Word(*obj1.Word, *obj2.Word)
  If *obj1\w = *obj2\w
    ProcedureReturn #Vector_Compare_Equal
  ElseIf *obj1\w < *obj2\w
    ProcedureReturn #Vector_Compare_Less
  Else
    ProcedureReturn #Vector_Compare_More
  EndIf
EndProcedure
Procedure V__Comparator_Long(*obj1.Long, *obj2.Long)
  If *obj1\l = *obj2\l
    ProcedureReturn #Vector_Compare_Equal
  ElseIf *obj1\l < *obj2\l
    ProcedureReturn #Vector_Compare_Less
  Else
    ProcedureReturn #Vector_Compare_More
  EndIf
EndProcedure
Procedure V__Comparator_Float(*obj1.Float, *obj2.Float)
  If *obj1\f = *obj2\f
    ProcedureReturn #Vector_Compare_Equal
  ElseIf *obj1\f < *obj2\f
    ProcedureReturn #Vector_Compare_Less
  Else
    ProcedureReturn #Vector_Compare_More
  EndIf
EndProcedure
Procedure V__Comparator_Quad(*obj1.Quad, *obj2.Quad)
  If *obj1\q = *obj2\q
    ProcedureReturn #Vector_Compare_Equal
  ElseIf *obj1\q < *obj2\q
    ProcedureReturn #Vector_Compare_Less
  Else
    ProcedureReturn #Vector_Compare_More
  EndIf
EndProcedure
Procedure V__Comparator_StringCaseSensitive(*obj1.String, *obj2.String)
  ProcedureReturn CompareMemoryString(@*obj1\s, @*obj2\s, #True)
EndProcedure
Procedure V__Comparator_String(*obj1.String, *obj2.String)
  ProcedureReturn CompareMemoryString(@*obj1\s, @*obj2\s, #False)
EndProcedure
Procedure V__Comparator_Double(*obj1.Double, *obj2.Double)
  If *obj1\d = *obj2\d
    ProcedureReturn #Vector_Compare_Equal
  ElseIf *obj1\d < *obj2\d
    ProcedureReturn #Vector_Compare_Less
  Else
    ProcedureReturn #Vector_Compare_More
  EndIf
EndProcedure
;}





;/------------------------------------------\
;|                                          |
;-             Get/Set Functions 
;|                                          |
;\------------------------------------------/



ProcedureDLL Vector_Count(*vector.Vector)             ; Count Nodes
  Vector__IsInitialized(*vector, "Vector_Count")
  ProcedureReturn *vector\Count
EndProcedure
ProcedureDLL Vector_Index(*vector.Vector)             ; Position
  Vector__IsInitialized(*vector, "Vector_Index")
  ProcedureReturn *vector\Count
EndProcedure
ProcedureDLL Vector_GetCurrentElement(*vector.Vector) ; Current Element
  Vector__IsInitialized(*vector, "Vector_CurrentElement")
  ProcedureReturn *vector\CurrentElement
EndProcedure
ProcedureDLL Vector_GetFirstElement(*vector.Vector)   ; Firts Element
  Vector__IsInitialized(*vector, "Vector_GetFirstElement")
  ProcedureReturn *vector\FirstElement
EndProcedure
ProcedureDLL Vector_GetLastElement(*vector.Vector)    ; Last Element
  Vector__IsInitialized(*vector, "Vector_GetLastElement")
  ProcedureReturn *vector\LastElement
EndProcedure

ProcedureDLL Vector_SetCaseSensitiveState(*Vector.Vector, State.l)
  Vector__IsInitialized(*vector, "Vector_SetCaseSensitiveState")
  If *Vector\Type = #String
    If State
      *Vector\Constructor = @V__Comparator_StringCaseSensitive()
    Else
      *Vector\Constructor = @V__Constructor_String()
    EndIf
  Else
    Vector__RaiseError("This is not a String Vector", "Vector_SetCaseSensitiveState")
  EndIf
EndProcedure





;/------------------------------------------\
;|                                          |
;-               Moves Functions 
;|                                          |
;\------------------------------------------/



ProcedureDLL Vector_FirstElement(*vector.Vector)
  Vector__IsInitialized(*vector, "Vector_FirstElement")
  With *vector
    WaitForSingleObject_(\Mutex,0)
    \CurrentElement = \FirstElement
    \Index = 0
    ReleaseMutex_(\Mutex)
    ProcedureReturn \CurrentElement
  EndWith
EndProcedure

ProcedureDLL Vector_LastElement(*vector.Vector)
  Vector__IsInitialized(*vector, "Vector_LastElement")
  With *vector
    WaitForSingleObject_(\Mutex,0)
    \CurrentElement = \LastElement
    \Index = \Count - 1
    ReleaseMutex_(\Mutex)
    ProcedureReturn \CurrentElement
  EndWith
EndProcedure

ProcedureDLL Vector_NextElement(*vector.Vector)
  Vector__IsInitialized(*vector, "Vector_NextElement")
  With *vector
    WaitForSingleObject_(\Mutex,0)
    If \Count And \Index = -1
      \CurrentElement = \FirstElement
      \Index = 0
    ElseIf \CurrentElement
      Vector_W_NextElement()
    EndIf
    ReleaseMutex_(\Mutex)
    ProcedureReturn \CurrentElement
  EndWith
EndProcedure

ProcedureDLL Vector_PreviousElement(*vector.Vector)
  Vector__IsInitialized(*vector, "Vector_PreviousElement")
  With *vector
    WaitForSingleObject_(\Mutex,0)
    If \Count = \Index
      \CurrentElement = \LastElement
      \Index - 1
    ElseIf \CurrentElement
      Vector_W_PreviousElement()
    EndIf
    ReleaseMutex_(\Mutex)
    ProcedureReturn \CurrentElement
  EndWith
EndProcedure

ProcedureDLL Vector_Reset(*vector.Vector)
  Vector__IsInitialized(*vector, "Vector_Reset")
  With *vector
    WaitForSingleObject_(\Mutex,0)
    \CurrentElement = #Null
    \Index = -1
    ReleaseMutex_(\Mutex)
    ProcedureReturn \CurrentElement
  EndWith
EndProcedure

ProcedureDLL Vector_SelectElement(*vector.Vector, Index.l, FonctionName.s = #NULL$)
  Protected dist.l, index_.l, *node_.VNode
  If FonctionName = #NULL$
    FonctionName = "Vector_SelectElement"
  EndIf
  Vector__IsInitialized(*vector, FonctionName)
  With *vector
    WaitForSingleObject_(\Mutex,0)
    If Index < -1 Or Index >= \Count
      Vector__RaiseError("Invalid Index for Vector_Select()", FonctionName)
    EndIf
    dist = Abs(\Index - Index)
    If dist > Index
      ;Debug "Search from the begin !"
      dist = Index
      \Index = 0
      \CurrentElement = \FirstElement
    EndIf
    If dist > \Count - Index
      ;Debug "Search from the end !"
      \Index = \Count - 1
      \CurrentElement = \LastElement
    EndIf
    If Index = -1 Or Index = \Count
      \CurrentElement = #Null
      \Index = Index
    EndIf
    If \Index <> Index
      If \CurrentElement = #Null
        If \Index = -1
          \Index = 0
          \CurrentElement = \FirstElement
        Else
          \Index = \Count - 1
          \CurrentElement = \LastElement
        EndIf
      EndIf
      Repeat
        If \Index < Index
          Vector_W_NextElement()
        Else
          Vector_W_PreviousElement()
        EndIf
      Until \Index = Index
    EndIf
    ReleaseMutex_(\Mutex)
    ProcedureReturn \CurrentElement
  EndWith
EndProcedure





;/------------------------------------------\
;|                                          |
;-              Get/Set Functions 
;|                                          |
;\------------------------------------------/



ProcedureDLL Vector_Get(*vector.Vector, Index.l = #Vector_CurrentElement)
  Vector__IsInitialized(*vector, "Vector_Get")
  If Index <> #Vector_CurrentElement
    Vector_SelectElement(*vector, Index, "Vector_Get")
  EndIf
  If *vector\CurrentElement
    ProcedureReturn *vector\CurrentElement\Value
  Else
    Vector__RaiseError("The current element is a Null Pointer !", "Vector_Get")
  EndIf
EndProcedure

ProcedureDLL Vector_Set(*vector.Vector, *Object = #Null, Index.l = #Vector_CurrentElement)
  Vector__IsInitialized(*vector, "Vector_Get")
  If Index <> #Vector_CurrentElement
    Vector_SelectElement(*vector, Index, "Vector_Get")
  EndIf
  With *vector
    WaitForSingleObject_(\Mutex,0)
    If *vector\CurrentElement
      CallFunctionFast(\Destructor, \CurrentElement\Value)
      \CurrentElement\Value = CallFunctionFast(\Constructor, *Object)
    Else
      Vector__RaiseError("Null Pointer !", "Vector_Get")
    EndIf
    ReleaseMutex_(\Mutex)
  EndWith
EndProcedure

ProcedureDLL Vector_SwapElements(*vector.Vector, Index1.l, Index2.l)
  Protected *node.VNode, index.l, *node1.VNode, *node2.VNode, temp
  Vector__IsInitialized(*vector, "Vector_SwapElements")
  If Index1 <> Index2
    With *vector
      WaitForSingleObject_(\Mutex,0)
      *node = \CurrentElement
      index = \Index
      *node1 = Vector_SelectElement(*vector, Index1, "Vector_Swap")
      *node2 = Vector_SelectElement(*vector, Index2, "Vector_Swap")
      If *node1 And *node2
        temp = *node1\Value
        *node1\Value = *node2\Value
        *node2\Value = temp
      EndIf
      \CurrentElement = *node
      \Index = index
      ReleaseMutex_(\Mutex)
    EndWith
  EndIf
EndProcedure



ProcedureDLL Vector_SetComparator(*vector.Vector, Function)
  WaitForSingleObject_(*vector\Mutex,0)
  Vector__IsInitialized(*vector, "Vector_SetComparator")
  *vector\Comparator = Function
  ReleaseMutex_(*vector\Mutex)
EndProcedure

ProcedureDLL Vector_GetComparator(*vector.Vector)
  Vector__IsInitialized(*vector, "Vector_SetComparator")
  ProcedureReturn *vector\Comparator
EndProcedure





;/------------------------------------------\
;|                                          |
;-       Vector Constructor/Destructor
;|                                          |
;\------------------------------------------/



;{- Vector_Create
;   Create a Vector from a given Type
;   If the Type is known, Constructor and Destructor will be ignored
;   Otherwise, this 2 arguments are pointer to the Constructor and Destructor Functions
ProcedureDLL Vector__Create(Type.w, Constructor = #Null, Destructor = #Null, Comparator = #Null)
  Protected *vector.Vector
  *vector = Vector__Allocate(SizeOf(Vector))
  With *vector
    \Initilized = #Vector_Flag_Allocated
    If Type < #Vector_Type_Minimum Or Type > #Vector_Type_Maximum
      Vector__RaiseError("Incorrect Type value", "Vector_Create")
    EndIf
    \Type = Type
    \Destructor  = @V__BasicDestructor()
    Select Type
      Case #Complex
        \Constructor = Constructor
        \Destructor  = Destructor
        \Comparator  = Comparator
      Case #Byte
        \Constructor = @V__Constructor_Byte()
        \Comparator  = @V__Comparator_Byte()
      Case #Word
        \Constructor = @V__Constructor_Word()
        \Comparator  = @V__Comparator_Word()
      Case #Long
        \Constructor = @V__Constructor_Long()
        \Comparator  = @V__Comparator_Long()
      Case #Float
        \Constructor = @V__Constructor_Float()
        \Comparator  = @V__Comparator_Float()
      Case #Quad
        \Constructor = @V__Constructor_Quad()
        \Comparator  = @V__Comparator_Quad()
      Case #String
        \Constructor = @V__Constructor_String()
        \Comparator  = @V__Comparator_StringCaseSensitive() ; @V__Comparator_String()
      Case #Double
        \Constructor = @V__Constructor_Double()
        \Comparator  = @V__Comparator_Double()
    EndSelect
    \Count          = 0
    \Index          = -1
    \FirstElement   = #Null
    \LastElement    = #Null
    \CurrentElement = #Null
    \Mutex          = CreateMutex_(0,0,0)
  EndWith
  AddElement(Vector__GarbageCollector()) : Vector__GarbageCollector() = *vector
  ProcedureReturn *vector
EndProcedure
Macro Vector_CreateFromStructure(Constructor, Destructor, Comparator = #Null)
  Vector__Create(#Complex, Constructor, Destructor, Comparator)
EndMacro
Macro Vector_CreateFromStruct(Constructor, Destructor, Comparator = #Null)
  Vector__Create(#Complex, Constructor, Destructor, Comparator)
EndMacro
Macro Vector_Create(Type_)
  Vector__Create(Type_)
EndMacro
;}

;{- Vector_Clear
;   Delete all nodes
ProcedureDLL.l Vector_Clear(*vector.Vector)
  Protected *cNode.VNode, *nNode.VNode
  
  Vector__IsInitialized(*vector, "Vector_Clear")
  With *vector
    WaitForSingleObject_(\Mutex,0)
    *cNode = *vector\FirstElement
    While *cNode
      *nNode = *cNode\NextElement
      CallFunctionFast(\Destructor, *cNode\Value)
      *cNode = *nNode
    Wend
    \Count = 0
    \Index = -1
    \FirstElement = #Null
    \LastElement = #Null
    ReleaseMutex_(\Mutex)
  EndWith
EndProcedure
;}

;{- Vector_Free
;   FreeMemory for the Vector and his Nodes
ProcedureDLL.l Vector_Free(*vector.Vector)
  Vector__IsInitialized(*vector, "Vector_Free")
  Vector_Clear(*vector)
  *vector\Initilized = #Null
  CloseHandle_(*vector\Mutex)
  ForEach Vector__GarbageCollector()
    If Vector__GarbageCollector() = *vector
      DeleteElement(Vector__GarbageCollector())
      Break
    EndIf
  Next
  FreeMemory(*vector)
EndProcedure
;}


;{- Vector_FreeGarbageCollector
;   Clear all Vector who haven't been cleared !!!
ProcedureDLL Vector_FreeGarbageCollector()
  ForEach Vector__GarbageCollector()
    Vector_Free(Vector__GarbageCollector())
  Next
  ClearList(Vector__GarbageCollector())
EndProcedure
;}




;/------------------------------------------\
;|                                          |
;-           Add/Delete Functions
;|                                          |
;\------------------------------------------/



;{- Vector_AddElement (after the Current/New Element)
ProcedureDLL Vector_AddElement(*vector.Vector, *object = #Null, Index.l = #Vector_CurrentElement)
  Protected *new.VNode

  Vector__IsInitialized(*vector, "Vector_AddElement")
  
  If Index <> #Vector_CurrentElement
    Vector_SelectElement(*vector, Index, "AddElement")
  EndIf
  
  With *vector
    WaitForSingleObject_(\Mutex,0)
    *new                  = Vector__Allocate(SizeOf(VNode))
    *new\Value            = CallFunctionFast(\Constructor, *object)
    *new\PreviousElement  = #Null
    *new\NextElement      = #Null
    
    If *vector\Count = 0      ; Add the firts Element
    
      \FirstElement   = *new
      \LastElement    = *new
      \Index          = 0
      
    ElseIf \Index = -1        ; Add at head of list
    
      *new\NextElement              = \FirstElement
      \FirstElement\PreviousElement = *new
      \FirstElement                 = *new
      \Index                        = 0
    
    ElseIf \Index >= \Count-1 ; Add at end of list
    
      *new\PreviousElement          = \LastElement
      \LastElement\NextElement      = *new
      \LastElement                  = *new
      \Index                        = \Count
    
    Else                      ; In the list
    
      *new\PreviousElement        = \CurrentElement
      *new\NextElement            = \CurrentElement\NextElement
      \CurrentElement\NextElement\PreviousElement =  *new
      \CurrentElement\NextElement =  *new
      \Index                      + 1
    
    EndIf
    \Count + 1
    \CurrentElement = *new
    ReleaseMutex_(\Mutex)
  EndWith
  ProcedureReturn *new

EndProcedure
;}

;{- Vector_DeleteElement (the Current/Selected Element)
ProcedureDLL Vector_DeleteElement(*vector.Vector, Index.l = #Vector_CurrentElement)
  Protected *cNode.VNode

  Vector__IsInitialized(*vector, "Vector_AddElement")
  
  If Index <> #Vector_CurrentElement
    Vector_SelectElement(*vector, Index, "AddElement")
  EndIf
  
  With *vector
    WaitForSingleObject_(\Mutex,0)
    If \CurrentElement = #Null
      Vector__RaiseError("There is no current element", "Vector_DelElement")
    EndIf
    *cNode = \CurrentElement
    If *cNode\NextElement
      *cNode\NextElement\PreviousElement = *cNode\PreviousElement
    EndIf
    If *cNode\PreviousElement
      *cNode\PreviousElement\NextElement = *cNode\NextElement
    EndIf
    \CurrentElement = *cNode\PreviousElement
    \Index - 1
    \Count - 1
    ;Debug *cNode
    ;Debug *cNode\Value
    CallFunctionFast(\Destructor, *cNode\Value)
    FreeMemory(*cNode\Value)
    FreeMemory(*cNode)
    ReleaseMutex_(\Mutex)
  EndWith
  
EndProcedure
;}





;/------------------------------------------\
;|                                          |
;-              Sort Functions
;|                                          |
;\------------------------------------------/



Procedure Vector__QS_Swap(*vector.Vector, iMin.l, iMax.l, opt.l)
  Protected temp, *min.VNode, *max.VNode, test1.b, test2.b
  
  If opt & #Vector_Sort_Downward
    test1 = -1: test2 =  1
  Else
    test1 =  1: test2 = -1
  EndIf
  
  *max = Vector_SelectElement(*vector, iMax)
  temp = *max\Value
  *min = Vector_SelectElement(*vector, iMin)
  
  With *vector
    While (iMax > iMin)
      While iMax > iMin And CallFunctionFast(\Comparator, *min\Value, temp) <> test1
        iMin + 1
        \CurrentElement = \CurrentElement\NextElement
        \Index + 1
        *min = \CurrentElement
      Wend
      If iMax > iMin
        *max\Value = *min\Value
        \CurrentElement = *max
        \Index = iMax
        *max = Vector_PreviousElement(*vector): iMax - 1
        While iMax > iMin And CallFunctionFast(\Comparator, *max\Value, temp) <> test2
          iMax - 1
          \CurrentElement = \CurrentElement\PreviousElement
          \Index - 1
          *max = \CurrentElement
          ;*max = Vector_Prev(*vector)
        Wend
        If iMax > iMin
          *min\Value = *max\Value
          \CurrentElement = *min
          \Index = iMin
          \CurrentElement = \CurrentElement\NextElement
          \Index + 1
          *min = \CurrentElement
          ;*min = Vector_Next(*vector)
          iMin + 1
        EndIf
      EndIf
    Wend
  EndWith
  *max\Value = temp
  ProcedureReturn iMax
EndProcedure

Procedure Vector__QS_Split(*vector.Vector, deb.l, fin.l, opt.l)
  Protected mil.l

  If deb < fin
    mil = Vector__QS_Swap(*vector, deb, fin, opt)
    If mil-deb > fin-mil
      Vector__QS_Split(*vector, mil+1, fin, opt)
      Vector__QS_Split(*vector, deb, mil-1, opt)
    Else
      Vector__QS_Split(*vector, deb, mil-1, opt)
      Vector__QS_Split(*vector, mil+1, fin, opt)
    EndIf
  EndIf
EndProcedure


ProcedureDLL Vector_SortOnRange(*vector.Vector, options.l, debut.l, fin.l)
  Vector__IsInitialized(*vector, "Vector_Sort")
  ;Vector_SortString_CaseNotSentitive_ = (options & #Vector_Sort_CaseNotSensitive) 
  With *vector
    \CurrentElement = \FirstElement
    \Index          = 0
    Vector__QS_Split(*vector, debut, fin, options)
    \CurrentElement = \FirstElement
    \Index          = 0
  EndWith
EndProcedure

ProcedureDLL Vector_Sort(*vector.Vector, options.l = #Null)
  Vector__IsInitialized(*vector, "Vector_Sort")
  Vector_SortOnRange(*vector, options, 0, *vector\Count - 1)
EndProcedure





;/------------------------------------------\
;|                                          |
;-             Search Functions
;|                                          |
;\------------------------------------------/



ProcedureDLL Vector_Search(*vector.Vector, *element, *index.Long = #Null)
  Protected *backup, index.l = -1

  Vector__IsInitialized(*vector, "Vector_Search")
  If *vector\Comparator = #Null
    Vector__RaiseError("No comparator defined !", "Vector_Search")
  EndIf
  Vector__SaveContext(*vector, *backup)
  Vector_Reset(*vector)
  While index = -1 And Vector_NextElement(*vector)
    If CallFunctionFast(*vector\Comparator, *vector\CurrentElement\Value, *element) = 0
      index = *vector\Index
    EndIf
  Wend
  Vector__RestoreContext(*vector, *backup)
  If *index
    *index\l = index
  EndIf
  If index > 1
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure





;/------------------------------------------\
;|                                          |
;-             Others Functions
;|                                          |
;\------------------------------------------/



ProcedureDLL Vector_Copy(*original.Vector)
  Protected *vector.Vector, *backup,    *s.String

  Vector__IsInitialized(*original, "Vector_Copy")
  Vector__SaveContext(*original, *backup)
  *vector = Vector_Create(*original\Type)
  *vector\Constructor = *original\Constructor
  *vector\Destructor  = *original\Destructor
  Vector_Reset(*original)
  While Vector_NextElement(*original)
    If *vector\Type = #String
      *s = *original\CurrentElement\Value
      Vector_AddElement(*vector, @*s\s)
    Else
      Vector_AddElement(*vector, *original\CurrentElement\Value)
    EndIf
    *s = Vector_Get(*vector)
  Wend
  Vector__RestoreContext(*original, *backup)
  ProcedureReturn *vector
EndProcedure

ProcedureDLL Vector_Combine(*source.Vector, *destination.Vector)
  Protected *backup.Vector

  Vector__IsInitialized(*source, "Vector_Combine")
  Vector__IsInitialized(*destination, "Vector_Combine")
  If *destination\Constructor = *source\Constructor And *destination\Destructor  = *source\Destructor And *destination\Type  = *source\Type
    Vector__SaveContext(*source, *backup)
    Vector_Reset(*source)
    While Vector_NextElement(*source)
      Vector_AddElement(*destination, *source\CurrentElement\Value)
    Wend
    Vector__RestoreContext(*source, *backup)
  Else
    Vector__RaiseError("Incompatibles Vectors !", "Vector_Combine")
  EndIf
EndProcedure




;/------------------------------------------\
;|                                          |
;-            Directory Functions
;|                                          |
;\------------------------------------------/


Procedure Vector__NextDirectoryEntry(hDir.l)
  Protected Type.l, Name$

  If NextDirectoryEntry(hDir)
    Type = DirectoryEntryType(hDir)
    If Type = #PB_DirectoryEntry_Directory
      Name$ = DirectoryEntryName(hDir)
      If Name$ = "." Or Name$ = ".."
        ProcedureReturn Vector__NextDirectoryEntry(hDir)
      EndIf
    EndIf
    ProcedureReturn Type
  Else
    ProcedureReturn #Null
  EndIf
EndProcedure


Procedure Vector__ScanDir(*Vector.VectorScan, Dir$, SecondDirPart$, options.l, ext$)
  Protected hDir.l, FileName$, Type.l, CompleteName$

  hDir = ExamineDirectory(#PB_Any, Dir$+SecondDirPart$, "*.*")
  If hDir
    Type = Vector__NextDirectoryEntry(hDir)
    While Type And *Vector\Stop = #Null
      FileName$ = DirectoryEntryName(hDir)
      Debug FileName$
      CompleteName$ = SecondDirPart$ + FileName$
      If Type = #PB_DirectoryEntry_File
        If ext$ = ";;"
          Vector_AddElement(*Vector, @CompleteName$)
        ElseIf FindString(ext$, ";"+LCase(GetExtensionPart(FileName$))+";", 1)
          Vector_AddElement(*Vector, @CompleteName$)
        EndIf
      Else
        If options & #Vector_Dir_KeepFolder
          Vector_AddElement(*Vector, @CompleteName$)
        EndIf
        If options & #Vector_Dir_Recursive
          Vector__ScanDir(*Vector, Dir$, CompleteName$+#PATH_DELIMITER, options, ext$)
        EndIf
      EndIf
      ; Debug Dir$ + DirectoryEntryName(hDir) + Type$ + "- Taille en octet : " + Str(DirectoryEntrySize(hDir))
      Type = Vector__NextDirectoryEntry(hDir)
    Wend
    FinishDirectory(hDir)
  Else
    Debug "Can't examine directory : " + Dir$
  EndIf

EndProcedure


Procedure Vector_ThreadScanDir(*params.Vector_Dir_Params)
  Vector__ScanDir(*params\Vector, *params\Path, "", *params\Options, *params\Extensions)
  *params\Vector\ThreadID = #Null
  FreeMemory(*params)
EndProcedure


; extensions$ : list of used extensions délimited by ";"
; Return Null Pointer, if path not exist
ProcedureDLL Vector_ScanDirectory(Directory$, options.l = #Null, extensions$ = #NULL$)
  Protected *param.Vector_Dir_Params

  If FileSize(Directory$) = -2
    If Right(Directory$, 1) <> #PATH_DELIMITER
      Directory$ + #PATH_DELIMITER
    EndIf
    Debug Directory$
    *param                 = Vector__Allocate(SizeOf(Vector_Dir_Params))
    Debug *param
    *param\Vector          = Vector_Create(#String)
    *param\Path            = Directory$
    *param\Options         = options
    *param\Extensions      = extensions$
    Debug *param\Vector
    *param\Vector\ThreadID = CreateThread(@Vector_ThreadScanDir(), *param)
    ;Vector__ScanDir(*Vector, Directory$, "", options, ";"+LCase(extensions$)+";")
  Else
    Vector__RaiseError("Folder doesn't exists !", "Vector_ScanDirectory")
  EndIf
  ProcedureReturn *param\Vector
EndProcedure


ProcedureDLL Vector_ScanDirectory_Finished(*vector.VectorScan)
  Vector__IsInitialized(*vector, "Vector_ScanDirectory_Finished")
  If *vector\ThreadID = #Null
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure


ProcedureDLL Vector_ScanDirectory_Stop(*vector.VectorScan)
  Vector__IsInitialized(*vector, "Vector_ScanDirectory_Stop")
  *vector\Stop = #True
EndProcedure



;/------------------------------------------\
;|                                          |
;-             String Functions
;|                                          |
;\------------------------------------------/


ProcedureDLL Vector_Explode(String$, Separator$)
  Protected *vector.Vector, i.l, chaine$
  
  *vector = Vector_Create(#String)
  For i = 1 To CountString(String$, Separator$)+1
    chaine$ = StringField(String$, i, Separator$)
    Vector_AddElement(*vector, @chaine$)
  Next i
  
  ProcedureReturn *vector
EndProcedure

ProcedureDLL.s Vector_Implode(*vector.Vector, Separator$)
  Protected String$, *s.String
  
  Vector__IsType(*vector, #String, "Vector_Implode")
  Vector_Reset(*vector)
  While Vector_NextElement(*vector)
    *s = Vector_Get(*vector)
    String$ + *s\s
    If *vector\CurrentElement\NextElement
      String$ + Separator$
    EndIf
  Wend

  ProcedureReturn String$
EndProcedure




;/------------------------------------------\
;|                                          |
;-             Files Functions
;|                                          |
;\------------------------------------------/


ProcedureDLL Vector_LoadByteFile(FileName$)
  Protected *vector.Vector, hFile.l, value.b
  
  hFile = OpenFile(#PB_Any, FileName$)
  If hFile
    *vector = Vector_Create(#Byte)
    While Not(Eof(hFile))
      value = ReadByte(hFile)
      Vector_AddElement(*vector, @value)
    Wend
    CloseFile(hFile)
    ProcedureReturn *vector
  Else
    ProcedureReturn #Null
  EndIf
EndProcedure
ProcedureDLL Vector_LoadWordFile(FileName$)
  Protected *vector.Vector, hFile.l, value.w
  
  hFile = OpenFile(#PB_Any, FileName$)
  If hFile
    *vector = Vector_Create(#Word)
    While Not(Eof(hFile))
      value = ReadByte(hFile)
      Vector_AddElement(*vector, @value)
    Wend
    CloseFile(hFile)
    ProcedureReturn *vector
  Else
    ProcedureReturn #Null
  EndIf
EndProcedure
ProcedureDLL Vector_LoadLongFile(FileName$)
  Protected *vector.Vector, hFile.l, value.l
  
  hFile = OpenFile(#PB_Any, FileName$)
  If hFile
    *vector = Vector_Create(#Byte)
    While Not(Eof(hFile))
      value = ReadLong(hFile)
      Vector_AddElement(*vector, @value)
    Wend
    CloseFile(hFile)
    ProcedureReturn *vector
  Else
    ProcedureReturn #Null
  EndIf
EndProcedure
ProcedureDLL Vector_LoadStringFile(FileName$)
  Protected *vector.Vector, hFile.l, line$
  
  hFile = OpenFile(#PB_Any, FileName$)
  If hFile
    *vector = Vector_Create(#String)
    While Not(Eof(hFile))
      line$ = ReadString(hFile)
      Vector_AddElement(*vector, @line$)
    Wend
    CloseFile(hFile)
    ProcedureReturn *vector
  Else
    ProcedureReturn #Null
  EndIf
EndProcedure
ProcedureDLL Vector_LoadQuadFile(FileName$)
  Protected *vector.Vector, hFile.l, value.q
  
  hFile = OpenFile(#PB_Any, FileName$)
  If hFile
    *vector = Vector_Create(#Byte)
    While Not(Eof(hFile))
      value = ReadQuad(hFile)
      Vector_AddElement(*vector, @value)
    Wend
    CloseFile(hFile)
    ProcedureReturn *vector
  Else
    ProcedureReturn #Null
  EndIf
EndProcedure
ProcedureDLL Vector_LoadFloatFile(FileName$)
  Protected *vector.Vector, hFile.l, value.f
  
  hFile = OpenFile(#PB_Any, FileName$)
  If hFile
    *vector = Vector_Create(#Byte)
    While Not(Eof(hFile))
      value = ReadFloat(hFile)
      Vector_AddElement(*vector, @value)
    Wend
    CloseFile(hFile)
    ProcedureReturn *vector
  Else
    ProcedureReturn #Null
  EndIf
EndProcedure
ProcedureDLL Vector_LoadDoubleFile(FileName$)
  Protected *vector.Vector, hFile.l, value.d
  
  hFile = OpenFile(#PB_Any, FileName$)
  If hFile
    *vector = Vector_Create(#Byte)
    While Not(Eof(hFile))
      value = ReadDouble(hFile)
      Vector_AddElement(*vector, @value)
    Wend
    CloseFile(hFile)
    ProcedureReturn *vector
  Else
    ProcedureReturn #Null
  EndIf
EndProcedure




;/------------------------------------------\
;|                                          |
;-              Debug Functions
;|                                          |
;\------------------------------------------/


Procedure Vector_Debug(*vector.Vector, spacer$ = #NULL$, number.b = #Null)
  Protected nb, number$, *b.Byte, *w.Word, *l.Long, *f.Float, *q.Quad, *s.String, *d.Double
  
  Vector__IsInitialized(*vector, "Vector_Debug")
  If *vector\Type = #Complex
    Vector__RaiseError("Can't Debug Complexe Type !", "Vector_Debug")
  EndIf
  
  If number
    If *vector\Count
      nb = Len(Str(*vector\Count-1))
    Else
      nb = 0
    EndIf
  EndIf
  
  Vector_Reset(*Vector)
  While Vector_NextElement(*Vector)
    If number
      number$ = spacer$ + LSet(Str(*Vector\Index), nb, "0") + ") "
    Else
      number$ = spacer$
    EndIf
    Select *vector\Type
      Case #Byte
        *b = Vector_Get(*Vector)
        Debug number$ + Str(*b\b)
      Case #Word
        *w = Vector_Get(*Vector)
        Debug number$ + Str(*w\w)
      Case #Long
        *l = Vector_Get(*Vector)
        Debug number$ + Str(*l\l)
      Case #Float
        *f = Vector_Get(*Vector)
        Debug number$ + StrF(*f\f)
      Case #Quad
        *q = Vector_Get(*Vector)
        Debug number$ + StrQ(*q\q)
      Case #String
        *s = Vector_Get(*Vector)
        Debug number$ + *s\s
      Case #Double
        *d = Vector_Get(*Vector)
        Debug number$ + StrD(*d\d)
    EndSelect
  Wend
  
EndProcedure



;/------------------------------------------\
;|                                          |
;-                  Macros
;|                                          |
;\------------------------------------------/



Macro Vector_First(vector_)
  Vector_FirstElement(vector_)
EndMacro
Macro Vector_Last(vector_)
  Vector_LastElement(vector_)
EndMacro
Macro Vector_Next(vector_)
  Vector_NextElement(vector_)
EndMacro
Macro Vector_Previous(vector_)
  Vector_PreviousElement(vector_)
EndMacro
Macro Vector_Swap(vector_, Idx1_, Idx2_)
  Vector_SwapElements(vector_, Idx1_, Idx2_)
EndMacro


Macro Vector_Add(vector_, object_ = #Null, index_ = #Vector_CurrentElement)
  Vector_AddElement(vector_, object_, index_)
EndMacro
Macro Vector_AddAtStart(vector_, object_ = #Null)
  Vector_AddElement(vector_, object_, -1)
EndMacro
ProcedureDLL Vector_AddAtEnd(*vector.Vector, *object = #Null)
  Vector__IsInitialized(*vector, "Vector_AddAtEnd")
  ProcedureReturn Vector_AddElement(*vector, *object, *vector\Count - 1)
EndProcedure


Macro Vector_Delete(vector_, index_ = #Vector_CurrentElement)
  Vector_DeleteElement(vector_, index_)
EndMacro
Macro Vector_DeleteLastElement(vector_)
  Vector__IsInitialized(vector_, "Vector_DeleteLastElement")
  Vector_DeleteElement(vector_, vector_\Count - 1)
EndMacro
Macro Vector_DeleteFirstElement(vector_)
  Vector_DeleteElement(vector_, -1)
EndMacro



Macro Vector_Del(vector_, index_ = #Vector_CurrentElement)
  Vector_DeleteElement(vector_, index_)
EndMacro
Macro Vector_Select(vector_, index_, fctName_ = #NULL$)
  Vector_SelectElement(vector_, index_, fctName_)
EndMacro


Macro Vector_Clone(vector_)
  Vector_Copy(vector_)
EndMacro



; ===========================================
;- Exemple



Define *ptr2.String, dir$, *Vector.VectorScan
dir$ = "E:\Programmation\PureBasic\Projets\LIB\Lib Vector\Version2"

Debug dir$
*Vector.VectorScan = Vector_ScanDirectory(dir$, 3, "")
Debug *Vector

While Not(Vector_ScanDirectory_Finished(*Vector))
  Debug "wait..."
  Delay(2)
Wend


Debug "------------"


; Affichage du contenu du Vector
Vector_Reset(*Vector)
While Vector_NextElement(*Vector)
  *ptr2 = Vector_Get(*Vector)
  Debug *ptr2\s
Wend


; Libération de la mémoire
Vector_Free(*Vector)


That you for your help !
Lionel :)
lionel_om
User
User
Posts: 31
Joined: Wed Jul 18, 2007 4:14 pm
Location: France

Post by lionel_om »

Maybe, if it is a problem of memory, the problem may come from this part :

Code: Select all

Procedure.l V__Constructor_String(*param = #Null)
  Protected *str.String, *mem.String
  If *param
    *str = @*param
    *mem = Vector__Allocate(SizeOf(String))
    *mem\s = *str\s
  Else
    *mem = Vector__Allocate(1)
    *mem\s = ""
  EndIf
  ProcedureReturn *mem
EndProcedure
This part is always used like that :

Code: Select all

a.s = "coucou"
V__Constructor_String(@"coucou")
V__Constructor_String(@a)
Lio
lionel_om
User
User
Posts: 31
Joined: Wed Jul 18, 2007 4:14 pm
Location: France

Post by lionel_om »

No one have any idea ? :cry:
freak
PureBasic Team
PureBasic Team
Posts: 5940
Joined: Fri Apr 25, 2003 5:21 pm
Location: Germany

Post by freak »

AllocateMemory() itself cannot be the problem.

You can try with this new validation code: http://www.purebasic.fr/english/viewtop ... 460#203460
quidquid Latine dictum sit altum videtur
Xombie
Addict
Addict
Posts: 898
Joined: Thu Jul 01, 2004 2:51 am
Location: Tacoma, WA
Contact:

Post by Xombie »

lionel_om - your code works fine on my computer. I used your "code" code and the only change I made was to Dir$ to use a directory on my computer. It didn't crash on me.

I haven't looked into it in detail to see if there may be something causing your problem, however. You've tried with different directories, right?
Pupil
Enthusiast
Enthusiast
Posts: 715
Joined: Fri Apr 25, 2003 3:56 pm

Post by Pupil »

lionel_om wrote:Maybe, if it is a problem of memory, the problem may come from this part :

Code: Select all

Procedure.l V__Constructor_String(*param = #Null)
  Protected *str.String, *mem.String
  If *param
    *str = @*param
    *mem = Vector__Allocate(SizeOf(String))
    *mem\s = *str\s
  Else
    *mem = Vector__Allocate(1)
    *mem\s = ""
  EndIf
  ProcedureReturn *mem
EndProcedure
This part is always used like that :

Code: Select all

a.s = "coucou"
V__Constructor_String(@"coucou")
V__Constructor_String(@a)
Lio
A string in PB is a pointer to the actual characters that constitute the string, so you should use the line below for both cases, even when '*param = #Null'.

Code: Select all

*mem = Vector__Allocate(SizeOf(String))
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

Code: Select all

*str = @*param 
This doesn't look right, as it makes no sense to work with the address of the pointer.
BERESHEIT
lionel_om
User
User
Posts: 31
Joined: Wed Jul 18, 2007 4:14 pm
Location: France

Post by lionel_om »

Thanks for all yours answers.
netmaestro wrote:

Code: Select all

*str = @*param 
This doesn't look right, as it makes no sense to work with the address of the pointer.
It is the way to copy a String from a pointer without using PeekS(), isn't it ?

@Pupil
Oh, yeah, I've forgetten to change this part !

@Xombie
Be sure that the Debugger is enable

@freak
Thanks for this link !
User avatar
Kaeru Gaman
Addict
Addict
Posts: 4826
Joined: Sun Mar 19, 2006 1:57 pm
Location: Germany

Post by Kaeru Gaman »

> It is the way to copy a String from a pointer without using PeekS(), isn't it ?

not at all.
after all you would only copy the pointer, thus working on the same memory.

and additional, as netmaestro said: it makes no sense to work with the address of the pointer.
oh... and have a nice day.
lionel_om
User
User
Posts: 31
Joined: Wed Jul 18, 2007 4:14 pm
Location: France

Post by lionel_om »

Kaeru Gaman wrote:> It is the way to copy a String from a pointer without using PeekS(), isn't it ?

not at all.
after all you would only copy the pointer, thus working on the same memory.

and additional, as netmaestro said: it makes no sense to work with the address of the pointer.
But with using "*mem\s = *str\s", PB made the copy and create a new buffer . Or I'm wrong...?
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

No, just another pointer to the same buffer.
BERESHEIT
lionel_om
User
User
Posts: 31
Joined: Wed Jul 18, 2007 4:14 pm
Location: France

Post by lionel_om »

netmaestro wrote:No, just another pointer to the same buffer.
Are you sure, because with this code :

Code: Select all

a$= "hello          "
s.String

s\s = a$
PokeS(@a$, "coucou")
Debug s\s
When I change the content of a$, s\s keep the same value.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

In that example you're not using pointers. *s.STRING and s.STRING are two different things altogether. @s is often used to get a pointer to a string variable, while *s is already a pointer, which makes @*s look quite incongruous.
BERESHEIT
lionel_om
User
User
Posts: 31
Joined: Wed Jul 18, 2007 4:14 pm
Location: France

Post by lionel_om »

netmaestro wrote:In that example you're not using pointers. *s.STRING and s.STRING are two different things altogether. @s is often used to get a pointer to a string variable, while *s is already a pointer, which makes @*s look quite incongruous.
Yeah but a String (in all languages) is a pointer on chars, and the PB-structur STRING is a pointer on a chars pointer...

So if i'm wrong, have you a way for creating a STRING variable on a global way : for the memory to be keep after le end of the procedure ?
Pupil
Enthusiast
Enthusiast
Posts: 715
Joined: Fri Apr 25, 2003 3:56 pm

Post by Pupil »

lionel_om wrote: But with using "*mem\s = *str\s", PB made the copy and create a new buffer . Or I'm wrong...?
No, you're quite right.
PB's way of handling the '@' operator for strings can be a bit confusing at times. :) As you can se from the different answers you're getting ;)
Post Reply