Simple adding of bulk data to array/list

[Danilo]

is there a way to initialize array as in C?
[...]
is there some elegant way such as:

Code: Select all

 Fa() = {361, 575, 922, 525, 176, 586, 640, 321, 536, 742, 677, 742, 687, 284, 193, 517, 273, 494, 263, 147, 593, 800, 571, 320, 803, 133, 231, 390, 685, 330, 63, 410}

Code: Select all

;=================================
;
; works with types a,b,c,w,u,l,i,q,f,d,s
;
Macro SetTypeSizes(_type_,_name_) : #__#_type_#__size = SizeOf(_name_) : EndMacro

SetTypeSizes(a,Ascii) : SetTypeSizes(b,Byte)    : SetTypeSizes(w,Word) : SetTypeSizes(u,Unicode)
SetTypeSizes(l,Long)  : SetTypeSizes(i,Integer) : SetTypeSizes(q,Quad) : SetTypeSizes(f,Float)
SetTypeSizes(d,Double): SetTypeSizes(s,String)  : SetTypeSizes(c,Character)

Macro CreateArray(_name_,_type_)
    Dim _name_._type_( (?__CreateArray__End__Label_#MacroExpandedCount - ?__CreateArray__Start__Label_#MacroExpandedCount) / #__#_type_#__size )
    Define __CreateArray__loop__#MacroExpandedCount
    Restore __CreateArray__Start__Label_#MacroExpandedCount
    For __CreateArray__loop__#MacroExpandedCount = 0 To ArraySize(_name_()) - 1
        Read._type_ _name_( __CreateArray__loop__#MacroExpandedCount )
    Next
    DataSection : __CreateArray__Start__Label_#MacroExpandedCount: : Data._type_
EndMacro

Macro EndCreateArray(_name_)
    : __CreateArray__End__Label_#MacroExpandedCount: : EndDataSection
EndMacro

;---------------------------------

CreateArray(Fa,i) 361, 575, 922, 525, 176, 586, 640, 321, 536, 742, 677,
                  742, 687, 284, 193, 517, 273, 494, 263, 147, 593, 800,
                  571, 320, 803, 133, 231, 390, 685, 330,  63, 410
                  EndCreateArray(Fa)
                  
Debug ArraySize( Fa() )
Debug "-----"
                  
For i = 0 To ArraySize( Fa() ) - 1
    Debug Fa(i)
Next

Debug "================================="

CreateArray(theStrings,s) "abc", "def", "ghi", "jkl" EndCreateArray(theStrings)

For i = 0 To ArraySize( theStrings() ) - 1
    Debug theStrings(i)
Next

Wilbert's way:

Code: Select all

EnableExplicit

Macro Arr(_type_)
    ?__Arr__Label_#MacroExpandedCount
    DataSection : __Arr__Label_#MacroExpandedCount: : Data._type_
EndMacro

Macro EndArr()
    : EndDataSection
EndMacro

;---------------------------------

Macro DefMemArray(_type_,_name_) : Structure _name_#Array : _type_._type_[0] : EndStructure : EndMacro

DefMemArray(a,Ascii) : DefMemArray(b,Byte)      : DefMemArray(w,Word)   : DefMemArray(u,Unicode)
DefMemArray(l,Long)  : DefMemArray(i,Integer)   : DefMemArray(q,Quad)   : DefMemArray(f,Float)
DefMemArray(d,Double): DefMemArray(c,Character) : DefMemArray(s,String)

Define i, *p.IntegerArray

*p = Arr(i) 361, 575, 922, 525, 176, 586, 640, 321, 536, 742, 677,
            742, 687, 284, 193, 517, 273, 494, 263, 147, 593, 800,
            571, 320, 803, 133, 231, 390, 685, 330,  63, 410
            EndArr()
            
For i = 0 To 31
    Debug *p\i[i]
Next

Debug "================================="

Define *b.ByteArray = Arr(b) 1,2,3,4,5,6,7,8,9,10 EndArr()

For i = 0 To 9
    Debug *b\b[i]
Next

Debug "================================="

; String pointers
Define *s.StringArray = Arr(i) @"abc", @"def", @"ghi", @"jkl" EndArr()

For i = 0 To 3
    Debug *s\s[i]
Next

Using CopyMemory():

Code: Select all

;=================================
;
; Using CopyMemory, does not work with strings
;
Macro CreateArray(_name_,_type_)
    Dim _name_._type_(1)
    ReDim _name_._type_( (?__CreateArray__End__Label_#MacroExpandedCount - ?__CreateArray__Start__Label_#MacroExpandedCount) / (@_name_(1)-@_name_(0)) )
    Debug "CreateArray"
    CopyMemory(?__CreateArray__Start__Label_#MacroExpandedCount, @_name_(0), (ArraySize(_name_()))*(@_name_(1)-@_name_(0)))
    DataSection : __CreateArray__Start__Label_#MacroExpandedCount: : Data._type_
EndMacro

Macro EndCreateArray(_name_)
    : __CreateArray__End__Label_#MacroExpandedCount: : EndDataSection
EndMacro

;---------------------------------

CreateArray(Fa,i) 361, 575, 922, 525, 176, 586, 640, 321, 536, 742, 677,
                  742, 687, 284, 193, 517, 273, 494, 263, 147, 593, 800,
                  571, 320, 803, 133, 231, 390, 685, 330,  63, 410
                  EndCreateArray(Fa)
                  
Debug ArraySize( Fa() )
Debug "-----"

For i = 0 To ArraySize( Fa() ) - 1
    Debug Fa(i)
Next

[Fred]

That's some fancy macros going on here

[bbanelli]

@Danilo and rest of the guys

Thanks, this looks fantastic. I will run some benchmarks to see if there are measurable differences for my data sets.

Reporting back in few hours time.

Thanks to all once again (that's why I asked Fred for "thumbs-up" system )!

With my best,

Bruno

[Tenaja]

That's some fancy macros going on here

Hmmm...maybe someone could build this feature in natively. It has to be on the top ten list of requests...

[Tenaja]

Maybe the easiest way is not to use a PureBasic array but to do it like this ...

Code: Select all

Structure QuadArray
  q.q[0]
EndStructure

DataSection
  Array1Data:
  Data.q 1, 2, 3, 4, 5, 6, 7
  Array2Data:
  Data.q 1000, 2000, 3000, 4000, 5000, 6000, 7000
EndDataSection

*Array1.QuadArray = ?Array1Data
*Array2.QuadArray = ?Array2Data

Debug *Array1\q[2] + *Array2\q[4]

Wilbert, that is the one I was looking for, but could not find. It was the most efficient until I refined it. I took the PB code output from an actual array and cut out 3 more instructions from your version:

Code: Select all

Structure QuadArray	; Note: Use for 64-bit Ints or for Quads
	q.q[0]
EndStructure
Structure IntArray		; NOTE: Use for 32-bit ints or 64-bit Longs.
	q.i[0]
EndStructure

DataSection
	Array1Data:
	Data.i 1, 2, 3, 4, 5, 6, 7
	Array2Data:
	Data.i 1000, 2000, 3000, 4000, 5000, 6000, 7000
EndDataSection

; Initiliazation:
*Array1.IntArray = ?Array1Data
*Array2.IntArray = ?Array2Data



; ; x = Arr(num)
Macro ArrToX(Arr, num, x)
	; Setup info:
	; Use qword for 64 bits results, dword for 32-bit
	; Use 3 for 64-bit results, 2 for 32-bit in the SAL (shift left)
	EnableASM
	CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
		MOV    rbp,qword [p_#Arr]
		MOV    r15,qword [v_#num]
		SAL    r15,3					; Shift Left; 3 for 64-bit
		MOV    rax,qword [rbp+r15]
		MOV    qword [v_#x],rax
	CompilerElse
		MOV    ebp,dword [p_#Arr]
		MOV    ebx,dword [v_#num]		; v_Counter
		SAL    ebx,2					; Shift Left; 2 for 32-bit, 3 for 64-bit
		MOV    eax,dword [ebp+ebx]
		MOV    dword [v_#x],eax
	CompilerEndIf
	DisableASM
EndMacro


For Counter = 0 To 4		; You must prevent overflow.
	ArrToX(Array1, Counter, x)			; x=...
	ArrToX(Array2, Counter, z)	
	Debug Str(x) + ", " + Str(z)
Next

In reality, you are probably better off hardcoding the Type by size (quad, long) rather than using Int. Or, make a separate macro for each size, and use the appropriate named macro.) Anyway, like I said, this is the most efficient suggestion to date. It does NOT do bounds checking, though. That is up to the user.

[wilbert]

@Tenaja, you don't need the SAL instruction.

Code: Select all

Macro ArrToX(Arr, num, x)
   ; Setup info:
   ; Use qword for 64 bits results, dword for 32-bit
   ; Use 3 for 64-bit results, 2 for 32-bit in the SAL (shift left)
   EnableASM
   CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
      MOV    rbp,qword [p_#Arr]
      MOV    r15,qword [v_#num]
      MOV    rax,qword [rbp + r15 * 8]
      MOV    qword [v_#x],rax
   CompilerElse
      MOV    ebp,dword [p_#Arr]
      MOV    ebx,dword [v_#num]      ; v_Counter
      MOV    eax,dword [ebp + ebx * 4]
      MOV    dword [v_#x],eax
   CompilerEndIf
   DisableASM
EndMacro

When using ASM, you can even access the data without creating a structure and a pointer.

Code: Select all

DataSection
  !Array1Data:
  Data.i 1, 2, 3, 4, 5, 6, 7
  !Array2Data:
  Data.i 1000, 2000, 3000, 4000, 5000, 6000, 7000
EndDataSection

; ; x = Arr(num)
Macro ArrToX(Arr, num, x)
  EnableASM
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    LEA    rdx, [Arr]
    MOV    rax, [v_#num]
    MOV    rax, [rdx + rax * 8]
    MOV    [v_#x], rax
  CompilerElse
    MOV    eax, [v_#num]
    MOV    eax, [Arr + eax * 4]
    MOV    [v_#x], eax
  CompilerEndIf
  DisableASM
EndMacro


For Counter = 0 To 4      ; You must prevent overflow.
  ArrToX(Array1Data, Counter, x)         ; x=...
  ArrToX(Array2Data, Counter, z)   
  Debug Str(x) + ", " + Str(z)
Next

[bbanelli]

Using CopyMemory():

If I disable debugger or comment Debug line in first Macro...

Code: Select all

Macro CreateArray(_name_,_type_)
    Dim _name_._type_(1)
    ReDim _name_._type_( (?__CreateArray__End__Label_#MacroExpandedCount - ?__CreateArray__Start__Label_#MacroExpandedCount) / (@_name_(1)-@_name_(0)) )
;     Debug "CreateArray"
    CopyMemory(?__CreateArray__Start__Label_#MacroExpandedCount, @_name_(0), (ArraySize(_name_()))*(@_name_(1)-@_name_(0)))
    DataSection : __CreateArray__Start__Label_#MacroExpandedCount: : Data._type_
EndMacro

Macro EndCreateArray(_name_)
    : __CreateArray__End__Label_#MacroExpandedCount: : EndDataSection
EndMacro

CreateArray(Fa,q) 361, 575, 922, 525, 176, 586, 640, 321, 536, 742, 677, 742, 687, 284, 193, 517, 273, 494, 263, 147, 593, 800, 571, 320, 803, 133, 231, 390, 685, 330, 63, 410
EndCreateArray(Fa)
CreateArray(T1,q) 11101010111000000, ..., 11011111011110100 ;929 elements
EndCreateArray(T1)
CreateArray(T2,q) 11111010101100000, ..., 10011111100100110 ;929 elements
EndCreateArray(T2)
CreateArray(T3,q) 11010101111100000, ..., 11100011111101010 ;929 elements
EndCreateArray(T3)

I get [ERROR] Invalid memory access. (read error at address 4294967288); CreateArray(T2,q) is the line in question.

On x64 version, similar error [ERROR] Invalid memory access. (write error at address 5316608) but on line CreateArray(T1,q).

First example that you've posted seems to be working perfectly, however (at least in my example)!

[Danilo]

Using CopyMemory():

If I disable debugger or comment Debug line in first Macro...

I get [ERROR] Invalid memory access. (read error at address 4294967288); CreateArray(T2,q) is the line in question.

Same on MacOSX.

This does crash PB:

Code: Select all

    Dim _name_._type_(1)
    ReDim _name_._type_( (?__CreateArray__End__Label_#MacroExpandedCount - ?__CreateArray__Start__Label_#MacroExpandedCount) / (@_name_(1)-@_name_(0)) )

Accessing array elements @_name_(1) and @_name_(0) within ReDim statement crashes.

Use this for CopyMemory version:

Code: Select all

Macro SetTypeSizes(_type_,_name_) : #__#_type_#__size = SizeOf(_name_) : EndMacro

SetTypeSizes(a,Ascii) : SetTypeSizes(b,Byte)    : SetTypeSizes(w,Word) : SetTypeSizes(u,Unicode)
SetTypeSizes(l,Long)  : SetTypeSizes(i,Integer) : SetTypeSizes(q,Quad) : SetTypeSizes(f,Float)
SetTypeSizes(d,Double): SetTypeSizes(s,String)  : SetTypeSizes(c,Character)

;=================================
;
; Using CopyMemory, does not work with strings
;
Macro CreateArray(_name_,_type_)
    Dim _name_._type_( (?__CreateArray__End__Label_#MacroExpandedCount - ?__CreateArray__Start__Label_#MacroExpandedCount) / #__#_type_#__size )
    CopyMemory(?__CreateArray__Start__Label_#MacroExpandedCount, @_name_(0), ?__CreateArray__End__Label_#MacroExpandedCount - ?__CreateArray__Start__Label_#MacroExpandedCount)
    DataSection : __CreateArray__Start__Label_#MacroExpandedCount: : Data._type_
EndMacro

Macro EndCreateArray(_name_)
    : __CreateArray__End__Label_#MacroExpandedCount: : EndDataSection
EndMacro

;---------------------------------

CreateArray(Fa,i) 361, 575, 922, 525, 176, 586, 640, 321, 536, 742, 677,
                  742, 687, 284, 193, 517, 273, 494, 263, 147, 593, 800,
                  571, 320, 803, 133, 231, 390, 685, 330,  63, 410
                  EndCreateArray(Fa)
                  
Debug ArraySize( Fa() )
Debug "-----"

For i = 0 To ArraySize( Fa() ) - 1
    Debug Fa(i)
Next

[Tenaja]

@Tenaja, you don't need the SAL instruction.
...snip code...
When using ASM, you can even access the data without creating a structure and a pointer.

Thanks for the code optimization; not surprised it could be done, but do appreciate your tune-up. I just used PB's array assignment asm, so mine was only as good as that. (I did reorder it to match the argument order.) I can understand asm, but I have only coded it in 8 and 16 bit...never have learned x86. I had no idea it could do a MOV rax, qword [rbp + r15 * 8] with all that math one instruction.

Thanks again!

[Michael Vogel]

Quite interesting things within this thread, would be interested if everything could be made much simpler?!

Code: Select all

DataSection
	ArrTop:
	Data.i	1,2,999,3,4
	ArrEnd:
EndDataSection

Global Dim Arr.i(4)

CopyMemory(?ArrTop,Arr(),?ArrEnd-?ArrTop)

For i=0 To 4
	Debug Arr(i)
Next i

But wouldn't it be possible to use the data memory for the array instead of copying the content, what about a new MemDim command doing such an initialization?

[Little John]

But wouldn't it be possible to use the data memory for the array instead of copying the content,

E.g. with PowerBasic, this is possible since a long time.

what about a new MemDim command doing such an initialization?

I would appriciate such a new command, too.

As already was shown in this thread, currently we can do something like this:

Code: Select all

DataSection
   ArrBeg:
   Data.i  1, 2, 999, 3, 4
   ArrEnd:
EndDataSection

Structure MemArray
   element.i[0]     ; With index 0, PB doesn't check the array bounds.
EndStructure

Define *Arr.MemArray = ?ArrBeg

For i = 0 To 4
   Debug *Arr\element[i]
Next

[Michael Vogel]

Thanks, Little John - good points.
Anyhow, I am using the "traditional" array very often, so I post another combination of the ideas above for a quite simple version:

Code: Select all

; Define Macros

	Macro SetTypeSizes(type,name)
		#_#type#_ = SizeOf(name)
	EndMacro

	SetTypeSizes(a,Ascii)
	SetTypeSizes(b,Byte)
	SetTypeSizes(w,Word)
	SetTypeSizes(u,Unicode)
	SetTypeSizes(l,Long)
	SetTypeSizes(i,Integer)
	SetTypeSizes(q,Quad)
	SetTypeSizes(f,Float)
	SetTypeSizes(d,Double)
	SetTypeSizes(c,Character)

	Macro MemDim(var,size,label,type=i)
		Dim var.type(size)
		CopyMemory(?label,var(),(size+1)*#_#type#_)
	EndMacro

; EndDefine

; Code

DataSection
	ArrValues:
	Data.i   1,2,999,3,4,-1
EndDataSection

Global MemDim(Arr,4,ArrValues)

Procedure test()
	For i=0 To 4
		Debug Arr(i)
	Next i
EndProcedure

test()