I need someone to defeat my string splitting algo

General FreeBASIC programming questions.
Post Reply
fxm
Moderator
Posts: 12107
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: I need someone to defeat my string splitting algo

Post by fxm »

By compiling without the option '-exx', all access time should be equal, because they all correspond, behind the FreeBASIC code, to a pointer dereferencing.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: I need someone to defeat my string splitting algo

Post by grindstone »

Maybe the various execution times do arise from different hardware and/or OSs. My equipment is rather old, my CPU (Pentium IV) has only one core (although hyperthreading). This could explain the different behaviour.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: I need someone to defeat my string splitting algo

Post by dodicat »

I checked out boolean for access time.
Not too good really.

Code: Select all

Dim As Integer n = 1000000
Dim As Double t
dim as integer ii
dim as byte b
dim as ubyte g
dim as boolean bl
t = Timer
For I As Integer = 1 To 1
  Scope
    Dim As String s = String(n*Sizeof(Integer), 0)
    ''''' user code
    for j as integer=1 to 100000000
     g=s[0]
     next j
  End Scope
Next I
t = Timer - t
Print "string(string, )", t
sleep 50
t = Timer
For I As Integer = 1 To 1
  Scope
    Dim As Integer Ptr p = New Integer[n]
    ''''' user code
    for j as integer=1 to 100000000
    ii=p[0]
    next j
    Delete[] p
  End scope
Next I
t = Timer - t
Print "new integer     ", t
sleep 50
t = Timer
For I As Integer = 1 To 1
  Scope
    Dim As byte Ptr p = New byte[n]
    ''''' user code
    for j as integer=1 to 100000000
    ii=p[0]
    next j
    Delete[] p
  End scope
Next I
t = Timer - t
Print "new byte       ", t
sleep 50
t = Timer
For I As Integer = 1 To 1
  Scope
    Dim As Integer Ptr p = Callocate(n, Sizeof(Integer))
    ''''' user code
    for j as integer=1 to 100000000
    b=p[0]
    next j
    Deallocate p
  End Scope
Next I
t = Timer - t
Print "Callocate( )    ", t
sleep 50
t = Timer
For I As Integer = 1 To 1
  Scope
    Dim As Integer Ptr p = Allocate(n*Sizeof(Integer))
    Clear p[0], 0, n*Sizeof(Integer)
    ''''' user code
    for j as integer=1 to 100000000
    ii=p[0]
    next j
    Deallocate p
  End Scope
Next I
t = Timer - t
Print "allocate( )    ", t
sleep 50
t = Timer
For I As Integer = 1 To 1
  Scope
    Dim As String s = space(n*Sizeof(Integer))', 0)
    ''''' user code
    for j as integer=1 to 100000000
    g=s[0]
    next j
  End Scope
Next I
t = Timer - t
Print "string space( )    ", t
sleep 50
t = Timer
For I As Integer = 1 To 1
  Scope
    Dim As byte s(n)',  = String(n*Sizeof(Integer), 0)
    for j as integer=1 to 100000000
    b=s(0)
    next j
    ''''' user code
  End Scope
Next I
t = Timer - t
Print "byte()         ", t
sleep 50
t = Timer
For I As Integer = 1 To 1
  Scope
    Dim As boolean s(n)',  = String(n*Sizeof(Integer), 0)
    for j as integer=1 to 100000000
    bl=s(0)
    next j
    ''''' user code
  End Scope
Next I
t = Timer - t
Print "bool()         ", t
print
print
print "Done"


Sleep 
I have altered my splitter to accommodate the boolean type.
(I cannot try boolean ptr=new boolean[~ ])
It crashes.

Code: Select all

 

'=============================================================================
Function string_split(s_in As String,chars As String,result() As String) As Long
    Dim As Long ctr,ctr2,k,n,LC=len(chars)
    dim As boolean tally(Len(s_in))
    #macro check_instring()
        n=0
        while n<Lc
        If s_in[k]=chars[n] Then 
        tally(k)=true
        If ctr2>1 Then ctr+=1
        ctr2=0
        exit while
        end if
        n+=1
    wend
    #endmacro
   
    #macro split()
    If tally(k) Then
        If ctr2>1 Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)
        ctr2=0
    End If
    #endmacro
    '==================  LOOP TWICE =======================
    For k  =0 To Len(s_in)-1
        ctr2+=1:check_instring()
    Next k
    If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else : Return 0
    For k  =0 To Len(s_in)-1
        ctr2+=1:split()
    Next k
    '===================== Last one ========================
    If ctr2>0 Then
        Redim Preserve result(1 To ctr+1)
        result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)
    End If
    Return Ubound(result)
End Function
'=================================================================
'create a string
Function rnd_range (first As Double, last As Double) As Double
    Function = Rnd * (last - first) + first
End Function
Dim As String txt
For x As Integer = 1 To 1000000
    Var  c = Chr(rnd_range(97, 122))
    txt &= c      
Next

Print txt  'OPTIONAL
Redim As String atxt()


Print
Print "text length = ";Len(txt)
Dim As Double t=Timer
Print "Array has ";string_split( txt, "abcdef", aTxt());" items"
Print "time = ";Timer-t
'print some
Print "Some results:"
If Ubound(atxt)<>-1 Then
    Print
    For n As Integer=Lbound(atxt) To 10
        Print "array(";Str(n);") = "; atxt(n)
    Next n
    For i As Integer=1 To 10
        Print "..."
    Next i
    For n As Integer=Ubound(atxt)-10 To Ubound(atxt)
        Print "array(";Str(n);") = "; atxt(n)
        
    Next n
Else
    Print "NONE"
End If


Sleep 
fxm
Moderator
Posts: 12107
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: I need someone to defeat my string splitting algo

Post by fxm »

dodicat wrote:I have altered my splitter to accommodate the boolean type.
(I cannot try boolean ptr=new boolean[~ ])
It crashes.
That works for me:

Code: Select all

'=============================================================================
Function string_split(byref s_in As String, byref chars As String, result() As String) As Long
    Dim As Long ctr,ctr2,k,n,LC=len(chars)
    dim As boolean ptr tally = new boolean[Len(s_in)]
    #macro check_instring()
        n=0
        while n<Lc
        If s_in[k]=chars[n] Then
        tally[k]=true
        If ctr2>1 Then ctr+=1
        ctr2=0
        exit while
        end if
        n+=1
    wend
    #endmacro
   
    #macro split()
    If tally[k] Then
        If ctr2>1 Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)
        ctr2=0
    End If
    #endmacro
    '==================  LOOP TWICE =======================
    For k  =0 To Len(s_in)-1
        ctr2+=1:check_instring()
    Next k
    If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else : Delete[] tally : Return 0
    For k  =0 To Len(s_in)-1
        ctr2+=1:split()
    Next k
    '===================== Last one ========================
    If ctr2>0 Then
        Redim Preserve result(1 To ctr+1)
        result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)
    End If
    Delete[] tally
    Return Ubound(result)
End Function
'=================================================================
'create a string
Function rnd_range (byval first As Double, byval last As Double) As Double
    Function = Rnd * (last - first) + first
End Function
Dim As String txt
For x As Integer = 1 To 1000000
    Var  c = Chr(rnd_range(97, 122))
    txt &= c     
Next

Print txt  'OPTIONAL
Redim As String atxt()


Print
Print "text length = ";Len(txt)
Dim As Double t=Timer
Print "Array has ";string_split( txt, "abcdef", aTxt());" items"
Print "time = ";Timer-t
'print some
Print "Some results:"
If Ubound(atxt)<>-1 Then
    Print
    For n As Integer=Lbound(atxt) To 10
        Print "array(";Str(n);") = "; atxt(n)
    Next n
    For i As Integer=1 To 10
        Print "..."
    Next i
    For n As Integer=Ubound(atxt)-10 To Ubound(atxt)
        Print "array(";Str(n);") = "; atxt(n)
       
    Next n
Else
    Print "NONE"
End If


Sleep 
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: I need someone to defeat my string splitting algo

Post by dodicat »

Yea-OK fxm.
I must have done a typo.
Thanks.
StringEpsilon
Posts: 42
Joined: Apr 09, 2015 20:49

Re: I need someone to defeat my string splitting algo

Post by StringEpsilon »

BTW, directly manipulating the string structure is not just faster because you can skip sanity checks (and the function-call overhead). The runtime also allocates string-memory in chunks of 36 byte. This safes time in concatenations, but if you have a lot of string allocations the amount of extra memory allocated stacks up.

When using the FB internal algorithms for allocation size of the new string, I loose a lot of my advantage in fastMid()
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: I need someone to defeat my string splitting algo

Post by grindstone »

Just for amusement, I played a little with assembly code. Not quite the improvement I'd expected, but still...

Code: Select all

Sub splitOver2(txts As String, delim As String, outArr() As String)

	Dim As String txt = txts + delim
	
	Dim As Integer x, p3 = Len(txt) - 1, dm = Len(delim) - 1, count = Int(Len(txt)/8)+1
	Dim As Integer Ptr bpp = Callocate(Len(txt)*2, SizeOf(Integer))
	Dim As String tally = String(count*8, Chr(0)), dla, g 
	Dim As tStrDescr Ptr gp = Cast(tStrDescr Ptr, @g)
	Dim As Integer spp = Cast(Integer, StrPtr(txt))
	Dim As Integer tpp = Cast(Integer, StrPtr(tally))
	Dim As Integer dpp = Cast(Integer, StrPtr(dla))
	Dim As Any Ptr tap = bpp
	
	For x = 0 To dm
		dla = String(8,Chr(delim[x]))
		dpp = Cast(Integer, StrPtr(dla))
		
		Asm
		  mov ecx,[count]     'loop count (Int(Len(txt)/8)+1)
		  mov esi,[dpp]       'pointer to delimiter
			movq mm3,[esi]		  'load 8x delimiter
		  mov esi,[spp]       'pointer to text string
		  mov edi,[tpp]       'pointer to tally string
		  cloop:              
			  movq mm4,mm3      '8x delimiter
			  pcmpeqb mm4,[esi] 'compare 8 bytes of text with delimiter
			  por mm4,[edi]     'OR result with tally
			  movq [edi],mm4    'store in tally
			  Add esi,8
			  Add edi,8
			Loop cloop          'next 8 characters
			emms
		End Asm
	Next	
		
	ReDim outArr(p3)
	count = 0
	Asm
		mov eax,[tap]
		movd mm2,eax
		mov edi,[tpp]        'pointer to temp-array
		dec edi              'set pointer ahead of string
		mov esi,[tpp]        'pointer to tallystring
		Add esi,[p3]         'text end
		inc esi              'text end + 1
f1:	inc edi
		cmp edi,esi
		je quit
		mov al,[edi]
		cmp al,0
		jne f1
		'found begin of substring
		' calculate offset
		movd mm1,edi         'memorise tally pointer
		mov ebx,edi          'load ebx with actual tally pointer
		Sub ebx,[tpp]        'subtract memorised tally pointer = offset
		Add ebx,[spp]        'offset + text string pointer = actual text pointer
		movd eax,mm2
		mov [eax],ebx
		'search for substring end
f2:	inc edi
		cmp edi,esi
		je quit
		mov al,[edi]
		cmp al,0
		je f2
		' calculate substring length
		mov ebx,edi
		movd eax,mm1
		Subd ebx,eax         'text length
		movd eax,mm2
		mov [eax + 4],ebx
		Add eax,8
		movd mm2,eax         'pointer to next buffer element
		mov ebx,[count]
		inc ebx
		mov [count],ebx
		jmp f1
quit:			
		emms
	End Asm

	For x = 0 To count - 1
		gp->txtPtr = Cast(Any Ptr,bpp[x*2])
		gp->txtLen = bpp[x*2+1]
		gp->txtMem = gp->txtLen
		outArr(x) = g
	Next
	gp->txtPtr = 0
	gp->txtLen = 0
	gp->txtMem = 0

	ReDim Preserve outArr(count - 1)
	DeAllocate bpp

End Sub
Last edited by grindstone on Apr 21, 2016 20:06, edited 2 times in total.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: I need someone to defeat my string splitting algo

Post by dodicat »

Very fast.
You are missing the last element of "abcdef" in the million string.
You have gylxvxxvvioqrmxvoxgixruoi
It should be
gylxvxxvvioqrmxvoxgixruoi
then
jmprulripmtru
as the final element.
Pity, because your asm method would be the fastest yet by a good margin.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: I need someone to defeat my string splitting algo

Post by grindstone »

Yes, I see. The simplest way to fix it is to let the text string surely end with a delimiter. I amended the code above.
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: I need someone to defeat my string splitting algo

Post by Tourist Trap »

Hello, fxm, grindstone, dodicat, sancho2, and others (I'm only refering to the last pages for the topic is too long and technically dense for me),

A simple question: what's the winner algorithm in the whole set of proposals? There is so much variants that we get easily lost, and this work can really be a great starting point for a text processing program.
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: I need someone to defeat my string splitting algo

Post by dodicat »

Grindstones asm code was fastest (32 bit only)
Mine wasn't too bad, and only uses simple code (no asm/pointers/UDT's)

Code: Select all

Function StringSplit(s_in As String,chars As String,result() As String) As Long
    Dim As Long ctr,ctr2,k,n,LC=len(chars)
    dim As boolean tally(Len(s_in))
    #macro check_instring()
        n=0
        while n<Lc
        If chars[n]=s_in[k] Then 
        tally(k)=true
        If (ctr2-1) Then ctr+=1
        ctr2=0
        exit while
        end if
        n+=1
       wend
    #endmacro
   
    #macro split()
    If tally(k) Then
        If (ctr2-1) Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)
        ctr2=0
    End If
    #endmacro
    '==================  LOOP TWICE =======================
    For k  =0 To Len(s_in)-1
        ctr2+=1:check_instring()
    Next k
    If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else  Return 0
    For k  =0 To Len(s_in)-1
        ctr2+=1:split()
    Next k
    '===================== Last one ========================
    If ctr2>0 Then
        Redim Preserve result(1 To ctr+1)
        result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)
    End If
    Return Ubound(result)
End Function
'====================================================================================

dim as string s="0123456789ab"
for n as long=1 to 20
    s+=s
next
print "string length ";len(s)
Print "string looks like:"
Print Mid(s,1,60)+ "  ...  "
Print "Split by any numerical character:" 
redim as string a()
dim as double t1=timer,t2
stringsplit(s,"0123456789",a())
t2=Timer
Print "array"
print lbound(a),"to",ubound(a)
print a(lbound(a)),a((ubound(a)/2)),a(ubound(a))
Print "time "; t2-t1
sleep
 
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: I need someone to defeat my string splitting algo

Post by Tourist Trap »

dodicat wrote:Grindstones asm code was fastest (32 bit only)
Mine wasn't too bad, and only uses simple code (no asm/pointers/UDT's)
Thanks a lot dodi, I agree with you that ASM would limit the range of the portability of a program. I take yours if don't see anything wrong in doing so! Thanks again for the answer.
fxm
Moderator
Posts: 12107
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: I need someone to defeat my string splitting algo

Post by fxm »

Without polemic on coding types and execution times, I just want to highlight here that result is slightly different depending on the different proposed functions.

When the string to split begins by the delimiter (or finishes by the delimiter), one can consider that there is nothing before (or after), or else (as me) that the delimiter is here to specify that there is an empty string before it (or after it)?
Same behavior if 'n' adjacent delimiters are inside the string to split: this adds 'n-1' empty strings?
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: I need someone to defeat my string splitting algo

Post by dodicat »

A little test.
The alphabet repeated over and over until about 850 thousand digits.
Then a testing loop
This string is either cycled (one digit cyclic per loop), or just mixed up.
If cycled then a string digit is always separated from itself by 25 places. I.E. no doubles appear.
If mixed then any combination can result.
The string is split by every letter except z, so only z's are loaded into the splitting array.
The choice is yours to cycle the string or mix the string (lines 66/67)
RESULTS:

Code: Select all

Function StringSplit(s_in As String,chars As String,result() As String) As Long
    Dim As Long ctr,ctr2,k,n,LC=len(chars)
    dim As boolean tally(Len(s_in))
    #macro check_instring()
        n=0
        while n<Lc
        If chars[n]=s_in[k] Then 
        tally(k)=true
        If (ctr2-1) Then ctr+=1
        ctr2=0
        exit while
        end if
        n+=1
       wend
    #endmacro
   
    #macro split()
    If tally(k) Then
        If (ctr2-1) Then ctr+=1:result(ctr)=Mid(s_in,k+2-ctr2,ctr2-1)
        ctr2=0
    End If
    #endmacro
    '==================  LOOP TWICE =======================
    For k  =0 To Len(s_in)-1
        ctr2+=1:check_instring()
    Next k
    If ctr Then Redim result(1 To ctr): ctr=0:ctr2=0 Else  Return 0
    For k  =0 To Len(s_in)-1
        ctr2+=1:split()
    Next k
    '===================== Last one ========================
    If ctr2>0 Then
        Redim Preserve result(1 To ctr+1)
        result(ctr+1)=Mid(s_in,k+1-ctr2,ctr2)
    End If
    Return Ubound(result)
End Function
'====================================================================================
#define range(f,l) int(Rnd*((l+1)-(f))+(f))
#define idx(s) range(0,(len(s)-1))

dim as string s="abcdefghijklmnopqrsruvwxyz"
for n as long=1 to 15
    s+=s
next

#macro mix(s)
for n as long=1 to len(s)
    swap s[idx(s)],s[idx(s)]
next
#endmacro

#macro Cycle(p,n)
for y as integer=1 to (n)
For z As Integer=0 To len((p))-2
    Swap (p)[z],(p)[z+1]
Next z
next y
#endmacro
screen 19
do
    screenlock
    cls
    locate 1

cycle(s,1)
'mix(s)

print "string length ";len(s)

Print "string looks like:"
Print Mid(s,1,75)+ "  ...  "
Print "Split by every letter except z:" 
redim as string a()
dim as double t1=timer,t2
stringsplit(s,"abcdefghijklmnopqrsruvwxy",a())
t2=Timer
Print "array"
print lbound(a),"to",ubound(a)
if ubound(a)<>-1 then
print a(lbound(a)),a((ubound(a)/2)),a(ubound(a))
end if
Print "time "; t2-t1
sleep 1,1 
screenunlock
loop until inkey=chr(27)
  
marpon
Posts: 342
Joined: Dec 28, 2012 13:31
Location: Paris - France

Re: I need someone to defeat my string splitting algo

Post by marpon »

hi dodicat

your stringsplit function is doing what strtok does in c , in my vision not as split function was doing in vb

but if you want a much faster (arround 3 times...) use the original strtok from the c lib ( #include "crt/string.bi")

here under is the file for tests with my new proposal ,i have also included yours and the asm sub too. (can change the tests, see line 250+)

the fastest by far is my string_strtok function...

Code: Select all

#include "crt/string.bi"   'needed for strtok function

'using strtok(s1 as zstring ptr, s2 as zstring ptr) as zstring ptr
Function String_strtok(s_in As String , chars As String , result() As String) As Long
   Dim As Long 			ctr   
	dim as zstring ptr	p, p1, p2
	dim as long				i1 
	dim as string s2 = s_in 'copy because strtok alter the input zstring
	
	p = strptr(s2)				'get pointers
	p2= strptr(chars)
	
	p1 = strtok(p , p2)
	while p1 <> NULL 			' counting only
		ctr +=1
		p1 = strtok(NULL, p2)
	WEND
	
   If ctr Then
		Redim result(1 To ctr) 'redim the array
	Else 
		Return 0
	end if 
 
   s2 = s_in 					'copy again because strtok alter the input zstring
	
	p1 = strtok(p , p2)
	while i1 < ctr
		i1 += 1
		result(i1) = *p1		'fill the array 
		p1 = strtok(NULL, p2)
	WEND

   Return Ubound(result)
End Function
'====================================================================================



Function StringSplit(s_in As String , chars As String , result() As String) As Long
   Dim As Long ctr , ctr2 , k , n , LC = len(chars)
   dim         As boolean tally(Len(s_in))
   #macro check_instring()
      n = 0
      while n < Lc
         If chars[n] = s_in[k] Then
            tally(k) = true
            If (ctr2 - 1) Then ctr += 1
            ctr2 = 0
            exit while
         end if
         n += 1
      wend
   #endmacro
   
   #macro split()
      If tally(k) Then
         If (ctr2 - 1) Then ctr += 1 : result(ctr) = Mid(s_in , k + 2 - ctr2 , ctr2 - 1)
         ctr2 = 0
      End If
   #endmacro
   '================== LOOP TWICE =======================
   For k = 0 To Len(s_in) - 1
      ctr2 += 1 : check_instring()
   Next k
   If ctr Then Redim result(1 To ctr) : ctr = 0 : ctr2 = 0 Else Return 0
   For k = 0 To Len(s_in) - 1
      ctr2 += 1 : split()
   Next k
   '===================== Last one ========================
   If ctr2 > 0 Then
      Redim Preserve result(1 To ctr + 1)
      result(ctr + 1) = Mid(s_in , k + 1 - ctr2 , ctr2)
   End If
   Return Ubound(result)
End Function
'====================================================================================




#ifdef __FB_64BIT__  /'  to not compile under 64 bits  ...'/ 
Sub splitOver2(txts As String, delim As String, outArr() As String)
	print "That function will not work in 64 bits system , please compile with 32 bits compiler
end sub
#else   					/'  32 bits ...'/ 
Type tStrDescr
   txtPtr As UByte Ptr
   txtLen As Ulong
   txtMem As Ulong
End Type

Sub splitOver2(txts As String, delim As String, outArr() As String)

   Dim As String txt = txts + delim
   
   Dim As long x, p3 = Len(txt) - 1, dm = Len(delim) - 1, count = Int(Len(txt)/8)+1
   Dim As long Ptr bpp = Callocate(Len(txt)*2, SizeOf(long))
   Dim As String tally = String(count*8, Chr(0)), dla, g
   Dim As tStrDescr Ptr gp = Cast(tStrDescr Ptr, @g)
   Dim As long spp = Cast(long, StrPtr(txt))
   Dim As long tpp = Cast(long, StrPtr(tally))
   Dim As long dpp = Cast(long, StrPtr(dla))
   Dim As Any Ptr tap = bpp
   
   For x = 0 To dm
      dla = String(8,Chr(delim[x]))
      dpp = Cast(long, StrPtr(dla))
      
      Asm
        mov ecx,[count]     'loop count (Int(Len(txt)/8)+1)
        mov esi,[dpp]       'pointer to delimiter
         movq mm3,[esi]        'load 8x delimiter
        mov esi,[spp]       'pointer to text string
        mov edi,[tpp]       'pointer to tally string
        cloop:             
           movq mm4,mm3      '8x delimiter
           pcmpeqb mm4,[esi] 'compare 8 bytes of text with delimiter
           por mm4,[edi]     'OR result with tally
           movq [edi],mm4    'store in tally
           Add esi,8
           Add edi,8
         Loop cloop          'next 8 characters
         emms
      End Asm
   Next   
      
   ReDim outArr(p3)
   count = 0
   Asm
      mov eax,[tap]
      movd mm2,eax
      mov edi,[tpp]        'pointer to temp-array
      dec edi              'set pointer ahead of string
      mov esi,[tpp]        'pointer to tallystring
      Add esi,[p3]         'text end
      inc esi              'text end + 1
f1:   inc edi
      cmp edi,esi
      je quit
      mov al,[edi]
      cmp al,0
      jne f1
      'found begin of substring
      ' calculate offset
      movd mm1,edi         'memorise tally pointer
      mov ebx,edi          'load ebx with actual tally pointer
      Sub ebx,[tpp]        'subtract memorised tally pointer = offset
      Add ebx,[spp]        'offset + text string pointer = actual text pointer
      movd eax,mm2
      mov [eax],ebx
      'search for substring end
f2:   inc edi
      cmp edi,esi
      je quit
      mov al,[edi]
      cmp al,0
      je f2
      ' calculate substring length
      mov ebx,edi
      movd eax,mm1
      Subd ebx,eax         'text length
      movd eax,mm2
      mov [eax + 4],ebx
      Add eax,8
      movd mm2,eax         'pointer to next buffer element
      mov ebx,[count]
      inc ebx
      mov [count],ebx
      jmp f1
quit:         
      emms
   End Asm

   For x = 0 To count - 1
      gp->txtPtr = Cast(Any Ptr,bpp[x*2])
      gp->txtLen = bpp[x*2+1]
      gp->txtMem = gp->txtLen
      outArr(x) = g
   Next
   gp->txtPtr = 0
   gp->txtLen = 0
   gp->txtMem = 0

   ReDim Preserve outArr(count - 1)
   DeAllocate bpp

End Sub
'====================================================================================
#endif	/'  end 32 bits ...'/ 





'====================================================================================
'		tests
'====================================================================================

#define range(f,l) int(Rnd*((l+1)-(f))+(f))
#define idx(s) range(0,(len(s)-1))

dim as string s = "abcdefghijklmnopqrsruvwxyz"
for n as long = 1 to 15
   s += s
next

#macro mix(s)
   for n as long = 1 to len(s)
      swap s[idx(s)] , s[idx(s)]
   next
#endmacro

#macro Cycle(p , n)
   for y as long = 1 to(n)
      For z As long = 0 To len((p)) - 2
         Swap(p)[z] ,(p)[z + 1]
      Next z
   next y
#endmacro
screen 19
dim as double t1 , t2
do
   screenlock
   cls
   locate 1
	
   '====================================================================================	
	'choose option under
	'====================================================================================
	
   cycle(s , 1)
   'mix(s)
	
	'====================================================================================
   
   print "string length " ; len(s)
   
   Print "string looks like:"
   Print Mid(s , 1 , 75) + "  ...  "
   Print "Split by every letter except z:"
   redim as string a()
   t1 = timer 
	
	
	'====================================================================================	
	'choose the one to test under
	'====================================================================================
		
	'stringsplit(s , "z" , a())
	'string_strtok(s , "z" , a())
	'splitOver2(s , "z" , a())
   'stringsplit(s , "abcdefghijklmnopqrsruvwxy" , a())
	string_strtok(s , "abcdefghijklmnopqrsruvwxy" , a())
	'splitOver2(s , "abcdefghijklmnopqrsruvwxy" , a())
	
	'====================================================================================
	
   t2 = Timer
   Print "array"  
   if ubound(a) <> - 1 then
		print lbound(a) , "to" , ubound(a)
      print a(lbound(a)) , a((ubound(a) / 2)) , a(ubound(a))
   end if
   Print : Print "time " ; t2 - t1
   sleep 1 , 1
   screenunlock
loop until inkey = chr(27)

Post Reply