News:

Building a 3D Ray Tracer  By stevmjon

Main Menu

PlayBASICFX / PBFX Vm2 Translation (WIP)

Started by kevin, September 08, 2008, 12:13:35 PM

Previous topic - Next topic

kevin

#15
   Redim Stress Test In Vm2.

   The past few sessions i've  basically been rewriting the array library.  Todays little task has been to tackle the redim command.  While the main logic is about as good as i can get it, however there we're some situations where it was moving data that didn't really need to.   While in most game situations this  is basically irrelevant (not enough data to notice),  the overhead is really magnified when running it through a stress test like the one bellow.

  Performance wise PB1.64 (Vm1) returns these results.

   Dim & redim 1d -  34.8 milliseconds
   Dim & redim 2d -  527.2 milliseconds

   PB1.73k (Vm2) returns these results.

   Dim & redim 1d -  13.1 milliseconds
   Dim & redim 2d -  82.6 milliseconds
 
   So in this particular case, Vm2 is running the 1D test about 2.6 times faster and the 2D test is about 6.3 times faster.  


PlayBASIC Code: [Select]
Size=50

max=10000
Do
Cls rgb(0,0,0)
inc frames

Memory=0
t=timer()
For lp=0 to max
Dim Table(Size)
reDim Table(Size*2)

next
t1#=t1#+(Timer()-t)
print "DIM & REDIM 1D:"+str$(t1#/frames)
Memory=Memory+(Max*Size)


t=timer()
For lp=0 to max
Dim Table(Size,Size)
reDim Table(Size+5,Size-5)
next
t2#=t2#+(Timer()-t)
print "DIM & REDIM 2D:"+str$(t2#/frames)

Memory=Memory+(Max*(Size*Size*2))

print "Integers:"+Str$(Memory)
Sync
loop





  UNdim / Typed arrays In Vm2.

PlayBASIC Code: [Select]
   Type Stuff
a
b#
names$(100)
EndType


Do
cls 0
inc frame
Dim Table(10) as Stuff

NameIndex=0
For lp=0 to 10
Table(lp) =new Stuff
Table(lp).a =1000+lp
Table(lp).b# =2000.0+lp
for n=0 to 100
Table(lp).names$(n) ="name:"+str$(nameindex)
inc nameindex
next
next

undim Table()
print "Free"+str$(frame)
Sync
Waitkey
waitnokey
loop



kevin

#16
   CopyArray on Vm2.

       Replaced the copy array function set.    It should be a bit faster than the original, as  most of copy methods are smarter.    Plus it leverages optimizations already made to the copy structure interface.   Will test that in a minute, first the test code.


PlayBASIC Code: [Select]
   Size=100
Dim SrcTable(size)
Dim DestTable(1)
For lp=0 to size
SrcTable(lp)=rnd(1000)
next

Dim SrcTableFlt#(size)
Dim DestTableFlt#(1)
For lp=0 to size
SrcTableFlt#(lp)=rnd(1000)
next

Dim SrcTableStr$(size)
Dim DestTableStr$(1)
For lp=0 to size
SrcTableStr$(lp)="text:"+Str$(rnd(1000))
next

Type Stuff
a
b#
names$(100)
EndType

Dim SrcTableTyped(10) as Stuff
Dim DestTableTyped(0) as Stuff

NameIndex=0
For lp=0 to 10
SrcTableTyped(lp) =new Stuff
SrcTableTyped(lp).a =1000+lp
SrcTableTyped(lp).b# =2000.0+lp
for n=0 to 100
SrcTableTyped(lp).names$(n) ="name:"+str$(nameindex)
inc nameindex
next
next

CopyArray SrcTable(),DestTable()
CopyArray SrcTableFlt#(),DestTableFlt#()
CopyArray SrcTableStr$(),DestTableStr$()
CopyArray SrcTableTyped(),DestTableTyped()

Sync
waitkey






  Benchmark

   The following test simply runs the CopyArray function 1000 times on Integer/Float/String and Typed arrays.    For purely data structures (int/float) this doesn't represent much of a challenge, but for anything that contains strings we get some serious memory thrashing.

   Results,

   Copy Integer Array:  Vm2 is 1.5 times faster than Vm1
   Copy Float Array:     Vm2 is 1.5 times faster than Vm1
   Copy String Array:   Vm2 is 7.7 times faster than Vm1
   Copy Typed Array:   Vm2 is 1.12 times faster than Vm1  

    Note: The typed array test copying  1 million strings btw  (10 types with 100 string * 1000 tests).  


PlayBASIC Code: [Select]
   Size=1000
Dim SrcTable(size)
Dim DestTable(1)
For lp=0 to size
SrcTable(lp)=rnd(1000)
next

Dim SrcTableFlt#(size)
Dim DestTableFlt#(1)
For lp=0 to size
SrcTableFlt#(lp)=rnd(1000)
next

Dim SrcTableStr$(size)
Dim DestTableStr$(1)
For lp=0 to size
SrcTableStr$(lp)="text:"+Str$(rnd(1000))
next

Type Stuff
a
b#
names$(100)
Table(100)
EndType

Dim SrcTableTyped(10) as Stuff
Dim DestTableTyped(0) as Stuff

NameIndex=0
For lp=0 to 10
SrcTableTyped(lp) =new Stuff
SrcTableTyped(lp).a =1000+lp
SrcTableTyped(lp).b# =2000.0+lp
for n=0 to 100
SrcTableTyped(lp).names$(n) ="name:"+str$(nameindex)
SrcTableTyped(lp).table(n)=nameIndex
inc nameindex
next
next


maxtests=1000

do
cls 0
inc frames

t=timer()
For lp=0 to maxtests
CopyArray SrcTable(),DestTable()
next
t1#=t1#+(timer()-t)
print "Copy Integer Array:"+str$(t1#/frames)


t=timer()
For lp=0 to maxtests
CopyArray SrcTableFlt#(),DestTableFlt#()
next
t2#=t2#+(timer()-t)
print "Copy Float Array:"+str$(t2#/frames)


t=timer()
For lp=0 to maxtests
CopyArray SrcTableStr$(),DestTableStr$()
next
t3#=t3#+(timer()-t)
print "Copy String Array:"+str$(t3#/frames)


t=timer()
For lp=0 to maxtests
CopyArray SrcTableTyped(),DestTableTyped()
next
t4#=t4#+(timer()-t)
print "Copy Typed Array:"+str$(t4#/frames)

Sync
loop






kevin

#17
   CopyArrayCells on Vm2.

  As per CopyArray, all of CopyArrayCells routines have been replacement.   Performance wise, it should be about the same as the copy array.  


PlayBASIC Code: [Select]
Size=100
Dim SrcTable(size)
Dim DestTable(size*2)
For lp=0 to size
SrcTable(lp)=rnd(1000)
next

Dim SrcTableFlt#(size)
Dim DestTableFlt#(size*2)
For lp=0 to size
SrcTableFlt#(lp)=rnd(1000)
next

Dim SrcTableStr$(size)
Dim DestTableStr$(size*2)
For lp=0 to size
SrcTableStr$(lp)="text:"+Str$(rnd(1000))
next

Type Stuff
a
b#
names$(100)
EndType

Dim SrcTableTyped(10) as Stuff
Dim DestTableTyped(10) as Stuff

NameIndex=0
For lp=0 to 10
SrcTableTyped(lp) =new Stuff
; DestTableTyped(lp) =new Stuff
SrcTableTyped(lp).a =1000+lp
SrcTableTyped(lp).b# =2000.0+lp
for n=0 to 100
SrcTableTyped(lp).names$(n) ="name:"+str$(nameindex)
inc nameindex
next
next


CopyArrayCells SrcTable() ,0,1,DestTable(),size+10,1,Size+1
CopyArrayCells SrcTableFlt#() ,0,1,DestTableFlt#(),size+10,1,Size+1
CopyArrayCells SrcTableStr$() ,0,1,DestTableStr$(),size+10,1,Size+1
CopyArrayCells SrcTableTyped() ,0,1,DestTabletyped(),5,1,6

Sync
waitkey






  Benchmark

   Results,

   Copy Integer Array Cells:  Vm2 is 6.25 times faster than Vm1
   Copy Float Array  Cells:     Vm2 is 5.1 times faster than Vm1
   Copy String Array Cells:   Vm2 is 1.24 times faster than Vm1
   Copy Typed Array Cells:   Vm2 is 6.5 times faster than Vm1  


PlayBASIC Code: [Select]
   Size=100

Dim SrcTable(size)
Dim DestTable(size*2)
For lp=0 to size
SrcTable(lp)=rnd(1000)
next

Dim SrcTableFlt#(size)
Dim DestTableFlt#(size*2)
For lp=0 to size
SrcTableFlt#(lp)=rnd(1000)
next

Dim SrcTableStr$(size)
Dim DestTableStr$(size*2)

For lp=0 to size
SrcTableStr$(lp)="text:"+Str$(rnd(1000))
next

Type Stuff
a
b#
names$(100)
EndType

Dim SrcTableTyped(10) as Stuff
Dim DestTableTyped(10) as Stuff

NameIndex=0

For lp=0 to 10
SrcTableTyped(lp) =new Stuff
DestTableTyped(lp) =new Stuff
SrcTableTyped(lp).a =1000+lp
SrcTableTyped(lp).b# =2000.0+lp
for n=0 to 100
SrcTableTyped(lp).names$(n) ="name:"+str$(nameindex)
inc nameindex
next
next




maxtests=1000

do
cls 0
inc frames

t=timer()
For lp=0 to maxtests
CopyArrayCells SrcTable() ,0,1,DestTable(),size+10,1,Size+1
next
t1#=t1#+(timer()-t)
print "Copy Integer Array Cells:"+str$(t1#/frames)


t=timer()
For lp=0 to maxtests
CopyArrayCells SrcTableFlt#() ,0,1,DestTableFlt#(),size+10,1,Size+1
next
t2#=t2#+(timer()-t)
print "Copy Float Array Cells:"+str$(t2#/frames)


t=timer()
For lp=0 to maxtests
CopyArrayCells SrcTableStr$() ,0,1,DestTableStr$(),size+10,1,Size+1
next
t3#=t3#+(timer()-t)
print "Copy String Array Cells:"+str$(t3#/frames)


t=timer()
For lp=0 to maxtests
CopyArrayCells SrcTableTyped() ,0,1,DestTabletyped(),5,1,6
next
t4#=t4#+(timer()-t)
print "Copy Typed Array Cells:"+str$(t4#/frames)

Sync
loop








kevin

#18
  ClearArrayCells on Vm2.

    Back working on the Vm2 translation.  So far today ClearArrayCells has been moved to Vm2.  It should be quicker, but the main change is that i've  been able to remove a few extra routines also, further reducing the runtime size.



Size=100
Dim SrcTable(size)
Dim DestTable(1)
For lp=0 to size
SrcTable(lp)=rnd(1000)
next

Dim SrcTableFlt#(size)
Dim DestTableFlt#(1)
For lp=0 to size
SrcTableFlt#(lp)=rnd(1000)
next

Dim SrcTableStr$(size)
Dim DestTableStr$(1)
For lp=0 to size
SrcTableStr$(lp)="text:"+Str$(rnd(1000))
next

Type Stuff
a
b#
names$(100)
EndType

Dim SrcTableTyped(10) as Stuff
Dim DestTableTyped(0) as Stuff

NameIndex=0
For lp=0 to 10
SrcTableTyped(lp) =new Stuff
SrcTableTyped(lp).a =1000+lp
SrcTableTyped(lp).b# =2000.0+lp
for n=0 to 100
SrcTableTyped(lp).names$(n) ="name:"+str$(nameindex)
inc nameindex
next
next



CopyArray SrcTable(),DestTable()   
CopyArray SrcTableFlt#(),DestTableFlt#()   
CopyArray SrcTableStr$(),DestTableStr$()   
CopyArray SrcTableTyped(),DestTableTyped()   

ClearArrayCells  DestTable(),0,1,5,4444.34
ClearArrayCells  DestTableFlt#(),0,1,5,123
ClearArrayCells  DestTableStr$(),0,1,5,"Cool Baby"
ClearArrayCells  DestTableTyped(),0,1,5,0

Sync
waitkey




   Benchmark

    Results,

    Copy & Clear Integer Array Cells:  Vm2 is 2.92 times faster than Vm1
    Copy & Clear Float Array  Cells:    Vm2 is 3.93 times faster than Vm1
    Copy & Clear String Array Cells:   Vm2 is 1.49 times faster than Vm1
    Copy & Clear Typed Array Cells:   Vm2 is 1.21 times faster than Vm1   




Size=100
Dim SrcTable(size)
Dim DestTable(1)
For lp=0 to size
SrcTable(lp)=rnd(1000)
next

Dim SrcTableFlt#(size)
Dim DestTableFlt#(1)
For lp=0 to size
SrcTableFlt#(lp)=rnd(1000)
next

Dim SrcTableStr$(size)
Dim DestTableStr$(1)
For lp=0 to size
SrcTableStr$(lp)="text:"+Str$(rnd(1000))
next

Type Stuff
a
b#
names$(100)
EndType

Dim SrcTableTyped(10) as Stuff
Dim DestTableTyped(0) as Stuff

NameIndex=0
For lp=0 to 10
SrcTableTyped(lp) =new Stuff
SrcTableTyped(lp).a =1000+lp
SrcTableTyped(lp).b# =2000.0+lp
for n=0 to 100
SrcTableTyped(lp).names$(n) ="name:"+str$(nameindex)
inc nameindex
next
next








maxtests=500

do
cls 0
inc frames

t=timer()
For lp=0 to maxtests
CopyArray SrcTable(),DestTable()   
ClearArrayCells  DestTable(),0,1,5,4444.34
next
t1#=t1#+(timer()-t)
print "Copy & Clear Integer Array Cells:"+str$(t1#/frames)


t=timer()
For lp=0 to maxtests
CopyArray SrcTableFlt#(),DestTableFlt#()   
ClearArrayCells  DestTableFlt#(),0,1,5,123
next
t2#=t2#+(timer()-t)
print "Copy & Clear Float Array Cells:"+str$(t2#/frames)


t=timer()
For lp=0 to maxtests
CopyArray SrcTableStr$(),DestTableStr$()   
ClearArrayCells  DestTableStr$(),0,1,5,"Cool Baby"
next
t3#=t3#+(timer()-t)
print "Copy & Clear String Array Cells:"+str$(t3#/frames)

t=timer()
For lp=0 to maxtests
CopyArray SrcTableTyped(),DestTableTyped()   
ClearArrayCells  DestTableTyped(),0,1,5,0
next
t4#=t4#+(timer()-t)
print "Copy & Clear Typed Array Cells:"+str$(t4#/frames)

Sync
loop


kevin


  ClearArray on Vm2.

 

Size=100
Dim SrcTable(size)
Dim DestTable(1)
For lp=0 to size
SrcTable(lp)=rnd(1000)
next

Dim SrcTableFlt#(size)
Dim DestTableFlt#(1)
For lp=0 to size
SrcTableFlt#(lp)=rnd(1000)
next

Dim SrcTableStr$(size)
Dim DestTableStr$(1)
For lp=0 to size
SrcTableStr$(lp)="text:"+Str$(rnd(1000))
next

Type Stuff
a
b#
names$(100)
EndType

Dim SrcTableTyped(10) as Stuff
Dim DestTableTyped(0) as Stuff

NameIndex=0
For lp=0 to 10
SrcTableTyped(lp) =new Stuff
SrcTableTyped(lp).a =1000+lp
SrcTableTyped(lp).b# =2000.0+lp
for n=0 to 100
SrcTableTyped(lp).names$(n) ="name:"+str$(nameindex)
inc nameindex
next
next

maxtests=1

do
cls 0
inc frames

t=timer()
For lp=0 to maxtests
CopyArray SrcTable(),DestTable()   
ClearArray  DestTable(),4444
next
t1#=t1#+(timer()-t)
print "Copy & Clear Integer Array:"+str$(t1#/frames)


t=timer()
For lp=0 to maxtests
CopyArray SrcTableFlt#(),DestTableFlt#()   
ClearArray  DestTableFlt#(),123.45
next
t2#=t2#+(timer()-t)
print "Copy & Clear Float Array:"+str$(t2#/frames)


t=timer()
For lp=0 to maxtests
CopyArray SrcTableStr$(),DestTableStr$()   
ClearArray  DestTableStr$(),"Cool Baby"
next
t3#=t3#+(timer()-t)
print "Copy & Clear String Array:"+str$(t3#/frames)

t=timer()
For lp=0 to maxtests
CopyArray SrcTableTyped(),DestTableTyped()   
ClearArray  DestTableTyped(),0
next
t4#=t4#+(timer()-t)
print "Copy & Clear Typed Array:"+str$(t4#/frames)

Sync
loop





kevin

#20
  Split To Array Vm2.

   Ripped the SplitToArray opcode and rewrote it as more generic function for the array command set. So far, the Integer/Float versions seems to be working ok.



; Dimension an array called MyString$()
  Dim Values(1000)
 
; Create a string variable s$ and assign it a string
  s$="10,123.45,30,$ff0000"
 
; Split the S$ into Mystring$()
  Tokens=SplitToArray(s$,",",Values(),1)
   
; Display the number of tokens found
  Print "Number of tokens found:"+Str$(Tokens)
 
; Display each token
  For lp=0 To Tokens
    Print Values(lp)
  Next
 
; Display the Screen and wait for the user to press a key
  Sync
  WaitKey



Float version



; Dimension an array called MyString$()
  Dim Values#(1000)
 
; Create a string variable s$ and assign it a string
  s$="10,123.45,30,$ffff"
 
; Split the S$ into Mystring$()
  Tokens=SplitToArray(s$,",",Values#(),1)
   
; Display the number of tokens found
  Print "Number of tokens found:"+Str$(Tokens)
 
; Display each token
  For lp=0 To Tokens
    Print Values#(lp)
  Next
 
; Display the Screen and wait for the user to press a key
  Sync
  WaitKey




   String Array Version.



; Dimension an array called MyString$()
  Dim Text$(1000)
 
; Create a string variable s$ and assign it a string
  s$="AAA,hello,123.45,30,$ffff,"
 
; Split the S$ into Mystring$()
  Tokens=SplitToArray(s$,",",Text$(),1)
   
; Display the number of tokens found
  Print "Number of tokens found:"+Str$(Tokens)
 
; Display each token
  For lp=0 To Tokens
    Print text$(lp)
  Next
 
; Display the Screen and wait for the user to press a key
  Sync
  WaitKey



   Benchmark

    The updated version in Vm2 is about 5% faster than VM1 across all tests. 




; Dimension an array called MyString$()
  Dim Values(1000)
  Dim Values#(1000)
  Dim Values$(1000)
 
; Create a string variable s$ and assign it a string
   s$="10,123.45,30,$ffff,12,33333,44433,6"
 

maxtests=1000

Do
cls 0
inc frames

t=timer()
For lp=0 to maxtests
  Tokens=SplitToArray(s$,",",Values(),1)
next
t1#=t1#+(timer()-t)
print "Split To Array As Integers:"+str$(t1#/frames)


t=timer()
For lp=0 to maxtests
  Tokens=SplitToArray(s$,",",Values#(),1)
next
t2#=t2#+(timer()-t)
print "Split To Array As Floats:"+str$(t2#/frames)


t=timer()
For lp=0 to maxtests
  Tokens=SplitToArray(s$,",",Values$(),1)
next
t3#=t3#+(timer()-t)
print "Split To Array As Strings:"+str$(t3#/frames)


; Display the number of tokens found
  Print "Number of tokens found:"+Str$(Tokens)
 
; Display each token
  For lp=1 To Tokens
    Print Values(lp)
  Print Values#(lp)
  Print Values$(lp)
  Next


Sync
loop


kevin

#21
  Split To Array Cont.

  The Vm2 version of the command now preserves the contents of the array when (if) it needs to be resized. 



Do 
cls 0

restore 0

  Dim Values(0)

Pos=0
repeat
s$=readdata$()
if s$<>""
print s$
  Tokens=SplitToArray(s$,",",Values(),Pos)
Pos=Pos+Tokens   
    endif
    until s$=""
   
; Display the number of tokens found
  Print "Number of tokens found:"+Str$(Pos)
 
; Display each token
  For lp=0 To Pos-1
    Print Values(lp)
Next
 
; Display the Screen and wait for the user to press a key
  Sync
loop


data "10,123.45,30,200"
data "10,123.45,30,200"
data "10,123.45,30,200"
data "10,123.45,30,200"

Data ""

kevin

#22
  SearchLowestArrayCell on VM2

   Split this from function from an inline opcode to an array lib function. 
   


Size=20

Dim Table(Size)
For lp=0 to Size
table(lp)=rnd(1000)
next

ShowArray(Table())

for lp=0 to size
index=SearchLowestArrayCell( Table(),lp,1,Size+1,10000)
if index>-1
index=lp+index
temp=table(lp)
Table(lp)=table(Index)
Table(index)=temp
endif
next

ShowArray(Table())

Sync
waitkey


Function ShowArray(This())
For lp=0 to GetArrayElements(This(),1)
s$=s$+str$(Table(lp))+","
next
print trimright$(s$,",")
EndFunction



BenchMark

  VM2 runs this test 3 times faster than Vm1



Size=20

Dim Table(Size)

maxtests=1000

do
cls 0
inc frames
For lp=0 to Size
table(lp)=rnd(1000)
next

ShowArray(Table())

t=timer()
for tests=0 to maxtests
for lp=0 to size
index=SearchLowestArrayCell( Table(),lp,1,Size+1,10000)
if index>-1
index=lp+index
temp=table(lp)
Table(lp)=table(Index)
Table(index)=temp
endif
next
next
tt1#=tt1#+(Timer()-t)
ShowArray(Table())
print tt1#/frames
Sync
loop

Function ShowArray(This())
For lp=0 to GetArrayElements(This(),1)
s$=s$+str$(Table(lp))+","
next
print trimright$(s$,",")
EndFunction



kevin

#23
  Search Lowest Array Cell Cont.

    The Vm2 versions now supports searching String arrays.   VM1 only supported int/float arrays.




Size=15

Dim Table(Size)
Dim Table#(Size)
Dim Table$(Size)

MaxTests=1000

do

cls 0
inc frames

For lp=0 to Size
table(lp)=rnd(10)
table#(lp)=table(lp)
table$(lp)=chr$(rndrange(asc("a"),asc("z")))
next

ShowArray(Table())

t=timer()
for tests=0 to maxtests
for lp=0 to size
index=SearchLowestArrayCell( Table(),lp,1,Size+1,10000)
if index>-1
index=lp+index
temp=table(lp)
Table(lp)=table(Index)
Table(index)=temp
endif
next
next
tt1#=tt1#+(Timer()-t)
print tt1#/frames
ShowArray(Table())


ShowArrayFlt(Table#())
t=timer()
for tests=0 to maxtests
for lp=0 to size
index=SearchLowestArrayCell( Table#(),lp,1,Size+1,10000)
if index>-1
index=lp+index
temp#=table#(lp)
Table#(lp)=table#(Index)
Table#(index)=temp#
endif
next
next
tt2#=tt2#+(Timer()-t)
print tt2#/frames
ShowArrayFlt(Table#())



ShowArrayStr(Table$())
t=timer()
for tests=0 to maxtests
for lp=0 to size
index=SearchLowestArrayCell( Table$(),lp,1,Size+1,"z")
if index>-1
index=lp+index
temp$=table$(lp)
Table$(lp)=table$(Index)
Table$(index)=temp$
endif
next
next
tt3#=tt3#+(Timer()-t)
print tt3#/frames
ShowArrayStr(Table$())


Sync
loop


Function ShowArray(This())
print "INtegers"
For lp=0 to GetArrayElements(This(),1)
s$=s$+str$(Table(lp))+","
next
print trimright$(s$,",")
EndFunction


Function ShowArrayFlt(This#())
print "Floats"
For lp=0 to GetArrayElements(This#(),1)
s$=s$+str$(Table#(lp))+","
next
print trimright$(s$,",")
EndFunction


Function ShowArrayStr(This$())
print "String"
For lp=0 to GetArrayElements(This$(),1)
s$=s$+Table$(lp)+","
next
print trimright$(s$,",")
EndFunction





  Search Highest Array Cell on VM2.

    The Vm2 version now supports searching Int/Float & String arrays.




Size=15

Dim Table(Size)
Dim Table#(Size)
Dim Table$(Size)

MaxTests=1000

do

cls 0
inc frames

For lp=0 to Size
table(lp)=rnd(10)
table#(lp)=table(lp)
table$(lp)=chr$(rndrange(asc("a"),asc("z")))
next

ShowArray(Table())

t=timer()
for tests=0 to maxtests
for lp=0 to size
index=SearchHighestArrayCell( Table(),lp,1,Size+1,0)
if index>-1
index=lp+index
temp=table(lp)
Table(lp)=table(Index)
Table(index)=temp
endif
next
next
tt1#=tt1#+(Timer()-t)
print tt1#/frames
ShowArray(Table())


ShowArrayFlt(Table#())
t=timer()
for tests=0 to maxtests
for lp=0 to size
index=SearchHighestArrayCell( Table#(),lp,1,Size+1,0)
if index>-1
index=lp+index
temp#=table#(lp)
Table#(lp)=table#(Index)
Table#(index)=temp#
endif
next
next
tt2#=tt2#+(Timer()-t)
print tt2#/frames
ShowArrayFlt(Table#())



ShowArrayStr(Table$())
t=timer()
for tests=0 to maxtests
for lp=0 to size
index=SearchHighestArrayCell( Table$(),lp,1,Size+1," ")
if index>-1
index=lp+index
temp$=table$(lp)
Table$(lp)=table$(Index)
Table$(index)=temp$
endif
next
next
tt3#=tt3#+(Timer()-t)
print tt3#/frames
ShowArrayStr(Table$())

Sync
loop


Function ShowArray(This())
print "INtegers"
For lp=0 to GetArrayElements(This(),1)
s$=s$+str$(Table(lp))+","
next
print trimright$(s$,",")
EndFunction


Function ShowArrayFlt(This#())
print "Floats"
For lp=0 to GetArrayElements(This#(),1)
s$=s$+str$(Table#(lp))+","
next
print trimright$(s$,",")
EndFunction


Function ShowArrayStr(This$())
print "String"
For lp=0 to GetArrayElements(This$(),1)
s$=s$+Table$(lp)+","
next
print trimright$(s$,",")
EndFunction





kevin

#24
  Find Array Cell On Vm2.

  Find array removed from inline and rebuilt into the Vm2 array function library.   The replace runs betweent 2->3 times faster than the Vm1 versions in the following test.




Size=15

Dim Table(Size)
Dim Table#(Size)
Dim Table$(Size)

MaxTests=1000

For lp=0 to Size
table(lp)=lp
table#(lp)=table(lp)
table$(lp)=chr$(asc("a")+lp)
next


do

cls 0
inc frames


ShowArray(Table())

t=timer()
for tests=0 to maxtests
Found=0
for lp=0 to size
index=FindArrayCell( Table(),0,1,Size+1,Table(lp))
if index>-1
inc Found
endif
next
next
tt1#=tt1#+(Timer()-t)
print tt1#/frames
print found

ShowArrayFlt(Table#())
t=timer()
for tests=0 to maxtests
Found=0
for lp=0 to size
index=FindArrayCell( Table#(),0,1,Size+1,Table#(lp))
if index>-1
inc Found
endif
next
next
tt2#=tt2#+(Timer()-t)
print tt2#/frames
print found



ShowArrayStr(Table$())
t=timer()
for tests=0 to maxtests
Found=0
for lp=0 to size
index=FindArrayCell( Table$(),0,1,Size+1,table$(lp))
if index>-1
inc found
endif
next
next
tt3#=tt3#+(Timer()-t)
print tt3#/frames
print Found


Sync
loop


Function ShowArray(This())
print "INtegers"
For lp=0 to GetArrayElements(This(),1)
s$=s$+str$(Table(lp))+","
next
print trimright$(s$,",")
EndFunction


Function ShowArrayFlt(This#())
print "Floats"
For lp=0 to GetArrayElements(This#(),1)
s$=s$+str$(Table#(lp))+","
next
print trimright$(s$,",")
EndFunction


Function ShowArrayStr(This$())
print "String"
For lp=0 to GetArrayElements(This$(),1)
s$=s$+Table$(lp)+","
next
print trimright$(s$,",")
EndFunction





kevin

#25
Manual List Controls on Vm2

 After a few WTF moments, the first handful of list control opcodes are now on Vm2.


PlayBASIC Code: [Select]
   Type tItem
X,Y,Z
EndType

Dim Variable as tItem list

Dim Me as tItem

RemStart
/// Manual Controls over list pointer

NewList Me() ; Alloc LIst this type variable

ResetList Me() ; reset pointer to first object in list

StepList Me() ; Move the list ptr to the next item in the list

result=EndOfList(Me()) ; check if we've hit the end of the list
RemEnd


NewList Me()

For lp=1 to 10
; add a new item
Me = New tiTem
Me.x= 100 +lp
Me.y= 200 +lp
Me.z= 300 +lp
Next

Do
;
Cls 0


; For each list processing
/*
For each me()
x=me.x
y=me.y
z=me.z

if X<105 then continue
Print str$(x)+", "+str$(y)+", "+str$(z)+", "
print "Index:"+str$(GetListPos(me()))
next
*/




; Process list from While loop
ResetList Me()
While not EndOfList(me()) ; Loop while current link isn't at the end of the list

x=me.x
y=me.y
z=me.z
Print str$(x)+", "+str$(y)+", "+str$(z)+", "

print "Index:"+str$(GetListPos(me()))

StepList Me() ; step to the next link in the list
EndWhile

; print GetListPos(me())
; print getlistsize(me())

; Kill the first item
ResetList Me()
Me = null ; Delete first cell

; Delete Cell 5 from the list
// FreeCell Me(),5


Sync
WaitKey
Waitnokey
loop





kevin

#26
 
 Basic List Controls on Vm2

  The basic link list control opcodes are now running on the VM2 runtime.  While I haven't tested it, the new instruction set should be quicker than Vm1.


PlayBASIC Code: [Select]
   Type tItem
X,Y,Z
EndType

Dim Variable as tItem list

Dim Me as tItem

RemStart
/// Manual Controls over list pointer

NewList Me() ; Alloc LIst this type variable

ResetList Me() ; reset pointer to first object in list

StepList Me() ; Move the list ptr to the next item in the list

result=EndOfList(Me()) ; check if we've hit the end of the list
RemEnd


NewList Me()
For lp=1 to 10
; add a new item
Me = New tiTem
Me.x= 100 +lp
Me.y= 200 +lp
Me.z= 300 +lp
Next



Do
;
Cls 0

; For each list processing

For each me()
x=me.x
y=me.y
z=me.z

if X<105 then continue
Print str$(x)+", "+str$(y)+", "+str$(z)+", "
print "Index:"+str$(GetListPos(me()))
next

; Process list from While loop
ResetList Me()
While not EndOfList(me()) ; Loop while current link isn't at the end of the list

x=me.x
y=me.y
z=me.z
Print str$(x)+", "+str$(y)+", "+str$(z)+", "

print "Previous:"+str$(GetListPrevious(me()))
print "Index:"+str$(GetListPos(me()))
print "Next:"+str$(GetListNext(me()))
print "Ptr:"+str$(int(GetListPtr(me())))

StepList Me() ; step to the next link in the list

EndWhile

print GetListFirst(me())
print GetListPos(me())
print getlistsize(me())

; Kill the first item
ResetList Me()
Me = null ; Delete first cell

; Delete Cell 5 from the list
// FreeCell Me(),5


Sync
WaitKey
Waitnokey
loop





 Benchmark (For EACH & Manual Loop processing)

      Results,

   For Each list :  Vm2 is 3.22 times faster than Vm1
   Manual List:    Vm2 is 5.08 times faster than Vm1




PlayBASIC Code: [Select]
   Type tItem
X,Y,Z
EndType

Dim Variable as tItem list

Dim Me as tItem

NewList Me()
For lp=1 to 100
; add a new item
Me = New tiTem
Me.x= 100 +lp
Me.y= 200 +lp
Me.z= 300 +lp
Next

maxtests=1000

Do
;
Cls 0

; For each list processing
inc frames

counter=0
t=timer()
for tests=0 to maxtests
For each me()
inc counter
next
next
t1#=t1#+(timer()-t)
print t1#/frames
print Counter


; Process list from While loop
counter=0
t=timer()
for tests=0 to maxtests
ResetList Me()
While not EndOfList(me()) ; Loop while current link isn't at the end of the list
inc Counter
StepList Me() ; step to the next link in the list
EndWhile
next
t2#=t2#+(timer()-t)
print t2#/frames
print Counter

print "Linked Loops:"+Str$(getlistsize(me())*MaxTests)

Sync
loop




kevin

#27
  FreeCell/GetFreeCell

    Currently working on the various left over tidbits from the array/list lib's.

    GetFreeCell() Test code,

PlayBASIC Code: [Select]
   Type tItem
X,Y,Z
EndType


Dim obj(0) as tItem

For lp=1 to 10

index =GetFreeCell(Obj())

; add a new item
Obj(index) = New tItem
Obj(index).x= 100 +lp
Obj(index).y= 200 +lp
Obj(index).z= 300 +lp

Next


setfps 60

Do
Cls 0

; Process types
For Index=0 to getarrayElements(Obj(),1)
if Obj(index)
x=Obj(index).x
y=Obj(index).y
z=Obj(index).z
Print str$(x)+", "+str$(y)+", "+str$(z)+", "
endif
next

; Kill a random item
if SpaceKey()

index=rnd(getarrayElements(Obj(),1))

IF obj(index)
freecell obj(),index
print "Killed Index:"+Str$(index)
Else
print "Missed Index:"+Str$(index)
EndIF

Sync
WaitKey
WaitNoKey

EndIF

Sync
loop





   Fixed Size Test Code

PlayBASIC Code: [Select]
   Type tItem
X,Y,Z
EndType


Dim obj(10) as tItem

For lp=1 to 10

; index =GetFreeCell(Obj())
index=lp
; add a new item
Obj(index) = New tItem
Obj(index).x= 100 +lp
Obj(index).y= 200 +lp
Obj(index).z= 300 +lp

Next


setfps 60

Do
Cls 0

; Process types
For Index=0 to getarrayElements(Obj(),1)
if Obj(index)
x=Obj(index).x
y=Obj(index).y
z=Obj(index).z
Print str$(x)+", "+str$(y)+", "+str$(z)+", "
endif
next

; Kill a random item
if SpaceKey()

index=rnd(getarrayElements(Obj(),1))

IF obj(index)
freecell obj(),index
print "Killed Index:"+Str$(index)
Else
print "Missed Index:"+Str$(index)
EndIF

Sync
WaitKey
WaitNoKey

EndIF

Sync
loop





kevin

#28
 FreeCell & GetFreeCell on VM2

  These are now set up on Vm2 side the runtime.  Both functions hook into various libraries, so I've had to do some old->new wrapping to make it work for the time being.  


PlayBASIC Code: [Select]
   Type tItem
X,Y,Z
EndType


Dim obj as tItem list

For lp=1 to 10

; add a new item
Obj = New tItem
Obj.x= 100 +lp
Obj.y= 200 +lp
Obj.z= 300 +lp

Next

Setfps 60

Do
Cls 0

; Process types
for each Obj()
x=Obj.x
y=Obj.y
z=Obj.z
Print str$(x)+", "+str$(y)+", "+str$(z)+", "
next

; Kill a random item
if SpaceKey()
index=rnd(10)
freecell obj(),index
print "Killed Index:"+Str$(index)
Sync
WaitKey
WaitNoKey
EndIF

Sync

loop






kevin

#29
Type Container Instruction Set


read testing
PlayBASIC Code: [Select]
   Type Tpos 
x,y,z
endtype


Dim Obj(10) as tpos

Obj(1)=new Tpos

Print Obj(1)

Sync
waitkey





Write test
PlayBASIC Code: [Select]
   Type Tpos 
x,y,z
endtype

Dim Obj(10) as tpos

Dim PointerToObject as Tpos pointer
PointerToObject = new tpos

; alloc
Obj(1)=new Tpos

; copy from existing typed pointer
Obj(2)=PointerToObject

; Write a NULL cell (integer assign)
Obj(3)=new Tpos
Obj(3)=0


Print Obj(1)
Print Obj(2)
Print Obj(3)

Sync
waitkey