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 --- j1demo/firmware/main.fs | 799 ------------------------------------------------ 1 file changed, 799 deletions(-) delete mode 100644 j1demo/firmware/main.fs (limited to 'j1demo/firmware/main.fs') diff --git a/j1demo/firmware/main.fs b/j1demo/firmware/main.fs deleted file mode 100644 index 16e4cf5..0000000 --- a/j1demo/firmware/main.fs +++ /dev/null @@ -1,799 +0,0 @@ -( 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