PlayBASICFX / PBFX Vm2 Translation (WIP)

[kevin]

   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]

   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]

   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]

  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.

Code Select Expand


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   

Code Select Expand



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.

 

Code Select Expand


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]

  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.

Code Select Expand



; 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

Code Select Expand



; 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.

Code Select Expand



; 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. 

Code Select Expand



; 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]

  Split To Array Cont.

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

Code Select Expand



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]

  SearchLowestArrayCell on VM2

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

Code Select Expand


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

Code Select Expand



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]

  Search Lowest Array Cell Cont.

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

Code Select Expand



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.

Code Select Expand



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]

  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.

Code Select Expand




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]

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]

 
 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]

  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]

 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]

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