aboutsummaryrefslogtreecommitdiff
path: root/j1demo/firmware
diff options
context:
space:
mode:
authorDimitri Sokolyuk <demon@dim13.org>2019-10-30 20:04:56 +0100
committerDimitri Sokolyuk <demon@dim13.org>2019-10-30 20:04:56 +0100
commita76977af62010a392c16010c367185e61e856ffe (patch)
tree56cf4177d5bc0e3ead781d1c60818c13b1df0f3c /j1demo/firmware
parentc0165d167d7cb40d80028bcf7a4a6b160b5a7e83 (diff)
mv to docs
Diffstat (limited to 'j1demo/firmware')
-rw-r--r--j1demo/firmware/Makefile26
-rw-r--r--j1demo/firmware/ans.fs46
-rw-r--r--j1demo/firmware/arp.fs225
-rw-r--r--j1demo/firmware/basewords.fs60
-rw-r--r--j1demo/firmware/clock.fs90
-rw-r--r--j1demo/firmware/crossj1.fs527
-rw-r--r--j1demo/firmware/defines_tcpip.fs70
-rw-r--r--j1demo/firmware/defines_tcpip.py94
-rw-r--r--j1demo/firmware/defines_tcpip2.fs150
-rw-r--r--j1demo/firmware/defines_tcpip2.py215
-rw-r--r--j1demo/firmware/dhcp.fs176
-rw-r--r--j1demo/firmware/dns.fs81
-rw-r--r--j1demo/firmware/doc.fs20
-rw-r--r--j1demo/firmware/document.fs3
-rw-r--r--j1demo/firmware/encode.py28
-rw-r--r--j1demo/firmware/eth-ax88796.fs506
-rw-r--r--j1demo/firmware/font8x8bin768 -> 0 bytes
-rw-r--r--j1demo/firmware/fsm-32.pngbin1489 -> 0 bytes
-rw-r--r--j1demo/firmware/genoffsets.py11
-rw-r--r--j1demo/firmware/go16
-rw-r--r--j1demo/firmware/hwdefs.fs57
-rw-r--r--j1demo/firmware/intelhex.py643
-rw-r--r--j1demo/firmware/invaders.fs362
-rw-r--r--j1demo/firmware/ip.fs124
-rw-r--r--j1demo/firmware/ip0.fs70
-rw-r--r--j1demo/firmware/j1.pngbin3262 -> 0 bytes
-rw-r--r--j1demo/firmware/keycodes.fs28
-rw-r--r--j1demo/firmware/loader.fs114
-rw-r--r--j1demo/firmware/main.fs799
-rw-r--r--j1demo/firmware/mkblob.py14
-rw-r--r--j1demo/firmware/ntp.fs36
-rw-r--r--j1demo/firmware/nuc.fs546
-rw-r--r--j1demo/firmware/packet.fs11
-rw-r--r--j1demo/firmware/ps2kb.fs434
-rw-r--r--j1demo/firmware/sincos.fs36
-rw-r--r--j1demo/firmware/sprite.fs20
-rw-r--r--j1demo/firmware/tftp.fs67
-rw-r--r--j1demo/firmware/time.fs33
-rw-r--r--j1demo/firmware/twist.py311
-rw-r--r--j1demo/firmware/udp.fs41
-rw-r--r--j1demo/firmware/version.fs2
41 files changed, 0 insertions, 6092 deletions
diff --git a/j1demo/firmware/Makefile b/j1demo/firmware/Makefile
deleted file mode 100644
index b28bfe6..0000000
--- a/j1demo/firmware/Makefile
+++ /dev/null
@@ -1,26 +0,0 @@
-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/j1demo/firmware/ans.fs b/j1demo/firmware/ans.fs
deleted file mode 100644
index dcd29ed..0000000
--- a/j1demo/firmware/ans.fs
+++ /dev/null
@@ -1,46 +0,0 @@
-( 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/j1demo/firmware/arp.fs b/j1demo/firmware/arp.fs
deleted file mode 100644
index c6b69c7..0000000
--- a/j1demo/firmware/arp.fs
+++ /dev/null
@@ -1,225 +0,0 @@
-( 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/j1demo/firmware/basewords.fs b/j1demo/firmware/basewords.fs
deleted file mode 100644
index e529f66..0000000
--- a/j1demo/firmware/basewords.fs
+++ /dev/null
@@ -1,60 +0,0 @@
-( 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/j1demo/firmware/clock.fs b/j1demo/firmware/clock.fs
deleted file mode 100644
index 4bb35bb..0000000
--- a/j1demo/firmware/clock.fs
+++ /dev/null
@@ -1,90 +0,0 @@
-( 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/j1demo/firmware/crossj1.fs b/j1demo/firmware/crossj1.fs
deleted file mode 100644
index d034611..0000000
--- a/j1demo/firmware/crossj1.fs
+++ /dev/null
@@ -1,527 +0,0 @@
-( 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/j1demo/firmware/defines_tcpip.fs b/j1demo/firmware/defines_tcpip.fs
deleted file mode 100644
index 90d3990..0000000
--- a/j1demo/firmware/defines_tcpip.fs
+++ /dev/null
@@ -1,70 +0,0 @@
-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/j1demo/firmware/defines_tcpip.py b/j1demo/firmware/defines_tcpip.py
deleted file mode 100644
index bbeb16b..0000000
--- a/j1demo/firmware/defines_tcpip.py
+++ /dev/null
@@ -1,94 +0,0 @@
-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/j1demo/firmware/defines_tcpip2.fs b/j1demo/firmware/defines_tcpip2.fs
deleted file mode 100644
index 4d38a13..0000000
--- a/j1demo/firmware/defines_tcpip2.fs
+++ /dev/null
@@ -1,150 +0,0 @@
-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/j1demo/firmware/defines_tcpip2.py b/j1demo/firmware/defines_tcpip2.py
deleted file mode 100644
index 1d9e556..0000000
--- a/j1demo/firmware/defines_tcpip2.py
+++ /dev/null
@@ -1,215 +0,0 @@
-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/j1demo/firmware/dhcp.fs b/j1demo/firmware/dhcp.fs
deleted file mode 100644
index 971e567..0000000
--- a/j1demo/firmware/dhcp.fs
+++ /dev/null
@@ -1,176 +0,0 @@
-( 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/j1demo/firmware/dns.fs b/j1demo/firmware/dns.fs
deleted file mode 100644
index 96ec36c..0000000
--- a/j1demo/firmware/dns.fs
+++ /dev/null
@@ -1,81 +0,0 @@
-( 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/j1demo/firmware/doc.fs b/j1demo/firmware/doc.fs
deleted file mode 100644
index 8b3c07d..0000000
--- a/j1demo/firmware/doc.fs
+++ /dev/null
@@ -1,20 +0,0 @@
-( 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/j1demo/firmware/document.fs b/j1demo/firmware/document.fs
deleted file mode 100644
index 53c741c..0000000
--- a/j1demo/firmware/document.fs
+++ /dev/null
@@ -1,3 +0,0 @@
-\ For use with docforth.fs
-
-s" ans.fs" included
diff --git a/j1demo/firmware/encode.py b/j1demo/firmware/encode.py
deleted file mode 100644
index 54022d2..0000000
--- a/j1demo/firmware/encode.py
+++ /dev/null
@@ -1,28 +0,0 @@
-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/j1demo/firmware/eth-ax88796.fs b/j1demo/firmware/eth-ax88796.fs
deleted file mode 100644
index 0a630d6..0000000
--- a/j1demo/firmware/eth-ax88796.fs
+++ /dev/null
@@ -1,506 +0,0 @@
-( 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/j1demo/firmware/font8x8 b/j1demo/firmware/font8x8
deleted file mode 100644
index fbdaf14..0000000
--- a/j1demo/firmware/font8x8
+++ /dev/null
Binary files differ
diff --git a/j1demo/firmware/fsm-32.png b/j1demo/firmware/fsm-32.png
deleted file mode 100644
index 974f70c..0000000
--- a/j1demo/firmware/fsm-32.png
+++ /dev/null
Binary files differ
diff --git a/j1demo/firmware/genoffsets.py b/j1demo/firmware/genoffsets.py
deleted file mode 100644
index 2ed279e..0000000
--- a/j1demo/firmware/genoffsets.py
+++ /dev/null
@@ -1,11 +0,0 @@
-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/j1demo/firmware/go b/j1demo/firmware/go
deleted file mode 100644
index 0adb2d0..0000000
--- a/j1demo/firmware/go
+++ /dev/null
@@ -1,16 +0,0 @@
-# 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/j1demo/firmware/hwdefs.fs b/j1demo/firmware/hwdefs.fs
deleted file mode 100644
index 4539d1a..0000000
--- a/j1demo/firmware/hwdefs.fs
+++ /dev/null
@@ -1,57 +0,0 @@
-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/j1demo/firmware/intelhex.py b/j1demo/firmware/intelhex.py
deleted file mode 100644
index ecf8b28..0000000
--- a/j1demo/firmware/intelhex.py
+++ /dev/null
@@ -1,643 +0,0 @@
-#!/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/j1demo/firmware/invaders.fs b/j1demo/firmware/invaders.fs
deleted file mode 100644
index f501a3e..0000000
--- a/j1demo/firmware/invaders.fs
+++ /dev/null
@@ -1,362 +0,0 @@
-( 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/j1demo/firmware/ip.fs b/j1demo/firmware/ip.fs
deleted file mode 100644
index 7c66137..0000000
--- a/j1demo/firmware/ip.fs
+++ /dev/null
@@ -1,124 +0,0 @@
-( 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/j1demo/firmware/ip0.fs b/j1demo/firmware/ip0.fs
deleted file mode 100644
index 1631d5f..0000000
--- a/j1demo/firmware/ip0.fs
+++ /dev/null
@@ -1,70 +0,0 @@
-( 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/j1demo/firmware/j1.png b/j1demo/firmware/j1.png
deleted file mode 100644
index 552f8d3..0000000
--- a/j1demo/firmware/j1.png
+++ /dev/null
Binary files differ
diff --git a/j1demo/firmware/keycodes.fs b/j1demo/firmware/keycodes.fs
deleted file mode 100644
index bd9b814..0000000
--- a/j1demo/firmware/keycodes.fs
+++ /dev/null
@@ -1,28 +0,0 @@
-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/j1demo/firmware/loader.fs b/j1demo/firmware/loader.fs
deleted file mode 100644
index d4ae725..0000000
--- a/j1demo/firmware/loader.fs
+++ /dev/null
@@ -1,114 +0,0 @@
-( 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/j1demo/firmware/main.fs b/j1demo/firmware/main.fs
deleted file mode 100644
index 16e4cf5..0000000
--- a/j1demo/firmware/main.fs
+++ /dev/null
@@ -1,799 +0,0 @@
-( Main for WGE firmware JCB 13:24 08/24/10)
-
-\ warnings off
-\ require tags.fs
-
-include crossj1.fs
-meta
- : TARGET? 1 ;
- : build-debug? 1 ;
-
-include basewords.fs
-target
-include hwdefs.fs
-
-0 [IF]
- h# 1f80 org
- \ the RAM Bootloader copies 2000-3f80 to 0-1f80, then branches to zero
- : bootloader
- h# 1f80 h# 0
- begin
- 2dupxor
- while
- dup h# 2000 + @
- over !
- d# 2 +
- repeat
-
- begin dsp h# ff and while drop repeat
- d# 0 >r
- ;
-[ELSE]
- h# 3f80 org
- \ the Flash Bootloader copies 0x190000 to 0-3f80, then branches to zero
- : bootloader
- h# c flash_a_hi !
- h# 0 begin
- dup h# 8000 + flash_a !
- d# 0 flash_oe_n !
- flash_d @
- d# 1 flash_oe_n !
- over dup + !
- d# 1 +
- dup h# 1fc0 =
- until
-
- begin dsp h# ff and while drop repeat
- d# 0 >r
- ;
-[THEN]
-
-4 org
-module[ everything"
-include nuc.fs
-
-include version.fs
-
-\ 33333333 / 115200 = 289, half cycle is 144
-
-: pause144
- d# 0 d# 45
- begin
- 1-
- 2dup=
- until
- 2drop
-;
-
-: serout ( u -- )
- h# 300 or \ 1 stop bits
- 2* \ 0 start bit
- \ Start bit
- begin
- dup RS232_TXD ! 2/
- pause144
- pause144
- dup 0=
- until
- drop
- pause144 pause144
- pause144 pause144
-;
-
-: frac ( ud u -- d1 u1 ) \ d1+u1 is ud
- >r 2dup d# 1 r@ m*/ 2swap 2over r> d# 1 m*/ d- drop ;
-: .2 s>d <# # # #> type ;
-: build.
- decimal
- builddate drop
- [ -8 3600 * ] literal s>d d+
- d# 1 d# 60 m*/mod >r
- d# 1 d# 60 m*/mod >r
- d# 1 d# 24 m*/mod >r
- 2drop
- r> .2 [char] : emit
- r> .2 [char] : emit
- r> .2 ;
-
-: net-my-mac h# 1234 h# 5677 h# 7777 ;
-
-include doc.fs
-include time.fs
-include eth-ax88796.fs
-include packet.fs
-include ip0.fs
-include defines_tcpip.fs
-include defines_tcpip2.fs
-include arp.fs
-include ip.fs
-include udp.fs
-include dhcp.fs
-
-code in end-code
-: on ( a -- ) d# 1 swap ! ;
-code out end-code
-: off ( a -- ) d# 0 swap ! ;
-
-: flash-reset
- flash_rst_n off
- flash_rst_n on
-;
-
-: flash-cold
- flash_ddir on
- flash_ce_n off
- flash_oe_n on
- flash_we_n on
- flash_byte_n on
- flash_rdy on
- flash-reset
-;
-
-: flash-w ( u a -- )
- flash_a !
- flash_d !
- flash_ddir off
- flash_we_n off
- flash_we_n on
- flash_ddir on
-;
-
-: flash-r ( a -- u )
- flash_a !
- flash_oe_n off
- flash_d @
- flash_oe_n on
-;
-
-: flash-unlock ( -- )
- h# aa h# 555 flash-w
- h# 55 h# 2aa flash-w
-;
-
-: flash! ( u da. -- )
- flash-unlock
- h# a0 h# 555 flash-w
- flash_a 2+ ! ( u a )
- 2dup ( u a u a)
- flash-w ( u a )
- begin
- 2dup flash-r xor
- h# 80 and 0=
- until
- 2drop
- flash-reset
-;
-
-: flash@ ( da. -- u )
- flash_a 2+ ! ( u a )
- flash-r
-;
-
-: flash-chiperase
- flash-unlock
- h# 80 h# 555 flash-w
- h# aa h# 555 flash-w
- h# 55 h# 2aa flash-w
- h# 10 h# 555 flash-w
-;
-
-: flash-sectorerase ( da -- ) \ erase one sector
- flash-unlock
- h# 80 h# 555 flash-w
- h# aa h# 555 flash-w
- h# 55 h# 2aa flash-w
- flash_a 2+ ! h# 30 swap flash-w
-;
-
-: flash-erased ( a -- f )
- flash@ h# 80 and 0<> ;
-
-: flash-dump ( da u -- )
- 0do
- 2dup flash@ hex4 space
- d1+
- loop cr
- 2drop
-;
-
-: flashc@
- over d# 15 lshift flash_d !
- d2/ flash@
-;
-
-: flash-bytes
- s" BYTES: " type
- flash_byte_n off
- h# 0.
- d# 1024 0do
- i d# 15 and 0= if
- cr
- 2dup hex8 space space
- then
- 2dup flashc@ hex2 space
- d1+
- loop cr
- 2drop
- flash_byte_n on
-;
-
-0 [IF]
-: flash-demo
- flash-unlock
- h# 90 h# 555 flash-w
- h# 00 flash-r hex4 cr
- flash-reset
-
- false if
- flash-unlock
- h# a0 h# 555 flash-w
- h# 0947 h# 5 flash-w
- sleep1
- flash-reset
- then
-
- \ h# dead d# 11. flash!
-
- h# 100 0do
- i flash-r hex4 space
- loop cr
- cr cr
- d# 0. h# 80 flash-dump
- cr cr
-
- flash-bytes
-
- exit
- flash-unlock
- h# 80 h# 555 flash-w
- h# aa h# 555 flash-w
- h# 55 h# 2aa flash-w
- h# 10 h# 555 flash-w
- s" waiting for erase" type cr
- begin
- h# 0 flash-r dup hex4 cr
- h# 80 and
- until
-
- h# 100 0do
- i flash-r hex4 space
- loop cr
-;
-[THEN]
-
-include sprite.fs
-
-variable cursory \ ptr to start of line in video memory
-variable cursorx \ offset to char
-
-64 constant width
-50 constant wrapcolumn
-
-: vga-at-xy ( u1 u2 )
- cursory !
- cursorx !
-;
-
-: home d# 0 vga_scroll ! d# 0 d# 0 vga-at-xy ;
-
-: vga-line ( -- a ) \ address of current line
- cursory @ vga_scroll @ + d# 31 and d# 6 lshift
- h# 8000 or
-;
-
-: vga-erase ( a u -- )
- bounds begin
- 2dupxor
- while
- h# 00 over ! 1+
- repeat 2drop
-;
-
-: vga-page
- home vga-line d# 2048 vga-erase
- hide
-;
-
-: down1
- cursory @ d# 31 <> if
- d# 1 cursory +!
- else
- false if
- d# 1 vga_scroll +!
- vga-line width vga-erase
- else
- home
- then
- then
-;
-
-: vga-emit ( c -- )
- dup d# 13 = if
- drop d# 0 cursorx !
- else
- dup d# 10 = if
- drop down1
- else
- d# -32 +
- vga-line cursorx @ + !
- d# 1 cursorx +!
- cursorx @ wrapcolumn = if
- d# 0 cursorx !
- down1
- then
- then
- then
-;
-
-: flash>ram ( d. a -- ) \ copy 2K from flash d to a
- >r d2/ r>
- d# 1024 0do
- >r
- 2dup flash@
- r> ( d. u a )
- over swab over !
- 1+
- tuck !
- 1+
- >r d1+ r>
- loop
- drop 2drop
-;
-
-: vga-cold
- h# f800 h# f000 do
- d# 0 i !
- loop
-
- vga-page
-
- \ pic: Copy 2048 bytes from 180000 to 8000
- \ chr: Copy 2048 bytes from 180800 to f000
- h# 180000. h# 8000 flash>ram
- h# 180800. h# f000 flash>ram
-
- \ ['] vga-emit 'emit !
-;
-
-create glyph 8 allot
-: wide1 ( c -- )
- swab
- d# 8 0do
- dup 0<
- if d# 127 else sp then
- \ if [char] * else [char] . then
- vga-emit
- 2*
- loop drop
-;
-
-: vga-bigemit ( c -- )
- dup d# 13 = if
- drop d# 0 cursorx !
- else
- dup d# 10 = if
- drop d# 8 0do down1 loop
- else
- sp - d# 8 * s>d
- h# 00180800. d+ d2/
- d# 4 0do
- 2dup flash@ swab
- i cells glyph + !
- d1+
- loop 2drop
-
- d# 7 0do
- i glyph + c@ wide1
- d# -8 cursorx +! down1
- loop
- d# 7 glyph + c@ wide1
-
- d# -7 cursory +!
- then
- then
-;
-
-( Demo utilities JCB 10:56 12/05/10)
-
-: statusline ( a u -- ) \ display string on the status line
- d# 0 d# 31 2dup vga-at-xy
- d# 50 spaces
- vga-at-xy type
-;
-
-( Game stuff JCB 15:20 11/15/10)
-
-variable seed
-: random ( -- u )
- seed @ d# 23947 * d# 57711 xor dup seed ! ;
-
-
-\ Each line is 20.8 us, so 1000 instructions
-
-include sincos.fs
-
-( Stars JCB 15:23 11/15/10)
-
-2variable vision
-variable frame
-128 constant nstars
-create stars 1024 allot
-
-: star 2* cells stars + ;
-: 15.* m* d2* nip ;
-
-\ >>> math.cos(math.pi / 180) * 32767
-\ 32762.009427189474
-\ >>> math.sin(math.pi / 180) * 32767
-\ 571.8630017304688
-
-[ pi 128e0 f/ fcos 32767e0 f* f>d drop ] constant COSa
-[ pi 128e0 f/ fsin 32767e0 f* f>d drop ] constant SINa
-
-: rotate ( i -- ) \ rotate star i
- star dup 2@ ( x y )
- over SINa 15.* over COSa 15.* + >r
- swap COSa 15.* swap SINa 15.* - r>
- rot 2!
-;
-
-: rotateall
- d# 256 0do i rotate loop ;
-
-: scatterR
- nstars 0do
- random d# 0 i star 2!
- rotateall
- rotateall
- rotateall
- rotateall
- loop
-;
-
-: scatterSpiral
- nstars 0do
- i d# 3 and 1+ d# 8000 *
- d# 0 i star 2!
- rotateall
- rotateall
- rotateall
- rotateall
- loop
-;
-
-: scatter
- nstars 0do
- \ d# 0 random
- d# 0 i sin
- i star 2!
- i random d# 255 and 0do
- dup rotate
- loop drop
- loop
-;
-
-: /128 dup 0< h# fe00 and swap d# 7 rshift or ;
-: tx /128 [ 400 ] literal + ;
-: ty /128 [ 256 ] literal + ;
-
-: plot ( i s ) \ plot star i in sprite s
- >r
- dup star @ tx swap d# 2 lshift
- r> sprite!
-;
-
-( Display list JCB 16:10 11/15/10)
-
-create dl 1026 allot
-
-: erasedl
- dl d# 1024 bounds begin
- d# -1 over !
- cell+ 2dup=
- until 2drop
-;
-
-: makedl
- erasedl
-
- nstars 0do
- i d# 2 lshift
- cells dl +
- \ cell occupied, use one below
- \ dup @ 0< invert if cell+ then
- i swap !
- loop
-;
-
-variable lastsp
-: stars-chasebeam
- hide
- d# 0 lastsp !
- d# 512 0do
- begin vga-line@ i = until
- i cells dl + @ dup 0< if
- drop
- else
- lastsp @ 1+ d# 7 and dup lastsp ! plot
- then
- i nstars < if i rotate then
- loop
-;
-
-
-
-: loadcolors
- d# 8 0do
- dup @
- i cells vga_spritec + !
- cell+
- loop
- drop
-;
-create cpastels
-h# 423 ,
-h# 243 ,
-h# 234 ,
-h# 444 ,
-h# 324 ,
-h# 432 ,
-h# 342 ,
-h# 244 ,
-: pastels cpastels loadcolors ;
-
-create crainbow
-h# 400 ,
-h# 440 ,
-h# 040 ,
-h# 044 ,
-h# 004 ,
-h# 404 ,
-h# 444 ,
-h# 444 ,
-: rainbow crainbow loadcolors ;
-
-variable prev_sw3_n
-
-: next? ( -- f ) \ has user requested next screen
- sw3_n @ prev_sw3_n fall?
-;
-
-: loadsprites ( da -- )
- 2/
- d# 16384 0do
- 2dup i s>d d+ flash@
- i vga_spritea ! vga_spriteport !
- loop
- 2drop
-;
-
-: stars-main
- vga-page
- d# 16384 0do
- h# 204000. 2/ i s>d d+ flash@
- i vga_spritea ! vga_spriteport !
- loop
-
- vga_addsprites on
- rainbow
-
- time@ xor seed !
- seed off
- scatter
-
- d# 7000000. vision setalarm
- d# 0 frame !
- begin
- makedl
- stars-chasebeam
- \ d# 256 0do i i plot loop
- \ rotateall
- frame @ 1+ frame !
- next?
- until
- frame @ . s" frames" type cr
-;
-
-: buttons ( -- u ) \ pb4 pb3 pb2
- pb_a_dir on
- pb_a @ d# 7 xor
- pb_a_dir off
-;
-
-include loader.fs
-include dns.fs
-
-: preip-handler
- begin
- mac-fullness
- while
- OFFSET_ETH_TYPE packet@ h# 800 = if
- dhcp-wait-offer
- then
- mac-consume
- repeat
-;
-
-: haveip-handler
- \ time@ begin ether_irq @ until time@ 2swap d- d. cr
- \ begin ether_irq @ until
- begin
- mac-fullness
- while
- arp-handler
- OFFSET_ETH_TYPE packet@ h# 800 =
- if
- d# 2 OFFSET_IP_DSTIP mac-inoffset mac@n net-my-ip d=
- if
- icmp-handler
- then
- loader-handler
- then
- depth if .s cr then
- mac-consume
- repeat
-;
-
-include invaders.fs
-
-: uptime
- time@
- d# 1 d# 1000 m*/
- d# 1 d# 1000 m*/
-;
-
-( IP address formatting JCB 14:50 10/26/10)
-
-: #ip1 h# ff and s>d #s 2drop ;
-: #. [char] . hold ;
-: #ip2 dup #ip1 #. d# 8 rshift #ip1 ;
-: #ip ( ip -- c-addr u) dup #ip2 #. over #ip2 ;
-
-variable prev_sw2_n
-: sw2? sw2_n @ prev_sw2_n fall? ;
-
-include ps2kb.fs
-
-: istab?
- key? dup if key TAB = and then
-;
-
-: welcome-main
- vga-cold
- home
- s" F1 to set up network, TAB for next demo" statusline
-
- rainbow
- h# 200000. loadsprites
- 'emit @ >r
- d# 6 d# 26 vga-at-xy s" Softcore Forth CPU" type
-
- d# 32 d# 6 vga-at-xy s" version " type version type
- d# 32 d# 8 vga-at-xy s" built " type build.
-
- kb-cold
- home
- begin
- kbfifo-proc
- d# 32 d# 10 vga-at-xy net-my-ip <# #ip #> type space space
- d# 32 d# 12 vga-at-xy s" uptime " type uptime d.
- haveip-handler
-
- d# 8 0do
- frame @ i d# 32 * + invert >r
- d# 100 r@ sin* d# 600 +
- d# 100 r> cos* d# 334 +
- i sprite!
- loop
-
- waitblank
- d# 1 frame +!
- next?
- istab? or
- until
- r> 'emit !
-;
-
-include clock.fs
-
-: frob
- flash_ce_n on
- flash_ddir off
- d# 32 0do
- d# 1 i d# 7 and lshift
- flash_d !
- d# 30000. sleepus
- loop
- flash_ddir on
-;
-
-: main
- decimal
- ['] serout 'emit !
- \ sleep1
-
- frob
-
- d# 60 0do cr loop
- s" Welcome! Built " type build. cr
- snap
-
- flash-cold
- \ flash-demo
- \ flash-bytes
- vga-cold
- ['] vga-emit 'emit !
- s" Waiting for Ethernet NIC" statusline
- mac-cold
- nicwork
- h# decafbad. dhcp-xid!
- d# 3000000. dhcp-alarm setalarm
- false if
- ip-addr dz
- begin
- net-my-ip d0=
- while
- dhcp-alarm isalarm if
- dhcp-discover
- s" DISCOVER" type cr
- d# 3000000. dhcp-alarm setalarm
- then
- preip-handler
- repeat
- else
- ip# 192.168.0.99 ip-addr 2!
- ip# 255.255.255.0 ip-subnetmask 2!
- ip# 192.168.0.1 ip-router 2!
- \ ip# 192.168.2.201 ip-addr 2!
- \ ip# 255.255.255.0 ip-subnetmask 2!
- \ ip# 192.168.2.1 ip-router 2!
- then
- dhcp-status
- arp-reset
-
- begin
- welcome-main sleep.1
- clock-main sleep.1
- stars-main sleep.1
- invaders-main sleep.1
- s" looping" type cr
- again
-
- begin
- haveip-handler
- again
-;
-
-
-]module
-
-0 org
-
-code 0jump
- \ h# 3e00 ubranch
- main ubranch
- main ubranch
-end-code
-
-meta
-
-hex
-
-: create-output-file w/o create-file throw to outfile ;
-
-\ .mem is a memory dump formatted for use with the Xilinx
-\ data2mem tool.
-s" j1.mem" create-output-file
-:noname
- s" @ 20000" type cr
- 4000 0 do i t@ s>d <# # # # # #> type cr 2 +loop
-; execute
-
-\ .bin is a big-endian binary memory dump
-s" j1.bin" create-output-file
-:noname 4000 0 do i t@ dup 8 rshift emit emit 2 +loop ; execute
-
-\ .lst file is a human-readable disassembly
-s" j1.lst" create-output-file
-d# 0
-h# 2000 disassemble-block
diff --git a/j1demo/firmware/mkblob.py b/j1demo/firmware/mkblob.py
deleted file mode 100644
index 6623f91..0000000
--- a/j1demo/firmware/mkblob.py
+++ /dev/null
@@ -1,14 +0,0 @@
-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/j1demo/firmware/ntp.fs b/j1demo/firmware/ntp.fs
deleted file mode 100644
index 881296a..0000000
--- a/j1demo/firmware/ntp.fs
+++ /dev/null
@@ -1,36 +0,0 @@
-( 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/j1demo/firmware/nuc.fs b/j1demo/firmware/nuc.fs
deleted file mode 100644
index deadcc7..0000000
--- a/j1demo/firmware/nuc.fs
+++ /dev/null
@@ -1,546 +0,0 @@
-( 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/j1demo/firmware/packet.fs b/j1demo/firmware/packet.fs
deleted file mode 100644
index b188cc5..0000000
--- a/j1demo/firmware/packet.fs
+++ /dev/null
@@ -1,11 +0,0 @@
-( 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/j1demo/firmware/ps2kb.fs b/j1demo/firmware/ps2kb.fs
deleted file mode 100644
index f151971..0000000
--- a/j1demo/firmware/ps2kb.fs
+++ /dev/null
@@ -1,434 +0,0 @@
-( 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/j1demo/firmware/sincos.fs b/j1demo/firmware/sincos.fs
deleted file mode 100644
index 6ad1ea4..0000000
--- a/j1demo/firmware/sincos.fs
+++ /dev/null
@@ -1,36 +0,0 @@
-( 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/j1demo/firmware/sprite.fs b/j1demo/firmware/sprite.fs
deleted file mode 100644
index 877917a..0000000
--- a/j1demo/firmware/sprite.fs
+++ /dev/null
@@ -1,20 +0,0 @@
-( 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/j1demo/firmware/tftp.fs b/j1demo/firmware/tftp.fs
deleted file mode 100644
index da40aa2..0000000
--- a/j1demo/firmware/tftp.fs
+++ /dev/null
@@ -1,67 +0,0 @@
-( 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/j1demo/firmware/time.fs b/j1demo/firmware/time.fs
deleted file mode 100644
index 4d53113..0000000
--- a/j1demo/firmware/time.fs
+++ /dev/null
@@ -1,33 +0,0 @@
-( 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/j1demo/firmware/twist.py b/j1demo/firmware/twist.py
deleted file mode 100644
index 19743f6..0000000
--- a/j1demo/firmware/twist.py
+++ /dev/null
@@ -1,311 +0,0 @@
-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/j1demo/firmware/udp.fs b/j1demo/firmware/udp.fs
deleted file mode 100644
index 835983a..0000000
--- a/j1demo/firmware/udp.fs
+++ /dev/null
@@ -1,41 +0,0 @@
-( 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/j1demo/firmware/version.fs b/j1demo/firmware/version.fs
deleted file mode 100644
index 75e63a9..0000000
--- a/j1demo/firmware/version.fs
+++ /dev/null
@@ -1,2 +0,0 @@
-: version s" 649:659M" ;
-: builddate d# 1291578086. d# -0800 ;