800 lines
14 KiB
Forth
800 lines
14 KiB
Forth
( Main for WGE firmware JCB 13:24 08/24/10)
|
|
|
|
\ warnings off
|
|
\ require tags.fs
|
|
|
|
include crossj1.fs
|
|
meta
|
|
: TARGET? 1 ;
|
|
: build-debug? 1 ;
|
|
|
|
include basewords.fs
|
|
target
|
|
include hwdefs.fs
|
|
|
|
0 [IF]
|
|
h# 1f80 org
|
|
\ the RAM Bootloader copies 2000-3f80 to 0-1f80, then branches to zero
|
|
: bootloader
|
|
h# 1f80 h# 0
|
|
begin
|
|
2dupxor
|
|
while
|
|
dup h# 2000 + @
|
|
over !
|
|
d# 2 +
|
|
repeat
|
|
|
|
begin dsp h# ff and while drop repeat
|
|
d# 0 >r
|
|
;
|
|
[ELSE]
|
|
h# 3f80 org
|
|
\ the Flash Bootloader copies 0x190000 to 0-3f80, then branches to zero
|
|
: bootloader
|
|
h# c flash_a_hi !
|
|
h# 0 begin
|
|
dup h# 8000 + flash_a !
|
|
d# 0 flash_oe_n !
|
|
flash_d @
|
|
d# 1 flash_oe_n !
|
|
over dup + !
|
|
d# 1 +
|
|
dup h# 1fc0 =
|
|
until
|
|
|
|
begin dsp h# ff and while drop repeat
|
|
d# 0 >r
|
|
;
|
|
[THEN]
|
|
|
|
4 org
|
|
module[ everything"
|
|
include nuc.fs
|
|
|
|
include version.fs
|
|
|
|
\ 33333333 / 115200 = 289, half cycle is 144
|
|
|
|
: pause144
|
|
d# 0 d# 45
|
|
begin
|
|
1-
|
|
2dup=
|
|
until
|
|
2drop
|
|
;
|
|
|
|
: serout ( u -- )
|
|
h# 300 or \ 1 stop bits
|
|
2* \ 0 start bit
|
|
\ Start bit
|
|
begin
|
|
dup RS232_TXD ! 2/
|
|
pause144
|
|
pause144
|
|
dup 0=
|
|
until
|
|
drop
|
|
pause144 pause144
|
|
pause144 pause144
|
|
;
|
|
|
|
: frac ( ud u -- d1 u1 ) \ d1+u1 is ud
|
|
>r 2dup d# 1 r@ m*/ 2swap 2over r> d# 1 m*/ d- drop ;
|
|
: .2 s>d <# # # #> type ;
|
|
: build.
|
|
decimal
|
|
builddate drop
|
|
[ -8 3600 * ] literal s>d d+
|
|
d# 1 d# 60 m*/mod >r
|
|
d# 1 d# 60 m*/mod >r
|
|
d# 1 d# 24 m*/mod >r
|
|
2drop
|
|
r> .2 [char] : emit
|
|
r> .2 [char] : emit
|
|
r> .2 ;
|
|
|
|
: net-my-mac h# 1234 h# 5677 h# 7777 ;
|
|
|
|
include doc.fs
|
|
include time.fs
|
|
include eth-ax88796.fs
|
|
include packet.fs
|
|
include ip0.fs
|
|
include defines_tcpip.fs
|
|
include defines_tcpip2.fs
|
|
include arp.fs
|
|
include ip.fs
|
|
include udp.fs
|
|
include dhcp.fs
|
|
|
|
code in end-code
|
|
: on ( a -- ) d# 1 swap ! ;
|
|
code out end-code
|
|
: off ( a -- ) d# 0 swap ! ;
|
|
|
|
: flash-reset
|
|
flash_rst_n off
|
|
flash_rst_n on
|
|
;
|
|
|
|
: flash-cold
|
|
flash_ddir on
|
|
flash_ce_n off
|
|
flash_oe_n on
|
|
flash_we_n on
|
|
flash_byte_n on
|
|
flash_rdy on
|
|
flash-reset
|
|
;
|
|
|
|
: flash-w ( u a -- )
|
|
flash_a !
|
|
flash_d !
|
|
flash_ddir off
|
|
flash_we_n off
|
|
flash_we_n on
|
|
flash_ddir on
|
|
;
|
|
|
|
: flash-r ( a -- u )
|
|
flash_a !
|
|
flash_oe_n off
|
|
flash_d @
|
|
flash_oe_n on
|
|
;
|
|
|
|
: flash-unlock ( -- )
|
|
h# aa h# 555 flash-w
|
|
h# 55 h# 2aa flash-w
|
|
;
|
|
|
|
: flash! ( u da. -- )
|
|
flash-unlock
|
|
h# a0 h# 555 flash-w
|
|
flash_a 2+ ! ( u a )
|
|
2dup ( u a u a)
|
|
flash-w ( u a )
|
|
begin
|
|
2dup flash-r xor
|
|
h# 80 and 0=
|
|
until
|
|
2drop
|
|
flash-reset
|
|
;
|
|
|
|
: flash@ ( da. -- u )
|
|
flash_a 2+ ! ( u a )
|
|
flash-r
|
|
;
|
|
|
|
: flash-chiperase
|
|
flash-unlock
|
|
h# 80 h# 555 flash-w
|
|
h# aa h# 555 flash-w
|
|
h# 55 h# 2aa flash-w
|
|
h# 10 h# 555 flash-w
|
|
;
|
|
|
|
: flash-sectorerase ( da -- ) \ erase one sector
|
|
flash-unlock
|
|
h# 80 h# 555 flash-w
|
|
h# aa h# 555 flash-w
|
|
h# 55 h# 2aa flash-w
|
|
flash_a 2+ ! h# 30 swap flash-w
|
|
;
|
|
|
|
: flash-erased ( a -- f )
|
|
flash@ h# 80 and 0<> ;
|
|
|
|
: flash-dump ( da u -- )
|
|
0do
|
|
2dup flash@ hex4 space
|
|
d1+
|
|
loop cr
|
|
2drop
|
|
;
|
|
|
|
: flashc@
|
|
over d# 15 lshift flash_d !
|
|
d2/ flash@
|
|
;
|
|
|
|
: flash-bytes
|
|
s" BYTES: " type
|
|
flash_byte_n off
|
|
h# 0.
|
|
d# 1024 0do
|
|
i d# 15 and 0= if
|
|
cr
|
|
2dup hex8 space space
|
|
then
|
|
2dup flashc@ hex2 space
|
|
d1+
|
|
loop cr
|
|
2drop
|
|
flash_byte_n on
|
|
;
|
|
|
|
0 [IF]
|
|
: flash-demo
|
|
flash-unlock
|
|
h# 90 h# 555 flash-w
|
|
h# 00 flash-r hex4 cr
|
|
flash-reset
|
|
|
|
false if
|
|
flash-unlock
|
|
h# a0 h# 555 flash-w
|
|
h# 0947 h# 5 flash-w
|
|
sleep1
|
|
flash-reset
|
|
then
|
|
|
|
\ h# dead d# 11. flash!
|
|
|
|
h# 100 0do
|
|
i flash-r hex4 space
|
|
loop cr
|
|
cr cr
|
|
d# 0. h# 80 flash-dump
|
|
cr cr
|
|
|
|
flash-bytes
|
|
|
|
exit
|
|
flash-unlock
|
|
h# 80 h# 555 flash-w
|
|
h# aa h# 555 flash-w
|
|
h# 55 h# 2aa flash-w
|
|
h# 10 h# 555 flash-w
|
|
s" waiting for erase" type cr
|
|
begin
|
|
h# 0 flash-r dup hex4 cr
|
|
h# 80 and
|
|
until
|
|
|
|
h# 100 0do
|
|
i flash-r hex4 space
|
|
loop cr
|
|
;
|
|
[THEN]
|
|
|
|
include sprite.fs
|
|
|
|
variable cursory \ ptr to start of line in video memory
|
|
variable cursorx \ offset to char
|
|
|
|
64 constant width
|
|
50 constant wrapcolumn
|
|
|
|
: vga-at-xy ( u1 u2 )
|
|
cursory !
|
|
cursorx !
|
|
;
|
|
|
|
: home d# 0 vga_scroll ! d# 0 d# 0 vga-at-xy ;
|
|
|
|
: vga-line ( -- a ) \ address of current line
|
|
cursory @ vga_scroll @ + d# 31 and d# 6 lshift
|
|
h# 8000 or
|
|
;
|
|
|
|
: vga-erase ( a u -- )
|
|
bounds begin
|
|
2dupxor
|
|
while
|
|
h# 00 over ! 1+
|
|
repeat 2drop
|
|
;
|
|
|
|
: vga-page
|
|
home vga-line d# 2048 vga-erase
|
|
hide
|
|
;
|
|
|
|
: down1
|
|
cursory @ d# 31 <> if
|
|
d# 1 cursory +!
|
|
else
|
|
false if
|
|
d# 1 vga_scroll +!
|
|
vga-line width vga-erase
|
|
else
|
|
home
|
|
then
|
|
then
|
|
;
|
|
|
|
: vga-emit ( c -- )
|
|
dup d# 13 = if
|
|
drop d# 0 cursorx !
|
|
else
|
|
dup d# 10 = if
|
|
drop down1
|
|
else
|
|
d# -32 +
|
|
vga-line cursorx @ + !
|
|
d# 1 cursorx +!
|
|
cursorx @ wrapcolumn = if
|
|
d# 0 cursorx !
|
|
down1
|
|
then
|
|
then
|
|
then
|
|
;
|
|
|
|
: flash>ram ( d. a -- ) \ copy 2K from flash d to a
|
|
>r d2/ r>
|
|
d# 1024 0do
|
|
>r
|
|
2dup flash@
|
|
r> ( d. u a )
|
|
over swab over !
|
|
1+
|
|
tuck !
|
|
1+
|
|
>r d1+ r>
|
|
loop
|
|
drop 2drop
|
|
;
|
|
|
|
: vga-cold
|
|
h# f800 h# f000 do
|
|
d# 0 i !
|
|
loop
|
|
|
|
vga-page
|
|
|
|
\ pic: Copy 2048 bytes from 180000 to 8000
|
|
\ chr: Copy 2048 bytes from 180800 to f000
|
|
h# 180000. h# 8000 flash>ram
|
|
h# 180800. h# f000 flash>ram
|
|
|
|
\ ['] vga-emit 'emit !
|
|
;
|
|
|
|
create glyph 8 allot
|
|
: wide1 ( c -- )
|
|
swab
|
|
d# 8 0do
|
|
dup 0<
|
|
if d# 127 else sp then
|
|
\ if [char] * else [char] . then
|
|
vga-emit
|
|
2*
|
|
loop drop
|
|
;
|
|
|
|
: vga-bigemit ( c -- )
|
|
dup d# 13 = if
|
|
drop d# 0 cursorx !
|
|
else
|
|
dup d# 10 = if
|
|
drop d# 8 0do down1 loop
|
|
else
|
|
sp - d# 8 * s>d
|
|
h# 00180800. d+ d2/
|
|
d# 4 0do
|
|
2dup flash@ swab
|
|
i cells glyph + !
|
|
d1+
|
|
loop 2drop
|
|
|
|
d# 7 0do
|
|
i glyph + c@ wide1
|
|
d# -8 cursorx +! down1
|
|
loop
|
|
d# 7 glyph + c@ wide1
|
|
|
|
d# -7 cursory +!
|
|
then
|
|
then
|
|
;
|
|
|
|
( Demo utilities JCB 10:56 12/05/10)
|
|
|
|
: statusline ( a u -- ) \ display string on the status line
|
|
d# 0 d# 31 2dup vga-at-xy
|
|
d# 50 spaces
|
|
vga-at-xy type
|
|
;
|
|
|
|
( Game stuff JCB 15:20 11/15/10)
|
|
|
|
variable seed
|
|
: random ( -- u )
|
|
seed @ d# 23947 * d# 57711 xor dup seed ! ;
|
|
|
|
|
|
\ Each line is 20.8 us, so 1000 instructions
|
|
|
|
include sincos.fs
|
|
|
|
( Stars JCB 15:23 11/15/10)
|
|
|
|
2variable vision
|
|
variable frame
|
|
128 constant nstars
|
|
create stars 1024 allot
|
|
|
|
: star 2* cells stars + ;
|
|
: 15.* m* d2* nip ;
|
|
|
|
\ >>> math.cos(math.pi / 180) * 32767
|
|
\ 32762.009427189474
|
|
\ >>> math.sin(math.pi / 180) * 32767
|
|
\ 571.8630017304688
|
|
|
|
[ pi 128e0 f/ fcos 32767e0 f* f>d drop ] constant COSa
|
|
[ pi 128e0 f/ fsin 32767e0 f* f>d drop ] constant SINa
|
|
|
|
: rotate ( i -- ) \ rotate star i
|
|
star dup 2@ ( x y )
|
|
over SINa 15.* over COSa 15.* + >r
|
|
swap COSa 15.* swap SINa 15.* - r>
|
|
rot 2!
|
|
;
|
|
|
|
: rotateall
|
|
d# 256 0do i rotate loop ;
|
|
|
|
: scatterR
|
|
nstars 0do
|
|
random d# 0 i star 2!
|
|
rotateall
|
|
rotateall
|
|
rotateall
|
|
rotateall
|
|
loop
|
|
;
|
|
|
|
: scatterSpiral
|
|
nstars 0do
|
|
i d# 3 and 1+ d# 8000 *
|
|
d# 0 i star 2!
|
|
rotateall
|
|
rotateall
|
|
rotateall
|
|
rotateall
|
|
loop
|
|
;
|
|
|
|
: scatter
|
|
nstars 0do
|
|
\ d# 0 random
|
|
d# 0 i sin
|
|
i star 2!
|
|
i random d# 255 and 0do
|
|
dup rotate
|
|
loop drop
|
|
loop
|
|
;
|
|
|
|
: /128 dup 0< h# fe00 and swap d# 7 rshift or ;
|
|
: tx /128 [ 400 ] literal + ;
|
|
: ty /128 [ 256 ] literal + ;
|
|
|
|
: plot ( i s ) \ plot star i in sprite s
|
|
>r
|
|
dup star @ tx swap d# 2 lshift
|
|
r> sprite!
|
|
;
|
|
|
|
( Display list JCB 16:10 11/15/10)
|
|
|
|
create dl 1026 allot
|
|
|
|
: erasedl
|
|
dl d# 1024 bounds begin
|
|
d# -1 over !
|
|
cell+ 2dup=
|
|
until 2drop
|
|
;
|
|
|
|
: makedl
|
|
erasedl
|
|
|
|
nstars 0do
|
|
i d# 2 lshift
|
|
cells dl +
|
|
\ cell occupied, use one below
|
|
\ dup @ 0< invert if cell+ then
|
|
i swap !
|
|
loop
|
|
;
|
|
|
|
variable lastsp
|
|
: stars-chasebeam
|
|
hide
|
|
d# 0 lastsp !
|
|
d# 512 0do
|
|
begin vga-line@ i = until
|
|
i cells dl + @ dup 0< if
|
|
drop
|
|
else
|
|
lastsp @ 1+ d# 7 and dup lastsp ! plot
|
|
then
|
|
i nstars < if i rotate then
|
|
loop
|
|
;
|
|
|
|
|
|
|
|
: loadcolors
|
|
d# 8 0do
|
|
dup @
|
|
i cells vga_spritec + !
|
|
cell+
|
|
loop
|
|
drop
|
|
;
|
|
create cpastels
|
|
h# 423 ,
|
|
h# 243 ,
|
|
h# 234 ,
|
|
h# 444 ,
|
|
h# 324 ,
|
|
h# 432 ,
|
|
h# 342 ,
|
|
h# 244 ,
|
|
: pastels cpastels loadcolors ;
|
|
|
|
create crainbow
|
|
h# 400 ,
|
|
h# 440 ,
|
|
h# 040 ,
|
|
h# 044 ,
|
|
h# 004 ,
|
|
h# 404 ,
|
|
h# 444 ,
|
|
h# 444 ,
|
|
: rainbow crainbow loadcolors ;
|
|
|
|
variable prev_sw3_n
|
|
|
|
: next? ( -- f ) \ has user requested next screen
|
|
sw3_n @ prev_sw3_n fall?
|
|
;
|
|
|
|
: loadsprites ( da -- )
|
|
2/
|
|
d# 16384 0do
|
|
2dup i s>d d+ flash@
|
|
i vga_spritea ! vga_spriteport !
|
|
loop
|
|
2drop
|
|
;
|
|
|
|
: stars-main
|
|
vga-page
|
|
d# 16384 0do
|
|
h# 204000. 2/ i s>d d+ flash@
|
|
i vga_spritea ! vga_spriteport !
|
|
loop
|
|
|
|
vga_addsprites on
|
|
rainbow
|
|
|
|
time@ xor seed !
|
|
seed off
|
|
scatter
|
|
|
|
d# 7000000. vision setalarm
|
|
d# 0 frame !
|
|
begin
|
|
makedl
|
|
stars-chasebeam
|
|
\ d# 256 0do i i plot loop
|
|
\ rotateall
|
|
frame @ 1+ frame !
|
|
next?
|
|
until
|
|
frame @ . s" frames" type cr
|
|
;
|
|
|
|
: buttons ( -- u ) \ pb4 pb3 pb2
|
|
pb_a_dir on
|
|
pb_a @ d# 7 xor
|
|
pb_a_dir off
|
|
;
|
|
|
|
include loader.fs
|
|
include dns.fs
|
|
|
|
: preip-handler
|
|
begin
|
|
mac-fullness
|
|
while
|
|
OFFSET_ETH_TYPE packet@ h# 800 = if
|
|
dhcp-wait-offer
|
|
then
|
|
mac-consume
|
|
repeat
|
|
;
|
|
|
|
: haveip-handler
|
|
\ time@ begin ether_irq @ until time@ 2swap d- d. cr
|
|
\ begin ether_irq @ until
|
|
begin
|
|
mac-fullness
|
|
while
|
|
arp-handler
|
|
OFFSET_ETH_TYPE packet@ h# 800 =
|
|
if
|
|
d# 2 OFFSET_IP_DSTIP mac-inoffset mac@n net-my-ip d=
|
|
if
|
|
icmp-handler
|
|
then
|
|
loader-handler
|
|
then
|
|
depth if .s cr then
|
|
mac-consume
|
|
repeat
|
|
;
|
|
|
|
include invaders.fs
|
|
|
|
: uptime
|
|
time@
|
|
d# 1 d# 1000 m*/
|
|
d# 1 d# 1000 m*/
|
|
;
|
|
|
|
( IP address formatting JCB 14:50 10/26/10)
|
|
|
|
: #ip1 h# ff and s>d #s 2drop ;
|
|
: #. [char] . hold ;
|
|
: #ip2 dup #ip1 #. d# 8 rshift #ip1 ;
|
|
: #ip ( ip -- c-addr u) dup #ip2 #. over #ip2 ;
|
|
|
|
variable prev_sw2_n
|
|
: sw2? sw2_n @ prev_sw2_n fall? ;
|
|
|
|
include ps2kb.fs
|
|
|
|
: istab?
|
|
key? dup if key TAB = and then
|
|
;
|
|
|
|
: welcome-main
|
|
vga-cold
|
|
home
|
|
s" F1 to set up network, TAB for next demo" statusline
|
|
|
|
rainbow
|
|
h# 200000. loadsprites
|
|
'emit @ >r
|
|
d# 6 d# 26 vga-at-xy s" Softcore Forth CPU" type
|
|
|
|
d# 32 d# 6 vga-at-xy s" version " type version type
|
|
d# 32 d# 8 vga-at-xy s" built " type build.
|
|
|
|
kb-cold
|
|
home
|
|
begin
|
|
kbfifo-proc
|
|
d# 32 d# 10 vga-at-xy net-my-ip <# #ip #> type space space
|
|
d# 32 d# 12 vga-at-xy s" uptime " type uptime d.
|
|
haveip-handler
|
|
|
|
d# 8 0do
|
|
frame @ i d# 32 * + invert >r
|
|
d# 100 r@ sin* d# 600 +
|
|
d# 100 r> cos* d# 334 +
|
|
i sprite!
|
|
loop
|
|
|
|
waitblank
|
|
d# 1 frame +!
|
|
next?
|
|
istab? or
|
|
until
|
|
r> 'emit !
|
|
;
|
|
|
|
include clock.fs
|
|
|
|
: frob
|
|
flash_ce_n on
|
|
flash_ddir off
|
|
d# 32 0do
|
|
d# 1 i d# 7 and lshift
|
|
flash_d !
|
|
d# 30000. sleepus
|
|
loop
|
|
flash_ddir on
|
|
;
|
|
|
|
: main
|
|
decimal
|
|
['] serout 'emit !
|
|
\ sleep1
|
|
|
|
frob
|
|
|
|
d# 60 0do cr loop
|
|
s" Welcome! Built " type build. cr
|
|
snap
|
|
|
|
flash-cold
|
|
\ flash-demo
|
|
\ flash-bytes
|
|
vga-cold
|
|
['] vga-emit 'emit !
|
|
s" Waiting for Ethernet NIC" statusline
|
|
mac-cold
|
|
nicwork
|
|
h# decafbad. dhcp-xid!
|
|
d# 3000000. dhcp-alarm setalarm
|
|
false if
|
|
ip-addr dz
|
|
begin
|
|
net-my-ip d0=
|
|
while
|
|
dhcp-alarm isalarm if
|
|
dhcp-discover
|
|
s" DISCOVER" type cr
|
|
d# 3000000. dhcp-alarm setalarm
|
|
then
|
|
preip-handler
|
|
repeat
|
|
else
|
|
ip# 192.168.0.99 ip-addr 2!
|
|
ip# 255.255.255.0 ip-subnetmask 2!
|
|
ip# 192.168.0.1 ip-router 2!
|
|
\ ip# 192.168.2.201 ip-addr 2!
|
|
\ ip# 255.255.255.0 ip-subnetmask 2!
|
|
\ ip# 192.168.2.1 ip-router 2!
|
|
then
|
|
dhcp-status
|
|
arp-reset
|
|
|
|
begin
|
|
welcome-main sleep.1
|
|
clock-main sleep.1
|
|
stars-main sleep.1
|
|
invaders-main sleep.1
|
|
s" looping" type cr
|
|
again
|
|
|
|
begin
|
|
haveip-handler
|
|
again
|
|
;
|
|
|
|
|
|
]module
|
|
|
|
0 org
|
|
|
|
code 0jump
|
|
\ h# 3e00 ubranch
|
|
main ubranch
|
|
main ubranch
|
|
end-code
|
|
|
|
meta
|
|
|
|
hex
|
|
|
|
: create-output-file w/o create-file throw to outfile ;
|
|
|
|
\ .mem is a memory dump formatted for use with the Xilinx
|
|
\ data2mem tool.
|
|
s" j1.mem" create-output-file
|
|
:noname
|
|
s" @ 20000" type cr
|
|
4000 0 do i t@ s>d <# # # # # #> type cr 2 +loop
|
|
; execute
|
|
|
|
\ .bin is a big-endian binary memory dump
|
|
s" j1.bin" create-output-file
|
|
:noname 4000 0 do i t@ dup 8 rshift emit emit 2 +loop ; execute
|
|
|
|
\ .lst file is a human-readable disassembly
|
|
s" j1.lst" create-output-file
|
|
d# 0
|
|
h# 2000 disassemble-block
|