aboutsummaryrefslogtreecommitdiff
path: root/docs/j1demo/firmware/main.fs
diff options
context:
space:
mode:
Diffstat (limited to 'docs/j1demo/firmware/main.fs')
-rw-r--r--docs/j1demo/firmware/main.fs799
1 files changed, 799 insertions, 0 deletions
diff --git a/docs/j1demo/firmware/main.fs b/docs/j1demo/firmware/main.fs
new file mode 100644
index 0000000..16e4cf5
--- /dev/null
+++ b/docs/j1demo/firmware/main.fs
@@ -0,0 +1,799 @@
+( 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