mem arrays - James D Jarvis - 08-23-2022
Other folks using mem and posting about it got me reading the documentation on the _mem commands and I realized it
was a possible solution to a limitation in QB.
I've always wanted to use arrays inside a programmer defined record type. The functions and subs here are an attempt to do so. Currently only supports one dimensional arrays of 2 byte integers.
Code: (Select All) 'mem array functions and subs
Type rectype
array As _MEM 'this could of course be just one of many entries inside a larger record but this demo code is cleaner with the array alone here
End Type
Dim rec As rectype
Dim r2 As rectype
rec.array = _MemNew(20) 'make a 20 byte mem block to hold an intger array with 10 elements
r2.array = _MemNew(20)
Print "I've always wanted to uses arrays inside record types but that isn't a standard option"
Print "the functions and subs this program uses are made to handle arrays inside such records"
'I chose to do this without creating seperate reference arrays to establish the arrays as all the routines...
' required to access the arrays don't have to ever look at a seperately defined array
Print
Print "Made 2 integer arays"
Print "Offset", "Size"
Print rec.array.OFFSET, rec.array.SIZE, "Rec"
Print r2.array.OFFSET, r2.array.SIZE, "R2"
Print
'build 2 integer arrays
For x = 1 To 10
xx% = Int(x * 2)
x2% = Int(x)
miput_array xx%, rec.array, x
miput_array x2%, r2.array, x
Next x
Print "Here are their values"
'manually read the arrays rec.array and r2.array and print the values
For x = 1 To 10
n = Int(miget(rec.array, x))
m = Int(miget(r2.array, x))
Print n, m
Next
Input "press enter to continue", kk$
'directly setting the first elelemnt in array in r2 to the vale 123
Print "Changed the 1st vlaue of the array r2"
xx% = 123
_MemPut r2.array, r2.array.OFFSET, xx%
'trying out iget function
Print iget(r2, 1)
'trying out miget function
Print miget(r2.array, 1)
Print
print_iarray r2.array, 1, 10
Input "press enter to continue", kk$
Print
Print "Appending the array at r2 to have 2 more elements"
mem_iappend r2.array, 2
s = iarray_len(r2.array)
For x = 1 To s
Print miget(r2.array, x);
Next x
Print "array length "; iarray_len(r2.array)
Print "let's fill elements 11 and 12..."
x2% = 11
miput_array x2%, r2.array, 11
x2% = 12
miput_array x2%, r2.array, 12
print_iarray r2.array, 1, s
Print: Print
Print "taking these values"
print_iarray rec.array, 1, 6
Print "and replacing elements 4 to 9 in the last array."
quick_iacopy rec.array, r2.array, 1, 6, 4
print_iarray r2.array, 1, 12
'cleaning up
_MemFree rec.array
_MemFree r2.array
'================================================================================================
'functions and subs to handle arrays inside a memory block
'
'currently only supports 2 byte intgers
'================================================================================================
Sub quick_iacopy (ra As _MEM, rb As _MEM, a1 As Integer, a2 As Integer, b As Integer)
'take elements a1 to a2 form integer arrai ra and repalce in integer array rb starting at element b
_MemCopy ra, ra.OFFSET + (a1 - 1) * 2, (a2 + 1 - a1) * 2 To rb, rb.OFFSET + (b - 1) * 2
End Sub
Sub print_iarray (r As _MEM, x1, x2)
'print elements x1 to x2 in an integer array
If x1 < x2 Then 'print order is lower element # to higher element #
For n = x1 To x2
x = _MemGet(r, r.OFFSET + (n - 1) * 2, Integer)
Print x;
Next
Print
End If
If x1 > x2 Then 'print order is higher elelemnt # to lower element #
For n = x1 To x2 Step -1
x = _MemGet(r, r.OFFSET + (n - 1) * 2, Integer)
Print x;
Next
Print
End If
End Sub
Sub miput_array (n As Integer, r As _MEM, e)
'this puts a 2 byte integer into the array r at element e
If e > 0 And e <= r.SIZE / 2 Then 'if element is outside array size program will not check incorrect offset but will still return a 0
_MemPut r, r.OFFSET + ((e - 1) * 2), n
End If
End Sub
Function iget (r As rectype, e)
'get elelent e out of the array in the record ... probably retirng this function as it isn't as robust as miget
iget = _MemGet(r.array, r.array.OFFSET + (e - 1) * 2, Integer)
End Function
Function miget (r As _MEM, e)
'mem integer get, grab element out of the array at r
miget = _MemGet(r, r.OFFSET + (e - 1) * 2, Integer)
End Function
Sub mem_iappend (r As _MEM, n)
'add n elements to an integer array
SA$ = Str$(r.SIZE)
s = Val(_Trim$(SA$))
Dim temp As _MEM
temp = _MemNew(s)
_MemCopy r, r.OFFSET, r.SIZE To temp, temp.OFFSET
_MemFree r 'now ths is strange, if you don't do this the address of the offset will change after the next command, not a big deal but a curisotiy
r = _MemNew(s + n * 2)
_MemCopy temp, temp.OFFSET, temp.SIZE To r, r.OFFSET
_MemFree temp
End Sub
Function iarray_len (r As _MEM)
ll% = Int(Val(_Trim$(Str$(r.SIZE))) / 2)
iarray_len = ll%
End Function
RE: mem arrays - Jack - 08-23-2022
I agree with you on the need for array's in udt's, my only complaints with the _mem approach is that it looks messy setting and getting the values and the need to cleanup afterwards
I had a different idea, use a member of string * number_of_elements * size_of_element and copy from that string member to a temporary array when operations on the member elements are needed and copy the array back to the string member, I hope that you won't mind me posting an example of my idea
the drawbacks are the need for temporary arrays and having to copy the udt member to the array and back
Code: (Select All) $Console:Only
_Dest _Console
Declare CustomType Library
Sub memcpy (ByVal dest As _Offset, Byval source As _Offset, Byval bytes As Long)
End Declare
Const max = 20
Const max4 = 4 * (max + 1)
Type foo
m As String * Max4
End Type
Dim As Long i, m
Dim As Long a(max), b(max)
Dim x As foo
Print "populate array a, a(i) = i"
For i = 0 To max
a(i) = i
Next
Print "copy array a to member m of x"
memcpy _Offset(x.m), _Offset(a()), Len(a())
Print "prove that the copy was successful"
For i = 0 To max
m = CVL(Mid$(x.m, 4 * i + 1, 4)) 'this messy way to access the member data is only used to prove that the copy was successful
Print "i = "; i, "x.m["; i; "] = "; m
Next
Print "copy member m of x to array b"
memcpy _Offset(b()), _Offset(x.m), Len(b())
Print "prove that the copy was successful"
For i = 0 To max
Print "i = "; i, "b("; i; ") = "; b(i)
Next
RE: mem arrays - James D Jarvis - 08-23-2022
Oh no totally cool to share. I've used text-based solutions in this genral area more than once myself.
RE: mem arrays - Jack - 08-23-2022
your solution is better of course
if in my example one could simply swap pointers, that is, make the temporary array point to the member data that would be cool and much faster than copying back and forth
it may be possible to do in C, not sure it's possible in basic
RE: mem arrays - James D Jarvis - 08-23-2022
(08-23-2022, 12:50 PM)Jack Wrote: your solution is better of course
if in my example one could simply swap pointers, that is, make the temporary array point to the member data that would be cool and much faster than copying back and forth
it may be possible to do in C, not sure it's possible in basic
It was one of my favorite features of Powerbasic back in the 90's. I really, really could use linked lists where entries could be built and destroyed without having to worry about how many elements are in the list (except of course for RAM use). Not sure how close _mem commands and _offset let us get just yet.
Currently I want to be able to have a cellmap of an environment where every cell may or may not have a linked list of a different number of elements within that cell. Even in this day and age the brute force approach of a multi-dimensional array just takes up too much RAM for the scale I'm thinking of.
RE: mem arrays - SpriggsySpriggs - 08-31-2022
How I do an array in a TYPE is by making the array (in whatever variable type it is) and then storing it in the MEM block member of the TYPE. Works quite well but doesn't work with external APIs/libraries.
RE: mem arrays - mdijkens - 08-31-2022
I'd like to do it like below:
very flexible and easy to read/understand
Code: (Select All) DefInt A-Z
Type orderType
amount As Long
status As _Byte
End Type
Type detailType
prodid As String * 10
amount As Long
End Type
ReDim Shared order(1) As orderType
ReDim Shared detail(1, 1) As detailType
For o = 1 To 100
onr = addOrder
Next o
Function addOrder% ()
onr = UBound(order) + 1: ReDim _Preserve order(onr) As orderType
order(onr).amount = 0
For d = 1 To 6
dnr = addDetail(onr, Right$(String$(10, " ") + LTrim$(Str$(d)), 10), d * 10)
Next d
addOrder = onr
End Function
Function addDetail (onr, id$, amount)
oo = UBound(detail, 1): dd = UBound(detail, 2)
If onr > oo Then
ReDim _Preserve detail(onr, dd) As detailType
Else
For dnr = 1 To dd
If _Trim$(detail(onr, dnr).prodid) = "" Then Exit For
Next dnr
End If
If dnr > dd Then ReDim _Preserve detail(onr, dnr) As detailType
detail(onr, dnr).prodid = id$
detail(onr, dnr).amount = amount
order(onr).amount = order(onr).amount + amount
addDetail = dnr
End Function
|