123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799 |
- ( 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
|