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 Memblocks and Banks (Matrix1Utils by IanM).
[update17Mar2021:latest version 0.10: code now only uses 2 functions MakeMemoryFromFile(mtype,src$) and MakeArrayFromMemory(mptr,msz,aryptr,vtype). see attached zip file for 0.10 ]
Rem Project: memory_to_array (including strings)
Rem Created: Wednesday, March 17, 2021
Rem ***** Main Source File *****
Rem ***** draft version 0.10 *****
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())
// MakeMemoryFromFile now reads in the file then fixes the memory content
bid=MakeMemoryFromFile(1,"input.txt")
memptr=get memblock ptr(bid)
memsz=get memblock size(bid)
`bid=MakeMemoryFromFile(2,"input.txt")
`memptr=get bank ptr(bid)
`memsz=get bank size(bid)
`memptr=MakeMemoryFromFile(3,"input.txt")
`memsz=memory size(memptr)
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
undim dwary()
delete memblock bid
`delete bank bid
`free memptr
sync
wait key
end
function MakeMemoryFromFile(mtype,src$)
// mtype: 1=memblock 2=bank 3=alloc
if file exist(src$)=0
exitfunction 0
endif
if mtype=1
mid=find free memblock()
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=mid
endif
if mtype=2
mid=find free bank()
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=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=1
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
[update17Mar2021:latest version 0.9: integrated the FixMemory function into the MakeMemoryFromFile function. see attached zip file for 0.9. more to come ]
Rem Project: memory_to_array (including strings)
Rem Created: Wednesday, March 17, 2021
Rem ***** Main Source File *****
Rem ***** draft version 0.9 *****
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())
// MakeMemoryFromFile now reads in the file then fixes the memory content
memptr=MakeMemoryFromFile("input.txt")
if memptr > 0
memsz=memory size(memptr)
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
undim dwary()
free memptr
endif
sync
wait key
end
// memtype: 1=Memblock, 2=Bank, 3=Alloc memory
function CreateZeroedMemory(memtype,memsz)
if (memtype <1 or memtype>3) or memsz<=0
exitfunction -1
endif
// memblock
select memtype
case 1
memid=find free memblock()
make memblock memid,memsz
for b=0 to memsz-1
write memblock byte memid,b,0
next b
r=memid
endcase
// bank
case 2
memid=find free bank()
make bank memid,memsz
for b=0 to memsz-1
write bank byte memid,b,0
next b
r=memid
endcase
// alloc
case 3
memptr=alloc zeroed(memsz) // returns pointer to an address of memory
r=memptr
endcase
endselect
endfunction r
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=1
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
function FixMemblock(mid)
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
endfunction 1
function FixBank(mid)
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
endfunction 1
function FixMemory(mptr)
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
endfunction newmptr
function MakeMemoryFromFile(src$)
if file exist(src$)=0
exitfunction 0
endif
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
endfunction newmptr
[update17Mar2021:updated code to use ALLOC memory to MAKEARRAYFROMMEMORY-added an interim FIXMEMORY function which will be integrated eventually into the MakeMemoryFromFile function. Testing still ongoing and tweaking here and there. IF statements replaced with SELECT CASE. + other tweaks here and there and fine tuning. The final version will just be using all PTRs for both MEMBLOCK/BANK mem types. Will be testing out on UDT arrays and making updates to the code to cater for those array types, so haven't forgotten. I'm also planning to get the code to auto populate that actual string array e.g. STRARY(), this will come soon when I do testing on UDT arrays. Added the project file in a zip bottom of thread and will update this with each progressive version, hopefully it can only get better. C+ version on it's way soon so you can use a DBPro command instead. That will need more thought/testing.]
Rem Project: memory_to_array (including strings)
Rem Created: Wednesday, March 17, 2021
Rem ***** Main Source File *****
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())
memptr=MakeMemoryFromFile("input.txt")
memsz=memory size(memptr)
newmemptr=FixMemory(memptr)
newmemsz=memory size(newmemptr)
MakeArrayFromMemory(newmemptr,newmemsz,dwptr,2)
cnt=array count(dwary())
for i=0 to cnt
t$ = peek string(dwary(i))
strary(i)= t$
print strary(i)
next i
undim dwary()
free newmemptr
sync
wait key
end
// memtype: 1=Memblock, 2=Bank, 3=Alloc memory
function CreateZeroedMemory(memtype,memsz)
if (memtype <1 or memtype>3) or memsz<=0
exitfunction -1
endif
// memblock
select memtype
case 1
memid=find free memblock()
make memblock memid,memsz
for b=0 to memsz-1
write memblock byte memid,b,0
next b
r=memid
endcase
// bank
case 2
memid=find free bank()
make bank memid,memsz
for b=0 to memsz-1
write bank byte memid,b,0
next b
r=memid
endcase
// alloc
case 3
memptr=alloc zeroed(memsz) // returns pointer to an address of memory
r=memptr
endcase
endselect
endfunction r
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=1
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
function FixMemblock(mid)
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
endfunction 1
function FixBank(mid)
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
endfunction 1
function FixMemory(mptr)
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
endfunction newmptr
function MakeMemoryFromFile(src$)
if file exist(src$)=0
exitfunction 0
endif
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
endfunction mptr
[update16Mar2021:17:44-found a fix for the make memblock/bank from file-will post once tested properly and code as water tight as a ducks ...... ]
I will be adding c+ equivalent code in VS2019 i.e. a DBP command to do the same, bit more complex but quite straight forward plus a lot more checking.
here is full draft code (quick knock up code), subject to change/optimization/efficiency. You just create the memory and an array of said type i.e. integer=0, 1=float, 2=string, 3=boolean, 4=byte, 5=word, 6=dword, 7=double float, 8=double integer in this example, I have used dword type (2) and alloc type of memory. Notice I have used DWORD type and not STRING. I've left in STRING type for now, but is probably redundant here. I've added a 2nd array of string type which can then be used to populate the actual text data and then you delete the DWORD array and lastly memory . I'm looking into using the link array which I've used before which is very handy. Will be better in C+, which maybe by the end of the week I can have implemented as a new DBPro command . might replace the if.. then with select statements ...
[update 4:16Mar2021]
You can use the attached .txt file or create your own. Now can load in a file into a memblock/bank and save to array. A lot more to do to the code, and there is always a reason why I have written the code the way it is. Still WIP. Obviously you can remove the code that you don't want, so if you want to use banks instead of memblocks remove the code relating to memblocks etc. The current code is using the memblock, so the bank functions/code can be removed from the source. It's up to you-> Memblocks; Banks or Alloc reserved memory.
Do what you want with the code, make it better, report any issues and constructive criticism please. As it's still ongoing, code will change dramatically over the next few days/weeks. DBPro commands to be added soon and maybe AppGameKit all in C+
Rem Project: memory_to_array (including strings)
Rem Created: Tuesday, March 16, 2021
Rem ***** Main Source File *****
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())
open to read 1,"input2.txt"
make memblock from file 1,1
close file 1
memptr=Get Memblock Ptr(1)
memsz=Get Memblock Size(1)
`make bank from file 1,"input2.txt"
`memptr=Get Bank Ptr(1)
`memsz=Get Bank Size(1)
`memptr=CreateZeroedMemory(3,1000)
`memsz=memory size(memptr)
// call to function FixMemblock() / FixBank()
success=FixMemblock(1)
memptr=Get Memblock Ptr(1)
memsz=Get Memblock Size(1)
`success=FixBank(1)
`memptr=Get Bank Ptr(1)
`memsz=Get Bank Size(1)
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
undim dwary()
delete memblock 1
`delete bank 1
`free memptr
sync
wait key
end
// memtype: 1=Memblock, 2=Bank, 3=Alloc memory
function CreateZeroedMemory(memtype,memsz)
if (memtype <1 or memtype>3) or memsz<=0
exitfunction -1
endif
// memblock
if memtype = 1
memid=find free memblock()
make memblock memid,memsz
for b=0 to memsz-1
write memblock byte memid,b,0
next b
r=memid
endif
// bank
if memtype = 2
memid=find free bank()
make bank memid,memsz
for b=0 to memsz-1
write bank byte memid,b,0
next b
r=memid
endif
// alloc
if memtype = 3
memptr=alloc zeroed(memsz) // returns pointer to an address of memory
r=memptr
endif
endfunction r
// CURRENTLY WORKING ON //
function MakeArrayFromMemory(mptr,msz,aryptr,vtype)
// vtype : no value type/integer=0, 1=float, 2=string(obsolete), 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
if vtype = 0 or vtype = 1 or vtype = 6
loopstep=4
else
if vtype=2
loopstep=1
else
if vtype=3 or vtype=4
loopstep=1
else
if vtype=3 or vtype=4
loopstep=1
else
if vtype=5
loopstep=2
else
if vtype = 7 or vtype = 8
loopstep = 8
endif
endif
endif
endif
endif
endif
index=1
stpos=mptr
bpos=-1
for addr = mptr to (mptr+msz)-loopstep step loopstep
iptr = aryptr+get arrayptr item ptr(aryptr,index)
if vtype=0
value=peek integer(addr)
poke integer iptr,value
endif
if vtype=1
value#=peek float(addr)
poke float iptr,value#
endif
if vtype=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
endif
if vtype=3
value=peek byte(addr)
poke byte iptr,value
endif
if vtype=4
value=peek byte(addr)
poke byte iptr,value
endif
if vtype=5
value=peek word(addr)
poke word iptr,value
endif
if vtype=6
value=peek dword(addr)
poke dword iptr,value
endif
if vtype=7
value=peek double float(addr)
poke double float iptr,value
endif
if vtype=8
value=peek double integer(addr)
poke double integer iptr,value
endif
inc index
next addr
endfunction
function FixMemblock(mid)
if memblock exist(mid)=0
exitfunction -1
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
delete memblock mid
make memblock mid,msz
copy memblock tmid,mid,0,0,msz
delete memblock tmid
endfunction 1
function FixBank(mid)
if bank exist(mid)=0
exitfunction -1
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
delete bank mid
make bank mid,msz
copy bank tmid,0,msz,mid,0
delete bank tmid
endfunction 1
[update3:16Mar2021]
Rem Project: memory_to_array (including strings)
Rem Created: Tuesday, March 16, 2021
Rem ***** Main Source File *****
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())
a$="I wandered as lonely as a cloud."
alen=len(a$)+1 // +1 for the null
b$="I am not a number, I am a free man!"
blen=len(b$)+1 // +1 for the null
c$="666, the number of the beast."
`mid=CreateZeroedMemory(1,1000)
`memptr=Get Memblock Ptr(mid)
`memsz=Get Memblock Size(mid)
`mid=CreateZeroedMemory(2,1000)
`memptr=Get Bank Ptr(mid)
`memsz=Get Bank Size(mid)
memptr=CreateZeroedMemory(3,1000)
memsz=memory size(memptr)
poke string memptr, a$
poke string memptr+alen, b$
poke string memptr+alen+blen, c$
MakeArrayFromMemory(memptr,memsz,dwptr,2)
for i=0 to array count(dwary())
t$ = peek string(dwary(i))
strary(i)= t$
print strary(i)
next i
undim dwary()
free memptr
sync
wait key
end
// memtype: 1=Memblock, 2=Bank, 3=Alloc memory
function CreateZeroedMemory(memtype,memsz)
if (memtype <1 or memtype>3) or memsz<=0
exitfunction -1
endif
// memblock
if memtype = 1
memid=find free memblock()
make memblock memid,memsz
for b=0 to memsz-1
write memblock byte memid,b,0
next b
`memptr=get memblock ptr (memid)
r=memid
endif
// bank
if memtype = 2
memid=find free bank()
make bank memid,memsz
for b=0 to memsz-1
write bank byte memid,b,0
next b
`memptr=get bank ptr (memid)
r=memid
endif
// alloc
if memtype = 3
memptr=alloc zeroed(memsz) // returns pointer to an address of memory
r=memptr
endif
endfunction r
// CURRENTLY WORKING ON //
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
if vtype = 0 or vtype = 1 or vtype = 6
loopstep=4
else
if vtype=2
loopstep=1
else
if vtype=3 or vtype=4
loopstep=1
else
if vtype=3 or vtype=4
loopstep=1
else
if vtype=5
loopstep=2
else
if vtype = 7 or vtype = 8
loopstep = 8
endif
endif
endif
endif
endif
endif
index=1
stpos=mptr
bpos=-1
for addr = mptr to (mptr+msz)-loopstep step loopstep
iptr = aryptr+get arrayptr item ptr(aryptr,index)
if vtype=0
value=peek integer(addr)
poke integer iptr,value
endif
if vtype=1
value#=peek float(addr)
poke float iptr,value#
endif
if vtype=2
inc bpos
b=peek byte(addr)
b1=peek byte(addr+1)
if b=0 and b1=0 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
endif
if vtype=3
value=peek byte(addr)
poke byte iptr,value
endif
if vtype=4
value=peek byte(addr)
poke byte iptr,value
endif
if vtype=5
value=peek word(addr)
poke word iptr,value
endif
if vtype=6
value=peek dword(addr)
poke dword iptr,value
endif
if vtype=7
value=peek double float(addr)
poke double float iptr,value
endif
if vtype=8
value=peek double integer(addr)
poke double integer iptr,value
endif
inc index
next addr
endfunction
Professional Programmer, languages: SAS, C++, SQL, PL-SQL, DBPro, Purebasic, JavaScript, others
