aboutsummaryrefslogtreecommitdiff
path: root/docs/j1demo/firmware
diff options
context:
space:
mode:
Diffstat (limited to 'docs/j1demo/firmware')
-rw-r--r--docs/j1demo/firmware/Makefile26
-rw-r--r--docs/j1demo/firmware/ans.fs46
-rw-r--r--docs/j1demo/firmware/arp.fs225
-rw-r--r--docs/j1demo/firmware/basewords.fs60
-rw-r--r--docs/j1demo/firmware/clock.fs90
-rw-r--r--docs/j1demo/firmware/crossj1.fs527
-rw-r--r--docs/j1demo/firmware/defines_tcpip.fs70
-rw-r--r--docs/j1demo/firmware/defines_tcpip.py94
-rw-r--r--docs/j1demo/firmware/defines_tcpip2.fs150
-rw-r--r--docs/j1demo/firmware/defines_tcpip2.py215
-rw-r--r--docs/j1demo/firmware/dhcp.fs176
-rw-r--r--docs/j1demo/firmware/dns.fs81
-rw-r--r--docs/j1demo/firmware/doc.fs20
-rw-r--r--docs/j1demo/firmware/document.fs3
-rw-r--r--docs/j1demo/firmware/encode.py28
-rw-r--r--docs/j1demo/firmware/eth-ax88796.fs506
-rw-r--r--docs/j1demo/firmware/font8x8bin0 -> 768 bytes
-rw-r--r--docs/j1demo/firmware/fsm-32.pngbin0 -> 1489 bytes
-rw-r--r--docs/j1demo/firmware/genoffsets.py11
-rw-r--r--docs/j1demo/firmware/go16
-rw-r--r--docs/j1demo/firmware/hwdefs.fs57
-rw-r--r--docs/j1demo/firmware/intelhex.py643
-rw-r--r--docs/j1demo/firmware/invaders.fs362
-rw-r--r--docs/j1demo/firmware/ip.fs124
-rw-r--r--docs/j1demo/firmware/ip0.fs70
-rw-r--r--docs/j1demo/firmware/j1.pngbin0 -> 3262 bytes
-rw-r--r--docs/j1demo/firmware/keycodes.fs28
-rw-r--r--docs/j1demo/firmware/loader.fs114
-rw-r--r--docs/j1demo/firmware/main.fs799
-rw-r--r--docs/j1demo/firmware/mkblob.py14
-rw-r--r--docs/j1demo/firmware/ntp.fs36
-rw-r--r--docs/j1demo/firmware/nuc.fs546
-rw-r--r--docs/j1demo/firmware/packet.fs11
-rw-r--r--docs/j1demo/firmware/ps2kb.fs434
-rw-r--r--docs/j1demo/firmware/sincos.fs36
-rw-r--r--docs/j1demo/firmware/sprite.fs20
-rw-r--r--docs/j1demo/firmware/tftp.fs67
-rw-r--r--docs/j1demo/firmware/time.fs33
-rw-r--r--docs/j1demo/firmware/twist.py311
-rw-r--r--docs/j1demo/firmware/udp.fs41
-rw-r--r--docs/j1demo/firmware/version.fs2
41 files changed, 6092 insertions, 0 deletions
diff --git a/docs/j1demo/firmware/Makefile b/docs/j1demo/firmware/Makefile
new file mode 100644
index 0000000..b28bfe6
--- /dev/null
+++ b/docs/j1demo/firmware/Makefile
@@ -0,0 +1,26 @@
+j1.mem j1.bin: *.fs Makefile
+ @gforth -e 'include main.fs bye'
+
+doc: *.fs Makefile
+ gforth -e 'include ../../docforth/docforth.fs s" document.fs" document bye'
+ mkdir -p html
+ mv *.html html
+
+# PRGDIR=$(HOME)/wge100_firmware/trunk/synth/programming_files/latest
+PRGDIR=../hardware/synth/programming_files/latest
+
+wge100_ip_camera.bit: $(PRGDIR)/wge100.bit j1.mem $(PRGDIR)/wge100_bd.bmm
+ (. /opt/Xilinx/11.1/ISE/settings32.sh ; data2mem -bm $(PRGDIR)/wge100_bd.bmm -bd j1.mem tag jram -bt $(PRGDIR)/wge100.bit -o b wge100_ip_camera.bit )
+
+wge100_ip_camera.mcs: wge100_ip_camera.bit
+ (. /opt/Xilinx/11.1/ISE/settings32.sh ; linux32 promgen -w -p mcs -c FF -o wge100_ip_camera.mcs -u 0 wge100_ip_camera.bit >/dev/null )
+
+defines_tcpip.fs defines_tcpip2.fs: genoffsets.py defines*py
+ python genoffsets.py
+
+download: j1.mem
+ ./send
+ sudo python listenterminal.py
+
+bundle: j1.bin wge100_ip_camera.mcs
+ cp j1.bin wge100_ip_camera.mcs tools/*.py $(HOME)/bundle
diff --git a/docs/j1demo/firmware/ans.fs b/docs/j1demo/firmware/ans.fs
new file mode 100644
index 0000000..dcd29ed
--- /dev/null
+++ b/docs/j1demo/firmware/ans.fs
@@ -0,0 +1,46 @@
+( Main file for pure ANS forth JCB 13:53 11/27/10)
+
+: parse-word
+ bl word count ;
+
+: defer create ( "name" -- )
+ ['] abort , does> @ execute ;
+
+: include ( "filename" -- )
+ bl word count included decimal ;
+
+: is ( xt "name" -- )
+ ' ( xt xt2)
+ state @ if
+ postpone literal postpone >body postpone !
+ else
+ >body !
+ then ; immediate
+
+
+: include ( "filename" -- )
+ bl parse included decimal ;
+
+ : Do-Vocabulary ( -- )
+ DOES> @ >R ( )( R: widnew)
+ GET-ORDER SWAP DROP ( wid_n ... wid_2 n)
+ R> SWAP SET-ORDER ;
+
+: VOCABULARY ( "name" -- )
+ WORDLIST CREATE , Do-Vocabulary ;
+
+: -rot rot rot ;
+: nstime 0. ;
+: <= > invert ;
+: >= < invert ;
+: d0<> d0= invert ;
+
+: f> fswap f< ;
+: f<= f> invert ;
+: f>= f< invert ;
+: f= 0e0 f~ ;
+: f<> f= invert ;
+
+3.1415926e0 fconstant pi
+
+include main.fs
diff --git a/docs/j1demo/firmware/arp.fs b/docs/j1demo/firmware/arp.fs
new file mode 100644
index 0000000..c6b69c7
--- /dev/null
+++ b/docs/j1demo/firmware/arp.fs
@@ -0,0 +1,225 @@
+( ARP: Address Resolution Protocol JCB 13:12 08/24/10)
+module[ arp"
+
+\ ARP uses a small cache of entries. Each entry has an age counter; new
+\ entries have an age of 0, any entry with an age >N is old.
+\
+
+
+d# 12 constant arp-cache-entry-size
+d# 5 constant arp-cache-entries
+TARGET? [IF]
+ meta
+ arp-cache-entry-size arp-cache-entries * d# 64 max
+ target
+ constant arp-size
+ create arp-cache arp-size allot
+ meta
+ arp-cache-entries 1- arp-cache-entry-size * arp-cache +
+ target
+ constant arp-cache-last
+[ELSE]
+ arp-cache-entry-size arp-cache-entries * d# 64 max constant arp-size
+ create arp-cache arp-size allot
+ arp-cache-entries 1- arp-cache-entry-size * arp-cache + constant arp-cache-last
+[THEN]
+
+: arp-foreach \ (func -- )
+ arp-cache-last 2>r
+ begin
+ 2r@ swap \ ptr func
+ execute
+ r> dup arp-cache-entry-size - >r
+ arp-cache =
+ until
+ 2r> 2drop
+;
+
+build-debug? [IF]
+: arp-.
+ dup @ hex4 space \ age
+ dup 2+ dup @ swap d# 2 + dup @ swap d# 2 + @ ethaddr-pretty space
+ d# 8 + 2@ ip-pretty
+ cr
+;
+
+: arp-dump
+ ['] arp-. arp-foreach
+;
+[THEN]
+
+: arp-del h# ff swap ! ;
+: arp-reset ['] arp-del arp-foreach ;
+: used? @ h# ff <> ;
+: arp-age-1 dup used? d# 1 and swap +! ;
+: arp-age ['] arp-age-1 arp-foreach ;
+: arp-cmp ( ptr0 ptr1 -- ptr) over @ over @ > ?: ;
+: arp-oldest \ return the address of the oldest ARP entry
+ arp-cache ['] arp-cmp arp-foreach ;
+
+\ ARP offsets
+\ d# 28 sender ethaddr
+\ d# 34 sender ip
+\ d# 38 target ethaddr
+\ d# 44 target ip
+
+d# 20 constant OFFSET_ARP_OPCODE
+d# 22 constant OFFSET_ARP_SRC_ETH
+d# 28 constant OFFSET_ARP_SRC_IP
+d# 32 constant OFFSET_ARP_DST_ETH
+d# 38 constant OFFSET_ARP_DST_IP
+
+: arp-is-response
+ OFFSET_ETH_TYPE packet@ h# 806 =
+ OFFSET_ARP_OPCODE packet@ d# 2 =
+ and
+;
+
+\ write the current arp response into the cache, replacing the oldest entry
+: !-- \ ( val ptr -- ptr-2 )
+ tuck \ ptr val ptr
+ !
+ 2-
+;
+
+\ Current packet is an ARP response; write it to the given slot in the ARP cache, ageing all others
+
+: arp-cache-write \ ( ptr -- )
+ arp-age \ because this new entry will have age d# 0
+ d# 0 over ! \ age d# 0
+ >r
+
+ d# 3 OFFSET_ARP_SRC_ETH mac-inoffset mac@n
+ r@ d# 6 + !-- !-- !-- drop
+ d# 2 OFFSET_ARP_SRC_IP mac-inoffset mac@n
+ r> d# 8 + 2!
+
+;
+
+\ Comparison of IP
+: arp-cmpip \ (ip01 ip23 ptr/0 ptr -- ip01 ip23 ptr)
+ dup used? if
+ dup d# 8 + 2@ d# 2 2pick d<> ?:
+ else
+ drop
+ then
+;
+
+: arp-cache-find ( ip01 ip23 -- ip01 ip23 ptr )
+\ Find an IP. Zero if the IP was not found in the cache, ptr to entry otherwise
+ d# 0 ['] arp-cmpip arp-foreach ;
+
+
+: arp-issue-whohas \ (ip01 ip23 -- ptr)
+ mac-pkt-begin
+ ethaddr-broadcast mac-pkt-3,
+ net-my-mac mac-pkt-3,
+ h# 806 \ frame type
+ d# 1 \ hard type
+ h# 800 \ prot type
+ mac-pkt-3,
+ h# 0604 \ hard size, prot size
+ d# 1 \ op (1=request)
+ mac-pkt-2,
+ net-my-mac mac-pkt-3,
+ net-my-ip mac-pkt-2,
+ ethaddr-broadcast mac-pkt-3,
+ mac-pkt-2,
+ mac-pkt-complete drop
+ mac-send
+;
+
+\ Look up ethaddr for given IP.
+\ If found, return pointer to the 6-byte ethaddr
+\ If not found, issue an ARP request and return d# 0.
+
+: arp-lookup \ ( ip01 ip23 -- ptr)
+ 2dup
+ ip-router 2@ dxor ip-subnetmask 2@ dand
+ d0<>
+ if
+ 2drop
+ ip-router 2@
+ then
+ arp-cache-find \ ip01 ip23 ptr
+ dup 0= if
+ -rot \ d# 0 ip01 ip23
+ arp-issue-whohas \ d# 0
+ else
+ nip nip 2+ \ ptr
+ then
+;
+
+\ If the current packet is an ARP request for our IP, answer it
+: arp-responder
+ \ is destination ff:ff:ff:ff:ff:ff or my mac
+ d# 3 OFFSET_ETH_DST mac-inoffset mac@n
+ and and invert 0=
+
+ net-my-mac \ a b c
+ d# 2 OFFSET_ETH_DST 2+ mac-inoffset mac@n
+ d= swap \ F a
+ OFFSET_ETH_DST packet@ = and
+
+ or
+ OFFSET_ETH_TYPE packet@ h# 806 = and
+ \ is target IP mine?
+ d# 2 OFFSET_ARP_DST_IP mac-inoffset mac@n net-my-ip d= and
+ if
+ mac-pkt-begin
+
+ d# 3 OFFSET_ARP_SRC_ETH mac-pkt-src
+ net-my-mac mac-pkt-3,
+ h# 806 \ frame type
+ d# 1 \ hard type
+ h# 800 \ prot type
+ mac-pkt-3,
+ h# 0604 \ hard size, prot size
+ d# 2 \ op (2=reply)
+ mac-pkt-2,
+ net-my-mac mac-pkt-3,
+ net-my-ip mac-pkt-2,
+ d# 3 OFFSET_ARP_SRC_ETH mac-pkt-src
+ d# 2 OFFSET_ARP_SRC_IP mac-pkt-src
+
+ mac-pkt-complete drop
+ mac-send
+ then
+;
+
+: arp-announce
+ mac-pkt-begin
+
+ ethaddr-broadcast mac-pkt-3,
+ net-my-mac mac-pkt-3,
+ h# 806 \ frame type
+ d# 1 \ hard type
+ h# 800 \ prot type
+ mac-pkt-3,
+ h# 0604 \ hard size, prot size
+ d# 2 \ op (2=reply)
+ mac-pkt-2,
+ net-my-mac mac-pkt-3,
+ net-my-ip mac-pkt-2,
+ ethaddr-broadcast mac-pkt-3,
+ net-my-ip mac-pkt-2,
+
+ mac-pkt-complete drop
+ mac-send
+
+;
+
+: arp-handler
+ arp-responder
+ arp-is-response
+ if
+ d# 2 OFFSET_ARP_SRC_IP mac-inoffset mac@n
+ arp-cache-find nip nip
+ dup 0= if
+ drop arp-oldest
+ then
+ arp-cache-write
+ then
+;
+
+]module
diff --git a/docs/j1demo/firmware/basewords.fs b/docs/j1demo/firmware/basewords.fs
new file mode 100644
index 0000000..e529f66
--- /dev/null
+++ b/docs/j1demo/firmware/basewords.fs
@@ -0,0 +1,60 @@
+( Base words implemented in assembler JCB 13:10 08/24/10)
+
+meta
+: noop T alu ;
+: + T+N d-1 alu ;
+: xor T^N d-1 alu ;
+: and T&N d-1 alu ;
+: or T|N d-1 alu ;
+: invert ~T alu ;
+: = N==T d-1 alu ;
+: < N<T d-1 alu ;
+: u< Nu<T d-1 alu ;
+: swap N T->N alu ;
+: dup T T->N d+1 alu ;
+: drop N d-1 alu ;
+: over N T->N d+1 alu ;
+: nip T d-1 alu ;
+: >r N T->R r+1 d-1 alu ;
+: r> rT T->N r-1 d+1 alu ;
+: r@ rT T->N d+1 alu ;
+: @ [T] alu ;
+: ! T N->[T] d-1 alu
+ N d-1 alu ;
+: dsp dsp T->N d+1 alu ;
+: lshift N<<T d-1 alu ;
+: rshift N>>T d-1 alu ;
+: 1- T-1 alu ;
+: 2r> rT T->N r-1 d+1 alu
+ rT T->N r-1 d+1 alu
+ N T->N alu ;
+: 2>r N T->N alu
+ N T->R r+1 d-1 alu
+ N T->R r+1 d-1 alu ;
+: 2r@ rT T->N r-1 d+1 alu
+ rT T->N r-1 d+1 alu
+ N T->N d+1 alu
+ N T->N d+1 alu
+ N T->R r+1 d-1 alu
+ N T->R r+1 d-1 alu
+ N T->N alu ;
+: unloop
+ T r-1 alu
+ T r-1 alu ;
+: exit return ;
+
+\ Elided words
+: dup@ [T] T->N d+1 alu ;
+: dup>r T T->R r+1 alu ;
+: 2dupxor T^N T->N d+1 alu ;
+: 2dup= N==T T->N d+1 alu ;
+: !nip T N->[T] d-1 alu ;
+: 2dup! T N->[T] alu ;
+
+\ Words used to implement pick
+: up1 T d+1 alu ;
+: down1 T d-1 alu ;
+: copy N alu ;
+
+: module[ there [char] " parse preserve ;
+: ]module s" Compiled " type count type space there swap - . cr ;
diff --git a/docs/j1demo/firmware/clock.fs b/docs/j1demo/firmware/clock.fs
new file mode 100644
index 0000000..4bb35bb
--- /dev/null
+++ b/docs/j1demo/firmware/clock.fs
@@ -0,0 +1,90 @@
+( Clock JCB 10:54 11/17/10)
+
+variable seconds
+variable minutes
+variable hours
+variable days
+variable months
+variable years
+variable weekday
+
+: show2 ( a -- ) @ s>d <# # # #> type ;
+
+: setdate ( ud -- )
+ [ -8 3600 * ] literal s>d d+
+ d# 1 d# 60 m*/mod seconds !
+ d# 1 d# 60 m*/mod minutes !
+ d# 1 d# 24 m*/mod hours !
+ d# 59. d- \ Days since Mar 1 1900
+ 2dup d# 1 d# 7 m*/mod weekday ! 2drop
+ d# 365 um/mod ( days years )
+ dup d# 1900 + years !
+ d# 4 / 1- - \ subtract leaps ( daynum 0-365 )
+ dup d# 5 * d# 308 + d# 153 / d# 2 - months !
+ months @ d# 4 + d# 153 d# 5 */ - d# 122 + days !
+
+ home
+ 'emit @ >r
+ ['] vga-bigemit 'emit !
+
+ s" ThuFriSatSunMonTueWed" drop
+ weekday @ d# 3 * + d# 3 type cr
+ s" MarAprMayJunJulAugSepOctNovDecJanFeb" drop
+ months @ d# 3 * + d# 3 type
+ space days @ d# 0 .r cr
+ years @ . cr
+
+ true if
+ hours show2
+ minutes show2
+ seconds show2
+ home
+ then
+
+ r> 'emit !
+;
+
+: setdelay ( ud -- )
+ 'emit @ >r
+ ['] vga-emit 'emit !
+ d# 32 d# 0 vga-at-xy
+ s" ntp " type <# # # # [char] . hold #s #> type
+ s" ms " type
+ r> 'emit !
+;
+
+include ntp.fs
+
+2variable ntp-alarm
+
+: clock-main
+ vga-page
+ d# 1000000. ntp-alarm setalarm
+ begin
+ 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
+ ntp-handler
+ then
+
+ depth if .s cr then
+ mac-consume
+ repeat
+
+ ntp-alarm isalarm if
+ ntp-request
+ d# 1000000. ntp-alarm setalarm
+ then
+
+ next?
+ until
+;
+
diff --git a/docs/j1demo/firmware/crossj1.fs b/docs/j1demo/firmware/crossj1.fs
new file mode 100644
index 0000000..d034611
--- /dev/null
+++ b/docs/j1demo/firmware/crossj1.fs
@@ -0,0 +1,527 @@
+( Cross-compiler for the J1 JCB 13:12 08/24/10)
+decimal
+
+( outfile is fileid or zero JCB 12:30 11/27/10)
+
+0 value outfile
+
+: type ( c-addr u )
+ outfile if
+ outfile write-file throw
+ else
+ type
+ then
+;
+: emit ( u )
+ outfile if
+ pad c! pad 1 outfile write-file throw
+ else
+ emit
+ then
+;
+: cr ( u )
+ outfile if
+ s" " outfile write-line throw
+ else
+ cr
+ then
+;
+: space bl emit ;
+: spaces dup 0> if 0 do space loop then ;
+
+vocabulary j1assembler \ assembly storage and instructions
+vocabulary metacompiler \ the cross-compiling words
+vocabulary j1target \ actual target words
+
+: j1asm
+ only
+ metacompiler
+ also j1assembler definitions
+ also forth ;
+: meta
+ only
+ j1target also
+ j1assembler also
+ metacompiler definitions also
+ forth ;
+: target
+ only
+ metacompiler also
+ j1target definitions ;
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+
+j1asm
+
+: tcell 2 ;
+: tcells tcell * ;
+: tcell+ tcell + ;
+65536 allocate throw constant tflash
+
+: h#
+ base @ >r 16 base !
+ 0. bl parse >number throw 2drop postpone literal
+ r> base ! ; immediate
+
+variable tdp
+: there tdp @ ;
+: islegal dup h# 7fff u> abort" illegal address" ;
+: tc! islegal tflash + c! ;
+: tc@ islegal tflash + c@ ;
+: t! islegal over h# ff and over tc! swap 8 rshift swap 1+ tc! ;
+: t@ islegal dup tc@ swap 1+ tc@ 8 lshift or ;
+: talign tdp @ 1 + h# fffe and tdp ! ;
+: tc, there tc! 1 tdp +! ;
+: t, there t! tcell tdp +! ;
+: org tdp ! ;
+
+tflash 65536 255 fill
+
+65536 cells allocate throw constant references
+: referenced cells references + 1 swap +! ;
+
+65536 cells allocate throw constant labels
+labels 65536 cells 0 fill
+: atlabel? ( -- f = are we at a label )
+ labels there cells + @ 0<>
+;
+
+: preserve ( c-addr1 u -- c-addr )
+ dup 1+ allocate throw dup >r
+ 2dup c! 1+
+ swap cmove r> ;
+
+: setlabel ( c-addr u -- )
+ atlabel? if 2drop else preserve labels there cells + ! then ;
+
+j1asm
+
+: hex-literal ( u -- c-addr u ) s>d <# bl hold #s [char] $ hold #> ;
+
+: imm h# 8000 or t, ;
+
+: T h# 0000 ;
+: N h# 0100 ;
+: T+N h# 0200 ;
+: T&N h# 0300 ;
+: T|N h# 0400 ;
+: T^N h# 0500 ;
+: ~T h# 0600 ;
+: N==T h# 0700 ;
+: N<T h# 0800 ;
+: N>>T h# 0900 ;
+: T-1 h# 0a00 ;
+: rT h# 0b00 ;
+: [T] h# 0c00 ;
+: N<<T h# 0d00 ;
+: dsp h# 0e00 ;
+: Nu<T h# 0f00 ;
+
+: T->N h# 0080 or ;
+: T->R h# 0040 or ;
+: N->[T] h# 0020 or ;
+: d-1 h# 0003 or ;
+: d+1 h# 0001 or ;
+: r-1 h# 000c or ;
+: r-2 h# 0008 or ;
+: r+1 h# 0004 or ;
+
+: alu h# 6000 or t, ;
+
+: return T h# 1000 or r-1 alu ;
+: ubranch 2/ h# 0000 or t, ;
+: 0branch 2/ h# 2000 or t, ;
+: scall 2/ h# 4000 or t, ;
+
+: dump-words ( c-addr n -- ) \ Write n/2 words from c-addr
+ dup 6 > abort" invalid byte count"
+ 2/ dup >r
+ 0 do
+ dup t@ s>d <# # # # # #> type space
+ 2 +
+ loop drop
+ 3 r> - 5 * spaces
+;
+
+variable padc
+: pad+ ( c-addr u -- ) \ append to pad
+ dup >r
+ pad padc @ + swap cmove
+ r> padc +! ;
+
+: pad+loc ( addr -- )
+ dup cells labels + @ ?dup if
+ nip count pad+
+ else
+ s>d <# #s [char] $ hold #> pad+
+ then
+ s" " pad+
+;
+
+
+: disassemble-j
+ 0 padc !
+ dup t@ h# 8000 and if
+ s" LIT " pad+
+ dup t@ h# 7fff and hex-literal pad+ exit
+ else
+ dup t@ h# e000 and h# 6000 = if
+ s" ALU " pad+
+ dup t@ pad+loc exit
+ else
+ dup t@ h# e000 and h# 4000 = if
+ s" CALL "
+ else
+ dup t@ h# 2000 and if
+ s" 0BRANCH "
+ else
+ s" BRANCH "
+ then
+ then
+ pad+
+ dup t@ h# 1fff and 2* pad+loc
+ then
+ then
+;
+
+: disassemble-line ( offset -- offset' )
+ dup cells labels + @ ?dup if s" \ " type count type cr then
+ dup s>d <# # # # # #> type space
+ dup 2 dump-words
+ disassemble-j
+ pad padc @ type
+ 2 +
+ cr
+;
+
+: disassemble-block
+ 0 do
+ disassemble-line
+ loop
+ drop
+;
+
+j1asm
+
+\ tcompile is like "STATE": it is true when compiling
+
+variable tcompile
+: tcompile? tcompile @ ;
+: +tcompile tcompile? abort" Already in compilation mode" 1 tcompile ! ;
+: -tcompile 0 tcompile ! ;
+
+: (literal)
+ \ dup $f rshift over $e rshift xor 1 and throw
+ dup h# 8000 and if
+ h# ffff xor recurse
+ ~T alu
+ else
+ h# 8000 or t,
+ then
+
+;
+: (t-constant)
+ tcompile? if
+ (literal)
+ then
+;
+
+meta
+
+\ Find name - without consuming it - and return a counted string
+: wordstr ( "name" -- c-addr u )
+ >in @ >r bl word count r> >in !
+;
+
+
+: literal (literal) ; immediate
+: 2literal swap (literal) (literal) ; immediate
+: call,
+ dup referenced
+ scall
+;
+
+: t:
+ talign
+ wordstr setlabel
+ create
+ there ,
+ +tcompile
+ 947947
+ does>
+ @
+ tcompile? if
+ call,
+ then
+;
+
+: lookback ( offset -- v ) there swap - t@ ;
+: prevcall? 2 lookback h# e000 and h# 4000 = ;
+: call>goto dup t@ h# 1fff and swap t! ;
+: prevsafe?
+ 2 lookback h# e000 and h# 6000 = \ is an ALU
+ 2 lookback h# 004c and 0= and ; \ does not touch RStack
+: alu>return dup t@ h# 1000 or r-1 swap t! ;
+
+: t; 947947 <> if abort" Unstructured" then
+ true if
+ atlabel? invert prevcall? and if
+ there 2 - call>goto
+ else
+ atlabel? invert prevsafe? and if
+ there 2 - alu>return
+ else
+ return
+ then
+ then
+ else
+ return
+ then
+ -tcompile
+;
+
+: t;fallthru 947947 <> if abort" Unstructured" then
+ -tcompile
+;
+
+variable shadow-tcompile
+wordlist constant escape]-wordlist
+escape]-wordlist set-current
+: ] shadow-tcompile @ tcompile ! previous previous ;
+
+meta
+
+: [
+ tcompile @ shadow-tcompile !
+ -tcompile get-order forth-wordlist escape]-wordlist rot 2 + set-order
+;
+
+: : t: ;
+: ; t; ;
+: ;fallthru t;fallthru ;
+: , t, ;
+: c, tc, ;
+
+: constant ( n "name" -- ) create , immediate does> @ (t-constant) ;
+
+: ]asm
+ -tcompile also forth also j1target also j1assembler ;
+: asm[ +tcompile previous previous previous ;
+: code t: ]asm ;
+
+j1asm
+
+: end-code
+ 947947 <> if abort" Unstructured" then
+ previous previous previous ;
+
+meta
+
+\ Some Forth words are safe to use in target mode, so import them
+
+: ( postpone ( ;
+: \ postpone \ ;
+
+: import ( "name" -- )
+ >in @ ' swap >in !
+ create , does> @ execute ;
+
+import meta
+import org
+import include
+import [if]
+import [else]
+import [then]
+
+: do-number ( n -- |n )
+ state @ if
+ postpone literal
+ else
+ tcompile? if
+ (literal)
+ then
+ then
+;
+
+decimal
+
+: [char] ( "name" -- ) ( run: -- ascii) char (literal) ;
+
+: ['] ( "name" -- ) ( run: -- xt )
+ ' tcompile @ >r -tcompile execute r> tcompile !
+ dup referenced
+ (literal)
+;
+
+: (sliteral--h) ( addr n -- ptr ) ( run: -- eeaddr n )
+ s" sliteral" evaluate
+ there >r
+ dup tc,
+ 0 do count tc, loop
+ drop
+ talign
+ r>
+;
+
+: (sliteral) (sliteral--h) drop ;
+: s" ( "ccc<quote>" -- ) ( run: -- eaddr n ) [char] " parse (sliteral) ;
+: s' ( "ccc<quote>" -- ) ( run: -- eaddr n ) [char] ' parse (sliteral) ;
+
+: create
+ wordstr setlabel
+ create there ,
+ does> @ do-number
+;
+
+: allot tdp +! ;
+
+: variable wordstr setlabel create there , 0 t,
+ does> @ do-number ;
+: 2variable wordstr setlabel create there , 0 t, 0 t,
+ does> @ do-number ;
+
+: createdoes
+ wordstr setlabel
+ create there , ' ,
+ does> dup @ dup referenced (literal) cell+ @ execute
+;
+
+: jumptable
+ wordstr setlabel
+ create there ,
+ does> s" 2*" evaluate @ dup referenced (literal) s" + @" evaluate
+;
+
+: | ' execute dup referenced t, ;
+
+: ', ' execute t, ;
+
+( DEFER JCB 11:18 11/12/10)
+
+: defer
+ wordstr setlabel
+ create there , 0 t,
+ does> @ tcompile? if do-number s" @ execute" evaluate then ;
+
+: is ( xt "name" -- )
+ tcompile? if
+ ' >body @ do-number
+ s" ! " evaluate
+ else
+ ' execute t!
+ then ;
+
+: ' ' execute ;
+
+( VALUE JCB 13:06 11/12/10)
+
+: value
+ wordstr setlabel
+ create there , t,
+ does> @ do-number s" @" evaluate ;
+
+: to ( u "name" -- )
+ ' >body @ do-number s" !" evaluate ;
+
+( ARRAY JCB 13:34 11/12/10)
+
+: array
+ wordstr setlabel
+ create there , 0 do 0 t, loop
+ does> s" cells" evaluate @ do-number s" +" evaluate ;
+: 2array
+ wordstr setlabel
+ create there , 2* 0 do 0 t, loop
+ does> s" 2* cells" evaluate @ do-number s" +" evaluate ;
+
+( eforth's way of handling constants JCB 13:12 09/03/10)
+
+: sign>number
+ over c@ [char] - = if
+ 1- swap 1+ swap
+ >number
+ 2swap dnegate 2swap
+ else
+ >number
+ then
+;
+
+: base>number ( caddr u base -- )
+ base @ >r base !
+ sign>number
+ r> base !
+ dup 0= if
+ 2drop drop do-number
+ else
+ 1 = swap c@ [char] . = and if
+ drop dup do-number 16 rshift do-number
+ else
+ -1 abort" bad number"
+ then
+ then ;
+
+: d# 0. bl parse 10 base>number ;
+: h# 0. bl parse 16 base>number ;
+
+( Conditionals JCB 13:12 09/03/10)
+: if
+ there
+ 0 0branch
+;
+
+: resolve
+ dup t@ there 2/ or swap t!
+;
+
+: then
+ resolve
+ s" (then)" setlabel
+;
+
+: else
+ there
+ 0 ubranch
+ swap resolve
+ s" (else)" setlabel
+;
+
+
+: begin s" (begin)" setlabel there ;
+: again
+ ubranch
+;
+: until
+ 0branch
+;
+: while
+ there
+ 0 0branch
+;
+: repeat
+ swap ubranch
+ resolve
+ s" (repeat)" setlabel
+;
+
+: 0do s" >r d# 0 >r" evaluate there s" (do)" setlabel ;
+: do s" 2>r" evaluate there s" (do)" setlabel ;
+: loop
+ s" looptest" evaluate 0branch
+;
+: i s" r@" evaluate ;
+
+77 constant sourceline#
+s" none" 2constant sourcefilename
+
+: line# sourceline# (literal) ;
+create currfilename 1 cells 80 + allot
+variable currfilename#
+: savestr ( c-addr u dst -- ) 2dup c! 1+ swap cmove ;
+: getfilename sourcefilename currfilename count compare 0<>
+ if
+ sourcefilename 2dup currfilename savestr (sliteral--h) currfilename# !
+ else
+ currfilename# @ dup 1+ (literal) tc@ (literal)
+ then ;
+: snap line# getfilename s" (snap)" evaluate ; immediate
+: assert 0= if line# sourcefilename (sliteral) s" (assert)" evaluate then ; immediate
diff --git a/docs/j1demo/firmware/defines_tcpip.fs b/docs/j1demo/firmware/defines_tcpip.fs
new file mode 100644
index 0000000..90d3990
--- /dev/null
+++ b/docs/j1demo/firmware/defines_tcpip.fs
@@ -0,0 +1,70 @@
+42 constant OFFSET_DHCP
+70 constant OFFSET_DHCP_CHADDR
+54 constant OFFSET_DHCP_CIADDR
+150 constant OFFSET_DHCP_FILE
+52 constant OFFSET_DHCP_FLAGS
+66 constant OFFSET_DHCP_GIADDR
+44 constant OFFSET_DHCP_HLEN
+45 constant OFFSET_DHCP_HOPS
+43 constant OFFSET_DHCP_HTYPE
+42 constant OFFSET_DHCP_OP
+278 constant OFFSET_DHCP_OPTIONS
+50 constant OFFSET_DHCP_SECS
+62 constant OFFSET_DHCP_SIADDR
+548 constant OFFSET_DHCP_SIZE
+86 constant OFFSET_DHCP_SNAME
+46 constant OFFSET_DHCP_XID
+58 constant OFFSET_DHCP_YIADDR
+42 constant OFFSET_DNS
+44 constant OFFSET_DNS_FLAGS
+42 constant OFFSET_DNS_IDENTIFICATION
+48 constant OFFSET_DNS_NOA
+52 constant OFFSET_DNS_NOARR
+46 constant OFFSET_DNS_NOQ
+50 constant OFFSET_DNS_NORR
+54 constant OFFSET_DNS_QUERY
+13 constant OFFSET_DNS_SIZE
+0 constant OFFSET_ETH
+0 constant OFFSET_ETH_DST
+14 constant OFFSET_ETH_SIZE
+6 constant OFFSET_ETH_SRC
+12 constant OFFSET_ETH_TYPE
+34 constant OFFSET_ICMP
+36 constant OFFSET_ICMP_CHKSUM
+38 constant OFFSET_ICMP_IDENTIFIER
+40 constant OFFSET_ICMP_SEQUENCE
+8 constant OFFSET_ICMP_SIZE
+34 constant OFFSET_ICMP_TYPECODE
+14 constant OFFSET_IP
+24 constant OFFSET_IP_CHKSUM
+30 constant OFFSET_IP_DSTIP
+18 constant OFFSET_IP_IPID
+20 constant OFFSET_IP_IPOFFSET
+16 constant OFFSET_IP_LENGTH
+20 constant OFFSET_IP_SIZE
+26 constant OFFSET_IP_SRCIP
+22 constant OFFSET_IP_TTLPROTO
+14 constant OFFSET_IP_VHLTOS
+42 constant OFFSET_JUICE
+68 constant OFFSET_JUICE_COMMAND
+42 constant OFFSET_JUICE_HASH
+62 constant OFFSET_JUICE_MAGIC
+70 constant OFFSET_JUICE_PAYLOAD
+66 constant OFFSET_JUICE_SEQ
+30 constant OFFSET_JUICE_SIZE
+34 constant OFFSET_TCP
+42 constant OFFSET_TCP_ACK
+50 constant OFFSET_TCP_CHECKSUM
+36 constant OFFSET_TCP_DESTPORT
+46 constant OFFSET_TCP_FLAGS
+38 constant OFFSET_TCP_SEQNUM
+20 constant OFFSET_TCP_SIZE
+34 constant OFFSET_TCP_SOURCEPORT
+52 constant OFFSET_TCP_URGENT
+48 constant OFFSET_TCP_WINDOW
+34 constant OFFSET_UDP
+40 constant OFFSET_UDP_CHECKSUM
+36 constant OFFSET_UDP_DESTPORT
+38 constant OFFSET_UDP_LENGTH
+8 constant OFFSET_UDP_SIZE
+34 constant OFFSET_UDP_SOURCEPORT
diff --git a/docs/j1demo/firmware/defines_tcpip.py b/docs/j1demo/firmware/defines_tcpip.py
new file mode 100644
index 0000000..bbeb16b
--- /dev/null
+++ b/docs/j1demo/firmware/defines_tcpip.py
@@ -0,0 +1,94 @@
+layout = [
+ ('ETH', [
+ ('DST', 6),
+ ('SRC', 6),
+ ('TYPE', 2),
+ [
+ ('IP', [
+ ('VHLTOS', 2),
+ ('LENGTH', 2),
+ ('IPID', 2),
+ ('IPOFFSET', 2),
+ ('TTLPROTO', 2),
+ ('CHKSUM', 2),
+ ('SRCIP', 4),
+ ('DSTIP', 4),
+ [
+ ('ICMP', [
+ ('TYPECODE', 2),
+ ('CHKSUM', 2),
+ ('IDENTIFIER', 2),
+ ('SEQUENCE', 2) ]),
+ ('TCP', [
+ ('SOURCEPORT', 2),
+ ('DESTPORT', 2),
+ ('SEQNUM', 4),
+ ('ACK', 4),
+ ('FLAGS', 2),
+ ('WINDOW', 2),
+ ('CHECKSUM', 2),
+ ('URGENT', 2) ]),
+ ('UDP', [
+ ('SOURCEPORT', 2),
+ ('DESTPORT', 2),
+ ('LENGTH', 2),
+ ('CHECKSUM', 2),
+ [
+ ('DHCP', [
+ ('OP', 1),
+ ('HTYPE', 1),
+ ('HLEN', 1),
+ ('HOPS', 1),
+ ('XID', 4),
+ ('SECS', 2),
+ ('FLAGS', 2),
+ ('CIADDR', 4),
+ ('YIADDR', 4),
+ ('SIADDR', 4),
+ ('GIADDR', 4),
+ ('CHADDR', 16),
+ ('SNAME', 64),
+ ('FILE', 128),
+ ('OPTIONS', 312)
+ ]),
+ ('DNS', [
+ ('IDENTIFICATION', 2),
+ ('FLAGS', 2),
+ ('NOQ', 2),
+ ('NOA', 2),
+ ('NORR', 2),
+ ('NOARR', 2),
+ ('QUERY', 1)
+ ]),
+ ('JUICE', [
+ ('HASH', 20),
+ ('MAGIC', 4),
+ ('SEQ', 2),
+ ('COMMAND', 2),
+ ('PAYLOAD', 2)
+ ])
+ ]
+ ])
+ ]
+ ])
+ ]])
+]
+
+offsets = {}
+def descend(offset, prefix, node):
+ (name, members) = node
+ offsets[prefix + name] = offset
+ start = offset
+ for m in members:
+ if isinstance(m, tuple):
+ (field, size) = m
+ # print prefix, name, field, offset
+ offsets["%s%s_%s" % (prefix, name, field)] = offset
+ offset += size
+ else:
+ for n in m:
+ descend(offset, prefix, n)
+ # print prefix, name, "SIZE", offset - start
+ offsets["%s%s_SIZE" % (prefix, name)] = offset - start
+
+descend(0, 'OFFSET_', layout[0])
diff --git a/docs/j1demo/firmware/defines_tcpip2.fs b/docs/j1demo/firmware/defines_tcpip2.fs
new file mode 100644
index 0000000..4d38a13
--- /dev/null
+++ b/docs/j1demo/firmware/defines_tcpip2.fs
@@ -0,0 +1,150 @@
+0 constant ETH
+14 constant ETH.ARP
+32 constant ETH.ARP.DST_ETH
+38 constant ETH.ARP.DST_IP
+20 constant ETH.ARP.OPCODE
+14 constant ETH.ARP.SOMETHING
+22 constant ETH.ARP.SRC_ETH
+28 constant ETH.ARP.SRC_IP
+0 constant ETH.DST
+14 constant ETH.IP
+24 constant ETH.IP.CHKSUM
+30 constant ETH.IP.DSTIP
+34 constant ETH.IP.ICMP
+36 constant ETH.IP.ICMP.CHKSUM
+38 constant ETH.IP.ICMP.IDENTIFIER
+40 constant ETH.IP.ICMP.SEQUENCE
+34 constant ETH.IP.ICMP.TYPECODE
+18 constant ETH.IP.IPID
+20 constant ETH.IP.IPOFFSET
+16 constant ETH.IP.LENGTH
+26 constant ETH.IP.SRCIP
+34 constant ETH.IP.TCP
+42 constant ETH.IP.TCP.ACK
+50 constant ETH.IP.TCP.CHECKSUM
+36 constant ETH.IP.TCP.DESTPORT
+46 constant ETH.IP.TCP.FLAGS
+38 constant ETH.IP.TCP.SEQNUM
+34 constant ETH.IP.TCP.SOURCEPORT
+52 constant ETH.IP.TCP.URGENT
+48 constant ETH.IP.TCP.WINDOW
+22 constant ETH.IP.TTLPROTO
+34 constant ETH.IP.UDP
+40 constant ETH.IP.UDP.CHECKSUM
+36 constant ETH.IP.UDP.DESTPORT
+42 constant ETH.IP.UDP.DHCP
+70 constant ETH.IP.UDP.DHCP.CHADDR
+54 constant ETH.IP.UDP.DHCP.CIADDR
+150 constant ETH.IP.UDP.DHCP.FILE
+52 constant ETH.IP.UDP.DHCP.FLAGS
+66 constant ETH.IP.UDP.DHCP.GIADDR
+44 constant ETH.IP.UDP.DHCP.HLEN
+45 constant ETH.IP.UDP.DHCP.HOPS
+43 constant ETH.IP.UDP.DHCP.HTYPE
+42 constant ETH.IP.UDP.DHCP.OP
+278 constant ETH.IP.UDP.DHCP.OPTIONS
+50 constant ETH.IP.UDP.DHCP.SECS
+62 constant ETH.IP.UDP.DHCP.SIADDR
+86 constant ETH.IP.UDP.DHCP.SNAME
+46 constant ETH.IP.UDP.DHCP.XID
+58 constant ETH.IP.UDP.DHCP.YIADDR
+42 constant ETH.IP.UDP.DNS
+44 constant ETH.IP.UDP.DNS.FLAGS
+42 constant ETH.IP.UDP.DNS.IDENTIFICATION
+48 constant ETH.IP.UDP.DNS.NOA
+52 constant ETH.IP.UDP.DNS.NOARR
+46 constant ETH.IP.UDP.DNS.NOQ
+50 constant ETH.IP.UDP.DNS.NORR
+54 constant ETH.IP.UDP.DNS.QUERY
+38 constant ETH.IP.UDP.LENGTH
+42 constant ETH.IP.UDP.LOADER
+46 constant ETH.IP.UDP.LOADER.FLASHREAD
+46 constant ETH.IP.UDP.LOADER.FLASHREAD.ADDR
+46 constant ETH.IP.UDP.LOADER.FLASHWRITE
+46 constant ETH.IP.UDP.LOADER.FLASHWRITE.ADDR
+50 constant ETH.IP.UDP.LOADER.FLASHWRITE.DATA
+44 constant ETH.IP.UDP.LOADER.OPCODE
+46 constant ETH.IP.UDP.LOADER.RAMREAD
+46 constant ETH.IP.UDP.LOADER.RAMREAD.ADDR
+46 constant ETH.IP.UDP.LOADER.RAMWRITE
+46 constant ETH.IP.UDP.LOADER.RAMWRITE.ADDR
+48 constant ETH.IP.UDP.LOADER.RAMWRITE.DATA
+42 constant ETH.IP.UDP.LOADER.SEQNO
+42 constant ETH.IP.UDP.NTP
+42 constant ETH.IP.UDP.NTP.FLAGS
+66 constant ETH.IP.UDP.NTP.ORIGINATE
+74 constant ETH.IP.UDP.NTP.RECEIVE
+58 constant ETH.IP.UDP.NTP.REFERENCE
+54 constant ETH.IP.UDP.NTP.REFID
+46 constant ETH.IP.UDP.NTP.ROOTDELAY
+50 constant ETH.IP.UDP.NTP.ROOTDISPERSION
+82 constant ETH.IP.UDP.NTP.TRANSMIT
+34 constant ETH.IP.UDP.SOURCEPORT
+42 constant ETH.IP.UDP.TFTP
+44 constant ETH.IP.UDP.TFTP.ACK
+44 constant ETH.IP.UDP.TFTP.ACK.BLOCK
+44 constant ETH.IP.UDP.TFTP.DATA
+44 constant ETH.IP.UDP.TFTP.DATA.BLOCK
+46 constant ETH.IP.UDP.TFTP.DATA.DATA
+44 constant ETH.IP.UDP.TFTP.ERROR
+46 constant ETH.IP.UDP.TFTP.ERROR.MESSAGE
+44 constant ETH.IP.UDP.TFTP.ERROR.NUMBER
+42 constant ETH.IP.UDP.TFTP.OPCODE
+44 constant ETH.IP.UDP.TFTP.RWRQ
+44 constant ETH.IP.UDP.TFTP.RWRQ.FILENAME
+42 constant ETH.IP.UDP.WGE
+82 constant ETH.IP.UDP.WGE.CONFIGURE
+90 constant ETH.IP.UDP.WGE.CONFIGURE.IP
+82 constant ETH.IP.UDP.WGE.CONFIGURE.PRODUCT
+86 constant ETH.IP.UDP.WGE.CONFIGURE.SERIAL
+82 constant ETH.IP.UDP.WGE.DISCOVER
+82 constant ETH.IP.UDP.WGE.DISCOVER.IP
+82 constant ETH.IP.UDP.WGE.FLASHREAD
+82 constant ETH.IP.UDP.WGE.FLASHREAD.ADDRESS
+82 constant ETH.IP.UDP.WGE.FLASHWRITE
+82 constant ETH.IP.UDP.WGE.FLASHWRITE.ADDRESS
+86 constant ETH.IP.UDP.WGE.FLASHWRITE.DATA
+50 constant ETH.IP.UDP.WGE.HRT
+82 constant ETH.IP.UDP.WGE.IMAGERMODE
+82 constant ETH.IP.UDP.WGE.IMAGERMODE.MODE
+82 constant ETH.IP.UDP.WGE.IMAGERSETRES
+82 constant ETH.IP.UDP.WGE.IMAGERSETRES.HORIZONTAL
+84 constant ETH.IP.UDP.WGE.IMAGERSETRES.VERTICAL
+42 constant ETH.IP.UDP.WGE.MAGIC
+80 constant ETH.IP.UDP.WGE.PAD
+66 constant ETH.IP.UDP.WGE.REPLYTO
+74 constant ETH.IP.UDP.WGE.REPLYTO.IP
+66 constant ETH.IP.UDP.WGE.REPLYTO.MAC
+78 constant ETH.IP.UDP.WGE.REPLYTO.PORT
+82 constant ETH.IP.UDP.WGE.SENSORREAD
+82 constant ETH.IP.UDP.WGE.SENSORREAD.ADDRESS
+82 constant ETH.IP.UDP.WGE.SENSORSELECT
+83 constant ETH.IP.UDP.WGE.SENSORSELECT.ADDRESS
+82 constant ETH.IP.UDP.WGE.SENSORSELECT.INDEX
+82 constant ETH.IP.UDP.WGE.SENSORWRITE
+82 constant ETH.IP.UDP.WGE.SENSORWRITE.ADDRESS
+83 constant ETH.IP.UDP.WGE.SENSORWRITE.DATA
+82 constant ETH.IP.UDP.WGE.SYSCONFIG
+82 constant ETH.IP.UDP.WGE.SYSCONFIG.MAC
+88 constant ETH.IP.UDP.WGE.SYSCONFIG.SERIAL
+82 constant ETH.IP.UDP.WGE.TRIGCONTROL
+82 constant ETH.IP.UDP.WGE.TRIGCONTROL.TRIGSTATE
+46 constant ETH.IP.UDP.WGE.TYPE
+82 constant ETH.IP.UDP.WGE.VIDSTART
+90 constant ETH.IP.UDP.WGE.VIDSTART.IP
+82 constant ETH.IP.UDP.WGE.VIDSTART.MAC
+94 constant ETH.IP.UDP.WGE.VIDSTART.PORT
+14 constant ETH.IP.VHLTOS
+6 constant ETH.SRC
+12 constant ETH.TYPE
+1 constant IP_PROTO_ICMP
+2 constant IP_PROTO_IGMP
+6 constant IP_PROTO_TCP
+17 constant IP_PROTO_UDP
+2 constant NUM_TCPS
+16 constant TCP_ACK
+1 constant TCP_FIN
+8 constant TCP_PSH
+4 constant TCP_RST
+2 constant TCP_SYN
+32 constant TCP_URG
diff --git a/docs/j1demo/firmware/defines_tcpip2.py b/docs/j1demo/firmware/defines_tcpip2.py
new file mode 100644
index 0000000..1d9e556
--- /dev/null
+++ b/docs/j1demo/firmware/defines_tcpip2.py
@@ -0,0 +1,215 @@
+layout = [
+ ('ETH', [
+ ('DST', 6),
+ ('SRC', 6),
+ ('TYPE', 2),
+ [
+ ('ARP', [
+ ('SOMETHING', 6),
+ ('OPCODE', 2),
+ ('SRC_ETH', 6),
+ ('SRC_IP', 4),
+ ('DST_ETH', 6),
+ ('DST_IP', 4) ]),
+ ('IP', [
+ ('VHLTOS', 2),
+ ('LENGTH', 2),
+ ('IPID', 2),
+ ('IPOFFSET', 2),
+ ('TTLPROTO', 2),
+ ('CHKSUM', 2),
+ ('SRCIP', 4),
+ ('DSTIP', 4),
+ [
+ ('ICMP', [
+ ('TYPECODE', 2),
+ ('CHKSUM', 2),
+ ('IDENTIFIER', 2),
+ ('SEQUENCE', 2) ]),
+ ('TCP', [
+ ('SOURCEPORT', 2),
+ ('DESTPORT', 2),
+ ('SEQNUM', 4),
+ ('ACK', 4),
+ ('FLAGS', 2),
+ ('WINDOW', 2),
+ ('CHECKSUM', 2),
+ ('URGENT', 2) ]),
+ ('UDP', [
+ ('SOURCEPORT', 2),
+ ('DESTPORT', 2),
+ ('LENGTH', 2),
+ ('CHECKSUM', 2),
+ [
+ ('DHCP', [
+ ('OP', 1),
+ ('HTYPE', 1),
+ ('HLEN', 1),
+ ('HOPS', 1),
+ ('XID', 4),
+ ('SECS', 2),
+ ('FLAGS', 2),
+ ('CIADDR', 4),
+ ('YIADDR', 4),
+ ('SIADDR', 4),
+ ('GIADDR', 4),
+ ('CHADDR', 16),
+ ('SNAME', 64),
+ ('FILE', 128),
+ ('OPTIONS', 312)
+ ]),
+ ('DNS', [
+ ('IDENTIFICATION', 2),
+ ('FLAGS', 2),
+ ('NOQ', 2),
+ ('NOA', 2),
+ ('NORR', 2),
+ ('NOARR', 2),
+ ('QUERY', 1)
+ ]),
+ ('NTP', [
+ ('FLAGS', 4),
+ ('ROOTDELAY', 4),
+ ('ROOTDISPERSION', 4),
+ ('REFID', 4),
+ ('REFERENCE', 8),
+ ('ORIGINATE', 8),
+ ('RECEIVE', 8),
+ ('TRANSMIT', 8),
+ ]),
+ ('TFTP', [
+ ('OPCODE', 2),
+ [
+ ('RWRQ', [
+ ('FILENAME', 512)
+ ]),
+ ('DATA', [
+ ('BLOCK', 2),
+ ('DATA', 512)
+ ]),
+ ('ACK', [
+ ('BLOCK', 2),
+ ]),
+ ('ERROR', [
+ ('NUMBER', 2),
+ ('MESSAGE', 512),
+ ]),
+ ]
+ ]),
+ ('LOADER', [
+ ('SEQNO', 2),
+ ('OPCODE', 2),
+ [
+ ('RAMREAD', [
+ ('ADDR', 2)
+ ]),
+ ('RAMWRITE', [
+ ('ADDR', 2),
+ ('DATA', 128)
+ ]),
+ ('FLASHREAD', [
+ ('ADDR', 4)
+ ]),
+ ('FLASHWRITE', [
+ ('ADDR', 4),
+ ('DATA', 128)
+ ]),
+ ]
+ ]),
+ ('WGE', [
+ ('MAGIC', 4),
+ ('TYPE', 4),
+ ('HRT', 16),
+ ('REPLYTO', [
+ ('MAC', 8),
+ ('IP', 4),
+ ('PORT', 2),
+ ]),
+ ('PAD', 2),
+ [
+ ('DISCOVER', [
+ ('IP', 4)
+ ]),
+ ('CONFIGURE', [
+ ('PRODUCT', 4),
+ ('SERIAL', 4),
+ ('IP', 4)
+ ]),
+ ('FLASHREAD', [
+ ('ADDRESS', 4)
+ ]),
+ ('FLASHWRITE', [
+ ('ADDRESS', 4),
+ ('DATA', 264),
+ ]),
+ ('TRIGCONTROL', [
+ ('TRIGSTATE', 4),
+ ]),
+ ('SENSORREAD', [
+ ('ADDRESS', 1),
+ ]),
+ ('SENSORWRITE', [
+ ('ADDRESS', 1),
+ ('DATA', 2),
+ ]),
+ ('SENSORSELECT', [
+ ('INDEX', 1),
+ ('ADDRESS', 4),
+ ]),
+ ('IMAGERMODE', [
+ ('MODE', 4),
+ ]),
+ ('IMAGERSETRES', [
+ ('HORIZONTAL', 2),
+ ('VERTICAL', 2),
+ ]),
+ ('SYSCONFIG', [
+ ('MAC', 6),
+ ('SERIAL', 4),
+ ]),
+ ('VIDSTART', [
+ ('MAC', 8),
+ ('IP', 4),
+ ('PORT', 2),
+ ]),
+ ]
+ ]),
+ ]
+ ])
+ ]
+ ])
+ ]])
+]
+
+offsets = {}
+def descend(offset, prefix, node):
+ start = offset
+ if isinstance(node, list):
+ for n in node:
+ descend(offset, prefix, n)
+ else:
+ (name, members) = node
+ offsets[".".join((prefix + [name]))] = offset
+ if isinstance(members, int):
+ offset += members
+ else:
+ for n in members:
+ offset = descend(offset, prefix + [name], n)
+ # offsets["%s%s_SIZE" % (prefix, name)] = offset - start
+ return offset
+
+descend(0, [], layout[0])
+
+offsets['TCP_FIN'] = 1
+offsets['TCP_SYN'] = 2
+offsets['TCP_RST'] = 4
+offsets['TCP_PSH'] = 8
+offsets['TCP_ACK'] = 16
+offsets['TCP_URG'] = 32
+
+offsets['IP_PROTO_ICMP'] = 1
+offsets['IP_PROTO_IGMP'] = 2
+offsets['IP_PROTO_TCP'] = 6
+offsets['IP_PROTO_UDP'] = 17
+
+offsets['NUM_TCPS'] = 2
diff --git a/docs/j1demo/firmware/dhcp.fs b/docs/j1demo/firmware/dhcp.fs
new file mode 100644
index 0000000..971e567
--- /dev/null
+++ b/docs/j1demo/firmware/dhcp.fs
@@ -0,0 +1,176 @@
+( DHCP: Dynamic Host Configuration Protocol JCB 13:13 08/24/10)
+module[ dhcp"
+
+\ Since DHCP alarm is only used when there is no lease, it is
+\ safe to use the ip-subnetmask for the same purpose.
+
+ip-subnetmask constant dhcp-alarm
+
+: dhcp-xid
+ ip-router 2@
+;
+
+: dhcp-xid!
+ ip-router 2!
+;
+
+: dhcp-option \ ( ... n code -- )
+ mac-pkt-c,
+ dup mac-pkt-c,
+ 0do
+ mac-pkt-c,
+ loop
+;
+
+: dhcp-common \ ( messagetype -- )
+ d# 67 d# 68
+ d# 0 invert dup
+ d# 0 dup
+ d# 0 \ broadcast ethaddr
+ ( dst-port src-port dst-ip src-ip *ethaddr -- )
+ udp-header
+ h# 0101 h# 0600 mac-pkt-2,
+ dhcp-xid mac-pkt-2,
+ d# 10 mac-pkt-,0
+ net-my-mac mac-pkt-3,
+ d# 101 mac-pkt-,0 \ d# 5 + d# 96 zeroes
+
+ h# 6382 h# 5363
+ mac-pkt-2,
+
+ \ DHCP option 53: DHCP Discover
+ \ messagetype
+ d# 1 d# 53 \ messagetype 1 53
+ dhcp-option
+
+ \ DHCP option 50: 192.168.1.100 requested
+
+ \ DHCP option 55: Parameter Request List:
+ \ Request Subnet Mask (1), Router (3),
+ \ Domain Name Server (6)
+ d# 1 d# 3 d# 6 d# 3 d# 55 dhcp-option
+;
+
+: dhcp-wrapup
+ \ Finish options
+ h# ff mac-pkt-c,
+ \ mac-wrptr @ d# 1 and
+ d# 1 if \ XXX
+ h# ff mac-pkt-c,
+ then
+
+ udp-wrapup
+ mac-send
+;
+
+\ memory layout is little-endian
+
+: macc@++ ( c-addr -- c-addr+1 c )
+ dup 1+ swap macc@ ;
+
+: dhcp-field \ ( match -- ptr/0 )
+ OFFSET_DHCP_OPTIONS d# 4 + mac-inoffset
+ \ match ptr
+ begin
+ macc@++ \ match ptr code
+ dup h# ff <>
+ while \ match ptr code
+ d# 2 pick =
+ if
+ nip \ ptr
+ exit
+ then \ match ptr
+ macc@++ + \ match ptr'
+ repeat
+ \ fail - return false
+ 2drop false
+;
+
+: dhcp-yiaddr
+ d# 2 OFFSET_DHCP_YIADDR mac-inoffset mac@n
+;
+
+: dhcp-field4
+ dhcp-field d# 1 +
+ macc@++ swap macc@++ swap macc@++ swap macc@
+ ( a b c d )
+ swap d# 8 lshift or -rot
+ swap d# 8 lshift or
+ swap
+;
+
+build-debug? [IF]
+: .pad ( ip. c-addr u -- ) d# 14 typepad ip-pretty cr ;
+
+: dhcp-status
+ ip-addr 2@ s" IP" .pad
+ ip-router 2@ s" router" .pad
+ ip-subnetmask 2@ s" subnetmask" .pad
+;
+[ELSE]
+: dhcp-status ;
+[THEN]
+
+: lease-setalarm
+ d# 0 >r
+ begin
+ 2dup d# 63. d>
+ while
+ d2/ r> 1+ >r
+ repeat
+ r>
+ hex4 space hex8 cr
+;
+
+: dhcp-wait-offer
+ h# 11 ip-isproto
+ OFFSET_UDP_SOURCEPORT packet@ d# 67 = and
+ OFFSET_UDP_DESTPORT packet@ d# 68 = and
+ d# 2 OFFSET_DHCP_XID mac-inoffset mac@n dhcp-xid d= and
+ if
+ snap
+ d# 53 dhcp-field ?dup
+ snap
+ if
+ d# 1 + macc@
+ snap
+ dup d# 2 =
+ if
+ \ [char] % emit
+ d# 3 dhcp-common
+
+ \ option 50: request IP
+ h# 3204
+ dhcp-yiaddr
+ mac-pkt-3,
+
+ \ Option 54: server
+ h# 3604
+ d# 54 dhcp-field4
+ mac-pkt-3,
+
+ dhcp-wrapup
+ then
+ d# 5 =
+ if
+ \ clrwdt
+ \ [char] & emit
+
+ dhcp-yiaddr ip-addr 2!
+ d# 1 dhcp-field4 ip-subnetmask 2!
+ \ For the router and DNS server, send out ARP requests right now. This
+ \ reduces start-up time.
+ d# 3 dhcp-field4 2dup ip-router 2! arp-lookup drop
+ d# 6 dhcp-field4 2dup ip-dns 2! arp-lookup drop
+ \ Option 51: lease time
+ s" expires in " type
+ d# 51 dhcp-field4 swap d. cr
+ then
+ then
+ snap
+ then
+;
+
+: dhcp-discover d# 1 dhcp-common dhcp-wrapup ;
+
+]module
diff --git a/docs/j1demo/firmware/dns.fs b/docs/j1demo/firmware/dns.fs
new file mode 100644
index 0000000..96ec36c
--- /dev/null
+++ b/docs/j1demo/firmware/dns.fs
@@ -0,0 +1,81 @@
+( DNS JCB 19:44 11/27/10)
+module[ dns"
+
+: ip-dns@ ip-dns 2@ ;
+
+\ ( offset -- offset' ) advance pointer past DNS label
+\ 0 means end
+\ >h# c0 means ptr to end
+\ N means word of N bytes
+
+: dns-skiplabel
+ begin
+ dup 1+ swap mac-inoffset macc@ \ offset+1 v
+ dup 0= if
+ drop exit
+ then
+ dup h# c0 >= if
+ drop 1+ exit
+ then
+ +
+ again
+;
+
+\ Query DNS. xt is a word that appends domainname to packet. id is DNS
+\ id field, used to route responses.
+
+: dns-query ( xt id -- )
+ >r
+ \ dst-port src-port dst-ip src-ip *ethaddr
+ d# 53 d# 31947
+ ip-dns@
+ net-my-ip
+ ip-dns@ arp-lookup
+ udp-header
+ r> \ IDENTIFICATION
+ h# 0100 \ FLAGS
+ d# 1 \ NOQ
+ mac-pkt-3,
+ d# 3 mac-pkt-,0
+
+ execute
+
+ d# 1 \ query type A
+ dup \ query class internet
+ mac-pkt-2,
+ udp-wrapup
+
+ ip-dns@ arp-lookup if
+ mac-send
+ then
+;
+
+: dns-handler ( srcport dstport -- 0 / ip. id 1 )
+ d# 53 d# 31947 d=
+ OFFSET_DNS_FLAGS packet@ 0< and
+ OFFSET_DNS_NOA packet@ 0<> and
+ if
+ OFFSET_DNS_QUERY
+ dns-skiplabel
+ d# 4 +
+ dns-skiplabel
+ d# 10 +
+ mac-inoffset d# 2 swap mac@n
+ OFFSET_DNS_IDENTIFICATION packet@
+ d# 1
+ else
+ d# 0
+ then
+;
+
+: dns-appendname ( str -- )
+ dup mac-pkt-c,
+ mac-pkt-s,
+;
+
+: dns-append.com ( str -- )
+ dns-appendname
+ s" com" dns-appendname
+ d# 0 mac-pkt-c,
+;
+]module
diff --git a/docs/j1demo/firmware/doc.fs b/docs/j1demo/firmware/doc.fs
new file mode 100644
index 0000000..8b3c07d
--- /dev/null
+++ b/docs/j1demo/firmware/doc.fs
@@ -0,0 +1,20 @@
+( Documentation conventions JCB 14:37 10/26/10)
+
+meta
+
+: getword ( -- a u )
+ begin
+ bl word count dup 0=
+ while
+ 2drop refill true <> abort" Failed to find word"
+ repeat
+;
+
+: ================================================================
+ begin
+ getword
+ nip 64 =
+ until
+;
+
+target
diff --git a/docs/j1demo/firmware/document.fs b/docs/j1demo/firmware/document.fs
new file mode 100644
index 0000000..53c741c
--- /dev/null
+++ b/docs/j1demo/firmware/document.fs
@@ -0,0 +1,3 @@
+\ For use with docforth.fs
+
+s" ans.fs" included
diff --git a/docs/j1demo/firmware/encode.py b/docs/j1demo/firmware/encode.py
new file mode 100644
index 0000000..54022d2
--- /dev/null
+++ b/docs/j1demo/firmware/encode.py
@@ -0,0 +1,28 @@
+import sys
+import Image
+from array import array
+
+def getch(im, x, y):
+ return tuple(tuple((int(0 != im.getpixel((x + j, y + i)))) for j in range(8)) for i in range(8))
+
+def main(filename):
+ sm = Image.open(filename).convert("L")
+ im = Image.new("L", (512, 256))
+ im.paste(sm, (0,0))
+ charset = {}
+ picture = []
+ for y in range(0, im.size[1], 8):
+ for x in range(0, im.size[0], 8):
+ glyph = getch(im, x, y)
+ if not glyph in charset:
+ charset[glyph] = 96 + len(charset)
+ picture.append(charset[glyph])
+ open(filename + ".pic", "w").write(array('B', picture).tostring())
+ cd = array('B', [0] * 8 * len(charset))
+ for d,i in charset.items():
+ i -= 96
+ for y in range(8):
+ cd[8 * i + y] = sum([(d[y][x] << (7 - x)) for x in range(8)])
+ open(filename + ".chr", "w").write(cd.tostring())
+
+main(sys.argv[1])
diff --git a/docs/j1demo/firmware/eth-ax88796.fs b/docs/j1demo/firmware/eth-ax88796.fs
new file mode 100644
index 0000000..0a630d6
--- /dev/null
+++ b/docs/j1demo/firmware/eth-ax88796.fs
@@ -0,0 +1,506 @@
+( Low-level MAC actions JCB 13:23 08/24/10)
+
+================================================================
+
+Initialization:
+ mac-cold
+
+Packet reception and reading:
+ mac-fullness
+ mac-inoffset
+ mac@
+ macc@
+ mac@n
+ mac-consume
+
+Packet construction and transmission:
+ mac-pkt-begin
+ mac-pkt-,
+ mac-pkt-c,
+ mac-pkt-d,
+ mac-pkt-2,
+ mac-pkt-3,
+ mac-pkt-,0
+ mac-pkt-s,
+ mac-pkt-src
+ packetout-off
+ mac!
+ macc!
+ mac-complete
+ mac-checksum
+ mac-send
+
+================================================================
+
+( NE2K JCB 10:23 11/08/10)
+
+: ne2sel
+ false ether_cs_n ! ;
+: ne2unsel
+ true ether_cs_n ! ;
+: ne2a ( a -- )
+ pb_a ! ;
+
+: ne2rc@ ( a -- u ) \ NE2 byte reg read
+ true ether_bhe_n !
+ true ether_aen !
+ ne2sel
+ ne2a
+ false pb_rd_n !
+ \ pause144
+ pb_d @ h# ff and
+ true pb_rd_n !
+ \ false ether_aen !
+ \ ne2unsel
+;
+
+: ne2rc! ( u a -- )
+ \ over hex2 s" -> " type dup hex2 cr
+
+ true ether_bhe_n !
+
+ ne2sel
+ ne2a
+ pb_d !
+ d# 0 ddir !
+ false pb_wr_n !
+ true pb_wr_n !
+ \ ne2unsel
+ d# 1 ddir !
+;
+
+: ne2r! ( u a -- )
+ over d# 8 rshift over 1+ ne2rc! ne2rc! ;
+
+: ne2r. \ dump registers
+ d# 16 0do
+ d# 1000 0do pause144 loop
+ i hex2 space
+ i ne2rc@ hex4 cr
+ loop
+;
+
+h# 00 constant ne2-CR
+h# 01 constant ne2-PSTART
+h# 01 constant ne2-PAR0
+h# 03 constant ne2-PAR2
+h# 05 constant ne2-PAR4
+h# 01 constant ne2-CR9346
+h# 02 constant ne2-PSTOP
+h# 03 constant ne2-BNRY
+h# 04 constant ne2-TSR
+h# 04 constant ne2-TPSR
+h# 05 constant ne2-TBCR0
+h# 05 constant ne2-NCR
+h# 06 constant ne2-CPR
+h# 06 constant ne2-TBCR1
+h# 07 constant ne2-ISR
+h# 07 constant ne2-CURR
+h# 08 constant ne2-RSAR0
+h# 08 constant ne2-CRDA0
+h# 09 constant ne2-RSAR1
+h# 09 constant ne2-CRDA1
+h# 0A constant ne2-RBCR0
+h# 0B constant ne2-RBCR1
+h# 0C constant ne2-RSR
+h# 0C constant ne2-RCR
+h# 0D constant ne2-TCR
+h# 0D constant ne2-CNTR0
+h# 0E constant ne2-DCR
+h# 0E constant ne2-CNTR1
+h# 0F constant ne2-IMR
+h# 0F constant ne2-CNTR2
+h# 10 constant ne2-RDMAPORT
+h# 14 constant ne2-MIIEEP
+h# 15 constant ne2-TR
+h# 17 constant ne2-GPOC
+h# 17 constant ne2-GPI
+h# 1F constant ne2-RSTPORT
+
+: ne2-page0 h# 22 ne2-CR ne2rc! ;
+: ne2-page1 h# 62 ne2-CR ne2rc! ;
+
+: ne2-clrisr \ clear the ISR
+ h# ff ne2-ISR ne2rc! ;
+
+
+: ne2r.2
+ s" Page 0" type cr
+ ne2-page0
+ ne2r.
+ s" Page 1" type cr
+ ne2-page1
+ ne2r.
+ ne2-page0 ;
+
+( The MII interface JCB 12:47 11/09/10)
+
+h# 08 constant MII_EEP_MDO
+h# 04 constant MII_EEP_MDI
+h# 01 constant MII_EEP_MDC
+
+: eep-on ( u ) ne2-MIIEEP ne2rc@ or ne2-MIIEEP ne2rc! ;
+: eep-off ( u ) invert ne2-MIIEEP ne2rc@ and ne2-MIIEEP ne2rc! ;
+
+: miix ( u c -- u ) \ Send c bit data u
+ tuck
+ d# 16 swap - lshift
+ swap
+ 0do
+ MII_EEP_MDO over 0< if
+ eep-on
+ else
+ eep-off
+ then
+ MII_EEP_MDC eep-on \ clock up
+ 2*
+ ne2-MIIEEP ne2rc@ MII_EEP_MDI and if 1+ then
+ MII_EEP_MDC eep-off \ clock down
+ loop
+;
+
+: phy@ ( a -- u )
+ h# ffff d# 16 miix drop
+ h# ffff d# 16 miix drop
+ h# 0d0 d# 9 miix drop
+ d# 5 miix drop
+ h# 0 d# 1 miix drop
+ h# 0 d# 16 miix
+;
+
+: phy! ( u a -- )
+ h# ffff d# 16 miix drop
+ h# ffff d# 16 miix drop
+ h# 0b0 d# 9 miix drop
+ d# 5 miix drop
+ h# 2 d# 2 miix drop
+ d# 16 miix drop
+;
+
+: phy.
+ d# 32 0do
+ i hex2 space i phy@ hex4 cr
+ loop
+ cr
+;
+
+: phy-cold
+ \ h# b000 d# 0 phy!
+ h# 0800 d# 0 phy!
+ s" PHY power down for 2.5s" type cr
+ d# 2500000. sleepus
+ \ h# 1200 d# 0 phy!
+ h# 0000 d# 0 phy!
+ exit
+ sleep1
+ sleep1
+ sleep1
+ sleep1
+ sleep1
+ sleep1
+
+ \ h# 6030 d# 30 phy!
+
+ phy. sleep1
+ cr
+ phy.
+;
+
+: mac-cold ( ethaddr -- )
+
+ false RESET_TRIGGER !
+ sleep1
+ true RESET_TRIGGER !
+ sleep1
+
+ true pb_rd_n !
+ true pb_wr_n !
+ true ether_cs_n !
+ false ether_aen !
+ true ether_bhe_n !
+ d# 0 pb_a !
+ d# 1 ddir !
+
+ \ d# 4 0do ne2-RSTPORT ne2rc@ ne2-RSTPORT ne2rc! sleep1 loop
+
+ phy-cold
+
+ \ Wait for TR RST_B to go low and GPI link up
+ s" TR GPI" type cr
+ begin
+ ne2-TR ne2rc@ hex2 d# 3 spaces
+ ne2-GPI ne2rc@ hex2 d# 3 spaces
+ sleep.1
+ cr
+ ne2-TR ne2rc@ d# 2 and 0=
+ ne2-GPI ne2rc@ d# 1 and 0<> and
+ until
+
+ \ Wait for TR RST_B to go low
+\ begin
+\ sleep1
+\ ne2-TR ne2rc@ dup hex2 cr
+\ d# 2 and 0=
+\ until
+
+ true if
+ h# 21 ne2-CR ne2rc! \ Stop the NIC, abort DMA, page 0
+ h# 00 ne2-DCR ne2rc! \ Selects byte-wide DMA transfers
+ h# 00 ne2-RBCR0 ne2rc! \ Load data byte count for remote DMA
+ h# 00 ne2-RBCR1 ne2rc!
+ h# 20 ne2-RCR ne2rc! \ Temporarily set receiver to monitor mode
+ h# 02 ne2-TCR ne2rc! \ Transmitter set to internal loopback mode
+ \ Initialize Receive Buffer Ring: Boundary Pointer
+ \ (BNDRY), Page Start (PSTART), and Page Stop
+ \ (PSTOP)
+ h# 46 ne2-PSTART ne2rc!
+ h# 46 ne2-BNRY ne2rc!
+ h# 80 ne2-PSTOP ne2rc!
+ h# ff ne2-ISR ne2rc! \ Clear Interrupt Status Register (ISR) by writing 0FFh to it.
+ h# 01 ne2-IMR ne2rc! \ Initialize interrupt mask
+ h# 61 ne2-CR ne2rc! \ Stop the NIC, abort DMA, page 1
+ h# 12 d# 1 ne2rc! \ Set Physical Address
+ h# 34 d# 2 ne2rc!
+ h# 56 d# 3 ne2rc!
+ h# 77 d# 4 ne2rc!
+ h# 77 d# 5 ne2rc!
+ h# 77 d# 6 ne2rc!
+ d# 16 d# 8 do \ Set multicast address
+ h# 00 i ne2rc!
+ loop
+
+ h# 47 ne2-CURR ne2rc! \ Initialize CURRent pointer
+ h# 22 ne2-CR ne2rc! \ Start the NIC, Abort DMA, page 0
+ h# 10 ne2-GPOC ne2rc! \ Select media interface
+ s" GPI = " type ne2-GPI ne2rc@ hex2 cr
+ h# 00 ne2-TCR ne2rc! \ Transmitter full duplex
+ h# 04 ne2-RCR ne2rc! \ Enable receiver and set accept broadcast
+ else
+ h# 21 ne2-CR ne2rc! \ Stop the NIC, abort DMA, page 0
+ sleep.1
+
+ h# 00 ne2-DCR ne2rc! \ Selects word-wide DMA transfers
+ h# 00 ne2-RBCR0 ne2rc! \ Load data byte count for remote DMA
+ h# 00 ne2-RBCR1 ne2rc!
+
+ h# 20 ne2-RCR ne2rc! \ Temporarily set receiver to monitor mode
+ h# 02 ne2-TCR ne2rc! \ Transmitter set to internal loopback mode
+
+ h# 40 ne2-TPSR ne2rc! \ Set Tx start page
+ \ Initialize Receive Buffer Ring: Boundary Pointer
+ \ (BNDRY), Page Start (PSTART), and Page Stop
+ \ (PSTOP)
+ h# 46 ne2-PSTART ne2rc!
+ h# 46 ne2-BNRY ne2rc!
+ h# 80 ne2-PSTOP ne2rc!
+ h# ff ne2-ISR ne2rc! \ Clear Interrupt Status Register (ISR) by writing 0FFh to it.
+ h# 01 ne2-IMR ne2rc! \ Initialize interrupt mask
+
+ h# 61 ne2-CR ne2rc! \ Stop the NIC, abort DMA, page 1
+ sleep.1
+ h# 12 d# 1 ne2rc! \ Set Physical Address
+ h# 34 d# 2 ne2rc!
+ h# 56 d# 3 ne2rc!
+ h# 77 d# 4 ne2rc!
+ h# 77 d# 5 ne2rc!
+ h# 77 d# 6 ne2rc!
+ d# 16 d# 8 do \ Set multicast address
+ h# ff i ne2rc!
+ loop
+
+ h# 47 ne2-CURR ne2rc! \ Initialize CURRent pointer
+
+ h# 20 ne2-CR ne2rc! \ DMA abort, page 0
+
+ h# 10 ne2-GPOC ne2rc! \ Select media interface
+ s" GPI = " type ne2-GPI ne2rc@ hex2 cr
+ h# 1c ne2-RCR ne2rc! \ Enable receiver and set accept broadcast
+ h# 00 ne2-TCR ne2rc! \ Transmitter full duplex
+
+ h# ff ne2-ISR ne2rc! \ Clear Interrupt Status Register (ISR) by writing 0FFh to it.
+ h# 22 ne2-CR ne2rc! \ Start the NIC, Abort DMA, page 0
+ then
+;
+
+: NicCompleteDma
+ h# 22 ne2-CR ne2rc! \ Complete remote DMA
+;
+
+: maca ( a -- ) \ set DMA address a
+ dup d# 8 rshift ne2-RSAR1 ne2rc! ne2-RSAR0 ne2rc! ;
+: mac1b \ set DMA transfer for 1 byte
+ h# 01 ne2-RBCR0 ne2rc!
+ h# 00 ne2-RBCR1 ne2rc! ;
+: mac2b \ set DMA transfer for 2 bytes
+ h# 02 ne2-RBCR0 ne2rc!
+ h# 00 ne2-RBCR1 ne2rc! ;
+: macc@ ( a -- u )
+ maca mac1b
+ h# 0a ne2-CR ne2rc! \ running, DMA read
+ ne2-RDMAPORT ne2rc@
+ NicCompleteDma ;
+: macc! ( u a -- )
+ maca mac1b
+ h# 12 ne2-CR ne2rc! \ running, DMA write
+ ne2-RDMAPORT ne2rc! ;
+: mac@ ( a -- u )
+ maca mac2b
+ h# 0a ne2-CR ne2rc! \ running, DMA read
+ ne2-RDMAPORT ne2rc@ d# 8 lshift ne2-RDMAPORT ne2rc@ or
+ NicCompleteDma ;
+: mac! ( u a -- )
+ maca mac2b
+ h# 12 ne2-CR ne2rc! \ running, DMA write
+ dup d# 8 rshift ne2-RDMAPORT ne2rc! ne2-RDMAPORT ne2rc! ;
+
+: mac-dump ( a u -- )
+ bounds
+ begin
+ 2dup u>
+ while
+ dup h# f and 0= if
+ cr dup hex4 [char] : emit space
+ then
+ dup mac@ hex4 space
+ 2+
+ repeat 2drop cr ;
+
+variable currpkt
+
+: mac-inoffset ( u -- u ) \ compute offset into current incoming packet
+ currpkt @ +
+ dup 0< if
+ h# 8000 -
+ h# 4600 +
+ then
+;
+
+: mac@n ( n addr -- d0 .. dn )
+ swap 0do dup mac@ swap 2+ loop drop ;
+
+
+( words for constructing packet data JCB 07:01 08/20/10)
+variable writer
+
+: mac-pkt-begin h# 4000 writer ! ;
+: bump ( n -- ) writer +! ;
+: mac-pkt-c, ( n -- ) writer @ macc! d# 1 bump ;
+: mac-pkt-, ( n -- ) writer @ mac! d# 2 bump ;
+: mac-pkt-d, ( d -- ) mac-pkt-, mac-pkt-, ;
+: mac-pkt-2, ( n0 n1 -- ) swap mac-pkt-, mac-pkt-, ;
+: mac-pkt-3, rot mac-pkt-, mac-pkt-2, ;
+: mac-pkt-,0 ( n -- ) 0do d# 0 mac-pkt-, loop ;
+: mac-pkt-s, ( caddr u -- )
+ 0do
+ dup c@
+ mac-pkt-c,
+ 1+
+ loop
+ drop
+;
+
+: mac-pkt-src ( n offset -- ) \ copy n words from incoming+offset
+ swap 0do
+ dup mac-inoffset mac@ mac-pkt-,
+ 2+
+ loop
+ drop
+;
+
+: mac-pkt-complete ( -- length ) \ set up size
+ writer @ h# 4000 -
+ \ h# 4000 over mac-dump
+ dup ne2-TBCR0 ne2r! ;
+
+: mac-checksum ( addr nwords -- sum )
+ d# 0 swap
+ 0do
+ over mac@ ( addr sum v )
+ +1c
+ swap 2+ swap
+ loop
+ nip
+ invert
+;
+
+: mac-snap
+ s" CR PSTART PSTOP BNRY TSR NCR CPR ISR CRDA0 CRDA1 - - RSR CNTR0 CNTR1 CNTR2" type cr
+ d# 16 0do
+ i ne2rc@ hex2 d# 5 spaces
+ loop
+;
+
+: mac-fullness ( -- f )
+ ether_irq @ if
+ ne2-BNRY ne2rc@ 1+ ne2-CPR ne2rc@ <> dup if
+ \ mac-snap
+ ne2-BNRY ne2rc@ 1+ d# 8 lshift d# 4 + currpkt !
+ \ s" currpkt=" type currpkt @ hex4 space
+ \ currpkt @ d# 4 - macc@ hex2
+ \ cr
+ \ currpkt @ d# 4 - d# 16 mac-dump
+ else
+ ne2-clrisr
+ then
+ else
+ false
+ then
+;
+
+: mac-consume ( -- ) \ finished with current packet, move on
+ ne2-BNRY ne2rc@ 1+ d# 8 lshift 1+ macc@ \ next pkt
+ 1- ne2-BNRY ne2rc!
+;
+
+variable ne2cold
+
+: mac-send
+ ne2cold @ 0= if
+ h# 21 ne2-CR ne2rc!
+ h# 22 ne2-CR ne2rc!
+ true ne2cold !
+ then
+
+ h# 40 ne2-TPSR ne2rc!
+ h# 26 ne2-CR ne2rc! \ START
+ ;
+
+: packetout-off \ compute offset in output packet
+ h# 4000 + ;
+
+: nicwork
+
+ \ ISA mode
+
+ \ begin
+ s" TR= " type h# 15 ne2rc@ hex2 space
+ s" ether_irq=" type ether_irq @ hex1 space
+ s" ISR=" type ne2-ISR ne2rc@ hex2 space
+ cr
+ \ again
+
+ false if
+ h# 0000 ne2-RSAR0 ne2r!
+ cr
+ d# 16 0do
+ ne2-RDMAPORT ne2rc@ hex2 space
+ loop
+ cr
+ then
+
+ s" CR PSTART PSTOP BNRY TSR NCR CPR ISR CRDA0 CRDA1 - - RSR CNTR0 CNTR1 CNTR2" type cr
+ begin
+ d# 16 0do
+ i ne2rc@ hex2 d# 5 spaces
+ loop
+ ether_irq @ hex1
+ cr
+ sleep1
+ ne2-CPR ne2rc@ h# 47 <>
+ until
+
+ \ h# 4700 h# 100 mac-dump
+ \ cr
+ \ h# 0947 h# 4700 mac!
+ \ h# 4700 h# 100 mac-dump
+;
diff --git a/docs/j1demo/firmware/font8x8 b/docs/j1demo/firmware/font8x8
new file mode 100644
index 0000000..fbdaf14
--- /dev/null
+++ b/docs/j1demo/firmware/font8x8
Binary files differ
diff --git a/docs/j1demo/firmware/fsm-32.png b/docs/j1demo/firmware/fsm-32.png
new file mode 100644
index 0000000..974f70c
--- /dev/null
+++ b/docs/j1demo/firmware/fsm-32.png
Binary files differ
diff --git a/docs/j1demo/firmware/genoffsets.py b/docs/j1demo/firmware/genoffsets.py
new file mode 100644
index 0000000..2ed279e
--- /dev/null
+++ b/docs/j1demo/firmware/genoffsets.py
@@ -0,0 +1,11 @@
+from defines_tcpip import offsets
+
+d = open("defines_tcpip.fs", "w")
+for nm,o in sorted(offsets.items()):
+ print >>d, "%d constant %s" % (o, nm)
+
+import defines_tcpip2
+
+d = open("defines_tcpip2.fs", "w")
+for nm,o in sorted(defines_tcpip2.offsets.items()):
+ print >>d, "%d constant %s" % (o, nm)
diff --git a/docs/j1demo/firmware/go b/docs/j1demo/firmware/go
new file mode 100644
index 0000000..0adb2d0
--- /dev/null
+++ b/docs/j1demo/firmware/go
@@ -0,0 +1,16 @@
+# make doc
+# python encode.py j1.png
+# python mkblob.py ; exit
+make j1.bin || exit
+
+# for ADDR in 0 80000 100000 180000
+# do
+# (. /opt/Xilinx/11.1/ISE/settings32.sh ; promgen -u $ADDR j1_program.bit -p mcs -w -o j1_program_$ADDR.mcs )
+# done
+# ./boot
+# ping -c 4 192.168.0.99 && python twist.py
+
+python twist.py
+
+(. /opt/Xilinx/11.1/ISE/settings32.sh ; data2mem -bm ../synth/j1_bd.bmm -bd j1.mem tag jram -bt ../synth/j1.bit -o b j1_program.bit )
+scp j1_program.bit leonard:.
diff --git a/docs/j1demo/firmware/hwdefs.fs b/docs/j1demo/firmware/hwdefs.fs
new file mode 100644
index 0000000..4539d1a
--- /dev/null
+++ b/docs/j1demo/firmware/hwdefs.fs
@@ -0,0 +1,57 @@
+h# 4100 constant flash_ddir
+h# 4102 constant flash_ce_n
+h# 4104 constant flash_oe_n
+h# 4106 constant flash_we_n
+h# 4108 constant flash_byte_n
+h# 410a constant flash_rdy
+h# 410c constant flash_rst_n
+h# 410e constant flash_a
+h# 4110 constant flash_a_hi
+h# 4112 constant flash_d
+
+h# 4200 constant ps2_clk
+h# 4202 constant ps2_dat
+h# 4204 constant ps2_clk_dir
+h# 4206 constant ps2_dat_dir
+h# 4208 constant kbfifocount
+h# 4210 constant kbfifo
+
+h# 4300 constant vga_scroll
+h# 4302 constant vga_spritea
+h# 4304 constant vga_spriteport
+h# 4306 constant vga_line
+h# 4308 constant vga_addsprites
+
+h# 4400 constant vga_spritex
+h# 4402 constant vga_spritey
+
+h# 4420 constant vga_spritec
+h# 4430 constant vga_spritep
+
+h# 4500 constant sw2_n
+h# 4502 constant sw3_n
+
+h# 5000 constant RS232_TXD
+h# 5001 constant RESET_TRIGGER
+h# 5100 constant ether_cs_n
+h# 5101 constant ether_aen
+h# 5102 constant ether_bhe_n
+h# 5103 constant pb_a
+h# 5104 constant ddir
+h# 5105 constant pb_d
+h# 5106 constant pb_rd_n
+h# 5107 constant pb_wr_n
+h# 5108 constant ether_rdy
+h# 5109 constant ether_irq
+h# 510a constant pb_a_dir
+
+h# 6000 constant time
+h# 6100 constant mult_a
+h# 6102 constant mult_b
+h# 6104 constant mult_p
+
+\ Pushbuttons
+
+h# 1 constant pb2
+h# 2 constant pb3
+h# 4 constant pb4
diff --git a/docs/j1demo/firmware/intelhex.py b/docs/j1demo/firmware/intelhex.py
new file mode 100644
index 0000000..ecf8b28
--- /dev/null
+++ b/docs/j1demo/firmware/intelhex.py
@@ -0,0 +1,643 @@
+#!/usr/bin/python
+
+# Copyright (c) 2005-2007, Alexander Belchenko
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms,
+# with or without modification, are permitted provided
+# that the following conditions are met:
+#
+# * Redistributions of source code must retain
+# the above copyright notice, this list of conditions
+# and the following disclaimer.
+# * Redistributions in binary form must reproduce
+# the above copyright notice, this list of conditions
+# and the following disclaimer in the documentation
+# and/or other materials provided with the distribution.
+# * Neither the name of the <Alexander Belchenko>
+# nor the names of its contributors may be used to endorse
+# or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING,
+# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+# AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+# IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
+# OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+# OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+# AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
+# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+'''Intel HEX file format reader and converter.
+
+This script also may be used as hex2bin convertor utility.
+
+@author Alexander Belchenko (bialix AT ukr net)
+@version 0.8.6
+@date 2007/04/26
+'''
+
+
+__docformat__ = "javadoc"
+
+
+from array import array
+from binascii import hexlify, unhexlify
+
+
+class IntelHex:
+ ''' Intel HEX file reader. '''
+
+ def __init__(self, fname):
+ ''' Constructor.
+ @param fname file name of HEX file or file object.
+ '''
+ #public members
+ self.Error = None
+ self.AddrOverlap = None
+ self.padding = 0x0FF
+ # Start Address
+ self.start_addr = None
+
+ # private members
+ self._fname = fname
+ self._buf = {}
+ self._readed = False
+ self._eof = False
+ self._offset = 0
+
+ def readfile(self):
+ ''' Read file into internal buffer.
+ @return True if successful.
+ '''
+ if self._readed:
+ return True
+
+ if not hasattr(self._fname, "read"):
+ f = file(self._fname, "rU")
+ fclose = f.close
+ else:
+ f = self._fname
+ fclose = None
+
+ self._offset = 0
+ self._eof = False
+
+ result = True
+
+ for s in f:
+ if not self.decode_record(s):
+ result = False
+ break
+
+ if self._eof:
+ break
+
+ if fclose:
+ fclose()
+
+ self._readed = result
+ return result
+
+ def decode_record(self, s):
+ ''' Decode one record of HEX file.
+ @param s line with HEX record.
+ @return True if line decode OK, or this is not HEX line.
+ False if this is invalid HEX line or checksum error.
+ '''
+ s = s.rstrip('\r\n')
+ if not s:
+ return True # empty line
+
+ if s[0] == ':':
+ try:
+ bin = array('B', unhexlify(s[1:]))
+ except TypeError:
+ # this might be raised by unhexlify when odd hexascii digits
+ self.Error = "Odd hexascii digits"
+ return False
+ length = len(bin)
+ if length < 5:
+ self.Error = "Too short line"
+ return False
+ else:
+ return True # first char must be ':'
+
+ record_length = bin[0]
+
+ if length != (5 + record_length):
+ self.Error = "Invalid line length"
+ return False
+
+ addr = bin[1]*256 + bin[2]
+
+ record_type = bin[3]
+ if not (0 <= record_type <= 5):
+ self.Error = "Invalid type of record: %d" % record_type
+ return False
+
+ crc = sum(bin)
+ crc &= 0x0FF
+ if crc != 0:
+ self.Error = "Invalid crc"
+ return False
+
+ if record_type == 0:
+ # data record
+ addr += self._offset
+ for i in xrange(4, 4+record_length):
+ if not self._buf.get(addr, None) is None:
+ self.AddrOverlap = addr
+ self._buf[addr] = bin[i]
+ addr += 1 # FIXME: addr should be wrapped on 64K boundary
+
+ elif record_type == 1:
+ # end of file record
+ if record_length != 0:
+ self.Error = "Bad End-of-File Record"
+ return False
+ self._eof = True
+
+ elif record_type == 2:
+ # Extended 8086 Segment Record
+ if record_length != 2 or addr != 0:
+ self.Error = "Bad Extended 8086 Segment Record"
+ return False
+ self._offset = (bin[4]*256 + bin[5]) * 16
+
+ elif record_type == 4:
+ # Extended Linear Address Record
+ if record_length != 2 or addr != 0:
+ self.Error = "Bad Extended Linear Address Record"
+ return False
+ self._offset = (bin[4]*256 + bin[5]) * 65536
+
+ elif record_type == 3:
+ # Start Segment Address Record
+ if record_length != 4 or addr != 0:
+ self.Error = "Bad Start Segment Address Record"
+ return False
+ if self.start_addr:
+ self.Error = "Start Address Record appears twice"
+ return False
+ self.start_addr = {'CS': bin[4]*256 + bin[5],
+ 'IP': bin[6]*256 + bin[7],
+ }
+
+ elif record_type == 5:
+ # Start Linear Address Record
+ if record_length != 4 or addr != 0:
+ self.Error = "Bad Start Linear Address Record"
+ return False
+ if self.start_addr:
+ self.Error = "Start Address Record appears twice"
+ return False
+ self.start_addr = {'EIP': (bin[4]*16777216 +
+ bin[5]*65536 +
+ bin[6]*256 +
+ bin[7]),
+ }
+
+ return True
+
+ def _get_start_end(self, start=None, end=None):
+ """Return default values for start and end if they are None
+ """
+ if start is None:
+ start = min(self._buf.keys())
+ if end is None:
+ end = max(self._buf.keys())
+ if start > end:
+ start, end = end, start
+ return start, end
+
+ def tobinarray(self, start=None, end=None, pad=None):
+ ''' Convert to binary form.
+ @param start start address of output bytes.
+ @param end end address of output bytes.
+ @param pad fill empty spaces with this value
+ (if None used self.padding).
+ @return array of unsigned char data.
+ '''
+ if pad is None:
+ pad = self.padding
+
+ bin = array('B')
+
+ if self._buf == {}:
+ return bin
+
+ start, end = self._get_start_end(start, end)
+
+ for i in xrange(start, end+1):
+ bin.append(self._buf.get(i, pad))
+
+ return bin
+
+ def tobinstr(self, start=None, end=None, pad=0xFF):
+ ''' Convert to binary form.
+ @param start start address of output bytes.
+ @param end end address of output bytes.
+ @param pad fill empty spaces with this value
+ (if None used self.padding).
+ @return string of binary data.
+ '''
+ return self.tobinarray(start, end, pad).tostring()
+
+ def tobinfile(self, fobj, start=None, end=None, pad=0xFF):
+ '''Convert to binary and write to file.
+
+ @param fobj file name or file object for writing output bytes.
+ @param start start address of output bytes.
+ @param end end address of output bytes.
+ @param pad fill empty spaces with this value
+ (if None used self.padding).
+ '''
+ if not hasattr(fobj, "write"):
+ fobj = file(fobj, "wb")
+ fclose = fobj.close
+ else:
+ fclose = None
+
+ fobj.write(self.tobinstr(start, end, pad))
+
+ if fclose:
+ fclose()
+
+ def minaddr(self):
+ ''' Get minimal address of HEX content. '''
+ aa = self._buf.keys()
+ if aa == []:
+ return 0
+ else:
+ return min(aa)
+
+ def maxaddr(self):
+ ''' Get maximal address of HEX content. '''
+ aa = self._buf.keys()
+ if aa == []:
+ return 0
+ else:
+ return max(aa)
+
+ def __getitem__(self, addr):
+ ''' Get byte from address.
+ @param addr address of byte.
+ @return byte if address exists in HEX file, or self.padding
+ if no data found.
+ '''
+ return self._buf.get(addr, self.padding)
+
+ def __setitem__(self, addr, byte):
+ self._buf[addr] = byte
+
+ def writefile(self, f, write_start_addr=True):
+ """Write data to file f in HEX format.
+
+ @param f filename or file-like object for writing
+ @param write_start_addr enable or disable writing start address
+ record to file (enabled by default).
+ If there is no start address nothing
+ will be written.
+
+ @return True if successful.
+ """
+ fwrite = getattr(f, "write", None)
+ if fwrite:
+ fobj = f
+ fclose = None
+ else:
+ fobj = file(f, 'w')
+ fwrite = fobj.write
+ fclose = fobj.close
+
+ # start address record if any
+ if self.start_addr and write_start_addr:
+ keys = self.start_addr.keys()
+ keys.sort()
+ bin = array('B', '\0'*9)
+ if keys == ['CS','IP']:
+ # Start Segment Address Record
+ bin[0] = 4 # reclen
+ bin[1] = 0 # offset msb
+ bin[2] = 0 # offset lsb
+ bin[3] = 3 # rectyp
+ cs = self.start_addr['CS']
+ bin[4] = (cs >> 8) & 0x0FF
+ bin[5] = cs & 0x0FF
+ ip = self.start_addr['IP']
+ bin[6] = (ip >> 8) & 0x0FF
+ bin[7] = ip & 0x0FF
+ bin[8] = (-sum(bin)) & 0x0FF # chksum
+ fwrite(':')
+ fwrite(hexlify(bin.tostring()).upper())
+ fwrite('\n')
+ elif keys == ['EIP']:
+ # Start Linear Address Record
+ bin[0] = 4 # reclen
+ bin[1] = 0 # offset msb
+ bin[2] = 0 # offset lsb
+ bin[3] = 5 # rectyp
+ eip = self.start_addr['EIP']
+ bin[4] = (eip >> 24) & 0x0FF
+ bin[5] = (eip >> 16) & 0x0FF
+ bin[6] = (eip >> 8) & 0x0FF
+ bin[7] = eip & 0x0FF
+ bin[8] = (-sum(bin)) & 0x0FF # chksum
+ fwrite(':')
+ fwrite(hexlify(bin.tostring()).upper())
+ fwrite('\n')
+ else:
+ self.Error = ('Invalid start address value: %r'
+ % self.start_addr)
+ return False
+
+ # data
+ minaddr = IntelHex.minaddr(self)
+ maxaddr = IntelHex.maxaddr(self)
+ if maxaddr > 65535:
+ offset = (minaddr/65536)*65536
+ else:
+ offset = None
+
+ while True:
+ if offset != None:
+ # emit 32-bit offset record
+ high_ofs = offset / 65536
+ offset_record = ":02000004%04X" % high_ofs
+ bytes = divmod(high_ofs, 256)
+ csum = 2 + 4 + bytes[0] + bytes[1]
+ csum = (-csum) & 0x0FF
+ offset_record += "%02X\n" % csum
+
+ ofs = offset
+ if (ofs + 65536) > maxaddr:
+ rng = xrange(maxaddr - ofs + 1)
+ else:
+ rng = xrange(65536)
+ else:
+ ofs = 0
+ offset_record = ''
+ rng = xrange(maxaddr + 1)
+
+ csum = 0
+ k = 0
+ record = ""
+ for addr in rng:
+ byte = self._buf.get(ofs+addr, None)
+ if byte != None:
+ if k == 0:
+ # optionally offset record
+ fobj.write(offset_record)
+ offset_record = ''
+ # start data record
+ record += "%04X00" % addr
+ bytes = divmod(addr, 256)
+ csum = bytes[0] + bytes[1]
+
+ k += 1
+ # continue data in record
+ record += "%02X" % byte
+ csum += byte
+
+ # check for length of record
+ if k < 16:
+ continue
+
+ if k != 0:
+ # close record
+ csum += k
+ csum = (-csum) & 0x0FF
+ record += "%02X" % csum
+ fobj.write(":%02X%s\n" % (k, record))
+ # cleanup
+ csum = 0
+ k = 0
+ record = ""
+ else:
+ if k != 0:
+ # close record
+ csum += k
+ csum = (-csum) & 0x0FF
+ record += "%02X" % csum
+ fobj.write(":%02X%s\n" % (k, record))
+
+ # advance offset
+ if offset is None:
+ break
+
+ offset += 65536
+ if offset > maxaddr:
+ break
+
+ # end-of-file record
+ fobj.write(":00000001FF\n")
+ if fclose:
+ fclose()
+
+ return True
+#/IntelHex
+
+
+class IntelHex16bit(IntelHex):
+ """Access to data as 16-bit words."""
+
+ def __init__(self, source):
+ """Construct class from HEX file
+ or from instance of ordinary IntelHex class.
+
+ @param source file name of HEX file or file object
+ or instance of ordinary IntelHex class
+ """
+ if isinstance(source, IntelHex):
+ # from ihex8
+ self.Error = source.Error
+ self.AddrOverlap = source.AddrOverlap
+ self.padding = source.padding
+
+ # private members
+ self._fname = source._fname
+ self._buf = source._buf
+ self._readed = source._readed
+ self._eof = source._eof
+ self._offset = source._offset
+ else:
+ IntelHex.__init__(self, source)
+
+ if self.padding == 0x0FF:
+ self.padding = 0x0FFFF
+
+ def __getitem__(self, addr16):
+ """Get 16-bit word from address.
+ Raise error if found only one byte from pair.
+
+ @param addr16 address of word (addr8 = 2 * addr16).
+ @return word if bytes exists in HEX file, or self.padding
+ if no data found.
+ """
+ addr1 = addr16 * 2
+ addr2 = addr1 + 1
+ byte1 = self._buf.get(addr1, None)
+ byte2 = self._buf.get(addr2, None)
+
+ if byte1 != None and byte2 != None:
+ return byte1 | (byte2 << 8) # low endian
+
+ if byte1 == None and byte2 == None:
+ return self.padding
+
+ raise Exception, 'Bad access in 16-bit mode (not enough data)'
+
+ def __setitem__(self, addr16, word):
+ addr_byte = addr16 * 2
+ bytes = divmod(word, 256)
+ self._buf[addr_byte] = bytes[1]
+ self._buf[addr_byte+1] = bytes[0]
+
+ def minaddr(self):
+ '''Get minimal address of HEX content in 16-bit mode.'''
+ aa = self._buf.keys()
+ if aa == []:
+ return 0
+ else:
+ return min(aa)/2
+
+ def maxaddr(self):
+ '''Get maximal address of HEX content in 16-bit mode.'''
+ aa = self._buf.keys()
+ if aa == []:
+ return 0
+ else:
+ return max(aa)/2
+
+#/class IntelHex16bit
+
+
+def hex2bin(fin, fout, start=None, end=None, size=None, pad=0xFF):
+ """Hex-to-Bin convertor engine.
+ @return 0 if all OK
+
+ @param fin input hex file (filename or file-like object)
+ @param fout output bin file (filename or file-like object)
+ @param start start of address range (optional)
+ @param end end of address range (optional)
+ @param size size of resulting file (in bytes) (optional)
+ @param pad padding byte (optional)
+ """
+ h = IntelHex(fin)
+ if not h.readfile():
+ print "Bad HEX file"
+ return 1
+
+ # start, end, size
+ if size != None and size != 0:
+ if end == None:
+ if start == None:
+ start = h.minaddr()
+ end = start + size - 1
+ else:
+ if (end+1) >= size:
+ start = end + 1 - size
+ else:
+ start = 0
+
+ try:
+ h.tobinfile(fout, start, end, pad)
+ except IOError:
+ print "Could not write to file: %s" % fout
+ return 1
+
+ return 0
+#/def hex2bin
+
+
+if __name__ == '__main__':
+ import getopt
+ import os
+ import sys
+
+ usage = '''Hex2Bin python converting utility.
+Usage:
+ python intelhex.py [options] file.hex [out.bin]
+
+Arguments:
+ file.hex name of hex file to processing.
+ out.bin name of output file.
+ If omitted then output write to file.bin.
+
+Options:
+ -h, --help this help message.
+ -p, --pad=FF pad byte for empty spaces (ascii hex value).
+ -r, --range=START:END specify address range for writing output
+ (ascii hex value).
+ Range can be in form 'START:' or ':END'.
+ -l, --length=NNNN,
+ -s, --size=NNNN size of output (decimal value).
+'''
+
+ pad = 0xFF
+ start = None
+ end = None
+ size = None
+
+ try:
+ opts, args = getopt.getopt(sys.argv[1:], "hp:r:l:s:",
+ ["help", "pad=", "range=",
+ "length=", "size="])
+
+ for o, a in opts:
+ if o in ("-h", "--help"):
+ print usage
+ sys.exit(0)
+ elif o in ("-p", "--pad"):
+ try:
+ pad = int(a, 16) & 0x0FF
+ except:
+ raise getopt.GetoptError, 'Bad pad value'
+ elif o in ("-r", "--range"):
+ try:
+ l = a.split(":")
+ if l[0] != '':
+ start = int(l[0], 16)
+ if l[1] != '':
+ end = int(l[1], 16)
+ except:
+ raise getopt.GetoptError, 'Bad range value(s)'
+ elif o in ("-l", "--lenght", "-s", "--size"):
+ try:
+ size = int(a, 10)
+ except:
+ raise getopt.GetoptError, 'Bad size value'
+
+ if start != None and end != None and size != None:
+ raise getopt.GetoptError, 'Cannot specify START:END and SIZE simultaneously'
+
+ if not args:
+ raise getopt.GetoptError, 'Hex file is not specified'
+
+ if len(args) > 2:
+ raise getopt.GetoptError, 'Too many arguments'
+
+ except getopt.GetoptError, msg:
+ print msg
+ print usage
+ sys.exit(2)
+
+ fin = args[0]
+ if len(args) == 1:
+ import os.path
+ name, ext = os.path.splitext(fin)
+ fout = name + ".bin"
+ else:
+ fout = args[1]
+
+ if not os.path.isfile(fin):
+ print "File not found"
+ sys.exit(1)
+
+ sys.exit(hex2bin(fin, fout, start, end, size, pad))
diff --git a/docs/j1demo/firmware/invaders.fs b/docs/j1demo/firmware/invaders.fs
new file mode 100644
index 0000000..f501a3e
--- /dev/null
+++ b/docs/j1demo/firmware/invaders.fs
@@ -0,0 +1,362 @@
+( Space invaders JCB 10:43 11/18/10)
+
+: whereis ( t -- x y )
+ >r
+ d# 384 r@ sin* d# 384 +
+ r@ d# 4 rshift d# 32 r> 2* sin* +
+;
+
+56 constant nsprites
+
+nsprites array invx
+nsprites array invy
+nsprites array alive
+nsprites array invnext
+nsprites array anim
+
+: invload ( i -- ) \ load sprite i
+ \ s" sprite " type dup . s" at " type dup invx @ . dup invy @ . cr
+ dup invx @ swap
+ dup invy @ swap
+ dup anim @ swap
+ d# 7 and
+ tuck cells vga_spritep + !
+ sprite!
+;
+
+: inv-makedl ( -- )
+ erasedl
+ nsprites 0do
+ \ invy -ve load sprite; +ve gives the dl offset
+ i alive @ if
+ i invy @ dup 0< if
+ drop i invload
+ else
+ dup d# 512 < if
+ \ dl[y] -> invnext[i]
+ \ i -> dl[y]
+ cells dl + dup
+ @ i invnext !
+ i swap !
+ else
+ drop
+ then
+ then
+ then
+ loop
+;
+
+: inv-chase
+ d# 512 0do
+ begin vga-line@ i = until
+ \ s" line" type i . cr
+ i cells dl + @
+ begin
+ dup d# 0 >=
+ while
+ dup invload
+ invnext @
+ repeat
+ loop
+;
+
+: born ( x y i ) \ sprite i born
+ dup alive on
+ tuck invy !
+ invx !
+;
+
+: kill ( i -- ) \ kill sprite i
+ d# 512 over invy !
+ alive off
+;
+
+: isalien ( u -- f)
+ d# 6 and d# 6 <> ;
+
+: moveto ( i -- ) \ move invader i to current position
+ dup d# 6 and d# 6 <>
+ over alive @ and if
+ >r
+ frame @ r@ d# 7 and d# 8 * + whereis
+ r@ d# 3 rshift d# 40 * +
+ r@ invy !
+ r> invx !
+ else
+ drop
+ then
+;
+
+: bomb ( u -- u ) d# 3 lshift d# 6 + ;
+: shot ( u -- u ) d# 3 lshift d# 7 + ;
+
+8 array lowest
+
+: findlowest
+ d# 8 0do d# -1 i lowest ! loop
+ d# 48 0do
+ i alive @ if
+ i dup d# 7 and lowest !
+ then
+ loop
+;
+
+create bias 0 , 1 , 2 , 3 , 4 , 5 , 0 , 5 ,
+: rand6
+ time @ d# 7 and cells bias + @
+;
+
+2variable bombalarm
+variable nextbomb
+
+2variable shotalarm
+variable nextshot
+
+variable playerx
+variable lives
+2variable score
+variable dying
+
+32 constant girth
+
+: 1+mod6 ( a )
+ dup @ dup d# 5 = if d# -5 else d# 1 then + swap ! ;
+
+: .status
+ 'emit @ >r ['] vga-emit 'emit !
+
+ home
+ s" LIVES " type lives @ .
+ d# 38 d# 0 vga-at-xy
+ s" SCORE " type score 2@ <# # # # # # # #> type
+ cr
+
+ lives @ 0= if
+ ['] vga-bigemit 'emit !
+ d# 8 d# 7 vga-at-xy s" GAME" type
+ d# 8 d# 17 vga-at-xy s" OVER" type
+ then
+
+ r> 'emit !
+;
+
+: newlife
+ d# -1 lives +! .status
+ d# 0 dying !
+ d# 100 playerx !
+;
+
+: parabolic ( dx dy i -- ) \ move sprite i in parabolic path
+ >r
+ swap r@ invx +!
+ dying @ d# 3 rshift +
+ r> invy +!
+;
+
+: exploding
+ d# 3 d# -4 d# 48 parabolic
+ d# -3 d# -4 d# 49 parabolic
+ d# -4 d# -3 d# 50 parabolic
+ d# 4 d# -3 d# 51 parabolic
+ d# -5 d# -2 d# 52 parabolic
+ d# 5 d# -2 d# 53 parabolic
+ d# 1 d# -2 d# 55 parabolic
+;
+
+: @xy ( i -- x y )
+ dup invx @ swap invy @ ;
+
+: dist ( u1 u2 )
+ invert + dup 0< xor ;
+
+: fall
+ d# 6 0do
+ i bomb
+ d# 4 over invy +!
+ @xy d# 470 dist d# 16 < swap
+ playerx @ dist girth < and
+ dying @ 0= and if
+ d# 1 dying !
+ then
+ loop
+;
+
+: trigger \ if shotalarm expired, launch new shot
+ shotalarm isalarm if
+ d# 400000. shotalarm setalarm
+ playerx @ d# 480
+ nextshot @ shot born
+ nextshot 1+mod6
+ then
+;
+
+: collide ( x y -- u )
+ d# 48 0do
+ i isalien i alive @ and if
+ over i invx @ dist d# 16 <
+ over i invy @ dist d# 16 < and if
+ 2drop i unloop exit
+ then
+ then
+ loop
+ 2drop
+ d# -1
+;
+
+: rise
+ d# 6 0do
+ i shot >r r@ alive @ if
+ d# -5 r@ invy +!
+ r@ invy @ d# -30 < if r@ kill then
+ r@ @xy collide dup 0< if
+ drop
+ else
+ kill r@ kill
+ d# 10. score 2@ d+ score 2!
+ .status
+ then
+ then
+ r> drop
+ loop
+;
+
+: doplayer
+ lives @ if
+ dying @ 0= if
+ buttons >r
+
+ girth 2/ playerx @ <
+ r@ pb2 and and if
+ d# -4 playerx +!
+ then
+
+ playerx @ d# 800 girth 2/ - <
+ r@ pb3 and and if
+ d# 4 playerx +!
+ then
+
+ r> pb4 and if
+ trigger
+ \ else trigger
+ then
+
+ d# 6 0do
+ frame @ d# 3 lshift i d# 42 * +
+ girth swap sin* playerx @ +
+ d# 480
+ i d# 48 +
+ dup anim on
+ born
+ loop
+ playerx @ d# 470 d# 55 born
+ else
+ exploding
+ d# 1 dying +!
+ dying @ d# 100 > if
+ newlife
+ then
+ then
+ then
+;
+
+create cscheme
+ h# 400 ,
+ h# 440 ,
+ h# 040 ,
+ h# 044 ,
+ h# 004 ,
+ h# 404 ,
+ h# 340 ,
+ h# 444 ,
+
+: invaders-cold
+ vga-page
+ d# 16384 0do
+ h# 208000. 2/ i s>d d+ flash@
+ i vga_spritea ! vga_spriteport !
+ loop
+
+ vga_addsprites on
+ rainbow
+
+ \ vga_spritep d# 6 cells + on
+
+ \ everything dead
+ nsprites 0do
+ i kill
+ loop
+
+ \ all aliens alive
+ d# 48 0do
+ i isalien i alive !
+ loop
+
+ d# 500000. bombalarm setalarm
+ d# 0 nextbomb !
+ d# 100000. shotalarm setalarm
+ d# 0 nextshot !
+ d# 4 lives !
+ d# 0. score 2!
+
+ newlife
+
+ time@ xor seed !
+ d# 0 frame !
+ d# 48 0do i moveto loop
+;
+
+0 [IF]
+: escape
+ vision isalarm next? or ;
+: restart
+ vision isalarm sw2_n @ 0= or ;
+[ELSE]
+: escape
+ next? ;
+: restart
+ sw2_n @ 0= ;
+[THEN]
+
+: gameloop
+ invaders-cold
+ begin
+depth if snap then
+ inv-makedl
+depth if snap then
+ inv-chase
+depth if snap then
+ frame @ 1+ frame !
+ d# 48 0do i moveto loop
+ findlowest
+ bombalarm isalarm if
+ d# 800000. bombalarm setalarm
+ rand6 lowest @ dup 0< if
+ drop
+ else
+ dup invx @ swap invy @
+ dup d# 460 > if d# 1 dying ! then
+ nextbomb @ bomb born
+ nextbomb 1+mod6
+ then
+ then
+depth if snap then
+ fall
+depth if snap then
+ rise
+depth if snap then
+ doplayer
+depth if snap then
+ escape if exit then
+ again
+;
+
+: invaders-main
+ invaders-cold
+ d# 9000000. vision setalarm
+
+ gameloop
+ snap
+
+ frame @ . s" frames" type cr
+;
+
diff --git a/docs/j1demo/firmware/ip.fs b/docs/j1demo/firmware/ip.fs
new file mode 100644
index 0000000..7c66137
--- /dev/null
+++ b/docs/j1demo/firmware/ip.fs
@@ -0,0 +1,124 @@
+( IP networking: headers and wrapup JCB 13:21 08/24/10)
+module[ ip"
+
+: ip-datalength ( -- u ) \ length of current IP packet in words
+ ETH.IP.LENGTH packet@
+ d# 20 - 2/
+;
+
+: ip-isproto ( u -- f ) \ true if packet PROTO is u
+ ETH.IP.TTLPROTO packet@ h# ff and =
+;
+
+: ip-identification
+ ip-id-counter d# 1 over +! @
+;
+
+: @ethaddr ( eth-addr -- mac01 mac23 mac45 )
+ ?dup
+ if
+ dup @ swap 2+ 2@
+ else
+ ethaddr-broadcast
+ then
+;
+
+: ip-header ( dst-ip src-ip eth-addr protocol -- )
+ >r
+ mac-pkt-begin
+
+ @ethaddr mac-pkt-3,
+ net-my-mac mac-pkt-3,
+ h# 800 mac-pkt-,
+
+ h# 4500
+ h# 0000 \ length
+ ip-identification
+ mac-pkt-3,
+ h# 4000 \ do not fragment
+ h# 4000 r> or \ TTL, protocol
+ d# 0 \ checksum
+ mac-pkt-3,
+ mac-pkt-2, \ src ip
+ mac-pkt-2, \ dst ip
+;
+
+: ip-wrapup ( bytelen -- )
+ \ write IP length
+ ETH.IP -
+ ETH.IP.LENGTH packetout-off mac!
+
+ \ write IP checksum
+ ETH.IP packetout-off d# 10 mac-checksum
+ ETH.IP.CHKSUM packetout-off mac!
+;
+
+: ip-packet-srcip
+ d# 2 ETH.IP.SRCIP mac-inoffset mac@n
+;
+
+( ICMP return and originate JCB 13:22 08/24/10)
+
+\ Someone pings us, generate a return packet
+
+: icmp-handler
+ IP_PROTO_ICMP ip-isproto
+ ETH.IP.ICMP.TYPECODE packet@ h# 800 =
+ and if
+ ip-packet-srcip
+ 2dup arp-lookup
+ ?dup if
+ \ transmit ICMP reply
+ \ dstip *ethaddr
+ net-my-ip rot \ dstip srcip *ethaddr
+ d# 1 ip-header
+
+ \ Now the ICMP header
+ d# 0 mac-pkt-,
+
+ s" =====> ICMP seq " type
+ ETH.IP.ICMP.SEQUENCE mac-inoffset mac@ u. cr
+
+ ETH.IP.ICMP.IDENTIFIER mac-inoffset
+ ip-datalength 2- ( offset n )
+ tuck
+ mac-checksum mac-pkt-,
+ ETH.IP.ICMP.IDENTIFIER mac-pkt-src
+
+ mac-pkt-complete
+ ip-wrapup
+ mac-send
+ else
+ 2drop
+ then
+ then
+;
+
+: ping ( ip. -- ) \ originate
+ 2dup arp-lookup
+ ?dup if
+ \ transmit ICMP request
+ \ dstip *ethaddr
+ net-my-ip rot \ dstip srcip *ethaddr
+ d# 1 ip-header
+
+ \ Now the ICMP header
+ h# 800 mac-pkt-,
+
+ \ id is h# 550b, seq is lo word of time
+ h# 550b time@ drop
+ 2dup +1c h# 800 +1c
+ d# 28 begin swap d# 0 +1c swap 1- dup 0= until drop
+ invert mac-pkt-, \ checksum
+ mac-pkt-2,
+ d# 28 mac-pkt-,0
+
+ mac-pkt-complete
+ ip-wrapup
+ mac-send
+ else
+ 2drop
+ then
+;
+
+]module
diff --git a/docs/j1demo/firmware/ip0.fs b/docs/j1demo/firmware/ip0.fs
new file mode 100644
index 0000000..1631d5f
--- /dev/null
+++ b/docs/j1demo/firmware/ip0.fs
@@ -0,0 +1,70 @@
+( Variables for IP networking JCB 13:21 08/24/10)
+
+module[ ip0"
+create ip-id-counter d# 2 allot
+create ip-addr d# 4 allot
+create ip-router d# 4 allot
+create ip-subnetmask d# 4 allot
+create ip-dns d# 4 allot
+create icmp-alarm-ptr d# 1 allot
+
+: ethaddr-broadcast
+ h# ffff dup dup
+;
+
+: net-my-ip
+ ip-addr 2@
+;
+
+: ethaddr-pretty-w
+ dup endian hex2
+ [char] : emit
+ hex2
+;
+
+: ethaddr-pretty
+ swap rot
+ ethaddr-pretty-w [char] : emit
+ ethaddr-pretty-w [char] : emit
+ ethaddr-pretty-w
+;
+
+: ip-pretty-byte
+ h# ff and
+ \ d# 0 u.r
+ hex2
+;
+
+: ip-pretty-2
+ dup swab ip-pretty-byte [char] . emit ip-pretty-byte
+;
+
+: ip-pretty
+ swap
+ ip-pretty-2 [char] . emit
+ ip-pretty-2
+;
+
+( IP address literals JCB 14:30 10/26/10)
+
+================================================================
+
+It is neat to write IP address literals e.g.
+ip# 192.168.0.1
+
+================================================================
+
+meta
+
+: octet# ( c -- u ) 0. rot parse >number throw 2drop ;
+
+: ip#
+ [char] . octet# 8 lshift
+ [char] . octet# or do-number
+ [char] . octet# 8 lshift
+ bl octet# or do-number
+;
+
+target
+
+]module
diff --git a/docs/j1demo/firmware/j1.png b/docs/j1demo/firmware/j1.png
new file mode 100644
index 0000000..552f8d3
--- /dev/null
+++ b/docs/j1demo/firmware/j1.png
Binary files differ
diff --git a/docs/j1demo/firmware/keycodes.fs b/docs/j1demo/firmware/keycodes.fs
new file mode 100644
index 0000000..bd9b814
--- /dev/null
+++ b/docs/j1demo/firmware/keycodes.fs
@@ -0,0 +1,28 @@
+9 constant TAB
+10 constant ENTER
+27 constant ESC
+
+h# 80 constant KDEL
+
+h# 81 constant KF1
+h# 82 constant KF2
+h# 83 constant KF3
+h# 84 constant KF4
+h# 85 constant KF5
+h# 86 constant KF6
+h# 87 constant KF7
+h# 88 constant KF8
+h# 89 constant KF9
+h# 8a constant KF10
+h# 8b constant KF11
+h# 8c constant KF12
+
+h# 90 constant KHOME
+h# 91 constant KPGUP
+h# 92 constant KPGDN
+h# 93 constant KEND
+h# 94 constant KLEFT
+h# 95 constant KRIGHT
+h# 96 constant KUP
+h# 97 constant KDOWN
+h# 98 constant KINS
diff --git a/docs/j1demo/firmware/loader.fs b/docs/j1demo/firmware/loader.fs
new file mode 100644
index 0000000..d4ae725
--- /dev/null
+++ b/docs/j1demo/firmware/loader.fs
@@ -0,0 +1,114 @@
+( LOADER PROTOCOL JCB 09:16 11/11/10)
+
+947 constant PORT
+
+: response0 ( -- )
+ ETH.IP.UDP.SOURCEPORT packet@
+ PORT
+ d# 2 ETH.IP.SRCIP mac-inoffset mac@n
+ net-my-ip
+ 2over arp-lookup
+ ( dst-port src-port dst-ip src-ip *ethaddr )
+ udp-header
+ d# 0 mac-pkt-,
+ ETH.IP.UDP.LOADER.SEQNO packet@ mac-pkt-,
+;
+
+: response1
+ udp-wrapup mac-send
+;
+
+: respond
+ response0
+ response1
+;
+
+: ramread
+ response0
+ ETH.IP.UDP.LOADER.RAMREAD.ADDR packet@
+ d# 128 bounds begin
+ dup @ mac-pkt-,
+ cell+
+ 2dup=
+ until
+ 2drop
+ response1
+;
+
+: ramwrite
+ ETH.IP.UDP.LOADER.RAMWRITE.ADDR packet@
+ d# 64 0do
+ ETH.IP.UDP.LOADER.RAMWRITE.DATA i cells + packet@
+ over !
+ cell+
+ loop
+ drop
+ respond
+;
+
+: reboot
+ respond bootloader ;
+
+: flashread
+ response0
+ ETH.IP.UDP.LOADER.FLASHREAD.ADDR packetd@ d2/
+ flash-reset
+ d# 64 0do
+ 2dup flash@
+ mac-pkt-,
+ d1+
+ loop
+ 2drop
+ response1
+;
+
+: flasherase
+ respond flash-chiperase ;
+
+: flashdone
+ response0
+ ETH.IP.UDP.LOADER.FLASHREAD.ADDR packetd@ d2/
+ flash-erased mac-pkt-,
+ response1
+;
+
+: flashwrite
+ ETH.IP.UDP.LOADER.FLASHWRITE.ADDR packetd@ d2/
+ d# 64 0do
+ 2dup
+ ETH.IP.UDP.LOADER.FLASHWRITE.DATA i cells + packet@
+ -rot flash!
+ d1+
+ loop
+ 2drop
+ respond
+;
+
+: flashsectorerase
+ ETH.IP.UDP.LOADER.FLASHWRITE.ADDR packetd@ d2/
+ flash-sectorerase
+ respond
+;
+
+jumptable opcodes
+( 0 ) | ramread
+( 1 ) | ramwrite
+( 2 ) | reboot
+( 3 ) | flashread
+( 4 ) | flasherase
+( 5 ) | flashdone
+( 6 ) | flashwrite
+( 7 ) | flashsectorerase
+
+: loader-handler ( -- )
+ IP_PROTO_UDP ip-isproto if
+ ETH.IP.UDP.DESTPORT packet@ PORT =
+ d# 2 ETH.IP.SRCIP mac-inoffset mac@n arp-lookup 0<> and if
+ udp-checksum? if
+ ETH.IP.UDP.LOADER.OPCODE packet@
+ \ s" loader opcode=" type dup hex4 cr
+ opcodes execute
+ then
+ then
+ then
+;
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
diff --git a/docs/j1demo/firmware/mkblob.py b/docs/j1demo/firmware/mkblob.py
new file mode 100644
index 0000000..6623f91
--- /dev/null
+++ b/docs/j1demo/firmware/mkblob.py
@@ -0,0 +1,14 @@
+import Image
+import math
+
+im = Image.new("L", (32,32))
+radius = 16
+for i in range(32):
+ for j in range(32):
+ x = abs(i - 16)
+ y = abs(j - 16)
+ d = math.sqrt(x * x + y * y)
+ if d < radius:
+ t = 1.0 - (d / radius)
+ im.putpixel((i, j), int(255 * (t * t)))
+im.save("blob.png")
diff --git a/docs/j1demo/firmware/ntp.fs b/docs/j1demo/firmware/ntp.fs
new file mode 100644
index 0000000..881296a
--- /dev/null
+++ b/docs/j1demo/firmware/ntp.fs
@@ -0,0 +1,36 @@
+( NTP JCB 09:54 11/17/10)
+
+: ntp-server
+ \ h# 02830a00.
+ \ ip# 91.189.94.4 \ time.ubuntu
+ ip# 17.151.16.20 \ time.apple.com
+;
+
+: ntp-request
+ d# 123 d# 9999
+ ntp-server
+ net-my-ip
+ 2over arp-lookup
+ ( dst-port src-port dst-ip src-ip *ethaddr )
+ udp-header
+ h# 2304 mac-pkt-, h# 04ec mac-pkt-,
+ d# 6 mac-pkt-,0
+
+ d# 4 mac-pkt-,0 \ originate
+ d# 4 mac-pkt-,0 \ reference
+ d# 4 mac-pkt-,0 \ receive
+ \ d# 4 mac-pkt-,0 \ transmit
+ time@ mac-pkt-d, d# 2 mac-pkt-,0
+ udp-wrapup mac-send
+;
+
+: ntp-handler
+ IP_PROTO_UDP ip-isproto
+ ETH.IP.UDP.SOURCEPORT packet@ d# 123 = and
+ ETH.IP.UDP.DESTPORT packet@ d# 9999 = and
+ if
+ ETH.IP.UDP.NTP.TRANSMIT packetd@ setdate
+ time@ ETH.IP.UDP.NTP.ORIGINATE packetd@ d- setdelay
+ then
+;
+
diff --git a/docs/j1demo/firmware/nuc.fs b/docs/j1demo/firmware/nuc.fs
new file mode 100644
index 0000000..deadcc7
--- /dev/null
+++ b/docs/j1demo/firmware/nuc.fs
@@ -0,0 +1,546 @@
+( Nucleus: ANS Forth core and ext words JCB 13:11 08/24/10)
+
+module[ nuc"
+
+32 constant sp
+0 constant false ( 6.2.1485 )
+: depth dsp h# ff and ;
+: true ( 6.2.2298 ) d# -1 ;
+: 1+ d# 1 + ;
+: rot >r swap r> swap ;
+: -rot swap >r swap r> ;
+: 0= d# 0 = ;
+: tuck swap over ;
+: 2drop drop drop ;
+: ?dup dup if dup then ;
+
+: split ( a m -- a&m a&~m )
+ over \ a m a
+ and \ a a&m
+ tuck \ a&m a a&m
+ xor \ a&m a&~m
+;
+
+: merge ( a b m -- m?b:a )
+ >r \ a b
+ over xor \ a a^b
+ r> and \ a (a^b)&m
+ xor \ ((a^b)&m)^a
+;
+
+: c@ dup @ swap d# 1 and if d# 8 rshift else d# 255 and then ;
+: c! ( u c-addr )
+ swap h# ff and dup d# 8 lshift or swap
+ tuck dup @ swap ( c-addr u v c-addr )
+ d# 1 and d# 0 = h# ff xor
+ merge swap !
+;
+: c!be d# 1 xor c! ;
+
+: looptest ( -- FIN )
+ r> ( xt )
+ r> ( xt i )
+ 1+
+ r@ over = ( xt i FIN )
+ dup if
+ nip r> drop
+ else
+ swap >r
+ then ( xt FIN )
+ swap
+ >r
+;
+
+\ Stack
+: 2dup over over ;
+: +! tuck @ + swap ! ;
+
+\ Comparisons
+: <> = invert ;
+: 0<> 0= invert ;
+: 0< d# 0 < ;
+: 0>= 0< invert ;
+: 0> d# 0 ;fallthru
+: > swap < ;
+: >= < invert ;
+: <= > invert ;
+: u> swap u< ;
+
+\ Arithmetic
+: negate invert 1+ ;
+: - negate + ;
+: abs dup 0< if negate then ;
+: min 2dup < ;fallthru
+: ?: ( xt xf f -- xt | xf) if drop else nip then ;
+: max 2dup > ?: ;
+code cells end-code
+code addrcells end-code
+: 2* d# 1 lshift ;
+code cell+ end-code
+code addrcell+ end-code
+: 2+ d# 2 + ;
+: 2- 1- 1- ;
+: 2/ d# 1 rshift ;
+: c+! tuck c@ + swap c! ;
+
+: count dup 1+ swap c@ ;
+: /string dup >r - swap r> + swap ;
+: aligned 1+ h# fffe and ;
+
+: sliteral
+ r>
+ count
+ 2dup
+ +
+ aligned
+;fallthru
+: execute >r ;
+
+: 15down down1 ;fallthru
+: 14down down1 ;fallthru
+: 13down down1 ;fallthru
+: 12down down1 ;fallthru
+: 11down down1 ;fallthru
+: 10down down1 ;fallthru
+: 9down down1 ;fallthru
+: 8down down1 ;fallthru
+: 7down down1 ;fallthru
+: 6down down1 ;fallthru
+: 5down down1 ;fallthru
+: 4down down1 ;fallthru
+: 3down down1 ;fallthru
+: 2down down1 ;fallthru
+: 1down down1 ;fallthru
+: 0down copy ;
+
+: 15up up1 ;fallthru
+: 14up up1 ;fallthru
+: 13up up1 ;fallthru
+: 12up up1 ;fallthru
+: 11up up1 ;fallthru
+: 10up up1 ;fallthru
+: 9up up1 ;fallthru
+: 8up up1 ;fallthru
+: 7up up1 ;fallthru
+: 6up up1 ;fallthru
+: 5up up1 ;fallthru
+: 4up up1 ;fallthru
+: 3up up1 ;fallthru
+: 2up up1 ;fallthru
+: 1up up1 ;fallthru
+: 0up ;
+
+code pickbody
+ copy return
+ 1down scall 1up ubranch
+ 2down scall 2up ubranch
+ 3down scall 3up ubranch
+ 4down scall 4up ubranch
+ 5down scall 5up ubranch
+ 6down scall 6up ubranch
+ 7down scall 7up ubranch
+ 8down scall 8up ubranch
+ 9down scall 9up ubranch
+ 10down scall 10up ubranch
+ 11down scall 11up ubranch
+ 12down scall 12up ubranch
+ 13down scall 13up ubranch
+ 14down scall 14up ubranch
+ 15down scall 15up ubranch
+end-code
+
+: pick
+ dup 2* 2* ['] pickbody + execute ;
+
+: swapdown
+ ]asm
+ N T->N alu
+ T d-1 alu
+ asm[
+;
+: swapdowns
+ swapdown swapdown swapdown swapdown
+ swapdown swapdown swapdown swapdown
+ swapdown swapdown swapdown swapdown
+ swapdown swapdown swapdown swapdown ;fallthru
+: swapdown0 ;
+: roll
+ 2*
+ ['] 0up over - >r
+ ['] swapdown0 swap - execute
+;
+
+\ ========================================================================
+\ Double
+\ ========================================================================
+
+: d= ( a b c d -- f )
+ >r \ a b c
+ rot xor \ b a^c
+ swap r> xor \ a^c b^d
+ or 0=
+;
+
+: 2@ ( ptr -- lo hi )
+ dup @ swap 2+ @
+;
+
+: 2! ( lo hi ptr -- )
+ rot over \ hi ptr lo ptr
+ ! 2+ !
+;
+
+: 2over >r >r 2dup r> r> ;fallthru
+: 2swap rot >r rot r> ;
+: 2nip rot drop rot drop ;
+: 2rot ( d1 d2 d3 -- d2 d3 d1 ) 2>r 2swap 2r> 2swap ;
+: 2pick
+ 2* 1+ dup 1+ \ lo hi ... 2k+1 2k+2
+ pick \ lo hi ... 2k+1 lo
+ swap \ lo hi ... lo 2k+1
+ pick \ lo hi ... lo hi
+;
+
+
+: d+ ( augend . addend . -- sum . )
+ rot + >r ( augend addend)
+ over + ( augend sum)
+ dup rot ( sum sum augend)
+ u< if ( sum)
+ r> 1+
+ else
+ r>
+ then ( sum . )
+;
+
+: +h ( u1 u2 -- u1+u2/2**16 )
+ over + ( a a+b )
+ u> d# 1 and
+;
+
+: +1c \ one's complement add, as in TCP checksum
+ 2dup +h + +
+;
+
+: s>d dup 0< ;
+: d1+ d# 1. d+ ;
+: dnegate
+ invert swap invert swap
+ d1+
+;
+: DABS ( d -- ud ) ( 8.6.1.1160 ) DUP 0< IF DNEGATE THEN ;
+
+: d- dnegate d+ ;
+
+\ Write zero to double
+: dz d# 0 dup rot 2! ;
+
+: dxor \ ( a b c d -- e f )
+ rot xor \ a c b^d
+ -rot xor \ b^d a^c
+ swap
+;
+
+: dand rot and -rot and swap ;
+: dor rot or -rot or swap ;
+
+: dinvert invert swap invert swap ;
+: d< \ ( al ah bl bh -- flag )
+ rot \ al bl bh ah
+ 2dup =
+ if
+ 2drop u<
+ else
+ 2nip >
+ then
+;
+
+: d> 2swap d< ;
+: d0<= d# 0. ;fallthru
+: d<= d> invert ;
+: d>= d< invert ;
+: d0= or 0= ;
+: d0< d# 0. d< ;
+: d0<> d0= invert ;
+: d<> d= invert ;
+: d2* 2dup d+ ;
+: d2/ dup d# 15 lshift >r 2/ swap 2/ r> or swap ;
+: dmax 2over 2over d< if 2swap then 2drop ;
+
+: d1- d# -1. d+ ;
+
+: d+! ( v. addr -- )
+ dup >r
+ 2@
+ d+
+ r>
+ 2!
+;
+
+: move ( addr1 addr2 u -- )
+ d# 0 do
+ over @ over !
+ 2+ swap 2+ swap
+ loop
+ 2drop
+;
+
+: cmove ( c-addr1 c-addr2 u -- )
+ d# 0 do
+ over c@ over c!
+ 1+ swap 1+ swap
+ loop
+ 2drop
+;
+
+: bounds ( a n -- a+n a ) OVER + SWAP ;
+: fill ( c-addr u char -- ) ( 6.1.1540 )
+ >R bounds
+ BEGIN 2dupxor
+ WHILE R@ OVER C! 1+
+ REPEAT R> DROP 2DROP ;
+
+\ Math
+
+0 [IF]
+create scratch d# 2 allot
+: um* ( u1 u2 -- ud )
+ scratch !
+ d# 0.
+ d# 16 0do
+ 2dup d+
+ rot dup 0< if
+ 2* -rot
+ scratch @ d# 0 d+
+ else
+ 2* -rot
+ then
+ loop
+ rot drop
+;
+[ELSE]
+: um* mult_a ! mult_b ! mult_p 2@ ;
+[THEN]
+
+: * um* drop ;
+: abssgn ( a b -- |a| |b| negf )
+ 2dup xor 0< >r abs swap abs swap r> ;
+
+: m* abssgn >r um* r> if dnegate then ;
+
+: divstep
+ ( divisor dq hi )
+ 2*
+ over 0< if 1+ then
+ swap 2* swap
+ rot ( dq hi divisor )
+ 2dup >= if
+ tuck ( dq divisor hi divisor )
+ -
+ swap ( dq hi divisor )
+ rot 1+ ( hi divisor dq )
+ rot ( divisor dq hi )
+ else
+ -rot
+ then
+ ;
+
+: um/mod ( ud u1 -- u2 u3 ) ( 6.1.2370 )
+ -rot
+ divstep divstep divstep divstep
+ divstep divstep divstep divstep
+ divstep divstep divstep divstep
+ divstep divstep divstep divstep
+ rot drop swap
+;
+
+: /mod >R S>D R> ;fallthru
+: SM/REM ( d n -- r q ) ( 6.1.2214 ) ( symmetric )
+ OVER >R >R DABS R@ ABS UM/MOD
+ R> R@ XOR 0< IF NEGATE THEN R> 0< IF >R NEGATE R> THEN ;
+: / /mod nip ;
+: mod /mod drop ;
+: */mod >R M* R> SM/REM ;
+: */ */mod nip ;
+
+: t2* over >r >r d2*
+ r> 2* r> 0< d# 1 and + ;
+
+variable divisor
+: m*/mod
+ divisor !
+ tuck um* 2swap um* ( hi. lo. )
+ ( m0 h l m1 )
+ swap >r d# 0 d+ r> ( m h l )
+ -rot ( l m h )
+ d# 32 0do
+ t2*
+ dup divisor @ >= if
+ divisor @ -
+ rot 1+ -rot
+ then
+ loop
+;
+: m*/ m*/mod drop ;
+
+
+\ Numeric output - from eforth
+
+variable base
+variable hld
+create pad 84 allot create pad|
+
+: <# ( -- ) ( 6.1.0490 )( h# 96 ) pad| HLD ! ;
+: DIGIT ( u -- c ) d# 9 OVER < d# 7 AND + [CHAR] 0 + ;
+: HOLD ( c -- ) ( 6.1.1670 ) HLD @ 1- DUP HLD ! C! ;
+
+: # ( d -- d ) ( 6.1.0030 )
+ d# 0 BASE @ UM/MOD >R BASE @ UM/MOD SWAP DIGIT HOLD R> ;
+
+: #S ( d -- d ) ( 6.1.0050 ) BEGIN # 2DUP OR 0= UNTIL ;
+: #> ( d -- a u ) ( 6.1.0040 ) 2DROP HLD @ pad| OVER - ;
+
+: SIGN ( n -- ) ( 6.1.2210 ) 0< IF [CHAR] - HOLD THEN ;
+
+\ hex(int((1<<24) * (115200 / 2400.) / (WB_CLOCK_FREQ / 2400.)))
+\ d# 42000000 constant WB_CLOCK_FREQ
+
+[ 48000000 17 12 */ ] constant WB_CLOCK_FREQ
+
+0 [IF]
+: uartbase
+ [ $100000000. 115200 WB_CLOCK_FREQ m*/ drop $ffffff00 and dup swap 16 rshift ] 2literal
+;
+: emit-uart
+ begin uart_0 @ 0= until
+ s>d
+ uartbase dor
+ uart_1 ! uart_0 !
+;
+[ELSE]
+: emit-uart drop ;
+[THEN]
+
+create 'emit
+meta emit-uart t, target
+
+: emit 'emit @ execute ;
+: cr d# 13 emit d# 10 emit ;
+d# 32 constant bl
+: space bl emit ;
+: spaces begin dup 0> while space 1- repeat drop ;
+
+: hex1 d# 15 and dup d# 10 < if d# 48 else d# 55 then + emit ;
+: hex2
+ dup
+ d# 4 rshift
+ hex1 hex1
+;
+: hex4
+ dup
+ d# 8 rshift
+ hex2 hex2 ;
+
+: hex8 hex4 hex4 ;
+
+: type
+ d# 0 do
+ dup c@ emit
+ 1+
+ loop
+ drop
+;
+
+: dump
+ ( addr u )
+ 0do
+ dup d# 15 and 0= if dup cr hex4 [char] : emit space space then
+ dup c@ hex2 space 1+
+ loop
+ cr drop
+;
+
+: dump16
+ ( addr u )
+ 0do
+ dup hex4 [char] : emit space dup @ hex4 cr 2+
+ loop
+ drop
+;
+
+: decimal d# 10 base ! ;
+: hex d# 16 base ! ;
+
+: S.R ( a u n -- ) OVER - SPACES TYPE ;
+: D.R ( d n -- ) ( 8.6.1.1070 ) >R DUP >R DABS <# #S R> SIGN #> R> S.R ;
+: U.R ( u n -- ) ( 6.2.2330 ) d# 0 SWAP D.R ;
+: .R ( n n -- ) ( 6.2.0210 ) >R S>D R> D.R ;
+
+: D. ( d -- ) ( 8.6.1.1060 ) d# 0 D.R SPACE ;
+: U. ( u -- ) ( 6.1.2320 ) d# 0 D. ;
+: . ( n -- ) ( 6.1.0180 ) BASE @ d# 10 XOR IF U. EXIT THEN S>D D. ;
+: ? ( a -- ) ( 15.6.1.0600 ) @ . ;
+
+( Numeric input )
+
+: DIGIT? ( c base -- u f ) ( 0xA3 )
+ >R [CHAR] 0 - D# 9 OVER <
+ IF D# 7 - DUP D# 10 < OR THEN DUP R> U< ;
+
+: >number ( ud a u -- ud a u ) ( 6.1.0570 )
+ begin
+ dup 0= if exit then
+ over c@ base @ digit? if
+ >r 2swap
+ drop base @ um*
+ r> s>d d+ 2swap
+ d# 1 /string >number
+ else
+ drop exit
+ then
+ again
+;
+
+: .s
+ [char] < emit
+ depth dup hex2
+ [char] > emit
+
+ d# 8 min
+ ?dup if
+ 0do
+ i pick hex4 space
+ loop
+ then
+;
+
+build-debug? [IF]
+: (assert)
+ s" **** ASSERTION FAILED **** " type
+ ;fallthru
+: (snap)
+ type space
+ s" LINE " type
+ .
+ [char] : emit
+ space
+ .s
+ cr
+;
+[THEN]
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+
+: endian dup d# 8 lshift swap d# 8 rshift or ;
+: 2endian endian swap endian ;
+: swab endian ;
+: typepad ( c-addr u w ) over - >r type r> spaces ;
+: even? d# 1 and 0= ;
+
+\ rise? and fall? act like ! - except that they leave a true
+\ if the value rose or fell, respectively.
+
+: rise? ( u a -- f ) 2dup @ u> >r ! r> ;
+: fall? ( u a -- f ) 2dup @ u< >r ! r> ;
+
+]module
diff --git a/docs/j1demo/firmware/packet.fs b/docs/j1demo/firmware/packet.fs
new file mode 100644
index 0000000..b188cc5
--- /dev/null
+++ b/docs/j1demo/firmware/packet.fs
@@ -0,0 +1,11 @@
+( Packet construction, tx, rx JCB 13:25 08/24/10)
+module[ packet"
+
+: packet@ ( u -- u )
+ mac-inoffset mac@ ;
+
+: packetd@ ( u -- ud )
+ mac-inoffset dup 2+ mac@ swap mac@ ;
+
+
+]module
diff --git a/docs/j1demo/firmware/ps2kb.fs b/docs/j1demo/firmware/ps2kb.fs
new file mode 100644
index 0000000..f151971
--- /dev/null
+++ b/docs/j1demo/firmware/ps2kb.fs
@@ -0,0 +1,434 @@
+( PS/2 keyboard handler JCB 18:29 11/21/10)
+
+================================================================
+
+Keycodes represent raw keypresses. Need to map these to
+ASCII characters. Each key can generate several ASCII
+codes depending on the state of the SHIFT/CTRL keys.
+
+Could use table giving keycode->ascii, but most keys
+generate two codes, so would need word for each.
+Keycodes 00-83. Storage 262 bytes.
+
+Table of N ascii codes, each entry specifies a keycode
+and shift state
+
+================================================================
+
+module[ ps2kb"
+
+meta
+
+create asciikb 144 allot
+asciikb 144 erase
+
+\ 1 word for each key.
+\ if high bit is zero, then
+
+h# 84 constant nscancodes
+create scanmap nscancodes cells allot
+scanmap nscancodes cells 2constant scanmap_
+scanmap_ erase
+
+: scanmap! ( n u -- ) \ write n to cell u in scanmap
+ cells scanmap + !
+;
+
+\ knowkey plain xx f0xx
+\ knowkey-n plain 3x, yy numlock exyy
+\ knowkey-h shift mask yy d0yy
+\ knowkey-s plain xx, shifted^caps yy xxyy
+
+h# f000 constant plainmask
+h# e000 constant numlockmask
+h# d000 constant shiftmask
+
+: wordval bl word count evaluate ;
+
+: knowkey
+ wordval
+ plainmask or
+ swap scanmap!
+;
+: knowkey-s
+ \ dup char asciikb + c!
+ \ 128 or
+ \ char asciikb + c!
+ char 8 lshift char or
+ swap scanmap!
+;
+: knowkey-h
+ wordval shiftmask or
+ swap scanmap!
+;
+: knowkey-n
+ \ dup char asciikb + c!
+ \ 128 or
+ \ char asciikb + c!
+ char [char] . - 8 lshift wordval or
+ numlockmask or
+ swap scanmap!
+;
+
+h# 01 constant SHIFTL
+h# 02 constant SHIFTR
+h# 04 constant CONTROL
+h# 08 constant ALT
+char * constant ASTERISK
+char - constant MINUS
+char + constant PLUS
+char 5 constant FIVE
+
+include keycodes.fs
+
+h# 76 knowkey ESC
+h# 05 knowkey KF1
+h# 06 knowkey KF2
+h# 04 knowkey KF3
+h# 0c knowkey KF4
+h# 03 knowkey KF5
+h# 0b knowkey KF6
+h# 83 knowkey KF7
+h# 0a knowkey KF8
+h# 01 knowkey KF9
+h# 09 knowkey KF10
+h# 78 knowkey KF11
+h# 07 knowkey KF12
+
+h# 0e knowkey-s ` ~
+h# 16 knowkey-s 1 !
+h# 1e knowkey-s 2 @
+h# 26 knowkey-s 3 #
+h# 25 knowkey-s 4 $
+h# 2e knowkey-s 5 %
+h# 36 knowkey-s 6 ^
+h# 3d knowkey-s 7 &
+h# 3e knowkey-s 8 *
+h# 46 knowkey-s 9 (
+h# 45 knowkey-s 0 )
+h# 4e knowkey-s - _
+h# 55 knowkey-s = +
+h# 5d knowkey-s \ |
+h# 66 knowkey KDEL
+
+h# 0d knowkey TAB
+h# 15 knowkey-s q Q
+h# 1d knowkey-s w W
+h# 24 knowkey-s e E
+h# 2d knowkey-s r R
+h# 2c knowkey-s t T
+h# 35 knowkey-s y Y
+h# 3c knowkey-s u U
+h# 43 knowkey-s i I
+h# 44 knowkey-s o O
+h# 4d knowkey-s p P
+h# 54 knowkey-s [ {
+h# 5b knowkey-s ] }
+h# 5a knowkey ENTER
+
+h# 58 knowkey -1
+h# 1c knowkey-s a A
+h# 1b knowkey-s s S
+h# 23 knowkey-s d D
+h# 2b knowkey-s f F
+h# 34 knowkey-s g G
+h# 33 knowkey-s h H
+h# 3b knowkey-s j J
+h# 42 knowkey-s k K
+h# 4b knowkey-s l L
+h# 4c knowkey-s ; :
+h# 52 knowkey-s ' "
+
+h# 1a knowkey-s z Z
+h# 22 knowkey-s x X
+h# 21 knowkey-s c C
+h# 2a knowkey-s v V
+h# 32 knowkey-s b B
+h# 31 knowkey-s n N
+h# 3a knowkey-s m M
+h# 41 knowkey-s , <
+h# 49 knowkey-s . >
+h# 4a knowkey-s / ?
+
+h# 29 knowkey BL
+
+h# 12 knowkey-h SHIFTL
+h# 59 knowkey-h SHIFTR
+h# 14 knowkey-h CONTROL
+h# 11 knowkey-h ALT
+
+h# 70 knowkey-n 0 KINS
+h# 71 knowkey-n . KDEL
+h# 69 knowkey-n 1 KEND
+h# 72 knowkey-n 2 KDOWN
+h# 7a knowkey-n 3 KPGDN
+h# 6b knowkey-n 4 KLEFT
+h# 73 knowkey FIVE
+h# 74 knowkey-n 6 KRIGHT
+h# 6c knowkey-n 7 KHOME
+h# 75 knowkey-n 8 KUP
+h# 7d knowkey-n 9 KPGUP
+h# 77 knowkey -2
+h# 7c knowkey ASTERISK
+h# 7b knowkey MINUS
+h# 79 knowkey PLUS
+
+: t,c ( c-addr u -- ) \ compile u cells into target memory
+ 0 do
+ dup @ t, cell+
+ loop
+ drop
+;
+
+target create scanmap meta
+scanmap nscancodes t,c
+
+target
+
+include keycodes.fs
+
+: scanmap@ ( u - u ) \ return scanmap entry u
+ cells scanmap + @ ;
+
+variable kbread \ read ptr into 64-bit KB fifo
+variable kbstate \ accumulates 11-bit code
+
+: ps2listening
+ ps2_clk_dir in
+ ps2_dat_dir in
+;
+: kbfifo@ ( u -- f ) \ read bit u from 64-bit KB fifo
+ dup d# 4 rshift 2* kbfifo + @
+ swap d# 15 and rshift d# 1 and
+;
+: kbnew ( -- ) \ start accumulating new code
+ h# 800 kbstate !
+;
+: kbfifo-cold
+ kbfifocount @ kbread !
+ kbnew
+;
+: kbfifo-fullness ( -- u ) \ how many unread bits in the kbfifo
+ kbfifocount @ kbread @ - h# ff and
+;
+
+variable ps2_clk'
+: waitfall \ wait for falling edge on ps2_clk
+ begin ps2_clk @ ps2_clk' fall? until ;
+
+: ps2-out1 ( u -- ) \ send lsb of u to keyboard
+ ps2_dat ! waitfall ;
+
+: oddparity ( u1 -- u2 ) \ u2 is odd parity of u1
+ dup d# 4 rshift xor
+ dup d# 2 rshift xor
+ dup 2/ xor
+;
+
+: kb-request
+ ps2_clk_dir out ps2_clk off \ clock low
+ d# 60. sleepus
+ ps2_dat_dir out ps2_dat off \ dat low
+ ps2_clk_dir in \ release clock
+
+ begin ps2_clk @ until
+ ps2_clk' on
+
+ \ bad keyboard hangs here
+ false ps2-out1 \ start
+
+ dup
+ d# 8 0do
+ dup ps2-out1 2/
+ loop
+ drop
+
+ oddparity ps2-out1 \ parity
+ true ps2-out1 \ stop
+
+ ps2listening \ waitfall
+ kbfifo-cold
+;
+
+: kbbit
+ d# 11 lshift kbstate @ 2/ or
+ kbstate !
+;
+: rawready? ( -- f) \ is the raw keycode ready?
+ kbstate @ d# 1 and ;
+
+: kbraw ( -- u ) \ get the current raw keycode
+ kbstate @ d# 2 rshift h# ff and
+ kbnew
+;
+
+variable lock
+
+: rawloop
+ begin
+ kbfifocount @ lock !
+ kbfifo-fullness 0<>
+ rawready? 0= and
+ while
+ kbfifo-fullness 1- kbfifo@
+ kbfifocount @ lock @ = if
+ kbbit d# 1 kbread +!
+ else
+ drop
+ then
+ repeat
+;
+
+: oneraw
+ begin
+ rawloop
+ rawready?
+ until
+ kbraw
+;
+
+: >leds ( u -- ) \ set keyboard leds (CAPS NUM SCROLL)
+ h# ed kb-request
+ oneraw drop
+ kb-request
+;
+
+( Decoding JCB 19:25 12/04/10)
+
+variable capslock
+variable numlock
+variable isrelease \ is this is key release
+variable ise0 \ is this an E0-prefix key
+0 value mods \ bitmask of modifier keys
+ \ RALT RCTRL -- -- LALT LCTRL RSHIFT LSHIFT
+
+: lrshift? ( -- f ) \ is either shift pressed?
+ mods h# 03 and ;
+: lrcontrol?
+ mods h# 44 and ;
+: lralt?
+ mods h# 88 and ;
+
+variable curkey
+
+: append ( u -- ) \ join u with mods write to curkey
+ h# ff and mods d# 8 lshift or
+ curkey !
+;
+
+: shiftmask
+ h# ff and
+ ise0 @ if d# 4 lshift then
+;
+: shift-press ( u -- ) \ a shift key was pressed
+ shiftmask mods or to mods ;
+: shift-release ( u -- ) \ a shift key was released
+ shiftmask invert mods and to mods ;
+
+: shiftable-press ( u -- ) \ a shiftable key was pressed
+ mods d# 3 and 0= capslock @ xor if
+ d# 8 rshift
+ then
+ append
+;
+: ignore drop ;
+
+: myleds \ compute led values from caps/numlock, send to KB
+ numlock @ d# 2 and
+ capslock @ d# 4 and
+ or
+ >leds
+;
+
+: toggle ( a -- ) \ invert cell at a
+ dup @ invert swap ! ;
+
+: plain-press ( u -- )
+ dup d# -1 = if
+ drop capslock toggle myleds
+ else
+ dup d# -2 = if
+ drop numlock toggle myleds
+ else
+ append
+ then
+ then
+;
+
+: num-press
+ \ if e0 prefix, low code, else hi code or 30
+ \ e0 numlock
+ \ 0 0 cursor
+ \ 0 1 num
+ \ 1 0 cursor
+ \ 1 1 cursor
+ ise0 @ 0= numlock @ and if
+ d# 8 rshift h# f and [char] . +
+ then
+ append
+;
+
+jumptable keyhandler
+\ PRESS RELEASE
+( 0 ) | shiftable-press | ignore
+( d ) | shift-press | shift-release
+( e ) | num-press | ignore
+( f ) | plain-press | ignore
+
+: handle-raw ( u -- )
+ dup h# e0 = if
+ drop ise0 on
+ else
+ dup h# f0 = if
+ drop isrelease on
+ else
+ dup h# 84 < if
+ scanmap@
+ \ hi 4 bits,
+ \ 1100 -> 0
+ \ 1101 -> 1
+ \ 1110 -> 2
+ \ 1111 -> 3
+ \
+ dup d# 12 rshift d# 12 - d# 0 max
+
+ 2* isrelease @ + keyhandler execute
+
+ isrelease off
+ ise0 off
+ else
+ drop
+ then
+ then
+ then
+;
+
+( kb: high-level keyboard JCB 19:45 12/04/10)
+
+: kb-cold
+ ps2listening kbfifo-cold
+ h# 7 >leds
+ sleep.1
+ h# 0 >leds
+
+ numlock off
+ capslock off
+ curkey off
+;
+
+: kbfifo-proc
+ rawloop
+ rawready? if
+ kbraw handle-raw
+ then
+;
+
+: key? ( -- flag )
+ kbfifo-proc
+ curkey @ 0<> ;
+: key ( -- u )
+ begin key? until
+ curkey @ curkey off ;
+
+]module
+
diff --git a/docs/j1demo/firmware/sincos.fs b/docs/j1demo/firmware/sincos.fs
new file mode 100644
index 0000000..6ad1ea4
--- /dev/null
+++ b/docs/j1demo/firmware/sincos.fs
@@ -0,0 +1,36 @@
+( Sine and cosine JCB 18:29 11/18/10)
+
+create sintab
+
+meta
+
+: mksin
+ 65 0 do
+ i s>d d>f 128e0 f/ pi f* fsin
+ 32767e0 f* f>d drop
+ t,
+ loop
+;
+mksin
+
+target
+
+: sin ( th -- v )
+ dup d# 128 and >r
+ d# 127 and
+ dup d# 63 > if
+ invert d# 129 + \ 64->64, 65->63
+ then
+ cells sintab + @
+ r> if
+ negate
+ then
+;
+
+: cos d# 64 + sin ;
+
+: sin* ( s th -- sinth * s )
+ sin swap 2* m* nip ;
+
+: cos* ( s th -- costh * s )
+ cos swap 2* m* nip ;
diff --git a/docs/j1demo/firmware/sprite.fs b/docs/j1demo/firmware/sprite.fs
new file mode 100644
index 0000000..877917a
--- /dev/null
+++ b/docs/j1demo/firmware/sprite.fs
@@ -0,0 +1,20 @@
+( Sprite low-level JCB 15:23 11/15/10)
+
+: vga-line@
+ begin
+ vga_line @
+ vga_line @
+ over xor
+ while
+ drop
+ repeat
+;
+
+: waitblank begin vga-line@ d# 512 = until ;
+
+: sprite! ( x y spr -- )
+ 2* cells vga_spritey + tuck ! 2- ! ;
+
+: hide \ hide all the sprites at (800,800)
+ d# 8 0do d# 800 dup i sprite! loop ;
+
diff --git a/docs/j1demo/firmware/tftp.fs b/docs/j1demo/firmware/tftp.fs
new file mode 100644
index 0000000..da40aa2
--- /dev/null
+++ b/docs/j1demo/firmware/tftp.fs
@@ -0,0 +1,67 @@
+( TFTP JCB 09:16 11/11/10)
+
+variable blocknum
+
+: tftp-ack ( -- )
+ d# 2 ETH.IP.SRCIP mac-inoffset mac@n arp-lookup if
+ ETH.IP.UDP.SOURCEPORT packet@
+ d# 1077
+ d# 2 ETH.IP.SRCIP mac-inoffset mac@n
+ net-my-ip
+ 2over arp-lookup
+ ( dst-port src-port dst-ip src-ip *ethaddr )
+ udp-header
+ d# 4 mac-pkt-,
+ blocknum @ mac-pkt-,
+ udp-wrapup mac-send
+ then
+;
+
+: tftp-handler ( -- )
+ IP_PROTO_UDP ip-isproto if
+ OFFSET_UDP_DESTPORT packet@ d# 69 = if
+ udp-checksum? if
+ ETH.IP.UDP.TFTP.OPCODE packet@
+ s" tftp opcode=" type dup hex4 cr
+ dup d# 2 = if
+ s" WRQ filename: " type
+ ETH.IP.UDP.TFTP.RWRQ.FILENAME mac-inoffset d# 32 mac-dump
+
+ d# 0 blocknum !
+ tftp-ack
+ then
+ drop
+ then
+ then
+ OFFSET_UDP_DESTPORT packet@ d# 1077 = if
+ udp-checksum? if
+ ETH.IP.UDP.TFTP.OPCODE packet@
+ s" tftp opcode=" type dup hex4 cr
+ dup d# 3 = if
+ s" tftp recv=" type ETH.IP.UDP.TFTP.DATA.BLOCK packet@ hex4 s" expected=" type blocknum @ 1+ hex4 cr
+ blocknum @ 1+
+ ETH.IP.UDP.TFTP.DATA.BLOCK packet@ = if
+ \ data at ETH.IP.UDP.TFTP.DATA.DATA
+ ETH.IP.UDP.TFTP.DATA.DATA mac-inoffset
+ blocknum @ d# 9 lshift h# 2000 +
+ d# 256 0do
+ over mac@ h# 5555 xor over h# 3ffe min !
+ 2+ swap 2+ swap
+ loop
+ 2drop
+ d# 1 blocknum +!
+ tftp-ack
+ ETH.IP.UDP.LENGTH packet@ d# 12 - 0= if
+ h# 2000 h# 100 dump
+ bootloader
+ then
+ else
+ s" unexpected blocknum" type cr
+ tftp-ack
+ then
+ then
+ drop
+ then
+ then
+ then
+;
diff --git a/docs/j1demo/firmware/time.fs b/docs/j1demo/firmware/time.fs
new file mode 100644
index 0000000..4d53113
--- /dev/null
+++ b/docs/j1demo/firmware/time.fs
@@ -0,0 +1,33 @@
+( Time access JCB 13:27 08/24/10)
+
+variable prevth \ previous high time
+2variable timeh \ high 32 bits of time
+
+: time@ ( -- time. )
+ begin
+ time 2@
+ time 2@
+ 2over d<>
+ while
+ 2drop
+ repeat
+
+\ dup prevth fall? if
+\ d# 1. timeh d+!
+\ then
+;
+
+: timeq ( -- d d ) \ 64-bit time
+ time@ timeh 2@ ;
+
+: setalarm ( d a -- ) \ set alarm a for d microseconds hence
+ >r time@ d+ r> 2! ;
+: isalarm ( a -- f )
+ 2@ time@ d- d0<= ;
+
+2variable sleeper
+: sleepus sleeper setalarm begin sleeper isalarm until ;
+: sleep.1 d# 100000. sleepus ;
+: sleep1 d# 1000000. sleepus ;
+
+: took ( d -- ) time@ 2swap d- s" took " type d. cr ;
diff --git a/docs/j1demo/firmware/twist.py b/docs/j1demo/firmware/twist.py
new file mode 100644
index 0000000..19743f6
--- /dev/null
+++ b/docs/j1demo/firmware/twist.py
@@ -0,0 +1,311 @@
+from twisted.internet.protocol import DatagramProtocol
+from twisted.internet import reactor, task
+from twisted.internet.task import deferLater
+
+import os
+import time
+import struct
+import sys
+import hashlib
+import operator
+import functools
+import random
+
+class Transporter(DatagramProtocol):
+
+ def __init__(self, jobs):
+ self.udp_transport = reactor.listenUDP(9947, self)
+ self.pending = {}
+ self.seq = 0
+ self.jobs = jobs
+ self.firstjob()
+ task.LoopingCall(self.earliest).start(0.1)
+ reactor.run()
+
+ def firstjob(self):
+ self.jobs[0].startwork(self)
+
+ def propose(self, cmd, rest):
+ seq = self.seq
+ self.seq += 1
+ data = struct.pack(">HH", seq, cmd) + rest;
+ self.pending[seq] = (time.time(), data)
+ return seq
+
+ def earliest(self):
+ bytime = [(t, k) for (k, (t, _)) in self.pending.items()]
+ for (t, seq) in sorted(bytime)[:32]:
+ self.send(seq)
+ self.pending[seq] = (time.time(), self.pending[seq][1])
+
+ def datagramReceived(self, data, (host, port)):
+ # print "received %r from %s:%d" % (data, host, port)
+ (opcode, seq) = struct.unpack(">HH", data[:4])
+ assert opcode == 0
+ if seq in self.pending:
+ del self.pending[seq]
+ try:
+ self.jobs[0].addresult(self, seq, data[4:])
+ except AssertionError as e:
+ print 'assertion failed', e
+ reactor.stop()
+ return
+ print "ACK ", seq, "pending", len(self.pending)
+ if len(self.pending) == 0:
+ self.jobs[0].close()
+ self.jobs = self.jobs[1:]
+ if self.jobs != []:
+ self.firstjob()
+ else:
+ reactor.stop()
+ # self.transport.write(data, (host, port))
+
+ def send(self, seq):
+ (_, data) = self.pending[seq]
+ # print "send %r" % data
+ self.udp_transport.write(data, ("192.168.0.99", 947))
+
+ def addresult(self, seq, payload):
+ pass
+
+
+class Action(object):
+ def addresult(self, tr, seq, payload):
+ pass
+
+ def close(self):
+ pass
+
+class ReadRAM(Action):
+
+ def startwork(self, tr):
+ self.result = 16384 * [None]
+ self.seqs = {}
+ for i in range(0, 128):
+ self.seqs[tr.propose(0, struct.pack(">H", i * 128))] = i * 128
+
+ def addresult(self, tr, seq, payload):
+ addr = self.seqs[seq]
+ assert len(payload) == 128
+ for i in range(128):
+ self.result[addr + i] = ord(payload[i])
+
+ def close(self):
+ for a in range(0, 16384, 16):
+ print ("%04x " % a) + " ".join("%02x" % x for x in self.result[a:a+16])
+
+
+class WriteRAM(Action):
+
+ def startwork(self, tr):
+ code = open('j1.bin').read()
+ for i in range(0x1f80 / 128):
+ print i
+ o = 128 * i
+ tr.propose(1, struct.pack(">H128s", 0x2000 + o, code[o:o+128]))
+
+class VerifyRAM(ReadRAM):
+ def close(self):
+ actual = "".join([chr(c) for c in self.result[0x2000:]])
+ expected = open('j1.bin').read()
+ l = 0x1f80
+ assert actual[:l] == expected[:l]
+
+class Reboot(Action):
+ def startwork(self, tr):
+ tr.propose(2, "")
+
+class ReadFlash(Action):
+
+ def startwork(self, tr):
+ self.result = 2 * 1024 * 1024 * [None]
+ self.seqs = {}
+ for addr in range(0, len(self.result), 128):
+ self.seqs[tr.propose(3, struct.pack(">I", addr))] = addr
+
+ def addresult(self, tr, seq, payload):
+ addr = self.seqs[seq]
+ assert len(payload) == 128
+ for i in range(128):
+ self.result[addr + i] = ord(payload[i])
+
+ def close(self):
+ open('flash.dump', 'w').write("".join([chr(x) for x in self.result]))
+ for a in range(0, 256, 16):
+ print ("%04x " % a) + " ".join("%02x" % x for x in self.result[a:a+16])
+
+class EraseFlash(Action):
+ def startwork(self, tr):
+ tr.propose(4, "")
+ def close(self):
+ time.sleep(5)
+
+class WaitFlash(Action):
+ def startwork(self, tr):
+ self.seq = tr.propose(5, struct.pack(">I", 0))
+ def addresult(self, tr, seq, payload):
+ (res,) = struct.unpack(">H", payload)
+ if res == 0:
+ self.startwork(tr)
+
+def bitload(bitfilename):
+ bit = open(bitfilename, "r")
+
+ def getH(fi):
+ return struct.unpack(">H", bit.read(2))[0]
+ def getI(fi):
+ return struct.unpack(">I", bit.read(4))[0]
+
+ bit.seek(getH(bit), os.SEEK_CUR)
+ assert getH(bit) == 1
+
+ # Search for the data section in the .bit file...
+ while True:
+ ty = ord(bit.read(1))
+ if ty == 0x65:
+ break
+ length = getH(bit)
+ bit.seek(length, os.SEEK_CUR)
+ fieldLength = getI(bit)
+ return bit.read(fieldLength)
+
+# open("xxx", "w").write(bitload("j1_program.bit"))
+
+import intelhex
+import array
+
+class Hexfile(object):
+ def __init__(self, filename):
+ self.hf = intelhex.IntelHex(filename)
+ self.hf.readfile()
+ while (self.hf.maxaddr() % 128) != 127:
+ self.hf[self.hf.maxaddr() + 1] = 0xff
+ print "%x %x" % (self.hf.minaddr(), self.hf.maxaddr())
+
+ def minmax(self):
+ return (self.hf.minaddr(), self.hf.maxaddr())
+
+ # The XESS CPLD bootloader runs the flash in byte mode,
+ # and the flash is littleendian, so must do the endian
+ # swap here
+ def blk(self, o):
+ b128 = array.array('B', [self.hf[o + i] for i in range(128)]).tostring()
+ hh = array.array('H', b128)
+ hh.byteswap()
+ return hh.tostring()
+
+class WriteFlash(Action, Hexfile):
+
+ def startwork(self, tr):
+ for o in range(self.hf.minaddr(), self.hf.maxaddr(), 128):
+ tr.propose(6, struct.pack(">I", o) + self.blk(o))
+
+class VerifyFlash(Action, Hexfile):
+
+ def startwork(self, tr):
+ self.seqs = {}
+ for o in range(self.hf.minaddr(), self.hf.maxaddr(), 128):
+ self.seqs[tr.propose(3, struct.pack(">I", o))] = o
+
+ def addresult(self, tr, seq, payload):
+ addr = self.seqs[seq]
+ assert len(payload) == 128, 'short packet'
+ assert self.blk(addr) == payload, "mismatch at %#x" % addr
+
+ def close(self):
+ print "Flash verified OK"
+
+class EraseSector(Action):
+ def __init__(self, a):
+ self.a = a
+ def startwork(self, tr):
+ tr.propose(7, struct.pack(">I", self.a))
+ def close(self):
+ time.sleep(.1)
+
+class WaitSector(Action):
+ def __init__(self, a):
+ self.a = a
+ def startwork(self, tr):
+ self.seq = tr.propose(5, struct.pack(">I", self.a))
+ def addresult(self, tr, seq, payload):
+ (res,) = struct.unpack(">H", payload)
+ if res == 0:
+ self.startwork(tr)
+
+class LoadSector(Action):
+ def __init__(self, a, data):
+ self.a = a
+ self.data = data
+ def startwork(self, tr):
+ for o in range(0, len(self.data), 128):
+ blk = self.data[o:o+128]
+ if blk != (128 * chr(0xff)):
+ tr.propose(6, struct.pack(">I", self.a + o) + blk)
+
+class DumpSector(Action):
+
+ def __init__(self, a):
+ self.a = a
+ def startwork(self, tr):
+ self.seqs = {}
+ for o in [0]:
+ self.seqs[tr.propose(3, struct.pack(">I", self.a + o))] = o
+
+ def addresult(self, tr, seq, payload):
+ addr = self.a + self.seqs[seq]
+ assert len(payload) == 128
+ print "result", repr(payload)
+
+# t = Transporter([WriteRAM(), VerifyRAM(), Reboot()])
+# t = Transporter([EraseFlash(), WaitFlash()])
+# sys.exit(0)
+
+erasing = [EraseFlash(), WaitFlash()]
+bases = [ 0 ]
+bases = [0, 0x80000, 0x100000, 0x180000]
+bases = [0x80000]
+# Transporter(erasing + [WriteFlash("j1_program_%x.mcs" % base) for base in bases])
+# Transporter([VerifyFlash("j1_program_%x.mcs" % base) for base in bases])
+# Transporter([EraseSector(seca), WaitSector(seca), ld, DumpSector(seca)])
+
+def loadcode(dsta, filenames):
+ data = "".join([open(fn).read() for fn in filenames])
+ return [EraseSector(dsta),
+ WaitSector(dsta),
+ LoadSector(dsta, data)]
+
+def pngstr(filename):
+ import Image
+ sa = array.array('B', Image.open(filename).convert("L").tostring())
+ return struct.pack('>1024H', *sa.tolist())
+
+def erasesecs(lo, hi):
+ r = []
+ for s in range(lo, hi, 65536):
+ r += [EraseSector(s), WaitSector(s)]
+ return r
+
+def loadhex(filename):
+ w = WriteFlash(filename)
+ (lo, hi) = w.minmax()
+ return erasesecs(lo, hi) + [w]
+
+def loadsprites(dsta, filenames):
+ data = "".join([pngstr(f) for f in filenames])
+ print "Loading %d bytes" % len(data)
+ return erasesecs(dsta, dsta + len(data)) + [LoadSector(dsta, data)]
+
+# Transporter(loadcode(0x180000, ["j1.png.pic", "font8x8", "j1.png.chr"]) + [Reboot()])
+spr = ["%d.png" % (i/2) for i in range(16)]
+spr += ["blob.png"] * 16
+spr += ["fsm-32.png", "pop.png"] * 6 + ["bomb.png", "pop.png", "shot.png", "pop.png"]
+
+# Transporter(loadsprites(0x200000, spr))
+# Transporter(loadcode(0x190000, ["j1.bin"]) + [Reboot()])
+# t = Transporter([ReadFlash()])
+
+Transporter(
+# loadhex("j1_program_80000.mcs")
+loadcode(0x190000, ["j1.bin"]) + [Reboot()]
+)
diff --git a/docs/j1demo/firmware/udp.fs b/docs/j1demo/firmware/udp.fs
new file mode 100644
index 0000000..835983a
--- /dev/null
+++ b/docs/j1demo/firmware/udp.fs
@@ -0,0 +1,41 @@
+( UDP header and wrapup JCB 13:22 08/24/10)
+
+: udp-header ( dst-port src-port dst-ip src-ip *ethaddr -- )
+ h# 11 ip-header
+ mac-pkt-, \ src port
+ mac-pkt-, \ dst port
+ d# 2 mac-pkt-,0 \ length and checksum
+;
+
+variable packetbase
+: packet packetbase @ + ;
+
+: udp-checksum ( addr -- u ) \ compute UDP checksum on packet
+ packetbase !
+ ETH.IP.UDP.LENGTH packet @ d# 1 and if
+ ETH.IP.UDP ETH.IP.UDP.LENGTH packet @ + packet
+ dup @ h# ff00 and swap !
+ then
+ ETH.IP.UDP packet
+ ETH.IP.UDP.LENGTH packet @ 1+ 2/
+ mac-checksum invert
+ d# 4 ETH.IP.SRCIP packet mac@n
+ +1c +1c +1c +1c
+ IP_PROTO_UDP +1c
+ ETH.IP.UDP.LENGTH packet @ +1c
+ invert
+;
+
+: udp-checksum? true ;
+ \ incoming udp-checksum 0= ;
+
+: udp-wrapup
+ mac-pkt-complete dup
+ ip-wrapup
+
+ OFFSET_UDP -
+ OFFSET_UDP_LENGTH packetout-off mac!
+
+ \ outgoing udp-checksum ETH.IP.UDP.CHECKSUM packetout-off !
+;
+
diff --git a/docs/j1demo/firmware/version.fs b/docs/j1demo/firmware/version.fs
new file mode 100644
index 0000000..75e63a9
--- /dev/null
+++ b/docs/j1demo/firmware/version.fs
@@ -0,0 +1,2 @@
+: version s" 649:659M" ;
+: builddate d# 1291578086. d# -0800 ;