I am writing code to allow the user to create an array from a memblock, bank or alloc memory. This works also with strings. As you probably know the DBPro command "Make Array From Memblock" doesn't work with strings. DBPro stores DWORD s and not the actual text data. So the use of pointers are required here and reading the content of the address pointer.
Now works with alloc, Memblocks and Banks (Matrix1Utils by IanM).
[version 0.14 both UDT to UDT strings. I was going to do the offsets in this code but changed my mind. Will be in v0.15. As you can see in this code iptr and *iptr are 2 differenct values. iptr is the arryay ptr to an item in the array and *iptr is the actual address ptr which points to the text data. This does away with using t$ and specifying the .txt, you can just go to the specific offset item.]
Rem Project: memory_to_array (including strings)
Rem Created: Friday, June 11, 2021
Rem ***** Main Source File *****
Rem ***** draft version 0.14 - with UDT -> UDT (offsets) *****
backdrop off
sync on : sync rate 30 : sync
type myUDT
txt as string
endtype
`dim dwary(2) as dword // items=3 0-2 (notice not used "as string" we are storing the dword address that points the the actual text in memory)
dim dwary(2) as myUDT // items=3 0-2 (notice not used "as string" we are storing the dword address that points the the actual text in memory)
`dim strary(2) as string // items=3 0-2
dim strary(2) as myUDT // items=3 0-2
strptr as dword
strptr=get arrayptr(strary())
dwptr as dword
dwptr = get arrayptr(dwary())
dwtype = get arrayptr type(dwptr)
`print "dwptr: ";dwptr;", dwtype: ";dwtype
rem below for memblock memory
memid=find free memblock()
memptr=MakeMemoryFromFile(1,memid,"input.txt")
memsz=get memblock size(memid)
rem below for bank memory
`memid=find free bank()
`memptr=MakeMemoryFromFile(2,memid,"input.txt")
rem below for ALLOC memory- use 0 for memid as n/a
`memptr=MakeMemoryFromFile(3,0,"input.txt")
rem ok for both ALLOC and BANK memory - do not use for memblocks
`memsz=memory size(memptr)
REM code below is for strings
if memptr > 0
MakeArrayFromMemory(memptr,memsz,dwptr,2)
cnt=get arrayptr count(dwptr)
for i=0 to cnt
iptr=get arrayptr item ptr(dwptr,i)
sptr=get arrayptr item ptr(strptr,i)
`t$ = peek string(*iptr)
`strary(i)= t$
`print strary(i)
poke dword sptr,*iptr
print peek string(*sptr)
next i
endif
sync
wait key
`undim dwary()
undim strary()
undim arrayptr dwptr
`delete memory - as appropriate
if memblock exist(memid)=1 then delete memblock memid
`if bank exist(memid)=1 then delete bank memid
`free memptr
end
function MakeMemoryFromFile(mtype,memid,src$)
// mtype: 1=memblock 2=bank 3=alloc
if file exist(src$)=0 or mtype<1 or mtype>3
exitfunction 0
endif
if mtype=1
mid=memid
fid=find free file()
open to read fid,src$
make memblock from file mid,fid
close file fid
`fix code
if memblock exist(mid)=0
exitfunction 0
endif
msz = Get Memblock Size(mid)
tmid = Find Free Memblock()
for b=0 to msz-1
if memblock byte(mid, b) = 13 or memblock byte(mid, b) = 10
write memblock byte mid,b,0
endif
next b
make memblock tmid,msz
for b=0 to msz-1
write memblock byte tmid,b,0
next b
tb=0
for b=0 to msz-1
byt=Memblock Byte(mid,b)
if byt <> 0
write memblock byte tmid,tb,byt
inc tb
else
inc b
inc tb
endif
next b
if memblock exist(mid) then delete memblock mid
make memblock mid,msz
copy memblock tmid,mid,0,0,msz
if memblock exist(tmid) then delete memblock tmid
newmptr=get memblock ptr(mid)
endif
if mtype=2
mid=memid
make bank from file mid,src$
`fix code
if bank exist(mid)=0
exitfunction 0
endif
msz = Get Bank Size(mid)
tmid = Find Free Bank()
for b=0 to msz-1
if bank byte(mid, b) = 13 or bank byte(mid, b) = 10
write bank byte mid,b,0
endif
next b
make bank tmid,msz
for b=0 to msz-1
write bank byte tmid,b,0
next b
tb=0
for b=0 to msz-1
byt=Bank Byte(mid,b)
if byt <> 0
write bank byte tmid,tb,byt
inc tb
else
inc b
inc tb
endif
next b
if bank exist(mid) then delete bank mid
make bank mid,msz
copy bank tmid,0,msz,mid,0
if bank exist(mid) then delete bank tmid
newmptr=get bank ptr(mid)
endif
if mtype=3
fsz=file size(src$)
mptr=alloc Zeroed(fsz)
fid=find free file()
open to read fid,src$
for addr=mptr to mptr+fsz-1
read byte fid,byt
poke byte addr,byt
next addr
close file fid
`fix memory code integrated
msz = Memory Size(mptr)
if msz=0
exitfunction 0
endif
for addr=mptr to mptr+msz-1
if peek byte(addr) = 13 or peek byte(addr) = 10
poke byte addr,0
endif
next addr
tmptr = alloc zeroed(msz)
tb=0
for addr=mptr to mptr+msz-1
byt=peek byte(addr)
if byt <> 0
poke byte tmptr+tb,byt
inc tb
else
inc addr
inc tb
endif
next addr
free mptr
newmptr=alloc zeroed(msz)
` copy mem to mem
bpos=0
for addr=tmptr to tmptr+msz-1
byt=peek byte(addr)
poke byte newmptr+bpos,byt
inc bpos
next addr
free tmptr
endif
endfunction newmptr
function MakeArrayFromMemory(mptr,msz,aryptr,vtype)
// vtype : no value type/integer=0, 1=float, 2=string, 3=boolean,
// 4=byte, 5=word, 6=dword, 7=double float, 8=double integer
stpos as dword
if vtype <0 or vtype >8
message "type is invalid, parse 1-8 only."
exitfunction
endif
select vtype
case 0
loopstep=4
endcase
case 1
loopstep=4
endcase
case 2
loopstep=1
endcase
case 3
loopstep=1
endcase
case 4
loopstep=1
endcase
case 5
loopstep=2
endcase
case 6
loopstep=4
endcase
case 7
loopstep=8
endcase
case 8
loopstep=8
endcase
endselect
index=0
stpos=mptr
bpos=-1
for addr = mptr to (mptr+msz)-loopstep step loopstep
iptr = aryptr+get arrayptr item ptr(aryptr,index)
select vtype
case 0
value=peek integer(addr)
poke integer iptr,value
endcase
case 1
value#=peek float(addr)
poke float iptr,value#
endcase
case 2
inc bpos
b=peek byte(addr)
b1=peek byte(addr+1)
if (addr-mptr)=msz-1 then exit
if b>=32 and b<=127 and b1 = 0
inc strcount
if strcount =1
iptr=get arrayptr item ptr(aryptr,strcount-1)
poke dword iptr,stpos
nbpos=bpos+1
else
if strcount > 1
iptr=get arrayptr item ptr(aryptr,strcount-1)
poke dword iptr,stpos+nbpos+1
nbpos=bpos+1
endif
endif
endif
endcase
case 3
value=peek byte(addr)
poke byte iptr,value
endcase
case 4
value=peek byte(addr)
poke byte iptr,value
endcase
case 5
value=peek word(addr)
poke word iptr,value
endcase
case 6
value=peek dword(addr)
poke dword iptr,value
endcase
case 7
value=peek double float(addr)
poke double float iptr,value
endcase
case 8
value=peek double integer(addr)
poke double integer iptr,value
endcase
endselect
inc index
next addr
endfunction
[version 0.13-both UDT and non UDT strings. At the moment I have just specified 1 variable in the UDT type definition. For more than 1 variable, we need to use offsets which is straightforward. Will add that in next code version]
Rem Project: memory_to_array (including strings)
Rem Created: Thursday, June 10, 2021
Rem ***** Main Source File *****
Rem ***** draft version 0.13 - with UDT *****
backdrop off
sync on : sync rate 30 : sync
type myUDT
txt as string
endtype
`dim dwary(2) as dword // items=3 0-2 (notice not used "as string" we are storing the dword address that points the the actual text in memory)
dim dwary(2) as myUDT // items=3 0-2 (notice not used "as string" we are storing the dword address that points the the actual text in memory)
dim strary(2) as string // items=3 0-2
dwptr as dword
dwptr = get arrayptr(dwary())
dwtype = get arrayptr type(dwptr)
`print "dwptr: ";dwptr;", dwtype: ";dwtype
rem below for memblock memory
memid=find free memblock()
memptr=MakeMemoryFromFile(1,memid,"input.txt")
memsz=get memblock size(memid)
rem below for bank memory
`memid=find free bank()
`memptr=MakeMemoryFromFile(2,memid,"input.txt")
rem below for ALLOC memory- use 0 for memid as n/a
`memptr=MakeMemoryFromFile(3,0,"input.txt")
rem ok for both ALLOC and BANK memory - do not use for memblocks
`memsz=memory size(memptr)
REM code below is for strings
if memptr > 0
MakeArrayFromMemory(memptr,memsz,dwptr,2)
cnt=get arrayptr count(dwptr)
for i=0 to cnt
iptr=get arrayptr item ptr(dwptr,i)
t$ = peek string(*iptr)
strary(i)= t$
print strary(i)
next i
endif
sync
wait key
`undim dwary()
undim strary()
undim arrayptr dwptr
`delete memory - as appropriate
if memblock exist(memid)=1 then delete memblock memid
`if bank exist(memid)=1 then delete bank memid
`free memptr
end
function MakeMemoryFromFile(mtype,memid,src$)
// mtype: 1=memblock 2=bank 3=alloc
if file exist(src$)=0 or mtype<1 or mtype>3
exitfunction 0
endif
if mtype=1
mid=memid
fid=find free file()
open to read fid,src$
make memblock from file mid,fid
close file fid
`fix code
if memblock exist(mid)=0
exitfunction 0
endif
msz = Get Memblock Size(mid)
tmid = Find Free Memblock()
for b=0 to msz-1
if memblock byte(mid, b) = 13 or memblock byte(mid, b) = 10
write memblock byte mid,b,0
endif
next b
make memblock tmid,msz
for b=0 to msz-1
write memblock byte tmid,b,0
next b
tb=0
for b=0 to msz-1
byt=Memblock Byte(mid,b)
if byt <> 0
write memblock byte tmid,tb,byt
inc tb
else
inc b
inc tb
endif
next b
if memblock exist(mid) then delete memblock mid
make memblock mid,msz
copy memblock tmid,mid,0,0,msz
if memblock exist(tmid) then delete memblock tmid
newmptr=get memblock ptr(mid)
endif
if mtype=2
mid=memid
make bank from file mid,src$
`fix code
if bank exist(mid)=0
exitfunction 0
endif
msz = Get Bank Size(mid)
tmid = Find Free Bank()
for b=0 to msz-1
if bank byte(mid, b) = 13 or bank byte(mid, b) = 10
write bank byte mid,b,0
endif
next b
make bank tmid,msz
for b=0 to msz-1
write bank byte tmid,b,0
next b
tb=0
for b=0 to msz-1
byt=Bank Byte(mid,b)
if byt <> 0
write bank byte tmid,tb,byt
inc tb
else
inc b
inc tb
endif
next b
if bank exist(mid) then delete bank mid
make bank mid,msz
copy bank tmid,0,msz,mid,0
if bank exist(mid) then delete bank tmid
newmptr=get bank ptr(mid)
endif
if mtype=3
fsz=file size(src$)
mptr=alloc Zeroed(fsz)
fid=find free file()
open to read fid,src$
for addr=mptr to mptr+fsz-1
read byte fid,byt
poke byte addr,byt
next addr
close file fid
`fix memory code integrated
msz = Memory Size(mptr)
if msz=0
exitfunction 0
endif
for addr=mptr to mptr+msz-1
if peek byte(addr) = 13 or peek byte(addr) = 10
poke byte addr,0
endif
next addr
tmptr = alloc zeroed(msz)
tb=0
for addr=mptr to mptr+msz-1
byt=peek byte(addr)
if byt <> 0
poke byte tmptr+tb,byt
inc tb
else
inc addr
inc tb
endif
next addr
free mptr
newmptr=alloc zeroed(msz)
` copy mem to mem
bpos=0
for addr=tmptr to tmptr+msz-1
byt=peek byte(addr)
poke byte newmptr+bpos,byt
inc bpos
next addr
free tmptr
endif
endfunction newmptr
function MakeArrayFromMemory(mptr,msz,aryptr,vtype)
// vtype : no value type/integer=0, 1=float, 2=string, 3=boolean,
// 4=byte, 5=word, 6=dword, 7=double float, 8=double integer
stpos as dword
if vtype <0 or vtype >8
message "type is invalid, parse 1-8 only."
exitfunction
endif
select vtype
case 0
loopstep=4
endcase
case 1
loopstep=4
endcase
case 2
loopstep=1
endcase
case 3
loopstep=1
endcase
case 4
loopstep=1
endcase
case 5
loopstep=2
endcase
case 6
loopstep=4
endcase
case 7
loopstep=8
endcase
case 8
loopstep=8
endcase
endselect
index=0
stpos=mptr
bpos=-1
for addr = mptr to (mptr+msz)-loopstep step loopstep
iptr = aryptr+get arrayptr item ptr(aryptr,index)
select vtype
case 0
value=peek integer(addr)
poke integer iptr,value
endcase
case 1
value#=peek float(addr)
poke float iptr,value#
endcase
case 2
inc bpos
b=peek byte(addr)
b1=peek byte(addr+1)
if (addr-mptr)=msz-1 then exit
if b>=32 and b<=127 and b1 = 0
inc strcount
if strcount =1
iptr=get arrayptr item ptr(aryptr,strcount-1)
poke dword iptr,stpos
nbpos=bpos+1
else
if strcount > 1
iptr=get arrayptr item ptr(aryptr,strcount-1)
poke dword iptr,stpos+nbpos+1
nbpos=bpos+1
endif
endif
endif
endcase
case 3
value=peek byte(addr)
poke byte iptr,value
endcase
case 4
value=peek byte(addr)
poke byte iptr,value
endcase
case 5
value=peek word(addr)
poke word iptr,value
endcase
case 6
value=peek dword(addr)
poke dword iptr,value
endcase
case 7
value=peek double float(addr)
poke double float iptr,value
endcase
case 8
value=peek double integer(addr)
poke double integer iptr,value
endcase
endselect
inc index
next addr
endfunction
[version 0.12- back to strings for now, uses alloc, memblocks, banks. see attached input file]
Rem Project: memory_to_array (including strings)
Rem Created: Tuesday, June 8, 2021
Rem ***** Main Source File *****
Rem ***** draft version 0.12 *****
backdrop off
sync on : sync rate 30 : sync
dim dwary(2) as dword // items=3 0-2 (notice not used "as string" we are storing the dword address that points the the actual text in memory)
dim strary(2) as string // items=3 0-2
dwptr as dword
dwptr = get arrayptr(dwary())
rem below for memblock memory
`memid=find free memblock()
`memptr=MakeMemoryFromFile(1,memid,"input.txt")
rem below for bank memory
`memid=find free bank()
`memptr=MakeMemoryFromFile(2,memid,"input.txt")
`memsz=get memblock size(memid)
rem below for ALLOC memory- use 0 for memid as n/a
memptr=MakeMemoryFromFile(3,0,"input.txt")
rem ok for both ALLOC and BANK memory - do not use for memblocks
memsz=memory size(memptr)
REM code below is for strings
if memptr > 0
MakeArrayFromMemory(memptr,memsz,dwptr,2)
cnt=array count(dwary())
for i=0 to cnt
t$ = peek string(dwary(i))
strary(i)= t$
print strary(i)
next i
endif
sync
wait key
undim dwary()
undim strary()
`if memblock exist(memid)=1 then delete memblock memid
if bank exist(memid)=1 then delete bank memid
`free memptr
end
function MakeMemoryFromFile(mtype,memid,src$)
// mtype: 1=memblock 2=bank 3=alloc
if file exist(src$)=0 or mtype<1 or mtype>3
exitfunction 0
endif
if mtype=1
mid=memid
fid=find free file()
open to read fid,src$
make memblock from file mid,fid
close file fid
`fix code
if memblock exist(mid)=0
exitfunction 0
endif
msz = Get Memblock Size(mid)
tmid = Find Free Memblock()
for b=0 to msz-1
if memblock byte(mid, b) = 13 or memblock byte(mid, b) = 10
write memblock byte mid,b,0
endif
next b
make memblock tmid,msz
for b=0 to msz-1
write memblock byte tmid,b,0
next b
tb=0
for b=0 to msz-1
byt=Memblock Byte(mid,b)
if byt <> 0
write memblock byte tmid,tb,byt
inc tb
else
inc b
inc tb
endif
next b
if memblock exist(mid) then delete memblock mid
make memblock mid,msz
copy memblock tmid,mid,0,0,msz
if memblock exist(tmid) then delete memblock tmid
newmptr=get memblock ptr(mid)
endif
if mtype=2
mid=memid
make bank from file mid,src$
`fix code
if bank exist(mid)=0
exitfunction 0
endif
msz = Get Bank Size(mid)
tmid = Find Free Bank()
for b=0 to msz-1
if bank byte(mid, b) = 13 or bank byte(mid, b) = 10
write bank byte mid,b,0
endif
next b
make bank tmid,msz
for b=0 to msz-1
write bank byte tmid,b,0
next b
tb=0
for b=0 to msz-1
byt=Bank Byte(mid,b)
if byt <> 0
write bank byte tmid,tb,byt
inc tb
else
inc b
inc tb
endif
next b
if bank exist(mid) then delete bank mid
make bank mid,msz
copy bank tmid,0,msz,mid,0
if bank exist(mid) then delete bank tmid
newmptr=get bank ptr(mid)
endif
if mtype=3
fsz=file size(src$)
mptr=alloc Zeroed(fsz)
fid=find free file()
open to read fid,src$
for addr=mptr to mptr+fsz-1
read byte fid,byt
poke byte addr,byt
next addr
close file fid
`fix memory code integrated
msz = Memory Size(mptr)
if msz=0
exitfunction 0
endif
for addr=mptr to mptr+msz-1
if peek byte(addr) = 13 or peek byte(addr) = 10
poke byte addr,0
endif
next addr
tmptr = alloc zeroed(msz)
tb=0
for addr=mptr to mptr+msz-1
byt=peek byte(addr)
if byt <> 0
poke byte tmptr+tb,byt
inc tb
else
inc addr
inc tb
endif
next addr
free mptr
newmptr=alloc zeroed(msz)
` copy mem to mem
bpos=0
for addr=tmptr to tmptr+msz-1
byt=peek byte(addr)
poke byte newmptr+bpos,byt
inc bpos
next addr
free tmptr
endif
endfunction newmptr
function MakeArrayFromMemory(mptr,msz,aryptr,vtype)
// vtype : no value type/integer=0, 1=float, 2=string, 3=boolean,
// 4=byte, 5=word, 6=dword, 7=double float, 8=double integer
stpos as dword
if vtype <0 or vtype >8
message "type is invalid, parse 1-8 only."
exitfunction
endif
select vtype
case 0
loopstep=4
endcase
case 1
loopstep=4
endcase
case 2
loopstep=1
endcase
case 3
loopstep=1
endcase
case 4
loopstep=1
endcase
case 5
loopstep=2
endcase
case 6
loopstep=4
endcase
case 7
loopstep=8
endcase
case 8
loopstep=8
endcase
endselect
index=0
stpos=mptr
bpos=-1
for addr = mptr to (mptr+msz)-loopstep step loopstep
iptr = aryptr+get arrayptr item ptr(aryptr,index)
select vtype
case 0
value=peek integer(addr)
poke integer iptr,value
endcase
case 1
value#=peek float(addr)
poke float iptr,value#
endcase
case 2
inc bpos
b=peek byte(addr)
b1=peek byte(addr+1)
if (addr-mptr)=msz-1 then exit
if b>=32 and b<=127 and b1 = 0
inc strcount
if strcount =1
iptr=get arrayptr item ptr(aryptr,strcount-1)
poke dword iptr,stpos
nbpos=bpos+1
else
if strcount > 1
iptr=get arrayptr item ptr(aryptr,strcount-1)
poke dword iptr,stpos+nbpos+1
nbpos=bpos+1
endif
endif
endif
endcase
case 3
value=peek byte(addr)
poke byte iptr,value
endcase
case 4
value=peek byte(addr)
poke byte iptr,value
endcase
case 5
value=peek word(addr)
poke word iptr,value
endcase
case 6
value=peek dword(addr)
poke dword iptr,value
endcase
case 7
value=peek double float(addr)
poke double float iptr,value
endcase
case 8
value=peek double integer(addr)
poke double integer iptr,value
endcase
endselect
inc index
next addr
endfunction
Professional Programmer, languages: SAS, C++, SQL, PL-SQL, DBPro, Purebasic, JavaScript, others
