( a blank file ) %+ { ADD } %- { SUB } %/ { DIV } %< { LTH } %> { GTH } %= { EQU } %! { NEQ } %++ { ADD2 } %-- { SUB2 } %// { DIV2 } %<< { LTH2 } %>> { GTH2 } %== { EQU2 } %!! { NEQ2 } %DEBUG { ;print-hex JSR2 #0a .Console/write DEO } %DEBUG2 { SWP ;print-hex JSR2 ;print-hex JSR2 #0a .Console/write DEO } %RTN { JMP2r } ( devices ) |00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ] |10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ] |20 @Screen [ &vector $2 &width $2 &height $2 &pad $2 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ] |30 @Audio0 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ] |40 @Audio1 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ] |50 @Audio2 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ] |60 @Audio3 [ &vector $2 &position $2 &output $1 &pad $3 &adsr $2 &length $2 &addr $2 &volume $1 &pitch $1 ] |80 @Controller [ &vector $2 &button $1 &key $1 ] |90 @Mouse [ &vector $2 &x $2 &y $2 &state $1 &wheel $1 ] |a0 @File [ &vector $2 &name $2 &length $2 &success $2 &load $2 &save $2 &stat $2 &delete $1 ] |b0 @DateTime [ &year $2 &month $1 &day $1 &hour $1 &minute $1 &second $1 &dotw $1 &doty $2 &isdst $1 ] ( variables ) |0000 @lista $3 @listb $3 @listc $3 ( program ) |0100 ( -> ) ( theme ) #0fe5 .System/r DEO2 #0fc5 .System/g DEO2 #0f25 .System/b DEO2 #01 .lista STZ #02 .lista INC STZ #03 .lista #02 + STZ #10 .listb STZ #20 .listb INC STZ #30 .listb #02 + STZ .lista .listb .listc ;add-lists-loop JSR2 .listc LDZ DEBUG .listc INC LDZ DEBUG .listc #02 + LDZ DEBUG BRK ( Write a Forth word to add together two integer vectors (a.k.a. arrays) of three elements each. ) @add-lists-linear ( a b c -- ) STH ( a[0] b[0] + ) LDZk STH SWP LDZk STHr + STHkr STZ ( a[1] b[1] + ) INC LDZk STH SWP INC LDZk STHr + STHkr INC STZ ( a[2] b[2] + ) INC LDZ SWP INC LDZ + STHr #02 + STZ RTN @add-lists-loop ( a b c -- ) STH #00 #03 &loop ( get incr ) OVR STH ( get a[x] ) OVR2 STHkr ADD LDZ ( get b[x] ) SWP STHkr ADD LDZ ( set c[x] ) ADD STHr STHkr ADD STZ ( incr ) SWP INC SWP LTHk ,&loop JCN POP2 POP2 POPr JMP2r @print-hex ( value -- ) STHk #04 SFT ,&parse JSR .Console/write DEO STHr #0f AND ,&parse JSR .Console/write DEO RTN &parse ( value -- char ) DUP #09 GTH ,&above JCN #30 ADD RTN &above #09 SUB #60 ADD RTN RTN