PlayBasicFX VM2 translation WIP/BLOG
This thread is mainly for me so I can keep track of what is functional and what changes have needed to be made during to the translation from the VM1 to VM2 runtime.
Learn About VM2 + PlayBASIC FX
* See Demo Retail and Upgrading Question (http://www.playbasic.com/faq.php?&Category=Demo-Retail-Freebie-And-Upgrading-Questions) FAQ
* See www.PlayBasicFX.com
Work In Progress Blog Follows
ON Goto
ON GOTO is now in VM2, one change is the it only accepts Integer 'select' variables. However, you can still use a float, but it's recast for you.
Sample.
[pbcode]
Setfps 30
Do
Cls 0
a#=rnd(5)
print a#
on a# goto l0,l1,l2,l3
print "MISSED"
goto Cont
L0:
print "label #0"
goto Cont
L1:
print "label #1"
goto Cont
L2:
print "label #2"
goto Cont
L3:
print "label #3"
goto Cont
Cont:
Sync
waitkey
loop
[/pbcode]
Loops - FOR/NEXT / REPEAT UNTIL / WHILE ENDWHILE & DO DECLOOP
All variable loop structures are running on VM2
[pbcode]
max=30000
Do
cls 0
inc frames
t=timer()
K=0
for lp=0 to max
K=K+1
next
t3#=t3#+(timer()-t)
print k
print "For loop:"+Str$(t3#/frames)
t=timer()
K=0
while K<max
K=K+1
endwhile
t1#=t1#+(timer()-t)
print k
print "While Loop:"+Str$(t1#/frames)
t=timer()
K=0
repeat
K=K+1
until K>=max
t2#=t2#+(timer()-t)
print k
print "Repeat Loop:"+Str$(t2#/frames)
t=timer()
lp=max
k=0
do
K=K+1
decloop lp
t4#=t4#+(timer()-t)
print k
print "Dec Loop:"+Str$(t4#/frames)
sync
loop
[/pbcode]
INC / DEC are inline
Old INC/DEC opcodes are removed and recast as packed ADD/SUB opcodes.
[pbcode]
Do
Cls 0
a=0
b#=0
c=0
d#=0
For lp=0 to 1000
inc a
inc B#
dec c
dec d#
next
print a
print B#
print c
print D#
sync
loop
[/pbcode]
Strings
Started moving/reworking the base string operations code to Vm2.
[pbcode]
a$="yeah"
b$="dude"
print a$
For lp =0 to 10
print "Hello"+Str$(lp)
print left$("Hello"+Str$(lp),2)
next
test("Local String")
Sync
Waitkey
Function test(LocalString$)
print LocalString$
EndFunction
[/pbcode]
String Addition
Updated the String Addition opcodes, it's following loop is now pure VM2. The string addition test (1 meg long string) runs about 5 milliseconds faster than 1.64. Running on average in 12.7 milliseconds... :).
[pbcode]
a$="hello World"
max=99000
Do
cls 0
inc frames
c$=""
t=timer()
For lp=0 to max
c$=c$+a$
next
tt#=tt#+(timer()-t)
print len(c$)
print left$(c$,1024)
print tt#/frames
Sync
loop
[/pbcode]
String Compares
[pbcode]
This$="Aaa"
That$="Bbb"
print "Strings Equal:"+Str$(This$=This$)
print "Strings Equal:"+Str$(This$=That$)
print "Strings Not Equal:"+Str$(This$<>That$)
print "Strings Less Than:"+Str$(This$<That$)
print "Strings Greater Than:"+Str$(This$>That$)
print "Strings Less Than Equal:"+Str$(This$<=That$)
print "Strings Greater Than Equal:"+Str$(This$>=That$)
Sync
waitkey
[/pbcode]
Changed the opcode structure a little (smaller) and when the test loop are running purely on Vm2 all the string compare methods are about 2->4ms faster over a 100,000 iterations. When comparing 41 chr strings.
[pbcode]
This$="BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB1"
That$="BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB2"
max=100000
Do
cls 0
inc frames
t=timer()
For lp=0 to max
result=This$=That$
next
t1#=t1#+(timer()-t)
print "Equals:"+Str$(t1#/frames)
t=timer()
For lp=0 to max
result=This$<>That$
next
t2#=t2#+(timer()-t)
print "Not Equals:"+Str$(t2#/frames)
t=timer()
For lp=0 to max
result=This$<That$
next
t3#=t3#+(timer()-t)
print "Less Than:"+Str$(t3#/frames)
t=timer()
For lp=0 to max
result=This$>That$
next
t4#=t4#+(timer()-t)
print "Greater Than:"+Str$(t4#/frames)
t=timer()
For lp=0 to max
result=This$<=That$
next
t5#=t5#+(timer()-t)
print "Less Than Equals:"+Str$(t5#/frames)
t=timer()
For lp=0 to max
result=This$>=That$
next
t6#=t6#+(timer()-t)
print "Greater Than Equals:"+Str$(t4#/frames)
Sync
loop
[/pbcode]
Pointers
The current beta has pointer operations hooked up. So while the following works, it's not purely running on VM2 in this edition.
[pbcode]
Bank=NewBank(1000)
Dim Ptr as Byte Pointer
print Bank
Ptr=GetBankPtr(Bank)
For lp=0 to 100
*ptr =lp
print PeekBankByte(Bank,lp)
print *ptr
ptr=ptr+1
next
Sync
waitkey
[/pbcode]
and
[pbcode]
Type tviewport
x1,y1,x2,y2
Endtype
Type Stuff
state
cool
yeah
x
viewport as tviewport
Array(100)
EndType
Dim me as Stuff pointer
Me = new Stuff
me.state=1
me.state=2
SetVP(Me.Viewport,100,100,200,200)
For lp=0 to 10
me.array(lp)=100+lp
next
print int(me)
print me.state
Sync
waitkey
Function SetVP(Vp as tviewport pointer,x1,y1,x2,y2)
vp.x1=x1
vp.y1=y1
vp.x2=x2
vp.y2=y2
EndFunction
[/pbcode]
Vm2 Stack
Moving/changing how the Stack works in the VM2. As such this means setting up various base controls again.
Gosub/return
Gosub is now running on Vm2, the new code doesn't support stack errors though. So under/overflow will crash the runtime.
[pbcode]
gosub SubRoutine
print "done"
Sync
waitkey
end
SubRoutine:
print "inside gosub"
gosub SubRoutine2
gosub SubRoutine2
gosub SubRoutine2
gosub SubRoutine2
return
SubRoutine2:
print "inside gosub #2"
return
[/pbcode]
On Variable Gosub
ON variable GOSUB is now in VM2. The select variable is now integer only (as per on variable goto), but floats are recast for you.
Sample.
[pbcode]
Setfps 30
Do
Cls 0
a#=rnd(10)
print a#
on a# gosub l0,l1,l2,l3
Sync
waitkey
loop
L0:
print "label #0"
gosub Hold
return
L1:
print "label #1"
gosub Hold
return
L2:
print "label #2"
gosub Hold
return
L3:
print "label #3"
gosub Hold
return
Hold:
Sync
waitkey
return
[/pbcode]
Scope / Stack Controls in VM2
The new stack behaviors in VM2 give it about a 40->50% speed increase in calling functions. It's also a little more logically firendly in regards to string thrashing also..
[pbcode]
; gosub SubRoutine
; print "done"
RecFun(100,200,"Cool")
Test(50.78,123.456,200)
Stuff()
print "pointer"
a= int(CalcTest(100,33.44))
print a
Fun(45, 33.33, "hello")
Fun(45, 33.33, "hello")
; push 1234567
; print pop()
Sync
#break
WaitKey
end
Function Stuff()
print "stuff"
EndFunction
Function Test(A,B#,C)
print a
print b#
print c
EndFunction
Function CalcTest(A,B#)
; print a
; print b#
result$="String Result"+str$(a+B#)
Bank=NewBank(100)
BankPtr= GetBankPtr(Bank)
Ptr=GetBankPtr(Bank)
; print Bank
; print int(PTR)
endFUnction Ptr as pointer
Function Fun(a,b#,c$)
print "FUNCTION BABY"
#break
print a
; print b#
print c$
g#=45
Stuffs$="Yeah yeah"
print Stuffs$
result=455
EndFunction
Function RecFun(a,b#,c$)
print "Recusive FUNCTION"
print a
print b#
print c$
Sync
g#=45
Stuffs$="Yeah yeah"
print Stuffs$
result=455
#break
if a<200
RecFun(a*2,b#*2,c$+c$)
endif
EndFunction
SubRoutine:
print "inside gosub"
gosub SubRoutine2
gosub SubRoutine2
gosub SubRoutine2
gosub SubRoutine2
return
SubRoutine2:
print "inside gosub #2"
return
[/pbcode]
This second example is just for benching the function/psub and sub routine calling mechanisms. I should point out that this code isn't running purely on VM2 just yet, so some bits are slower than they should due to the context switches (falling back to run old opcodes in VM1) But that's only temporary !
[pbcode]
Tests=10000
Do
cls 0
inc frames
// ===================================
// USer Functions VS Projected Subroutines
// ===================================
// ==========
// Test #1
// ==========
T=timer()
For LP=0 to Tests
result=SomeFunctionCalc(10,lp)
next
tt1#=tt1#+(timer()-t)
Print "Test #1 Average Time:"+Str$(tt1#/frames)
// ==========
// Test #2
// ==========
T=timer()
// Call the Psub function
For LP=0 to Tests
result=SomesubCalc(10,lp)
next
tt2#=tt2#+(timer()-t)
Print "Test #2 Average Time:"+Str$(tt2#/frames)
T=timer()
// Call the Psub function
For LP=0 to Tests
gosub MySub
next
tt3#=tt3#+(timer()-t)
Print "Test #3 Sub Routine Calling:"+Str$(tt3#/frames)
Sync
loop
Function SomeFunctionCalc(A,B)
A=A*B
l1=23
l2=23
l3=23
l4=23
l5=23
l6=23
l7=23
l8=23
l9=23
EndFunction A
Psub SomeSubCalc(A,B)
A=A*B
l1=23
l2=23
l3=23
l4=23
l5=23
l6=23
l7=23
l8=23
l9=23
EndPsub A
MySub:
return
[/pbcode]
Assignments / Basic Arrays in VM2
Today's revision now includes basic move operations on Vm2. These instructions currently only support simple variables & arrays. Speed wise they're about twice as fast (for integers & floats) as the quickest Vm1 edition (V1.64).
[pbcode]
Dim table(1000)
Dim table#(1000)
address=GetArrayPtr(Table())
print address
for lp=0 to 100
pokeint PBArrayStruct_size+address+(lp*4),lp
next
for lp=0 to PBArrayStruct_size-1 step 4
print peekint(Address+lp)
next
lp=10
print Table(lp)
print hex$(Table(lp))
Table(lp)=45.23
print Table(lp)
print hex$(Table(lp))
Sync
Waitkey
max=50000
Do
cls 0
inc frames
Offset=(Offset+1) and 255
t=timer()
For lp=0 to max
Table(offset)=lp
a=Table(offset)
next
T1#=t1#+(timer()-t)
print t1#/frames
t=timer()
For lp=0 to max
Table#(offset)=lp
a=Table#(offset)
next
T2#=t2#+(timer()-t)
print t2#/frames
sync
loop
[/pbcode]
User Defined Types/Structures
Today's little task has been to expand upon the 'move' instruction set by adding support for UDT structures on Vm2. This allows for types to be nulled/freed on VM2 side. The following NULL type runs about 4->5 times faster than PB1.64. However, field accesses still fall back through vm1 ATM.
[pbcode]
Type Kev2
MyInteger
MyFloat#
MyString$
MyInteger2
MyFloat2#
EndType
constant ArraySize=100
Type Kev
MyInteger
MyFloat#
MyString$
IntegerArray(ArraySize)
FloatArray(ArraySize)
StringArray$(ArraySize)
MyInteger2
MyFloat2#
EndType
Dim me as kev
max=1000
Do
cls 0
inc frames
me.MYinteger=45
me.MYFloat#=123.456
me.MYString$="Abccddeded"
me.MYinteger2=10045
me.MYFloat2#=200123.456
For lp=0 to ArraySize
me.Integerarray(lp)=30000+lp
me.Floatarray(lp)=22222.45+lp
me.stringarray$(lp)="yeah"+str$(lp)
next
// Clear the fields to zero
t=timer()
For test=0 to max
me.kev =null
next
t1#=t1#+(timer()-t)
print t1#/frames
Sync
loop
[/pbcode]
Bound Function Calling
Finally moved & updated the function calling opcodes to the Vm2 runtime. The new approach is a lot cleaner, which results is less man handling of data and thus faster call/return behaviors. Todays edition of the Vm2 can call the RGB() function 50000 times in 2.8/2.9 milliseconds. Compared to PB1.64 which takes 10.8/10.9 milliseconds, making Vm2 about 3 times faster. There will be difference depending upon the number of parameters etc.
[pbcode]
max=5000
Do
cls 0
inc frames
// calling the rgb function
t=timer()
For test=0 to max
; unroll so were timing the function calling mainly
result=rgb(r,g,b)
result=rgb(r,g,b)
result=rgb(r,g,b)
result=rgb(r,g,b)
result=rgb(r,g,b)
result=rgb(r,g,b)
result=rgb(r,g,b)
result=rgb(r,g,b)
result=rgb(r,g,b)
result=rgb(r,g,b)
next
t1#=t1#+(timer()-t)
a#=t1#/frames
print a#
// Calls per second
print "Calls Per second:"+str$(int((1000.0/a#)*(max*10)))
Sync
loop
[/pbcode]
Select /Case
Somehow the select/case opcodes had been missed, so those have been tonight's little focus. While the update it's not finished, Integer immediate selects are already some 3 times faster.
[pbcode]
SelectionValue=30
max=50000
Do
cls 0
print "Select Value:"+str$(SelectionValue)
inc frames
t=timer()
For lp=0 to max
Select SelectionValue
case 10
R=10
case 20
R=20
case 30
R=30
EndSelect
next
t1#=t1#+(Timer()-t)
print t1#/frames
print "Result:"+Str$(r)
print "done Select case"
Sync
loop
[/pbcode]
Select /Case String$
All the operations are supported now. Bellow is a demo of string range case trapping. Vm2 can run this code a little over twice as fast as Vm1.
[pbcode]
max=50000
SelectionValue$="feef"
Do
Cls rgb(0,0,0)
Print "Select Value:"+(SelectionValue$)
inc frames
t=timer()
For lp=0 to max
Select SelectionValue$
case "aa"
R=10
case "bb"
R=20
case "cc"
R=30
case "dd" to "zz"
R=40
EndSelect
next
t1#=t1#+(Timer()-t)
print t1#/frames
print lp
print "Result:"+Str$(r)
print "Done Select case"
Sync
loop
[/pbcode]
String Functions on Vm2
Tonight I've been working on the moving the built in string functions across. So far the only one that works is the "LEN" function. Only another 25 or so to go.. What fun :)
[pbcode]
a$="abcdef"
print len(a$)
Sync
waitkey
[/pbcode]
MID$() & Mid()
[pbcode]
a$="abcdef"
print mid$(a$,2,3)
for lp=1 to len(a$)
print mid(a$,lp)
next
Sync
waitkey
[/pbcode]
LEFT$() & RIGHT$()
[pbcode]
a$="abcdef"
print Left$(a$,1)
print Right$(a$,1)
Sync
waitkey
[/pbcode]
CutLeft$() & CutRight$()
[pbcode]
a$="abcdef"
print CutLeft$(a$,3)
print CutRight$(a$,3)
Sync
waitkey
[/pbcode]
Trim$(), TrimLeft$(),TrimRight$()
[pbcode]
a$="<<<<<stuff>>>>>"
print trim$(a$,"<>")
print trimLEft$(a$,"<")
print trimRight$(a$,">")
Sync
waitkey
[/pbcode]
Upper$(),lower$(),AutoCaps$()
[pbcode]
a$="aaaaaa"
b$="BBBBBBBB"
c$="hello world"
print upper$(a$)
print lower$(b$)
print autocaps$(c$)
Sync
waitkey
[/pbcode]
CHR$() / bin$(), HEX$()
[pbcode]
For lp=32 to 40
print chr$(lp)
print bin$(lp)
print hex$(lp)
next
Sync
waitkey
[/pbcode]
ASC()
[pbcode]
a$="abcdefg"
For lp=1 to len(a$)
print asc(mid$(a$,lp,1))
print mid(a$,lp)
next
Sync
waitkey
[/pbcode]
VAL() & VAL#()
[pbcode]
a$="123.456"
print Val(a$)
print Val#(a$)
Sync
waitkey
[/pbcode]
STR$()
[pbcode]
a$="123.456"
for lp=0 to 10
print "yeah"+str$(lp)
print "yeah"+str$(float(lp))
next
Sync
waitkey
[/pbcode]
Replace$()
[pbcode]
a$="aaaaabbbbBBBBcdefg"
print replace$(a$,"b","-",1,0,0)
print replace$(a$,"b","-",1,0,true)
print replace$(a$,"b","-",1,true,false)
Sync
waitkey
[/pbcode]
Instring()
[pbcode]
a$="aaaaabbbbBBBBcdefg"
print instring(a$,"B",1,false)
print instring(a$,"B",1,true)
Sync
waitkey
[/pbcode]
Make$(), insert$, Digits$(),Flip$(),pad$()
[pbcode]
a$="abc"
print make$(a$,10)
print pad$(a$,".",1)
print flip$(a$)
print Insert$(a$,"---",2)
print digits$(12,6)
Sync
waitkey
[/pbcode]
String Function Test
I've now moved all the built in string functions across to VM2. The following is a fairly nasty stress test comparison between Vm2 (found in 1.73j) and Vm1 found in PB V1.64. The results are the same as other previous tests, with a good health (25->50%) performance boast when running through Vm2. The gain is mainly due to the faster loop processing though, as I haven't really changed the library. But anyway
[pbcode]
b$="aaaaaaaaaaaaaaabbbbbbbbbbbbbbcccccccccccccccddddddddddddddddddddddd"
max=50000
Do
Cls rgb(0,0,0)
inc frames
t=timer()
For lp=0 to max
a$=mid$(b$,5,5)
next
t1#=t1#+(Timer()-t)
print "MID:"+str$(t1#/frames)
print a$
t=timer()
For lp=0 to max
a$=left$(b$,20)
next
t2#=t2#+(Timer()-t)
print "Left:"+str$(t2#/frames)
print a$
t=timer()
For lp=0 to max
a$=Right$(b$,20)
next
t3#=t3#+(Timer()-t)
print "Right:"+str$(t3#/frames)
print a$
t=timer()
For lp=0 to max
a$=Replace$(b$,"c","d",1,0,0,)
next
t4#=t4#+(Timer()-t)
print "Replace:"+str$(t4#/frames)
print a$
Sync
loop
[/pbcode]
Array Command Set
Haven't had much computer time the past couple of days, but the current WIP is the array command set. So far, the only command running on VM2 is DIM. There's not really much to speed up with dim, so I've mostly been breaking up the function set. With any luck and a little bit of effort, this will make upgrading the rest of the library much easier.
[pbcode]
Size=50
max=10000
Do
Cls rgb(0,0,0)
inc frames
Memory=0
t=timer()
For lp=0 to max
Dim Table(Size)
next
t1#=t1#+(Timer()-t)
print "DIM1D:"+str$(t1#/frames)
Memory=Memory+(Max*Size)
t=timer()
For lp=0 to max
Dim Table(Size,Size)
next
t2#=t2#+(Timer()-t)
print "DIM2D:"+str$(t2#/frames)
Memory=Memory+(Max*(Size*Size))
print "Integers:"+Str$(Memory)
Sync
loop
[/pbcode]
Array Command Set Cont.
Setting up the array query functions. One change is the GetArrayElements() will return a zero if you access an illegal dimension (a dimension that doesn't exist). Also, the new library doesn't throw errors ATM.
[pbcode]
Dim Table(20,30)
Print GetArrayStatus(Table())
Print GetArrayDimensions(Table())
for lp=0 to GetArrayDimensions(Table())+1
print GetArrayElements(Table(),lp)
next
Sync
waitkey
[/pbcode]
Sort Array
[pbcode]
Size=20
do
Cls 0
Dim Table(20)
Print "Random Array"
For lp=0 to size
Table(lp)=rnd(100)
print Table(lp)
next
SortArray Table(),0, size
Print "Sorted Array"
For lp=0 to size
print Table(lp)
next
Sync
waitkey
waitnokey
loop
[/pbcode]
Array Command Set Cont.
Swap Array
[pbcode]
Dim Table(20)
Dim Table2(10)
Print "Random Array"
FillArray(Table())
FillArray(Table2())
Do
Cls 0
Print "Table1"
ShowArray(Table())
Print "Table2"
ShowArray(Table2())
print "Press any key"
Sync
waitkey
waitnokey
swaparray Table(),Table2()
loop
Function ShowArray(ThisArray())
For lp=0 to GetArrayElements(ThisArray(),1)
print ThisArray(lp)
next
EndFunction
Function FillArray(ThisArray())
For lp=0 to GetArrayElements(ThisArray(),1)
ThisArray(lp)=rnd(100)
next
EndFunction
[/pbcode]
Move Array
[pbcode]
Dim Table(20)
Dim Table2(10)
Print "Random Array"
FillArray(Table())
FillArray(Table2())
Do
Cls 0
Print "Table1"
ShowArray(Table())
Print "Table2"
ShowArray(Table2())
print "Press any key"
Sync
waitkey
waitnokey
Movearray Table(),Table2()
loop
Function ShowArray(ThisArray())
For lp=0 to GetArrayElements(ThisArray(),1)
print ThisArray(lp)
next
EndFunction
Function FillArray(ThisArray())
For lp=0 to GetArrayElements(ThisArray(),1)
ThisArray(lp)=rnd(100)
next
EndFunction
[/pbcode]
Redim replacement.
Working on REDIM reaplacement, it's sorta working, even though it's currently got some issues.
[pbcode]
SIZE=100
Dim Table$(size)
For lp2=0 to size
table$(lp2)="test:"+str$(1000+lp2)
Next
Test()
Sync
WaitKey
Function Test()
redim Table$(10)
EndFunction
[/pbcode]
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.
[pbcode]
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
[/pbcode]
UNdim / Typed arrays In Vm2.
[pbcode]
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
[/pbcode]
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.
[pbcode]
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
[/pbcode]
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).
[pbcode]
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
[/pbcode]
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.
[pbcode]
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
[/pbcode]
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
[pbcode]
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
[/pbcode]
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
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
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
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 ""
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
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
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
Manual List Controls on Vm2
After a few WTF moments, the first handful of list control opcodes are now on Vm2.
[pbcode]
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
[/pbcode]
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.
[pbcode]
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
[/pbcode]
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
[pbcode]
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
[/pbcode]
FreeCell/GetFreeCell
Currently working on the various left over tidbits from the array/list lib's.
GetFreeCell() Test code,
[pbcode]
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
[/pbcode]
Fixed Size Test Code
[pbcode]
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
[/pbcode]
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.
[pbcode]
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
[/pbcode]
Type Container Instruction Set
read testing
[pbcode]
Type Tpos
x,y,z
endtype
Dim Obj(10) as tpos
Obj(1)=new Tpos
Print Obj(1)
Sync
waitkey
[/pbcode]
Write test
[pbcode]
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
[/pbcode]
Low Level Type Instruction Set on VM2
Currently i'm testing the read type instructions at the moment. Seem to be working, at least the basic data types anyway.
Type Tpos
x,y,z
f#
s$
ArrayI(100)
ArrayF#(100)
ArrayS$(100)
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)
obj(1).x=50
obj(1).f=123.456
obj(1).s="string"
; read opcodes
print Obj(1).x
print Obj(1).F#
print Obj(1).s$
Sync
waitkey
Embedded structure support (Int/float/String).
Type Tpos
x,y,z
f#
s$
ArrayI(100)
ArrayF#(100)
ArrayS$(100)
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)
obj(1).x=50
obj(1).f=123.456
obj(1).s="string"
; read opcodes
print Obj(1).x
print Obj(1).F#
print Obj(1).s$
; nested structures
Obj(1).Arrayi(10)=1000
Obj(1).Arrayf(10)=222.46
Obj(1).Arrays(10)="String array"
print Obj(1).Arrayi(10)
print Obj(1).Arrayf(10)
print Obj(1).Arrays(10)
Sync
waitkey
Export nested typed pointer
type tNestedStuff
a,b,c
EndType
Type Tpos
x,y,z
f#
s$
ArrayI(100)
ArrayF#(100)
ArrayS$(100)
Nest as tNestedStuff
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)
obj(1).x=50
obj(1).f=123.456
obj(1).s="string"
; read opcodes
print Obj(1).x
print Obj(1).F#
print Obj(1).s$
; nested structures
Obj(1).Arrayi(10)=1000
Obj(1).Arrayf(10)=222.46
Obj(1).Arrays(10)="String array"
print Obj(1).Arrayi(10)
print Obj(1).Arrayf(10)
print Obj(1).Arrays(10)
; Get pointer to Nested Types
InitNest(Obj(1).Nest)
print Obj(1).nest.a
print Obj(1).nest.b
print Obj(1).nest.c
Sync
waitkey
Function InitNest(Me as tNestedStuff Pointer)
me.a=5555
me.b=6666
me.c=7777
EndFunction
Read field & field pointer copies.
type tNestedStuff
a,b,c
EndType
Type Tpos
x,y,z
f#
s$
ArrayI(20)
ArrayF#(20)
ArrayS$(20)
Nest as tNestedStuff
EndType
Dim VarType as tpos
VarType = new tpos
VarType.x =12345
VarType.s ="variable type string"
for lp=0 to 10
VarType.Arrays$(lp)="String "+str$(lp+20000)
next
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(4)=new Tpos
Print Obj(1)
Print Obj(2)
Print Obj(3)
obj(1).x=50
obj(1).f=123.456
obj(1).s="string"
; read opcodes
print Obj(1).x
print Obj(1).F#
print Obj(1).s$
; nested structures
Obj(1).Arrayi(10)=1000
Obj(1).Arrayf(10)=222.46
Obj(1).Arrays(10)="String array"
print Obj(1).Arrayi(10)
print Obj(1).Arrayf(10)
print Obj(1).Arrays(10)
; Get pointer to Nested Types
InitNest(Obj(1).Nest)
print Obj(1).nest.a
print Obj(1).nest.b
print Obj(1).nest.c
; copy via pointer
Obj(3).tpos= obj(1).tpos
; Null via pointer
Obj(1).tpos= 0
; Assign pointer a type variable/list handle
Obj(4).tpos= VarType.Tpos
Sync
waitkey
Function InitNest(Me as tNestedStuff Pointer)
me.a=5555
me.b=6666
me.c=7777
EndFunction
BenchMark
This is the standard array/type field access benchmark from way back.
Vm2 runs this test 2.3 times faster than Vm1
MakeBitmapFont 1,$ffffff
Dim TestArrayInt(1000)
Dim TestArrayFloat#(1000)
Type Mixed
i,f#
endtype
Dim TestArray(1000) as Mixed
for lp=0 to 1000
TestArray(lp)= new Mixed
next
Dim Results#(100)
TestStart=Timer()
MaxTests=10000
Repeat
Cls 0
frames=frames+1
Test=0
Print "Array + Type Test "+str$(Maxtests)+" Tests"
Print "Current Frame:"+Str$(frames)
print ""
ts=Timer()
For i = 0 To MaxTests
index=i and $ff
TestArrayInt(index)=TestArrayInt(index)+1
Next i
t=Timer()-ts
totalloops=totalloops+i
Results#(test)=results#(test)+t
Print "Integer Array: Addition:"+Str$(results#(test)/frames)
test=test+1
ts=Timer()
For i = 0 To MaxTests
index=i and $ff
TestArrayFloat#(index)=TestArrayFloat#(index)+1
Next i
t=Timer()-ts
totalloops=totalloops+i
Results#(test)=results#(test)+t
Print "Float Array: Addition:"+Str$(results#(test)/frames)
test=test+1
ts=Timer()
For i = 0 To MaxTests
index=i and $ff
TestArray(index).i=TestArray(0).i+1
Next i
t=Timer()-ts
totalloops=totalloops+i
Results#(test)=results#(test)+t
Print "Typed Array: Integer Field:"+Str$(results#(test)/frames)
test=test+1
ts=Timer()
For i = 0 To MaxTests
index=i and $ff
TestArray(index).f=TestArray(index).f+1
Next i
t=Timer()-ts
Results#(test)=results#(test)+t
Print "Typed Array: Float Field:"+Str$(results#(test)/frames)
test=test+1
totalloops=totalloops+i
print TotalLoops
Sync
Until Frames>200
Print "Test Complete"
testEnd=Timer()-TestSTart
Print "Seconds:"+Str$((timer()-TestStart)/1000.0)
Sync
WaitKey
Moving Embedded Data opcodes To Vm2
So far the basic replacement frame work is in place, it shouldn't take too long to rewrite the opcodes, since there's only a handful of them.
Print GetDataType()
Print GetDataPointer()
Print GetDataQuantity()
Sync
Waitkey
Data "234.45"
Data 1,2,3,4,5,6,7,8,9,10
ReadData()
Print "Running"
for lp=0 to 10
Ptr=GetDataPointer()
A=ReadData()
Print digits$(Ptr,4)+" "+str$(a)
next
Sync
Waitkey
Data 111,2222,33.33,4444,5555,6666,7777,8888,9999,101010
Data 234.45
ReadData#()
Print "Running"
for lp=0 to 10
Ptr =GetDataPointer()
A# =ReadData#()
Print digits$(Ptr,4)+" "+str$(a#)
next
Sync
Waitkey
Data 111,2222,33.33,4444,5555,6666,7777,8888,9999,101010
Data 234.45
ReadData$()
Print "Running"
for lp=1 to 5
Ptr =GetDataPointer()
A$ =ReadData$()
Print digits$(Ptr,4)+" "+a$
next
Sync
Waitkey
Data "A","B","C","D","E"
Data 234.45
Find Data (string)
For lp=4 to 0 step -1
This$=chr$( asc("A") + lp )
This$=This$+This$
Index=FindData(This$,0,0)
print Digits$(Index,4)+" "+This$
Next
Sync
Waitkey
Data "AA","BB","CC","DD","EE"
Data 234.45
// Find Integers
print "ints"
For lp=4 to 0 step -1
ThisInt =rnd(10)*1000
Index=FindData(ThisInt,0,0)
print Digits$(Index,4)+" "+Str$(ThisInt)
Next
// Find Floats
print "Floats"
For lp=4 to 0 step -1
ThisFlt# =(rnd(10)*10)+0.5
Index=FindData(ThisFlt#,0,0)
print Digits$(Index,4)+" "+Str$(ThisFlt#)
Next
// Find strings
print "Strings"
For lp=4 to 0 step -1
This$=chr$( asc("A") + lp )
This$=This$+This$
Index=FindData(This$,0,0)
print Digits$(Index,4)+" "+This$
Next
Sync
Waitkey
Data 0000,1000,2000,3000,4000,5000,6000,7000,8000,9000,10000
Data 0000,10.5, 20.5, 30.5, 40.5, 50.5, 60.5, 70.5,80.5,90.5,100.5
Data "AA","BB","CC","DD","EE","FF","GG","HH","II","JJ"
Restore LABEL
// Label restores
// Find Integers
restore MyIntegers
Print "Ints"
For lp=0 to 5
print Digits$(GetDataPointer(),4)+" "+Str$(ReadData())
Next
restore MyFloats
Print "floats"
For lp=0 to 5
print Digits$(GetDataPointer(),4)+" "+Str$(ReadData#())
Next
restore MyStrings
Print "Strings"
For lp=0 to 5
print Digits$(GetDataPointer(),4)+" "+ReadData$()
Next
Sync
Waitkey
; Data "STUFF"
MyIntegers:
Data 1000,2000,3000,4000,5000,6000,7000,8000,9000,10000
MyFloats:
Data 10.5, 20.5, 30.5, 40.5, 50.5, 60.5, 70.5,80.5,90.5,100.5
MyStrings:
Data "AA","BB","CC","DD","EE","FF","GG","HH","II","JJ"
Restore Integer/Float Value
// Integer restores
// Find Integers
restore 1 // Set the data pointer manually
Print "Ints"
For lp=0 to 5
print Digits$(GetDataPointer(),4)+" "+Str$(ReadData())
Next
restore 11
Print "floats"
For lp=0 to 5
print Digits$(GetDataPointer(),4)+" "+Str$(ReadData#())
Next
restore 21
Print "Strings"
For lp=0 to 5
print Digits$(GetDataPointer(),4)+" "+ReadData$()
Next
Sync
Waitkey
Data "STUFF"
//MyIntegers:
Data 1000,2000,3000,4000,5000,6000,7000,8000,9000,10000
//MyFloats:
Data 10.5, 20.5, 30.5, 40.5, 50.5, 60.5, 70.5,80.5,90.5,100.5
// MyStrings:
Data "AA","BB","CC","DD","EE","FF","GG","HH","II","JJ"
String Restores
// String Token restores
restore "MyIntegers"
print ReadData$()
For lp=0 to 5
print Digits$(GetDataPointer(),4)+" "+Str$(ReadData())
Next
restore "MyFloats"
print ReadData$()
For lp=0 to 5
print Digits$(GetDataPointer(),4)+" "+Str$(ReadData#())
Next
restore "MyStrings"
print ReadData$()
For lp=0 to 5
print Digits$(GetDataPointer(),4)+" "+ReadData$()
Next
Sync
Waitkey
Data "STUFF"
data "MyIntegers"
Data 1000,2000,3000,4000,5000,6000,7000,8000,9000,10000
data "MyFloats"
Data 10.5, 20.5, 30.5, 40.5, 50.5, 60.5, 70.5,80.5,90.5,100.5
data "MyStrings"
Data "AA","BB","CC","DD","EE","FF","GG","HH","II","JJ"
BenchMark
VM2 runs this about twice as fast as VM1.
Integer Test Vm2 is 2.4 times faster
Float Test Vm2 is 2.5 times faster
String Test Vm2 is 1.8 times faster
maxtests=10000
do
cls 0
inc frames
t=timer()
For lp=0 to maxtests
restore "MyIntegers"
Label$=ReadData$()
a=ReadData()
a=ReadData()
a=ReadData()
a=ReadData()
a=ReadData()
next
t1#=t1#+(timer()-t)
print "Integers:"+str$(t1#/frames)
t=timer()
For lp=0 to maxtests
restore "MyFloats"
Label$=ReadData$()
a#=ReadData#()
a#=ReadData#()
a#=ReadData#()
a#=ReadData#()
a#=ReadData#()
next
t2#=t2#+(timer()-t)
print "Floats:"+str$(t2#/frames)
t=timer()
For lp=0 to maxtests
restore "MyStrings"
Label$=ReadData$()
a$=ReadData$()
a$=ReadData$()
a$=ReadData$()
a$=ReadData$()
a$=ReadData$()
next
t3#=t3#+(timer()-t)
print "Strings:"+str$(t3#/frames)
Sync
loop
data "MyIntegers"
Data 1000,2000,3000,4000,5000,6000,7000,8000,9000,10000
data "MyFloats"
Data 10.5, 20.5, 30.5, 40.5, 50.5, 60.5, 70.5,80.5,90.5,100.5
data "MyStrings"
Data "AA","BB","CC","DD","EE","FF","GG","HH","II","JJ"
Replaced another pocket Vm1 & launcher / environment functions tonight, some are actual commands such the FPS() stuff, most are not. Anyway, I've made one change to the FPS stuff, that is, they now allow the user to select a max frame rate in floating point. Previously it was integer only, which meant that due to rounding errors you'll generally get a few fps lower than requested. Now the replacements will also suffer from rounding issues. But this just allows you to 'tweak' the rate little more.
setfps 60.7
Do
cls 255
print fps()
print GetFps()
print 1000.0/GetFps()
Sync
loop
PBFX V1.74RC2 - Auto Casting for Internal & Externally Bound Functions
Previous versions of the 1.72/1.73 required explicit type matching when dealing with functions internally and externally bound. Meaning that if the function was declared requiring an Integer parameter say, and you passed it a float, the compiler would have previously halted and pop an error. This was most notable with externally bound functions, which the latest FX builds using more and more of. Therefore making the function matching seem much stricter. Anyway, the auto casting will ease this. It's also be added to internally bound functions as well.
It should be noted though, that if PB has to auto casting a parameter for you, this will cost you one operation at runtime. So it's always best to keep the data types matching throughout.
// Auto recasting of integers to floats for bound functions
setfps 50
x#=100
print GetFps()
lockbuffer
dotc x#,x#,255
p=point(x#,x#)
p=fastpoint(X#,X#)
unlockbuffer
print p
Sync
waitkey
PBFX V1.74RC2 - Auto Type Allocation Restored
RC2 now includes Auto type allocation when writing to none existent types within the container (aka the array). Therefore allowing a lot of old code (such as the stuff bellow) to run again. The picture bellow is the recent Frogger demo running in 1.74RC2. A few changes we're needed to make it run, primarily relating to the CurrentDir$() function. Since bound functions names can't currently include post fixes.. So CurrentDir$() should be CurrentDir() in PBFX, for the time being.
Type Stuff
Status
x#,y#
EndTYpe
Type Yeah
a,b,c
status
x#,y#
EndTYpe
Type Yeah2
a,b,c
status
x#,y#
EndTYpe
Dim collection(10) as stuff
Dim collection2(10) as stuff
Dim collection3(10) as yeah
Collection(5).status=true
Collection(6) = new yeah
Collection(5).x#=100
Collection(5).y#=2100
Print Collection(5).status
Print Collection(5).x#
Print Collection(5).Y#
sync
waitkey
PBFX V1.74RC5 - Polishing Off Arrays
After looking through some programs noticed there's a few Array commands not fully in the VM2 side of the runtime. Namely Set/Get array. Both of which use these extra info tables that I was going to replace in VM2, but since time is pressing, I'm just shoveling them across for the time being.
Test getArray()
Type Pos
x,ymz
endType
Dim STuff1(1)
Dim STuff2(1)
Dim STuff1#(1)
Dim STuff2#(1)
Dim STuff1$(1)
Dim STuff2$(1)
Dim Vertex as pos
DIm VertexArray(10) as pos
print GetArray(Stuff1())
print GetArray(Stuff2())
print GetArray(Stuff1#())
print GetArray(Stuff2#())
print GetArray(Stuff1$())
print GetArray(Stuff2$())
print GetArray(Vertex())
print GetArray(VertexArray())
Sync
waitkey
PBFX V1.74RC5 - SetArray
Had a few drama's getting SetArray to work initially, but it now seems to be working as expected.
[pbcode]
max=10
Dim Table(max)
For lp=0 to max
Table(lp)=rnd(100)
print Table(lp)
next
MakeArray Lookup()
SetArray LookUp(),GetArray(Table())
print "Redirected array"
For lp=0 to max
print LookUp(lp)
next
Sync
Waitkey
[/pbcode]
[pbcode]
max=10
Dim Table2(max)
Dim Table(max)
For lp=0 to max
Table(lp)=rnd(100)
print Table(lp)
next
MakeArray Lookup()
H=GetArray(Table())
SetArray LookUp(),h
print "Redirected array"
print h
For lp=0 to max
print LookUp(lp)
next
ThisFunction(h)
ThisOtherFunction(h)
Sync
Waitkey
Function ThisFunction(ThisArray)
print "Locally"
print ThisArray
makeArray Localarray()
SetArray LocalArray(),ThisArray
For lp=0 to GetArrayElements(localArray(),1)
print LocalArray(lp)
next
EndFunction
Function ThisOtherFunction(ThisArray)
Max=5
Dim Cool(max)
Print "standard local"
For lp=0 to max
Cool(lp)=rnd(100)
print Cool(lp)
next
MakeArray Localarray()
SetArray LocalArray(),GetArray(Cool())
Print "redirect locally"
For lp=0 to max
print LocalArray(lp)
next
EndFunction
[/pbcode]
Set/Get/Delete Array Benchmark
VM2 runs this benchmark about 2->4 times as fast as VM1.
GetArray Test Vm2 is 4.1 times faster
SetArray Test Vm2 is 2.3 times faster
DeleteArray Test Vm2 is 2.2 times faster
[pbcode]
max=10
Dim Table2(max)
Dim Table(max)
For lp=0 to max
Table(lp)=rnd(100)
next
MakeArray Lookup()
maxtests=25000
do
cls 0
inc frames
t=timer()
For lp=0 to maxtests
H=GetArray(Table())
next
t1#=t1#+(timer()-t)
print "GetArray:"+str$(t1#/frames)
t=timer()
For lp=0 to maxtests
SetArray LookUp(),h
next
t2#=t2#+(timer()-t)
print "SetArray:"+str$(t2#/frames)
t=timer()
For lp=0 to maxtests
DeleteArray LookUp()
next
t3#=t3#+(timer()-t)
print "DeleteArray:"+str$(t3#/frames)
Sync
loop
[/pbcode]
Vm2 Number Crunching
While the translation to VM2 isn't complete (but pretty close) it's become already pretty apparent that certain functions can yield anything from 2 to 5 times the performance of VM1. But those are generally focused tests, the following are some result running old demos (unchanged) in current VM2 betas running against the fastest VM1 V1.64b/c.
The first demo is the fire lines example from Projects/Demos. The demo was changed to display the frame rate on screen, the version and number of the lines. With 250 firelines (28 sections each, that's 7000 z sorted line fragments) 1.64 runs it 20/21fps, 1.74 runs it 52/53 fps. So in a real world test VM2 is about 2.4 times the processing speed of Vm1.
Shape Particles
This is the shape particles demo from the Projects/Demos. Even though this demo is mainly rendering bound, VM2 can squeeze another 30 off fps out it. Which is pretty surprising.
Dot Sphere
This is the dot sphere example, VM2 runs it about 100fps faster than Vm1.
Dot Shpere (http://www.underwaredesign.com/forums/index.php?topic=2760.msg18566#msg18566) (Code)
Vm2 Fractal Crunching
Fractals are notoriously processor hungry and not really the sort of thing that we should be doing in PB really. Having said that, it's here that we start to see just how much better the number crunching performance of VM2 in PBFX V1.74 is when compared the quickest VM1 edition in PB1.64. Vm2 runs this demo in about 5 seconds. Which works out to be about (approx) 61,000 pixels per second. Vm1 took 21/22 seconds (approx) 14,000 pixels per second. So in this real world raw performance test, we're seeing approximately 4 times the number crunching performance.
Test Code
[pbcode]
openscreen 640,480,16,1
titlescreen playbasic$
x#=-1.257
y#=-0.126
z#=0.02
z2#=0.015
StartTime=timer()
For ypoint=0 To 479
lockbuffer
For xpoint=0 To 639
x1#=x#+(z#/640)*xpoint
y1#=y#+(z2#/480)*ypoint
x2#=x#+(z#/640)*xpoint
y2#=y#+(z2#/480)*ypoint
For b=0 To 200
x3#=x2#*x2#-y2#*y2#+x1#
y3#=2*x2#*y2#+y1#
a#=Sqrt(x3#*x3#+y3#*y3#)
x2#=x3#
y2#=y3#
If a#>=2.0 Then Exit
Next
If a#>2.0
r=255-b
g=0
b=50+b
col1=lsl32(r,16)+g+b
dotc xpoint,ypoint,col1
EndIf
Next
unlockbuffer
if toss=30
sync
toss=0
endif
inc toss
Next
ShowINfo(startTime,ypoint)
Sync
WaitKey
Function ShowINfo(StartTime,Ypoint)
boxc 0,0,100,30,true,0
text 0,15,(timer()-starttime)/1000.0
if mod(ypoint,SyncEvery)=0 then sync
EndFunction
[/pbcode]
P.S. If you look closely, the inner loop of this code could be improved a great deal. See Optimization (http://www.underwaredesign.com/forums/index.php?topic=2548.0) :)
Restoring Vm1/Vm2 File Functions While a lot of the old file command set has been replaced, a lot of the disc processing stuff is still bound to the Vm1 side of the runtime. Making programs that are Dependant upon reading/write files misbehave. While it probably wouldn't take took long to move the whole library across to the VM2, i'm going to fore go that for time being and temporarily hook the read/write command set into the Vm2 program data tables. While this will restore the original functionality, they won't be anywhere near as quick as pure Vm2 solution (context switching between VM's). We'll tackle that post V1.74.
My Test codes:
[pbcode]
Dim ChrBuffer(0)
Dim WordBuffer(0)
Dim IntBuffer(0)
Dim Text$(0)
Filename$="C:\Features.txt"
print LoadTextFile(Filename$,text$())
print LoadCharFileAsIntegers(Filename$,ChrBuffer())
print LoadWordFileAsIntegers(Filename$,WordBuffer())
print LoadIntFileAsIntegers(Filename$,IntBuffer())
Sync
waitkey
Function LoadTextFile(Filename$,Array$())
t=timer()
Row=-1
if fileexist(filename$)=true
#print "file exist"
f=GetFreeFile()
if f>0
readfile filename$,f
ArraySize=GetArrayElements(Array$(),1)
while not endoffile(f)
inc row
s$=readstring$(f)
if Row>ArraySize
ArraySize=ArraySize+1000
redim Array$(ArraySize)
endif
Array$(Row)=s$
endwhile
if (Row>-1) and (row<ArraySize)
redim Array$(Row)
endif
endif
endif
#print "ticks:"+str$(timer()-t)
EndFunction row
Function LoadCharFileAsIntegers(Filename$,Array())
row=-1
t=timer()
if fileexist(filename$)=true
#print "file exist"
f=GetFreeFile()
if f>0
readfile filename$,f
ArraySize=GetArrayElements(Array(),1)
while not endoffile(f)
inc row
if Row>ArraySize
ArraySize=ArraySize+5000
redim Array(ArraySize)
endif
Array(Row)=readbyte(f)
endwhile
if (Row>-1) and (row<ArraySize)
redim Array(Row)
endif
endif
endif
#print "ticks:"+str$(timer()-t)
EndFunction row
Function LoadWordFileAsIntegers(Filename$,Array())
row=-1
t=timer()
if fileexist(filename$)=true
#print "file exist"
f=GetFreeFile()
if f>0
readfile filename$,f
ArraySize=GetArrayElements(Array(),1)
while not endoffile(f)
inc row
if Row>ArraySize
ArraySize=ArraySize+5000
redim Array(ArraySize)
endif
Array(Row)=readword(f)
endwhile
if (Row>-1) and (row<ArraySize)
redim Array(Row)
endif
endif
endif
#print "ticks:"+str$(timer()-t)
EndFunction row
Function LoadIntFileAsIntegers(Filename$,Array())
row=-1
t=timer()
if fileexist(filename$)=true
#print "file exist"
f=GetFreeFile()
if f>0
readfile filename$,f
ArraySize=GetArrayElements(Array(),1)
while not endoffile(f)
inc row
if Row>ArraySize
ArraySize=ArraySize+5000
redim Array(ArraySize)
endif
Array(Row)=readInt(f)
endwhile
if (Row>-1) and (row<ArraySize)
redim Array(Row)
endif
endif
endif
#print "ticks:"+str$(timer()-t)
EndFunction row
[/pbcode]
ReadChrsAt This was being passed the wrong param's
File contents
1234567890
1234567890
1234567890
1234567890
1234567890
[pbcode]
Filename$="C:\testfile.txt"
f=1
Openfile filename$,f
for lp=1 to 12
print readbyte(f)
next
for lp=0 to 2
print ReadChrAt$(F,(lp*12),10)
next
closefile f
print s$
Sync
waitkey
[/pbcode]
Xenon 2000 Comparison
These pictures are of the standard Xenon 2000 map load/viewer code running in both PB1.64 and the current PBFX1.74 beta. Drawing tiles is GPU bound, but even so the smarter render engine & runtime give us an extra 80->100 free fps to play with. Even more in full screen exclusive.
Sign Function in Vm2
// Sign function (returns -1 for neg values 0 for 0 and 1 if positive)
print "Sign"
For lp=-10 to 10
print Sgn(lp)
next
// Get Sign Bit (returns sign bit)
print "GetSign"
For lp=-10 to 10
print GetSign(lp)
next
Sync
waitkey
Kyruss Comparison
These pictures are of Kyruss (Virtual Machine) running in PlayBasic V1.64 AND PlayBasicFX1.74 rc10. Without change, the Vm2 (in PBFX) gives us another 60fps odd (and more) when Kyruss is running 4 synchronous tasks.
What is Kyruss VM ? - See this demo. Old Kyruss Demo (http://www.underwaredesign.com/forums/index.php?topic=529.0)
Z Rotator With Alpha
This is the Z rotator example running in PBFX1.74 (form the example pack See -> Projects/Demos) with alpha applied to the foreground playfield.
Shape Collision
The combined shape method was missing for the sprite compare function. Added in PBFX V174rc11.
Demo Projects\Sprites\_Collision\SpriteCollisionMode3_shape
PlayBasic FX - Basic 3D Demo
This demo is the old Dragon demo running in PlayBasicFX V1.74 rc12..
While PlayBasicFX is primarily a 2D language (with 3d hardware acceleration), you can use the entity sprites and the perspective sprite rendering to create custom 3D scenes, among other things.
Controls:
Mouse = View
Arrow Keys = move
ESC = Exit demo
Download
PlayBasicFX [plink]Basic 3D Demo (http://www.underwaredesign.com/files/demos/PBFX_Basic_3D_Demo.zip)[/plink] (1.2 meg)
PBFX V1.75 Beta #2 - Parser Updates
This beta introduces most (if not all) of the recent parser changes from PlayBasic compiler (V1.64i & j) into PlayBasicFX compiler.
Namely,
- optional INC/DEC amount parsing
- optional conditional expression for DO statement
- optional conditional expression for LOOP statement
- added extra byte code buffer overflow protection
- added compiler confirmation when building from a 'beta' compiler
PBFX V1.76 Beta #1 - Compiler/Parser Updates
This series of beta will be to bring PBFX inline with recent language changes found to PlayBasic V1.64K2..
First port of call is adding the Math Shorts cuts.. So far only ++, -- are working.. But the rest should fall like a deck of cards..
A=A+1
print A
A++
print A
A=A-1
print A
A--
print A
sync
waitkey
and a few hours later we have... ++,--, +=, -=, *=, /= , &=,|= and ~= support for variables...
print "++ Add"
A++
print A
print "-- Sub"
A--
print A
print "Add & Subtract"
A+=10
print a
A-=5
print a
print "Mult & Divide"
A*=10
print a
A/=10
print a
print "And"
a=255
print a
A&=15
print a
print "Or"
A|=$f0
print a
print "XOr"
A~=$ff
print a
sync
waitkey
Math Shorts In Integer/Float & String Array Assignments
Dim Table(100)
print "integer Array Test-----------------------------------------"
Table(20)=5
print Table(20)
print "++ Add"
Table(50)++
print Table(50)
print "-- Sub"
Table(50)--
print Table(50)
print "Add & Subtract"
Table(50)+=10
print Table(50)
Table(50)-=5
print Table(50)
print "Mult & Divide"
Table(50)*=10
print Table(50)
Table(50)/=10
print Table(50)
print "And"
Table(50)=255
print Table(50)
Table(50)&=15
print Table(50)
print "Or"
Table(50)|=$f0
print Table(50)
print "XOr"
Table(50)~=$ff
print Table(50)
sync
waitkey
waitnokey
Cls 0
Dim FltTable#(1000)
print "Float Array Test-----------------------------------------"
FltTable#(20)=5
print FltTable#(20)
print "++ Add"
FltTable#(100)++
print FltTable#(100)
print "-- Sub"
FltTable#(100)--
print FltTable#(100)
print "Add & Subtract"
FltTable#(100)+=10
print FltTable#(100)
FltTable#(100)-=5
print FltTable#(100)
print "Mult & Divide"
FltTable#(100)*=10
print FltTable#(100)
FltTable#(100)/=10
print FltTable#(100)
print "And"
FltTable#(100)=255
print FltTable#(100)
FltTable#(100)&=15
print FltTable#(100)
print "Or"
FltTable#(100)|=$f0
print FltTable#(100)
print "XOr"
FltTable#(100)~=$ff
print FltTable#(100)
sync
waitkey
waitnokey
Cls 0
Dim StrTable$(10)
print "String Array Test-----------------------------------------"
StrTable$(1)="hello"
print StrTable$(1)
StrTable$(1)+="A"
print StrTable$(1)
sync
waitkey
waitnokey
PBFX V1.76 Beta #2 - Short Cut Support For User Defined types
Slowly slotting the new part of the PBV1.64 parser into PBFX. This revision adds Math short cut support to typed variables and arrays.
Type Test1
x,y,z
endtype
Type Test2
i,f#,s$
Endtype
Dim a as Test2
Dim b(10) as Test2
b(5).i=45
b(5).i-=10
print b(5).i
b(5).f=100
print b(5).f
b(5).s="Hello"
b(5).s+="World"
print b(5).s
b(6) = new test1
a.i=45
a.i-=10
print a.i
a.f=123.456
a.f++
print a.f
a.s="Hello"
a.s+="World"
print a.s
Sync
Waitkey
Auto Casting of Mismatched Assignments
These changes allows pointers to be used more like 'integers'.... Which brings FX more inline with the changes made to PB V1.64 (Seen Here (http://www.underwaredesign.com/forums/index.php?topic=3216.msg21329#msg21329))
; declare pointer (generic)
Dim a as pointer
; assign the Integer variable PTR the integer value of 5
ptr=5
// move integer to pointer
a = ptr
// move pointer to integer
i=a
print i
// Add pointer to integer
i+=a
print i
sync
waitkey
more Tests
Mismatched Integer/Float to Float/Integer assignments in types
Type tTest
i
f#
EndType
dim a as tTest pointer
a= new tTest
a.i=5
print A.i
a.i=22.33
print A.i
a.f=5
print A.f
a.f=22.33
print A.f
Sync
waitkey
another test with arrays and pointer assignments
// declare pointer (generic)
Dim a as pointer
a=5
Dim Stuff(100)
Dim Stuff#(100)
print "Integer Array Assignments"
Stuff(1) =a
Stuff(1) +=a
print Stuff(1)
print "Float Array Assignments"
Stuff#(1) +=a
print Stuff#(1)
Type SomeData
x,y,z
f#
endtype
print "Typed Array Assignments"
Dim W(10) as somedata
w(1).x =a
w(1).f =a
print "typed array"
print w(1).x
print w(1).f
w(1).x *=a
w(1).f *=a
print "typed array"
print w(1).x
print w(1).f
print "Typed Variable Assignments"
Dim Y as SomeData
y.x =a
y.f =a
print "typed variable"
print y.x
print y.f
y.x *=a
y.f *=a
print "typed variable"
print y.x
print y.f
sync
waitkey
PBFX V1.76 Beta #3 - SizeOF + Byte / Word Fields in Types
So far I've added the SizeOF() function as well as adding parsing support for BYTE and WORD fields in type declarations. Can't access them though, but that shouldn't take too long..
Type Test
i as integer
f as float
b as byte
w as word
EndType
Dim A as Test
a= new test
print sizeof(test)
constant s =sizeof(test)
print s
Sync
waitkey
ahh finally it's working. Been fumbling around with this most of the night, getting to write the Byte/Word fields was easy enough, but getting it read them turned into one of those witch hunts. Long story short, turned out to be some broken table(s) and and hey presto, it works... Annoyingly, I had pretty much the same drama adding it V1.64k.. completely forget about that :), oh well.
Type Test
i as integer
f as float
b as byte
w as word
IArray(10)
fArray#(10)
sArray$(10)
EndType
Dim A as Test
a= new test
print sizeof(test)
constant s =sizeof(test)
print s
a.b=$aabbccdd
a.w=$aabbccdd
print a.b
print hex$(a.b)
print "Byte:"+hex$(a.b )
print "Word:"+hex$(a.w)
a.i=$11223344
a.f=123.456
print " Int:"+hex$(a.i)
print " Flt:"+Str$(a.f)
a.IArray(5)=455
print a.IArray(5)
a.fArray(5)=123.456
print a.fArray(5)
a.sArray(5)="Hello world"
print a.sArray(5)
Sync
waitkey
PBFX V1.76 Beta #3 - Sort Array Supports String Arrays
Dropped this one into PBFX also..
Size=10
Dim name$(Size)
for lp=0 to size
name$(lp)=ReadData$()
next
SortArray name$(),0,size
for lp=0 to size
print name$(lp)
next
Sync
waitkey
Data "zack","wolf","kev","andy","michelle","dogs","tess","c64","zynaps","dudes","Alpha"
PBFX V1.76 Beta #4 - POst Fix Support For User Functions
This additions bring user functions into line with the internally bound & native VM operations. In other words you can declare a user function name and use the # and $ symbols at the end. The parser doesn't use this are the return prototype though, the return type still comes from the what exported after the EndFunction statement.
[pbcode]
Print Yeah$(45)
print SomeOtherFunction#(11.22)
Sync
waitkey
Function Yeah$(A)
This$="Yeah Function="+str$(a)
EndFunction This$
Function SomeOtherFunction#(ThisFloat#)
Print Thisfloat#
This#=Thisfloat#*10
EndFunction This#
[/pbcode]
DLL bindings now support the # and $ chr;s also.
[pbcode]
Print Yeah$(45)
print SomeOtherFunction#(11.22)
Function Yeah$(A)
This$="Yeah Function="+str$(a)
EndFunction This$
Function SomeOtherFunction#(ThisFloat#)
Print Thisfloat#
This#=Thisfloat#*10
EndFunction This#
linkDll "Some.Dll"
TestFunction(Param) alias "Something" as integer
TestFunction$(Param) alias "Something2" as string
TestFunction#(Param) alias "Something3" as float
EndlinkDll
TestFunction(Param)
TestFunction#(Param)
TestFunction$(Param)
Sync
waitkey
[/pbcode]
PBFX V1.76 Beta #4 - Optional Parameter Support For Internal Commands & Functions
[pbcode]
Do
Cls 0
print "Optional Parameters in Commands"
box 100,100,200,200
circle 400,400,50
print "Optional Parameters in Functions"
a$="Hello"
for lp=1 to len(a$)
print mid$(a$,lp) ; notice the length is missing, it defaults to one now
next
Sync
loop
[/pbcode]
More info can be found here in the V1.64k WIP thread (http://www.underwaredesign.com/forums/index.php?topic=3216.msg21624#msg21624)
Debugger Prototype in PBFX V1.76 Beta #4
This is the recent debugger parser prototype running in today's edition of PBFX. The demo loads a 20,000 line source code, then pre-parsers (syntax highlights) the entire document. This as you can imagine is brute force operation. Pb V1.64k is able to run this test around 1450->1500 milliseconds, while PBFX runs it in 1100->1150 milliseconds. Approximately a 300->350 milliseconds gain on a 20,000 line document.
See Debugger Prototype Thread (http://www.underwaredesign.com/forums/index.php?topic=3264.0)
PBFX V1.76 Beta #5 - Function Declarations
Starting Updating the pre-parser to being it inline with the version in V1.64k. Slow progress currently, due to the number of changes that need to be made. But it'll get there...
Function TestReturns_None()
EndFunction
Function TestReturns_1i()
EndFunction a
Function TestReturns_1f()
EndFunction a#
Function TestReturns_1s()
EndFunction a$
Function TestAsDatatypeReturns_1i()
EndFunction a as integer
Function TestAsDatatypeReturns_1f()
EndFunction a as float
Function TestAsDatatypeReturnsb_1f()
EndFunction a# as float,b
Function TestAsDatatypeReturns_1s()
EndFunction a as string
Function TestAsDatatypeReturnsb_1s()
EndFunction a$ as string
Sync
waitkey
PBFX V1.76 Beta #6/7 - Function Declarations Continued
Still running through the pre-parsing changes, cleaning up the parsing code while I go... really exciting stuff ;)
[pbcode]
Function Test_Void()
EndFunction
Function TestInputs_2i(a,b)
EndFunction
Function TestInputs_1i(a as integer)
EndFunction
Function TestInputs_1f(a as float)
EndFunction
Function TestInputs_1fb(a# as float)
EndFunction
Function TestInputs_1s(a as string)
EndFunction
Function TestInputs_1sb(a$ as string)
EndFunction
Function TestPointerInputs_1(a as pointer)
EndFunction
Function TestPointerInputs_2(a as byte pointer)
EndFunction
Function TestPointerInputs_3(a as word pointer)
EndFunction
Function TestPointerInputs_4(a as integer pointer)
EndFunction
Function TestPointerInputs_5(a as float pointer)
EndFunction
Function TestPointerInputs_6(a as stringref pointer)
EndFunction
Type Vector2D
x#,t#
EndType
Function TestPointerInputs_7(a as vector2d pointer,b as vector2d pointer)
EndFunction
; integer array container
Function TestArrays_1(Me())
EndFunction
Function TestArrays_1b(Me() as integer)
EndFunction
; float array container
Function TestArrays_2(Me#())
EndFunction
Function TestArrays_2b(Me() as float)
EndFunction
; string array container
Function TestArrays_3(Me$())
EndFunction
Function TestArrays_3b(Me() as string)
EndFunction
; Pass typed variable container
Function TestArray_4(Me.Vector2d)
EndFunction
; Pass typed array container
Function TestArray_5(Me().Vector2d)
EndFunction
Function TestArray_5b(Me() as Vector2d)
EndFunction
; Pass typed array container
Function TestArray_6(Me as Vector2d list)
EndFunction
sync
Waitkey
[/pbcode]
PBFX V1.76 Beta #7 - Passing Individual UDT's into functions
Still working on moving the new functionality, namely passing individual UDT buffers into functions..
Type Vector2D
x#,y#
EndType
; container
Dim MyArray(10) as Vector2D
; alloc an instance
MyArray(10) = new Vector2d
; init the fioelds in this instance
MyArray(10).x=100
MyArray(10).y=200
TestUDT_1(MyArray(10))
sync
Waitkey
; Pass single bank into function
Function TestUDT_1(Me as Vector2d)
print me.x
print me.y
EndFunction
PBFX V1.76 Beta #8 - Optional Parameters in User defined functions & Psubs
Took a bit of messing around, but this seems to be working now..
Function TestOptional_Void()
EndFunction
Function FunctionTestOptional_1(a=45.456,b=123)
print "--------------"
print str$(a)+" "+str$(b)
EndFunction
Function FunctionTestOptional_2(a#=45.456,b#=123.567)
print "--------------"
print str$(a#)+" "+str$(b#)
EndFunction
Function FunctionTestOptional_3(a$="Hello",b$="World")
print "--------------"
print a$+" "+b$
EndFunction
; optional integers
print "Optional Integers"
FunctionTestOptional_1(10,20)
FunctionTestOptional_1(10)
FunctionTestOptional_1()
print "Optional Floats"
FunctionTestOptional_2(10,20)
FunctionTestOptional_2(10)
FunctionTestOptional_2()
print "Optional Strings"
FunctionTestOptional_3("Dude","Wobble")
FunctionTestOptional_3("Dude")
FunctionTestOptional_3()
Psub PsubTestOptional_1(a=45,b=123)
print "--------------"
print str$(a)+", "+str$(b)
EndPsub
Psub PsubTestOptional_2(a#=45.456,b#=123.567)
print "--------------"
print str$(a#)+", "+str$(b#)
EndPsub
Psub PsubTestOptional_3(a$="Hello",b$="World")
print a$+" "+b$
EndPsub
; optional integers
print "Optional Integers"
PsubTestOptional_1(10,20)
PsubTestOptional_1(10)
PsubTestOptional_1()
print "Optional Floats"
PsubTestOptional_2(10,20)
PsubTestOptional_2(10)
PsubTestOptional_2()
print "Optional Strings"
PsubTestOptional_3("Dude","Wobble")
PsubTestOptional_3("Dude")
PsubTestOptional_3()
Sync
waitkey
PBFX V1.76 Beta #9 - Exporting Individual UDT's into functions
Working on the exporting structures from functions.. The first is returning UDT buffers, so you can passing the buffer in/out. Not to be confusing with Array passing !
Type Vector2D
x#,y#
EndType
Dim Points(10) as vector2D
For lp=1 to 10
Points(lp)=NewPoint(222+lp,333+lp*10)
print str$(Points(lp))+" "+Str$(Points(lp).x)+" "+Str$(Points(lp).y)
next
Sync
waitkey
waitnokey
Function NewPoint(x#,y#)
Me = new Vector2D
Me.x = x#
Me.y = y#
EndFunction Me as Vector2D
PBFX V1.76 Beta #9 - Array Assignments
Got the first part of array assignments working in VM2...
Dim This(1)
Dim That(100)
For lp=1 to 100
That(lp)=lp+1000
next
; Make's a copy of THAT() array and stores it in THIS()
This()=That()
Sync
Waitkey
PBFX V1.76 Beta #9b - Return Arrays From Functions
Just got this working, so far in only supports Integer arrays, but the frame work is in place to return all array types. Just need to test them..
Integer Arrays
Dim This(1)
; create new array and assign it to the THIS() array
This()= NewArray(20,1000)
; display it's contents
For lp=1 to GetArrayElements(This())
print This(lp)
next
Sync
Waitkey
Function NewArray(Size,RandomRange)
Dim Me(Size)
For lp=0 to Size
me(Lp)=rnd(RandomRange)
next
EndFunction Me() as integer
Float Arrays
Dim This#(1)
; create new array and assign it to the THIS() array
This#()= NewArray(20,1000)
; display it's contents
For lp=1 to GetArrayElements(This#())
print This#(lp)
next
Sync
Waitkey
Function NewArray(Size,RandomRange)
Dim Me#(Size)
For lp=0 to Size
me#(Lp)=rnd(RandomRange)
next
EndFunction Me() as float
String Arrays
name$="Bill,Kev,Test,Dude"
Dim This$(1)
; create new array and assign it to the THIS() array
This$()= NewArray(20,name$)
; display it's contents
For lp=1 to GetArrayElements(This$())
print This$(lp)
next
Sync
Waitkey
Function NewArray(Size,Name$)
Dim NamesList$(100)
Count=SplitToArray(Name$,",",NamesLIst$(),0)
Dim Me$(Size)
For lp=0 to Size
me$(Lp)=NamesList$(rnd(Count))
next
EndFunction Me() as string
Typed Arrays
Type Vector2D
X#,y#
EndType
Type Stuff
name$
pos as vector2d
speed as vector2d
EndType
Dim This(0) as Stuff
; create new array and assign it to the THIS() array
name$="Bill,Dude,PLayBasic,PBFX"
This()= NewArray(20,name$)
; display it's contents
For lp=1 to GetArrayElements(This())
print This(lp)
print This(lp).Name$
print This(lp).pos.x
print This(lp).pos.y
next
Sync
Waitkey
Function NewArray(Size,Name$)
Dim NamesList$(100)
Count=SplitToArray(Name$,",",NamesLIst$(),0)
Dim Me(Size) as stuff
For lp=0 to Size
me(Lp).name=NamesList$(rnd(Count))
me(Lp).pos.x=100+lp
me(Lp).pos.y=200+lp
next
EndFunction Me() as stuff
Typed Variable
Typed variables are basically typed arrays with 1 element. So you can mix and match assignments, don't confuse this with passing a UDT element..
Type Vector2D
X#,y#
EndType
Type Stuff
name$
pos as vector2d
speed as vector2d
EndType
Dim This as Stuff
; create new typed VARIABLE (array) and assign it to the THIS() array
name$="Bill,Dude,PLayBasic,PBFX"
This()= NewArray(20,name$)
; display it's contents
print This
print This.Name$
print This.pos.x
print This.pos.y
Sync
Waitkey
Function NewArray(Size,Name$)
Dim NamesList$(100)
Count=SplitToArray(Name$,",",NamesLIst$(),0)
Dim Me as stuff
me.name=NamesList$(rnd(Count-1))
me.pos.x=100+lp
me.pos.y=200+lp
EndFunction Me.stuff
This version returns a Typed Variable, back into a Type Array. Here we can see that it is in fact a 1d array with 1 element..
Type Vector2D
X#,y#
EndType
Type Stuff
name$
pos as vector2d
speed as vector2d
EndType
Dim This(10) as Stuff
; create new typed VARIABLE (array) and assign it to the THIS() array
name$="Bill,Dude,PLayBasic,PBFX"
This()= NewArray(20,name$)
; display it's contents
for lp=0 to GetArrayElements(This())
print This(lp)
print This(lp).Name$
print This(lp).pos.x
print This(lp).pos.y
next
Sync
Waitkey
Function NewArray(Size,Name$)
Dim NamesList$(100)
Count=SplitToArray(Name$,",",NamesLIst$(),0)
Dim Me as stuff
me.name=NamesList$(rnd(Count-1))
me.pos.x=100+lp
me.pos.y=200+lp
EndFunction Me.stuff
PBFX V1.76 Beta #9b - Return Arrays From PSubs
Testing the array exporting to work with PSUBS.
Integer Arrays
Dim This(1)
; create new array and assign it to the THIS() array
This()= NewArray(20,1000)
; display it's contents
For lp=1 to GetArrayElements(This())
print This(lp)
next
Sync
Waitkey
Psub NewArray(Size,RandomRange)
Dim Me(Size)
For lp=0 to Size
me(Lp)=rnd(RandomRange)
next
EndPsub Me() as integer
Float Arrays
Dim This#(1)
; create new array and assign it to the THIS() array
This#()= NewArray(20,1000)
; display it's contents
For lp=1 to GetArrayElements(This#())
print This#(lp)
next
Sync
Waitkey
Psub NewArray(Size,RandomRange)
Dim Me#(Size)
For lp=0 to Size
me#(Lp)=rnd#(RandomRange)
next
EndPsub Me() as float
String Arrays
name$="Bill,Kev,Test,Dude"
Dim This$(1)
; create new array and assign it to the THIS() array
This$()= NewArray(20,name$)
; display it's contents
For lp=1 to GetArrayElements(This$())
print This$(lp)
next
Sync
Waitkey
Psub NewArray(Size,Name$)
Dim NamesList$(100)
Count=SplitToArray(Name$,",",NamesLIst$(),0)
Dim Me$(Size)
For lp=0 to Size
me$(Lp)=NamesList$(rnd(Count-1))
next
EndPsub Me() as string
Typed Arrays
Type Vector2D
X#,y#
EndType
Type Stuff
name$
pos as vector2d
speed as vector2d
EndType
Dim This(0) as Stuff
; create new array and assign it to the THIS() array
name$="Bill,Dude,PLayBasic,PBFX"
This()= NewArray(20,name$)
; display it's contents
For lp=1 to GetArrayElements(This())
print This(lp)
print This(lp).Name$
print This(lp).pos.x
print This(lp).pos.y
next
Sync
Waitkey
Psub NewArray(Size,Name$)
Dim NamesList$(100)
Count=SplitToArray(Name$,",",NamesLIst$(),0)
Dim Me(Size) as stuff
For lp=0 to Size
me(Lp).name=NamesList$(rnd(Count-1))
me(Lp).pos.x=100+lp
me(Lp).pos.y=200+lp
next
EndPsub Me() as stuff
Typed Variables
Type Vector2D
X#,y#
EndType
Type Stuff
name$
pos as vector2d
speed as vector2d
EndType
Dim This(0) as Stuff
; create new array and assign it to the THIS() array
name$="Bill,Dude,PLayBasic,PBFX"
This()= NewArray(20,name$)
; display it's contents
For lp=1 to GetArrayElements(This())
print This(lp)
print This(lp).Name$
print This(lp).pos.x
print This(lp).pos.y
next
Sync
Waitkey
Psub NewArray(Size,Name$)
Dim NamesList$(100)
Count=SplitToArray(Name$,",",NamesLIst$(),0)
Dim Me(Size) as stuff
For lp=0 to Size
me(Lp).name=NamesList$(rnd(Count-1))
me(Lp).pos.x=100+lp
me(Lp).pos.y=200+lp
next
EndPsub Me() as stuff
Type Vector2D
X#,y#
EndType
Type Stuff
name$
pos as vector2d
speed as vector2d
EndType
Dim This(10) as Stuff
; create new typed VARIABLE (array) and assign it to the THIS() array
name$="Bill,Dude,PLayBasic,PBFX"
This()= NewArray(20,name$)
; display it's contents
for lp=0 to GetArrayElements(This())
print This(lp)
print This(lp).Name$
print This(lp).pos.x
print This(lp).pos.y
next
Sync
Waitkey
Function NewArray(Size,Name$)
Dim NamesList$(100)
Count=SplitToArray(Name$,",",NamesLIst$(),0)
Dim Me as stuff
me.name=NamesList$(rnd(Count-1))
me.pos.x=100+lp
me.pos.y=200+lp
EndFunction Me.stuff
PBFX V1.76 Beta #10 - Returning Typed Lists Functions/PSubs
Type Vector2D
X#,y#
EndType
Type Stuff
name$
pos as vector2d
speed as vector2d
EndType
Dim This as Stuff list
; create new array and assign it to the THIS() array
name$="Bill,Dude,PLayBasic,PBFX"
This()= NewArray(20,name$)
; display it's contents
For each This()
print This
print This.Name$
print This.pos.x
print This.pos.y
next
Sync
Waitkey
Function NewArray(Size,Name$)
Dim NamesList$(100)
Count=SplitToArray(Name$,",",NamesLIst$(),0)
Dim Me as Stuff List
For lp=0 to Size
me = new Stuff
me.name=NamesList$(rnd(Count-1))
me.pos.x=100+lp
me.pos.y=200+lp
next
EndFunction Me as stuff list
PBFX V1.76 Beta #12 - FunctionExist +FunctionIndex
Been working towards getting the dynamic function calling working, first I need to set up the helper commands/functions..
print FunctionExist("COoL")
; print FunctionExist("Cool2")
createimage 1,100,100
print GetImageWidth(1)
x#=mod(x#,iw)
; x#=mod(x#-1.2,GetImageWidth(1))
Sync
waitkey
Function Cool()
EndFunction
While the first few bits are working, after a few modifications, it would appear that those mod's make other functions misbehave..
PBFX V1.76 Beta #12b - FunctionExist +FunctionIndex
These seem to be working now..
print FunctionExist("COoL")
print FunctionIndex("Cool")
print FunctionExist("SomeUnknownFunction")
print FunctionIndex("SomeUnknownFunction")
Sync
waitkey
Function BeforeCool()
EndFunction
Function Cool()
EndFunction
Function AfterCool()
EndFunction
The next and final port of call will the implementing the CallFunction operation.
PBFX V1.76 Beta #12c - CallFunction
After a bit a wrestling Call Function command springs to life. It's not fully implemented as yet, currently it only supports calling 'User Defined Functions' - The Vm2 implementation works a bit differently, but has the same limitations as before. Namely while you can call a function by Name or by index, you can't call a function an retrieve data back from it.
See Example #1 (http://www.underwaredesign.com/forums/index.php?topic=3276.msg21600#msg21600)
CallFunction Performance (PB vs PBFX)
With the addition of the CallFunction operation, I wanted to compare the performance between PB/Vm1 and PBFX/VM2. While VM2 is faster than VM1, we shouldn't simply assume it's everything is faster, just because it's running on it. They're very different beasts under the hood, so it's not that unusual for things to actually run a bit slower in VM2.
Now interestingly it just so happens that the CallFunction operations was indeed slower. About twice as slow actually in PBFXV1.76 beta12, than in PBV1.64l beta2. I had a feeling it would be, in particular when calling a function by name. For two reasons, the searching routine was a linear search and secondly because PBFX has a lot more bound functions to search through. So it just has more work to do.
So after a bit jiggling with the searcher the standard test (code bellow) in PBFX V1.76 beta 13 code runs this about 40% faster than PB V1.64. In fact both methods are faster, although I doubt calling the function by index is much faster in VM2 than it is Vm1, the test is quicker because Vm2 can just run the entire loop and function call quicker.
Print "Dynamic Function Calling"
Dim FunctionNames$(3)
Dim FunctionIndexes(3)
FunctionNames$(0)="Test0"
FunctionNames$(1)="Test1"
FunctionNames$(2)="Test2"
FunctionNames$(3)="Test3"
FunctionIndexes(0)=FunctionIndex("Test0")
FunctionIndexes(1)=FunctionIndex("Test1")
FunctionIndexes(2)=FunctionIndex("Test2")
FunctionIndexes(3)=FunctionIndex("Test3")
MaxTests=10000
Do
Cls 0
frames++
t=timer()
for lp=0 to MaxTests
CallFunction FunctionNames$(lp &3)
next
tt1#+=(timer()-t)
print tt1#/frames
print "tests:"+STR$(lp)
t=timer()
for lp=0 to MaxTests
CallFunction FunctionIndexes(lp &3)
next
tt2#+=(timer()-t)
print tt2#/frames
print "tests:"+STR$(lp)
Sync
loop
Function Test0()
EndFunction
Function Test1()
EndFunction
Function Test2()
EndFunction
Function Test3()
EndFunction
PBFX V1.76 Beta #13 - Psub support CallFunction
As you can see Vm2 version can now call PSUBS. The Vm2 version has an extra feature when calling Psubs, which is the ability to recast integers/floats to strings and vice versa.
[pbcode]
Test1(100,200)
; Passing in Integers
CallFunction "Test1",111,222
; Passing in floats
CallFunction "Test1",111.99,222.99
; Passing in strings. These get converted to the parameters type.
CallFunction "Test1","111.99","222.99"
ink $00ff00
Test2(100,200)
; Passing in Integers
CallFunction "Test2",111,222
; Passing in floats
CallFunction "Test2",111.99,222.99
; Passing in strings. These get converted to the parameters type.
CallFunction "Test2","111.99","222.99"
ink $ff0000
Test3("100","200")
; Passing in Integers
CallFunction "Test3",55,662
; Passing in floats
CallFunction "Test3",111.99,222.99
; Passing in strings. These get converted to the parameters type.
CallFunction "Test3","$ff","%1111"
Sync
waitkey
Psub Test1(a,b)
print "--------------"
print a
print b
EndPsub
Psub Test2(a#,b#)
print "--------------"
print a#
print b#
EndPsub
Psub Test3(a$,b$)
print "--------------"
print a$
print b$
EndPsub
[/pbcode]
Bench mark
[pbcode]
Print "Dynamic Psub Calling With Parameter"
Dim FunctionNames$(3)
Dim FunctionIndexes(3)
FunctionNames$(0)="Test0"
FunctionNames$(1)="Test1"
FunctionNames$(2)="Test2"
FunctionNames$(3)="Test3"
FunctionIndexes(0)=FunctionIndex("Test0")
FunctionIndexes(1)=FunctionIndex("Test1")
FunctionIndexes(2)=FunctionIndex("Test2")
FunctionIndexes(3)=FunctionIndex("Test3")
MaxTests=10000
Do
Cls 0
frames++
t=timer()
for lp=0 to MaxTests
CallFunction FunctionNames$(lp &3),lp
next
tt1#+=(timer()-t)
print tt1#/frames
print "tests:"+STR$(lp)
t=timer()
for lp=0 to MaxTests
CallFunction FunctionIndexes(lp &3),lp
next
tt2#+=(timer()-t)
print tt2#/frames
print "tests:"+STR$(lp)
Sync
loop
Psub Test0(a)
EndPsub
Psub Test1(a)
EndPsub
Psub Test2(a)
EndPsub
Psub Test3(a)
EndPsub
[/pbcode]
PBFX V1.76 Beta #13 - Rounding It Off
With this revision we're basically at that point where FX has caught up all the compiler changes that found in PB1.64k.
ExitFunction
Now supports returning arrays
[pbcode]
Dim Array(1)
Dim Array#(1)
Dim Array$(1)
Type Pos
x,y,z
EndType
; Yeah=1
Global State=true
for State=0 to 1
print "Test:State="+str$(State)
print Stuff_int()
print Stuff_int2()
print Stuff_float()
print Stuff_float2()
print Stuff_Str()
print Stuff_Str2()
next
Sync
waitkey
waitnokey
cls 0
for State=0 to 1
print "Test:State="+str$(State)
Array()=Stuff_intarray()
print GetArrayElements(Array())
Array$()=Stuff_Strarray()
print GetArrayElements(Array$())
#break
next
Sync
waitkey
waitnokey
Function Stuff_INtArray()
if State
Dim TestArray(100)
exitfunction TestArray()
else
Dim TestArray(200)
endif
EndFunction TestArray()
Function Stuff_FltArray()
if State
Dim TestArray#(100)
exitfunction TestArray#()
else
Dim TestArray#(200)
endif
EndFunction TestArray() as float
Function Stuff_StrArray()
if State
Dim TestArray$(102)
exitfunction TestArray$()
else
Dim TestArray$(202)
endif
EndFunction TestArray() as string
Function Stuff_INt()
a=1
Yeah=2
if State
exitfunction a
endif
EndFunction Yeah
Function Stuff_INt2()
a=1
Yeah=2
if State
exitfunction a
endif
EndFunction Yeah as integer
Function Stuff_Float()
a#=1
Yeah#=2
if State
exitfunction a#
endif
EndFunction Yeah#
Function Stuff_Float2()
a#=1
Yeah#=2
if State
exitfunction a#
endif
EndFunction Yeah as float
Function Stuff_Str()
a$="1$"
Yeah$="2$"
if State
exitfunction a$
endif
EndFunction Yeah$
Function Stuff_Str2()
a$="1$"
Yeah$="2$"
if State
exitfunction a$
endif
EndFunction Yeah as string
[/pbcode]
Vsync in Windowed modes
This allows the window to vsync'd, bring it in line with full screen modes.
[pbcode]
img= MakeGridPatternImg(32,4,32,4,10,rgb(120,130,140),rgb(150,150,150),rgb(210,200,200))
//
StartTime=Timer()
Do
TileIMage img,Xpos,0,false
TimePast=Timer()-StartTime
Xpos-=1
if spacekey()
ScreenVsync 1-getScreenVsync()
flushkeys()
endif
Text 0,0,"Vsync:"+Str$(GetScreenVsync())
Sync
loop
Function MakeGridPatternImg(GridWidth,GridWidthStepX,GridHeight,GridHeightStepY,Segs, BG_RGB, SubDiv_RGB, HighLight_RGB)
oldRgb=Getink()
oldSurface=GetSurface()
w =GridWidth *Segs
h =GridHeight *Segs
ThisIMage=NewImage(w,h)
RenderToImage thisimage
Cls BG_RGB
ink SubDiv_RGB
lockbuffer
For Ylp=0 to H-1 step GridWidthStepX
For Xlp=0 to w-1 step GridHeightStepY
line 0,ylp,w,ylp
line xlp,0,xlp,h
next
next
unlockbuffer
ink HighLight_RGB
lockbuffer
For Ylp=0 to H-1 step GridHeight
For Xlp=0 to w-1 step GridWidth
line 0,ylp,w,ylp
line xlp,0,xlp,h
next
next
unlockbuffer
; restore old surface and ink colour
RenderToImage OldSurface
ink oldrgb
EndFunction ThisImage
[/pbcode]