array(sort, (l, NOCASE)) works.
I get about .88 seconds for the sort and about .7 for the scan.
My machine is obviously slower than yours.
For the syntax_test_sort.bas I had to change all to uppercase.
Code: Select all
'#COMPILER FREEBASIC
'#compile console 32 exe /o "-pp -maxerr 10"
'#compile console 32 exe /o "-gen gcc"
'#compile console 64 exe
#include "ustring.bi"
#include "array.bi"
type testtype
i as long
n as byte
end type
private Function custom_sort_proc (byref a as testtype, byref b as testtype, byval flag as integer) as long
'***********************************************************************************************
' sample custom sort proc, byref parameters, flag > 0 -> sort up, flag <= 0 -> sort down
'***********************************************************************************************
if flag > 0 then
if a.n > b.n then
return 1
end if
else
if a.n < b.n then
return 1
end if
end if
return 0
end function
'***********************************************************************************************
'const sort = 1 'this works
'#define sort 1 'this doesn´t
' i can have CONSTs, ENUMs, procedures and variables with the keywords name´s (sort, etc.)
' but obviously i cannot not have #DEFINEs for these words !
'dim a(1 to 5) as string '* 16
'dim a() as zstring * 16
dim a(1 to 5) as zstring * 16
'dim as integer a1 '= 0
'dim as integer a2 '= 0
'dim b(1 to 1000000) as byte
dim b(1 to 5) as byte
dim c(1 to 5) as testtype
dim limit as long = 1000000
'redim d(1 to limit) as byte'double
redim d(1 to limit) as double
redim d2(1 to limit) as double
dim i as long
'randomize timer
for i = 1 to limit
d(i) = rnd '* 255
d2(i) = d(i)
next i
'redim a(1 to 5) 'as zstring * 16
'print "a1: "; hex(@a1), hex(a1)
'print "a2: "; hex(@a2), hex(a2)
'print "desc a(): "; hex(fb_ArrayDesc(a(), 60))
'print "desc b(): "; hex(fb_ArrayDesc(b(), 60))
'
'
'a(1)="test"
'print hex(@a(1)), a(1)
'print hex(@a(2)), a(2)
'print hex(@a(5)), a(5)
sub setupa(a() as zstring)
dim i as long
'dim n as long
'print "setupa"
'print sizeof(a)
'print array(sizeof, a)
'print hex(array(data, a)) 'address correct!
'print sizeof(a(1))
'print sizeof(a(2))
'print sizeof(a(3))
'print sizeof(a(4))
'print sizeof(a(5))
'print hex(@a(1)) 'address wrong in 64 bit, why ?
'print hex(@a(2)) 'a(1) + 16, which is expected
for i = 1 to 5
' for n = 4 to 7
' b(i,n) = i*10 + n
a(i) = "string" + str(i)
' a(i) = "1" 'gpf in 64 bit
' next n
next i
end sub
sub setupb(b() as byte)
dim i as long
'dim n as long
' for i = 1 to 1000000
for i = 1 to 5
' for n = 4 to 7
' b(i,n) = i*10 + n
b(i) = i
' next n
next i
end sub
sub setupc(c() as testtype)
dim i as long
'dim n as long
for i = 1 to 5
c(i).i = 100 - i
c(i).n = i
next i
end sub
'Sub show(d() As byte) 'double)
Sub show(d() as double)
For n As Long=Lbound(d) To 10
' For n As Long=Lbound(d) To ubound(d)
Print d(n)
Next
' For n As Long=1 To 4
Print "..."
' Next
For n As Long=Ubound(d)-10 To Ubound(d)
Print d(n)
Next
End Sub
sub showa(a() as zstring)
dim i as long
print err, "Error #"
for i = 1 to 5
print "-" + a(i) + "-" '+ hex(varptr(a(i)))
next i
end sub
sub showb(b() as byte)
dim i as long
'dim n as long
print err, "Error #"
for i = 1 to 5
' for n = 4 to 7
' print i,n, b(i,n)
print i, b(i)
' next n
next i
end sub
sub showc(c() as testtype)
dim i as long
'dim n as long
print err, "Error #"
for i = 1 to 5
print i, c(i).i, c(i).n
next i
end sub
'array(sort, (a, a), UP, at(1), 5) 'error
'array(sort, (a, a, NOCASE), UP, (1), 5) 'error
'array(sort, (a, b, NOCASES), UP, (1), 5) 'error
'array(sort, (b, a)UP) 'error
setupa(a())
'***********************************************************************************************
dim as double t 'timer
show(d())
print "**********************************"
print "array(sort, d, DOWN)"
t=timer
'array(sort, d, DOWN)
'array(sort, d)
'array(sort, (d2, d))
array(sort, d)
print "Time taken "; timer-t '0,26 (dedicated, without callback) / 0.33 (with 2 callbacks) / 0.35 sec (one callback [fb] with dflag)
show(d())
print
'***********************************************************************************************
' make dedicated functions, dflag before while loops
'***********************************************************************************************
dim n as long
for i as long = 1 to limit -1
if d(i) > d(i+1) then
n = n +1
if n = 1 then
print " error at", i
print d(i)
print d(i+1)
end if
end if
next i
print "# of errors:", n
sleep
'end
'***********************************************************************************************
setupb(b())
print "**********************************"
print "array(sort, b, DOWN)"
t=timer
array(sort, b, DOWN)
'array(sort, b)
print "Time taken "; timer-t
showb(b())
print
sleep
setupa(a())
print "**********************************"
print "array(sort, a)"
array(sort, a)
showa(a())
print
sleep
setupa(a())
print "**********************************"
print "array(sort, a, DOWN)"
array(sort, a, DOWN)
showa(a())
print
sleep
setupa(a())
setupb(b())
showb(b())
print "**********************************"
print "array(sort, (a, b), DOWN)"
array(sort, (a, b), DOWN)
showa(a())
showb(b())
print
sleep
setupa(a())
print "**********************************"
print "array(sort, (a, NOCASE), DOWN, (2), 3)"
array(sort, (a, NOCASE), DOWN, (2), 3)
showa(a())
sleep
print
print "**********************************"
print "array(sort, a, DOWN, (1), 5)"
array(sort, a, DOWN, (1), 5)
sleep
print
print "**********************************"
print "array(sort, a, UP, (1))"
array(sort, a, UP, (1))
sleep
print
print "**********************************"
print "array(sort, a, UP)"
array(sort, a, UP)
sleep
print
print "**********************************"
print "array(sort, (a, b), DOWN, (1), 5)"
array(sort, (a, b), DOWN, (1), 5)
sleep
print
print "**********************************"
print "array(sort, (a, b, NOCASE), UP, (1), 5)"
array(sort, (a, b, NOCASE), UP, (1), 5)
sleep
print
setupc(c())
print "**********************************"
print "array(sort, c, @custom_sort_proc)"
array(sort, c, @custom_sort_proc)
showc(c())
sleep
print
setupc(c())
print "**********************************"
print "array(sort, c, @custom_sort_proc, (2), 3)"
array(sort, c, @custom_sort_proc, (2), 3)
showc(c())
sleep
print "**********************************"
print
end
'***********************************************************************************************
'***********************************************************************************************
'***********************************************************************************************
So generally I must write those instructions in uppercase.
Thanks JK.