aboutsummaryrefslogtreecommitdiff
path: root/j1demo/firmware/main.fs
diff options
context:
space:
mode:
authorDimitri Sokolyuk <demon@dim13.org>2019-10-30 20:04:56 +0100
committerDimitri Sokolyuk <demon@dim13.org>2019-10-30 20:04:56 +0100
commita76977af62010a392c16010c367185e61e856ffe (patch)
tree56cf4177d5bc0e3ead781d1c60818c13b1df0f3c /j1demo/firmware/main.fs
parentc0165d167d7cb40d80028bcf7a4a6b160b5a7e83 (diff)
mv to docs
Diffstat (limited to 'j1demo/firmware/main.fs')
-rw-r--r--j1demo/firmware/main.fs799
1 files changed, 0 insertions, 799 deletions
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