From a76977af62010a392c16010c367185e61e856ffe Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Wed, 30 Oct 2019 20:04:56 +0100 Subject: mv to docs --- docs/j1demo/firmware/main.fs | 799 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 799 insertions(+) create mode 100644 docs/j1demo/firmware/main.fs (limited to 'docs/j1demo/firmware/main.fs') 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 -- cgit v1.2.3