Here is a piece of code that processes the concatenation of strings at high speed. I needed a way to export my DBO files to X format (including animated skinned meshes) in a fast way, so this code is utilized in that particular app. The code is undergoing optimisation, but the original code is here for now. Feel free to do with it what you want, improve and experiment with it:
[updated code 01Jul2018-now removed function CalcTotalStringBytes. ParseString function now returns string length and totsz is incremented with each call to ParseString, see updated code below]
Try changing the "iter" variable to a lot higher and compare time it takes to perform the concatenation using the traditional method to the faster alternative method.
Method 1
DWORD string ptr = FillMemWithString(s$,slen) -> calls FillMemWithString function
string length = ParseString(s$)
concat string bank ptr = ConcatStrings(bankid,totalbytes,iter)
DeallocateMemory(bankid)
fastfile$="debug_fast.txt"
iter=1000000
dim strptr()
DeleteFile(fastfile$)
open to write 1,fastfile$
timer()=0
startt=timer()
tlen=0
s$="This is my concatenated string " //+crnl
inc tlen,ParseString(s$)
s$="and its really cool " //+crnl
inc tlen,ParseString(s$)
s$="and very fast " //+crnl
inc tlen,ParseString(s$)
s$="and very flexible " //+crnl
inc tlen,ParseString(s$)
s$="and I love it."+crnl
inc tlen,ParseString(s$)
`print tlen
bid=reserve free bank()
bptr=ConcatStrings(bid,tlen,iter)
endt=timer()-startt
endt=endt/1000
write string 1,"duration (fast): "+str$(endt)
write string 1,peek string(bptr)
close file 1
sync
wait key
DeallocateMemory(bid)
message "finished ok."
end
//==============================================
// GENERAL STANDARD FUNCTIONS
function DeleteFile(f$)
if file exist(f$) then delete file f$
endfunction
//==============================================
// METHOD 1 FUNCTIONS
function FillMemWithString(s$,slen)
dwstr as dword
dwstr = make memory (slen+1)
fill memory dwstr,0,slen+1
poke string dwstr,s$
endfunction dwstr
function ParseString(s$)
slen = len(s$)
maddr=FillMemWithString(s$,slen)
array insert at bottom strptr()
strptr()=maddr
endfunction slen
function ConcatStrings(bankid,totalbytes,iter)
totalbytes = totalbytes*iter
make bank bankid,totalbytes+1
concat = get bank ptr(1)
fill memory concat,0,totalbytes
lastsz = 0
for i=1 to iter
for p=0 to array count(strptr())
if i=1 and p=0
poke string concat,peek string(strptr(p))
else
poke string concat+lastsz,peek string(strptr(p))
endif
inc lastsz, len(peek string(strptr(p)))
next p
next i
endfunction concat
function DeallocateMemory(bankid)
release reserved bank bankid
delete bank bankid
for p = 0 to array count(strptr())
delete memory strptr(p)
next p
undim strptr()
endfunction
Method 2
DWORD memory ptr = FastConcatStrings(tbytes,iter)
iter=1000000
numstrings=5
dim tmpptr(numstrings-1)
DeleteFile(fastfile$)
open to write 1,fastfile$
timer()=0
startt=timer()
s1$="This is my concatenated string " //+crnl
s2$="and its really cool " //+crnl
s3$="and very fast " //+crnl
s4$="and very flexible " //+crnl
s5$="and I love it."+crnl
tmpptr(0)=get string ptr(s1$)
tmpptr(1)=get string ptr(s2$)
tmpptr(2)=get string ptr(s3$)
tmpptr(3)=get string ptr(s4$)
tmpptr(4)=get string ptr(s5$)
for i = 0 to numstrings-1
// assigning the peek string to a var is slightly slower, however
// assigning the len to a var is slightly faster
tl=len(peek string(tmpptr(i)))
inc slen,tl
next i
saddr = FastConcatStrings(slen,iter)
endt=timer()-startt
endt=endt/1000
write string 1,"duration (fast): "+str$(endt)
write string 1,peek string(saddr)
close file 1
sync
wait key
message "finished ok."
function FastConcatStrings(tbytes,iter)
tbytes = tbytes*iter
cmem = make memory(tbytes+1)
fill memory cmem,0,tbytes
lastsz = 0
tmparycnt=array count(tmpptr())
for i=1 to iter
for p=0 to tmparycnt
if i=1 and p=0
poke string cmem,peek string(tmpptr(p))
else
poke string cmem+lastsz,peek string(tmpptr(p))
endif
inc lastsz, len(peek string(tmpptr(p)))
next p
next i
endfunction cmem
Method 3
#constant crnl chr$(13)+chr$(10)
fastfile$="debug_fast.txt"
iter=100000
nstr=5
dim tptr(nstr-1)
dim s$(nstr-1)
dim t$(nstr-1)
DeleteFile(fastfile$)
open to write 1,fastfile$
timer()=0
startt=timer()
// get array pointer for array holding list of strings
sptr = get arrayptr(s$())
s$="This is my concatenated string " //+crnl
AddConcatString(s$,0,sptr)
s$="and its really cool " //+crnl
AddConcatString(s$,1,sptr)
s$="and very fast " //+crnl
AddConcatString(s$,2,sptr)
s$="and very flexible " //+crnl
AddConcatString(s$,3,sptr)
s$="and I love it."+crnl
AddConcatString(s$,4,sptr)
s$=free string()
for i=0 to nstr-1
tptr(i)=get string ptr(s$(i))
tl=len(peek string(tptr(i)))
inc slen,tl
next i
saddr = FastConcatStrings(slen,iter)
endt=timer()-startt
endt=endt/1000
write string 1,"duration (fast): "+str$(endt)
write string 1,peek string(saddr)
close file 1
DeallocateMemory()
end
//==============================================
function AddConcatString(src$,i,iptr)
link array t$(), iptr
t$(i)=src$
unlink array t$()
endfunction
function FastConcatStrings(tb,iter)
tb = tb*iter
cmem = alloc(tb+1)
fill memory cmem,0,tb
lsz = 0
tcnt=array count(tptr())
for i=1 to iter
for p=0 to tcnt
if i=1 and p=0
poke string cmem,peek string(tptr(p))
else
poke string cmem+lsz,peek string(tptr(p))
endif
inc lsz, len(peek string(tptr(p)))
next p
next i
endfunction cmem
function DeallocateMemory()
tcnt=array count(tptr())
for p = 0 to tcnt
delete memory tptr(p)
next p
undim tptr()
endfunction
function DeleteFile(f$)
if file exist(f$) then delete file f$
endfunction
Method 4:
StrCat function to be updated using link array.
Rem ***** Main Source File *****
sync on : sync rate 0 : sync
#constant crnl chr$(13)+chr$(10)
dim strlist(4) as string
dim tptr(4) as dword
saryptr=get arrayptr(strlist())
taryptr=get arrayptr(tptr())
iter=1 ` 0 milliseconds to process
`iter=1000000 ` 2 seconds to process
`iter=2500000 ` 5 seconds to process
`iter=5000000 ` 10 seconds to process
timer()=0
starttm=timer()
s1$="This is string 1. "
StrAdd(s1$,saryptr,0)
s2$="This is string 2. "
StrAdd(s2$,saryptr,1)
s3$="This is string 3. "
StrAdd(s3$,saryptr,2)
s4$="This is string 4. "
StrAdd(s4$,saryptr,3)
s5$="This is string 5. "+crnl
StrAdd(s5$,saryptr,4)
sptr=StrCat(iter)
endtm=(timer()-starttm)
if endtm > 1000
endtm=endtm / 1000
units$="seconds"
else
units$="milliseconds"
endif
dumpfile$="dump.txt"
deletefile(dumpfile$)
open to write 1,dumpfile$
write string 1,str$(endtm)+" "+units$
write string 1,peek string(sptr)
close file 1
delete memory sptr
end
function StrAdd(s$,inptr,idx)
dim temp$(idx)
link array temp$(),inptr
temp$(idx)=s$
tptr(idx)=get string ptr(temp$(idx))
unlink array temp$()
undim temp$()
endfunction
function StrCat(iter)
tcnt=array count(tptr())
tb=0
for p=0 to tcnt
t$=peek string(tptr(p))
inc tb, len(t$)
next p
tb = tb*iter
cmem = alloc(tb+1)
fill memory cmem,0,tb
lsz = 0
for i=1 to iter
for p=0 to tcnt
if i=1 and p=0
poke string cmem,peek string(tptr(p))
else
poke string cmem+lsz,peek string(tptr(p))
endif
inc lsz, len(peek string(tptr(p)))
next p
next i
empty array strlist()
empty array tptr()
endfunction cmem
//==============================================
// GENERAL STANDARD FUNCTIONS
function DeleteFile(f$)
if file exist(f$) then delete file f$
endfunction
Method 4 (with updated StrCat which uses link array command)
Rem ***** Main Source File *****
sync on : sync rate 0 : sync
#constant crnl chr$(13)+chr$(10)
dim strlist$(4)
dim tptr(4)
saryptr=get arrayptr(strlist$())
taryptr=get arrayptr(tptr())
`iter=1 ` 0 milliseconds to process
`iter=100
`iter=500000 ` 1 seconds to process
iter=1000000 ` 2 seconds to process
`iter=2500000 ` 5 seconds to process
`iter=5000000 ` 10 seconds to process
timer()=0
starttm=timer()
s$="This is string 1. "
StrAdd(s$,saryptr,0)
s$="This is string 2. "
StrAdd(s$,saryptr,1)
s$="This is string 3. "
StrAdd(s$,saryptr,2)
s$="This is string 4. "
StrAdd(s$,saryptr,3)
s$="This is string 5. "+crnl
StrAdd(s$,saryptr,4)
sptr=StrCat(taryptr,iter)
endtm=(timer()-starttm)
if endtm > 1000
endtm=endtm / 1000
units$="seconds"
else
units$="milliseconds"
endif
dumpfile$="dump.txt"
deletefile(dumpfile$)
open to write 1,dumpfile$
write string 1,str$(endtm)+" "+units$
write string 1,peek string(sptr)
close file 1
undim strlist$()
undim tptr()
end
function StrAdd(s$,inptr,idx)
aryitems=get arrayptr count(inptr)
if idx > aryitems
warningmessage "idx value parsed "+str$(idx)+" exceeds array upper limit number of items ("+str$(aryitems)+"). exiting!"
exitfunction
endif
iptr=get arrayptr item ptr(inptr,idx)
dim t$(idx)
link array t$(),inptr
t$(idx)=s$
tptr(idx)=get string ptr(t$(idx))
unlink array t$()
undim t$()
endfunction
function StrCat(inptr,iter)
tcnt=get arrayptr count(inptr)
dim t(tcnt)
link array t(),inptr
tb=0
for p=0 to tcnt
inc tb, len( peek string(t(p)) )
next p
tb = tb*iter
cmem = alloc(tb+1)
fill memory cmem,0,tb
lsz = 0
for i=1 to iter
for p=0 to tcnt
if i=1 and p=0
poke string cmem,peek string(t(p))
else
poke string cmem+lsz,peek string(t(p))
endif
inc lsz, len(peek string(t(p)))
next p
next i
unlink array t()
undim t()
endfunction cmem
//==============================================
// GENERAL STANDARD FUNCTIONS
function DeleteFile(f$)
if file exist(f$) then delete file f$
endfunction
Professional Programmer, languages: SAS, C++, SQL, PL-SQL, DBPro, Purebasic, JavaScript, others
