Dynamic arrays in UDTs (once again)

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
TJF
Posts: 3503
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Dynamic arrays in UDTs (once again)

Postby TJF » Apr 12, 2011 11:58

FB (0.21.1) cannot handle dynamic arrays in an UDT yet.

Since this is needed often we saw different solutions here, based on pointers. Alternativ we can store the data for the dynamic array in a STRING variable. This isn't slow and it's easier to handle, ie when we need a copy of an array.

Here is code creating one or more dynamic array data types for use inside an UDT. Save it as 'VarField.bi' (but feel free to call it Garfield as well)

Code: Select all

' This is file VarField.bi, a type creator for dynamic arrays in UDTs
' (C) 2011-2013 by Thomas[ dot ]Freiherr[ at ]gmx[ dot ]net
' License LGPL v 2.1
'
' VarField datas have index 0 to max
' (.dim_(9) makes 10 entries index 0 to 9)
' VarField datas are stored in a STRING variable. The max STRING length
' limits the number of elements.
' The max string length is platform specific. In DOS it may be smaller
' (the value should be reviewed -- I'm no DOS expert).
#IFDEF __FB_DOS__
# DEFINE VF_MAX 2 ^ 16 - 1
#ELSE
# DEFINE VF_MAX 2147483647
#ENDIF
' some macros for convenience
#DEFINE VF_ERROR ? "VarField-error: Index out of range"
#MACRO VF_CHECK(Az)
  VAR l = (Az + 1) * VFSIZE
  IF l > VF_MAX THEN ? "VarField-error: Too much elements" : EXIT SUB
#ENDMACRO


' the core macro here: create a new VarField type
#MACRO MAKE_VarField_(_typ_)

#UNDEF VFSIZE
#UNDEF VFTYPE
#UNDEF VF_SET
#UNDEF VF_GET

' some predefined types, feel free to add yours (or remove uneeded)
#IF #_typ_ = "SHORT"
# DEFINE VFSIZE 2
# DEFINE VFTYPE SHORT
# DEFINE VF_SET(_V_) MKS(_V_)
# DEFINE VF_GET(_V_) CVS(_V_)
#ELSEIF #_typ_ = "ULONGINT"
# DEFINE VFSIZE 8
# DEFINE VFTYPE ULONGINT
# DEFINE VF_SET(_V_) MKLONGINT(_V_)
# DEFINE VF_GET(_V_) CVLONGINT(_V_)
#ELSEIF #_typ_ = "ANY PTR"
# DEFINE VFSIZE 4
# DEFINE VFTYPE ANY PTR
# DEFINE VF_SET(_V_) MKI(CAST(INTEGER, _V_))
# DEFINE VF_GET(_V_) CAST(VFTYPE, CVI(_V_))

' a STRING type with const length of 42
#ELSEIF #_typ_ = "MYSTR"
# DEFINE VFSIZE 26
# DEFINE VFTYPE STRING
# DEFINE VF_SET(_V_) _V_
# DEFINE VF_GET(_V_) _V_

 ' default is INTEGER, some explanations here
#ELSE
' the size of the stored data in bytes
# DEFINE VFSIZE 4
' the FB data type to store
# DEFINE VFTYPE INTEGER
' the FB function to convert the data type into a STRING
# DEFINE VF_SET(_V_) MKI(_V_)
' the FB function to convert a STRING to the data type
# DEFINE VF_GET(_V_) CVI(_V_)
#ENDIF

TYPE VarField_##_typ_
  DECLARE CONSTRUCTOR(BYVAL Az AS UINTEGER = 0)
  DECLARE SUB dim_(BYVAL Az AS UINTEGER = 0)
  DECLARE SUB redim_(BYVAL Az AS UINTEGER = 0)
  DECLARE FUNCTION ubound_() AS UINTEGER
  DECLARE SUB Sval(BYVAL In AS UINTEGER, BYVAL V AS VFTYPE)
  DECLARE FUNCTION Gval(BYVAL In AS UINTEGER = 0) AS VFTYPE
PRIVATE:
  AS UINTEGER Ma = 1
  AS STRING Va = STRING(VFSIZE, 0)
END TYPE

' DIM a new VarField (default size = 1 entry at index 0)
CONSTRUCTOR VarField_##_typ_##(BYVAL Az AS UINTEGER = 0)
  dim_(Az)
END CONSTRUCTOR

' DIM a new VarField with Az empty entries
SUB VarField_##_typ_##.dim_(BYVAL Az AS UINTEGER = 0)
  VF_CHECK(Az)
  Va = STRING(l, 0)
  Ma = l - VFSIZE + 1
END SUB

' REDIM (allways PRESERVE) the existing VarFiled with Az entries
SUB VarField_##_typ_##.redim_(BYVAL Az AS UINTEGER = 0)
  VF_CHECK(Az)
  VAR la = LEN(Va)
  IF l > la THEN Va &= STRING(l - la, 0) ELSE Va = LEFT(Va, l)
  Ma = l - VFSIZE + 1
END SUB

' get the maximum index of VarField
FUNCTION VarField_##_typ_##.ubound_() AS UINTEGER
  RETURN (Ma - 1) \ VFSIZE
END FUNCTION

' set a value V at index I
SUB VarField_##_typ_##.Sval(BYVAL I AS UINTEGER, BYVAL V AS VFTYPE)
  VAR p = 1 + I * VFSIZE
  IF p <= Ma THEN MID(Va, p, VFSIZE) = VF_SET(V) : EXIT SUB
  VF_ERROR
END SUB

' get the value at index I
FUNCTION VarField_##_typ_##.Gval(BYVAL I AS UINTEGER = 0) AS VFTYPE
  VAR p = 1 + I * VFSIZE
  IF p <= Ma THEN RETURN VF_GET(MID(Va, p, VFSIZE))
  VF_ERROR
END FUNCTION
#ENDMACRO

To use a dynamic array in an UDT the data type has to get created first, done by the MAKE_VarField_() macro. Once a data type is created, it can be used several times (and in different UDTs).
    Use .Sval(Index, Value) to set a value.
    Use .Gval(Index) to get a value.
    Use .dim_(Size) and .redim_(Size) to set the array size.
    Use .ubound_() to get the maximum index.

Here's an example

Code: Select all

' This is file VarFieldTest.bas, an example for dynamic arrays in UDTs
' (C) 2011-2013 by Thomas[ dot ]Freiherr[ at ]gmx[ dot ]net
' License GPL v 3
'
#INCLUDE ONCE "VarField.bi"

' create new VarField types as needed
MAKE_VarField_(MYSTR) ' a user defined STRING type, 26 bytes length
MAKE_VarField_(SHORT)
MAKE_VarField_(INTEGER)
MAKE_VarField_(ULONGINT)

' an UDT with 3 variadic fields of different type
TYPE testtype
' the STRING type
  AS VarField_MYSTR    a0 = 1 ' two entries with index 0 to 1

' a standard SHORT type
  AS VarField_SHORT    a1 '     one entry with index 0

' use either one of these
  AS VarField_INTEGER  a2 = 7 '   8 entries with index 0 to 7
  'AS VarField_ULONGINT a2 = 7 '   8 entries with index 0 to 7
END TYPE

DIM AS testtype test


' some demonstrating code here
WITH test

' set the STRING entries
.a0.Sval(0, "abcdefghijklmnopqrstuvwxyz")
.a0.Sval(1, UCASE(.a0.Gval(0)))

?"show the strings:"
?.a0.Gval(0)
?.a0.Gval(1)

' show the default value at default index
? : ?"a1(0): ";.a1.Gval

' redim the field a1
.a1.redim_(99) ' 100 entries index 0 TO 99

?"show all (empty) entries of a1:"
FOR i AS INTEGER = 0 TO .a1.ubound_
  ?.a1.Gval(i),
NEXT

' set the predimensioned 8 entries in a2
FOR i AS INTEGER = 0 TO .a2.ubound_
  .a2.Sval(i, 2 ^ i)
NEXT

? : ?"show all (previously dimed and set) values in a2:"
FOR i AS INTEGER = 0 TO .a2.ubound_
  ?.a2.Gval(i),
NEXT

' add new entries to a2 (leaves entries 0 to 7 unchanged)
.a2.redim_(31) ' 32 entries with index 0 TO 31

' fill the new entries with their negative index
FOR i AS INTEGER = 8 TO .a2.ubound_
  .a2.Sval(i, -i)
NEXT

? : ?"show all values in the redimensioned a2:"
FOR i AS INTEGER = 0 TO .a2.ubound_
  ?.a2.Gval(i),
NEXT

' reduce the entries in a2 (leaves entries 0 to 3 unchanged)
.a2.redim_(3) ' 4 entries with index 0 TO 3

? : ?"show all values in the redimensioned a2:"
FOR i AS INTEGER = 0 TO .a2.ubound_
  ?.a2.Gval(i),
NEXT

END WITH

#IFNDEF __FB_UNIX__
SLEEP
#ENDIF


Edit:

1) An update with better syntax using PROPERTY is avialable here
2) Code again extended, new example of UDT tree with dynamic arrays (120130)
3) Some text fixed

http://www.freebasic-portal.de/code-beispiele/kleine-helferlein/datenfelder-arrays-mit-variabler-groesse-in-udts-types-208.html
Last edited by TJF on Mar 17, 2013 20:40, edited 4 times in total.
Rens
Posts: 256
Joined: Jul 06, 2005 21:09

Postby Rens » Apr 12, 2011 19:13

Nice, Thanks

I think you have to use:

#IFDEF __FB_WIN32__
SLEEP
#ENDIF

instead of

#IFNDEF __FB_UNIX__
SLEEP
#ENDIF

when running on windows.
TJF
Posts: 3503
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Postby TJF » Apr 13, 2011 5:10

Rens wrote:I think you have to use:

#IFDEF __FB_WIN32__
SLEEP
#ENDIF

What about DOS? I haven't used it yet. Aren't there similar problems?
TJF
Posts: 3503
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: Dynamic arrays in UDTs (once again)

Postby TJF » Jan 30, 2012 8:28

Update available at the german website:

  • no more pre-defining of the types (MKx/CVx replaced by pointers)
  • .v(Index) is used to get or set a new value (PROPERTY)
  • initial values can be set by CONSTRUCTOR, .dim_ and .redim_ (default = NULL bytes)

Download (like in first post):

http://www.freebasic-portal.de/code-beispiele/kleine-helferlein/datenfelder-arrays-mit-variabler-groesse-in-udts-types-208.html

Edit: Typos
Last edited by TJF on Jan 30, 2012 19:49, edited 2 times in total.
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Re: Dynamic arrays in UDTs (once again)

Postby rdc » Jan 30, 2012 16:41

Very impressive work.
TJF
Posts: 3503
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: Dynamic arrays in UDTs (once again)

Postby TJF » Jan 30, 2012 19:47

rdc wrote:Very impressive work.

Thank you!
dafhi
Posts: 1329
Joined: Jun 04, 2005 9:51

Re: Dynamic arrays in UDTs (once again)

Postby dafhi » Jan 30, 2012 21:04

Very nice.
fxm
Posts: 9529
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Dynamic arrays in UDTs (once again)

Postby fxm » Apr 23, 2012 8:45

TJF wrote:FB (0.21.1) cannot handle dynamic arrays in an UDT yet.

Since this is needed often we saw different solutions here, based on pointers. They need to allocate/reallocate memory -- which may be unsave on windows in nested UDT structures (see this post as an example).

Alternativ we can store the data for the dynamic array in a STRING variable. This isn't slow and it's safe even on windows.

Yes, good job.

But Reallocate memory using var-len string functions is very slow with regard to use the 'Reallocate' memory function (+ clear new memory).

A short example which compares these two methods of dynamic memory allocation (on my portable PC, I get a factor 100 with this example):

Code: Select all

Type string_memory
  Declare Function CReallocate (Byval byte_size As Integer) As Any Ptr
  Dim As String S
End Type

Function string_memory.CReallocate (Byval byte_size As Integer) As Any Ptr
  Dim As Integer deltaS = byte_size - Len(This.S)
  If deltaS > 0 Then
    This.S = This.S + String(deltaS, 0)
  ElseIf deltaS < 0 Then
    This.S = Left(This.S, byte_size)
  End If
  Function = Strptr(This.S)
End Function



Function CReallocate(Byval p As Any Ptr, Byval S As Integer) As Any Ptr
  Static Size As Integer
  Dim Pt As Any Ptr
  Pt = Reallocate(p, S)
  If S > Size Then
    Clear Cast(Byte Ptr, pt)[Size], 0, S - size
  End If
  Size = S
  Function = Pt
End Function



Dim bpt As Byte Ptr
Dim sm As string_memory
Dim t As Double

Cls
Color 7
Print "Memory allocation from 1 byte to 128KB, then from 128KB to 0 byte,"
Print " by step of 1 byte:"
Print

Print "- Using the function 'CReallocate()' (function 'Reallocate' + clear new memory)"
Sleep 1000
t = Timer
For K As Integer = 1 To 128 * 1024
  bpt = CReallocate(bpt, k)
Next K
For K As Integer = 128 * 1024 - 1 To 0 Step -1
  bpt = CReallocate(bpt, k)
Next K
Print Timer - t; " seconds"
Print

Print "- Using the member function 'CReallocate()' of the UDT 'string_memory'"
Sleep 1000
t = Timer
For K As Integer = 1 To 128 * 1024
  bpt = sm.CReallocate(K)
Next K
For K As Integer = 128 * 1024 - 1 To 0 Step -1
  bpt = sm.CReallocate(K)
Next K
Print Timer - t; " seconds"
Print

Sleep

Code: Select all

Memory allocation from 1 byte to 128KB, then from 128KB to 0 byte,
 by step of 1 byte:

- Using the function 'CReallocate()' (function 'Reallocate' + clear new memory)
 0.03310029626639865 seconds

- Using the member function 'CReallocate()' of the UDT 'string_memory'
 3.450129555571924 seconds
Last edited by fxm on Apr 23, 2012 18:51, edited 1 time in total.
TJF
Posts: 3503
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: Dynamic arrays in UDTs (once again)

Postby TJF » Apr 23, 2012 9:49

Yes, thanks for testing this. Reallocating STRING memory is slower because fbc moves the STRING to a new position each time (check your bpt variable in the FOR ... NEXT loops).

And the win32 problem is solved. It was due to an overflow, ALLOCATE and REALLOCATE seem to be safe even on win32 (I didn't test it).

But I think I won't change my code. In practical terms nobody changes the array size that often, so this speed difference isn't critical.

On the other hand the STRING solution gives you the oportunity to copy an array without additional code. The inbuild '=' operator for UDTs can be used. Just code

    VAR ArrayB = ArrayA.
fxm
Posts: 9529
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Dynamic arrays in UDTs (once again)

Postby fxm » Apr 24, 2012 10:55

fxm wrote:A short example which compares these two methods of dynamic memory allocation (on my portable PC, I get a factor 100 with this example):
..........

Refering to my new topic in forum 'General':
Memory allocation study for character data of var-len string
and the remarks at the end of the fist post.

- I improved my previous short example, modifying the member function 'string_memory.CReallocate' where the var-len string is passed by reference:
a work around is to swap it with a local string, to inflate the local string, then to swap again with the passed reference.

Code: Select all

Type string_memory
  Declare Function CReallocate (Byval byte_size As Integer) As Any Ptr
  Dim As String S
End Type

Function string_memory.CReallocate (Byval byte_size As Integer) As Any Ptr
  Dim As Integer deltaS = byte_size - Len(This.S)
'  If deltaS > 0 Then
'    This.S = This.S + String(deltaS, 0)
'  ElseIf deltaS < 0 Then
'    This.S = Left(This.S, byte_size)
'  End If
  Dim S0 As String
  Swap This.S, S0
  If deltaS > 0 Then
    S0 = S0 + String(deltaS, 0)
  Elseif deltaS < 0 Then
    S0 = Left(S0, byte_size)
  End If
  Swap S0, This.S
  Function = Strptr(This.S)
End Function



Function CReallocate(Byval p As Any Ptr, Byval S As Integer) As Any Ptr
  Static Size As Integer
  Dim Pt As Any Ptr
  Pt = Reallocate(p, S)
  If S > Size Then
    Clear Cast(Byte Ptr, pt)[Size], 0, S - size
  End If
  Size = S
  Function = Pt
End Function



Dim bpt As Byte Ptr
Dim sm As string_memory
Dim t As Double

Cls
Color 7
Print "Memory allocation from 1 byte to 128KB, then from 128KB to 0 byte,"
Print " by step of 1 byte:"
Print

Print "- Using the function 'CReallocate()' (function 'Reallocate' + clear new memory)"
Sleep 1000
t = Timer
For K As Integer = 1 To 128 * 1024
  bpt = CReallocate(bpt, k)
Next K
For K As Integer = 128 * 1024 - 1 To 0 Step -1
  bpt = CReallocate(bpt, k)
Next K
Print Timer - t; " seconds"
Print

Print "- Using the member function 'CReallocate()' of the UDT 'string_memory'"
Sleep 1000
t = Timer
For K As Integer = 1 To 128 * 1024
  bpt = sm.CReallocate(K)
Next K
For K As Integer = 128 * 1024 - 1 To 0 Step -1
  bpt = sm.CReallocate(K)
Next K
Print Timer - t; " seconds"
Print

Sleep

Code: Select all

Memory allocation from 1 byte to 128KB, then from 128KB to 0 byte,
 by step of 1 byte:

- Using the function 'CReallocate()' (function 'Reallocate' + clear new memory)
 0.03685384595059915 seconds

- Using the member function 'CReallocate()' of the UDT 'string_memory'
 1.776621050999587 seconds
- Now, I get only a factor 50 with regard to use the 'Reallocate' memory function (+ clear new memory), because the inflating phase is optimized using a local var-len string (swap instruction time is negligible because only the descriptors are swapped, and the syntax 'local_string = local_string + String(N - Len(s), 0)' is well optimized by the compiler).
- But the syntax 'local_string = Left(local_string, N)' is always not optimized by the compiler?
TJF
Posts: 3503
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: Memory allocation, var-len string

Postby TJF » Apr 25, 2012 5:09

Neat trick, well found!

Do you know if local strings are limited to the stack size on win32?
fxm
Posts: 9529
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Memory allocation, var-len string

Postby fxm » Apr 25, 2012 7:29

TJF wrote:Neat trick, well found!

Do you know if local strings are limited to the stack size on win32?

There is no problem for a var-len string, because only the descriptor of a local string is put into the stack and not the string's character data (up to 2GB long).
See below a small program to check this:

Code: Select all

Dim As String s1 = "local main string"
Dim Shared As String s2
  s2 = "global main string"
Static As String s3
  s3 = "static main string"

Sub procedure ()
  Dim As String s4 = "local sub string"
  Static As String s5
    s5 = "static sub string"
  Print s4, @s4, Strptr(s4)
  Print s5, @s5, Strptr(s5)
End Sub

Print "String", , "descriptor", "pointer"
Print
Print s1, @s1, Strptr(s1)
Print s2, @s2, Strptr(s2)
Print s3, @s3, Strptr(s3)
procedure()

Sleep

Code: Select all

String                      descriptor    pointer

local main string           1245000       3353952
global main string          4235328       3354000
static main string          4235312       3354048
local sub string            1244964       3354128
static sub string           4235296       3354176
TJF
Posts: 3503
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: Memory allocation, var-len string

Postby TJF » Apr 25, 2012 7:48

fxm wrote:There is no problem for a var-len string, because only the descriptor of a local string is put into the stack and not the string's character data (up to 2GB long).

That's what I assumed. But I wanted to be sure and I cannot test at my office (all win boxes removed).

Thanks for the info.
fxm
Posts: 9529
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Dynamic arrays in UDTs (once again)

Postby fxm » Apr 25, 2012 12:08

fxm wrote:
fxm wrote:I improved my previous short example, modifying the member function 'string_memory.CReallocate' where the var-len string is passed by reference:
a work around is to swap it with a local string, to inflate the local string, then to swap again with the passed reference.
..........

Referring to this post of forum 'General':
viewtopic.php?p=173306#p173306

Code is also added in order to optimize the deflating execution time (with compromise between execution time and memory use) instead of the compiler:

Code: Select all

Type string_memory
  Declare Function CReallocate (Byval byte_size As Integer) As Any Ptr
  Dim As String S
End Type

Function string_memory.CReallocate (Byval byte_size As Integer) As Any Ptr
  Dim As Integer deltaS = byte_size - Len(This.S)
'  If deltaS > 0 Then
'    This.S = This.S + String(deltaS, 0)
'  ElseIf deltaS < 0 Then
'    This.S = Left(This.S, byte_size)
'  End If
  Dim S0 As String
  If deltaS > 0 Then
    Swap This.S, S0
    S0 = S0 + String(deltaS, 0)
    Swap S0, This.S
  Elseif deltaS < 0 Then
'    This.S = Left(This.S, byte_size)
    If Cast(Integer Ptr, @This.S)[2] - byte_size <= (36 + byte_size Shr 3) And byte_size > 0 Then
      Clear This.S[byte_size], 0, Len(This.S) - byte_size
      Cast(Integer Ptr, @This.S)[1] = byte_size
    Else
      This.S = Left(This.S, byte_size)
    End If
  End If
  Function = Strptr(This.S)
End Function



Function CReallocate(Byval p As Any Ptr, Byval S As Integer) As Any Ptr
  Static Size As Integer
  Dim Pt As Any Ptr
  Pt = Reallocate(p, S)
  If S > Size Then
    Clear Cast(Byte Ptr, pt)[Size], 0, S - size
  End If
  Size = S
  Function = Pt
End Function



Dim bpt As Byte Ptr
Dim sm As string_memory
Dim t As Double

Cls
Color 7
Print "Memory allocation from 1 byte to 128KB, then from 128KB to 0 byte,"
Print " by step of 1 byte:"
Print

Print "- Using the function 'CReallocate()' (function 'Reallocate' + clear new memory)"
Sleep 1000
t = Timer
For K As Integer = 1 To 128 * 1024
  bpt = CReallocate(bpt, k)
Next K
For K As Integer = 128 * 1024 - 1 To 0 Step -1
  bpt = CReallocate(bpt, k)
Next K
Print Timer - t; " seconds"
Print

Print "- Using the member function 'CReallocate()' of the UDT 'string_memory'"
Sleep 1000
t = Timer
For K As Integer = 1 To 128 * 1024
  bpt = sm.CReallocate(K)
Next K
For K As Integer = 128 * 1024 - 1 To 0 Step -1
  bpt = sm.CReallocate(K)
Next K
Print Timer - t; " seconds"
Print

Sleep

Code: Select all

Memory allocation from 1 byte to 128KB, then from 128KB to 0 byte,
 by step of 1 byte:

- Using the function 'CReallocate()' (function 'Reallocate' + clear new memory)
 0.03634176969239888 seconds

- Using the member function 'CReallocate()' of the UDT 'string_memory'
 0.1147237986959642 seconds
- Finally, I get now a factor 3 (with this setting of deflating code) with regard to use the 'Reallocate' memory function (+ clear new memory), because the deflating phase is also optimized by adding code accessing directly to descriptor.
- But the previous syntax 'local_string = Left(local_string, N)' is optimized by own code instead of the compiler!
TJF
Posts: 3503
Joined: Dec 06, 2009 22:27
Location: N47°, E15°
Contact:

Re: Dynamic arrays in UDTs (once again)

Postby TJF » Apr 25, 2012 17:24

Two more days and you'll make the STRING solution faster than ALLOCATE ;-)

Return to “Tips and Tricks”

Who is online

Users browsing this forum: MSN [Bot] and 1 guest