Array byRef to a Proc or Func

[Roger Cabo]

Hi everyone, long time ago

When passing an array to a procedure/func it is always ByRef, anyway using by ByVal?
Example:


CalcFromArray()

Proc CalcFromArray
 Local anyInt%(10, 10, 10)
 anyInt%(0, 0, 0) = 1
 CalcDo(anyInt%())
 MsgBox "CalcFromArray" + Str$(anyInt%(0, 0, 0))
EndProc

Proc CalcDo(ByVal anyInt%())
 MsgBox "CalcDo" + Str$(anyInt%(0, 0, 0))
 anyInt%(0, 0, 0) = 99999
EndProc
Another interesting possibility would be:

Dim anyInt1%(10, 10, 10)
Dim anyInt2%(10, 10, 10)

anyInt1%() = anyInt2%()


For sure it's possible by BMove *anyInt2%(), *anyInt1%(), etc...


Dim a%(10, 9, -12 To 0)
Dim b%(10, 9, -12 To 0)
Dim i%, j%, k%

a%(10, 9, -12) = -12

MsgBox "b%(10, 9, -12) = " + Str$(b%(10, 9, -12))

CopyArray(a%(), b%())

MsgBox "b%(10, 9, -12) = " + Str$(b%(10, 9, -12))

Proc CopyArray(source() As Int, dest() As Int) Naked
 
 Local dim1Source%, dim2Source%, dim3Source%
 Local dim1Dest%, dim2Dest%, dim3Dest%
 
 dim1Source% = UBound(source(), 1) - LBound(source(), 1) + 1
 dim2Source% = UBound(source(), 2) - LBound(source(), 2) + 1
 dim3Source% = UBound(source(), 3) - LBound(source(), 3) + 1
 
 dim1Dest% = UBound(dest(), 1) - LBound(dest(), 1) + 1
 dim2Dest% = UBound(dest(), 2) - LBound(dest(), 2) + 1
 dim3Dest% = UBound(dest(), 3) - LBound(dest(), 3) + 1
 
 If (dim1Source% = dim1Dest%) && (dim2Source% = dim2Dest%) && (dim3Source% = dim3Dest%)
   BMove VarPtr(source(LBound(source(), 1), LBound(source(), 2), LBound(source(), 3))), _
     VarPtr(dest(LBound(dest(), 1), LBound(dest(), 2), LBound(dest(), 3))), _
     (dim1Source% * dim2Source% * dim3Source%) * SizeOf(Int)
 Else
   MsgBox "Arrays sind nicht kompatibel für das Kopieren - END"
   End
 EndIf
EndProc

Edit: 17-06-2024
Here is the code that will copy an array to another array.. This can not be used with Strings$


$Library "gfawinx"
$Library "UpdateRT"
UpdateRuntime      ' Patches GfaWin23.Ocx

'Example:

Dim a(20, 20, 20, 20, 20, 20) As Double
Dim b(20, 20, 20, 20, 20, 20) As Double

a(20, 20, 20, 20, 20, 20) = 7.7

Dim t% = oTimer
$StepOff
ArrayCopyAToB(*a(), *b())
t% = oTimer - t%
$StepOn

MsgBox Trim$(ArraySize(a()) / 1000000 &  " MB" &  _
 #13#10 & "Copy in time: " & t% & "ms" & _
 #13#10 & "b(24, 24, 24, 24, 24, 24) should be 7.7  = " & a(20, 20, 20, 20, 20, 20))

Function ArrayCopyAToB(AdrA%, AdrB%) As Int
 Dim _ErrorNR% = 0
 Dim _ErrorSTR$ = ""
 
 Local IndexCountA% = {AdrA% + 12}
 Local IndexCountB% = {AdrB% + 12}
 Local VartypeA% = {AdrA% + 4}
 Local VartypeB% = {AdrB% + 4}
 
 Local LBAs%(5)   // All LBounds A
 Local UBAs%(5)   // All UBounds A
 Local LBBs%(5)   // All LBounds B
 Local UBBs%(5)   // All UBounds B
 
 If (IndexCountA% - IndexCountB%)
   _ErrorSTR$ = "ArrayCopyAToB: Error, both arrays contain a different index count!"
   _ErrorNR% = -1
   MsgBox _ErrorSTR$
   Return _ErrorNR%
 Else If AdrA% = AdrB%
   _ErrorSTR$ = "ArrayCopyAToB: Error, admint two different arrays!"
   _ErrorNR% = -2
   MsgBox _ErrorSTR$
   Return _ErrorNR%
 Else If ({AdrA% + 4} - {AdrB% + 4}) != 0           // varType (internal const)
   _ErrorSTR$ = "ArrayCopyAToB: Error, both of the same VarTypes are required!"
   _ErrorNR% = -3
   MsgBox _ErrorSTR$
   Return _ErrorNR%
 Else If {AdrB% + 4} = 72                        // No String Type (72 Internal Const) possible
   _ErrorSTR$ = "ArrayCopyAToB: Error, both of the same VarTypes are required!"
   _ErrorNR% = -3
   MsgBox _ErrorSTR$
   Return _ErrorNR%
 Else
   // Get U/A Bounds of all dimensions
   Local i As Register Int
   Local o As Register Int
   o = (i * 4) + $28                   // Start at $28
   
   For i = 0 To IndexCountA% - 1
     LBAs%(i) = {AdrA% + o}
     LBBs%(i) = {AdrB% + o}
     Add o, 4
     UBAs%(i) = {AdrA% + o}
     UBBs%(i) = {AdrB% + o}
     Add o, 8                          // Unknown +4 bytes
   Next i
 EndIf
 
 For i = 0 To IndexCountA% - 1
   If (LBAs%(i) != LBBs%(i)) || (UBAs%(i) != UBBs%(i))
     _ErrorSTR$ = "ArrayCopyAToB: Any array has different dimensions!"
     MsgBox _ErrorSTR$
     Return -4
   EndIf
 Next i
 
 // Copy from A to B
 BMove {AdrA% + 20}, {AdrB% + 20}, {AdrB% + 36}
 Return 0
EndFunc

[dragonjim]

Apparently, one of the reasons why Arrays can only be passed ByRef in GB33 (regardless of what you specify) is the processing and data overheads that a ByVal transfer would imply (think 1998, limited RAM and slow processors).

A nice solution to the problem.

[dragonjim]

A few ideas for improvements, maybe?

1. Use IndexCount and Dim? to do quick checks on the two arrays
2. OR get round the problem of incompatible arrays by simply ReDim-ing the destination array to suit the source
3. Use arrays to store the LBound and UBound values of each Index, so that different sized multi-dimensional/index arrays can be processed.

Sadly, I'm not near a computer with GB32 at the moment, otherwise I would have a go myself...

[Roger Cabo]

Jun 14, 2024 22:34:40 GMT 1 dragonjim said:

A few ideas for improvements, maybe?

1. Use IndexCount and Dim? to do quick checks on the two arrays
2. OR get round the problem of incompatible arrays by simply ReDim-ing the destination array to suit the source
3. Use arrays to store the LBound and UBound values of each Index, so that different sized multi-dimensional/index arrays can be processed.

Sadly, I'm not near a computer with GB32 at the moment, otherwise I would have a go myself...

Hmm it's not that trivial as it seems..
If we use IndexCount, in this case we got 3.

But how you will quantify the single dimensions later because of the syntax check?
I think we must separate the IndexCount to approx 6 or anything. Then running though a Select.

Select ArrayIndexCount%
Case 1
    if typeof(source(n1)) != typeof(dest(n1)) then Error
    ....
Case 2
    if typeof(source(n1, n2)) != typeof(dest(n1, n2)) then Error
    ....
Case 3
    if typeof(source(n1, n2, n3)) != typeof(dest(n1, n2, n3)) then Error
    ....
EndSelect

etc

or I'm completely wrong?

------

Currently types working excellent in this case!

Type Test
 a As Int
EndType

Type Test
 a As Double
EndType

Dim Test1 As Test
Dim Test2 As Test

Test1.a = 99
Test2 = Test1

MsgBox Test2.a



Anyway the ArrayCopy would be gorgeous because of speed and usability..
I'm working on a simple AI test image project, to see how all the stuff should be me managed.

[dragonjim]

Hi Roger,

Try out the routine below; it should work but I have not had time to test it and there are two variables in the Array Pointer of which I am unsure of their purpose.

Procedure ArrayCopyInt(ByRef a() As Int, ByRef b() As Int)
 Local Int n, newmem, ptr
 If IndexCount(a()) > 6 Then Message "ArrayCopyInt can only handle up to 6 indexes" : Exit Procedure
 // Resize b() to handle up to 6 indexes; this forces GFA to resize the Array Pointer record
 ReDim b(1, 1, 1, 1, 1, 1)
 // Create the data store for b() and copy the values from a()
 newmem = mAlloc(ArraySize(a()))
 BMove LPeek(*a() + 20), newmem, ArraySize(a())
 // Set the rest of the values for b()
 LPoke *b() + 12, IndexCount(a())
 LPoke *b() + 16, IndexCount(a())
 LPoke *b() + 20, newmem
 LPoke *b() + 28, newmem
 LPoke *b() + 32, LPeek(*a() + 32)     // Dim?()
 LPoke *b() + 36, LPeek(*a() + 36)     // ArraySize
 ptr = *b() + 40
 // Create the individual indexes
 For n = 1 To IndexCount(a())
   LPoke ptr, LBound(a(), n) : LPoke ptr + 4, UBound(a(), n) : Add ptr, 12
 Next n
EndProcedure

[Roger Cabo]

Seems Gb32 can't handle receiving different var types in procedure parameters.
Hmm...

Means for every different var type like Int, Double, etc, we have to build a different proc/func.
Or we use a pointer to the array descriptor like:

Eg:


Dim a(-1 To 77, -1 To 77, -1 To 77) As Int
Dim b(64, 64, 64) As Int

ArrayCopyAToB(*a(), *b())


Procedure ArrayCopyAToB(AdrA%, AdrB%)

 Debug.OnTop
 Debug.Show

 Local IndexCountA% = {AdrA% + 12}
 Local IndexCountB% = {AdrB% + 16}
 
 Dim i%
 Debug.OnTop
 Debug.Show
 For i% = 0 To $48 Step 4
   'Debug.Print Byte{AdrA% + i%} & Byte{AdrA% + i% + 1} & Byte{AdrA% + i% + 2} & Byte{AdrA% + i% + 3}
   Debug.Print "Offs: $" & Hex$(i%) & "    " & Byte{AdrA% + i%} & Byte{AdrA% + i% + 1} & Byte{AdrA% + i% + 2} & Byte{AdrA% + i% + 3}
 Next i%
 
 Stop
 


Result:

Offs: $0      89 114 114 65
Offs: $4      24 0 0 0 // vtType (internal const)
Offs: $8      4 0 0 0
Offs: $C      3 0 0 0
Offs: $10     3 0 0 0
Offs: $14     32 144 160 7
Offs: $18     79 231 255 255
Offs: $1C     228 242 160 7
Offs: $20     239 133 7 0
Offs: $24     188 23 30 0
Offs: $28     255 255 255 255          // LBound -1 dim 1
Offs: $2C     77 0 0 0                 // UBound 77
Offs: $30     1 0 0 0                  // ?
Offs: $34     255 255 255 255          // LBound -1 dim 2
Offs: $38     77 0 0 0                 // UBound 77
Offs: $3C     79 0 0 0                 // ?
Offs: $40     255 255 255 255          // LBound -1 dim 3
Offs: $44     77 0 0 0                 // UBound 77
Offs: $48     97 24 0 0                // ?



{$C} represents the length of the descriptor as well. in this case 3 * (INT * 3) for the upper and lower dimensions
{$C} = 10 then the descriptor seems to be 10 * (INT * 3)

Should be the easiest way to prevent 10th of different procedures for each variable type.

I have read through gfabasic32.blogspot.com/2017/08/a-little-array-magic.html
and it seems to be a difference between local and global arrays...  but step by step

[dragonjim]

Exactly my idea.

Below is a routine which will not just copy two arrays of different types, it can copy between different numeric variable types.

$Library "gfawinx"
$Library "UpdateRT"
UpdateRuntime      ' Patches GfaWin23.Ocx
Local Int a(2, 2), b(1, 1)
Local Single c(2, 2) : ArrayFill c(), 3
Local Double d(3, 6) : ArrayFill d(), Now
Local Large e(4, 4) : ArrayFill e(), 33331286
°Local Int f(3, 3, 1 To 2, 2)
°Trace HexDump(ArrPtr(f()), 88)
°End
ArrayFill a(), 2
ArrayCopy(ArrPtr(a()), ArrPtr(b()))
ArrayPrint(b())
ArrayCopy(ArrPtr(c()), ArrPtr(b()))
ArrayPrint(b())
ArrayCopy(ArrPtr(d()), ArrPtr(b()))
ArrayCopy(ArrPtr(e()), ArrPtr(d()))
ArrayPrint(b())
ArrayPrint(a())
Trace HexDump(ArrPtr(e()), 64)
°ArrayCopy(ArrPtr(d()), ArrPtr(e()))
°Trace UBound(e(), 1) : Trace UBound(e(), 2)
°Trace HexDump(ArrPtr(e()), 64)
ArrayPrintd(d())
Function  ArrayCopy(Aptr%, Bptr%)
 Local Const ARRAYCOPY_BYTE = $34, ARRAYCOPY_CARD = $30, ARRAYCOPY_CURRENCY = $28, ARRAYCOPY_DATE = $50, ARRAYCOPY_DOUBLE = $1C, _
   ARRAYCOPY_LARGE = $24, ARRAYCOPY_LONG = $18, ARRAYCOPY_SINGLE = $20, ARRAYCOPY_WORD = $2C
 Local datasizeB%, dims%, icount%, newmemB%, n%, ptrA%, ptrB%, sizeB%, v As Large, v#, v!, v@, vartypeA%, vartypeB%, vtypB%
 // Set variables
 icount% = LPeek(Aptr% + 12) : vartypeA% = LPeek(Aptr% + 4) : vartypeB% = LPeek(Bptr% + 4)
 // Check IndexCount
 If icount% = 0 Then Message "Array needs to be redimensioned before being copied" : Return -1
 If icount% <> LPeek(Bptr% + 12) Then Message("The number of indexes in both array must be the same") : Return -1
 // Calculate arraysize and indexcount
 datasizeB% = LPeek(Bptr% + 8)
 icount% = LPeek(Aptr% + 12)
 dims% = LPeek(Aptr% + 32)
 sizeB% = dims% * datasizeB%
 Trace sizeB%
 // Clear old memory block in Array B and create the new one
 If LPeek(Bptr% + 20) <> 0 Then ~mFree(LPeek(Bptr% + 20))
 newmemB% = mAlloc(sizeB%)
 // Populate the main array properties
 LPoke Bptr% + 12, icount%
 LPoke Bptr% + 16, icount%
 LPoke Bptr% + 20, newmemB%
 LPoke Bptr% + 28, newmemB%
 LPoke Bptr% + 32, dims%
 LPoke Bptr% + 36, sizeB%
 // Create the individual indexes
 ptrA% = Aptr% + 40 : ptrB% = Bptr% + 40
 For n% = 1 To icount%
   BMove ptrA%, ptrB%, 12 : Add ptrA%, 12 : Add ptrB%, 12
 Next n%
 // Copy across array data
 If vartypeA% = vartypeB%
   BMove LPeek(Aptr% + 20), newmemB%, sizeB%
 Else
   ptrA% = LPeek(Aptr% + 20) : ptrB% = newmemB%
   Select vartypeA%
   Case ARRAYCOPY_DATE, ARRAYCOPY_DOUBLE
     vtypB% = 2
   Case ARRAYCOPY_SINGLE
     vtypB% = 3
   Case ARRAYCOPY_CURRENCY
     vtypB% = 4
   Otherwise
     vtypB% = 1
   EndSelect
   For n% = 1 To dims%
     Select vartypeA%
     Case ARRAYCOPY_BYTE
       v = Peek(ptrA%) : Inc ptrA%
     Case ARRAYCOPY_CARD
       v = CPeek(ptrA%) : Add ptrA%, 2
     Case ARRAYCOPY_WORD
       v = DPeek(ptrA%) : Add ptrA%, 2
     Case ARRAYCOPY_LONG
       v = LPeek(ptrA%) : Add ptrA%, 4
     Case ARRAYCOPY_SINGLE
       v! = SngPeek(ptrA%) : Add ptrA%, 4
     Case ARRAYCOPY_LARGE
       v = Peek8(ptrA%) : Add ptrA%, 8
     Case ARRAYCOPY_DOUBLE
       v# = DblPeek(ptrA%) : Add ptrA%, 8
     Case ARRAYCOPY_DATE
       v# = DblPeek(ptrA%) : Add ptrA%, 8
     Case ARRAYCOPY_CURRENCY
       v@ = CurPeek(ptrA%) : Add ptrA%, 8
     EndSelect
     Select vartypeB%
     Case ARRAYCOPY_BYTE
       Poke ptrB%, CByte(Choose(vtypB%, v, v#, v!, v@)) : Inc ptrB%
     Case ARRAYCOPY_CARD
       CPoke ptrB%, CShort(Choose(vtypB%, v, v#, v!, v@)) : Add ptrB%, 2
     Case ARRAYCOPY_WORD
       DPoke ptrB%, CShort(Choose(vtypB%, v, v#, v!, v@)) : Add ptrB%, 2
     Case ARRAYCOPY_LONG
       LPoke ptrB%, CLong(Choose(vtypB%, v, v#, v!, v@)) : Add ptrB%, 4
     Case ARRAYCOPY_SINGLE
       SngPoke ptrB%, CSng(Choose(vtypB%, v, v#, v!, v@)) : Add ptrB%, 4
     Case ARRAYCOPY_LARGE
       Poke8 ptrB%, CLarge(Choose(vtypB%, v, v#, v!, v@)) : Add ptrB%, 8
     Case ARRAYCOPY_DOUBLE
       DblPoke ptrB%, CDbl(Choose(vtypB%, v, v#, v!, v@)) : Add ptrB%, 8
     Case ARRAYCOPY_DATE
       DblPoke ptrB%, CDate(Choose(vtypB%, v, v#, v!, v@)) : Add ptrB%, 8
     Case ARRAYCOPY_CURRENCY
       CurPoke ptrB%, CCur(Choose(vtypB%, v, v#, v!, v@)) : Add ptrB%, 8
     EndSelect
   Next n%
 EndIf
EndFunction
Procedure ArrayPrintd(ByRef a() As Double)
 Local Int m, n
 For n = LBound(a(), 1) To UBound(a(), 1)
   For m = LBound(a(), 2) To UBound(a(), 2)
     Debug.Print a(n, m);" ";
   Next m
   Debug.Print
 Next n
 Debug.Show
EndProcedure
Procedure ArrayPrint(ByRef a() As Int)
 Local Int m, n
 For n = LBound(a(), 1) To UBound(a(), 1)
   For m = LBound(a(), 2) To UBound(a(), 2)
     Debug.Print a(n, m);" ";
   Next m
   Debug.Print
 Next n
 Debug.Show
EndProcedure

A word of caution, though. If you amend the code above and there is an error, GB32 can destabilise and freeze.

If this happens, close GB32, reopen again, correct the erroneous code and all should be OK.

[dragonjim]

However, to be honest, it is far simpler to do the following:

1. ReDim the destination to match the source
2. Copy the data from one array to the other.

As in the example below:

Local Single a(4, 4), b(1)
ArrayFill a(), 10
ReDim b(4, 4)
Mat Print b()
BMove LPeek(ArrPtr(a()) + 20), LPeek(ArrPtr(b()) + 20), LPeek(ArrPtr(a()) + 36)
Mat Print b()

The line...

BMove LPeek(ArrPtr(a()) + 20), LPeek(ArrPtr(b()) + 20), LPeek(ArrPtr(a()) + 36)

...will work for all non-string variable types as long as the arrays and variable types are the same.

Plus, the other advantage is that, as you are not changing memory addresses in the second array - it is all being done internally by GB32 - the resulting code will be stable.

[dragonjim]

Just for information, the Array structure for all variable types is:

Bytes  
1  -  4     The letters Arry signifying an array record
5  -  8     The variable type
9  - 12     The size of each individual data record  
13 - 16     The number of indexes (= IndexCount)
17 - 20     The same as 13 - 16
21 - 24     The address of the datablock (= ArrayAddr)
25 - 28     Unknown
29 - 32     The same as 21 - 24 (But not always the same value.  If this is omitted then no value is returned)
33 - 36     The total number of elements (= Dim?)
37 - 40     The total size of the datablock (= ArraySize)
41 onwards  A block of 12 bytes describing each index as follows:

1  -  4     The Lower Bound of the index (= LBound)
5  -  8     The Upper Bound of the index (= UBound)
9  - 12     The gap between elements in each index*

*The first index always has a value of 1; the second, the number of elements in the first index; the third is the number of elements in the first index multiplied by the number in the second; the fourth is the last value multiplied by the number of elements in the third index; and so on. So a(2,3,4,2) will give values of 1, 3, 12 and 60.

GB32 stores arrays iterating the first index first, then the second, then the third and so on.

So the elements for a(2,1,4) as stored a(0,0,0), a(1,0,0), a(2,0,0), a(0,1,0), a(1,1,0), a(2,1,0), a(0,0,1), a(0,0,2), etc.

This can be seen using the following code:

Dim a(2, 4, 5, 6) As Byte : Local k%, l%, m%, n%
Debug HexDump(ArrPtr(a()) + 40, 48)
For n% = 0 To 2
 For m% = 0 To 4
   For l% = 0 To 5
     For k% = 0 To 6
       a(n%, m%, l%, k%) = m%
     Next k%
   Next l%
 Next m%
Next n%
Debug HexDump(ArrayAddr(a()), ArraySize(a())
Unfortunately, this means that ReDim-ing an array leads to some very odd results:

Dim a(2, 2) As Single
Local ct%, m%, n%
For n% = 0 To 2
 For m% = 0 To 2
   a(n%, m%) = ct% : Inc ct%
 Next m%
Next n%
Mat Print a()
ReDim a(3, 3)
Mat Print a()
...prints this:

0,1,2
3,4,5
6,7,8

0,4,8,0
3,7,0,0
6,2,0,0
1,5,0,0
So maybe the challenge is to write a ReDim that works for arrays with more than one index...

[dragonjim]

...and here is a routine that should work with all variable types including variable-length strings...

ReDimX (arraypointer, dataaddress, index1 [, index2, ...])

arraypointer     - This is the pointer to the array that is about to be ReDim-ed
daataddress     - The address of the sorted datablock for when the array is ReDim-ed
index1, index2 - The new indexes either as a number or a string; if a number is passed then the index is assumed to run from 0 or 1 (depending on Option Base) to the number passed; if a string, it should be in the format 'LBound To UBound'.  There is no limit to the number of indexes you can pass.

A basic example is:

Dim a(3, 3, 3) as Int16, addr%
RedimX(Arrptr(a()), addr%, 4, "2 To 4")
Redim a(4, 2 To 4)
BMove addr%, ArrayAddr(a()), ArraySize(a())
~mFree(addr%)
The routine is listed below with a more extensive example

$Library "gfawinx"
$Library "UpdateRT"
UpdateRuntime      ' Patches GfaWin23.Ocx

Local a(2, 3, 4) As Variant, ct%, l%, m%, n%
Local b(2, 3, 4) As Variant

For n% = 0 To 4
 For m% = 0 To 3
   For l% = 0 To 2
     a(l%, m%, n%) = "Item " & ct%
     Inc ct%
   Next l%
 Next m%
Next n%
BMove LPeek(ArrPtr(a()) + 20), LPeek(ArrPtr(b()) + 20), LPeek(ArrPtr(a()) + 36)
Local addr% : RedimX(ArrPtr(a()), addr%, 4, "1 to 4")
Trace addr%
ReDim a(4, 1 To 4)
BMove addr%, ArrayAddr(a()), ArraySize(a())
~mFree(addr%)
For n% = 0 To 4
 For m% = 0 To 4
   Debug n%,m%,
   If (n% >= LBound(a(), 1) && n% <= UBound(a(), 1)) && (m% >= LBound(a(), 2) && m% <= UBound(a(), 2)) : Debug a(n%, m%),
   Else : Debug "-----",
   EndIf
   If n% <= UBound(b(), 1) && m% <= UBound(b(), 2) : Debug b(n%, m%, 0)
   Else : Debug "-----"
   EndIf
 Next m%
Next n%
Debug.Show

Procedure RedimX(Ptr%, ByRef addr%, ParamArray p())
 Local a$, acc%, baddr%, chkelem?, ct%, n%, icountB%, lastinc%, maxindex%, p1%, taddr%, relational?, sizeB%
 // Create and load in Array details
 Local ArrA As ARRAY : BMove Ptr%, V:ArrA, SizeOf(ARRAY)
 Local IndexA(1 To ArrA.IndexCount) As INDEX : BMove Ptr% + 40, V:IndexA(1), (SizeOf(INDEX) * ArrA.IndexCount)
 // Create array with which to cycle through the Indexes and Elements
 Local indexesA(1 To ArrA.IndexCount)
 For n% = 1 To ArrA.IndexCount : indexesA(n%) = IndexA(n%).LBound : Next n%
 Dec indexesA(1)
 // Create the basis for the ReDim-ed array, starting with IndexCount and Indexes
 icountB% = Dim?(p())
 Local indexB(1 To icountB%) As INDEX
 acc% = 1 : lastinc% = 1
 For n% = 1 To icountB%
   If IsNumeric(p(n% - 1))
     indexB(n%).LBound = OptionBase
     indexB(n%).UBound = p(n% - 1)
   Else
     a$ = Trim(p(n% - 1))
     p1% = InStr(a$, " TO ", 0, 1)
     If p1% = 0 Then Message "Indexes must be sent as either numbers or in the form 'lb TO ub'." : End
     indexB(n%).LBound = Val(Left(a$, p1%))
     indexB(n%).UBound = Val(Mid(a$, p1% + 4))
     If indexB(n%).LBound > indexB(n%).UBound Then Message "LBound must be lower than UBound." : End
   EndIf
   acc% = acc% * lastinc%
   indexB(n%).Increment = acc%
   lastinc% = indexB(n%).UBound - indexB(n%).LBound + 1
 Next n%
 // Work out the new ArraySize and create the new memory block
 sizeB% = (indexB(icountB%).Increment * (indexB(icountB%).UBound - indexB(icountB%).LBound + 1)) * ArrA.DataSize
 addr% = mAlloc(sizeB%) : MemZero addr%, sizeB%
 // Determine the number of indexes to process
 maxindex% = Min(ArrA.IndexCount, icountB%)
 taddr% = ArrA.ArrayAddr
 // Process the elements
 While indexesA(maxindex%) <= IndexA(maxindex%).UBound
   ct% = 1                                                                                     // Aleays start on the 1st Index
   Inc indexesA(ct%)                                                                           // ...and increment
   While indexesA(ct%) > IndexA(ct%).UBound && indexesA(maxindex%) <= IndexA(maxindex%).UBound // If exceeds UBound...
     indexesA(ct%) = IndexA(ct%).LBound                                                        // ...reset the index count
     Inc ct%                                                                                   // ...move to the next Index
     Inc indexesA(ct%)                                                                         // ...and increment
   Wend                                                                                        // ...and do again if this exceeds UBound
   If indexesA(maxindex%) <= IndexA(maxindex%).UBound                                          // If not at end of process
     chkelem? = False                                                                          // ...reset copy flag
     For n% = 1 To Min(UBound(indexB()), UBound(indexesA()))                                   // ...check to see if index is present...
       If indexesA(n%) >= indexB(n%).LBound && indexesA(n%) <= indexB(n%).UBound               // ...in the new array configuration...
         chkelem? = True                                                                       // ...and, if so, set copy flag to true
         Exit For
       EndIf
     Next n%
     If chkelem?                                                                               // If element to be copied
       baddr% = addr%                                                                          // ...work out the address of the relative...
       For n% = 1 To Min(UBound(indexB()), UBound(indexesA()))                                 // ...element in the new array configuration
         baddr% = baddr% + (((indexesA(n%) - indexB(n%).LBound) * indexB(n%).Increment) * ArrA.DataSize)
       Next n%
       BMove taddr%, baddr%, ArrA.DataSize                                                     // ...and trasnfer the data value
     EndIf
     Add taddr%, ArrA.DataSize                                                                 // Increase the data address of the original array
   EndIf
 Wend
 Type ARRAY
   Descriptor As String*4
   - Int32 VarType
   - Int32 DataSize
   - Int32 IndexCount
   - Int32 IndexCount2
   - Int32 ArrayAddr
   - Int32 Unknown
   - Int32 ArrayAddr2
   - Int32 Elements
   - Int32 ArraySize
 EndType
 Type INDEX
   - Int32 LBound
   - Int32 UBound
   - Int32 Increment
 EndType
EndProcedure
Function OptionBase
 Local a(1)
 Return LBound(a())
EndFunction


[Roger Cabo]

I done this in a different way and currently for easy use and strictly as array to array copy.
Here is a small example.. No strings possible to copy.. only numeric data arrays.

It does not check for max 6 dimensions currently, because gb32 doesn't like it to use more than 6.


Fixed:
Local IndexCountB% = {AdrB% + 12}
instead of
Local IndexCountB% = {AdrB% + 16}

$Library "gfawinx"
$Library "UpdateRT"
UpdateRuntime      ' Patches GfaWin23.Ocx

Dim a(20, 20, 20, 20, 20, 20) As Double
Dim b(20, 20, 20, 20, 20, 20) As Double

a(20, 20, 20, 20, 20, 20) = 7.7

Dim t% = oTimer
$StepOff
ArrayCopyAToB(*a(), *b())
t% = oTimer - t%
$StepOn

MsgBox Trim$(ArraySize(a()) / 1000000 &  " MB" &  _
 #13#10 & "Copy in time: " & t% & "ms" & _
 #13#10 & "b(24, 24, 24, 24, 24, 24) should be 7.7  = " & a(20, 20, 20, 20, 20, 20))

Function ArrayCopyAToB(AdrA%, AdrB%) As Int
 Dim _ErrorNR% = 0
 Dim _ErrorSTR$ = ""
 
 Local IndexCountA% = {AdrA% + 12}
 Local IndexCountB% = {AdrB% + 12}
 Local VartypeA% = {AdrA% + 4}
 Local VartypeB% = {AdrB% + 4}
 
 Local LBAs%(5)   // All LBounds A
 Local UBAs%(5)   // All UBounds A
 Local LBBs%(5)   // All LBounds B
 Local UBBs%(5)   // All UBounds B
 
 If (IndexCountA% - IndexCountB%)
   _ErrorSTR$ = "ArrayCopyAToB: Error, both arrays contain a different index count!"
   _ErrorNR% = -1
   MsgBox _ErrorSTR$
   Return _ErrorNR%
 Else If AdrA% = AdrB%
   _ErrorSTR$ = "ArrayCopyAToB: Error, admint two different arrays!"
   _ErrorNR% = -2
   MsgBox _ErrorSTR$
   Return _ErrorNR%
 Else If ({AdrA% + 4} - {AdrB% + 4}) != 0           // varType (internal const)
   _ErrorSTR$ = "ArrayCopyAToB: Error, both of the same VarTypes are required!"
   _ErrorNR% = -3
   MsgBox _ErrorSTR$
   Return _ErrorNR%
 Else If {AdrB% + 4} = 72                        // No String Type (72 Internal Const) possible
   _ErrorSTR$ = "ArrayCopyAToB: Error, both of the same VarTypes are required!"
   _ErrorNR% = -3
   MsgBox _ErrorSTR$
   Return _ErrorNR%
 Else
   // Get U/A Bounds of all dimensions
   Local i As Register Int
   Local o As Register Int
   o = (i * 4) + $28                   // Start at $28
   
   For i = 0 To IndexCountA% - 1
     LBAs%(i) = {AdrA% + o}
     LBBs%(i) = {AdrB% + o}
     Add o, 4
     UBAs%(i) = {AdrA% + o}
     UBBs%(i) = {AdrB% + o}
     Add o, 8                          // Unknown +4 bytes
   Next i
 EndIf
 
 For i = 0 To IndexCountA% - 1
   If (LBAs%(i) != LBBs%(i)) || (UBAs%(i) != UBBs%(i))
     _ErrorSTR$ = "ArrayCopyAToB: Any array has different dimensions!"
     MsgBox _ErrorSTR$
     Return -4
   EndIf
 Next i
 
 // Copy from A to B
 BMove {AdrA% + 20}, {AdrB% + 20}, {AdrB% + 36}
 Return 0
EndFunc

I will implement your great example step by step.. it's a cool idea to have the ability to copy different numerical types as well!
Really well done!

[dragonjim]

Nice code and I like the thorough checks.

Copying a string array (variable length not fixed) is very complex, needing many new memory blocks to be created, with all the fun that brings.
From experience, I would suggest simply creating a loop and copy each element one at a time - e.g. a$(1,1) = b$(1,1) - and let GB32 do the heavy lifting.

I have got code somewhere which copies a string array into a string array-like structure; when I am near my old computer, I will dig it out. From memory, it is not a great deal faster than creating a loop and copying the old-fashioned way.

EDIT: On second thoughts, you can only copy the old fashioned way if you know the number of indexes, so ignore the above. I will dig out the old code - it only copied a single index across as the array-like structure was a dynamic array which you could increase or decrease as you wish; however, it will be useful from the data structure perspective.