From a76977af62010a392c16010c367185e61e856ffe Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Wed, 30 Oct 2019 20:04:56 +0100 Subject: mv to docs --- buzzard/README | 1 - buzzard/buzzard.2.README | 22 - buzzard/buzzard.2.c | 61 - buzzard/buzzard.2.design | 780 --------- buzzard/buzzard.2.hint | 217 --- buzzard/buzzard.2.orig.c | 61 - buzzard/demo1.1st | 12 - buzzard/demo1.th | 4 - buzzard/demo2.th | 10 - buzzard/demo3.th | 15 - buzzard/demo4.th | 30 - buzzard/demo5.th | 27 - buzzard/demo6.th | 18 - buzzard/help.th | 54 - buzzard/third | 367 ---- doc/README.md | 6 - doc/eForthOverviewv5.pdf | Bin 455143 -> 0 bytes doc/learnforth.fs | 205 --- doc/tcjassem.txt | 805 --------- docs/README.md | 6 + docs/buzzard/README | 1 + docs/buzzard/buzzard.2.README | 22 + docs/buzzard/buzzard.2.c | 61 + docs/buzzard/buzzard.2.design | 780 +++++++++ docs/buzzard/buzzard.2.hint | 217 +++ docs/buzzard/buzzard.2.orig.c | 61 + docs/buzzard/demo1.1st | 12 + docs/buzzard/demo1.th | 4 + docs/buzzard/demo2.th | 10 + docs/buzzard/demo3.th | 15 + docs/buzzard/demo4.th | 30 + docs/buzzard/demo5.th | 27 + docs/buzzard/demo6.th | 18 + docs/buzzard/first.c | 113 ++ docs/buzzard/help.th | 54 + docs/buzzard/third | 367 ++++ docs/eForthOverviewv5.pdf | Bin 0 -> 455143 bytes docs/j1.txt | 57 + docs/j1/.gitignore | 2 + docs/j1/Makefile | 14 + docs/j1/README.md | 4 + docs/j1/build/.empty | 0 docs/j1/build/.gitignore | 2 + docs/j1/go | 5 + docs/j1/sim_main.cpp | 76 + docs/j1/toolchain/basewords.fs | 92 + docs/j1/toolchain/cross.fs | 321 ++++ docs/j1/toolchain/demo1.fs | 7 + docs/j1/toolchain/dump.py | 36 + docs/j1/toolchain/go | 3 + docs/j1/toolchain/nuc.fs | 604 +++++++ docs/j1/toolchain/strings.fs | 25 + docs/j1/verilog/common.h | 3 + docs/j1/verilog/j1.v | 123 ++ docs/j1/verilog/stack.v | 22 + docs/j1/verilog/testbench.v | 30 + docs/j1/verilog/top.v | 9 + docs/j1/verilog/uart.v | 180 ++ docs/j1/verilog/xilinx-top.v | 215 +++ docs/j1/xilinx/.gitignore | 44 + docs/j1/xilinx/Makefile | 11 + docs/j1/xilinx/go | 22 + docs/j1/xilinx/j1-papilioduo.bmm | 24 + docs/j1/xilinx/j1-papilioduo.ucf | 183 ++ docs/j1/xilinx/shell.py | 78 + docs/j1/xilinx/xilinx.mk | 176 ++ docs/j1/xilinx/xilinx.opt | 42 + docs/j1demo/firmware/Makefile | 26 + docs/j1demo/firmware/ans.fs | 46 + docs/j1demo/firmware/arp.fs | 225 +++ docs/j1demo/firmware/basewords.fs | 60 + docs/j1demo/firmware/clock.fs | 90 + docs/j1demo/firmware/crossj1.fs | 527 ++++++ docs/j1demo/firmware/defines_tcpip.fs | 70 + docs/j1demo/firmware/defines_tcpip.py | 94 + docs/j1demo/firmware/defines_tcpip2.fs | 150 ++ docs/j1demo/firmware/defines_tcpip2.py | 215 +++ docs/j1demo/firmware/dhcp.fs | 176 ++ docs/j1demo/firmware/dns.fs | 81 + docs/j1demo/firmware/doc.fs | 20 + docs/j1demo/firmware/document.fs | 3 + docs/j1demo/firmware/encode.py | 28 + docs/j1demo/firmware/eth-ax88796.fs | 506 ++++++ docs/j1demo/firmware/font8x8 | Bin 0 -> 768 bytes docs/j1demo/firmware/fsm-32.png | Bin 0 -> 1489 bytes docs/j1demo/firmware/genoffsets.py | 11 + docs/j1demo/firmware/go | 16 + docs/j1demo/firmware/hwdefs.fs | 57 + docs/j1demo/firmware/intelhex.py | 643 +++++++ docs/j1demo/firmware/invaders.fs | 362 ++++ docs/j1demo/firmware/ip.fs | 124 ++ docs/j1demo/firmware/ip0.fs | 70 + docs/j1demo/firmware/j1.png | Bin 0 -> 3262 bytes docs/j1demo/firmware/keycodes.fs | 28 + docs/j1demo/firmware/loader.fs | 114 ++ docs/j1demo/firmware/main.fs | 799 +++++++++ docs/j1demo/firmware/mkblob.py | 14 + docs/j1demo/firmware/ntp.fs | 36 + docs/j1demo/firmware/nuc.fs | 546 ++++++ docs/j1demo/firmware/packet.fs | 11 + docs/j1demo/firmware/ps2kb.fs | 434 +++++ docs/j1demo/firmware/sincos.fs | 36 + docs/j1demo/firmware/sprite.fs | 20 + docs/j1demo/firmware/tftp.fs | 67 + docs/j1demo/firmware/time.fs | 33 + docs/j1demo/firmware/twist.py | 311 ++++ docs/j1demo/firmware/udp.fs | 41 + docs/j1demo/firmware/version.fs | 2 + docs/j1demo/j1.pdf | Bin 0 -> 124188 bytes docs/j1demo/synth/Makefile | 9 + docs/j1demo/synth/j1.bmm | 12 + docs/j1demo/synth/j1.ucf | 327 ++++ docs/j1demo/synth/xilinx.mk | 174 ++ docs/j1demo/synth/xilinx.opt | 42 + docs/j1demo/verilog/ck_div.v | 41 + docs/j1demo/verilog/j1.v | 187 ++ docs/j1demo/verilog/rams.v | 36 + docs/j1demo/verilog/top.v | 667 +++++++ docs/j1eforth/Makefile | 12 + docs/j1eforth/README.md | 99 ++ docs/j1eforth/fpga/papilio-pro-j1.xise | 422 +++++ docs/j1eforth/fpga/papilio_pro_j1.bit | Bin 0 -> 340703 bytes docs/j1eforth/fpga/src/Rxunit.vhd | 97 ++ docs/j1eforth/fpga/src/Txunit.vhd | 100 ++ docs/j1eforth/fpga/src/clock.vhd | 78 + docs/j1eforth/fpga/src/j1.v | 199 +++ docs/j1eforth/fpga/src/miniuart.vhd | 146 ++ docs/j1eforth/fpga/src/papilio-pro-j1.vhd | 117 ++ docs/j1eforth/fpga/src/papilio-pro.ucf | 143 ++ docs/j1eforth/fpga/src/utils.vhd | 132 ++ docs/j1eforth/fpga/test/miniuart2_tb.vhd | 128 ++ docs/j1eforth/fpga/test/papilio_pro_j1_tb.vhd | 96 + docs/j1eforth/ipv4.4th | 249 +++ docs/j1eforth/j1.4th | 910 ++++++++++ docs/j1eforth/j1.c | 162 ++ docs/jonesforth/Dockerfile | 6 + docs/jonesforth/docker-compose.yml | 6 + docs/jonesforth/jonesforth.S | 2313 +++++++++++++++++++++++++ docs/jonesforth/jonesforth.fs | 1790 +++++++++++++++++++ docs/jonesforth/run.sh | 3 + docs/learnforth.fs | 205 +++ docs/samples.fs | 2 + docs/tcjassem.txt | 805 +++++++++ go.mod | 2 + j1/.gitignore | 2 - j1/Makefile | 14 - j1/README.md | 4 - j1/build/.empty | 0 j1/build/.gitignore | 2 - j1/go | 5 - j1/sim_main.cpp | 76 - j1/toolchain/basewords.fs | 92 - j1/toolchain/cross.fs | 321 ---- j1/toolchain/demo1.fs | 7 - j1/toolchain/dump.py | 36 - j1/toolchain/go | 3 - j1/toolchain/nuc.fs | 604 ------- j1/toolchain/strings.fs | 25 - j1/verilog/common.h | 3 - j1/verilog/j1.v | 123 -- j1/verilog/stack.v | 22 - j1/verilog/testbench.v | 30 - j1/verilog/top.v | 9 - j1/verilog/uart.v | 180 -- j1/verilog/xilinx-top.v | 215 --- j1/xilinx/.gitignore | 44 - j1/xilinx/Makefile | 11 - j1/xilinx/go | 22 - j1/xilinx/j1-papilioduo.bmm | 24 - j1/xilinx/j1-papilioduo.ucf | 183 -- j1/xilinx/shell.py | 78 - j1/xilinx/xilinx.mk | 176 -- j1/xilinx/xilinx.opt | 42 - j1demo/firmware/Makefile | 26 - j1demo/firmware/ans.fs | 46 - j1demo/firmware/arp.fs | 225 --- j1demo/firmware/basewords.fs | 60 - j1demo/firmware/clock.fs | 90 - j1demo/firmware/crossj1.fs | 527 ------ j1demo/firmware/defines_tcpip.fs | 70 - j1demo/firmware/defines_tcpip.py | 94 - j1demo/firmware/defines_tcpip2.fs | 150 -- j1demo/firmware/defines_tcpip2.py | 215 --- j1demo/firmware/dhcp.fs | 176 -- j1demo/firmware/dns.fs | 81 - j1demo/firmware/doc.fs | 20 - j1demo/firmware/document.fs | 3 - j1demo/firmware/encode.py | 28 - j1demo/firmware/eth-ax88796.fs | 506 ------ j1demo/firmware/font8x8 | Bin 768 -> 0 bytes j1demo/firmware/fsm-32.png | Bin 1489 -> 0 bytes j1demo/firmware/genoffsets.py | 11 - j1demo/firmware/go | 16 - j1demo/firmware/hwdefs.fs | 57 - j1demo/firmware/intelhex.py | 643 ------- j1demo/firmware/invaders.fs | 362 ---- j1demo/firmware/ip.fs | 124 -- j1demo/firmware/ip0.fs | 70 - j1demo/firmware/j1.png | Bin 3262 -> 0 bytes j1demo/firmware/keycodes.fs | 28 - j1demo/firmware/loader.fs | 114 -- j1demo/firmware/main.fs | 799 --------- j1demo/firmware/mkblob.py | 14 - j1demo/firmware/ntp.fs | 36 - j1demo/firmware/nuc.fs | 546 ------ j1demo/firmware/packet.fs | 11 - j1demo/firmware/ps2kb.fs | 434 ----- j1demo/firmware/sincos.fs | 36 - j1demo/firmware/sprite.fs | 20 - j1demo/firmware/tftp.fs | 67 - j1demo/firmware/time.fs | 33 - j1demo/firmware/twist.py | 311 ---- j1demo/firmware/udp.fs | 41 - j1demo/firmware/version.fs | 2 - j1demo/j1.pdf | Bin 124188 -> 0 bytes j1demo/synth/Makefile | 9 - j1demo/synth/j1.bmm | 12 - j1demo/synth/j1.ucf | 327 ---- j1demo/synth/xilinx.mk | 174 -- j1demo/synth/xilinx.opt | 42 - j1demo/verilog/ck_div.v | 41 - j1demo/verilog/j1.v | 187 -- j1demo/verilog/rams.v | 36 - j1demo/verilog/top.v | 667 ------- j1eforth/Makefile | 12 - j1eforth/README.md | 99 -- j1eforth/fpga/papilio-pro-j1.xise | 422 ----- j1eforth/fpga/papilio_pro_j1.bit | Bin 340703 -> 0 bytes j1eforth/fpga/src/Rxunit.vhd | 97 -- j1eforth/fpga/src/Txunit.vhd | 100 -- j1eforth/fpga/src/clock.vhd | 78 - j1eforth/fpga/src/j1.v | 199 --- j1eforth/fpga/src/miniuart.vhd | 146 -- j1eforth/fpga/src/papilio-pro-j1.vhd | 117 -- j1eforth/fpga/src/papilio-pro.ucf | 143 -- j1eforth/fpga/src/utils.vhd | 132 -- j1eforth/fpga/test/miniuart2_tb.vhd | 128 -- j1eforth/fpga/test/papilio_pro_j1_tb.vhd | 96 - j1eforth/ipv4.4th | 249 --- j1eforth/j1.4th | 910 ---------- j1eforth/j1.c | 162 -- jonesforth/Dockerfile | 6 - jonesforth/docker-compose.yml | 6 - jonesforth/jonesforth.S | 2313 ------------------------- jonesforth/jonesforth.fs | 1790 ------------------- jonesforth/run.sh | 3 - 246 files changed, 20017 insertions(+), 19843 deletions(-) delete mode 100644 buzzard/README delete mode 100644 buzzard/buzzard.2.README delete mode 100644 buzzard/buzzard.2.c delete mode 100644 buzzard/buzzard.2.design delete mode 100644 buzzard/buzzard.2.hint delete mode 100644 buzzard/buzzard.2.orig.c delete mode 100644 buzzard/demo1.1st delete mode 100644 buzzard/demo1.th delete mode 100644 buzzard/demo2.th delete mode 100644 buzzard/demo3.th delete mode 100644 buzzard/demo4.th delete mode 100644 buzzard/demo5.th delete mode 100644 buzzard/demo6.th delete mode 100644 buzzard/help.th delete mode 100644 buzzard/third delete mode 100644 doc/README.md delete mode 100644 doc/eForthOverviewv5.pdf delete mode 100644 doc/learnforth.fs delete mode 100644 doc/tcjassem.txt create mode 100644 docs/README.md create mode 100644 docs/buzzard/README create mode 100644 docs/buzzard/buzzard.2.README create mode 100644 docs/buzzard/buzzard.2.c create mode 100644 docs/buzzard/buzzard.2.design create mode 100644 docs/buzzard/buzzard.2.hint create mode 100644 docs/buzzard/buzzard.2.orig.c create mode 100644 docs/buzzard/demo1.1st create mode 100644 docs/buzzard/demo1.th create mode 100644 docs/buzzard/demo2.th create mode 100644 docs/buzzard/demo3.th create mode 100644 docs/buzzard/demo4.th create mode 100644 docs/buzzard/demo5.th create mode 100644 docs/buzzard/demo6.th create mode 100644 docs/buzzard/first.c create mode 100644 docs/buzzard/help.th create mode 100644 docs/buzzard/third create mode 100644 docs/eForthOverviewv5.pdf create mode 100644 docs/j1.txt create mode 100644 docs/j1/.gitignore create mode 100644 docs/j1/Makefile create mode 100644 docs/j1/README.md create mode 100644 docs/j1/build/.empty create mode 100644 docs/j1/build/.gitignore create mode 100644 docs/j1/go create mode 100644 docs/j1/sim_main.cpp create mode 100644 docs/j1/toolchain/basewords.fs create mode 100644 docs/j1/toolchain/cross.fs create mode 100644 docs/j1/toolchain/demo1.fs create mode 100644 docs/j1/toolchain/dump.py create mode 100644 docs/j1/toolchain/go create mode 100644 docs/j1/toolchain/nuc.fs create mode 100644 docs/j1/toolchain/strings.fs create mode 100644 docs/j1/verilog/common.h create mode 100644 docs/j1/verilog/j1.v create mode 100644 docs/j1/verilog/stack.v create mode 100644 docs/j1/verilog/testbench.v create mode 100644 docs/j1/verilog/top.v create mode 100644 docs/j1/verilog/uart.v create mode 100644 docs/j1/verilog/xilinx-top.v create mode 100644 docs/j1/xilinx/.gitignore create mode 100644 docs/j1/xilinx/Makefile create mode 100644 docs/j1/xilinx/go create mode 100644 docs/j1/xilinx/j1-papilioduo.bmm create mode 100644 docs/j1/xilinx/j1-papilioduo.ucf create mode 100644 docs/j1/xilinx/shell.py create mode 100644 docs/j1/xilinx/xilinx.mk create mode 100644 docs/j1/xilinx/xilinx.opt create mode 100644 docs/j1demo/firmware/Makefile create mode 100644 docs/j1demo/firmware/ans.fs create mode 100644 docs/j1demo/firmware/arp.fs create mode 100644 docs/j1demo/firmware/basewords.fs create mode 100644 docs/j1demo/firmware/clock.fs create mode 100644 docs/j1demo/firmware/crossj1.fs create mode 100644 docs/j1demo/firmware/defines_tcpip.fs create mode 100644 docs/j1demo/firmware/defines_tcpip.py create mode 100644 docs/j1demo/firmware/defines_tcpip2.fs create mode 100644 docs/j1demo/firmware/defines_tcpip2.py create mode 100644 docs/j1demo/firmware/dhcp.fs create mode 100644 docs/j1demo/firmware/dns.fs create mode 100644 docs/j1demo/firmware/doc.fs create mode 100644 docs/j1demo/firmware/document.fs create mode 100644 docs/j1demo/firmware/encode.py create mode 100644 docs/j1demo/firmware/eth-ax88796.fs create mode 100644 docs/j1demo/firmware/font8x8 create mode 100644 docs/j1demo/firmware/fsm-32.png create mode 100644 docs/j1demo/firmware/genoffsets.py create mode 100644 docs/j1demo/firmware/go create mode 100644 docs/j1demo/firmware/hwdefs.fs create mode 100644 docs/j1demo/firmware/intelhex.py create mode 100644 docs/j1demo/firmware/invaders.fs create mode 100644 docs/j1demo/firmware/ip.fs create mode 100644 docs/j1demo/firmware/ip0.fs create mode 100644 docs/j1demo/firmware/j1.png create mode 100644 docs/j1demo/firmware/keycodes.fs create mode 100644 docs/j1demo/firmware/loader.fs create mode 100644 docs/j1demo/firmware/main.fs create mode 100644 docs/j1demo/firmware/mkblob.py create mode 100644 docs/j1demo/firmware/ntp.fs create mode 100644 docs/j1demo/firmware/nuc.fs create mode 100644 docs/j1demo/firmware/packet.fs create mode 100644 docs/j1demo/firmware/ps2kb.fs create mode 100644 docs/j1demo/firmware/sincos.fs create mode 100644 docs/j1demo/firmware/sprite.fs create mode 100644 docs/j1demo/firmware/tftp.fs create mode 100644 docs/j1demo/firmware/time.fs create mode 100644 docs/j1demo/firmware/twist.py create mode 100644 docs/j1demo/firmware/udp.fs create mode 100644 docs/j1demo/firmware/version.fs create mode 100644 docs/j1demo/j1.pdf create mode 100644 docs/j1demo/synth/Makefile create mode 100644 docs/j1demo/synth/j1.bmm create mode 100644 docs/j1demo/synth/j1.ucf create mode 100644 docs/j1demo/synth/xilinx.mk create mode 100644 docs/j1demo/synth/xilinx.opt create mode 100644 docs/j1demo/verilog/ck_div.v create mode 100644 docs/j1demo/verilog/j1.v create mode 100644 docs/j1demo/verilog/rams.v create mode 100644 docs/j1demo/verilog/top.v create mode 100644 docs/j1eforth/Makefile create mode 100644 docs/j1eforth/README.md create mode 100644 docs/j1eforth/fpga/papilio-pro-j1.xise create mode 100644 docs/j1eforth/fpga/papilio_pro_j1.bit create mode 100644 docs/j1eforth/fpga/src/Rxunit.vhd create mode 100644 docs/j1eforth/fpga/src/Txunit.vhd create mode 100644 docs/j1eforth/fpga/src/clock.vhd create mode 100644 docs/j1eforth/fpga/src/j1.v create mode 100644 docs/j1eforth/fpga/src/miniuart.vhd create mode 100644 docs/j1eforth/fpga/src/papilio-pro-j1.vhd create mode 100644 docs/j1eforth/fpga/src/papilio-pro.ucf create mode 100644 docs/j1eforth/fpga/src/utils.vhd create mode 100644 docs/j1eforth/fpga/test/miniuart2_tb.vhd create mode 100644 docs/j1eforth/fpga/test/papilio_pro_j1_tb.vhd create mode 100644 docs/j1eforth/ipv4.4th create mode 100644 docs/j1eforth/j1.4th create mode 100644 docs/j1eforth/j1.c create mode 100644 docs/jonesforth/Dockerfile create mode 100644 docs/jonesforth/docker-compose.yml create mode 100644 docs/jonesforth/jonesforth.S create mode 100644 docs/jonesforth/jonesforth.fs create mode 100755 docs/jonesforth/run.sh create mode 100644 docs/learnforth.fs create mode 100644 docs/samples.fs create mode 100644 docs/tcjassem.txt delete mode 100644 j1/.gitignore delete mode 100644 j1/Makefile delete mode 100644 j1/README.md delete mode 100644 j1/build/.empty delete mode 100644 j1/build/.gitignore delete mode 100644 j1/go delete mode 100644 j1/sim_main.cpp delete mode 100644 j1/toolchain/basewords.fs delete mode 100644 j1/toolchain/cross.fs delete mode 100644 j1/toolchain/demo1.fs delete mode 100644 j1/toolchain/dump.py delete mode 100644 j1/toolchain/go delete mode 100644 j1/toolchain/nuc.fs delete mode 100644 j1/toolchain/strings.fs delete mode 100644 j1/verilog/common.h delete mode 100644 j1/verilog/j1.v delete mode 100644 j1/verilog/stack.v delete mode 100644 j1/verilog/testbench.v delete mode 100644 j1/verilog/top.v delete mode 100644 j1/verilog/uart.v delete mode 100644 j1/verilog/xilinx-top.v delete mode 100644 j1/xilinx/.gitignore delete mode 100644 j1/xilinx/Makefile delete mode 100644 j1/xilinx/go delete mode 100644 j1/xilinx/j1-papilioduo.bmm delete mode 100644 j1/xilinx/j1-papilioduo.ucf delete mode 100644 j1/xilinx/shell.py delete mode 100644 j1/xilinx/xilinx.mk delete mode 100644 j1/xilinx/xilinx.opt delete mode 100644 j1demo/firmware/Makefile delete mode 100644 j1demo/firmware/ans.fs delete mode 100644 j1demo/firmware/arp.fs delete mode 100644 j1demo/firmware/basewords.fs delete mode 100644 j1demo/firmware/clock.fs delete mode 100644 j1demo/firmware/crossj1.fs delete mode 100644 j1demo/firmware/defines_tcpip.fs delete mode 100644 j1demo/firmware/defines_tcpip.py delete mode 100644 j1demo/firmware/defines_tcpip2.fs delete mode 100644 j1demo/firmware/defines_tcpip2.py delete mode 100644 j1demo/firmware/dhcp.fs delete mode 100644 j1demo/firmware/dns.fs delete mode 100644 j1demo/firmware/doc.fs delete mode 100644 j1demo/firmware/document.fs delete mode 100644 j1demo/firmware/encode.py delete mode 100644 j1demo/firmware/eth-ax88796.fs delete mode 100644 j1demo/firmware/font8x8 delete mode 100644 j1demo/firmware/fsm-32.png delete mode 100644 j1demo/firmware/genoffsets.py delete mode 100644 j1demo/firmware/go delete mode 100644 j1demo/firmware/hwdefs.fs delete mode 100644 j1demo/firmware/intelhex.py delete mode 100644 j1demo/firmware/invaders.fs delete mode 100644 j1demo/firmware/ip.fs delete mode 100644 j1demo/firmware/ip0.fs delete mode 100644 j1demo/firmware/j1.png delete mode 100644 j1demo/firmware/keycodes.fs delete mode 100644 j1demo/firmware/loader.fs delete mode 100644 j1demo/firmware/main.fs delete mode 100644 j1demo/firmware/mkblob.py delete mode 100644 j1demo/firmware/ntp.fs delete mode 100644 j1demo/firmware/nuc.fs delete mode 100644 j1demo/firmware/packet.fs delete mode 100644 j1demo/firmware/ps2kb.fs delete mode 100644 j1demo/firmware/sincos.fs delete mode 100644 j1demo/firmware/sprite.fs delete mode 100644 j1demo/firmware/tftp.fs delete mode 100644 j1demo/firmware/time.fs delete mode 100644 j1demo/firmware/twist.py delete mode 100644 j1demo/firmware/udp.fs delete mode 100644 j1demo/firmware/version.fs delete mode 100644 j1demo/j1.pdf delete mode 100644 j1demo/synth/Makefile delete mode 100644 j1demo/synth/j1.bmm delete mode 100644 j1demo/synth/j1.ucf delete mode 100644 j1demo/synth/xilinx.mk delete mode 100644 j1demo/synth/xilinx.opt delete mode 100644 j1demo/verilog/ck_div.v delete mode 100644 j1demo/verilog/j1.v delete mode 100644 j1demo/verilog/rams.v delete mode 100644 j1demo/verilog/top.v delete mode 100644 j1eforth/Makefile delete mode 100644 j1eforth/README.md delete mode 100644 j1eforth/fpga/papilio-pro-j1.xise delete mode 100644 j1eforth/fpga/papilio_pro_j1.bit delete mode 100644 j1eforth/fpga/src/Rxunit.vhd delete mode 100644 j1eforth/fpga/src/Txunit.vhd delete mode 100644 j1eforth/fpga/src/clock.vhd delete mode 100644 j1eforth/fpga/src/j1.v delete mode 100644 j1eforth/fpga/src/miniuart.vhd delete mode 100644 j1eforth/fpga/src/papilio-pro-j1.vhd delete mode 100644 j1eforth/fpga/src/papilio-pro.ucf delete mode 100644 j1eforth/fpga/src/utils.vhd delete mode 100644 j1eforth/fpga/test/miniuart2_tb.vhd delete mode 100644 j1eforth/fpga/test/papilio_pro_j1_tb.vhd delete mode 100644 j1eforth/ipv4.4th delete mode 100644 j1eforth/j1.4th delete mode 100644 j1eforth/j1.c delete mode 100644 jonesforth/Dockerfile delete mode 100644 jonesforth/docker-compose.yml delete mode 100644 jonesforth/jonesforth.S delete mode 100644 jonesforth/jonesforth.fs delete mode 100755 jonesforth/run.sh diff --git a/buzzard/README b/buzzard/README deleted file mode 100644 index e95ba91..0000000 --- a/buzzard/README +++ /dev/null @@ -1 +0,0 @@ -See http://www.ioccc.org/1992/ diff --git a/buzzard/buzzard.2.README b/buzzard/buzzard.2.README deleted file mode 100644 index ee59a3b..0000000 --- a/buzzard/buzzard.2.README +++ /dev/null @@ -1,22 +0,0 @@ -buzzard.2.README this file -buzzard.2.design description of FIRST (design documentation of THIRD) -third implementation of THIRD in FIRST -help.th online listing of THIRD primitives - - FIRST demos: use 'first < {demo}' - -demo1.1st prints Hello World! assuming ASCII - - THIRD demos: use 'cat third {demo} | first' - -demo1.th prints Hello World! regardless of character set -demo2.th demonstrates a simple loop -demo3.th demonstrates a simple if test -demo4.th recursive factorial calculating on the way up -demo5.th recursive factorial calculating on the way down -demo6.th demonstrates switching from compiler to execution mode - - Interactive THIRD: use 'cat third - | first'. - - To include the primitive on-line help, use - 'cat third help.th - | first'. diff --git a/buzzard/buzzard.2.c b/buzzard/buzzard.2.c deleted file mode 100644 index 4765458..0000000 --- a/buzzard/buzzard.2.c +++ /dev/null @@ -1,61 +0,0 @@ -#define c m[m[0]++] = -#define z;break;case - -char s[5000]; -int m[20000]={32},L=1,I,T[500],*S=T,t=64,w,f; - -a(x) -{ - c L; - L= *m-1; - c t; - c x; - scanf("%s",s+t); - t+=strlen(s+t)+1; -} - -r(x) -{ - switch(m[x++]){ - z 5: for(w=scanf("%s",s)<1?exit(0),0:L;strcmp(s,&s[m[w+1]]);w=m[w]); - w-1 ? r(w+2) : (c 2,c atoi(s)) - z 12: I=m[m[1]--] - z 15: f=S[-f] - z 1: c x - z 9: f *=* S-- - z 7: m[f]= *S--; - f= *S-- - z 0: *++S=f; - f=m[I++] - z 8: f= *S --- f - z 2: m[++m[1]]=I; - I=x - z 11: f=0>f - z 4: *m-=2;c 2 - z 6: f=m[f] - z 10: f= *S--/f - z 3: a(1); - c 2 - z 13: putchar(f); - f= *S-- - z 14: *++S=f; - f=getchar(); - } -} - -main() -{ - a(3); - a(4); - a(1); - w= *m; - c 5; - c 2; - I= *m; - c w; - c I-1; - for(w=6;w<16;) - a(1),c w++; - m[1]= *m; - for(*m+=512;;r(m[I++])); -} diff --git a/buzzard/buzzard.2.design b/buzzard/buzzard.2.design deleted file mode 100644 index 49b2e2d..0000000 --- a/buzzard/buzzard.2.design +++ /dev/null @@ -1,780 +0,0 @@ - FIRST & THIRD - almost FORTH - - FORTH is a language mostly familiar to users of "small" machines. -FORTH programs are small because they are interpreted--a function -call in FORTH takes two bytes. FORTH is an extendable language-- -built-in primitives are indistinguishable from user-defined -_words_. FORTH interpreters are small because much of the system -can be coded in FORTH--only a small number of primitives need to -be implemented. Some FORTH interpreters can also compile defined -words into machine code, resulting in a fast system. - - FIRST is an incredibly small language which is sufficient for -defining the language THIRD, which is mostly like FORTH. There are -some differences, and THIRD is probably just enough like FORTH for -those differences to be disturbing to regular FORTH users. - - The only existing FIRST interpreter is written in obfuscated C, -and rings in at under 800 bytes of source code, although through -deletion of whitespace and unobfuscation it can be brought to about -650 bytes. - - This document FIRST defines the FIRST environment and primitives, -with relevent design decision explanations. It secondly documents -the general strategies we will use to implement THIRD. The THIRD -section demonstrates how the complete THIRD system is built up -using FIRST. - - -Section 1: FIRST - - -Environment - - FIRST implements a virtual machine. The machine has three chunks -of memory: "main memory", "the stack", and "string storage". When -the virtual machine wishes to do random memory accesses, they come -out of main memory--it cannot access the stack or string storage. - - The stack is simply a standard LIFO data structure that is used -implicitly by most of the FIRST primitives. The stack is made up -of ints, whatever size they are on the host machine. - - String storage is used to store the names of built-in and defined -primitives. Separate storage is used for these because it allows -the C code to use C string operations, reducing C source code size. - - Main memory is a large array of ints. When we speak of -addresses, we actually mean indices into main memory. Main memory -is used for two things, primarily: the return stack and the dictionary. - - The return stack is a LIFO data structure, independent of -the abovementioned "the stack", which is used by FIRST to keep -track of function call return addresses. - - The dictionary is a list of words. Each word contains a header -and a data field. In the header is the address of the previous word, -an index into the string storage indicating where the name of this -word is stored, and a "code pointer". The code pointer is simply -an integer which names which "machine-language-primitive" implements -this instruction. For example, for defined words the code pointer -names the "run some code" primitive, which pushes the current program -counter onto the return stack and sets the counter to the address of -the data field for this word. - - There are several important pointers into main memory. There is -a pointer to the most recently defined word, which is used to start -searches back through memory when compiling words. There is a pointer -to the top of the return stack. There is a pointer to the current -end of the dictionary, used while compiling. - - For the last two pointers, namely the return stack pointer and -the dictionary pointer, there is an important distinction: the pointers -themselves are stored in main memory (in FIRST's main memory). This -is critical, because it means FIRST programs can get at them without -any further primitives needing to be defined. - - -Instructions - - There are two kinds of FIRST instructions, normal instructions and -immediate instructions. Immediate instructions do something significant -when they are used. Normal instructions compile a pointer to their -executable part onto the end of the dictionary. As we will see, this -means that by default FIRST simply compiles things. - - Integer Operations -Symbol Name Function - - binary minus pop top 2 elements of stack, subtract, push - * multiply pop top 2 elements of stack, multiply, push - / divide pop top 2 elements of stack, divide, push - <0 less than 0 pop top element of stack, push 1 if < 0 else 0 - -Note that we can synthesize addition and negation from binary minus, -but we cannot synthesize a time efficient divide or multiply from it. -<0 is synthesizable, but only nonportably. - - Memory Operations -Symbol Name Function - @ fetch pop top of stack, treat as address to push contents of - ! store top of stack is address, 2nd is value; store to memory - and pop both off the stack - - Input/Output Operations -Name Function -echo output top of stack through C's putchar() -key push C's getchar() onto top of stack -_read read a space-delimited word, find it in the - dictionary, and compile a pointer to - that word's code pointer onto the - current end of the dictionary - -Although _read could be synthesized from key, we need _read to be able -to compile words to be able to start any syntheses. - - Execution Operations -Name Function -exit leave the current function: pop the return stack - into the program counter - - Immediate (compilation) Operations -Symbol Name Function - : define read in the next space-delimited word, add it to - the end of our string storage, and generate - a header for the new word so that when it - is typed it compiles a pointer to itself - so that it can be executed. -immediate immediate when used immediately after a name following a ':', - makes the word being defined run whenever - it is typed. - -: cannot be synthesized, because we could not synthesize anything. -immediate has to be an immediate operation, so it could not be -synthesized unless by default operations were immediate; but that -would preclude our being able to do any useful compilation. - - Stack Operations -Name Function -pick pop top of stack, use as index into stack and copy up - that element - -If the data stack were stored in main memory, we could synthesize pick; -but putting the stack and stack pointer in main memory would significantly -increase the C source code size. - - There are three more primitives, but they are "internal only"-- -they have no names and no dictionary entries. The first is -"pushint". It takes the next integer out of the instruction stream -and pushes it on the stack. This could be synthesized, but probably -not without using integer constants. It is generated by _read when -the input is not a known word. The second is "compile me". When -this instruction is executed, a pointer to the word's data field is -appended to the dictionary. The third is "run me"--the word's data -field is taken to be a stream of pointers to words, and is executed. - - One last note about the environment: FIRST builds a very small -word internally that it executes as its main loop. This word calls -_read and then calls itself. Each time it calls itself, it uses -up a word on the return stack, so it will eventually trash things. -This is discussed some more in section 2. - - -Here's a handy summary of all the FIRST words: - - - * / binary integer operations on the stack - <0 is top of stack less than 0? - @ ! read from or write to memory - echo key output or input one character - _read read a word from input and compile a pointer to it - exit stop running the current function - : compile the header of a definition - immediate modify the header to create an immediate word - - Here is a sample FIRST program. I'm assuming you're using -the ASCII character set. FIRST does not depend upon ASCII, but -since FIRST has no syntax for character constants, one normally has -to use decimal values. This can be gotten around using getchar, though. -Oh. One other odd thing. FIRST initially builds its symbol table -by calling : several times, so it needs to get the names of the base -symbols as its first 13 words of input. You could even name them -differently if you wanted. - These FIRST programs have FORTH comments in them: they are contained -inside parentheses. FIRST programs cannot have FORTH comments; but I need -some device to indicate what's going on. (THIRD programs are an entirely -different subject.) - - ( Our first line gives the symbols for the built-ins ) -: immediate _read @ ! - * / <0 exit echo key _pick - - ( now we define a simple word that will print out a couple characters ) - -: L ( define a word named 'L' ) - 108 echo ( output an ascii 'l' ) - exit - -: hello ( define a word named 'hello') - 72 echo ( output an ascii 'H' ) - 101 echo ( output an ascii 'e' ) - 111 ( push ascii 'o' onto the stack ) - L L ( output two ascii 'l's ) - echo ( output the 'o' we pushed on the stack before ) - 10 echo ( print a newline ) - exit ( stop running this routine ) - -: test immediate ( define a word named 'test' that runs whenever typed ) - hello ( call hello ) - exit - -test - -( The result of running this program should be: -Hello -) - - -Section 2: Motivating THIRD - - What is missing from FIRST? There are a large number of -important primitives that aren't implemented, but which are -easy to implement. drop , which throws away the top of the -stack, can be implemented as { 0 * + } -- that is, multiply -the top of the stack by 0 (which turns the top of the stack -into a 0), and then add the top two elements of the stack. - - dup , which copies the top of the stack, can be easily -implemented using temporary storage locations. Conveniently, -FIRST leaves memory locations 3, 4, and 5 unused. So we can -implement dup by writing the top of stack into 3, and then -reading it out twice: { 3 ! 3 @ 3 @ }. - - we will never use the FIRST primitive 'pick' in building THIRD, -just to show that it can be done; 'pick' is only provided because -pick itself cannot be built out of the rest of FIRST's building -blocks. - - So, instead of worrying about stack primitives and the -like, what else is missing from FIRST? We get recursion, but -no control flow--no conditional operations. We cannot at the -moment write a looping routine which terminates. - - Another glaring dissimilarity between FIRST and FORTH is -that there is no "command mode"--you cannot be outside of a -: definition and issue some straight commands to be executed. -Also, as we noted above, we cannot do comments. - - FORTH also provides a system for defining new data types, -using the words [in one version of FORTH] . -We would like to implement these words as well. - - As the highest priority thing, we will build control flow -structures first. Once we have control structures, we can -write recursive routines that terminate, and we are ready to -tackle tasks like parsing, and the building of a command mode. - - By the way, location 0 holds the dictionary pointer, location -1 holds the return stack pointer, and location 2 should always -be 0--it's a fake dictionary entry that means "pushint". - - -Section 3: Building THIRD - - In this section, I'm going to keep my conversation - indented to this depth, rather than using fake comments-- - because we'll have real comments eventually. - - The first thing we have to do is give the symbols for our - built-ins. - -: immediate _read @ ! - * / < exit echo key _pick - - Next we want to be mildly self commenting, so we define - the word 'r' to push the *address of the return stack - pointer* onto the stack--NOT the value of the return - stack pointer. (In fact, when we run r, the value of - the return stack pointer is temporarily changed.) - -: r 1 exit - - Next, we're currently executing a short loop that contains - _read and recursion, which is slowly blowing up the return - stack. So let's define a new word, from which you can - never return. What it does is drops the top value off - the return stack, calls _read, then calls itself. Because - it kills the top of the return stack, it can recurse - indefinitely. - -: ] - r @ Get the value of the return stack pointer - 1 - Subtract one - r ! Store it back into the return stack pointer - _read Read and compile one word - ] Start over - - Notice that we don't need to exit, since we never come - back. Also, it's possible that an immediate word may - get run during _read, and that _read will never return! - - Now let's get compile running. - -: main immediate ] -main - - Next off, I'm going to do this the easy but non-portable - way, and put some character constant definitions in. - I wanted them at the top of the file, but that would have - burned too much of the return stack. - -: '"' 34 exit -: ')' 41 exit -: '\n' 10 exit -: 'space' 32 exit -: '0' 48 exit -: '-' 45 exit - -: cr '\n' echo exit - - Next, we want to define some temporary variables for - locations 3, 4, and 5, since this'll make our code look - clearer. -: _x 3 @ exit -: _x! 3 ! exit -: _y 4 @ exit -: _y! 4 ! exit - - Ok. Now, we want to make THIRD look vaguely like FORTH, - so we're going to define ';'. What ; ought to do is - terminate a compilation, and turn control over to the - command-mode handler. We don't have one, so all we want - ';' to do for now is compile 'exit' at the end of the - current word. To do this we'll need several other words. - - Swap by writing out the top two elements into temps, and - then reading them back in the other order. -: swap _x! _y! _x _y exit - Take another look and make sure you see why that works, - since it LOOKS like I'm reading them back in the same - order--in fact, it not only looks like it, but I AM! - - Addition might be nice to have. To add, we need to - negate the top element of the stack, and then subtract. - To negate, we subtract from 0. -: + - 0 swap - - - - exit - - Create a copy of the top of stack -: dup _x! _x _x exit - - Get a mnemonic name for our dictionary pointer--we need - to compile stuff, so it goes through this. -: h 0 exit - - We're going to need to advance that pointer, so let's - make a generic pointer-advancing function. - Given a pointer to a memory location, increment the value - at that memory location. -: inc - dup @ Get another copy of the address, and get the value - so now we have value, address on top of stack. - 1 + Add one to the value - swap Swap to put the address on top of the stack - ! exit Write it to memory - - , is a standard FORTH word. It should write the top of - stack into the dictionary, and advance the pointer -: , - h @ Get the value of the dictionary pointer - ! Write the top of stack there - h inc And increment the dictionary pointer - exit - - ' is a standard FORTH word. It should push the address - of the word that follows it onto the stack. We could - do this by making ' immediate, but then it'd need to - parse the next word. Instead, we compile the next word - as normal. When ' is executed, the top of the return - stack will point into the instruction stream immediately - after the ' . We push the word there, and advance the - return stack pointer so that we don't execute it. -: ' - r @ Get the address of the top of return stack - We currently have a pointer to the top of return stack - @ Get the value from there - We currently have a pointer to the instruction stream - dup Get another copy of it--the bottom copy will stick - around until the end of this word - 1 + Increment the pointer, pointing to the NEXT instruction - r @ ! Write it back onto the top of the return stack - We currently have our first copy of the old pointer - to the instruction stream - @ Get the value there--the address of the "next word" - exit - - Now we're set. ; should be an immediate word that pushes - the address of exit onto the stack, then writes it out. -: ; immediate - ' exit Get the address of exit - , Compile it - exit And we should return - - Now let's test out ; by defining a useful word: -: drop 0 * + ; - - Since we have 'inc', we ought to make 'dec': -: dec dup @ 1 - swap ! ; - - Our next goal, now that we have ;, is to implement - if-then. To do this, we'll need to play fast and - loose with the return stack, so let's make some - words to save us some effort. - - First we want a word that pops off the top of the normal - stack and pushes it on top of the return stack. We'll - call this 'tor', for TO-Return-stack. It sounds easy, - but when tor is running, there's an extra value on the - return stack--tor's return address! So we have to pop - that off first... We better just bite the bullet and - code it out--but we can't really break it into smaller - words, because that'll trash the return stack. -: tor - r @ @ Get the value off the top of the return stack - swap Bring the value to be pushed to the top of stack - r @ ! Write it over the current top of return stack - r @ 1 + r ! Increment the return stack pointer--but can't use inc - r @ ! Store our return address back on the return stack -; - - Next we want the opposite routine, which pops the top - of the return stack, and puts it on the normal stack. -: fromr - r @ @ Save old value - r @ 1 - r ! Decrement pointer - r @ @ Get value that we want off - swap Bring return address to top - r @ ! Store it and return -; - - Now, if we have a routine that's recursing, and we - want to be polite about the return stack, right before - we recurse we can run { fromr drop } so the stack won't - blow up. This means, though, that the first time we - enter this recursive routine, we blow our *real* return - address--so when we're done, we'll return up two levels. - To save a little, we make 'tail' mean { fromr drop }; - however, it's more complex since there's a new value on - top of the return stack. -: tail fromr fromr drop tor ; - - Now, we want to do 'if'. To do this, we need to convert - values to boolean values. The next few words set this - up. - - minus gives us unary negation. -: minus 0 swap - ; - - If top of stack is boolean, bnot gives us inverse -: bnot 1 swap - ; - - To compare two numbers, subtract and compare to 0. -: < - <0 ; - - logical turns the top of stack into either 0 or 1. -: logical - dup Get two copies of it - 0 < 1 if < 0, 0 otherwise - swap minus Swap number back up, and take negative - 0 < 1 if original was > 0, 0 otherwise - + Add them up--has to be 0 or 1! -; - - not returns 1 if top of stack is 0, and 0 otherwise -: not logical bnot ; - - We can test equality by subtracting and comparing to 0. -: = - not ; - - Just to show how you compute a branch: Suppose you've - compiled a call to branch, and immediately after it is - an integer constant with the offset of how far to branch. - To branch, we use the return stack to read the offset, and - add that on to the top of the return stack, and return. -: branch - r @ Address of top of return stack - @ Our return address - @ Value from there: the branch offset - r @ @ Our return address again - + The address we want to execute at - r @ ! Store it back onto the return stack -; - - For conditional branches, we want to branch by a certain - amount if true, otherwise we want to skip over the branch - offset constant--that is, branch by one. Assuming that - the top of the stack is the branch offset, and the second - on the stack is 1 if we should branch, and 0 if not, the - following computes the correct branch offset. -: computebranch 1 - * 1 + ; - - Branch if the value on top of the stack is 0. -: notbranch - not - r @ @ @ Get the branch offset - computebranch Adjust as necessary - r @ @ + Calculate the new address - r @ ! Store it -; - - here is a standard FORTH word which returns a pointer to - the current dictionary address--that is, the value of - the dictionary pointer. -: here h @ ; - - We're ALL SET to compile if...else...then constructs! - Here's what we do. When we get 'if', we compile a call - to notbranch, and then compile a dummy offset, because - we don't know where the 'then' will be. On the *stack* - we leave the address where we compiled the dummy offset. - 'then' will calculate the offset and fill it in for us. -: if immediate - ' notbranch , Compile notbranch - here Save the current dictionary address - 0 , Compile a dummy value -; - - then expects the address to fixup to be on the stack. -: then immediate - dup Make another copy of the address - here Find the current location, where to branch to - swap - Calculate the difference between them - swap ! Bring the address to the top, and store it. -; - - Now that we can do if...then statements, we can do - some parsing! Let's introduce real FORTH comments. - find-) will scan the input until it finds a ), and - exit. -: find-) - key Read in a character - ')' = Compare it to close parentheses - not if If it's not equal - tail find-) repeat (popping R stack) - then Otherwise branch here and exit -; - -: ( immediate - find-) -; - -( we should be able to do FORTH-style comments now ) - -( now that we've got comments, we can comment the rest of the code - in a legitimate [self parsing] fashion. Note that you can't - nest parentheses... ) - -: else immediate - ' branch , ( compile a definite branch ) - here ( push the backpatching address ) - 0 , ( compile a dummy offset for branch ) - swap ( bring old backpatch address to top ) - dup here swap - ( calculate the offset from old address ) - swap ! ( put the address on top and store it ) -; - -: over _x! _y! _y _x _y ; - -: add - _x! ( save the pointer in a temp variable ) - _x @ ( get the value pointed to ) - + ( add the incremement from on top of the stack ) - _x ! ( and save it ) -; - -: allot h add ; - -: maybebranch - logical ( force the TOS to be 0 or 1 ) - r @ @ @ ( load the branch offset ) - computebranch ( calculate the condition offset [either TOS or 1]) - r @ @ + ( add it to the return address ) - r @ ! ( store it to our return address and return ) -; - -: mod _x! _y! ( get x then y off of stack ) - _y _y _x / _x * ( y - y / x * x ) - - -; - -: printnum - dup - 10 mod '0' + - swap 10 / dup - if - printnum - echo - else - drop - echo - then -; - -: . - dup 0 < - if - '-' echo minus - then - printnum - 'space' echo -; - -: debugprint dup . cr ; - -( the following routine takes a pointer to a string, and prints it, - except for the trailing quote. returns a pointer to the next word - after the trailing quote ) - -: _print - dup 1 + - swap @ - dup '"' = - if - drop exit - then - echo - tail _print -; - -: print _print ; - - ( print the next thing from the instruction stream ) -: immprint - r @ @ - print - r @ ! -; - -: find-" - key dup , - '"' = - if - exit - then - tail find-" -; - -: " immediate - key drop - ' immprint , - find-" -; - -: do immediate - ' swap , ( compile 'swap' to swap the limit and start ) - ' tor , ( compile to push the limit onto the return stack ) - ' tor , ( compile to push the start on the return stack ) - here ( save this address so we can branch back to it ) -; - -: i r @ 1 - @ ; -: j r @ 3 - @ ; - -: > swap < ; -: <= 1 + < ; -: >= swap <= ; - -: inci - r @ 1 - ( get the pointer to i ) - inc ( add one to it ) - r @ 1 - @ ( find the value again ) - r @ 2 - @ ( find the limit value ) - <= - if - r @ @ @ r @ @ + r @ ! exit ( branch ) - then - fromr 1 + - fromr drop - fromr drop - tor -; - -: loop immediate ' inci @ here - , ; - -: loopexit - - fromr drop ( pop off our return address ) - fromr drop ( pop off i ) - fromr drop ( pop off the limit of i ) -; ( and return to the caller's caller routine ) - -: execute - 8 ! - ' exit 9 ! - 8 tor -; - -: :: ; ( :: is going to be a word that does ':' at runtime ) - -: fix-:: immediate 3 ' :: ! ; -fix-:: - - ( Override old definition of ':' with a new one that invokes ] ) -: : immediate :: ] ; - -: command - here 5 ! ( store dict pointer in temp variable ) - _read ( compile a word ) - ( if we get control back: ) - here 5 @ - = if - tail command ( we didn't compile anything ) - then - here 1 - h ! ( decrement the dictionary pointer ) - here 5 @ ( get the original value ) - = if - here @ ( get the word that was compiled ) - execute ( and run it ) - else - here @ ( else it was an integer constant, so push it ) - here 1 - h ! ( and decrement the dictionary pointer again ) - then - tail command -; - -: make-immediate ( make a word just compiled immediate ) - here 1 - ( back up a word in the dictionary ) - dup dup ( save the pointer to here ) - h ! ( store as the current dictionary pointer ) - @ ( get the run-time code pointer ) - swap ( get the dict pointer again ) - 1 - ( point to the compile-time code pointer ) - ! ( write run-time code pointer on compile-time pointer ) -; - -: ) - ' , , ( compile a push that address onto dictionary ) -; - -: does> immediate - ' command , ( jump back into command mode at runtime ) - here swap ! ( backpatch the build> to point to here ) - 2 , ( compile run-code primitive so we look like a word ) - ' fromr , ( compile fromr, which leaves var address on stack ) -; - - -: _dump ( dump out the definition of a word, sort of ) - dup " (" . " , " - dup @ ( save the pointer and get the contents ) - dup ' exit - = if - " ;)" cr exit - then - . " ), " - 1 + - tail _dump -; - -: dump _dump ; - -: # . cr ; - -: var ; -: constant @ ; -: array + ; - -: [ immediate command ; -: _welcome " Welcome to THIRD. -Ok. -" ; - -: ; immediate ' exit , command exit - -[ - -_welcome - diff --git a/buzzard/buzzard.2.hint b/buzzard/buzzard.2.hint deleted file mode 100644 index b0fe22b..0000000 --- a/buzzard/buzzard.2.hint +++ /dev/null @@ -1,217 +0,0 @@ -Best Language Tool: - - Sean Barrett - Software Construction Company - 430 Southwest Parkway, #1906 - College Station, TX 77840 - USA - - -Judges' comments: - - First: - make first - - Second: - echo help | cat third help.th - | first - cat third demo5.th | first - - Third: - cat third help.th - | first - - Wait until Ok is printed and the type: - 2 3 + . cr <-- yes you should really type the 2 letters: cr - - Forth: - Sorry, this is third! - - -Selected notes from the author: - - What it does: - - first implements a relatively primitive stack machine. How - primitive? It supplies 13 visible primitives: 3 arithmetic, - 1 comparison, 2 memory-access, 2 character I/O, 3 primitives - for defining new words, 1 tokenizing, and 1 special stack - operation. (There are also three internal operations for - the stack machine: 'push this integer', 'call this code', - and 'compile a call to this code'.) - - It is very difficult to accomplish anything with this set - of primitives, but they do have an interesting property. - - This--what this interesting property is, or in other words - what first is good for--is the major obfuscation; there are - also minor source obfuscations, as well as some design tricks - that are effectively obfuscations. Details on the obfuscations - are below, and the interesting property is discussed much - further down. - - - How to run it: - - first expects you to first enter the names of the 13 primitives, - separated by whitespace--it doesn't care what you name them, but - if all the names aren't unique, you won't be able to use some of - them. After this you may type any sequence of valid first input. - Valid first input is defined as any sequence of whitespace-delimited - tokens which consist of primitives, new words you've defined, and - integers (as parsed by "%d"). Invalid input behaves unpredictably, - but gives no warning messages. A sample program, demo1.1st, is - included, but it only works on ASCII systems. - - Do not expect to be able to do anything interesting with first. - - To do something interesting, you need to feed first the file - third first. In unix, you can do - - % cat third help.th - | first - - to do this. Hopefully most operating systems will provide a - way to do this. It may take some time for this to complete - (I seem to remember it taking several minutes on an 8086 PC); - THIRD will prompt you when it is finished. The file third has - not been obfuscated, due to sheer kindness on the author's part. - - For more information on what you can do once you've piped - THIRD into first, type 'help' and consult FORTH manuals for - further reference. Six sample THIRD programs are included - in the files demo[1-6].th. buzzard.2.README has more - information. - - Keep in mind that you are still running first, and - are for the most part limited by first's tokenizer - (notably, unknown words will attempt to be parsed as - integers.) It is possible to build a new parser that - parses by hand, reading a single character at a time; - however, such a parser cannot easily use the existing - dictionary, and so would have to implement its own, - thus requiring reimplementing all of first and third - a second time--I did not care to tackle this project. - - - Compiling: - - first is reasonably portable. You may need to adjust the - size of the buffers on smaller machines; m[] needs to be - at least 2000 long, though. - - I say first is portable mainly because it uses native types. - Unlike FORTH, which traditionally allows byte and multi-byte - operations, all operations are performed on C 'int's. That - means first code is only as portable as the same code would - be in C. As in C, the result of dividing -1 by 2 is machine - (or rather compiler) dependent. - - How is first obfuscated? - - first is obfuscated in several ways. Some minor obfuscations - like &w[&m[1]][s] for s+m[w+1] were in the original source - but are no longer because, apparently, ANSI doesn't allow it - (gcc -ansi -pedantic doesn't mind it, though.) - Other related obfuscations are still present. The top of the - stack is cached in a variable, which increases performance - massively if the compiler can figure out to keep it in a register; - it also obfuscates the code. (Unfortunately, the top of stack - is a global variable and neither gcc nor most bundled compilers - seem to register allocate it.) - - More significant are the design obfuscations. m[0] is the - "dictionary pointer", used when compiling words, and m[1] is - the return stack index. Both are used as integer offsets into - m. Both are kept in m, instead of as separate pointers, - because they are then accessible to first programs, which is a - crucial property of first. Similarly the way words are stored - in the dictionary is not obvious, so it can be difficult to - follow exactly what the compiler words are doing. - - Assuming you've waded through all that, you still have - to penetrate the most significant obfuscation. Traditionally, - the question is whether a reader can answer the question "what - will this do when I run it". A reader who has deciphered first - to this point may think they know the answer to this question, - but they may not know the answer to the more important question, - "what will this program do when given the right input?" FORTH - afficianados, and especially FORTH implementors, may recognize - the similarity of the internal compiler format to many FORTH - interal representations, and, being aware that FORTH interpreters - can often by self-compiling, may be suspicious that this program - can compile FORTH, or a significant subset of it, or at least be - capable of doing so if fed the right input. Of course, the name - "THIRD" should be a dead giveaway, if the name "first" wasn't. - (These numbers were largely chosed because they were five letters - long, like "FORTH", and would not require truncation to five - letters, which would be a dead giveaway. Besides, THIRD represents - a step backwards, in more ways than one.) - - - What exactly is first, then? - - first is a tiny interpreter which implements a sufficient - pseudo-subset of FORTH to allow it to bootstrap a relatively - complete version of FORTH (based loosely on forth79), which - I call THIRD. Complete relative to what, I'm not sure. - - I believe first is close to the smallest amount of code possible - to get this effect *using forth-style primitives*, and still have - some efficiency (it is possible to get by without multiplication - if you have addition, obviously). In the design file, design, - I give a justification for why each primitive in first was included. - - THIRD is sorta slow, because first has so few primitives that - many things that are primitives in FORTH (like swap) take a - significant amount of time in THIRD. - - When you get the 'Ok.' message from third, try out some sample - FORTH code (first has no way of knowing if keyboard input is - waiting, so it can't actually prompt you in a normal way. It - only prints 'Ok.' after you define a word). - - 2 3 + . cr ( add 2 and 3, and print it and a newline.) - - and THIRD responds - - 5 - - Now try: - - : test 11 1 do i . loop cr ; - test - - and THIRD responds - - 1 2 3 4 5 6 7 8 9 10 - - - When in THIRD, you can see how much space you're currently - using by typing - - here . - - The number THIRD replies is the number of machine words (ints) - that the dictionary (the first code) takes up, plus the - 512 ints for the return stack. If you compile the basic - THIRD system without the help word (strings take up one - int per character in the string!), you should find that - you're using around 1000 ints (plus the return stack). - - Thus THIRD gives you a relatively complete FORTH system in - less than 700 chars of C source + about 1000 ints of - memory--and it's portable too (you could copy over the - THIRD memory dump to another machine, in theory). If the - above numbers seem to you to be mixing apples and oranges - (C source and compiled THIRD code), note that you should - in theory be able to stick the compiled THIRD code into - the C source. - - - Software Construction Company gets credit for rekindling - my interest in FORTH and thus indirectly inspiring me - to write this program. - -Copyright (c) 1992, Landon Curt Noll & Larry Bassel. -All Rights Reserved. Permission for personal, educational or non-profit use is -granted provided this this copyright and notice are included in its entirety -and remains unaltered. All other uses must receive prior permission in writing -from both Landon Curt Noll and Larry Bassel. diff --git a/buzzard/buzzard.2.orig.c b/buzzard/buzzard.2.orig.c deleted file mode 100644 index 7f77ab1..0000000 --- a/buzzard/buzzard.2.orig.c +++ /dev/null @@ -1,61 +0,0 @@ -#define c 0 [m] ++ [m] = -#define z;break;case - -char s[5000]; -int m[20000]={32},L=1,I,T[500],*S=T,t=64,w,f; - -a(x) -{ - c L; - L= *m-1; - c t; - c x; - scanf("%s",s+t); - t+=strlen(s+t)+1; -} - -r(x) -{ - switch(x++[m]){ - z 5: for(w=scanf("%s",s)<1?exit(0):L;strcmp(s,&w[&m[1]][s]);w=m[w]); - w-1 ? r(w+2) : (c 2,c atoi(s)) - z 12: I=1[m]--[m] - z 15: f=S[-f] - z 1: c x - z 9: f *=* S-- - z 7: m[f]= *S--; - f= *S-- - z 0: *++S=f; - f=I++[m] - z 8: f= *S --- f - z 2: m[++1[m]]=I; - I=x - z 11: f=0>f - z 4: *m-=2;c 2 - z 6: f=f[m] - z 10: f= *S--/f - z 3: a(1); - c 2 - z 13: putchar(f); - f= *S-- - z 14: *++S=f; - f=getchar(); - } -} - -main() -{ - a(3); - a(4); - a(1); - w= *m; - c 5; - c 2; - I= *m; - c w; - c I-1; - for(w=6;w<16;) - a(1),c w++; - m[1]= *m; - for(*m+=512;;r(m[I++])); -} diff --git a/buzzard/demo1.1st b/buzzard/demo1.1st deleted file mode 100644 index b836967..0000000 --- a/buzzard/demo1.1st +++ /dev/null @@ -1,12 +0,0 @@ -: immediate _read @ ! - * / <0 exit echo key _pick - -: show echo echo echo echo exit -: all show show show show echo exit - -: doit immediate - 10 33 100 108 114 111 87 - 32 111 108 108 101 72 - all -exit - -doit diff --git a/buzzard/demo1.th b/buzzard/demo1.th deleted file mode 100644 index 99d22bd..0000000 --- a/buzzard/demo1.th +++ /dev/null @@ -1,4 +0,0 @@ -: demo1 " Hello world! -" ; - -demo1 diff --git a/buzzard/demo2.th b/buzzard/demo2.th deleted file mode 100644 index 8bf8eee..0000000 --- a/buzzard/demo2.th +++ /dev/null @@ -1,10 +0,0 @@ -: demo2 - - 10 0 ( iterate from 0 stopping before 10 ) - do - i . ( print the loop counter ) - loop - cr ( add a newline ) -; - -demo2 diff --git a/buzzard/demo3.th b/buzzard/demo3.th deleted file mode 100644 index c061b74..0000000 --- a/buzzard/demo3.th +++ /dev/null @@ -1,15 +0,0 @@ -: printfour - - dup ( save the number on top of the stack ) - 4 = ( compare it to four ) - if - " forth " ( output a string for it ) - drop ( and delete the saved value ) - else - . - endif -; - -: demo3 10 0 do i printfour loop cr ; - -demo3 diff --git a/buzzard/demo4.th b/buzzard/demo4.th deleted file mode 100644 index 3f9a76d..0000000 --- a/buzzard/demo4.th +++ /dev/null @@ -1,30 +0,0 @@ -( compute factorial recursively ) -( take x as input, return x! and x as output ) - -: fact-help - - dup if - 1 - ( leave x-1 on top ) - fact-help ( leave x-1, [x-1]! ) - 1 + ( leave x, [x-1]!, x ) - swap over swap ( leave [x-1]!, x, x ) - * ( into x!, x ) - swap ( into x, x! ) - else - 1 swap - then -; - -: fact - - fact-help - drop - -; - -: demo4 - " 4 factorial is: " 4 fact . cr - " 6 factorial is: " 6 fact . cr -; - -demo4 diff --git a/buzzard/demo5.th b/buzzard/demo5.th deleted file mode 100644 index d16ca1e..0000000 --- a/buzzard/demo5.th +++ /dev/null @@ -1,27 +0,0 @@ -( recursive factorial. given x on top, followed by ) -( an "accumulator" containing the product except for x! ) - -: fact-help2 - - dup if - swap over swap - * - swap 1 - - fact-help2 - then -; - -: fact - - 1 swap - fact-help2 - drop -; - -: demo5 - - " The factorial of 3 is: " 3 fact . cr - " The factorial of 5 is: " 5 fact . cr -; - -demo5 diff --git a/buzzard/demo6.th b/buzzard/demo6.th deleted file mode 100644 index 75ec667..0000000 --- a/buzzard/demo6.th +++ /dev/null @@ -1,18 +0,0 @@ -: foobar - 2 - [ 2 , ( '[' turns the compiler off, allowing us to execute code ) - 1 1 1 + + , ( and we compile in-line a 2 and a three ) - ( the '2' means 'push the number following this' ) - ] - + . cr -; - -foobar - -: 'foobar ' foobar ; ( ' can only be run inside the compiler ) - ( ' leaves the address of the following word - on the stack ) - -'foobar . cr - -'foobar dump diff --git a/buzzard/help.th b/buzzard/help.th deleted file mode 100644 index 7afab27..0000000 --- a/buzzard/help.th +++ /dev/null @@ -1,54 +0,0 @@ -: help key ( flush the carriage return form the input buffer ) - -" The following are the standard known words; words marked with (*) are -immediate words, which cannot be used from command mode, but only in -word definitions. Words marked by (**) declare new words, so are always -followed by the new word. - - ! @ fetch, store - + - * / mod standard arithmetic operations - = < > <= >= standard comparison operations - - not boolean not of top of stack - logical turn top of stack into 0 or 1 - - dup over duplicate the top of stack or second of stack - swap drop reverse top two elements or drop topmost - - inc dec increment/decrement the value at address from stack - add add a value from 2nd of stack into address from top - - echo key output character from, or input to, top of stack - . # print out number on top of stack without/with cr - cr print a carriage return - -[more]" key -" (**) var declare variable with initial value taken from stack -(**) constant declare constant with initial value taken from stack -(**) array declare an array with size taken from stack - -(*) if...else...then FORTH branching construct -(*) do...loop FORTH looping construct - i j loop values (not variables) - - print print the string pointed to on screen - -(*)(**) : declare a new THIRD word -(*) declare a data types compile-time and run-time -(*) ; terminate a word definition - -[more]" key -" Advanced words: - here current location in dictionary - h pointer into dictionary - r pointer to return stack - fromr tor pop a value from or to the return stack - - , write the top of stack to dictionary - ' store the address of the following word on the stack - allot leave space on the dictionary - - :: compile a ':' header - [ switch into command mode - ] continue doing : definitions -" ; diff --git a/buzzard/third b/buzzard/third deleted file mode 100644 index b5d3802..0000000 --- a/buzzard/third +++ /dev/null @@ -1,367 +0,0 @@ -: immediate _read @ ! - * / <0 exit echo key _pick - -: debug immediate 1 5 ! exit - -: r 1 exit - -: ] r @ 1 - r ! _read ] - -: _main immediate r @ 7 ! ] -_main - - -: _x 3 @ exit -: _y 4 @ exit -: _x! 3 ! exit -: _y! 4 ! exit - - -: swap _x! _y! _x _y exit - -: + 0 swap - - exit - -: dup _x! _x _x exit - -: inc dup @ 1 + swap ! exit - -: h 0 exit - -: , h @ ! h inc exit - - -: ' r @ @ dup 1 + r @ ! @ exit - -: ; immediate ' exit , exit - - -: drop 0 * + ; - -: dec dup @ 1 - swap ! ; - -: tor r @ @ swap r @ ! r @ 1 + r ! r @ ! ; - -: fromr r @ @ r @ 1 - r ! r @ @ swap r @ ! ; - -: tail fromr fromr drop tor ; - -: minus 0 swap - ; - -: bnot 1 swap - ; - -: < - <0 ; - -: logical dup 0 < swap minus 0 < + ; - -: not logical bnot ; - -: = - not ; - -: branch r @ @ @ r @ @ + r @ ! ; - -: computebranch 1 - * 1 + ; - -: notbranch - not - r @ @ @ - computebranch - r @ @ + - r @ ! -; - -: here h @ ; - -: if immediate ' notbranch , here 0 , ; - -: then immediate dup here swap - swap ! ; - -: ')' 0 ; - -: _fix key drop key swap 2 + ! ; - -: fix-')' immediate ' ')' _fix ; - -fix-')' ) - -: find-) key ')' = not if tail find-) then ; - -: ( immediate find-) ; - -( we should be able to do FORTH-style comments now ) - -( this works as follows: ( is an immediate word, so it gets - control during compilation. Then it simply reads in characters - until it sees a close parenthesis. once it does, it exits. - if not, it pops off the return stack--manual tail recursion. ) - -( now that we've got comments, we can comment the rest of the code! ) - -: else immediate - ' branch , ( compile a definite branch ) - here ( push the backpatching address ) - 0 , ( compile a dummy offset for branch ) - swap ( bring old backpatch address to top ) - dup here swap - ( calculate the offset from old address ) - swap ! ( put the address on top and store it ) -; - -: over _x! _y! _y _x _y ; - -: add - _x! ( save the pointer in a temp variable ) - _x @ ( get the value pointed to ) - + ( add the incremement from on top of the stack ) - _x ! ( and save it ) -; - -: allot h add ; - -: maybebranch - logical ( force the TOS to be 0 or 1 ) - r @ @ @ ( load the branch offset ) - computebranch ( calculate the condition offset [either TOS or 1]) - r @ @ + ( add it to the return address ) - r @ ! ( store it to our return address and return ) -; - -: mod _x! _y! ( get x then y off of stack ) - _y - _y _x / _x * ( y - y / x * x ) - - -; - -: '\n' 0 ; -: '"' 0 ; -: '0' 0 ; -: 'space' 0 ; - -: fix-'\n' immediate ' '\n' _fix ; -: fix-'"' immediate ' '"' _fix ; -: fix-'0' immediate ' '0' _fix ; -: fix-'space' immediate ' 'space' _fix ; - -fix-'0' 0 fix-'space' fix-'"' " -fix-'\n' - - -: cr '\n' echo exit - -: printnum - dup - 10 mod '0' + - swap 10 / dup - if - printnum 0 - then - drop echo -; - -: . - dup 0 < - if - 45 echo minus - then - printnum - 'space' echo -; - - -: debugprint dup . cr ; - -( the following routine takes a pointer to a string, and prints it, - except for the trailing quote. returns a pointer to the next word - after the trailing quote ) - -: _print - dup 1 + - swap @ - dup '"' = - if - drop exit - then - echo - tail _print -; - -: print _print ; - - ( print the next thing from the instruction stream ) -: immprint - r @ @ - print - r @ ! -; - -: find-" - key dup , - '"' = - if - exit - then - tail find-" -; - -: " immediate - key drop - ' immprint , - find-" -; - -: do immediate - ' swap , ( compile 'swap' to swap the limit and start ) - ' tor , ( compile to push the limit onto the return stack ) - ' tor , ( compile to push the start on the return stack ) - here ( save this address so we can branch back to it ) -; - -: i r @ 1 - @ ; -: j r @ 3 - @ ; - -: > swap < ; -: <= 1 + < ; -: >= swap <= ; - -: inci - r @ 1 - ( get the pointer to i ) - inc ( add one to it ) - r @ 1 - @ ( find the value again ) - r @ 2 - @ ( find the limit value ) - < - if - r @ @ @ r @ @ + r @ ! exit ( branch ) - then - fromr 1 + - fromr drop - fromr drop - tor -; - -: loop immediate ' inci , here - , ; - -: loopexit - - fromr drop ( pop off our return address ) - fromr drop ( pop off i ) - fromr drop ( pop off the limit of i ) -; ( and return to the caller's caller routine ) - -: isprime - dup 2 = if - exit - then - dup 2 / 2 ( loop from 2 to n/2 ) - do - dup ( value we're checking if it's prime ) - i mod ( mod it by divisor ) - not if - drop 0 loopexit ( exit from routine from inside loop ) - then - loop -; - -: primes - " The primes from " - dup . - " to " - over . - " are:" - cr - - do - i isprime - if - i . 'space' echo - then - loop - cr -; - -: execute - 8 ! - ' exit 9 ! - 8 tor -; - -: :: ; ( :: is going to be a word that does ':' at runtime ) - -: fix-:: immediate 3 ' :: ! ; -fix-:: - - ( Override old definition of ':' with a new one that invokes ] ) -: : immediate :: ] ; - -: command - here 5 ! ( store dict pointer in temp variable ) - _read ( compile a word ) - ( if we get control back: ) - here 5 @ - = if - tail command ( we didn't compile anything ) - then - here 1 - h ! ( decrement the dictionary pointer ) - here 5 @ ( get the original value ) - = if - here @ ( get the word that was compiled ) - execute ( and run it ) - else - here @ ( else it was an integer constant, so push it ) - here 1 - h ! ( and decrement the dictionary pointer again ) - then - tail command -; - -: make-immediate ( make a word just compiled immediate ) - here 1 - ( back up a word in the dictionary ) - dup dup ( save the pointer to here ) - h ! ( store as the current dictionary pointer ) - @ ( get the run-time code pointer ) - swap ( get the dict pointer again ) - 1 - ( point to the compile-time code pointer ) - ! ( write run-time code pointer on compile-time pointer ) -; - -: ) - ' , , ( compile a push that address onto dictionary ) -; - -: does> immediate - ' command , ( jump back into command mode at runtime ) - here swap ! ( backpatch the build> to point to here ) - 2 , ( compile run-code primitive so we look like a word ) - ' fromr , ( compile fromr, which leaves var address on stack ) -; - - -: _dump ( dump out the definition of a word, sort of ) - dup " (" . " , " - dup @ ( save the pointer and get the contents ) - dup ' exit - = if - " ;)" cr exit - then - . " ), " - 1 + - tail _dump -; - -: dump _dump ; - -: # . cr ; - -: var ; -: constant @ ; -: array + ; - -: [ immediate command ; -: _welcome " Welcome to THIRD. -Ok. -" ; - -: ; immediate ' exit , command exit - -[ - -_welcome diff --git a/doc/README.md b/doc/README.md deleted file mode 100644 index a98f5fe..0000000 --- a/doc/README.md +++ /dev/null @@ -1,6 +0,0 @@ -# Links - -* https://users.ece.cmu.edu/~koopman/stack_computers/sec4_4.html -* https://www.fpgarelated.com/showarticle/790.php -* https://github.com/jamesbowman/j1 -* http://www.excamera.com/sphinx/fpga-j1.html diff --git a/doc/eForthOverviewv5.pdf b/doc/eForthOverviewv5.pdf deleted file mode 100644 index bf5f5b0..0000000 Binary files a/doc/eForthOverviewv5.pdf and /dev/null differ diff --git a/doc/learnforth.fs b/doc/learnforth.fs deleted file mode 100644 index 2f8efe7..0000000 --- a/doc/learnforth.fs +++ /dev/null @@ -1,205 +0,0 @@ - -\ This is a comment -( This is also a comment but it's only used when defining words ) - -\ --------------------------------- Precursor ---------------------------------- - -\ All programming in Forth is done by manipulating the parameter stack (more -\ commonly just referred to as "the stack"). -5 2 3 56 76 23 65 \ ok - -\ Those numbers get added to the stack, from left to right. -.s \ <7> 5 2 3 56 76 23 65 ok - -\ In Forth, everything is either a word or a number. - -\ ------------------------------ Basic Arithmetic ------------------------------ - -\ Arithmetic (in fact most words requiring data) works by manipulating data on -\ the stack. -5 4 + \ ok - -\ `.` pops the top result from the stack: -. \ 9 ok - -\ More examples of arithmetic: -6 7 * . \ 42 ok -1360 23 - . \ 1337 ok -12 12 / . \ 1 ok -13 2 mod . \ 1 ok - -99 negate . \ -99 ok --99 abs . \ 99 ok -52 23 max . \ 52 ok -52 23 min . \ 23 ok - -\ ----------------------------- Stack Manipulation ----------------------------- - -\ Naturally, as we work with the stack, we'll want some useful methods: - -3 dup - \ duplicate the top item (1st now equals 2nd): 3 - 3 -2 5 swap / \ swap the top with the second element: 5 / 2 -6 4 5 rot .s \ rotate the top 3 elements: 4 5 6 -4 0 drop 2 / \ remove the top item (don't print to screen): 4 / 2 -1 2 3 nip .s \ remove the second item (similar to drop): 1 3 - -\ ---------------------- More Advanced Stack Manipulation ---------------------- - -1 2 3 4 tuck \ duplicate the top item below the second slot: 1 2 4 3 4 ok -1 2 3 4 over \ duplicate the second item to the top: 1 2 3 4 3 ok -1 2 3 4 2 roll \ *move* the item at that position to the top: 1 3 4 2 ok -1 2 3 4 2 pick \ *duplicate* the item at that position to the top: 1 2 3 4 2 ok - -\ When referring to stack indexes, they are zero-based. - -\ ------------------------------ Creating Words -------------------------------- - -\ The `:` word sets Forth into compile mode until it sees the `;` word. -: square ( n -- n ) dup * ; \ ok -5 square . \ 25 ok - -\ We can view what a word does too: -see square \ : square dup * ; ok - -\ -------------------------------- Conditionals -------------------------------- - -\ -1 == true, 0 == false. However, any non-zero value is usually treated as -\ being true: -42 42 = \ -1 ok -12 53 = \ 0 ok - -\ `if` is a compile-only word. `if` `then` . -: ?>64 ( n -- n ) dup 64 > if ." Greater than 64!" then ; \ ok -100 ?>64 \ Greater than 64! ok - -\ Else: -: ?>64 ( n -- n ) dup 64 > if ." Greater than 64!" else ." Less than 64!" then ; -100 ?>64 \ Greater than 64! ok -20 ?>64 \ Less than 64! ok - -\ ------------------------------------ Loops ----------------------------------- - -\ `do` is also a compile-only word. -: myloop ( -- ) 5 0 do cr ." Hello!" loop ; \ ok -myloop -\ Hello! -\ Hello! -\ Hello! -\ Hello! -\ Hello! ok - -\ `do` expects two numbers on the stack: the end number and the start number. - -\ We can get the value of the index as we loop with `i`: -: one-to-12 ( -- ) 12 0 do i . loop ; \ ok -one-to-12 \ 0 1 2 3 4 5 6 7 8 9 10 11 12 ok - -\ `?do` works similarly, except it will skip the loop if the end and start -\ numbers are equal. -: squares ( n -- ) 0 ?do i square . loop ; \ ok -10 squares \ 0 1 4 9 16 25 36 49 64 81 ok - -\ Change the "step" with `+loop`: -: threes ( n n -- ) ?do i . 3 +loop ; \ ok -15 0 threes \ 0 3 6 9 12 ok - -\ Indefinite loops with `begin` `until`: -: death ( -- ) begin ." Are we there yet?" 0 until ; \ ok - -\ ---------------------------- Variables and Memory ---------------------------- - -\ Use `variable` to declare `age` to be a variable. -variable age \ ok - -\ Then we write 21 to age with the word `!`. -21 age ! \ ok - -\ Finally we can print our variable using the "read" word `@`, which adds the -\ value to the stack, or use `?` that reads and prints it in one go. -age @ . \ 21 ok -age ? \ 21 ok - -\ Constants are quite similar, except we don't bother with memory addresses: -100 constant WATER-BOILING-POINT \ ok -WATER-BOILING-POINT . \ 100 ok - -\ ----------------------------------- Arrays ----------------------------------- - -\ Creating arrays is similar to variables, except we need to allocate more -\ memory to them. - -\ You can use `2 cells allot` to create an array that's 3 cells long: -variable mynumbers 2 cells allot \ ok - -\ Initialize all the values to 0 -mynumbers 3 cells erase \ ok - -\ Alternatively we could use `fill`: -mynumbers 3 cells 0 fill - -\ or we can just skip all the above and initialize with specific values: -create mynumbers 64 , 9001 , 1337 , \ ok (the last `,` is important!) - -\ ...which is equivalent to: - -\ Manually writing values to each index: -64 mynumbers 0 cells + ! \ ok -9001 mynumbers 1 cells + ! \ ok -1337 mynumbers 2 cells + ! \ ok - -\ Reading values at certain array indexes: -0 cells mynumbers + ? \ 64 ok -1 cells mynumbers + ? \ 9001 ok - -\ We can simplify it a little by making a helper word for manipulating arrays: -: of-arr ( n n -- n ) cells + ; \ ok -mynumbers 2 of-arr ? \ 1337 ok - -\ Which we can use for writing too: -20 mynumbers 1 of-arr ! \ ok -mynumbers 1 of-arr ? \ 20 ok - -\ ------------------------------ The Return Stack ------------------------------ - -\ The return stack is used to the hold pointers to things when words are -\ executing other words, e.g. loops. - -\ We've already seen one use of it: `i`, which duplicates the top of the return -\ stack. `i` is equivalent to `r@`. -: myloop ( -- ) 5 0 do r@ . loop ; \ ok - -\ As well as reading, we can add to the return stack and remove from it: -5 6 4 >r swap r> .s \ 6 5 4 ok - -\ NOTE: Because Forth uses the return stack for word pointers, `>r` should -\ always be followed by `r>`. - -\ ------------------------- Floating Point Operations -------------------------- - -\ Most Forths tend to eschew the use of floating point operations. -8.3e 0.8e f+ f. \ 9.1 ok - -\ Usually we simply prepend words with 'f' when dealing with floats: -variable myfloatingvar \ ok -4.4e myfloatingvar f! \ ok -myfloatingvar f@ f. \ 4.4 ok - -\ --------------------------------- Final Notes -------------------------------- - -\ Typing a non-existent word will empty the stack. However, there's also a word -\ specifically for that: -clearstack - -\ Clear the screen: -page - -\ Loading Forth files: -\ s" forthfile.fs" included - -\ You can list every word that's in Forth's dictionary (but it's a huge list!): -\ words - -\ Exiting Gforth: -\ bye - - diff --git a/doc/tcjassem.txt b/doc/tcjassem.txt deleted file mode 100644 index 97ed164..0000000 --- a/doc/tcjassem.txt +++ /dev/null @@ -1,805 +0,0 @@ - B.Y.O.ASSEMBLER - -or- - Build Your Own (Cross-) Assembler....in Forth - - by Brad Rodriguez - - - A. INTRODUCTION - - In a previous issue of this journal I described how to - "bootstrap" yourself into a new processor, with a simple - debug monitor. But how do you write code for this new CPU, - when you can't find or can't afford an assembler? Build - your own! - - Forth is an ideal language for this. I've written cross- - assemblers in as little as two hours (for the TMS320, over a - long lunch break). Two days is perhaps more common; and one - processor (the Zilog Super8) took me five days. But when - you have more time than money, this is a bargain. - - In part 1 of this article I will describe the basic - principles of Forth-style assemblers -- structured, - single-pass, postfix. Much of this will apply to any - processor, and these concepts are in almost every Forth - assembler. - - In part 2 I will examine an assembler for a specific CPU: - the Motorola 6809. This assembler is simple but not - trivial, occupying 15 screens of source code. Among other - things, it shows how to handle instructions with multiple - modes (in this case, addressing modes). By studying this - example, you can figure out how to handle the peculiarities - of your own CPU. - - B. WHY USE FORTH? - - I believe that Forth is the easiest language in which to - write assemblers. - - First and foremost, Forth has a "text interpreter" designed - to look up text strings and perform some related action. - Turning text strings into bytes is exactly what is needed to - compile assembler mnemonics! Operands and addressing modes - can also be handled as Forth "words." - - Forth also includes "defining words," which create large - sets of words with a common action. This feature is very - useful when defining assembler mnemonics. - - Since every Forth word is always available, Forth's - arithmetic and logical functions can be used within the - assembler environment to perform address and operand - arithmetic. - - Finally, since the assembler is entirely implemented in - Forth words, Forth's "colon definitions" provide a - rudimentary macro facility, with no extra effort. - - C. THE SIMPLEST CASE: ASSEMBLING A NOP - - To understand how Forth translates mnemonics to machine - code, consider the simplest case: the NOP instruction (12 - hex on the 6809). - - A conventional assembler, on encountering a NOP in the - opcode field, must append a 12H byte to the output file and - advance the location counter by 1. Operands and comments - are ignored. (I will ignore labels for the time being.) - - In Forth, the memory-resident dictionary is usually the - output "file." So, make NOP a Forth word, and give it an - action, namely, "append 12H to the dictionary and advance - the dictionary pointer." - - HEX - : NOP, 12 C, ; - - Assembler opcodes are often given Forth names which include - a trailing comma, as shown above. This is because many - Forth words -- such as AND XOR and OR -- conflict with - assembler mnemonics. The simplest solution is to change the - assembler mnemonics slightly, usually with a trailing comma. - (This comma is a Forth convention, indicating that something - is appended to the dictionary.) - - D. THE CLASS OF "INHERENT" OPCODES - - Most processors have many instructions, like NOP, which - require no operands. All of these could be defined as Forth - colon definitions, but this duplicates code, and wastes a - lot of space. It's much more efficient to use Forth's - "defining word" mechanism to give all of these words a - common action. In object-oriented parlance, this builds - "instances" of a single "class." - - This is done with Forth's CREATE and DOES>. (In fig-Forth, - as used in the 6809 assembler, the words are .) - - : INHERENT ( Defines the name of the class) - CREATE ( this will create an instance) - C, ( store the parameter for each - instance) - DOES> ( this is the class' common action) - C@ ( get each instance's parameter) - C, ( the assembly action, as above) - ; ( End of definition) - - HEX - 12 INHERENT NOP, ( Defines an instance NOP, of class - INHERENT, with parameter 12H.) - 3A INHERENT ABX, ( Another instance - the ABX instr) - 3D INHERENT MUL, ( Another instance - the MUL instr) - - In this case, the parameter (which is specific to each - instance) is simply the opcode to be assembled for each - instruction. - - This technique provides a substantial memory savings, with - almost no speed penalty. But the real advantage becomes - evident when complex instruction actions -- such as required - for parameters, or addressing modes -- are involved. - - E. HANDLING OPERANDS - - Most assembler opcodes, it is true, require one or more - operands. As part of the action for these instructions, - Forth routines could be written to parse text from the input - stream, and interpret this text as operand fields. But why? - The Forth envrionment already provides a parse-and-interpret - mechanism! - - So, Forth will be used to parse operands. Numbers are - parsed normally (in any base!), and equates can be Forth - CONSTANTs. But, since the operands determine how the opcode - is handled, they will be processed first. The results of - operand parsing will be left on Forth's stack, to be picked - up by the opcode word. This leads to Forth's unique postfix - format for assemblers: operands, followed by opcode. - - Take, for example, the 6809's ORCC instruction, which takes - a single numeric parameter: - - HEX - : ORCC, 1A C, C, ; - - The exact sequence of actions for ORCC, is: 1) put 1A hex - on the parameter stack; 2) append the top stack item (the - 1A) to the dictionary, and drop it from the stack; 3) append - the new top stack item (the operand) to the dictionary, and - drop it from the stack. It is assumed that a numeric value - was already on the stack, for the second C, to use. This - numeric value is the result of the operand parsing, which, - in this case, is simply the parsing of a single integer - value: - - HEX - 0F ORCC, - - The advantage here is that all of Forth's power to operate - on stack values, via both built-in operators and - newly-defined functions, can be employed to create and - modify operands. For example: - - HEX - 01 CONSTANT CY-FLAG ( a "named" numeric value) - 02 CONSTANT OV-FLAG - 04 CONSTANT Z-FLAG - ... - CY-FLAG Z-FLAG + ORCC, ( add 1 and 4 to get operand) - - The extension of operand-passing to the defining words - technique is straightforward. - - - F. HANDLING ADDRESSING MODES - - Rarely can an operand, or an opcode, be used unmodified. - Most of the instructions in a modern processor can take - multiple forms, depending on the programmer's choice of - addressing mode. - - Forth assemblers have attacked this problem in a number of - ways, depending on the requirements of the specific - processor. All of these techniques remain true to the Forth - methodology: the addressing mode operators are implemented - as Forth words. When these words are executed, they alter - the assembly of the current instruction. - - 1. Leaving additional parameters on the stack. - This is most useful when an addressing mode must always - be specified. The addressing-mode word leaves some - constant value on the stack, to be picked up by the - opcode word. Sometimes this value can be a "magic - number" which can be added to the opcode to modify it - for the different mode. When this is not feasible, the - addressing-mode value can activate a CASE statement - within the opcode, to select one of several actions. - In this latter case, instructions of different lengths, - possibly with different operands, can be assembled - depending on the addressing mode. - - 2. Setting flags or values in fixed variables. - This is most useful when the addressing mode is - optional. Without knowing whether an addressing mode - was specified, you don't know if the value on the stack - is a "magic number" or just an operand value. The - solution: have the addressing mode put its magic number - in a predefined variable (often called MODE). This - variable is initialized to a default value, and reset - to this default value after each instruction is - assembled. Thus, this variable can be tested to see if - an addressing mode was specified (overriding the - default). - - 3. Modifying parameter values already on the stack. - It is occasionally possible to implement addressing - mode words that work by modifying an operand value. - This is rarely seen. - - All three of these techniques are used, to some extent, - within the 6809 assembler. - - For most processors, register names can simply be Forth - CONSTANTs, which leave a value on the stack. For some - processors it is useful to have register names specify - "register addressing mode" as well. This is easily done by - defining register names with a new defining word, whose - run-time action sets the addressing mode (either on the - stack or in a MODE variable). - - Some processors allow multiple addressing modes in a single - instruction. If the number of addressing modes is fixed by - the instruction, they can be left on the stack. If the - number of addressing modes is variable, and it is desired to - know how many have been specified, multiple MODE variables - can be used for the first, second, etc. (In one case -- the - Super8 -- I had to keep track of not only how many - addressing modes were specified, but also where among the - operands they were specified. I did this by saving the - stack position along with each addressing mode.) - - Consider the 6809 ADD instruction. To simplify things, - ignore the Indexed addressing modes for now, and just - consider the remaining three addressing modes: Immediate, - Direct, and Extended. These will be specified as follows: - - source code assembles as - Immediate: number # ADD, 8B nn - Direct: address <> ADD, 9B aa - Extended: address ADD, BB aa aa - - Since Extended has no addressing mode operator, the - mode-variable approach seems to be indicated. The Forth - words # and <> will set MODE. - - Observe the regularity in the 6809 opcodes. If the - Immediate opcode is the "base" value, then the Direct opcode - is this value plus 10 hex, and the Extended opcode is this - value plus 30 hex. (And the Indexed opcode, incidentally, - is this value plus 20 hex.) This applies uniformly across - almost all 6809 instructions which use these addressing - modes. (The exceptions are those opcodes whose Direct - opcodes are of the form 0x hex.) - - Regularities like this are made to be exploited! This is a - general rule for writing assemblers: find or make an opcode - chart, and look for regularities -- especially those - applying to addressing modes or other instruction modifiers - (like condition codes). - - In this case, appropriate MODE values are suggested: - - VARIABLE MODE HEX - : # 0 MODE ! ; - : <> 10 MODE ! ; - : RESET 30 MODE ! ; - - The default MODE value is 30 hex (for Extended mode), so a - Forth word RESET is added to restore this value. RESET will - be used after every instruction is assembled. - - The ADD, routine can now be written. Let's go ahead and - write it using a defining word: - - HEX - : GENERAL-OP \ base-opcode -- - CREATE C, - DOES> \ operand -- - C@ \ get the base opcode - MODE @ + \ add the "magic number" - C, \ assemble the opcode - MODE @ CASE - 0 OF C, ENDOF \ byte operand - 10 OF C, ENDOF \ byte operand - 30 OF , ENDOF \ word operand - ENDCASE - RESET ; - - 8B GENERAL-OP ADD, - - Each "instance" of GENERAL-OP will have a different base - opcode. When ADD, executes, it will fetch this base opcode, - add the MODE value to it, and assemble that byte. Then it - will take the operand which was passed on the stack, and - assemble it either as a byte or word operand, depending on - the selected mode. Finally, it will reset MODE. - - Note that all of the code is now defined to create - instructions in the same family as ADD: - - HEX 89 GENERAL-OP ADC, - 84 GENERAL-OP AND, - 85 GENERAL-OP BIT, - etc. - - The memory savings from defining words really become evident - now. Each new opcode word executes the lengthy bit of DOES> - code given above; but each word is only a one-byte Forth - definition (plus header and code field, of course). - - This is not the actual code from the 6809 assembler -- there - are additional special cases which need to be handled. But - it demonstrates that, by storing enough mode information, - and by making liberal use of CASE statements, the most - ludicrous instruction sets can be assembled. - - - G. HANDLING CONTROL STRUCTURES - - The virtues of structured programming, have long been sung - -- and there are countless "structured assembly" macro - packages for conventional assemblers. But Forth assemblers - favor label-free, structured assembly code for a pragmatic - reason: in Forth, it's simpler to create assembler - structures than labels! - - The structures commonly included in Forth assemblers are - intended to resemble the programming structures of - high-level Forth. (Again, the assembler structures are - usually distinguished by a trailing comma.) - - 1. BEGIN, ... UNTIL, - - The BEGIN, ... UNTIL, construct is the simplest assembler - structure to understand. The assembler code is to loop back - to the BEGIN point, until some condition is satisfied. The - Forth assembler syntax is - - BEGIN, more code cc UNTIL, - - where 'cc' is a condition code, which has presumably been - defined -- either as an operand or an addressing mode -- for - the jump instructions. - - Obviously, the UNTIL, will assemble a conditional jump. The - sense of the jump must be "inverted" so that if 'cc' is - satisfied, the jump does NOT take place, but instead the - code "falls through" the jump. The conventional assembler - equivalent would be: - - xxx: ... - ... - ... - JR ~cc,xxx - - (where ~cc is the logical inverse of cc.) - - Forth offers two aids to implementing BEGIN, and UNTIL,. - The word HERE will return the current location counter - value. And values may be kept deep in the stack, with no - effect on Forth processing, then "elevated" when required. - - So: BEGIN, will "remember" a location counter, by placing - its value on the stack. UNTIL, will assemble a conditional - jump to the "remembered" location. - - : BEGIN, ( - a) HERE ; - : UNTIL, ( a cc - ) NOTCC JR, ; - - This introduces the common Forth stack notation, to indicate - that BEGIN, leaves one value (an address) on the stack. - UNTIL, consumes two values (an address and a condition code) - from the stack, with the condition code on top. It is - presumed that a word NOTCC has been defined, which will - convert a condition code to its logical inverse. It is also - presumed that the opcode word JR, has been defined, which - will expect an address and a condition code as operands. - (JR, is a more general example than the branch instructions - used in the 6809 assembler.) - - The use of the stack for storage of the loop address allows - BEGIN, ... UNTIL, constructs to be nested, as: - - BEGIN, ... BEGIN, ... cc UNTIL, ... cc UNTIL, - - The "inner" UNTIL, resolves the "inner" BEGIN, forming a - loop wholly contained within the outer BEGIN, ... UNTIL, - loop. - - 2. BEGIN, ... AGAIN, - - Forth commonly provides an "infinite loop" construct, - BEGIN ... AGAIN , which never exits. For the sake of - completeness, this is usually implemented in the assembler - as well. - - Obviously, this is implemented in the same manner as BEGIN, - ... UNTIL, except that the jump which is assembled by AGAIN, - is an unconditional jump. - - 3. DO, ... LOOP, - - Many processors offer some kind of looping instruction. - Since the 6809 does not, let's consider the Zilog Super8; - its Decrement-and-Jump-Non-Zero (DJNZ) instruction can use - any of 16 registers as the loop counter. This can be - written in structured assembler: - - DO, more code r LOOP, - - where r is the register used as the loop counter. Once - again, the intent is to make the assembler construct - resemble the high-level Forth construct. - - : DO, ( - a) HERE ; - : LOOP, ( a r - ) DJNZ, ; - - Some Forth assemblers go so far as to make DO, assemble a - load-immediate instruction for the loop counter -- but this - loses flexibility. Sometimes the loop count isn't a - constant. So I prefer the above definition of DO, . - - 4. IF, ... THEN, - - The IF, ... THEN, construct is the simplest forward- - referencing construct. If a condition is satisfied, the - code within the IF,...THEN, is to be executed; otherwise, - control is transferred to the first instruction after THEN,. - - (Note that Forth normally employs THEN, where other - languages use "endif." You can have both in your - assembler.) - - The Forth syntax is - - cc IF, ... ... ... THEN, - - for which the "conventional" equivalent is - - JP ~cc,xxx - ... - ... - ... - xxx: - - Note that, once again, the condition code must be inverted - to produce the expected logical sense for IF, . - - In a single pass assembler, the requisite forward jump - cannot be directly assembled, since the destination address - of the jump is not known when IF, is encountered. This - problem is solved by causing IF, to assemble a "dummy" jump, - and stack the address of the jump's operand field. Later, - the word THEN, (which will provide the destination address) - can remove this stacked address and "patch" the jump - instruction accordingly. - - : IF, ( cc - a) NOT 0 SWAP JP, ( conditional jump - HERE 2 - ; with 2-byte operand) - : THEN, ( a) HERE SWAP ! ; ( store HERE at the - stacked address) - - IF, inverts the condition code, assembles a conditional jump - to address zero, and then puts on the stack the address of - the jump address field. (After JP, is assembled, the - location counter HERE points past the jump instruction, so - we need to subtract two to get the location of the address - field.) THEN, will patch the current location into the - operand field of that jump. - - If relative jumps are used, additional code must be added to - THEN, to calculate the relative offset. - - 5. IF, ... ELSE, ... THEN, - - A refinement of the IF,...THEN, construct allows code to be - executed if the condition is NOT satisfied. The Forth - syntax is - - cc IF, ... ... ELSE, ... ... THEN, - - ELSE, has the expected meaning: if the first part of this - statement is not executed, then the second part is. - - The assembler code necessary to create this construct is: - - JP ~cc,xxx - ... ( the "if" code) - ... - JP yyy - xxx: ... ( the "else" code) - ... - yyy: - - ELSE, must modify the actions of IF, and THEN, as follows: - a) the forward jump from IF, must be patched to the start of - the "else" code ("xxx"); and b) the address supplied by - THEN, must be patched into the unconditional jump - instruction at the end of the "if" code ("JP yyy"). ELSE, - must also assemble the unconditional jump. This is done - thus: - - : ELSE ( a - a) 0 T JP, ( unconditional jump) - HERE 2 - ( stack its address - for THEN, to patch) - SWAP ( get the patch address - of the IF, jump) - HERE SWAP ! ( patch it to the current - location, i.e., the - ; next instruction) - - Note that the jump condition 'T' assembles a "jump always" - instruction. The code from IF, and THEN, can be "re-used" - if the condition 'F' is defined as the condition-code - inverse of 'T': - - : ELSE ( a - a) F IF, SWAP THEN, ; - - The SWAP of the stacked addresses reverses the patch order, - so that the THEN, inside ELSE, patches the original IF; and - the final THEN, patches the IF, inside ELSE,. Graphically, - this becomes: - - IF,(1) ... IF,(2) THEN,(1) ... THEN,(2) - \______________/ - inside ELSE, - - IF,...THEN, and IF,...ELSE,...THEN, structures can be - nested. This freedom of nesting also extends to mixtures of - these and BEGIN,...UNTIL, structures. - - 6. BEGIN, ... WHILE, ... REPEAT, - - The final, and most complex, assembler control structure is - the "while" loop in which the condition is tested at the - beginning of the loop, rather than at the end. - - In Forth the accepted syntax for this structure is - - BEGIN, evaluate cc WHILE, loop code REPEAT, - - In practice, any code -- not just condition evaluations -- - may be inserted between BEGIN, and WHILE,. - - What needs to be assembled is this: WHILE, will assemble a - conditional jump, on the inverse of cc, to the code - following the REPEAT,. (If the condition code cc is - satisfied, we should "fall through" WHILE, to execute the - loop code.) REPEAT, will assemble an unconditional jump - back to BEGIN. Or, in terms of existing constructs: - - BEGIN,(1) ... cc IF,(2) ... AGAIN,(1) THEN,(2) - - Once again, this can be implemented with existing words, by - means of a stack manipulation inside WHILE, to re-arrange - what jumps are patched by whom: - - : WHILE, ( a cc - a a) IF, SWAP ; - : REPEAT, ( a a - ) AGAIN, THEN, ; - - Again, nesting is freely permitted. - - - H. THE FORTH DEFINITION HEADER - - In most applications, machine code created by a Forth - assembler will be put in a CODE word in the Forth - dictionary. This requires giving it an identifying text - "name," and linking it into the dictionary list. - - The Forth word CREATE performs these functions for the - programmer. CREATE will parse a word from the input stream, - build a new entry in the dictionary with that name, and - adjust the dictionary pointer to the start of the - "definition field" for this word. - - Standard Forth uses the word CODE to distinguish the start - of an assembler definition in the Forth dictionary. In - addition to performing CREATE, the word CODE may set the - assembler environment (vocabulary), and may reset variables - (such as MODE) in the assembler. Some Forths may also - require a "code address" field; this is set by CREATE in - some systems, while others expect CODE to do this. - - - I. SPECIAL CASES - - 1. Resident vs. cross-compilation - - Up to now, it has been assumed that the machine code is to - be assembled into the dictionary of the machine running the - assembler. - - For cross-assembly and cross-compilation, code is usually - assembled for the "target" machine into a different area of - memory. This area may or may not have its own dictionary - structure, but it is separate from the "host" machine's - dictionary. - - The most common and straightforward solution is to provide - the host machine with a set of Forth operators to access the - "target" memory space. These are made deliberately - analogous to the normal Forth memory and dictionary - operators, and are usually distinguished by the prefix "T". - The basic set of operators required is: - - TDP target dictionary pointer DP - THERE analogous to HERE, returns TDP - TC, target byte append C, - TC@ target byte fetch C@ - TC! target byte store C! - T@ target word fetch @ - T! target word store ! - - Sometimes, instead of using the "T" prefix, these words will - be given identical names but in a different Forth - vocabulary. (The vocabulary structure in Forth allows - unambiguous use of the same word name in multiple contexts.) - The 6809 assembler in Part 2 assumes this. - - 2. Compiling to disk - - Assembler output can be directed to disk, rather than to - memory. This, too, can be handled by defining a new set of - dictionary, fetch, and store operators. They can be - distinguished with a different prefix (such as "T" again), - or put in a distinct vocabulary. - - Note that the "patching" manipulations used in the - single-pass control structures require a randomly- - accessible output medium. This is not a problem with disk, - although heavy use of control structures may result in some - inefficient disk access. - - 3. Compiler Security - - Some Forth implementations include a feature known as - "compiler security," which attempts to catch mismatches of - control structures. For example, the structure - - IF, ... cc UNTIL, - - would leave the stack balanced (UNTIL, consumes the address - left by IF,), but would result in nonsense code. - - The usual method for checking the match of control - structures is to require the "leading" control word to leave - a code value on the stack, and the "trailing" word to check - the stack for the correct value. For example: - - IF, leaves a 1; - THEN, checks for a 1; - ELSE, checks for a 1 and leaves a 1; - BEGIN, leaves a 2; - UNTIL, checks for a 2; - AGAIN, checks for a 2; - WHILE, checks for a 2 and leaves a 3; - REPEAT, checks for a 3. - - This will detect most mismatches. Additional checks may be - included for the stack imbalance caused by "unmatched" - control words. (The 6809 assembler uses both of these error - checks.) - - The cost of compiler security is the increased complexity of - the stack manipulations in such words as ELSE, and WHILE,. - Also, the programmer may wish to alter the order in which - control structures are resolved, by manually re-arranging - the stack; compiler security makes this more difficult. - - 4. Labels - - Even in the era of structured programming, some programmers - will insist on labels in their assembler code. - - The principal problem with named labels in a Forth assembler - definition is that the labels themselves are Forth words. - They are compiled into the dictionary -- usually at an - inconvenient point, such as inside the machine code. For - example: - - CODE TEST ... machine code ... - HERE CONSTANT LABEL1 - ... machine code ... - LABEL1 NZ JP, - - will cause the dictionary header for LABEL1 -- text, links, - and all -- to be inserted in the middle of CODE. Several - solutions have been proposed: - - a) define labels only "outside" machine code. - Occasionally useful, but very restricted. - - b) use some predefined storage locations (variables) to - provide "temporary," or local, labels. - - c) use a separate dictionary space for the labels, e.g., - as provided by the TRANSIENT scheme [3]. - - d) use a separate dictionary space for the machine code. - This is common practice for meta-compilation; most - Forth meta- compilers support labels with little - difficulty. - - 5. Table Driven Assemblers - - Most Forth assemblers can handle the profusion of addressing - modes and instruction opcodes by CASE statements and other - flow-of-control constructs. These may be referred to as - "procedural" assemblers. - - Some processors, notably the Motorola 68000, have - instruction and addressing sets so complex as to render the - decision trees immense. In such cases, a more "table- - driven" approach may save substantial memory and processor - time. - - (I avoid such processors. Table driven assemblers are much - more complex to write.) - - 6. Prefix Assemblers - - Sometimes a prefix assembler is unavoidable. (One example: - I recently translated many K of Super8 assembler code from - the Zilog assembler to a Forth assembler.) There is a - programming "trick" which simulates a prefix assembler, - while using the assembler techniques described in this - article. - - Basically, this trick is to "postpone" execution of the - opcode word, until after the operands have been evaluated. - How can the assembler determine when the operands are - finished? Easy: when the next opcode word is encountered. - - So, every opcode word is modified to a) save its own - execution address somewhere, and b) execute the "saved" - action of the previous opcode word. For example: - - ... JP operand ADD operands ... - - JP stores its execution address (and the address of its - "instance" parameters) in a variable somewhere. Then, the - operands are evaluated. ADD will fetch the information - saved by JP, and execute the run-time action of JP. The JP - action will pick up whatever the operands left on the stack. - When the JP action returns, ADD will save its own execution - address and instance parameters, and the process continues. - (Of course, JP would have executed its previous opcode.) - - This is confusing. Special care must be taken for the first - and last opcodes in the assembler code. If mode variables - are used, the problem of properly saving and restoring them - becomes nightmarish. I leave this subject as an exercise - for the advanced student...or for an article of its own. - - J. CONCLUSION - - I've touched upon the common techniques used in Forth - assemblers. Since I believe the second-best way to learn is - by example, in part 2 I will present the full code for the - 6809 assembler. Studying a working assembler may give you - hints on writing an assembler of your own. - - The BEST way to learn is by doing! - - K. REFERENCES - - 1. Curley, Charles, Advancing Forth. Unpublished manuscript - (1985). - - 2. Wasson, Philip, "Transient Definitions," Forth Dimensions - III/6 (Mar-Apr 1982), p.171. - - L. ADDITIONAL SOURCES - - 1. Cassady, John J., "8080 Assembler," Forth Dimensions III/6 - (Mar-Apr 1982), pp. 180-181. Noteworthy in that the entire - assembler fits in less than 48 lines of code. - - 2. Ragsdale, William F., "A FORTH Assembler for the 6502," Dr. - Dobb's Journal #59 (September 1981), pp. 12-24. A simple - illustration of addressing modes. - - 3. Duncan, Ray, "FORTH 8086 Assembler," Dr. Dobb's Journal #64 - (February 1982), pp. 14-18 and 33-46. - - 4. Perry, Michael A., "A 68000 Forth Assembler," Dr. Dobb's - Journal #83 (September 1983), pp. 28-42. - - 5. Assemblers for the 8080, 8051, 6502, 68HC11, 8086, 80386, - 68000, SC32, and Transputer can be downloaded from the Forth - Interest Group (FORTH) conference on GEnie. - \ No newline at end of file diff --git a/docs/README.md b/docs/README.md new file mode 100644 index 0000000..a98f5fe --- /dev/null +++ b/docs/README.md @@ -0,0 +1,6 @@ +# Links + +* https://users.ece.cmu.edu/~koopman/stack_computers/sec4_4.html +* https://www.fpgarelated.com/showarticle/790.php +* https://github.com/jamesbowman/j1 +* http://www.excamera.com/sphinx/fpga-j1.html diff --git a/docs/buzzard/README b/docs/buzzard/README new file mode 100644 index 0000000..e95ba91 --- /dev/null +++ b/docs/buzzard/README @@ -0,0 +1 @@ +See http://www.ioccc.org/1992/ diff --git a/docs/buzzard/buzzard.2.README b/docs/buzzard/buzzard.2.README new file mode 100644 index 0000000..ee59a3b --- /dev/null +++ b/docs/buzzard/buzzard.2.README @@ -0,0 +1,22 @@ +buzzard.2.README this file +buzzard.2.design description of FIRST (design documentation of THIRD) +third implementation of THIRD in FIRST +help.th online listing of THIRD primitives + + FIRST demos: use 'first < {demo}' + +demo1.1st prints Hello World! assuming ASCII + + THIRD demos: use 'cat third {demo} | first' + +demo1.th prints Hello World! regardless of character set +demo2.th demonstrates a simple loop +demo3.th demonstrates a simple if test +demo4.th recursive factorial calculating on the way up +demo5.th recursive factorial calculating on the way down +demo6.th demonstrates switching from compiler to execution mode + + Interactive THIRD: use 'cat third - | first'. + + To include the primitive on-line help, use + 'cat third help.th - | first'. diff --git a/docs/buzzard/buzzard.2.c b/docs/buzzard/buzzard.2.c new file mode 100644 index 0000000..4765458 --- /dev/null +++ b/docs/buzzard/buzzard.2.c @@ -0,0 +1,61 @@ +#define c m[m[0]++] = +#define z;break;case + +char s[5000]; +int m[20000]={32},L=1,I,T[500],*S=T,t=64,w,f; + +a(x) +{ + c L; + L= *m-1; + c t; + c x; + scanf("%s",s+t); + t+=strlen(s+t)+1; +} + +r(x) +{ + switch(m[x++]){ + z 5: for(w=scanf("%s",s)<1?exit(0),0:L;strcmp(s,&s[m[w+1]]);w=m[w]); + w-1 ? r(w+2) : (c 2,c atoi(s)) + z 12: I=m[m[1]--] + z 15: f=S[-f] + z 1: c x + z 9: f *=* S-- + z 7: m[f]= *S--; + f= *S-- + z 0: *++S=f; + f=m[I++] + z 8: f= *S --- f + z 2: m[++m[1]]=I; + I=x + z 11: f=0>f + z 4: *m-=2;c 2 + z 6: f=m[f] + z 10: f= *S--/f + z 3: a(1); + c 2 + z 13: putchar(f); + f= *S-- + z 14: *++S=f; + f=getchar(); + } +} + +main() +{ + a(3); + a(4); + a(1); + w= *m; + c 5; + c 2; + I= *m; + c w; + c I-1; + for(w=6;w<16;) + a(1),c w++; + m[1]= *m; + for(*m+=512;;r(m[I++])); +} diff --git a/docs/buzzard/buzzard.2.design b/docs/buzzard/buzzard.2.design new file mode 100644 index 0000000..49b2e2d --- /dev/null +++ b/docs/buzzard/buzzard.2.design @@ -0,0 +1,780 @@ + FIRST & THIRD + almost FORTH + + FORTH is a language mostly familiar to users of "small" machines. +FORTH programs are small because they are interpreted--a function +call in FORTH takes two bytes. FORTH is an extendable language-- +built-in primitives are indistinguishable from user-defined +_words_. FORTH interpreters are small because much of the system +can be coded in FORTH--only a small number of primitives need to +be implemented. Some FORTH interpreters can also compile defined +words into machine code, resulting in a fast system. + + FIRST is an incredibly small language which is sufficient for +defining the language THIRD, which is mostly like FORTH. There are +some differences, and THIRD is probably just enough like FORTH for +those differences to be disturbing to regular FORTH users. + + The only existing FIRST interpreter is written in obfuscated C, +and rings in at under 800 bytes of source code, although through +deletion of whitespace and unobfuscation it can be brought to about +650 bytes. + + This document FIRST defines the FIRST environment and primitives, +with relevent design decision explanations. It secondly documents +the general strategies we will use to implement THIRD. The THIRD +section demonstrates how the complete THIRD system is built up +using FIRST. + + +Section 1: FIRST + + +Environment + + FIRST implements a virtual machine. The machine has three chunks +of memory: "main memory", "the stack", and "string storage". When +the virtual machine wishes to do random memory accesses, they come +out of main memory--it cannot access the stack or string storage. + + The stack is simply a standard LIFO data structure that is used +implicitly by most of the FIRST primitives. The stack is made up +of ints, whatever size they are on the host machine. + + String storage is used to store the names of built-in and defined +primitives. Separate storage is used for these because it allows +the C code to use C string operations, reducing C source code size. + + Main memory is a large array of ints. When we speak of +addresses, we actually mean indices into main memory. Main memory +is used for two things, primarily: the return stack and the dictionary. + + The return stack is a LIFO data structure, independent of +the abovementioned "the stack", which is used by FIRST to keep +track of function call return addresses. + + The dictionary is a list of words. Each word contains a header +and a data field. In the header is the address of the previous word, +an index into the string storage indicating where the name of this +word is stored, and a "code pointer". The code pointer is simply +an integer which names which "machine-language-primitive" implements +this instruction. For example, for defined words the code pointer +names the "run some code" primitive, which pushes the current program +counter onto the return stack and sets the counter to the address of +the data field for this word. + + There are several important pointers into main memory. There is +a pointer to the most recently defined word, which is used to start +searches back through memory when compiling words. There is a pointer +to the top of the return stack. There is a pointer to the current +end of the dictionary, used while compiling. + + For the last two pointers, namely the return stack pointer and +the dictionary pointer, there is an important distinction: the pointers +themselves are stored in main memory (in FIRST's main memory). This +is critical, because it means FIRST programs can get at them without +any further primitives needing to be defined. + + +Instructions + + There are two kinds of FIRST instructions, normal instructions and +immediate instructions. Immediate instructions do something significant +when they are used. Normal instructions compile a pointer to their +executable part onto the end of the dictionary. As we will see, this +means that by default FIRST simply compiles things. + + Integer Operations +Symbol Name Function + - binary minus pop top 2 elements of stack, subtract, push + * multiply pop top 2 elements of stack, multiply, push + / divide pop top 2 elements of stack, divide, push + <0 less than 0 pop top element of stack, push 1 if < 0 else 0 + +Note that we can synthesize addition and negation from binary minus, +but we cannot synthesize a time efficient divide or multiply from it. +<0 is synthesizable, but only nonportably. + + Memory Operations +Symbol Name Function + @ fetch pop top of stack, treat as address to push contents of + ! store top of stack is address, 2nd is value; store to memory + and pop both off the stack + + Input/Output Operations +Name Function +echo output top of stack through C's putchar() +key push C's getchar() onto top of stack +_read read a space-delimited word, find it in the + dictionary, and compile a pointer to + that word's code pointer onto the + current end of the dictionary + +Although _read could be synthesized from key, we need _read to be able +to compile words to be able to start any syntheses. + + Execution Operations +Name Function +exit leave the current function: pop the return stack + into the program counter + + Immediate (compilation) Operations +Symbol Name Function + : define read in the next space-delimited word, add it to + the end of our string storage, and generate + a header for the new word so that when it + is typed it compiles a pointer to itself + so that it can be executed. +immediate immediate when used immediately after a name following a ':', + makes the word being defined run whenever + it is typed. + +: cannot be synthesized, because we could not synthesize anything. +immediate has to be an immediate operation, so it could not be +synthesized unless by default operations were immediate; but that +would preclude our being able to do any useful compilation. + + Stack Operations +Name Function +pick pop top of stack, use as index into stack and copy up + that element + +If the data stack were stored in main memory, we could synthesize pick; +but putting the stack and stack pointer in main memory would significantly +increase the C source code size. + + There are three more primitives, but they are "internal only"-- +they have no names and no dictionary entries. The first is +"pushint". It takes the next integer out of the instruction stream +and pushes it on the stack. This could be synthesized, but probably +not without using integer constants. It is generated by _read when +the input is not a known word. The second is "compile me". When +this instruction is executed, a pointer to the word's data field is +appended to the dictionary. The third is "run me"--the word's data +field is taken to be a stream of pointers to words, and is executed. + + One last note about the environment: FIRST builds a very small +word internally that it executes as its main loop. This word calls +_read and then calls itself. Each time it calls itself, it uses +up a word on the return stack, so it will eventually trash things. +This is discussed some more in section 2. + + +Here's a handy summary of all the FIRST words: + + - * / binary integer operations on the stack + <0 is top of stack less than 0? + @ ! read from or write to memory + echo key output or input one character + _read read a word from input and compile a pointer to it + exit stop running the current function + : compile the header of a definition + immediate modify the header to create an immediate word + + Here is a sample FIRST program. I'm assuming you're using +the ASCII character set. FIRST does not depend upon ASCII, but +since FIRST has no syntax for character constants, one normally has +to use decimal values. This can be gotten around using getchar, though. +Oh. One other odd thing. FIRST initially builds its symbol table +by calling : several times, so it needs to get the names of the base +symbols as its first 13 words of input. You could even name them +differently if you wanted. + These FIRST programs have FORTH comments in them: they are contained +inside parentheses. FIRST programs cannot have FORTH comments; but I need +some device to indicate what's going on. (THIRD programs are an entirely +different subject.) + + ( Our first line gives the symbols for the built-ins ) +: immediate _read @ ! - * / <0 exit echo key _pick + + ( now we define a simple word that will print out a couple characters ) + +: L ( define a word named 'L' ) + 108 echo ( output an ascii 'l' ) + exit + +: hello ( define a word named 'hello') + 72 echo ( output an ascii 'H' ) + 101 echo ( output an ascii 'e' ) + 111 ( push ascii 'o' onto the stack ) + L L ( output two ascii 'l's ) + echo ( output the 'o' we pushed on the stack before ) + 10 echo ( print a newline ) + exit ( stop running this routine ) + +: test immediate ( define a word named 'test' that runs whenever typed ) + hello ( call hello ) + exit + +test + +( The result of running this program should be: +Hello +) + + +Section 2: Motivating THIRD + + What is missing from FIRST? There are a large number of +important primitives that aren't implemented, but which are +easy to implement. drop , which throws away the top of the +stack, can be implemented as { 0 * + } -- that is, multiply +the top of the stack by 0 (which turns the top of the stack +into a 0), and then add the top two elements of the stack. + + dup , which copies the top of the stack, can be easily +implemented using temporary storage locations. Conveniently, +FIRST leaves memory locations 3, 4, and 5 unused. So we can +implement dup by writing the top of stack into 3, and then +reading it out twice: { 3 ! 3 @ 3 @ }. + + we will never use the FIRST primitive 'pick' in building THIRD, +just to show that it can be done; 'pick' is only provided because +pick itself cannot be built out of the rest of FIRST's building +blocks. + + So, instead of worrying about stack primitives and the +like, what else is missing from FIRST? We get recursion, but +no control flow--no conditional operations. We cannot at the +moment write a looping routine which terminates. + + Another glaring dissimilarity between FIRST and FORTH is +that there is no "command mode"--you cannot be outside of a +: definition and issue some straight commands to be executed. +Also, as we noted above, we cannot do comments. + + FORTH also provides a system for defining new data types, +using the words [in one version of FORTH] . +We would like to implement these words as well. + + As the highest priority thing, we will build control flow +structures first. Once we have control structures, we can +write recursive routines that terminate, and we are ready to +tackle tasks like parsing, and the building of a command mode. + + By the way, location 0 holds the dictionary pointer, location +1 holds the return stack pointer, and location 2 should always +be 0--it's a fake dictionary entry that means "pushint". + + +Section 3: Building THIRD + + In this section, I'm going to keep my conversation + indented to this depth, rather than using fake comments-- + because we'll have real comments eventually. + + The first thing we have to do is give the symbols for our + built-ins. + +: immediate _read @ ! - * / < exit echo key _pick + + Next we want to be mildly self commenting, so we define + the word 'r' to push the *address of the return stack + pointer* onto the stack--NOT the value of the return + stack pointer. (In fact, when we run r, the value of + the return stack pointer is temporarily changed.) + +: r 1 exit + + Next, we're currently executing a short loop that contains + _read and recursion, which is slowly blowing up the return + stack. So let's define a new word, from which you can + never return. What it does is drops the top value off + the return stack, calls _read, then calls itself. Because + it kills the top of the return stack, it can recurse + indefinitely. + +: ] + r @ Get the value of the return stack pointer + 1 - Subtract one + r ! Store it back into the return stack pointer + _read Read and compile one word + ] Start over + + Notice that we don't need to exit, since we never come + back. Also, it's possible that an immediate word may + get run during _read, and that _read will never return! + + Now let's get compile running. + +: main immediate ] +main + + Next off, I'm going to do this the easy but non-portable + way, and put some character constant definitions in. + I wanted them at the top of the file, but that would have + burned too much of the return stack. + +: '"' 34 exit +: ')' 41 exit +: '\n' 10 exit +: 'space' 32 exit +: '0' 48 exit +: '-' 45 exit + +: cr '\n' echo exit + + Next, we want to define some temporary variables for + locations 3, 4, and 5, since this'll make our code look + clearer. +: _x 3 @ exit +: _x! 3 ! exit +: _y 4 @ exit +: _y! 4 ! exit + + Ok. Now, we want to make THIRD look vaguely like FORTH, + so we're going to define ';'. What ; ought to do is + terminate a compilation, and turn control over to the + command-mode handler. We don't have one, so all we want + ';' to do for now is compile 'exit' at the end of the + current word. To do this we'll need several other words. + + Swap by writing out the top two elements into temps, and + then reading them back in the other order. +: swap _x! _y! _x _y exit + Take another look and make sure you see why that works, + since it LOOKS like I'm reading them back in the same + order--in fact, it not only looks like it, but I AM! + + Addition might be nice to have. To add, we need to + negate the top element of the stack, and then subtract. + To negate, we subtract from 0. +: + + 0 swap - + - + exit + + Create a copy of the top of stack +: dup _x! _x _x exit + + Get a mnemonic name for our dictionary pointer--we need + to compile stuff, so it goes through this. +: h 0 exit + + We're going to need to advance that pointer, so let's + make a generic pointer-advancing function. + Given a pointer to a memory location, increment the value + at that memory location. +: inc + dup @ Get another copy of the address, and get the value + so now we have value, address on top of stack. + 1 + Add one to the value + swap Swap to put the address on top of the stack + ! exit Write it to memory + + , is a standard FORTH word. It should write the top of + stack into the dictionary, and advance the pointer +: , + h @ Get the value of the dictionary pointer + ! Write the top of stack there + h inc And increment the dictionary pointer + exit + + ' is a standard FORTH word. It should push the address + of the word that follows it onto the stack. We could + do this by making ' immediate, but then it'd need to + parse the next word. Instead, we compile the next word + as normal. When ' is executed, the top of the return + stack will point into the instruction stream immediately + after the ' . We push the word there, and advance the + return stack pointer so that we don't execute it. +: ' + r @ Get the address of the top of return stack + We currently have a pointer to the top of return stack + @ Get the value from there + We currently have a pointer to the instruction stream + dup Get another copy of it--the bottom copy will stick + around until the end of this word + 1 + Increment the pointer, pointing to the NEXT instruction + r @ ! Write it back onto the top of the return stack + We currently have our first copy of the old pointer + to the instruction stream + @ Get the value there--the address of the "next word" + exit + + Now we're set. ; should be an immediate word that pushes + the address of exit onto the stack, then writes it out. +: ; immediate + ' exit Get the address of exit + , Compile it + exit And we should return + + Now let's test out ; by defining a useful word: +: drop 0 * + ; + + Since we have 'inc', we ought to make 'dec': +: dec dup @ 1 - swap ! ; + + Our next goal, now that we have ;, is to implement + if-then. To do this, we'll need to play fast and + loose with the return stack, so let's make some + words to save us some effort. + + First we want a word that pops off the top of the normal + stack and pushes it on top of the return stack. We'll + call this 'tor', for TO-Return-stack. It sounds easy, + but when tor is running, there's an extra value on the + return stack--tor's return address! So we have to pop + that off first... We better just bite the bullet and + code it out--but we can't really break it into smaller + words, because that'll trash the return stack. +: tor + r @ @ Get the value off the top of the return stack + swap Bring the value to be pushed to the top of stack + r @ ! Write it over the current top of return stack + r @ 1 + r ! Increment the return stack pointer--but can't use inc + r @ ! Store our return address back on the return stack +; + + Next we want the opposite routine, which pops the top + of the return stack, and puts it on the normal stack. +: fromr + r @ @ Save old value + r @ 1 - r ! Decrement pointer + r @ @ Get value that we want off + swap Bring return address to top + r @ ! Store it and return +; + + Now, if we have a routine that's recursing, and we + want to be polite about the return stack, right before + we recurse we can run { fromr drop } so the stack won't + blow up. This means, though, that the first time we + enter this recursive routine, we blow our *real* return + address--so when we're done, we'll return up two levels. + To save a little, we make 'tail' mean { fromr drop }; + however, it's more complex since there's a new value on + top of the return stack. +: tail fromr fromr drop tor ; + + Now, we want to do 'if'. To do this, we need to convert + values to boolean values. The next few words set this + up. + + minus gives us unary negation. +: minus 0 swap - ; + + If top of stack is boolean, bnot gives us inverse +: bnot 1 swap - ; + + To compare two numbers, subtract and compare to 0. +: < - <0 ; + + logical turns the top of stack into either 0 or 1. +: logical + dup Get two copies of it + 0 < 1 if < 0, 0 otherwise + swap minus Swap number back up, and take negative + 0 < 1 if original was > 0, 0 otherwise + + Add them up--has to be 0 or 1! +; + + not returns 1 if top of stack is 0, and 0 otherwise +: not logical bnot ; + + We can test equality by subtracting and comparing to 0. +: = - not ; + + Just to show how you compute a branch: Suppose you've + compiled a call to branch, and immediately after it is + an integer constant with the offset of how far to branch. + To branch, we use the return stack to read the offset, and + add that on to the top of the return stack, and return. +: branch + r @ Address of top of return stack + @ Our return address + @ Value from there: the branch offset + r @ @ Our return address again + + The address we want to execute at + r @ ! Store it back onto the return stack +; + + For conditional branches, we want to branch by a certain + amount if true, otherwise we want to skip over the branch + offset constant--that is, branch by one. Assuming that + the top of the stack is the branch offset, and the second + on the stack is 1 if we should branch, and 0 if not, the + following computes the correct branch offset. +: computebranch 1 - * 1 + ; + + Branch if the value on top of the stack is 0. +: notbranch + not + r @ @ @ Get the branch offset + computebranch Adjust as necessary + r @ @ + Calculate the new address + r @ ! Store it +; + + here is a standard FORTH word which returns a pointer to + the current dictionary address--that is, the value of + the dictionary pointer. +: here h @ ; + + We're ALL SET to compile if...else...then constructs! + Here's what we do. When we get 'if', we compile a call + to notbranch, and then compile a dummy offset, because + we don't know where the 'then' will be. On the *stack* + we leave the address where we compiled the dummy offset. + 'then' will calculate the offset and fill it in for us. +: if immediate + ' notbranch , Compile notbranch + here Save the current dictionary address + 0 , Compile a dummy value +; + + then expects the address to fixup to be on the stack. +: then immediate + dup Make another copy of the address + here Find the current location, where to branch to + swap - Calculate the difference between them + swap ! Bring the address to the top, and store it. +; + + Now that we can do if...then statements, we can do + some parsing! Let's introduce real FORTH comments. + find-) will scan the input until it finds a ), and + exit. +: find-) + key Read in a character + ')' = Compare it to close parentheses + not if If it's not equal + tail find-) repeat (popping R stack) + then Otherwise branch here and exit +; + +: ( immediate + find-) +; + +( we should be able to do FORTH-style comments now ) + +( now that we've got comments, we can comment the rest of the code + in a legitimate [self parsing] fashion. Note that you can't + nest parentheses... ) + +: else immediate + ' branch , ( compile a definite branch ) + here ( push the backpatching address ) + 0 , ( compile a dummy offset for branch ) + swap ( bring old backpatch address to top ) + dup here swap - ( calculate the offset from old address ) + swap ! ( put the address on top and store it ) +; + +: over _x! _y! _y _x _y ; + +: add + _x! ( save the pointer in a temp variable ) + _x @ ( get the value pointed to ) + + ( add the incremement from on top of the stack ) + _x ! ( and save it ) +; + +: allot h add ; + +: maybebranch + logical ( force the TOS to be 0 or 1 ) + r @ @ @ ( load the branch offset ) + computebranch ( calculate the condition offset [either TOS or 1]) + r @ @ + ( add it to the return address ) + r @ ! ( store it to our return address and return ) +; + +: mod _x! _y! ( get x then y off of stack ) + _y _y _x / _x * ( y - y / x * x ) + - +; + +: printnum + dup + 10 mod '0' + + swap 10 / dup + if + printnum + echo + else + drop + echo + then +; + +: . + dup 0 < + if + '-' echo minus + then + printnum + 'space' echo +; + +: debugprint dup . cr ; + +( the following routine takes a pointer to a string, and prints it, + except for the trailing quote. returns a pointer to the next word + after the trailing quote ) + +: _print + dup 1 + + swap @ + dup '"' = + if + drop exit + then + echo + tail _print +; + +: print _print ; + + ( print the next thing from the instruction stream ) +: immprint + r @ @ + print + r @ ! +; + +: find-" + key dup , + '"' = + if + exit + then + tail find-" +; + +: " immediate + key drop + ' immprint , + find-" +; + +: do immediate + ' swap , ( compile 'swap' to swap the limit and start ) + ' tor , ( compile to push the limit onto the return stack ) + ' tor , ( compile to push the start on the return stack ) + here ( save this address so we can branch back to it ) +; + +: i r @ 1 - @ ; +: j r @ 3 - @ ; + +: > swap < ; +: <= 1 + < ; +: >= swap <= ; + +: inci + r @ 1 - ( get the pointer to i ) + inc ( add one to it ) + r @ 1 - @ ( find the value again ) + r @ 2 - @ ( find the limit value ) + <= + if + r @ @ @ r @ @ + r @ ! exit ( branch ) + then + fromr 1 + + fromr drop + fromr drop + tor +; + +: loop immediate ' inci @ here - , ; + +: loopexit + + fromr drop ( pop off our return address ) + fromr drop ( pop off i ) + fromr drop ( pop off the limit of i ) +; ( and return to the caller's caller routine ) + +: execute + 8 ! + ' exit 9 ! + 8 tor +; + +: :: ; ( :: is going to be a word that does ':' at runtime ) + +: fix-:: immediate 3 ' :: ! ; +fix-:: + + ( Override old definition of ':' with a new one that invokes ] ) +: : immediate :: ] ; + +: command + here 5 ! ( store dict pointer in temp variable ) + _read ( compile a word ) + ( if we get control back: ) + here 5 @ + = if + tail command ( we didn't compile anything ) + then + here 1 - h ! ( decrement the dictionary pointer ) + here 5 @ ( get the original value ) + = if + here @ ( get the word that was compiled ) + execute ( and run it ) + else + here @ ( else it was an integer constant, so push it ) + here 1 - h ! ( and decrement the dictionary pointer again ) + then + tail command +; + +: make-immediate ( make a word just compiled immediate ) + here 1 - ( back up a word in the dictionary ) + dup dup ( save the pointer to here ) + h ! ( store as the current dictionary pointer ) + @ ( get the run-time code pointer ) + swap ( get the dict pointer again ) + 1 - ( point to the compile-time code pointer ) + ! ( write run-time code pointer on compile-time pointer ) +; + +: ) + ' , , ( compile a push that address onto dictionary ) +; + +: does> immediate + ' command , ( jump back into command mode at runtime ) + here swap ! ( backpatch the build> to point to here ) + 2 , ( compile run-code primitive so we look like a word ) + ' fromr , ( compile fromr, which leaves var address on stack ) +; + + +: _dump ( dump out the definition of a word, sort of ) + dup " (" . " , " + dup @ ( save the pointer and get the contents ) + dup ' exit + = if + " ;)" cr exit + then + . " ), " + 1 + + tail _dump +; + +: dump _dump ; + +: # . cr ; + +: var ; +: constant @ ; +: array + ; + +: [ immediate command ; +: _welcome " Welcome to THIRD. +Ok. +" ; + +: ; immediate ' exit , command exit + +[ + +_welcome + diff --git a/docs/buzzard/buzzard.2.hint b/docs/buzzard/buzzard.2.hint new file mode 100644 index 0000000..b0fe22b --- /dev/null +++ b/docs/buzzard/buzzard.2.hint @@ -0,0 +1,217 @@ +Best Language Tool: + + Sean Barrett + Software Construction Company + 430 Southwest Parkway, #1906 + College Station, TX 77840 + USA + + +Judges' comments: + + First: + make first + + Second: + echo help | cat third help.th - | first + cat third demo5.th | first + + Third: + cat third help.th - | first + + Wait until Ok is printed and the type: + 2 3 + . cr <-- yes you should really type the 2 letters: cr + + Forth: + Sorry, this is third! + + +Selected notes from the author: + + What it does: + + first implements a relatively primitive stack machine. How + primitive? It supplies 13 visible primitives: 3 arithmetic, + 1 comparison, 2 memory-access, 2 character I/O, 3 primitives + for defining new words, 1 tokenizing, and 1 special stack + operation. (There are also three internal operations for + the stack machine: 'push this integer', 'call this code', + and 'compile a call to this code'.) + + It is very difficult to accomplish anything with this set + of primitives, but they do have an interesting property. + + This--what this interesting property is, or in other words + what first is good for--is the major obfuscation; there are + also minor source obfuscations, as well as some design tricks + that are effectively obfuscations. Details on the obfuscations + are below, and the interesting property is discussed much + further down. + + + How to run it: + + first expects you to first enter the names of the 13 primitives, + separated by whitespace--it doesn't care what you name them, but + if all the names aren't unique, you won't be able to use some of + them. After this you may type any sequence of valid first input. + Valid first input is defined as any sequence of whitespace-delimited + tokens which consist of primitives, new words you've defined, and + integers (as parsed by "%d"). Invalid input behaves unpredictably, + but gives no warning messages. A sample program, demo1.1st, is + included, but it only works on ASCII systems. + + Do not expect to be able to do anything interesting with first. + + To do something interesting, you need to feed first the file + third first. In unix, you can do + + % cat third help.th - | first + + to do this. Hopefully most operating systems will provide a + way to do this. It may take some time for this to complete + (I seem to remember it taking several minutes on an 8086 PC); + THIRD will prompt you when it is finished. The file third has + not been obfuscated, due to sheer kindness on the author's part. + + For more information on what you can do once you've piped + THIRD into first, type 'help' and consult FORTH manuals for + further reference. Six sample THIRD programs are included + in the files demo[1-6].th. buzzard.2.README has more + information. + + Keep in mind that you are still running first, and + are for the most part limited by first's tokenizer + (notably, unknown words will attempt to be parsed as + integers.) It is possible to build a new parser that + parses by hand, reading a single character at a time; + however, such a parser cannot easily use the existing + dictionary, and so would have to implement its own, + thus requiring reimplementing all of first and third + a second time--I did not care to tackle this project. + + + Compiling: + + first is reasonably portable. You may need to adjust the + size of the buffers on smaller machines; m[] needs to be + at least 2000 long, though. + + I say first is portable mainly because it uses native types. + Unlike FORTH, which traditionally allows byte and multi-byte + operations, all operations are performed on C 'int's. That + means first code is only as portable as the same code would + be in C. As in C, the result of dividing -1 by 2 is machine + (or rather compiler) dependent. + + How is first obfuscated? + + first is obfuscated in several ways. Some minor obfuscations + like &w[&m[1]][s] for s+m[w+1] were in the original source + but are no longer because, apparently, ANSI doesn't allow it + (gcc -ansi -pedantic doesn't mind it, though.) + Other related obfuscations are still present. The top of the + stack is cached in a variable, which increases performance + massively if the compiler can figure out to keep it in a register; + it also obfuscates the code. (Unfortunately, the top of stack + is a global variable and neither gcc nor most bundled compilers + seem to register allocate it.) + + More significant are the design obfuscations. m[0] is the + "dictionary pointer", used when compiling words, and m[1] is + the return stack index. Both are used as integer offsets into + m. Both are kept in m, instead of as separate pointers, + because they are then accessible to first programs, which is a + crucial property of first. Similarly the way words are stored + in the dictionary is not obvious, so it can be difficult to + follow exactly what the compiler words are doing. + + Assuming you've waded through all that, you still have + to penetrate the most significant obfuscation. Traditionally, + the question is whether a reader can answer the question "what + will this do when I run it". A reader who has deciphered first + to this point may think they know the answer to this question, + but they may not know the answer to the more important question, + "what will this program do when given the right input?" FORTH + afficianados, and especially FORTH implementors, may recognize + the similarity of the internal compiler format to many FORTH + interal representations, and, being aware that FORTH interpreters + can often by self-compiling, may be suspicious that this program + can compile FORTH, or a significant subset of it, or at least be + capable of doing so if fed the right input. Of course, the name + "THIRD" should be a dead giveaway, if the name "first" wasn't. + (These numbers were largely chosed because they were five letters + long, like "FORTH", and would not require truncation to five + letters, which would be a dead giveaway. Besides, THIRD represents + a step backwards, in more ways than one.) + + + What exactly is first, then? + + first is a tiny interpreter which implements a sufficient + pseudo-subset of FORTH to allow it to bootstrap a relatively + complete version of FORTH (based loosely on forth79), which + I call THIRD. Complete relative to what, I'm not sure. + + I believe first is close to the smallest amount of code possible + to get this effect *using forth-style primitives*, and still have + some efficiency (it is possible to get by without multiplication + if you have addition, obviously). In the design file, design, + I give a justification for why each primitive in first was included. + + THIRD is sorta slow, because first has so few primitives that + many things that are primitives in FORTH (like swap) take a + significant amount of time in THIRD. + + When you get the 'Ok.' message from third, try out some sample + FORTH code (first has no way of knowing if keyboard input is + waiting, so it can't actually prompt you in a normal way. It + only prints 'Ok.' after you define a word). + + 2 3 + . cr ( add 2 and 3, and print it and a newline.) + + and THIRD responds + + 5 + + Now try: + + : test 11 1 do i . loop cr ; + test + + and THIRD responds + + 1 2 3 4 5 6 7 8 9 10 + + + When in THIRD, you can see how much space you're currently + using by typing + + here . + + The number THIRD replies is the number of machine words (ints) + that the dictionary (the first code) takes up, plus the + 512 ints for the return stack. If you compile the basic + THIRD system without the help word (strings take up one + int per character in the string!), you should find that + you're using around 1000 ints (plus the return stack). + + Thus THIRD gives you a relatively complete FORTH system in + less than 700 chars of C source + about 1000 ints of + memory--and it's portable too (you could copy over the + THIRD memory dump to another machine, in theory). If the + above numbers seem to you to be mixing apples and oranges + (C source and compiled THIRD code), note that you should + in theory be able to stick the compiled THIRD code into + the C source. + + + Software Construction Company gets credit for rekindling + my interest in FORTH and thus indirectly inspiring me + to write this program. + +Copyright (c) 1992, Landon Curt Noll & Larry Bassel. +All Rights Reserved. Permission for personal, educational or non-profit use is +granted provided this this copyright and notice are included in its entirety +and remains unaltered. All other uses must receive prior permission in writing +from both Landon Curt Noll and Larry Bassel. diff --git a/docs/buzzard/buzzard.2.orig.c b/docs/buzzard/buzzard.2.orig.c new file mode 100644 index 0000000..7f77ab1 --- /dev/null +++ b/docs/buzzard/buzzard.2.orig.c @@ -0,0 +1,61 @@ +#define c 0 [m] ++ [m] = +#define z;break;case + +char s[5000]; +int m[20000]={32},L=1,I,T[500],*S=T,t=64,w,f; + +a(x) +{ + c L; + L= *m-1; + c t; + c x; + scanf("%s",s+t); + t+=strlen(s+t)+1; +} + +r(x) +{ + switch(x++[m]){ + z 5: for(w=scanf("%s",s)<1?exit(0):L;strcmp(s,&w[&m[1]][s]);w=m[w]); + w-1 ? r(w+2) : (c 2,c atoi(s)) + z 12: I=1[m]--[m] + z 15: f=S[-f] + z 1: c x + z 9: f *=* S-- + z 7: m[f]= *S--; + f= *S-- + z 0: *++S=f; + f=I++[m] + z 8: f= *S --- f + z 2: m[++1[m]]=I; + I=x + z 11: f=0>f + z 4: *m-=2;c 2 + z 6: f=f[m] + z 10: f= *S--/f + z 3: a(1); + c 2 + z 13: putchar(f); + f= *S-- + z 14: *++S=f; + f=getchar(); + } +} + +main() +{ + a(3); + a(4); + a(1); + w= *m; + c 5; + c 2; + I= *m; + c w; + c I-1; + for(w=6;w<16;) + a(1),c w++; + m[1]= *m; + for(*m+=512;;r(m[I++])); +} diff --git a/docs/buzzard/demo1.1st b/docs/buzzard/demo1.1st new file mode 100644 index 0000000..b836967 --- /dev/null +++ b/docs/buzzard/demo1.1st @@ -0,0 +1,12 @@ +: immediate _read @ ! - * / <0 exit echo key _pick + +: show echo echo echo echo exit +: all show show show show echo exit + +: doit immediate + 10 33 100 108 114 111 87 + 32 111 108 108 101 72 + all +exit + +doit diff --git a/docs/buzzard/demo1.th b/docs/buzzard/demo1.th new file mode 100644 index 0000000..99d22bd --- /dev/null +++ b/docs/buzzard/demo1.th @@ -0,0 +1,4 @@ +: demo1 " Hello world! +" ; + +demo1 diff --git a/docs/buzzard/demo2.th b/docs/buzzard/demo2.th new file mode 100644 index 0000000..8bf8eee --- /dev/null +++ b/docs/buzzard/demo2.th @@ -0,0 +1,10 @@ +: demo2 + + 10 0 ( iterate from 0 stopping before 10 ) + do + i . ( print the loop counter ) + loop + cr ( add a newline ) +; + +demo2 diff --git a/docs/buzzard/demo3.th b/docs/buzzard/demo3.th new file mode 100644 index 0000000..c061b74 --- /dev/null +++ b/docs/buzzard/demo3.th @@ -0,0 +1,15 @@ +: printfour + + dup ( save the number on top of the stack ) + 4 = ( compare it to four ) + if + " forth " ( output a string for it ) + drop ( and delete the saved value ) + else + . + endif +; + +: demo3 10 0 do i printfour loop cr ; + +demo3 diff --git a/docs/buzzard/demo4.th b/docs/buzzard/demo4.th new file mode 100644 index 0000000..3f9a76d --- /dev/null +++ b/docs/buzzard/demo4.th @@ -0,0 +1,30 @@ +( compute factorial recursively ) +( take x as input, return x! and x as output ) + +: fact-help + + dup if + 1 - ( leave x-1 on top ) + fact-help ( leave x-1, [x-1]! ) + 1 + ( leave x, [x-1]!, x ) + swap over swap ( leave [x-1]!, x, x ) + * ( into x!, x ) + swap ( into x, x! ) + else + 1 swap + then +; + +: fact + + fact-help + drop + +; + +: demo4 + " 4 factorial is: " 4 fact . cr + " 6 factorial is: " 6 fact . cr +; + +demo4 diff --git a/docs/buzzard/demo5.th b/docs/buzzard/demo5.th new file mode 100644 index 0000000..d16ca1e --- /dev/null +++ b/docs/buzzard/demo5.th @@ -0,0 +1,27 @@ +( recursive factorial. given x on top, followed by ) +( an "accumulator" containing the product except for x! ) + +: fact-help2 + + dup if + swap over swap + * + swap 1 - + fact-help2 + then +; + +: fact + + 1 swap + fact-help2 + drop +; + +: demo5 + + " The factorial of 3 is: " 3 fact . cr + " The factorial of 5 is: " 5 fact . cr +; + +demo5 diff --git a/docs/buzzard/demo6.th b/docs/buzzard/demo6.th new file mode 100644 index 0000000..75ec667 --- /dev/null +++ b/docs/buzzard/demo6.th @@ -0,0 +1,18 @@ +: foobar + 2 + [ 2 , ( '[' turns the compiler off, allowing us to execute code ) + 1 1 1 + + , ( and we compile in-line a 2 and a three ) + ( the '2' means 'push the number following this' ) + ] + + . cr +; + +foobar + +: 'foobar ' foobar ; ( ' can only be run inside the compiler ) + ( ' leaves the address of the following word + on the stack ) + +'foobar . cr + +'foobar dump diff --git a/docs/buzzard/first.c b/docs/buzzard/first.c new file mode 100644 index 0000000..9820b1b --- /dev/null +++ b/docs/buzzard/first.c @@ -0,0 +1,113 @@ +#include +#include +#include + +char s[5000]; +int m[20000] = {32}; +int length = 1; +int pc; +int dstack[500]; +int *dsp = dstack; +int top = 64; +int w; +int st0; + +void +at(int x) +{ + m[m[0]++] = length; + length = *m - 1; + m[m[0]++] = top; + m[m[0]++] = x; + scanf("%s", s + top); + top += strlen(s + top) + 1; +} + +void +run(int x) +{ + switch (m[x++]) { + case 0: // pushint + *++dsp = st0; + st0 = m[pc++]; + break; + case 1: // compile me + m[m[0]++] = x; + break; + case 2: // run me + m[++m[1]] = pc; + pc = x; + break; + case 3: // : + at(1); + m[m[0]++] = 2; + break; + case 4: // immediate + *m -= 2; + m[m[0]++] = 2; + break; + case 5: // _read + for (w = scanf("%s", s) < 1 ? exit(0), 0 : length; strcmp(s, &s[m[w + 1]]); w = m[w]); + if (w - 1) { + run(w + 2); + } else { + m[m[0]++] = 2; + m[m[0]++] = atoi(s); + } + break; + case 6: // @ + st0 = m[st0]; + break; + case 7: // ! + m[st0] = *dsp--; + st0 = *dsp--; + break; + case 8: // - + st0 = *dsp-- - st0; + break; + case 9: // * + st0 *= *dsp--; + break; + case 10: // / + st0 = *dsp-- / st0; + break; + case 11: // <0 + st0 = 0 > st0; + break; + case 12: // exit + pc = m[m[1]--]; + break; + case 13: // echo + putchar(st0); + st0 = *dsp--; + break; + case 14: // key + *++dsp = st0; + st0 = getchar(); + case 15: // _pick + st0 = dsp[-st0]; + break; + } +} + +int +main() +{ + at(3); + at(4); + at(1); + w = *m; + m[m[0]++] = 5; + m[m[0]++] = 2; + pc = *m; + m[m[0]++] = w; + m[m[0]++] = pc - 1; + for (w = 6; w < 16;) { + at(1); + m[m[0]++] = w++; + } + m[1] = *m; + for (*m += 512;; run(m[pc++])); + + return 0; +} diff --git a/docs/buzzard/help.th b/docs/buzzard/help.th new file mode 100644 index 0000000..7afab27 --- /dev/null +++ b/docs/buzzard/help.th @@ -0,0 +1,54 @@ +: help key ( flush the carriage return form the input buffer ) + +" The following are the standard known words; words marked with (*) are +immediate words, which cannot be used from command mode, but only in +word definitions. Words marked by (**) declare new words, so are always +followed by the new word. + + ! @ fetch, store + + - * / mod standard arithmetic operations + = < > <= >= standard comparison operations + + not boolean not of top of stack + logical turn top of stack into 0 or 1 + + dup over duplicate the top of stack or second of stack + swap drop reverse top two elements or drop topmost + + inc dec increment/decrement the value at address from stack + add add a value from 2nd of stack into address from top + + echo key output character from, or input to, top of stack + . # print out number on top of stack without/with cr + cr print a carriage return + +[more]" key +" (**) var declare variable with initial value taken from stack +(**) constant declare constant with initial value taken from stack +(**) array declare an array with size taken from stack + +(*) if...else...then FORTH branching construct +(*) do...loop FORTH looping construct + i j loop values (not variables) + + print print the string pointed to on screen + +(*)(**) : declare a new THIRD word +(*) declare a data types compile-time and run-time +(*) ; terminate a word definition + +[more]" key +" Advanced words: + here current location in dictionary + h pointer into dictionary + r pointer to return stack + fromr tor pop a value from or to the return stack + + , write the top of stack to dictionary + ' store the address of the following word on the stack + allot leave space on the dictionary + + :: compile a ':' header + [ switch into command mode + ] continue doing : definitions +" ; diff --git a/docs/buzzard/third b/docs/buzzard/third new file mode 100644 index 0000000..b5d3802 --- /dev/null +++ b/docs/buzzard/third @@ -0,0 +1,367 @@ +: immediate _read @ ! - * / <0 exit echo key _pick + +: debug immediate 1 5 ! exit + +: r 1 exit + +: ] r @ 1 - r ! _read ] + +: _main immediate r @ 7 ! ] +_main + + +: _x 3 @ exit +: _y 4 @ exit +: _x! 3 ! exit +: _y! 4 ! exit + + +: swap _x! _y! _x _y exit + +: + 0 swap - - exit + +: dup _x! _x _x exit + +: inc dup @ 1 + swap ! exit + +: h 0 exit + +: , h @ ! h inc exit + + +: ' r @ @ dup 1 + r @ ! @ exit + +: ; immediate ' exit , exit + + +: drop 0 * + ; + +: dec dup @ 1 - swap ! ; + +: tor r @ @ swap r @ ! r @ 1 + r ! r @ ! ; + +: fromr r @ @ r @ 1 - r ! r @ @ swap r @ ! ; + +: tail fromr fromr drop tor ; + +: minus 0 swap - ; + +: bnot 1 swap - ; + +: < - <0 ; + +: logical dup 0 < swap minus 0 < + ; + +: not logical bnot ; + +: = - not ; + +: branch r @ @ @ r @ @ + r @ ! ; + +: computebranch 1 - * 1 + ; + +: notbranch + not + r @ @ @ + computebranch + r @ @ + + r @ ! +; + +: here h @ ; + +: if immediate ' notbranch , here 0 , ; + +: then immediate dup here swap - swap ! ; + +: ')' 0 ; + +: _fix key drop key swap 2 + ! ; + +: fix-')' immediate ' ')' _fix ; + +fix-')' ) + +: find-) key ')' = not if tail find-) then ; + +: ( immediate find-) ; + +( we should be able to do FORTH-style comments now ) + +( this works as follows: ( is an immediate word, so it gets + control during compilation. Then it simply reads in characters + until it sees a close parenthesis. once it does, it exits. + if not, it pops off the return stack--manual tail recursion. ) + +( now that we've got comments, we can comment the rest of the code! ) + +: else immediate + ' branch , ( compile a definite branch ) + here ( push the backpatching address ) + 0 , ( compile a dummy offset for branch ) + swap ( bring old backpatch address to top ) + dup here swap - ( calculate the offset from old address ) + swap ! ( put the address on top and store it ) +; + +: over _x! _y! _y _x _y ; + +: add + _x! ( save the pointer in a temp variable ) + _x @ ( get the value pointed to ) + + ( add the incremement from on top of the stack ) + _x ! ( and save it ) +; + +: allot h add ; + +: maybebranch + logical ( force the TOS to be 0 or 1 ) + r @ @ @ ( load the branch offset ) + computebranch ( calculate the condition offset [either TOS or 1]) + r @ @ + ( add it to the return address ) + r @ ! ( store it to our return address and return ) +; + +: mod _x! _y! ( get x then y off of stack ) + _y + _y _x / _x * ( y - y / x * x ) + - +; + +: '\n' 0 ; +: '"' 0 ; +: '0' 0 ; +: 'space' 0 ; + +: fix-'\n' immediate ' '\n' _fix ; +: fix-'"' immediate ' '"' _fix ; +: fix-'0' immediate ' '0' _fix ; +: fix-'space' immediate ' 'space' _fix ; + +fix-'0' 0 fix-'space' fix-'"' " +fix-'\n' + + +: cr '\n' echo exit + +: printnum + dup + 10 mod '0' + + swap 10 / dup + if + printnum 0 + then + drop echo +; + +: . + dup 0 < + if + 45 echo minus + then + printnum + 'space' echo +; + + +: debugprint dup . cr ; + +( the following routine takes a pointer to a string, and prints it, + except for the trailing quote. returns a pointer to the next word + after the trailing quote ) + +: _print + dup 1 + + swap @ + dup '"' = + if + drop exit + then + echo + tail _print +; + +: print _print ; + + ( print the next thing from the instruction stream ) +: immprint + r @ @ + print + r @ ! +; + +: find-" + key dup , + '"' = + if + exit + then + tail find-" +; + +: " immediate + key drop + ' immprint , + find-" +; + +: do immediate + ' swap , ( compile 'swap' to swap the limit and start ) + ' tor , ( compile to push the limit onto the return stack ) + ' tor , ( compile to push the start on the return stack ) + here ( save this address so we can branch back to it ) +; + +: i r @ 1 - @ ; +: j r @ 3 - @ ; + +: > swap < ; +: <= 1 + < ; +: >= swap <= ; + +: inci + r @ 1 - ( get the pointer to i ) + inc ( add one to it ) + r @ 1 - @ ( find the value again ) + r @ 2 - @ ( find the limit value ) + < + if + r @ @ @ r @ @ + r @ ! exit ( branch ) + then + fromr 1 + + fromr drop + fromr drop + tor +; + +: loop immediate ' inci , here - , ; + +: loopexit + + fromr drop ( pop off our return address ) + fromr drop ( pop off i ) + fromr drop ( pop off the limit of i ) +; ( and return to the caller's caller routine ) + +: isprime + dup 2 = if + exit + then + dup 2 / 2 ( loop from 2 to n/2 ) + do + dup ( value we're checking if it's prime ) + i mod ( mod it by divisor ) + not if + drop 0 loopexit ( exit from routine from inside loop ) + then + loop +; + +: primes + " The primes from " + dup . + " to " + over . + " are:" + cr + + do + i isprime + if + i . 'space' echo + then + loop + cr +; + +: execute + 8 ! + ' exit 9 ! + 8 tor +; + +: :: ; ( :: is going to be a word that does ':' at runtime ) + +: fix-:: immediate 3 ' :: ! ; +fix-:: + + ( Override old definition of ':' with a new one that invokes ] ) +: : immediate :: ] ; + +: command + here 5 ! ( store dict pointer in temp variable ) + _read ( compile a word ) + ( if we get control back: ) + here 5 @ + = if + tail command ( we didn't compile anything ) + then + here 1 - h ! ( decrement the dictionary pointer ) + here 5 @ ( get the original value ) + = if + here @ ( get the word that was compiled ) + execute ( and run it ) + else + here @ ( else it was an integer constant, so push it ) + here 1 - h ! ( and decrement the dictionary pointer again ) + then + tail command +; + +: make-immediate ( make a word just compiled immediate ) + here 1 - ( back up a word in the dictionary ) + dup dup ( save the pointer to here ) + h ! ( store as the current dictionary pointer ) + @ ( get the run-time code pointer ) + swap ( get the dict pointer again ) + 1 - ( point to the compile-time code pointer ) + ! ( write run-time code pointer on compile-time pointer ) +; + +: ) + ' , , ( compile a push that address onto dictionary ) +; + +: does> immediate + ' command , ( jump back into command mode at runtime ) + here swap ! ( backpatch the build> to point to here ) + 2 , ( compile run-code primitive so we look like a word ) + ' fromr , ( compile fromr, which leaves var address on stack ) +; + + +: _dump ( dump out the definition of a word, sort of ) + dup " (" . " , " + dup @ ( save the pointer and get the contents ) + dup ' exit + = if + " ;)" cr exit + then + . " ), " + 1 + + tail _dump +; + +: dump _dump ; + +: # . cr ; + +: var ; +: constant @ ; +: array + ; + +: [ immediate command ; +: _welcome " Welcome to THIRD. +Ok. +" ; + +: ; immediate ' exit , command exit + +[ + +_welcome diff --git a/docs/eForthOverviewv5.pdf b/docs/eForthOverviewv5.pdf new file mode 100644 index 0000000..bf5f5b0 Binary files /dev/null and b/docs/eForthOverviewv5.pdf differ diff --git a/docs/j1.txt b/docs/j1.txt new file mode 100644 index 0000000..6720b72 --- /dev/null +++ b/docs/j1.txt @@ -0,0 +1,57 @@ +f e d c b a 9 8 7 6 5 4 3 2 1 0 +1 . . . . . . . . . . . . . . . literal +0 0 0 . . . . . . . . . . . . . jump +0 1 0 . . . . . . . . . . . . . call +0 0 1 . . . . . . . . . . . . . cond jump +0 1 1 ? 0 0 0 0 nop +. . . +. . . . . . . . . 0 0 1 . . . . func_T_N +. . . . . . . . . 0 1 0 . . . . func_T_R +. . . . . . . . . 0 1 1 . . . . func_write +. . . . . . . . . 1 0 0 . . . . func_iow +0 1 1 . . . . . . . . . . . . . is_alu +0 1 1 . . . . . . 0 1 1 . . . . mem_wr +0 1 1 . . . . . . 1 0 0 . . . . io_wr + + + +1 . . . . . . . . . . . . . . . imm + +0 0 0 . . . . . . . . . . . . . ubranch +0 0 1 . . . . . . . . . . . . . 0branch +0 1 0 . . . . . . . . . . . . . scall +0 1 1 . . . . . . . . . . . . . alu + +. . . ? . . . . . . . . . . . . unused + +. . . . 0 0 0 0 . . . . . . . . T +. . . . 0 0 0 1 . . . . . . . . N +. . . . 0 0 1 0 . . . . . . . . T+N +. . . . 0 0 1 1 . . . . . . . . T&N +. . . . 0 1 0 0 . . . . . . . . T|N +. . . . 0 1 0 1 . . . . . . . . T^N +. . . . 0 1 1 0 . . . . . . . . ~T +. . . . 0 1 1 1 . . . . . . . . N==T +. . . . 1 0 0 0 . . . . . . . . N>T +. . . . 1 0 1 0 . . . . . . . . N<N +. . . . . . . . . 0 1 0 . . . . T->R +. . . . . . . . . 0 1 1 . . . . N->[T] +. . . . . . . . . 1 0 0 . . . . N->io[T] + +. . . . . . . . . . . . 1 1 . . r-1 +. . . . . . . . . . . . 1 0 . . r-2 +. . . . . . . . . . . . 0 1 . . r+1 + +. . . . . . . . . . . . . . 1 1 d-1 +. . . . . . . . . . . . . . 0 1 d+1 + diff --git a/docs/j1/.gitignore b/docs/j1/.gitignore new file mode 100644 index 0000000..f169042 --- /dev/null +++ b/docs/j1/.gitignore @@ -0,0 +1,2 @@ +a.out +test.vcd diff --git a/docs/j1/Makefile b/docs/j1/Makefile new file mode 100644 index 0000000..34f0dae --- /dev/null +++ b/docs/j1/Makefile @@ -0,0 +1,14 @@ + +$(SUBDIRS): + $(MAKE) -C $@ + +all: obj_dir/Vj1 $(SUBDIRS) + +VERILOGS=verilog/j1.v verilog/stack.v + +obj_dir/Vj1: $(VERILOGS) sim_main.cpp Makefile + verilator -Wall --cc --trace -Iverilog/ $(VERILOGS) --top-module j1 --exe sim_main.cpp + # verilator --cc --trace $(VERILOGS) --top-module j1 --exe sim_main.cpp + $(MAKE) -C obj_dir OPT_FAST="-O2" -f Vj1.mk Vj1 + +.PHONY: all diff --git a/docs/j1/README.md b/docs/j1/README.md new file mode 100644 index 0000000..9a419f5 --- /dev/null +++ b/docs/j1/README.md @@ -0,0 +1,4 @@ +j1 +== + +The J1 CPU diff --git a/docs/j1/build/.empty b/docs/j1/build/.empty new file mode 100644 index 0000000..e69de29 diff --git a/docs/j1/build/.gitignore b/docs/j1/build/.gitignore new file mode 100644 index 0000000..ebc3c15 --- /dev/null +++ b/docs/j1/build/.gitignore @@ -0,0 +1,2 @@ +firmware +quartus diff --git a/docs/j1/go b/docs/j1/go new file mode 100644 index 0000000..c0740cb --- /dev/null +++ b/docs/j1/go @@ -0,0 +1,5 @@ +(cd toolchain && sh go) || exit +iverilog -I verilog/ -g2 -s testbench verilog/testbench.v verilog/top.v verilog/j1.v verilog/stack.v || exit +./a.out + +make && obj_dir/Vj1 build/firmware/demo0.hex diff --git a/docs/j1/sim_main.cpp b/docs/j1/sim_main.cpp new file mode 100644 index 0000000..ee075ac --- /dev/null +++ b/docs/j1/sim_main.cpp @@ -0,0 +1,76 @@ +#include +#include "Vj1.h" +#include "verilated_vcd_c.h" + +int main(int argc, char **argv) +{ + Verilated::commandArgs(argc, argv); + Vj1* top = new Vj1; + int i; + + // Verilated::traceEverOn(true); + // VerilatedVcdC* tfp = new VerilatedVcdC; + // top->trace (tfp, 99); + // tfp->open ("simx.vcd"); + + if (argc != 2) { + fprintf(stderr, "usage: sim \n"); + exit(1); + } + + union { + uint32_t ram32[4096]; + uint16_t ram16[8192]; + }; + + FILE *hex = fopen(argv[1], "r"); + for (i = 0; i < 4096; i++) { + unsigned int v; + if (fscanf(hex, "%x\n", &v) != 1) { + fprintf(stderr, "invalid hex value at line %d\n", i + 1); + exit(1); + } + ram32[i] = v; + } + + FILE *log = fopen("log", "w"); + int t = 0; + + top->resetq = 0; + top->eval(); + top->resetq = 1; + top->eval(); + + for (i = 0; i < 100000000; i++) { + uint16_t a = top->mem_addr; + uint16_t b = top->code_addr; + if (top->mem_wr) + ram32[(a & 16383) / 4] = top->dout; + top->clk = 1; + top->eval(); + t += 20; + + top->mem_din = ram32[(a & 16383) / 4]; + top->insn = ram16[b]; + top->clk = 0; + top->eval(); + t += 20; + if (top->io_wr) { + putchar(top->dout); + putc(top->dout, log); + if (top->dout == '#') + break; + } +#if 0 + if (top->io_inp && (top->io_n == 2)) { + top->io_din = getchar(); + } +#endif + } + printf("\nSimulation ended after %d cycles\n", i); + delete top; + // tfp->close(); + fclose(log); + + exit(0); +} diff --git a/docs/j1/toolchain/basewords.fs b/docs/j1/toolchain/basewords.fs new file mode 100644 index 0000000..6534d2b --- /dev/null +++ b/docs/j1/toolchain/basewords.fs @@ -0,0 +1,92 @@ +( J1 base words implemented in assembler JCB 17:27 12/31/11) + +: 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# 0900 ; +: N<N h# 0010 or ; +: T->R h# 0020 or ; +: N->[T] h# 0030 or ; +: N->io[T] h# 0040 or ; +: RET h# 0080 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 ; + +: imm h# 8000 or tw, ; +: alu h# 6000 or tw, ; +: ubranch h# 0000 or tw, ; +: 0branch h# 2000 or tw, ; +: scall h# 4000 or tw, ; + + +:: 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 ; +:: < NN 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 ; +:: io@ io[T] alu ; +:: ! T N->[T] d-1 alu + N d-1 alu ; +:: io! T N->io[T] d-1 alu + N d-1 alu ; +:: rshift N>>T d-1 alu ; +:: lshift N<N d+1 alu ; +:: exit T RET r-1 alu ; + +\ Elided words +\ These words are supported by the hardware but are not +\ part of ANS Forth. They are named after the word-pair +\ that matches their effect +\ Using these elided words instead of +\ the pair saves one cycle and one instruction. + +:: 2dupand T&N T->N d+1 alu ; +:: 2dup< NN d+1 alu ; +:: 2dup= N==T T->N d+1 alu ; +:: 2dupor T|N T->N d+1 alu ; +:: 2duprshift N>>T T->N d+1 alu ; +:: 2dup+ T+N T->N d+1 alu ; +:: 2dupu< NuN d+1 alu ; +:: 2dupxor T^N T->N d+1 alu ; +:: dup>r T T->R r+1 alu ; +:: dup@ [T] T->N d+1 alu ; +:: overand T&N alu ; +:: over> N Nu[T] d-1 alu ; diff --git a/docs/j1/toolchain/cross.fs b/docs/j1/toolchain/cross.fs new file mode 100644 index 0000000..56c0025 --- /dev/null +++ b/docs/j1/toolchain/cross.fs @@ -0,0 +1,321 @@ +( J1 Cross Compiler JCB 16:55 05/02/12) + +\ Usage gforth cross.fs +\ +\ Where machine.fs defines the target machine +\ and program.fs is the target program +\ + +variable lst \ .lst output file handle + +: h# + base @ >r 16 base ! + 0. bl parse >number throw 2drop postpone literal + r> base ! ; immediate + +: tcell 2 ; +: tcells tcell * ; +: tcell+ tcell + ; + +131072 allocate throw constant tflash \ bytes, target flash +131072 allocate throw constant _tbranches \ branch targets, cells +tflash 31072 0 fill +_tbranches 131072 0 fill +: tbranches cells _tbranches + ; + +variable tdp 0 tdp ! +: there tdp @ ; +: islegal ; +: tc! islegal tflash + c! ; +: tc@ islegal tflash + c@ ; +: tw! islegal tflash + w! ; +: t! islegal tflash + l! ; +: t@ islegal tflash + uw@ ; +: twalign tdp @ 1+ -2 and tdp ! ; +: talign tdp @ 3 + -4 and tdp ! ; +: tc, there tc! 1 tdp +! ; +: t, there t! 4 tdp +! ; +: tw, there tw! tcell tdp +! ; +: org tdp ! ; + +wordlist constant target-wordlist +: add-order ( wid -- ) >r get-order r> swap 1+ set-order ; +: :: get-current >r target-wordlist set-current : r> set-current ; + +next-arg included \ include the machine.fs + +( Language basics for target JCB 19:08 05/02/12) + +warnings off +:: ( postpone ( ; +:: \ postpone \ ; + +:: org org ; +:: include include ; +:: included included ; +:: marker marker ; +:: [if] postpone [if] ; +:: [else] postpone [else] ; +:: [then] postpone [then] ; + +: 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 tw, + then +; + +: literal + dup $80000000 and if + invert recurse + ~T alu + else + dup $ffff8000 and if + dup $F rshift recurse + $f recurse + N<in @ >r bl word count r> >in ! +; + +variable link 0 link ! + +:: header + twalign there + \ cr ." link is " link @ . + link @ tw, + link ! + bl parse + dup tc, + bounds do + i c@ tc, + loop + twalign +; + +:: : + hex + codeptr s>d + <# bl hold # # # # #> + lst @ write-file throw + wordstr lst @ write-line throw + + create codeptr , + does> @ scall +; + +:: :noname +; + +:: , + talign + t, +; + +:: allot + 0 ?do + 0 tc, + loop +; + +: shortcut ( orig -- f ) \ insn @orig precedes ;. Shortcut it. + \ call becomes jump + dup t@ h# e000 and h# 4000 = if + dup t@ h# 1fff and over tw! + true + else + dup t@ h# e00c and h# 6000 = if + dup t@ h# 0080 or r-1 over tw! + true + else + false + then + then + nip +; + +:: ; + there 2 - shortcut \ true if shortcut applied + there 0 do + i tbranches @ there = if + i tbranches @ shortcut and + then + loop + 0= if \ not all shortcuts worked + s" exit" evaluate + then +; +:: ;fallthru ; + +:: jmp + ' >body @ ubranch +; + +:: constant + create , + does> @ literal +; + +:: create + talign + create there , + does> @ literal +; + +( Switching between target and meta JCB 19:08 05/02/12) + +: target only target-wordlist add-order definitions ; +: ] target ; +:: meta forth definitions ; +:: [ forth definitions ; + +: t' bl parse target-wordlist search-wordlist 0= throw >body @ ; + +( eforth's way of handling constants JCB 13:12 09/03/10) + +: sign>number ( c-addr1 u1 -- ud2 c-addr2 u2 ) + 0. 2swap + over c@ [char] - = if + 1 /string + >number + 2swap dnegate 2swap + else + >number + then +; + +: base>number ( caddr u base -- ) + base @ >r base ! + sign>number + r> base ! + dup 0= if + 2drop drop literal + else + 1 = swap c@ [char] . = and if + drop dup literal 32 rshift literal + else + -1 abort" bad number" + then + then ; +warnings on + +:: d# bl parse 10 base>number ; +:: h# bl parse 16 base>number ; +:: ['] ' >body @ 2* literal ; +:: [char] char literal ; + +:: asm-0branch + ' >body @ + 0branch +; + +( Conditionals JCB 13:12 09/03/10) + +: resolve ( orig -- ) + there over tbranches ! \ forward reference from orig to this loc + dup t@ there 2/ or swap tw! +; + +:: if + there + 0 0branch +; + +:: then + resolve +; + +:: else + there + 0 ubranch + swap resolve +; + +:: begin there ; + +:: again ( dest -- ) + 2/ ubranch +; +:: until + 2/ 0branch +; +:: while + there + 0 0branch +; +:: repeat + swap 2/ ubranch + resolve +; + +4 org +: .trim ( a-addr u ) \ shorten string until it ends with '.' + begin + 2dup + 1- c@ [char] . <> + while + 1- + repeat +; +include strings.fs +next-arg 2dup .trim >str constant prefix. +: .suffix ( c-addr u -- c-addr u ) \ e.g. "bar" -> "foo.bar" + >str prefix. +str str@ +; +: create-output-file w/o create-file throw ; +: out-suffix ( s -- h ) \ Create an output file h with suffix s + >str + prefix. +str + s" ../build/firmware/" >str +str str@ + create-output-file +; +:noname + s" lst" out-suffix lst ! +; execute + + +target included \ include the program.fs + +[ tdp @ 0 org ] bootloader main [ org ] +meta + +decimal +0 value file +: dumpall.16 + s" hex" out-suffix to file + + hex + 1024 0 do + tflash i 2* + w@ + s>d <# # # # # #> file write-line throw + loop + file close-file +; +: dumpall.32 + s" hex" out-suffix to file + + hex + 4096 0 do + tflash i 4 * + @ + s>d <# # # # # # # # # #> file write-line throw + loop + file close-file +; + +dumpall.32 + +bye diff --git a/docs/j1/toolchain/demo1.fs b/docs/j1/toolchain/demo1.fs new file mode 100644 index 0000000..7c49af4 --- /dev/null +++ b/docs/j1/toolchain/demo1.fs @@ -0,0 +1,7 @@ +: main + begin + h# 0 io@ + d# 1 + + h# 0 io! + again +; diff --git a/docs/j1/toolchain/dump.py b/docs/j1/toolchain/dump.py new file mode 100644 index 0000000..283916b --- /dev/null +++ b/docs/j1/toolchain/dump.py @@ -0,0 +1,36 @@ +import sys +import array + +def hexdump(s): + def toprint(c): + if 32 <= ord(c) < 127: + return c + else: + return "." + def hexline(i, s): + return ("%04x: " % i + " ".join(["%02x" % ord(c) for c in s]).ljust(52) + + "|" + + "".join([toprint(c) for c in s]).ljust(16) + + "|") + return "\n".join([hexline(i, s[i:i+16]) for i in range(0, len(s), 16)]) + +pgm = array.array('H', [int(l, 16) for l in open(sys.argv[1])]) + +while pgm[-1] == 0: + pgm = pgm[:-1] +s = pgm.tostring() +print +print hexdump(s) + +link = [w for w in pgm[::-1] if w][0] +words = [] +while link: + name = s[link + 2:] + c = ord(name[0]) + name = name[1:1+c] + print "%04x %s" % (link, name) + assert not name in words + words.append(name) + link = pgm[link / 2] +print len(words), " ".join(words) +print "program size %d/%d" % (len(pgm), 1024) diff --git a/docs/j1/toolchain/go b/docs/j1/toolchain/go new file mode 100644 index 0000000..6570942 --- /dev/null +++ b/docs/j1/toolchain/go @@ -0,0 +1,3 @@ +set -e +gforth cross.fs basewords.fs nuc.fs +# python dump.py ../build/firmware/demo0.hex diff --git a/docs/j1/toolchain/nuc.fs b/docs/j1/toolchain/nuc.fs new file mode 100644 index 0000000..846db05 --- /dev/null +++ b/docs/j1/toolchain/nuc.fs @@ -0,0 +1,604 @@ +header 1+ : 1+ d# 1 + ; +header 1- : 1- d# -1 + ; +header 0= : 0= d# 0 = ; +header cell+ : cell+ d# 2 + ; + +header <> : <> = invert ; +header > : > swap < ; +header 0< : 0< d# 0 < ; +header 0> : 0> d# 0 > ; +header 0<> : 0<> d# 0 <> ; +header u> : u> swap u< ; + +: eol ( u -- u' false | true ) + d# -1 + + dup 0= dup if + ( 0 true -- ) + nip + then +; + +header ms +: ms + begin + d# 15000 begin + eol until + eol until +; + + +header key? +: key? + d# 0 io@ + d# 4 and + 0<> +; + +header key +: key + begin + key? + until + d# 0 io@ d# 8 rshift + d# 0 d# 2 io! +; + +: ready + d# 0 io@ + d# 2 and + 0= +; + +header emit +: emit + begin ready until + h# 0 io! +; + +header cr +: cr + d# 13 emit + d# 10 emit +; + +header space +: space + d# 32 emit +; + +header bl +: bl + d# 32 +; + +: hex1 + h# f and + dup d# 10 < if + [char] 0 + else + d# 55 + then + + + emit +; + +: hex2 + dup d# 4 rshift hex1 hex1 +; + +: hex4 + dup d# 8 rshift hex2 hex2 +; + +: hex8 + dup d# 16 rshift hex4 hex4 +; + +header . +: . hex8 space ; + +header false : false d# 0 ; +header true : true d# -1 ; +header rot : rot >r swap r> swap ; +header -rot : -rot swap >r swap r> ; +header tuck : tuck swap over ; +header 2drop : 2drop drop drop ; +header ?dup : ?dup dup if dup then ; + +header 2dup : 2dup over over ; +header +! : +! tuck @ + swap ! ; +header 2swap : 2swap rot >r rot r> ; + +header min : min 2dup< if drop else nip then ; +header max : max 2dup< if nip else drop then ; + +header c@ +: c@ + dup @ swap + d# 3 and d# 3 lshift rshift + d# 255 and +; + +: hi16 + d# 16 rshift d# 16 lshift +; + +: lo16 + d# 16 lshift d# 16 rshift +; + +header uw@ +: uw@ + dup @ swap + d# 2 and d# 3 lshift rshift + lo16 +; + +header w! +: w! ( u c-addr -- ) + dup>r d# 2 and if + d# 16 lshift + r@ @ lo16 + else + lo16 + r@ @ hi16 + then + or r> ! +; + +header c! +: c! ( u c-addr -- ) + dup>r d# 1 and if + d# 8 lshift + h# 00ff + else + h# 00ff and + h# ff00 + then + r@ uw@ and + or r> w! +; + +header count +: count + dup 1+ swap c@ +; + +: bounds ( a n -- a+n a ) + over + swap +; + +header type +: type + bounds + begin + 2dupxor + while + dup c@ emit + 1+ + repeat + 2drop +; + +create base $a , +create ll 0 , +create dp 0 , +create tib# 0 , +create >in 0 , +create tib 80 allot + +header words : words + ll uw@ + begin + dup + while + cr + dup . + dup cell+ + count type + space + uw@ + repeat + drop +; + +header dump : dump ( addr u -- ) + cr over hex4 + begin ( addr u ) + ?dup + while + over c@ space hex2 + 1- swap 1+ ( u' addr' ) + dup h# f and 0= if ( next line? ) + cr dup hex4 + then + swap + repeat + drop cr +; + +header negate : negate invert 1+ ; +header - : - negate + ; +header abs : abs dup 0< if negate then ; +header 2* : 2* d# 1 lshift ; +header 2/ : 2/ d# 1 rshift ; +header here : here dp @ ; +header depth : depth depths h# f and ; + +: /string + dup >r - swap r> + swap +; + +header aligned +: aligned + d# 3 + d# -4 and +; + +: 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 . ) +; + +: d1+ d# 1. d+ ; + +: dnegate + invert swap invert swap + d1+ +; + +: dabs ( d -- ud ) + dup 0< if dnegate then +; + +: s>d dup 0< ; +: m+ + s>d d+ +; + +: snap + cr depth hex2 space + begin + depth + while + . + repeat + cr + [char] # emit + begin again +; + +create scratch 0 , + +header um* +: um* ( u1 u2 -- ud ) + scratch ! + d# 0. + d# 32 begin + >r + 2dup d+ + rot dup 0< if + 2* -rot + scratch @ d# 0 d+ + else + 2* -rot + then + r> eol + until + rot drop +; +: * + um* drop +; + +header accept +: accept + d# 30 emit + drop dup + begin + key + dup h# 0d xor + while + dup h# 0a = if + drop + else + over c! 1+ + then + repeat + drop swap - +; + +: 3rd >r over r> swap ; +: 3dup 3rd 3rd 3rd ; + +: sameword ( c-addr u wp -- c-addr u wp flag ) + 2dup d# 2 + c@ = if + 3dup + d# 3 + >r + bounds + begin + 2dupxor + while + dup c@ r@ c@ <> if + 2drop rdrop false exit + then + 1+ + r> 1+ >r + repeat + 2drop rdrop true + else + false + then +; + +\ lsb 0 means non-immediate, return -1 +\ 1 means immediate, return 1 +: isimmediate ( wp -- -1 | 1 ) + uw@ d# 1 and 2* 1- +; + +: sfind + ll uw@ + begin + dup + while + sameword + if + nip nip + dup + d# 2 + + count + + d# 1 + d# -2 and + swap isimmediate + exit + then + uw@ + repeat +; + +: digit? ( c -- u f ) + dup h# 39 > h# 100 and + + dup h# 140 > h# 107 and - h# 30 - + dup base @ u< +; + +: ud* ( ud1 u -- ud2 ) \ ud2 is the product of ud1 and u + tuck * >r + um* r> + +; + +: >number ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 ) + begin + dup + while + over c@ digit? + 0= if drop exit then + >r 2swap base @ ud* + r> m+ 2swap + d# 1 /string + repeat +; + +header fill +: fill ( c-addr u char -- ) ( 6.1.1540 ) + >r bounds + begin + 2dupxor + while + r@ over c! 1+ + repeat + r> drop 2drop +; + +header erase +: erase + d# 0 fill +; + +header execute +: execute + >r +; + +header source +: source + tib tib# @ +; + +\ From Forth200x - public domain + +: isspace? ( c -- f ) + bl 1+ u< ; + +: isnotspace? ( c -- f ) + isspace? 0= ; + +: xt-skip ( addr1 n1 xt -- addr2 n2 ) \ gforth + \ skip all characters satisfying xt ( c -- f ) + >r + BEGIN + over c@ r@ execute + over 0<> and + WHILE + d# 1 /string + REPEAT + r> drop ; + +: parse-name ( "name" -- c-addr u ) + source >in @ /string + ['] isspace? xt-skip over >r + ['] isnotspace? xt-skip ( end-word restlen r: start-word ) + 2dup d# 1 min + source drop - >in ! + drop r> tuck - ; + +header ! :noname ! ; +header + :noname + ; +header xor :noname xor ; +header and :noname and ; +header or :noname or ; +header invert :noname invert ; +header = :noname = ; +header < :noname < ; +header u< :noname u< ; +header swap :noname swap ; +header dup :noname dup ; +header drop :noname drop ; +header over :noname over ; +header nip :noname nip ; +header @ :noname @ ; +header io! :noname io! ; +header rshift :noname rshift ; +header lshift :noname lshift ; +\ +\ \ >r +\ \ r> +\ \ r@ +\ \ exit +\ + +: xmain + cr d# 1 ms cr + d# 60 begin + [char] - emit + eol until + begin key? while key drop repeat + + cr h# ffff hex8 + + d# 0 d# 100 dump + words cr cr + + begin again + + begin + cr + tib d# 30 accept >r + d# 0. tib r> >number + 2drop hex4 space hex4 + again + + snap +; + +: route + r> + >r ; + +\ (doubleAlso) ( c-addr u -- x 1 | x x 2 ) +\ If the string is legal, leave a single or double cell number +\ and size of the number. + +: isvoid ( caddr u -- ) \ any char remains, throw -13 + nip 0<> + if [char] x emit snap then +; + +: consume1 ( caddr u ch -- caddr' u' f ) + >r over c@ r> = + over 0<> and + dup>r d# 1 and /string r> +; + +: (doubleAlso) + h# 0. 2swap + [char] - consume1 >r + >number + [char] . consume1 if + isvoid \ double number + r> if dnegate then + d# 2 exit + then + \ single number + isvoid drop + r> if negate then + d# 1 +; + +: doubleAlso + (doubleAlso) drop +; + + +: dispatch + route ;fallthru + jmp execute \ -1 0 non-immediate + jmp doubleAlso \ 0 0 number + jmp execute \ 1 0 immediate + +\ jmp compile_comma \ -1 2 non-immediate +\ jmp doubleAlso_comma \ 0 2 number +\ jmp execute \ 1 2 immediate + +: interpret + begin + parse-name dup + while + sfind + 1+ 2* dispatch + repeat + 2drop +; + +: main + 2drop + begin + tib d# 80 accept + tib# ! + \ h# 40 emit + d# 0 >in ! + source dump + \ cr parse-name sfind + \ if + \ execute + \ then + interpret + again +; + +meta + $3f80 org +target + +: b.key + begin + d# 0 io@ + d# 4 and + until + d# 0 io@ d# 8 rshift + d# 0 d# 2 io! +; + +: b.32 + b.key + b.key d# 8 lshift or + b.key d# 16 lshift or + b.key d# 24 lshift or +; + +meta + $3fc0 org +target + +: bootloader + begin + b.key d# 27 = + until + + b.32 d# 0 + begin + 2dupxor + while + b.32 over ! + d# 4 + + repeat +; + +meta + link @ t, + link @ t' ll tw! + there t' dp tw! +target diff --git a/docs/j1/toolchain/strings.fs b/docs/j1/toolchain/strings.fs new file mode 100644 index 0000000..cbd9b0e --- /dev/null +++ b/docs/j1/toolchain/strings.fs @@ -0,0 +1,25 @@ +( Strings JCB 11:57 05/18/12) + +: >str ( c-addr u -- str ) \ a new u char string from c-addr + dup cell+ allocate throw dup >r + 2dup ! cell+ \ write size into first cell + ( c-addr u saddr ) + swap cmove r> +; +: str@ dup cell+ swap @ ; +: str! ( str c-addr -- c-addr' ) \ copy str to c-addr + >r str@ r> + 2dup + >r swap + cmove r> +; +: +str ( str2 str1 -- str3 ) + over @ over @ + cell+ allocate throw >r + over @ over @ + r@ ! + r@ cell+ str! str! drop r> +; + +: example + s" sailor" >str + s" hello" >str + +str str@ type +; diff --git a/docs/j1/verilog/common.h b/docs/j1/verilog/common.h new file mode 100644 index 0000000..03da65d --- /dev/null +++ b/docs/j1/verilog/common.h @@ -0,0 +1,3 @@ +`default_nettype none +`define WIDTH 32 +`define DEPTH 4 diff --git a/docs/j1/verilog/j1.v b/docs/j1/verilog/j1.v new file mode 100644 index 0000000..d69ca20 --- /dev/null +++ b/docs/j1/verilog/j1.v @@ -0,0 +1,123 @@ +`include "common.h" + +module j1( + input wire clk, + input wire resetq, + + output wire io_wr, + output wire [15:0] mem_addr, + output wire mem_wr, + output wire [`WIDTH-1:0] dout, + input wire [`WIDTH-1:0] mem_din, + + input wire [`WIDTH-1:0] io_din, + + output wire [12:0] code_addr, + input wire [15:0] insn + ); + reg [`DEPTH-1:0] dsp; // Data stack pointer + reg [`DEPTH-1:0] dspN; + reg [`WIDTH-1:0] st0; // Top of data stack + reg [`WIDTH-1:0] st0N; + reg dstkW; // D stack write + + reg [12:0] pc, pcN; + reg [`DEPTH-1:0] rsp, rspN; + reg rstkW; // R stack write + wire [`WIDTH-1:0] rstkD; // R stack write value + reg reboot = 1; + wire [12:0] pc_plus_1 = pc + 1; + + assign mem_addr = st0N[15:0]; + assign code_addr = {pcN}; + + // The D and R stacks + wire [`WIDTH-1:0] st1, rst0; + stack #(.DEPTH(`DEPTH)) + dstack(.clk(clk), .resetq(resetq), .ra(dsp), .rd(st1), .we(dstkW), .wa(dspN), .wd(st0)); + stack #(.DEPTH(`DEPTH))rstack(.clk(clk), .resetq(resetq), .ra(rsp), .rd(rst0), .we(rstkW), .wa(rspN), .wd(rstkD)); + + always @* + begin + // Compute the new value of st0 + casez ({insn[15:8]}) + 8'b1??_?????: st0N = { {(`WIDTH - 15){1'b0}}, insn[14:0] }; // literal + 8'b000_?????: st0N = st0; // jump + 8'b010_?????: st0N = st0; // call + 8'b001_?????: st0N = st1; // conditional jump + 8'b011_?0000: st0N = st0; // ALU operations... + 8'b011_?0001: st0N = st1; + 8'b011_?0010: st0N = st0 + st1; + 8'b011_?0011: st0N = st0 & st1; + 8'b011_?0100: st0N = st0 | st1; + 8'b011_?0101: st0N = st0 ^ st1; + 8'b011_?0110: st0N = ~st0; + 8'b011_?0111: st0N = {`WIDTH{(st1 == st0)}}; + 8'b011_?1000: st0N = {`WIDTH{($signed(st1) < $signed(st0))}}; +`ifdef NOSHIFTER // `define NOSHIFTER in common.h to cut slice usage in half and shift by 1 only + 8'b011_?1001: st0N = st1 >> 1; + 8'b011_?1010: st0N = st1 << 1; +`else // otherwise shift by 1-any number of bits + 8'b011_?1001: st0N = st1 >> st0[4:0]; + 8'b011_?1010: st0N = st1 << st0[4:0]; +`endif + 8'b011_?1011: st0N = rst0; + 8'b011_?1100: st0N = mem_din; + 8'b011_?1101: st0N = io_din; + 8'b011_?1110: st0N = {{(`WIDTH - 8){1'b0}}, rsp, dsp}; + 8'b011_?1111: st0N = {`WIDTH{(st1 < st0)}}; + default: st0N = {`WIDTH{1'bx}}; + endcase + end + + wire func_T_N = (insn[6:4] == 1); + wire func_T_R = (insn[6:4] == 2); + wire func_write = (insn[6:4] == 3); + wire func_iow = (insn[6:4] == 4); + + wire is_alu = (insn[15:13] == 3'b011); + assign mem_wr = !reboot & is_alu & func_write; + assign dout = st1; + assign io_wr = !reboot & is_alu & func_iow; + + assign rstkD = (insn[13] == 1'b0) ? {{(`WIDTH - 14){1'b0}}, pc_plus_1, 1'b0} : st0; + + reg [`DEPTH-1:0] dspI, rspI; + always @* + begin + casez ({insn[15:13]}) + 3'b1??: {dstkW, dspI} = {1'b1, 4'b0001}; + 3'b001: {dstkW, dspI} = {1'b0, 4'b1111}; + 3'b011: {dstkW, dspI} = {func_T_N, {insn[1], insn[1], insn[1:0]}}; + default: {dstkW, dspI} = {1'b0, 4'b0000}; + endcase + dspN = dsp + dspI; + + casez ({insn[15:13]}) + 3'b010: {rstkW, rspI} = {1'b1, 4'b0001}; + 3'b011: {rstkW, rspI} = {func_T_R, {insn[3], insn[3], insn[3:2]}}; + default: {rstkW, rspI} = {1'b0, 4'b0000}; + endcase + rspN = rsp + rspI; + + casez ({reboot, insn[15:13], insn[7], |st0}) + 6'b1_???_?_?: pcN = 0; + 6'b0_000_?_?, + 6'b0_010_?_?, + 6'b0_001_?_0: pcN = insn[12:0]; + 6'b0_011_1_?: pcN = rst0[13:1]; + default: pcN = pc_plus_1; + endcase + end + + always @(negedge resetq or posedge clk) + begin + if (!resetq) begin + reboot <= 1'b1; + { pc, dsp, st0, rsp } <= 0; + end else begin + reboot <= 0; + { pc, dsp, st0, rsp } <= { pcN, dspN, st0N, rspN }; + end + end +endmodule diff --git a/docs/j1/verilog/stack.v b/docs/j1/verilog/stack.v new file mode 100644 index 0000000..e5cee8a --- /dev/null +++ b/docs/j1/verilog/stack.v @@ -0,0 +1,22 @@ +`include "common.h" + +module stack + #(parameter DEPTH=4) + (input wire clk, + /* verilator lint_off UNUSED */ + input wire resetq, + /* verilator lint_on UNUSED */ + input wire [DEPTH-1:0] ra, + output wire [`WIDTH-1:0] rd, + input wire we, + input wire [DEPTH-1:0] wa, + input wire [`WIDTH-1:0] wd); + + reg [`WIDTH-1:0] store[0:(2**DEPTH)-1]; + + always @(posedge clk) + if (we) + store[wa] <= wd; + + assign rd = store[ra]; +endmodule diff --git a/docs/j1/verilog/testbench.v b/docs/j1/verilog/testbench.v new file mode 100644 index 0000000..2ec2b5e --- /dev/null +++ b/docs/j1/verilog/testbench.v @@ -0,0 +1,30 @@ +`timescale 1ns/1ps +`default_nettype none + +module testbench(); + + reg clk; + reg resetq; + integer t; + + top #(.FIRMWARE("build/firmware/")) dut(.clk(clk), .resetq(resetq)); + + initial begin + clk = 1; + t = 0; + resetq = 0; + #1; + resetq = 1; + + $dumpfile("test.vcd"); + $dumpvars(0, dut); + end + + always #5.0 clk = ~clk; + + always @(posedge clk) begin + t <= t + 1; + if (t == 300) + $finish; + end +endmodule diff --git a/docs/j1/verilog/top.v b/docs/j1/verilog/top.v new file mode 100644 index 0000000..efcf297 --- /dev/null +++ b/docs/j1/verilog/top.v @@ -0,0 +1,9 @@ +module top( + input clk, + input resetq, + output [15:0] tail); + parameter FIRMWARE = ""; + + j1 _j1 (.clk(clk), .resetq(resetq)); + +endmodule diff --git a/docs/j1/verilog/uart.v b/docs/j1/verilog/uart.v new file mode 100644 index 0000000..4daac0f --- /dev/null +++ b/docs/j1/verilog/uart.v @@ -0,0 +1,180 @@ +`default_nettype none + +module baudgen( + input wire clk, + input wire resetq, + input wire [31:0] baud, + input wire restart, + output wire ser_clk); + parameter CLKFREQ = 1000000; + + wire [38:0] aclkfreq = CLKFREQ; + reg [38:0] d; + wire [38:0] dInc = d[38] ? ({4'd0, baud}) : (({4'd0, baud}) - aclkfreq); + wire [38:0] dN = restart ? 0 : (d + dInc); + wire fastclk = ~d[38]; + assign ser_clk = fastclk; + + always @(negedge resetq or posedge clk) + begin + if (!resetq) begin + d <= 0; + end else begin + d <= dN; + end + end +endmodule + +/* + +-----+ +-----+-----+-----+-----+-----+-----+-----+-----+-----+-----+---- + | | | | | | | | | | | | + |start| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 |stop1|stop2| + | | | | | | | | | | | ? | + +-----+-----+-----+-----+-----+-----+-----+-----+-----+ + + +*/ + +module uart( + input wire clk, // System clock + input wire resetq, + + // Outputs + output wire uart_busy, // High means UART is transmitting + output reg uart_tx, // UART transmit wire + // Inputs + input wire [31:0] baud, + input wire uart_wr_i, // Raise to transmit byte + input wire [7:0] uart_dat_i // 8-bit data +); + parameter CLKFREQ = 1000000; + + reg [3:0] bitcount; + reg [8:0] shifter; + + assign uart_busy = |bitcount; + wire sending = |bitcount; + + wire ser_clk; + + wire starting = uart_wr_i & ~uart_busy; + baudgen #(.CLKFREQ(CLKFREQ)) _baudgen( + .clk(clk), + .resetq(resetq), + .baud(baud), + .restart(1'b0), + .ser_clk(ser_clk)); + + always @(negedge resetq or posedge clk) + begin + if (!resetq) begin + uart_tx <= 1; + bitcount <= 0; + shifter <= 0; + end else begin + if (starting) begin + shifter <= { uart_dat_i[7:0], 1'b0 }; + bitcount <= 1 + 8 + 1; + end + + if (sending & ser_clk) begin + { shifter, uart_tx } <= { 1'b1, shifter }; + bitcount <= bitcount - 4'd1; + end + end + end + +endmodule + +module rxuart( + input wire clk, + input wire resetq, + input wire [31:0] baud, + input wire uart_rx, // UART recv wire + input wire rd, // read strobe + output wire valid, // has data + output wire [7:0] data); // data + parameter CLKFREQ = 1000000; + + reg [4:0] bitcount; + reg [7:0] shifter; + + // On starting edge, wait 3 half-bits then sample, and sample every 2 bits thereafter + + wire idle = &bitcount; + wire sample; + reg [2:0] hh = 3'b111; + wire [2:0] hhN = {hh[1:0], uart_rx}; + wire startbit = idle & (hhN[2:1] == 2'b10); + wire [7:0] shifterN = sample ? {hh[1], shifter[7:1]} : shifter; + + wire ser_clk; + baudgen #(.CLKFREQ(CLKFREQ)) _baudgen( + .clk(clk), + .baud({baud[30:0], 1'b0}), + .resetq(resetq), + .restart(startbit), + .ser_clk(ser_clk)); + + assign valid = (bitcount == 18); + reg [4:0] bitcountN; + always @* + if (startbit) + bitcountN = 0; + else if (!idle & !valid & ser_clk) + bitcountN = bitcount + 5'd1; + else if (valid & rd) + bitcountN = 5'b11111; + else + bitcountN = bitcount; + + // 3,5,7,9,11,13,15,17 + assign sample = (bitcount > 2) & bitcount[0] & !valid & ser_clk; + assign data = shifter; + + always @(negedge resetq or posedge clk) + begin + if (!resetq) begin + hh <= 3'b111; + bitcount <= 5'b11111; + shifter <= 0; + end else begin + hh <= hhN; + bitcount <= bitcountN; + shifter <= shifterN; + end + end +endmodule + +module buart( + input wire clk, + input wire resetq, + input wire [31:0] baud, + input wire rx, // recv wire + output wire tx, // xmit wire + input wire rd, // read strobe + input wire wr, // write strobe + output wire valid, // has recv data + output wire busy, // is transmitting + input wire [7:0] tx_data, + output wire [7:0] rx_data // data +); + parameter CLKFREQ = 1000000; + + rxuart #(.CLKFREQ(CLKFREQ)) _rx ( + .clk(clk), + .resetq(resetq), + .baud(baud), + .uart_rx(rx), + .rd(rd), + .valid(valid), + .data(rx_data)); + uart #(.CLKFREQ(CLKFREQ)) _tx ( + .clk(clk), + .resetq(resetq), + .baud(baud), + .uart_busy(busy), + .uart_tx(tx), + .uart_wr_i(wr), + .uart_dat_i(tx_data)); +endmodule diff --git a/docs/j1/verilog/xilinx-top.v b/docs/j1/verilog/xilinx-top.v new file mode 100644 index 0000000..6695d77 --- /dev/null +++ b/docs/j1/verilog/xilinx-top.v @@ -0,0 +1,215 @@ +`default_nettype none + + +module bram_tdp #( + parameter DATA = 72, + parameter ADDR = 10 +) ( + // Port A + input wire a_clk, + input wire a_wr, + input wire [ADDR-1:0] a_addr, + input wire [DATA-1:0] a_din, + output reg [DATA-1:0] a_dout, + + // Port B + input wire b_clk, + input wire b_wr, + input wire [ADDR-1:0] b_addr, + input wire [DATA-1:0] b_din, + output reg [DATA-1:0] b_dout +); + +// Shared memory +reg [DATA-1:0] mem [(2**ADDR)-1:0]; + initial begin + $readmemh("../build/firmware/demo0.hex", mem); + end + +// Port A +always @(posedge a_clk) begin + a_dout <= mem[a_addr]; + if(a_wr) begin + a_dout <= a_din; + mem[a_addr] <= a_din; + end +end + +// Port B +always @(posedge b_clk) begin + b_dout <= mem[b_addr]; + if(b_wr) begin + b_dout <= b_din; + mem[b_addr] <= b_din; + end +end + +endmodule + +// A 16Kbyte RAM (4096x32) with one write port and one read port +module ram16k0( + input wire clk, + + input wire[15:0] a_addr, + output wire[31:0] a_q, + input wire[31:0] a_d, + input wire a_wr, + + input wire[12:0] b_addr, + output wire[15:0] b_q); + + //synthesis attribute ram_style of mem is block + reg [31:0] mem[0:4095]; //pragma attribute mem ram_block TRUE + initial begin + $readmemh("../build/firmware/demo0.hex", mem); + end + + always @ (posedge clk) + if (a_wr) + mem[a_addr[13:2]] <= a_d; + + reg [15:0] a_addr_; + always @ (posedge clk) + a_addr_ <= a_addr; + assign a_q = mem[a_addr_[13:2]]; + + reg [12:0] raddr_reg; + always @ (posedge clk) + raddr_reg <= b_addr; + wire [31:0] insn32 = mem[raddr_reg[12:1]]; + assign b_q = raddr_reg[0] ? insn32[31:16] : insn32[15:0]; +endmodule + +module ram16k( + input wire clk, + + input wire[15:0] a_addr, + output wire[31:0] a_q, + input wire[31:0] a_d, + input wire a_wr, + + input wire[12:0] b_addr, + output wire[15:0] b_q); + + wire [31:0] insn32; + + bram_tdp #(.DATA(32), .ADDR(12)) nram ( + .a_clk(clk), + .a_wr(a_wr), + .a_addr(a_addr[13:2]), + .a_din(a_d), + .a_dout(a_q), + + .b_clk(clk), + .b_wr(1'b0), + .b_addr(b_addr[12:1]), + .b_din(32'd0), + .b_dout(insn32)); + + reg ba_; + always @(posedge clk) + ba_ <= b_addr[0]; + assign b_q = ba_ ? insn32[31:16] : insn32[15:0]; + +endmodule + + +module top( + input wire CLK, + output wire DUO_LED, + input wire DUO_SW1, + input wire RXD, + output wire TXD, + input wire DTR + ); + localparam MHZ = 40; + + wire fclk; + + DCM_CLKGEN #( + .CLKFX_MD_MAX(0.0), // Specify maximum M/D ratio for timing anlysis + .CLKFX_DIVIDE(32), // Divide value - D - (1-256) + .CLKFX_MULTIPLY(MHZ), // Multiply value - M - (2-256) + .CLKIN_PERIOD(31.25), // Input clock period specified in nS + .STARTUP_WAIT("FALSE") // Delay config DONE until DCM_CLKGEN LOCKED (TRUE/FALSE) + ) + DCM_CLKGEN_inst ( + .CLKFX(fclk), // 1-bit output: Generated clock output + .CLKIN(CLK), // 1-bit input: Input clock + .FREEZEDCM(0), // 1-bit input: Prevents frequency adjustments to input clock + .PROGCLK(0), // 1-bit input: Clock input for M/D reconfiguration + .PROGDATA(0), // 1-bit input: Serial data input for M/D reconfiguration + .PROGEN(0), // 1-bit input: Active high program enable + .RST(0) // 1-bit input: Reset input pin + ); + + reg [25:0] counter; + always @(posedge fclk) + counter <= counter + 26'd1; + assign DUO_LED = counter[25]; + + // ------------------------------------------------------------------------ + + wire uart0_valid, uart0_busy; + wire [7:0] uart0_data; + wire uart0_rd, uart0_wr; + reg [31:0] baud = 32'd115200; + wire UART0_RX; + buart #(.CLKFREQ(MHZ * 1000000)) _uart0 ( + .clk(fclk), + .resetq(1'b1), + .baud(baud), + .rx(RXD), + .tx(TXD), + .rd(uart0_rd), + .wr(uart0_wr), + .valid(uart0_valid), + .busy(uart0_busy), + .tx_data(dout_[7:0]), + .rx_data(uart0_data)); + + wire [15:0] mem_addr; + wire [31:0] mem_din; + wire mem_wr; + wire [31:0] dout; + + wire [12:0] code_addr; + wire [15:0] insn; + + wire io_wr; + + wire resetq = DTR; + + j1 _j1 ( + .clk(fclk), + .resetq(resetq), + + .io_wr(io_wr), + .mem_addr(mem_addr), + .mem_wr(mem_wr), + .mem_din(mem_din), + .dout(dout), + .io_din({16'd0, uart0_data, 4'd0, DTR, uart0_valid, uart0_busy, DUO_SW1}), + + .code_addr(code_addr), + .insn(insn) + ); + + ram16k ram(.clk(fclk), + .a_addr(mem_addr), + .a_q(mem_din), + .a_wr(mem_wr), + .a_d(dout), + .b_addr(code_addr), + .b_q(insn)); + + reg io_wr_; + reg [15:0] mem_addr_; + reg [31:0] dout_; + always @(posedge fclk) + {io_wr_, mem_addr_, dout_} <= {io_wr, mem_addr, dout}; + + assign uart0_wr = io_wr_ & (mem_addr_ == 16'h0000); + assign uart0_rd = io_wr_ & (mem_addr_ == 16'h0002); + +endmodule diff --git a/docs/j1/xilinx/.gitignore b/docs/j1/xilinx/.gitignore new file mode 100644 index 0000000..e138931 --- /dev/null +++ b/docs/j1/xilinx/.gitignore @@ -0,0 +1,44 @@ +*.bgn +*.bit +*_bitgen.xwbt +*.bld +*.cfi +*.drc +*.map +*.mcs +*.mrp +*.ncd +*.ngc +*.ngc_xst.xrpt +*.ngd +*_ngdbuild.xrpt +*.ngm +*_par.grf +*_par.ncd +*_par.pad +*_par_pad.csv +*_par_pad.txt +*_par.par +*_par.ptwx +*_par.unroutes +*_par.xpi +*.pcf +*.prj +*.prm +*.psr +*.scr +*.srp +*.xml +*.html +_impactbatch.log +netlist.lst +smartguide.ncd +top.lso +top_map.xrpt +top_par.xrpt +usage_statistics_webtalk.html +webtalk.log +xlnx_auto_0_xdb +_xmsgs +xst +unused/ diff --git a/docs/j1/xilinx/Makefile b/docs/j1/xilinx/Makefile new file mode 100644 index 0000000..481513b --- /dev/null +++ b/docs/j1/xilinx/Makefile @@ -0,0 +1,11 @@ +project = j1-papilioduo +vendor = xilinx +family = spartan3s +part = xc6slx9-2-tqg144 +# part = xc3s200an-4ftg256 +top_module = top +flashsize = 2048 + +vfiles = ../verilog/xilinx-top.v ../verilog/uart.v ../verilog/j1.v ../verilog/stack.v + +include xilinx.mk diff --git a/docs/j1/xilinx/go b/docs/j1/xilinx/go new file mode 100644 index 0000000..c527f4c --- /dev/null +++ b/docs/j1/xilinx/go @@ -0,0 +1,22 @@ +set -e +cd ../toolchain +sh go +cd ../xilinx + +$HOME/Downloads/DesignLab-1.0.5/tools/Papilio_Loader/programmer/linux32/papilio-prog -v -f j1-papilioduo.bit +python shell.py -h /dev/ttyUSB2 -i ../build/firmware/nuc.hex ; exit + +make clean +make +if false +then + cp ../build/firmware/nuc.hex ../build/firmware/nuc.mem + data2mem -bm j1-papilioduo_bd.bmm -bd ../build/firmware/nuc.mem -bt j1-papilioduo.bit + trce -v 10 j1-papilioduo.ncd j1-papilioduo.pcf -o j1-papilioduo.twr + DL=j1-papilioduo_rp.bit +else + DL=j1-papilioduo.bit +fi +$HOME/Downloads/DesignLab-1.0.5/tools/Papilio_Loader/programmer/linux32/papilio-prog -v -f $DL +python shell.py -h /dev/ttyUSB2 -i ../build/firmware/nuc.hex ; exit +# miniterm.py /dev/ttyUSB0 115200 diff --git a/docs/j1/xilinx/j1-papilioduo.bmm b/docs/j1/xilinx/j1-papilioduo.bmm new file mode 100644 index 0000000..3dea0be --- /dev/null +++ b/docs/j1/xilinx/j1-papilioduo.bmm @@ -0,0 +1,24 @@ +// BMM LOC annotation file. +// +// Release 14.6 - P.20131013, build 3.0.10 Apr 3, 2013 +// Copyright (c) 1995-2015 Xilinx, Inc. All rights reserved. + + +/////////////////////////////////////////////////////////////////////////////// +// +// Address space 'j1' 0x00000000:0x000007FF (2 KBytes). +// +/////////////////////////////////////////////////////////////////////////////// + +// ADDRESS_SPACE j1 RAMB16 [0xffff0000:0xffff3FFF] +// BUS_BLOCK +// ram/nram/Mram_mem7 RAMB16 [3:0] [0:4095]; +// ram/nram/Mram_mem6 RAMB16 [7:4] [0:4095]; +// ram/nram/Mram_mem5 RAMB16 [11:8] [0:4095]; +// ram/nram/Mram_mem4 RAMB16 [15:12] [0:4095]; +// ram/nram/Mram_mem3 RAMB16 [19:16] [0:4095]; +// ram/nram/Mram_mem2 RAMB16 [23:20] [0:4095]; +// ram/nram/Mram_mem1 RAMB16 [27:24] [0:4095]; +// ram/nram/Mram_mem0 RAMB16 [31:28] [0:4095]; +// END_BUS_BLOCK; +// END_ADDRESS_SPACE; diff --git a/docs/j1/xilinx/j1-papilioduo.ucf b/docs/j1/xilinx/j1-papilioduo.ucf new file mode 100644 index 0000000..e06e002 --- /dev/null +++ b/docs/j1/xilinx/j1-papilioduo.ucf @@ -0,0 +1,183 @@ +# UCF file for the Papilio DUO board +# Generated by pin_converter, written by Kevin Lindsey +# https://github.com/thelonious/papilio_pins/tree/development/pin_converter + +# Main board wing pin [] to FPGA pin Pxx map +# -------C------- -------B------- -------A------- +# [GND] [C00] P114 [GND] [B00] P99 P100 [A15] +# [2V5] [C01] P115 [2V5] [B01] P97 P98 [A14] +# [3V3] [C02] P116 [3V3] [B02] P92 P93 [A13] +# [5V0] [C03] P117 [5V0] [B03] P87 P88 [A12] +# [C04] P118 [B04] P84 P85 [A11] [5V0] +# [C05] P119 [B05] P82 P83 [A10] [3V3] +# [C06] P120 [B06] P80 P81 [A09] [2V5] +# [C07] P121 [B07] P78 P79 [A08] [GND] +# [GND] [C08] P123 [GND] [B08] P74 P75 [A07] +# [2V5] [C09] P124 [2V5] [B09] P95 P67 [A06] +# [3V3] [C10] P126 [3V3] [B10] P62 P66 [A05] +# [5V0] [C11] P127 [5V0] [B11] P59 P61 [A04] +# [C12] P131 [B12] P57 P58 [A03] [5V0] +# [C13] P132 [B13] P55 P56 [A02] [3V3] +# [C14] P133 [B14] P50 P51 [A01] [2V5] +# [C15] P134 [B15] P47 P48 [A00] [GND] + +## Prohibit the automatic placement of pins that are connected to VCC or GND for configuration. +CONFIG PROHIBIT=P144; +CONFIG PROHIBIT=P69; +CONFIG PROHIBIT=P60; + +#NET "*" IOSTANDARD = LVTTL; + +NET CLK LOC="P94" | IOSTANDARD=LVTTL; # CLK +TIMESPEC TS_Period_1 = PERIOD "CLK" 31.25 ns HIGH 50%; +NET TXD LOC="P141" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; +NET RXD LOC="P46" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; +NET DTR LOC="P137" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; + +// NET "fclk" PERIOD = 6 ns HIGH 50%; + +# +# NET Arduino_0 LOC="P116" | IOSTANDARD=LVTTL; # A0 +# NET Arduino_1 LOC="P117" | IOSTANDARD=LVTTL; # A1 +# NET Arduino_2 LOC="P118" | IOSTANDARD=LVTTL; # A2 +# NET Arduino_3 LOC="P119" | IOSTANDARD=LVTTL; # A3 +# NET Arduino_4 LOC="P120" | IOSTANDARD=LVTTL; # A4 +# NET Arduino_5 LOC="P121" | IOSTANDARD=LVTTL; # A5 +# NET Arduino_6 LOC="P123" | IOSTANDARD=LVTTL; # A6 +# NET Arduino_7 LOC="P124" | IOSTANDARD=LVTTL; # A7 +# NET Arduino_8 LOC="P126" | IOSTANDARD=LVTTL; # A8 +# NET Arduino_9 LOC="P127" | IOSTANDARD=LVTTL; # A9 +# NET Arduino_10 LOC="P131" | IOSTANDARD=LVTTL; # A10 +# NET Arduino_11 LOC="P132" | IOSTANDARD=LVTTL; # A11 +# NET Arduino_12 LOC="P133" | IOSTANDARD=LVTTL; # A12 +# NET Arduino_13 LOC="P134" | IOSTANDARD=LVTTL; # A13 +# +# NET Arduino_14 LOC="P115" | IOSTANDARD=LVTTL; # B0 +# NET Arduino_15 LOC="P114" | IOSTANDARD=LVTTL; # B1 +# NET Arduino_16 LOC="P112" | IOSTANDARD=LVTTL; # B2 +# NET Arduino_17 LOC="P111" | IOSTANDARD=LVTTL; # B3 +# NET Arduino_18 LOC="P105" | IOSTANDARD=LVTTL; # B4 +# NET Arduino_19 LOC="P102" | IOSTANDARD=LVTTL; # B5 +# NET Arduino_20 LOC="P101" | IOSTANDARD=LVTTL; # B6 +# NET Arduino_21 LOC="P100" | IOSTANDARD=LVTTL; # B7 +# +# NET Arduino_22 LOC="P99" | IOSTANDARD=LVTTL; # C0 +# NET Arduino_24 LOC="P97" | IOSTANDARD=LVTTL; # C1 +# NET Arduino_26 LOC="P93" | IOSTANDARD=LVTTL; # C2 +# NET Arduino_28 LOC="P88" | IOSTANDARD=LVTTL; # C3 +# NET Arduino_30 LOC="P85" | IOSTANDARD=LVTTL; # C4 +# NET Arduino_32 LOC="P83" | IOSTANDARD=LVTTL; # C5 +# NET Arduino_34 LOC="P81" | IOSTANDARD=LVTTL; # C6 +# NET Arduino_36 LOC="P79" | IOSTANDARD=LVTTL; # C7 +# NET Arduino_38 LOC="P75" | IOSTANDARD=LVTTL; # C8 +# NET Arduino_40 LOC="P67" | IOSTANDARD=LVTTL; # C9 +# NET Arduino_42 LOC="P62" | IOSTANDARD=LVTTL; # C10 +# NET Arduino_44 LOC="P59" | IOSTANDARD=LVTTL; # C11 +# NET Arduino_46 LOC="P57" | IOSTANDARD=LVTTL; # C12 +# NET Arduino_48 LOC="P55" | IOSTANDARD=LVTTL; # C13 +# NET Arduino_50 LOC="P50" | IOSTANDARD=LVTTL; # C14 +# NET Arduino_52 LOC="P47" | IOSTANDARD=LVTTL; # C15 +# +# NET Arduino_23 LOC="P98" | IOSTANDARD=LVTTL ; +# NET Arduino_25 LOC="P95" | IOSTANDARD=LVTTL ; +# NET Arduino_27 LOC="P92" | IOSTANDARD=LVTTL ; +# NET Arduino_29 LOC="P87" | IOSTANDARD=LVTTL ; +# NET Arduino_31 LOC="P84" | IOSTANDARD=LVTTL ; +# NET Arduino_33 LOC="P82" | IOSTANDARD=LVTTL ; +# NET Arduino_35 LOC="P80" | IOSTANDARD=LVTTL ; +# NET Arduino_37 LOC="P78" | IOSTANDARD=LVTTL ; +# NET Arduino_39 LOC="P74" | IOSTANDARD=LVTTL ; +# NET Arduino_41 LOC="P66" | IOSTANDARD=LVTTL ; +# NET Arduino_43 LOC="P61" | IOSTANDARD=LVTTL ; +# NET Arduino_45 LOC="P58" | IOSTANDARD=LVTTL ; +# NET Arduino_47 LOC="P56" | IOSTANDARD=LVTTL ; +# NET Arduino_49 LOC="P51" | IOSTANDARD=LVTTL ; +# NET Arduino_51 LOC="P48" | IOSTANDARD=LVTTL ; +# NET Arduino_53 LOC="P39" | IOSTANDARD=LVTTL ; +# +# # SRAM +# +# NET "sram_addr<0>" LOC = "P7" | IOSTANDARD=LVTTL | SLEW=FAST; +# NET "sram_addr<1>" LOC = "P8" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<2>" LOC = "P9" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<3>" LOC = "P10" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<4>" LOC = "P11" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<5>" LOC = "P5" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<6>" LOC = "P2" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<7>" LOC = "P1" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<8>" LOC = "P143" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<9>" LOC = "P142" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<10>" LOC = "P43" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<11>" LOC = "P41" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<12>" LOC = "P40" | IOSTANDARD=LVTTL | SLEW=FAST; +# NET "sram_addr<13>" LOC = "P35" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<14>" LOC = "P34" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<15>" LOC = "P27" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<16>" LOC = "P29" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<17>" LOC = "P33" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_addr<18>" LOC = "P32" | IOSTANDARD=LVTTL | SLEW=FAST ; +# #NET "sram_addr<19>" LOC = "P44" | IOSTANDARD=LVTTL | SLEW=FAST ; +# #NET "sram_addr<20>" LOC = "P30" | IOSTANDARD=LVTTL | SLEW=FAST ; +# +# # Data lines +# NET "sram_data<0>" LOC = "P14" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_data<1>" LOC = "P15" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_data<2>" LOC = "P16" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_data<3>" LOC = "P17" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_data<4>" LOC = "P21" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_data<5>" LOC = "P22" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_data<6>" LOC = "P23" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_data<7>" LOC = "P24" | IOSTANDARD=LVTTL | SLEW=FAST ; +# +# # Control lines +# NET "sram_ce" LOC = "P12" | IOSTANDARD=LVTTL | SLEW=FAST; +# NET "sram_we" LOC = "P6" | IOSTANDARD=LVTTL | SLEW=FAST ; +# NET "sram_oe" LOC = "P26" | IOSTANDARD=LVTTL | SLEW=FAST; +# +# NET SPI_CS LOC="P38" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_CS OK +# NET SPI_SCK LOC="P70" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_CK OK +# NET SPI_MOSI LOC="P64" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_SI OK +# NET SPI_MISO LOC="P65" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_SO OK +# +# #Dragon MPSSE +# NET BD0_MPSSE_TCK LOC="P46" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET BD1_MPSSE_TDI LOC="P141" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET BD2_MPSSE_TDO LOC="P140" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET BD3_MPSSE_TMS LOC="P138" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET BD4_MPSSE_DTR LOC="P137" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# +# #Arduino JTAG +# NET ARD_JTAG_TDI LOC="P88" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET ARD_JTAG_TDO LOC="P85" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET ARD_JTAG_TMS LOC="P83" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET ARD_JTAG_TCK LOC="P81" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# +# #Arduino SPI +# NET ARD_SPI_MISO LOC="P133" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET ARD_SPI_MOSI LOC="P132" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET ARD_SPI_SCLK LOC="P134" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# +# #Dragon SPI +# NET DRAGON_SPI_GND LOC="P78" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET DRAGON_SPI_RESET LOC="P79" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# #NET DRAGON_SPI_RESET LOC="P79" | IOSTANDARD=LVTTL | DRIVE=8 | PULLUP | SLEW=SLOW; +# NET DRAGON_SPI_MOSI LOC="P74" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET DRAGON_SPI_SCK LOC="P75" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET DRAGON_SPI_VTG LOC="P66" | IOSTANDARD=LVTTL | DRIVE=24 | SLEW=SLOW; +# NET DRAGON_SPI_MISO LOC="P67" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# +# #Dragon JTAG +# NET DRAGON_JTAG_TCK LOC="P47" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET DRAGON_JTAG_GND LOC="P39" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET DRAGON_JTAG_TDO LOC="P50" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET DRAGON_JTAG_VTG LOC="P48" | IOSTANDARD=LVTTL | DRIVE=24 | SLEW=SLOW; +# NET DRAGON_JTAG_TMS LOC="P55" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET DRAGON_JTAG_RESET LOC="P51" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# #NET DRAGON_JTAG_RESET LOC="P51" | IOSTANDARD=LVTTL | DRIVE=8 | PULLUP | SLEW=SLOW; +# NET DRAGON_JTAG_TDI LOC="P59" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET DRAGON_JTAG_GND2 LOC="P58" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# +# #Dragon Misc +NET DUO_SW1 LOC="P104" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; +# NET ARD_RESET LOC="P139" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; # ARD_RESET +NET DUO_LED LOC="P134" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; diff --git a/docs/j1/xilinx/shell.py b/docs/j1/xilinx/shell.py new file mode 100644 index 0000000..814e6a2 --- /dev/null +++ b/docs/j1/xilinx/shell.py @@ -0,0 +1,78 @@ +#!/usr/bin/env python + +import sys +from datetime import datetime +import time +import array +import struct +import os + +try: + import serial +except: + print "This tool needs PySerial, but it was not found" + sys.exit(1) + +import swapforth as sf + +class TetheredJ1b(sf.TetheredFT900): + def __init__(self, port): + ser = serial.Serial(port, 115200, timeout=None, rtscts=0) + self.ser = ser + self.searchpath = ['.'] + self.log = open("log", "w") + + def boot(self, bootfile = None): + ser = self.ser + ser.setDTR(1) + ser.setDTR(0) + boot = array.array('I', [int(l, 16) for l in open(bootfile)]) + boot = boot[:0x3f80 / 4] # remove bootloader itself (top 128 bytes) + while boot[-1] == 0: # remove any unused words + boot = boot[:-1] + boot = boot.tostring() + ser.write(chr(27)) + print 'wrote 27' + # print repr(ser.read(1)) + + ser.write(struct.pack('I', len(boot))) + ser.write(boot) + print 'completed load of %d bytes' % len(boot) + # print repr(ser.read(1)) + +if __name__ == '__main__': + port = '/dev/ttyUSB0' + image = None + + r = None + + args = sys.argv[1:] + while args: + a = args[0] + if a.startswith('-i'): + image = args[1] + args = args[2:] + elif a.startswith('-h'): + port = args[1] + args = args[2:] + else: + if not r: + r = TetheredJ1b(port) + r.boot(image) + if a.startswith('-e'): + print r.shellcmd(args[1]) + args = args[2:] + else: + try: + r.include(a) + except sf.Bye: + pass + args = args[1:] + if not r: + r = TetheredJ1b(port) + r.boot(image) + + print repr(r.ser.read(1)) + # r.interactive_command(None) + r.shell(False) + # r.listen() diff --git a/docs/j1/xilinx/xilinx.mk b/docs/j1/xilinx/xilinx.mk new file mode 100644 index 0000000..f71dede --- /dev/null +++ b/docs/j1/xilinx/xilinx.mk @@ -0,0 +1,176 @@ +# The top level module should define the variables below then include +# this file. The files listed should be in the same directory as the +# Makefile. +# +# variable description +# ---------- ------------- +# project project name (top level module should match this name) +# top_module top level module of the project +# libdir path to library directory +# libs library modules used +# vfiles all local .v files +# xilinx_cores all local .xco files +# vendor vendor of FPGA (xilinx, altera, etc.) +# family FPGA device family (spartan3e) +# part FPGA part name (xc4vfx12-10-sf363) +# flashsize size of flash for mcs file (16384) +# optfile (optional) xst extra opttions file to put in .scr +# map_opts (optional) options to give to map +# par_opts (optional) options to give to par +# intstyle (optional) intstyle option to all tools +# +# files description +# ---------- ------------ +# $(project).ucf ucf file +# +# Library modules should have a modules.mk in their root directory, +# namely $(libdir)//module.mk, that simply adds to the vfiles +# and xilinx_cores variable. +# +# all the .xco files listed in xilinx_cores will be generated with core, with +# the resulting .v and .ngc files placed back in the same directory as +# the .xco file. +# +# TODO: .xco files are device dependant, should use a template based system + +coregen_work_dir ?= ./coregen-tmp +map_opts ?= -timing -ol high -detail -pr b -register_duplication -w +par_opts ?= -ol high +isedir ?= /data/Xilinx/14.7/ISE_DS +xil_env ?= . $(isedir)/settings64.sh +flashsize ?= 8192 + +libmks = $(patsubst %,$(libdir)/%/module.mk,$(libs)) +mkfiles = Makefile $(libmks) xilinx.mk +include $(libmks) + +corengcs = $(foreach core,$(xilinx_cores),$(core:.xco=.ngc)) +local_corengcs = $(foreach ngc,$(corengcs),$(notdir $(ngc))) +vfiles += $(foreach core,$(xilinx_cores),$(core:.xco=.v)) +junk += $(local_corengcs) + +.PHONY: default xilinx_cores clean twr etwr +default: $(project).bit $(project).mcs +xilinx_cores: $(corengcs) +twr: $(project).twr +etwr: $(project)_err.twr + +define cp_template +$(2): $(1) + cp $(1) $(2) +endef +$(foreach ngc,$(corengcs),$(eval $(call cp_template,$(ngc),$(notdir $(ngc))))) + +%.ngc %.v: %.xco + @echo "=== rebuilding $@" + if [ -d $(coregen_work_dir) ]; then \ + rm -rf $(coregen_work_dir)/*; \ + else \ + mkdir -p $(coregen_work_dir); \ + fi + cd $(coregen_work_dir); \ + $(xil_env); \ + coregen -b $$OLDPWD/$<; \ + cd - + xcodir=`dirname $<`; \ + basename=`basename $< .xco`; \ + if [ ! -r $(coregen_work_dir/$$basename.ngc) ]; then \ + echo "'$@' wasn't created."; \ + exit 1; \ + else \ + cp $(coregen_work_dir)/$$basename.v $(coregen_work_dir)/$$basename.ngc $$xcodir; \ + fi +junk += $(coregen_work_dir) + +date = $(shell date +%F-%H-%M) + +# some common junk +junk += *.xrpt + +programming_files: $(project).bit $(project).mcs + mkdir -p $@/$(date) + mkdir -p $@/latest + for x in .bit .mcs .cfi _bd.bmm; do cp $(project)$$x $@/$(date)/$(project)$$x; cp $(project)$$x $@/latest/$(project)$$x; done + $(xil_env); xst -help | head -1 | sed 's/^/#/' | cat - $(project).scr > $@/$(date)/$(project).scr + +$(project).mcs: $(project).bit + $(xil_env); \ + promgen -w -s $(flashsize) -p mcs -o $@ -u 0 $^ +junk += $(project).mcs $(project).cfi $(project).prm + +$(project).bit: $(project)_par.ncd + $(xil_env); \ + bitgen $(intstyle) -g UserID:0x09470947 -g DriveDone:yes -g StartupClk:Cclk -w $(project)_par.ncd $(project).bit + # bitgen $(intstyle) -g compress -g UserID:0x09470947 -g DriveDone:yes -g StartupClk:Cclk -w $(project)_par.ncd $(project).bit + # bitgen $(intstyle) -g UserID:0x09470947 -g DriveDone:yes -g StartupClk:Cclk -w $(project)_par.ncd $(project).bit +junk += $(project).bgn $(project).bit $(project).drc $(project)_bd.bmm + + +$(project)_par.ncd: $(project).ncd + $(xil_env); \ + if par $(intstyle) $(par_opts) -w $(project).ncd $(project)_par.ncd; then \ + :; \ + else \ + $(MAKE) etwr; \ + fi +junk += $(project)_par.ncd $(project)_par.par $(project)_par.pad +junk += $(project)_par_pad.csv $(project)_par_pad.txt +junk += $(project)_par.grf $(project)_par.ptwx +junk += $(project)_par.unroutes $(project)_par.xpi + +$(project).ncd: $(project).ngd + if [ -r $(project)_par.ncd ]; then \ + cp $(project)_par.ncd smartguide.ncd; \ + smartguide="-smartguide smartguide.ncd"; \ + else \ + smartguide=""; \ + fi; \ + $(xil_env); \ + map $(intstyle) $(map_opts) $$smartguide $< +junk += $(project).ncd $(project).pcf $(project).ngm $(project).mrp $(project).map +junk += smartguide.ncd $(project).psr +junk += $(project)_summary.xml $(project)_usage.xml + +$(project).ngd: $(project).ngc $(project).ucf $(project).bmm + $(xil_env); ngdbuild $(intstyle) $(project).ngc -bm $(project).bmm +junk += $(project).ngd $(project).bld + +$(project).ngc: $(vfiles) $(local_corengcs) $(project).scr $(project).prj + $(xil_env); xst $(intstyle) -ifn $(project).scr +junk += xlnx_auto* $(top_module).lso $(project).srp +junk += netlist.lst xst $(project).ngc + +$(project).prj: $(vfiles) $(mkfiles) + for src in $(vfiles); do echo "verilog work $$src" >> $(project).tmpprj; done + sort -u $(project).tmpprj > $(project).prj + rm -f $(project).tmpprj +junk += $(project).prj + +optfile += $(wildcard $(project).opt) +top_module ?= $(project) +$(project).scr: $(optfile) $(mkfiles) ./xilinx.opt + echo "run" > $@ + echo "-p $(part)" >> $@ + echo "-top $(top_module)" >> $@ + echo "-ifn $(project).prj" >> $@ + echo "-ofn $(project).ngc" >> $@ + cat ./xilinx.opt $(optfile) >> $@ +junk += $(project).scr + +$(project).post_map.twr: $(project).ncd + $(xil_env); trce -e 10 $< $(project).pcf -o $@ +junk += $(project).post_map.twr $(project).post_map.twx smartpreview.twr + +$(project).twr: $(project)_par.ncd + $(xil_env); trce $< $(project).pcf -o $(project).twr +junk += $(project).twr $(project).twx smartpreview.twr + +$(project)_err.twr: $(project)_par.ncd + $(xil_env); trce -e 10 $< $(project).pcf -o $(project)_err.twr +junk += $(project)_err.twr $(project)_err.twx + +.gitignore: $(mkfiles) + echo programming_files $(junk) | sed 's, ,\n,g' > .gitignore + +clean:: + rm -rf $(junk) diff --git a/docs/j1/xilinx/xilinx.opt b/docs/j1/xilinx/xilinx.opt new file mode 100644 index 0000000..c9e5ab7 --- /dev/null +++ b/docs/j1/xilinx/xilinx.opt @@ -0,0 +1,42 @@ +-ifmt mixed +-ofmt NGC +-opt_mode speed +-opt_level 1 +-iuc NO +-keep_hierarchy no +-netlist_hierarchy as_optimized +-rtlview no +-glob_opt AllClockNets +-read_cores yes +-write_timing_constraints NO +-cross_clock_analysis NO +-hierarchy_separator / +-bus_delimiter <> +-case maintain +-slice_utilization_ratio 100 +-bram_utilization_ratio 100 +#-dsp_utilization_ratio 100 +-safe_implementation No +-fsm_extract YES +-fsm_encoding Auto +-fsm_style lut +-ram_extract Yes +-ram_style Auto +-rom_extract Yes +-rom_style Auto +-shreg_extract YES +-auto_bram_packing NO +-resource_sharing NO +-async_to_sync NO +#-use_dsp48 auto +-iobuf YES +-max_fanout 500 +-register_duplication YES +-register_balancing No +-optimize_primitives NO +-use_clock_enable Auto +-use_sync_set Auto +-use_sync_reset Auto +-iob auto +-equivalent_register_removal YES +-slice_utilization_ratio_maxmargin 5 diff --git a/docs/j1demo/firmware/Makefile b/docs/j1demo/firmware/Makefile new file mode 100644 index 0000000..b28bfe6 --- /dev/null +++ b/docs/j1demo/firmware/Makefile @@ -0,0 +1,26 @@ +j1.mem j1.bin: *.fs Makefile + @gforth -e 'include main.fs bye' + +doc: *.fs Makefile + gforth -e 'include ../../docforth/docforth.fs s" document.fs" document bye' + mkdir -p html + mv *.html html + +# PRGDIR=$(HOME)/wge100_firmware/trunk/synth/programming_files/latest +PRGDIR=../hardware/synth/programming_files/latest + +wge100_ip_camera.bit: $(PRGDIR)/wge100.bit j1.mem $(PRGDIR)/wge100_bd.bmm + (. /opt/Xilinx/11.1/ISE/settings32.sh ; data2mem -bm $(PRGDIR)/wge100_bd.bmm -bd j1.mem tag jram -bt $(PRGDIR)/wge100.bit -o b wge100_ip_camera.bit ) + +wge100_ip_camera.mcs: wge100_ip_camera.bit + (. /opt/Xilinx/11.1/ISE/settings32.sh ; linux32 promgen -w -p mcs -c FF -o wge100_ip_camera.mcs -u 0 wge100_ip_camera.bit >/dev/null ) + +defines_tcpip.fs defines_tcpip2.fs: genoffsets.py defines*py + python genoffsets.py + +download: j1.mem + ./send + sudo python listenterminal.py + +bundle: j1.bin wge100_ip_camera.mcs + cp j1.bin wge100_ip_camera.mcs tools/*.py $(HOME)/bundle diff --git a/docs/j1demo/firmware/ans.fs b/docs/j1demo/firmware/ans.fs new file mode 100644 index 0000000..dcd29ed --- /dev/null +++ b/docs/j1demo/firmware/ans.fs @@ -0,0 +1,46 @@ +( Main file for pure ANS forth JCB 13:53 11/27/10) + +: parse-word + bl word count ; + +: defer create ( "name" -- ) + ['] abort , does> @ execute ; + +: include ( "filename" -- ) + bl word count included decimal ; + +: is ( xt "name" -- ) + ' ( xt xt2) + state @ if + postpone literal postpone >body postpone ! + else + >body ! + then ; immediate + + +: include ( "filename" -- ) + bl parse included decimal ; + + : Do-Vocabulary ( -- ) + DOES> @ >R ( )( R: widnew) + GET-ORDER SWAP DROP ( wid_n ... wid_2 n) + R> SWAP SET-ORDER ; + +: VOCABULARY ( "name" -- ) + WORDLIST CREATE , Do-Vocabulary ; + +: -rot rot rot ; +: nstime 0. ; +: <= > invert ; +: >= < invert ; +: d0<> d0= invert ; + +: f> fswap f< ; +: f<= f> invert ; +: f>= f< invert ; +: f= 0e0 f~ ; +: f<> f= invert ; + +3.1415926e0 fconstant pi + +include main.fs diff --git a/docs/j1demo/firmware/arp.fs b/docs/j1demo/firmware/arp.fs new file mode 100644 index 0000000..c6b69c7 --- /dev/null +++ b/docs/j1demo/firmware/arp.fs @@ -0,0 +1,225 @@ +( ARP: Address Resolution Protocol JCB 13:12 08/24/10) +module[ arp" + +\ ARP uses a small cache of entries. Each entry has an age counter; new +\ entries have an age of 0, any entry with an age >N is old. +\ + + +d# 12 constant arp-cache-entry-size +d# 5 constant arp-cache-entries +TARGET? [IF] + meta + arp-cache-entry-size arp-cache-entries * d# 64 max + target + constant arp-size + create arp-cache arp-size allot + meta + arp-cache-entries 1- arp-cache-entry-size * arp-cache + + target + constant arp-cache-last +[ELSE] + arp-cache-entry-size arp-cache-entries * d# 64 max constant arp-size + create arp-cache arp-size allot + arp-cache-entries 1- arp-cache-entry-size * arp-cache + constant arp-cache-last +[THEN] + +: arp-foreach \ (func -- ) + arp-cache-last 2>r + begin + 2r@ swap \ ptr func + execute + r> dup arp-cache-entry-size - >r + arp-cache = + until + 2r> 2drop +; + +build-debug? [IF] +: arp-. + dup @ hex4 space \ age + dup 2+ dup @ swap d# 2 + dup @ swap d# 2 + @ ethaddr-pretty space + d# 8 + 2@ ip-pretty + cr +; + +: arp-dump + ['] arp-. arp-foreach +; +[THEN] + +: arp-del h# ff swap ! ; +: arp-reset ['] arp-del arp-foreach ; +: used? @ h# ff <> ; +: arp-age-1 dup used? d# 1 and swap +! ; +: arp-age ['] arp-age-1 arp-foreach ; +: arp-cmp ( ptr0 ptr1 -- ptr) over @ over @ > ?: ; +: arp-oldest \ return the address of the oldest ARP entry + arp-cache ['] arp-cmp arp-foreach ; + +\ ARP offsets +\ d# 28 sender ethaddr +\ d# 34 sender ip +\ d# 38 target ethaddr +\ d# 44 target ip + +d# 20 constant OFFSET_ARP_OPCODE +d# 22 constant OFFSET_ARP_SRC_ETH +d# 28 constant OFFSET_ARP_SRC_IP +d# 32 constant OFFSET_ARP_DST_ETH +d# 38 constant OFFSET_ARP_DST_IP + +: arp-is-response + OFFSET_ETH_TYPE packet@ h# 806 = + OFFSET_ARP_OPCODE packet@ d# 2 = + and +; + +\ write the current arp response into the cache, replacing the oldest entry +: !-- \ ( val ptr -- ptr-2 ) + tuck \ ptr val ptr + ! + 2- +; + +\ Current packet is an ARP response; write it to the given slot in the ARP cache, ageing all others + +: arp-cache-write \ ( ptr -- ) + arp-age \ because this new entry will have age d# 0 + d# 0 over ! \ age d# 0 + >r + + d# 3 OFFSET_ARP_SRC_ETH mac-inoffset mac@n + r@ d# 6 + !-- !-- !-- drop + d# 2 OFFSET_ARP_SRC_IP mac-inoffset mac@n + r> d# 8 + 2! + +; + +\ Comparison of IP +: arp-cmpip \ (ip01 ip23 ptr/0 ptr -- ip01 ip23 ptr) + dup used? if + dup d# 8 + 2@ d# 2 2pick d<> ?: + else + drop + then +; + +: arp-cache-find ( ip01 ip23 -- ip01 ip23 ptr ) +\ Find an IP. Zero if the IP was not found in the cache, ptr to entry otherwise + d# 0 ['] arp-cmpip arp-foreach ; + + +: arp-issue-whohas \ (ip01 ip23 -- ptr) + mac-pkt-begin + ethaddr-broadcast mac-pkt-3, + net-my-mac mac-pkt-3, + h# 806 \ frame type + d# 1 \ hard type + h# 800 \ prot type + mac-pkt-3, + h# 0604 \ hard size, prot size + d# 1 \ op (1=request) + mac-pkt-2, + net-my-mac mac-pkt-3, + net-my-ip mac-pkt-2, + ethaddr-broadcast mac-pkt-3, + mac-pkt-2, + mac-pkt-complete drop + mac-send +; + +\ Look up ethaddr for given IP. +\ If found, return pointer to the 6-byte ethaddr +\ If not found, issue an ARP request and return d# 0. + +: arp-lookup \ ( ip01 ip23 -- ptr) + 2dup + ip-router 2@ dxor ip-subnetmask 2@ dand + d0<> + if + 2drop + ip-router 2@ + then + arp-cache-find \ ip01 ip23 ptr + dup 0= if + -rot \ d# 0 ip01 ip23 + arp-issue-whohas \ d# 0 + else + nip nip 2+ \ ptr + then +; + +\ If the current packet is an ARP request for our IP, answer it +: arp-responder + \ is destination ff:ff:ff:ff:ff:ff or my mac + d# 3 OFFSET_ETH_DST mac-inoffset mac@n + and and invert 0= + + net-my-mac \ a b c + d# 2 OFFSET_ETH_DST 2+ mac-inoffset mac@n + d= swap \ F a + OFFSET_ETH_DST packet@ = and + + or + OFFSET_ETH_TYPE packet@ h# 806 = and + \ is target IP mine? + d# 2 OFFSET_ARP_DST_IP mac-inoffset mac@n net-my-ip d= and + if + mac-pkt-begin + + d# 3 OFFSET_ARP_SRC_ETH mac-pkt-src + net-my-mac mac-pkt-3, + h# 806 \ frame type + d# 1 \ hard type + h# 800 \ prot type + mac-pkt-3, + h# 0604 \ hard size, prot size + d# 2 \ op (2=reply) + mac-pkt-2, + net-my-mac mac-pkt-3, + net-my-ip mac-pkt-2, + d# 3 OFFSET_ARP_SRC_ETH mac-pkt-src + d# 2 OFFSET_ARP_SRC_IP mac-pkt-src + + mac-pkt-complete drop + mac-send + then +; + +: arp-announce + mac-pkt-begin + + ethaddr-broadcast mac-pkt-3, + net-my-mac mac-pkt-3, + h# 806 \ frame type + d# 1 \ hard type + h# 800 \ prot type + mac-pkt-3, + h# 0604 \ hard size, prot size + d# 2 \ op (2=reply) + mac-pkt-2, + net-my-mac mac-pkt-3, + net-my-ip mac-pkt-2, + ethaddr-broadcast mac-pkt-3, + net-my-ip mac-pkt-2, + + mac-pkt-complete drop + mac-send + +; + +: arp-handler + arp-responder + arp-is-response + if + d# 2 OFFSET_ARP_SRC_IP mac-inoffset mac@n + arp-cache-find nip nip + dup 0= if + drop arp-oldest + then + arp-cache-write + then +; + +]module diff --git a/docs/j1demo/firmware/basewords.fs b/docs/j1demo/firmware/basewords.fs new file mode 100644 index 0000000..e529f66 --- /dev/null +++ b/docs/j1demo/firmware/basewords.fs @@ -0,0 +1,60 @@ +( Base words implemented in assembler JCB 13:10 08/24/10) + +meta +: noop T alu ; +: + T+N d-1 alu ; +: xor T^N d-1 alu ; +: and T&N d-1 alu ; +: or T|N d-1 alu ; +: invert ~T alu ; +: = N==T d-1 alu ; +: < NN 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 ; +: 1- T-1 alu ; +: 2r> rT T->N r-1 d+1 alu + rT T->N r-1 d+1 alu + N T->N alu ; +: 2>r N T->N alu + N T->R r+1 d-1 alu + N T->R r+1 d-1 alu ; +: 2r@ rT T->N r-1 d+1 alu + rT T->N r-1 d+1 alu + N T->N d+1 alu + N T->N d+1 alu + N T->R r+1 d-1 alu + N T->R r+1 d-1 alu + N T->N alu ; +: unloop + T r-1 alu + T r-1 alu ; +: exit return ; + +\ Elided words +: dup@ [T] T->N d+1 alu ; +: dup>r T T->R r+1 alu ; +: 2dupxor T^N T->N d+1 alu ; +: 2dup= N==T T->N d+1 alu ; +: !nip T N->[T] d-1 alu ; +: 2dup! T N->[T] alu ; + +\ Words used to implement pick +: up1 T d+1 alu ; +: down1 T d-1 alu ; +: copy N alu ; + +: module[ there [char] " parse preserve ; +: ]module s" Compiled " type count type space there swap - . cr ; diff --git a/docs/j1demo/firmware/clock.fs b/docs/j1demo/firmware/clock.fs new file mode 100644 index 0000000..4bb35bb --- /dev/null +++ b/docs/j1demo/firmware/clock.fs @@ -0,0 +1,90 @@ +( Clock JCB 10:54 11/17/10) + +variable seconds +variable minutes +variable hours +variable days +variable months +variable years +variable weekday + +: show2 ( a -- ) @ s>d <# # # #> type ; + +: setdate ( ud -- ) + [ -8 3600 * ] literal s>d d+ + d# 1 d# 60 m*/mod seconds ! + d# 1 d# 60 m*/mod minutes ! + d# 1 d# 24 m*/mod hours ! + d# 59. d- \ Days since Mar 1 1900 + 2dup d# 1 d# 7 m*/mod weekday ! 2drop + d# 365 um/mod ( days years ) + dup d# 1900 + years ! + d# 4 / 1- - \ subtract leaps ( daynum 0-365 ) + dup d# 5 * d# 308 + d# 153 / d# 2 - months ! + months @ d# 4 + d# 153 d# 5 */ - d# 122 + days ! + + home + 'emit @ >r + ['] vga-bigemit 'emit ! + + s" ThuFriSatSunMonTueWed" drop + weekday @ d# 3 * + d# 3 type cr + s" MarAprMayJunJulAugSepOctNovDecJanFeb" drop + months @ d# 3 * + d# 3 type + space days @ d# 0 .r cr + years @ . cr + + true if + hours show2 + minutes show2 + seconds show2 + home + then + + r> 'emit ! +; + +: setdelay ( ud -- ) + 'emit @ >r + ['] vga-emit 'emit ! + d# 32 d# 0 vga-at-xy + s" ntp " type <# # # # [char] . hold #s #> type + s" ms " type + r> 'emit ! +; + +include ntp.fs + +2variable ntp-alarm + +: clock-main + vga-page + d# 1000000. ntp-alarm setalarm + begin + begin + mac-fullness + while + arp-handler + OFFSET_ETH_TYPE packet@ h# 800 = + if + d# 2 OFFSET_IP_DSTIP mac-inoffset mac@n net-my-ip d= + if + icmp-handler + then + loader-handler + ntp-handler + then + + depth if .s cr then + mac-consume + repeat + + ntp-alarm isalarm if + ntp-request + d# 1000000. ntp-alarm setalarm + then + + next? + until +; + diff --git a/docs/j1demo/firmware/crossj1.fs b/docs/j1demo/firmware/crossj1.fs new file mode 100644 index 0000000..d034611 --- /dev/null +++ b/docs/j1demo/firmware/crossj1.fs @@ -0,0 +1,527 @@ +( Cross-compiler for the J1 JCB 13:12 08/24/10) +decimal + +( outfile is fileid or zero JCB 12:30 11/27/10) + +0 value outfile + +: type ( c-addr u ) + outfile if + outfile write-file throw + else + type + then +; +: emit ( u ) + outfile if + pad c! pad 1 outfile write-file throw + else + emit + then +; +: cr ( u ) + outfile if + s" " outfile write-line throw + else + cr + then +; +: space bl emit ; +: spaces dup 0> if 0 do space loop then ; + +vocabulary j1assembler \ assembly storage and instructions +vocabulary metacompiler \ the cross-compiling words +vocabulary j1target \ actual target words + +: j1asm + only + metacompiler + also j1assembler definitions + also forth ; +: meta + only + j1target also + j1assembler also + metacompiler definitions also + forth ; +: target + only + metacompiler also + j1target definitions ; + +\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +j1asm + +: tcell 2 ; +: tcells tcell * ; +: tcell+ tcell + ; +65536 allocate throw constant tflash + +: h# + base @ >r 16 base ! + 0. bl parse >number throw 2drop postpone literal + r> base ! ; immediate + +variable tdp +: there tdp @ ; +: islegal dup h# 7fff u> abort" illegal address" ; +: tc! islegal tflash + c! ; +: tc@ islegal tflash + c@ ; +: t! islegal over h# ff and over tc! swap 8 rshift swap 1+ tc! ; +: t@ islegal dup tc@ swap 1+ tc@ 8 lshift or ; +: talign tdp @ 1 + h# fffe and tdp ! ; +: tc, there tc! 1 tdp +! ; +: t, there t! tcell tdp +! ; +: org tdp ! ; + +tflash 65536 255 fill + +65536 cells allocate throw constant references +: referenced cells references + 1 swap +! ; + +65536 cells allocate throw constant labels +labels 65536 cells 0 fill +: atlabel? ( -- f = are we at a label ) + labels there cells + @ 0<> +; + +: preserve ( c-addr1 u -- c-addr ) + dup 1+ allocate throw dup >r + 2dup c! 1+ + swap cmove r> ; + +: setlabel ( c-addr u -- ) + atlabel? if 2drop else preserve labels there cells + ! then ; + +j1asm + +: hex-literal ( u -- c-addr u ) s>d <# bl hold #s [char] $ hold #> ; + +: imm h# 8000 or t, ; + +: T h# 0000 ; +: N h# 0100 ; +: T+N h# 0200 ; +: T&N h# 0300 ; +: T|N h# 0400 ; +: T^N h# 0500 ; +: ~T h# 0600 ; +: N==T h# 0700 ; +: N>T h# 0900 ; +: T-1 h# 0a00 ; +: rT h# 0b00 ; +: [T] h# 0c00 ; +: N<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" -- ) ( run: -- eaddr n ) [char] " parse (sliteral) ; +: s' ( "ccc" -- ) ( run: -- eaddr n ) [char] ' parse (sliteral) ; + +: create + wordstr setlabel + create there , + does> @ do-number +; + +: allot tdp +! ; + +: variable wordstr setlabel create there , 0 t, + does> @ do-number ; +: 2variable wordstr setlabel create there , 0 t, 0 t, + does> @ do-number ; + +: createdoes + wordstr setlabel + create there , ' , + does> dup @ dup referenced (literal) cell+ @ execute +; + +: jumptable + wordstr setlabel + create there , + does> s" 2*" evaluate @ dup referenced (literal) s" + @" evaluate +; + +: | ' execute dup referenced t, ; + +: ', ' execute t, ; + +( DEFER JCB 11:18 11/12/10) + +: defer + wordstr setlabel + create there , 0 t, + does> @ tcompile? if do-number s" @ execute" evaluate then ; + +: is ( xt "name" -- ) + tcompile? if + ' >body @ do-number + s" ! " evaluate + else + ' execute t! + then ; + +: ' ' execute ; + +( VALUE JCB 13:06 11/12/10) + +: value + wordstr setlabel + create there , t, + does> @ do-number s" @" evaluate ; + +: to ( u "name" -- ) + ' >body @ do-number s" !" evaluate ; + +( ARRAY JCB 13:34 11/12/10) + +: array + wordstr setlabel + create there , 0 do 0 t, loop + does> s" cells" evaluate @ do-number s" +" evaluate ; +: 2array + wordstr setlabel + create there , 2* 0 do 0 t, loop + does> s" 2* cells" evaluate @ do-number s" +" evaluate ; + +( eforth's way of handling constants JCB 13:12 09/03/10) + +: sign>number + over c@ [char] - = if + 1- swap 1+ swap + >number + 2swap dnegate 2swap + else + >number + then +; + +: base>number ( caddr u base -- ) + base @ >r base ! + sign>number + r> base ! + dup 0= if + 2drop drop do-number + else + 1 = swap c@ [char] . = and if + drop dup do-number 16 rshift do-number + else + -1 abort" bad number" + then + then ; + +: d# 0. bl parse 10 base>number ; +: h# 0. bl parse 16 base>number ; + +( Conditionals JCB 13:12 09/03/10) +: if + there + 0 0branch +; + +: resolve + dup t@ there 2/ or swap t! +; + +: then + resolve + s" (then)" setlabel +; + +: else + there + 0 ubranch + swap resolve + s" (else)" setlabel +; + + +: begin s" (begin)" setlabel there ; +: again + ubranch +; +: until + 0branch +; +: while + there + 0 0branch +; +: repeat + swap ubranch + resolve + s" (repeat)" setlabel +; + +: 0do s" >r d# 0 >r" evaluate there s" (do)" setlabel ; +: do s" 2>r" evaluate there s" (do)" setlabel ; +: loop + s" looptest" evaluate 0branch +; +: i s" r@" evaluate ; + +77 constant sourceline# +s" none" 2constant sourcefilename + +: line# sourceline# (literal) ; +create currfilename 1 cells 80 + allot +variable currfilename# +: savestr ( c-addr u dst -- ) 2dup c! 1+ swap cmove ; +: getfilename sourcefilename currfilename count compare 0<> + if + sourcefilename 2dup currfilename savestr (sliteral--h) currfilename# ! + else + currfilename# @ dup 1+ (literal) tc@ (literal) + then ; +: snap line# getfilename s" (snap)" evaluate ; immediate +: assert 0= if line# sourcefilename (sliteral) s" (assert)" evaluate then ; immediate diff --git a/docs/j1demo/firmware/defines_tcpip.fs b/docs/j1demo/firmware/defines_tcpip.fs new file mode 100644 index 0000000..90d3990 --- /dev/null +++ b/docs/j1demo/firmware/defines_tcpip.fs @@ -0,0 +1,70 @@ +42 constant OFFSET_DHCP +70 constant OFFSET_DHCP_CHADDR +54 constant OFFSET_DHCP_CIADDR +150 constant OFFSET_DHCP_FILE +52 constant OFFSET_DHCP_FLAGS +66 constant OFFSET_DHCP_GIADDR +44 constant OFFSET_DHCP_HLEN +45 constant OFFSET_DHCP_HOPS +43 constant OFFSET_DHCP_HTYPE +42 constant OFFSET_DHCP_OP +278 constant OFFSET_DHCP_OPTIONS +50 constant OFFSET_DHCP_SECS +62 constant OFFSET_DHCP_SIADDR +548 constant OFFSET_DHCP_SIZE +86 constant OFFSET_DHCP_SNAME +46 constant OFFSET_DHCP_XID +58 constant OFFSET_DHCP_YIADDR +42 constant OFFSET_DNS +44 constant OFFSET_DNS_FLAGS +42 constant OFFSET_DNS_IDENTIFICATION +48 constant OFFSET_DNS_NOA +52 constant OFFSET_DNS_NOARR +46 constant OFFSET_DNS_NOQ +50 constant OFFSET_DNS_NORR +54 constant OFFSET_DNS_QUERY +13 constant OFFSET_DNS_SIZE +0 constant OFFSET_ETH +0 constant OFFSET_ETH_DST +14 constant OFFSET_ETH_SIZE +6 constant OFFSET_ETH_SRC +12 constant OFFSET_ETH_TYPE +34 constant OFFSET_ICMP +36 constant OFFSET_ICMP_CHKSUM +38 constant OFFSET_ICMP_IDENTIFIER +40 constant OFFSET_ICMP_SEQUENCE +8 constant OFFSET_ICMP_SIZE +34 constant OFFSET_ICMP_TYPECODE +14 constant OFFSET_IP +24 constant OFFSET_IP_CHKSUM +30 constant OFFSET_IP_DSTIP +18 constant OFFSET_IP_IPID +20 constant OFFSET_IP_IPOFFSET +16 constant OFFSET_IP_LENGTH +20 constant OFFSET_IP_SIZE +26 constant OFFSET_IP_SRCIP +22 constant OFFSET_IP_TTLPROTO +14 constant OFFSET_IP_VHLTOS +42 constant OFFSET_JUICE +68 constant OFFSET_JUICE_COMMAND +42 constant OFFSET_JUICE_HASH +62 constant OFFSET_JUICE_MAGIC +70 constant OFFSET_JUICE_PAYLOAD +66 constant OFFSET_JUICE_SEQ +30 constant OFFSET_JUICE_SIZE +34 constant OFFSET_TCP +42 constant OFFSET_TCP_ACK +50 constant OFFSET_TCP_CHECKSUM +36 constant OFFSET_TCP_DESTPORT +46 constant OFFSET_TCP_FLAGS +38 constant OFFSET_TCP_SEQNUM +20 constant OFFSET_TCP_SIZE +34 constant OFFSET_TCP_SOURCEPORT +52 constant OFFSET_TCP_URGENT +48 constant OFFSET_TCP_WINDOW +34 constant OFFSET_UDP +40 constant OFFSET_UDP_CHECKSUM +36 constant OFFSET_UDP_DESTPORT +38 constant OFFSET_UDP_LENGTH +8 constant OFFSET_UDP_SIZE +34 constant OFFSET_UDP_SOURCEPORT diff --git a/docs/j1demo/firmware/defines_tcpip.py b/docs/j1demo/firmware/defines_tcpip.py new file mode 100644 index 0000000..bbeb16b --- /dev/null +++ b/docs/j1demo/firmware/defines_tcpip.py @@ -0,0 +1,94 @@ +layout = [ + ('ETH', [ + ('DST', 6), + ('SRC', 6), + ('TYPE', 2), + [ + ('IP', [ + ('VHLTOS', 2), + ('LENGTH', 2), + ('IPID', 2), + ('IPOFFSET', 2), + ('TTLPROTO', 2), + ('CHKSUM', 2), + ('SRCIP', 4), + ('DSTIP', 4), + [ + ('ICMP', [ + ('TYPECODE', 2), + ('CHKSUM', 2), + ('IDENTIFIER', 2), + ('SEQUENCE', 2) ]), + ('TCP', [ + ('SOURCEPORT', 2), + ('DESTPORT', 2), + ('SEQNUM', 4), + ('ACK', 4), + ('FLAGS', 2), + ('WINDOW', 2), + ('CHECKSUM', 2), + ('URGENT', 2) ]), + ('UDP', [ + ('SOURCEPORT', 2), + ('DESTPORT', 2), + ('LENGTH', 2), + ('CHECKSUM', 2), + [ + ('DHCP', [ + ('OP', 1), + ('HTYPE', 1), + ('HLEN', 1), + ('HOPS', 1), + ('XID', 4), + ('SECS', 2), + ('FLAGS', 2), + ('CIADDR', 4), + ('YIADDR', 4), + ('SIADDR', 4), + ('GIADDR', 4), + ('CHADDR', 16), + ('SNAME', 64), + ('FILE', 128), + ('OPTIONS', 312) + ]), + ('DNS', [ + ('IDENTIFICATION', 2), + ('FLAGS', 2), + ('NOQ', 2), + ('NOA', 2), + ('NORR', 2), + ('NOARR', 2), + ('QUERY', 1) + ]), + ('JUICE', [ + ('HASH', 20), + ('MAGIC', 4), + ('SEQ', 2), + ('COMMAND', 2), + ('PAYLOAD', 2) + ]) + ] + ]) + ] + ]) + ]]) +] + +offsets = {} +def descend(offset, prefix, node): + (name, members) = node + offsets[prefix + name] = offset + start = offset + for m in members: + if isinstance(m, tuple): + (field, size) = m + # print prefix, name, field, offset + offsets["%s%s_%s" % (prefix, name, field)] = offset + offset += size + else: + for n in m: + descend(offset, prefix, n) + # print prefix, name, "SIZE", offset - start + offsets["%s%s_SIZE" % (prefix, name)] = offset - start + +descend(0, 'OFFSET_', layout[0]) diff --git a/docs/j1demo/firmware/defines_tcpip2.fs b/docs/j1demo/firmware/defines_tcpip2.fs new file mode 100644 index 0000000..4d38a13 --- /dev/null +++ b/docs/j1demo/firmware/defines_tcpip2.fs @@ -0,0 +1,150 @@ +0 constant ETH +14 constant ETH.ARP +32 constant ETH.ARP.DST_ETH +38 constant ETH.ARP.DST_IP +20 constant ETH.ARP.OPCODE +14 constant ETH.ARP.SOMETHING +22 constant ETH.ARP.SRC_ETH +28 constant ETH.ARP.SRC_IP +0 constant ETH.DST +14 constant ETH.IP +24 constant ETH.IP.CHKSUM +30 constant ETH.IP.DSTIP +34 constant ETH.IP.ICMP +36 constant ETH.IP.ICMP.CHKSUM +38 constant ETH.IP.ICMP.IDENTIFIER +40 constant ETH.IP.ICMP.SEQUENCE +34 constant ETH.IP.ICMP.TYPECODE +18 constant ETH.IP.IPID +20 constant ETH.IP.IPOFFSET +16 constant ETH.IP.LENGTH +26 constant ETH.IP.SRCIP +34 constant ETH.IP.TCP +42 constant ETH.IP.TCP.ACK +50 constant ETH.IP.TCP.CHECKSUM +36 constant ETH.IP.TCP.DESTPORT +46 constant ETH.IP.TCP.FLAGS +38 constant ETH.IP.TCP.SEQNUM +34 constant ETH.IP.TCP.SOURCEPORT +52 constant ETH.IP.TCP.URGENT +48 constant ETH.IP.TCP.WINDOW +22 constant ETH.IP.TTLPROTO +34 constant ETH.IP.UDP +40 constant ETH.IP.UDP.CHECKSUM +36 constant ETH.IP.UDP.DESTPORT +42 constant ETH.IP.UDP.DHCP +70 constant ETH.IP.UDP.DHCP.CHADDR +54 constant ETH.IP.UDP.DHCP.CIADDR +150 constant ETH.IP.UDP.DHCP.FILE +52 constant ETH.IP.UDP.DHCP.FLAGS +66 constant ETH.IP.UDP.DHCP.GIADDR +44 constant ETH.IP.UDP.DHCP.HLEN +45 constant ETH.IP.UDP.DHCP.HOPS +43 constant ETH.IP.UDP.DHCP.HTYPE +42 constant ETH.IP.UDP.DHCP.OP +278 constant ETH.IP.UDP.DHCP.OPTIONS +50 constant ETH.IP.UDP.DHCP.SECS +62 constant ETH.IP.UDP.DHCP.SIADDR +86 constant ETH.IP.UDP.DHCP.SNAME +46 constant ETH.IP.UDP.DHCP.XID +58 constant ETH.IP.UDP.DHCP.YIADDR +42 constant ETH.IP.UDP.DNS +44 constant ETH.IP.UDP.DNS.FLAGS +42 constant ETH.IP.UDP.DNS.IDENTIFICATION +48 constant ETH.IP.UDP.DNS.NOA +52 constant ETH.IP.UDP.DNS.NOARR +46 constant ETH.IP.UDP.DNS.NOQ +50 constant ETH.IP.UDP.DNS.NORR +54 constant ETH.IP.UDP.DNS.QUERY +38 constant ETH.IP.UDP.LENGTH +42 constant ETH.IP.UDP.LOADER +46 constant ETH.IP.UDP.LOADER.FLASHREAD +46 constant ETH.IP.UDP.LOADER.FLASHREAD.ADDR +46 constant ETH.IP.UDP.LOADER.FLASHWRITE +46 constant ETH.IP.UDP.LOADER.FLASHWRITE.ADDR +50 constant ETH.IP.UDP.LOADER.FLASHWRITE.DATA +44 constant ETH.IP.UDP.LOADER.OPCODE +46 constant ETH.IP.UDP.LOADER.RAMREAD +46 constant ETH.IP.UDP.LOADER.RAMREAD.ADDR +46 constant ETH.IP.UDP.LOADER.RAMWRITE +46 constant ETH.IP.UDP.LOADER.RAMWRITE.ADDR +48 constant ETH.IP.UDP.LOADER.RAMWRITE.DATA +42 constant ETH.IP.UDP.LOADER.SEQNO +42 constant ETH.IP.UDP.NTP +42 constant ETH.IP.UDP.NTP.FLAGS +66 constant ETH.IP.UDP.NTP.ORIGINATE +74 constant ETH.IP.UDP.NTP.RECEIVE +58 constant ETH.IP.UDP.NTP.REFERENCE +54 constant ETH.IP.UDP.NTP.REFID +46 constant ETH.IP.UDP.NTP.ROOTDELAY +50 constant ETH.IP.UDP.NTP.ROOTDISPERSION +82 constant ETH.IP.UDP.NTP.TRANSMIT +34 constant ETH.IP.UDP.SOURCEPORT +42 constant ETH.IP.UDP.TFTP +44 constant ETH.IP.UDP.TFTP.ACK +44 constant ETH.IP.UDP.TFTP.ACK.BLOCK +44 constant ETH.IP.UDP.TFTP.DATA +44 constant ETH.IP.UDP.TFTP.DATA.BLOCK +46 constant ETH.IP.UDP.TFTP.DATA.DATA +44 constant ETH.IP.UDP.TFTP.ERROR +46 constant ETH.IP.UDP.TFTP.ERROR.MESSAGE +44 constant ETH.IP.UDP.TFTP.ERROR.NUMBER +42 constant ETH.IP.UDP.TFTP.OPCODE +44 constant ETH.IP.UDP.TFTP.RWRQ +44 constant ETH.IP.UDP.TFTP.RWRQ.FILENAME +42 constant ETH.IP.UDP.WGE +82 constant ETH.IP.UDP.WGE.CONFIGURE +90 constant ETH.IP.UDP.WGE.CONFIGURE.IP +82 constant ETH.IP.UDP.WGE.CONFIGURE.PRODUCT +86 constant ETH.IP.UDP.WGE.CONFIGURE.SERIAL +82 constant ETH.IP.UDP.WGE.DISCOVER +82 constant ETH.IP.UDP.WGE.DISCOVER.IP +82 constant ETH.IP.UDP.WGE.FLASHREAD +82 constant ETH.IP.UDP.WGE.FLASHREAD.ADDRESS +82 constant ETH.IP.UDP.WGE.FLASHWRITE +82 constant ETH.IP.UDP.WGE.FLASHWRITE.ADDRESS +86 constant ETH.IP.UDP.WGE.FLASHWRITE.DATA +50 constant ETH.IP.UDP.WGE.HRT +82 constant ETH.IP.UDP.WGE.IMAGERMODE +82 constant ETH.IP.UDP.WGE.IMAGERMODE.MODE +82 constant ETH.IP.UDP.WGE.IMAGERSETRES +82 constant ETH.IP.UDP.WGE.IMAGERSETRES.HORIZONTAL +84 constant ETH.IP.UDP.WGE.IMAGERSETRES.VERTICAL +42 constant ETH.IP.UDP.WGE.MAGIC +80 constant ETH.IP.UDP.WGE.PAD +66 constant ETH.IP.UDP.WGE.REPLYTO +74 constant ETH.IP.UDP.WGE.REPLYTO.IP +66 constant ETH.IP.UDP.WGE.REPLYTO.MAC +78 constant ETH.IP.UDP.WGE.REPLYTO.PORT +82 constant ETH.IP.UDP.WGE.SENSORREAD +82 constant ETH.IP.UDP.WGE.SENSORREAD.ADDRESS +82 constant ETH.IP.UDP.WGE.SENSORSELECT +83 constant ETH.IP.UDP.WGE.SENSORSELECT.ADDRESS +82 constant ETH.IP.UDP.WGE.SENSORSELECT.INDEX +82 constant ETH.IP.UDP.WGE.SENSORWRITE +82 constant ETH.IP.UDP.WGE.SENSORWRITE.ADDRESS +83 constant ETH.IP.UDP.WGE.SENSORWRITE.DATA +82 constant ETH.IP.UDP.WGE.SYSCONFIG +82 constant ETH.IP.UDP.WGE.SYSCONFIG.MAC +88 constant ETH.IP.UDP.WGE.SYSCONFIG.SERIAL +82 constant ETH.IP.UDP.WGE.TRIGCONTROL +82 constant ETH.IP.UDP.WGE.TRIGCONTROL.TRIGSTATE +46 constant ETH.IP.UDP.WGE.TYPE +82 constant ETH.IP.UDP.WGE.VIDSTART +90 constant ETH.IP.UDP.WGE.VIDSTART.IP +82 constant ETH.IP.UDP.WGE.VIDSTART.MAC +94 constant ETH.IP.UDP.WGE.VIDSTART.PORT +14 constant ETH.IP.VHLTOS +6 constant ETH.SRC +12 constant ETH.TYPE +1 constant IP_PROTO_ICMP +2 constant IP_PROTO_IGMP +6 constant IP_PROTO_TCP +17 constant IP_PROTO_UDP +2 constant NUM_TCPS +16 constant TCP_ACK +1 constant TCP_FIN +8 constant TCP_PSH +4 constant TCP_RST +2 constant TCP_SYN +32 constant TCP_URG diff --git a/docs/j1demo/firmware/defines_tcpip2.py b/docs/j1demo/firmware/defines_tcpip2.py new file mode 100644 index 0000000..1d9e556 --- /dev/null +++ b/docs/j1demo/firmware/defines_tcpip2.py @@ -0,0 +1,215 @@ +layout = [ + ('ETH', [ + ('DST', 6), + ('SRC', 6), + ('TYPE', 2), + [ + ('ARP', [ + ('SOMETHING', 6), + ('OPCODE', 2), + ('SRC_ETH', 6), + ('SRC_IP', 4), + ('DST_ETH', 6), + ('DST_IP', 4) ]), + ('IP', [ + ('VHLTOS', 2), + ('LENGTH', 2), + ('IPID', 2), + ('IPOFFSET', 2), + ('TTLPROTO', 2), + ('CHKSUM', 2), + ('SRCIP', 4), + ('DSTIP', 4), + [ + ('ICMP', [ + ('TYPECODE', 2), + ('CHKSUM', 2), + ('IDENTIFIER', 2), + ('SEQUENCE', 2) ]), + ('TCP', [ + ('SOURCEPORT', 2), + ('DESTPORT', 2), + ('SEQNUM', 4), + ('ACK', 4), + ('FLAGS', 2), + ('WINDOW', 2), + ('CHECKSUM', 2), + ('URGENT', 2) ]), + ('UDP', [ + ('SOURCEPORT', 2), + ('DESTPORT', 2), + ('LENGTH', 2), + ('CHECKSUM', 2), + [ + ('DHCP', [ + ('OP', 1), + ('HTYPE', 1), + ('HLEN', 1), + ('HOPS', 1), + ('XID', 4), + ('SECS', 2), + ('FLAGS', 2), + ('CIADDR', 4), + ('YIADDR', 4), + ('SIADDR', 4), + ('GIADDR', 4), + ('CHADDR', 16), + ('SNAME', 64), + ('FILE', 128), + ('OPTIONS', 312) + ]), + ('DNS', [ + ('IDENTIFICATION', 2), + ('FLAGS', 2), + ('NOQ', 2), + ('NOA', 2), + ('NORR', 2), + ('NOARR', 2), + ('QUERY', 1) + ]), + ('NTP', [ + ('FLAGS', 4), + ('ROOTDELAY', 4), + ('ROOTDISPERSION', 4), + ('REFID', 4), + ('REFERENCE', 8), + ('ORIGINATE', 8), + ('RECEIVE', 8), + ('TRANSMIT', 8), + ]), + ('TFTP', [ + ('OPCODE', 2), + [ + ('RWRQ', [ + ('FILENAME', 512) + ]), + ('DATA', [ + ('BLOCK', 2), + ('DATA', 512) + ]), + ('ACK', [ + ('BLOCK', 2), + ]), + ('ERROR', [ + ('NUMBER', 2), + ('MESSAGE', 512), + ]), + ] + ]), + ('LOADER', [ + ('SEQNO', 2), + ('OPCODE', 2), + [ + ('RAMREAD', [ + ('ADDR', 2) + ]), + ('RAMWRITE', [ + ('ADDR', 2), + ('DATA', 128) + ]), + ('FLASHREAD', [ + ('ADDR', 4) + ]), + ('FLASHWRITE', [ + ('ADDR', 4), + ('DATA', 128) + ]), + ] + ]), + ('WGE', [ + ('MAGIC', 4), + ('TYPE', 4), + ('HRT', 16), + ('REPLYTO', [ + ('MAC', 8), + ('IP', 4), + ('PORT', 2), + ]), + ('PAD', 2), + [ + ('DISCOVER', [ + ('IP', 4) + ]), + ('CONFIGURE', [ + ('PRODUCT', 4), + ('SERIAL', 4), + ('IP', 4) + ]), + ('FLASHREAD', [ + ('ADDRESS', 4) + ]), + ('FLASHWRITE', [ + ('ADDRESS', 4), + ('DATA', 264), + ]), + ('TRIGCONTROL', [ + ('TRIGSTATE', 4), + ]), + ('SENSORREAD', [ + ('ADDRESS', 1), + ]), + ('SENSORWRITE', [ + ('ADDRESS', 1), + ('DATA', 2), + ]), + ('SENSORSELECT', [ + ('INDEX', 1), + ('ADDRESS', 4), + ]), + ('IMAGERMODE', [ + ('MODE', 4), + ]), + ('IMAGERSETRES', [ + ('HORIZONTAL', 2), + ('VERTICAL', 2), + ]), + ('SYSCONFIG', [ + ('MAC', 6), + ('SERIAL', 4), + ]), + ('VIDSTART', [ + ('MAC', 8), + ('IP', 4), + ('PORT', 2), + ]), + ] + ]), + ] + ]) + ] + ]) + ]]) +] + +offsets = {} +def descend(offset, prefix, node): + start = offset + if isinstance(node, list): + for n in node: + descend(offset, prefix, n) + else: + (name, members) = node + offsets[".".join((prefix + [name]))] = offset + if isinstance(members, int): + offset += members + else: + for n in members: + offset = descend(offset, prefix + [name], n) + # offsets["%s%s_SIZE" % (prefix, name)] = offset - start + return offset + +descend(0, [], layout[0]) + +offsets['TCP_FIN'] = 1 +offsets['TCP_SYN'] = 2 +offsets['TCP_RST'] = 4 +offsets['TCP_PSH'] = 8 +offsets['TCP_ACK'] = 16 +offsets['TCP_URG'] = 32 + +offsets['IP_PROTO_ICMP'] = 1 +offsets['IP_PROTO_IGMP'] = 2 +offsets['IP_PROTO_TCP'] = 6 +offsets['IP_PROTO_UDP'] = 17 + +offsets['NUM_TCPS'] = 2 diff --git a/docs/j1demo/firmware/dhcp.fs b/docs/j1demo/firmware/dhcp.fs new file mode 100644 index 0000000..971e567 --- /dev/null +++ b/docs/j1demo/firmware/dhcp.fs @@ -0,0 +1,176 @@ +( DHCP: Dynamic Host Configuration Protocol JCB 13:13 08/24/10) +module[ dhcp" + +\ Since DHCP alarm is only used when there is no lease, it is +\ safe to use the ip-subnetmask for the same purpose. + +ip-subnetmask constant dhcp-alarm + +: dhcp-xid + ip-router 2@ +; + +: dhcp-xid! + ip-router 2! +; + +: dhcp-option \ ( ... n code -- ) + mac-pkt-c, + dup mac-pkt-c, + 0do + mac-pkt-c, + loop +; + +: dhcp-common \ ( messagetype -- ) + d# 67 d# 68 + d# 0 invert dup + d# 0 dup + d# 0 \ broadcast ethaddr + ( dst-port src-port dst-ip src-ip *ethaddr -- ) + udp-header + h# 0101 h# 0600 mac-pkt-2, + dhcp-xid mac-pkt-2, + d# 10 mac-pkt-,0 + net-my-mac mac-pkt-3, + d# 101 mac-pkt-,0 \ d# 5 + d# 96 zeroes + + h# 6382 h# 5363 + mac-pkt-2, + + \ DHCP option 53: DHCP Discover + \ messagetype + d# 1 d# 53 \ messagetype 1 53 + dhcp-option + + \ DHCP option 50: 192.168.1.100 requested + + \ DHCP option 55: Parameter Request List: + \ Request Subnet Mask (1), Router (3), + \ Domain Name Server (6) + d# 1 d# 3 d# 6 d# 3 d# 55 dhcp-option +; + +: dhcp-wrapup + \ Finish options + h# ff mac-pkt-c, + \ mac-wrptr @ d# 1 and + d# 1 if \ XXX + h# ff mac-pkt-c, + then + + udp-wrapup + mac-send +; + +\ memory layout is little-endian + +: macc@++ ( c-addr -- c-addr+1 c ) + dup 1+ swap macc@ ; + +: dhcp-field \ ( match -- ptr/0 ) + OFFSET_DHCP_OPTIONS d# 4 + mac-inoffset + \ match ptr + begin + macc@++ \ match ptr code + dup h# ff <> + while \ match ptr code + d# 2 pick = + if + nip \ ptr + exit + then \ match ptr + macc@++ + \ match ptr' + repeat + \ fail - return false + 2drop false +; + +: dhcp-yiaddr + d# 2 OFFSET_DHCP_YIADDR mac-inoffset mac@n +; + +: dhcp-field4 + dhcp-field d# 1 + + macc@++ swap macc@++ swap macc@++ swap macc@ + ( a b c d ) + swap d# 8 lshift or -rot + swap d# 8 lshift or + swap +; + +build-debug? [IF] +: .pad ( ip. c-addr u -- ) d# 14 typepad ip-pretty cr ; + +: dhcp-status + ip-addr 2@ s" IP" .pad + ip-router 2@ s" router" .pad + ip-subnetmask 2@ s" subnetmask" .pad +; +[ELSE] +: dhcp-status ; +[THEN] + +: lease-setalarm + d# 0 >r + begin + 2dup d# 63. d> + while + d2/ r> 1+ >r + repeat + r> + hex4 space hex8 cr +; + +: dhcp-wait-offer + h# 11 ip-isproto + OFFSET_UDP_SOURCEPORT packet@ d# 67 = and + OFFSET_UDP_DESTPORT packet@ d# 68 = and + d# 2 OFFSET_DHCP_XID mac-inoffset mac@n dhcp-xid d= and + if + snap + d# 53 dhcp-field ?dup + snap + if + d# 1 + macc@ + snap + dup d# 2 = + if + \ [char] % emit + d# 3 dhcp-common + + \ option 50: request IP + h# 3204 + dhcp-yiaddr + mac-pkt-3, + + \ Option 54: server + h# 3604 + d# 54 dhcp-field4 + mac-pkt-3, + + dhcp-wrapup + then + d# 5 = + if + \ clrwdt + \ [char] & emit + + dhcp-yiaddr ip-addr 2! + d# 1 dhcp-field4 ip-subnetmask 2! + \ For the router and DNS server, send out ARP requests right now. This + \ reduces start-up time. + d# 3 dhcp-field4 2dup ip-router 2! arp-lookup drop + d# 6 dhcp-field4 2dup ip-dns 2! arp-lookup drop + \ Option 51: lease time + s" expires in " type + d# 51 dhcp-field4 swap d. cr + then + then + snap + then +; + +: dhcp-discover d# 1 dhcp-common dhcp-wrapup ; + +]module diff --git a/docs/j1demo/firmware/dns.fs b/docs/j1demo/firmware/dns.fs new file mode 100644 index 0000000..96ec36c --- /dev/null +++ b/docs/j1demo/firmware/dns.fs @@ -0,0 +1,81 @@ +( DNS JCB 19:44 11/27/10) +module[ dns" + +: ip-dns@ ip-dns 2@ ; + +\ ( offset -- offset' ) advance pointer past DNS label +\ 0 means end +\ >h# c0 means ptr to end +\ N means word of N bytes + +: dns-skiplabel + begin + dup 1+ swap mac-inoffset macc@ \ offset+1 v + dup 0= if + drop exit + then + dup h# c0 >= if + drop 1+ exit + then + + + again +; + +\ Query DNS. xt is a word that appends domainname to packet. id is DNS +\ id field, used to route responses. + +: dns-query ( xt id -- ) + >r + \ dst-port src-port dst-ip src-ip *ethaddr + d# 53 d# 31947 + ip-dns@ + net-my-ip + ip-dns@ arp-lookup + udp-header + r> \ IDENTIFICATION + h# 0100 \ FLAGS + d# 1 \ NOQ + mac-pkt-3, + d# 3 mac-pkt-,0 + + execute + + d# 1 \ query type A + dup \ query class internet + mac-pkt-2, + udp-wrapup + + ip-dns@ arp-lookup if + mac-send + then +; + +: dns-handler ( srcport dstport -- 0 / ip. id 1 ) + d# 53 d# 31947 d= + OFFSET_DNS_FLAGS packet@ 0< and + OFFSET_DNS_NOA packet@ 0<> and + if + OFFSET_DNS_QUERY + dns-skiplabel + d# 4 + + dns-skiplabel + d# 10 + + mac-inoffset d# 2 swap mac@n + OFFSET_DNS_IDENTIFICATION packet@ + d# 1 + else + d# 0 + then +; + +: dns-appendname ( str -- ) + dup mac-pkt-c, + mac-pkt-s, +; + +: dns-append.com ( str -- ) + dns-appendname + s" com" dns-appendname + d# 0 mac-pkt-c, +; +]module diff --git a/docs/j1demo/firmware/doc.fs b/docs/j1demo/firmware/doc.fs new file mode 100644 index 0000000..8b3c07d --- /dev/null +++ b/docs/j1demo/firmware/doc.fs @@ -0,0 +1,20 @@ +( Documentation conventions JCB 14:37 10/26/10) + +meta + +: getword ( -- a u ) + begin + bl word count dup 0= + while + 2drop refill true <> abort" Failed to find word" + repeat +; + +: ================================================================ + begin + getword + nip 64 = + until +; + +target diff --git a/docs/j1demo/firmware/document.fs b/docs/j1demo/firmware/document.fs new file mode 100644 index 0000000..53c741c --- /dev/null +++ b/docs/j1demo/firmware/document.fs @@ -0,0 +1,3 @@ +\ For use with docforth.fs + +s" ans.fs" included diff --git a/docs/j1demo/firmware/encode.py b/docs/j1demo/firmware/encode.py new file mode 100644 index 0000000..54022d2 --- /dev/null +++ b/docs/j1demo/firmware/encode.py @@ -0,0 +1,28 @@ +import sys +import Image +from array import array + +def getch(im, x, y): + return tuple(tuple((int(0 != im.getpixel((x + j, y + i)))) for j in range(8)) for i in range(8)) + +def main(filename): + sm = Image.open(filename).convert("L") + im = Image.new("L", (512, 256)) + im.paste(sm, (0,0)) + charset = {} + picture = [] + for y in range(0, im.size[1], 8): + for x in range(0, im.size[0], 8): + glyph = getch(im, x, y) + if not glyph in charset: + charset[glyph] = 96 + len(charset) + picture.append(charset[glyph]) + open(filename + ".pic", "w").write(array('B', picture).tostring()) + cd = array('B', [0] * 8 * len(charset)) + for d,i in charset.items(): + i -= 96 + for y in range(8): + cd[8 * i + y] = sum([(d[y][x] << (7 - x)) for x in range(8)]) + open(filename + ".chr", "w").write(cd.tostring()) + +main(sys.argv[1]) diff --git a/docs/j1demo/firmware/eth-ax88796.fs b/docs/j1demo/firmware/eth-ax88796.fs new file mode 100644 index 0000000..0a630d6 --- /dev/null +++ b/docs/j1demo/firmware/eth-ax88796.fs @@ -0,0 +1,506 @@ +( Low-level MAC actions JCB 13:23 08/24/10) + +================================================================ + +Initialization: + mac-cold + +Packet reception and reading: + mac-fullness + mac-inoffset + mac@ + macc@ + mac@n + mac-consume + +Packet construction and transmission: + mac-pkt-begin + mac-pkt-, + mac-pkt-c, + mac-pkt-d, + mac-pkt-2, + mac-pkt-3, + mac-pkt-,0 + mac-pkt-s, + mac-pkt-src + packetout-off + mac! + macc! + mac-complete + mac-checksum + mac-send + +================================================================ + +( NE2K JCB 10:23 11/08/10) + +: ne2sel + false ether_cs_n ! ; +: ne2unsel + true ether_cs_n ! ; +: ne2a ( a -- ) + pb_a ! ; + +: ne2rc@ ( a -- u ) \ NE2 byte reg read + true ether_bhe_n ! + true ether_aen ! + ne2sel + ne2a + false pb_rd_n ! + \ pause144 + pb_d @ h# ff and + true pb_rd_n ! + \ false ether_aen ! + \ ne2unsel +; + +: ne2rc! ( u a -- ) + \ over hex2 s" -> " type dup hex2 cr + + true ether_bhe_n ! + + ne2sel + ne2a + pb_d ! + d# 0 ddir ! + false pb_wr_n ! + true pb_wr_n ! + \ ne2unsel + d# 1 ddir ! +; + +: ne2r! ( u a -- ) + over d# 8 rshift over 1+ ne2rc! ne2rc! ; + +: ne2r. \ dump registers + d# 16 0do + d# 1000 0do pause144 loop + i hex2 space + i ne2rc@ hex4 cr + loop +; + +h# 00 constant ne2-CR +h# 01 constant ne2-PSTART +h# 01 constant ne2-PAR0 +h# 03 constant ne2-PAR2 +h# 05 constant ne2-PAR4 +h# 01 constant ne2-CR9346 +h# 02 constant ne2-PSTOP +h# 03 constant ne2-BNRY +h# 04 constant ne2-TSR +h# 04 constant ne2-TPSR +h# 05 constant ne2-TBCR0 +h# 05 constant ne2-NCR +h# 06 constant ne2-CPR +h# 06 constant ne2-TBCR1 +h# 07 constant ne2-ISR +h# 07 constant ne2-CURR +h# 08 constant ne2-RSAR0 +h# 08 constant ne2-CRDA0 +h# 09 constant ne2-RSAR1 +h# 09 constant ne2-CRDA1 +h# 0A constant ne2-RBCR0 +h# 0B constant ne2-RBCR1 +h# 0C constant ne2-RSR +h# 0C constant ne2-RCR +h# 0D constant ne2-TCR +h# 0D constant ne2-CNTR0 +h# 0E constant ne2-DCR +h# 0E constant ne2-CNTR1 +h# 0F constant ne2-IMR +h# 0F constant ne2-CNTR2 +h# 10 constant ne2-RDMAPORT +h# 14 constant ne2-MIIEEP +h# 15 constant ne2-TR +h# 17 constant ne2-GPOC +h# 17 constant ne2-GPI +h# 1F constant ne2-RSTPORT + +: ne2-page0 h# 22 ne2-CR ne2rc! ; +: ne2-page1 h# 62 ne2-CR ne2rc! ; + +: ne2-clrisr \ clear the ISR + h# ff ne2-ISR ne2rc! ; + + +: ne2r.2 + s" Page 0" type cr + ne2-page0 + ne2r. + s" Page 1" type cr + ne2-page1 + ne2r. + ne2-page0 ; + +( The MII interface JCB 12:47 11/09/10) + +h# 08 constant MII_EEP_MDO +h# 04 constant MII_EEP_MDI +h# 01 constant MII_EEP_MDC + +: eep-on ( u ) ne2-MIIEEP ne2rc@ or ne2-MIIEEP ne2rc! ; +: eep-off ( u ) invert ne2-MIIEEP ne2rc@ and ne2-MIIEEP ne2rc! ; + +: miix ( u c -- u ) \ Send c bit data u + tuck + d# 16 swap - lshift + swap + 0do + MII_EEP_MDO over 0< if + eep-on + else + eep-off + then + MII_EEP_MDC eep-on \ clock up + 2* + ne2-MIIEEP ne2rc@ MII_EEP_MDI and if 1+ then + MII_EEP_MDC eep-off \ clock down + loop +; + +: phy@ ( a -- u ) + h# ffff d# 16 miix drop + h# ffff d# 16 miix drop + h# 0d0 d# 9 miix drop + d# 5 miix drop + h# 0 d# 1 miix drop + h# 0 d# 16 miix +; + +: phy! ( u a -- ) + h# ffff d# 16 miix drop + h# ffff d# 16 miix drop + h# 0b0 d# 9 miix drop + d# 5 miix drop + h# 2 d# 2 miix drop + d# 16 miix drop +; + +: phy. + d# 32 0do + i hex2 space i phy@ hex4 cr + loop + cr +; + +: phy-cold + \ h# b000 d# 0 phy! + h# 0800 d# 0 phy! + s" PHY power down for 2.5s" type cr + d# 2500000. sleepus + \ h# 1200 d# 0 phy! + h# 0000 d# 0 phy! + exit + sleep1 + sleep1 + sleep1 + sleep1 + sleep1 + sleep1 + + \ h# 6030 d# 30 phy! + + phy. sleep1 + cr + phy. +; + +: mac-cold ( ethaddr -- ) + + false RESET_TRIGGER ! + sleep1 + true RESET_TRIGGER ! + sleep1 + + true pb_rd_n ! + true pb_wr_n ! + true ether_cs_n ! + false ether_aen ! + true ether_bhe_n ! + d# 0 pb_a ! + d# 1 ddir ! + + \ d# 4 0do ne2-RSTPORT ne2rc@ ne2-RSTPORT ne2rc! sleep1 loop + + phy-cold + + \ Wait for TR RST_B to go low and GPI link up + s" TR GPI" type cr + begin + ne2-TR ne2rc@ hex2 d# 3 spaces + ne2-GPI ne2rc@ hex2 d# 3 spaces + sleep.1 + cr + ne2-TR ne2rc@ d# 2 and 0= + ne2-GPI ne2rc@ d# 1 and 0<> and + until + + \ Wait for TR RST_B to go low +\ begin +\ sleep1 +\ ne2-TR ne2rc@ dup hex2 cr +\ d# 2 and 0= +\ until + + true if + h# 21 ne2-CR ne2rc! \ Stop the NIC, abort DMA, page 0 + h# 00 ne2-DCR ne2rc! \ Selects byte-wide DMA transfers + h# 00 ne2-RBCR0 ne2rc! \ Load data byte count for remote DMA + h# 00 ne2-RBCR1 ne2rc! + h# 20 ne2-RCR ne2rc! \ Temporarily set receiver to monitor mode + h# 02 ne2-TCR ne2rc! \ Transmitter set to internal loopback mode + \ Initialize Receive Buffer Ring: Boundary Pointer + \ (BNDRY), Page Start (PSTART), and Page Stop + \ (PSTOP) + h# 46 ne2-PSTART ne2rc! + h# 46 ne2-BNRY ne2rc! + h# 80 ne2-PSTOP ne2rc! + h# ff ne2-ISR ne2rc! \ Clear Interrupt Status Register (ISR) by writing 0FFh to it. + h# 01 ne2-IMR ne2rc! \ Initialize interrupt mask + h# 61 ne2-CR ne2rc! \ Stop the NIC, abort DMA, page 1 + h# 12 d# 1 ne2rc! \ Set Physical Address + h# 34 d# 2 ne2rc! + h# 56 d# 3 ne2rc! + h# 77 d# 4 ne2rc! + h# 77 d# 5 ne2rc! + h# 77 d# 6 ne2rc! + d# 16 d# 8 do \ Set multicast address + h# 00 i ne2rc! + loop + + h# 47 ne2-CURR ne2rc! \ Initialize CURRent pointer + h# 22 ne2-CR ne2rc! \ Start the NIC, Abort DMA, page 0 + h# 10 ne2-GPOC ne2rc! \ Select media interface + s" GPI = " type ne2-GPI ne2rc@ hex2 cr + h# 00 ne2-TCR ne2rc! \ Transmitter full duplex + h# 04 ne2-RCR ne2rc! \ Enable receiver and set accept broadcast + else + h# 21 ne2-CR ne2rc! \ Stop the NIC, abort DMA, page 0 + sleep.1 + + h# 00 ne2-DCR ne2rc! \ Selects word-wide DMA transfers + h# 00 ne2-RBCR0 ne2rc! \ Load data byte count for remote DMA + h# 00 ne2-RBCR1 ne2rc! + + h# 20 ne2-RCR ne2rc! \ Temporarily set receiver to monitor mode + h# 02 ne2-TCR ne2rc! \ Transmitter set to internal loopback mode + + h# 40 ne2-TPSR ne2rc! \ Set Tx start page + \ Initialize Receive Buffer Ring: Boundary Pointer + \ (BNDRY), Page Start (PSTART), and Page Stop + \ (PSTOP) + h# 46 ne2-PSTART ne2rc! + h# 46 ne2-BNRY ne2rc! + h# 80 ne2-PSTOP ne2rc! + h# ff ne2-ISR ne2rc! \ Clear Interrupt Status Register (ISR) by writing 0FFh to it. + h# 01 ne2-IMR ne2rc! \ Initialize interrupt mask + + h# 61 ne2-CR ne2rc! \ Stop the NIC, abort DMA, page 1 + sleep.1 + h# 12 d# 1 ne2rc! \ Set Physical Address + h# 34 d# 2 ne2rc! + h# 56 d# 3 ne2rc! + h# 77 d# 4 ne2rc! + h# 77 d# 5 ne2rc! + h# 77 d# 6 ne2rc! + d# 16 d# 8 do \ Set multicast address + h# ff i ne2rc! + loop + + h# 47 ne2-CURR ne2rc! \ Initialize CURRent pointer + + h# 20 ne2-CR ne2rc! \ DMA abort, page 0 + + h# 10 ne2-GPOC ne2rc! \ Select media interface + s" GPI = " type ne2-GPI ne2rc@ hex2 cr + h# 1c ne2-RCR ne2rc! \ Enable receiver and set accept broadcast + h# 00 ne2-TCR ne2rc! \ Transmitter full duplex + + h# ff ne2-ISR ne2rc! \ Clear Interrupt Status Register (ISR) by writing 0FFh to it. + h# 22 ne2-CR ne2rc! \ Start the NIC, Abort DMA, page 0 + then +; + +: NicCompleteDma + h# 22 ne2-CR ne2rc! \ Complete remote DMA +; + +: maca ( a -- ) \ set DMA address a + dup d# 8 rshift ne2-RSAR1 ne2rc! ne2-RSAR0 ne2rc! ; +: mac1b \ set DMA transfer for 1 byte + h# 01 ne2-RBCR0 ne2rc! + h# 00 ne2-RBCR1 ne2rc! ; +: mac2b \ set DMA transfer for 2 bytes + h# 02 ne2-RBCR0 ne2rc! + h# 00 ne2-RBCR1 ne2rc! ; +: macc@ ( a -- u ) + maca mac1b + h# 0a ne2-CR ne2rc! \ running, DMA read + ne2-RDMAPORT ne2rc@ + NicCompleteDma ; +: macc! ( u a -- ) + maca mac1b + h# 12 ne2-CR ne2rc! \ running, DMA write + ne2-RDMAPORT ne2rc! ; +: mac@ ( a -- u ) + maca mac2b + h# 0a ne2-CR ne2rc! \ running, DMA read + ne2-RDMAPORT ne2rc@ d# 8 lshift ne2-RDMAPORT ne2rc@ or + NicCompleteDma ; +: mac! ( u a -- ) + maca mac2b + h# 12 ne2-CR ne2rc! \ running, DMA write + dup d# 8 rshift ne2-RDMAPORT ne2rc! ne2-RDMAPORT ne2rc! ; + +: mac-dump ( a u -- ) + bounds + begin + 2dup u> + while + dup h# f and 0= if + cr dup hex4 [char] : emit space + then + dup mac@ hex4 space + 2+ + repeat 2drop cr ; + +variable currpkt + +: mac-inoffset ( u -- u ) \ compute offset into current incoming packet + currpkt @ + + dup 0< if + h# 8000 - + h# 4600 + + then +; + +: mac@n ( n addr -- d0 .. dn ) + swap 0do dup mac@ swap 2+ loop drop ; + + +( words for constructing packet data JCB 07:01 08/20/10) +variable writer + +: mac-pkt-begin h# 4000 writer ! ; +: bump ( n -- ) writer +! ; +: mac-pkt-c, ( n -- ) writer @ macc! d# 1 bump ; +: mac-pkt-, ( n -- ) writer @ mac! d# 2 bump ; +: mac-pkt-d, ( d -- ) mac-pkt-, mac-pkt-, ; +: mac-pkt-2, ( n0 n1 -- ) swap mac-pkt-, mac-pkt-, ; +: mac-pkt-3, rot mac-pkt-, mac-pkt-2, ; +: mac-pkt-,0 ( n -- ) 0do d# 0 mac-pkt-, loop ; +: mac-pkt-s, ( caddr u -- ) + 0do + dup c@ + mac-pkt-c, + 1+ + loop + drop +; + +: mac-pkt-src ( n offset -- ) \ copy n words from incoming+offset + swap 0do + dup mac-inoffset mac@ mac-pkt-, + 2+ + loop + drop +; + +: mac-pkt-complete ( -- length ) \ set up size + writer @ h# 4000 - + \ h# 4000 over mac-dump + dup ne2-TBCR0 ne2r! ; + +: mac-checksum ( addr nwords -- sum ) + d# 0 swap + 0do + over mac@ ( addr sum v ) + +1c + swap 2+ swap + loop + nip + invert +; + +: mac-snap + s" CR PSTART PSTOP BNRY TSR NCR CPR ISR CRDA0 CRDA1 - - RSR CNTR0 CNTR1 CNTR2" type cr + d# 16 0do + i ne2rc@ hex2 d# 5 spaces + loop +; + +: mac-fullness ( -- f ) + ether_irq @ if + ne2-BNRY ne2rc@ 1+ ne2-CPR ne2rc@ <> dup if + \ mac-snap + ne2-BNRY ne2rc@ 1+ d# 8 lshift d# 4 + currpkt ! + \ s" currpkt=" type currpkt @ hex4 space + \ currpkt @ d# 4 - macc@ hex2 + \ cr + \ currpkt @ d# 4 - d# 16 mac-dump + else + ne2-clrisr + then + else + false + then +; + +: mac-consume ( -- ) \ finished with current packet, move on + ne2-BNRY ne2rc@ 1+ d# 8 lshift 1+ macc@ \ next pkt + 1- ne2-BNRY ne2rc! +; + +variable ne2cold + +: mac-send + ne2cold @ 0= if + h# 21 ne2-CR ne2rc! + h# 22 ne2-CR ne2rc! + true ne2cold ! + then + + h# 40 ne2-TPSR ne2rc! + h# 26 ne2-CR ne2rc! \ START + ; + +: packetout-off \ compute offset in output packet + h# 4000 + ; + +: nicwork + + \ ISA mode + + \ begin + s" TR= " type h# 15 ne2rc@ hex2 space + s" ether_irq=" type ether_irq @ hex1 space + s" ISR=" type ne2-ISR ne2rc@ hex2 space + cr + \ again + + false if + h# 0000 ne2-RSAR0 ne2r! + cr + d# 16 0do + ne2-RDMAPORT ne2rc@ hex2 space + loop + cr + then + + s" CR PSTART PSTOP BNRY TSR NCR CPR ISR CRDA0 CRDA1 - - RSR CNTR0 CNTR1 CNTR2" type cr + begin + d# 16 0do + i ne2rc@ hex2 d# 5 spaces + loop + ether_irq @ hex1 + cr + sleep1 + ne2-CPR ne2rc@ h# 47 <> + until + + \ h# 4700 h# 100 mac-dump + \ cr + \ h# 0947 h# 4700 mac! + \ h# 4700 h# 100 mac-dump +; diff --git a/docs/j1demo/firmware/font8x8 b/docs/j1demo/firmware/font8x8 new file mode 100644 index 0000000..fbdaf14 Binary files /dev/null and b/docs/j1demo/firmware/font8x8 differ diff --git a/docs/j1demo/firmware/fsm-32.png b/docs/j1demo/firmware/fsm-32.png new file mode 100644 index 0000000..974f70c Binary files /dev/null and b/docs/j1demo/firmware/fsm-32.png differ diff --git a/docs/j1demo/firmware/genoffsets.py b/docs/j1demo/firmware/genoffsets.py new file mode 100644 index 0000000..2ed279e --- /dev/null +++ b/docs/j1demo/firmware/genoffsets.py @@ -0,0 +1,11 @@ +from defines_tcpip import offsets + +d = open("defines_tcpip.fs", "w") +for nm,o in sorted(offsets.items()): + print >>d, "%d constant %s" % (o, nm) + +import defines_tcpip2 + +d = open("defines_tcpip2.fs", "w") +for nm,o in sorted(defines_tcpip2.offsets.items()): + print >>d, "%d constant %s" % (o, nm) diff --git a/docs/j1demo/firmware/go b/docs/j1demo/firmware/go new file mode 100644 index 0000000..0adb2d0 --- /dev/null +++ b/docs/j1demo/firmware/go @@ -0,0 +1,16 @@ +# make doc +# python encode.py j1.png +# python mkblob.py ; exit +make j1.bin || exit + +# for ADDR in 0 80000 100000 180000 +# do +# (. /opt/Xilinx/11.1/ISE/settings32.sh ; promgen -u $ADDR j1_program.bit -p mcs -w -o j1_program_$ADDR.mcs ) +# done +# ./boot +# ping -c 4 192.168.0.99 && python twist.py + +python twist.py + +(. /opt/Xilinx/11.1/ISE/settings32.sh ; data2mem -bm ../synth/j1_bd.bmm -bd j1.mem tag jram -bt ../synth/j1.bit -o b j1_program.bit ) +scp j1_program.bit leonard:. diff --git a/docs/j1demo/firmware/hwdefs.fs b/docs/j1demo/firmware/hwdefs.fs new file mode 100644 index 0000000..4539d1a --- /dev/null +++ b/docs/j1demo/firmware/hwdefs.fs @@ -0,0 +1,57 @@ +h# 4100 constant flash_ddir +h# 4102 constant flash_ce_n +h# 4104 constant flash_oe_n +h# 4106 constant flash_we_n +h# 4108 constant flash_byte_n +h# 410a constant flash_rdy +h# 410c constant flash_rst_n +h# 410e constant flash_a +h# 4110 constant flash_a_hi +h# 4112 constant flash_d + +h# 4200 constant ps2_clk +h# 4202 constant ps2_dat +h# 4204 constant ps2_clk_dir +h# 4206 constant ps2_dat_dir +h# 4208 constant kbfifocount +h# 4210 constant kbfifo + +h# 4300 constant vga_scroll +h# 4302 constant vga_spritea +h# 4304 constant vga_spriteport +h# 4306 constant vga_line +h# 4308 constant vga_addsprites + +h# 4400 constant vga_spritex +h# 4402 constant vga_spritey + +h# 4420 constant vga_spritec +h# 4430 constant vga_spritep + +h# 4500 constant sw2_n +h# 4502 constant sw3_n + +h# 5000 constant RS232_TXD +h# 5001 constant RESET_TRIGGER +h# 5100 constant ether_cs_n +h# 5101 constant ether_aen +h# 5102 constant ether_bhe_n +h# 5103 constant pb_a +h# 5104 constant ddir +h# 5105 constant pb_d +h# 5106 constant pb_rd_n +h# 5107 constant pb_wr_n +h# 5108 constant ether_rdy +h# 5109 constant ether_irq +h# 510a constant pb_a_dir + +h# 6000 constant time +h# 6100 constant mult_a +h# 6102 constant mult_b +h# 6104 constant mult_p + +\ Pushbuttons + +h# 1 constant pb2 +h# 2 constant pb3 +h# 4 constant pb4 diff --git a/docs/j1demo/firmware/intelhex.py b/docs/j1demo/firmware/intelhex.py new file mode 100644 index 0000000..ecf8b28 --- /dev/null +++ b/docs/j1demo/firmware/intelhex.py @@ -0,0 +1,643 @@ +#!/usr/bin/python + +# Copyright (c) 2005-2007, Alexander Belchenko +# All rights reserved. +# +# Redistribution and use in source and binary forms, +# with or without modification, are permitted provided +# that the following conditions are met: +# +# * Redistributions of source code must retain +# the above copyright notice, this list of conditions +# and the following disclaimer. +# * Redistributions in binary form must reproduce +# the above copyright notice, this list of conditions +# and the following disclaimer in the documentation +# and/or other materials provided with the distribution. +# * Neither the name of the +# nor the names of its contributors may be used to endorse +# or promote products derived from this software +# without specific prior written permission. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, +# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY +# AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +# IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, +# OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +# OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED +# AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, +# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +'''Intel HEX file format reader and converter. + +This script also may be used as hex2bin convertor utility. + +@author Alexander Belchenko (bialix AT ukr net) +@version 0.8.6 +@date 2007/04/26 +''' + + +__docformat__ = "javadoc" + + +from array import array +from binascii import hexlify, unhexlify + + +class IntelHex: + ''' Intel HEX file reader. ''' + + def __init__(self, fname): + ''' Constructor. + @param fname file name of HEX file or file object. + ''' + #public members + self.Error = None + self.AddrOverlap = None + self.padding = 0x0FF + # Start Address + self.start_addr = None + + # private members + self._fname = fname + self._buf = {} + self._readed = False + self._eof = False + self._offset = 0 + + def readfile(self): + ''' Read file into internal buffer. + @return True if successful. + ''' + if self._readed: + return True + + if not hasattr(self._fname, "read"): + f = file(self._fname, "rU") + fclose = f.close + else: + f = self._fname + fclose = None + + self._offset = 0 + self._eof = False + + result = True + + for s in f: + if not self.decode_record(s): + result = False + break + + if self._eof: + break + + if fclose: + fclose() + + self._readed = result + return result + + def decode_record(self, s): + ''' Decode one record of HEX file. + @param s line with HEX record. + @return True if line decode OK, or this is not HEX line. + False if this is invalid HEX line or checksum error. + ''' + s = s.rstrip('\r\n') + if not s: + return True # empty line + + if s[0] == ':': + try: + bin = array('B', unhexlify(s[1:])) + except TypeError: + # this might be raised by unhexlify when odd hexascii digits + self.Error = "Odd hexascii digits" + return False + length = len(bin) + if length < 5: + self.Error = "Too short line" + return False + else: + return True # first char must be ':' + + record_length = bin[0] + + if length != (5 + record_length): + self.Error = "Invalid line length" + return False + + addr = bin[1]*256 + bin[2] + + record_type = bin[3] + if not (0 <= record_type <= 5): + self.Error = "Invalid type of record: %d" % record_type + return False + + crc = sum(bin) + crc &= 0x0FF + if crc != 0: + self.Error = "Invalid crc" + return False + + if record_type == 0: + # data record + addr += self._offset + for i in xrange(4, 4+record_length): + if not self._buf.get(addr, None) is None: + self.AddrOverlap = addr + self._buf[addr] = bin[i] + addr += 1 # FIXME: addr should be wrapped on 64K boundary + + elif record_type == 1: + # end of file record + if record_length != 0: + self.Error = "Bad End-of-File Record" + return False + self._eof = True + + elif record_type == 2: + # Extended 8086 Segment Record + if record_length != 2 or addr != 0: + self.Error = "Bad Extended 8086 Segment Record" + return False + self._offset = (bin[4]*256 + bin[5]) * 16 + + elif record_type == 4: + # Extended Linear Address Record + if record_length != 2 or addr != 0: + self.Error = "Bad Extended Linear Address Record" + return False + self._offset = (bin[4]*256 + bin[5]) * 65536 + + elif record_type == 3: + # Start Segment Address Record + if record_length != 4 or addr != 0: + self.Error = "Bad Start Segment Address Record" + return False + if self.start_addr: + self.Error = "Start Address Record appears twice" + return False + self.start_addr = {'CS': bin[4]*256 + bin[5], + 'IP': bin[6]*256 + bin[7], + } + + elif record_type == 5: + # Start Linear Address Record + if record_length != 4 or addr != 0: + self.Error = "Bad Start Linear Address Record" + return False + if self.start_addr: + self.Error = "Start Address Record appears twice" + return False + self.start_addr = {'EIP': (bin[4]*16777216 + + bin[5]*65536 + + bin[6]*256 + + bin[7]), + } + + return True + + def _get_start_end(self, start=None, end=None): + """Return default values for start and end if they are None + """ + if start is None: + start = min(self._buf.keys()) + if end is None: + end = max(self._buf.keys()) + if start > end: + start, end = end, start + return start, end + + def tobinarray(self, start=None, end=None, pad=None): + ''' Convert to binary form. + @param start start address of output bytes. + @param end end address of output bytes. + @param pad fill empty spaces with this value + (if None used self.padding). + @return array of unsigned char data. + ''' + if pad is None: + pad = self.padding + + bin = array('B') + + if self._buf == {}: + return bin + + start, end = self._get_start_end(start, end) + + for i in xrange(start, end+1): + bin.append(self._buf.get(i, pad)) + + return bin + + def tobinstr(self, start=None, end=None, pad=0xFF): + ''' Convert to binary form. + @param start start address of output bytes. + @param end end address of output bytes. + @param pad fill empty spaces with this value + (if None used self.padding). + @return string of binary data. + ''' + return self.tobinarray(start, end, pad).tostring() + + def tobinfile(self, fobj, start=None, end=None, pad=0xFF): + '''Convert to binary and write to file. + + @param fobj file name or file object for writing output bytes. + @param start start address of output bytes. + @param end end address of output bytes. + @param pad fill empty spaces with this value + (if None used self.padding). + ''' + if not hasattr(fobj, "write"): + fobj = file(fobj, "wb") + fclose = fobj.close + else: + fclose = None + + fobj.write(self.tobinstr(start, end, pad)) + + if fclose: + fclose() + + def minaddr(self): + ''' Get minimal address of HEX content. ''' + aa = self._buf.keys() + if aa == []: + return 0 + else: + return min(aa) + + def maxaddr(self): + ''' Get maximal address of HEX content. ''' + aa = self._buf.keys() + if aa == []: + return 0 + else: + return max(aa) + + def __getitem__(self, addr): + ''' Get byte from address. + @param addr address of byte. + @return byte if address exists in HEX file, or self.padding + if no data found. + ''' + return self._buf.get(addr, self.padding) + + def __setitem__(self, addr, byte): + self._buf[addr] = byte + + def writefile(self, f, write_start_addr=True): + """Write data to file f in HEX format. + + @param f filename or file-like object for writing + @param write_start_addr enable or disable writing start address + record to file (enabled by default). + If there is no start address nothing + will be written. + + @return True if successful. + """ + fwrite = getattr(f, "write", None) + if fwrite: + fobj = f + fclose = None + else: + fobj = file(f, 'w') + fwrite = fobj.write + fclose = fobj.close + + # start address record if any + if self.start_addr and write_start_addr: + keys = self.start_addr.keys() + keys.sort() + bin = array('B', '\0'*9) + if keys == ['CS','IP']: + # Start Segment Address Record + bin[0] = 4 # reclen + bin[1] = 0 # offset msb + bin[2] = 0 # offset lsb + bin[3] = 3 # rectyp + cs = self.start_addr['CS'] + bin[4] = (cs >> 8) & 0x0FF + bin[5] = cs & 0x0FF + ip = self.start_addr['IP'] + bin[6] = (ip >> 8) & 0x0FF + bin[7] = ip & 0x0FF + bin[8] = (-sum(bin)) & 0x0FF # chksum + fwrite(':') + fwrite(hexlify(bin.tostring()).upper()) + fwrite('\n') + elif keys == ['EIP']: + # Start Linear Address Record + bin[0] = 4 # reclen + bin[1] = 0 # offset msb + bin[2] = 0 # offset lsb + bin[3] = 5 # rectyp + eip = self.start_addr['EIP'] + bin[4] = (eip >> 24) & 0x0FF + bin[5] = (eip >> 16) & 0x0FF + bin[6] = (eip >> 8) & 0x0FF + bin[7] = eip & 0x0FF + bin[8] = (-sum(bin)) & 0x0FF # chksum + fwrite(':') + fwrite(hexlify(bin.tostring()).upper()) + fwrite('\n') + else: + self.Error = ('Invalid start address value: %r' + % self.start_addr) + return False + + # data + minaddr = IntelHex.minaddr(self) + maxaddr = IntelHex.maxaddr(self) + if maxaddr > 65535: + offset = (minaddr/65536)*65536 + else: + offset = None + + while True: + if offset != None: + # emit 32-bit offset record + high_ofs = offset / 65536 + offset_record = ":02000004%04X" % high_ofs + bytes = divmod(high_ofs, 256) + csum = 2 + 4 + bytes[0] + bytes[1] + csum = (-csum) & 0x0FF + offset_record += "%02X\n" % csum + + ofs = offset + if (ofs + 65536) > maxaddr: + rng = xrange(maxaddr - ofs + 1) + else: + rng = xrange(65536) + else: + ofs = 0 + offset_record = '' + rng = xrange(maxaddr + 1) + + csum = 0 + k = 0 + record = "" + for addr in rng: + byte = self._buf.get(ofs+addr, None) + if byte != None: + if k == 0: + # optionally offset record + fobj.write(offset_record) + offset_record = '' + # start data record + record += "%04X00" % addr + bytes = divmod(addr, 256) + csum = bytes[0] + bytes[1] + + k += 1 + # continue data in record + record += "%02X" % byte + csum += byte + + # check for length of record + if k < 16: + continue + + if k != 0: + # close record + csum += k + csum = (-csum) & 0x0FF + record += "%02X" % csum + fobj.write(":%02X%s\n" % (k, record)) + # cleanup + csum = 0 + k = 0 + record = "" + else: + if k != 0: + # close record + csum += k + csum = (-csum) & 0x0FF + record += "%02X" % csum + fobj.write(":%02X%s\n" % (k, record)) + + # advance offset + if offset is None: + break + + offset += 65536 + if offset > maxaddr: + break + + # end-of-file record + fobj.write(":00000001FF\n") + if fclose: + fclose() + + return True +#/IntelHex + + +class IntelHex16bit(IntelHex): + """Access to data as 16-bit words.""" + + def __init__(self, source): + """Construct class from HEX file + or from instance of ordinary IntelHex class. + + @param source file name of HEX file or file object + or instance of ordinary IntelHex class + """ + if isinstance(source, IntelHex): + # from ihex8 + self.Error = source.Error + self.AddrOverlap = source.AddrOverlap + self.padding = source.padding + + # private members + self._fname = source._fname + self._buf = source._buf + self._readed = source._readed + self._eof = source._eof + self._offset = source._offset + else: + IntelHex.__init__(self, source) + + if self.padding == 0x0FF: + self.padding = 0x0FFFF + + def __getitem__(self, addr16): + """Get 16-bit word from address. + Raise error if found only one byte from pair. + + @param addr16 address of word (addr8 = 2 * addr16). + @return word if bytes exists in HEX file, or self.padding + if no data found. + """ + addr1 = addr16 * 2 + addr2 = addr1 + 1 + byte1 = self._buf.get(addr1, None) + byte2 = self._buf.get(addr2, None) + + if byte1 != None and byte2 != None: + return byte1 | (byte2 << 8) # low endian + + if byte1 == None and byte2 == None: + return self.padding + + raise Exception, 'Bad access in 16-bit mode (not enough data)' + + def __setitem__(self, addr16, word): + addr_byte = addr16 * 2 + bytes = divmod(word, 256) + self._buf[addr_byte] = bytes[1] + self._buf[addr_byte+1] = bytes[0] + + def minaddr(self): + '''Get minimal address of HEX content in 16-bit mode.''' + aa = self._buf.keys() + if aa == []: + return 0 + else: + return min(aa)/2 + + def maxaddr(self): + '''Get maximal address of HEX content in 16-bit mode.''' + aa = self._buf.keys() + if aa == []: + return 0 + else: + return max(aa)/2 + +#/class IntelHex16bit + + +def hex2bin(fin, fout, start=None, end=None, size=None, pad=0xFF): + """Hex-to-Bin convertor engine. + @return 0 if all OK + + @param fin input hex file (filename or file-like object) + @param fout output bin file (filename or file-like object) + @param start start of address range (optional) + @param end end of address range (optional) + @param size size of resulting file (in bytes) (optional) + @param pad padding byte (optional) + """ + h = IntelHex(fin) + if not h.readfile(): + print "Bad HEX file" + return 1 + + # start, end, size + if size != None and size != 0: + if end == None: + if start == None: + start = h.minaddr() + end = start + size - 1 + else: + if (end+1) >= size: + start = end + 1 - size + else: + start = 0 + + try: + h.tobinfile(fout, start, end, pad) + except IOError: + print "Could not write to file: %s" % fout + return 1 + + return 0 +#/def hex2bin + + +if __name__ == '__main__': + import getopt + import os + import sys + + usage = '''Hex2Bin python converting utility. +Usage: + python intelhex.py [options] file.hex [out.bin] + +Arguments: + file.hex name of hex file to processing. + out.bin name of output file. + If omitted then output write to file.bin. + +Options: + -h, --help this help message. + -p, --pad=FF pad byte for empty spaces (ascii hex value). + -r, --range=START:END specify address range for writing output + (ascii hex value). + Range can be in form 'START:' or ':END'. + -l, --length=NNNN, + -s, --size=NNNN size of output (decimal value). +''' + + pad = 0xFF + start = None + end = None + size = None + + try: + opts, args = getopt.getopt(sys.argv[1:], "hp:r:l:s:", + ["help", "pad=", "range=", + "length=", "size="]) + + for o, a in opts: + if o in ("-h", "--help"): + print usage + sys.exit(0) + elif o in ("-p", "--pad"): + try: + pad = int(a, 16) & 0x0FF + except: + raise getopt.GetoptError, 'Bad pad value' + elif o in ("-r", "--range"): + try: + l = a.split(":") + if l[0] != '': + start = int(l[0], 16) + if l[1] != '': + end = int(l[1], 16) + except: + raise getopt.GetoptError, 'Bad range value(s)' + elif o in ("-l", "--lenght", "-s", "--size"): + try: + size = int(a, 10) + except: + raise getopt.GetoptError, 'Bad size value' + + if start != None and end != None and size != None: + raise getopt.GetoptError, 'Cannot specify START:END and SIZE simultaneously' + + if not args: + raise getopt.GetoptError, 'Hex file is not specified' + + if len(args) > 2: + raise getopt.GetoptError, 'Too many arguments' + + except getopt.GetoptError, msg: + print msg + print usage + sys.exit(2) + + fin = args[0] + if len(args) == 1: + import os.path + name, ext = os.path.splitext(fin) + fout = name + ".bin" + else: + fout = args[1] + + if not os.path.isfile(fin): + print "File not found" + sys.exit(1) + + sys.exit(hex2bin(fin, fout, start, end, size, pad)) diff --git a/docs/j1demo/firmware/invaders.fs b/docs/j1demo/firmware/invaders.fs new file mode 100644 index 0000000..f501a3e --- /dev/null +++ b/docs/j1demo/firmware/invaders.fs @@ -0,0 +1,362 @@ +( Space invaders JCB 10:43 11/18/10) + +: whereis ( t -- x y ) + >r + d# 384 r@ sin* d# 384 + + r@ d# 4 rshift d# 32 r> 2* sin* + +; + +56 constant nsprites + +nsprites array invx +nsprites array invy +nsprites array alive +nsprites array invnext +nsprites array anim + +: invload ( i -- ) \ load sprite i + \ s" sprite " type dup . s" at " type dup invx @ . dup invy @ . cr + dup invx @ swap + dup invy @ swap + dup anim @ swap + d# 7 and + tuck cells vga_spritep + ! + sprite! +; + +: inv-makedl ( -- ) + erasedl + nsprites 0do + \ invy -ve load sprite; +ve gives the dl offset + i alive @ if + i invy @ dup 0< if + drop i invload + else + dup d# 512 < if + \ dl[y] -> invnext[i] + \ i -> dl[y] + cells dl + dup + @ i invnext ! + i swap ! + else + drop + then + then + then + loop +; + +: inv-chase + d# 512 0do + begin vga-line@ i = until + \ s" line" type i . cr + i cells dl + @ + begin + dup d# 0 >= + while + dup invload + invnext @ + repeat + loop +; + +: born ( x y i ) \ sprite i born + dup alive on + tuck invy ! + invx ! +; + +: kill ( i -- ) \ kill sprite i + d# 512 over invy ! + alive off +; + +: isalien ( u -- f) + d# 6 and d# 6 <> ; + +: moveto ( i -- ) \ move invader i to current position + dup d# 6 and d# 6 <> + over alive @ and if + >r + frame @ r@ d# 7 and d# 8 * + whereis + r@ d# 3 rshift d# 40 * + + r@ invy ! + r> invx ! + else + drop + then +; + +: bomb ( u -- u ) d# 3 lshift d# 6 + ; +: shot ( u -- u ) d# 3 lshift d# 7 + ; + +8 array lowest + +: findlowest + d# 8 0do d# -1 i lowest ! loop + d# 48 0do + i alive @ if + i dup d# 7 and lowest ! + then + loop +; + +create bias 0 , 1 , 2 , 3 , 4 , 5 , 0 , 5 , +: rand6 + time @ d# 7 and cells bias + @ +; + +2variable bombalarm +variable nextbomb + +2variable shotalarm +variable nextshot + +variable playerx +variable lives +2variable score +variable dying + +32 constant girth + +: 1+mod6 ( a ) + dup @ dup d# 5 = if d# -5 else d# 1 then + swap ! ; + +: .status + 'emit @ >r ['] vga-emit 'emit ! + + home + s" LIVES " type lives @ . + d# 38 d# 0 vga-at-xy + s" SCORE " type score 2@ <# # # # # # # #> type + cr + + lives @ 0= if + ['] vga-bigemit 'emit ! + d# 8 d# 7 vga-at-xy s" GAME" type + d# 8 d# 17 vga-at-xy s" OVER" type + then + + r> 'emit ! +; + +: newlife + d# -1 lives +! .status + d# 0 dying ! + d# 100 playerx ! +; + +: parabolic ( dx dy i -- ) \ move sprite i in parabolic path + >r + swap r@ invx +! + dying @ d# 3 rshift + + r> invy +! +; + +: exploding + d# 3 d# -4 d# 48 parabolic + d# -3 d# -4 d# 49 parabolic + d# -4 d# -3 d# 50 parabolic + d# 4 d# -3 d# 51 parabolic + d# -5 d# -2 d# 52 parabolic + d# 5 d# -2 d# 53 parabolic + d# 1 d# -2 d# 55 parabolic +; + +: @xy ( i -- x y ) + dup invx @ swap invy @ ; + +: dist ( u1 u2 ) + invert + dup 0< xor ; + +: fall + d# 6 0do + i bomb + d# 4 over invy +! + @xy d# 470 dist d# 16 < swap + playerx @ dist girth < and + dying @ 0= and if + d# 1 dying ! + then + loop +; + +: trigger \ if shotalarm expired, launch new shot + shotalarm isalarm if + d# 400000. shotalarm setalarm + playerx @ d# 480 + nextshot @ shot born + nextshot 1+mod6 + then +; + +: collide ( x y -- u ) + d# 48 0do + i isalien i alive @ and if + over i invx @ dist d# 16 < + over i invy @ dist d# 16 < and if + 2drop i unloop exit + then + then + loop + 2drop + d# -1 +; + +: rise + d# 6 0do + i shot >r r@ alive @ if + d# -5 r@ invy +! + r@ invy @ d# -30 < if r@ kill then + r@ @xy collide dup 0< if + drop + else + kill r@ kill + d# 10. score 2@ d+ score 2! + .status + then + then + r> drop + loop +; + +: doplayer + lives @ if + dying @ 0= if + buttons >r + + girth 2/ playerx @ < + r@ pb2 and and if + d# -4 playerx +! + then + + playerx @ d# 800 girth 2/ - < + r@ pb3 and and if + d# 4 playerx +! + then + + r> pb4 and if + trigger + \ else trigger + then + + d# 6 0do + frame @ d# 3 lshift i d# 42 * + + girth swap sin* playerx @ + + d# 480 + i d# 48 + + dup anim on + born + loop + playerx @ d# 470 d# 55 born + else + exploding + d# 1 dying +! + dying @ d# 100 > if + newlife + then + then + then +; + +create cscheme + h# 400 , + h# 440 , + h# 040 , + h# 044 , + h# 004 , + h# 404 , + h# 340 , + h# 444 , + +: invaders-cold + vga-page + d# 16384 0do + h# 208000. 2/ i s>d d+ flash@ + i vga_spritea ! vga_spriteport ! + loop + + vga_addsprites on + rainbow + + \ vga_spritep d# 6 cells + on + + \ everything dead + nsprites 0do + i kill + loop + + \ all aliens alive + d# 48 0do + i isalien i alive ! + loop + + d# 500000. bombalarm setalarm + d# 0 nextbomb ! + d# 100000. shotalarm setalarm + d# 0 nextshot ! + d# 4 lives ! + d# 0. score 2! + + newlife + + time@ xor seed ! + d# 0 frame ! + d# 48 0do i moveto loop +; + +0 [IF] +: escape + vision isalarm next? or ; +: restart + vision isalarm sw2_n @ 0= or ; +[ELSE] +: escape + next? ; +: restart + sw2_n @ 0= ; +[THEN] + +: gameloop + invaders-cold + begin +depth if snap then + inv-makedl +depth if snap then + inv-chase +depth if snap then + frame @ 1+ frame ! + d# 48 0do i moveto loop + findlowest + bombalarm isalarm if + d# 800000. bombalarm setalarm + rand6 lowest @ dup 0< if + drop + else + dup invx @ swap invy @ + dup d# 460 > if d# 1 dying ! then + nextbomb @ bomb born + nextbomb 1+mod6 + then + then +depth if snap then + fall +depth if snap then + rise +depth if snap then + doplayer +depth if snap then + escape if exit then + again +; + +: invaders-main + invaders-cold + d# 9000000. vision setalarm + + gameloop + snap + + frame @ . s" frames" type cr +; + diff --git a/docs/j1demo/firmware/ip.fs b/docs/j1demo/firmware/ip.fs new file mode 100644 index 0000000..7c66137 --- /dev/null +++ b/docs/j1demo/firmware/ip.fs @@ -0,0 +1,124 @@ +( IP networking: headers and wrapup JCB 13:21 08/24/10) +module[ ip" + +: ip-datalength ( -- u ) \ length of current IP packet in words + ETH.IP.LENGTH packet@ + d# 20 - 2/ +; + +: ip-isproto ( u -- f ) \ true if packet PROTO is u + ETH.IP.TTLPROTO packet@ h# ff and = +; + +: ip-identification + ip-id-counter d# 1 over +! @ +; + +: @ethaddr ( eth-addr -- mac01 mac23 mac45 ) + ?dup + if + dup @ swap 2+ 2@ + else + ethaddr-broadcast + then +; + +: ip-header ( dst-ip src-ip eth-addr protocol -- ) + >r + mac-pkt-begin + + @ethaddr mac-pkt-3, + net-my-mac mac-pkt-3, + h# 800 mac-pkt-, + + h# 4500 + h# 0000 \ length + ip-identification + mac-pkt-3, + h# 4000 \ do not fragment + h# 4000 r> or \ TTL, protocol + d# 0 \ checksum + mac-pkt-3, + mac-pkt-2, \ src ip + mac-pkt-2, \ dst ip +; + +: ip-wrapup ( bytelen -- ) + \ write IP length + ETH.IP - + ETH.IP.LENGTH packetout-off mac! + + \ write IP checksum + ETH.IP packetout-off d# 10 mac-checksum + ETH.IP.CHKSUM packetout-off mac! +; + +: ip-packet-srcip + d# 2 ETH.IP.SRCIP mac-inoffset mac@n +; + +( ICMP return and originate JCB 13:22 08/24/10) + +\ Someone pings us, generate a return packet + +: icmp-handler + IP_PROTO_ICMP ip-isproto + ETH.IP.ICMP.TYPECODE packet@ h# 800 = + and if + ip-packet-srcip + 2dup arp-lookup + ?dup if + \ transmit ICMP reply + \ dstip *ethaddr + net-my-ip rot \ dstip srcip *ethaddr + d# 1 ip-header + + \ Now the ICMP header + d# 0 mac-pkt-, + + s" =====> ICMP seq " type + ETH.IP.ICMP.SEQUENCE mac-inoffset mac@ u. cr + + ETH.IP.ICMP.IDENTIFIER mac-inoffset + ip-datalength 2- ( offset n ) + tuck + mac-checksum mac-pkt-, + ETH.IP.ICMP.IDENTIFIER mac-pkt-src + + mac-pkt-complete + ip-wrapup + mac-send + else + 2drop + then + then +; + +: ping ( ip. -- ) \ originate + 2dup arp-lookup + ?dup if + \ transmit ICMP request + \ dstip *ethaddr + net-my-ip rot \ dstip srcip *ethaddr + d# 1 ip-header + + \ Now the ICMP header + h# 800 mac-pkt-, + + \ id is h# 550b, seq is lo word of time + h# 550b time@ drop + 2dup +1c h# 800 +1c + d# 28 begin swap d# 0 +1c swap 1- dup 0= until drop + invert mac-pkt-, \ checksum + mac-pkt-2, + d# 28 mac-pkt-,0 + + mac-pkt-complete + ip-wrapup + mac-send + else + 2drop + then +; + +]module diff --git a/docs/j1demo/firmware/ip0.fs b/docs/j1demo/firmware/ip0.fs new file mode 100644 index 0000000..1631d5f --- /dev/null +++ b/docs/j1demo/firmware/ip0.fs @@ -0,0 +1,70 @@ +( Variables for IP networking JCB 13:21 08/24/10) + +module[ ip0" +create ip-id-counter d# 2 allot +create ip-addr d# 4 allot +create ip-router d# 4 allot +create ip-subnetmask d# 4 allot +create ip-dns d# 4 allot +create icmp-alarm-ptr d# 1 allot + +: ethaddr-broadcast + h# ffff dup dup +; + +: net-my-ip + ip-addr 2@ +; + +: ethaddr-pretty-w + dup endian hex2 + [char] : emit + hex2 +; + +: ethaddr-pretty + swap rot + ethaddr-pretty-w [char] : emit + ethaddr-pretty-w [char] : emit + ethaddr-pretty-w +; + +: ip-pretty-byte + h# ff and + \ d# 0 u.r + hex2 +; + +: ip-pretty-2 + dup swab ip-pretty-byte [char] . emit ip-pretty-byte +; + +: ip-pretty + swap + ip-pretty-2 [char] . emit + ip-pretty-2 +; + +( IP address literals JCB 14:30 10/26/10) + +================================================================ + +It is neat to write IP address literals e.g. +ip# 192.168.0.1 + +================================================================ + +meta + +: octet# ( c -- u ) 0. rot parse >number throw 2drop ; + +: ip# + [char] . octet# 8 lshift + [char] . octet# or do-number + [char] . octet# 8 lshift + bl octet# or do-number +; + +target + +]module diff --git a/docs/j1demo/firmware/j1.png b/docs/j1demo/firmware/j1.png new file mode 100644 index 0000000..552f8d3 Binary files /dev/null and b/docs/j1demo/firmware/j1.png differ diff --git a/docs/j1demo/firmware/keycodes.fs b/docs/j1demo/firmware/keycodes.fs new file mode 100644 index 0000000..bd9b814 --- /dev/null +++ b/docs/j1demo/firmware/keycodes.fs @@ -0,0 +1,28 @@ +9 constant TAB +10 constant ENTER +27 constant ESC + +h# 80 constant KDEL + +h# 81 constant KF1 +h# 82 constant KF2 +h# 83 constant KF3 +h# 84 constant KF4 +h# 85 constant KF5 +h# 86 constant KF6 +h# 87 constant KF7 +h# 88 constant KF8 +h# 89 constant KF9 +h# 8a constant KF10 +h# 8b constant KF11 +h# 8c constant KF12 + +h# 90 constant KHOME +h# 91 constant KPGUP +h# 92 constant KPGDN +h# 93 constant KEND +h# 94 constant KLEFT +h# 95 constant KRIGHT +h# 96 constant KUP +h# 97 constant KDOWN +h# 98 constant KINS diff --git a/docs/j1demo/firmware/loader.fs b/docs/j1demo/firmware/loader.fs new file mode 100644 index 0000000..d4ae725 --- /dev/null +++ b/docs/j1demo/firmware/loader.fs @@ -0,0 +1,114 @@ +( LOADER PROTOCOL JCB 09:16 11/11/10) + +947 constant PORT + +: response0 ( -- ) + ETH.IP.UDP.SOURCEPORT packet@ + PORT + d# 2 ETH.IP.SRCIP mac-inoffset mac@n + net-my-ip + 2over arp-lookup + ( dst-port src-port dst-ip src-ip *ethaddr ) + udp-header + d# 0 mac-pkt-, + ETH.IP.UDP.LOADER.SEQNO packet@ mac-pkt-, +; + +: response1 + udp-wrapup mac-send +; + +: respond + response0 + response1 +; + +: ramread + response0 + ETH.IP.UDP.LOADER.RAMREAD.ADDR packet@ + d# 128 bounds begin + dup @ mac-pkt-, + cell+ + 2dup= + until + 2drop + response1 +; + +: ramwrite + ETH.IP.UDP.LOADER.RAMWRITE.ADDR packet@ + d# 64 0do + ETH.IP.UDP.LOADER.RAMWRITE.DATA i cells + packet@ + over ! + cell+ + loop + drop + respond +; + +: reboot + respond bootloader ; + +: flashread + response0 + ETH.IP.UDP.LOADER.FLASHREAD.ADDR packetd@ d2/ + flash-reset + d# 64 0do + 2dup flash@ + mac-pkt-, + d1+ + loop + 2drop + response1 +; + +: flasherase + respond flash-chiperase ; + +: flashdone + response0 + ETH.IP.UDP.LOADER.FLASHREAD.ADDR packetd@ d2/ + flash-erased mac-pkt-, + response1 +; + +: flashwrite + ETH.IP.UDP.LOADER.FLASHWRITE.ADDR packetd@ d2/ + d# 64 0do + 2dup + ETH.IP.UDP.LOADER.FLASHWRITE.DATA i cells + packet@ + -rot flash! + d1+ + loop + 2drop + respond +; + +: flashsectorerase + ETH.IP.UDP.LOADER.FLASHWRITE.ADDR packetd@ d2/ + flash-sectorerase + respond +; + +jumptable opcodes +( 0 ) | ramread +( 1 ) | ramwrite +( 2 ) | reboot +( 3 ) | flashread +( 4 ) | flasherase +( 5 ) | flashdone +( 6 ) | flashwrite +( 7 ) | flashsectorerase + +: loader-handler ( -- ) + IP_PROTO_UDP ip-isproto if + ETH.IP.UDP.DESTPORT packet@ PORT = + d# 2 ETH.IP.SRCIP mac-inoffset mac@n arp-lookup 0<> and if + udp-checksum? if + ETH.IP.UDP.LOADER.OPCODE packet@ + \ s" loader opcode=" type dup hex4 cr + opcodes execute + then + then + then +; diff --git a/docs/j1demo/firmware/main.fs b/docs/j1demo/firmware/main.fs new file mode 100644 index 0000000..16e4cf5 --- /dev/null +++ b/docs/j1demo/firmware/main.fs @@ -0,0 +1,799 @@ +( Main for WGE firmware JCB 13:24 08/24/10) + +\ warnings off +\ require tags.fs + +include crossj1.fs +meta + : TARGET? 1 ; + : build-debug? 1 ; + +include basewords.fs +target +include hwdefs.fs + +0 [IF] + h# 1f80 org + \ the RAM Bootloader copies 2000-3f80 to 0-1f80, then branches to zero + : bootloader + h# 1f80 h# 0 + begin + 2dupxor + while + dup h# 2000 + @ + over ! + d# 2 + + repeat + + begin dsp h# ff and while drop repeat + d# 0 >r + ; +[ELSE] + h# 3f80 org + \ the Flash Bootloader copies 0x190000 to 0-3f80, then branches to zero + : bootloader + h# c flash_a_hi ! + h# 0 begin + dup h# 8000 + flash_a ! + d# 0 flash_oe_n ! + flash_d @ + d# 1 flash_oe_n ! + over dup + ! + d# 1 + + dup h# 1fc0 = + until + + begin dsp h# ff and while drop repeat + d# 0 >r + ; +[THEN] + +4 org +module[ everything" +include nuc.fs + +include version.fs + +\ 33333333 / 115200 = 289, half cycle is 144 + +: pause144 + d# 0 d# 45 + begin + 1- + 2dup= + until + 2drop +; + +: serout ( u -- ) + h# 300 or \ 1 stop bits + 2* \ 0 start bit + \ Start bit + begin + dup RS232_TXD ! 2/ + pause144 + pause144 + dup 0= + until + drop + pause144 pause144 + pause144 pause144 +; + +: frac ( ud u -- d1 u1 ) \ d1+u1 is ud + >r 2dup d# 1 r@ m*/ 2swap 2over r> d# 1 m*/ d- drop ; +: .2 s>d <# # # #> type ; +: build. + decimal + builddate drop + [ -8 3600 * ] literal s>d d+ + d# 1 d# 60 m*/mod >r + d# 1 d# 60 m*/mod >r + d# 1 d# 24 m*/mod >r + 2drop + r> .2 [char] : emit + r> .2 [char] : emit + r> .2 ; + +: net-my-mac h# 1234 h# 5677 h# 7777 ; + +include doc.fs +include time.fs +include eth-ax88796.fs +include packet.fs +include ip0.fs +include defines_tcpip.fs +include defines_tcpip2.fs +include arp.fs +include ip.fs +include udp.fs +include dhcp.fs + +code in end-code +: on ( a -- ) d# 1 swap ! ; +code out end-code +: off ( a -- ) d# 0 swap ! ; + +: flash-reset + flash_rst_n off + flash_rst_n on +; + +: flash-cold + flash_ddir on + flash_ce_n off + flash_oe_n on + flash_we_n on + flash_byte_n on + flash_rdy on + flash-reset +; + +: flash-w ( u a -- ) + flash_a ! + flash_d ! + flash_ddir off + flash_we_n off + flash_we_n on + flash_ddir on +; + +: flash-r ( a -- u ) + flash_a ! + flash_oe_n off + flash_d @ + flash_oe_n on +; + +: flash-unlock ( -- ) + h# aa h# 555 flash-w + h# 55 h# 2aa flash-w +; + +: flash! ( u da. -- ) + flash-unlock + h# a0 h# 555 flash-w + flash_a 2+ ! ( u a ) + 2dup ( u a u a) + flash-w ( u a ) + begin + 2dup flash-r xor + h# 80 and 0= + until + 2drop + flash-reset +; + +: flash@ ( da. -- u ) + flash_a 2+ ! ( u a ) + flash-r +; + +: flash-chiperase + flash-unlock + h# 80 h# 555 flash-w + h# aa h# 555 flash-w + h# 55 h# 2aa flash-w + h# 10 h# 555 flash-w +; + +: flash-sectorerase ( da -- ) \ erase one sector + flash-unlock + h# 80 h# 555 flash-w + h# aa h# 555 flash-w + h# 55 h# 2aa flash-w + flash_a 2+ ! h# 30 swap flash-w +; + +: flash-erased ( a -- f ) + flash@ h# 80 and 0<> ; + +: flash-dump ( da u -- ) + 0do + 2dup flash@ hex4 space + d1+ + loop cr + 2drop +; + +: flashc@ + over d# 15 lshift flash_d ! + d2/ flash@ +; + +: flash-bytes + s" BYTES: " type + flash_byte_n off + h# 0. + d# 1024 0do + i d# 15 and 0= if + cr + 2dup hex8 space space + then + 2dup flashc@ hex2 space + d1+ + loop cr + 2drop + flash_byte_n on +; + +0 [IF] +: flash-demo + flash-unlock + h# 90 h# 555 flash-w + h# 00 flash-r hex4 cr + flash-reset + + false if + flash-unlock + h# a0 h# 555 flash-w + h# 0947 h# 5 flash-w + sleep1 + flash-reset + then + + \ h# dead d# 11. flash! + + h# 100 0do + i flash-r hex4 space + loop cr + cr cr + d# 0. h# 80 flash-dump + cr cr + + flash-bytes + + exit + flash-unlock + h# 80 h# 555 flash-w + h# aa h# 555 flash-w + h# 55 h# 2aa flash-w + h# 10 h# 555 flash-w + s" waiting for erase" type cr + begin + h# 0 flash-r dup hex4 cr + h# 80 and + until + + h# 100 0do + i flash-r hex4 space + loop cr +; +[THEN] + +include sprite.fs + +variable cursory \ ptr to start of line in video memory +variable cursorx \ offset to char + +64 constant width +50 constant wrapcolumn + +: vga-at-xy ( u1 u2 ) + cursory ! + cursorx ! +; + +: home d# 0 vga_scroll ! d# 0 d# 0 vga-at-xy ; + +: vga-line ( -- a ) \ address of current line + cursory @ vga_scroll @ + d# 31 and d# 6 lshift + h# 8000 or +; + +: vga-erase ( a u -- ) + bounds begin + 2dupxor + while + h# 00 over ! 1+ + repeat 2drop +; + +: vga-page + home vga-line d# 2048 vga-erase + hide +; + +: down1 + cursory @ d# 31 <> if + d# 1 cursory +! + else + false if + d# 1 vga_scroll +! + vga-line width vga-erase + else + home + then + then +; + +: vga-emit ( c -- ) + dup d# 13 = if + drop d# 0 cursorx ! + else + dup d# 10 = if + drop down1 + else + d# -32 + + vga-line cursorx @ + ! + d# 1 cursorx +! + cursorx @ wrapcolumn = if + d# 0 cursorx ! + down1 + then + then + then +; + +: flash>ram ( d. a -- ) \ copy 2K from flash d to a + >r d2/ r> + d# 1024 0do + >r + 2dup flash@ + r> ( d. u a ) + over swab over ! + 1+ + tuck ! + 1+ + >r d1+ r> + loop + drop 2drop +; + +: vga-cold + h# f800 h# f000 do + d# 0 i ! + loop + + vga-page + + \ pic: Copy 2048 bytes from 180000 to 8000 + \ chr: Copy 2048 bytes from 180800 to f000 + h# 180000. h# 8000 flash>ram + h# 180800. h# f000 flash>ram + + \ ['] vga-emit 'emit ! +; + +create glyph 8 allot +: wide1 ( c -- ) + swab + d# 8 0do + dup 0< + if d# 127 else sp then + \ if [char] * else [char] . then + vga-emit + 2* + loop drop +; + +: vga-bigemit ( c -- ) + dup d# 13 = if + drop d# 0 cursorx ! + else + dup d# 10 = if + drop d# 8 0do down1 loop + else + sp - d# 8 * s>d + h# 00180800. d+ d2/ + d# 4 0do + 2dup flash@ swab + i cells glyph + ! + d1+ + loop 2drop + + d# 7 0do + i glyph + c@ wide1 + d# -8 cursorx +! down1 + loop + d# 7 glyph + c@ wide1 + + d# -7 cursory +! + then + then +; + +( Demo utilities JCB 10:56 12/05/10) + +: statusline ( a u -- ) \ display string on the status line + d# 0 d# 31 2dup vga-at-xy + d# 50 spaces + vga-at-xy type +; + +( Game stuff JCB 15:20 11/15/10) + +variable seed +: random ( -- u ) + seed @ d# 23947 * d# 57711 xor dup seed ! ; + + +\ Each line is 20.8 us, so 1000 instructions + +include sincos.fs + +( Stars JCB 15:23 11/15/10) + +2variable vision +variable frame +128 constant nstars +create stars 1024 allot + +: star 2* cells stars + ; +: 15.* m* d2* nip ; + +\ >>> math.cos(math.pi / 180) * 32767 +\ 32762.009427189474 +\ >>> math.sin(math.pi / 180) * 32767 +\ 571.8630017304688 + +[ pi 128e0 f/ fcos 32767e0 f* f>d drop ] constant COSa +[ pi 128e0 f/ fsin 32767e0 f* f>d drop ] constant SINa + +: rotate ( i -- ) \ rotate star i + star dup 2@ ( x y ) + over SINa 15.* over COSa 15.* + >r + swap COSa 15.* swap SINa 15.* - r> + rot 2! +; + +: rotateall + d# 256 0do i rotate loop ; + +: scatterR + nstars 0do + random d# 0 i star 2! + rotateall + rotateall + rotateall + rotateall + loop +; + +: scatterSpiral + nstars 0do + i d# 3 and 1+ d# 8000 * + d# 0 i star 2! + rotateall + rotateall + rotateall + rotateall + loop +; + +: scatter + nstars 0do + \ d# 0 random + d# 0 i sin + i star 2! + i random d# 255 and 0do + dup rotate + loop drop + loop +; + +: /128 dup 0< h# fe00 and swap d# 7 rshift or ; +: tx /128 [ 400 ] literal + ; +: ty /128 [ 256 ] literal + ; + +: plot ( i s ) \ plot star i in sprite s + >r + dup star @ tx swap d# 2 lshift + r> sprite! +; + +( Display list JCB 16:10 11/15/10) + +create dl 1026 allot + +: erasedl + dl d# 1024 bounds begin + d# -1 over ! + cell+ 2dup= + until 2drop +; + +: makedl + erasedl + + nstars 0do + i d# 2 lshift + cells dl + + \ cell occupied, use one below + \ dup @ 0< invert if cell+ then + i swap ! + loop +; + +variable lastsp +: stars-chasebeam + hide + d# 0 lastsp ! + d# 512 0do + begin vga-line@ i = until + i cells dl + @ dup 0< if + drop + else + lastsp @ 1+ d# 7 and dup lastsp ! plot + then + i nstars < if i rotate then + loop +; + + + +: loadcolors + d# 8 0do + dup @ + i cells vga_spritec + ! + cell+ + loop + drop +; +create cpastels +h# 423 , +h# 243 , +h# 234 , +h# 444 , +h# 324 , +h# 432 , +h# 342 , +h# 244 , +: pastels cpastels loadcolors ; + +create crainbow +h# 400 , +h# 440 , +h# 040 , +h# 044 , +h# 004 , +h# 404 , +h# 444 , +h# 444 , +: rainbow crainbow loadcolors ; + +variable prev_sw3_n + +: next? ( -- f ) \ has user requested next screen + sw3_n @ prev_sw3_n fall? +; + +: loadsprites ( da -- ) + 2/ + d# 16384 0do + 2dup i s>d d+ flash@ + i vga_spritea ! vga_spriteport ! + loop + 2drop +; + +: stars-main + vga-page + d# 16384 0do + h# 204000. 2/ i s>d d+ flash@ + i vga_spritea ! vga_spriteport ! + loop + + vga_addsprites on + rainbow + + time@ xor seed ! + seed off + scatter + + d# 7000000. vision setalarm + d# 0 frame ! + begin + makedl + stars-chasebeam + \ d# 256 0do i i plot loop + \ rotateall + frame @ 1+ frame ! + next? + until + frame @ . s" frames" type cr +; + +: buttons ( -- u ) \ pb4 pb3 pb2 + pb_a_dir on + pb_a @ d# 7 xor + pb_a_dir off +; + +include loader.fs +include dns.fs + +: preip-handler + begin + mac-fullness + while + OFFSET_ETH_TYPE packet@ h# 800 = if + dhcp-wait-offer + then + mac-consume + repeat +; + +: haveip-handler + \ time@ begin ether_irq @ until time@ 2swap d- d. cr + \ begin ether_irq @ until + begin + mac-fullness + while + arp-handler + OFFSET_ETH_TYPE packet@ h# 800 = + if + d# 2 OFFSET_IP_DSTIP mac-inoffset mac@n net-my-ip d= + if + icmp-handler + then + loader-handler + then + depth if .s cr then + mac-consume + repeat +; + +include invaders.fs + +: uptime + time@ + d# 1 d# 1000 m*/ + d# 1 d# 1000 m*/ +; + +( IP address formatting JCB 14:50 10/26/10) + +: #ip1 h# ff and s>d #s 2drop ; +: #. [char] . hold ; +: #ip2 dup #ip1 #. d# 8 rshift #ip1 ; +: #ip ( ip -- c-addr u) dup #ip2 #. over #ip2 ; + +variable prev_sw2_n +: sw2? sw2_n @ prev_sw2_n fall? ; + +include ps2kb.fs + +: istab? + key? dup if key TAB = and then +; + +: welcome-main + vga-cold + home + s" F1 to set up network, TAB for next demo" statusline + + rainbow + h# 200000. loadsprites + 'emit @ >r + d# 6 d# 26 vga-at-xy s" Softcore Forth CPU" type + + d# 32 d# 6 vga-at-xy s" version " type version type + d# 32 d# 8 vga-at-xy s" built " type build. + + kb-cold + home + begin + kbfifo-proc + d# 32 d# 10 vga-at-xy net-my-ip <# #ip #> type space space + d# 32 d# 12 vga-at-xy s" uptime " type uptime d. + haveip-handler + + d# 8 0do + frame @ i d# 32 * + invert >r + d# 100 r@ sin* d# 600 + + d# 100 r> cos* d# 334 + + i sprite! + loop + + waitblank + d# 1 frame +! + next? + istab? or + until + r> 'emit ! +; + +include clock.fs + +: frob + flash_ce_n on + flash_ddir off + d# 32 0do + d# 1 i d# 7 and lshift + flash_d ! + d# 30000. sleepus + loop + flash_ddir on +; + +: main + decimal + ['] serout 'emit ! + \ sleep1 + + frob + + d# 60 0do cr loop + s" Welcome! Built " type build. cr + snap + + flash-cold + \ flash-demo + \ flash-bytes + vga-cold + ['] vga-emit 'emit ! + s" Waiting for Ethernet NIC" statusline + mac-cold + nicwork + h# decafbad. dhcp-xid! + d# 3000000. dhcp-alarm setalarm + false if + ip-addr dz + begin + net-my-ip d0= + while + dhcp-alarm isalarm if + dhcp-discover + s" DISCOVER" type cr + d# 3000000. dhcp-alarm setalarm + then + preip-handler + repeat + else + ip# 192.168.0.99 ip-addr 2! + ip# 255.255.255.0 ip-subnetmask 2! + ip# 192.168.0.1 ip-router 2! + \ ip# 192.168.2.201 ip-addr 2! + \ ip# 255.255.255.0 ip-subnetmask 2! + \ ip# 192.168.2.1 ip-router 2! + then + dhcp-status + arp-reset + + begin + welcome-main sleep.1 + clock-main sleep.1 + stars-main sleep.1 + invaders-main sleep.1 + s" looping" type cr + again + + begin + haveip-handler + again +; + + +]module + +0 org + +code 0jump + \ h# 3e00 ubranch + main ubranch + main ubranch +end-code + +meta + +hex + +: create-output-file w/o create-file throw to outfile ; + +\ .mem is a memory dump formatted for use with the Xilinx +\ data2mem tool. +s" j1.mem" create-output-file +:noname + s" @ 20000" type cr + 4000 0 do i t@ s>d <# # # # # #> type cr 2 +loop +; execute + +\ .bin is a big-endian binary memory dump +s" j1.bin" create-output-file +:noname 4000 0 do i t@ dup 8 rshift emit emit 2 +loop ; execute + +\ .lst file is a human-readable disassembly +s" j1.lst" create-output-file +d# 0 +h# 2000 disassemble-block diff --git a/docs/j1demo/firmware/mkblob.py b/docs/j1demo/firmware/mkblob.py new file mode 100644 index 0000000..6623f91 --- /dev/null +++ b/docs/j1demo/firmware/mkblob.py @@ -0,0 +1,14 @@ +import Image +import math + +im = Image.new("L", (32,32)) +radius = 16 +for i in range(32): + for j in range(32): + x = abs(i - 16) + y = abs(j - 16) + d = math.sqrt(x * x + y * y) + if d < radius: + t = 1.0 - (d / radius) + im.putpixel((i, j), int(255 * (t * t))) +im.save("blob.png") diff --git a/docs/j1demo/firmware/ntp.fs b/docs/j1demo/firmware/ntp.fs new file mode 100644 index 0000000..881296a --- /dev/null +++ b/docs/j1demo/firmware/ntp.fs @@ -0,0 +1,36 @@ +( NTP JCB 09:54 11/17/10) + +: ntp-server + \ h# 02830a00. + \ ip# 91.189.94.4 \ time.ubuntu + ip# 17.151.16.20 \ time.apple.com +; + +: ntp-request + d# 123 d# 9999 + ntp-server + net-my-ip + 2over arp-lookup + ( dst-port src-port dst-ip src-ip *ethaddr ) + udp-header + h# 2304 mac-pkt-, h# 04ec mac-pkt-, + d# 6 mac-pkt-,0 + + d# 4 mac-pkt-,0 \ originate + d# 4 mac-pkt-,0 \ reference + d# 4 mac-pkt-,0 \ receive + \ d# 4 mac-pkt-,0 \ transmit + time@ mac-pkt-d, d# 2 mac-pkt-,0 + udp-wrapup mac-send +; + +: ntp-handler + IP_PROTO_UDP ip-isproto + ETH.IP.UDP.SOURCEPORT packet@ d# 123 = and + ETH.IP.UDP.DESTPORT packet@ d# 9999 = and + if + ETH.IP.UDP.NTP.TRANSMIT packetd@ setdate + time@ ETH.IP.UDP.NTP.ORIGINATE packetd@ d- setdelay + then +; + diff --git a/docs/j1demo/firmware/nuc.fs b/docs/j1demo/firmware/nuc.fs new file mode 100644 index 0000000..deadcc7 --- /dev/null +++ b/docs/j1demo/firmware/nuc.fs @@ -0,0 +1,546 @@ +( Nucleus: ANS Forth core and ext words JCB 13:11 08/24/10) + +module[ nuc" + +32 constant sp +0 constant false ( 6.2.1485 ) +: depth dsp h# ff and ; +: true ( 6.2.2298 ) d# -1 ; +: 1+ d# 1 + ; +: rot >r swap r> swap ; +: -rot swap >r swap r> ; +: 0= d# 0 = ; +: tuck swap over ; +: 2drop drop drop ; +: ?dup dup if dup then ; + +: split ( a m -- a&m a&~m ) + over \ a m a + and \ a a&m + tuck \ a&m a a&m + xor \ a&m a&~m +; + +: merge ( a b m -- m?b:a ) + >r \ a b + over xor \ a a^b + r> and \ a (a^b)&m + xor \ ((a^b)&m)^a +; + +: c@ dup @ swap d# 1 and if d# 8 rshift else d# 255 and then ; +: c! ( u c-addr ) + swap h# ff and dup d# 8 lshift or swap + tuck dup @ swap ( c-addr u v c-addr ) + d# 1 and d# 0 = h# ff xor + merge swap ! +; +: c!be d# 1 xor c! ; + +: looptest ( -- FIN ) + r> ( xt ) + r> ( xt i ) + 1+ + r@ over = ( xt i FIN ) + dup if + nip r> drop + else + swap >r + then ( xt FIN ) + swap + >r +; + +\ Stack +: 2dup over over ; +: +! tuck @ + swap ! ; + +\ Comparisons +: <> = invert ; +: 0<> 0= invert ; +: 0< d# 0 < ; +: 0>= 0< invert ; +: 0> d# 0 ;fallthru +: > swap < ; +: >= < invert ; +: <= > invert ; +: u> swap u< ; + +\ Arithmetic +: negate invert 1+ ; +: - negate + ; +: abs dup 0< if negate then ; +: min 2dup < ;fallthru +: ?: ( xt xf f -- xt | xf) if drop else nip then ; +: max 2dup > ?: ; +code cells end-code +code addrcells end-code +: 2* d# 1 lshift ; +code cell+ end-code +code addrcell+ end-code +: 2+ d# 2 + ; +: 2- 1- 1- ; +: 2/ d# 1 rshift ; +: c+! tuck c@ + swap c! ; + +: count dup 1+ swap c@ ; +: /string dup >r - swap r> + swap ; +: aligned 1+ h# fffe and ; + +: sliteral + r> + count + 2dup + + + aligned +;fallthru +: execute >r ; + +: 15down down1 ;fallthru +: 14down down1 ;fallthru +: 13down down1 ;fallthru +: 12down down1 ;fallthru +: 11down down1 ;fallthru +: 10down down1 ;fallthru +: 9down down1 ;fallthru +: 8down down1 ;fallthru +: 7down down1 ;fallthru +: 6down down1 ;fallthru +: 5down down1 ;fallthru +: 4down down1 ;fallthru +: 3down down1 ;fallthru +: 2down down1 ;fallthru +: 1down down1 ;fallthru +: 0down copy ; + +: 15up up1 ;fallthru +: 14up up1 ;fallthru +: 13up up1 ;fallthru +: 12up up1 ;fallthru +: 11up up1 ;fallthru +: 10up up1 ;fallthru +: 9up up1 ;fallthru +: 8up up1 ;fallthru +: 7up up1 ;fallthru +: 6up up1 ;fallthru +: 5up up1 ;fallthru +: 4up up1 ;fallthru +: 3up up1 ;fallthru +: 2up up1 ;fallthru +: 1up up1 ;fallthru +: 0up ; + +code pickbody + copy return + 1down scall 1up ubranch + 2down scall 2up ubranch + 3down scall 3up ubranch + 4down scall 4up ubranch + 5down scall 5up ubranch + 6down scall 6up ubranch + 7down scall 7up ubranch + 8down scall 8up ubranch + 9down scall 9up ubranch + 10down scall 10up ubranch + 11down scall 11up ubranch + 12down scall 12up ubranch + 13down scall 13up ubranch + 14down scall 14up ubranch + 15down scall 15up ubranch +end-code + +: pick + dup 2* 2* ['] pickbody + execute ; + +: swapdown + ]asm + N T->N alu + T d-1 alu + asm[ +; +: swapdowns + swapdown swapdown swapdown swapdown + swapdown swapdown swapdown swapdown + swapdown swapdown swapdown swapdown + swapdown swapdown swapdown swapdown ;fallthru +: swapdown0 ; +: roll + 2* + ['] 0up over - >r + ['] swapdown0 swap - execute +; + +\ ======================================================================== +\ Double +\ ======================================================================== + +: d= ( a b c d -- f ) + >r \ a b c + rot xor \ b a^c + swap r> xor \ a^c b^d + or 0= +; + +: 2@ ( ptr -- lo hi ) + dup @ swap 2+ @ +; + +: 2! ( lo hi ptr -- ) + rot over \ hi ptr lo ptr + ! 2+ ! +; + +: 2over >r >r 2dup r> r> ;fallthru +: 2swap rot >r rot r> ; +: 2nip rot drop rot drop ; +: 2rot ( d1 d2 d3 -- d2 d3 d1 ) 2>r 2swap 2r> 2swap ; +: 2pick + 2* 1+ dup 1+ \ lo hi ... 2k+1 2k+2 + pick \ lo hi ... 2k+1 lo + swap \ lo hi ... lo 2k+1 + pick \ lo hi ... lo hi +; + + +: d+ ( augend . addend . -- sum . ) + rot + >r ( augend addend) + over + ( augend sum) + dup rot ( sum sum augend) + u< if ( sum) + r> 1+ + else + r> + then ( sum . ) +; + +: +h ( u1 u2 -- u1+u2/2**16 ) + over + ( a a+b ) + u> d# 1 and +; + +: +1c \ one's complement add, as in TCP checksum + 2dup +h + + +; + +: s>d dup 0< ; +: d1+ d# 1. d+ ; +: dnegate + invert swap invert swap + d1+ +; +: DABS ( d -- ud ) ( 8.6.1.1160 ) DUP 0< IF DNEGATE THEN ; + +: d- dnegate d+ ; + +\ Write zero to double +: dz d# 0 dup rot 2! ; + +: dxor \ ( a b c d -- e f ) + rot xor \ a c b^d + -rot xor \ b^d a^c + swap +; + +: dand rot and -rot and swap ; +: dor rot or -rot or swap ; + +: dinvert invert swap invert swap ; +: d< \ ( al ah bl bh -- flag ) + rot \ al bl bh ah + 2dup = + if + 2drop u< + else + 2nip > + then +; + +: d> 2swap d< ; +: d0<= d# 0. ;fallthru +: d<= d> invert ; +: d>= d< invert ; +: d0= or 0= ; +: d0< d# 0. d< ; +: d0<> d0= invert ; +: d<> d= invert ; +: d2* 2dup d+ ; +: d2/ dup d# 15 lshift >r 2/ swap 2/ r> or swap ; +: dmax 2over 2over d< if 2swap then 2drop ; + +: d1- d# -1. d+ ; + +: d+! ( v. addr -- ) + dup >r + 2@ + d+ + r> + 2! +; + +: move ( addr1 addr2 u -- ) + d# 0 do + over @ over ! + 2+ swap 2+ swap + loop + 2drop +; + +: cmove ( c-addr1 c-addr2 u -- ) + d# 0 do + over c@ over c! + 1+ swap 1+ swap + loop + 2drop +; + +: bounds ( a n -- a+n a ) OVER + SWAP ; +: fill ( c-addr u char -- ) ( 6.1.1540 ) + >R bounds + BEGIN 2dupxor + WHILE R@ OVER C! 1+ + REPEAT R> DROP 2DROP ; + +\ Math + +0 [IF] +create scratch d# 2 allot +: um* ( u1 u2 -- ud ) + scratch ! + d# 0. + d# 16 0do + 2dup d+ + rot dup 0< if + 2* -rot + scratch @ d# 0 d+ + else + 2* -rot + then + loop + rot drop +; +[ELSE] +: um* mult_a ! mult_b ! mult_p 2@ ; +[THEN] + +: * um* drop ; +: abssgn ( a b -- |a| |b| negf ) + 2dup xor 0< >r abs swap abs swap r> ; + +: m* abssgn >r um* r> if dnegate then ; + +: divstep + ( divisor dq hi ) + 2* + over 0< if 1+ then + swap 2* swap + rot ( dq hi divisor ) + 2dup >= if + tuck ( dq divisor hi divisor ) + - + swap ( dq hi divisor ) + rot 1+ ( hi divisor dq ) + rot ( divisor dq hi ) + else + -rot + then + ; + +: um/mod ( ud u1 -- u2 u3 ) ( 6.1.2370 ) + -rot + divstep divstep divstep divstep + divstep divstep divstep divstep + divstep divstep divstep divstep + divstep divstep divstep divstep + rot drop swap +; + +: /mod >R S>D R> ;fallthru +: SM/REM ( d n -- r q ) ( 6.1.2214 ) ( symmetric ) + OVER >R >R DABS R@ ABS UM/MOD + R> R@ XOR 0< IF NEGATE THEN R> 0< IF >R NEGATE R> THEN ; +: / /mod nip ; +: mod /mod drop ; +: */mod >R M* R> SM/REM ; +: */ */mod nip ; + +: t2* over >r >r d2* + r> 2* r> 0< d# 1 and + ; + +variable divisor +: m*/mod + divisor ! + tuck um* 2swap um* ( hi. lo. ) + ( m0 h l m1 ) + swap >r d# 0 d+ r> ( m h l ) + -rot ( l m h ) + d# 32 0do + t2* + dup divisor @ >= if + divisor @ - + rot 1+ -rot + then + loop +; +: m*/ m*/mod drop ; + + +\ Numeric output - from eforth + +variable base +variable hld +create pad 84 allot create pad| + +: <# ( -- ) ( 6.1.0490 )( h# 96 ) pad| HLD ! ; +: DIGIT ( u -- c ) d# 9 OVER < d# 7 AND + [CHAR] 0 + ; +: HOLD ( c -- ) ( 6.1.1670 ) HLD @ 1- DUP HLD ! C! ; + +: # ( d -- d ) ( 6.1.0030 ) + d# 0 BASE @ UM/MOD >R BASE @ UM/MOD SWAP DIGIT HOLD R> ; + +: #S ( d -- d ) ( 6.1.0050 ) BEGIN # 2DUP OR 0= UNTIL ; +: #> ( d -- a u ) ( 6.1.0040 ) 2DROP HLD @ pad| OVER - ; + +: SIGN ( n -- ) ( 6.1.2210 ) 0< IF [CHAR] - HOLD THEN ; + +\ hex(int((1<<24) * (115200 / 2400.) / (WB_CLOCK_FREQ / 2400.))) +\ d# 42000000 constant WB_CLOCK_FREQ + +[ 48000000 17 12 */ ] constant WB_CLOCK_FREQ + +0 [IF] +: uartbase + [ $100000000. 115200 WB_CLOCK_FREQ m*/ drop $ffffff00 and dup swap 16 rshift ] 2literal +; +: emit-uart + begin uart_0 @ 0= until + s>d + uartbase dor + uart_1 ! uart_0 ! +; +[ELSE] +: emit-uart drop ; +[THEN] + +create 'emit +meta emit-uart t, target + +: emit 'emit @ execute ; +: cr d# 13 emit d# 10 emit ; +d# 32 constant bl +: space bl emit ; +: spaces begin dup 0> while space 1- repeat drop ; + +: hex1 d# 15 and dup d# 10 < if d# 48 else d# 55 then + emit ; +: hex2 + dup + d# 4 rshift + hex1 hex1 +; +: hex4 + dup + d# 8 rshift + hex2 hex2 ; + +: hex8 hex4 hex4 ; + +: type + d# 0 do + dup c@ emit + 1+ + loop + drop +; + +: dump + ( addr u ) + 0do + dup d# 15 and 0= if dup cr hex4 [char] : emit space space then + dup c@ hex2 space 1+ + loop + cr drop +; + +: dump16 + ( addr u ) + 0do + dup hex4 [char] : emit space dup @ hex4 cr 2+ + loop + drop +; + +: decimal d# 10 base ! ; +: hex d# 16 base ! ; + +: S.R ( a u n -- ) OVER - SPACES TYPE ; +: D.R ( d n -- ) ( 8.6.1.1070 ) >R DUP >R DABS <# #S R> SIGN #> R> S.R ; +: U.R ( u n -- ) ( 6.2.2330 ) d# 0 SWAP D.R ; +: .R ( n n -- ) ( 6.2.0210 ) >R S>D R> D.R ; + +: D. ( d -- ) ( 8.6.1.1060 ) d# 0 D.R SPACE ; +: U. ( u -- ) ( 6.1.2320 ) d# 0 D. ; +: . ( n -- ) ( 6.1.0180 ) BASE @ d# 10 XOR IF U. EXIT THEN S>D D. ; +: ? ( a -- ) ( 15.6.1.0600 ) @ . ; + +( Numeric input ) + +: DIGIT? ( c base -- u f ) ( 0xA3 ) + >R [CHAR] 0 - D# 9 OVER < + IF D# 7 - DUP D# 10 < OR THEN DUP R> U< ; + +: >number ( ud a u -- ud a u ) ( 6.1.0570 ) + begin + dup 0= if exit then + over c@ base @ digit? if + >r 2swap + drop base @ um* + r> s>d d+ 2swap + d# 1 /string >number + else + drop exit + then + again +; + +: .s + [char] < emit + depth dup hex2 + [char] > emit + + d# 8 min + ?dup if + 0do + i pick hex4 space + loop + then +; + +build-debug? [IF] +: (assert) + s" **** ASSERTION FAILED **** " type + ;fallthru +: (snap) + type space + s" LINE " type + . + [char] : emit + space + .s + cr +; +[THEN] + +\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + +: endian dup d# 8 lshift swap d# 8 rshift or ; +: 2endian endian swap endian ; +: swab endian ; +: typepad ( c-addr u w ) over - >r type r> spaces ; +: even? d# 1 and 0= ; + +\ rise? and fall? act like ! - except that they leave a true +\ if the value rose or fell, respectively. + +: rise? ( u a -- f ) 2dup @ u> >r ! r> ; +: fall? ( u a -- f ) 2dup @ u< >r ! r> ; + +]module diff --git a/docs/j1demo/firmware/packet.fs b/docs/j1demo/firmware/packet.fs new file mode 100644 index 0000000..b188cc5 --- /dev/null +++ b/docs/j1demo/firmware/packet.fs @@ -0,0 +1,11 @@ +( Packet construction, tx, rx JCB 13:25 08/24/10) +module[ packet" + +: packet@ ( u -- u ) + mac-inoffset mac@ ; + +: packetd@ ( u -- ud ) + mac-inoffset dup 2+ mac@ swap mac@ ; + + +]module diff --git a/docs/j1demo/firmware/ps2kb.fs b/docs/j1demo/firmware/ps2kb.fs new file mode 100644 index 0000000..f151971 --- /dev/null +++ b/docs/j1demo/firmware/ps2kb.fs @@ -0,0 +1,434 @@ +( PS/2 keyboard handler JCB 18:29 11/21/10) + +================================================================ + +Keycodes represent raw keypresses. Need to map these to +ASCII characters. Each key can generate several ASCII +codes depending on the state of the SHIFT/CTRL keys. + +Could use table giving keycode->ascii, but most keys +generate two codes, so would need word for each. +Keycodes 00-83. Storage 262 bytes. + +Table of N ascii codes, each entry specifies a keycode +and shift state + +================================================================ + +module[ ps2kb" + +meta + +create asciikb 144 allot +asciikb 144 erase + +\ 1 word for each key. +\ if high bit is zero, then + +h# 84 constant nscancodes +create scanmap nscancodes cells allot +scanmap nscancodes cells 2constant scanmap_ +scanmap_ erase + +: scanmap! ( n u -- ) \ write n to cell u in scanmap + cells scanmap + ! +; + +\ knowkey plain xx f0xx +\ knowkey-n plain 3x, yy numlock exyy +\ knowkey-h shift mask yy d0yy +\ knowkey-s plain xx, shifted^caps yy xxyy + +h# f000 constant plainmask +h# e000 constant numlockmask +h# d000 constant shiftmask + +: wordval bl word count evaluate ; + +: knowkey + wordval + plainmask or + swap scanmap! +; +: knowkey-s + \ dup char asciikb + c! + \ 128 or + \ char asciikb + c! + char 8 lshift char or + swap scanmap! +; +: knowkey-h + wordval shiftmask or + swap scanmap! +; +: knowkey-n + \ dup char asciikb + c! + \ 128 or + \ char asciikb + c! + char [char] . - 8 lshift wordval or + numlockmask or + swap scanmap! +; + +h# 01 constant SHIFTL +h# 02 constant SHIFTR +h# 04 constant CONTROL +h# 08 constant ALT +char * constant ASTERISK +char - constant MINUS +char + constant PLUS +char 5 constant FIVE + +include keycodes.fs + +h# 76 knowkey ESC +h# 05 knowkey KF1 +h# 06 knowkey KF2 +h# 04 knowkey KF3 +h# 0c knowkey KF4 +h# 03 knowkey KF5 +h# 0b knowkey KF6 +h# 83 knowkey KF7 +h# 0a knowkey KF8 +h# 01 knowkey KF9 +h# 09 knowkey KF10 +h# 78 knowkey KF11 +h# 07 knowkey KF12 + +h# 0e knowkey-s ` ~ +h# 16 knowkey-s 1 ! +h# 1e knowkey-s 2 @ +h# 26 knowkey-s 3 # +h# 25 knowkey-s 4 $ +h# 2e knowkey-s 5 % +h# 36 knowkey-s 6 ^ +h# 3d knowkey-s 7 & +h# 3e knowkey-s 8 * +h# 46 knowkey-s 9 ( +h# 45 knowkey-s 0 ) +h# 4e knowkey-s - _ +h# 55 knowkey-s = + +h# 5d knowkey-s \ | +h# 66 knowkey KDEL + +h# 0d knowkey TAB +h# 15 knowkey-s q Q +h# 1d knowkey-s w W +h# 24 knowkey-s e E +h# 2d knowkey-s r R +h# 2c knowkey-s t T +h# 35 knowkey-s y Y +h# 3c knowkey-s u U +h# 43 knowkey-s i I +h# 44 knowkey-s o O +h# 4d knowkey-s p P +h# 54 knowkey-s [ { +h# 5b knowkey-s ] } +h# 5a knowkey ENTER + +h# 58 knowkey -1 +h# 1c knowkey-s a A +h# 1b knowkey-s s S +h# 23 knowkey-s d D +h# 2b knowkey-s f F +h# 34 knowkey-s g G +h# 33 knowkey-s h H +h# 3b knowkey-s j J +h# 42 knowkey-s k K +h# 4b knowkey-s l L +h# 4c knowkey-s ; : +h# 52 knowkey-s ' " + +h# 1a knowkey-s z Z +h# 22 knowkey-s x X +h# 21 knowkey-s c C +h# 2a knowkey-s v V +h# 32 knowkey-s b B +h# 31 knowkey-s n N +h# 3a knowkey-s m M +h# 41 knowkey-s , < +h# 49 knowkey-s . > +h# 4a knowkey-s / ? + +h# 29 knowkey BL + +h# 12 knowkey-h SHIFTL +h# 59 knowkey-h SHIFTR +h# 14 knowkey-h CONTROL +h# 11 knowkey-h ALT + +h# 70 knowkey-n 0 KINS +h# 71 knowkey-n . KDEL +h# 69 knowkey-n 1 KEND +h# 72 knowkey-n 2 KDOWN +h# 7a knowkey-n 3 KPGDN +h# 6b knowkey-n 4 KLEFT +h# 73 knowkey FIVE +h# 74 knowkey-n 6 KRIGHT +h# 6c knowkey-n 7 KHOME +h# 75 knowkey-n 8 KUP +h# 7d knowkey-n 9 KPGUP +h# 77 knowkey -2 +h# 7c knowkey ASTERISK +h# 7b knowkey MINUS +h# 79 knowkey PLUS + +: t,c ( c-addr u -- ) \ compile u cells into target memory + 0 do + dup @ t, cell+ + loop + drop +; + +target create scanmap meta +scanmap nscancodes t,c + +target + +include keycodes.fs + +: scanmap@ ( u - u ) \ return scanmap entry u + cells scanmap + @ ; + +variable kbread \ read ptr into 64-bit KB fifo +variable kbstate \ accumulates 11-bit code + +: ps2listening + ps2_clk_dir in + ps2_dat_dir in +; +: kbfifo@ ( u -- f ) \ read bit u from 64-bit KB fifo + dup d# 4 rshift 2* kbfifo + @ + swap d# 15 and rshift d# 1 and +; +: kbnew ( -- ) \ start accumulating new code + h# 800 kbstate ! +; +: kbfifo-cold + kbfifocount @ kbread ! + kbnew +; +: kbfifo-fullness ( -- u ) \ how many unread bits in the kbfifo + kbfifocount @ kbread @ - h# ff and +; + +variable ps2_clk' +: waitfall \ wait for falling edge on ps2_clk + begin ps2_clk @ ps2_clk' fall? until ; + +: ps2-out1 ( u -- ) \ send lsb of u to keyboard + ps2_dat ! waitfall ; + +: oddparity ( u1 -- u2 ) \ u2 is odd parity of u1 + dup d# 4 rshift xor + dup d# 2 rshift xor + dup 2/ xor +; + +: kb-request + ps2_clk_dir out ps2_clk off \ clock low + d# 60. sleepus + ps2_dat_dir out ps2_dat off \ dat low + ps2_clk_dir in \ release clock + + begin ps2_clk @ until + ps2_clk' on + + \ bad keyboard hangs here + false ps2-out1 \ start + + dup + d# 8 0do + dup ps2-out1 2/ + loop + drop + + oddparity ps2-out1 \ parity + true ps2-out1 \ stop + + ps2listening \ waitfall + kbfifo-cold +; + +: kbbit + d# 11 lshift kbstate @ 2/ or + kbstate ! +; +: rawready? ( -- f) \ is the raw keycode ready? + kbstate @ d# 1 and ; + +: kbraw ( -- u ) \ get the current raw keycode + kbstate @ d# 2 rshift h# ff and + kbnew +; + +variable lock + +: rawloop + begin + kbfifocount @ lock ! + kbfifo-fullness 0<> + rawready? 0= and + while + kbfifo-fullness 1- kbfifo@ + kbfifocount @ lock @ = if + kbbit d# 1 kbread +! + else + drop + then + repeat +; + +: oneraw + begin + rawloop + rawready? + until + kbraw +; + +: >leds ( u -- ) \ set keyboard leds (CAPS NUM SCROLL) + h# ed kb-request + oneraw drop + kb-request +; + +( Decoding JCB 19:25 12/04/10) + +variable capslock +variable numlock +variable isrelease \ is this is key release +variable ise0 \ is this an E0-prefix key +0 value mods \ bitmask of modifier keys + \ RALT RCTRL -- -- LALT LCTRL RSHIFT LSHIFT + +: lrshift? ( -- f ) \ is either shift pressed? + mods h# 03 and ; +: lrcontrol? + mods h# 44 and ; +: lralt? + mods h# 88 and ; + +variable curkey + +: append ( u -- ) \ join u with mods write to curkey + h# ff and mods d# 8 lshift or + curkey ! +; + +: shiftmask + h# ff and + ise0 @ if d# 4 lshift then +; +: shift-press ( u -- ) \ a shift key was pressed + shiftmask mods or to mods ; +: shift-release ( u -- ) \ a shift key was released + shiftmask invert mods and to mods ; + +: shiftable-press ( u -- ) \ a shiftable key was pressed + mods d# 3 and 0= capslock @ xor if + d# 8 rshift + then + append +; +: ignore drop ; + +: myleds \ compute led values from caps/numlock, send to KB + numlock @ d# 2 and + capslock @ d# 4 and + or + >leds +; + +: toggle ( a -- ) \ invert cell at a + dup @ invert swap ! ; + +: plain-press ( u -- ) + dup d# -1 = if + drop capslock toggle myleds + else + dup d# -2 = if + drop numlock toggle myleds + else + append + then + then +; + +: num-press + \ if e0 prefix, low code, else hi code or 30 + \ e0 numlock + \ 0 0 cursor + \ 0 1 num + \ 1 0 cursor + \ 1 1 cursor + ise0 @ 0= numlock @ and if + d# 8 rshift h# f and [char] . + + then + append +; + +jumptable keyhandler +\ PRESS RELEASE +( 0 ) | shiftable-press | ignore +( d ) | shift-press | shift-release +( e ) | num-press | ignore +( f ) | plain-press | ignore + +: handle-raw ( u -- ) + dup h# e0 = if + drop ise0 on + else + dup h# f0 = if + drop isrelease on + else + dup h# 84 < if + scanmap@ + \ hi 4 bits, + \ 1100 -> 0 + \ 1101 -> 1 + \ 1110 -> 2 + \ 1111 -> 3 + \ + dup d# 12 rshift d# 12 - d# 0 max + + 2* isrelease @ + keyhandler execute + + isrelease off + ise0 off + else + drop + then + then + then +; + +( kb: high-level keyboard JCB 19:45 12/04/10) + +: kb-cold + ps2listening kbfifo-cold + h# 7 >leds + sleep.1 + h# 0 >leds + + numlock off + capslock off + curkey off +; + +: kbfifo-proc + rawloop + rawready? if + kbraw handle-raw + then +; + +: key? ( -- flag ) + kbfifo-proc + curkey @ 0<> ; +: key ( -- u ) + begin key? until + curkey @ curkey off ; + +]module + diff --git a/docs/j1demo/firmware/sincos.fs b/docs/j1demo/firmware/sincos.fs new file mode 100644 index 0000000..6ad1ea4 --- /dev/null +++ b/docs/j1demo/firmware/sincos.fs @@ -0,0 +1,36 @@ +( Sine and cosine JCB 18:29 11/18/10) + +create sintab + +meta + +: mksin + 65 0 do + i s>d d>f 128e0 f/ pi f* fsin + 32767e0 f* f>d drop + t, + loop +; +mksin + +target + +: sin ( th -- v ) + dup d# 128 and >r + d# 127 and + dup d# 63 > if + invert d# 129 + \ 64->64, 65->63 + then + cells sintab + @ + r> if + negate + then +; + +: cos d# 64 + sin ; + +: sin* ( s th -- sinth * s ) + sin swap 2* m* nip ; + +: cos* ( s th -- costh * s ) + cos swap 2* m* nip ; diff --git a/docs/j1demo/firmware/sprite.fs b/docs/j1demo/firmware/sprite.fs new file mode 100644 index 0000000..877917a --- /dev/null +++ b/docs/j1demo/firmware/sprite.fs @@ -0,0 +1,20 @@ +( Sprite low-level JCB 15:23 11/15/10) + +: vga-line@ + begin + vga_line @ + vga_line @ + over xor + while + drop + repeat +; + +: waitblank begin vga-line@ d# 512 = until ; + +: sprite! ( x y spr -- ) + 2* cells vga_spritey + tuck ! 2- ! ; + +: hide \ hide all the sprites at (800,800) + d# 8 0do d# 800 dup i sprite! loop ; + diff --git a/docs/j1demo/firmware/tftp.fs b/docs/j1demo/firmware/tftp.fs new file mode 100644 index 0000000..da40aa2 --- /dev/null +++ b/docs/j1demo/firmware/tftp.fs @@ -0,0 +1,67 @@ +( TFTP JCB 09:16 11/11/10) + +variable blocknum + +: tftp-ack ( -- ) + d# 2 ETH.IP.SRCIP mac-inoffset mac@n arp-lookup if + ETH.IP.UDP.SOURCEPORT packet@ + d# 1077 + d# 2 ETH.IP.SRCIP mac-inoffset mac@n + net-my-ip + 2over arp-lookup + ( dst-port src-port dst-ip src-ip *ethaddr ) + udp-header + d# 4 mac-pkt-, + blocknum @ mac-pkt-, + udp-wrapup mac-send + then +; + +: tftp-handler ( -- ) + IP_PROTO_UDP ip-isproto if + OFFSET_UDP_DESTPORT packet@ d# 69 = if + udp-checksum? if + ETH.IP.UDP.TFTP.OPCODE packet@ + s" tftp opcode=" type dup hex4 cr + dup d# 2 = if + s" WRQ filename: " type + ETH.IP.UDP.TFTP.RWRQ.FILENAME mac-inoffset d# 32 mac-dump + + d# 0 blocknum ! + tftp-ack + then + drop + then + then + OFFSET_UDP_DESTPORT packet@ d# 1077 = if + udp-checksum? if + ETH.IP.UDP.TFTP.OPCODE packet@ + s" tftp opcode=" type dup hex4 cr + dup d# 3 = if + s" tftp recv=" type ETH.IP.UDP.TFTP.DATA.BLOCK packet@ hex4 s" expected=" type blocknum @ 1+ hex4 cr + blocknum @ 1+ + ETH.IP.UDP.TFTP.DATA.BLOCK packet@ = if + \ data at ETH.IP.UDP.TFTP.DATA.DATA + ETH.IP.UDP.TFTP.DATA.DATA mac-inoffset + blocknum @ d# 9 lshift h# 2000 + + d# 256 0do + over mac@ h# 5555 xor over h# 3ffe min ! + 2+ swap 2+ swap + loop + 2drop + d# 1 blocknum +! + tftp-ack + ETH.IP.UDP.LENGTH packet@ d# 12 - 0= if + h# 2000 h# 100 dump + bootloader + then + else + s" unexpected blocknum" type cr + tftp-ack + then + then + drop + then + then + then +; diff --git a/docs/j1demo/firmware/time.fs b/docs/j1demo/firmware/time.fs new file mode 100644 index 0000000..4d53113 --- /dev/null +++ b/docs/j1demo/firmware/time.fs @@ -0,0 +1,33 @@ +( Time access JCB 13:27 08/24/10) + +variable prevth \ previous high time +2variable timeh \ high 32 bits of time + +: time@ ( -- time. ) + begin + time 2@ + time 2@ + 2over d<> + while + 2drop + repeat + +\ dup prevth fall? if +\ d# 1. timeh d+! +\ then +; + +: timeq ( -- d d ) \ 64-bit time + time@ timeh 2@ ; + +: setalarm ( d a -- ) \ set alarm a for d microseconds hence + >r time@ d+ r> 2! ; +: isalarm ( a -- f ) + 2@ time@ d- d0<= ; + +2variable sleeper +: sleepus sleeper setalarm begin sleeper isalarm until ; +: sleep.1 d# 100000. sleepus ; +: sleep1 d# 1000000. sleepus ; + +: took ( d -- ) time@ 2swap d- s" took " type d. cr ; diff --git a/docs/j1demo/firmware/twist.py b/docs/j1demo/firmware/twist.py new file mode 100644 index 0000000..19743f6 --- /dev/null +++ b/docs/j1demo/firmware/twist.py @@ -0,0 +1,311 @@ +from twisted.internet.protocol import DatagramProtocol +from twisted.internet import reactor, task +from twisted.internet.task import deferLater + +import os +import time +import struct +import sys +import hashlib +import operator +import functools +import random + +class Transporter(DatagramProtocol): + + def __init__(self, jobs): + self.udp_transport = reactor.listenUDP(9947, self) + self.pending = {} + self.seq = 0 + self.jobs = jobs + self.firstjob() + task.LoopingCall(self.earliest).start(0.1) + reactor.run() + + def firstjob(self): + self.jobs[0].startwork(self) + + def propose(self, cmd, rest): + seq = self.seq + self.seq += 1 + data = struct.pack(">HH", seq, cmd) + rest; + self.pending[seq] = (time.time(), data) + return seq + + def earliest(self): + bytime = [(t, k) for (k, (t, _)) in self.pending.items()] + for (t, seq) in sorted(bytime)[:32]: + self.send(seq) + self.pending[seq] = (time.time(), self.pending[seq][1]) + + def datagramReceived(self, data, (host, port)): + # print "received %r from %s:%d" % (data, host, port) + (opcode, seq) = struct.unpack(">HH", data[:4]) + assert opcode == 0 + if seq in self.pending: + del self.pending[seq] + try: + self.jobs[0].addresult(self, seq, data[4:]) + except AssertionError as e: + print 'assertion failed', e + reactor.stop() + return + print "ACK ", seq, "pending", len(self.pending) + if len(self.pending) == 0: + self.jobs[0].close() + self.jobs = self.jobs[1:] + if self.jobs != []: + self.firstjob() + else: + reactor.stop() + # self.transport.write(data, (host, port)) + + def send(self, seq): + (_, data) = self.pending[seq] + # print "send %r" % data + self.udp_transport.write(data, ("192.168.0.99", 947)) + + def addresult(self, seq, payload): + pass + + +class Action(object): + def addresult(self, tr, seq, payload): + pass + + def close(self): + pass + +class ReadRAM(Action): + + def startwork(self, tr): + self.result = 16384 * [None] + self.seqs = {} + for i in range(0, 128): + self.seqs[tr.propose(0, struct.pack(">H", i * 128))] = i * 128 + + def addresult(self, tr, seq, payload): + addr = self.seqs[seq] + assert len(payload) == 128 + for i in range(128): + self.result[addr + i] = ord(payload[i]) + + def close(self): + for a in range(0, 16384, 16): + print ("%04x " % a) + " ".join("%02x" % x for x in self.result[a:a+16]) + + +class WriteRAM(Action): + + def startwork(self, tr): + code = open('j1.bin').read() + for i in range(0x1f80 / 128): + print i + o = 128 * i + tr.propose(1, struct.pack(">H128s", 0x2000 + o, code[o:o+128])) + +class VerifyRAM(ReadRAM): + def close(self): + actual = "".join([chr(c) for c in self.result[0x2000:]]) + expected = open('j1.bin').read() + l = 0x1f80 + assert actual[:l] == expected[:l] + +class Reboot(Action): + def startwork(self, tr): + tr.propose(2, "") + +class ReadFlash(Action): + + def startwork(self, tr): + self.result = 2 * 1024 * 1024 * [None] + self.seqs = {} + for addr in range(0, len(self.result), 128): + self.seqs[tr.propose(3, struct.pack(">I", addr))] = addr + + def addresult(self, tr, seq, payload): + addr = self.seqs[seq] + assert len(payload) == 128 + for i in range(128): + self.result[addr + i] = ord(payload[i]) + + def close(self): + open('flash.dump', 'w').write("".join([chr(x) for x in self.result])) + for a in range(0, 256, 16): + print ("%04x " % a) + " ".join("%02x" % x for x in self.result[a:a+16]) + +class EraseFlash(Action): + def startwork(self, tr): + tr.propose(4, "") + def close(self): + time.sleep(5) + +class WaitFlash(Action): + def startwork(self, tr): + self.seq = tr.propose(5, struct.pack(">I", 0)) + def addresult(self, tr, seq, payload): + (res,) = struct.unpack(">H", payload) + if res == 0: + self.startwork(tr) + +def bitload(bitfilename): + bit = open(bitfilename, "r") + + def getH(fi): + return struct.unpack(">H", bit.read(2))[0] + def getI(fi): + return struct.unpack(">I", bit.read(4))[0] + + bit.seek(getH(bit), os.SEEK_CUR) + assert getH(bit) == 1 + + # Search for the data section in the .bit file... + while True: + ty = ord(bit.read(1)) + if ty == 0x65: + break + length = getH(bit) + bit.seek(length, os.SEEK_CUR) + fieldLength = getI(bit) + return bit.read(fieldLength) + +# open("xxx", "w").write(bitload("j1_program.bit")) + +import intelhex +import array + +class Hexfile(object): + def __init__(self, filename): + self.hf = intelhex.IntelHex(filename) + self.hf.readfile() + while (self.hf.maxaddr() % 128) != 127: + self.hf[self.hf.maxaddr() + 1] = 0xff + print "%x %x" % (self.hf.minaddr(), self.hf.maxaddr()) + + def minmax(self): + return (self.hf.minaddr(), self.hf.maxaddr()) + + # The XESS CPLD bootloader runs the flash in byte mode, + # and the flash is littleendian, so must do the endian + # swap here + def blk(self, o): + b128 = array.array('B', [self.hf[o + i] for i in range(128)]).tostring() + hh = array.array('H', b128) + hh.byteswap() + return hh.tostring() + +class WriteFlash(Action, Hexfile): + + def startwork(self, tr): + for o in range(self.hf.minaddr(), self.hf.maxaddr(), 128): + tr.propose(6, struct.pack(">I", o) + self.blk(o)) + +class VerifyFlash(Action, Hexfile): + + def startwork(self, tr): + self.seqs = {} + for o in range(self.hf.minaddr(), self.hf.maxaddr(), 128): + self.seqs[tr.propose(3, struct.pack(">I", o))] = o + + def addresult(self, tr, seq, payload): + addr = self.seqs[seq] + assert len(payload) == 128, 'short packet' + assert self.blk(addr) == payload, "mismatch at %#x" % addr + + def close(self): + print "Flash verified OK" + +class EraseSector(Action): + def __init__(self, a): + self.a = a + def startwork(self, tr): + tr.propose(7, struct.pack(">I", self.a)) + def close(self): + time.sleep(.1) + +class WaitSector(Action): + def __init__(self, a): + self.a = a + def startwork(self, tr): + self.seq = tr.propose(5, struct.pack(">I", self.a)) + def addresult(self, tr, seq, payload): + (res,) = struct.unpack(">H", payload) + if res == 0: + self.startwork(tr) + +class LoadSector(Action): + def __init__(self, a, data): + self.a = a + self.data = data + def startwork(self, tr): + for o in range(0, len(self.data), 128): + blk = self.data[o:o+128] + if blk != (128 * chr(0xff)): + tr.propose(6, struct.pack(">I", self.a + o) + blk) + +class DumpSector(Action): + + def __init__(self, a): + self.a = a + def startwork(self, tr): + self.seqs = {} + for o in [0]: + self.seqs[tr.propose(3, struct.pack(">I", self.a + o))] = o + + def addresult(self, tr, seq, payload): + addr = self.a + self.seqs[seq] + assert len(payload) == 128 + print "result", repr(payload) + +# t = Transporter([WriteRAM(), VerifyRAM(), Reboot()]) +# t = Transporter([EraseFlash(), WaitFlash()]) +# sys.exit(0) + +erasing = [EraseFlash(), WaitFlash()] +bases = [ 0 ] +bases = [0, 0x80000, 0x100000, 0x180000] +bases = [0x80000] +# Transporter(erasing + [WriteFlash("j1_program_%x.mcs" % base) for base in bases]) +# Transporter([VerifyFlash("j1_program_%x.mcs" % base) for base in bases]) +# Transporter([EraseSector(seca), WaitSector(seca), ld, DumpSector(seca)]) + +def loadcode(dsta, filenames): + data = "".join([open(fn).read() for fn in filenames]) + return [EraseSector(dsta), + WaitSector(dsta), + LoadSector(dsta, data)] + +def pngstr(filename): + import Image + sa = array.array('B', Image.open(filename).convert("L").tostring()) + return struct.pack('>1024H', *sa.tolist()) + +def erasesecs(lo, hi): + r = [] + for s in range(lo, hi, 65536): + r += [EraseSector(s), WaitSector(s)] + return r + +def loadhex(filename): + w = WriteFlash(filename) + (lo, hi) = w.minmax() + return erasesecs(lo, hi) + [w] + +def loadsprites(dsta, filenames): + data = "".join([pngstr(f) for f in filenames]) + print "Loading %d bytes" % len(data) + return erasesecs(dsta, dsta + len(data)) + [LoadSector(dsta, data)] + +# Transporter(loadcode(0x180000, ["j1.png.pic", "font8x8", "j1.png.chr"]) + [Reboot()]) +spr = ["%d.png" % (i/2) for i in range(16)] +spr += ["blob.png"] * 16 +spr += ["fsm-32.png", "pop.png"] * 6 + ["bomb.png", "pop.png", "shot.png", "pop.png"] + +# Transporter(loadsprites(0x200000, spr)) +# Transporter(loadcode(0x190000, ["j1.bin"]) + [Reboot()]) +# t = Transporter([ReadFlash()]) + +Transporter( +# loadhex("j1_program_80000.mcs") +loadcode(0x190000, ["j1.bin"]) + [Reboot()] +) diff --git a/docs/j1demo/firmware/udp.fs b/docs/j1demo/firmware/udp.fs new file mode 100644 index 0000000..835983a --- /dev/null +++ b/docs/j1demo/firmware/udp.fs @@ -0,0 +1,41 @@ +( UDP header and wrapup JCB 13:22 08/24/10) + +: udp-header ( dst-port src-port dst-ip src-ip *ethaddr -- ) + h# 11 ip-header + mac-pkt-, \ src port + mac-pkt-, \ dst port + d# 2 mac-pkt-,0 \ length and checksum +; + +variable packetbase +: packet packetbase @ + ; + +: udp-checksum ( addr -- u ) \ compute UDP checksum on packet + packetbase ! + ETH.IP.UDP.LENGTH packet @ d# 1 and if + ETH.IP.UDP ETH.IP.UDP.LENGTH packet @ + packet + dup @ h# ff00 and swap ! + then + ETH.IP.UDP packet + ETH.IP.UDP.LENGTH packet @ 1+ 2/ + mac-checksum invert + d# 4 ETH.IP.SRCIP packet mac@n + +1c +1c +1c +1c + IP_PROTO_UDP +1c + ETH.IP.UDP.LENGTH packet @ +1c + invert +; + +: udp-checksum? true ; + \ incoming udp-checksum 0= ; + +: udp-wrapup + mac-pkt-complete dup + ip-wrapup + + OFFSET_UDP - + OFFSET_UDP_LENGTH packetout-off mac! + + \ outgoing udp-checksum ETH.IP.UDP.CHECKSUM packetout-off ! +; + diff --git a/docs/j1demo/firmware/version.fs b/docs/j1demo/firmware/version.fs new file mode 100644 index 0000000..75e63a9 --- /dev/null +++ b/docs/j1demo/firmware/version.fs @@ -0,0 +1,2 @@ +: version s" 649:659M" ; +: builddate d# 1291578086. d# -0800 ; diff --git a/docs/j1demo/j1.pdf b/docs/j1demo/j1.pdf new file mode 100644 index 0000000..188ac02 Binary files /dev/null and b/docs/j1demo/j1.pdf differ diff --git a/docs/j1demo/synth/Makefile b/docs/j1demo/synth/Makefile new file mode 100644 index 0000000..4cec0ac --- /dev/null +++ b/docs/j1demo/synth/Makefile @@ -0,0 +1,9 @@ +project = j1 +vendor = xilinx +family = spartan3s +part = xc3s1000-4ft256 +top_module = top + +vfiles = ../verilog/top.v ../verilog/j1.v ../verilog/ck_div.v ../verilog/uart.v + +include xilinx.mk diff --git a/docs/j1demo/synth/j1.bmm b/docs/j1demo/synth/j1.bmm new file mode 100644 index 0000000..61a7d83 --- /dev/null +++ b/docs/j1demo/synth/j1.bmm @@ -0,0 +1,12 @@ +ADDRESS_SPACE jram RAMB16 [0x00020000:0x00023fff] + BUS_BLOCK + j1/ram[7].ram [15:14]; + j1/ram[6].ram [13:12]; + j1/ram[5].ram [11:10]; + j1/ram[4].ram [9:8]; + j1/ram[3].ram [7:6]; + j1/ram[2].ram [5:4]; + j1/ram[1].ram [3:2]; + j1/ram[0].ram [1:0]; + END_BUS_BLOCK; +END_ADDRESS_SPACE; diff --git a/docs/j1demo/synth/j1.ucf b/docs/j1demo/synth/j1.ucf new file mode 100644 index 0000000..f6bbd70 --- /dev/null +++ b/docs/j1demo/synth/j1.ucf @@ -0,0 +1,327 @@ +##################################################### +# +# XSA-3S1000 Board FPGA pin assignment constraints +# +##################################################### +# +# Clocks +# +net CLKA loc=T9 | IOSTANDARD = LVCMOS33 ; # 100MHz +#net CLKB loc=P8 | IOSTANDARD = LVCMOS33 ; # 50MHz +#net CLKC loc=R9 | IOSTANDARD = LVCMOS33 ; # ??Mhz +# +# Push button switches +# +#NET SW1_3_N loc=K2 | IOSTANDARD = LVCMOS33 ; # Flash Block select +#NET SW1_4_N loc=J4 | IOSTANDARD = LVCMOS33 ; # Flash Block +#NET SW2_N loc=E11 | IOSTANDARD = LVCMOS33 ; # active-low pushbutton +#NET SW3_N loc=A13 | IOSTANDARD = LVCMOS33 ; # active-low pushbutton +# +# PS/2 Keyboard +# +net PS2_CLK loc=B16 | IOSTANDARD = LVCMOS33 ; +net PS2_DAT loc=E13 | IOSTANDARD = LVCMOS33 ; +# +# VGA Outputs +# +NET VGA_BLUE<0> LOC=C9 | IOSTANDARD = LVCMOS33 ; +NET VGA_BLUE<1> LOC=E7 | IOSTANDARD = LVCMOS33 ; +NET VGA_BLUE<2> LOC=D5 | IOSTANDARD = LVCMOS33 ; +NET VGA_GREEN<0> LOC=A8 | IOSTANDARD = LVCMOS33 ; +NET VGA_GREEN<1> LOC=A5 | IOSTANDARD = LVCMOS33 ; +NET VGA_GREEN<2> LOC=C3 | IOSTANDARD = LVCMOS33 ; +NET VGA_RED<0> LOC=C8 | IOSTANDARD = LVCMOS33 ; +NET VGA_RED<1> LOC=D6 | IOSTANDARD = LVCMOS33 ; +NET VGA_RED<2> LOC=B1 | IOSTANDARD = LVCMOS33 ; +NET VGA_HSYNC_N LOC=B7 | IOSTANDARD = LVCMOS33 ; +NET VGA_VSYNC_N LOC=D8 | IOSTANDARD = LVCMOS33 ; +# +# Manually assign locations for the DCMs along the bottom of the FPGA +# because PAR sometimes places them in opposing corners and that ruins the clocks. +# +#INST "u1/gen_dlls.dllint" LOC="DCM_X0Y0"; +#INST "u1/gen_dlls.dllext" LOC="DCM_X1Y0"; + +# Manually assign locations for the DCMs along the bottom of the FPGA +# because PAR sometimes places them in opposing corners and that ruins the clocks. +#INST "u2_dllint" LOC="DCM_X0Y0"; +#INST "u2_dllext" LOC="DCM_X1Y0"; +# +# SDRAM memory pin assignments +# +#net SDRAM_clkfb loc=N8 | IOSTANDARD = LVCMOS33 ; # feedback SDRAM clock after PCB delays +#net SDRAM_clkout loc=E10 | IOSTANDARD = LVCMOS33 ; # clock to SDRAM +#net SDRAM_CKE loc=D7 | IOSTANDARD = LVCMOS33 ; # SDRAM clock enable +#net SDRAM_CS_N loc=B8 | IOSTANDARD = LVCMOS33 ; # SDRAM chip-select +#net SDRAM_RAS_N loc=A9 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_CAS_N loc=A10 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_WE_N loc=B10 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_DQMH loc=D9 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_DQML loc=C10 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<0> loc=B5 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<1> loc=A4 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<2> loc=B4 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<3> loc=E6 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<4> loc=E3 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<5> loc=C1 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<6> loc=E4 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<7> loc=D3 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<8> loc=C2 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<9> loc=A3 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<10> loc=B6 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<11> loc=C5 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_A<12> loc=C6 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<0> loc=C15 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<1> loc=D12 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<2> loc=A14 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<3> loc=B13 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<4> loc=D11 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<5> loc=A12 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<6> loc=C11 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<7> loc=D10 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<8> loc=B11 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<9> loc=B12 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<10> loc=C12 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<11> loc=B14 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<12> loc=D14 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<13> loc=C16 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<14> loc=F12 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_D<15> loc=F13 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_BA<0> loc=A7 | IOSTANDARD = LVCMOS33 ; +#net SDRAM_BA<1> loc=C7 | IOSTANDARD = LVCMOS33 ; +# +# Flash memory interface + +net FLASH_A<0> LOC=N5 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<1> LOC=K14 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<2> LOC=K13 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<3> LOC=K12 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<4> LOC=L14 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<5> LOC=M16 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<6> LOC=L13 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<7> LOC=N16 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<8> LOC=N14 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<9> LOC=P15 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<10> LOC=R16 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<11> LOC=P14 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<12> LOC=P13 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<13> LOC=N12 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<14> LOC=T14 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<15> LOC=R13 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<16> LOC=N10 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<17> LOC=M14 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<18> LOC=K3 | IOSTANDARD = LVCMOS33 ; +net FLASH_A<19> LOC=K4 | IOSTANDARD = LVCMOS33 ; + +net FLASH_D<0> LOC=M11 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<1> LOC=N11 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<2> LOC=P10 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<3> LOC=R10 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<4> LOC=T7 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<5> LOC=R7 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<6> LOC=N6 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<7> LOC=M6 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<8> LOC=T4 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<9> LOC=R5 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<10> LOC=T5 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<11> LOC=P6 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<12> LOC=M7 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<13> LOC=R6 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<14> LOC=N7 | IOSTANDARD = LVCMOS33 ; +net FLASH_D<15> LOC=P7 | IOSTANDARD = LVCMOS33 ; +net FLASH_CE_N LOC=R4 | IOSTANDARD = LVCMOS33 ; +net FLASH_OE_N LOC=P5 | IOSTANDARD = LVCMOS33 ; +net FLASH_WE_N LOC=M13 | IOSTANDARD = LVCMOS33 ; +net FLASH_BYTE_N LOC=T8 | IOSTANDARD = LVCMOS33 ; +net FLASH_RDY LOC=L12 | IOSTANDARD = LVCMOS33 ; +net FLASH_RST_N LOC=P16 | IOSTANDARD = LVCMOS33 ; + +# FPGA Programming interface +# +#net FPGA_D<0> LOC=M11 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D0, S1, LED_C +#net FPGA_D<1> LOC=N11 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D1, S7, LED_DP +#net FPGA_D<2> LOC=P10 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D2, S4, LED_B +#net FPGA_D<3> LOC=R10 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D3, S6, LED_A +#net FPGA_D<4> LOC=T7 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D4, S5, LED_F +#net FPGA_D<5> LOC=R7 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D5, S3, LED_G +#net FPGA_D<6> LOC=N6 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D6, S2, LED_E +#net FPGA_D<7> LOC=M6 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D7, S0, LED_D +#net FPGA_CCLK LOC=T15 | IOSTANDARD = LVCMOS33 ; +#net FPGA_DONE LOC=R14 | IOSTANDARD = LVCMOS33 ; +#net FPGA_INIT_N LOC=N9 | IOSTANDARD = LVCMOS33 ; +#net FPGA_PROG_N LOC=B3 | IOSTANDARD = LVCMOS33 ; +#net FPGA_TCK LOC=C14 | IOSTANDARD = LVCMOS33 ; +#net FPGA_TDI LOC=A2 | IOSTANDARD = LVCMOS33 ; +#net FPGA_TDI_CSN LOC=R3 | IOSTANDARD = LVCMOS33 ; +#net FPGA_TDO LOC=A15 | IOSTANDARD = LVCMOS33 ; +#net FPGA_TDO_WRN LOC=T3 | IOSTANDARD = LVCMOS33 ; +#net FPGA_TMS LOC=C13 | IOSTANDARD = LVCMOS33 ; +#net FPGA_TMS_BSY LOC=P9 | IOSTANDARD = LVCMOS33 ; +# +# Status LED +# +#net S<0> loc=M6 | IOSTANDARD = LVCMOS33 ; # FPGA_D7, LED_D +#net S<1> loc=M11 | IOSTANDARD = LVCMOS33 ; # FPGA_D0, LED_C +#net S<2> loc=N6 | IOSTANDARD = LVCMOS33 ; # FPGA_D6, LED_E +#net S<3> loc=R7 | IOSTANDARD = LVCMOS33 ; # FPGA_D5, LED_G +#net S<4> loc=P10 | IOSTANDARD = LVCMOS33 ; # FPGA_D2, LED_B +#net S<5> loc=T7 | IOSTANDARD = LVCMOS33 ; # FPGA_D4, LED_F +#net S<6> loc=R10 | IOSTANDARD = LVCMOS33 ; # FPGA_D3, LED_A +#net S<7> loc=N11 | IOSTANDARD = LVCMOS33 ; # FPGA_D1, LED_DP +# +# Parallel Port +# +#net PPORT_load loc=N14 | IOSTANDARD = LVCMOS33 ; +#net PPORT_clk loc=P15 | IOSTANDARD = LVCMOS33 ; +#net PPORT_din<0> loc=R16 | IOSTANDARD = LVCMOS33 ; +#net PPORT_din<1> loc=P14 | IOSTANDARD = LVCMOS33 ; +#net PPORT_din<2> loc=P13 | IOSTANDARD = LVCMOS33 ; +#net PPORT_din<3> loc=N12 | IOSTANDARD = LVCMOS33 ; +# +#net PPORT_dout<0> loc=N5 | IOSTANDARD = LVCMOS33 ; +#net PPORT_dout<1> loc=K14 | IOSTANDARD = LVCMOS33 ; +#net PPORT_dout<2> loc=K13 | IOSTANDARD = LVCMOS33 ; +#net PPORT_dout<3> loc=T10 | IOSTANDARD = LVCMOS33 ; +# +#net PPORT_d<0> loc=N14 | IOSTANDARD = LVCMOS33 ; # FLASH_A<8> / PPORT_LOAD +#net PPORT_d<1> loc=P15 | IOSTANDARD = LVCMOS33 ; # FLASH_A<9> / PPORT_CLK +#net PPORT_d<2> loc=R16 | IOSTANDARD = LVCMOS33 ; # FLASH_A<10> / PPORT_DIN<0> +#net PPORT_d<3> loc=P14 | IOSTANDARD = LVCMOS33 ; # FLASH_A<11> / PPORT_DIN<1> +#net PPORT_d<4> loc=P13 | IOSTANDARD = LVCMOS33 ; # FLASH_A<12> / PPORT_DIN<2> +#net PPORT_d<5> loc=N12 | IOSTANDARD = LVCMOS33 ; # FLASH_A<13> / PPORT_DIN<3> +##net PPORT_d<6> loc=T14 | IOSTANDARD = LVCMOS33 ; # FLASH_A<14> +##net PPORT_d<7> loc=R13 | IOSTANDARD = LVCMOS33 ; # FLASH_A<15> +# +#net PPORT_s<3> loc=N5 | IOSTANDARD = LVCMOS33 ; # FLASH_A<0> / PPORT_DOUT<0> +#net PPORT_s<4> loc=K14 | IOSTANDARD = LVCMOS33 ; # FLASH_A<1> / PPORT_DOUT<1> +#net PPORT_s<5> loc=K13 | IOSTANDARD = LVCMOS33 ; # FLASH_A<2> / PPORT_DOUT<2> +#net PPORT_s<6> loc=T10 | IOSTANDARD = LVCMOS33 ; # / PPORT_DOUT<3> +# +######################################################## +# +# XST3.0 pins +# +######################################################## +# +# BAR LED +# +#net BAR<1> loc=L5 | IOSTANDARD = LVCMOS33 ; # bar led 1, PB_A0 +#net BAR<2> loc=N2 | IOSTANDARD = LVCMOS33 ; # bar led 2, PB_A1 +#net BAR<3> loc=M3 | IOSTANDARD = LVCMOS33 ; # bar led 3, PB_A2 +#net BAR<4> loc=N1 | IOSTANDARD = LVCMOS33 ; # bar led 4, PB_A3 +#net BAR<5> loc=T13 | IOSTANDARD = LVCMOS33 ; # bar led 5, PB_A4 +#net BAR<6> loc=L15 | IOSTANDARD = LVCMOS33 ; # bar led 6, ETHER_IRQ +#net BAR<7> loc=J13 | IOSTANDARD = LVCMOS33 ; # bar led 7, USB_IRQ_N +#net BAR<8> loc=H15 | IOSTANDARD = LVCMOS33 ; # bar led 8, IDE_IRQ +#net BAR<9> loc=J16 | IOSTANDARD = LVCMOS33 ; # bar led 9, SLOT1_IRQ +#net BAR<10> loc=J14 | IOSTANDARD = LVCMOS33 ; # bar led 10, SLOT2_IRQ +# +# Push Buttons +# +#net PB1_N loc=H4 | IOSTANDARD = LVCMOS33 ; # Shared with PB_D15 +#net PB2_N loc=L5 | IOSTANDARD = LVCMOS33 ; # Shared with BAR1, PB_A0 +#net PB3_N loc=N2 | IOSTANDARD = LVCMOS33 ; # Shared with BAR2, PB_A1 +#net PB4_N loc=M3 | IOSTANDARD = LVCMOS33 ; # Shared with BAR3, PB_A2 +# +# RS232 PORT +# +net RS232_TXD loc=J2 | IOSTANDARD = LVCMOS33 ; # RS232 TD pin 3 +#net RS232_RXD loc=G5 | IOSTANDARD = LVCMOS33 ; # RS232 RD pin 2 +#net RS232_CTS loc=D1 | IOSTANDARD = LVCMOS33 ; # RS232 CTS +#net RS232_RTS loc=F4 | IOSTANDARD = LVCMOS33 ; # RS232 RTS +# +# 16 Bit Peripheral Bus +# +# 5-bit Peripheral address bus +net PB_A<0> loc=L5 | IOSTANDARD = LVCMOS33 ; # Shared with BAR1, PB2 +net PB_A<1> loc=N2 | IOSTANDARD = LVCMOS33 ; # Shared with BAR2, PB3 +net PB_A<2> loc=M3 | IOSTANDARD = LVCMOS33 ; # Shared with BAR3, PB4 +net PB_A<3> loc=N1 | IOSTANDARD = LVCMOS33 ; # Shared with BAR4 +net PB_A<4> loc=T13 | IOSTANDARD = LVCMOS33 ; # Shared with BAR5 +# 16-bit peripheral data bus +net PB_D<0> loc=P12 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW1 +net PB_D<1> loc=J1 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW2 +net PB_D<2> loc=H1 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW3 +net PB_D<3> loc=H3 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW4 +net PB_D<4> loc=G2 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW5 +net PB_D<5> loc=K15 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW6 +net PB_D<6> loc=K16 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW7 +net PB_D<7> loc=F15 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW8 +net PB_D<8> loc=E2 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_A +net PB_D<9> loc=E1 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_B +net PB_D<10> loc=F3 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_C +net PB_D<11> loc=F2 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_D +net PB_D<12> loc=G4 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_E +net PB_D<13> loc=G3 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_F +net PB_D<14> loc=G1 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_G +net PB_D<15> loc=H4 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_DP, PB1 +net PB_RD_N loc=P2 | IOSTANDARD = LVCMOS33 ; # disk I/O read control +net PB_WR_N loc=R1 | IOSTANDARD = LVCMOS33 ; # disk I/O write control +net RESET_TRIGGER loc=D15 | IOSTANDARD = LVCMOS33 ; # Reset RESET_TRIGGER# +# +# IDE Interface +# +#net IDE_CS0_N loc=G15 | IOSTANDARD = LVCMOS33 ; # disk register-bank select +#net IDE_CS1_N loc=G14 | IOSTANDARD = LVCMOS33 ; # disk register-bank select +#net IDE_DMACK_N loc=K1 | IOSTANDARD = LVCMOS33 ; # (out) IDE DMA acknowledge +#net IDE_DMARQ loc=L4 | IOSTANDARD = LVCMOS33 ; # (in) IDE DMA request +#net IDE_IORDY loc=L2 | IOSTANDARD = LVCMOS33 ; # (in) IDE IO ready +#net IDE_IRQ loc=H15 | IOSTANDARD = LVCMOS33 ; # (in) IDE interrupt # shared with BAR8 +# +# Ethernet Controller +# Disable if not used +# +net ether_cs_n loc=G13 | IOSTANDARD = LVCMOS33 ; # (out)Ethernet chip-enable +net ether_aen loc=E14 | IOSTANDARD = LVCMOS33 ; # (out) Ethernet address enable not +net ether_bhe_n loc=J3 | IOSTANDARD = LVCMOS33 ; # (out) Ethernet bus high enable +net ether_clk loc=R9 | IOSTANDARD = LVCMOS33 ; # (in) Ethernet clock +net ether_irq loc=L15 | IOSTANDARD = LVCMOS33 ; # (in) Ethernet irq - Shared with BAR6 +net ether_rdy loc=M2 | IOSTANDARD = LVCMOS33 ; # (in) Ethernet ready +# +# Expansion slots +# +#net slot1_cs_n loc=E15 | IOSTANDARD = LVCMOS33 ; # (out) +#net slot1_irq loc=J16 | IOSTANDARD = LVCMOS33 ; # (in) Shared with BAR9 +#net slot2_cs_n loc=D16 | IOSTANDARD = LVCMOS33 ; # (out) +#net slot2_irq loc=J14 | IOSTANDARD = LVCMOS33 ; # (in) Shared with BAR10 +# +# Audio codec +# +#net audio_lrck loc=R12 | IOSTANDARD = LVCMOS33 ; # (out) +#net audio_mclk loc=P11 | IOSTANDARD = LVCMOS33 ; # (out) +#net audio_sclk loc=T12 | IOSTANDARD = LVCMOS33 ; # (out) +#net audio_sdti loc=M10 | IOSTANDARD = LVCMOS33 ; # (out) +#net audio_sdto loc=K5 | IOSTANDARD = LVCMOS33 ; # (in) +# +# i2c +# +#net i2c_scl loc=F5 | IOSTANDARD = LVCMOS33 ; #(out) +#net i2c_sda loc=D2 | IOSTANDARD = LVCMOS33 ; # (in/out) +# +# USB +# +#NET USB_CLK LOC=M1 | IOSTANDARD = LVCMOS33 ; # (IN) +#NET USB_IRQ_N LOC=J13 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with BAR7 +#NET USB_SUSPEND LOC=l3 | IOSTANDARD = LVCMOS33 ; # (IN) +# +# VIDEO DIGITIZER +# +#NET VIDIN_AVID LOC= | IOSTANDARD = LVCMOS33 ; # (IN) +#NET VIDIN_CLK LOC=H16 | IOSTANDARD = LVCMOS33 ; # (IN) +#NET VIDIN_FID LOC= | IOSTANDARD = LVCMOS33 ; # (IN) +#NET VIDIN_HSYNC LOC= | IOSTANDARD = LVCMOS33 ; # (IN) +#NET VIDIN_IRQ LOC= | IOSTANDARD = LVCMOS33 ; # (IN) +#NET VIDIN_VSYNC LOC= | IOSTANDARD = LVCMOS33 ; # (IN) +#NET VIDIN_Y<0> LOC=H14 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_A +#NET VIDIN_Y<1> LOC=M4 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_B +#NET VIDIN_Y<2> LOC=P1 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_C +#NET VIDIN_Y<3> LOC=N3 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_D +#NET VIDIN_Y<4> LOC=M15 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_E +#NET VIDIN_Y<5> LOC=H13 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_F +#NET VIDIN_Y<6> LOC=G16 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_G +#NET VIDIN_Y<7> LOC=N15 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_DP +# +# Timing Constraints +# +NET "CLKA" TNM_NET="CLKA"; +TIMESPEC "TS_clk"=PERIOD "CLKA" 10 ns HIGH 50 %; diff --git a/docs/j1demo/synth/xilinx.mk b/docs/j1demo/synth/xilinx.mk new file mode 100644 index 0000000..c692fe7 --- /dev/null +++ b/docs/j1demo/synth/xilinx.mk @@ -0,0 +1,174 @@ +# The top level module should define the variables below then include +# this file. The files listed should be in the same directory as the +# Makefile. +# +# variable description +# ---------- ------------- +# project project name (top level module should match this name) +# top_module top level module of the project +# libdir path to library directory +# libs library modules used +# vfiles all local .v files +# xilinx_cores all local .xco files +# vendor vendor of FPGA (xilinx, altera, etc.) +# family FPGA device family (spartan3e) +# part FPGA part name (xc4vfx12-10-sf363) +# flashsize size of flash for mcs file (16384) +# optfile (optional) xst extra opttions file to put in .scr +# map_opts (optional) options to give to map +# par_opts (optional) options to give to par +# intstyle (optional) intstyle option to all tools +# +# files description +# ---------- ------------ +# $(project).ucf ucf file +# +# Library modules should have a modules.mk in their root directory, +# namely $(libdir)//module.mk, that simply adds to the vfiles +# and xilinx_cores variable. +# +# all the .xco files listed in xilinx_cores will be generated with core, with +# the resulting .v and .ngc files placed back in the same directory as +# the .xco file. +# +# TODO: .xco files are device dependant, should use a template based system + +coregen_work_dir ?= ./coregen-tmp +map_opts ?= -timing -ol high -detail -pr b -register_duplication -w +par_opts ?= -ol high +isedir ?= /opt/Xilinx/11.1/ISE +xil_env ?= . $(isedir)/settings32.sh +flashsize ?= 8192 + +libmks = $(patsubst %,$(libdir)/%/module.mk,$(libs)) +mkfiles = Makefile $(libmks) xilinx.mk +include $(libmks) + +corengcs = $(foreach core,$(xilinx_cores),$(core:.xco=.ngc)) +local_corengcs = $(foreach ngc,$(corengcs),$(notdir $(ngc))) +vfiles += $(foreach core,$(xilinx_cores),$(core:.xco=.v)) +junk += $(local_corengcs) + +.PHONY: default xilinx_cores clean twr etwr +default: $(project).bit $(project).mcs +xilinx_cores: $(corengcs) +twr: $(project).twr +etwr: $(project)_err.twr + +define cp_template +$(2): $(1) + cp $(1) $(2) +endef +$(foreach ngc,$(corengcs),$(eval $(call cp_template,$(ngc),$(notdir $(ngc))))) + +%.ngc %.v: %.xco + @echo "=== rebuilding $@" + if [ -d $(coregen_work_dir) ]; then \ + rm -rf $(coregen_work_dir)/*; \ + else \ + mkdir -p $(coregen_work_dir); \ + fi + cd $(coregen_work_dir); \ + $(xil_env); \ + coregen -b $$OLDPWD/$<; \ + cd - + xcodir=`dirname $<`; \ + basename=`basename $< .xco`; \ + if [ ! -r $(coregen_work_dir/$$basename.ngc) ]; then \ + echo "'$@' wasn't created."; \ + exit 1; \ + else \ + cp $(coregen_work_dir)/$$basename.v $(coregen_work_dir)/$$basename.ngc $$xcodir; \ + fi +junk += $(coregen_work_dir) + +date = $(shell date +%F-%H-%M) + +# some common junk +junk += *.xrpt + +programming_files: $(project).bit $(project).mcs + mkdir -p $@/$(date) + mkdir -p $@/latest + for x in .bit .mcs .cfi _bd.bmm; do cp $(project)$$x $@/$(date)/$(project)$$x; cp $(project)$$x $@/latest/$(project)$$x; done + $(xil_env); xst -help | head -1 | sed 's/^/#/' | cat - $(project).scr > $@/$(date)/$(project).scr + +$(project).mcs: $(project).bit + $(xil_env); \ + promgen -w -s $(flashsize) -p mcs -o $@ -u 0 $^ +junk += $(project).mcs $(project).cfi $(project).prm + +$(project).bit: $(project)_par.ncd + $(xil_env); \ + bitgen $(intstyle) -g DriveDone:yes -g StartupClk:Cclk -w $(project)_par.ncd $(project).bit +junk += $(project).bgn $(project).bit $(project).drc $(project)_bd.bmm + + +$(project)_par.ncd: $(project).ncd + $(xil_env); \ + if par $(intstyle) $(par_opts) -w $(project).ncd $(project)_par.ncd; then \ + :; \ + else \ + $(MAKE) etwr; \ + fi +junk += $(project)_par.ncd $(project)_par.par $(project)_par.pad +junk += $(project)_par_pad.csv $(project)_par_pad.txt +junk += $(project)_par.grf $(project)_par.ptwx +junk += $(project)_par.unroutes $(project)_par.xpi + +$(project).ncd: $(project).ngd + if [ -r $(project)_par.ncd ]; then \ + cp $(project)_par.ncd smartguide.ncd; \ + smartguide="-smartguide smartguide.ncd"; \ + else \ + smartguide=""; \ + fi; \ + $(xil_env); \ + map $(intstyle) $(map_opts) $$smartguide $< +junk += $(project).ncd $(project).pcf $(project).ngm $(project).mrp $(project).map +junk += smartguide.ncd $(project).psr +junk += $(project)_summary.xml $(project)_usage.xml + +$(project).ngd: $(project).ngc $(project).ucf $(project).bmm + $(xil_env); ngdbuild $(intstyle) $(project).ngc -bm $(project).bmm +junk += $(project).ngd $(project).bld + +$(project).ngc: $(vfiles) $(local_corengcs) $(project).scr $(project).prj + $(xil_env); xst $(intstyle) -ifn $(project).scr +junk += xlnx_auto* $(top_module).lso $(project).srp +junk += netlist.lst xst $(project).ngc + +$(project).prj: $(vfiles) $(mkfiles) + for src in $(vfiles); do echo "verilog work $$src" >> $(project).tmpprj; done + sort -u $(project).tmpprj > $(project).prj + rm -f $(project).tmpprj +junk += $(project).prj + +optfile += $(wildcard $(project).opt) +top_module ?= $(project) +$(project).scr: $(optfile) $(mkfiles) ./xilinx.opt + echo "run" > $@ + echo "-p $(part)" >> $@ + echo "-top $(top_module)" >> $@ + echo "-ifn $(project).prj" >> $@ + echo "-ofn $(project).ngc" >> $@ + cat ./xilinx.opt $(optfile) >> $@ +junk += $(project).scr + +$(project).post_map.twr: $(project).ncd + $(xil_env); trce -e 10 $< $(project).pcf -o $@ +junk += $(project).post_map.twr $(project).post_map.twx smartpreview.twr + +$(project).twr: $(project)_par.ncd + $(xil_env); trce $< $(project).pcf -o $(project).twr +junk += $(project).twr $(project).twx smartpreview.twr + +$(project)_err.twr: $(project)_par.ncd + $(xil_env); trce -e 10 $< $(project).pcf -o $(project)_err.twr +junk += $(project)_err.twr $(project)_err.twx + +.gitignore: $(mkfiles) + echo programming_files $(junk) | sed 's, ,\n,g' > .gitignore + +clean:: + rm -rf $(junk) diff --git a/docs/j1demo/synth/xilinx.opt b/docs/j1demo/synth/xilinx.opt new file mode 100644 index 0000000..7fe9d8b --- /dev/null +++ b/docs/j1demo/synth/xilinx.opt @@ -0,0 +1,42 @@ +-ifmt mixed +-ofmt NGC +-opt_mode speed +-opt_level 1 +-iuc NO +-keep_hierarchy no +-netlist_hierarchy as_optimized +-rtlview no +-glob_opt AllClockNets +-read_cores yes +-write_timing_constraints NO +-cross_clock_analysis NO +-hierarchy_separator / +-bus_delimiter <> +-case maintain +-slice_utilization_ratio 100 +-bram_utilization_ratio 100 +#-dsp_utilization_ratio 100 +-safe_implementation No +-fsm_extract YES +-fsm_encoding Auto +-fsm_style lut +-ram_extract Yes +-ram_style Auto +-rom_extract Yes +-rom_style Auto +-shreg_extract YES +-auto_bram_packing NO +-resource_sharing YES +-async_to_sync NO +#-use_dsp48 auto +-iobuf YES +-max_fanout 500 +-register_duplication YES +-register_balancing No +-optimize_primitives NO +-use_clock_enable Auto +-use_sync_set Auto +-use_sync_reset Auto +-iob auto +-equivalent_register_removal YES +-slice_utilization_ratio_maxmargin 5 diff --git a/docs/j1demo/verilog/ck_div.v b/docs/j1demo/verilog/ck_div.v new file mode 100644 index 0000000..a753804 --- /dev/null +++ b/docs/j1demo/verilog/ck_div.v @@ -0,0 +1,41 @@ +module ck_div( +input ck_in, +output ck_out, +input sys_rst_i +//output locked; +); +parameter DIV_BY = 1; +parameter MULT_BY = 1; + +wire ck_fb; + +//DCM #( +// .CLKDV_DIVIDE(DIV_BY), +// .DFS_FREQUENCY_MODE("LOW"), // HIGH or LOW frequency mode for frequency synthesis +// .DUTY_CYCLE_CORRECTION("TRUE"), // Duty cycle correction, TRUE or FALSE +// .STARTUP_WAIT("TRUE") // Delay configuration DONE until DCM LOCK, TRUE/FALSE +//) DCM_inst ( +// .CLK0(ck_fb), +// .CLKDV(ck_out), +// .CLKFB(ck_fb), // DCM clock feedback +// .CLKIN(ck_in), // Clock input (from IBUFG, BUFG or DCM) +// .RST(0) +//); + +DCM #( + .CLKFX_MULTIPLY(MULT_BY), + .CLKFX_DIVIDE(DIV_BY), + .DFS_FREQUENCY_MODE("LOW"), // HIGH or LOW frequency mode for frequency synthesis + .DUTY_CYCLE_CORRECTION("TRUE"), // Duty cycle correction, TRUE or FALSE + .STARTUP_WAIT("TRUE") // Delay configuration DONE until DCM LOCK, TRUE/FALSE +) DCM_inst ( + .CLK0(ck_fb), + .CLKFX(ck_out), + .CLKFB(ck_fb), // DCM clock feedback + .CLKIN(ck_in), // Clock input (from IBUFG, BUFG or DCM) + .RST(0) +); + +//BUFG BUFG_inst(.I(ck_int), .O(ck_out)); + +endmodule diff --git a/docs/j1demo/verilog/j1.v b/docs/j1demo/verilog/j1.v new file mode 100644 index 0000000..861cb3c --- /dev/null +++ b/docs/j1demo/verilog/j1.v @@ -0,0 +1,187 @@ +module j1( + input sys_clk_i, input sys_rst_i, input [15:0] io_din, + output io_rd, output io_wr, output [15:0] io_addr, output [15:0] io_dout); + + wire [15:0] insn; + wire [15:0] immediate = { 1'b0, insn[14:0] }; + + wire [15:0] ramrd; + + reg [4:0] dsp; // Data stack pointer + reg [4:0] _dsp; + reg [15:0] st0; // Return stack pointer + reg [15:0] _st0; + wire _dstkW; // D stack write + + reg [12:0] pc; + reg [12:0] _pc; + reg [4:0] rsp; + reg [4:0] _rsp; + reg _rstkW; // R stack write + reg [15:0] _rstkD; + wire _ramWE; // RAM write enable + + wire [15:0] pc_plus_1; + assign pc_plus_1 = pc + 1; + + // The D and R stacks + reg [15:0] dstack[0:31]; + reg [15:0] rstack[0:31]; + always @(posedge sys_clk_i) + begin + if (_dstkW) + dstack[_dsp] = st0; + if (_rstkW) + rstack[_rsp] = _rstkD; + end + wire [15:0] st1 = dstack[dsp]; + wire [15:0] rst0 = rstack[rsp]; + + // st0sel is the ALU operation. For branch and call the operation + // is T, for 0branch it is N. For ALU ops it is loaded from the instruction + // field. + reg [3:0] st0sel; + always @* + begin + case (insn[14:13]) + 2'b00: st0sel = 0; // ubranch + 2'b10: st0sel = 0; // call + 2'b01: st0sel = 1; // 0branch + 2'b11: st0sel = insn[11:8]; // ALU + default: st0sel = 4'bxxxx; + endcase + end + +`define RAMS 3 + + genvar i; + +`define w (16 >> `RAMS) +`define w1 (`w - 1) + + generate + for (i = 0; i < (1 << `RAMS); i=i+1) begin : ram + // RAMB16_S18_S18 + RAMB16_S2_S2 + ram( + .DIA(0), + // .DIPA(0), + .DOA(insn[`w*i+`w1:`w*i]), + .WEA(0), + .ENA(1), + .CLKA(sys_clk_i), + .ADDRA({_pc}), + + .DIB(st1[`w*i+`w1:`w*i]), + // .DIPB(2'b0), + .WEB(_ramWE & (_st0[15:14] == 0)), + .ENB(|_st0[15:14] == 0), + .CLKB(sys_clk_i), + .ADDRB(_st0[15:1]), + .DOB(ramrd[`w*i+`w1:`w*i])); + end + endgenerate + + // Compute the new value of T. + always @* + begin + if (insn[15]) + _st0 = immediate; + else + case (st0sel) + 4'b0000: _st0 = st0; + 4'b0001: _st0 = st1; + 4'b0010: _st0 = st0 + st1; + 4'b0011: _st0 = st0 & st1; + 4'b0100: _st0 = st0 | st1; + 4'b0101: _st0 = st0 ^ st1; + 4'b0110: _st0 = ~st0; + 4'b0111: _st0 = {16{(st1 == st0)}}; + 4'b1000: _st0 = {16{($signed(st1) < $signed(st0))}}; + 4'b1001: _st0 = st1 >> st0[3:0]; + 4'b1010: _st0 = st0 - 1; + 4'b1011: _st0 = rst0; + 4'b1100: _st0 = |st0[15:14] ? io_din : ramrd; + 4'b1101: _st0 = st1 << st0[3:0]; + 4'b1110: _st0 = {rsp, 3'b000, dsp}; + 4'b1111: _st0 = {16{(st1 < st0)}}; + default: _st0 = 16'hxxxx; + endcase + end + + wire is_alu = (insn[15:13] == 3'b011); + wire is_lit = (insn[15]); + + assign io_rd = (is_alu & (insn[11:8] == 4'hc)); + assign io_wr = _ramWE; + assign io_addr = st0; + assign io_dout = st1; + + assign _ramWE = is_alu & insn[5]; + assign _dstkW = is_lit | (is_alu & insn[7]); + + wire [1:0] dd = insn[1:0]; // D stack delta + wire [1:0] rd = insn[3:2]; // R stack delta + + always @* + begin + if (is_lit) begin // literal + _dsp = dsp + 1; + _rsp = rsp; + _rstkW = 0; + _rstkD = _pc; + end else if (is_alu) begin + _dsp = dsp + {dd[1], dd[1], dd[1], dd}; + _rsp = rsp + {rd[1], rd[1], rd[1], rd}; + _rstkW = insn[6]; + _rstkD = st0; + end else begin // jump/call + // predicated jump is like DROP + if (insn[15:13] == 3'b001) begin + _dsp = dsp - 1; + end else begin + _dsp = dsp; + end + if (insn[15:13] == 3'b010) begin // call + _rsp = rsp + 1; + _rstkW = 1; + _rstkD = {pc_plus_1[14:0], 1'b0}; + end else begin + _rsp = rsp; + _rstkW = 0; + _rstkD = _pc; + end + end + end + + always @* + begin + if (sys_rst_i) + _pc = pc; + else + if ((insn[15:13] == 3'b000) | + ((insn[15:13] == 3'b001) & (|st0 == 0)) | + (insn[15:13] == 3'b010)) + _pc = insn[12:0]; + else if (is_alu & insn[12]) + _pc = rst0[15:1]; + else + _pc = pc_plus_1; + end + + always @(posedge sys_clk_i) + begin + if (sys_rst_i) begin + pc <= 0; + dsp <= 0; + st0 <= 0; + rsp <= 0; + end else begin + dsp <= _dsp; + pc <= _pc; + st0 <= _st0; + rsp <= _rsp; + end + end + +endmodule // j1 diff --git a/docs/j1demo/verilog/rams.v b/docs/j1demo/verilog/rams.v new file mode 100644 index 0000000..620a831 --- /dev/null +++ b/docs/j1demo/verilog/rams.v @@ -0,0 +1,36 @@ +module ram8_8( + input [7:0] dia, + output [7:0] doa, + input wea, + input ena, + input clka, + input [10:0] addra, + + input [7:0] dib, + output [7:0] dob, + input web, + input enb, + input clkb, + input [10:0] addrb + ); +genvar i; +generate + for (i = 0; i < 4; i=i+1) begin : ramx + RAMB16_S2_S2 ramx( + .DIA(dia[2 * i + 1: 2 * i]), + .WEA(wea), + .ENA(ena), + .CLKA(clka), + .ADDRA(addra), + .DOA(doa[2 * i + 1: 2 * i]), + + .DIB(dib[2 * i + 1: 2 * i]), + .WEB(web), + .ENB(enb), + .CLKB(clkb), + .ADDRB(addrb), + .DOB(dob[2 * i + 1: 2 * i]) + ); + end +endgenerate +endmodule diff --git a/docs/j1demo/verilog/top.v b/docs/j1demo/verilog/top.v new file mode 100644 index 0000000..9c21431 --- /dev/null +++ b/docs/j1demo/verilog/top.v @@ -0,0 +1,667 @@ +module bidir_io( + input dir, + input d, + inout port); + assign port = (dir) ? 1'bz : d; +endmodule + +module saturating_adder( + input [7:0] a, + input [7:0] b, + input [7:0] c, + input [7:0] d, + input [7:0] e, + input [7:0] f, + input [7:0] g, + input [7:0] h, + input [7:0] i, + output [7:0] sum); + +wire [10:0] fullsum = a + b + c + d + e + f + g + h + i; +assign sum = |fullsum[10:8] ? 255 : fullsum[7:0]; +endmodule + +module partial( + input [7:0] original, + input alpha, + input [2:0] scale, // by quarters + output [7:0] result +); +assign result = alpha ? ((scale[0] ? original[7:2] : 0) + + (scale[1] ? original[7:1] : 0) + + (scale[2] ? original : 0)) : 0; +endmodule + +module lfsre( + input clk, + output reg [16:0] lfsr); +wire d0; + +xnor(d0,lfsr[16],lfsr[13]); + +always @(posedge clk) begin + lfsr <= {lfsr[15:0],d0}; +end +endmodule + +module sprite( + pixel_clk, + picsel, + pixel_x, + pixel_y, + sx, sy, + write_data, write_address, write_en, write_clk, + brightness, + alpha +); + input pixel_clk; + input picsel; + input [9:0] pixel_x; + input [9:0] pixel_y; + input [9:0] sx; + input [9:0] sy; + input [8:0] write_data; + input [11:0] write_address; + input write_en; + input write_clk; + + output alpha; + output [7:0] brightness; + + wire [9:0] local_x = pixel_x - sx; + wire [9:0] local_y = pixel_y - sy; + wire [7:0] sprite_pixel; + RAMB16_S9_S9 spriteram( + .DIA(0), + // .DIPA(0), + .DOA(sprite_pixel), + .WEA(0), + .ENA(1), + .CLKA(pixel_clk), + .ADDRA({picsel, local_y[4:0], local_x[4:0]}), + + .ADDRB(write_address), + .DIPB(write_data[8]), + .DIB(write_data), + .WEB(write_en), + .ENB(1), + .CLKB(write_clk), + .DOB()); + wire sprite_outside = |(local_y[9:5]) | |(local_x[9:5]); + wire alpha = ~sprite_outside; + wire [7:0] brightness = sprite_pixel; // sprite_outside ? 0 : sprite_pixel; +endmodule + +module top( + // Outputs + // s, // Onboard LED + RS232_TXD, // RS232 transmit + RESET_TRIGGER, // RESET-TRIGGER# + + // Inputs + clka, + + pb_a, pb_d, pb_rd_n, pb_wr_n, + + ether_cs_n, ether_aen, ether_bhe_n, ether_clk, ether_irq, ether_rdy, + + // Flash + flash_a, flash_d, + flash_ce_n, flash_oe_n, flash_we_n, flash_byte_n, flash_rdy, flash_rst_n, + + // PS/2 Keyboard + ps2_clk, ps2_dat, + + // Pushbuttons + sw2_n, sw3_n, + + // VGA + vga_red, vga_green, vga_blue, vga_hsync_n, vga_vsync_n, + + ); + + // output [7:0] s; + output RS232_TXD; + output RESET_TRIGGER; + inout [4:0] pb_a; + output ether_cs_n; + output ether_aen; + output ether_bhe_n; + output pb_rd_n; + output pb_wr_n; + + input clka; + input ether_clk; + input ether_irq; + input ether_rdy; + + inout [15:0] pb_d; + + output [19:0] flash_a; + + inout [15:0] flash_d; + + output flash_ce_n; + output flash_oe_n; + output flash_we_n; + output flash_byte_n; + output flash_rdy; + output flash_rst_n; + + reg ps2_clk_dir; + reg ps2_dat_dir; + reg ps2_clk_d; + reg ps2_dat_d; + inout ps2_clk; + inout ps2_dat; + bidir_io ps2_clkb(.dir(ps2_clk_dir), .d(ps2_clk_d), .port(ps2_clk)); + bidir_io ps2_datb(.dir(ps2_dat_dir), .d(ps2_dat_d), .port(ps2_dat)); + + input sw2_n; + input sw3_n; + + output [2:0] vga_red; + output [2:0] vga_green; + output [2:0] vga_blue; + output vga_hsync_n; + output vga_vsync_n; + + wire j1_io_rd; + wire j1_io_wr; + wire [15:0] j1_io_addr; + reg [15:0] j1_io_din; + wire [15:0] j1_io_dout; + + wire sys_clk; + ck_div #(.DIV_BY(12), .MULT_BY(4)) sys_ck_gen(.ck_in(clka), .ck_out(sys_clk)); + + // ================================================ + // Hardware multiplier + + reg [15:0] mult_a; + reg [15:0] mult_b; + wire [31:0] mult_p; + MULT18X18 mulinsn(.A(mult_a), .B(mult_b), .P(mult_p)); +// MULT18X18SIO #( +// .AREG(0), +// .BREG(0), +// .PREG(0)) +// MULT18X18SIO( +// .A(mult_a), +// .B(mult_b), +// .P(mult_p)); + + // ================================================ + // 32-bit 1-MHz system clock + + reg [5:0] clockus; + wire [5:0] _clockus = (clockus == 32) ? 0 : (clockus + 1); + reg [31:0] clock; + wire [31:0] _clock = (clockus == 32) ? (clock + 1) : (clock); + + always @(posedge sys_clk) + begin + clockus <= _clockus; + clock <= _clock; + end + + // reg [7:0] s; + reg RS232_TXD; + reg RESET_TRIGGER; + + reg ether_cs_n; + reg ether_aen; + reg ether_bhe_n; + reg ddir; + + reg [15:0] pb_dout; + assign pb_d = (ddir) ? 16'bz : pb_dout; + reg pb_rd_n; + reg pb_wr_n; + + reg pb_a_dir; + reg [4:0] pb_aout; + assign pb_a = pb_a_dir ? 5'bz : pb_aout; + + reg flash_ddir; + reg [19:0] flash_a; + reg [15:0] flash_dout; + assign flash_d[14:0] = (flash_ddir) ? 15'bz : flash_dout[14:0]; + assign flash_d[15] = (flash_ddir & flash_byte_n) ? 1'bz : flash_dout[15]; + reg flash_ce_n; + reg flash_oe_n; + reg flash_we_n; + reg flash_byte_n; + reg flash_rdy; + reg flash_rst_n; + + reg [12:0] vga_scroll; + reg [13:0] vga_spritea; + reg [9:0] vga_spritex[7:0]; + reg [9:0] vga_spritey[7:0]; + reg vga_addsprites; + reg [10:0] vga_spritec0; + reg [10:0] vga_spritec1; + reg [10:0] vga_spritec2; + reg [10:0] vga_spritec3; + reg [10:0] vga_spritec4; + reg [10:0] vga_spritec5; + reg [10:0] vga_spritec6; + reg [10:0] vga_spritec7; + wire [9:0] vga_line; + reg [7:0] vga_spritesel; + + always @(posedge sys_clk) + begin + if (j1_io_wr) begin + case (j1_io_addr) + // 16'h4000: s <= j1_io_dout; + + 16'h4100: flash_ddir <= j1_io_dout; + 16'h4102: flash_ce_n <= j1_io_dout; + 16'h4104: flash_oe_n <= j1_io_dout; + 16'h4106: flash_we_n <= j1_io_dout; + 16'h4108: flash_byte_n <= j1_io_dout; + 16'h410a: flash_rdy <= j1_io_dout; + 16'h410c: flash_rst_n <= j1_io_dout; + 16'h410e: flash_a[15:0] <= j1_io_dout; + 16'h4110: flash_a[19:16] <= j1_io_dout; + 16'h4112: flash_dout <= j1_io_dout; + + 16'h4200: ps2_clk_d <= j1_io_dout; + 16'h4202: ps2_dat_d <= j1_io_dout; + 16'h4204: ps2_clk_dir <= j1_io_dout; + 16'h4206: ps2_dat_dir <= j1_io_dout; + + 16'h4300: vga_scroll <= j1_io_dout; + 16'h4302: vga_spritea <= j1_io_dout; + // 16'h4304: vga_spriteport + 16'h4308: vga_addsprites <= j1_io_dout; + + 16'h4400: vga_spritex[0] <= j1_io_dout; + 16'h4402: vga_spritey[0] <= j1_io_dout; + 16'h4404: vga_spritex[1] <= j1_io_dout; + 16'h4406: vga_spritey[1] <= j1_io_dout; + 16'h4408: vga_spritex[2] <= j1_io_dout; + 16'h440a: vga_spritey[2] <= j1_io_dout; + 16'h440c: vga_spritex[3] <= j1_io_dout; + 16'h440e: vga_spritey[3] <= j1_io_dout; + 16'h4410: vga_spritex[4] <= j1_io_dout; + 16'h4412: vga_spritey[4] <= j1_io_dout; + 16'h4414: vga_spritex[5] <= j1_io_dout; + 16'h4416: vga_spritey[5] <= j1_io_dout; + 16'h4418: vga_spritex[6] <= j1_io_dout; + 16'h441a: vga_spritey[6] <= j1_io_dout; + 16'h441c: vga_spritex[7] <= j1_io_dout; + 16'h441e: vga_spritey[7] <= j1_io_dout; + + 16'h4420: vga_spritec0 <= j1_io_dout; + 16'h4422: vga_spritec1 <= j1_io_dout; + 16'h4424: vga_spritec2 <= j1_io_dout; + 16'h4426: vga_spritec3 <= j1_io_dout; + 16'h4428: vga_spritec4 <= j1_io_dout; + 16'h442a: vga_spritec5 <= j1_io_dout; + 16'h442c: vga_spritec6 <= j1_io_dout; + 16'h442e: vga_spritec7 <= j1_io_dout; + + 16'h4430: vga_spritesel[0] <= j1_io_dout; + 16'h4432: vga_spritesel[1] <= j1_io_dout; + 16'h4434: vga_spritesel[2] <= j1_io_dout; + 16'h4436: vga_spritesel[3] <= j1_io_dout; + 16'h4438: vga_spritesel[4] <= j1_io_dout; + 16'h443a: vga_spritesel[5] <= j1_io_dout; + 16'h443c: vga_spritesel[6] <= j1_io_dout; + 16'h443e: vga_spritesel[7] <= j1_io_dout; + + 16'h5000: RS232_TXD <= j1_io_dout; + 16'h5001: RESET_TRIGGER <= j1_io_dout; + 16'h5100: ether_cs_n <= j1_io_dout; + 16'h5101: ether_aen <= j1_io_dout; + 16'h5102: ether_bhe_n <= j1_io_dout; + 16'h5103: pb_aout <= j1_io_dout; + 16'h5104: ddir <= j1_io_dout; + 16'h5105: pb_dout <= j1_io_dout; + 16'h5106: pb_rd_n <= j1_io_dout; + 16'h5107: pb_wr_n <= j1_io_dout; + // 5108 + // 5109 + 16'h510a: pb_a_dir <= j1_io_dout; + + 16'h6100: mult_a <= j1_io_dout; + 16'h6102: mult_b <= j1_io_dout; + + endcase + end + end + + always @* + begin + case (j1_io_addr) + 16'h4112: j1_io_din = flash_d; + + 16'h4200: j1_io_din = ps2_clk; + 16'h4202: j1_io_din = ps2_dat; + + 16'h4300: j1_io_din = vga_scroll; + 16'h4306: j1_io_din = vga_line; + + 16'h4500: j1_io_din = sw2_n; + 16'h4502: j1_io_din = sw3_n; + + 16'h5103: j1_io_din = pb_a; + 16'h5105: j1_io_din = pb_d; + 16'h5108: j1_io_din = ether_rdy; + 16'h5109: j1_io_din = ether_irq; + + 16'h6000: j1_io_din = clock[15:0]; + 16'h6002: j1_io_din = clock[31:16]; + + 16'h6104: j1_io_din = mult_p[15:0]; + 16'h6106: j1_io_din = mult_p[31:16]; + + default: j1_io_din = 16'h0946; + endcase + end + + reg [10:0] reset_count = 1000; + wire sys_rst_i = |reset_count; + + always @(posedge sys_clk) begin + if (sys_rst_i) + reset_count <= reset_count - 1; + end + + j1 j1( + // Inputs + .sys_clk_i (sys_clk), + .sys_rst_i (sys_rst_i), + + .io_rd(j1_io_rd), + .io_wr(j1_io_wr), + .io_addr(j1_io_addr), + .io_din(j1_io_din), + .io_dout(j1_io_dout) + ); + + /* + uart uart( + // Outputs + .uart_busy (uart_busy), + .uart_tx (RS232_TXD), + // Inputs + .uart_wr_i (j1_uart_we), + .uart_dat_i (j1_io_dout), + .sys_clk_i (sys_clk_i), + .sys_rst_i (sys_rst_i)); + */ + + // ================================================ + // VGA + + wire vga_clk; + ck_div #(.DIV_BY(4), .MULT_BY(2)) vga_ck_gen(.ck_in(clka), .ck_out(vga_clk)); + + reg [10:0] CounterX; + reg [9:0] CounterY; + wire CounterXmaxed = (CounterX==1040); + + always @(posedge vga_clk) + if(CounterXmaxed) + CounterX <= 0; + else + CounterX <= CounterX + 1; + + wire [9:0] _CounterY = (CounterY == 666) ? 0 : (CounterY + 1); + always @(posedge vga_clk) + if(CounterXmaxed) + CounterY <= _CounterY; + + reg vga_HS, vga_VS; + always @(posedge vga_clk) + begin + vga_HS <= (53 <= CounterX) & (CounterX < (53 + 120)); + vga_VS <= (35 <= CounterY) & (CounterY < (35 + 6)); + end + + // Character RAM is 2K + wire [10:0] xx = (CounterX - (53 + 120 + 61)); + wire [10:0] xx_1 = (CounterX - (53 + 120 + 61) + 1); + // standard timing, except (600-512)/2=44 at top and bottom + wire [10:0] yy = (CounterY - (35 + 6 + 21 + 44)); + wire [10:0] column = xx[10:1]; + wire [10:0] column_1 = xx_1[10:1]; + wire [10:0] row = yy[10:1]; + wire [7:0] glyph; + + wire [10:0] picaddr = {(row[7:3] + vga_scroll[4:0]), column_1[8:3]}; + +// genvar i; +// generate +// for (i = 0; i < 4; i=i+1) begin : picture +// RAMB16_S2_S2 picture( +// .DIA(0), +// // .DIPA(0), +// .DOA(glyph[2 * i + 1: 2 * i]), +// .WEA(0), +// .ENA(1), +// .CLKA(vga_clk), +// .ADDRA(spicaddr), +// +// // .DIPB(0), +// .DIB(j1_io_dout[2 * i + 1: 2 * i]), +// .WEB(j1_io_wr & (j1_io_addr[15:13] == 3'b100)), +// .ENB(1), +// .CLKB(sys_clk), +// .ADDRB(j1_io_addr), +// .DOB()); +// end +// endgenerate + +// RAMB16_S9_S9 picture( +// .DIA(0), +// // .DIPA(0), +// .DOA(glyph), +// .WEA(0), +// .ENA(1), +// .CLKA(vga_clk), +// .ADDRA(picaddr), +// +// .DIPB(0), +// .DIB(j1_io_dout), +// .WEB(j1_io_wr & (j1_io_addr[15:13] == 3'b100)), +// .ENB(1), +// .CLKB(sys_clk), +// .ADDRB(j1_io_addr), +// .DOB()); + wire pic_w = j1_io_wr & (j1_io_addr[15:13] == 3'b100); + ram8_8 picture( + .dia(0), .doa(glyph), .wea(0), .ena(1), .clka(vga_clk), .addra(picaddr), + .dib(j1_io_dout), .web(pic_w), .enb(1), .clkb(sys_clk), .addrb(j1_io_addr)); + + wire charout; + RAMB16_S1_S9 chars( + .DIA(0), + // .DIPA(0), + .DOA(charout), + .WEA(0), + .ENA(1), + .CLKA(vga_clk), + .ADDRA({glyph, row[2:0], ~column[2:0]}), + + .DIPB(0), + .DIB(j1_io_dout), + // .DIPB(2'b0), + .WEB(j1_io_wr & (j1_io_addr[15:12] == 4'hf)), + .ENB(1), + .CLKB(sys_clk), + .ADDRB(j1_io_addr), + .DOB()); + + reg [10:0] regxx; + always @(posedge vga_clk) + begin + regxx <= xx; + end + + wire [63:0] sprite_pixels; + wire [7:0] alpha; + genvar i; + generate + for (i = 0; i < 8; i=i+1) begin : sprite_n + sprite sprite_n( + .pixel_clk(vga_clk), + .picsel(vga_spritesel[i]), + .pixel_x(regxx), + .pixel_y(yy), + .sx(vga_spritex[i]), + .sy(vga_spritey[i]), + .write_data(j1_io_dout), + .write_address(vga_spritea), + .write_en(j1_io_wr & (j1_io_addr == 16'h4304) & (vga_spritea[13:11] == i)), + .write_clk(sys_clk), + .alpha(alpha[i]), + .brightness(sprite_pixels[8*i+7:8*i])); + end + endgenerate + + // wire [10:0] brightsum = bright[0] + bright[1] + bright[2] + bright[3] + bright[4] + bright[5] + bright[6] + bright[7]; + // wire [7:0] brightness = |brightsum[10:8] ? 255 : brightsum[7:0]; + // wire [7:0] final_bright = |alpha ? 255 : 0; + + // wire [7:0] final_bright = sprite_pixels[39:32]; + + wire [7:0] sprite0 = sprite_pixels[7:0]; + wire [7:0] sprite1 = sprite_pixels[15:8]; + wire [7:0] sprite2 = sprite_pixels[23:16]; + wire [7:0] sprite3 = sprite_pixels[31:24]; + wire [7:0] sprite4 = sprite_pixels[39:32]; + wire [7:0] sprite5 = sprite_pixels[47:40]; + wire [7:0] sprite6 = sprite_pixels[55:48]; + wire [7:0] sprite7 = sprite_pixels[63:56]; + + reg [10:0] fullsum; + reg [7:0] final_bright; + + wire [16:0] lfsr; + lfsre lfsr0( + .clk(vga_clk), + .lfsr(lfsr)); + wire [7:0] charout8 = {8{charout}}; + wire [7:0] dither = {lfsr[0], lfsr[4], lfsr[8], lfsr[12], lfsr[16]} | charout8; + + wire [7:0] r0; + wire [7:0] r1; + wire [7:0] r2; + wire [7:0] r3; + wire [7:0] r4; + wire [7:0] r5; + wire [7:0] r6; + wire [7:0] r7; + wire [7:0] g0; + wire [7:0] g1; + wire [7:0] g2; + wire [7:0] g3; + wire [7:0] g4; + wire [7:0] g5; + wire [7:0] g6; + wire [7:0] g7; + wire [7:0] b0; + wire [7:0] b1; + wire [7:0] b2; + wire [7:0] b3; + wire [7:0] b4; + wire [7:0] b5; + wire [7:0] b6; + wire [7:0] b7; + + wire [2:0] spr0r = vga_spritec0[10:8]; + wire [2:0] spr1r = vga_spritec1[10:8]; + wire [2:0] spr2r = vga_spritec2[10:8]; + wire [2:0] spr3r = vga_spritec3[10:8]; + wire [2:0] spr4r = vga_spritec4[10:8]; + wire [2:0] spr5r = vga_spritec5[10:8]; + wire [2:0] spr6r = vga_spritec6[10:8]; + wire [2:0] spr7r = vga_spritec7[10:8]; + wire [2:0] spr0g = vga_spritec0[6:4]; + wire [2:0] spr1g = vga_spritec1[6:4]; + wire [2:0] spr2g = vga_spritec2[6:4]; + wire [2:0] spr3g = vga_spritec3[6:4]; + wire [2:0] spr4g = vga_spritec4[6:4]; + wire [2:0] spr5g = vga_spritec5[6:4]; + wire [2:0] spr6g = vga_spritec6[6:4]; + wire [2:0] spr7g = vga_spritec7[6:4]; + wire [2:0] spr0b = vga_spritec0[2:0]; + wire [2:0] spr1b = vga_spritec1[2:0]; + wire [2:0] spr2b = vga_spritec2[2:0]; + wire [2:0] spr3b = vga_spritec3[2:0]; + wire [2:0] spr4b = vga_spritec4[2:0]; + wire [2:0] spr5b = vga_spritec5[2:0]; + wire [2:0] spr6b = vga_spritec6[2:0]; + wire [2:0] spr7b = vga_spritec7[2:0]; + + partial pr0(sprite0, alpha[0], spr0r, r0); + partial pr1(sprite1, alpha[1], spr1r, r1); + partial pr2(sprite2, alpha[2], spr2r, r2); + partial pr3(sprite3, alpha[3], spr3r, r3); + partial pr4(sprite4, alpha[4], spr4r, r4); + partial pr5(sprite5, alpha[5], spr5r, r5); + partial pr6(sprite6, alpha[6], spr6r, r6); + partial pr7(sprite7, alpha[7], spr7r, r7); + + partial pg0(sprite0, alpha[0], spr0g, g0); + partial pg1(sprite1, alpha[1], spr1g, g1); + partial pg2(sprite2, alpha[2], spr2g, g2); + partial pg3(sprite3, alpha[3], spr3g, g3); + partial pg4(sprite4, alpha[4], spr4g, g4); + partial pg5(sprite5, alpha[5], spr5g, g5); + partial pg6(sprite6, alpha[6], spr6g, g6); + partial pg7(sprite7, alpha[7], spr7g, g7); + + partial pb0(sprite0, alpha[0], spr0b, b0); + partial pb1(sprite1, alpha[1], spr1b, b1); + partial pb2(sprite2, alpha[2], spr2b, b2); + partial pb3(sprite3, alpha[3], spr3b, b3); + partial pb4(sprite4, alpha[4], spr4b, b4); + partial pb5(sprite5, alpha[5], spr5b, b5); + partial pb6(sprite6, alpha[6], spr6b, b6); + partial pb7(sprite7, alpha[7], spr7b, b7); + + wire [7:0] sat_r; + saturating_adder add_r(r0, r1, r2, r3, r4, r5, r6, r7, dither, sat_r); + wire [7:0] sat_g; + saturating_adder add_g(g0, g1, g2, g3, g4, g5, g6, g7, dither, sat_g); + wire [7:0] sat_b; + saturating_adder add_b(b0, b1, b2, b3, b4, b5, b6, b7, dither, sat_b); + + always @* + begin + if(vga_addsprites) begin + final_bright = sat_r; + end else begin + if(alpha[0]) final_bright = sprite0; + else if(alpha[1]) final_bright = sprite1; + else if(alpha[2]) final_bright = sprite2; + else if(alpha[3]) final_bright = sprite3; + else if(alpha[4]) final_bright = sprite4; + else if(alpha[5]) final_bright = sprite5; + else if(alpha[6]) final_bright = sprite6; + else if(alpha[7]) final_bright = sprite7; + else + final_bright = 0; + end + end + + wire active = ((53 + 120 + 61) <= CounterX) & (CounterX < (53 + 120 + 61 + 800)) & ((35 + 6 + 21 + 44) < CounterY) & (CounterY < (35 + 6 + 21 + 44 + 512)); + assign vga_line = yy; + // wire [2:0] vga_red = active ? (charout ? 7 : 0) : 0; + // wire [2:0] vga_red = active ? final_bright[7:5] : 0; + // wire [2:0] vga_green = active ? final_bright[7:5] : 0; + // wire [2:0] vga_blue = active ? final_bright[7:5] : 0; + wire [2:0] vga_red = active ? sat_r[7:5] : 0; + wire [2:0] vga_green = active ? sat_g[7:5] : 0; + wire [2:0] vga_blue = active ? sat_b[7:5] : 0; + wire vga_hsync_n = ~vga_HS; + wire vga_vsync_n = ~vga_VS; + +endmodule // top + diff --git a/docs/j1eforth/Makefile b/docs/j1eforth/Makefile new file mode 100644 index 0000000..0be1611 --- /dev/null +++ b/docs/j1eforth/Makefile @@ -0,0 +1,12 @@ +all: j1 j1.bin j1.hex + +j1: j1.c + gcc -o j1 j1.c +j1.bin j1.hex: j1.4th + gforth ./j1.4th +run: all + ./j1 +core: all + ./j1 core.4th +clean: + rm -rf j1 j1.bin j1.hex diff --git a/docs/j1eforth/README.md b/docs/j1eforth/README.md new file mode 100644 index 0000000..cca83c6 --- /dev/null +++ b/docs/j1eforth/README.md @@ -0,0 +1,99 @@ +eForth for the J1 Simulator and actual J1 FPGAs +------------- + +J1 eForth is an interactive work-in-progress Forth designed to run on the [James Bowman's J1 FPGA soft core][j1] +(see also [J1 on Github][J1github]). There is a Forth cross compiler written in Forth to +generate the interactice J1 eForth system, and a J1 simulator written in C to run J1 eForth simulated +on a PC. + +J1 eForth also runs on actual J1 FPGAs. It has been ported to the [Papilio Pro][pappro] FPGA board, +where it executes Forth program at 66 MHz. It communicates with a host system using a serial line at a +default speed of 115200 Bits/s. + +### Prerequisites + + - [GNU make][gmake] (optional) for job control + - [gforth][gforth] for cross compiling / generating the J1 eForth image + - [WpdPack][pcap] for network simulation + +If you want to run J1 eForth simulated on a PC: + + - [gcc][gcc] to compile the J1 simulator + +If you want to run J1 eForth on a J1 in an FPGA: + + - [Xilinx ISE][xilinxise] to generate the FPGA bit stream (ISE 14.7) + - [Papilio-Loader][paploader] to download the bitstream to the FPGA + +### Directry Structure + + j1eforth + ├── README.MD + ├── j1.4th cross compiler with J1 eForth + ├── j1.c J1 simulator + └── fpga + ├── src Verilog projects for J1 and UART (miniuart2) for Papilio Pro + └── test testbenches + +### Building and running the j1 Simulator +#### Compiling using gcc Mingw (Windows) + + gcc j1.c -o -lwpcap j1.exe + +#### Creating flash image j1.bin (and j1.hex) + + gforth j1.4th +#### Running the Simulator + + j1.exe [optional argument] + + The argument to the simulator is an optional forth file that can be used to extend the dictionary + and is passed to the simulator as the first argument during startup + + Words to test in the simulator : + + [ see , ' , compile , [compile] , ?branch , branch , call, .. and many more ] + + Have fun , modify and pass on + +### Running on Real Hardware + +J1 eForth can run on an actual j1 FPGA. It has been ported to the [Papilio Pro][pappro] FPGA board. + +#### Create the J1 bit stream: + +Start Xilinx ise on project `vhdl/papiolo-pro-j1.xise` +choose `Generate Programming File` on the `papilio_pro_j1` component. This generates `papilio_pro_j1.bit` +including the Forth image (`j1.hex`) as initial memory (built before when generating the flash image). + +#### Load the complete bit stream (J1 and memory) into the FPGA: + + sudo papilio-prog -v -f papilio_pro_j1.bit + + You might want to use the pre-built `pipilio_pro_j1.bit` for a quick start. + +#### Connect to J1 eForth: + + screen /dev/tty.usbserial 115200 + + or similar. J1 eForth should show the prompt + + eForth j1 v1.04 + ok + + If you only see the **`ok`** prompts issue a **`cold`** and press the enter key to reboot the system. + + +### May the Forth be with you. + +[pappro]: http://papilio.cc/index.php?n=Papilio.PapilioPro +[paploader]: http://papilio.cc/index.php?n=Papilio.PapilioLoaderV2 +[pcap]: http://www.winpcap.org/archive/4.1.1-WpdPack.zip +[j1]: http://www.excamera.com/sphinx/fpga-j1.html +[j1github]: https://github.com/jamesbowman/j1 + +[gmake]: https://www.gnu.org/software/make/ +[gcc]: https://gcc.gnu.org/ +[gforth]: https://www.gnu.org/software/gforth/ + +[xilinxise]: http://www.xilinx.com/products/design-tools/ise-design-suite/ise-webpack.html diff --git a/docs/j1eforth/fpga/papilio-pro-j1.xise b/docs/j1eforth/fpga/papilio-pro-j1.xise new file mode 100644 index 0000000..d41153c --- /dev/null +++ b/docs/j1eforth/fpga/papilio-pro-j1.xise @@ -0,0 +1,422 @@ + + + +
+ + + + + + + + +
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
diff --git a/docs/j1eforth/fpga/papilio_pro_j1.bit b/docs/j1eforth/fpga/papilio_pro_j1.bit new file mode 100644 index 0000000..1c1372f Binary files /dev/null and b/docs/j1eforth/fpga/papilio_pro_j1.bit differ diff --git a/docs/j1eforth/fpga/src/Rxunit.vhd b/docs/j1eforth/fpga/src/Rxunit.vhd new file mode 100644 index 0000000..c30a30e --- /dev/null +++ b/docs/j1eforth/fpga/src/Rxunit.vhd @@ -0,0 +1,97 @@ +------------------------------------------------------------------------------- +-- Title : UART +-- Project : UART +------------------------------------------------------------------------------- +-- File : Rxunit.vhd +-- Author : Philippe CARTON +-- (philippe.carton2@libertysurf.fr) +-- Organization: +-- Created : 15/12/2001 +-- Last update : 8/1/2003 +-- Platform : Foundation 3.1i +-- Simulators : ModelSim 5.5b +-- Synthesizers: Xilinx Synthesis +-- Targets : Xilinx Spartan +-- Dependency : IEEE std_logic_1164 +------------------------------------------------------------------------------- +-- Description: RxUnit is a serial to parallel unit Receiver. +------------------------------------------------------------------------------- +-- Copyright (c) notice +-- This core adheres to the GNU public license +-- +------------------------------------------------------------------------------- +-- Revisions : +-- Revision Number : +-- Version : +-- Date : +-- Modifier : name +-- Description : +-- +------------------------------------------------------------------------------ +library ieee; + use ieee.std_logic_1164.all; + +entity RxUnit is + port ( + Clk : in std_logic; -- system clock signal + Reset : in std_logic; -- Reset input + Enable : in std_logic; -- Enable input + ReadA : in Std_logic; -- Async Read Received Byte + RxD : in std_logic; -- RS-232 data input + RxAv : out std_logic; -- Byte available + DataO : out std_logic_vector(7 downto 0)); -- Byte received +end RxUnit; + +architecture Behaviour of RxUnit is + signal RReg : std_logic_vector(7 downto 0); -- receive register + signal RRegL : std_logic; -- Byte received +begin + -- RxAv process + RxAvProc : process(RRegL,Reset,ReadA) + begin + if ReadA = '1' or Reset = '1' then + RxAv <= '0'; -- Negate RxAv when RReg read + elsif Rising_Edge(RRegL) then + RxAv <= '1'; -- Assert RxAv when RReg written + end if; + end process; + + -- Rx Process + RxProc : process(Clk,Reset,Enable,RxD,RReg) + variable BitPos : INTEGER range 0 to 10; -- Position of the bit in the frame + variable SampleCnt : INTEGER range 0 to 3; -- Count from 0 to 3 in each bit + begin + if Reset = '1' then -- Reset + RRegL <= '0'; + BitPos := 0; + elsif Rising_Edge(Clk) then + if Enable = '1' then + case BitPos is + when 0 => -- idle + RRegL <= '0'; + if RxD = '0' then -- Start Bit + SampleCnt := 0; + BitPos := 1; + end if; + when 10 => -- Stop Bit + BitPos := 0; -- next is idle + RRegL <= '1'; -- Indicate byte received + DataO <= RReg; -- Store received byte + when others => + if (SampleCnt = 1 and BitPos >= 2) then -- Sample RxD on 1 + RReg(BitPos-2) <= RxD; -- Deserialisation + end if; + if SampleCnt = 3 then -- Increment BitPos on 3 + BitPos := BitPos + 1; + end if; + end case; + if SampleCnt = 3 then + SampleCnt := 0; + else + sampleCnt := SampleCnt + 1; + end if; + + end if; + end if; + end process; +end Behaviour; diff --git a/docs/j1eforth/fpga/src/Txunit.vhd b/docs/j1eforth/fpga/src/Txunit.vhd new file mode 100644 index 0000000..bdf5b5d --- /dev/null +++ b/docs/j1eforth/fpga/src/Txunit.vhd @@ -0,0 +1,100 @@ +------------------------------------------------------------------------------- +-- Title : UART +-- Project : UART +------------------------------------------------------------------------------- +-- File : Txunit.vhd +-- Author : Philippe CARTON +-- (philippe.carton2@libertysurf.fr) +-- Organization: +-- Created : 15/12/2001 +-- Last update : 8/1/2003 +-- Platform : Foundation 3.1i +-- Simulators : ModelSim 5.5b +-- Synthesizers: Xilinx Synthesis +-- Targets : Xilinx Spartan +-- Dependency : IEEE std_logic_1164 +------------------------------------------------------------------------------- +-- Description: Txunit is a parallel to serial unit transmitter. +------------------------------------------------------------------------------- +-- Copyright (c) notice +-- This core adheres to the GNU public license +-- +------------------------------------------------------------------------------- +-- Revisions : +-- Revision Number : +-- Version : +-- Date : +-- Modifier : name +-- Description : +-- +------------------------------------------------------------------------------ + +library ieee; +use ieee.std_logic_1164.all; + +entity TxUnit is + port ( + Clk : in std_logic; -- Clock signal + Reset : in std_logic; -- Reset input + Enable : in std_logic; -- Enable input + LoadA : in std_logic; -- Asynchronous Load + TxD : out std_logic; -- RS-232 data output + Busy : out std_logic; -- Tx Busy + DataI : in std_logic_vector(7 downto 0)); -- Byte to transmit +end TxUnit; + +architecture Behaviour of TxUnit is + + component synchroniser + port ( + C1 : in std_logic; -- Asynchronous signal + C : in std_logic; -- Clock + O : out Std_logic);-- Synchronised signal + end component; + + signal TBuff : std_logic_vector(7 downto 0); -- transmit buffer + signal TReg : std_logic_vector(7 downto 0); -- transmit register + signal TBufL : std_logic; -- Buffer loaded + signal LoadS : std_logic; -- Synchronised load signal + +begin + -- Synchronise Load on Clk + SyncLoad : Synchroniser port map (LoadA, Clk, LoadS); + Busy <= LoadS or TBufL; + + -- Tx process + TxProc : process(Clk, Reset, Enable, DataI, TBuff, TReg, TBufL) + variable BitPos : INTEGER range 0 to 10; -- Bit position in the frame + begin + if Reset = '1' then + TBufL <= '0'; + BitPos := 0; + TxD <= '1'; + elsif Rising_Edge(Clk) then + if LoadS = '1' then + TBuff <= DataI; + TBufL <= '1'; + end if; + if Enable = '1' then + case BitPos is + when 0 => -- idle or stop bit + TxD <= '1'; + if TBufL = '1' then -- start transmit. next is start bit + TReg <= TBuff; + TBufL <= '0'; + BitPos := 1; + end if; + when 1 => -- Start bit + TxD <= '0'; + BitPos := 2; + when others => + TxD <= TReg(BitPos-2); -- Serialisation of TReg + BitPos := BitPos + 1; + end case; + if BitPos = 10 then -- bit8. next is stop bit + BitPos := 0; + end if; + end if; + end if; + end process; +end Behaviour; diff --git a/docs/j1eforth/fpga/src/clock.vhd b/docs/j1eforth/fpga/src/clock.vhd new file mode 100644 index 0000000..31536e7 --- /dev/null +++ b/docs/j1eforth/fpga/src/clock.vhd @@ -0,0 +1,78 @@ +library ieee; +use ieee.std_logic_1164.ALL; +use ieee.numeric_std.ALL; +library UNISIM; +use UNISIM.Vcomponents.ALL; + +entity clock is + port ( clk_in : in std_logic; + clk : out std_logic; + clk180 : out std_logic); +end clock; + +architecture BEHAVIORAL of clock is + + signal CLKFB_IN : std_logic; + signal CLKFX_BUF : std_logic; + signal CLKFX180_BUF : std_logic; + signal CLKIN_IBUFG : std_logic; + signal CLK2X_BUF : std_logic; + +begin + + CLKFX_BUFG_INST : BUFG + port map (I=>CLKFX_BUF, + O=>clk); + + CLKFX180_BUFG_INST : BUFG + port map (I=>CLKFX180_BUF, + O=>clk180); + + CLKIN_IBUFG_INST : IBUFG + port map (I=>clk_in, + O=>CLKIN_IBUFG); + + CLK2X_BUFG_INST : BUFG + port map (I=>CLK2X_BUF, + O=>CLKFB_IN); + + DCM_SP_INST : DCM_SP + generic map( + CLK_FEEDBACK => "2X", + CLKDV_DIVIDE => 4.0, + CLKFX_DIVIDE => 1, + CLKFX_MULTIPLY => 2, + CLKIN_DIVIDE_BY_2 => FALSE, + CLKIN_PERIOD => 31.250, + CLKOUT_PHASE_SHIFT => "NONE", + DESKEW_ADJUST => "SYSTEM_SYNCHRONOUS", + DFS_FREQUENCY_MODE => "LOW", + DLL_FREQUENCY_MODE => "LOW", + DUTY_CYCLE_CORRECTION=> TRUE, + FACTORY_JF => x"C080", + PHASE_SHIFT => 0, + STARTUP_WAIT => TRUE) + port map ( + CLKIN => CLKIN_IBUFG, + CLKFB => CLKFB_IN, + DSSEN => '0', + PSCLK => '0', + PSEN => '0', + PSINCDEC => '0', + RST => '0', + CLKDV => open, + CLKFX => CLKFX_BUF, + CLKFX180 => CLKFX180_BUF, + CLK2X => CLK2X_BUF, + CLK2X180 => open, + CLK0 => open, + CLK90 => open, + CLK180 => open, + CLK270 => open, + LOCKED => open, + PSDONE => open, + STATUS => open); + +end BEHAVIORAL; + + diff --git a/docs/j1eforth/fpga/src/j1.v b/docs/j1eforth/fpga/src/j1.v new file mode 100644 index 0000000..db8901a --- /dev/null +++ b/docs/j1eforth/fpga/src/j1.v @@ -0,0 +1,199 @@ +/* +Copyright (c) 2011 + James Bowman All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of James Bowman 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 +REGENTS 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. +*/ + +module j1( + input sys_clk_i, input sys_rst_i, input [15:0] io_din, + output io_rd, output io_wr, output [15:0] io_addr, output [15:0] io_dout); + + reg [15:0] insn; + wire [15:0] immediate = { 1'b0, insn[14:0] }; + + reg [4:0] dsp; // Data stack pointer + reg [4:0] _dsp; + reg [15:0] st0; // Return stack pointer + reg [15:0] _st0; + wire _dstkW; // D stack write + + reg [12:0] pc; + reg [12:0] _pc; + reg [4:0] rsp; + reg [4:0] _rsp; + reg _rstkW; // R stack write + reg [15:0] _rstkD; + wire _ramWE; // RAM write enable + + wire [15:0] pc_plus_1; + assign pc_plus_1 = pc + 1; + + // The D and R stacks + reg [15:0] dstack[0:31]; + reg [15:0] rstack[0:31]; + always @(posedge sys_clk_i) + begin + if (_dstkW) + dstack[_dsp] = st0; + if (_rstkW) + rstack[_rsp] = _rstkD; + end + wire [15:0] st1 = dstack[dsp]; + wire [15:0] rst0 = rstack[rsp]; + + // st0sel is the ALU operation. For branch and call the operation + // is T, for 0branch it is N. For ALU ops it is loaded from the instruction + // field. + reg [3:0] st0sel; + always @* + begin + case (insn[14:13]) + 2'b00: st0sel = 0; // ubranch + 2'b10: st0sel = 0; // call + 2'b01: st0sel = 1; // 0branch + 2'b11: st0sel = insn[11:8]; // ALU + default: st0sel = 4'bxxxx; + endcase + end + + + // Papilio Pro: main memory to be infered instead of specified explitely. + reg [15:0] ram[0:16383]; initial $readmemh("../j1.hex", ram); + + reg [15:0] mem_din; + always @(posedge sys_clk_i) begin + // $monitor("insn_addr= %h, insn = %h, sp=%h, rp=%h, S=%h %h", pc, insn, dsp, rsp, st1, st0); + insn <= ram[_pc]; + mem_din <= ram[_st0[15:1]]; + if (_ramWE & (_st0[15:14] ==0)) + ram[_st0[15:1]] <= st1[15:0]; + end + + + // Compute the new value of T. + always @* + begin + if (insn[15]) + _st0 = immediate; + else + case (st0sel) + 4'b0000: _st0 = st0; + 4'b0001: _st0 = st1; + 4'b0010: _st0 = st0 + st1; + 4'b0011: _st0 = st0 & st1; + 4'b0100: _st0 = st0 | st1; + 4'b0101: _st0 = st0 ^ st1; + 4'b0110: _st0 = ~st0; + 4'b0111: _st0 = {16{(st1 == st0)}}; + 4'b1000: _st0 = {16{($signed(st1) < $signed(st0))}}; + 4'b1001: _st0 = st1 >> st0[3:0]; + 4'b1010: _st0 = st0 - 1; + 4'b1011: _st0 = rst0; + 4'b1100: _st0 = |st0[15:14] ? io_din : mem_din; + 4'b1101: _st0 = st1 << st0[3:0]; + 4'b1110: _st0 = {rsp, 3'b000, dsp}; + 4'b1111: _st0 = {16{(st1 < st0)}}; + default: _st0 = 16'hxxxx; + endcase + end + + wire is_alu = (insn[15:13] == 3'b011); + wire is_lit = (insn[15]); + + assign io_rd = (is_alu & (insn[11:8] == 4'hc)); + assign io_wr = _ramWE; + assign io_addr = st0; + assign io_dout = st1; + + assign _ramWE = is_alu & insn[5]; + assign _dstkW = is_lit | (is_alu & insn[7]); + + wire [1:0] dd = insn[1:0]; // D stack delta + wire [1:0] rd = insn[3:2]; // R stack delta + + always @* + begin + if (is_lit) begin // literal + _dsp = dsp + 1; + _rsp = rsp; + _rstkW = 0; + _rstkD = _pc; + end else if (is_alu) begin + _dsp = dsp + {dd[1], dd[1], dd[1], dd}; + _rsp = rsp + {rd[1], rd[1], rd[1], rd}; + _rstkW = insn[6]; + _rstkD = st0; + end else begin // jump/call + // predicated jump is like DROP + if (insn[15:13] == 3'b001) begin + _dsp = dsp - 1; + end else begin + _dsp = dsp; + end + if (insn[15:13] == 3'b010) begin // call + _rsp = rsp + 1; + _rstkW = 1; + _rstkD = {pc_plus_1[14:0], 1'b0}; + end else begin + _rsp = rsp; + _rstkW = 0; + _rstkD = _pc; + end + end + end + + always @* + begin + if (sys_rst_i) + _pc = pc; + else + if ((insn[15:13] == 3'b000) | + ((insn[15:13] == 3'b001) & (|st0 == 0)) | + (insn[15:13] == 3'b010)) + _pc = insn[12:0]; + else if (is_alu & insn[12]) + _pc = rst0[15:1]; + else + _pc = pc_plus_1; + end + + always @(posedge sys_clk_i) + begin + if (sys_rst_i) begin + pc <= 0; + dsp <= 0; + st0 <= 0; + rsp <= 0; + end else begin + dsp <= _dsp; + pc <= _pc; + st0 <= _st0; + rsp <= _rsp; + end + end + +endmodule // j1 diff --git a/docs/j1eforth/fpga/src/miniuart.vhd b/docs/j1eforth/fpga/src/miniuart.vhd new file mode 100644 index 0000000..2ee4f3c --- /dev/null +++ b/docs/j1eforth/fpga/src/miniuart.vhd @@ -0,0 +1,146 @@ +------------------------------------------------------------------------------- +-- Title : MINIUART2 -- this is a modified version without Wishbone interface +-- Project : MINIUART2 +------------------------------------------------------------------------------- +-- File : MiniUart.vhd +-- Author : Philippe CARTON +-- (philippe.carton2@libertysurf.fr) +-- Organization: +-- Created : 15/12/2001 +-- Last update : 8/1/2003 +-- Platform : Foundation 3.1i +-- Simulators : ModelSim 5.5b +-- Synthesizers: Xilinx Synthesis +-- Targets : Xilinx Spartan +-- Dependency : IEEE std_logic_1164, Rxunit.vhd, Txunit.vhd, utils.vhd +------------------------------------------------------------------------------- +-- Description: Uart (Universal Asynchronous Receiver Transmitter) for SoC. +-- Wishbone compatable. +------------------------------------------------------------------------------- +-- Copyright (c) notice +-- This core adheres to the GNU public license +-- +------------------------------------------------------------------------------- +-- Revisions : +-- Revision Number : +-- Version : +-- Date : +-- Modifier : name +-- Description : +-- +------------------------------------------------------------------------------- +-- Revision History: +-- 2014-12-19: removed wishbone interface (uh@xlerb.de) + + +library ieee; + use ieee.std_logic_1164.all; + +entity MINIUART2 is + generic(BRDIVISOR: INTEGER range 0 to 65535 := 143); -- Baud rate divisor 143 = 115200 at 66 Mhz + port ( + clk: in STD_LOGIC; + rst: in STD_LOGIC; + rx: in STD_LOGIC; + tx: out STD_LOGIC; + io_rd: in STD_LOGIC; + io_wr: in STD_LOGIC; + io_addr: in STD_LOGIC; + io_din: in STD_LOGIC_VECTOR (15 downto 0); + io_dout: out STD_LOGIC_VECTOR (15 downto 0)); +end MINIUART2; + +-- Architecture for UART for synthesis +architecture Behaviour of MINIUART2 is + + component Counter + generic(COUNT: INTEGER range 0 to 65535); -- Count revolution + port ( + Clk : in std_logic; -- Clock + Reset : in std_logic; -- Reset input + CE : in std_logic; -- Chip Enable + O : out std_logic); -- Output + end component; + + component RxUnit + port ( + Clk : in std_logic; -- system clock signal + Reset : in std_logic; -- Reset input + Enable : in std_logic; -- Enable input + ReadA : in Std_logic; -- Async Read Received Byte + RxD : in std_logic; -- RS-232 data input + RxAv : out std_logic; -- Byte available + DataO : out std_logic_vector(7 downto 0)); -- Byte received + end component; + + component TxUnit + port ( + Clk : in std_logic; -- Clock signal + Reset : in std_logic; -- Reset input + Enable : in std_logic; -- Enable input + LoadA : in std_logic; -- Asynchronous Load + TxD : out std_logic; -- RS-232 data output + Busy : out std_logic; -- Tx Busy + DataI : in std_logic_vector(7 downto 0)); -- Byte to transmit + end component; + + signal RxData : std_logic_vector(7 downto 0); -- Last Byte received + signal TxData : std_logic_vector(7 downto 0); -- Last bytes transmitted + signal SReg : std_logic_vector(7 downto 0); -- Status register + signal EnabRx : std_logic; -- Enable RX unit + signal EnabTx : std_logic; -- Enable TX unit + signal RxAv : std_logic; -- Data Received + signal TxBusy : std_logic; -- Transmiter Busy + signal ReadA : std_logic; -- Async Read receive buffer + signal LoadA : std_logic; -- Async Load transmit buffer + signal Sig0 : std_logic; -- gnd signal + signal Sig1 : std_logic; -- vcc signal + + + begin + sig0 <= '0'; + sig1 <= '1'; + Uart_Rxrate : Counter -- Baud Rate adjust + generic map (COUNT => BRDIVISOR) + port map (clk, rst, sig1, EnabRx); + Uart_Txrate : Counter -- 4 Divider for Tx + generic map (COUNT => 4) + port map (clk, rst, EnabRx, EnabTx); + Uart_TxUnit : TxUnit port map (clk, rst, EnabTX, LoadA, tx, TxBusy, TxData); + Uart_RxUnit : RxUnit port map (clk, rst, EnabRX, ReadA, rx, RxAv, RxData); + + -- status register + SReg(0) <= RxAv; + SReg(1) <= TxBusy; + SReg(7 downto 2) <= (others => '0'); -- the rest is silence + + process (clk, rst, io_addr, io_wr, io_din) + begin + if Rising_Edge(clk) then + if rst='1' then + LoadA <= '0'; + elsif io_wr='1' and io_addr='0' then -- write byte to tx + TxData <= io_din(7 downto 0); + LoadA <= '1'; + else + LoadA <= '0'; + end if; + end if; + end process; + + process (clk, rst, io_addr, io_rd, RxData, TxBusy, RxAv) + begin + if Rising_Edge(clk) then + if rst='1' then + ReadA <= '0'; + elsif io_rd='1' and io_addr='0' then + ReadA <= '1'; + else + ReadA <= '0'; + end if; + end if; + end process; + io_dout(7 downto 0) <= RxData when io_addr='0' else SReg; + io_dout(15 downto 8) <= (others => '0'); + +end Behaviour; diff --git a/docs/j1eforth/fpga/src/papilio-pro-j1.vhd b/docs/j1eforth/fpga/src/papilio-pro-j1.vhd new file mode 100644 index 0000000..4680c07 --- /dev/null +++ b/docs/j1eforth/fpga/src/papilio-pro-j1.vhd @@ -0,0 +1,117 @@ +library IEEE; +use IEEE.STD_LOGIC_1164.ALL; +use IEEE.NUMERIC_STD.ALL; + +entity papilio_pro_j1 is + port ( + clk_in: in std_logic; + rx: in std_logic; + tx: out std_logic; + wing: out std_logic_vector(15 downto 0)); +end papilio_pro_j1; + +architecture Behavioral of papilio_pro_j1 is + + component clock is + port ( + clk_in: in std_logic; + clk: out std_logic; + clk180: out std_logic); + end component; + + component j1 is + port ( + sys_clk_i: in std_logic; + sys_rst_i: in std_logic; + io_rd: out std_logic; + io_wr: out std_logic; + io_addr: out std_logic_vector (15 downto 0); + io_din: in std_logic_vector (15 downto 0); + io_dout: out std_logic_vector (15 downto 0)); + end component; + + component miniuart2 is + port ( + clk: in STD_LOGIC; + rst: in STD_LOGIC; + rx: in STD_LOGIC; + tx: out STD_LOGIC; + io_rd: in STD_LOGIC; + io_wr: in STD_LOGIC; + io_addr: in STD_LOGIC; + io_din: in STD_LOGIC_VECTOR (15 downto 0); + io_dout: out STD_LOGIC_VECTOR (15 downto 0)); + end component; + + + signal clk: std_logic; + signal clk180: std_logic; + + signal rst_counter: integer range 0 to 15 := 15; + signal sys_rst: std_logic := '1'; + + signal io_rd: std_logic; + signal io_wr: std_logic; + signal io_addr: std_logic_vector (15 downto 0); + signal io_din: std_logic_vector (15 downto 0); + signal io_dout: std_logic_vector (15 downto 0); + + signal uart_en: std_logic; + signal uart_rd: std_logic; + signal uart_wr: std_logic; + signal uart_dout: std_logic_vector (15 downto 0); +begin + + clock_inst: clock + port map ( + clk_in => clk_in, + clk => clk, + clk180 => clk180); + + j1_inst: j1 + port map ( + sys_clk_i => clk, + sys_rst_i => sys_rst, + io_rd => io_rd, + io_wr => io_wr, + io_addr => io_addr, + io_din => io_din, + io_dout => io_dout); + + uart_inst: miniuart2 + port map( + clk => clk180, + rst => sys_rst, + rx => rx, + tx => tx, + io_rd => uart_rd, + io_wr => uart_wr, + io_addr => io_addr(0), + io_din => io_dout, + io_dout => uart_dout); + + process (clk, rst_counter) + begin + if rising_edge(clk) and rst_counter>0 then + rst_counter <= rst_counter-1; + end if; + end process; + sys_rst <= '1' when rst_counter>0 else '0'; + + uart_en <= '1' when io_addr(15 downto 1)="111100000000000" else '0'; + uart_rd <= io_rd and uart_en; + uart_wr <= io_wr and uart_en; + + process (io_addr, uart_dout) + begin + case io_addr(15 downto 1) is + when "111100000000000" => + io_din <= uart_dout; + when others => + io_din <= (others=>'0'); + end case; + end process; + + wing <= (others=>'0'); + +end Behavioral; \ No newline at end of file diff --git a/docs/j1eforth/fpga/src/papilio-pro.ucf b/docs/j1eforth/fpga/src/papilio-pro.ucf new file mode 100644 index 0000000..338cd2d --- /dev/null +++ b/docs/j1eforth/fpga/src/papilio-pro.ucf @@ -0,0 +1,143 @@ +# UCF file for the Papilio Pro board +# Generated by pin_converter, written by Kevin Lindsey +# https://github.com/thelonious/papilio_pins/tree/development/pin_converter + +# Main board wing pin [] to FPGA pin Pxx map +# -------C------- -------B------- -------A------- +# [GND] [C00] P114 [GND] [B00] P99 P100 [A15] +# [2V5] [C01] P115 [2V5] [B01] P97 P98 [A14] +# [3V3] [C02] P116 [3V3] [B02] P92 P93 [A13] +# [5V0] [C03] P117 [5V0] [B03] P87 P88 [A12] +# [C04] P118 [B04] P84 P85 [A11] [5V0] +# [C05] P119 [B05] P82 P83 [A10] [3V3] +# [C06] P120 [B06] P80 P81 [A09] [2V5] +# [C07] P121 [B07] P78 P79 [A08] [GND] +# [GND] [C08] P123 [GND] [B08] P74 P75 [A07] +# [2V5] [C09] P124 [2V5] [B09] P95 P67 [A06] +# [3V3] [C10] P126 [3V3] [B10] P62 P66 [A05] +# [5V0] [C11] P127 [5V0] [B11] P59 P61 [A04] +# [C12] P131 [B12] P57 P58 [A03] [5V0] +# [C13] P132 [B13] P55 P56 [A02] [3V3] +# [C14] P133 [B14] P50 P51 [A01] [2V5] +# [C15] P134 [B15] P47 P48 [A00] [GND] + +## Prohibit the automatic placement of pins that are connected to VCC or GND for configuration. +CONFIG PROHIBIT=P144; +CONFIG PROHIBIT=P69; +CONFIG PROHIBIT=P60; + +NET CLK_IN LOC="P94" | IOSTANDARD=LVTTL | PERIOD=31.25ns; # CLK +NET RX LOC="P101" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # RX +NET TX LOC="P105" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # TX +NET WING(0) LOC="P48" | IOSTANDARD=LVTTL; # A0 +NET WING(1) LOC="P51" | IOSTANDARD=LVTTL; # A1 +NET WING(2) LOC="P56" | IOSTANDARD=LVTTL; # A2 +NET WING(3) LOC="P58" | IOSTANDARD=LVTTL; # A3 +NET WING(4) LOC="P61" | IOSTANDARD=LVTTL; # A4 +NET WING(5) LOC="P66" | IOSTANDARD=LVTTL; # A5 +NET WING(6) LOC="P67" | IOSTANDARD=LVTTL; # A6 +NET WING(7) LOC="P75" | IOSTANDARD=LVTTL; # A7 +NET WING(8) LOC="P79" | IOSTANDARD=LVTTL; # A8 +NET WING(9) LOC="P81" | IOSTANDARD=LVTTL; # A9 +NET WING(10) LOC="P83" | IOSTANDARD=LVTTL; # A10 +NET WING(11) LOC="P85" | IOSTANDARD=LVTTL; # A11 +NET WING(12) LOC="P88" | IOSTANDARD=LVTTL; # A12 +NET WING(13) LOC="P93" | IOSTANDARD=LVTTL; # A13 +NET WING(14) LOC="P98" | IOSTANDARD=LVTTL; # A14 +NET WING(15) LOC="P100" | IOSTANDARD=LVTTL; # A15 +#NET A(0) LOC="P48" | IOSTANDARD=LVTTL; # A0 +#NET A(1) LOC="P51" | IOSTANDARD=LVTTL; # A1 +#NET A(2) LOC="P56" | IOSTANDARD=LVTTL; # A2 +#NET A(3) LOC="P58" | IOSTANDARD=LVTTL; # A3 +#NET A(4) LOC="P61" | IOSTANDARD=LVTTL; # A4 +#NET A(5) LOC="P66" | IOSTANDARD=LVTTL; # A5 +#NET A(6) LOC="P67" | IOSTANDARD=LVTTL; # A6 +#NET A(7) LOC="P75" | IOSTANDARD=LVTTL; # A7 +#NET A(8) LOC="P79" | IOSTANDARD=LVTTL; # A8 +#NET A(9) LOC="P81" | IOSTANDARD=LVTTL; # A9 +#NET A(10) LOC="P83" | IOSTANDARD=LVTTL; # A10 +#NET A(11) LOC="P85" | IOSTANDARD=LVTTL; # A11 +#NET A(12) LOC="P88" | IOSTANDARD=LVTTL; # A12 +#NET A(13) LOC="P93" | IOSTANDARD=LVTTL; # A13 +#NET A(14) LOC="P98" | IOSTANDARD=LVTTL; # A14 +#NET A(15) LOC="P100" | IOSTANDARD=LVTTL; # A15 +#NET B(0) LOC="P99" | IOSTANDARD=LVTTL; # B0 +#NET B(1) LOC="P97" | IOSTANDARD=LVTTL; # B1 +#NET B(2) LOC="P92" | IOSTANDARD=LVTTL; # B2 +#NET B(3) LOC="P87" | IOSTANDARD=LVTTL; # B3 +#NET B(4) LOC="P84" | IOSTANDARD=LVTTL; # B4 +#NET B(5) LOC="P82" | IOSTANDARD=LVTTL; # B5 +#NET B(6) LOC="P80" | IOSTANDARD=LVTTL; # B6 +#NET B(7) LOC="P78" | IOSTANDARD=LVTTL; # B7 +#NET B(8) LOC="P74" | IOSTANDARD=LVTTL; # B8 +#NET B(9) LOC="P95" | IOSTANDARD=LVTTL; # B9 +#NET B(10) LOC="P62" | IOSTANDARD=LVTTL; # B10 +#NET B(11) LOC="P59" | IOSTANDARD=LVTTL; # B11 +#NET B(12) LOC="P57" | IOSTANDARD=LVTTL; # B12 +#NET B(13) LOC="P55" | IOSTANDARD=LVTTL; # B13 +#NET B(14) LOC="P50" | IOSTANDARD=LVTTL; # B14 +#NET B(15) LOC="P47" | IOSTANDARD=LVTTL; # B15 +#NET C(0) LOC="P114" | IOSTANDARD=LVTTL; # C0 +#NET C(1) LOC="P115" | IOSTANDARD=LVTTL; # C1 +#NET C(2) LOC="P116" | IOSTANDARD=LVTTL; # C2 +#NET C(3) LOC="P117" | IOSTANDARD=LVTTL; # C3 +#NET C(4) LOC="P118" | IOSTANDARD=LVTTL; # C4 +#NET C(5) LOC="P119" | IOSTANDARD=LVTTL; # C5 +#NET C(6) LOC="P120" | IOSTANDARD=LVTTL; # C6 +#NET C(7) LOC="P121" | IOSTANDARD=LVTTL; # C7 +#NET C(8) LOC="P123" | IOSTANDARD=LVTTL; # C8 +#NET C(9) LOC="P124" | IOSTANDARD=LVTTL; # C9 +#NET C(10) LOC="P126" | IOSTANDARD=LVTTL; # C10 +#NET C(11) LOC="P127" | IOSTANDARD=LVTTL; # C11 +#NET C(12) LOC="P131" | IOSTANDARD=LVTTL; # C12 +#NET C(13) LOC="P132" | IOSTANDARD=LVTTL; # C13 +#NET C(14) LOC="P133" | IOSTANDARD=LVTTL; # C14 +#NET C(15) LOC="P134" | IOSTANDARD=LVTTL; # C15 +#NET SDRAM_ADDR(0) LOC="P140" | IOSTANDARD=LVTTL; # SDRAM_ADDR0 +#NET SDRAM_ADDR(1) LOC="P139" | IOSTANDARD=LVTTL; # SDRAM_ADDR1 +#NET SDRAM_ADDR(2) LOC="P138" | IOSTANDARD=LVTTL; # SDRAM_ADDR2 +#NET SDRAM_ADDR(3) LOC="P137" | IOSTANDARD=LVTTL; # SDRAM_ADDR3 +#NET SDRAM_ADDR(4) LOC="P46" | IOSTANDARD=LVTTL; # SDRAM_ADDR4 +#NET SDRAM_ADDR(5) LOC="P45" | IOSTANDARD=LVTTL; # SDRAM_ADDR5 +#NET SDRAM_ADDR(6) LOC="P44" | IOSTANDARD=LVTTL; # SDRAM_ADDR6 +#NET SDRAM_ADDR(7) LOC="P43" | IOSTANDARD=LVTTL; # SDRAM_ADDR7 +#NET SDRAM_ADDR(8) LOC="P41" | IOSTANDARD=LVTTL; # SDRAM_ADDR8 +#NET SDRAM_ADDR(9) LOC="P40" | IOSTANDARD=LVTTL; # SDRAM_ADDR9 +#NET SDRAM_ADDR(10) LOC="P141" | IOSTANDARD=LVTTL; # SDRAM_ADDR10 +#NET SDRAM_ADDR(11) LOC="P35" | IOSTANDARD=LVTTL; # SDRAM_ADDR11 +#NET SDRAM_ADDR(12) LOC="P34" | IOSTANDARD=LVTTL; # SDRAM_ADDR12 +#NET SDRAM_DATA(0) LOC="P9" | IOSTANDARD=LVTTL; # SDRAM_DATA0 +#NET SDRAM_DATA(1) LOC="P10" | IOSTANDARD=LVTTL; # SDRAM_DATA1 +#NET SDRAM_DATA(2) LOC="P11" | IOSTANDARD=LVTTL; # SDRAM_DATA2 +#NET SDRAM_DATA(3) LOC="P12" | IOSTANDARD=LVTTL; # SDRAM_DATA3 +#NET SDRAM_DATA(4) LOC="P14" | IOSTANDARD=LVTTL; # SDRAM_DATA4 +#NET SDRAM_DATA(5) LOC="P15" | IOSTANDARD=LVTTL; # SDRAM_DATA5 +#NET SDRAM_DATA(6) LOC="P16" | IOSTANDARD=LVTTL; # SDRAM_DATA6 +#NET SDRAM_DATA(7) LOC="P8" | IOSTANDARD=LVTTL; # SDRAM_DATA7 +#NET SDRAM_DATA(8) LOC="P21" | IOSTANDARD=LVTTL; # SDRAM_DATA8 +#NET SDRAM_DATA(9) LOC="P22" | IOSTANDARD=LVTTL; # SDRAM_DATA9 +#NET SDRAM_DATA(10) LOC="P23" | IOSTANDARD=LVTTL; # SDRAM_DATA10 +#NET SDRAM_DATA(11) LOC="P24" | IOSTANDARD=LVTTL; # SDRAM_DATA11 +#NET SDRAM_DATA(12) LOC="P26" | IOSTANDARD=LVTTL; # SDRAM_DATA12 +#NET SDRAM_DATA(13) LOC="P27" | IOSTANDARD=LVTTL; # SDRAM_DATA13 +#NET SDRAM_DATA(14) LOC="P29" | IOSTANDARD=LVTTL; # SDRAM_DATA14 +#NET SDRAM_DATA(15) LOC="P30" | IOSTANDARD=LVTTL; # SDRAM_DATA15 +#NET SDRAM_DQML LOC="P7" | IOSTANDARD=LVTTL; # SDRAM_DQML +#NET SDRAM_DQMH LOC="P17" | IOSTANDARD=LVTTL; # SDRAM_DQMH +#NET SDRAM_BA(0) LOC="P143" | IOSTANDARD=LVTTL; # SDRAM_BA0 +#NET SDRAM_BA(1) LOC="P142" | IOSTANDARD=LVTTL; # SDRAM_BA1 +#NET SDRAM_nWE LOC="P6" | IOSTANDARD=LVTTL; # SDRAM_nWE +#NET SDRAM_nCAS LOC="P5" | IOSTANDARD=LVTTL; # SDRAM_nCAS +#NET SDRAM_nRAS LOC="P2" | IOSTANDARD=LVTTL; # SDRAM_nRAS +#NET SDRAM_CS LOC="P1" | IOSTANDARD=LVTTL; # SDRAM_CS +#NET SDRAM_CLK LOC="P32" | IOSTANDARD=LVTTL; # SDRAM_CLK +#NET SDRAM_CKE LOC="P33" | IOSTANDARD=LVTTL; # SDRAM_CKE +#NET LED1 LOC="P112" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; # LED1 +#NET JTAG_TMS LOC="P107" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TMS +#NET JTAG_TCK LOC="P109" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TCK +#NET JTAG_TDI LOC="P110" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TDI +#NET JTAG_TDO LOC="P106" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TDO +#NET FLASH_CS LOC="P38" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_CS +#NET FLASH_CK LOC="P70" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_CK +#NET FLASH_SI LOC="P64" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_SI +#NET FLASH_SO LOC="P65" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST | PULLUP; # FLASH_SO diff --git a/docs/j1eforth/fpga/src/utils.vhd b/docs/j1eforth/fpga/src/utils.vhd new file mode 100644 index 0000000..19eb1f7 --- /dev/null +++ b/docs/j1eforth/fpga/src/utils.vhd @@ -0,0 +1,132 @@ +------------------------------------------------------------------------------- +-- Title : UART +-- Project : UART +------------------------------------------------------------------------------- +-- File : utils.vhd +-- Author : Philippe CARTON +-- (philippe.carton2@libertysurf.fr) +-- Organization: +-- Created : 15/12/2001 +-- Last update : 8/1/2003 +-- Platform : Foundation 3.1i +-- Simulators : ModelSim 5.5b +-- Synthesizers: Xilinx Synthesis +-- Targets : Xilinx Spartan +-- Dependency : IEEE std_logic_1164 +------------------------------------------------------------------------------- +-- Description: VHDL utility file +------------------------------------------------------------------------------- +-- Copyright (c) notice +-- This core adheres to the GNU public license +-- +------------------------------------------------------------------------------- +-- Revisions : +-- Revision Number : +-- Version : +-- Date : +-- Modifier : name +-- Description : +-- +------------------------------------------------------------------------------ + + +------------------------------------------------------------------------------- +-- Revision list +-- Version Author Date Changes +-- +-- 1.0 Philippe CARTON 19 December 2001 New model +-- philippe.carton2@libertysurf.fr +------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- Synchroniser: +-- Synchronize an input signal (C1) with an input clock (C). +-- The result is the O signal which is synchronous of C, and persist for +-- one C clock period. +-------------------------------------------------------------------------------- +library IEEE,STD; +use IEEE.std_logic_1164.all; + +entity synchroniser is + port ( + C1 : in std_logic;-- Asynchronous signal + C : in std_logic;-- Clock + O : out std_logic);-- Synchronised signal +end synchroniser; + +architecture Behaviour of synchroniser is + signal C1A : std_logic; + signal C1S : std_logic; + signal R : std_logic; +begin + RiseC1A : process(C1,R) + begin + if Rising_Edge(C1) then + C1A <= '1'; + end if; + if (R = '1') then + C1A <= '0'; + end if; + end process; + + SyncP : process(C,R) + begin + if Rising_Edge(C) then + if (C1A = '1') then + C1S <= '1'; + else C1S <= '0'; + end if; + if (C1S = '1') then + R <= '1'; + else R <= '0'; + end if; + end if; + if (R = '1') then + C1S <= '0'; + end if; + end process; + O <= C1S; +end Behaviour; + +------------------------------------------------------------------------------- +-- Counter +-- This counter is a parametrizable clock divider. +-- The count value is the generic parameter Count. +-- It is CE enabled. (it will count only if CE is high). +-- When it overflow, it will emit a pulse on O. +-- It can be reseted to 0. +------------------------------------------------------------------------------- +library IEEE,STD; +use IEEE.std_logic_1164.all; + +entity Counter is + generic(Count: INTEGER range 0 to 65535); -- Count revolution + port ( + Clk : in std_logic; -- Clock + Reset : in std_logic; -- Reset input + CE : in std_logic; -- Chip Enable + O : out std_logic); -- Output +end Counter; + +architecture Behaviour of Counter is +begin + counter : process(Clk,Reset) + variable Cnt : INTEGER range 0 to Count-1; + begin + if Reset = '1' then + Cnt := Count - 1; + O <= '0'; + elsif Rising_Edge(Clk) then + if CE = '1' then + if Cnt = 0 then + O <= '1'; + Cnt := Count - 1; + else + O <= '0'; + Cnt := Cnt - 1; + end if; + else O <= '0'; + end if; + end if; + end process; +end Behaviour; diff --git a/docs/j1eforth/fpga/test/miniuart2_tb.vhd b/docs/j1eforth/fpga/test/miniuart2_tb.vhd new file mode 100644 index 0000000..6049582 --- /dev/null +++ b/docs/j1eforth/fpga/test/miniuart2_tb.vhd @@ -0,0 +1,128 @@ +-------------------------------------------------------------------------------- +-- Company: +-- Engineer: +-- +-- Create Date: 11:48:15 12/20/2014 +-- Design Name: +-- Module Name: /mnt/hgfs/Projects/j1eforth/vhdl/test/miniuart2_tb.vhd +-- Project Name: papilio-pro-forth +-- Target Device: +-- Tool versions: +-- Description: +-- +-- VHDL Test Bench Created by ISE for module: MINIUART2 +-- +-- Dependencies: +-- +-- Revision: +-- Revision 0.01 - File Created +-- Additional Comments: +-- +-- Notes: +-- This testbench has been automatically generated using types std_logic and +-- std_logic_vector for the ports of the unit under test. Xilinx recommends +-- that these types always be used for the top-level I/O of a design in order +-- to guarantee that the testbench will bind correctly to the post-implementation +-- simulation model. +-------------------------------------------------------------------------------- +LIBRARY ieee; +USE ieee.std_logic_1164.ALL; + +-- Uncomment the following library declaration if using +-- arithmetic functions with Signed or Unsigned values +--USE ieee.numeric_std.ALL; + +ENTITY miniuart2_tb IS +END miniuart2_tb; + +ARCHITECTURE behavior OF miniuart2_tb IS + + -- Component Declaration for the Unit Under Test (UUT) + + COMPONENT MINIUART2 + PORT( + clk : IN std_logic; + rst : IN std_logic; + rx : IN std_logic; + tx : OUT std_logic; + io_rd : IN std_logic; + io_wr : IN std_logic; + io_addr : IN std_logic; + io_din : IN std_logic_vector(15 downto 0); + io_dout : OUT std_logic_vector(15 downto 0) + ); + END COMPONENT; + + + --Inputs + signal clk : std_logic := '0'; + signal rst : std_logic := '0'; + signal rx : std_logic := '0'; + signal io_rd : std_logic := '0'; + signal io_wr : std_logic := '0'; + signal io_addr : std_logic := '0'; + signal io_din : std_logic_vector(15 downto 0) := (others => '0'); + + --Outputs + signal tx : std_logic; + signal io_dout : std_logic_vector(15 downto 0); + + -- Clock period definitions + constant clk_period : time := 10 ns; -- 31.25 ns; + +BEGIN + + -- Instantiate the Unit Under Test (UUT) + uut: MINIUART2 PORT MAP ( + clk => clk, + rst => rst, + rx => rx, + tx => tx, + io_rd => io_rd, + io_wr => io_wr, + io_addr => io_addr, + io_din => io_din, + io_dout => io_dout + ); + + -- Clock process definitions + clk_process :process + begin + clk <= '0'; + wait for clk_period/2; + clk <= '1'; + wait for clk_period/2; + end process; + + + -- Stimulus process + stim_proc: process + begin + -- hold reset state for 100 ns. + wait for 100 ns; + + wait for clk_period*5; + + rst <= '1'; + + wait for clk_period*3; + + rst <= '0'; + + wait for clk_period*3; + + -- insert stimulus here + io_din <= X"002A"; + io_addr <= '1'; + io_wr <= '1'; + + wait for clk_period; + + io_addr <= '0'; + io_din <= X"0000"; + io_wr <= '0'; + + wait; + end process; + +END; diff --git a/docs/j1eforth/fpga/test/papilio_pro_j1_tb.vhd b/docs/j1eforth/fpga/test/papilio_pro_j1_tb.vhd new file mode 100644 index 0000000..3aedf53 --- /dev/null +++ b/docs/j1eforth/fpga/test/papilio_pro_j1_tb.vhd @@ -0,0 +1,96 @@ +-------------------------------------------------------------------------------- +-- Company: +-- Engineer: +-- +-- Create Date: 22:12:23 03/03/2012 +-- Design Name: +-- Module Name: /home/ben/prog/PapilioForth/ise/main_tb.vhd +-- Project Name: PapilioForth +-- Target Device: +-- Tool versions: +-- Description: +-- +-- VHDL Test Bench Created by ISE for module: main +-- +-- Dependencies: +-- +-- Revision: +-- Revision 0.01 - File Created +-- Additional Comments: +-- +-- Notes: +-- This testbench has been automatically generated using types std_logic and +-- std_logic_vector for the ports of the unit under test. Xilinx recommends +-- that these types always be used for the top-level I/O of a design in order +-- to guarantee that the testbench will bind correctly to the post-implementation +-- simulation model. +-------------------------------------------------------------------------------- +LIBRARY ieee; +USE ieee.std_logic_1164.ALL; + +-- Uncomment the following library declaration if using +-- arithmetic functions with Signed or Unsigned values +--USE ieee.numeric_std.ALL; + +ENTITY papilio_pro_j1_tb IS +END papilio_pro_j1_tb; + +ARCHITECTURE behavior OF papilio_pro_j1_tb IS + + -- Component Declaration for the Unit Under Test (UUT) + + COMPONENT papilio_pro_j1 + PORT( + clk_in : IN std_logic; + rx : IN std_logic; + tx : OUT std_logic; + wing : INOUT std_logic_vector(15 downto 0) + ); + END COMPONENT; + + + --Inputs + signal clk_in : std_logic := '0'; + signal rx : std_logic := '0'; + + --Outputs + signal tx : std_logic; + signal wing : std_logic_vector(15 downto 0); + + -- Clock period definitions + constant clk_in_period : time := 31.25 ns; + +BEGIN + + -- Instantiate the Unit Under Test (UUT) + uut: papilio_pro_j1 PORT MAP ( + clk_in => clk_in, + rx => rx, + tx => tx, + wing => wing + ); + + -- Clock process definitions + clk_in_process :process + begin + clk_in <= '0'; + wait for clk_in_period/2; + clk_in <= '1'; + wait for clk_in_period/2; + end process; + + + -- Stimulus process + stim_proc: process + begin + -- hold reset state for 100 ns. + wait for 100 ns; + + wait for clk_in_period*50; + + -- insert stimulus here + + wait; + end process; + +END; diff --git a/docs/j1eforth/ipv4.4th b/docs/j1eforth/ipv4.4th new file mode 100644 index 0000000..080686c --- /dev/null +++ b/docs/j1eforth/ipv4.4th @@ -0,0 +1,249 @@ +( + I feel that the Kernel is at it's best for now and that I can proceed + to do some other things. Note that version 1 is just to make the whole + thing work, later on I might look at optimisation where I might have to move + some stuff around so that memory utilization and execution speed efficiency is + achieved.So far the Kernel works without needing tweaks. + + Work in progress: Implementing simple ipv4 for the j1eforth model + + 7 project targets: + + 1. Add multi-tasking support to the Kernel - 0% + 2. Modify j1 sim to use pcap interface for network tx and rx - 0% + 3. ARP - 0% + 4. ICMP - 0% + 5. IP - 0% + 6. UDP - 0% + 7. TCP - 0% + + Hopefully I will get time to do all this and also document the design of + the j1eforth Kernel for those who are starting out with forth and also those + who wish to tinker with the Kernel for fun. +) + +hex + +forth-wordlist >voc forth + +vocabulary ipv4.1 +only forth also ipv4.1 + +ipv4.1 definitions + +variable active_struct + +: field + create over , + + does> + @ active_struct @ + ; + +( ethernet frame ) + +0 + 6 field eth_dest ( 48 bit source address ) + 6 field eth_src ( 48 bit destination address ) + 2 field eth_type ( 16 bit type ) +constant eth_frame% + +( arp message ) + +0 + 2 field arp_hw ( 16 bit hw type ) + 2 field arp_proto ( 16 bit protocol ) + 1 field arp_hlen ( 8 bit hw address length ) + 1 field arp_plen ( 8 bit protocol address length ) + 2 field arp_op ( 16 bit operation ) + 6 field arp_shw ( 48 bit sender hw address ) + 4 field arp_sp ( 32 bit sender ipv4 address ) + 6 field arp_thw ( 48 bit target hw address ) + 4 field arp_tp ( 32 bit target ipv4 address ) +constant arp_message% + +( arp cache ) + +0 + 4 field ac_ip ( 32 bit protocol address ) + 6 field ac_hw ( 48 bit hw address ) +constant arp_cache% + +( ipv4 datagram header ) + +0 + 1 field ip_vhl ( 4 bit version and 4 bit header length ) + 1 field ip_tos ( 8 bit type of service ) + 2 field ip_len ( 16 bit length ) + 2 field ip_id ( 16 bit identification ) + 2 field ip_frags ( 3 bit flags 13 bit fragment offset ) + 1 field ip_ttl ( 8 bit time to live ) + 1 field ip_proto ( 8 bit protocol number ) + 2 field ip_checksum ( 16 bit checksum ) + 4 field ip_source ( 32 bit source address ) + 4 field ip_dest ( 32 bit destination address ) +constant ip_header% + +( icmp header ) + +0 + 1 field icmp_type ( 8 bits type ) + 1 field icmp_code ( 8 bits code ) + 2 field icmp_checksum ( 16 bits checksum ) +constant icmp_header% + +( udp datagram ) + +0 + 2 field udp_source ( 16 bit source port ) + 2 field udp_dest ( 16 bit destination port ) + 2 field udp_len ( 16 bit length ) + 2 field udp_checksum ( 16 bit checksum ) +constant udp_datagram% + +( tcp header ) + +0 + 2 field tcp_source ( 16 bit source port ) + 2 field tcp_dest ( 16 bit destination port ) + 4 field tcp_seq ( 32 bit sequence number ) + 4 field tcp_ack ( 32 bit acknowledgement ) + 1 field tcp_offset ( 8 bit offset ) + 2 field tcp_flags ( 16 bit flags ) + 1 field tcp_window ( 8 bit window size ) + 2 field tcp_checksum ( 16 bit checksum ) + 2 field tcp_urgent ( 16 bit urgent pointer ) +constant tcp_header% + +4000 constant eth_rx_buf + +: htons ( n -- n ) + dup ff and 8 lshift swap ff00 and 8 rshift or ; + +create ip_addr a8c0 , fe0b , +create ip_netmask ffff , 00ff , +create hw_addr bd00 , 333b , 7f05 , + + 8 constant eth_ip_type + 608 constant eth_arp_type +3580 constant eth_rarp_type + +100 constant arp_request_type +200 constant arp_reply_type + +0 constant icmp_echo_reply +8 constant icmp_echo + +0 constant arp_action + +: arp_lookup 0 to arp_action ; +: arp_update 1 to arp_action ; +: arp_insert 2 to arp_action ; +: arp_delete 3 to arp_action ; +: +arp_age 4 to arp_action ; + +: (arp_lookup) cr ." compare" . . ; +: (arp_update) cr ." update" . . ; +: (arp_insert) cr ." insert" ; +: (arp_delete) cr ." delete" ; +: (+arp_age) cr ." age" ; + +: arp_table ( u -- ) + create here over allot swap erase + does> + swap arp_cache% * + + arp_action 0 to arp_action + case + 0 of (arp_lookup) endof + 1 of (arp_update) endof + 2 of (arp_insert) endof + 3 of (arp_delete) endof + 4 of (+arp_age) endof + ." unknown cache option" + endcase ; + +arp_cache% 8 * arp_table arp_cache + +: eth_rx f008 @ ; +: eth_tx f008 ! ; + +: checksum ( address count -- checksum) + over + 0 -rot + do + i @ + i @ over u> if 1+ then + -2 +loop + dup 10 rshift swap ffff and + + dup 10 rshift + + ffff xor ; +: arp_in ( -- ) + eth_frame% active_struct +! + arp_op @ arp_request_type = if + 100 arp_hw ! + eth_ip_type arp_proto ! + 6 arp_hlen c! + 4 arp_plen c! + arp_reply_type arp_op ! + arp_shw arp_thw 6 cmove + hw_addr arp_shw 6 cmove + arp_sp arp_tp 4 cmove + ip_addr arp_sp 4 cmove + arp_thw + eth_rx_buf active_struct ! + eth_dest 6 cmove + hw_addr eth_src 6 cmove + eth_arp_type eth_type ! + eth_tx + else + ( arp_update ) + then ; +: icmp_in + ip_len @ htons + ip_header% active_struct +! + icmp_type c@ 8 = if + 0 icmp_type c! + icmp_checksum @ fff7 = if + 9 icmp_checksum +! + else 8 icmp_checksum +! then + else + cr ." weird icmp packet" + then eth_tx ; +: udp_in cr ." got udp packet." ; +: tcp_in cr ." got tcp packet." ; +: ip_in ( -- ) + eth_frame% active_struct +! + ip_vhl @ 45 = if + ip_proto c@ case + 1 of + ip_source dup ip_dest 4 cmove + ip_addr swap 4 cmove + icmp_in + endof + 6 of tcp_in endof + 17 of udp_in endof + cr ." unknown ip protocol:" + endcase + else + cr ." unsupported ip version detected" + then ; +: process ( -- ) + eth_type @ case + eth_arp_type of arp_in endof + eth_ip_type of ip_in endof + cr ." unknown ethernet protocol" + endcase ; +: pcap_poll + eth_rx_buf active_struct ! + active_struct @ 5dc erase + eth_rx ; +: round + pcap_poll 0 <> if + process + then ; +: main + begin + round + again +; + +( main ) + +forth definitions +ipv4.1 definitions diff --git a/docs/j1eforth/j1.4th b/docs/j1eforth/j1.4th new file mode 100644 index 0000000..7a1a900 --- /dev/null +++ b/docs/j1eforth/j1.4th @@ -0,0 +1,910 @@ +( + eForth 1.04 for j1 Simulator by Edward A., July 2014 + Much of the code is derived from the following sources: + j1 Cross-compiler by James Bowman August 2010 + 8086 eForth 1.0 by Bill Muench and C. H. Ting, 1990 +) + +only forth definitions hex + +wordlist constant meta.1 +wordlist constant target.1 +wordlist constant assembler.1 + +: (order) ( w wid*n n -- wid*n w n ) + dup if + 1- swap >r recurse over r@ xor if + 1+ r> -rot exit then r> drop then ; +: -order ( wid -- ) get-order (order) nip set-order ; +: +order ( wid -- ) dup >r -order get-order r> swap 1+ set-order ; + +: ]asm ( -- ) assembler.1 +order ; immediate + +get-current meta.1 set-current + +: [a] ( "name" -- ) + parse-word assembler.1 search-wordlist 0= + abort" [a]?" compile, ; immediate +: a: ( "name" -- ) + get-current >r assembler.1 set-current + : r> set-current ; + +target.1 +order meta.1 +order + +a: asm[ ( -- ) assembler.1 -order ; immediate + +create tflash 1000 cells here over erase allot + +variable tdp + +: there tdp @ ; +: tc! tflash + c! ; +: tc@ tflash + c@ ; +: t! over ff and over tc! swap 8 rshift swap 1+ tc! ; +: t@ dup tc@ swap 1+ tc@ 8 lshift or ; +: talign there 1 and tdp +! ; +: tc, there tc! 1 tdp +! ; +: t, there t! 2 tdp +! ; +: $literal [char] " word count dup tc, 0 ?do + count tc, loop drop talign ; +: tallot tdp +! ; +: org tdp ! ; + +a: t 0000 ; +a: n 0100 ; +a: t+n 0200 ; +a: t&n 0300 ; +a: t|n 0400 ; +a: t^n 0500 ; +a: ~t 0600 ; +a: n==t 0700 ; +a: n>t 0900 ; +a: t-1 0a00 ; +a: rt 0b00 ; +a: [t] 0c00 ; +a: n<n 0080 or ; +a: t->r 0040 or ; +a: n->[t] 0020 or ; +a: d-1 0003 or ; +a: d+1 0001 or ; +a: r-1 000c or ; +a: r-2 0008 or ; +a: r+1 0004 or ; + +a: alu 6000 or t, ; + +a: return [a] t 1000 or [a] r-1 [a] alu ; +a: branch 2/ 0000 or t, ; +a: ?branch 2/ 2000 or t, ; +a: call 2/ 4000 or t, ; + +a: literal + dup 8000 and if + ffff xor recurse + [a] ~t [a] alu + else + 8000 or t, + then ; + +variable tlast +variable tuser + +0002 constant =major +0000 constant =minor +0040 constant =comp +0080 constant =imed +7f1f constant =mask +0002 constant =cell +0010 constant =base +0008 constant =bksp +000a constant =nl +000d constant =cr + +4000 constant =em +0000 constant =cold + + 8 constant =vocs +80 constant =us + +=em 100 - constant =tib +=tib =us - constant =up +=cold =us + constant =pick +=pick 100 + constant =code + +: thead + talign + tlast @ t, there tlast ! + parse-word dup tc, 0 ?do count tc, loop drop talign ; +: twords + cr tlast @ + begin + dup tflash + count 1f and type space =cell - t@ + ?dup 0= until ; +: [t] + parse-word target.1 search-wordlist 0= + abort" [t]?" >body @ ; immediate +: [last] tlast @ ; immediate +: ( [char] ) parse 2drop ; immediate +: literal [a] literal ; +: lookback there =cell - t@ ; +: call? lookback e000 and 4000 = ; +: call>goto there =cell - dup t@ 1fff and swap t! ; +: safe? lookback e000 and 6000 = lookback 004c and 0= and ; +: alu>return there =cell - dup t@ 1000 or [a] r-1 swap t! ; +: t: + >in @ thead >in ! + get-current >r target.1 set-current create + r> set-current 947947 talign there , does> @ [a] call ; +: exit + call? if + call>goto else safe? if + alu>return else + [a] return + then + then ; +: t; + 947947 <> if + abort" unstructured" then true if + exit else [a] return then ; +: u: + >in @ thead >in ! + get-current >r target.1 set-current create + r> set-current talign tuser @ dup , + [a] literal exit =cell tuser +! does> @ [a] literal ; +: [u] + parse-word target.1 search-wordlist 0= + abort" [t]?" >body @ =up - =cell + ; immediate +: immediate tlast @ tflash + dup c@ =imed or swap c! ; +: compile-only tlast @ tflash + dup c@ =comp or swap c! ; + + 0 tlast ! + =up tuser ! + +: hex# ( u -- addr len ) 0 <# base @ >r hex =nl hold # # # # r> base ! #> ; +: save-hex ( -- ) + parse-word w/o create-file throw + there 0 do i t@ over >r hex# r> write-file throw 2 +loop + close-file throw ; +: save-target ( -- ) + parse-word w/o create-file throw >r + tflash there r@ write-file throw r> close-file ; + +: begin there ; +: until [a] ?branch ; + +: if there 0 [a] ?branch ; +: skip there 0 [a] branch ; +: then begin 2/ over t@ or swap t! ; +: else skip swap then ; +: while if swap ; +: repeat [a] branch then ; +: again [a] branch ; +: aft drop skip begin swap ; + +: noop ]asm t alu asm[ ; +: + ]asm t+n d-1 alu asm[ ; +: xor ]asm t^n d-1 alu asm[ ; +: and ]asm t&n d-1 alu asm[ ; +: or ]asm t|n d-1 alu asm[ ; +: invert ]asm ~t alu asm[ ; +: = ]asm n==t d-1 alu asm[ ; +: < ]asm nn alu asm[ ; +: dup ]asm t t->n d+1 alu asm[ ; +: drop ]asm n d-1 alu asm[ ; +: over ]asm n t->n d+1 alu asm[ ; +: nip ]asm t d-1 alu asm[ ; +: >r ]asm n t->r r+1 d-1 alu asm[ ; +: r> ]asm rt t->n r-1 d+1 alu asm[ ; +: r@ ]asm rt t->n d+1 alu asm[ ; +: @ ]asm [t] alu asm[ ; +: ! ]asm t n->[t] d-1 alu + n d-1 alu asm[ ; +: dsp ]asm dsp t->n d+1 alu asm[ ; +: lshift ]asm n<>t d-1 alu asm[ ; +: 1- ]asm t-1 alu asm[ ; +: 2r> ]asm rt t->n r-1 d+1 alu + rt t->n r-1 d+1 alu + n t->n alu asm[ ; +: 2>r ]asm n t->n alu + n t->r r+1 d-1 alu + n t->r r+1 d-1 alu asm[ ; +: 2r@ ]asm 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 asm[ ; +: unloop + ]asm t r-1 alu + t r-1 alu asm[ ; + +: dup@ ]asm [t] t->n d+1 alu asm[ ; +: dup>r ]asm t t->r r+1 alu asm[ ; +: 2dupxor ]asm t^n t->n d+1 alu asm[ ; +: 2dup= ]asm n==t t->n d+1 alu asm[ ; +: !nip ]asm t n->[t] d-1 alu asm[ ; +: 2dup! ]asm t n->[t] alu asm[ ; + +: up1 ]asm t d+1 alu asm[ ; +: down1 ]asm t d-1 alu asm[ ; +: copy ]asm n alu asm[ ; + +a: down e for down1 next copy exit ; +a: up e for up1 next noop exit ; + +: for >r begin ; +: next r@ while r> 1- >r repeat r> drop ; + +=pick org + + ]asm down up asm[ + +there constant =pickbody + + copy ]asm return asm[ + 9c ]asm call asm[ bc ]asm branch asm[ + 9a ]asm call asm[ ba ]asm branch asm[ + 98 ]asm call asm[ b8 ]asm branch asm[ + 96 ]asm call asm[ b6 ]asm branch asm[ + 94 ]asm call asm[ b4 ]asm branch asm[ + 92 ]asm call asm[ b2 ]asm branch asm[ + 90 ]asm call asm[ b0 ]asm branch asm[ + 8e ]asm call asm[ ae ]asm branch asm[ + 8c ]asm call asm[ ac ]asm branch asm[ + 8a ]asm call asm[ aa ]asm branch asm[ + 88 ]asm call asm[ a8 ]asm branch asm[ + 86 ]asm call asm[ a6 ]asm branch asm[ + 84 ]asm call asm[ a4 ]asm branch asm[ + 82 ]asm call asm[ a2 ]asm branch asm[ + 80 ]asm call asm[ a0 ]asm branch asm[ + ]asm return asm[ + +=cold org + +0 t, + +there constant =uzero + =base t, ( base ) + 0 t, ( temp ) + 0 t, ( >in ) + 0 t, ( #tib ) + =tib t, ( tib ) + 0 t, ( 'eval ) + 0 t, ( 'abort ) + 0 t, ( hld ) + + ( context ) + + 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, + + ( forth-wordlist ) + + 0 t, ( na, of last definition, linked ) + 0 t, ( wid|0, next or last wordlist in chain ) + 0 t, ( na, wordlist name pointer ) + + ( current ) + + 0 t, ( wid, new definitions ) + 0 t, ( wid, head of chain ) + + 0 t, ( dp ) + 0 t, ( last ) + 0 t, ( '?key ) + 0 t, ( 'emit ) + 0 t, ( 'boot ) + 0 t, ( '\ ) + 0 t, ( '?name ) + 0 t, ( '$,n ) + 0 t, ( 'overt ) + 0 t, ( '; ) + 0 t, ( 'create ) +there constant =ulast +=ulast =uzero - constant =udiff + +=code org + +t: noop noop t; +t: + + t; +t: xor xor t; +t: and and t; +t: or or t; +t: invert invert t; +t: = = t; +t: < < t; +t: u< u< t; +t: swap swap t; +t: u> swap u< t; +t: dup dup t; +t: drop drop t; +t: over over t; +t: nip nip t; +t: lshift lshift t; +t: rshift rshift t; +t: 1- 1- t; +t: >r r> swap >r >r t; compile-only +t: r> r> r> swap >r t; compile-only +t: r@ r> r> dup >r swap >r t; compile-only +t: @ ( a -- w ) @ t; +t: ! ( w a -- ) ! t; + +t: <> = invert t; +t: 0< 0 literal < t; +t: 0= 0 literal = t; +t: > swap < t; +t: 0> 0 literal swap < t; +t: >= < invert t; +t: tuck swap over t; +t: -rot swap >r swap r> t; +t: 2/ 1 literal rshift t; +t: 2* 1 literal lshift t; +t: 1+ 1 literal + t; +t: sp@ dsp ff literal and t; +t: execute ( ca -- ) >r t; +t: bye ( -- ) 7002 literal ! t; +t: c@ ( b -- c ) + dup @ swap 1 literal and if + 8 literal rshift else ff literal and then exit t; +t: c! ( c b -- ) + swap ff literal and dup 8 literal lshift or swap + tuck dup @ swap 1 literal and 0 literal = ff literal xor + >r over xor r> and xor swap ! t; +t: um+ ( w w -- w cy ) + over over + >r + r@ 0 literal >= >r + over over and + 0< r> or >r + or 0< r> and invert 1+ + r> swap t; +t: dovar ( -- a ) r> t; compile-only +t: up dovar =up t, t; +t: douser ( -- a ) up @ r> @ + t; compile-only + +u: base +u: temp +u: >in +u: #tib +u: tib +u: 'eval +u: 'abort +u: hld +u: context + =vocs =cell * tuser +! +u: forth-wordlist + =cell tuser +! + =cell tuser +! +u: current + =cell tuser +! +u: dp +u: last +u: '?key +u: 'emit +u: 'boot +u: '\ +u: 'name? +u: '$,n +u: 'overt +u: '; +u: 'create + +t: ?dup ( w -- w w | 0 ) dup if dup then exit t; +t: rot ( w1 w2 w3 -- w2 w3 w1 ) >r swap r> swap t; +t: 2drop ( w w -- ) drop drop t; +t: 2dup ( w1 w2 -- w1 w2 w1 w2 ) over over t; +t: negate ( n -- -n ) invert 1+ t; +t: dnegate ( d -- -d ) + invert >r invert 1 literal um+ r> + t; +t: - ( n1 n2 -- n1-n2 ) negate + t; +t: abs ( n -- n ) dup 0< if negate then exit t; +t: max ( n n -- n ) 2dup > if drop exit then nip t; +t: min ( n n -- n ) 2dup < if drop exit then nip t; +t: within ( u ul uh -- t ) over - >r - r> u< t; +t: um/mod ( udl udh u -- ur uq ) + 2dup u< if + negate f literal + for >r dup um+ >r >r dup um+ r> + dup + r> r@ swap >r um+ r> or if + >r drop 1+ r> + else + drop + then r> + next drop swap exit + then drop 2drop -1 literal dup t; +t: m/mod ( d n -- r q ) + dup 0< dup >r if + negate >r dnegate r> + then >r dup 0< if + r@ + + then r> um/mod r> if + swap negate swap then exit t; +t: /mod ( n n -- r q ) over 0< swap m/mod t; +t: mod ( n n -- r ) /mod drop t; +t: / ( n n -- q ) /mod nip t; +t: um* ( u u -- ud ) + 0 literal swap f literal + for dup um+ >r >r dup um+ r> + r> if + >r over um+ r> + then + next rot drop t; +t: * ( n n -- n ) um* drop t; +t: m* ( n n -- d ) + 2dup xor 0< >r abs swap abs um* r> if + dnegate then exit t; +t: */mod ( n1 n2 n3 -- r q ) >r m* r> m/mod t; +t: */ ( n1 n2 n3 -- q ) */mod nip t; +t: cell+ ( a -- a ) =cell literal + t; +t: cell- ( a -- a ) =cell literal - t; +t: cells ( n -- n ) 1 literal lshift t; +t: bl ( -- 32 ) 20 literal t; +t: >char ( c -- c ) + 7f literal and dup 7f literal bl within if + drop 5f literal then exit t; +t: +! ( n a -- ) tuck @ + swap ! t; +t: 2! ( d a -- ) swap over ! cell+ ! t; +t: 2@ ( a -- d ) dup cell+ @ swap @ t; +t: count ( b -- b +n ) dup 1+ swap c@ t; +t: here ( -- a ) dp @ t; +t: aligned ( b -- a ) + dup 0 literal =cell literal um/mod drop dup if + =cell literal swap - then + t; +t: align ( -- ) here aligned dp ! t; +t: pad ( -- a ) here 50 literal + aligned t; +t: @execute ( a -- ) @ ?dup if execute then exit t; +t: fill ( b u c -- ) + swap for swap aft 2dup c! 1+ then next 2drop t; +t: erase 0 literal fill t; +t: digit ( u -- c ) 9 literal over < 7 literal and + 30 literal + t; +t: extract ( n base -- n c ) 0 literal swap um/mod swap digit t; +t: <# ( -- ) pad hld ! t; +t: hold ( c -- ) hld @ 1- dup hld ! c! t; +t: # ( u -- u ) base @ extract hold t; +t: #s ( u -- 0 ) begin # dup while repeat t; +t: sign ( n -- ) 0< if 2d literal hold then exit t; +t: #> ( w -- b u ) drop hld @ pad over - t; +t: str ( n -- b u ) dup >r abs <# #s r> sign #> t; +t: hex ( -- ) 10 literal base ! t; +t: decimal ( -- ) a literal base ! t; +t: digit? ( c base -- u t ) + >r 30 literal - 9 literal over < if + dup 20 literal > if + 20 literal - + then + 7 literal - dup a literal < or + then dup r> u< t; +t: number? ( a -- n t | a f ) + base @ >r 0 literal over count + over c@ 24 literal = if + hex swap 1+ swap 1- then + over c@ 2d literal = >r + swap r@ - swap r@ + ?dup if + 1- + for dup >r c@ base @ digit? + while swap base @ * + r> 1+ + next r@ nip if + negate then swap + else r> r> 2drop 2drop 0 literal + then dup + then r> 2drop r> base ! t; +t: ?rx ( -- c t | f ) 7001 literal @ 1 literal and 0= invert t; +t: tx! ( c -- ) + begin + 7001 literal @ 2 literal and 0= + until 7000 literal ! t; +t: ?key ( -- c ) '?key @execute t; +t: emit ( c -- ) 'emit @execute t; +t: key ( -- c ) + begin + ?key + until 7000 literal @ t; +t: nuf? ( -- t ) ?key dup if drop key =nl literal = then exit t; +t: space ( -- ) bl emit t; +t: spaces ( +n -- ) 0 literal max for aft space then next t; +t: type ( b u -- ) for aft count emit then next drop t; +t: cr ( -- ) =cr literal emit =nl literal emit t; +t: do$ ( -- a ) r> r@ r> count + aligned >r swap >r t; compile-only +t: $"| ( -- a ) do$ noop t; compile-only +t: .$ ( a -- ) count type t; +t: ."| ( -- ) do$ .$ t; compile-only +t: .r ( n +n -- ) >r str r> over - spaces type t; +t: u.r ( u +n -- ) >r <# #s #> r> over - spaces type t; +t: u. ( u -- ) <# #s #> space type t; +t: . ( w -- ) base @ a literal xor if u. exit then str space type t; +t: cmove ( b1 b2 u -- ) for aft >r dup c@ r@ c! 1+ r> 1+ then next 2drop t; +t: pack$ ( b u a -- a ) dup >r 2dup ! 1+ swap cmove r> t; +t: ? ( a -- ) @ . t; +t: (parse) ( b u c -- b u delta ; ) + temp ! over >r dup if + 1- temp @ bl = if + for + count temp @ swap - 0< invert r@ 0> and + while next r> drop 0 literal dup exit + then 1- r> + then over swap + for + count temp @ swap - temp @ bl = if + 0< then + while next dup >r else r> drop dup >r 1- + then over - r> r> - exit + then over r> - t; +t: parse ( c -- b u ; ) + >r + tib @ >in @ + + #tib @ >in @ - r> + (parse) + >in +! t; +t: .( ( -- ) 29 literal parse type t; immediate +t: ( ( -- ) 29 literal parse 2drop t; immediate +t: <\> ( -- ) #tib @ >in ! t; immediate +t: \ ( -- ) '\ @execute t; immediate +t: word ( c -- a ; ) parse here cell+ pack$ t; +t: token ( -- a ; ) bl word t; +t: name> ( na -- ca ) count 1f literal and + aligned t; +t: same? ( a a u -- a a f \ -0+ ) + 1- + for aft over r@ + c@ + over r@ + c@ - ?dup + if r> drop exit then then + next 0 literal t; +t: find ( a va -- ca na | a f ) + swap + dup c@ temp ! + dup @ >r + cell+ swap + begin @ dup + if dup @ =mask literal and r@ xor + if cell+ -1 literal else cell+ temp @ same? then + else r> drop swap cell- swap exit + then + while 2 literal cells - + repeat r> drop nip cell- dup name> swap t; +t: ( a -- ca na | a f ) + context dup 2@ xor if cell- then >r + begin + r> cell+ dup >r @ ?dup + while + find ?dup + until r> drop exit then r> drop 0 literal t; +t: name? ( a -- ca na | a f ) 'name? @execute t; +t: ^h ( bot eot cur -- bot eot cur ) + >r over r@ < dup if + =bksp literal dup emit space + emit then r> + t; +t: tap ( bot eot cur c -- bot eot cur ) + dup emit over c! 1+ t; +t: ktap ( bot eot cur c -- bot eot cur ) + dup =nl literal xor if + =bksp literal xor if + bl tap exit + then ^h exit + then drop nip dup t; +t: accept ( b u -- b u ) + over + over + begin + 2dup xor + while + key dup bl - 7f literal u< if tap else ktap then + repeat drop over - t; +t: query ( -- ) tib @ 50 literal accept #tib ! drop 0 literal >in ! t; +t: abort2 do$ drop t; +t: abort1 space .$ 3f literal emit cr 'abort @execute abort2 t; +t: if do$ abort1 exit then abort2 t; compile-only +t: forget ( -- ) + token name? ?dup if + cell- dup dp ! + @ dup context ! last ! + drop exit + then abort1 t; +t: $interpret ( a -- ) + name? ?dup if + @ =comp literal and + $literal compile-only" execute exit + else number? if + exit then abort1 then t; +t: [ ( -- ) [t] $interpret literal 'eval ! t; immediate +t: .ok ( -- ) + [t] $interpret literal 'eval @ = if + ."| $literal ok" + then cr t; +t: eval ( -- ) + begin + token dup c@ + while + 'eval @execute + repeat drop .ok t; +t: $eval ( a u -- ) + >in @ >r #tib @ >r tib @ >r + [t] >in literal 0 literal swap ! + #tib ! tib ! eval r> tib ! r> #tib ! r> >in ! t; compile-only +t: preset ( -- ) =tib literal #tib cell+ ! t; +t: quit ( -- ) + [ begin + query eval + again t; +t: abort drop preset .ok quit t; +t: ' ( -- ca ) token name? if exit then abort1 t; +t: allot ( n -- ) aligned dp +! t; +t: , ( w -- ) here dup cell+ dp ! ! t; +t: call, ( ca -- ) 1 literal rshift 4000 literal or , t; compile-only +t: ?branch ( ca -- ) 1 literal rshift 2000 literal or , t; compile-only +t: branch ( ca -- ) 1 literal rshift 0000 literal or , t; compile-only +t: [compile] ( -- ; ) ' call, t; immediate +t: compile ( -- ) r> dup @ , cell+ >r t; compile-only +t: recurse last @ name> call, t; immediate +t: pick dup 2* 2* =pickbody literal + >r t; +t: literal ( w -- ) + dup 8000 literal and if + ffff literal xor [t] literal ]asm call asm[ compile invert + else + 8000 literal or , + then exit t; immediate +t: ['] ' [t] literal ]asm call asm[ t; immediate +t: $," ( -- ) 22 literal parse here pack$ count + aligned dp ! t; +t: for ( -- a ) compile [t] >r ]asm call asm[ here t; compile-only immediate +t: begin ( -- a ) here t; compile-only immediate +t: (next) ( n -- ) r> r> ?dup if 1- >r @ >r exit then cell+ >r t; compile-only +t: next ( -- ) compile (next) , t; compile-only immediate +t: (do) ( limit index -- index ) r> dup >r swap rot >r >r cell+ >r t; compile-only +t: do ( limit index -- ) compile (do) 0 literal , here t; compile-only immediate +t: (leave) r> drop r> drop r> drop t; compile-only +t: leave compile (leave) noop t; compile-only immediate +t: (loop) + r> r> 1+ r> 2dup <> if + >r >r @ >r exit + then >r 1- >r cell+ >r t; compile-only +t: (unloop) r> r> drop r> drop r> drop >r t; compile-only +t: unloop compile (unloop) noop t; compile-only immediate +t: (?do) + 2dup <> if + r> dup >r swap rot >r >r cell+ >r exit + then 2drop exit t; compile-only +t: ?do ( limit index -- ) compile (?do) 0 literal , here t; compile-only immediate +t: loop ( -- ) compile (loop) dup , compile (unloop) cell- here 1 literal rshift swap ! t; compile-only immediate +t: (+loop) + r> swap r> r> 2dup - >r + 2 literal pick r@ + r@ xor 0< 0= + 3 literal pick r> xor 0< 0= or if + >r + >r @ >r exit + then >r >r drop cell+ >r t; compile-only +t: +loop ( n -- ) compile (+loop) dup , compile (unloop) cell- here 1 literal rshift swap ! t; compile-only immediate +t: (i) ( -- index ) r> r> tuck >r >r t; compile-only +t: i ( -- index ) compile (i) noop t; compile-only immediate +t: until ( a -- ) ?branch t; compile-only immediate +t: again ( a -- ) branch t; compile-only immediate +t: if ( -- a ) here 0 literal ?branch t; compile-only immediate +t: then ( a -- ) here 1 literal rshift over @ or swap ! t; compile-only immediate +t: repeat ( a a -- ) branch [t] then ]asm call asm[ t; compile-only immediate +t: skip here 0 literal branch t; compile-only immediate +t: aft ( a -- a a ) drop [t] skip ]asm call asm[ [t] begin ]asm call asm[ swap t; compile-only immediate +t: else ( a -- a ) [t] skip ]asm call asm[ swap [t] then ]asm call asm[ t; compile-only immediate +t: while ( a -- a a ) [t] if ]asm call asm[ swap t; compile-only immediate +t: (case) r> swap >r >r t; compile-only +t: case compile (case) 30 literal t; compile-only immediate +t: (of) r> r@ swap >r = t; compile-only +t: of compile (of) [t] if ]asm call asm[ t; compile-only immediate +t: endof [t] else ]asm call asm[ 31 literal t; compile-only immediate +t: (endcase) r> r> drop >r t; +t: endcase + begin + dup 31 literal = + while + drop + [t] then ]asm call asm[ + repeat + 30 literal <> $literal bad case construct." + compile (endcase) noop t; compile-only immediate +t: $" ( -- ; ) compile $"| $," t; compile-only immediate +t: ." ( -- ; ) compile ."| $," t; compile-only immediate +t: >body ( ca -- pa ) cell+ t; +t: (to) ( n -- ) r> dup cell+ >r @ ! t; compile-only +t: to ( n -- ) compile (to) ' >body , t; compile-only immediate +t: (+to) ( n -- ) r> dup cell+ >r @ +! t; compile-only +t: +to ( n -- ) compile (+to) ' >body , t; compile-only immediate +t: get-current ( -- wid ) current @ t; +t: set-current ( wid -- ) current ! t; +t: definitions ( -- ) context @ set-current t; +t: ?unique ( a -- a ) + dup get-current find if ."| $literal redef " over .$ then drop t; +t: <$,n> ( na -- ) + dup c@ if + ?unique + dup count + aligned + dp ! + dup last ! + cell- + get-current @ + swap ! exit + then drop $"| $literal name" abort1 t; +t: $,n ( na -- ) '$,n @execute t; +t: $compile ( a -- ) + name? ?dup if + @ =imed literal and if + execute exit + else call, exit + then + then + number? if + [t] literal ]asm call asm[ exit then abort1 t; +t: abort" compile $," t; immediate +t: ( -- ) last @ get-current ! t; +t: overt ( -- ) 'overt @execute t; +t: exit r> drop t; +t: <;> ( -- ) + compile [t] exit ]asm call asm[ + [ overt 0 literal here ! t; compile-only immediate +t: ; ( -- ) '; @execute t; compile-only immediate +t: ] ( -- ) [t] $compile literal 'eval ! t; +t: : ( -- ; ) token $,n ] t; +t: immediate ( -- ) =imed literal last @ @ or last @ ! t; +t: user ( u -- ; ) token $,n overt compile douser , t; +t: ( -- ; ) token $,n overt [t] dovar ]asm literal asm[ call, t; +t: create ( -- ; ) 'create @execute t; +t: variable ( -- ; ) create 0 literal , t; +t: (does>) ( -- ) + r> 1 literal rshift here 1 literal rshift + last @ name> dup cell+ ]asm 8000 literal asm[ or , ! , t; compile-only +t: compile-only ( -- ) =comp literal last @ @ or last @ ! t; +t: does> ( -- ) compile (does>) noop t; immediate +t: char ( -- char ) ( -- c ) bl word 1+ c@ t; +t: [char] char [t] literal ]asm call asm[ t; immediate +t: constant create , (does>) @ t; +t: defer create 0 literal , + (does>) + @ ?dup 0 literal = + $literal uninitialized" execute t; +t: is ' >body ! t; immediate +t: .id ( na -- ) + ?dup if + count 1f literal and type exit then + cr ."| $literal {noname}" t; +t: wordlist ( -- wid ) align here 0 literal , dup current cell+ dup @ , ! 0 literal , t; +t: order@ ( a -- u*wid u ) dup @ dup if >r cell+ order@ r> swap 1+ exit then nip t; +t: get-order ( -- u*wid u ) context order@ t; +t: >wid ( wid -- ) cell+ t; +t: .wid ( wid -- ) + space dup >wid cell+ @ ?dup if .id drop exit then 0 literal u.r t; +t: !wid ( wid -- ) >wid cell+ last @ swap ! t; +t: vocs ( -- ) ( list all wordlists ) + cr ."| $literal vocs:" current cell+ + begin + @ ?dup + while + dup .wid >wid + repeat t; +t: order ( -- ) ( list search order ) + cr ."| $literal search:" get-order + begin + ?dup + while + swap .wid 1- + repeat + cr ."| $literal define:" get-current .wid t; +t: set-order ( u*wid n -- ) ( 16.6.1.2197 ) + dup -1 literal = if + drop forth-wordlist 1 literal then + =vocs literal over u< $literal over size of #vocs" + context swap + begin + dup + while + >r swap over ! cell+ r> + 1- + repeat swap ! t; +t: only ( -- ) -1 literal set-order t; +t: also ( -- ) get-order over swap 1+ set-order t; +t: previous ( -- ) get-order swap drop 1- set-order t; +t: >voc ( wid 'name' -- ) + create dup , !wid + (does>) + @ >r get-order swap drop r> swap set-order t; +t: widof ( "vocabulary" -- wid ) ' >body @ t; +t: vocabulary ( 'name' -- ) wordlist >voc t; +t: _type ( b u -- ) for aft count >char emit then next drop t; +t: dm+ ( a u -- a ) + over 4 literal u.r space + for aft count 3 literal u.r then next t; +t: dump ( a u -- ) + base @ >r hex 10 literal / + for cr 10 literal 2dup dm+ -rot + 2 literal spaces _type + next drop r> base ! t; +t: .s ( ... -- ... ) cr sp@ 1- f literal and for r@ pick . next ."| $literal name) ( ca va -- na | f ) + begin + @ ?dup + while + 2dup name> xor + while cell- + repeat nip exit + then drop 0 literal t; +t: >name ( ca -- na | f ) + >r get-order + begin + ?dup + while + swap + r@ swap + (>name) + ?dup if + >r + 1- for aft drop then next + r> r> drop + exit + then + 1- + repeat + r> drop 0 literal t; +t: see ( -- ; ) + ' cr + begin + dup @ ?dup 700c literal xor + while + 3fff literal and 1 literal lshift + >name ?dup if + space .id + else + dup @ 7fff literal and u. + then + cell+ + repeat 2drop t; +t: (words) ( -- ) + cr + begin + @ ?dup + while + dup .id space cell- + repeat t; +t: words + get-order + begin + ?dup + while + swap + cr cr ."| $literal :" dup .wid cr + (words) + 1- + repeat t; +t: ver ( -- n ) =major literal 100 literal * =minor literal + t; +t: hi ( -- ) + cr ."| $literal eforth j1 v" + base @ hex + ver <# # # 2e literal hold # #> + type base ! cr t; +t: cold ( -- ) + =uzero literal =up literal =udiff literal cmove + preset forth-wordlist dup context ! dup current 2! overt + 4000 literal cell+ dup cell- @ $eval + 'boot @execute + quit + cold t; + +target.1 -order set-current + +there [u] dp t! +[last] [u] last t! +[t] ?rx [u] '?key t! +[t] tx! [u] 'emit t! +[t] <\> [u] '\ t! +[t] $interpret [u] 'eval t! +[t] abort [u] 'abort t! +[t] hi [u] 'boot t! +[t] [u] 'name? t! +[t] [u] 'overt t! +[t] <$,n> [u] '$,n t! +[t] <;> [u] '; t! +[t] [u] 'create t! +[t] cold 2/ =cold t! + +save-target j1.bin +save-hex j1.hex + +meta.1 -order + +bye diff --git a/docs/j1eforth/j1.c b/docs/j1eforth/j1.c new file mode 100644 index 0000000..926adb5 --- /dev/null +++ b/docs/j1eforth/j1.c @@ -0,0 +1,162 @@ +#include +#include +#include +#include +#include +#if defined(unix) || defined(__unix__) || defined(__unix) || (defined(__APPLE__) && defined(__MACH__)) +#include +#include +int getch(void) { /* reads from keypress, doesn't echo */ + struct termios oldattr, newattr; + int ch; + tcgetattr( STDIN_FILENO, &oldattr ); + newattr = oldattr; + // newattr.c_iflag &= ~( ICRNL ); + newattr.c_lflag &= ~( ICANON | ECHO ); + tcsetattr( STDIN_FILENO, TCSANOW, &newattr ); + ch = getchar(); + tcsetattr( STDIN_FILENO, TCSANOW, &oldattr ); + // printf("%d\n", ch); + if(ch==0x1b) exit(0); + return ch==127 ? 8 : ch; +} +int putch(int c) { /* output character to sstdout & flush */ + int res=putchar(c); + fflush(stdout); + return res; +} +#endif +int len = 0; +static unsigned short t; +static unsigned short s; +static unsigned short d[0x20]; /* data stack */ +static unsigned short r[0x20]; /* return stack */ +static unsigned short pc; /* program counter, counts cells */ +static unsigned char dsp, rsp; /* point to top entry */ +static unsigned short* memory; /* ram */ +static int sx[4] = { 0, 1, -2, -1 }; /* 2-bit sign extension */ + +static void push(int v) // push v on the data stack +{ + dsp = 0x1f & (dsp + 1); + d[dsp] = t; + t = v; +} + +static int pop(void) // pop value from the data stack and return it +{ + int v = t; + t = d[dsp]; + dsp = 0x1f & (dsp - 1); + return v; +} + +static void execute(int entrypoint) +{ + int i = 0; + int j = 0; + int _pc, _t; + int insn = 0x4000 | entrypoint; // first insn: "call entrypoint" + do { + _pc = pc + 1; + if (insn & 0x8000) { // literal + push(insn & 0x7fff); + } else { + int target = insn & 0x1fff; + switch (insn >> 13) { + case 0: // jump + _pc = target; + break; + case 1: // conditional jump + if (pop() == 0) + _pc = target; + break; + case 2: // call + rsp = 31 & (rsp + 1); + r[rsp] = _pc << 1; + _pc = target; + break; + case 3: // alu + if (insn & 0x1000) {/* r->pc */ + _pc = r[rsp] >> 1; + } + s = d[dsp]; + switch ((insn >> 8) & 0xf) { + case 0: _t = t; break; /* noop */ + case 1: _t = s; break; /* copy */ + case 2: _t = t+s; break; /* + */ + case 3: _t = t&s; break; /* and */ + case 4: _t = t|s; break; /* or */ + case 5: _t = t^s; break; /* xor */ + case 6: _t = ~t; break; /* invert */ + case 7: _t = -(t==s); break; /* = */ + case 8: _t = -((signed short)s < (signed short)t); break; /* < */ + case 9: _t = s>>t; break; /* rshift */ + case 0xa: _t = t-1; break; /* 1- */ + case 0xb: _t = r[rsp]; break; /* r@ */ + case 0xc: switch (t) { + case 0x7001: _t = 1; break; + case 0x7000: _t = getch(); break; + default: _t = memory[t>>1]; break; + } + break; /* @ */ + case 0xd: _t = s<> 2) & 3]); /* rstack+- */ + if (insn & 0x80) /* t->s */ + d[dsp] = t; + if (insn & 0x40) /* t->r */ + r[rsp] = t; + if (insn & 0x20) /* s->[t] */ + switch (t) { + case 0x7002: rsp = 0; break; + case 0x7000: putch(s); break; + default: memory[t>>1]=s; break; /* ! */ + } + t = _t; + break; + } + } + pc = _pc; + insn = memory[pc]; +#if DEBUG + printf("%d: pc: %0.4x; sp: %0.4x\n", i, pc, t); + printf("\td:"); + for (j = 0; j < dsp; j++) { + printf(" %0.4x", d[j]); + } + printf("\n\tr:"); + for (j = 0; j < rsp; j++) { + printf(" %0.4x", r[j]); + } + printf("\n"); +#endif + i++; + } while (1); +} +/* end of cpu */ + +/* start of i/o demo */ + + +int main(int argc , char *argv[]) +{ + unsigned short m[0x4000]; /* 32kb or RAM */ + FILE *f = fopen("j1.bin", "rb"); + fread(m, 0x2000, sizeof(m[0]), f); /* 0kb - 16kb data and code */ + fclose(f); + if (argc>1) { // program name is counted as one + struct stat st; + f = fopen(argv[1], "r"); + stat(argv[1], &st); + (&m[0x2000])[0] = st.st_size; /* 16kb - 32kb memory mapped i/o */ + fread(&m[0x2001], 0x2000, sizeof(m[0]), f); + fclose(f); + } + memory = m; + execute(0x00); + return 0; +} diff --git a/docs/jonesforth/Dockerfile b/docs/jonesforth/Dockerfile new file mode 100644 index 0000000..14c1c0a --- /dev/null +++ b/docs/jonesforth/Dockerfile @@ -0,0 +1,6 @@ +FROM debian +RUN apt-get update && apt-get install -y libc6-dev-i386 +COPY jonesforth.* / +RUN gcc -m32 -nostdlib -static -Wl,-Ttext,0 -Wl,--build-id=none -o jonesforth jonesforth.S +CMD cat jonesforth.fs - | ./jonesforth +# NOTE requires SYS_RAWIO diff --git a/docs/jonesforth/docker-compose.yml b/docs/jonesforth/docker-compose.yml new file mode 100644 index 0000000..b78971c --- /dev/null +++ b/docs/jonesforth/docker-compose.yml @@ -0,0 +1,6 @@ +version: '3' +services: + jonesforth: + build: . + cap_add: + - SYS_RAWIO diff --git a/docs/jonesforth/jonesforth.S b/docs/jonesforth/jonesforth.S new file mode 100644 index 0000000..8d13286 --- /dev/null +++ b/docs/jonesforth/jonesforth.S @@ -0,0 +1,2313 @@ +/* A sometimes minimal FORTH compiler and tutorial for Linux / i386 systems. -*- asm -*- + By Richard W.M. Jones http://annexia.org/forth + This is PUBLIC DOMAIN (see public domain release statement below). + $Id: jonesforth.S,v 1.45 2007/10/22 18:53:13 rich Exp $ + + gcc -m32 -nostdlib -static -Wl,-Ttext,0 -Wl,--build-id=none -o jonesforth jonesforth.S +*/ + .set JONES_VERSION,45 +/* + INTRODUCTION ---------------------------------------------------------------------- + + FORTH is one of those alien languages which most working programmers regard in the same + way as Haskell, LISP, and so on. Something so strange that they'd rather any thoughts + of it just go away so they can get on with writing this paying code. But that's wrong + and if you care at all about programming then you should at least understand all these + languages, even if you will never use them. + + LISP is the ultimate high-level language, and features from LISP are being added every + decade to the more common languages. But FORTH is in some ways the ultimate in low level + programming. Out of the box it lacks features like dynamic memory management and even + strings. In fact, at its primitive level it lacks even basic concepts like IF-statements + and loops. + + Why then would you want to learn FORTH? There are several very good reasons. First + and foremost, FORTH is minimal. You really can write a complete FORTH in, say, 2000 + lines of code. I don't just mean a FORTH program, I mean a complete FORTH operating + system, environment and language. You could boot such a FORTH on a bare PC and it would + come up with a prompt where you could start doing useful work. The FORTH you have here + isn't minimal and uses a Linux process as its 'base PC' (both for the purposes of making + it a good tutorial). It's possible to completely understand the system. Who can say they + completely understand how Linux works, or gcc? + + Secondly FORTH has a peculiar bootstrapping property. By that I mean that after writing + a little bit of assembly to talk to the hardware and implement a few primitives, all the + rest of the language and compiler is written in FORTH itself. Remember I said before + that FORTH lacked IF-statements and loops? Well of course it doesn't really because + such a lanuage would be useless, but my point was rather that IF-statements and loops are + written in FORTH itself. + + Now of course this is common in other languages as well, and in those languages we call + them 'libraries'. For example in C, 'printf' is a library function written in C. But + in FORTH this goes way beyond mere libraries. Can you imagine writing C's 'if' in C? + And that brings me to my third reason: If you can write 'if' in FORTH, then why restrict + yourself to the usual if/while/for/switch constructs? You want a construct that iterates + over every other element in a list of numbers? You can add it to the language. What + about an operator which pulls in variables directly from a configuration file and makes + them available as FORTH variables? Or how about adding Makefile-like dependencies to + the language? No problem in FORTH. How about modifying the FORTH compiler to allow + complex inlining strategies -- simple. This concept isn't common in programming languages, + but it has a name (in fact two names): "macros" (by which I mean LISP-style macros, not + the lame C preprocessor) and "domain specific languages" (DSLs). + + This tutorial isn't about learning FORTH as the language. I'll point you to some references + you should read if you're not familiar with using FORTH. This tutorial is about how to + write FORTH. In fact, until you understand how FORTH is written, you'll have only a very + superficial understanding of how to use it. + + So if you're not familiar with FORTH or want to refresh your memory here are some online + references to read: + + http://en.wikipedia.org/wiki/Forth_%28programming_language%29 + + http://galileo.phys.virginia.edu/classes/551.jvn.fall01/primer.htm + + http://wiki.laptop.org/go/Forth_Lessons + + http://www.albany.net/~hello/simple.htm + + Here is another "Why FORTH?" essay: http://www.jwdt.com/~paysan/why-forth.html + + Discussion and criticism of this FORTH here: http://lambda-the-ultimate.org/node/2452 + + ACKNOWLEDGEMENTS ---------------------------------------------------------------------- + + This code draws heavily on the design of LINA FORTH (http://home.hccnet.nl/a.w.m.van.der.horst/lina.html) + by Albert van der Horst. Any similarities in the code are probably not accidental. + + Some parts of this FORTH are also based on this IOCCC entry from 1992: + http://ftp.funet.fi/pub/doc/IOCCC/1992/buzzard.2.design. + I was very proud when Sean Barrett, the original author of the IOCCC entry, commented in the LtU thread + http://lambda-the-ultimate.org/node/2452#comment-36818 about this FORTH. + + And finally I'd like to acknowledge the (possibly forgotten?) authors of ARTIC FORTH because their + original program which I still have on original cassette tape kept nagging away at me all these years. + http://en.wikipedia.org/wiki/Artic_Software + + PUBLIC DOMAIN ---------------------------------------------------------------------- + + I, the copyright holder of this work, hereby release it into the public domain. This applies worldwide. + + In case this is not legally possible, I grant any entity the right to use this work for any purpose, + without any conditions, unless such conditions are required by law. + + SETTING UP ---------------------------------------------------------------------- + + Let's get a few housekeeping things out of the way. Firstly because I need to draw lots of + ASCII-art diagrams to explain concepts, the best way to look at this is using a window which + uses a fixed width font and is at least this wide: + + <------------------------------------------------------------------------------------------------------------------------> + + Secondly make sure TABS are set to 8 characters. The following should be a vertical + line. If not, sort out your tabs. + + | + | + | + + Thirdly I assume that your screen is at least 50 characters high. + + ASSEMBLING ---------------------------------------------------------------------- + + If you want to actually run this FORTH, rather than just read it, you will need Linux on an + i386. Linux because instead of programming directly to the hardware on a bare PC which I + could have done, I went for a simpler tutorial by assuming that the 'hardware' is a Linux + process with a few basic system calls (read, write and exit and that's about all). i386 + is needed because I had to write the assembly for a processor, and i386 is by far the most + common. (Of course when I say 'i386', any 32- or 64-bit x86 processor will do. I'm compiling + this on a 64 bit AMD Opteron). + + Again, to assemble this you will need gcc and gas (the GNU assembler). The commands to + assemble and run the code (save this file as 'jonesforth.S') are: + + gcc -m32 -nostdlib -static -Wl,-Ttext,0 -Wl,--build-id=none -o jonesforth jonesforth.S + cat jonesforth.f - | ./jonesforth + + If you want to run your own FORTH programs you can do: + + cat jonesforth.f myprog.f | ./jonesforth + + If you want to load your own FORTH code and then continue reading user commands, you can do: + + cat jonesforth.f myfunctions.f - | ./jonesforth + + ASSEMBLER ---------------------------------------------------------------------- + + (You can just skip to the next section -- you don't need to be able to read assembler to + follow this tutorial). + + However if you do want to read the assembly code here are a few notes about gas (the GNU assembler): + + (1) Register names are prefixed with '%', so %eax is the 32 bit i386 accumulator. The registers + available on i386 are: %eax, %ebx, %ecx, %edx, %esi, %edi, %ebp and %esp, and most of them + have special purposes. + + (2) Add, mov, etc. take arguments in the form SRC,DEST. So mov %eax,%ecx moves %eax -> %ecx + + (3) Constants are prefixed with '$', and you mustn't forget it! If you forget it then it + causes a read from memory instead, so: + mov $2,%eax moves number 2 into %eax + mov 2,%eax reads the 32 bit word from address 2 into %eax (ie. most likely a mistake) + + (4) gas has a funky syntax for local labels, where '1f' (etc.) means label '1:' "forwards" + and '1b' (etc.) means label '1:' "backwards". Notice that these labels might be mistaken + for hex numbers (eg. you might confuse 1b with $0x1b). + + (5) 'ja' is "jump if above", 'jb' for "jump if below", 'je' "jump if equal" etc. + + (6) gas has a reasonably nice .macro syntax, and I use them a lot to make the code shorter and + less repetitive. + + For more help reading the assembler, do "info gas" at the Linux prompt. + + Now the tutorial starts in earnest. + + THE DICTIONARY ---------------------------------------------------------------------- + + In FORTH as you will know, functions are called "words", and just as in other languages they + have a name and a definition. Here are two FORTH words: + + : DOUBLE DUP + ; \ name is "DOUBLE", definition is "DUP +" + : QUADRUPLE DOUBLE DOUBLE ; \ name is "QUADRUPLE", definition is "DOUBLE DOUBLE" + + Words, both built-in ones and ones which the programmer defines later, are stored in a dictionary + which is just a linked list of dictionary entries. + + <--- DICTIONARY ENTRY (HEADER) -----------------------> + +------------------------+--------+---------- - - - - +----------- - - - - + | LINK POINTER | LENGTH/| NAME | DEFINITION + | | FLAGS | | + +--- (4 bytes) ----------+- byte -+- n bytes - - - - +----------- - - - - + + I'll come to the definition of the word later. For now just look at the header. The first + 4 bytes are the link pointer. This points back to the previous word in the dictionary, or, for + the first word in the dictionary it is just a NULL pointer. Then comes a length/flags byte. + The length of the word can be up to 31 characters (5 bits used) and the top three bits are used + for various flags which I'll come to later. This is followed by the name itself, and in this + implementation the name is rounded up to a multiple of 4 bytes by padding it with zero bytes. + That's just to ensure that the definition starts on a 32 bit boundary. + + A FORTH variable called LATEST contains a pointer to the most recently defined word, in + other words, the head of this linked list. + + DOUBLE and QUADRUPLE might look like this: + + pointer to previous word + ^ + | + +--|------+---+---+---+---+---+---+---+---+------------- - - - - + | LINK | 6 | D | O | U | B | L | E | 0 | (definition ...) + +---------+---+---+---+---+---+---+---+---+------------- - - - - + ^ len padding + | + +--|------+---+---+---+---+---+---+---+---+---+---+---+---+------------- - - - - + | LINK | 9 | Q | U | A | D | R | U | P | L | E | 0 | 0 | (definition ...) + +---------+---+---+---+---+---+---+---+---+---+---+---+---+------------- - - - - + ^ len padding + | + | + LATEST + + You should be able to see from this how you might implement functions to find a word in + the dictionary (just walk along the dictionary entries starting at LATEST and matching + the names until you either find a match or hit the NULL pointer at the end of the dictionary); + and add a word to the dictionary (create a new definition, set its LINK to LATEST, and set + LATEST to point to the new word). We'll see precisely these functions implemented in + assembly code later on. + + One interesting consequence of using a linked list is that you can redefine words, and + a newer definition of a word overrides an older one. This is an important concept in + FORTH because it means that any word (even "built-in" or "standard" words) can be + overridden with a new definition, either to enhance it, to make it faster or even to + disable it. However because of the way that FORTH words get compiled, which you'll + understand below, words defined using the old definition of a word continue to use + the old definition. Only words defined after the new definition use the new definition. + + DIRECT THREADED CODE ---------------------------------------------------------------------- + + Now we'll get to the really crucial bit in understanding FORTH, so go and get a cup of tea + or coffee and settle down. It's fair to say that if you don't understand this section, then you + won't "get" how FORTH works, and that would be a failure on my part for not explaining it well. + So if after reading this section a few times you don't understand it, please email me + (rich@annexia.org). + + Let's talk first about what "threaded code" means. Imagine a peculiar version of C where + you are only allowed to call functions without arguments. (Don't worry for now that such a + language would be completely useless!) So in our peculiar C, code would look like this: + + f () + { + a (); + b (); + c (); + } + + and so on. How would a function, say 'f' above, be compiled by a standard C compiler? + Probably into assembly code like this. On the right hand side I've written the actual + i386 machine code. + + f: + CALL a E8 08 00 00 00 + CALL b E8 1C 00 00 00 + CALL c E8 2C 00 00 00 + ; ignore the return from the function for now + + "E8" is the x86 machine code to "CALL" a function. In the first 20 years of computing + memory was hideously expensive and we might have worried about the wasted space being used + by the repeated "E8" bytes. We can save 20% in code size (and therefore, in expensive memory) + by compressing this into just: + + 08 00 00 00 Just the function addresses, without + 1C 00 00 00 the CALL prefix. + 2C 00 00 00 + + On a 16-bit machine like the ones which originally ran FORTH the savings are even greater - 33%. + + [Historical note: If the execution model that FORTH uses looks strange from the following + paragraphs, then it was motivated entirely by the need to save memory on early computers. + This code compression isn't so important now when our machines have more memory in their L1 + caches than those early computers had in total, but the execution model still has some + useful properties]. + + Of course this code won't run directly on the CPU any more. Instead we need to write an + interpreter which takes each set of bytes and calls it. + + On an i386 machine it turns out that we can write this interpreter rather easily, in just + two assembly instructions which turn into just 3 bytes of machine code. Let's store the + pointer to the next word to execute in the %esi register: + + 08 00 00 00 <- We're executing this one now. %esi is the _next_ one to execute. + %esi -> 1C 00 00 00 + 2C 00 00 00 + + The all-important i386 instruction is called LODSL (or in Intel manuals, LODSW). It does + two things. Firstly it reads the memory at %esi into the accumulator (%eax). Secondly it + increments %esi by 4 bytes. So after LODSL, the situation now looks like this: + + 08 00 00 00 <- We're still executing this one + 1C 00 00 00 <- %eax now contains this address (0x0000001C) + %esi -> 2C 00 00 00 + + Now we just need to jump to the address in %eax. This is again just a single x86 instruction + written JMP *(%eax). And after doing the jump, the situation looks like: + + 08 00 00 00 + 1C 00 00 00 <- Now we're executing this subroutine. + %esi -> 2C 00 00 00 + + To make this work, each subroutine is followed by the two instructions 'LODSL; JMP *(%eax)' + which literally make the jump to the next subroutine. + + And that brings us to our first piece of actual code! Well, it's a macro. +*/ + +/* NEXT macro. */ + .macro NEXT + lodsl + jmp *(%eax) + .endm + +/* The macro is called NEXT. That's a FORTH-ism. It expands to those two instructions. + + Every FORTH primitive that we write has to be ended by NEXT. Think of it kind of like + a return. + + The above describes what is known as direct threaded code. + + To sum up: We compress our function calls down to a list of addresses and use a somewhat + magical macro to act as a "jump to next function in the list". We also use one register (%esi) + to act as a kind of instruction pointer, pointing to the next function in the list. + + I'll just give you a hint of what is to come by saying that a FORTH definition such as: + + : QUADRUPLE DOUBLE DOUBLE ; + + actually compiles (almost, not precisely but we'll see why in a moment) to a list of + function addresses for DOUBLE, DOUBLE and a special function called EXIT to finish off. + + At this point, REALLY EAGLE-EYED ASSEMBLY EXPERTS are saying "JONES, YOU'VE MADE A MISTAKE!". + + I lied about JMP *(%eax). + + INDIRECT THREADED CODE ---------------------------------------------------------------------- + + It turns out that direct threaded code is interesting but only if you want to just execute + a list of functions written in assembly language. So QUADRUPLE would work only if DOUBLE + was an assembly language function. In the direct threaded code, QUADRUPLE would look like: + + +------------------+ + | addr of DOUBLE --------------------> (assembly code to do the double) + +------------------+ NEXT + %esi -> | addr of DOUBLE | + +------------------+ + + We can add an extra indirection to allow us to run both words written in assembly language + (primitives written for speed) and words written in FORTH themselves as lists of addresses. + + The extra indirection is the reason for the brackets in JMP *(%eax). + + Let's have a look at how QUADRUPLE and DOUBLE really look in FORTH: + + : QUADRUPLE DOUBLE DOUBLE ; + + +------------------+ + | codeword | : DOUBLE DUP + ; + +------------------+ + | addr of DOUBLE ---------------> +------------------+ + +------------------+ | codeword | + | addr of DOUBLE | +------------------+ + +------------------+ | addr of DUP --------------> +------------------+ + | addr of EXIT | +------------------+ | codeword -------+ + +------------------+ %esi -> | addr of + --------+ +------------------+ | + +------------------+ | | assembly to <-----+ + | addr of EXIT | | | implement DUP | + +------------------+ | | .. | + | | .. | + | | NEXT | + | +------------------+ + | + +-----> +------------------+ + | codeword -------+ + +------------------+ | + | assembly to <------+ + | implement + | + | .. | + | .. | + | NEXT | + +------------------+ + + This is the part where you may need an extra cup of tea/coffee/favourite caffeinated + beverage. What has changed is that I've added an extra pointer to the beginning of + the definitions. In FORTH this is sometimes called the "codeword". The codeword is + a pointer to the interpreter to run the function. For primitives written in + assembly language, the "interpreter" just points to the actual assembly code itself. + They don't need interpreting, they just run. + + In words written in FORTH (like QUADRUPLE and DOUBLE), the codeword points to an interpreter + function. + + I'll show you the interpreter function shortly, but let's recall our indirect + JMP *(%eax) with the "extra" brackets. Take the case where we're executing DOUBLE + as shown, and DUP has been called. Note that %esi is pointing to the address of + + + The assembly code for DUP eventually does a NEXT. That: + + (1) reads the address of + into %eax %eax points to the codeword of + + (2) increments %esi by 4 + (3) jumps to the indirect %eax jumps to the address in the codeword of +, + ie. the assembly code to implement + + + +------------------+ + | codeword | + +------------------+ + | addr of DOUBLE ---------------> +------------------+ + +------------------+ | codeword | + | addr of DOUBLE | +------------------+ + +------------------+ | addr of DUP --------------> +------------------+ + | addr of EXIT | +------------------+ | codeword -------+ + +------------------+ | addr of + --------+ +------------------+ | + +------------------+ | | assembly to <-----+ + %esi -> | addr of EXIT | | | implement DUP | + +------------------+ | | .. | + | | .. | + | | NEXT | + | +------------------+ + | + +-----> +------------------+ + | codeword -------+ + +------------------+ | + now we're | assembly to <-----+ + executing | implement + | + this | .. | + function | .. | + | NEXT | + +------------------+ + + So I hope that I've convinced you that NEXT does roughly what you'd expect. This is + indirect threaded code. + + I've glossed over four things. I wonder if you can guess without reading on what they are? + + . + . + . + + My list of four things are: (1) What does "EXIT" do? (2) which is related to (1) is how do + you call into a function, ie. how does %esi start off pointing at part of QUADRUPLE, but + then point at part of DOUBLE. (3) What goes in the codeword for the words which are written + in FORTH? (4) How do you compile a function which does anything except call other functions + ie. a function which contains a number like : DOUBLE 2 * ; ? + + THE INTERPRETER AND RETURN STACK ------------------------------------------------------------ + + Going at these in no particular order, let's talk about issues (3) and (2), the interpreter + and the return stack. + + Words which are defined in FORTH need a codeword which points to a little bit of code to + give them a "helping hand" in life. They don't need much, but they do need what is known + as an "interpreter", although it doesn't really "interpret" in the same way that, say, + Java bytecode used to be interpreted (ie. slowly). This interpreter just sets up a few + machine registers so that the word can then execute at full speed using the indirect + threaded model above. + + One of the things that needs to happen when QUADRUPLE calls DOUBLE is that we save the old + %esi ("instruction pointer") and create a new one pointing to the first word in DOUBLE. + Because we will need to restore the old %esi at the end of DOUBLE (this is, after all, like + a function call), we will need a stack to store these "return addresses" (old values of %esi). + + As you will have seen in the background documentation, FORTH has two stacks, an ordinary + stack for parameters, and a return stack which is a bit more mysterious. But our return + stack is just the stack I talked about in the previous paragraph, used to save %esi when + calling from a FORTH word into another FORTH word. + + In this FORTH, we are using the normal stack pointer (%esp) for the parameter stack. + We will use the i386's "other" stack pointer (%ebp, usually called the "frame pointer") + for our return stack. + + I've got two macros which just wrap up the details of using %ebp for the return stack. + You use them as for example "PUSHRSP %eax" (push %eax on the return stack) or "POPRSP %ebx" + (pop top of return stack into %ebx). +*/ + +/* Macros to deal with the return stack. */ + .macro PUSHRSP reg + lea -4(%ebp),%ebp // push reg on to return stack + movl \reg,(%ebp) + .endm + + .macro POPRSP reg + mov (%ebp),\reg // pop top of return stack to reg + lea 4(%ebp),%ebp + .endm + +/* + And with that we can now talk about the interpreter. + + In FORTH the interpreter function is often called DOCOL (I think it means "DO COLON" because + all FORTH definitions start with a colon, as in : DOUBLE DUP + ; + + The "interpreter" (it's not really "interpreting") just needs to push the old %esi on the + stack and set %esi to the first word in the definition. Remember that we jumped to the + function using JMP *(%eax)? Well a consequence of that is that conveniently %eax contains + the address of this codeword, so just by adding 4 to it we get the address of the first + data word. Finally after setting up %esi, it just does NEXT which causes that first word + to run. +*/ + +/* DOCOL - the interpreter! */ + .text + .align 4 +DOCOL: + PUSHRSP %esi // push %esi on to the return stack + addl $4,%eax // %eax points to codeword, so make + movl %eax,%esi // %esi point to first data word + NEXT + +/* + Just to make this absolutely clear, let's see how DOCOL works when jumping from QUADRUPLE + into DOUBLE: + + QUADRUPLE: + +------------------+ + | codeword | + +------------------+ DOUBLE: + | addr of DOUBLE ---------------> +------------------+ + +------------------+ %eax -> | addr of DOCOL | + %esi -> | addr of DOUBLE | +------------------+ + +------------------+ | addr of DUP | + | addr of EXIT | +------------------+ + +------------------+ | etc. | + + First, the call to DOUBLE calls DOCOL (the codeword of DOUBLE). DOCOL does this: It + pushes the old %esi on the return stack. %eax points to the codeword of DOUBLE, so we + just add 4 on to it to get our new %esi: + + QUADRUPLE: + +------------------+ + | codeword | + +------------------+ DOUBLE: + | addr of DOUBLE ---------------> +------------------+ +top of return +------------------+ %eax -> | addr of DOCOL | +stack points -> | addr of DOUBLE | + 4 = +------------------+ + +------------------+ %esi -> | addr of DUP | + | addr of EXIT | +------------------+ + +------------------+ | etc. | + + Then we do NEXT, and because of the magic of threaded code that increments %esi again + and calls DUP. + + Well, it seems to work. + + One minor point here. Because DOCOL is the first bit of assembly actually to be defined + in this file (the others were just macros), and because I usually compile this code with the + text segment starting at address 0, DOCOL has address 0. So if you are disassembling the + code and see a word with a codeword of 0, you will immediately know that the word is + written in FORTH (it's not an assembler primitive) and so uses DOCOL as the interpreter. + + STARTING UP ---------------------------------------------------------------------- + + Now let's get down to nuts and bolts. When we start the program we need to set up + a few things like the return stack. But as soon as we can, we want to jump into FORTH + code (albeit much of the "early" FORTH code will still need to be written as + assembly language primitives). + + This is what the set up code does. Does a tiny bit of house-keeping, sets up the + separate return stack (NB: Linux gives us the ordinary parameter stack already), then + immediately jumps to a FORTH word called QUIT. Despite its name, QUIT doesn't quit + anything. It resets some internal state and starts reading and interpreting commands. + (The reason it is called QUIT is because you can call QUIT from your own FORTH code + to "quit" your program and go back to interpreting). +*/ + +/* Assembler entry point. */ + .text + .globl _start +_start: + cld + mov %esp,var_S0 // Save the initial data stack pointer in FORTH variable S0. + mov $return_stack_top,%ebp // Initialise the return stack. + call set_up_data_segment + + mov $cold_start,%esi // Initialise interpreter. + NEXT // Run interpreter! + + .section .rodata +cold_start: // High-level code without a codeword. + .int QUIT + +/* + BUILT-IN WORDS ---------------------------------------------------------------------- + + Remember our dictionary entries (headers)? Let's bring those together with the codeword + and data words to see how : DOUBLE DUP + ; really looks in memory. + + pointer to previous word + ^ + | + +--|------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ + | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | + +---------+---+---+---+---+---+---+---+---+------------+--|---------+------------+------------+ + ^ len pad codeword | + | V + LINK in next word points to codeword of DUP + + Initially we can't just write ": DOUBLE DUP + ;" (ie. that literal string) here because we + don't yet have anything to read the string, break it up at spaces, parse each word, etc. etc. + So instead we will have to define built-in words using the GNU assembler data constructors + (like .int, .byte, .string, .ascii and so on -- look them up in the gas info page if you are + unsure of them). + + The long way would be: + + .int + .byte 6 // len + .ascii "DOUBLE" // string + .byte 0 // padding +DOUBLE: .int DOCOL // codeword + .int DUP // pointer to codeword of DUP + .int PLUS // pointer to codeword of + + .int EXIT // pointer to codeword of EXIT + + That's going to get quite tedious rather quickly, so here I define an assembler macro + so that I can just write: + + defword "DOUBLE",6,,DOUBLE + .int DUP,PLUS,EXIT + + and I'll get exactly the same effect. + + Don't worry too much about the exact implementation details of this macro - it's complicated! +*/ + +/* Flags - these are discussed later. */ + .set F_IMMED,0x80 + .set F_HIDDEN,0x20 + .set F_LENMASK,0x1f // length mask + + // Store the chain of links. + .set link,0 + + .macro defword name, namelen, flags=0, label + .section .rodata + .align 4 + .globl name_\label +name_\label : + .int link // link + .set link,name_\label + .byte \flags+\namelen // flags + length byte + .ascii "\name" // the name + .align 4 // padding to next 4 byte boundary + .globl \label +\label : + .int DOCOL // codeword - the interpreter + // list of word pointers follow + .endm + +/* + Similarly I want a way to write words written in assembly language. There will quite a few + of these to start with because, well, everything has to start in assembly before there's + enough "infrastructure" to be able to start writing FORTH words, but also I want to define + some common FORTH words in assembly language for speed, even though I could write them in FORTH. + + This is what DUP looks like in memory: + + pointer to previous word + ^ + | + +--|------+---+---+---+---+------------+ + | LINK | 3 | D | U | P | code_DUP ---------------------> points to the assembly + +---------+---+---+---+---+------------+ code used to write DUP, + ^ len codeword which ends with NEXT. + | + LINK in next word + + Again, for brevity in writing the header I'm going to write an assembler macro called defcode. + As with defword above, don't worry about the complicated details of the macro. +*/ + + .macro defcode name, namelen, flags=0, label + .section .rodata + .align 4 + .globl name_\label +name_\label : + .int link // link + .set link,name_\label + .byte \flags+\namelen // flags + length byte + .ascii "\name" // the name + .align 4 // padding to next 4 byte boundary + .globl \label +\label : + .int code_\label // codeword + .text + //.align 4 + .globl code_\label +code_\label : // assembler code follows + .endm + +/* + Now some easy FORTH primitives. These are written in assembly for speed. If you understand + i386 assembly language then it is worth reading these. However if you don't understand assembly + you can skip the details. +*/ + + defcode "DROP",4,,DROP + pop %eax // drop top of stack + NEXT + + defcode "SWAP",4,,SWAP + pop %eax // swap top two elements on stack + pop %ebx + push %eax + push %ebx + NEXT + + defcode "DUP",3,,DUP + mov (%esp),%eax // duplicate top of stack + push %eax + NEXT + + defcode "OVER",4,,OVER + mov 4(%esp),%eax // get the second element of stack + push %eax // and push it on top + NEXT + + defcode "ROT",3,,ROT + pop %eax + pop %ebx + pop %ecx + push %eax + push %ecx + push %ebx + NEXT + + defcode "-ROT",4,,NROT + pop %eax + pop %ebx + pop %ecx + push %ebx + push %eax + push %ecx + NEXT + + defcode "2DROP",5,,TWODROP // drop top two elements of stack + pop %eax + pop %eax + NEXT + + defcode "2DUP",4,,TWODUP // duplicate top two elements of stack + mov (%esp),%eax + mov 4(%esp),%ebx + push %ebx + push %eax + NEXT + + defcode "2SWAP",5,,TWOSWAP // swap top two pairs of elements of stack + pop %eax + pop %ebx + pop %ecx + pop %edx + push %ebx + push %eax + push %edx + push %ecx + NEXT + + defcode "?DUP",4,,QDUP // duplicate top of stack if non-zero + movl (%esp),%eax + test %eax,%eax + jz 1f + push %eax +1: NEXT + + defcode "1+",2,,INCR + incl (%esp) // increment top of stack + NEXT + + defcode "1-",2,,DECR + decl (%esp) // decrement top of stack + NEXT + + defcode "4+",2,,INCR4 + addl $4,(%esp) // add 4 to top of stack + NEXT + + defcode "4-",2,,DECR4 + subl $4,(%esp) // subtract 4 from top of stack + NEXT + + defcode "+",1,,ADD + pop %eax // get top of stack + addl %eax,(%esp) // and add it to next word on stack + NEXT + + defcode "-",1,,SUB + pop %eax // get top of stack + subl %eax,(%esp) // and subtract it from next word on stack + NEXT + + defcode "*",1,,MUL + pop %eax + pop %ebx + imull %ebx,%eax + push %eax // ignore overflow + NEXT + +/* + In this FORTH, only /MOD is primitive. Later we will define the / and MOD words in + terms of the primitive /MOD. The design of the i386 assembly instruction idiv which + leaves both quotient and remainder makes this the obvious choice. +*/ + + defcode "/MOD",4,,DIVMOD + xor %edx,%edx + pop %ebx + pop %eax + idivl %ebx + push %edx // push remainder + push %eax // push quotient + NEXT + +/* + Lots of comparison operations like =, <, >, etc.. + + ANS FORTH says that the comparison words should return all (binary) 1's for + TRUE and all 0's for FALSE. However this is a bit of a strange convention + so this FORTH breaks it and returns the more normal (for C programmers ...) + 1 meaning TRUE and 0 meaning FALSE. +*/ + + defcode "=",1,,EQU // top two words are equal? + pop %eax + pop %ebx + cmp %ebx,%eax + sete %al + movzbl %al,%eax + pushl %eax + NEXT + + defcode "<>",2,,NEQU // top two words are not equal? + pop %eax + pop %ebx + cmp %ebx,%eax + setne %al + movzbl %al,%eax + pushl %eax + NEXT + + defcode "<",1,,LT + pop %eax + pop %ebx + cmp %eax,%ebx + setl %al + movzbl %al,%eax + pushl %eax + NEXT + + defcode ">",1,,GT + pop %eax + pop %ebx + cmp %eax,%ebx + setg %al + movzbl %al,%eax + pushl %eax + NEXT + + defcode "<=",2,,LE + pop %eax + pop %ebx + cmp %eax,%ebx + setle %al + movzbl %al,%eax + pushl %eax + NEXT + + defcode ">=",2,,GE + pop %eax + pop %ebx + cmp %eax,%ebx + setge %al + movzbl %al,%eax + pushl %eax + NEXT + + defcode "0=",2,,ZEQU // top of stack equals 0? + pop %eax + test %eax,%eax + setz %al + movzbl %al,%eax + pushl %eax + NEXT + + defcode "0<>",3,,ZNEQU // top of stack not 0? + pop %eax + test %eax,%eax + setnz %al + movzbl %al,%eax + pushl %eax + NEXT + + defcode "0<",2,,ZLT // comparisons with 0 + pop %eax + test %eax,%eax + setl %al + movzbl %al,%eax + pushl %eax + NEXT + + defcode "0>",2,,ZGT + pop %eax + test %eax,%eax + setg %al + movzbl %al,%eax + pushl %eax + NEXT + + defcode "0<=",3,,ZLE + pop %eax + test %eax,%eax + setle %al + movzbl %al,%eax + pushl %eax + NEXT + + defcode "0>=",3,,ZGE + pop %eax + test %eax,%eax + setge %al + movzbl %al,%eax + pushl %eax + NEXT + + defcode "AND",3,,AND // bitwise AND + pop %eax + andl %eax,(%esp) + NEXT + + defcode "OR",2,,OR // bitwise OR + pop %eax + orl %eax,(%esp) + NEXT + + defcode "XOR",3,,XOR // bitwise XOR + pop %eax + xorl %eax,(%esp) + NEXT + + defcode "INVERT",6,,INVERT // this is the FORTH bitwise "NOT" function (cf. NEGATE and NOT) + notl (%esp) + NEXT + +/* + RETURNING FROM FORTH WORDS ---------------------------------------------------------------------- + + Time to talk about what happens when we EXIT a function. In this diagram QUADRUPLE has called + DOUBLE, and DOUBLE is about to exit (look at where %esi is pointing): + + QUADRUPLE + +------------------+ + | codeword | + +------------------+ DOUBLE + | addr of DOUBLE ---------------> +------------------+ + +------------------+ | codeword | + | addr of DOUBLE | +------------------+ + +------------------+ | addr of DUP | + | addr of EXIT | +------------------+ + +------------------+ | addr of + | + +------------------+ + %esi -> | addr of EXIT | + +------------------+ + + What happens when the + function does NEXT? Well, the following code is executed. +*/ + + defcode "EXIT",4,,EXIT + POPRSP %esi // pop return stack into %esi + NEXT + +/* + EXIT gets the old %esi which we saved from before on the return stack, and puts it in %esi. + So after this (but just before NEXT) we get: + + QUADRUPLE + +------------------+ + | codeword | + +------------------+ DOUBLE + | addr of DOUBLE ---------------> +------------------+ + +------------------+ | codeword | + %esi -> | addr of DOUBLE | +------------------+ + +------------------+ | addr of DUP | + | addr of EXIT | +------------------+ + +------------------+ | addr of + | + +------------------+ + | addr of EXIT | + +------------------+ + + And NEXT just completes the job by, well, in this case just by calling DOUBLE again :-) + + LITERALS ---------------------------------------------------------------------- + + The final point I "glossed over" before was how to deal with functions that do anything + apart from calling other functions. For example, suppose that DOUBLE was defined like this: + + : DOUBLE 2 * ; + + It does the same thing, but how do we compile it since it contains the literal 2? One way + would be to have a function called "2" (which you'd have to write in assembler), but you'd need + a function for every single literal that you wanted to use. + + FORTH solves this by compiling the function using a special word called LIT: + + +---------------------------+-------+-------+-------+-------+-------+ + | (usual header of DOUBLE) | DOCOL | LIT | 2 | * | EXIT | + +---------------------------+-------+-------+-------+-------+-------+ + + LIT is executed in the normal way, but what it does next is definitely not normal. It + looks at %esi (which now points to the number 2), grabs it, pushes it on the stack, then + manipulates %esi in order to skip the number as if it had never been there. + + What's neat is that the whole grab/manipulate can be done using a single byte single + i386 instruction, our old friend LODSL. Rather than me drawing more ASCII-art diagrams, + see if you can find out how LIT works: +*/ + + defcode "LIT",3,,LIT + // %esi points to the next command, but in this case it points to the next + // literal 32 bit integer. Get that literal into %eax and increment %esi. + // On x86, it's a convenient single byte instruction! (cf. NEXT macro) + lodsl + push %eax // push the literal number on to stack + NEXT + +/* + MEMORY ---------------------------------------------------------------------- + + As important point about FORTH is that it gives you direct access to the lowest levels + of the machine. Manipulating memory directly is done frequently in FORTH, and these are + the primitive words for doing it. +*/ + + defcode "!",1,,STORE + pop %ebx // address to store at + pop %eax // data to store there + mov %eax,(%ebx) // store it + NEXT + + defcode "@",1,,FETCH + pop %ebx // address to fetch + mov (%ebx),%eax // fetch it + push %eax // push value onto stack + NEXT + + defcode "+!",2,,ADDSTORE + pop %ebx // address + pop %eax // the amount to add + addl %eax,(%ebx) // add it + NEXT + + defcode "-!",2,,SUBSTORE + pop %ebx // address + pop %eax // the amount to subtract + subl %eax,(%ebx) // add it + NEXT + +/* + ! and @ (STORE and FETCH) store 32-bit words. It's also useful to be able to read and write bytes + so we also define standard words C@ and C!. + + Byte-oriented operations only work on architectures which permit them (i386 is one of those). + */ + + defcode "C!",2,,STOREBYTE + pop %ebx // address to store at + pop %eax // data to store there + movb %al,(%ebx) // store it + NEXT + + defcode "C@",2,,FETCHBYTE + pop %ebx // address to fetch + xor %eax,%eax + movb (%ebx),%al // fetch it + push %eax // push value onto stack + NEXT + +/* C@C! is a useful byte copy primitive. */ + defcode "C@C!",4,,CCOPY + movl 4(%esp),%ebx // source address + movb (%ebx),%al // get source character + pop %edi // destination address + stosb // copy to destination + push %edi // increment destination address + incl 4(%esp) // increment source address + NEXT + +/* and CMOVE is a block copy operation. */ + defcode "CMOVE",5,,CMOVE + mov %esi,%edx // preserve %esi + pop %ecx // length + pop %edi // destination address + pop %esi // source address + rep movsb // copy source to destination + mov %edx,%esi // restore %esi + NEXT + +/* + BUILT-IN VARIABLES ---------------------------------------------------------------------- + + These are some built-in variables and related standard FORTH words. Of these, the only one that we + have discussed so far was LATEST, which points to the last (most recently defined) word in the + FORTH dictionary. LATEST is also a FORTH word which pushes the address of LATEST (the variable) + on to the stack, so you can read or write it using @ and ! operators. For example, to print + the current value of LATEST (and this can apply to any FORTH variable) you would do: + + LATEST @ . CR + + To make defining variables shorter, I'm using a macro called defvar, similar to defword and + defcode above. (In fact the defvar macro uses defcode to do the dictionary header). +*/ + + .macro defvar name, namelen, flags=0, label, initial=0 + defcode \name,\namelen,\flags,\label + push $var_\name + NEXT + .data + .align 4 +var_\name : + .int \initial + .endm + +/* + The built-in variables are: + + STATE Is the interpreter executing code (0) or compiling a word (non-zero)? + LATEST Points to the latest (most recently defined) word in the dictionary. + HERE Points to the next free byte of memory. When compiling, compiled words go here. + S0 Stores the address of the top of the parameter stack. + BASE The current base for printing and reading numbers. + +*/ + defvar "STATE",5,,STATE + defvar "HERE",4,,HERE + defvar "LATEST",6,,LATEST,name_SYSCALL0 // SYSCALL0 must be last in built-in dictionary + defvar "S0",2,,SZ + defvar "BASE",4,,BASE,10 + +/* + BUILT-IN CONSTANTS ---------------------------------------------------------------------- + + It's also useful to expose a few constants to FORTH. When the word is executed it pushes a + constant value on the stack. + + The built-in constants are: + + VERSION Is the current version of this FORTH. + R0 The address of the top of the return stack. + DOCOL Pointer to DOCOL. + F_IMMED The IMMEDIATE flag's actual value. + F_HIDDEN The HIDDEN flag's actual value. + F_LENMASK The length mask in the flags/len byte. + + SYS_* and the numeric codes of various Linux syscalls (from ) +*/ + +//#include // you might need this instead +#include + + .macro defconst name, namelen, flags=0, label, value + defcode \name,\namelen,\flags,\label + push $\value + NEXT + .endm + + defconst "VERSION",7,,VERSION,JONES_VERSION + defconst "R0",2,,RZ,return_stack_top + defconst "DOCOL",5,,__DOCOL,DOCOL + defconst "F_IMMED",7,,__F_IMMED,F_IMMED + defconst "F_HIDDEN",8,,__F_HIDDEN,F_HIDDEN + defconst "F_LENMASK",9,,__F_LENMASK,F_LENMASK + + defconst "SYS_EXIT",8,,SYS_EXIT,__NR_exit + defconst "SYS_OPEN",8,,SYS_OPEN,__NR_open + defconst "SYS_CLOSE",9,,SYS_CLOSE,__NR_close + defconst "SYS_READ",8,,SYS_READ,__NR_read + defconst "SYS_WRITE",9,,SYS_WRITE,__NR_write + defconst "SYS_CREAT",9,,SYS_CREAT,__NR_creat + defconst "SYS_BRK",7,,SYS_BRK,__NR_brk + + defconst "O_RDONLY",8,,__O_RDONLY,0 + defconst "O_WRONLY",8,,__O_WRONLY,1 + defconst "O_RDWR",6,,__O_RDWR,2 + defconst "O_CREAT",7,,__O_CREAT,0100 + defconst "O_EXCL",6,,__O_EXCL,0200 + defconst "O_TRUNC",7,,__O_TRUNC,01000 + defconst "O_APPEND",8,,__O_APPEND,02000 + defconst "O_NONBLOCK",10,,__O_NONBLOCK,04000 + +/* + RETURN STACK ---------------------------------------------------------------------- + + These words allow you to access the return stack. Recall that the register %ebp always points to + the top of the return stack. +*/ + + defcode ">R",2,,TOR + pop %eax // pop parameter stack into %eax + PUSHRSP %eax // push it on to the return stack + NEXT + + defcode "R>",2,,FROMR + POPRSP %eax // pop return stack on to %eax + push %eax // and push on to parameter stack + NEXT + + defcode "RSP@",4,,RSPFETCH + push %ebp + NEXT + + defcode "RSP!",4,,RSPSTORE + pop %ebp + NEXT + + defcode "RDROP",5,,RDROP + addl $4,%ebp // pop return stack and throw away + NEXT + +/* + PARAMETER (DATA) STACK ---------------------------------------------------------------------- + + These functions allow you to manipulate the parameter stack. Recall that Linux sets up the parameter + stack for us, and it is accessed through %esp. +*/ + + defcode "DSP@",4,,DSPFETCH + mov %esp,%eax + push %eax + NEXT + + defcode "DSP!",4,,DSPSTORE + pop %esp + NEXT + +/* + INPUT AND OUTPUT ---------------------------------------------------------------------- + + These are our first really meaty/complicated FORTH primitives. I have chosen to write them in + assembler, but surprisingly in "real" FORTH implementations these are often written in terms + of more fundamental FORTH primitives. I chose to avoid that because I think that just obscures + the implementation. After all, you may not understand assembler but you can just think of it + as an opaque block of code that does what it says. + + Let's discuss input first. + + The FORTH word KEY reads the next byte from stdin (and pushes it on the parameter stack). + So if KEY is called and someone hits the space key, then the number 32 (ASCII code of space) + is pushed on the stack. + + In FORTH there is no distinction between reading code and reading input. We might be reading + and compiling code, we might be reading words to execute, we might be asking for the user + to type their name -- ultimately it all comes in through KEY. + + The implementation of KEY uses an input buffer of a certain size (defined at the end of this + file). It calls the Linux read(2) system call to fill this buffer and tracks its position + in the buffer using a couple of variables, and if it runs out of input buffer then it refills + it automatically. The other thing that KEY does is if it detects that stdin has closed, it + exits the program, which is why when you hit ^D the FORTH system cleanly exits. + + buffer bufftop + | | + V V + +-------------------------------+--------------------------------------+ + | INPUT READ FROM STDIN ....... | unused part of the buffer | + +-------------------------------+--------------------------------------+ + ^ + | + currkey (next character to read) + + <---------------------- BUFFER_SIZE (4096 bytes) ----------------------> +*/ + + defcode "KEY",3,,KEY + call _KEY + push %eax // push return value on stack + NEXT +_KEY: + mov (currkey),%ebx + cmp (bufftop),%ebx + jge 1f // exhausted the input buffer? + xor %eax,%eax + mov (%ebx),%al // get next key from input buffer + inc %ebx + mov %ebx,(currkey) // increment currkey + ret + +1: // Out of input; use read(2) to fetch more input from stdin. + xor %ebx,%ebx // 1st param: stdin + mov $buffer,%ecx // 2nd param: buffer + mov %ecx,currkey + mov $BUFFER_SIZE,%edx // 3rd param: max length + mov $__NR_read,%eax // syscall: read + int $0x80 + test %eax,%eax // If %eax <= 0, then exit. + jbe 2f + addl %eax,%ecx // buffer+%eax = bufftop + mov %ecx,bufftop + jmp _KEY + +2: // Error or end of input: exit the program. + xor %ebx,%ebx + mov $__NR_exit,%eax // syscall: exit + int $0x80 + + .data + .align 4 +currkey: + .int buffer // Current place in input buffer (next character to read). +bufftop: + .int buffer // Last valid data in input buffer + 1. + +/* + By contrast, output is much simpler. The FORTH word EMIT writes out a single byte to stdout. + This implementation just uses the write system call. No attempt is made to buffer output, but + it would be a good exercise to add it. +*/ + + defcode "EMIT",4,,EMIT + pop %eax + call _EMIT + NEXT +_EMIT: + mov $1,%ebx // 1st param: stdout + + // write needs the address of the byte to write + mov %al,emit_scratch + mov $emit_scratch,%ecx // 2nd param: address + + mov $1,%edx // 3rd param: nbytes = 1 + + mov $__NR_write,%eax // write syscall + int $0x80 + ret + + .data // NB: easier to fit in the .data section +emit_scratch: + .space 1 // scratch used by EMIT + +/* + Back to input, WORD is a FORTH word which reads the next full word of input. + + What it does in detail is that it first skips any blanks (spaces, tabs, newlines and so on). + Then it calls KEY to read characters into an internal buffer until it hits a blank. Then it + calculates the length of the word it read and returns the address and the length as + two words on the stack (with the length at the top of stack). + + Notice that WORD has a single internal buffer which it overwrites each time (rather like + a static C string). Also notice that WORD's internal buffer is just 32 bytes long and + there is NO checking for overflow. 31 bytes happens to be the maximum length of a + FORTH word that we support, and that is what WORD is used for: to read FORTH words when + we are compiling and executing code. The returned strings are not NUL-terminated. + + Start address+length is the normal way to represent strings in FORTH (not ending in an + ASCII NUL character as in C), and so FORTH strings can contain any character including NULs + and can be any length. + + WORD is not suitable for just reading strings (eg. user input) because of all the above + peculiarities and limitations. + + Note that when executing, you'll see: + WORD FOO + which puts "FOO" and length 3 on the stack, but when compiling: + : BAR WORD FOO ; + is an error (or at least it doesn't do what you might expect). Later we'll talk about compiling + and immediate mode, and you'll understand why. +*/ + + defcode "WORD",4,,WORD + call _WORD + push %edi // push base address + push %ecx // push length + NEXT + +_WORD: + /* Search for first non-blank character. Also skip \ comments. */ +1: + call _KEY // get next key, returned in %eax + cmpb $'\\',%al // start of a comment? + je 3f // if so, skip the comment + cmpb $' ',%al + jbe 1b // if so, keep looking + + /* Search for the end of the word, storing chars as we go. */ + mov $word_buffer,%edi // pointer to return buffer +2: + stosb // add character to return buffer + call _KEY // get next key, returned in %al + cmpb $' ',%al // is blank? + ja 2b // if not, keep looping + + /* Return the word (well, the static buffer) and length. */ + sub $word_buffer,%edi + mov %edi,%ecx // return length of the word + mov $word_buffer,%edi // return address of the word + ret + + /* Code to skip \ comments to end of the current line. */ +3: + call _KEY + cmpb $'\n',%al // end of line yet? + jne 3b + jmp 1b + + .data // NB: easier to fit in the .data section + // A static buffer where WORD returns. Subsequent calls + // overwrite this buffer. Maximum word length is 32 chars. +word_buffer: + .space 32 + +/* + As well as reading in words we'll need to read in numbers and for that we are using a function + called NUMBER. This parses a numeric string such as one returned by WORD and pushes the + number on the parameter stack. + + The function uses the variable BASE as the base (radix) for conversion, so for example if + BASE is 2 then we expect a binary number. Normally BASE is 10. + + If the word starts with a '-' character then the returned value is negative. + + If the string can't be parsed as a number (or contains characters outside the current BASE) + then we need to return an error indication. So NUMBER actually returns two items on the stack. + At the top of stack we return the number of unconverted characters (ie. if 0 then all characters + were converted, so there is no error). Second from top of stack is the parsed number or a + partial value if there was an error. +*/ + defcode "NUMBER",6,,NUMBER + pop %ecx // length of string + pop %edi // start address of string + call _NUMBER + push %eax // parsed number + push %ecx // number of unparsed characters (0 = no error) + NEXT + +_NUMBER: + xor %eax,%eax + xor %ebx,%ebx + + test %ecx,%ecx // trying to parse a zero-length string is an error, but will return 0. + jz 5f + + movl var_BASE,%edx // get BASE (in %dl) + + // Check if first character is '-'. + movb (%edi),%bl // %bl = first character in string + inc %edi + push %eax // push 0 on stack + cmpb $'-',%bl // negative number? + jnz 2f + pop %eax + push %ebx // push <> 0 on stack, indicating negative + dec %ecx + jnz 1f + pop %ebx // error: string is only '-'. + movl $1,%ecx + ret + + // Loop reading digits. +1: imull %edx,%eax // %eax *= BASE + movb (%edi),%bl // %bl = next character in string + inc %edi + + // Convert 0-9, A-Z to a number 0-35. +2: subb $'0',%bl // < '0'? + jb 4f + cmp $10,%bl // <= '9'? + jb 3f + subb $17,%bl // < 'A'? (17 is 'A'-'0') + jb 4f + addb $10,%bl + +3: cmp %dl,%bl // >= BASE? + jge 4f + + // OK, so add it to %eax and loop. + add %ebx,%eax + dec %ecx + jnz 1b + + // Negate the result if first character was '-' (saved on the stack). +4: pop %ebx + test %ebx,%ebx + jz 5f + neg %eax + +5: ret + +/* + DICTIONARY LOOK UPS ---------------------------------------------------------------------- + + We're building up to our prelude on how FORTH code is compiled, but first we need yet more infrastructure. + + The FORTH word FIND takes a string (a word as parsed by WORD -- see above) and looks it up in the + dictionary. What it actually returns is the address of the dictionary header, if it finds it, + or 0 if it didn't. + + So if DOUBLE is defined in the dictionary, then WORD DOUBLE FIND returns the following pointer: + + pointer to this + | + | + V + +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ + | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | + +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ + + See also >CFA and >DFA. + + FIND doesn't find dictionary entries which are flagged as HIDDEN. See below for why. +*/ + + defcode "FIND",4,,FIND + pop %ecx // %ecx = length + pop %edi // %edi = address + call _FIND + push %eax // %eax = address of dictionary entry (or NULL) + NEXT + +_FIND: + push %esi // Save %esi so we can use it in string comparison. + + // Now we start searching backwards through the dictionary for this word. + mov var_LATEST,%edx // LATEST points to name header of the latest word in the dictionary +1: test %edx,%edx // NULL pointer? (end of the linked list) + je 4f + + // Compare the length expected and the length of the word. + // Note that if the F_HIDDEN flag is set on the word, then by a bit of trickery + // this won't pick the word (the length will appear to be wrong). + xor %eax,%eax + movb 4(%edx),%al // %al = flags+length field + andb $(F_HIDDEN|F_LENMASK),%al // %al = name length + cmpb %cl,%al // Length is the same? + jne 2f + + // Compare the strings in detail. + push %ecx // Save the length + push %edi // Save the address (repe cmpsb will move this pointer) + lea 5(%edx),%esi // Dictionary string we are checking against. + repe cmpsb // Compare the strings. + pop %edi + pop %ecx + jne 2f // Not the same. + + // The strings are the same - return the header pointer in %eax + pop %esi + mov %edx,%eax + ret + +2: mov (%edx),%edx // Move back through the link field to the previous word + jmp 1b // .. and loop. + +4: // Not found. + pop %esi + xor %eax,%eax // Return zero to indicate not found. + ret + +/* + FIND returns the dictionary pointer, but when compiling we need the codeword pointer (recall + that FORTH definitions are compiled into lists of codeword pointers). The standard FORTH + word >CFA turns a dictionary pointer into a codeword pointer. + + The example below shows the result of: + + WORD DOUBLE FIND >CFA + + FIND returns a pointer to this + | >CFA converts it to a pointer to this + | | + V V + +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ + | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | + +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ + codeword + + Notes: + + Because names vary in length, this isn't just a simple increment. + + In this FORTH you cannot easily turn a codeword pointer back into a dictionary entry pointer, but + that is not true in most FORTH implementations where they store a back pointer in the definition + (with an obvious memory/complexity cost). The reason they do this is that it is useful to be + able to go backwards (codeword -> dictionary entry) in order to decompile FORTH definitions + quickly. + + What does CFA stand for? My best guess is "Code Field Address". +*/ + + defcode ">CFA",4,,TCFA + pop %edi + call _TCFA + push %edi + NEXT +_TCFA: + xor %eax,%eax + add $4,%edi // Skip link pointer. + movb (%edi),%al // Load flags+len into %al. + inc %edi // Skip flags+len byte. + andb $F_LENMASK,%al // Just the length, not the flags. + add %eax,%edi // Skip the name. + addl $3,%edi // The codeword is 4-byte aligned. + andl $~3,%edi + ret + +/* + Related to >CFA is >DFA which takes a dictionary entry address as returned by FIND and + returns a pointer to the first data field. + + FIND returns a pointer to this + | >CFA converts it to a pointer to this + | | + | | >DFA converts it to a pointer to this + | | | + V V V + +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ + | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | + +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ + codeword + + (Note to those following the source of FIG-FORTH / ciforth: My >DFA definition is + different from theirs, because they have an extra indirection). + + You can see that >DFA is easily defined in FORTH just by adding 4 to the result of >CFA. +*/ + + defword ">DFA",4,,TDFA + .int TCFA // >CFA (get code field address) + .int INCR4 // 4+ (add 4 to it to get to next word) + .int EXIT // EXIT (return from FORTH word) + +/* + COMPILING ---------------------------------------------------------------------- + + Now we'll talk about how FORTH compiles words. Recall that a word definition looks like this: + + : DOUBLE DUP + ; + + and we have to turn this into: + + pointer to previous word + ^ + | + +--|------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ + | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | + +---------+---+---+---+---+---+---+---+---+------------+--|---------+------------+------------+ + ^ len pad codeword | + | V + LATEST points here points to codeword of DUP + + There are several problems to solve. Where to put the new word? How do we read words? How + do we define the words : (COLON) and ; (SEMICOLON)? + + FORTH solves this rather elegantly and as you might expect in a very low-level way which + allows you to change how the compiler works on your own code. + + FORTH has an INTERPRET function (a true interpreter this time, not DOCOL) which runs in a + loop, reading words (using WORD), looking them up (using FIND), turning them into codeword + pointers (using >CFA) and deciding what to do with them. + + What it does depends on the mode of the interpreter (in variable STATE). + + When STATE is zero, the interpreter just runs each word as it looks them up. This is known as + immediate mode. + + The interesting stuff happens when STATE is non-zero -- compiling mode. In this mode the + interpreter appends the codeword pointer to user memory (the HERE variable points to the next + free byte of user memory -- see DATA SEGMENT section below). + + So you may be able to see how we could define : (COLON). The general plan is: + + (1) Use WORD to read the name of the function being defined. + + (2) Construct the dictionary entry -- just the header part -- in user memory: + + pointer to previous word (from LATEST) +-- Afterwards, HERE points here, where + ^ | the interpreter will start appending + | V codewords. + +--|------+---+---+---+---+---+---+---+---+------------+ + | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | + +---------+---+---+---+---+---+---+---+---+------------+ + len pad codeword + + (3) Set LATEST to point to the newly defined word, ... + + (4) .. and most importantly leave HERE pointing just after the new codeword. This is where + the interpreter will append codewords. + + (5) Set STATE to 1. This goes into compile mode so the interpreter starts appending codewords to + our partially-formed header. + + After : has run, our input is here: + + : DOUBLE DUP + ; + ^ + | + Next byte returned by KEY will be the 'D' character of DUP + + so the interpreter (now it's in compile mode, so I guess it's really the compiler) reads "DUP", + looks it up in the dictionary, gets its codeword pointer, and appends it: + + +-- HERE updated to point here. + | + V + +---------+---+---+---+---+---+---+---+---+------------+------------+ + | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + +---------+---+---+---+---+---+---+---+---+------------+------------+ + len pad codeword + + Next we read +, get the codeword pointer, and append it: + + +-- HERE updated to point here. + | + V + +---------+---+---+---+---+---+---+---+---+------------+------------+------------+ + | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | + +---------+---+---+---+---+---+---+---+---+------------+------------+------------+ + len pad codeword + + The issue is what happens next. Obviously what we _don't_ want to happen is that we + read ";" and compile it and go on compiling everything afterwards. + + At this point, FORTH uses a trick. Remember the length byte in the dictionary definition + isn't just a plain length byte, but can also contain flags. One flag is called the + IMMEDIATE flag (F_IMMED in this code). If a word in the dictionary is flagged as + IMMEDIATE then the interpreter runs it immediately _even if it's in compile mode_. + + This is how the word ; (SEMICOLON) works -- as a word flagged in the dictionary as IMMEDIATE. + + And all it does is append the codeword for EXIT on to the current definition and switch + back to immediate mode (set STATE back to 0). Shortly we'll see the actual definition + of ; and we'll see that it's really a very simple definition, declared IMMEDIATE. + + After the interpreter reads ; and executes it 'immediately', we get this: + + +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ + | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | + +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ + len pad codeword ^ + | + HERE + STATE is set to 0. + + And that's it, job done, our new definition is compiled, and we're back in immediate mode + just reading and executing words, perhaps including a call to test our new word DOUBLE. + + The only last wrinkle in this is that while our word was being compiled, it was in a + half-finished state. We certainly wouldn't want DOUBLE to be called somehow during + this time. There are several ways to stop this from happening, but in FORTH what we + do is flag the word with the HIDDEN flag (F_HIDDEN in this code) just while it is + being compiled. This prevents FIND from finding it, and thus in theory stops any + chance of it being called. + + The above explains how compiling, : (COLON) and ; (SEMICOLON) works and in a moment I'm + going to define them. The : (COLON) function can be made a little bit more general by writing + it in two parts. The first part, called CREATE, makes just the header: + + +-- Afterwards, HERE points here. + | + V + +---------+---+---+---+---+---+---+---+---+ + | LINK | 6 | D | O | U | B | L | E | 0 | + +---------+---+---+---+---+---+---+---+---+ + len pad + + and the second part, the actual definition of : (COLON), calls CREATE and appends the + DOCOL codeword, so leaving: + + +-- Afterwards, HERE points here. + | + V + +---------+---+---+---+---+---+---+---+---+------------+ + | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | + +---------+---+---+---+---+---+---+---+---+------------+ + len pad codeword + + CREATE is a standard FORTH word and the advantage of this split is that we can reuse it to + create other types of words (not just ones which contain code, but words which contain variables, + constants and other data). +*/ + + defcode "CREATE",6,,CREATE + + // Get the name length and address. + pop %ecx // %ecx = length + pop %ebx // %ebx = address of name + + // Link pointer. + movl var_HERE,%edi // %edi is the address of the header + movl var_LATEST,%eax // Get link pointer + stosl // and store it in the header. + + // Length byte and the word itself. + mov %cl,%al // Get the length. + stosb // Store the length/flags byte. + push %esi + mov %ebx,%esi // %esi = word + rep movsb // Copy the word + pop %esi + addl $3,%edi // Align to next 4 byte boundary. + andl $~3,%edi + + // Update LATEST and HERE. + movl var_HERE,%eax + movl %eax,var_LATEST + movl %edi,var_HERE + NEXT + +/* + Because I want to define : (COLON) in FORTH, not assembler, we need a few more FORTH words + to use. + + The first is , (COMMA) which is a standard FORTH word which appends a 32 bit integer to the user + memory pointed to by HERE, and adds 4 to HERE. So the action of , (COMMA) is: + + previous value of HERE + | + V + +---------+---+---+---+---+---+---+---+---+-- - - - - --+------------+ + | LINK | 6 | D | O | U | B | L | E | 0 | | | + +---------+---+---+---+---+---+---+---+---+-- - - - - --+------------+ + len pad ^ + | + new value of HERE + + and is whatever 32 bit integer was at the top of the stack. + + , (COMMA) is quite a fundamental operation when compiling. It is used to append codewords + to the current word that is being compiled. +*/ + + defcode ",",1,,COMMA + pop %eax // Code pointer to store. + call _COMMA + NEXT +_COMMA: + movl var_HERE,%edi // HERE + stosl // Store it. + movl %edi,var_HERE // Update HERE (incremented) + ret + +/* + Our definitions of : (COLON) and ; (SEMICOLON) will need to switch to and from compile mode. + + Immediate mode vs. compile mode is stored in the global variable STATE, and by updating this + variable we can switch between the two modes. + + For various reasons which may become apparent later, FORTH defines two standard words called + [ and ] (LBRAC and RBRAC) which switch between modes: + + Word Assembler Action Effect + [ LBRAC STATE := 0 Switch to immediate mode. + ] RBRAC STATE := 1 Switch to compile mode. + + [ (LBRAC) is an IMMEDIATE word. The reason is as follows: If we are in compile mode and the + interpreter saw [ then it would compile it rather than running it. We would never be able to + switch back to immediate mode! So we flag the word as IMMEDIATE so that even in compile mode + the word runs immediately, switching us back to immediate mode. +*/ + + defcode "[",1,F_IMMED,LBRAC + xor %eax,%eax + movl %eax,var_STATE // Set STATE to 0. + NEXT + + defcode "]",1,,RBRAC + movl $1,var_STATE // Set STATE to 1. + NEXT + +/* + Now we can define : (COLON) using CREATE. It just calls CREATE, appends DOCOL (the codeword), sets + the word HIDDEN and goes into compile mode. +*/ + + defword ":",1,,COLON + .int WORD // Get the name of the new word + .int CREATE // CREATE the dictionary entry / header + .int LIT, DOCOL, COMMA // Append DOCOL (the codeword). + .int LATEST, FETCH, HIDDEN // Make the word hidden (see below for definition). + .int RBRAC // Go into compile mode. + .int EXIT // Return from the function. + +/* + ; (SEMICOLON) is also elegantly simple. Notice the F_IMMED flag. +*/ + + defword ";",1,F_IMMED,SEMICOLON + .int LIT, EXIT, COMMA // Append EXIT (so the word will return). + .int LATEST, FETCH, HIDDEN // Toggle hidden flag -- unhide the word (see below for definition). + .int LBRAC // Go back to IMMEDIATE mode. + .int EXIT // Return from the function. + +/* + EXTENDING THE COMPILER ---------------------------------------------------------------------- + + Words flagged with IMMEDIATE (F_IMMED) aren't just for the FORTH compiler to use. You can define + your own IMMEDIATE words too, and this is a crucial aspect when extending basic FORTH, because + it allows you in effect to extend the compiler itself. Does gcc let you do that? + + Standard FORTH words like IF, WHILE, ." and so on are all written as extensions to the basic + compiler, and are all IMMEDIATE words. + + The IMMEDIATE word toggles the F_IMMED (IMMEDIATE flag) on the most recently defined word, + or on the current word if you call it in the middle of a definition. + + Typical usage is: + + : MYIMMEDWORD IMMEDIATE + ...definition... + ; + + but some FORTH programmers write this instead: + + : MYIMMEDWORD + ...definition... + ; IMMEDIATE + + The two usages are equivalent, to a first approximation. +*/ + + defcode "IMMEDIATE",9,F_IMMED,IMMEDIATE + movl var_LATEST,%edi // LATEST word. + addl $4,%edi // Point to name/flags byte. + xorb $F_IMMED,(%edi) // Toggle the IMMED bit. + NEXT + +/* + 'addr HIDDEN' toggles the hidden flag (F_HIDDEN) of the word defined at addr. To hide the + most recently defined word (used above in : and ; definitions) you would do: + + LATEST @ HIDDEN + + 'HIDE word' toggles the flag on a named 'word'. + + Setting this flag stops the word from being found by FIND, and so can be used to make 'private' + words. For example, to break up a large word into smaller parts you might do: + + : SUB1 ... subword ... ; + : SUB2 ... subword ... ; + : SUB3 ... subword ... ; + : MAIN ... defined in terms of SUB1, SUB2, SUB3 ... ; + HIDE SUB1 + HIDE SUB2 + HIDE SUB3 + + After this, only MAIN is 'exported' or seen by the rest of the program. +*/ + + defcode "HIDDEN",6,,HIDDEN + pop %edi // Dictionary entry. + addl $4,%edi // Point to name/flags byte. + xorb $F_HIDDEN,(%edi) // Toggle the HIDDEN bit. + NEXT + + defword "HIDE",4,,HIDE + .int WORD // Get the word (after HIDE). + .int FIND // Look up in the dictionary. + .int HIDDEN // Set F_HIDDEN flag. + .int EXIT // Return. + +/* + ' (TICK) is a standard FORTH word which returns the codeword pointer of the next word. + + The common usage is: + + ' FOO , + + which appends the codeword of FOO to the current word we are defining (this only works in compiled code). + + You tend to use ' in IMMEDIATE words. For example an alternate (and rather useless) way to define + a literal 2 might be: + + : LIT2 IMMEDIATE + ' LIT , \ Appends LIT to the currently-being-defined word + 2 , \ Appends the number 2 to the currently-being-defined word + ; + + So you could do: + + : DOUBLE LIT2 * ; + + (If you don't understand how LIT2 works, then you should review the material about compiling words + and immediate mode). + + This definition of ' uses a cheat which I copied from buzzard92. As a result it only works in + compiled code. It is possible to write a version of ' based on WORD, FIND, >CFA which works in + immediate mode too. +*/ + defcode "'",1,,TICK + lodsl // Get the address of the next word and skip it. + pushl %eax // Push it on the stack. + NEXT + +/* + BRANCHING ---------------------------------------------------------------------- + + It turns out that all you need in order to define looping constructs, IF-statements, etc. + are two primitives. + + BRANCH is an unconditional branch. 0BRANCH is a conditional branch (it only branches if the + top of stack is zero). + + The diagram below shows how BRANCH works in some imaginary compiled word. When BRANCH executes, + %esi starts by pointing to the offset field (compare to LIT above): + + +---------------------+-------+---- - - ---+------------+------------+---- - - - ----+------------+ + | (Dictionary header) | DOCOL | | BRANCH | offset | (skipped) | word | + +---------------------+-------+---- - - ---+------------+-----|------+---- - - - ----+------------+ + ^ | ^ + | | | + | +-----------------------+ + %esi added to offset + + The offset is added to %esi to make the new %esi, and the result is that when NEXT runs, execution + continues at the branch target. Negative offsets work as expected. + + 0BRANCH is the same except the branch happens conditionally. + + Now standard FORTH words such as IF, THEN, ELSE, WHILE, REPEAT, etc. can be implemented entirely + in FORTH. They are IMMEDIATE words which append various combinations of BRANCH or 0BRANCH + into the word currently being compiled. + + As an example, code written like this: + + condition-code IF true-part THEN rest-code + + compiles to: + + condition-code 0BRANCH OFFSET true-part rest-code + | ^ + | | + +-------------+ +*/ + + defcode "BRANCH",6,,BRANCH + add (%esi),%esi // add the offset to the instruction pointer + NEXT + + defcode "0BRANCH",7,,ZBRANCH + pop %eax + test %eax,%eax // top of stack is zero? + jz code_BRANCH // if so, jump back to the branch function above + lodsl // otherwise we need to skip the offset + NEXT + +/* + LITERAL STRINGS ---------------------------------------------------------------------- + + LITSTRING is a primitive used to implement the ." and S" operators (which are written in + FORTH). See the definition of those operators later. + + TELL just prints a string. It's more efficient to define this in assembly because we + can make it a single Linux syscall. +*/ + + defcode "LITSTRING",9,,LITSTRING + lodsl // get the length of the string + push %esi // push the address of the start of the string + push %eax // push it on the stack + addl %eax,%esi // skip past the string + addl $3,%esi // but round up to next 4 byte boundary + andl $~3,%esi + NEXT + + defcode "TELL",4,,TELL + mov $1,%ebx // 1st param: stdout + pop %edx // 3rd param: length of string + pop %ecx // 2nd param: address of string + mov $__NR_write,%eax // write syscall + int $0x80 + NEXT + +/* + QUIT AND INTERPRET ---------------------------------------------------------------------- + + QUIT is the first FORTH function called, almost immediately after the FORTH system "boots". + As explained before, QUIT doesn't "quit" anything. It does some initialisation (in particular + it clears the return stack) and it calls INTERPRET in a loop to interpret commands. The + reason it is called QUIT is because you can call it from your own FORTH words in order to + "quit" your program and start again at the user prompt. + + INTERPRET is the FORTH interpreter ("toploop", "toplevel" or "REPL" might be a more accurate + description -- see: http://en.wikipedia.org/wiki/REPL). +*/ + + // QUIT must not return (ie. must not call EXIT). + defword "QUIT",4,,QUIT + .int RZ,RSPSTORE // R0 RSP!, clear the return stack + .int INTERPRET // interpret the next word + .int BRANCH,-8 // and loop (indefinitely) + +/* + This interpreter is pretty simple, but remember that in FORTH you can always override + it later with a more powerful one! + */ + defcode "INTERPRET",9,,INTERPRET + call _WORD // Returns %ecx = length, %edi = pointer to word. + + // Is it in the dictionary? + xor %eax,%eax + movl %eax,interpret_is_lit // Not a literal number (not yet anyway ...) + call _FIND // Returns %eax = pointer to header or 0 if not found. + test %eax,%eax // Found? + jz 1f + + // In the dictionary. Is it an IMMEDIATE codeword? + mov %eax,%edi // %edi = dictionary entry + movb 4(%edi),%al // Get name+flags. + push %ax // Just save it for now. + call _TCFA // Convert dictionary entry (in %edi) to codeword pointer. + pop %ax + andb $F_IMMED,%al // Is IMMED flag set? + mov %edi,%eax + jnz 4f // If IMMED, jump straight to executing. + + jmp 2f + +1: // Not in the dictionary (not a word) so assume it's a literal number. + incl interpret_is_lit + call _NUMBER // Returns the parsed number in %eax, %ecx > 0 if error + test %ecx,%ecx + jnz 6f + mov %eax,%ebx + mov $LIT,%eax // The word is LIT + +2: // Are we compiling or executing? + movl var_STATE,%edx + test %edx,%edx + jz 4f // Jump if executing. + + // Compiling - just append the word to the current dictionary definition. + call _COMMA + mov interpret_is_lit,%ecx // Was it a literal? + test %ecx,%ecx + jz 3f + mov %ebx,%eax // Yes, so LIT is followed by a number. + call _COMMA +3: NEXT + +4: // Executing - run it! + mov interpret_is_lit,%ecx // Literal? + test %ecx,%ecx // Literal? + jnz 5f + + // Not a literal, execute it now. This never returns, but the codeword will + // eventually call NEXT which will reenter the loop in QUIT. + jmp *(%eax) + +5: // Executing a literal, which means push it on the stack. + push %ebx + NEXT + +6: // Parse error (not a known word or a number in the current BASE). + // Print an error message followed by up to 40 characters of context. + mov $2,%ebx // 1st param: stderr + mov $errmsg,%ecx // 2nd param: error message + mov $errmsgend-errmsg,%edx // 3rd param: length of string + mov $__NR_write,%eax // write syscall + int $0x80 + + mov (currkey),%ecx // the error occurred just before currkey position + mov %ecx,%edx + sub $buffer,%edx // %edx = currkey - buffer (length in buffer before currkey) + cmp $40,%edx // if > 40, then print only 40 characters + jle 7f + mov $40,%edx +7: sub %edx,%ecx // %ecx = start of area to print, %edx = length + mov $__NR_write,%eax // write syscall + int $0x80 + + mov $errmsgnl,%ecx // newline + mov $1,%edx + mov $__NR_write,%eax // write syscall + int $0x80 + + NEXT + + .section .rodata +errmsg: .ascii "PARSE ERROR: " +errmsgend: +errmsgnl: .ascii "\n" + + .data // NB: easier to fit in the .data section + .align 4 +interpret_is_lit: + .int 0 // Flag used to record if reading a literal + +/* + ODDS AND ENDS ---------------------------------------------------------------------- + + CHAR puts the ASCII code of the first character of the following word on the stack. For example + CHAR A puts 65 on the stack. + + EXECUTE is used to run execution tokens. See the discussion of execution tokens in the + FORTH code for more details. + + SYSCALL0, SYSCALL1, SYSCALL2, SYSCALL3 make a standard Linux system call. (See + for a list of system call numbers). As their name suggests these forms take between 0 and 3 + syscall parameters, plus the system call number. + + In this FORTH, SYSCALL0 must be the last word in the built-in (assembler) dictionary because we + initialise the LATEST variable to point to it. This means that if you want to extend the assembler + part, you must put new words before SYSCALL0, or else change how LATEST is initialised. +*/ + + defcode "CHAR",4,,CHAR + call _WORD // Returns %ecx = length, %edi = pointer to word. + xor %eax,%eax + movb (%edi),%al // Get the first character of the word. + push %eax // Push it onto the stack. + NEXT + + defcode "EXECUTE",7,,EXECUTE + pop %eax // Get xt into %eax + jmp *(%eax) // and jump to it. + // After xt runs its NEXT will continue executing the current word. + + defcode "SYSCALL3",8,,SYSCALL3 + pop %eax // System call number (see ) + pop %ebx // First parameter. + pop %ecx // Second parameter + pop %edx // Third parameter + int $0x80 + push %eax // Result (negative for -errno) + NEXT + + defcode "SYSCALL2",8,,SYSCALL2 + pop %eax // System call number (see ) + pop %ebx // First parameter. + pop %ecx // Second parameter + int $0x80 + push %eax // Result (negative for -errno) + NEXT + + defcode "SYSCALL1",8,,SYSCALL1 + pop %eax // System call number (see ) + pop %ebx // First parameter. + int $0x80 + push %eax // Result (negative for -errno) + NEXT + + defcode "SYSCALL0",8,,SYSCALL0 + pop %eax // System call number (see ) + int $0x80 + push %eax // Result (negative for -errno) + NEXT + +/* + DATA SEGMENT ---------------------------------------------------------------------- + + Here we set up the Linux data segment, used for user definitions and variously known as just + the 'data segment', 'user memory' or 'user definitions area'. It is an area of memory which + grows upwards and stores both newly-defined FORTH words and global variables of various + sorts. + + It is completely analogous to the C heap, except there is no generalised 'malloc' and 'free' + (but as with everything in FORTH, writing such functions would just be a Simple Matter + Of Programming). Instead in normal use the data segment just grows upwards as new FORTH + words are defined/appended to it. + + There are various "features" of the GNU toolchain which make setting up the data segment + more complicated than it really needs to be. One is the GNU linker which inserts a random + "build ID" segment. Another is Address Space Randomization which means we can't tell + where the kernel will choose to place the data segment (or the stack for that matter). + + Therefore writing this set_up_data_segment assembler routine is a little more complicated + than it really needs to be. We ask the Linux kernel where it thinks the data segment starts + using the brk(2) system call, then ask it to reserve some initial space (also using brk(2)). + + You don't need to worry about this code. +*/ + .text + .set INITIAL_DATA_SEGMENT_SIZE,65536 +set_up_data_segment: + xor %ebx,%ebx // Call brk(0) + movl $__NR_brk,%eax + int $0x80 + movl %eax,var_HERE // Initialise HERE to point at beginning of data segment. + addl $INITIAL_DATA_SEGMENT_SIZE,%eax // Reserve nn bytes of memory for initial data segment. + movl %eax,%ebx // Call brk(HERE+INITIAL_DATA_SEGMENT_SIZE) + movl $__NR_brk,%eax + int $0x80 + ret + +/* + We allocate static buffers for the return static and input buffer (used when + reading in files and text that the user types in). +*/ + .set RETURN_STACK_SIZE,8192 + .set BUFFER_SIZE,4096 + + .bss +/* FORTH return stack. */ + .align 4096 +return_stack: + .space RETURN_STACK_SIZE +return_stack_top: // Initial top of return stack. + +/* This is used as a temporary input buffer when reading from files or the terminal. */ + .align 4096 +buffer: + .space BUFFER_SIZE + +/* + START OF FORTH CODE ---------------------------------------------------------------------- + + We've now reached the stage where the FORTH system is running and self-hosting. All further + words can be written as FORTH itself, including words like IF, THEN, .", etc which in most + languages would be considered rather fundamental. + + I used to append this here in the assembly file, but I got sick of fighting against gas's + crack-smoking (lack of) multiline string syntax. So now that is in a separate file called + jonesforth.f + + If you don't already have that file, download it from http://annexia.org/forth in order + to continue the tutorial. +*/ + +/* END OF jonesforth.S */ diff --git a/docs/jonesforth/jonesforth.fs b/docs/jonesforth/jonesforth.fs new file mode 100644 index 0000000..5a998cc --- /dev/null +++ b/docs/jonesforth/jonesforth.fs @@ -0,0 +1,1790 @@ +\ -*- text -*- +\ A sometimes minimal FORTH compiler and tutorial for Linux / i386 systems. -*- asm -*- +\ By Richard W.M. Jones http://annexia.org/forth +\ This is PUBLIC DOMAIN (see public domain release statement below). +\ $Id: jonesforth.f,v 1.17 2007/10/12 20:07:44 rich Exp $ +\ +\ The first part of this tutorial is in jonesforth.S. Get if from http://annexia.org/forth +\ +\ PUBLIC DOMAIN ---------------------------------------------------------------------- +\ +\ I, the copyright holder of this work, hereby release it into the public domain. This applies worldwide. +\ +\ In case this is not legally possible, I grant any entity the right to use this work for any purpose, +\ without any conditions, unless such conditions are required by law. +\ +\ SETTING UP ---------------------------------------------------------------------- +\ +\ Let's get a few housekeeping things out of the way. Firstly because I need to draw lots of +\ ASCII-art diagrams to explain concepts, the best way to look at this is using a window which +\ uses a fixed width font and is at least this wide: +\ +\<------------------------------------------------------------------------------------------------------------------------> +\ +\ Secondly make sure TABS are set to 8 characters. The following should be a vertical +\ line. If not, sort out your tabs. +\ +\ | +\ | +\ | +\ +\ Thirdly I assume that your screen is at least 50 characters high. +\ +\ START OF FORTH CODE ---------------------------------------------------------------------- +\ +\ We've now reached the stage where the FORTH system is running and self-hosting. All further +\ words can be written as FORTH itself, including words like IF, THEN, .", etc which in most +\ languages would be considered rather fundamental. +\ +\ Some notes about the code: +\ +\ I use indenting to show structure. The amount of whitespace has no meaning to FORTH however +\ except that you must use at least one whitespace character between words, and words themselves +\ cannot contain whitespace. +\ +\ FORTH is case-sensitive. Use capslock! + +\ The primitive word /MOD (DIVMOD) leaves both the quotient and the remainder on the stack. (On +\ i386, the idivl instruction gives both anyway). Now we can define the / and MOD in terms of /MOD +\ and a few other primitives. +: / /MOD SWAP DROP ; +: MOD /MOD DROP ; + +\ Define some character constants +: '\n' 10 ; +: BL 32 ; \ BL (BLank) is a standard FORTH word for space. + +\ CR prints a carriage return +: CR '\n' EMIT ; + +\ SPACE prints a space +: SPACE BL EMIT ; + +\ NEGATE leaves the negative of a number on the stack. +: NEGATE 0 SWAP - ; + +\ Standard words for booleans. +: TRUE 1 ; +: FALSE 0 ; +: NOT 0= ; + +\ LITERAL takes whatever is on the stack and compiles LIT +: LITERAL IMMEDIATE + ' LIT , \ compile LIT + , \ compile the literal itself (from the stack) + ; + +\ Now we can use [ and ] to insert literals which are calculated at compile time. (Recall that +\ [ and ] are the FORTH words which switch into and out of immediate mode.) +\ Within definitions, use [ ... ] LITERAL anywhere that '...' is a constant expression which you +\ would rather only compute once (at compile time, rather than calculating it each time your word runs). +: ':' + [ \ go into immediate mode (temporarily) + CHAR : \ push the number 58 (ASCII code of colon) on the parameter stack + ] \ go back to compile mode + LITERAL \ compile LIT 58 as the definition of ':' word +; + +\ A few more character constants defined the same way as above. +: ';' [ CHAR ; ] LITERAL ; +: '(' [ CHAR ( ] LITERAL ; +: ')' [ CHAR ) ] LITERAL ; +: '"' [ CHAR " ] LITERAL ; +: 'A' [ CHAR A ] LITERAL ; +: '0' [ CHAR 0 ] LITERAL ; +: '-' [ CHAR - ] LITERAL ; +: '.' [ CHAR . ] LITERAL ; + +\ While compiling, '[COMPILE] word' compiles 'word' if it would otherwise be IMMEDIATE. +: [COMPILE] IMMEDIATE + WORD \ get the next word + FIND \ find it in the dictionary + >CFA \ get its codeword + , \ and compile that +; + +\ RECURSE makes a recursive call to the current word that is being compiled. +\ +\ Normally while a word is being compiled, it is marked HIDDEN so that references to the +\ same word within are calls to the previous definition of the word. However we still have +\ access to the word which we are currently compiling through the LATEST pointer so we +\ can use that to compile a recursive call. +: RECURSE IMMEDIATE + LATEST @ \ LATEST points to the word being compiled at the moment + >CFA \ get the codeword + , \ compile it +; + +\ CONTROL STRUCTURES ---------------------------------------------------------------------- +\ +\ So far we have defined only very simple definitions. Before we can go further, we really need to +\ make some control structures, like IF ... THEN and loops. Luckily we can define arbitrary control +\ structures directly in FORTH. +\ +\ Please note that the control structures as I have defined them here will only work inside compiled +\ words. If you try to type in expressions using IF, etc. in immediate mode, then they won't work. +\ Making these work in immediate mode is left as an exercise for the reader. + +\ condition IF true-part THEN rest +\ -- compiles to: --> condition 0BRANCH OFFSET true-part rest +\ where OFFSET is the offset of 'rest' +\ condition IF true-part ELSE false-part THEN +\ -- compiles to: --> condition 0BRANCH OFFSET true-part BRANCH OFFSET2 false-part rest +\ where OFFSET if the offset of false-part and OFFSET2 is the offset of rest + +\ IF is an IMMEDIATE word which compiles 0BRANCH followed by a dummy offset, and places +\ the address of the 0BRANCH on the stack. Later when we see THEN, we pop that address +\ off the stack, calculate the offset, and back-fill the offset. +: IF IMMEDIATE + ' 0BRANCH , \ compile 0BRANCH + HERE @ \ save location of the offset on the stack + 0 , \ compile a dummy offset +; + +: THEN IMMEDIATE + DUP + HERE @ SWAP - \ calculate the offset from the address saved on the stack + SWAP ! \ store the offset in the back-filled location +; + +: ELSE IMMEDIATE + ' BRANCH , \ definite branch to just over the false-part + HERE @ \ save location of the offset on the stack + 0 , \ compile a dummy offset + SWAP \ now back-fill the original (IF) offset + DUP \ same as for THEN word above + HERE @ SWAP - + SWAP ! +; + +\ BEGIN loop-part condition UNTIL +\ -- compiles to: --> loop-part condition 0BRANCH OFFSET +\ where OFFSET points back to the loop-part +\ This is like do { loop-part } while (condition) in the C language +: BEGIN IMMEDIATE + HERE @ \ save location on the stack +; + +: UNTIL IMMEDIATE + ' 0BRANCH , \ compile 0BRANCH + HERE @ - \ calculate the offset from the address saved on the stack + , \ compile the offset here +; + +\ BEGIN loop-part AGAIN +\ -- compiles to: --> loop-part BRANCH OFFSET +\ where OFFSET points back to the loop-part +\ In other words, an infinite loop which can only be returned from with EXIT +: AGAIN IMMEDIATE + ' BRANCH , \ compile BRANCH + HERE @ - \ calculate the offset back + , \ compile the offset here +; + +\ BEGIN condition WHILE loop-part REPEAT +\ -- compiles to: --> condition 0BRANCH OFFSET2 loop-part BRANCH OFFSET +\ where OFFSET points back to condition (the beginning) and OFFSET2 points to after the whole piece of code +\ So this is like a while (condition) { loop-part } loop in the C language +: WHILE IMMEDIATE + ' 0BRANCH , \ compile 0BRANCH + HERE @ \ save location of the offset2 on the stack + 0 , \ compile a dummy offset2 +; + +: REPEAT IMMEDIATE + ' BRANCH , \ compile BRANCH + SWAP \ get the original offset (from BEGIN) + HERE @ - , \ and compile it after BRANCH + DUP + HERE @ SWAP - \ calculate the offset2 + SWAP ! \ and back-fill it in the original location +; + +\ UNLESS is the same as IF but the test is reversed. +\ +\ Note the use of [COMPILE]: Since IF is IMMEDIATE we don't want it to be executed while UNLESS +\ is compiling, but while UNLESS is running (which happens to be when whatever word using UNLESS is +\ being compiled -- whew!). So we use [COMPILE] to reverse the effect of marking IF as immediate. +\ This trick is generally used when we want to write our own control words without having to +\ implement them all in terms of the primitives 0BRANCH and BRANCH, but instead reusing simpler +\ control words like (in this instance) IF. +: UNLESS IMMEDIATE + ' NOT , \ compile NOT (to reverse the test) + [COMPILE] IF \ continue by calling the normal IF +; + +\ COMMENTS ---------------------------------------------------------------------- +\ +\ FORTH allows ( ... ) as comments within function definitions. This works by having an IMMEDIATE +\ word called ( which just drops input characters until it hits the corresponding ). +: ( IMMEDIATE + 1 \ allowed nested parens by keeping track of depth + BEGIN + KEY \ read next character + DUP '(' = IF \ open paren? + DROP \ drop the open paren + 1+ \ depth increases + ELSE + ')' = IF \ close paren? + 1- \ depth decreases + THEN + THEN + DUP 0= UNTIL \ continue until we reach matching close paren, depth 0 + DROP \ drop the depth counter +; + +( + From now on we can use ( ... ) for comments. + + STACK NOTATION ---------------------------------------------------------------------- + + In FORTH style we can also use ( ... -- ... ) to show the effects that a word has on the + parameter stack. For example: + + ( n -- ) means that the word consumes an integer (n) from the parameter stack. + ( b a -- c ) means that the word uses two integers (a and b, where a is at the top of stack) + and returns a single integer (c). + ( -- ) means the word has no effect on the stack +) + +( Some more complicated stack examples, showing the stack notation. ) +: NIP ( x y -- y ) SWAP DROP ; +: TUCK ( x y -- y x y ) DUP ROT ; +: PICK ( x_u ... x_1 x_0 u -- x_u ... x_1 x_0 x_u ) + 1+ ( add one because of 'u' on the stack ) + 4 * ( multiply by the word size ) + DSP@ + ( add to the stack pointer ) + @ ( and fetch ) +; + +( With the looping constructs, we can now write SPACES, which writes n spaces to stdout. ) +: SPACES ( n -- ) + BEGIN + DUP 0> ( while n > 0 ) + WHILE + SPACE ( print a space ) + 1- ( until we count down to 0 ) + REPEAT + DROP +; + +( Standard words for manipulating BASE. ) +: DECIMAL ( -- ) 10 BASE ! ; +: HEX ( -- ) 16 BASE ! ; + +( + PRINTING NUMBERS ---------------------------------------------------------------------- + + The standard FORTH word . (DOT) is very important. It takes the number at the top + of the stack and prints it out. However first I'm going to implement some lower-level + FORTH words: + + U.R ( u width -- ) which prints an unsigned number, padded to a certain width + U. ( u -- ) which prints an unsigned number + .R ( n width -- ) which prints a signed number, padded to a certain width. + + For example: + -123 6 .R + will print out these characters: + - 1 2 3 + + In other words, the number padded left to a certain number of characters. + + The full number is printed even if it is wider than width, and this is what allows us to + define the ordinary functions U. and . (we just set width to zero knowing that the full + number will be printed anyway). + + Another wrinkle of . and friends is that they obey the current base in the variable BASE. + BASE can be anything in the range 2 to 36. + + While we're defining . &c we can also define .S which is a useful debugging tool. This + word prints the current stack (non-destructively) from top to bottom. +) + +( This is the underlying recursive definition of U. ) +: U. ( u -- ) + BASE @ /MOD ( width rem quot ) + ?DUP IF ( if quotient <> 0 then ) + RECURSE ( print the quotient ) + THEN + + ( print the remainder ) + DUP 10 < IF + '0' ( decimal digits 0..9 ) + ELSE + 10 - ( hex and beyond digits A..Z ) + 'A' + THEN + + + EMIT +; + +( + FORTH word .S prints the contents of the stack. It doesn't alter the stack. + Very useful for debugging. +) +: .S ( -- ) + DSP@ ( get current stack pointer ) + BEGIN + DUP S0 @ < + WHILE + DUP @ U. ( print the stack element ) + SPACE + 4+ ( move up ) + REPEAT + DROP +; + +( This word returns the width (in characters) of an unsigned number in the current base ) +: UWIDTH ( u -- width ) + BASE @ / ( rem quot ) + ?DUP IF ( if quotient <> 0 then ) + RECURSE 1+ ( return 1+recursive call ) + ELSE + 1 ( return 1 ) + THEN +; + +: U.R ( u width -- ) + SWAP ( width u ) + DUP ( width u u ) + UWIDTH ( width u uwidth ) + -ROT ( u uwidth width ) + SWAP - ( u width-uwidth ) + ( At this point if the requested width is narrower, we'll have a negative number on the stack. + Otherwise the number on the stack is the number of spaces to print. But SPACES won't print + a negative number of spaces anyway, so it's now safe to call SPACES ... ) + SPACES + ( ... and then call the underlying implementation of U. ) + U. +; + +( + .R prints a signed number, padded to a certain width. We can't just print the sign + and call U.R because we want the sign to be next to the number ('-123' instead of '- 123'). +) +: .R ( n width -- ) + SWAP ( width n ) + DUP 0< IF + NEGATE ( width u ) + 1 ( save a flag to remember that it was negative | width n 1 ) + ROT ( 1 width u ) + SWAP ( 1 u width ) + 1- ( 1 u width-1 ) + ELSE + 0 ( width u 0 ) + ROT ( 0 width u ) + SWAP ( 0 u width ) + THEN + SWAP ( flag width u ) + DUP ( flag width u u ) + UWIDTH ( flag width u uwidth ) + -ROT ( flag u uwidth width ) + SWAP - ( flag u width-uwidth ) + + SPACES ( flag u ) + SWAP ( u flag ) + + IF ( was it negative? print the - character ) + '-' EMIT + THEN + + U. +; + +( Finally we can define word . in terms of .R, with a trailing space. ) +: . 0 .R SPACE ; + +( The real U., note the trailing space. ) +: U. U. SPACE ; + +( ? fetches the integer at an address and prints it. ) +: ? ( addr -- ) @ . ; + +( c a b WITHIN returns true if a <= c and c < b ) +: WITHIN + ROT ( b c a ) + OVER ( b c a c ) + <= IF + > IF ( b c -- ) + TRUE + ELSE + FALSE + THEN + ELSE + 2DROP ( b c -- ) + FALSE + THEN +; + +( DEPTH returns the depth of the stack. ) +: DEPTH ( -- n ) + S0 @ DSP@ - + 4- ( adjust because S0 was on the stack when we pushed DSP ) +; + +( + ALIGNED takes an address and rounds it up (aligns it) to the next 4 byte boundary. +) +: ALIGNED ( addr -- addr ) + 3 + 3 INVERT AND ( (addr+3) & ~3 ) +; + +( + ALIGN aligns the HERE pointer, so the next word appended will be aligned properly. +) +: ALIGN HERE @ ALIGNED HERE ! ; + +( + STRINGS ---------------------------------------------------------------------- + + S" string" is used in FORTH to define strings. It leaves the address of the string and + its length on the stack, (length at the top of stack). The space following S" is the normal + space between FORTH words and is not a part of the string. + + This is tricky to define because it has to do different things depending on whether + we are compiling or in immediate mode. (Thus the word is marked IMMEDIATE so it can + detect this and do different things). + + In compile mode we append + LITSTRING + to the current word. The primitive LITSTRING does the right thing when the current + word is executed. + + In immediate mode there isn't a particularly good place to put the string, but in this + case we put the string at HERE (but we _don't_ change HERE). This is meant as a temporary + location, likely to be overwritten soon after. +) +( C, appends a byte to the current compiled word. ) +: C, + HERE @ C! ( store the character in the compiled image ) + 1 HERE +! ( increment HERE pointer by 1 byte ) +; + +: S" IMMEDIATE ( -- addr len ) + STATE @ IF ( compiling? ) + ' LITSTRING , ( compile LITSTRING ) + HERE @ ( save the address of the length word on the stack ) + 0 , ( dummy length - we don't know what it is yet ) + BEGIN + KEY ( get next character of the string ) + DUP '"' <> + WHILE + C, ( copy character ) + REPEAT + DROP ( drop the double quote character at the end ) + DUP ( get the saved address of the length word ) + HERE @ SWAP - ( calculate the length ) + 4- ( subtract 4 (because we measured from the start of the length word) ) + SWAP ! ( and back-fill the length location ) + ALIGN ( round up to next multiple of 4 bytes for the remaining code ) + ELSE ( immediate mode ) + HERE @ ( get the start address of the temporary space ) + BEGIN + KEY + DUP '"' <> + WHILE + OVER C! ( save next character ) + 1+ ( increment address ) + REPEAT + DROP ( drop the final " character ) + HERE @ - ( calculate the length ) + HERE @ ( push the start address ) + SWAP ( addr len ) + THEN +; + +( + ." is the print string operator in FORTH. Example: ." Something to print" + The space after the operator is the ordinary space required between words and is not + a part of what is printed. + + In immediate mode we just keep reading characters and printing them until we get to + the next double quote. + + In compile mode we use S" to store the string, then add TELL afterwards: + LITSTRING TELL + + It may be interesting to note the use of [COMPILE] to turn the call to the immediate + word S" into compilation of that word. It compiles it into the definition of .", + not into the definition of the word being compiled when this is running (complicated + enough for you?) +) +: ." IMMEDIATE ( -- ) + STATE @ IF ( compiling? ) + [COMPILE] S" ( read the string, and compile LITSTRING, etc. ) + ' TELL , ( compile the final TELL ) + ELSE + ( In immediate mode, just read characters and print them until we get + to the ending double quote. ) + BEGIN + KEY + DUP '"' = IF + DROP ( drop the double quote character ) + EXIT ( return from this function ) + THEN + EMIT + AGAIN + THEN +; + +( + CONSTANTS AND VARIABLES ---------------------------------------------------------------------- + + In FORTH, global constants and variables are defined like this: + + 10 CONSTANT TEN when TEN is executed, it leaves the integer 10 on the stack + VARIABLE VAR when VAR is executed, it leaves the address of VAR on the stack + + Constants can be read but not written, eg: + + TEN . CR prints 10 + + You can read a variable (in this example called VAR) by doing: + + VAR @ leaves the value of VAR on the stack + VAR @ . CR prints the value of VAR + VAR ? CR same as above, since ? is the same as @ . + + and update the variable by doing: + + 20 VAR ! sets VAR to 20 + + Note that variables are uninitialised (but see VALUE later on which provides initialised + variables with a slightly simpler syntax). + + How can we define the words CONSTANT and VARIABLE? + + The trick is to define a new word for the variable itself (eg. if the variable was called + 'VAR' then we would define a new word called VAR). This is easy to do because we exposed + dictionary entry creation through the CREATE word (part of the definition of : above). + A call to WORD [TEN] CREATE (where [TEN] means that "TEN" is the next word in the input) + leaves the dictionary entry: + + +--- HERE + | + V + +---------+---+---+---+---+ + | LINK | 3 | T | E | N | + +---------+---+---+---+---+ + len + + For CONSTANT we can continue by appending DOCOL (the codeword), then LIT followed by + the constant itself and then EXIT, forming a little word definition that returns the + constant: + + +---------+---+---+---+---+------------+------------+------------+------------+ + | LINK | 3 | T | E | N | DOCOL | LIT | 10 | EXIT | + +---------+---+---+---+---+------------+------------+------------+------------+ + len codeword + + Notice that this word definition is exactly the same as you would have got if you had + written : TEN 10 ; + + Note for people reading the code below: DOCOL is a constant word which we defined in the + assembler part which returns the value of the assembler symbol of the same name. +) +: CONSTANT + WORD ( get the name (the name follows CONSTANT) ) + CREATE ( make the dictionary entry ) + DOCOL , ( append DOCOL (the codeword field of this word) ) + ' LIT , ( append the codeword LIT ) + , ( append the value on the top of the stack ) + ' EXIT , ( append the codeword EXIT ) +; + +( + VARIABLE is a little bit harder because we need somewhere to put the variable. There is + nothing particularly special about the user memory (the area of memory pointed to by HERE + where we have previously just stored new word definitions). We can slice off bits of this + memory area to store anything we want, so one possible definition of VARIABLE might create + this: + + +--------------------------------------------------------------+ + | | + V | + +---------+---------+---+---+---+---+------------+------------+---|--------+------------+ + | | LINK | 3 | V | A | R | DOCOL | LIT | | EXIT | + +---------+---------+---+---+---+---+------------+------------+------------+------------+ + len codeword + + where is the place to store the variable, and points back to it. + + To make this more general let's define a couple of words which we can use to allocate + arbitrary memory from the user memory. + + First ALLOT, where n ALLOT allocates n bytes of memory. (Note when calling this that + it's a very good idea to make sure that n is a multiple of 4, or at least that next time + a word is compiled that HERE has been left as a multiple of 4). +) +: ALLOT ( n -- addr ) + HERE @ SWAP ( here n ) + HERE +! ( adds n to HERE, after this the old value of HERE is still on the stack ) +; + +( + Second, CELLS. In FORTH the phrase 'n CELLS ALLOT' means allocate n integers of whatever size + is the natural size for integers on this machine architecture. On this 32 bit machine therefore + CELLS just multiplies the top of stack by 4. +) +: CELLS ( n -- n ) 4 * ; + +( + So now we can define VARIABLE easily in much the same way as CONSTANT above. Refer to the + diagram above to see what the word that this creates will look like. +) +: VARIABLE + 1 CELLS ALLOT ( allocate 1 cell of memory, push the pointer to this memory ) + WORD CREATE ( make the dictionary entry (the name follows VARIABLE) ) + DOCOL , ( append DOCOL (the codeword field of this word) ) + ' LIT , ( append the codeword LIT ) + , ( append the pointer to the new memory ) + ' EXIT , ( append the codeword EXIT ) +; + +( + VALUES ---------------------------------------------------------------------- + + VALUEs are like VARIABLEs but with a simpler syntax. You would generally use them when you + want a variable which is read often, and written infrequently. + + 20 VALUE VAL creates VAL with initial value 20 + VAL pushes the value (20) directly on the stack + 30 TO VAL updates VAL, setting it to 30 + VAL pushes the value (30) directly on the stack + + Notice that 'VAL' on its own doesn't return the address of the value, but the value itself, + making values simpler and more obvious to use than variables (no indirection through '@'). + The price is a more complicated implementation, although despite the complexity there is no + performance penalty at runtime. + + A naive implementation of 'TO' would be quite slow, involving a dictionary search each time. + But because this is FORTH we have complete control of the compiler so we can compile TO more + efficiently, turning: + TO VAL + into: + LIT ! + and calculating (the address of the value) at compile time. + + Now this is the clever bit. We'll compile our value like this: + + +---------+---+---+---+---+------------+------------+------------+------------+ + | LINK | 3 | V | A | L | DOCOL | LIT | | EXIT | + +---------+---+---+---+---+------------+------------+------------+------------+ + len codeword + + where is the actual value itself. Note that when VAL executes, it will push the + value on the stack, which is what we want. + + But what will TO use for the address ? Why of course a pointer to that : + + code compiled - - - - --+------------+------------+------------+-- - - - - + by TO VAL | LIT | | ! | + - - - - --+------------+-----|------+------------+-- - - - - + | + V + +---------+---+---+---+---+------------+------------+------------+------------+ + | LINK | 3 | V | A | L | DOCOL | LIT | | EXIT | + +---------+---+---+---+---+------------+------------+------------+------------+ + len codeword + + In other words, this is a kind of self-modifying code. + + (Note to the people who want to modify this FORTH to add inlining: values defined this + way cannot be inlined). +) +: VALUE ( n -- ) + WORD CREATE ( make the dictionary entry (the name follows VALUE) ) + DOCOL , ( append DOCOL ) + ' LIT , ( append the codeword LIT ) + , ( append the initial value ) + ' EXIT , ( append the codeword EXIT ) +; + +: TO IMMEDIATE ( n -- ) + WORD ( get the name of the value ) + FIND ( look it up in the dictionary ) + >DFA ( get a pointer to the first data field (the 'LIT') ) + 4+ ( increment to point at the value ) + STATE @ IF ( compiling? ) + ' LIT , ( compile LIT ) + , ( compile the address of the value ) + ' ! , ( compile ! ) + ELSE ( immediate mode ) + ! ( update it straightaway ) + THEN +; + +( x +TO VAL adds x to VAL ) +: +TO IMMEDIATE + WORD ( get the name of the value ) + FIND ( look it up in the dictionary ) + >DFA ( get a pointer to the first data field (the 'LIT') ) + 4+ ( increment to point at the value ) + STATE @ IF ( compiling? ) + ' LIT , ( compile LIT ) + , ( compile the address of the value ) + ' +! , ( compile +! ) + ELSE ( immediate mode ) + +! ( update it straightaway ) + THEN +; + +( + PRINTING THE DICTIONARY ---------------------------------------------------------------------- + + ID. takes an address of a dictionary entry and prints the word's name. + + For example: LATEST @ ID. would print the name of the last word that was defined. +) +: ID. + 4+ ( skip over the link pointer ) + DUP C@ ( get the flags/length byte ) + F_LENMASK AND ( mask out the flags - just want the length ) + + BEGIN + DUP 0> ( length > 0? ) + WHILE + SWAP 1+ ( addr len -- len addr+1 ) + DUP C@ ( len addr -- len addr char | get the next character) + EMIT ( len addr char -- len addr | and print it) + SWAP 1- ( len addr -- addr len-1 | subtract one from length ) + REPEAT + 2DROP ( len addr -- ) +; + +( + 'WORD word FIND ?HIDDEN' returns true if 'word' is flagged as hidden. + + 'WORD word FIND ?IMMEDIATE' returns true if 'word' is flagged as immediate. +) +: ?HIDDEN + 4+ ( skip over the link pointer ) + C@ ( get the flags/length byte ) + F_HIDDEN AND ( mask the F_HIDDEN flag and return it (as a truth value) ) +; +: ?IMMEDIATE + 4+ ( skip over the link pointer ) + C@ ( get the flags/length byte ) + F_IMMED AND ( mask the F_IMMED flag and return it (as a truth value) ) +; + +( + WORDS prints all the words defined in the dictionary, starting with the word defined most recently. + However it doesn't print hidden words. + + The implementation simply iterates backwards from LATEST using the link pointers. +) +: WORDS + LATEST @ ( start at LATEST dictionary entry ) + BEGIN + ?DUP ( while link pointer is not null ) + WHILE + DUP ?HIDDEN NOT IF ( ignore hidden words ) + DUP ID. ( but if not hidden, print the word ) + SPACE + THEN + @ ( dereference the link pointer - go to previous word ) + REPEAT + CR +; + +( + FORGET ---------------------------------------------------------------------- + + So far we have only allocated words and memory. FORTH provides a rather primitive method + to deallocate. + + 'FORGET word' deletes the definition of 'word' from the dictionary and everything defined + after it, including any variables and other memory allocated after. + + The implementation is very simple - we look up the word (which returns the dictionary entry + address). Then we set HERE to point to that address, so in effect all future allocations + and definitions will overwrite memory starting at the word. We also need to set LATEST to + point to the previous word. + + Note that you cannot FORGET built-in words (well, you can try but it will probably cause + a segfault). + + XXX: Because we wrote VARIABLE to store the variable in memory allocated before the word, + in the current implementation VARIABLE FOO FORGET FOO will leak 1 cell of memory. +) +: FORGET + WORD FIND ( find the word, gets the dictionary entry address ) + DUP @ LATEST ! ( set LATEST to point to the previous word ) + HERE ! ( and store HERE with the dictionary address ) +; + +( + DUMP ---------------------------------------------------------------------- + + DUMP is used to dump out the contents of memory, in the 'traditional' hexdump format. + + Notice that the parameters to DUMP (address, length) are compatible with string words + such as WORD and S". + + You can dump out the raw code for the last word you defined by doing something like: + + LATEST @ 128 DUMP +) +: DUMP ( addr len -- ) + BASE @ ROT ( save the current BASE at the bottom of the stack ) + HEX ( and switch to hexadecimal mode ) + + BEGIN + ?DUP ( while len > 0 ) + WHILE + OVER 8 U.R ( print the address ) + SPACE + + ( print up to 16 words on this line ) + 2DUP ( addr len addr len ) + 1- 15 AND 1+ ( addr len addr linelen ) + BEGIN + ?DUP ( while linelen > 0 ) + WHILE + SWAP ( addr len linelen addr ) + DUP C@ ( addr len linelen addr byte ) + 2 .R SPACE ( print the byte ) + 1+ SWAP 1- ( addr len linelen addr -- addr len addr+1 linelen-1 ) + REPEAT + DROP ( addr len ) + + ( print the ASCII equivalents ) + 2DUP 1- 15 AND 1+ ( addr len addr linelen ) + BEGIN + ?DUP ( while linelen > 0) + WHILE + SWAP ( addr len linelen addr ) + DUP C@ ( addr len linelen addr byte ) + DUP 32 128 WITHIN IF ( 32 <= c < 128? ) + EMIT + ELSE + DROP '.' EMIT + THEN + 1+ SWAP 1- ( addr len linelen addr -- addr len addr+1 linelen-1 ) + REPEAT + DROP ( addr len ) + CR + + DUP 1- 15 AND 1+ ( addr len linelen ) + DUP ( addr len linelen linelen ) + ROT ( addr linelen len linelen ) + - ( addr linelen len-linelen ) + ROT ( len-linelen addr linelen ) + + ( len-linelen addr+linelen ) + SWAP ( addr-linelen len-linelen ) + REPEAT + + DROP ( restore stack ) + BASE ! ( restore saved BASE ) +; + +( + CASE ---------------------------------------------------------------------- + + CASE...ENDCASE is how we do switch statements in FORTH. There is no generally + agreed syntax for this, so I've gone for the syntax mandated by the ISO standard + FORTH (ANS-FORTH). + + ( some value on the stack ) + CASE + test1 OF ... ENDOF + test2 OF ... ENDOF + testn OF ... ENDOF + ... ( default case ) + ENDCASE + + The CASE statement tests the value on the stack by comparing it for equality with + test1, test2, ..., testn and executes the matching piece of code within OF ... ENDOF. + If none of the test values match then the default case is executed. Inside the ... of + the default case, the value is still at the top of stack (it is implicitly DROP-ed + by ENDCASE). When ENDOF is executed it jumps after ENDCASE (ie. there is no "fall-through" + and no need for a break statement like in C). + + The default case may be omitted. In fact the tests may also be omitted so that you + just have a default case, although this is probably not very useful. + + An example (assuming that 'q', etc. are words which push the ASCII value of the letter + on the stack): + + 0 VALUE QUIT + 0 VALUE SLEEP + KEY CASE + 'q' OF 1 TO QUIT ENDOF + 's' OF 1 TO SLEEP ENDOF + ( default case: ) + ." Sorry, I didn't understand key <" DUP EMIT ." >, try again." CR + ENDCASE + + (In some versions of FORTH, more advanced tests are supported, such as ranges, etc. + Other versions of FORTH need you to write OTHERWISE to indicate the default case. + As I said above, this FORTH tries to follow the ANS FORTH standard). + + The implementation of CASE...ENDCASE is somewhat non-trivial. I'm following the + implementations from here: + http://www.uni-giessen.de/faq/archiv/forthfaq.case_endcase/msg00000.html + + The general plan is to compile the code as a series of IF statements: + + CASE (push 0 on the immediate-mode parameter stack) + test1 OF ... ENDOF test1 OVER = IF DROP ... ELSE + test2 OF ... ENDOF test2 OVER = IF DROP ... ELSE + testn OF ... ENDOF testn OVER = IF DROP ... ELSE + ... ( default case ) ... + ENDCASE DROP THEN [THEN [THEN ...]] + + The CASE statement pushes 0 on the immediate-mode parameter stack, and that number + is used to count how many THEN statements we need when we get to ENDCASE so that each + IF has a matching THEN. The counting is done implicitly. If you recall from the + implementation above of IF, each IF pushes a code address on the immediate-mode stack, + and these addresses are non-zero, so by the time we get to ENDCASE the stack contains + some number of non-zeroes, followed by a zero. The number of non-zeroes is how many + times IF has been called, so how many times we need to match it with THEN. + + This code uses [COMPILE] so that we compile calls to IF, ELSE, THEN instead of + actually calling them while we're compiling the words below. + + As is the case with all of our control structures, they only work within word + definitions, not in immediate mode. +) +: CASE IMMEDIATE + 0 ( push 0 to mark the bottom of the stack ) +; + +: OF IMMEDIATE + ' OVER , ( compile OVER ) + ' = , ( compile = ) + [COMPILE] IF ( compile IF ) + ' DROP , ( compile DROP ) +; + +: ENDOF IMMEDIATE + [COMPILE] ELSE ( ENDOF is the same as ELSE ) +; + +: ENDCASE IMMEDIATE + ' DROP , ( compile DROP ) + + ( keep compiling THEN until we get to our zero marker ) + BEGIN + ?DUP + WHILE + [COMPILE] THEN + REPEAT +; + +( + DECOMPILER ---------------------------------------------------------------------- + + CFA> is the opposite of >CFA. It takes a codeword and tries to find the matching + dictionary definition. (In truth, it works with any pointer into a word, not just + the codeword pointer, and this is needed to do stack traces). + + In this FORTH this is not so easy. In fact we have to search through the dictionary + because we don't have a convenient back-pointer (as is often the case in other versions + of FORTH). Because of this search, CFA> should not be used when performance is critical, + so it is only used for debugging tools such as the decompiler and printing stack + traces. + + This word returns 0 if it doesn't find a match. +) +: CFA> + LATEST @ ( start at LATEST dictionary entry ) + BEGIN + ?DUP ( while link pointer is not null ) + WHILE + 2DUP SWAP ( cfa curr curr cfa ) + < IF ( current dictionary entry < cfa? ) + NIP ( leave curr dictionary entry on the stack ) + EXIT + THEN + @ ( follow link pointer back ) + REPEAT + DROP ( restore stack ) + 0 ( sorry, nothing found ) +; + +( + SEE decompiles a FORTH word. + + We search for the dictionary entry of the word, then search again for the next + word (effectively, the end of the compiled word). This results in two pointers: + + +---------+---+---+---+---+------------+------------+------------+------------+ + | LINK | 3 | T | E | N | DOCOL | LIT | 10 | EXIT | + +---------+---+---+---+---+------------+------------+------------+------------+ + ^ ^ + | | + Start of word End of word + + With this information we can have a go at decompiling the word. We need to + recognise "meta-words" like LIT, LITSTRING, BRANCH, etc. and treat those separately. +) +: SEE + WORD FIND ( find the dictionary entry to decompile ) + + ( Now we search again, looking for the next word in the dictionary. This gives us + the length of the word that we will be decompiling. (Well, mostly it does). ) + HERE @ ( address of the end of the last compiled word ) + LATEST @ ( word last curr ) + BEGIN + 2 PICK ( word last curr word ) + OVER ( word last curr word curr ) + <> ( word last curr word<>curr? ) + WHILE ( word last curr ) + NIP ( word curr ) + DUP @ ( word curr prev (which becomes: word last curr) ) + REPEAT + + DROP ( at this point, the stack is: start-of-word end-of-word ) + SWAP ( end-of-word start-of-word ) + + ( begin the definition with : NAME [IMMEDIATE] ) + ':' EMIT SPACE DUP ID. SPACE + DUP ?IMMEDIATE IF ." IMMEDIATE " THEN + + >DFA ( get the data address, ie. points after DOCOL | end-of-word start-of-data ) + + ( now we start decompiling until we hit the end of the word ) + BEGIN ( end start ) + 2DUP > + WHILE + DUP @ ( end start codeword ) + + CASE + ' LIT OF ( is it LIT ? ) + 4 + DUP @ ( get next word which is the integer constant ) + . ( and print it ) + ENDOF + ' LITSTRING OF ( is it LITSTRING ? ) + [ CHAR S ] LITERAL EMIT '"' EMIT SPACE ( print S" ) + 4 + DUP @ ( get the length word ) + SWAP 4 + SWAP ( end start+4 length ) + 2DUP TELL ( print the string ) + '"' EMIT SPACE ( finish the string with a final quote ) + + ALIGNED ( end start+4+len, aligned ) + 4 - ( because we're about to add 4 below ) + ENDOF + ' 0BRANCH OF ( is it 0BRANCH ? ) + ." 0BRANCH ( " + 4 + DUP @ ( print the offset ) + . + ." ) " + ENDOF + ' BRANCH OF ( is it BRANCH ? ) + ." BRANCH ( " + 4 + DUP @ ( print the offset ) + . + ." ) " + ENDOF + ' ' OF ( is it ' (TICK) ? ) + [ CHAR ' ] LITERAL EMIT SPACE + 4 + DUP @ ( get the next codeword ) + CFA> ( and force it to be printed as a dictionary entry ) + ID. SPACE + ENDOF + ' EXIT OF ( is it EXIT? ) + ( We expect the last word to be EXIT, and if it is then we don't print it + because EXIT is normally implied by ;. EXIT can also appear in the middle + of words, and then it needs to be printed. ) + 2DUP ( end start end start ) + 4 + ( end start end start+4 ) + <> IF ( end start | we're not at the end ) + ." EXIT " + THEN + ENDOF + ( default case: ) + DUP ( in the default case we always need to DUP before using ) + CFA> ( look up the codeword to get the dictionary entry ) + ID. SPACE ( and print it ) + ENDCASE + + 4 + ( end start+4 ) + REPEAT + + ';' EMIT CR + + 2DROP ( restore stack ) +; + +( + EXECUTION TOKENS ---------------------------------------------------------------------- + + Standard FORTH defines a concept called an 'execution token' (or 'xt') which is very + similar to a function pointer in C. We map the execution token to a codeword address. + + execution token of DOUBLE is the address of this codeword + | + V + +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ + | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | + +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ + len pad codeword ^ + + There is one assembler primitive for execution tokens, EXECUTE ( xt -- ), which runs them. + + You can make an execution token for an existing word the long way using >CFA, + ie: WORD [foo] FIND >CFA will push the xt for foo onto the stack where foo is the + next word in input. So a very slow way to run DOUBLE might be: + + : DOUBLE DUP + ; + : SLOW WORD FIND >CFA EXECUTE ; + 5 SLOW DOUBLE . CR \ prints 10 + + We also offer a simpler and faster way to get the execution token of any word FOO: + + ['] FOO + + (Exercises for readers: (1) What is the difference between ['] FOO and ' FOO? + (2) What is the relationship between ', ['] and LIT?) + + More useful is to define anonymous words and/or to assign xt's to variables. + + To define an anonymous word (and push its xt on the stack) use :NONAME ... ; as in this + example: + + :NONAME ." anon word was called" CR ; \ pushes xt on the stack + DUP EXECUTE EXECUTE \ executes the anon word twice + + Stack parameters work as expected: + + :NONAME ." called with parameter " . CR ; + DUP + 10 SWAP EXECUTE \ prints 'called with parameter 10' + 20 SWAP EXECUTE \ prints 'called with parameter 20' + + Notice that the above code has a memory leak: the anonymous word is still compiled + into the data segment, so even if you lose track of the xt, the word continues to + occupy memory. A good way to keep track of the xt and thus avoid the memory leak is + to assign it to a CONSTANT, VARIABLE or VALUE: + + 0 VALUE ANON + :NONAME ." anon word was called" CR ; TO ANON + ANON EXECUTE + ANON EXECUTE + + Another use of :NONAME is to create an array of functions which can be called quickly + (think: fast switch statement). This example is adapted from the ANS FORTH standard: + + 10 CELLS ALLOT CONSTANT CMD-TABLE + : SET-CMD CELLS CMD-TABLE + ! ; + : CALL-CMD CELLS CMD-TABLE + @ EXECUTE ; + + :NONAME ." alternate 0 was called" CR ; 0 SET-CMD + :NONAME ." alternate 1 was called" CR ; 1 SET-CMD + \ etc... + :NONAME ." alternate 9 was called" CR ; 9 SET-CMD + + 0 CALL-CMD + 1 CALL-CMD +) + +: :NONAME + 0 0 CREATE ( create a word with no name - we need a dictionary header because ; expects it ) + HERE @ ( current HERE value is the address of the codeword, ie. the xt ) + DOCOL , ( compile DOCOL (the codeword) ) + ] ( go into compile mode ) +; + +: ['] IMMEDIATE + ' LIT , ( compile LIT ) +; + +( + EXCEPTIONS ---------------------------------------------------------------------- + + Amazingly enough, exceptions can be implemented directly in FORTH, in fact rather easily. + + The general usage is as follows: + + : FOO ( n -- ) THROW ; + + : TEST-EXCEPTIONS + 25 ['] FOO CATCH \ execute 25 FOO, catching any exception + ?DUP IF + ." called FOO and it threw exception number: " + . CR + DROP \ we have to drop the argument of FOO (25) + THEN + ; + \ prints: called FOO and it threw exception number: 25 + + CATCH runs an execution token and detects whether it throws any exception or not. The + stack signature of CATCH is rather complicated: + + ( a_n-1 ... a_1 a_0 xt -- r_m-1 ... r_1 r_0 0 ) if xt did NOT throw an exception + ( a_n-1 ... a_1 a_0 xt -- ?_n-1 ... ?_1 ?_0 e ) if xt DID throw exception 'e' + + where a_i and r_i are the (arbitrary number of) argument and return stack contents + before and after xt is EXECUTEd. Notice in particular the case where an exception + is thrown, the stack pointer is restored so that there are n of _something_ on the + stack in the positions where the arguments a_i used to be. We don't really guarantee + what is on the stack -- perhaps the original arguments, and perhaps other nonsense -- + it largely depends on the implementation of the word that was executed. + + THROW, ABORT and a few others throw exceptions. + + Exception numbers are non-zero integers. By convention the positive numbers can be used + for app-specific exceptions and the negative numbers have certain meanings defined in + the ANS FORTH standard. (For example, -1 is the exception thrown by ABORT). + + 0 THROW does nothing. This is the stack signature of THROW: + + ( 0 -- ) + ( * e -- ?_n-1 ... ?_1 ?_0 e ) the stack is restored to the state from the corresponding CATCH + + The implementation hangs on the definitions of CATCH and THROW and the state shared + between them. + + Up to this point, the return stack has consisted merely of a list of return addresses, + with the top of the return stack being the return address where we will resume executing + when the current word EXITs. However CATCH will push a more complicated 'exception stack + frame' on the return stack. The exception stack frame records some things about the + state of execution at the time that CATCH was called. + + When called, THROW walks up the return stack (the process is called 'unwinding') until + it finds the exception stack frame. It then uses the data in the exception stack frame + to restore the state allowing execution to continue after the matching CATCH. (If it + unwinds the stack and doesn't find the exception stack frame then it prints a message + and drops back to the prompt, which is also normal behaviour for so-called 'uncaught + exceptions'). + + This is what the exception stack frame looks like. (As is conventional, the return stack + is shown growing downwards from higher to lower memory addresses). + + +------------------------------+ + | return address from CATCH | Notice this is already on the + | | return stack when CATCH is called. + +------------------------------+ + | original parameter stack | + | pointer | + +------------------------------+ ^ + | exception stack marker | | + | (EXCEPTION-MARKER) | | Direction of stack + +------------------------------+ | unwinding by THROW. + | + | + + The EXCEPTION-MARKER marks the entry as being an exception stack frame rather than an + ordinary return address, and it is this which THROW "notices" as it is unwinding the + stack. (If you want to implement more advanced exceptions such as TRY...WITH then + you'll need to use a different value of marker if you want the old and new exception stack + frame layouts to coexist). + + What happens if the executed word doesn't throw an exception? It will eventually + return and call EXCEPTION-MARKER, so EXCEPTION-MARKER had better do something sensible + without us needing to modify EXIT. This nicely gives us a suitable definition of + EXCEPTION-MARKER, namely a function that just drops the stack frame and itself + returns (thus "returning" from the original CATCH). + + One thing to take from this is that exceptions are a relatively lightweight mechanism + in FORTH. +) + +: EXCEPTION-MARKER + RDROP ( drop the original parameter stack pointer ) + 0 ( there was no exception, this is the normal return path ) +; + +: CATCH ( xt -- exn? ) + DSP@ 4+ >R ( save parameter stack pointer (+4 because of xt) on the return stack ) + ' EXCEPTION-MARKER 4+ ( push the address of the RDROP inside EXCEPTION-MARKER ... ) + >R ( ... on to the return stack so it acts like a return address ) + EXECUTE ( execute the nested function ) +; + +: THROW ( n -- ) + ?DUP IF ( only act if the exception code <> 0 ) + RSP@ ( get return stack pointer ) + BEGIN + DUP R0 4- < ( RSP < R0 ) + WHILE + DUP @ ( get the return stack entry ) + ' EXCEPTION-MARKER 4+ = IF ( found the EXCEPTION-MARKER on the return stack ) + 4+ ( skip the EXCEPTION-MARKER on the return stack ) + RSP! ( restore the return stack pointer ) + + ( Restore the parameter stack. ) + DUP DUP DUP ( reserve some working space so the stack for this word + doesn't coincide with the part of the stack being restored ) + R> ( get the saved parameter stack pointer | n dsp ) + 4- ( reserve space on the stack to store n ) + SWAP OVER ( dsp n dsp ) + ! ( write n on the stack ) + DSP! EXIT ( restore the parameter stack pointer, immediately exit ) + THEN + 4+ + REPEAT + + ( No matching catch - print a message and restart the INTERPRETer. ) + DROP + + CASE + 0 1- OF ( ABORT ) + ." ABORTED" CR + ENDOF + ( default case ) + ." UNCAUGHT THROW " + DUP . CR + ENDCASE + QUIT + THEN +; + +: ABORT ( -- ) + 0 1- THROW +; + +( Print a stack trace by walking up the return stack. ) +: PRINT-STACK-TRACE + RSP@ ( start at caller of this function ) + BEGIN + DUP R0 4- < ( RSP < R0 ) + WHILE + DUP @ ( get the return stack entry ) + CASE + ' EXCEPTION-MARKER 4+ OF ( is it the exception stack frame? ) + ." CATCH ( DSP=" + 4+ DUP @ U. ( print saved stack pointer ) + ." ) " + ENDOF + ( default case ) + DUP + CFA> ( look up the codeword to get the dictionary entry ) + ?DUP IF ( and print it ) + 2DUP ( dea addr dea ) + ID. ( print word from dictionary entry ) + [ CHAR + ] LITERAL EMIT + SWAP >DFA 4+ - . ( print offset ) + THEN + ENDCASE + 4+ ( move up the stack ) + REPEAT + DROP + CR +; + +( + C STRINGS ---------------------------------------------------------------------- + + FORTH strings are represented by a start address and length kept on the stack or in memory. + + Most FORTHs don't handle C strings, but we need them in order to access the process arguments + and environment left on the stack by the Linux kernel, and to make some system calls. + + Operation Input Output FORTH word Notes + ---------------------------------------------------------------------- + + Create FORTH string addr len S" ..." + + Create C string c-addr Z" ..." + + C -> FORTH c-addr addr len DUP STRLEN + + FORTH -> C addr len c-addr CSTRING Allocated in a temporary buffer, so + should be consumed / copied immediately. + FORTH string should not contain NULs. + + For example, DUP STRLEN TELL prints a C string. +) + +( + Z" .." is like S" ..." except that the string is terminated by an ASCII NUL character. + + To make it more like a C string, at runtime Z" just leaves the address of the string + on the stack (not address & length as with S"). To implement this we need to add the + extra NUL to the string and also a DROP instruction afterwards. Apart from that the + implementation just a modified S". +) +: Z" IMMEDIATE + STATE @ IF ( compiling? ) + ' LITSTRING , ( compile LITSTRING ) + HERE @ ( save the address of the length word on the stack ) + 0 , ( dummy length - we don't know what it is yet ) + BEGIN + KEY ( get next character of the string ) + DUP '"' <> + WHILE + HERE @ C! ( store the character in the compiled image ) + 1 HERE +! ( increment HERE pointer by 1 byte ) + REPEAT + 0 HERE @ C! ( add the ASCII NUL byte ) + 1 HERE +! + DROP ( drop the double quote character at the end ) + DUP ( get the saved address of the length word ) + HERE @ SWAP - ( calculate the length ) + 4- ( subtract 4 (because we measured from the start of the length word) ) + SWAP ! ( and back-fill the length location ) + ALIGN ( round up to next multiple of 4 bytes for the remaining code ) + ' DROP , ( compile DROP (to drop the length) ) + ELSE ( immediate mode ) + HERE @ ( get the start address of the temporary space ) + BEGIN + KEY + DUP '"' <> + WHILE + OVER C! ( save next character ) + 1+ ( increment address ) + REPEAT + DROP ( drop the final " character ) + 0 SWAP C! ( store final ASCII NUL ) + HERE @ ( push the start address ) + THEN +; + +: STRLEN ( str -- len ) + DUP ( save start address ) + BEGIN + DUP C@ 0<> ( zero byte found? ) + WHILE + 1+ + REPEAT + + SWAP - ( calculate the length ) +; + +: CSTRING ( addr len -- c-addr ) + SWAP OVER ( len saddr len ) + HERE @ SWAP ( len saddr daddr len ) + CMOVE ( len ) + + HERE @ + ( daddr+len ) + 0 SWAP C! ( store terminating NUL char ) + + HERE @ ( push start address ) +; + +( + THE ENVIRONMENT ---------------------------------------------------------------------- + + Linux makes the process arguments and environment available to us on the stack. + + The top of stack pointer is saved by the early assembler code when we start up in the FORTH + variable S0, and starting at this pointer we can read out the command line arguments and the + environment. + + Starting at S0, S0 itself points to argc (the number of command line arguments). + + S0+4 points to argv[0], S0+8 points to argv[1] etc up to argv[argc-1]. + + argv[argc] is a NULL pointer. + + After that the stack contains environment variables, a set of pointers to strings of the + form NAME=VALUE and on until we get to another NULL pointer. + + The first word that we define, ARGC, pushes the number of command line arguments (note that + as with C argc, this includes the name of the command). +) +: ARGC + S0 @ @ +; + +( + n ARGV gets the nth command line argument. + + For example to print the command name you would do: + 0 ARGV TELL CR +) +: ARGV ( n -- str u ) + 1+ CELLS S0 @ + ( get the address of argv[n] entry ) + @ ( get the address of the string ) + DUP STRLEN ( and get its length / turn it into a FORTH string ) +; + +( + ENVIRON returns the address of the first environment string. The list of strings ends + with a NULL pointer. + + For example to print the first string in the environment you could do: + ENVIRON @ DUP STRLEN TELL +) +: ENVIRON ( -- addr ) + ARGC ( number of command line parameters on the stack to skip ) + 2 + ( skip command line count and NULL pointer after the command line args ) + CELLS ( convert to an offset ) + S0 @ + ( add to base stack address ) +; + +( + SYSTEM CALLS AND FILES ---------------------------------------------------------------------- + + Miscellaneous words related to system calls, and standard access to files. +) + +( BYE exits by calling the Linux exit(2) syscall. ) +: BYE ( -- ) + 0 ( return code (0) ) + SYS_EXIT ( system call number ) + SYSCALL1 +; + +( + UNUSED returns the number of cells remaining in the user memory (data segment). + + For our implementation we will use Linux brk(2) system call to find out the end + of the data segment and subtract HERE from it. +) +: GET-BRK ( -- brkpoint ) + 0 SYS_BRK SYSCALL1 ( call brk(0) ) +; + +: UNUSED ( -- n ) + GET-BRK ( get end of data segment according to the kernel ) + HERE @ ( get current position in data segment ) + - + 4 / ( returns number of cells ) +; + +( + MORECORE increases the data segment by the specified number of (4 byte) cells. + + NB. The number of cells requested should normally be a multiple of 1024. The + reason is that Linux can't extend the data segment by less than a single page + (4096 bytes or 1024 cells). + + This FORTH doesn't automatically increase the size of the data segment "on demand" + (ie. when , (COMMA), ALLOT, CREATE, and so on are used). Instead the programmer + needs to be aware of how much space a large allocation will take, check UNUSED, and + call MORECORE if necessary. A simple programming exercise is to change the + implementation of the data segment so that MORECORE is called automatically if + the program needs more memory. +) +: BRK ( brkpoint -- ) + SYS_BRK SYSCALL1 +; + +: MORECORE ( cells -- ) + CELLS GET-BRK + BRK +; + +( + Standard FORTH provides some simple file access primitives which we model on + top of Linux syscalls. + + The main complication is converting FORTH strings (address & length) into C + strings for the Linux kernel. + + Notice there is no buffering in this implementation. +) + +: R/O ( -- fam ) O_RDONLY ; +: R/W ( -- fam ) O_RDWR ; + +: OPEN-FILE ( addr u fam -- fd 0 (if successful) | c-addr u fam -- fd errno (if there was an error) ) + ROT ( fam addr u ) + CSTRING ( fam cstring ) + SYS_OPEN SYSCALL2 ( open (filename, flags) ) + DUP ( fd fd ) + DUP 0< IF ( errno? ) + NEGATE ( fd errno ) + ELSE + DROP 0 ( fd 0 ) + THEN +; + +: CREATE-FILE ( addr u fam -- fd 0 (if successful) | c-addr u fam -- fd errno (if there was an error) ) + O_CREAT OR + O_TRUNC OR + ROT ( fam addr u ) + CSTRING ( fam cstring ) + 420 ROT ( 0644 fam cstring ) + SYS_OPEN SYSCALL3 ( open (filename, flags|O_TRUNC|O_CREAT, 0644) ) + DUP ( fd fd ) + DUP 0< IF ( errno? ) + NEGATE ( fd errno ) + ELSE + DROP 0 ( fd 0 ) + THEN +; + +: CLOSE-FILE ( fd -- 0 (if successful) | fd -- errno (if there was an error) ) + SYS_CLOSE SYSCALL1 + NEGATE +; + +: READ-FILE ( addr u fd -- u2 0 (if successful) | addr u fd -- 0 0 (if EOF) | addr u fd -- u2 errno (if error) ) + ROT SWAP -ROT ( u addr fd ) + SYS_READ SYSCALL3 + + DUP ( u2 u2 ) + DUP 0< IF ( errno? ) + NEGATE ( u2 errno ) + ELSE + DROP 0 ( u2 0 ) + THEN +; + +( + PERROR prints a message for an errno, similar to C's perror(3) but we don't have the extensive + list of strerror strings available, so all we can do is print the errno. +) +: PERROR ( errno addr u -- ) + TELL + ':' EMIT SPACE + ." ERRNO=" + . CR +; + +( + ASSEMBLER CODE ---------------------------------------------------------------------- + + This is just the outline of a simple assembler, allowing you to write FORTH primitives + in assembly language. + + Assembly primitives begin ': NAME' in the normal way, but are ended with ;CODE. ;CODE + updates the header so that the codeword isn't DOCOL, but points instead to the assembled + code (in the DFA part of the word). + + We provide a convenience macro NEXT (you guessed what it does). However you don't need to + use it because ;CODE will put a NEXT at the end of your word. + + The rest consists of some immediate words which expand into machine code appended to the + definition of the word. Only a very tiny part of the i386 assembly space is covered, just + enough to write a few assembler primitives below. +) + +HEX + +( Equivalent to the NEXT macro ) +: NEXT IMMEDIATE AD C, FF C, 20 C, ; + +: ;CODE IMMEDIATE + [COMPILE] NEXT ( end the word with NEXT macro ) + ALIGN ( machine code is assembled in bytes so isn't necessarily aligned at the end ) + LATEST @ DUP + HIDDEN ( unhide the word ) + DUP >DFA SWAP >CFA ! ( change the codeword to point to the data area ) + [COMPILE] [ ( go back to immediate mode ) +; + +( The i386 registers ) +: EAX IMMEDIATE 0 ; +: ECX IMMEDIATE 1 ; +: EDX IMMEDIATE 2 ; +: EBX IMMEDIATE 3 ; +: ESP IMMEDIATE 4 ; +: EBP IMMEDIATE 5 ; +: ESI IMMEDIATE 6 ; +: EDI IMMEDIATE 7 ; + +( i386 stack instructions ) +: PUSH IMMEDIATE 50 + C, ; +: POP IMMEDIATE 58 + C, ; + +( RDTSC instruction ) +: RDTSC IMMEDIATE 0F C, 31 C, ; + +DECIMAL + +( + RDTSC is an assembler primitive which reads the Pentium timestamp counter (a very fine- + grained counter which counts processor clock cycles). Because the TSC is 64 bits wide + we have to push it onto the stack in two slots. +) +: RDTSC ( -- lsb msb ) + RDTSC ( writes the result in %edx:%eax ) + EAX PUSH ( push lsb ) + EDX PUSH ( push msb ) +;CODE + +( + INLINE can be used to inline an assembler primitive into the current (assembler) + word. + + For example: + + : 2DROP INLINE DROP INLINE DROP ;CODE + + will build an efficient assembler word 2DROP which contains the inline assembly code + for DROP followed by DROP (eg. two 'pop %eax' instructions in this case). + + Another example. Consider this ordinary FORTH definition: + + : C@++ ( addr -- addr+1 byte ) DUP 1+ SWAP C@ ; + + (it is equivalent to the C operation '*p++' where p is a pointer to char). If we + notice that all of the words used to define C@++ are in fact assembler primitives, + then we can write a faster (but equivalent) definition like this: + + : C@++ INLINE DUP INLINE 1+ INLINE SWAP INLINE C@ ;CODE + + One interesting point to note is that this "concatenative" style of programming + allows you to write assembler words portably. The above definition would work + for any CPU architecture. + + There are several conditions that must be met for INLINE to be used successfully: + + (1) You must be currently defining an assembler word (ie. : ... ;CODE). + + (2) The word that you are inlining must be known to be an assembler word. If you try + to inline a FORTH word, you'll get an error message. + + (3) The assembler primitive must be position-independent code and must end with a + single NEXT macro. + + Exercises for the reader: (a) Generalise INLINE so that it can inline FORTH words when + building FORTH words. (b) Further generalise INLINE so that it does something sensible + when you try to inline FORTH into assembler and vice versa. + + The implementation of INLINE is pretty simple. We find the word in the dictionary, + check it's an assembler word, then copy it into the current definition, byte by byte, + until we reach the NEXT macro (which is not copied). +) +HEX +: =NEXT ( addr -- next? ) + DUP C@ AD <> IF DROP FALSE EXIT THEN + 1+ DUP C@ FF <> IF DROP FALSE EXIT THEN + 1+ C@ 20 <> IF FALSE EXIT THEN + TRUE +; +DECIMAL + +( (INLINE) is the lowlevel inline function. ) +: (INLINE) ( cfa -- ) + @ ( remember codeword points to the code ) + BEGIN ( copy bytes until we hit NEXT macro ) + DUP =NEXT NOT + WHILE + DUP C@ C, + 1+ + REPEAT + DROP +; + +: INLINE IMMEDIATE + WORD FIND ( find the word in the dictionary ) + >CFA ( codeword ) + + DUP @ DOCOL = IF ( check codeword <> DOCOL (ie. not a FORTH word) ) + ." Cannot INLINE FORTH words" CR ABORT + THEN + + (INLINE) +; + +HIDE =NEXT + +( + NOTES ---------------------------------------------------------------------- + + DOES> isn't possible to implement with this FORTH because we don't have a separate + data pointer. +) + +( + WELCOME MESSAGE ---------------------------------------------------------------------- + + Print the version and OK prompt. +) + +: WELCOME + S" TEST-MODE" FIND NOT IF + ." JONESFORTH VERSION " VERSION . CR + UNUSED . ." CELLS REMAINING" CR + ." OK " + THEN +; + +WELCOME +HIDE WELCOME diff --git a/docs/jonesforth/run.sh b/docs/jonesforth/run.sh new file mode 100755 index 0000000..8ba83b3 --- /dev/null +++ b/docs/jonesforth/run.sh @@ -0,0 +1,3 @@ +#!/bin/sh +docker build -t jonesforth . +docker run --cap-add=SYS_RAWIO -ti --rm jonesforth diff --git a/docs/learnforth.fs b/docs/learnforth.fs new file mode 100644 index 0000000..2f8efe7 --- /dev/null +++ b/docs/learnforth.fs @@ -0,0 +1,205 @@ + +\ This is a comment +( This is also a comment but it's only used when defining words ) + +\ --------------------------------- Precursor ---------------------------------- + +\ All programming in Forth is done by manipulating the parameter stack (more +\ commonly just referred to as "the stack"). +5 2 3 56 76 23 65 \ ok + +\ Those numbers get added to the stack, from left to right. +.s \ <7> 5 2 3 56 76 23 65 ok + +\ In Forth, everything is either a word or a number. + +\ ------------------------------ Basic Arithmetic ------------------------------ + +\ Arithmetic (in fact most words requiring data) works by manipulating data on +\ the stack. +5 4 + \ ok + +\ `.` pops the top result from the stack: +. \ 9 ok + +\ More examples of arithmetic: +6 7 * . \ 42 ok +1360 23 - . \ 1337 ok +12 12 / . \ 1 ok +13 2 mod . \ 1 ok + +99 negate . \ -99 ok +-99 abs . \ 99 ok +52 23 max . \ 52 ok +52 23 min . \ 23 ok + +\ ----------------------------- Stack Manipulation ----------------------------- + +\ Naturally, as we work with the stack, we'll want some useful methods: + +3 dup - \ duplicate the top item (1st now equals 2nd): 3 - 3 +2 5 swap / \ swap the top with the second element: 5 / 2 +6 4 5 rot .s \ rotate the top 3 elements: 4 5 6 +4 0 drop 2 / \ remove the top item (don't print to screen): 4 / 2 +1 2 3 nip .s \ remove the second item (similar to drop): 1 3 + +\ ---------------------- More Advanced Stack Manipulation ---------------------- + +1 2 3 4 tuck \ duplicate the top item below the second slot: 1 2 4 3 4 ok +1 2 3 4 over \ duplicate the second item to the top: 1 2 3 4 3 ok +1 2 3 4 2 roll \ *move* the item at that position to the top: 1 3 4 2 ok +1 2 3 4 2 pick \ *duplicate* the item at that position to the top: 1 2 3 4 2 ok + +\ When referring to stack indexes, they are zero-based. + +\ ------------------------------ Creating Words -------------------------------- + +\ The `:` word sets Forth into compile mode until it sees the `;` word. +: square ( n -- n ) dup * ; \ ok +5 square . \ 25 ok + +\ We can view what a word does too: +see square \ : square dup * ; ok + +\ -------------------------------- Conditionals -------------------------------- + +\ -1 == true, 0 == false. However, any non-zero value is usually treated as +\ being true: +42 42 = \ -1 ok +12 53 = \ 0 ok + +\ `if` is a compile-only word. `if` `then` . +: ?>64 ( n -- n ) dup 64 > if ." Greater than 64!" then ; \ ok +100 ?>64 \ Greater than 64! ok + +\ Else: +: ?>64 ( n -- n ) dup 64 > if ." Greater than 64!" else ." Less than 64!" then ; +100 ?>64 \ Greater than 64! ok +20 ?>64 \ Less than 64! ok + +\ ------------------------------------ Loops ----------------------------------- + +\ `do` is also a compile-only word. +: myloop ( -- ) 5 0 do cr ." Hello!" loop ; \ ok +myloop +\ Hello! +\ Hello! +\ Hello! +\ Hello! +\ Hello! ok + +\ `do` expects two numbers on the stack: the end number and the start number. + +\ We can get the value of the index as we loop with `i`: +: one-to-12 ( -- ) 12 0 do i . loop ; \ ok +one-to-12 \ 0 1 2 3 4 5 6 7 8 9 10 11 12 ok + +\ `?do` works similarly, except it will skip the loop if the end and start +\ numbers are equal. +: squares ( n -- ) 0 ?do i square . loop ; \ ok +10 squares \ 0 1 4 9 16 25 36 49 64 81 ok + +\ Change the "step" with `+loop`: +: threes ( n n -- ) ?do i . 3 +loop ; \ ok +15 0 threes \ 0 3 6 9 12 ok + +\ Indefinite loops with `begin` `until`: +: death ( -- ) begin ." Are we there yet?" 0 until ; \ ok + +\ ---------------------------- Variables and Memory ---------------------------- + +\ Use `variable` to declare `age` to be a variable. +variable age \ ok + +\ Then we write 21 to age with the word `!`. +21 age ! \ ok + +\ Finally we can print our variable using the "read" word `@`, which adds the +\ value to the stack, or use `?` that reads and prints it in one go. +age @ . \ 21 ok +age ? \ 21 ok + +\ Constants are quite similar, except we don't bother with memory addresses: +100 constant WATER-BOILING-POINT \ ok +WATER-BOILING-POINT . \ 100 ok + +\ ----------------------------------- Arrays ----------------------------------- + +\ Creating arrays is similar to variables, except we need to allocate more +\ memory to them. + +\ You can use `2 cells allot` to create an array that's 3 cells long: +variable mynumbers 2 cells allot \ ok + +\ Initialize all the values to 0 +mynumbers 3 cells erase \ ok + +\ Alternatively we could use `fill`: +mynumbers 3 cells 0 fill + +\ or we can just skip all the above and initialize with specific values: +create mynumbers 64 , 9001 , 1337 , \ ok (the last `,` is important!) + +\ ...which is equivalent to: + +\ Manually writing values to each index: +64 mynumbers 0 cells + ! \ ok +9001 mynumbers 1 cells + ! \ ok +1337 mynumbers 2 cells + ! \ ok + +\ Reading values at certain array indexes: +0 cells mynumbers + ? \ 64 ok +1 cells mynumbers + ? \ 9001 ok + +\ We can simplify it a little by making a helper word for manipulating arrays: +: of-arr ( n n -- n ) cells + ; \ ok +mynumbers 2 of-arr ? \ 1337 ok + +\ Which we can use for writing too: +20 mynumbers 1 of-arr ! \ ok +mynumbers 1 of-arr ? \ 20 ok + +\ ------------------------------ The Return Stack ------------------------------ + +\ The return stack is used to the hold pointers to things when words are +\ executing other words, e.g. loops. + +\ We've already seen one use of it: `i`, which duplicates the top of the return +\ stack. `i` is equivalent to `r@`. +: myloop ( -- ) 5 0 do r@ . loop ; \ ok + +\ As well as reading, we can add to the return stack and remove from it: +5 6 4 >r swap r> .s \ 6 5 4 ok + +\ NOTE: Because Forth uses the return stack for word pointers, `>r` should +\ always be followed by `r>`. + +\ ------------------------- Floating Point Operations -------------------------- + +\ Most Forths tend to eschew the use of floating point operations. +8.3e 0.8e f+ f. \ 9.1 ok + +\ Usually we simply prepend words with 'f' when dealing with floats: +variable myfloatingvar \ ok +4.4e myfloatingvar f! \ ok +myfloatingvar f@ f. \ 4.4 ok + +\ --------------------------------- Final Notes -------------------------------- + +\ Typing a non-existent word will empty the stack. However, there's also a word +\ specifically for that: +clearstack + +\ Clear the screen: +page + +\ Loading Forth files: +\ s" forthfile.fs" included + +\ You can list every word that's in Forth's dictionary (but it's a huge list!): +\ words + +\ Exiting Gforth: +\ bye + + diff --git a/docs/samples.fs b/docs/samples.fs new file mode 100644 index 0000000..3371453 --- /dev/null +++ b/docs/samples.fs @@ -0,0 +1,2 @@ +: fibonacci dup 2 < if drop 1 else dup 2 - recurse swap 1 - recurse + then ; +: fibnums for i fibonacci u. next ; diff --git a/docs/tcjassem.txt b/docs/tcjassem.txt new file mode 100644 index 0000000..97ed164 --- /dev/null +++ b/docs/tcjassem.txt @@ -0,0 +1,805 @@ + B.Y.O.ASSEMBLER + -or- + Build Your Own (Cross-) Assembler....in Forth + + by Brad Rodriguez + + + A. INTRODUCTION + + In a previous issue of this journal I described how to + "bootstrap" yourself into a new processor, with a simple + debug monitor. But how do you write code for this new CPU, + when you can't find or can't afford an assembler? Build + your own! + + Forth is an ideal language for this. I've written cross- + assemblers in as little as two hours (for the TMS320, over a + long lunch break). Two days is perhaps more common; and one + processor (the Zilog Super8) took me five days. But when + you have more time than money, this is a bargain. + + In part 1 of this article I will describe the basic + principles of Forth-style assemblers -- structured, + single-pass, postfix. Much of this will apply to any + processor, and these concepts are in almost every Forth + assembler. + + In part 2 I will examine an assembler for a specific CPU: + the Motorola 6809. This assembler is simple but not + trivial, occupying 15 screens of source code. Among other + things, it shows how to handle instructions with multiple + modes (in this case, addressing modes). By studying this + example, you can figure out how to handle the peculiarities + of your own CPU. + + B. WHY USE FORTH? + + I believe that Forth is the easiest language in which to + write assemblers. + + First and foremost, Forth has a "text interpreter" designed + to look up text strings and perform some related action. + Turning text strings into bytes is exactly what is needed to + compile assembler mnemonics! Operands and addressing modes + can also be handled as Forth "words." + + Forth also includes "defining words," which create large + sets of words with a common action. This feature is very + useful when defining assembler mnemonics. + + Since every Forth word is always available, Forth's + arithmetic and logical functions can be used within the + assembler environment to perform address and operand + arithmetic. + + Finally, since the assembler is entirely implemented in + Forth words, Forth's "colon definitions" provide a + rudimentary macro facility, with no extra effort. + + C. THE SIMPLEST CASE: ASSEMBLING A NOP + + To understand how Forth translates mnemonics to machine + code, consider the simplest case: the NOP instruction (12 + hex on the 6809). + + A conventional assembler, on encountering a NOP in the + opcode field, must append a 12H byte to the output file and + advance the location counter by 1. Operands and comments + are ignored. (I will ignore labels for the time being.) + + In Forth, the memory-resident dictionary is usually the + output "file." So, make NOP a Forth word, and give it an + action, namely, "append 12H to the dictionary and advance + the dictionary pointer." + + HEX + : NOP, 12 C, ; + + Assembler opcodes are often given Forth names which include + a trailing comma, as shown above. This is because many + Forth words -- such as AND XOR and OR -- conflict with + assembler mnemonics. The simplest solution is to change the + assembler mnemonics slightly, usually with a trailing comma. + (This comma is a Forth convention, indicating that something + is appended to the dictionary.) + + D. THE CLASS OF "INHERENT" OPCODES + + Most processors have many instructions, like NOP, which + require no operands. All of these could be defined as Forth + colon definitions, but this duplicates code, and wastes a + lot of space. It's much more efficient to use Forth's + "defining word" mechanism to give all of these words a + common action. In object-oriented parlance, this builds + "instances" of a single "class." + + This is done with Forth's CREATE and DOES>. (In fig-Forth, + as used in the 6809 assembler, the words are .) + + : INHERENT ( Defines the name of the class) + CREATE ( this will create an instance) + C, ( store the parameter for each + instance) + DOES> ( this is the class' common action) + C@ ( get each instance's parameter) + C, ( the assembly action, as above) + ; ( End of definition) + + HEX + 12 INHERENT NOP, ( Defines an instance NOP, of class + INHERENT, with parameter 12H.) + 3A INHERENT ABX, ( Another instance - the ABX instr) + 3D INHERENT MUL, ( Another instance - the MUL instr) + + In this case, the parameter (which is specific to each + instance) is simply the opcode to be assembled for each + instruction. + + This technique provides a substantial memory savings, with + almost no speed penalty. But the real advantage becomes + evident when complex instruction actions -- such as required + for parameters, or addressing modes -- are involved. + + E. HANDLING OPERANDS + + Most assembler opcodes, it is true, require one or more + operands. As part of the action for these instructions, + Forth routines could be written to parse text from the input + stream, and interpret this text as operand fields. But why? + The Forth envrionment already provides a parse-and-interpret + mechanism! + + So, Forth will be used to parse operands. Numbers are + parsed normally (in any base!), and equates can be Forth + CONSTANTs. But, since the operands determine how the opcode + is handled, they will be processed first. The results of + operand parsing will be left on Forth's stack, to be picked + up by the opcode word. This leads to Forth's unique postfix + format for assemblers: operands, followed by opcode. + + Take, for example, the 6809's ORCC instruction, which takes + a single numeric parameter: + + HEX + : ORCC, 1A C, C, ; + + The exact sequence of actions for ORCC, is: 1) put 1A hex + on the parameter stack; 2) append the top stack item (the + 1A) to the dictionary, and drop it from the stack; 3) append + the new top stack item (the operand) to the dictionary, and + drop it from the stack. It is assumed that a numeric value + was already on the stack, for the second C, to use. This + numeric value is the result of the operand parsing, which, + in this case, is simply the parsing of a single integer + value: + + HEX + 0F ORCC, + + The advantage here is that all of Forth's power to operate + on stack values, via both built-in operators and + newly-defined functions, can be employed to create and + modify operands. For example: + + HEX + 01 CONSTANT CY-FLAG ( a "named" numeric value) + 02 CONSTANT OV-FLAG + 04 CONSTANT Z-FLAG + ... + CY-FLAG Z-FLAG + ORCC, ( add 1 and 4 to get operand) + + The extension of operand-passing to the defining words + technique is straightforward. + + + F. HANDLING ADDRESSING MODES + + Rarely can an operand, or an opcode, be used unmodified. + Most of the instructions in a modern processor can take + multiple forms, depending on the programmer's choice of + addressing mode. + + Forth assemblers have attacked this problem in a number of + ways, depending on the requirements of the specific + processor. All of these techniques remain true to the Forth + methodology: the addressing mode operators are implemented + as Forth words. When these words are executed, they alter + the assembly of the current instruction. + + 1. Leaving additional parameters on the stack. + This is most useful when an addressing mode must always + be specified. The addressing-mode word leaves some + constant value on the stack, to be picked up by the + opcode word. Sometimes this value can be a "magic + number" which can be added to the opcode to modify it + for the different mode. When this is not feasible, the + addressing-mode value can activate a CASE statement + within the opcode, to select one of several actions. + In this latter case, instructions of different lengths, + possibly with different operands, can be assembled + depending on the addressing mode. + + 2. Setting flags or values in fixed variables. + This is most useful when the addressing mode is + optional. Without knowing whether an addressing mode + was specified, you don't know if the value on the stack + is a "magic number" or just an operand value. The + solution: have the addressing mode put its magic number + in a predefined variable (often called MODE). This + variable is initialized to a default value, and reset + to this default value after each instruction is + assembled. Thus, this variable can be tested to see if + an addressing mode was specified (overriding the + default). + + 3. Modifying parameter values already on the stack. + It is occasionally possible to implement addressing + mode words that work by modifying an operand value. + This is rarely seen. + + All three of these techniques are used, to some extent, + within the 6809 assembler. + + For most processors, register names can simply be Forth + CONSTANTs, which leave a value on the stack. For some + processors it is useful to have register names specify + "register addressing mode" as well. This is easily done by + defining register names with a new defining word, whose + run-time action sets the addressing mode (either on the + stack or in a MODE variable). + + Some processors allow multiple addressing modes in a single + instruction. If the number of addressing modes is fixed by + the instruction, they can be left on the stack. If the + number of addressing modes is variable, and it is desired to + know how many have been specified, multiple MODE variables + can be used for the first, second, etc. (In one case -- the + Super8 -- I had to keep track of not only how many + addressing modes were specified, but also where among the + operands they were specified. I did this by saving the + stack position along with each addressing mode.) + + Consider the 6809 ADD instruction. To simplify things, + ignore the Indexed addressing modes for now, and just + consider the remaining three addressing modes: Immediate, + Direct, and Extended. These will be specified as follows: + + source code assembles as + Immediate: number # ADD, 8B nn + Direct: address <> ADD, 9B aa + Extended: address ADD, BB aa aa + + Since Extended has no addressing mode operator, the + mode-variable approach seems to be indicated. The Forth + words # and <> will set MODE. + + Observe the regularity in the 6809 opcodes. If the + Immediate opcode is the "base" value, then the Direct opcode + is this value plus 10 hex, and the Extended opcode is this + value plus 30 hex. (And the Indexed opcode, incidentally, + is this value plus 20 hex.) This applies uniformly across + almost all 6809 instructions which use these addressing + modes. (The exceptions are those opcodes whose Direct + opcodes are of the form 0x hex.) + + Regularities like this are made to be exploited! This is a + general rule for writing assemblers: find or make an opcode + chart, and look for regularities -- especially those + applying to addressing modes or other instruction modifiers + (like condition codes). + + In this case, appropriate MODE values are suggested: + + VARIABLE MODE HEX + : # 0 MODE ! ; + : <> 10 MODE ! ; + : RESET 30 MODE ! ; + + The default MODE value is 30 hex (for Extended mode), so a + Forth word RESET is added to restore this value. RESET will + be used after every instruction is assembled. + + The ADD, routine can now be written. Let's go ahead and + write it using a defining word: + + HEX + : GENERAL-OP \ base-opcode -- + CREATE C, + DOES> \ operand -- + C@ \ get the base opcode + MODE @ + \ add the "magic number" + C, \ assemble the opcode + MODE @ CASE + 0 OF C, ENDOF \ byte operand + 10 OF C, ENDOF \ byte operand + 30 OF , ENDOF \ word operand + ENDCASE + RESET ; + + 8B GENERAL-OP ADD, + + Each "instance" of GENERAL-OP will have a different base + opcode. When ADD, executes, it will fetch this base opcode, + add the MODE value to it, and assemble that byte. Then it + will take the operand which was passed on the stack, and + assemble it either as a byte or word operand, depending on + the selected mode. Finally, it will reset MODE. + + Note that all of the code is now defined to create + instructions in the same family as ADD: + + HEX 89 GENERAL-OP ADC, + 84 GENERAL-OP AND, + 85 GENERAL-OP BIT, + etc. + + The memory savings from defining words really become evident + now. Each new opcode word executes the lengthy bit of DOES> + code given above; but each word is only a one-byte Forth + definition (plus header and code field, of course). + + This is not the actual code from the 6809 assembler -- there + are additional special cases which need to be handled. But + it demonstrates that, by storing enough mode information, + and by making liberal use of CASE statements, the most + ludicrous instruction sets can be assembled. + + + G. HANDLING CONTROL STRUCTURES + + The virtues of structured programming, have long been sung + -- and there are countless "structured assembly" macro + packages for conventional assemblers. But Forth assemblers + favor label-free, structured assembly code for a pragmatic + reason: in Forth, it's simpler to create assembler + structures than labels! + + The structures commonly included in Forth assemblers are + intended to resemble the programming structures of + high-level Forth. (Again, the assembler structures are + usually distinguished by a trailing comma.) + + 1. BEGIN, ... UNTIL, + + The BEGIN, ... UNTIL, construct is the simplest assembler + structure to understand. The assembler code is to loop back + to the BEGIN point, until some condition is satisfied. The + Forth assembler syntax is + + BEGIN, more code cc UNTIL, + + where 'cc' is a condition code, which has presumably been + defined -- either as an operand or an addressing mode -- for + the jump instructions. + + Obviously, the UNTIL, will assemble a conditional jump. The + sense of the jump must be "inverted" so that if 'cc' is + satisfied, the jump does NOT take place, but instead the + code "falls through" the jump. The conventional assembler + equivalent would be: + + xxx: ... + ... + ... + JR ~cc,xxx + + (where ~cc is the logical inverse of cc.) + + Forth offers two aids to implementing BEGIN, and UNTIL,. + The word HERE will return the current location counter + value. And values may be kept deep in the stack, with no + effect on Forth processing, then "elevated" when required. + + So: BEGIN, will "remember" a location counter, by placing + its value on the stack. UNTIL, will assemble a conditional + jump to the "remembered" location. + + : BEGIN, ( - a) HERE ; + : UNTIL, ( a cc - ) NOTCC JR, ; + + This introduces the common Forth stack notation, to indicate + that BEGIN, leaves one value (an address) on the stack. + UNTIL, consumes two values (an address and a condition code) + from the stack, with the condition code on top. It is + presumed that a word NOTCC has been defined, which will + convert a condition code to its logical inverse. It is also + presumed that the opcode word JR, has been defined, which + will expect an address and a condition code as operands. + (JR, is a more general example than the branch instructions + used in the 6809 assembler.) + + The use of the stack for storage of the loop address allows + BEGIN, ... UNTIL, constructs to be nested, as: + + BEGIN, ... BEGIN, ... cc UNTIL, ... cc UNTIL, + + The "inner" UNTIL, resolves the "inner" BEGIN, forming a + loop wholly contained within the outer BEGIN, ... UNTIL, + loop. + + 2. BEGIN, ... AGAIN, + + Forth commonly provides an "infinite loop" construct, + BEGIN ... AGAIN , which never exits. For the sake of + completeness, this is usually implemented in the assembler + as well. + + Obviously, this is implemented in the same manner as BEGIN, + ... UNTIL, except that the jump which is assembled by AGAIN, + is an unconditional jump. + + 3. DO, ... LOOP, + + Many processors offer some kind of looping instruction. + Since the 6809 does not, let's consider the Zilog Super8; + its Decrement-and-Jump-Non-Zero (DJNZ) instruction can use + any of 16 registers as the loop counter. This can be + written in structured assembler: + + DO, more code r LOOP, + + where r is the register used as the loop counter. Once + again, the intent is to make the assembler construct + resemble the high-level Forth construct. + + : DO, ( - a) HERE ; + : LOOP, ( a r - ) DJNZ, ; + + Some Forth assemblers go so far as to make DO, assemble a + load-immediate instruction for the loop counter -- but this + loses flexibility. Sometimes the loop count isn't a + constant. So I prefer the above definition of DO, . + + 4. IF, ... THEN, + + The IF, ... THEN, construct is the simplest forward- + referencing construct. If a condition is satisfied, the + code within the IF,...THEN, is to be executed; otherwise, + control is transferred to the first instruction after THEN,. + + (Note that Forth normally employs THEN, where other + languages use "endif." You can have both in your + assembler.) + + The Forth syntax is + + cc IF, ... ... ... THEN, + + for which the "conventional" equivalent is + + JP ~cc,xxx + ... + ... + ... + xxx: + + Note that, once again, the condition code must be inverted + to produce the expected logical sense for IF, . + + In a single pass assembler, the requisite forward jump + cannot be directly assembled, since the destination address + of the jump is not known when IF, is encountered. This + problem is solved by causing IF, to assemble a "dummy" jump, + and stack the address of the jump's operand field. Later, + the word THEN, (which will provide the destination address) + can remove this stacked address and "patch" the jump + instruction accordingly. + + : IF, ( cc - a) NOT 0 SWAP JP, ( conditional jump + HERE 2 - ; with 2-byte operand) + : THEN, ( a) HERE SWAP ! ; ( store HERE at the + stacked address) + + IF, inverts the condition code, assembles a conditional jump + to address zero, and then puts on the stack the address of + the jump address field. (After JP, is assembled, the + location counter HERE points past the jump instruction, so + we need to subtract two to get the location of the address + field.) THEN, will patch the current location into the + operand field of that jump. + + If relative jumps are used, additional code must be added to + THEN, to calculate the relative offset. + + 5. IF, ... ELSE, ... THEN, + + A refinement of the IF,...THEN, construct allows code to be + executed if the condition is NOT satisfied. The Forth + syntax is + + cc IF, ... ... ELSE, ... ... THEN, + + ELSE, has the expected meaning: if the first part of this + statement is not executed, then the second part is. + + The assembler code necessary to create this construct is: + + JP ~cc,xxx + ... ( the "if" code) + ... + JP yyy + xxx: ... ( the "else" code) + ... + yyy: + + ELSE, must modify the actions of IF, and THEN, as follows: + a) the forward jump from IF, must be patched to the start of + the "else" code ("xxx"); and b) the address supplied by + THEN, must be patched into the unconditional jump + instruction at the end of the "if" code ("JP yyy"). ELSE, + must also assemble the unconditional jump. This is done + thus: + + : ELSE ( a - a) 0 T JP, ( unconditional jump) + HERE 2 - ( stack its address + for THEN, to patch) + SWAP ( get the patch address + of the IF, jump) + HERE SWAP ! ( patch it to the current + location, i.e., the + ; next instruction) + + Note that the jump condition 'T' assembles a "jump always" + instruction. The code from IF, and THEN, can be "re-used" + if the condition 'F' is defined as the condition-code + inverse of 'T': + + : ELSE ( a - a) F IF, SWAP THEN, ; + + The SWAP of the stacked addresses reverses the patch order, + so that the THEN, inside ELSE, patches the original IF; and + the final THEN, patches the IF, inside ELSE,. Graphically, + this becomes: + + IF,(1) ... IF,(2) THEN,(1) ... THEN,(2) + \______________/ + inside ELSE, + + IF,...THEN, and IF,...ELSE,...THEN, structures can be + nested. This freedom of nesting also extends to mixtures of + these and BEGIN,...UNTIL, structures. + + 6. BEGIN, ... WHILE, ... REPEAT, + + The final, and most complex, assembler control structure is + the "while" loop in which the condition is tested at the + beginning of the loop, rather than at the end. + + In Forth the accepted syntax for this structure is + + BEGIN, evaluate cc WHILE, loop code REPEAT, + + In practice, any code -- not just condition evaluations -- + may be inserted between BEGIN, and WHILE,. + + What needs to be assembled is this: WHILE, will assemble a + conditional jump, on the inverse of cc, to the code + following the REPEAT,. (If the condition code cc is + satisfied, we should "fall through" WHILE, to execute the + loop code.) REPEAT, will assemble an unconditional jump + back to BEGIN. Or, in terms of existing constructs: + + BEGIN,(1) ... cc IF,(2) ... AGAIN,(1) THEN,(2) + + Once again, this can be implemented with existing words, by + means of a stack manipulation inside WHILE, to re-arrange + what jumps are patched by whom: + + : WHILE, ( a cc - a a) IF, SWAP ; + : REPEAT, ( a a - ) AGAIN, THEN, ; + + Again, nesting is freely permitted. + + + H. THE FORTH DEFINITION HEADER + + In most applications, machine code created by a Forth + assembler will be put in a CODE word in the Forth + dictionary. This requires giving it an identifying text + "name," and linking it into the dictionary list. + + The Forth word CREATE performs these functions for the + programmer. CREATE will parse a word from the input stream, + build a new entry in the dictionary with that name, and + adjust the dictionary pointer to the start of the + "definition field" for this word. + + Standard Forth uses the word CODE to distinguish the start + of an assembler definition in the Forth dictionary. In + addition to performing CREATE, the word CODE may set the + assembler environment (vocabulary), and may reset variables + (such as MODE) in the assembler. Some Forths may also + require a "code address" field; this is set by CREATE in + some systems, while others expect CODE to do this. + + + I. SPECIAL CASES + + 1. Resident vs. cross-compilation + + Up to now, it has been assumed that the machine code is to + be assembled into the dictionary of the machine running the + assembler. + + For cross-assembly and cross-compilation, code is usually + assembled for the "target" machine into a different area of + memory. This area may or may not have its own dictionary + structure, but it is separate from the "host" machine's + dictionary. + + The most common and straightforward solution is to provide + the host machine with a set of Forth operators to access the + "target" memory space. These are made deliberately + analogous to the normal Forth memory and dictionary + operators, and are usually distinguished by the prefix "T". + The basic set of operators required is: + + TDP target dictionary pointer DP + THERE analogous to HERE, returns TDP + TC, target byte append C, + TC@ target byte fetch C@ + TC! target byte store C! + T@ target word fetch @ + T! target word store ! + + Sometimes, instead of using the "T" prefix, these words will + be given identical names but in a different Forth + vocabulary. (The vocabulary structure in Forth allows + unambiguous use of the same word name in multiple contexts.) + The 6809 assembler in Part 2 assumes this. + + 2. Compiling to disk + + Assembler output can be directed to disk, rather than to + memory. This, too, can be handled by defining a new set of + dictionary, fetch, and store operators. They can be + distinguished with a different prefix (such as "T" again), + or put in a distinct vocabulary. + + Note that the "patching" manipulations used in the + single-pass control structures require a randomly- + accessible output medium. This is not a problem with disk, + although heavy use of control structures may result in some + inefficient disk access. + + 3. Compiler Security + + Some Forth implementations include a feature known as + "compiler security," which attempts to catch mismatches of + control structures. For example, the structure + + IF, ... cc UNTIL, + + would leave the stack balanced (UNTIL, consumes the address + left by IF,), but would result in nonsense code. + + The usual method for checking the match of control + structures is to require the "leading" control word to leave + a code value on the stack, and the "trailing" word to check + the stack for the correct value. For example: + + IF, leaves a 1; + THEN, checks for a 1; + ELSE, checks for a 1 and leaves a 1; + BEGIN, leaves a 2; + UNTIL, checks for a 2; + AGAIN, checks for a 2; + WHILE, checks for a 2 and leaves a 3; + REPEAT, checks for a 3. + + This will detect most mismatches. Additional checks may be + included for the stack imbalance caused by "unmatched" + control words. (The 6809 assembler uses both of these error + checks.) + + The cost of compiler security is the increased complexity of + the stack manipulations in such words as ELSE, and WHILE,. + Also, the programmer may wish to alter the order in which + control structures are resolved, by manually re-arranging + the stack; compiler security makes this more difficult. + + 4. Labels + + Even in the era of structured programming, some programmers + will insist on labels in their assembler code. + + The principal problem with named labels in a Forth assembler + definition is that the labels themselves are Forth words. + They are compiled into the dictionary -- usually at an + inconvenient point, such as inside the machine code. For + example: + + CODE TEST ... machine code ... + HERE CONSTANT LABEL1 + ... machine code ... + LABEL1 NZ JP, + + will cause the dictionary header for LABEL1 -- text, links, + and all -- to be inserted in the middle of CODE. Several + solutions have been proposed: + + a) define labels only "outside" machine code. + Occasionally useful, but very restricted. + + b) use some predefined storage locations (variables) to + provide "temporary," or local, labels. + + c) use a separate dictionary space for the labels, e.g., + as provided by the TRANSIENT scheme [3]. + + d) use a separate dictionary space for the machine code. + This is common practice for meta-compilation; most + Forth meta- compilers support labels with little + difficulty. + + 5. Table Driven Assemblers + + Most Forth assemblers can handle the profusion of addressing + modes and instruction opcodes by CASE statements and other + flow-of-control constructs. These may be referred to as + "procedural" assemblers. + + Some processors, notably the Motorola 68000, have + instruction and addressing sets so complex as to render the + decision trees immense. In such cases, a more "table- + driven" approach may save substantial memory and processor + time. + + (I avoid such processors. Table driven assemblers are much + more complex to write.) + + 6. Prefix Assemblers + + Sometimes a prefix assembler is unavoidable. (One example: + I recently translated many K of Super8 assembler code from + the Zilog assembler to a Forth assembler.) There is a + programming "trick" which simulates a prefix assembler, + while using the assembler techniques described in this + article. + + Basically, this trick is to "postpone" execution of the + opcode word, until after the operands have been evaluated. + How can the assembler determine when the operands are + finished? Easy: when the next opcode word is encountered. + + So, every opcode word is modified to a) save its own + execution address somewhere, and b) execute the "saved" + action of the previous opcode word. For example: + + ... JP operand ADD operands ... + + JP stores its execution address (and the address of its + "instance" parameters) in a variable somewhere. Then, the + operands are evaluated. ADD will fetch the information + saved by JP, and execute the run-time action of JP. The JP + action will pick up whatever the operands left on the stack. + When the JP action returns, ADD will save its own execution + address and instance parameters, and the process continues. + (Of course, JP would have executed its previous opcode.) + + This is confusing. Special care must be taken for the first + and last opcodes in the assembler code. If mode variables + are used, the problem of properly saving and restoring them + becomes nightmarish. I leave this subject as an exercise + for the advanced student...or for an article of its own. + + J. CONCLUSION + + I've touched upon the common techniques used in Forth + assemblers. Since I believe the second-best way to learn is + by example, in part 2 I will present the full code for the + 6809 assembler. Studying a working assembler may give you + hints on writing an assembler of your own. + + The BEST way to learn is by doing! + + K. REFERENCES + + 1. Curley, Charles, Advancing Forth. Unpublished manuscript + (1985). + + 2. Wasson, Philip, "Transient Definitions," Forth Dimensions + III/6 (Mar-Apr 1982), p.171. + + L. ADDITIONAL SOURCES + + 1. Cassady, John J., "8080 Assembler," Forth Dimensions III/6 + (Mar-Apr 1982), pp. 180-181. Noteworthy in that the entire + assembler fits in less than 48 lines of code. + + 2. Ragsdale, William F., "A FORTH Assembler for the 6502," Dr. + Dobb's Journal #59 (September 1981), pp. 12-24. A simple + illustration of addressing modes. + + 3. Duncan, Ray, "FORTH 8086 Assembler," Dr. Dobb's Journal #64 + (February 1982), pp. 14-18 and 33-46. + + 4. Perry, Michael A., "A 68000 Forth Assembler," Dr. Dobb's + Journal #83 (September 1983), pp. 28-42. + + 5. Assemblers for the 8080, 8051, 6502, 68HC11, 8086, 80386, + 68000, SC32, and Transputer can be downloaded from the Forth + Interest Group (FORTH) conference on GEnie. + \ No newline at end of file diff --git a/go.mod b/go.mod index c19f998..7ac3990 100644 --- a/go.mod +++ b/go.mod @@ -1 +1,3 @@ module dim13.org/j1 + +go 1.13 diff --git a/j1/.gitignore b/j1/.gitignore deleted file mode 100644 index f169042..0000000 --- a/j1/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -a.out -test.vcd diff --git a/j1/Makefile b/j1/Makefile deleted file mode 100644 index 34f0dae..0000000 --- a/j1/Makefile +++ /dev/null @@ -1,14 +0,0 @@ - -$(SUBDIRS): - $(MAKE) -C $@ - -all: obj_dir/Vj1 $(SUBDIRS) - -VERILOGS=verilog/j1.v verilog/stack.v - -obj_dir/Vj1: $(VERILOGS) sim_main.cpp Makefile - verilator -Wall --cc --trace -Iverilog/ $(VERILOGS) --top-module j1 --exe sim_main.cpp - # verilator --cc --trace $(VERILOGS) --top-module j1 --exe sim_main.cpp - $(MAKE) -C obj_dir OPT_FAST="-O2" -f Vj1.mk Vj1 - -.PHONY: all diff --git a/j1/README.md b/j1/README.md deleted file mode 100644 index 9a419f5..0000000 --- a/j1/README.md +++ /dev/null @@ -1,4 +0,0 @@ -j1 -== - -The J1 CPU diff --git a/j1/build/.empty b/j1/build/.empty deleted file mode 100644 index e69de29..0000000 diff --git a/j1/build/.gitignore b/j1/build/.gitignore deleted file mode 100644 index ebc3c15..0000000 --- a/j1/build/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -firmware -quartus diff --git a/j1/go b/j1/go deleted file mode 100644 index c0740cb..0000000 --- a/j1/go +++ /dev/null @@ -1,5 +0,0 @@ -(cd toolchain && sh go) || exit -iverilog -I verilog/ -g2 -s testbench verilog/testbench.v verilog/top.v verilog/j1.v verilog/stack.v || exit -./a.out - -make && obj_dir/Vj1 build/firmware/demo0.hex diff --git a/j1/sim_main.cpp b/j1/sim_main.cpp deleted file mode 100644 index ee075ac..0000000 --- a/j1/sim_main.cpp +++ /dev/null @@ -1,76 +0,0 @@ -#include -#include "Vj1.h" -#include "verilated_vcd_c.h" - -int main(int argc, char **argv) -{ - Verilated::commandArgs(argc, argv); - Vj1* top = new Vj1; - int i; - - // Verilated::traceEverOn(true); - // VerilatedVcdC* tfp = new VerilatedVcdC; - // top->trace (tfp, 99); - // tfp->open ("simx.vcd"); - - if (argc != 2) { - fprintf(stderr, "usage: sim \n"); - exit(1); - } - - union { - uint32_t ram32[4096]; - uint16_t ram16[8192]; - }; - - FILE *hex = fopen(argv[1], "r"); - for (i = 0; i < 4096; i++) { - unsigned int v; - if (fscanf(hex, "%x\n", &v) != 1) { - fprintf(stderr, "invalid hex value at line %d\n", i + 1); - exit(1); - } - ram32[i] = v; - } - - FILE *log = fopen("log", "w"); - int t = 0; - - top->resetq = 0; - top->eval(); - top->resetq = 1; - top->eval(); - - for (i = 0; i < 100000000; i++) { - uint16_t a = top->mem_addr; - uint16_t b = top->code_addr; - if (top->mem_wr) - ram32[(a & 16383) / 4] = top->dout; - top->clk = 1; - top->eval(); - t += 20; - - top->mem_din = ram32[(a & 16383) / 4]; - top->insn = ram16[b]; - top->clk = 0; - top->eval(); - t += 20; - if (top->io_wr) { - putchar(top->dout); - putc(top->dout, log); - if (top->dout == '#') - break; - } -#if 0 - if (top->io_inp && (top->io_n == 2)) { - top->io_din = getchar(); - } -#endif - } - printf("\nSimulation ended after %d cycles\n", i); - delete top; - // tfp->close(); - fclose(log); - - exit(0); -} diff --git a/j1/toolchain/basewords.fs b/j1/toolchain/basewords.fs deleted file mode 100644 index 6534d2b..0000000 --- a/j1/toolchain/basewords.fs +++ /dev/null @@ -1,92 +0,0 @@ -( J1 base words implemented in assembler JCB 17:27 12/31/11) - -: 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# 0900 ; -: N<N h# 0010 or ; -: T->R h# 0020 or ; -: N->[T] h# 0030 or ; -: N->io[T] h# 0040 or ; -: RET h# 0080 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 ; - -: imm h# 8000 or tw, ; -: alu h# 6000 or tw, ; -: ubranch h# 0000 or tw, ; -: 0branch h# 2000 or tw, ; -: scall h# 4000 or tw, ; - - -:: 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 ; -:: < NN 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 ; -:: io@ io[T] alu ; -:: ! T N->[T] d-1 alu - N d-1 alu ; -:: io! T N->io[T] d-1 alu - N d-1 alu ; -:: rshift N>>T d-1 alu ; -:: lshift N<N d+1 alu ; -:: exit T RET r-1 alu ; - -\ Elided words -\ These words are supported by the hardware but are not -\ part of ANS Forth. They are named after the word-pair -\ that matches their effect -\ Using these elided words instead of -\ the pair saves one cycle and one instruction. - -:: 2dupand T&N T->N d+1 alu ; -:: 2dup< NN d+1 alu ; -:: 2dup= N==T T->N d+1 alu ; -:: 2dupor T|N T->N d+1 alu ; -:: 2duprshift N>>T T->N d+1 alu ; -:: 2dup+ T+N T->N d+1 alu ; -:: 2dupu< NuN d+1 alu ; -:: 2dupxor T^N T->N d+1 alu ; -:: dup>r T T->R r+1 alu ; -:: dup@ [T] T->N d+1 alu ; -:: overand T&N alu ; -:: over> N Nu[T] d-1 alu ; diff --git a/j1/toolchain/cross.fs b/j1/toolchain/cross.fs deleted file mode 100644 index 56c0025..0000000 --- a/j1/toolchain/cross.fs +++ /dev/null @@ -1,321 +0,0 @@ -( J1 Cross Compiler JCB 16:55 05/02/12) - -\ Usage gforth cross.fs -\ -\ Where machine.fs defines the target machine -\ and program.fs is the target program -\ - -variable lst \ .lst output file handle - -: h# - base @ >r 16 base ! - 0. bl parse >number throw 2drop postpone literal - r> base ! ; immediate - -: tcell 2 ; -: tcells tcell * ; -: tcell+ tcell + ; - -131072 allocate throw constant tflash \ bytes, target flash -131072 allocate throw constant _tbranches \ branch targets, cells -tflash 31072 0 fill -_tbranches 131072 0 fill -: tbranches cells _tbranches + ; - -variable tdp 0 tdp ! -: there tdp @ ; -: islegal ; -: tc! islegal tflash + c! ; -: tc@ islegal tflash + c@ ; -: tw! islegal tflash + w! ; -: t! islegal tflash + l! ; -: t@ islegal tflash + uw@ ; -: twalign tdp @ 1+ -2 and tdp ! ; -: talign tdp @ 3 + -4 and tdp ! ; -: tc, there tc! 1 tdp +! ; -: t, there t! 4 tdp +! ; -: tw, there tw! tcell tdp +! ; -: org tdp ! ; - -wordlist constant target-wordlist -: add-order ( wid -- ) >r get-order r> swap 1+ set-order ; -: :: get-current >r target-wordlist set-current : r> set-current ; - -next-arg included \ include the machine.fs - -( Language basics for target JCB 19:08 05/02/12) - -warnings off -:: ( postpone ( ; -:: \ postpone \ ; - -:: org org ; -:: include include ; -:: included included ; -:: marker marker ; -:: [if] postpone [if] ; -:: [else] postpone [else] ; -:: [then] postpone [then] ; - -: 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 tw, - then -; - -: literal - dup $80000000 and if - invert recurse - ~T alu - else - dup $ffff8000 and if - dup $F rshift recurse - $f recurse - N<in @ >r bl word count r> >in ! -; - -variable link 0 link ! - -:: header - twalign there - \ cr ." link is " link @ . - link @ tw, - link ! - bl parse - dup tc, - bounds do - i c@ tc, - loop - twalign -; - -:: : - hex - codeptr s>d - <# bl hold # # # # #> - lst @ write-file throw - wordstr lst @ write-line throw - - create codeptr , - does> @ scall -; - -:: :noname -; - -:: , - talign - t, -; - -:: allot - 0 ?do - 0 tc, - loop -; - -: shortcut ( orig -- f ) \ insn @orig precedes ;. Shortcut it. - \ call becomes jump - dup t@ h# e000 and h# 4000 = if - dup t@ h# 1fff and over tw! - true - else - dup t@ h# e00c and h# 6000 = if - dup t@ h# 0080 or r-1 over tw! - true - else - false - then - then - nip -; - -:: ; - there 2 - shortcut \ true if shortcut applied - there 0 do - i tbranches @ there = if - i tbranches @ shortcut and - then - loop - 0= if \ not all shortcuts worked - s" exit" evaluate - then -; -:: ;fallthru ; - -:: jmp - ' >body @ ubranch -; - -:: constant - create , - does> @ literal -; - -:: create - talign - create there , - does> @ literal -; - -( Switching between target and meta JCB 19:08 05/02/12) - -: target only target-wordlist add-order definitions ; -: ] target ; -:: meta forth definitions ; -:: [ forth definitions ; - -: t' bl parse target-wordlist search-wordlist 0= throw >body @ ; - -( eforth's way of handling constants JCB 13:12 09/03/10) - -: sign>number ( c-addr1 u1 -- ud2 c-addr2 u2 ) - 0. 2swap - over c@ [char] - = if - 1 /string - >number - 2swap dnegate 2swap - else - >number - then -; - -: base>number ( caddr u base -- ) - base @ >r base ! - sign>number - r> base ! - dup 0= if - 2drop drop literal - else - 1 = swap c@ [char] . = and if - drop dup literal 32 rshift literal - else - -1 abort" bad number" - then - then ; -warnings on - -:: d# bl parse 10 base>number ; -:: h# bl parse 16 base>number ; -:: ['] ' >body @ 2* literal ; -:: [char] char literal ; - -:: asm-0branch - ' >body @ - 0branch -; - -( Conditionals JCB 13:12 09/03/10) - -: resolve ( orig -- ) - there over tbranches ! \ forward reference from orig to this loc - dup t@ there 2/ or swap tw! -; - -:: if - there - 0 0branch -; - -:: then - resolve -; - -:: else - there - 0 ubranch - swap resolve -; - -:: begin there ; - -:: again ( dest -- ) - 2/ ubranch -; -:: until - 2/ 0branch -; -:: while - there - 0 0branch -; -:: repeat - swap 2/ ubranch - resolve -; - -4 org -: .trim ( a-addr u ) \ shorten string until it ends with '.' - begin - 2dup + 1- c@ [char] . <> - while - 1- - repeat -; -include strings.fs -next-arg 2dup .trim >str constant prefix. -: .suffix ( c-addr u -- c-addr u ) \ e.g. "bar" -> "foo.bar" - >str prefix. +str str@ -; -: create-output-file w/o create-file throw ; -: out-suffix ( s -- h ) \ Create an output file h with suffix s - >str - prefix. +str - s" ../build/firmware/" >str +str str@ - create-output-file -; -:noname - s" lst" out-suffix lst ! -; execute - - -target included \ include the program.fs - -[ tdp @ 0 org ] bootloader main [ org ] -meta - -decimal -0 value file -: dumpall.16 - s" hex" out-suffix to file - - hex - 1024 0 do - tflash i 2* + w@ - s>d <# # # # # #> file write-line throw - loop - file close-file -; -: dumpall.32 - s" hex" out-suffix to file - - hex - 4096 0 do - tflash i 4 * + @ - s>d <# # # # # # # # # #> file write-line throw - loop - file close-file -; - -dumpall.32 - -bye diff --git a/j1/toolchain/demo1.fs b/j1/toolchain/demo1.fs deleted file mode 100644 index 7c49af4..0000000 --- a/j1/toolchain/demo1.fs +++ /dev/null @@ -1,7 +0,0 @@ -: main - begin - h# 0 io@ - d# 1 + - h# 0 io! - again -; diff --git a/j1/toolchain/dump.py b/j1/toolchain/dump.py deleted file mode 100644 index 283916b..0000000 --- a/j1/toolchain/dump.py +++ /dev/null @@ -1,36 +0,0 @@ -import sys -import array - -def hexdump(s): - def toprint(c): - if 32 <= ord(c) < 127: - return c - else: - return "." - def hexline(i, s): - return ("%04x: " % i + " ".join(["%02x" % ord(c) for c in s]).ljust(52) + - "|" + - "".join([toprint(c) for c in s]).ljust(16) + - "|") - return "\n".join([hexline(i, s[i:i+16]) for i in range(0, len(s), 16)]) - -pgm = array.array('H', [int(l, 16) for l in open(sys.argv[1])]) - -while pgm[-1] == 0: - pgm = pgm[:-1] -s = pgm.tostring() -print -print hexdump(s) - -link = [w for w in pgm[::-1] if w][0] -words = [] -while link: - name = s[link + 2:] - c = ord(name[0]) - name = name[1:1+c] - print "%04x %s" % (link, name) - assert not name in words - words.append(name) - link = pgm[link / 2] -print len(words), " ".join(words) -print "program size %d/%d" % (len(pgm), 1024) diff --git a/j1/toolchain/go b/j1/toolchain/go deleted file mode 100644 index 6570942..0000000 --- a/j1/toolchain/go +++ /dev/null @@ -1,3 +0,0 @@ -set -e -gforth cross.fs basewords.fs nuc.fs -# python dump.py ../build/firmware/demo0.hex diff --git a/j1/toolchain/nuc.fs b/j1/toolchain/nuc.fs deleted file mode 100644 index 846db05..0000000 --- a/j1/toolchain/nuc.fs +++ /dev/null @@ -1,604 +0,0 @@ -header 1+ : 1+ d# 1 + ; -header 1- : 1- d# -1 + ; -header 0= : 0= d# 0 = ; -header cell+ : cell+ d# 2 + ; - -header <> : <> = invert ; -header > : > swap < ; -header 0< : 0< d# 0 < ; -header 0> : 0> d# 0 > ; -header 0<> : 0<> d# 0 <> ; -header u> : u> swap u< ; - -: eol ( u -- u' false | true ) - d# -1 + - dup 0= dup if - ( 0 true -- ) - nip - then -; - -header ms -: ms - begin - d# 15000 begin - eol until - eol until -; - - -header key? -: key? - d# 0 io@ - d# 4 and - 0<> -; - -header key -: key - begin - key? - until - d# 0 io@ d# 8 rshift - d# 0 d# 2 io! -; - -: ready - d# 0 io@ - d# 2 and - 0= -; - -header emit -: emit - begin ready until - h# 0 io! -; - -header cr -: cr - d# 13 emit - d# 10 emit -; - -header space -: space - d# 32 emit -; - -header bl -: bl - d# 32 -; - -: hex1 - h# f and - dup d# 10 < if - [char] 0 - else - d# 55 - then - + - emit -; - -: hex2 - dup d# 4 rshift hex1 hex1 -; - -: hex4 - dup d# 8 rshift hex2 hex2 -; - -: hex8 - dup d# 16 rshift hex4 hex4 -; - -header . -: . hex8 space ; - -header false : false d# 0 ; -header true : true d# -1 ; -header rot : rot >r swap r> swap ; -header -rot : -rot swap >r swap r> ; -header tuck : tuck swap over ; -header 2drop : 2drop drop drop ; -header ?dup : ?dup dup if dup then ; - -header 2dup : 2dup over over ; -header +! : +! tuck @ + swap ! ; -header 2swap : 2swap rot >r rot r> ; - -header min : min 2dup< if drop else nip then ; -header max : max 2dup< if nip else drop then ; - -header c@ -: c@ - dup @ swap - d# 3 and d# 3 lshift rshift - d# 255 and -; - -: hi16 - d# 16 rshift d# 16 lshift -; - -: lo16 - d# 16 lshift d# 16 rshift -; - -header uw@ -: uw@ - dup @ swap - d# 2 and d# 3 lshift rshift - lo16 -; - -header w! -: w! ( u c-addr -- ) - dup>r d# 2 and if - d# 16 lshift - r@ @ lo16 - else - lo16 - r@ @ hi16 - then - or r> ! -; - -header c! -: c! ( u c-addr -- ) - dup>r d# 1 and if - d# 8 lshift - h# 00ff - else - h# 00ff and - h# ff00 - then - r@ uw@ and - or r> w! -; - -header count -: count - dup 1+ swap c@ -; - -: bounds ( a n -- a+n a ) - over + swap -; - -header type -: type - bounds - begin - 2dupxor - while - dup c@ emit - 1+ - repeat - 2drop -; - -create base $a , -create ll 0 , -create dp 0 , -create tib# 0 , -create >in 0 , -create tib 80 allot - -header words : words - ll uw@ - begin - dup - while - cr - dup . - dup cell+ - count type - space - uw@ - repeat - drop -; - -header dump : dump ( addr u -- ) - cr over hex4 - begin ( addr u ) - ?dup - while - over c@ space hex2 - 1- swap 1+ ( u' addr' ) - dup h# f and 0= if ( next line? ) - cr dup hex4 - then - swap - repeat - drop cr -; - -header negate : negate invert 1+ ; -header - : - negate + ; -header abs : abs dup 0< if negate then ; -header 2* : 2* d# 1 lshift ; -header 2/ : 2/ d# 1 rshift ; -header here : here dp @ ; -header depth : depth depths h# f and ; - -: /string - dup >r - swap r> + swap -; - -header aligned -: aligned - d# 3 + d# -4 and -; - -: 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 . ) -; - -: d1+ d# 1. d+ ; - -: dnegate - invert swap invert swap - d1+ -; - -: dabs ( d -- ud ) - dup 0< if dnegate then -; - -: s>d dup 0< ; -: m+ - s>d d+ -; - -: snap - cr depth hex2 space - begin - depth - while - . - repeat - cr - [char] # emit - begin again -; - -create scratch 0 , - -header um* -: um* ( u1 u2 -- ud ) - scratch ! - d# 0. - d# 32 begin - >r - 2dup d+ - rot dup 0< if - 2* -rot - scratch @ d# 0 d+ - else - 2* -rot - then - r> eol - until - rot drop -; -: * - um* drop -; - -header accept -: accept - d# 30 emit - drop dup - begin - key - dup h# 0d xor - while - dup h# 0a = if - drop - else - over c! 1+ - then - repeat - drop swap - -; - -: 3rd >r over r> swap ; -: 3dup 3rd 3rd 3rd ; - -: sameword ( c-addr u wp -- c-addr u wp flag ) - 2dup d# 2 + c@ = if - 3dup - d# 3 + >r - bounds - begin - 2dupxor - while - dup c@ r@ c@ <> if - 2drop rdrop false exit - then - 1+ - r> 1+ >r - repeat - 2drop rdrop true - else - false - then -; - -\ lsb 0 means non-immediate, return -1 -\ 1 means immediate, return 1 -: isimmediate ( wp -- -1 | 1 ) - uw@ d# 1 and 2* 1- -; - -: sfind - ll uw@ - begin - dup - while - sameword - if - nip nip - dup - d# 2 + - count + - d# 1 + d# -2 and - swap isimmediate - exit - then - uw@ - repeat -; - -: digit? ( c -- u f ) - dup h# 39 > h# 100 and + - dup h# 140 > h# 107 and - h# 30 - - dup base @ u< -; - -: ud* ( ud1 u -- ud2 ) \ ud2 is the product of ud1 and u - tuck * >r - um* r> + -; - -: >number ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 ) - begin - dup - while - over c@ digit? - 0= if drop exit then - >r 2swap base @ ud* - r> m+ 2swap - d# 1 /string - repeat -; - -header fill -: fill ( c-addr u char -- ) ( 6.1.1540 ) - >r bounds - begin - 2dupxor - while - r@ over c! 1+ - repeat - r> drop 2drop -; - -header erase -: erase - d# 0 fill -; - -header execute -: execute - >r -; - -header source -: source - tib tib# @ -; - -\ From Forth200x - public domain - -: isspace? ( c -- f ) - bl 1+ u< ; - -: isnotspace? ( c -- f ) - isspace? 0= ; - -: xt-skip ( addr1 n1 xt -- addr2 n2 ) \ gforth - \ skip all characters satisfying xt ( c -- f ) - >r - BEGIN - over c@ r@ execute - over 0<> and - WHILE - d# 1 /string - REPEAT - r> drop ; - -: parse-name ( "name" -- c-addr u ) - source >in @ /string - ['] isspace? xt-skip over >r - ['] isnotspace? xt-skip ( end-word restlen r: start-word ) - 2dup d# 1 min + source drop - >in ! - drop r> tuck - ; - -header ! :noname ! ; -header + :noname + ; -header xor :noname xor ; -header and :noname and ; -header or :noname or ; -header invert :noname invert ; -header = :noname = ; -header < :noname < ; -header u< :noname u< ; -header swap :noname swap ; -header dup :noname dup ; -header drop :noname drop ; -header over :noname over ; -header nip :noname nip ; -header @ :noname @ ; -header io! :noname io! ; -header rshift :noname rshift ; -header lshift :noname lshift ; -\ -\ \ >r -\ \ r> -\ \ r@ -\ \ exit -\ - -: xmain - cr d# 1 ms cr - d# 60 begin - [char] - emit - eol until - begin key? while key drop repeat - - cr h# ffff hex8 - - d# 0 d# 100 dump - words cr cr - - begin again - - begin - cr - tib d# 30 accept >r - d# 0. tib r> >number - 2drop hex4 space hex4 - again - - snap -; - -: route - r> + >r ; - -\ (doubleAlso) ( c-addr u -- x 1 | x x 2 ) -\ If the string is legal, leave a single or double cell number -\ and size of the number. - -: isvoid ( caddr u -- ) \ any char remains, throw -13 - nip 0<> - if [char] x emit snap then -; - -: consume1 ( caddr u ch -- caddr' u' f ) - >r over c@ r> = - over 0<> and - dup>r d# 1 and /string r> -; - -: (doubleAlso) - h# 0. 2swap - [char] - consume1 >r - >number - [char] . consume1 if - isvoid \ double number - r> if dnegate then - d# 2 exit - then - \ single number - isvoid drop - r> if negate then - d# 1 -; - -: doubleAlso - (doubleAlso) drop -; - - -: dispatch - route ;fallthru - jmp execute \ -1 0 non-immediate - jmp doubleAlso \ 0 0 number - jmp execute \ 1 0 immediate - -\ jmp compile_comma \ -1 2 non-immediate -\ jmp doubleAlso_comma \ 0 2 number -\ jmp execute \ 1 2 immediate - -: interpret - begin - parse-name dup - while - sfind - 1+ 2* dispatch - repeat - 2drop -; - -: main - 2drop - begin - tib d# 80 accept - tib# ! - \ h# 40 emit - d# 0 >in ! - source dump - \ cr parse-name sfind - \ if - \ execute - \ then - interpret - again -; - -meta - $3f80 org -target - -: b.key - begin - d# 0 io@ - d# 4 and - until - d# 0 io@ d# 8 rshift - d# 0 d# 2 io! -; - -: b.32 - b.key - b.key d# 8 lshift or - b.key d# 16 lshift or - b.key d# 24 lshift or -; - -meta - $3fc0 org -target - -: bootloader - begin - b.key d# 27 = - until - - b.32 d# 0 - begin - 2dupxor - while - b.32 over ! - d# 4 + - repeat -; - -meta - link @ t, - link @ t' ll tw! - there t' dp tw! -target diff --git a/j1/toolchain/strings.fs b/j1/toolchain/strings.fs deleted file mode 100644 index cbd9b0e..0000000 --- a/j1/toolchain/strings.fs +++ /dev/null @@ -1,25 +0,0 @@ -( Strings JCB 11:57 05/18/12) - -: >str ( c-addr u -- str ) \ a new u char string from c-addr - dup cell+ allocate throw dup >r - 2dup ! cell+ \ write size into first cell - ( c-addr u saddr ) - swap cmove r> -; -: str@ dup cell+ swap @ ; -: str! ( str c-addr -- c-addr' ) \ copy str to c-addr - >r str@ r> - 2dup + >r swap - cmove r> -; -: +str ( str2 str1 -- str3 ) - over @ over @ + cell+ allocate throw >r - over @ over @ + r@ ! - r@ cell+ str! str! drop r> -; - -: example - s" sailor" >str - s" hello" >str - +str str@ type -; diff --git a/j1/verilog/common.h b/j1/verilog/common.h deleted file mode 100644 index 03da65d..0000000 --- a/j1/verilog/common.h +++ /dev/null @@ -1,3 +0,0 @@ -`default_nettype none -`define WIDTH 32 -`define DEPTH 4 diff --git a/j1/verilog/j1.v b/j1/verilog/j1.v deleted file mode 100644 index d69ca20..0000000 --- a/j1/verilog/j1.v +++ /dev/null @@ -1,123 +0,0 @@ -`include "common.h" - -module j1( - input wire clk, - input wire resetq, - - output wire io_wr, - output wire [15:0] mem_addr, - output wire mem_wr, - output wire [`WIDTH-1:0] dout, - input wire [`WIDTH-1:0] mem_din, - - input wire [`WIDTH-1:0] io_din, - - output wire [12:0] code_addr, - input wire [15:0] insn - ); - reg [`DEPTH-1:0] dsp; // Data stack pointer - reg [`DEPTH-1:0] dspN; - reg [`WIDTH-1:0] st0; // Top of data stack - reg [`WIDTH-1:0] st0N; - reg dstkW; // D stack write - - reg [12:0] pc, pcN; - reg [`DEPTH-1:0] rsp, rspN; - reg rstkW; // R stack write - wire [`WIDTH-1:0] rstkD; // R stack write value - reg reboot = 1; - wire [12:0] pc_plus_1 = pc + 1; - - assign mem_addr = st0N[15:0]; - assign code_addr = {pcN}; - - // The D and R stacks - wire [`WIDTH-1:0] st1, rst0; - stack #(.DEPTH(`DEPTH)) - dstack(.clk(clk), .resetq(resetq), .ra(dsp), .rd(st1), .we(dstkW), .wa(dspN), .wd(st0)); - stack #(.DEPTH(`DEPTH))rstack(.clk(clk), .resetq(resetq), .ra(rsp), .rd(rst0), .we(rstkW), .wa(rspN), .wd(rstkD)); - - always @* - begin - // Compute the new value of st0 - casez ({insn[15:8]}) - 8'b1??_?????: st0N = { {(`WIDTH - 15){1'b0}}, insn[14:0] }; // literal - 8'b000_?????: st0N = st0; // jump - 8'b010_?????: st0N = st0; // call - 8'b001_?????: st0N = st1; // conditional jump - 8'b011_?0000: st0N = st0; // ALU operations... - 8'b011_?0001: st0N = st1; - 8'b011_?0010: st0N = st0 + st1; - 8'b011_?0011: st0N = st0 & st1; - 8'b011_?0100: st0N = st0 | st1; - 8'b011_?0101: st0N = st0 ^ st1; - 8'b011_?0110: st0N = ~st0; - 8'b011_?0111: st0N = {`WIDTH{(st1 == st0)}}; - 8'b011_?1000: st0N = {`WIDTH{($signed(st1) < $signed(st0))}}; -`ifdef NOSHIFTER // `define NOSHIFTER in common.h to cut slice usage in half and shift by 1 only - 8'b011_?1001: st0N = st1 >> 1; - 8'b011_?1010: st0N = st1 << 1; -`else // otherwise shift by 1-any number of bits - 8'b011_?1001: st0N = st1 >> st0[4:0]; - 8'b011_?1010: st0N = st1 << st0[4:0]; -`endif - 8'b011_?1011: st0N = rst0; - 8'b011_?1100: st0N = mem_din; - 8'b011_?1101: st0N = io_din; - 8'b011_?1110: st0N = {{(`WIDTH - 8){1'b0}}, rsp, dsp}; - 8'b011_?1111: st0N = {`WIDTH{(st1 < st0)}}; - default: st0N = {`WIDTH{1'bx}}; - endcase - end - - wire func_T_N = (insn[6:4] == 1); - wire func_T_R = (insn[6:4] == 2); - wire func_write = (insn[6:4] == 3); - wire func_iow = (insn[6:4] == 4); - - wire is_alu = (insn[15:13] == 3'b011); - assign mem_wr = !reboot & is_alu & func_write; - assign dout = st1; - assign io_wr = !reboot & is_alu & func_iow; - - assign rstkD = (insn[13] == 1'b0) ? {{(`WIDTH - 14){1'b0}}, pc_plus_1, 1'b0} : st0; - - reg [`DEPTH-1:0] dspI, rspI; - always @* - begin - casez ({insn[15:13]}) - 3'b1??: {dstkW, dspI} = {1'b1, 4'b0001}; - 3'b001: {dstkW, dspI} = {1'b0, 4'b1111}; - 3'b011: {dstkW, dspI} = {func_T_N, {insn[1], insn[1], insn[1:0]}}; - default: {dstkW, dspI} = {1'b0, 4'b0000}; - endcase - dspN = dsp + dspI; - - casez ({insn[15:13]}) - 3'b010: {rstkW, rspI} = {1'b1, 4'b0001}; - 3'b011: {rstkW, rspI} = {func_T_R, {insn[3], insn[3], insn[3:2]}}; - default: {rstkW, rspI} = {1'b0, 4'b0000}; - endcase - rspN = rsp + rspI; - - casez ({reboot, insn[15:13], insn[7], |st0}) - 6'b1_???_?_?: pcN = 0; - 6'b0_000_?_?, - 6'b0_010_?_?, - 6'b0_001_?_0: pcN = insn[12:0]; - 6'b0_011_1_?: pcN = rst0[13:1]; - default: pcN = pc_plus_1; - endcase - end - - always @(negedge resetq or posedge clk) - begin - if (!resetq) begin - reboot <= 1'b1; - { pc, dsp, st0, rsp } <= 0; - end else begin - reboot <= 0; - { pc, dsp, st0, rsp } <= { pcN, dspN, st0N, rspN }; - end - end -endmodule diff --git a/j1/verilog/stack.v b/j1/verilog/stack.v deleted file mode 100644 index e5cee8a..0000000 --- a/j1/verilog/stack.v +++ /dev/null @@ -1,22 +0,0 @@ -`include "common.h" - -module stack - #(parameter DEPTH=4) - (input wire clk, - /* verilator lint_off UNUSED */ - input wire resetq, - /* verilator lint_on UNUSED */ - input wire [DEPTH-1:0] ra, - output wire [`WIDTH-1:0] rd, - input wire we, - input wire [DEPTH-1:0] wa, - input wire [`WIDTH-1:0] wd); - - reg [`WIDTH-1:0] store[0:(2**DEPTH)-1]; - - always @(posedge clk) - if (we) - store[wa] <= wd; - - assign rd = store[ra]; -endmodule diff --git a/j1/verilog/testbench.v b/j1/verilog/testbench.v deleted file mode 100644 index 2ec2b5e..0000000 --- a/j1/verilog/testbench.v +++ /dev/null @@ -1,30 +0,0 @@ -`timescale 1ns/1ps -`default_nettype none - -module testbench(); - - reg clk; - reg resetq; - integer t; - - top #(.FIRMWARE("build/firmware/")) dut(.clk(clk), .resetq(resetq)); - - initial begin - clk = 1; - t = 0; - resetq = 0; - #1; - resetq = 1; - - $dumpfile("test.vcd"); - $dumpvars(0, dut); - end - - always #5.0 clk = ~clk; - - always @(posedge clk) begin - t <= t + 1; - if (t == 300) - $finish; - end -endmodule diff --git a/j1/verilog/top.v b/j1/verilog/top.v deleted file mode 100644 index efcf297..0000000 --- a/j1/verilog/top.v +++ /dev/null @@ -1,9 +0,0 @@ -module top( - input clk, - input resetq, - output [15:0] tail); - parameter FIRMWARE = ""; - - j1 _j1 (.clk(clk), .resetq(resetq)); - -endmodule diff --git a/j1/verilog/uart.v b/j1/verilog/uart.v deleted file mode 100644 index 4daac0f..0000000 --- a/j1/verilog/uart.v +++ /dev/null @@ -1,180 +0,0 @@ -`default_nettype none - -module baudgen( - input wire clk, - input wire resetq, - input wire [31:0] baud, - input wire restart, - output wire ser_clk); - parameter CLKFREQ = 1000000; - - wire [38:0] aclkfreq = CLKFREQ; - reg [38:0] d; - wire [38:0] dInc = d[38] ? ({4'd0, baud}) : (({4'd0, baud}) - aclkfreq); - wire [38:0] dN = restart ? 0 : (d + dInc); - wire fastclk = ~d[38]; - assign ser_clk = fastclk; - - always @(negedge resetq or posedge clk) - begin - if (!resetq) begin - d <= 0; - end else begin - d <= dN; - end - end -endmodule - -/* - ------+ +-----+-----+-----+-----+-----+-----+-----+-----+-----+-----+---- - | | | | | | | | | | | | - |start| 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 |stop1|stop2| - | | | | | | | | | | | ? | - +-----+-----+-----+-----+-----+-----+-----+-----+-----+ + - -*/ - -module uart( - input wire clk, // System clock - input wire resetq, - - // Outputs - output wire uart_busy, // High means UART is transmitting - output reg uart_tx, // UART transmit wire - // Inputs - input wire [31:0] baud, - input wire uart_wr_i, // Raise to transmit byte - input wire [7:0] uart_dat_i // 8-bit data -); - parameter CLKFREQ = 1000000; - - reg [3:0] bitcount; - reg [8:0] shifter; - - assign uart_busy = |bitcount; - wire sending = |bitcount; - - wire ser_clk; - - wire starting = uart_wr_i & ~uart_busy; - baudgen #(.CLKFREQ(CLKFREQ)) _baudgen( - .clk(clk), - .resetq(resetq), - .baud(baud), - .restart(1'b0), - .ser_clk(ser_clk)); - - always @(negedge resetq or posedge clk) - begin - if (!resetq) begin - uart_tx <= 1; - bitcount <= 0; - shifter <= 0; - end else begin - if (starting) begin - shifter <= { uart_dat_i[7:0], 1'b0 }; - bitcount <= 1 + 8 + 1; - end - - if (sending & ser_clk) begin - { shifter, uart_tx } <= { 1'b1, shifter }; - bitcount <= bitcount - 4'd1; - end - end - end - -endmodule - -module rxuart( - input wire clk, - input wire resetq, - input wire [31:0] baud, - input wire uart_rx, // UART recv wire - input wire rd, // read strobe - output wire valid, // has data - output wire [7:0] data); // data - parameter CLKFREQ = 1000000; - - reg [4:0] bitcount; - reg [7:0] shifter; - - // On starting edge, wait 3 half-bits then sample, and sample every 2 bits thereafter - - wire idle = &bitcount; - wire sample; - reg [2:0] hh = 3'b111; - wire [2:0] hhN = {hh[1:0], uart_rx}; - wire startbit = idle & (hhN[2:1] == 2'b10); - wire [7:0] shifterN = sample ? {hh[1], shifter[7:1]} : shifter; - - wire ser_clk; - baudgen #(.CLKFREQ(CLKFREQ)) _baudgen( - .clk(clk), - .baud({baud[30:0], 1'b0}), - .resetq(resetq), - .restart(startbit), - .ser_clk(ser_clk)); - - assign valid = (bitcount == 18); - reg [4:0] bitcountN; - always @* - if (startbit) - bitcountN = 0; - else if (!idle & !valid & ser_clk) - bitcountN = bitcount + 5'd1; - else if (valid & rd) - bitcountN = 5'b11111; - else - bitcountN = bitcount; - - // 3,5,7,9,11,13,15,17 - assign sample = (bitcount > 2) & bitcount[0] & !valid & ser_clk; - assign data = shifter; - - always @(negedge resetq or posedge clk) - begin - if (!resetq) begin - hh <= 3'b111; - bitcount <= 5'b11111; - shifter <= 0; - end else begin - hh <= hhN; - bitcount <= bitcountN; - shifter <= shifterN; - end - end -endmodule - -module buart( - input wire clk, - input wire resetq, - input wire [31:0] baud, - input wire rx, // recv wire - output wire tx, // xmit wire - input wire rd, // read strobe - input wire wr, // write strobe - output wire valid, // has recv data - output wire busy, // is transmitting - input wire [7:0] tx_data, - output wire [7:0] rx_data // data -); - parameter CLKFREQ = 1000000; - - rxuart #(.CLKFREQ(CLKFREQ)) _rx ( - .clk(clk), - .resetq(resetq), - .baud(baud), - .uart_rx(rx), - .rd(rd), - .valid(valid), - .data(rx_data)); - uart #(.CLKFREQ(CLKFREQ)) _tx ( - .clk(clk), - .resetq(resetq), - .baud(baud), - .uart_busy(busy), - .uart_tx(tx), - .uart_wr_i(wr), - .uart_dat_i(tx_data)); -endmodule diff --git a/j1/verilog/xilinx-top.v b/j1/verilog/xilinx-top.v deleted file mode 100644 index 6695d77..0000000 --- a/j1/verilog/xilinx-top.v +++ /dev/null @@ -1,215 +0,0 @@ -`default_nettype none - - -module bram_tdp #( - parameter DATA = 72, - parameter ADDR = 10 -) ( - // Port A - input wire a_clk, - input wire a_wr, - input wire [ADDR-1:0] a_addr, - input wire [DATA-1:0] a_din, - output reg [DATA-1:0] a_dout, - - // Port B - input wire b_clk, - input wire b_wr, - input wire [ADDR-1:0] b_addr, - input wire [DATA-1:0] b_din, - output reg [DATA-1:0] b_dout -); - -// Shared memory -reg [DATA-1:0] mem [(2**ADDR)-1:0]; - initial begin - $readmemh("../build/firmware/demo0.hex", mem); - end - -// Port A -always @(posedge a_clk) begin - a_dout <= mem[a_addr]; - if(a_wr) begin - a_dout <= a_din; - mem[a_addr] <= a_din; - end -end - -// Port B -always @(posedge b_clk) begin - b_dout <= mem[b_addr]; - if(b_wr) begin - b_dout <= b_din; - mem[b_addr] <= b_din; - end -end - -endmodule - -// A 16Kbyte RAM (4096x32) with one write port and one read port -module ram16k0( - input wire clk, - - input wire[15:0] a_addr, - output wire[31:0] a_q, - input wire[31:0] a_d, - input wire a_wr, - - input wire[12:0] b_addr, - output wire[15:0] b_q); - - //synthesis attribute ram_style of mem is block - reg [31:0] mem[0:4095]; //pragma attribute mem ram_block TRUE - initial begin - $readmemh("../build/firmware/demo0.hex", mem); - end - - always @ (posedge clk) - if (a_wr) - mem[a_addr[13:2]] <= a_d; - - reg [15:0] a_addr_; - always @ (posedge clk) - a_addr_ <= a_addr; - assign a_q = mem[a_addr_[13:2]]; - - reg [12:0] raddr_reg; - always @ (posedge clk) - raddr_reg <= b_addr; - wire [31:0] insn32 = mem[raddr_reg[12:1]]; - assign b_q = raddr_reg[0] ? insn32[31:16] : insn32[15:0]; -endmodule - -module ram16k( - input wire clk, - - input wire[15:0] a_addr, - output wire[31:0] a_q, - input wire[31:0] a_d, - input wire a_wr, - - input wire[12:0] b_addr, - output wire[15:0] b_q); - - wire [31:0] insn32; - - bram_tdp #(.DATA(32), .ADDR(12)) nram ( - .a_clk(clk), - .a_wr(a_wr), - .a_addr(a_addr[13:2]), - .a_din(a_d), - .a_dout(a_q), - - .b_clk(clk), - .b_wr(1'b0), - .b_addr(b_addr[12:1]), - .b_din(32'd0), - .b_dout(insn32)); - - reg ba_; - always @(posedge clk) - ba_ <= b_addr[0]; - assign b_q = ba_ ? insn32[31:16] : insn32[15:0]; - -endmodule - - -module top( - input wire CLK, - output wire DUO_LED, - input wire DUO_SW1, - input wire RXD, - output wire TXD, - input wire DTR - ); - localparam MHZ = 40; - - wire fclk; - - DCM_CLKGEN #( - .CLKFX_MD_MAX(0.0), // Specify maximum M/D ratio for timing anlysis - .CLKFX_DIVIDE(32), // Divide value - D - (1-256) - .CLKFX_MULTIPLY(MHZ), // Multiply value - M - (2-256) - .CLKIN_PERIOD(31.25), // Input clock period specified in nS - .STARTUP_WAIT("FALSE") // Delay config DONE until DCM_CLKGEN LOCKED (TRUE/FALSE) - ) - DCM_CLKGEN_inst ( - .CLKFX(fclk), // 1-bit output: Generated clock output - .CLKIN(CLK), // 1-bit input: Input clock - .FREEZEDCM(0), // 1-bit input: Prevents frequency adjustments to input clock - .PROGCLK(0), // 1-bit input: Clock input for M/D reconfiguration - .PROGDATA(0), // 1-bit input: Serial data input for M/D reconfiguration - .PROGEN(0), // 1-bit input: Active high program enable - .RST(0) // 1-bit input: Reset input pin - ); - - reg [25:0] counter; - always @(posedge fclk) - counter <= counter + 26'd1; - assign DUO_LED = counter[25]; - - // ------------------------------------------------------------------------ - - wire uart0_valid, uart0_busy; - wire [7:0] uart0_data; - wire uart0_rd, uart0_wr; - reg [31:0] baud = 32'd115200; - wire UART0_RX; - buart #(.CLKFREQ(MHZ * 1000000)) _uart0 ( - .clk(fclk), - .resetq(1'b1), - .baud(baud), - .rx(RXD), - .tx(TXD), - .rd(uart0_rd), - .wr(uart0_wr), - .valid(uart0_valid), - .busy(uart0_busy), - .tx_data(dout_[7:0]), - .rx_data(uart0_data)); - - wire [15:0] mem_addr; - wire [31:0] mem_din; - wire mem_wr; - wire [31:0] dout; - - wire [12:0] code_addr; - wire [15:0] insn; - - wire io_wr; - - wire resetq = DTR; - - j1 _j1 ( - .clk(fclk), - .resetq(resetq), - - .io_wr(io_wr), - .mem_addr(mem_addr), - .mem_wr(mem_wr), - .mem_din(mem_din), - .dout(dout), - .io_din({16'd0, uart0_data, 4'd0, DTR, uart0_valid, uart0_busy, DUO_SW1}), - - .code_addr(code_addr), - .insn(insn) - ); - - ram16k ram(.clk(fclk), - .a_addr(mem_addr), - .a_q(mem_din), - .a_wr(mem_wr), - .a_d(dout), - .b_addr(code_addr), - .b_q(insn)); - - reg io_wr_; - reg [15:0] mem_addr_; - reg [31:0] dout_; - always @(posedge fclk) - {io_wr_, mem_addr_, dout_} <= {io_wr, mem_addr, dout}; - - assign uart0_wr = io_wr_ & (mem_addr_ == 16'h0000); - assign uart0_rd = io_wr_ & (mem_addr_ == 16'h0002); - -endmodule diff --git a/j1/xilinx/.gitignore b/j1/xilinx/.gitignore deleted file mode 100644 index e138931..0000000 --- a/j1/xilinx/.gitignore +++ /dev/null @@ -1,44 +0,0 @@ -*.bgn -*.bit -*_bitgen.xwbt -*.bld -*.cfi -*.drc -*.map -*.mcs -*.mrp -*.ncd -*.ngc -*.ngc_xst.xrpt -*.ngd -*_ngdbuild.xrpt -*.ngm -*_par.grf -*_par.ncd -*_par.pad -*_par_pad.csv -*_par_pad.txt -*_par.par -*_par.ptwx -*_par.unroutes -*_par.xpi -*.pcf -*.prj -*.prm -*.psr -*.scr -*.srp -*.xml -*.html -_impactbatch.log -netlist.lst -smartguide.ncd -top.lso -top_map.xrpt -top_par.xrpt -usage_statistics_webtalk.html -webtalk.log -xlnx_auto_0_xdb -_xmsgs -xst -unused/ diff --git a/j1/xilinx/Makefile b/j1/xilinx/Makefile deleted file mode 100644 index 481513b..0000000 --- a/j1/xilinx/Makefile +++ /dev/null @@ -1,11 +0,0 @@ -project = j1-papilioduo -vendor = xilinx -family = spartan3s -part = xc6slx9-2-tqg144 -# part = xc3s200an-4ftg256 -top_module = top -flashsize = 2048 - -vfiles = ../verilog/xilinx-top.v ../verilog/uart.v ../verilog/j1.v ../verilog/stack.v - -include xilinx.mk diff --git a/j1/xilinx/go b/j1/xilinx/go deleted file mode 100644 index c527f4c..0000000 --- a/j1/xilinx/go +++ /dev/null @@ -1,22 +0,0 @@ -set -e -cd ../toolchain -sh go -cd ../xilinx - -$HOME/Downloads/DesignLab-1.0.5/tools/Papilio_Loader/programmer/linux32/papilio-prog -v -f j1-papilioduo.bit -python shell.py -h /dev/ttyUSB2 -i ../build/firmware/nuc.hex ; exit - -make clean -make -if false -then - cp ../build/firmware/nuc.hex ../build/firmware/nuc.mem - data2mem -bm j1-papilioduo_bd.bmm -bd ../build/firmware/nuc.mem -bt j1-papilioduo.bit - trce -v 10 j1-papilioduo.ncd j1-papilioduo.pcf -o j1-papilioduo.twr - DL=j1-papilioduo_rp.bit -else - DL=j1-papilioduo.bit -fi -$HOME/Downloads/DesignLab-1.0.5/tools/Papilio_Loader/programmer/linux32/papilio-prog -v -f $DL -python shell.py -h /dev/ttyUSB2 -i ../build/firmware/nuc.hex ; exit -# miniterm.py /dev/ttyUSB0 115200 diff --git a/j1/xilinx/j1-papilioduo.bmm b/j1/xilinx/j1-papilioduo.bmm deleted file mode 100644 index 3dea0be..0000000 --- a/j1/xilinx/j1-papilioduo.bmm +++ /dev/null @@ -1,24 +0,0 @@ -// BMM LOC annotation file. -// -// Release 14.6 - P.20131013, build 3.0.10 Apr 3, 2013 -// Copyright (c) 1995-2015 Xilinx, Inc. All rights reserved. - - -/////////////////////////////////////////////////////////////////////////////// -// -// Address space 'j1' 0x00000000:0x000007FF (2 KBytes). -// -/////////////////////////////////////////////////////////////////////////////// - -// ADDRESS_SPACE j1 RAMB16 [0xffff0000:0xffff3FFF] -// BUS_BLOCK -// ram/nram/Mram_mem7 RAMB16 [3:0] [0:4095]; -// ram/nram/Mram_mem6 RAMB16 [7:4] [0:4095]; -// ram/nram/Mram_mem5 RAMB16 [11:8] [0:4095]; -// ram/nram/Mram_mem4 RAMB16 [15:12] [0:4095]; -// ram/nram/Mram_mem3 RAMB16 [19:16] [0:4095]; -// ram/nram/Mram_mem2 RAMB16 [23:20] [0:4095]; -// ram/nram/Mram_mem1 RAMB16 [27:24] [0:4095]; -// ram/nram/Mram_mem0 RAMB16 [31:28] [0:4095]; -// END_BUS_BLOCK; -// END_ADDRESS_SPACE; diff --git a/j1/xilinx/j1-papilioduo.ucf b/j1/xilinx/j1-papilioduo.ucf deleted file mode 100644 index e06e002..0000000 --- a/j1/xilinx/j1-papilioduo.ucf +++ /dev/null @@ -1,183 +0,0 @@ -# UCF file for the Papilio DUO board -# Generated by pin_converter, written by Kevin Lindsey -# https://github.com/thelonious/papilio_pins/tree/development/pin_converter - -# Main board wing pin [] to FPGA pin Pxx map -# -------C------- -------B------- -------A------- -# [GND] [C00] P114 [GND] [B00] P99 P100 [A15] -# [2V5] [C01] P115 [2V5] [B01] P97 P98 [A14] -# [3V3] [C02] P116 [3V3] [B02] P92 P93 [A13] -# [5V0] [C03] P117 [5V0] [B03] P87 P88 [A12] -# [C04] P118 [B04] P84 P85 [A11] [5V0] -# [C05] P119 [B05] P82 P83 [A10] [3V3] -# [C06] P120 [B06] P80 P81 [A09] [2V5] -# [C07] P121 [B07] P78 P79 [A08] [GND] -# [GND] [C08] P123 [GND] [B08] P74 P75 [A07] -# [2V5] [C09] P124 [2V5] [B09] P95 P67 [A06] -# [3V3] [C10] P126 [3V3] [B10] P62 P66 [A05] -# [5V0] [C11] P127 [5V0] [B11] P59 P61 [A04] -# [C12] P131 [B12] P57 P58 [A03] [5V0] -# [C13] P132 [B13] P55 P56 [A02] [3V3] -# [C14] P133 [B14] P50 P51 [A01] [2V5] -# [C15] P134 [B15] P47 P48 [A00] [GND] - -## Prohibit the automatic placement of pins that are connected to VCC or GND for configuration. -CONFIG PROHIBIT=P144; -CONFIG PROHIBIT=P69; -CONFIG PROHIBIT=P60; - -#NET "*" IOSTANDARD = LVTTL; - -NET CLK LOC="P94" | IOSTANDARD=LVTTL; # CLK -TIMESPEC TS_Period_1 = PERIOD "CLK" 31.25 ns HIGH 50%; -NET TXD LOC="P141" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; -NET RXD LOC="P46" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; -NET DTR LOC="P137" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; - -// NET "fclk" PERIOD = 6 ns HIGH 50%; - -# -# NET Arduino_0 LOC="P116" | IOSTANDARD=LVTTL; # A0 -# NET Arduino_1 LOC="P117" | IOSTANDARD=LVTTL; # A1 -# NET Arduino_2 LOC="P118" | IOSTANDARD=LVTTL; # A2 -# NET Arduino_3 LOC="P119" | IOSTANDARD=LVTTL; # A3 -# NET Arduino_4 LOC="P120" | IOSTANDARD=LVTTL; # A4 -# NET Arduino_5 LOC="P121" | IOSTANDARD=LVTTL; # A5 -# NET Arduino_6 LOC="P123" | IOSTANDARD=LVTTL; # A6 -# NET Arduino_7 LOC="P124" | IOSTANDARD=LVTTL; # A7 -# NET Arduino_8 LOC="P126" | IOSTANDARD=LVTTL; # A8 -# NET Arduino_9 LOC="P127" | IOSTANDARD=LVTTL; # A9 -# NET Arduino_10 LOC="P131" | IOSTANDARD=LVTTL; # A10 -# NET Arduino_11 LOC="P132" | IOSTANDARD=LVTTL; # A11 -# NET Arduino_12 LOC="P133" | IOSTANDARD=LVTTL; # A12 -# NET Arduino_13 LOC="P134" | IOSTANDARD=LVTTL; # A13 -# -# NET Arduino_14 LOC="P115" | IOSTANDARD=LVTTL; # B0 -# NET Arduino_15 LOC="P114" | IOSTANDARD=LVTTL; # B1 -# NET Arduino_16 LOC="P112" | IOSTANDARD=LVTTL; # B2 -# NET Arduino_17 LOC="P111" | IOSTANDARD=LVTTL; # B3 -# NET Arduino_18 LOC="P105" | IOSTANDARD=LVTTL; # B4 -# NET Arduino_19 LOC="P102" | IOSTANDARD=LVTTL; # B5 -# NET Arduino_20 LOC="P101" | IOSTANDARD=LVTTL; # B6 -# NET Arduino_21 LOC="P100" | IOSTANDARD=LVTTL; # B7 -# -# NET Arduino_22 LOC="P99" | IOSTANDARD=LVTTL; # C0 -# NET Arduino_24 LOC="P97" | IOSTANDARD=LVTTL; # C1 -# NET Arduino_26 LOC="P93" | IOSTANDARD=LVTTL; # C2 -# NET Arduino_28 LOC="P88" | IOSTANDARD=LVTTL; # C3 -# NET Arduino_30 LOC="P85" | IOSTANDARD=LVTTL; # C4 -# NET Arduino_32 LOC="P83" | IOSTANDARD=LVTTL; # C5 -# NET Arduino_34 LOC="P81" | IOSTANDARD=LVTTL; # C6 -# NET Arduino_36 LOC="P79" | IOSTANDARD=LVTTL; # C7 -# NET Arduino_38 LOC="P75" | IOSTANDARD=LVTTL; # C8 -# NET Arduino_40 LOC="P67" | IOSTANDARD=LVTTL; # C9 -# NET Arduino_42 LOC="P62" | IOSTANDARD=LVTTL; # C10 -# NET Arduino_44 LOC="P59" | IOSTANDARD=LVTTL; # C11 -# NET Arduino_46 LOC="P57" | IOSTANDARD=LVTTL; # C12 -# NET Arduino_48 LOC="P55" | IOSTANDARD=LVTTL; # C13 -# NET Arduino_50 LOC="P50" | IOSTANDARD=LVTTL; # C14 -# NET Arduino_52 LOC="P47" | IOSTANDARD=LVTTL; # C15 -# -# NET Arduino_23 LOC="P98" | IOSTANDARD=LVTTL ; -# NET Arduino_25 LOC="P95" | IOSTANDARD=LVTTL ; -# NET Arduino_27 LOC="P92" | IOSTANDARD=LVTTL ; -# NET Arduino_29 LOC="P87" | IOSTANDARD=LVTTL ; -# NET Arduino_31 LOC="P84" | IOSTANDARD=LVTTL ; -# NET Arduino_33 LOC="P82" | IOSTANDARD=LVTTL ; -# NET Arduino_35 LOC="P80" | IOSTANDARD=LVTTL ; -# NET Arduino_37 LOC="P78" | IOSTANDARD=LVTTL ; -# NET Arduino_39 LOC="P74" | IOSTANDARD=LVTTL ; -# NET Arduino_41 LOC="P66" | IOSTANDARD=LVTTL ; -# NET Arduino_43 LOC="P61" | IOSTANDARD=LVTTL ; -# NET Arduino_45 LOC="P58" | IOSTANDARD=LVTTL ; -# NET Arduino_47 LOC="P56" | IOSTANDARD=LVTTL ; -# NET Arduino_49 LOC="P51" | IOSTANDARD=LVTTL ; -# NET Arduino_51 LOC="P48" | IOSTANDARD=LVTTL ; -# NET Arduino_53 LOC="P39" | IOSTANDARD=LVTTL ; -# -# # SRAM -# -# NET "sram_addr<0>" LOC = "P7" | IOSTANDARD=LVTTL | SLEW=FAST; -# NET "sram_addr<1>" LOC = "P8" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<2>" LOC = "P9" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<3>" LOC = "P10" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<4>" LOC = "P11" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<5>" LOC = "P5" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<6>" LOC = "P2" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<7>" LOC = "P1" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<8>" LOC = "P143" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<9>" LOC = "P142" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<10>" LOC = "P43" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<11>" LOC = "P41" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<12>" LOC = "P40" | IOSTANDARD=LVTTL | SLEW=FAST; -# NET "sram_addr<13>" LOC = "P35" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<14>" LOC = "P34" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<15>" LOC = "P27" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<16>" LOC = "P29" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<17>" LOC = "P33" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_addr<18>" LOC = "P32" | IOSTANDARD=LVTTL | SLEW=FAST ; -# #NET "sram_addr<19>" LOC = "P44" | IOSTANDARD=LVTTL | SLEW=FAST ; -# #NET "sram_addr<20>" LOC = "P30" | IOSTANDARD=LVTTL | SLEW=FAST ; -# -# # Data lines -# NET "sram_data<0>" LOC = "P14" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_data<1>" LOC = "P15" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_data<2>" LOC = "P16" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_data<3>" LOC = "P17" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_data<4>" LOC = "P21" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_data<5>" LOC = "P22" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_data<6>" LOC = "P23" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_data<7>" LOC = "P24" | IOSTANDARD=LVTTL | SLEW=FAST ; -# -# # Control lines -# NET "sram_ce" LOC = "P12" | IOSTANDARD=LVTTL | SLEW=FAST; -# NET "sram_we" LOC = "P6" | IOSTANDARD=LVTTL | SLEW=FAST ; -# NET "sram_oe" LOC = "P26" | IOSTANDARD=LVTTL | SLEW=FAST; -# -# NET SPI_CS LOC="P38" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_CS OK -# NET SPI_SCK LOC="P70" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_CK OK -# NET SPI_MOSI LOC="P64" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_SI OK -# NET SPI_MISO LOC="P65" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_SO OK -# -# #Dragon MPSSE -# NET BD0_MPSSE_TCK LOC="P46" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET BD1_MPSSE_TDI LOC="P141" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET BD2_MPSSE_TDO LOC="P140" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET BD3_MPSSE_TMS LOC="P138" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET BD4_MPSSE_DTR LOC="P137" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# -# #Arduino JTAG -# NET ARD_JTAG_TDI LOC="P88" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET ARD_JTAG_TDO LOC="P85" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET ARD_JTAG_TMS LOC="P83" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET ARD_JTAG_TCK LOC="P81" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# -# #Arduino SPI -# NET ARD_SPI_MISO LOC="P133" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET ARD_SPI_MOSI LOC="P132" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET ARD_SPI_SCLK LOC="P134" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# -# #Dragon SPI -# NET DRAGON_SPI_GND LOC="P78" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET DRAGON_SPI_RESET LOC="P79" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# #NET DRAGON_SPI_RESET LOC="P79" | IOSTANDARD=LVTTL | DRIVE=8 | PULLUP | SLEW=SLOW; -# NET DRAGON_SPI_MOSI LOC="P74" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET DRAGON_SPI_SCK LOC="P75" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET DRAGON_SPI_VTG LOC="P66" | IOSTANDARD=LVTTL | DRIVE=24 | SLEW=SLOW; -# NET DRAGON_SPI_MISO LOC="P67" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# -# #Dragon JTAG -# NET DRAGON_JTAG_TCK LOC="P47" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET DRAGON_JTAG_GND LOC="P39" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET DRAGON_JTAG_TDO LOC="P50" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET DRAGON_JTAG_VTG LOC="P48" | IOSTANDARD=LVTTL | DRIVE=24 | SLEW=SLOW; -# NET DRAGON_JTAG_TMS LOC="P55" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET DRAGON_JTAG_RESET LOC="P51" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# #NET DRAGON_JTAG_RESET LOC="P51" | IOSTANDARD=LVTTL | DRIVE=8 | PULLUP | SLEW=SLOW; -# NET DRAGON_JTAG_TDI LOC="P59" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET DRAGON_JTAG_GND2 LOC="P58" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# -# #Dragon Misc -NET DUO_SW1 LOC="P104" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; -# NET ARD_RESET LOC="P139" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; # ARD_RESET -NET DUO_LED LOC="P134" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; diff --git a/j1/xilinx/shell.py b/j1/xilinx/shell.py deleted file mode 100644 index 814e6a2..0000000 --- a/j1/xilinx/shell.py +++ /dev/null @@ -1,78 +0,0 @@ -#!/usr/bin/env python - -import sys -from datetime import datetime -import time -import array -import struct -import os - -try: - import serial -except: - print "This tool needs PySerial, but it was not found" - sys.exit(1) - -import swapforth as sf - -class TetheredJ1b(sf.TetheredFT900): - def __init__(self, port): - ser = serial.Serial(port, 115200, timeout=None, rtscts=0) - self.ser = ser - self.searchpath = ['.'] - self.log = open("log", "w") - - def boot(self, bootfile = None): - ser = self.ser - ser.setDTR(1) - ser.setDTR(0) - boot = array.array('I', [int(l, 16) for l in open(bootfile)]) - boot = boot[:0x3f80 / 4] # remove bootloader itself (top 128 bytes) - while boot[-1] == 0: # remove any unused words - boot = boot[:-1] - boot = boot.tostring() - ser.write(chr(27)) - print 'wrote 27' - # print repr(ser.read(1)) - - ser.write(struct.pack('I', len(boot))) - ser.write(boot) - print 'completed load of %d bytes' % len(boot) - # print repr(ser.read(1)) - -if __name__ == '__main__': - port = '/dev/ttyUSB0' - image = None - - r = None - - args = sys.argv[1:] - while args: - a = args[0] - if a.startswith('-i'): - image = args[1] - args = args[2:] - elif a.startswith('-h'): - port = args[1] - args = args[2:] - else: - if not r: - r = TetheredJ1b(port) - r.boot(image) - if a.startswith('-e'): - print r.shellcmd(args[1]) - args = args[2:] - else: - try: - r.include(a) - except sf.Bye: - pass - args = args[1:] - if not r: - r = TetheredJ1b(port) - r.boot(image) - - print repr(r.ser.read(1)) - # r.interactive_command(None) - r.shell(False) - # r.listen() diff --git a/j1/xilinx/xilinx.mk b/j1/xilinx/xilinx.mk deleted file mode 100644 index f71dede..0000000 --- a/j1/xilinx/xilinx.mk +++ /dev/null @@ -1,176 +0,0 @@ -# The top level module should define the variables below then include -# this file. The files listed should be in the same directory as the -# Makefile. -# -# variable description -# ---------- ------------- -# project project name (top level module should match this name) -# top_module top level module of the project -# libdir path to library directory -# libs library modules used -# vfiles all local .v files -# xilinx_cores all local .xco files -# vendor vendor of FPGA (xilinx, altera, etc.) -# family FPGA device family (spartan3e) -# part FPGA part name (xc4vfx12-10-sf363) -# flashsize size of flash for mcs file (16384) -# optfile (optional) xst extra opttions file to put in .scr -# map_opts (optional) options to give to map -# par_opts (optional) options to give to par -# intstyle (optional) intstyle option to all tools -# -# files description -# ---------- ------------ -# $(project).ucf ucf file -# -# Library modules should have a modules.mk in their root directory, -# namely $(libdir)//module.mk, that simply adds to the vfiles -# and xilinx_cores variable. -# -# all the .xco files listed in xilinx_cores will be generated with core, with -# the resulting .v and .ngc files placed back in the same directory as -# the .xco file. -# -# TODO: .xco files are device dependant, should use a template based system - -coregen_work_dir ?= ./coregen-tmp -map_opts ?= -timing -ol high -detail -pr b -register_duplication -w -par_opts ?= -ol high -isedir ?= /data/Xilinx/14.7/ISE_DS -xil_env ?= . $(isedir)/settings64.sh -flashsize ?= 8192 - -libmks = $(patsubst %,$(libdir)/%/module.mk,$(libs)) -mkfiles = Makefile $(libmks) xilinx.mk -include $(libmks) - -corengcs = $(foreach core,$(xilinx_cores),$(core:.xco=.ngc)) -local_corengcs = $(foreach ngc,$(corengcs),$(notdir $(ngc))) -vfiles += $(foreach core,$(xilinx_cores),$(core:.xco=.v)) -junk += $(local_corengcs) - -.PHONY: default xilinx_cores clean twr etwr -default: $(project).bit $(project).mcs -xilinx_cores: $(corengcs) -twr: $(project).twr -etwr: $(project)_err.twr - -define cp_template -$(2): $(1) - cp $(1) $(2) -endef -$(foreach ngc,$(corengcs),$(eval $(call cp_template,$(ngc),$(notdir $(ngc))))) - -%.ngc %.v: %.xco - @echo "=== rebuilding $@" - if [ -d $(coregen_work_dir) ]; then \ - rm -rf $(coregen_work_dir)/*; \ - else \ - mkdir -p $(coregen_work_dir); \ - fi - cd $(coregen_work_dir); \ - $(xil_env); \ - coregen -b $$OLDPWD/$<; \ - cd - - xcodir=`dirname $<`; \ - basename=`basename $< .xco`; \ - if [ ! -r $(coregen_work_dir/$$basename.ngc) ]; then \ - echo "'$@' wasn't created."; \ - exit 1; \ - else \ - cp $(coregen_work_dir)/$$basename.v $(coregen_work_dir)/$$basename.ngc $$xcodir; \ - fi -junk += $(coregen_work_dir) - -date = $(shell date +%F-%H-%M) - -# some common junk -junk += *.xrpt - -programming_files: $(project).bit $(project).mcs - mkdir -p $@/$(date) - mkdir -p $@/latest - for x in .bit .mcs .cfi _bd.bmm; do cp $(project)$$x $@/$(date)/$(project)$$x; cp $(project)$$x $@/latest/$(project)$$x; done - $(xil_env); xst -help | head -1 | sed 's/^/#/' | cat - $(project).scr > $@/$(date)/$(project).scr - -$(project).mcs: $(project).bit - $(xil_env); \ - promgen -w -s $(flashsize) -p mcs -o $@ -u 0 $^ -junk += $(project).mcs $(project).cfi $(project).prm - -$(project).bit: $(project)_par.ncd - $(xil_env); \ - bitgen $(intstyle) -g UserID:0x09470947 -g DriveDone:yes -g StartupClk:Cclk -w $(project)_par.ncd $(project).bit - # bitgen $(intstyle) -g compress -g UserID:0x09470947 -g DriveDone:yes -g StartupClk:Cclk -w $(project)_par.ncd $(project).bit - # bitgen $(intstyle) -g UserID:0x09470947 -g DriveDone:yes -g StartupClk:Cclk -w $(project)_par.ncd $(project).bit -junk += $(project).bgn $(project).bit $(project).drc $(project)_bd.bmm - - -$(project)_par.ncd: $(project).ncd - $(xil_env); \ - if par $(intstyle) $(par_opts) -w $(project).ncd $(project)_par.ncd; then \ - :; \ - else \ - $(MAKE) etwr; \ - fi -junk += $(project)_par.ncd $(project)_par.par $(project)_par.pad -junk += $(project)_par_pad.csv $(project)_par_pad.txt -junk += $(project)_par.grf $(project)_par.ptwx -junk += $(project)_par.unroutes $(project)_par.xpi - -$(project).ncd: $(project).ngd - if [ -r $(project)_par.ncd ]; then \ - cp $(project)_par.ncd smartguide.ncd; \ - smartguide="-smartguide smartguide.ncd"; \ - else \ - smartguide=""; \ - fi; \ - $(xil_env); \ - map $(intstyle) $(map_opts) $$smartguide $< -junk += $(project).ncd $(project).pcf $(project).ngm $(project).mrp $(project).map -junk += smartguide.ncd $(project).psr -junk += $(project)_summary.xml $(project)_usage.xml - -$(project).ngd: $(project).ngc $(project).ucf $(project).bmm - $(xil_env); ngdbuild $(intstyle) $(project).ngc -bm $(project).bmm -junk += $(project).ngd $(project).bld - -$(project).ngc: $(vfiles) $(local_corengcs) $(project).scr $(project).prj - $(xil_env); xst $(intstyle) -ifn $(project).scr -junk += xlnx_auto* $(top_module).lso $(project).srp -junk += netlist.lst xst $(project).ngc - -$(project).prj: $(vfiles) $(mkfiles) - for src in $(vfiles); do echo "verilog work $$src" >> $(project).tmpprj; done - sort -u $(project).tmpprj > $(project).prj - rm -f $(project).tmpprj -junk += $(project).prj - -optfile += $(wildcard $(project).opt) -top_module ?= $(project) -$(project).scr: $(optfile) $(mkfiles) ./xilinx.opt - echo "run" > $@ - echo "-p $(part)" >> $@ - echo "-top $(top_module)" >> $@ - echo "-ifn $(project).prj" >> $@ - echo "-ofn $(project).ngc" >> $@ - cat ./xilinx.opt $(optfile) >> $@ -junk += $(project).scr - -$(project).post_map.twr: $(project).ncd - $(xil_env); trce -e 10 $< $(project).pcf -o $@ -junk += $(project).post_map.twr $(project).post_map.twx smartpreview.twr - -$(project).twr: $(project)_par.ncd - $(xil_env); trce $< $(project).pcf -o $(project).twr -junk += $(project).twr $(project).twx smartpreview.twr - -$(project)_err.twr: $(project)_par.ncd - $(xil_env); trce -e 10 $< $(project).pcf -o $(project)_err.twr -junk += $(project)_err.twr $(project)_err.twx - -.gitignore: $(mkfiles) - echo programming_files $(junk) | sed 's, ,\n,g' > .gitignore - -clean:: - rm -rf $(junk) diff --git a/j1/xilinx/xilinx.opt b/j1/xilinx/xilinx.opt deleted file mode 100644 index c9e5ab7..0000000 --- a/j1/xilinx/xilinx.opt +++ /dev/null @@ -1,42 +0,0 @@ --ifmt mixed --ofmt NGC --opt_mode speed --opt_level 1 --iuc NO --keep_hierarchy no --netlist_hierarchy as_optimized --rtlview no --glob_opt AllClockNets --read_cores yes --write_timing_constraints NO --cross_clock_analysis NO --hierarchy_separator / --bus_delimiter <> --case maintain --slice_utilization_ratio 100 --bram_utilization_ratio 100 -#-dsp_utilization_ratio 100 --safe_implementation No --fsm_extract YES --fsm_encoding Auto --fsm_style lut --ram_extract Yes --ram_style Auto --rom_extract Yes --rom_style Auto --shreg_extract YES --auto_bram_packing NO --resource_sharing NO --async_to_sync NO -#-use_dsp48 auto --iobuf YES --max_fanout 500 --register_duplication YES --register_balancing No --optimize_primitives NO --use_clock_enable Auto --use_sync_set Auto --use_sync_reset Auto --iob auto --equivalent_register_removal YES --slice_utilization_ratio_maxmargin 5 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 ; -: < NN 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 ; -: 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# 0900 ; -: T-1 h# 0a00 ; -: rT h# 0b00 ; -: [T] h# 0c00 ; -: N<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" -- ) ( run: -- eaddr n ) [char] " parse (sliteral) ; -: s' ( "ccc" -- ) ( 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 Binary files a/j1demo/firmware/font8x8 and /dev/null differ diff --git a/j1demo/firmware/fsm-32.png b/j1demo/firmware/fsm-32.png deleted file mode 100644 index 974f70c..0000000 Binary files a/j1demo/firmware/fsm-32.png and /dev/null 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 -# 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 Binary files a/j1demo/firmware/j1.png and /dev/null 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 ; diff --git a/j1demo/j1.pdf b/j1demo/j1.pdf deleted file mode 100644 index 188ac02..0000000 Binary files a/j1demo/j1.pdf and /dev/null differ diff --git a/j1demo/synth/Makefile b/j1demo/synth/Makefile deleted file mode 100644 index 4cec0ac..0000000 --- a/j1demo/synth/Makefile +++ /dev/null @@ -1,9 +0,0 @@ -project = j1 -vendor = xilinx -family = spartan3s -part = xc3s1000-4ft256 -top_module = top - -vfiles = ../verilog/top.v ../verilog/j1.v ../verilog/ck_div.v ../verilog/uart.v - -include xilinx.mk diff --git a/j1demo/synth/j1.bmm b/j1demo/synth/j1.bmm deleted file mode 100644 index 61a7d83..0000000 --- a/j1demo/synth/j1.bmm +++ /dev/null @@ -1,12 +0,0 @@ -ADDRESS_SPACE jram RAMB16 [0x00020000:0x00023fff] - BUS_BLOCK - j1/ram[7].ram [15:14]; - j1/ram[6].ram [13:12]; - j1/ram[5].ram [11:10]; - j1/ram[4].ram [9:8]; - j1/ram[3].ram [7:6]; - j1/ram[2].ram [5:4]; - j1/ram[1].ram [3:2]; - j1/ram[0].ram [1:0]; - END_BUS_BLOCK; -END_ADDRESS_SPACE; diff --git a/j1demo/synth/j1.ucf b/j1demo/synth/j1.ucf deleted file mode 100644 index f6bbd70..0000000 --- a/j1demo/synth/j1.ucf +++ /dev/null @@ -1,327 +0,0 @@ -##################################################### -# -# XSA-3S1000 Board FPGA pin assignment constraints -# -##################################################### -# -# Clocks -# -net CLKA loc=T9 | IOSTANDARD = LVCMOS33 ; # 100MHz -#net CLKB loc=P8 | IOSTANDARD = LVCMOS33 ; # 50MHz -#net CLKC loc=R9 | IOSTANDARD = LVCMOS33 ; # ??Mhz -# -# Push button switches -# -#NET SW1_3_N loc=K2 | IOSTANDARD = LVCMOS33 ; # Flash Block select -#NET SW1_4_N loc=J4 | IOSTANDARD = LVCMOS33 ; # Flash Block -#NET SW2_N loc=E11 | IOSTANDARD = LVCMOS33 ; # active-low pushbutton -#NET SW3_N loc=A13 | IOSTANDARD = LVCMOS33 ; # active-low pushbutton -# -# PS/2 Keyboard -# -net PS2_CLK loc=B16 | IOSTANDARD = LVCMOS33 ; -net PS2_DAT loc=E13 | IOSTANDARD = LVCMOS33 ; -# -# VGA Outputs -# -NET VGA_BLUE<0> LOC=C9 | IOSTANDARD = LVCMOS33 ; -NET VGA_BLUE<1> LOC=E7 | IOSTANDARD = LVCMOS33 ; -NET VGA_BLUE<2> LOC=D5 | IOSTANDARD = LVCMOS33 ; -NET VGA_GREEN<0> LOC=A8 | IOSTANDARD = LVCMOS33 ; -NET VGA_GREEN<1> LOC=A5 | IOSTANDARD = LVCMOS33 ; -NET VGA_GREEN<2> LOC=C3 | IOSTANDARD = LVCMOS33 ; -NET VGA_RED<0> LOC=C8 | IOSTANDARD = LVCMOS33 ; -NET VGA_RED<1> LOC=D6 | IOSTANDARD = LVCMOS33 ; -NET VGA_RED<2> LOC=B1 | IOSTANDARD = LVCMOS33 ; -NET VGA_HSYNC_N LOC=B7 | IOSTANDARD = LVCMOS33 ; -NET VGA_VSYNC_N LOC=D8 | IOSTANDARD = LVCMOS33 ; -# -# Manually assign locations for the DCMs along the bottom of the FPGA -# because PAR sometimes places them in opposing corners and that ruins the clocks. -# -#INST "u1/gen_dlls.dllint" LOC="DCM_X0Y0"; -#INST "u1/gen_dlls.dllext" LOC="DCM_X1Y0"; - -# Manually assign locations for the DCMs along the bottom of the FPGA -# because PAR sometimes places them in opposing corners and that ruins the clocks. -#INST "u2_dllint" LOC="DCM_X0Y0"; -#INST "u2_dllext" LOC="DCM_X1Y0"; -# -# SDRAM memory pin assignments -# -#net SDRAM_clkfb loc=N8 | IOSTANDARD = LVCMOS33 ; # feedback SDRAM clock after PCB delays -#net SDRAM_clkout loc=E10 | IOSTANDARD = LVCMOS33 ; # clock to SDRAM -#net SDRAM_CKE loc=D7 | IOSTANDARD = LVCMOS33 ; # SDRAM clock enable -#net SDRAM_CS_N loc=B8 | IOSTANDARD = LVCMOS33 ; # SDRAM chip-select -#net SDRAM_RAS_N loc=A9 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_CAS_N loc=A10 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_WE_N loc=B10 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_DQMH loc=D9 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_DQML loc=C10 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<0> loc=B5 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<1> loc=A4 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<2> loc=B4 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<3> loc=E6 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<4> loc=E3 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<5> loc=C1 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<6> loc=E4 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<7> loc=D3 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<8> loc=C2 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<9> loc=A3 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<10> loc=B6 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<11> loc=C5 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_A<12> loc=C6 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<0> loc=C15 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<1> loc=D12 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<2> loc=A14 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<3> loc=B13 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<4> loc=D11 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<5> loc=A12 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<6> loc=C11 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<7> loc=D10 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<8> loc=B11 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<9> loc=B12 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<10> loc=C12 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<11> loc=B14 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<12> loc=D14 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<13> loc=C16 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<14> loc=F12 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_D<15> loc=F13 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_BA<0> loc=A7 | IOSTANDARD = LVCMOS33 ; -#net SDRAM_BA<1> loc=C7 | IOSTANDARD = LVCMOS33 ; -# -# Flash memory interface - -net FLASH_A<0> LOC=N5 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<1> LOC=K14 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<2> LOC=K13 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<3> LOC=K12 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<4> LOC=L14 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<5> LOC=M16 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<6> LOC=L13 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<7> LOC=N16 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<8> LOC=N14 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<9> LOC=P15 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<10> LOC=R16 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<11> LOC=P14 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<12> LOC=P13 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<13> LOC=N12 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<14> LOC=T14 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<15> LOC=R13 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<16> LOC=N10 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<17> LOC=M14 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<18> LOC=K3 | IOSTANDARD = LVCMOS33 ; -net FLASH_A<19> LOC=K4 | IOSTANDARD = LVCMOS33 ; - -net FLASH_D<0> LOC=M11 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<1> LOC=N11 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<2> LOC=P10 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<3> LOC=R10 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<4> LOC=T7 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<5> LOC=R7 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<6> LOC=N6 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<7> LOC=M6 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<8> LOC=T4 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<9> LOC=R5 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<10> LOC=T5 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<11> LOC=P6 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<12> LOC=M7 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<13> LOC=R6 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<14> LOC=N7 | IOSTANDARD = LVCMOS33 ; -net FLASH_D<15> LOC=P7 | IOSTANDARD = LVCMOS33 ; -net FLASH_CE_N LOC=R4 | IOSTANDARD = LVCMOS33 ; -net FLASH_OE_N LOC=P5 | IOSTANDARD = LVCMOS33 ; -net FLASH_WE_N LOC=M13 | IOSTANDARD = LVCMOS33 ; -net FLASH_BYTE_N LOC=T8 | IOSTANDARD = LVCMOS33 ; -net FLASH_RDY LOC=L12 | IOSTANDARD = LVCMOS33 ; -net FLASH_RST_N LOC=P16 | IOSTANDARD = LVCMOS33 ; - -# FPGA Programming interface -# -#net FPGA_D<0> LOC=M11 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D0, S1, LED_C -#net FPGA_D<1> LOC=N11 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D1, S7, LED_DP -#net FPGA_D<2> LOC=P10 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D2, S4, LED_B -#net FPGA_D<3> LOC=R10 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D3, S6, LED_A -#net FPGA_D<4> LOC=T7 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D4, S5, LED_F -#net FPGA_D<5> LOC=R7 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D5, S3, LED_G -#net FPGA_D<6> LOC=N6 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D6, S2, LED_E -#net FPGA_D<7> LOC=M6 | IOSTANDARD = LVCMOS33 ; # shared with FLASH_D7, S0, LED_D -#net FPGA_CCLK LOC=T15 | IOSTANDARD = LVCMOS33 ; -#net FPGA_DONE LOC=R14 | IOSTANDARD = LVCMOS33 ; -#net FPGA_INIT_N LOC=N9 | IOSTANDARD = LVCMOS33 ; -#net FPGA_PROG_N LOC=B3 | IOSTANDARD = LVCMOS33 ; -#net FPGA_TCK LOC=C14 | IOSTANDARD = LVCMOS33 ; -#net FPGA_TDI LOC=A2 | IOSTANDARD = LVCMOS33 ; -#net FPGA_TDI_CSN LOC=R3 | IOSTANDARD = LVCMOS33 ; -#net FPGA_TDO LOC=A15 | IOSTANDARD = LVCMOS33 ; -#net FPGA_TDO_WRN LOC=T3 | IOSTANDARD = LVCMOS33 ; -#net FPGA_TMS LOC=C13 | IOSTANDARD = LVCMOS33 ; -#net FPGA_TMS_BSY LOC=P9 | IOSTANDARD = LVCMOS33 ; -# -# Status LED -# -#net S<0> loc=M6 | IOSTANDARD = LVCMOS33 ; # FPGA_D7, LED_D -#net S<1> loc=M11 | IOSTANDARD = LVCMOS33 ; # FPGA_D0, LED_C -#net S<2> loc=N6 | IOSTANDARD = LVCMOS33 ; # FPGA_D6, LED_E -#net S<3> loc=R7 | IOSTANDARD = LVCMOS33 ; # FPGA_D5, LED_G -#net S<4> loc=P10 | IOSTANDARD = LVCMOS33 ; # FPGA_D2, LED_B -#net S<5> loc=T7 | IOSTANDARD = LVCMOS33 ; # FPGA_D4, LED_F -#net S<6> loc=R10 | IOSTANDARD = LVCMOS33 ; # FPGA_D3, LED_A -#net S<7> loc=N11 | IOSTANDARD = LVCMOS33 ; # FPGA_D1, LED_DP -# -# Parallel Port -# -#net PPORT_load loc=N14 | IOSTANDARD = LVCMOS33 ; -#net PPORT_clk loc=P15 | IOSTANDARD = LVCMOS33 ; -#net PPORT_din<0> loc=R16 | IOSTANDARD = LVCMOS33 ; -#net PPORT_din<1> loc=P14 | IOSTANDARD = LVCMOS33 ; -#net PPORT_din<2> loc=P13 | IOSTANDARD = LVCMOS33 ; -#net PPORT_din<3> loc=N12 | IOSTANDARD = LVCMOS33 ; -# -#net PPORT_dout<0> loc=N5 | IOSTANDARD = LVCMOS33 ; -#net PPORT_dout<1> loc=K14 | IOSTANDARD = LVCMOS33 ; -#net PPORT_dout<2> loc=K13 | IOSTANDARD = LVCMOS33 ; -#net PPORT_dout<3> loc=T10 | IOSTANDARD = LVCMOS33 ; -# -#net PPORT_d<0> loc=N14 | IOSTANDARD = LVCMOS33 ; # FLASH_A<8> / PPORT_LOAD -#net PPORT_d<1> loc=P15 | IOSTANDARD = LVCMOS33 ; # FLASH_A<9> / PPORT_CLK -#net PPORT_d<2> loc=R16 | IOSTANDARD = LVCMOS33 ; # FLASH_A<10> / PPORT_DIN<0> -#net PPORT_d<3> loc=P14 | IOSTANDARD = LVCMOS33 ; # FLASH_A<11> / PPORT_DIN<1> -#net PPORT_d<4> loc=P13 | IOSTANDARD = LVCMOS33 ; # FLASH_A<12> / PPORT_DIN<2> -#net PPORT_d<5> loc=N12 | IOSTANDARD = LVCMOS33 ; # FLASH_A<13> / PPORT_DIN<3> -##net PPORT_d<6> loc=T14 | IOSTANDARD = LVCMOS33 ; # FLASH_A<14> -##net PPORT_d<7> loc=R13 | IOSTANDARD = LVCMOS33 ; # FLASH_A<15> -# -#net PPORT_s<3> loc=N5 | IOSTANDARD = LVCMOS33 ; # FLASH_A<0> / PPORT_DOUT<0> -#net PPORT_s<4> loc=K14 | IOSTANDARD = LVCMOS33 ; # FLASH_A<1> / PPORT_DOUT<1> -#net PPORT_s<5> loc=K13 | IOSTANDARD = LVCMOS33 ; # FLASH_A<2> / PPORT_DOUT<2> -#net PPORT_s<6> loc=T10 | IOSTANDARD = LVCMOS33 ; # / PPORT_DOUT<3> -# -######################################################## -# -# XST3.0 pins -# -######################################################## -# -# BAR LED -# -#net BAR<1> loc=L5 | IOSTANDARD = LVCMOS33 ; # bar led 1, PB_A0 -#net BAR<2> loc=N2 | IOSTANDARD = LVCMOS33 ; # bar led 2, PB_A1 -#net BAR<3> loc=M3 | IOSTANDARD = LVCMOS33 ; # bar led 3, PB_A2 -#net BAR<4> loc=N1 | IOSTANDARD = LVCMOS33 ; # bar led 4, PB_A3 -#net BAR<5> loc=T13 | IOSTANDARD = LVCMOS33 ; # bar led 5, PB_A4 -#net BAR<6> loc=L15 | IOSTANDARD = LVCMOS33 ; # bar led 6, ETHER_IRQ -#net BAR<7> loc=J13 | IOSTANDARD = LVCMOS33 ; # bar led 7, USB_IRQ_N -#net BAR<8> loc=H15 | IOSTANDARD = LVCMOS33 ; # bar led 8, IDE_IRQ -#net BAR<9> loc=J16 | IOSTANDARD = LVCMOS33 ; # bar led 9, SLOT1_IRQ -#net BAR<10> loc=J14 | IOSTANDARD = LVCMOS33 ; # bar led 10, SLOT2_IRQ -# -# Push Buttons -# -#net PB1_N loc=H4 | IOSTANDARD = LVCMOS33 ; # Shared with PB_D15 -#net PB2_N loc=L5 | IOSTANDARD = LVCMOS33 ; # Shared with BAR1, PB_A0 -#net PB3_N loc=N2 | IOSTANDARD = LVCMOS33 ; # Shared with BAR2, PB_A1 -#net PB4_N loc=M3 | IOSTANDARD = LVCMOS33 ; # Shared with BAR3, PB_A2 -# -# RS232 PORT -# -net RS232_TXD loc=J2 | IOSTANDARD = LVCMOS33 ; # RS232 TD pin 3 -#net RS232_RXD loc=G5 | IOSTANDARD = LVCMOS33 ; # RS232 RD pin 2 -#net RS232_CTS loc=D1 | IOSTANDARD = LVCMOS33 ; # RS232 CTS -#net RS232_RTS loc=F4 | IOSTANDARD = LVCMOS33 ; # RS232 RTS -# -# 16 Bit Peripheral Bus -# -# 5-bit Peripheral address bus -net PB_A<0> loc=L5 | IOSTANDARD = LVCMOS33 ; # Shared with BAR1, PB2 -net PB_A<1> loc=N2 | IOSTANDARD = LVCMOS33 ; # Shared with BAR2, PB3 -net PB_A<2> loc=M3 | IOSTANDARD = LVCMOS33 ; # Shared with BAR3, PB4 -net PB_A<3> loc=N1 | IOSTANDARD = LVCMOS33 ; # Shared with BAR4 -net PB_A<4> loc=T13 | IOSTANDARD = LVCMOS33 ; # Shared with BAR5 -# 16-bit peripheral data bus -net PB_D<0> loc=P12 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW1 -net PB_D<1> loc=J1 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW2 -net PB_D<2> loc=H1 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW3 -net PB_D<3> loc=H3 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW4 -net PB_D<4> loc=G2 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW5 -net PB_D<5> loc=K15 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW6 -net PB_D<6> loc=K16 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW7 -net PB_D<7> loc=F15 | IOSTANDARD = LVCMOS33 ; # Shared with DIPSW8 -net PB_D<8> loc=E2 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_A -net PB_D<9> loc=E1 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_B -net PB_D<10> loc=F3 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_C -net PB_D<11> loc=F2 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_D -net PB_D<12> loc=G4 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_E -net PB_D<13> loc=G3 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_F -net PB_D<14> loc=G1 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_G -net PB_D<15> loc=H4 | IOSTANDARD = LVCMOS33 ; # Shared with LED2_DP, PB1 -net PB_RD_N loc=P2 | IOSTANDARD = LVCMOS33 ; # disk I/O read control -net PB_WR_N loc=R1 | IOSTANDARD = LVCMOS33 ; # disk I/O write control -net RESET_TRIGGER loc=D15 | IOSTANDARD = LVCMOS33 ; # Reset RESET_TRIGGER# -# -# IDE Interface -# -#net IDE_CS0_N loc=G15 | IOSTANDARD = LVCMOS33 ; # disk register-bank select -#net IDE_CS1_N loc=G14 | IOSTANDARD = LVCMOS33 ; # disk register-bank select -#net IDE_DMACK_N loc=K1 | IOSTANDARD = LVCMOS33 ; # (out) IDE DMA acknowledge -#net IDE_DMARQ loc=L4 | IOSTANDARD = LVCMOS33 ; # (in) IDE DMA request -#net IDE_IORDY loc=L2 | IOSTANDARD = LVCMOS33 ; # (in) IDE IO ready -#net IDE_IRQ loc=H15 | IOSTANDARD = LVCMOS33 ; # (in) IDE interrupt # shared with BAR8 -# -# Ethernet Controller -# Disable if not used -# -net ether_cs_n loc=G13 | IOSTANDARD = LVCMOS33 ; # (out)Ethernet chip-enable -net ether_aen loc=E14 | IOSTANDARD = LVCMOS33 ; # (out) Ethernet address enable not -net ether_bhe_n loc=J3 | IOSTANDARD = LVCMOS33 ; # (out) Ethernet bus high enable -net ether_clk loc=R9 | IOSTANDARD = LVCMOS33 ; # (in) Ethernet clock -net ether_irq loc=L15 | IOSTANDARD = LVCMOS33 ; # (in) Ethernet irq - Shared with BAR6 -net ether_rdy loc=M2 | IOSTANDARD = LVCMOS33 ; # (in) Ethernet ready -# -# Expansion slots -# -#net slot1_cs_n loc=E15 | IOSTANDARD = LVCMOS33 ; # (out) -#net slot1_irq loc=J16 | IOSTANDARD = LVCMOS33 ; # (in) Shared with BAR9 -#net slot2_cs_n loc=D16 | IOSTANDARD = LVCMOS33 ; # (out) -#net slot2_irq loc=J14 | IOSTANDARD = LVCMOS33 ; # (in) Shared with BAR10 -# -# Audio codec -# -#net audio_lrck loc=R12 | IOSTANDARD = LVCMOS33 ; # (out) -#net audio_mclk loc=P11 | IOSTANDARD = LVCMOS33 ; # (out) -#net audio_sclk loc=T12 | IOSTANDARD = LVCMOS33 ; # (out) -#net audio_sdti loc=M10 | IOSTANDARD = LVCMOS33 ; # (out) -#net audio_sdto loc=K5 | IOSTANDARD = LVCMOS33 ; # (in) -# -# i2c -# -#net i2c_scl loc=F5 | IOSTANDARD = LVCMOS33 ; #(out) -#net i2c_sda loc=D2 | IOSTANDARD = LVCMOS33 ; # (in/out) -# -# USB -# -#NET USB_CLK LOC=M1 | IOSTANDARD = LVCMOS33 ; # (IN) -#NET USB_IRQ_N LOC=J13 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with BAR7 -#NET USB_SUSPEND LOC=l3 | IOSTANDARD = LVCMOS33 ; # (IN) -# -# VIDEO DIGITIZER -# -#NET VIDIN_AVID LOC= | IOSTANDARD = LVCMOS33 ; # (IN) -#NET VIDIN_CLK LOC=H16 | IOSTANDARD = LVCMOS33 ; # (IN) -#NET VIDIN_FID LOC= | IOSTANDARD = LVCMOS33 ; # (IN) -#NET VIDIN_HSYNC LOC= | IOSTANDARD = LVCMOS33 ; # (IN) -#NET VIDIN_IRQ LOC= | IOSTANDARD = LVCMOS33 ; # (IN) -#NET VIDIN_VSYNC LOC= | IOSTANDARD = LVCMOS33 ; # (IN) -#NET VIDIN_Y<0> LOC=H14 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_A -#NET VIDIN_Y<1> LOC=M4 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_B -#NET VIDIN_Y<2> LOC=P1 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_C -#NET VIDIN_Y<3> LOC=N3 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_D -#NET VIDIN_Y<4> LOC=M15 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_E -#NET VIDIN_Y<5> LOC=H13 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_F -#NET VIDIN_Y<6> LOC=G16 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_G -#NET VIDIN_Y<7> LOC=N15 | IOSTANDARD = LVCMOS33 ; # (IN) Shared with LED1_DP -# -# Timing Constraints -# -NET "CLKA" TNM_NET="CLKA"; -TIMESPEC "TS_clk"=PERIOD "CLKA" 10 ns HIGH 50 %; diff --git a/j1demo/synth/xilinx.mk b/j1demo/synth/xilinx.mk deleted file mode 100644 index c692fe7..0000000 --- a/j1demo/synth/xilinx.mk +++ /dev/null @@ -1,174 +0,0 @@ -# The top level module should define the variables below then include -# this file. The files listed should be in the same directory as the -# Makefile. -# -# variable description -# ---------- ------------- -# project project name (top level module should match this name) -# top_module top level module of the project -# libdir path to library directory -# libs library modules used -# vfiles all local .v files -# xilinx_cores all local .xco files -# vendor vendor of FPGA (xilinx, altera, etc.) -# family FPGA device family (spartan3e) -# part FPGA part name (xc4vfx12-10-sf363) -# flashsize size of flash for mcs file (16384) -# optfile (optional) xst extra opttions file to put in .scr -# map_opts (optional) options to give to map -# par_opts (optional) options to give to par -# intstyle (optional) intstyle option to all tools -# -# files description -# ---------- ------------ -# $(project).ucf ucf file -# -# Library modules should have a modules.mk in their root directory, -# namely $(libdir)//module.mk, that simply adds to the vfiles -# and xilinx_cores variable. -# -# all the .xco files listed in xilinx_cores will be generated with core, with -# the resulting .v and .ngc files placed back in the same directory as -# the .xco file. -# -# TODO: .xco files are device dependant, should use a template based system - -coregen_work_dir ?= ./coregen-tmp -map_opts ?= -timing -ol high -detail -pr b -register_duplication -w -par_opts ?= -ol high -isedir ?= /opt/Xilinx/11.1/ISE -xil_env ?= . $(isedir)/settings32.sh -flashsize ?= 8192 - -libmks = $(patsubst %,$(libdir)/%/module.mk,$(libs)) -mkfiles = Makefile $(libmks) xilinx.mk -include $(libmks) - -corengcs = $(foreach core,$(xilinx_cores),$(core:.xco=.ngc)) -local_corengcs = $(foreach ngc,$(corengcs),$(notdir $(ngc))) -vfiles += $(foreach core,$(xilinx_cores),$(core:.xco=.v)) -junk += $(local_corengcs) - -.PHONY: default xilinx_cores clean twr etwr -default: $(project).bit $(project).mcs -xilinx_cores: $(corengcs) -twr: $(project).twr -etwr: $(project)_err.twr - -define cp_template -$(2): $(1) - cp $(1) $(2) -endef -$(foreach ngc,$(corengcs),$(eval $(call cp_template,$(ngc),$(notdir $(ngc))))) - -%.ngc %.v: %.xco - @echo "=== rebuilding $@" - if [ -d $(coregen_work_dir) ]; then \ - rm -rf $(coregen_work_dir)/*; \ - else \ - mkdir -p $(coregen_work_dir); \ - fi - cd $(coregen_work_dir); \ - $(xil_env); \ - coregen -b $$OLDPWD/$<; \ - cd - - xcodir=`dirname $<`; \ - basename=`basename $< .xco`; \ - if [ ! -r $(coregen_work_dir/$$basename.ngc) ]; then \ - echo "'$@' wasn't created."; \ - exit 1; \ - else \ - cp $(coregen_work_dir)/$$basename.v $(coregen_work_dir)/$$basename.ngc $$xcodir; \ - fi -junk += $(coregen_work_dir) - -date = $(shell date +%F-%H-%M) - -# some common junk -junk += *.xrpt - -programming_files: $(project).bit $(project).mcs - mkdir -p $@/$(date) - mkdir -p $@/latest - for x in .bit .mcs .cfi _bd.bmm; do cp $(project)$$x $@/$(date)/$(project)$$x; cp $(project)$$x $@/latest/$(project)$$x; done - $(xil_env); xst -help | head -1 | sed 's/^/#/' | cat - $(project).scr > $@/$(date)/$(project).scr - -$(project).mcs: $(project).bit - $(xil_env); \ - promgen -w -s $(flashsize) -p mcs -o $@ -u 0 $^ -junk += $(project).mcs $(project).cfi $(project).prm - -$(project).bit: $(project)_par.ncd - $(xil_env); \ - bitgen $(intstyle) -g DriveDone:yes -g StartupClk:Cclk -w $(project)_par.ncd $(project).bit -junk += $(project).bgn $(project).bit $(project).drc $(project)_bd.bmm - - -$(project)_par.ncd: $(project).ncd - $(xil_env); \ - if par $(intstyle) $(par_opts) -w $(project).ncd $(project)_par.ncd; then \ - :; \ - else \ - $(MAKE) etwr; \ - fi -junk += $(project)_par.ncd $(project)_par.par $(project)_par.pad -junk += $(project)_par_pad.csv $(project)_par_pad.txt -junk += $(project)_par.grf $(project)_par.ptwx -junk += $(project)_par.unroutes $(project)_par.xpi - -$(project).ncd: $(project).ngd - if [ -r $(project)_par.ncd ]; then \ - cp $(project)_par.ncd smartguide.ncd; \ - smartguide="-smartguide smartguide.ncd"; \ - else \ - smartguide=""; \ - fi; \ - $(xil_env); \ - map $(intstyle) $(map_opts) $$smartguide $< -junk += $(project).ncd $(project).pcf $(project).ngm $(project).mrp $(project).map -junk += smartguide.ncd $(project).psr -junk += $(project)_summary.xml $(project)_usage.xml - -$(project).ngd: $(project).ngc $(project).ucf $(project).bmm - $(xil_env); ngdbuild $(intstyle) $(project).ngc -bm $(project).bmm -junk += $(project).ngd $(project).bld - -$(project).ngc: $(vfiles) $(local_corengcs) $(project).scr $(project).prj - $(xil_env); xst $(intstyle) -ifn $(project).scr -junk += xlnx_auto* $(top_module).lso $(project).srp -junk += netlist.lst xst $(project).ngc - -$(project).prj: $(vfiles) $(mkfiles) - for src in $(vfiles); do echo "verilog work $$src" >> $(project).tmpprj; done - sort -u $(project).tmpprj > $(project).prj - rm -f $(project).tmpprj -junk += $(project).prj - -optfile += $(wildcard $(project).opt) -top_module ?= $(project) -$(project).scr: $(optfile) $(mkfiles) ./xilinx.opt - echo "run" > $@ - echo "-p $(part)" >> $@ - echo "-top $(top_module)" >> $@ - echo "-ifn $(project).prj" >> $@ - echo "-ofn $(project).ngc" >> $@ - cat ./xilinx.opt $(optfile) >> $@ -junk += $(project).scr - -$(project).post_map.twr: $(project).ncd - $(xil_env); trce -e 10 $< $(project).pcf -o $@ -junk += $(project).post_map.twr $(project).post_map.twx smartpreview.twr - -$(project).twr: $(project)_par.ncd - $(xil_env); trce $< $(project).pcf -o $(project).twr -junk += $(project).twr $(project).twx smartpreview.twr - -$(project)_err.twr: $(project)_par.ncd - $(xil_env); trce -e 10 $< $(project).pcf -o $(project)_err.twr -junk += $(project)_err.twr $(project)_err.twx - -.gitignore: $(mkfiles) - echo programming_files $(junk) | sed 's, ,\n,g' > .gitignore - -clean:: - rm -rf $(junk) diff --git a/j1demo/synth/xilinx.opt b/j1demo/synth/xilinx.opt deleted file mode 100644 index 7fe9d8b..0000000 --- a/j1demo/synth/xilinx.opt +++ /dev/null @@ -1,42 +0,0 @@ --ifmt mixed --ofmt NGC --opt_mode speed --opt_level 1 --iuc NO --keep_hierarchy no --netlist_hierarchy as_optimized --rtlview no --glob_opt AllClockNets --read_cores yes --write_timing_constraints NO --cross_clock_analysis NO --hierarchy_separator / --bus_delimiter <> --case maintain --slice_utilization_ratio 100 --bram_utilization_ratio 100 -#-dsp_utilization_ratio 100 --safe_implementation No --fsm_extract YES --fsm_encoding Auto --fsm_style lut --ram_extract Yes --ram_style Auto --rom_extract Yes --rom_style Auto --shreg_extract YES --auto_bram_packing NO --resource_sharing YES --async_to_sync NO -#-use_dsp48 auto --iobuf YES --max_fanout 500 --register_duplication YES --register_balancing No --optimize_primitives NO --use_clock_enable Auto --use_sync_set Auto --use_sync_reset Auto --iob auto --equivalent_register_removal YES --slice_utilization_ratio_maxmargin 5 diff --git a/j1demo/verilog/ck_div.v b/j1demo/verilog/ck_div.v deleted file mode 100644 index a753804..0000000 --- a/j1demo/verilog/ck_div.v +++ /dev/null @@ -1,41 +0,0 @@ -module ck_div( -input ck_in, -output ck_out, -input sys_rst_i -//output locked; -); -parameter DIV_BY = 1; -parameter MULT_BY = 1; - -wire ck_fb; - -//DCM #( -// .CLKDV_DIVIDE(DIV_BY), -// .DFS_FREQUENCY_MODE("LOW"), // HIGH or LOW frequency mode for frequency synthesis -// .DUTY_CYCLE_CORRECTION("TRUE"), // Duty cycle correction, TRUE or FALSE -// .STARTUP_WAIT("TRUE") // Delay configuration DONE until DCM LOCK, TRUE/FALSE -//) DCM_inst ( -// .CLK0(ck_fb), -// .CLKDV(ck_out), -// .CLKFB(ck_fb), // DCM clock feedback -// .CLKIN(ck_in), // Clock input (from IBUFG, BUFG or DCM) -// .RST(0) -//); - -DCM #( - .CLKFX_MULTIPLY(MULT_BY), - .CLKFX_DIVIDE(DIV_BY), - .DFS_FREQUENCY_MODE("LOW"), // HIGH or LOW frequency mode for frequency synthesis - .DUTY_CYCLE_CORRECTION("TRUE"), // Duty cycle correction, TRUE or FALSE - .STARTUP_WAIT("TRUE") // Delay configuration DONE until DCM LOCK, TRUE/FALSE -) DCM_inst ( - .CLK0(ck_fb), - .CLKFX(ck_out), - .CLKFB(ck_fb), // DCM clock feedback - .CLKIN(ck_in), // Clock input (from IBUFG, BUFG or DCM) - .RST(0) -); - -//BUFG BUFG_inst(.I(ck_int), .O(ck_out)); - -endmodule diff --git a/j1demo/verilog/j1.v b/j1demo/verilog/j1.v deleted file mode 100644 index 861cb3c..0000000 --- a/j1demo/verilog/j1.v +++ /dev/null @@ -1,187 +0,0 @@ -module j1( - input sys_clk_i, input sys_rst_i, input [15:0] io_din, - output io_rd, output io_wr, output [15:0] io_addr, output [15:0] io_dout); - - wire [15:0] insn; - wire [15:0] immediate = { 1'b0, insn[14:0] }; - - wire [15:0] ramrd; - - reg [4:0] dsp; // Data stack pointer - reg [4:0] _dsp; - reg [15:0] st0; // Return stack pointer - reg [15:0] _st0; - wire _dstkW; // D stack write - - reg [12:0] pc; - reg [12:0] _pc; - reg [4:0] rsp; - reg [4:0] _rsp; - reg _rstkW; // R stack write - reg [15:0] _rstkD; - wire _ramWE; // RAM write enable - - wire [15:0] pc_plus_1; - assign pc_plus_1 = pc + 1; - - // The D and R stacks - reg [15:0] dstack[0:31]; - reg [15:0] rstack[0:31]; - always @(posedge sys_clk_i) - begin - if (_dstkW) - dstack[_dsp] = st0; - if (_rstkW) - rstack[_rsp] = _rstkD; - end - wire [15:0] st1 = dstack[dsp]; - wire [15:0] rst0 = rstack[rsp]; - - // st0sel is the ALU operation. For branch and call the operation - // is T, for 0branch it is N. For ALU ops it is loaded from the instruction - // field. - reg [3:0] st0sel; - always @* - begin - case (insn[14:13]) - 2'b00: st0sel = 0; // ubranch - 2'b10: st0sel = 0; // call - 2'b01: st0sel = 1; // 0branch - 2'b11: st0sel = insn[11:8]; // ALU - default: st0sel = 4'bxxxx; - endcase - end - -`define RAMS 3 - - genvar i; - -`define w (16 >> `RAMS) -`define w1 (`w - 1) - - generate - for (i = 0; i < (1 << `RAMS); i=i+1) begin : ram - // RAMB16_S18_S18 - RAMB16_S2_S2 - ram( - .DIA(0), - // .DIPA(0), - .DOA(insn[`w*i+`w1:`w*i]), - .WEA(0), - .ENA(1), - .CLKA(sys_clk_i), - .ADDRA({_pc}), - - .DIB(st1[`w*i+`w1:`w*i]), - // .DIPB(2'b0), - .WEB(_ramWE & (_st0[15:14] == 0)), - .ENB(|_st0[15:14] == 0), - .CLKB(sys_clk_i), - .ADDRB(_st0[15:1]), - .DOB(ramrd[`w*i+`w1:`w*i])); - end - endgenerate - - // Compute the new value of T. - always @* - begin - if (insn[15]) - _st0 = immediate; - else - case (st0sel) - 4'b0000: _st0 = st0; - 4'b0001: _st0 = st1; - 4'b0010: _st0 = st0 + st1; - 4'b0011: _st0 = st0 & st1; - 4'b0100: _st0 = st0 | st1; - 4'b0101: _st0 = st0 ^ st1; - 4'b0110: _st0 = ~st0; - 4'b0111: _st0 = {16{(st1 == st0)}}; - 4'b1000: _st0 = {16{($signed(st1) < $signed(st0))}}; - 4'b1001: _st0 = st1 >> st0[3:0]; - 4'b1010: _st0 = st0 - 1; - 4'b1011: _st0 = rst0; - 4'b1100: _st0 = |st0[15:14] ? io_din : ramrd; - 4'b1101: _st0 = st1 << st0[3:0]; - 4'b1110: _st0 = {rsp, 3'b000, dsp}; - 4'b1111: _st0 = {16{(st1 < st0)}}; - default: _st0 = 16'hxxxx; - endcase - end - - wire is_alu = (insn[15:13] == 3'b011); - wire is_lit = (insn[15]); - - assign io_rd = (is_alu & (insn[11:8] == 4'hc)); - assign io_wr = _ramWE; - assign io_addr = st0; - assign io_dout = st1; - - assign _ramWE = is_alu & insn[5]; - assign _dstkW = is_lit | (is_alu & insn[7]); - - wire [1:0] dd = insn[1:0]; // D stack delta - wire [1:0] rd = insn[3:2]; // R stack delta - - always @* - begin - if (is_lit) begin // literal - _dsp = dsp + 1; - _rsp = rsp; - _rstkW = 0; - _rstkD = _pc; - end else if (is_alu) begin - _dsp = dsp + {dd[1], dd[1], dd[1], dd}; - _rsp = rsp + {rd[1], rd[1], rd[1], rd}; - _rstkW = insn[6]; - _rstkD = st0; - end else begin // jump/call - // predicated jump is like DROP - if (insn[15:13] == 3'b001) begin - _dsp = dsp - 1; - end else begin - _dsp = dsp; - end - if (insn[15:13] == 3'b010) begin // call - _rsp = rsp + 1; - _rstkW = 1; - _rstkD = {pc_plus_1[14:0], 1'b0}; - end else begin - _rsp = rsp; - _rstkW = 0; - _rstkD = _pc; - end - end - end - - always @* - begin - if (sys_rst_i) - _pc = pc; - else - if ((insn[15:13] == 3'b000) | - ((insn[15:13] == 3'b001) & (|st0 == 0)) | - (insn[15:13] == 3'b010)) - _pc = insn[12:0]; - else if (is_alu & insn[12]) - _pc = rst0[15:1]; - else - _pc = pc_plus_1; - end - - always @(posedge sys_clk_i) - begin - if (sys_rst_i) begin - pc <= 0; - dsp <= 0; - st0 <= 0; - rsp <= 0; - end else begin - dsp <= _dsp; - pc <= _pc; - st0 <= _st0; - rsp <= _rsp; - end - end - -endmodule // j1 diff --git a/j1demo/verilog/rams.v b/j1demo/verilog/rams.v deleted file mode 100644 index 620a831..0000000 --- a/j1demo/verilog/rams.v +++ /dev/null @@ -1,36 +0,0 @@ -module ram8_8( - input [7:0] dia, - output [7:0] doa, - input wea, - input ena, - input clka, - input [10:0] addra, - - input [7:0] dib, - output [7:0] dob, - input web, - input enb, - input clkb, - input [10:0] addrb - ); -genvar i; -generate - for (i = 0; i < 4; i=i+1) begin : ramx - RAMB16_S2_S2 ramx( - .DIA(dia[2 * i + 1: 2 * i]), - .WEA(wea), - .ENA(ena), - .CLKA(clka), - .ADDRA(addra), - .DOA(doa[2 * i + 1: 2 * i]), - - .DIB(dib[2 * i + 1: 2 * i]), - .WEB(web), - .ENB(enb), - .CLKB(clkb), - .ADDRB(addrb), - .DOB(dob[2 * i + 1: 2 * i]) - ); - end -endgenerate -endmodule diff --git a/j1demo/verilog/top.v b/j1demo/verilog/top.v deleted file mode 100644 index 9c21431..0000000 --- a/j1demo/verilog/top.v +++ /dev/null @@ -1,667 +0,0 @@ -module bidir_io( - input dir, - input d, - inout port); - assign port = (dir) ? 1'bz : d; -endmodule - -module saturating_adder( - input [7:0] a, - input [7:0] b, - input [7:0] c, - input [7:0] d, - input [7:0] e, - input [7:0] f, - input [7:0] g, - input [7:0] h, - input [7:0] i, - output [7:0] sum); - -wire [10:0] fullsum = a + b + c + d + e + f + g + h + i; -assign sum = |fullsum[10:8] ? 255 : fullsum[7:0]; -endmodule - -module partial( - input [7:0] original, - input alpha, - input [2:0] scale, // by quarters - output [7:0] result -); -assign result = alpha ? ((scale[0] ? original[7:2] : 0) + - (scale[1] ? original[7:1] : 0) + - (scale[2] ? original : 0)) : 0; -endmodule - -module lfsre( - input clk, - output reg [16:0] lfsr); -wire d0; - -xnor(d0,lfsr[16],lfsr[13]); - -always @(posedge clk) begin - lfsr <= {lfsr[15:0],d0}; -end -endmodule - -module sprite( - pixel_clk, - picsel, - pixel_x, - pixel_y, - sx, sy, - write_data, write_address, write_en, write_clk, - brightness, - alpha -); - input pixel_clk; - input picsel; - input [9:0] pixel_x; - input [9:0] pixel_y; - input [9:0] sx; - input [9:0] sy; - input [8:0] write_data; - input [11:0] write_address; - input write_en; - input write_clk; - - output alpha; - output [7:0] brightness; - - wire [9:0] local_x = pixel_x - sx; - wire [9:0] local_y = pixel_y - sy; - wire [7:0] sprite_pixel; - RAMB16_S9_S9 spriteram( - .DIA(0), - // .DIPA(0), - .DOA(sprite_pixel), - .WEA(0), - .ENA(1), - .CLKA(pixel_clk), - .ADDRA({picsel, local_y[4:0], local_x[4:0]}), - - .ADDRB(write_address), - .DIPB(write_data[8]), - .DIB(write_data), - .WEB(write_en), - .ENB(1), - .CLKB(write_clk), - .DOB()); - wire sprite_outside = |(local_y[9:5]) | |(local_x[9:5]); - wire alpha = ~sprite_outside; - wire [7:0] brightness = sprite_pixel; // sprite_outside ? 0 : sprite_pixel; -endmodule - -module top( - // Outputs - // s, // Onboard LED - RS232_TXD, // RS232 transmit - RESET_TRIGGER, // RESET-TRIGGER# - - // Inputs - clka, - - pb_a, pb_d, pb_rd_n, pb_wr_n, - - ether_cs_n, ether_aen, ether_bhe_n, ether_clk, ether_irq, ether_rdy, - - // Flash - flash_a, flash_d, - flash_ce_n, flash_oe_n, flash_we_n, flash_byte_n, flash_rdy, flash_rst_n, - - // PS/2 Keyboard - ps2_clk, ps2_dat, - - // Pushbuttons - sw2_n, sw3_n, - - // VGA - vga_red, vga_green, vga_blue, vga_hsync_n, vga_vsync_n, - - ); - - // output [7:0] s; - output RS232_TXD; - output RESET_TRIGGER; - inout [4:0] pb_a; - output ether_cs_n; - output ether_aen; - output ether_bhe_n; - output pb_rd_n; - output pb_wr_n; - - input clka; - input ether_clk; - input ether_irq; - input ether_rdy; - - inout [15:0] pb_d; - - output [19:0] flash_a; - - inout [15:0] flash_d; - - output flash_ce_n; - output flash_oe_n; - output flash_we_n; - output flash_byte_n; - output flash_rdy; - output flash_rst_n; - - reg ps2_clk_dir; - reg ps2_dat_dir; - reg ps2_clk_d; - reg ps2_dat_d; - inout ps2_clk; - inout ps2_dat; - bidir_io ps2_clkb(.dir(ps2_clk_dir), .d(ps2_clk_d), .port(ps2_clk)); - bidir_io ps2_datb(.dir(ps2_dat_dir), .d(ps2_dat_d), .port(ps2_dat)); - - input sw2_n; - input sw3_n; - - output [2:0] vga_red; - output [2:0] vga_green; - output [2:0] vga_blue; - output vga_hsync_n; - output vga_vsync_n; - - wire j1_io_rd; - wire j1_io_wr; - wire [15:0] j1_io_addr; - reg [15:0] j1_io_din; - wire [15:0] j1_io_dout; - - wire sys_clk; - ck_div #(.DIV_BY(12), .MULT_BY(4)) sys_ck_gen(.ck_in(clka), .ck_out(sys_clk)); - - // ================================================ - // Hardware multiplier - - reg [15:0] mult_a; - reg [15:0] mult_b; - wire [31:0] mult_p; - MULT18X18 mulinsn(.A(mult_a), .B(mult_b), .P(mult_p)); -// MULT18X18SIO #( -// .AREG(0), -// .BREG(0), -// .PREG(0)) -// MULT18X18SIO( -// .A(mult_a), -// .B(mult_b), -// .P(mult_p)); - - // ================================================ - // 32-bit 1-MHz system clock - - reg [5:0] clockus; - wire [5:0] _clockus = (clockus == 32) ? 0 : (clockus + 1); - reg [31:0] clock; - wire [31:0] _clock = (clockus == 32) ? (clock + 1) : (clock); - - always @(posedge sys_clk) - begin - clockus <= _clockus; - clock <= _clock; - end - - // reg [7:0] s; - reg RS232_TXD; - reg RESET_TRIGGER; - - reg ether_cs_n; - reg ether_aen; - reg ether_bhe_n; - reg ddir; - - reg [15:0] pb_dout; - assign pb_d = (ddir) ? 16'bz : pb_dout; - reg pb_rd_n; - reg pb_wr_n; - - reg pb_a_dir; - reg [4:0] pb_aout; - assign pb_a = pb_a_dir ? 5'bz : pb_aout; - - reg flash_ddir; - reg [19:0] flash_a; - reg [15:0] flash_dout; - assign flash_d[14:0] = (flash_ddir) ? 15'bz : flash_dout[14:0]; - assign flash_d[15] = (flash_ddir & flash_byte_n) ? 1'bz : flash_dout[15]; - reg flash_ce_n; - reg flash_oe_n; - reg flash_we_n; - reg flash_byte_n; - reg flash_rdy; - reg flash_rst_n; - - reg [12:0] vga_scroll; - reg [13:0] vga_spritea; - reg [9:0] vga_spritex[7:0]; - reg [9:0] vga_spritey[7:0]; - reg vga_addsprites; - reg [10:0] vga_spritec0; - reg [10:0] vga_spritec1; - reg [10:0] vga_spritec2; - reg [10:0] vga_spritec3; - reg [10:0] vga_spritec4; - reg [10:0] vga_spritec5; - reg [10:0] vga_spritec6; - reg [10:0] vga_spritec7; - wire [9:0] vga_line; - reg [7:0] vga_spritesel; - - always @(posedge sys_clk) - begin - if (j1_io_wr) begin - case (j1_io_addr) - // 16'h4000: s <= j1_io_dout; - - 16'h4100: flash_ddir <= j1_io_dout; - 16'h4102: flash_ce_n <= j1_io_dout; - 16'h4104: flash_oe_n <= j1_io_dout; - 16'h4106: flash_we_n <= j1_io_dout; - 16'h4108: flash_byte_n <= j1_io_dout; - 16'h410a: flash_rdy <= j1_io_dout; - 16'h410c: flash_rst_n <= j1_io_dout; - 16'h410e: flash_a[15:0] <= j1_io_dout; - 16'h4110: flash_a[19:16] <= j1_io_dout; - 16'h4112: flash_dout <= j1_io_dout; - - 16'h4200: ps2_clk_d <= j1_io_dout; - 16'h4202: ps2_dat_d <= j1_io_dout; - 16'h4204: ps2_clk_dir <= j1_io_dout; - 16'h4206: ps2_dat_dir <= j1_io_dout; - - 16'h4300: vga_scroll <= j1_io_dout; - 16'h4302: vga_spritea <= j1_io_dout; - // 16'h4304: vga_spriteport - 16'h4308: vga_addsprites <= j1_io_dout; - - 16'h4400: vga_spritex[0] <= j1_io_dout; - 16'h4402: vga_spritey[0] <= j1_io_dout; - 16'h4404: vga_spritex[1] <= j1_io_dout; - 16'h4406: vga_spritey[1] <= j1_io_dout; - 16'h4408: vga_spritex[2] <= j1_io_dout; - 16'h440a: vga_spritey[2] <= j1_io_dout; - 16'h440c: vga_spritex[3] <= j1_io_dout; - 16'h440e: vga_spritey[3] <= j1_io_dout; - 16'h4410: vga_spritex[4] <= j1_io_dout; - 16'h4412: vga_spritey[4] <= j1_io_dout; - 16'h4414: vga_spritex[5] <= j1_io_dout; - 16'h4416: vga_spritey[5] <= j1_io_dout; - 16'h4418: vga_spritex[6] <= j1_io_dout; - 16'h441a: vga_spritey[6] <= j1_io_dout; - 16'h441c: vga_spritex[7] <= j1_io_dout; - 16'h441e: vga_spritey[7] <= j1_io_dout; - - 16'h4420: vga_spritec0 <= j1_io_dout; - 16'h4422: vga_spritec1 <= j1_io_dout; - 16'h4424: vga_spritec2 <= j1_io_dout; - 16'h4426: vga_spritec3 <= j1_io_dout; - 16'h4428: vga_spritec4 <= j1_io_dout; - 16'h442a: vga_spritec5 <= j1_io_dout; - 16'h442c: vga_spritec6 <= j1_io_dout; - 16'h442e: vga_spritec7 <= j1_io_dout; - - 16'h4430: vga_spritesel[0] <= j1_io_dout; - 16'h4432: vga_spritesel[1] <= j1_io_dout; - 16'h4434: vga_spritesel[2] <= j1_io_dout; - 16'h4436: vga_spritesel[3] <= j1_io_dout; - 16'h4438: vga_spritesel[4] <= j1_io_dout; - 16'h443a: vga_spritesel[5] <= j1_io_dout; - 16'h443c: vga_spritesel[6] <= j1_io_dout; - 16'h443e: vga_spritesel[7] <= j1_io_dout; - - 16'h5000: RS232_TXD <= j1_io_dout; - 16'h5001: RESET_TRIGGER <= j1_io_dout; - 16'h5100: ether_cs_n <= j1_io_dout; - 16'h5101: ether_aen <= j1_io_dout; - 16'h5102: ether_bhe_n <= j1_io_dout; - 16'h5103: pb_aout <= j1_io_dout; - 16'h5104: ddir <= j1_io_dout; - 16'h5105: pb_dout <= j1_io_dout; - 16'h5106: pb_rd_n <= j1_io_dout; - 16'h5107: pb_wr_n <= j1_io_dout; - // 5108 - // 5109 - 16'h510a: pb_a_dir <= j1_io_dout; - - 16'h6100: mult_a <= j1_io_dout; - 16'h6102: mult_b <= j1_io_dout; - - endcase - end - end - - always @* - begin - case (j1_io_addr) - 16'h4112: j1_io_din = flash_d; - - 16'h4200: j1_io_din = ps2_clk; - 16'h4202: j1_io_din = ps2_dat; - - 16'h4300: j1_io_din = vga_scroll; - 16'h4306: j1_io_din = vga_line; - - 16'h4500: j1_io_din = sw2_n; - 16'h4502: j1_io_din = sw3_n; - - 16'h5103: j1_io_din = pb_a; - 16'h5105: j1_io_din = pb_d; - 16'h5108: j1_io_din = ether_rdy; - 16'h5109: j1_io_din = ether_irq; - - 16'h6000: j1_io_din = clock[15:0]; - 16'h6002: j1_io_din = clock[31:16]; - - 16'h6104: j1_io_din = mult_p[15:0]; - 16'h6106: j1_io_din = mult_p[31:16]; - - default: j1_io_din = 16'h0946; - endcase - end - - reg [10:0] reset_count = 1000; - wire sys_rst_i = |reset_count; - - always @(posedge sys_clk) begin - if (sys_rst_i) - reset_count <= reset_count - 1; - end - - j1 j1( - // Inputs - .sys_clk_i (sys_clk), - .sys_rst_i (sys_rst_i), - - .io_rd(j1_io_rd), - .io_wr(j1_io_wr), - .io_addr(j1_io_addr), - .io_din(j1_io_din), - .io_dout(j1_io_dout) - ); - - /* - uart uart( - // Outputs - .uart_busy (uart_busy), - .uart_tx (RS232_TXD), - // Inputs - .uart_wr_i (j1_uart_we), - .uart_dat_i (j1_io_dout), - .sys_clk_i (sys_clk_i), - .sys_rst_i (sys_rst_i)); - */ - - // ================================================ - // VGA - - wire vga_clk; - ck_div #(.DIV_BY(4), .MULT_BY(2)) vga_ck_gen(.ck_in(clka), .ck_out(vga_clk)); - - reg [10:0] CounterX; - reg [9:0] CounterY; - wire CounterXmaxed = (CounterX==1040); - - always @(posedge vga_clk) - if(CounterXmaxed) - CounterX <= 0; - else - CounterX <= CounterX + 1; - - wire [9:0] _CounterY = (CounterY == 666) ? 0 : (CounterY + 1); - always @(posedge vga_clk) - if(CounterXmaxed) - CounterY <= _CounterY; - - reg vga_HS, vga_VS; - always @(posedge vga_clk) - begin - vga_HS <= (53 <= CounterX) & (CounterX < (53 + 120)); - vga_VS <= (35 <= CounterY) & (CounterY < (35 + 6)); - end - - // Character RAM is 2K - wire [10:0] xx = (CounterX - (53 + 120 + 61)); - wire [10:0] xx_1 = (CounterX - (53 + 120 + 61) + 1); - // standard timing, except (600-512)/2=44 at top and bottom - wire [10:0] yy = (CounterY - (35 + 6 + 21 + 44)); - wire [10:0] column = xx[10:1]; - wire [10:0] column_1 = xx_1[10:1]; - wire [10:0] row = yy[10:1]; - wire [7:0] glyph; - - wire [10:0] picaddr = {(row[7:3] + vga_scroll[4:0]), column_1[8:3]}; - -// genvar i; -// generate -// for (i = 0; i < 4; i=i+1) begin : picture -// RAMB16_S2_S2 picture( -// .DIA(0), -// // .DIPA(0), -// .DOA(glyph[2 * i + 1: 2 * i]), -// .WEA(0), -// .ENA(1), -// .CLKA(vga_clk), -// .ADDRA(spicaddr), -// -// // .DIPB(0), -// .DIB(j1_io_dout[2 * i + 1: 2 * i]), -// .WEB(j1_io_wr & (j1_io_addr[15:13] == 3'b100)), -// .ENB(1), -// .CLKB(sys_clk), -// .ADDRB(j1_io_addr), -// .DOB()); -// end -// endgenerate - -// RAMB16_S9_S9 picture( -// .DIA(0), -// // .DIPA(0), -// .DOA(glyph), -// .WEA(0), -// .ENA(1), -// .CLKA(vga_clk), -// .ADDRA(picaddr), -// -// .DIPB(0), -// .DIB(j1_io_dout), -// .WEB(j1_io_wr & (j1_io_addr[15:13] == 3'b100)), -// .ENB(1), -// .CLKB(sys_clk), -// .ADDRB(j1_io_addr), -// .DOB()); - wire pic_w = j1_io_wr & (j1_io_addr[15:13] == 3'b100); - ram8_8 picture( - .dia(0), .doa(glyph), .wea(0), .ena(1), .clka(vga_clk), .addra(picaddr), - .dib(j1_io_dout), .web(pic_w), .enb(1), .clkb(sys_clk), .addrb(j1_io_addr)); - - wire charout; - RAMB16_S1_S9 chars( - .DIA(0), - // .DIPA(0), - .DOA(charout), - .WEA(0), - .ENA(1), - .CLKA(vga_clk), - .ADDRA({glyph, row[2:0], ~column[2:0]}), - - .DIPB(0), - .DIB(j1_io_dout), - // .DIPB(2'b0), - .WEB(j1_io_wr & (j1_io_addr[15:12] == 4'hf)), - .ENB(1), - .CLKB(sys_clk), - .ADDRB(j1_io_addr), - .DOB()); - - reg [10:0] regxx; - always @(posedge vga_clk) - begin - regxx <= xx; - end - - wire [63:0] sprite_pixels; - wire [7:0] alpha; - genvar i; - generate - for (i = 0; i < 8; i=i+1) begin : sprite_n - sprite sprite_n( - .pixel_clk(vga_clk), - .picsel(vga_spritesel[i]), - .pixel_x(regxx), - .pixel_y(yy), - .sx(vga_spritex[i]), - .sy(vga_spritey[i]), - .write_data(j1_io_dout), - .write_address(vga_spritea), - .write_en(j1_io_wr & (j1_io_addr == 16'h4304) & (vga_spritea[13:11] == i)), - .write_clk(sys_clk), - .alpha(alpha[i]), - .brightness(sprite_pixels[8*i+7:8*i])); - end - endgenerate - - // wire [10:0] brightsum = bright[0] + bright[1] + bright[2] + bright[3] + bright[4] + bright[5] + bright[6] + bright[7]; - // wire [7:0] brightness = |brightsum[10:8] ? 255 : brightsum[7:0]; - // wire [7:0] final_bright = |alpha ? 255 : 0; - - // wire [7:0] final_bright = sprite_pixels[39:32]; - - wire [7:0] sprite0 = sprite_pixels[7:0]; - wire [7:0] sprite1 = sprite_pixels[15:8]; - wire [7:0] sprite2 = sprite_pixels[23:16]; - wire [7:0] sprite3 = sprite_pixels[31:24]; - wire [7:0] sprite4 = sprite_pixels[39:32]; - wire [7:0] sprite5 = sprite_pixels[47:40]; - wire [7:0] sprite6 = sprite_pixels[55:48]; - wire [7:0] sprite7 = sprite_pixels[63:56]; - - reg [10:0] fullsum; - reg [7:0] final_bright; - - wire [16:0] lfsr; - lfsre lfsr0( - .clk(vga_clk), - .lfsr(lfsr)); - wire [7:0] charout8 = {8{charout}}; - wire [7:0] dither = {lfsr[0], lfsr[4], lfsr[8], lfsr[12], lfsr[16]} | charout8; - - wire [7:0] r0; - wire [7:0] r1; - wire [7:0] r2; - wire [7:0] r3; - wire [7:0] r4; - wire [7:0] r5; - wire [7:0] r6; - wire [7:0] r7; - wire [7:0] g0; - wire [7:0] g1; - wire [7:0] g2; - wire [7:0] g3; - wire [7:0] g4; - wire [7:0] g5; - wire [7:0] g6; - wire [7:0] g7; - wire [7:0] b0; - wire [7:0] b1; - wire [7:0] b2; - wire [7:0] b3; - wire [7:0] b4; - wire [7:0] b5; - wire [7:0] b6; - wire [7:0] b7; - - wire [2:0] spr0r = vga_spritec0[10:8]; - wire [2:0] spr1r = vga_spritec1[10:8]; - wire [2:0] spr2r = vga_spritec2[10:8]; - wire [2:0] spr3r = vga_spritec3[10:8]; - wire [2:0] spr4r = vga_spritec4[10:8]; - wire [2:0] spr5r = vga_spritec5[10:8]; - wire [2:0] spr6r = vga_spritec6[10:8]; - wire [2:0] spr7r = vga_spritec7[10:8]; - wire [2:0] spr0g = vga_spritec0[6:4]; - wire [2:0] spr1g = vga_spritec1[6:4]; - wire [2:0] spr2g = vga_spritec2[6:4]; - wire [2:0] spr3g = vga_spritec3[6:4]; - wire [2:0] spr4g = vga_spritec4[6:4]; - wire [2:0] spr5g = vga_spritec5[6:4]; - wire [2:0] spr6g = vga_spritec6[6:4]; - wire [2:0] spr7g = vga_spritec7[6:4]; - wire [2:0] spr0b = vga_spritec0[2:0]; - wire [2:0] spr1b = vga_spritec1[2:0]; - wire [2:0] spr2b = vga_spritec2[2:0]; - wire [2:0] spr3b = vga_spritec3[2:0]; - wire [2:0] spr4b = vga_spritec4[2:0]; - wire [2:0] spr5b = vga_spritec5[2:0]; - wire [2:0] spr6b = vga_spritec6[2:0]; - wire [2:0] spr7b = vga_spritec7[2:0]; - - partial pr0(sprite0, alpha[0], spr0r, r0); - partial pr1(sprite1, alpha[1], spr1r, r1); - partial pr2(sprite2, alpha[2], spr2r, r2); - partial pr3(sprite3, alpha[3], spr3r, r3); - partial pr4(sprite4, alpha[4], spr4r, r4); - partial pr5(sprite5, alpha[5], spr5r, r5); - partial pr6(sprite6, alpha[6], spr6r, r6); - partial pr7(sprite7, alpha[7], spr7r, r7); - - partial pg0(sprite0, alpha[0], spr0g, g0); - partial pg1(sprite1, alpha[1], spr1g, g1); - partial pg2(sprite2, alpha[2], spr2g, g2); - partial pg3(sprite3, alpha[3], spr3g, g3); - partial pg4(sprite4, alpha[4], spr4g, g4); - partial pg5(sprite5, alpha[5], spr5g, g5); - partial pg6(sprite6, alpha[6], spr6g, g6); - partial pg7(sprite7, alpha[7], spr7g, g7); - - partial pb0(sprite0, alpha[0], spr0b, b0); - partial pb1(sprite1, alpha[1], spr1b, b1); - partial pb2(sprite2, alpha[2], spr2b, b2); - partial pb3(sprite3, alpha[3], spr3b, b3); - partial pb4(sprite4, alpha[4], spr4b, b4); - partial pb5(sprite5, alpha[5], spr5b, b5); - partial pb6(sprite6, alpha[6], spr6b, b6); - partial pb7(sprite7, alpha[7], spr7b, b7); - - wire [7:0] sat_r; - saturating_adder add_r(r0, r1, r2, r3, r4, r5, r6, r7, dither, sat_r); - wire [7:0] sat_g; - saturating_adder add_g(g0, g1, g2, g3, g4, g5, g6, g7, dither, sat_g); - wire [7:0] sat_b; - saturating_adder add_b(b0, b1, b2, b3, b4, b5, b6, b7, dither, sat_b); - - always @* - begin - if(vga_addsprites) begin - final_bright = sat_r; - end else begin - if(alpha[0]) final_bright = sprite0; - else if(alpha[1]) final_bright = sprite1; - else if(alpha[2]) final_bright = sprite2; - else if(alpha[3]) final_bright = sprite3; - else if(alpha[4]) final_bright = sprite4; - else if(alpha[5]) final_bright = sprite5; - else if(alpha[6]) final_bright = sprite6; - else if(alpha[7]) final_bright = sprite7; - else - final_bright = 0; - end - end - - wire active = ((53 + 120 + 61) <= CounterX) & (CounterX < (53 + 120 + 61 + 800)) & ((35 + 6 + 21 + 44) < CounterY) & (CounterY < (35 + 6 + 21 + 44 + 512)); - assign vga_line = yy; - // wire [2:0] vga_red = active ? (charout ? 7 : 0) : 0; - // wire [2:0] vga_red = active ? final_bright[7:5] : 0; - // wire [2:0] vga_green = active ? final_bright[7:5] : 0; - // wire [2:0] vga_blue = active ? final_bright[7:5] : 0; - wire [2:0] vga_red = active ? sat_r[7:5] : 0; - wire [2:0] vga_green = active ? sat_g[7:5] : 0; - wire [2:0] vga_blue = active ? sat_b[7:5] : 0; - wire vga_hsync_n = ~vga_HS; - wire vga_vsync_n = ~vga_VS; - -endmodule // top - diff --git a/j1eforth/Makefile b/j1eforth/Makefile deleted file mode 100644 index 0be1611..0000000 --- a/j1eforth/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -all: j1 j1.bin j1.hex - -j1: j1.c - gcc -o j1 j1.c -j1.bin j1.hex: j1.4th - gforth ./j1.4th -run: all - ./j1 -core: all - ./j1 core.4th -clean: - rm -rf j1 j1.bin j1.hex diff --git a/j1eforth/README.md b/j1eforth/README.md deleted file mode 100644 index cca83c6..0000000 --- a/j1eforth/README.md +++ /dev/null @@ -1,99 +0,0 @@ -eForth for the J1 Simulator and actual J1 FPGAs -------------- - -J1 eForth is an interactive work-in-progress Forth designed to run on the [James Bowman's J1 FPGA soft core][j1] -(see also [J1 on Github][J1github]). There is a Forth cross compiler written in Forth to -generate the interactice J1 eForth system, and a J1 simulator written in C to run J1 eForth simulated -on a PC. - -J1 eForth also runs on actual J1 FPGAs. It has been ported to the [Papilio Pro][pappro] FPGA board, -where it executes Forth program at 66 MHz. It communicates with a host system using a serial line at a -default speed of 115200 Bits/s. - -### Prerequisites - - - [GNU make][gmake] (optional) for job control - - [gforth][gforth] for cross compiling / generating the J1 eForth image - - [WpdPack][pcap] for network simulation - -If you want to run J1 eForth simulated on a PC: - - - [gcc][gcc] to compile the J1 simulator - -If you want to run J1 eForth on a J1 in an FPGA: - - - [Xilinx ISE][xilinxise] to generate the FPGA bit stream (ISE 14.7) - - [Papilio-Loader][paploader] to download the bitstream to the FPGA - -### Directry Structure - - j1eforth - ├── README.MD - ├── j1.4th cross compiler with J1 eForth - ├── j1.c J1 simulator - └── fpga - ├── src Verilog projects for J1 and UART (miniuart2) for Papilio Pro - └── test testbenches - -### Building and running the j1 Simulator -#### Compiling using gcc Mingw (Windows) - - gcc j1.c -o -lwpcap j1.exe - -#### Creating flash image j1.bin (and j1.hex) - - gforth j1.4th -#### Running the Simulator - - j1.exe [optional argument] - - The argument to the simulator is an optional forth file that can be used to extend the dictionary - and is passed to the simulator as the first argument during startup - - Words to test in the simulator : - - [ see , ' , compile , [compile] , ?branch , branch , call, .. and many more ] - - Have fun , modify and pass on - -### Running on Real Hardware - -J1 eForth can run on an actual j1 FPGA. It has been ported to the [Papilio Pro][pappro] FPGA board. - -#### Create the J1 bit stream: - -Start Xilinx ise on project `vhdl/papiolo-pro-j1.xise` -choose `Generate Programming File` on the `papilio_pro_j1` component. This generates `papilio_pro_j1.bit` -including the Forth image (`j1.hex`) as initial memory (built before when generating the flash image). - -#### Load the complete bit stream (J1 and memory) into the FPGA: - - sudo papilio-prog -v -f papilio_pro_j1.bit - - You might want to use the pre-built `pipilio_pro_j1.bit` for a quick start. - -#### Connect to J1 eForth: - - screen /dev/tty.usbserial 115200 - - or similar. J1 eForth should show the prompt - - eForth j1 v1.04 - ok - - If you only see the **`ok`** prompts issue a **`cold`** and press the enter key to reboot the system. - - -### May the Forth be with you. - -[pappro]: http://papilio.cc/index.php?n=Papilio.PapilioPro -[paploader]: http://papilio.cc/index.php?n=Papilio.PapilioLoaderV2 -[pcap]: http://www.winpcap.org/archive/4.1.1-WpdPack.zip -[j1]: http://www.excamera.com/sphinx/fpga-j1.html -[j1github]: https://github.com/jamesbowman/j1 - -[gmake]: https://www.gnu.org/software/make/ -[gcc]: https://gcc.gnu.org/ -[gforth]: https://www.gnu.org/software/gforth/ - -[xilinxise]: http://www.xilinx.com/products/design-tools/ise-design-suite/ise-webpack.html diff --git a/j1eforth/fpga/papilio-pro-j1.xise b/j1eforth/fpga/papilio-pro-j1.xise deleted file mode 100644 index d41153c..0000000 --- a/j1eforth/fpga/papilio-pro-j1.xise +++ /dev/null @@ -1,422 +0,0 @@ - - - -
- - - - - - - - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
diff --git a/j1eforth/fpga/papilio_pro_j1.bit b/j1eforth/fpga/papilio_pro_j1.bit deleted file mode 100644 index 1c1372f..0000000 Binary files a/j1eforth/fpga/papilio_pro_j1.bit and /dev/null differ diff --git a/j1eforth/fpga/src/Rxunit.vhd b/j1eforth/fpga/src/Rxunit.vhd deleted file mode 100644 index c30a30e..0000000 --- a/j1eforth/fpga/src/Rxunit.vhd +++ /dev/null @@ -1,97 +0,0 @@ -------------------------------------------------------------------------------- --- Title : UART --- Project : UART -------------------------------------------------------------------------------- --- File : Rxunit.vhd --- Author : Philippe CARTON --- (philippe.carton2@libertysurf.fr) --- Organization: --- Created : 15/12/2001 --- Last update : 8/1/2003 --- Platform : Foundation 3.1i --- Simulators : ModelSim 5.5b --- Synthesizers: Xilinx Synthesis --- Targets : Xilinx Spartan --- Dependency : IEEE std_logic_1164 -------------------------------------------------------------------------------- --- Description: RxUnit is a serial to parallel unit Receiver. -------------------------------------------------------------------------------- --- Copyright (c) notice --- This core adheres to the GNU public license --- -------------------------------------------------------------------------------- --- Revisions : --- Revision Number : --- Version : --- Date : --- Modifier : name --- Description : --- ------------------------------------------------------------------------------- -library ieee; - use ieee.std_logic_1164.all; - -entity RxUnit is - port ( - Clk : in std_logic; -- system clock signal - Reset : in std_logic; -- Reset input - Enable : in std_logic; -- Enable input - ReadA : in Std_logic; -- Async Read Received Byte - RxD : in std_logic; -- RS-232 data input - RxAv : out std_logic; -- Byte available - DataO : out std_logic_vector(7 downto 0)); -- Byte received -end RxUnit; - -architecture Behaviour of RxUnit is - signal RReg : std_logic_vector(7 downto 0); -- receive register - signal RRegL : std_logic; -- Byte received -begin - -- RxAv process - RxAvProc : process(RRegL,Reset,ReadA) - begin - if ReadA = '1' or Reset = '1' then - RxAv <= '0'; -- Negate RxAv when RReg read - elsif Rising_Edge(RRegL) then - RxAv <= '1'; -- Assert RxAv when RReg written - end if; - end process; - - -- Rx Process - RxProc : process(Clk,Reset,Enable,RxD,RReg) - variable BitPos : INTEGER range 0 to 10; -- Position of the bit in the frame - variable SampleCnt : INTEGER range 0 to 3; -- Count from 0 to 3 in each bit - begin - if Reset = '1' then -- Reset - RRegL <= '0'; - BitPos := 0; - elsif Rising_Edge(Clk) then - if Enable = '1' then - case BitPos is - when 0 => -- idle - RRegL <= '0'; - if RxD = '0' then -- Start Bit - SampleCnt := 0; - BitPos := 1; - end if; - when 10 => -- Stop Bit - BitPos := 0; -- next is idle - RRegL <= '1'; -- Indicate byte received - DataO <= RReg; -- Store received byte - when others => - if (SampleCnt = 1 and BitPos >= 2) then -- Sample RxD on 1 - RReg(BitPos-2) <= RxD; -- Deserialisation - end if; - if SampleCnt = 3 then -- Increment BitPos on 3 - BitPos := BitPos + 1; - end if; - end case; - if SampleCnt = 3 then - SampleCnt := 0; - else - sampleCnt := SampleCnt + 1; - end if; - - end if; - end if; - end process; -end Behaviour; diff --git a/j1eforth/fpga/src/Txunit.vhd b/j1eforth/fpga/src/Txunit.vhd deleted file mode 100644 index bdf5b5d..0000000 --- a/j1eforth/fpga/src/Txunit.vhd +++ /dev/null @@ -1,100 +0,0 @@ -------------------------------------------------------------------------------- --- Title : UART --- Project : UART -------------------------------------------------------------------------------- --- File : Txunit.vhd --- Author : Philippe CARTON --- (philippe.carton2@libertysurf.fr) --- Organization: --- Created : 15/12/2001 --- Last update : 8/1/2003 --- Platform : Foundation 3.1i --- Simulators : ModelSim 5.5b --- Synthesizers: Xilinx Synthesis --- Targets : Xilinx Spartan --- Dependency : IEEE std_logic_1164 -------------------------------------------------------------------------------- --- Description: Txunit is a parallel to serial unit transmitter. -------------------------------------------------------------------------------- --- Copyright (c) notice --- This core adheres to the GNU public license --- -------------------------------------------------------------------------------- --- Revisions : --- Revision Number : --- Version : --- Date : --- Modifier : name --- Description : --- ------------------------------------------------------------------------------- - -library ieee; -use ieee.std_logic_1164.all; - -entity TxUnit is - port ( - Clk : in std_logic; -- Clock signal - Reset : in std_logic; -- Reset input - Enable : in std_logic; -- Enable input - LoadA : in std_logic; -- Asynchronous Load - TxD : out std_logic; -- RS-232 data output - Busy : out std_logic; -- Tx Busy - DataI : in std_logic_vector(7 downto 0)); -- Byte to transmit -end TxUnit; - -architecture Behaviour of TxUnit is - - component synchroniser - port ( - C1 : in std_logic; -- Asynchronous signal - C : in std_logic; -- Clock - O : out Std_logic);-- Synchronised signal - end component; - - signal TBuff : std_logic_vector(7 downto 0); -- transmit buffer - signal TReg : std_logic_vector(7 downto 0); -- transmit register - signal TBufL : std_logic; -- Buffer loaded - signal LoadS : std_logic; -- Synchronised load signal - -begin - -- Synchronise Load on Clk - SyncLoad : Synchroniser port map (LoadA, Clk, LoadS); - Busy <= LoadS or TBufL; - - -- Tx process - TxProc : process(Clk, Reset, Enable, DataI, TBuff, TReg, TBufL) - variable BitPos : INTEGER range 0 to 10; -- Bit position in the frame - begin - if Reset = '1' then - TBufL <= '0'; - BitPos := 0; - TxD <= '1'; - elsif Rising_Edge(Clk) then - if LoadS = '1' then - TBuff <= DataI; - TBufL <= '1'; - end if; - if Enable = '1' then - case BitPos is - when 0 => -- idle or stop bit - TxD <= '1'; - if TBufL = '1' then -- start transmit. next is start bit - TReg <= TBuff; - TBufL <= '0'; - BitPos := 1; - end if; - when 1 => -- Start bit - TxD <= '0'; - BitPos := 2; - when others => - TxD <= TReg(BitPos-2); -- Serialisation of TReg - BitPos := BitPos + 1; - end case; - if BitPos = 10 then -- bit8. next is stop bit - BitPos := 0; - end if; - end if; - end if; - end process; -end Behaviour; diff --git a/j1eforth/fpga/src/clock.vhd b/j1eforth/fpga/src/clock.vhd deleted file mode 100644 index 31536e7..0000000 --- a/j1eforth/fpga/src/clock.vhd +++ /dev/null @@ -1,78 +0,0 @@ -library ieee; -use ieee.std_logic_1164.ALL; -use ieee.numeric_std.ALL; -library UNISIM; -use UNISIM.Vcomponents.ALL; - -entity clock is - port ( clk_in : in std_logic; - clk : out std_logic; - clk180 : out std_logic); -end clock; - -architecture BEHAVIORAL of clock is - - signal CLKFB_IN : std_logic; - signal CLKFX_BUF : std_logic; - signal CLKFX180_BUF : std_logic; - signal CLKIN_IBUFG : std_logic; - signal CLK2X_BUF : std_logic; - -begin - - CLKFX_BUFG_INST : BUFG - port map (I=>CLKFX_BUF, - O=>clk); - - CLKFX180_BUFG_INST : BUFG - port map (I=>CLKFX180_BUF, - O=>clk180); - - CLKIN_IBUFG_INST : IBUFG - port map (I=>clk_in, - O=>CLKIN_IBUFG); - - CLK2X_BUFG_INST : BUFG - port map (I=>CLK2X_BUF, - O=>CLKFB_IN); - - DCM_SP_INST : DCM_SP - generic map( - CLK_FEEDBACK => "2X", - CLKDV_DIVIDE => 4.0, - CLKFX_DIVIDE => 1, - CLKFX_MULTIPLY => 2, - CLKIN_DIVIDE_BY_2 => FALSE, - CLKIN_PERIOD => 31.250, - CLKOUT_PHASE_SHIFT => "NONE", - DESKEW_ADJUST => "SYSTEM_SYNCHRONOUS", - DFS_FREQUENCY_MODE => "LOW", - DLL_FREQUENCY_MODE => "LOW", - DUTY_CYCLE_CORRECTION=> TRUE, - FACTORY_JF => x"C080", - PHASE_SHIFT => 0, - STARTUP_WAIT => TRUE) - port map ( - CLKIN => CLKIN_IBUFG, - CLKFB => CLKFB_IN, - DSSEN => '0', - PSCLK => '0', - PSEN => '0', - PSINCDEC => '0', - RST => '0', - CLKDV => open, - CLKFX => CLKFX_BUF, - CLKFX180 => CLKFX180_BUF, - CLK2X => CLK2X_BUF, - CLK2X180 => open, - CLK0 => open, - CLK90 => open, - CLK180 => open, - CLK270 => open, - LOCKED => open, - PSDONE => open, - STATUS => open); - -end BEHAVIORAL; - - diff --git a/j1eforth/fpga/src/j1.v b/j1eforth/fpga/src/j1.v deleted file mode 100644 index db8901a..0000000 --- a/j1eforth/fpga/src/j1.v +++ /dev/null @@ -1,199 +0,0 @@ -/* -Copyright (c) 2011 - James Bowman All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: -1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. -2. 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. -3. Neither the name of James Bowman 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 -REGENTS 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. -*/ - -module j1( - input sys_clk_i, input sys_rst_i, input [15:0] io_din, - output io_rd, output io_wr, output [15:0] io_addr, output [15:0] io_dout); - - reg [15:0] insn; - wire [15:0] immediate = { 1'b0, insn[14:0] }; - - reg [4:0] dsp; // Data stack pointer - reg [4:0] _dsp; - reg [15:0] st0; // Return stack pointer - reg [15:0] _st0; - wire _dstkW; // D stack write - - reg [12:0] pc; - reg [12:0] _pc; - reg [4:0] rsp; - reg [4:0] _rsp; - reg _rstkW; // R stack write - reg [15:0] _rstkD; - wire _ramWE; // RAM write enable - - wire [15:0] pc_plus_1; - assign pc_plus_1 = pc + 1; - - // The D and R stacks - reg [15:0] dstack[0:31]; - reg [15:0] rstack[0:31]; - always @(posedge sys_clk_i) - begin - if (_dstkW) - dstack[_dsp] = st0; - if (_rstkW) - rstack[_rsp] = _rstkD; - end - wire [15:0] st1 = dstack[dsp]; - wire [15:0] rst0 = rstack[rsp]; - - // st0sel is the ALU operation. For branch and call the operation - // is T, for 0branch it is N. For ALU ops it is loaded from the instruction - // field. - reg [3:0] st0sel; - always @* - begin - case (insn[14:13]) - 2'b00: st0sel = 0; // ubranch - 2'b10: st0sel = 0; // call - 2'b01: st0sel = 1; // 0branch - 2'b11: st0sel = insn[11:8]; // ALU - default: st0sel = 4'bxxxx; - endcase - end - - - // Papilio Pro: main memory to be infered instead of specified explitely. - reg [15:0] ram[0:16383]; initial $readmemh("../j1.hex", ram); - - reg [15:0] mem_din; - always @(posedge sys_clk_i) begin - // $monitor("insn_addr= %h, insn = %h, sp=%h, rp=%h, S=%h %h", pc, insn, dsp, rsp, st1, st0); - insn <= ram[_pc]; - mem_din <= ram[_st0[15:1]]; - if (_ramWE & (_st0[15:14] ==0)) - ram[_st0[15:1]] <= st1[15:0]; - end - - - // Compute the new value of T. - always @* - begin - if (insn[15]) - _st0 = immediate; - else - case (st0sel) - 4'b0000: _st0 = st0; - 4'b0001: _st0 = st1; - 4'b0010: _st0 = st0 + st1; - 4'b0011: _st0 = st0 & st1; - 4'b0100: _st0 = st0 | st1; - 4'b0101: _st0 = st0 ^ st1; - 4'b0110: _st0 = ~st0; - 4'b0111: _st0 = {16{(st1 == st0)}}; - 4'b1000: _st0 = {16{($signed(st1) < $signed(st0))}}; - 4'b1001: _st0 = st1 >> st0[3:0]; - 4'b1010: _st0 = st0 - 1; - 4'b1011: _st0 = rst0; - 4'b1100: _st0 = |st0[15:14] ? io_din : mem_din; - 4'b1101: _st0 = st1 << st0[3:0]; - 4'b1110: _st0 = {rsp, 3'b000, dsp}; - 4'b1111: _st0 = {16{(st1 < st0)}}; - default: _st0 = 16'hxxxx; - endcase - end - - wire is_alu = (insn[15:13] == 3'b011); - wire is_lit = (insn[15]); - - assign io_rd = (is_alu & (insn[11:8] == 4'hc)); - assign io_wr = _ramWE; - assign io_addr = st0; - assign io_dout = st1; - - assign _ramWE = is_alu & insn[5]; - assign _dstkW = is_lit | (is_alu & insn[7]); - - wire [1:0] dd = insn[1:0]; // D stack delta - wire [1:0] rd = insn[3:2]; // R stack delta - - always @* - begin - if (is_lit) begin // literal - _dsp = dsp + 1; - _rsp = rsp; - _rstkW = 0; - _rstkD = _pc; - end else if (is_alu) begin - _dsp = dsp + {dd[1], dd[1], dd[1], dd}; - _rsp = rsp + {rd[1], rd[1], rd[1], rd}; - _rstkW = insn[6]; - _rstkD = st0; - end else begin // jump/call - // predicated jump is like DROP - if (insn[15:13] == 3'b001) begin - _dsp = dsp - 1; - end else begin - _dsp = dsp; - end - if (insn[15:13] == 3'b010) begin // call - _rsp = rsp + 1; - _rstkW = 1; - _rstkD = {pc_plus_1[14:0], 1'b0}; - end else begin - _rsp = rsp; - _rstkW = 0; - _rstkD = _pc; - end - end - end - - always @* - begin - if (sys_rst_i) - _pc = pc; - else - if ((insn[15:13] == 3'b000) | - ((insn[15:13] == 3'b001) & (|st0 == 0)) | - (insn[15:13] == 3'b010)) - _pc = insn[12:0]; - else if (is_alu & insn[12]) - _pc = rst0[15:1]; - else - _pc = pc_plus_1; - end - - always @(posedge sys_clk_i) - begin - if (sys_rst_i) begin - pc <= 0; - dsp <= 0; - st0 <= 0; - rsp <= 0; - end else begin - dsp <= _dsp; - pc <= _pc; - st0 <= _st0; - rsp <= _rsp; - end - end - -endmodule // j1 diff --git a/j1eforth/fpga/src/miniuart.vhd b/j1eforth/fpga/src/miniuart.vhd deleted file mode 100644 index 2ee4f3c..0000000 --- a/j1eforth/fpga/src/miniuart.vhd +++ /dev/null @@ -1,146 +0,0 @@ -------------------------------------------------------------------------------- --- Title : MINIUART2 -- this is a modified version without Wishbone interface --- Project : MINIUART2 -------------------------------------------------------------------------------- --- File : MiniUart.vhd --- Author : Philippe CARTON --- (philippe.carton2@libertysurf.fr) --- Organization: --- Created : 15/12/2001 --- Last update : 8/1/2003 --- Platform : Foundation 3.1i --- Simulators : ModelSim 5.5b --- Synthesizers: Xilinx Synthesis --- Targets : Xilinx Spartan --- Dependency : IEEE std_logic_1164, Rxunit.vhd, Txunit.vhd, utils.vhd -------------------------------------------------------------------------------- --- Description: Uart (Universal Asynchronous Receiver Transmitter) for SoC. --- Wishbone compatable. -------------------------------------------------------------------------------- --- Copyright (c) notice --- This core adheres to the GNU public license --- -------------------------------------------------------------------------------- --- Revisions : --- Revision Number : --- Version : --- Date : --- Modifier : name --- Description : --- -------------------------------------------------------------------------------- --- Revision History: --- 2014-12-19: removed wishbone interface (uh@xlerb.de) - - -library ieee; - use ieee.std_logic_1164.all; - -entity MINIUART2 is - generic(BRDIVISOR: INTEGER range 0 to 65535 := 143); -- Baud rate divisor 143 = 115200 at 66 Mhz - port ( - clk: in STD_LOGIC; - rst: in STD_LOGIC; - rx: in STD_LOGIC; - tx: out STD_LOGIC; - io_rd: in STD_LOGIC; - io_wr: in STD_LOGIC; - io_addr: in STD_LOGIC; - io_din: in STD_LOGIC_VECTOR (15 downto 0); - io_dout: out STD_LOGIC_VECTOR (15 downto 0)); -end MINIUART2; - --- Architecture for UART for synthesis -architecture Behaviour of MINIUART2 is - - component Counter - generic(COUNT: INTEGER range 0 to 65535); -- Count revolution - port ( - Clk : in std_logic; -- Clock - Reset : in std_logic; -- Reset input - CE : in std_logic; -- Chip Enable - O : out std_logic); -- Output - end component; - - component RxUnit - port ( - Clk : in std_logic; -- system clock signal - Reset : in std_logic; -- Reset input - Enable : in std_logic; -- Enable input - ReadA : in Std_logic; -- Async Read Received Byte - RxD : in std_logic; -- RS-232 data input - RxAv : out std_logic; -- Byte available - DataO : out std_logic_vector(7 downto 0)); -- Byte received - end component; - - component TxUnit - port ( - Clk : in std_logic; -- Clock signal - Reset : in std_logic; -- Reset input - Enable : in std_logic; -- Enable input - LoadA : in std_logic; -- Asynchronous Load - TxD : out std_logic; -- RS-232 data output - Busy : out std_logic; -- Tx Busy - DataI : in std_logic_vector(7 downto 0)); -- Byte to transmit - end component; - - signal RxData : std_logic_vector(7 downto 0); -- Last Byte received - signal TxData : std_logic_vector(7 downto 0); -- Last bytes transmitted - signal SReg : std_logic_vector(7 downto 0); -- Status register - signal EnabRx : std_logic; -- Enable RX unit - signal EnabTx : std_logic; -- Enable TX unit - signal RxAv : std_logic; -- Data Received - signal TxBusy : std_logic; -- Transmiter Busy - signal ReadA : std_logic; -- Async Read receive buffer - signal LoadA : std_logic; -- Async Load transmit buffer - signal Sig0 : std_logic; -- gnd signal - signal Sig1 : std_logic; -- vcc signal - - - begin - sig0 <= '0'; - sig1 <= '1'; - Uart_Rxrate : Counter -- Baud Rate adjust - generic map (COUNT => BRDIVISOR) - port map (clk, rst, sig1, EnabRx); - Uart_Txrate : Counter -- 4 Divider for Tx - generic map (COUNT => 4) - port map (clk, rst, EnabRx, EnabTx); - Uart_TxUnit : TxUnit port map (clk, rst, EnabTX, LoadA, tx, TxBusy, TxData); - Uart_RxUnit : RxUnit port map (clk, rst, EnabRX, ReadA, rx, RxAv, RxData); - - -- status register - SReg(0) <= RxAv; - SReg(1) <= TxBusy; - SReg(7 downto 2) <= (others => '0'); -- the rest is silence - - process (clk, rst, io_addr, io_wr, io_din) - begin - if Rising_Edge(clk) then - if rst='1' then - LoadA <= '0'; - elsif io_wr='1' and io_addr='0' then -- write byte to tx - TxData <= io_din(7 downto 0); - LoadA <= '1'; - else - LoadA <= '0'; - end if; - end if; - end process; - - process (clk, rst, io_addr, io_rd, RxData, TxBusy, RxAv) - begin - if Rising_Edge(clk) then - if rst='1' then - ReadA <= '0'; - elsif io_rd='1' and io_addr='0' then - ReadA <= '1'; - else - ReadA <= '0'; - end if; - end if; - end process; - io_dout(7 downto 0) <= RxData when io_addr='0' else SReg; - io_dout(15 downto 8) <= (others => '0'); - -end Behaviour; diff --git a/j1eforth/fpga/src/papilio-pro-j1.vhd b/j1eforth/fpga/src/papilio-pro-j1.vhd deleted file mode 100644 index 4680c07..0000000 --- a/j1eforth/fpga/src/papilio-pro-j1.vhd +++ /dev/null @@ -1,117 +0,0 @@ -library IEEE; -use IEEE.STD_LOGIC_1164.ALL; -use IEEE.NUMERIC_STD.ALL; - -entity papilio_pro_j1 is - port ( - clk_in: in std_logic; - rx: in std_logic; - tx: out std_logic; - wing: out std_logic_vector(15 downto 0)); -end papilio_pro_j1; - -architecture Behavioral of papilio_pro_j1 is - - component clock is - port ( - clk_in: in std_logic; - clk: out std_logic; - clk180: out std_logic); - end component; - - component j1 is - port ( - sys_clk_i: in std_logic; - sys_rst_i: in std_logic; - io_rd: out std_logic; - io_wr: out std_logic; - io_addr: out std_logic_vector (15 downto 0); - io_din: in std_logic_vector (15 downto 0); - io_dout: out std_logic_vector (15 downto 0)); - end component; - - component miniuart2 is - port ( - clk: in STD_LOGIC; - rst: in STD_LOGIC; - rx: in STD_LOGIC; - tx: out STD_LOGIC; - io_rd: in STD_LOGIC; - io_wr: in STD_LOGIC; - io_addr: in STD_LOGIC; - io_din: in STD_LOGIC_VECTOR (15 downto 0); - io_dout: out STD_LOGIC_VECTOR (15 downto 0)); - end component; - - - signal clk: std_logic; - signal clk180: std_logic; - - signal rst_counter: integer range 0 to 15 := 15; - signal sys_rst: std_logic := '1'; - - signal io_rd: std_logic; - signal io_wr: std_logic; - signal io_addr: std_logic_vector (15 downto 0); - signal io_din: std_logic_vector (15 downto 0); - signal io_dout: std_logic_vector (15 downto 0); - - signal uart_en: std_logic; - signal uart_rd: std_logic; - signal uart_wr: std_logic; - signal uart_dout: std_logic_vector (15 downto 0); -begin - - clock_inst: clock - port map ( - clk_in => clk_in, - clk => clk, - clk180 => clk180); - - j1_inst: j1 - port map ( - sys_clk_i => clk, - sys_rst_i => sys_rst, - io_rd => io_rd, - io_wr => io_wr, - io_addr => io_addr, - io_din => io_din, - io_dout => io_dout); - - uart_inst: miniuart2 - port map( - clk => clk180, - rst => sys_rst, - rx => rx, - tx => tx, - io_rd => uart_rd, - io_wr => uart_wr, - io_addr => io_addr(0), - io_din => io_dout, - io_dout => uart_dout); - - process (clk, rst_counter) - begin - if rising_edge(clk) and rst_counter>0 then - rst_counter <= rst_counter-1; - end if; - end process; - sys_rst <= '1' when rst_counter>0 else '0'; - - uart_en <= '1' when io_addr(15 downto 1)="111100000000000" else '0'; - uart_rd <= io_rd and uart_en; - uart_wr <= io_wr and uart_en; - - process (io_addr, uart_dout) - begin - case io_addr(15 downto 1) is - when "111100000000000" => - io_din <= uart_dout; - when others => - io_din <= (others=>'0'); - end case; - end process; - - wing <= (others=>'0'); - -end Behavioral; \ No newline at end of file diff --git a/j1eforth/fpga/src/papilio-pro.ucf b/j1eforth/fpga/src/papilio-pro.ucf deleted file mode 100644 index 338cd2d..0000000 --- a/j1eforth/fpga/src/papilio-pro.ucf +++ /dev/null @@ -1,143 +0,0 @@ -# UCF file for the Papilio Pro board -# Generated by pin_converter, written by Kevin Lindsey -# https://github.com/thelonious/papilio_pins/tree/development/pin_converter - -# Main board wing pin [] to FPGA pin Pxx map -# -------C------- -------B------- -------A------- -# [GND] [C00] P114 [GND] [B00] P99 P100 [A15] -# [2V5] [C01] P115 [2V5] [B01] P97 P98 [A14] -# [3V3] [C02] P116 [3V3] [B02] P92 P93 [A13] -# [5V0] [C03] P117 [5V0] [B03] P87 P88 [A12] -# [C04] P118 [B04] P84 P85 [A11] [5V0] -# [C05] P119 [B05] P82 P83 [A10] [3V3] -# [C06] P120 [B06] P80 P81 [A09] [2V5] -# [C07] P121 [B07] P78 P79 [A08] [GND] -# [GND] [C08] P123 [GND] [B08] P74 P75 [A07] -# [2V5] [C09] P124 [2V5] [B09] P95 P67 [A06] -# [3V3] [C10] P126 [3V3] [B10] P62 P66 [A05] -# [5V0] [C11] P127 [5V0] [B11] P59 P61 [A04] -# [C12] P131 [B12] P57 P58 [A03] [5V0] -# [C13] P132 [B13] P55 P56 [A02] [3V3] -# [C14] P133 [B14] P50 P51 [A01] [2V5] -# [C15] P134 [B15] P47 P48 [A00] [GND] - -## Prohibit the automatic placement of pins that are connected to VCC or GND for configuration. -CONFIG PROHIBIT=P144; -CONFIG PROHIBIT=P69; -CONFIG PROHIBIT=P60; - -NET CLK_IN LOC="P94" | IOSTANDARD=LVTTL | PERIOD=31.25ns; # CLK -NET RX LOC="P101" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # RX -NET TX LOC="P105" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # TX -NET WING(0) LOC="P48" | IOSTANDARD=LVTTL; # A0 -NET WING(1) LOC="P51" | IOSTANDARD=LVTTL; # A1 -NET WING(2) LOC="P56" | IOSTANDARD=LVTTL; # A2 -NET WING(3) LOC="P58" | IOSTANDARD=LVTTL; # A3 -NET WING(4) LOC="P61" | IOSTANDARD=LVTTL; # A4 -NET WING(5) LOC="P66" | IOSTANDARD=LVTTL; # A5 -NET WING(6) LOC="P67" | IOSTANDARD=LVTTL; # A6 -NET WING(7) LOC="P75" | IOSTANDARD=LVTTL; # A7 -NET WING(8) LOC="P79" | IOSTANDARD=LVTTL; # A8 -NET WING(9) LOC="P81" | IOSTANDARD=LVTTL; # A9 -NET WING(10) LOC="P83" | IOSTANDARD=LVTTL; # A10 -NET WING(11) LOC="P85" | IOSTANDARD=LVTTL; # A11 -NET WING(12) LOC="P88" | IOSTANDARD=LVTTL; # A12 -NET WING(13) LOC="P93" | IOSTANDARD=LVTTL; # A13 -NET WING(14) LOC="P98" | IOSTANDARD=LVTTL; # A14 -NET WING(15) LOC="P100" | IOSTANDARD=LVTTL; # A15 -#NET A(0) LOC="P48" | IOSTANDARD=LVTTL; # A0 -#NET A(1) LOC="P51" | IOSTANDARD=LVTTL; # A1 -#NET A(2) LOC="P56" | IOSTANDARD=LVTTL; # A2 -#NET A(3) LOC="P58" | IOSTANDARD=LVTTL; # A3 -#NET A(4) LOC="P61" | IOSTANDARD=LVTTL; # A4 -#NET A(5) LOC="P66" | IOSTANDARD=LVTTL; # A5 -#NET A(6) LOC="P67" | IOSTANDARD=LVTTL; # A6 -#NET A(7) LOC="P75" | IOSTANDARD=LVTTL; # A7 -#NET A(8) LOC="P79" | IOSTANDARD=LVTTL; # A8 -#NET A(9) LOC="P81" | IOSTANDARD=LVTTL; # A9 -#NET A(10) LOC="P83" | IOSTANDARD=LVTTL; # A10 -#NET A(11) LOC="P85" | IOSTANDARD=LVTTL; # A11 -#NET A(12) LOC="P88" | IOSTANDARD=LVTTL; # A12 -#NET A(13) LOC="P93" | IOSTANDARD=LVTTL; # A13 -#NET A(14) LOC="P98" | IOSTANDARD=LVTTL; # A14 -#NET A(15) LOC="P100" | IOSTANDARD=LVTTL; # A15 -#NET B(0) LOC="P99" | IOSTANDARD=LVTTL; # B0 -#NET B(1) LOC="P97" | IOSTANDARD=LVTTL; # B1 -#NET B(2) LOC="P92" | IOSTANDARD=LVTTL; # B2 -#NET B(3) LOC="P87" | IOSTANDARD=LVTTL; # B3 -#NET B(4) LOC="P84" | IOSTANDARD=LVTTL; # B4 -#NET B(5) LOC="P82" | IOSTANDARD=LVTTL; # B5 -#NET B(6) LOC="P80" | IOSTANDARD=LVTTL; # B6 -#NET B(7) LOC="P78" | IOSTANDARD=LVTTL; # B7 -#NET B(8) LOC="P74" | IOSTANDARD=LVTTL; # B8 -#NET B(9) LOC="P95" | IOSTANDARD=LVTTL; # B9 -#NET B(10) LOC="P62" | IOSTANDARD=LVTTL; # B10 -#NET B(11) LOC="P59" | IOSTANDARD=LVTTL; # B11 -#NET B(12) LOC="P57" | IOSTANDARD=LVTTL; # B12 -#NET B(13) LOC="P55" | IOSTANDARD=LVTTL; # B13 -#NET B(14) LOC="P50" | IOSTANDARD=LVTTL; # B14 -#NET B(15) LOC="P47" | IOSTANDARD=LVTTL; # B15 -#NET C(0) LOC="P114" | IOSTANDARD=LVTTL; # C0 -#NET C(1) LOC="P115" | IOSTANDARD=LVTTL; # C1 -#NET C(2) LOC="P116" | IOSTANDARD=LVTTL; # C2 -#NET C(3) LOC="P117" | IOSTANDARD=LVTTL; # C3 -#NET C(4) LOC="P118" | IOSTANDARD=LVTTL; # C4 -#NET C(5) LOC="P119" | IOSTANDARD=LVTTL; # C5 -#NET C(6) LOC="P120" | IOSTANDARD=LVTTL; # C6 -#NET C(7) LOC="P121" | IOSTANDARD=LVTTL; # C7 -#NET C(8) LOC="P123" | IOSTANDARD=LVTTL; # C8 -#NET C(9) LOC="P124" | IOSTANDARD=LVTTL; # C9 -#NET C(10) LOC="P126" | IOSTANDARD=LVTTL; # C10 -#NET C(11) LOC="P127" | IOSTANDARD=LVTTL; # C11 -#NET C(12) LOC="P131" | IOSTANDARD=LVTTL; # C12 -#NET C(13) LOC="P132" | IOSTANDARD=LVTTL; # C13 -#NET C(14) LOC="P133" | IOSTANDARD=LVTTL; # C14 -#NET C(15) LOC="P134" | IOSTANDARD=LVTTL; # C15 -#NET SDRAM_ADDR(0) LOC="P140" | IOSTANDARD=LVTTL; # SDRAM_ADDR0 -#NET SDRAM_ADDR(1) LOC="P139" | IOSTANDARD=LVTTL; # SDRAM_ADDR1 -#NET SDRAM_ADDR(2) LOC="P138" | IOSTANDARD=LVTTL; # SDRAM_ADDR2 -#NET SDRAM_ADDR(3) LOC="P137" | IOSTANDARD=LVTTL; # SDRAM_ADDR3 -#NET SDRAM_ADDR(4) LOC="P46" | IOSTANDARD=LVTTL; # SDRAM_ADDR4 -#NET SDRAM_ADDR(5) LOC="P45" | IOSTANDARD=LVTTL; # SDRAM_ADDR5 -#NET SDRAM_ADDR(6) LOC="P44" | IOSTANDARD=LVTTL; # SDRAM_ADDR6 -#NET SDRAM_ADDR(7) LOC="P43" | IOSTANDARD=LVTTL; # SDRAM_ADDR7 -#NET SDRAM_ADDR(8) LOC="P41" | IOSTANDARD=LVTTL; # SDRAM_ADDR8 -#NET SDRAM_ADDR(9) LOC="P40" | IOSTANDARD=LVTTL; # SDRAM_ADDR9 -#NET SDRAM_ADDR(10) LOC="P141" | IOSTANDARD=LVTTL; # SDRAM_ADDR10 -#NET SDRAM_ADDR(11) LOC="P35" | IOSTANDARD=LVTTL; # SDRAM_ADDR11 -#NET SDRAM_ADDR(12) LOC="P34" | IOSTANDARD=LVTTL; # SDRAM_ADDR12 -#NET SDRAM_DATA(0) LOC="P9" | IOSTANDARD=LVTTL; # SDRAM_DATA0 -#NET SDRAM_DATA(1) LOC="P10" | IOSTANDARD=LVTTL; # SDRAM_DATA1 -#NET SDRAM_DATA(2) LOC="P11" | IOSTANDARD=LVTTL; # SDRAM_DATA2 -#NET SDRAM_DATA(3) LOC="P12" | IOSTANDARD=LVTTL; # SDRAM_DATA3 -#NET SDRAM_DATA(4) LOC="P14" | IOSTANDARD=LVTTL; # SDRAM_DATA4 -#NET SDRAM_DATA(5) LOC="P15" | IOSTANDARD=LVTTL; # SDRAM_DATA5 -#NET SDRAM_DATA(6) LOC="P16" | IOSTANDARD=LVTTL; # SDRAM_DATA6 -#NET SDRAM_DATA(7) LOC="P8" | IOSTANDARD=LVTTL; # SDRAM_DATA7 -#NET SDRAM_DATA(8) LOC="P21" | IOSTANDARD=LVTTL; # SDRAM_DATA8 -#NET SDRAM_DATA(9) LOC="P22" | IOSTANDARD=LVTTL; # SDRAM_DATA9 -#NET SDRAM_DATA(10) LOC="P23" | IOSTANDARD=LVTTL; # SDRAM_DATA10 -#NET SDRAM_DATA(11) LOC="P24" | IOSTANDARD=LVTTL; # SDRAM_DATA11 -#NET SDRAM_DATA(12) LOC="P26" | IOSTANDARD=LVTTL; # SDRAM_DATA12 -#NET SDRAM_DATA(13) LOC="P27" | IOSTANDARD=LVTTL; # SDRAM_DATA13 -#NET SDRAM_DATA(14) LOC="P29" | IOSTANDARD=LVTTL; # SDRAM_DATA14 -#NET SDRAM_DATA(15) LOC="P30" | IOSTANDARD=LVTTL; # SDRAM_DATA15 -#NET SDRAM_DQML LOC="P7" | IOSTANDARD=LVTTL; # SDRAM_DQML -#NET SDRAM_DQMH LOC="P17" | IOSTANDARD=LVTTL; # SDRAM_DQMH -#NET SDRAM_BA(0) LOC="P143" | IOSTANDARD=LVTTL; # SDRAM_BA0 -#NET SDRAM_BA(1) LOC="P142" | IOSTANDARD=LVTTL; # SDRAM_BA1 -#NET SDRAM_nWE LOC="P6" | IOSTANDARD=LVTTL; # SDRAM_nWE -#NET SDRAM_nCAS LOC="P5" | IOSTANDARD=LVTTL; # SDRAM_nCAS -#NET SDRAM_nRAS LOC="P2" | IOSTANDARD=LVTTL; # SDRAM_nRAS -#NET SDRAM_CS LOC="P1" | IOSTANDARD=LVTTL; # SDRAM_CS -#NET SDRAM_CLK LOC="P32" | IOSTANDARD=LVTTL; # SDRAM_CLK -#NET SDRAM_CKE LOC="P33" | IOSTANDARD=LVTTL; # SDRAM_CKE -#NET LED1 LOC="P112" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=SLOW; # LED1 -#NET JTAG_TMS LOC="P107" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TMS -#NET JTAG_TCK LOC="P109" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TCK -#NET JTAG_TDI LOC="P110" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TDI -#NET JTAG_TDO LOC="P106" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # JTAG_TDO -#NET FLASH_CS LOC="P38" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_CS -#NET FLASH_CK LOC="P70" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_CK -#NET FLASH_SI LOC="P64" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST; # FLASH_SI -#NET FLASH_SO LOC="P65" | IOSTANDARD=LVTTL | DRIVE=8 | SLEW=FAST | PULLUP; # FLASH_SO diff --git a/j1eforth/fpga/src/utils.vhd b/j1eforth/fpga/src/utils.vhd deleted file mode 100644 index 19eb1f7..0000000 --- a/j1eforth/fpga/src/utils.vhd +++ /dev/null @@ -1,132 +0,0 @@ -------------------------------------------------------------------------------- --- Title : UART --- Project : UART -------------------------------------------------------------------------------- --- File : utils.vhd --- Author : Philippe CARTON --- (philippe.carton2@libertysurf.fr) --- Organization: --- Created : 15/12/2001 --- Last update : 8/1/2003 --- Platform : Foundation 3.1i --- Simulators : ModelSim 5.5b --- Synthesizers: Xilinx Synthesis --- Targets : Xilinx Spartan --- Dependency : IEEE std_logic_1164 -------------------------------------------------------------------------------- --- Description: VHDL utility file -------------------------------------------------------------------------------- --- Copyright (c) notice --- This core adheres to the GNU public license --- -------------------------------------------------------------------------------- --- Revisions : --- Revision Number : --- Version : --- Date : --- Modifier : name --- Description : --- ------------------------------------------------------------------------------- - - -------------------------------------------------------------------------------- --- Revision list --- Version Author Date Changes --- --- 1.0 Philippe CARTON 19 December 2001 New model --- philippe.carton2@libertysurf.fr -------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- Synchroniser: --- Synchronize an input signal (C1) with an input clock (C). --- The result is the O signal which is synchronous of C, and persist for --- one C clock period. --------------------------------------------------------------------------------- -library IEEE,STD; -use IEEE.std_logic_1164.all; - -entity synchroniser is - port ( - C1 : in std_logic;-- Asynchronous signal - C : in std_logic;-- Clock - O : out std_logic);-- Synchronised signal -end synchroniser; - -architecture Behaviour of synchroniser is - signal C1A : std_logic; - signal C1S : std_logic; - signal R : std_logic; -begin - RiseC1A : process(C1,R) - begin - if Rising_Edge(C1) then - C1A <= '1'; - end if; - if (R = '1') then - C1A <= '0'; - end if; - end process; - - SyncP : process(C,R) - begin - if Rising_Edge(C) then - if (C1A = '1') then - C1S <= '1'; - else C1S <= '0'; - end if; - if (C1S = '1') then - R <= '1'; - else R <= '0'; - end if; - end if; - if (R = '1') then - C1S <= '0'; - end if; - end process; - O <= C1S; -end Behaviour; - -------------------------------------------------------------------------------- --- Counter --- This counter is a parametrizable clock divider. --- The count value is the generic parameter Count. --- It is CE enabled. (it will count only if CE is high). --- When it overflow, it will emit a pulse on O. --- It can be reseted to 0. -------------------------------------------------------------------------------- -library IEEE,STD; -use IEEE.std_logic_1164.all; - -entity Counter is - generic(Count: INTEGER range 0 to 65535); -- Count revolution - port ( - Clk : in std_logic; -- Clock - Reset : in std_logic; -- Reset input - CE : in std_logic; -- Chip Enable - O : out std_logic); -- Output -end Counter; - -architecture Behaviour of Counter is -begin - counter : process(Clk,Reset) - variable Cnt : INTEGER range 0 to Count-1; - begin - if Reset = '1' then - Cnt := Count - 1; - O <= '0'; - elsif Rising_Edge(Clk) then - if CE = '1' then - if Cnt = 0 then - O <= '1'; - Cnt := Count - 1; - else - O <= '0'; - Cnt := Cnt - 1; - end if; - else O <= '0'; - end if; - end if; - end process; -end Behaviour; diff --git a/j1eforth/fpga/test/miniuart2_tb.vhd b/j1eforth/fpga/test/miniuart2_tb.vhd deleted file mode 100644 index 6049582..0000000 --- a/j1eforth/fpga/test/miniuart2_tb.vhd +++ /dev/null @@ -1,128 +0,0 @@ --------------------------------------------------------------------------------- --- Company: --- Engineer: --- --- Create Date: 11:48:15 12/20/2014 --- Design Name: --- Module Name: /mnt/hgfs/Projects/j1eforth/vhdl/test/miniuart2_tb.vhd --- Project Name: papilio-pro-forth --- Target Device: --- Tool versions: --- Description: --- --- VHDL Test Bench Created by ISE for module: MINIUART2 --- --- Dependencies: --- --- Revision: --- Revision 0.01 - File Created --- Additional Comments: --- --- Notes: --- This testbench has been automatically generated using types std_logic and --- std_logic_vector for the ports of the unit under test. Xilinx recommends --- that these types always be used for the top-level I/O of a design in order --- to guarantee that the testbench will bind correctly to the post-implementation --- simulation model. --------------------------------------------------------------------------------- -LIBRARY ieee; -USE ieee.std_logic_1164.ALL; - --- Uncomment the following library declaration if using --- arithmetic functions with Signed or Unsigned values ---USE ieee.numeric_std.ALL; - -ENTITY miniuart2_tb IS -END miniuart2_tb; - -ARCHITECTURE behavior OF miniuart2_tb IS - - -- Component Declaration for the Unit Under Test (UUT) - - COMPONENT MINIUART2 - PORT( - clk : IN std_logic; - rst : IN std_logic; - rx : IN std_logic; - tx : OUT std_logic; - io_rd : IN std_logic; - io_wr : IN std_logic; - io_addr : IN std_logic; - io_din : IN std_logic_vector(15 downto 0); - io_dout : OUT std_logic_vector(15 downto 0) - ); - END COMPONENT; - - - --Inputs - signal clk : std_logic := '0'; - signal rst : std_logic := '0'; - signal rx : std_logic := '0'; - signal io_rd : std_logic := '0'; - signal io_wr : std_logic := '0'; - signal io_addr : std_logic := '0'; - signal io_din : std_logic_vector(15 downto 0) := (others => '0'); - - --Outputs - signal tx : std_logic; - signal io_dout : std_logic_vector(15 downto 0); - - -- Clock period definitions - constant clk_period : time := 10 ns; -- 31.25 ns; - -BEGIN - - -- Instantiate the Unit Under Test (UUT) - uut: MINIUART2 PORT MAP ( - clk => clk, - rst => rst, - rx => rx, - tx => tx, - io_rd => io_rd, - io_wr => io_wr, - io_addr => io_addr, - io_din => io_din, - io_dout => io_dout - ); - - -- Clock process definitions - clk_process :process - begin - clk <= '0'; - wait for clk_period/2; - clk <= '1'; - wait for clk_period/2; - end process; - - - -- Stimulus process - stim_proc: process - begin - -- hold reset state for 100 ns. - wait for 100 ns; - - wait for clk_period*5; - - rst <= '1'; - - wait for clk_period*3; - - rst <= '0'; - - wait for clk_period*3; - - -- insert stimulus here - io_din <= X"002A"; - io_addr <= '1'; - io_wr <= '1'; - - wait for clk_period; - - io_addr <= '0'; - io_din <= X"0000"; - io_wr <= '0'; - - wait; - end process; - -END; diff --git a/j1eforth/fpga/test/papilio_pro_j1_tb.vhd b/j1eforth/fpga/test/papilio_pro_j1_tb.vhd deleted file mode 100644 index 3aedf53..0000000 --- a/j1eforth/fpga/test/papilio_pro_j1_tb.vhd +++ /dev/null @@ -1,96 +0,0 @@ --------------------------------------------------------------------------------- --- Company: --- Engineer: --- --- Create Date: 22:12:23 03/03/2012 --- Design Name: --- Module Name: /home/ben/prog/PapilioForth/ise/main_tb.vhd --- Project Name: PapilioForth --- Target Device: --- Tool versions: --- Description: --- --- VHDL Test Bench Created by ISE for module: main --- --- Dependencies: --- --- Revision: --- Revision 0.01 - File Created --- Additional Comments: --- --- Notes: --- This testbench has been automatically generated using types std_logic and --- std_logic_vector for the ports of the unit under test. Xilinx recommends --- that these types always be used for the top-level I/O of a design in order --- to guarantee that the testbench will bind correctly to the post-implementation --- simulation model. --------------------------------------------------------------------------------- -LIBRARY ieee; -USE ieee.std_logic_1164.ALL; - --- Uncomment the following library declaration if using --- arithmetic functions with Signed or Unsigned values ---USE ieee.numeric_std.ALL; - -ENTITY papilio_pro_j1_tb IS -END papilio_pro_j1_tb; - -ARCHITECTURE behavior OF papilio_pro_j1_tb IS - - -- Component Declaration for the Unit Under Test (UUT) - - COMPONENT papilio_pro_j1 - PORT( - clk_in : IN std_logic; - rx : IN std_logic; - tx : OUT std_logic; - wing : INOUT std_logic_vector(15 downto 0) - ); - END COMPONENT; - - - --Inputs - signal clk_in : std_logic := '0'; - signal rx : std_logic := '0'; - - --Outputs - signal tx : std_logic; - signal wing : std_logic_vector(15 downto 0); - - -- Clock period definitions - constant clk_in_period : time := 31.25 ns; - -BEGIN - - -- Instantiate the Unit Under Test (UUT) - uut: papilio_pro_j1 PORT MAP ( - clk_in => clk_in, - rx => rx, - tx => tx, - wing => wing - ); - - -- Clock process definitions - clk_in_process :process - begin - clk_in <= '0'; - wait for clk_in_period/2; - clk_in <= '1'; - wait for clk_in_period/2; - end process; - - - -- Stimulus process - stim_proc: process - begin - -- hold reset state for 100 ns. - wait for 100 ns; - - wait for clk_in_period*50; - - -- insert stimulus here - - wait; - end process; - -END; diff --git a/j1eforth/ipv4.4th b/j1eforth/ipv4.4th deleted file mode 100644 index 080686c..0000000 --- a/j1eforth/ipv4.4th +++ /dev/null @@ -1,249 +0,0 @@ -( - I feel that the Kernel is at it's best for now and that I can proceed - to do some other things. Note that version 1 is just to make the whole - thing work, later on I might look at optimisation where I might have to move - some stuff around so that memory utilization and execution speed efficiency is - achieved.So far the Kernel works without needing tweaks. - - Work in progress: Implementing simple ipv4 for the j1eforth model - - 7 project targets: - - 1. Add multi-tasking support to the Kernel - 0% - 2. Modify j1 sim to use pcap interface for network tx and rx - 0% - 3. ARP - 0% - 4. ICMP - 0% - 5. IP - 0% - 6. UDP - 0% - 7. TCP - 0% - - Hopefully I will get time to do all this and also document the design of - the j1eforth Kernel for those who are starting out with forth and also those - who wish to tinker with the Kernel for fun. -) - -hex - -forth-wordlist >voc forth - -vocabulary ipv4.1 -only forth also ipv4.1 - -ipv4.1 definitions - -variable active_struct - -: field - create over , + - does> - @ active_struct @ + ; - -( ethernet frame ) - -0 - 6 field eth_dest ( 48 bit source address ) - 6 field eth_src ( 48 bit destination address ) - 2 field eth_type ( 16 bit type ) -constant eth_frame% - -( arp message ) - -0 - 2 field arp_hw ( 16 bit hw type ) - 2 field arp_proto ( 16 bit protocol ) - 1 field arp_hlen ( 8 bit hw address length ) - 1 field arp_plen ( 8 bit protocol address length ) - 2 field arp_op ( 16 bit operation ) - 6 field arp_shw ( 48 bit sender hw address ) - 4 field arp_sp ( 32 bit sender ipv4 address ) - 6 field arp_thw ( 48 bit target hw address ) - 4 field arp_tp ( 32 bit target ipv4 address ) -constant arp_message% - -( arp cache ) - -0 - 4 field ac_ip ( 32 bit protocol address ) - 6 field ac_hw ( 48 bit hw address ) -constant arp_cache% - -( ipv4 datagram header ) - -0 - 1 field ip_vhl ( 4 bit version and 4 bit header length ) - 1 field ip_tos ( 8 bit type of service ) - 2 field ip_len ( 16 bit length ) - 2 field ip_id ( 16 bit identification ) - 2 field ip_frags ( 3 bit flags 13 bit fragment offset ) - 1 field ip_ttl ( 8 bit time to live ) - 1 field ip_proto ( 8 bit protocol number ) - 2 field ip_checksum ( 16 bit checksum ) - 4 field ip_source ( 32 bit source address ) - 4 field ip_dest ( 32 bit destination address ) -constant ip_header% - -( icmp header ) - -0 - 1 field icmp_type ( 8 bits type ) - 1 field icmp_code ( 8 bits code ) - 2 field icmp_checksum ( 16 bits checksum ) -constant icmp_header% - -( udp datagram ) - -0 - 2 field udp_source ( 16 bit source port ) - 2 field udp_dest ( 16 bit destination port ) - 2 field udp_len ( 16 bit length ) - 2 field udp_checksum ( 16 bit checksum ) -constant udp_datagram% - -( tcp header ) - -0 - 2 field tcp_source ( 16 bit source port ) - 2 field tcp_dest ( 16 bit destination port ) - 4 field tcp_seq ( 32 bit sequence number ) - 4 field tcp_ack ( 32 bit acknowledgement ) - 1 field tcp_offset ( 8 bit offset ) - 2 field tcp_flags ( 16 bit flags ) - 1 field tcp_window ( 8 bit window size ) - 2 field tcp_checksum ( 16 bit checksum ) - 2 field tcp_urgent ( 16 bit urgent pointer ) -constant tcp_header% - -4000 constant eth_rx_buf - -: htons ( n -- n ) - dup ff and 8 lshift swap ff00 and 8 rshift or ; - -create ip_addr a8c0 , fe0b , -create ip_netmask ffff , 00ff , -create hw_addr bd00 , 333b , 7f05 , - - 8 constant eth_ip_type - 608 constant eth_arp_type -3580 constant eth_rarp_type - -100 constant arp_request_type -200 constant arp_reply_type - -0 constant icmp_echo_reply -8 constant icmp_echo - -0 constant arp_action - -: arp_lookup 0 to arp_action ; -: arp_update 1 to arp_action ; -: arp_insert 2 to arp_action ; -: arp_delete 3 to arp_action ; -: +arp_age 4 to arp_action ; - -: (arp_lookup) cr ." compare" . . ; -: (arp_update) cr ." update" . . ; -: (arp_insert) cr ." insert" ; -: (arp_delete) cr ." delete" ; -: (+arp_age) cr ." age" ; - -: arp_table ( u -- ) - create here over allot swap erase - does> - swap arp_cache% * + - arp_action 0 to arp_action - case - 0 of (arp_lookup) endof - 1 of (arp_update) endof - 2 of (arp_insert) endof - 3 of (arp_delete) endof - 4 of (+arp_age) endof - ." unknown cache option" - endcase ; - -arp_cache% 8 * arp_table arp_cache - -: eth_rx f008 @ ; -: eth_tx f008 ! ; - -: checksum ( address count -- checksum) - over + 0 -rot - do - i @ + i @ over u> if 1+ then - -2 +loop - dup 10 rshift swap ffff and + - dup 10 rshift + - ffff xor ; -: arp_in ( -- ) - eth_frame% active_struct +! - arp_op @ arp_request_type = if - 100 arp_hw ! - eth_ip_type arp_proto ! - 6 arp_hlen c! - 4 arp_plen c! - arp_reply_type arp_op ! - arp_shw arp_thw 6 cmove - hw_addr arp_shw 6 cmove - arp_sp arp_tp 4 cmove - ip_addr arp_sp 4 cmove - arp_thw - eth_rx_buf active_struct ! - eth_dest 6 cmove - hw_addr eth_src 6 cmove - eth_arp_type eth_type ! - eth_tx - else - ( arp_update ) - then ; -: icmp_in - ip_len @ htons - ip_header% active_struct +! - icmp_type c@ 8 = if - 0 icmp_type c! - icmp_checksum @ fff7 = if - 9 icmp_checksum +! - else 8 icmp_checksum +! then - else - cr ." weird icmp packet" - then eth_tx ; -: udp_in cr ." got udp packet." ; -: tcp_in cr ." got tcp packet." ; -: ip_in ( -- ) - eth_frame% active_struct +! - ip_vhl @ 45 = if - ip_proto c@ case - 1 of - ip_source dup ip_dest 4 cmove - ip_addr swap 4 cmove - icmp_in - endof - 6 of tcp_in endof - 17 of udp_in endof - cr ." unknown ip protocol:" - endcase - else - cr ." unsupported ip version detected" - then ; -: process ( -- ) - eth_type @ case - eth_arp_type of arp_in endof - eth_ip_type of ip_in endof - cr ." unknown ethernet protocol" - endcase ; -: pcap_poll - eth_rx_buf active_struct ! - active_struct @ 5dc erase - eth_rx ; -: round - pcap_poll 0 <> if - process - then ; -: main - begin - round - again -; - -( main ) - -forth definitions -ipv4.1 definitions diff --git a/j1eforth/j1.4th b/j1eforth/j1.4th deleted file mode 100644 index 7a1a900..0000000 --- a/j1eforth/j1.4th +++ /dev/null @@ -1,910 +0,0 @@ -( - eForth 1.04 for j1 Simulator by Edward A., July 2014 - Much of the code is derived from the following sources: - j1 Cross-compiler by James Bowman August 2010 - 8086 eForth 1.0 by Bill Muench and C. H. Ting, 1990 -) - -only forth definitions hex - -wordlist constant meta.1 -wordlist constant target.1 -wordlist constant assembler.1 - -: (order) ( w wid*n n -- wid*n w n ) - dup if - 1- swap >r recurse over r@ xor if - 1+ r> -rot exit then r> drop then ; -: -order ( wid -- ) get-order (order) nip set-order ; -: +order ( wid -- ) dup >r -order get-order r> swap 1+ set-order ; - -: ]asm ( -- ) assembler.1 +order ; immediate - -get-current meta.1 set-current - -: [a] ( "name" -- ) - parse-word assembler.1 search-wordlist 0= - abort" [a]?" compile, ; immediate -: a: ( "name" -- ) - get-current >r assembler.1 set-current - : r> set-current ; - -target.1 +order meta.1 +order - -a: asm[ ( -- ) assembler.1 -order ; immediate - -create tflash 1000 cells here over erase allot - -variable tdp - -: there tdp @ ; -: tc! tflash + c! ; -: tc@ tflash + c@ ; -: t! over ff and over tc! swap 8 rshift swap 1+ tc! ; -: t@ dup tc@ swap 1+ tc@ 8 lshift or ; -: talign there 1 and tdp +! ; -: tc, there tc! 1 tdp +! ; -: t, there t! 2 tdp +! ; -: $literal [char] " word count dup tc, 0 ?do - count tc, loop drop talign ; -: tallot tdp +! ; -: org tdp ! ; - -a: t 0000 ; -a: n 0100 ; -a: t+n 0200 ; -a: t&n 0300 ; -a: t|n 0400 ; -a: t^n 0500 ; -a: ~t 0600 ; -a: n==t 0700 ; -a: n>t 0900 ; -a: t-1 0a00 ; -a: rt 0b00 ; -a: [t] 0c00 ; -a: n<n 0080 or ; -a: t->r 0040 or ; -a: n->[t] 0020 or ; -a: d-1 0003 or ; -a: d+1 0001 or ; -a: r-1 000c or ; -a: r-2 0008 or ; -a: r+1 0004 or ; - -a: alu 6000 or t, ; - -a: return [a] t 1000 or [a] r-1 [a] alu ; -a: branch 2/ 0000 or t, ; -a: ?branch 2/ 2000 or t, ; -a: call 2/ 4000 or t, ; - -a: literal - dup 8000 and if - ffff xor recurse - [a] ~t [a] alu - else - 8000 or t, - then ; - -variable tlast -variable tuser - -0002 constant =major -0000 constant =minor -0040 constant =comp -0080 constant =imed -7f1f constant =mask -0002 constant =cell -0010 constant =base -0008 constant =bksp -000a constant =nl -000d constant =cr - -4000 constant =em -0000 constant =cold - - 8 constant =vocs -80 constant =us - -=em 100 - constant =tib -=tib =us - constant =up -=cold =us + constant =pick -=pick 100 + constant =code - -: thead - talign - tlast @ t, there tlast ! - parse-word dup tc, 0 ?do count tc, loop drop talign ; -: twords - cr tlast @ - begin - dup tflash + count 1f and type space =cell - t@ - ?dup 0= until ; -: [t] - parse-word target.1 search-wordlist 0= - abort" [t]?" >body @ ; immediate -: [last] tlast @ ; immediate -: ( [char] ) parse 2drop ; immediate -: literal [a] literal ; -: lookback there =cell - t@ ; -: call? lookback e000 and 4000 = ; -: call>goto there =cell - dup t@ 1fff and swap t! ; -: safe? lookback e000 and 6000 = lookback 004c and 0= and ; -: alu>return there =cell - dup t@ 1000 or [a] r-1 swap t! ; -: t: - >in @ thead >in ! - get-current >r target.1 set-current create - r> set-current 947947 talign there , does> @ [a] call ; -: exit - call? if - call>goto else safe? if - alu>return else - [a] return - then - then ; -: t; - 947947 <> if - abort" unstructured" then true if - exit else [a] return then ; -: u: - >in @ thead >in ! - get-current >r target.1 set-current create - r> set-current talign tuser @ dup , - [a] literal exit =cell tuser +! does> @ [a] literal ; -: [u] - parse-word target.1 search-wordlist 0= - abort" [t]?" >body @ =up - =cell + ; immediate -: immediate tlast @ tflash + dup c@ =imed or swap c! ; -: compile-only tlast @ tflash + dup c@ =comp or swap c! ; - - 0 tlast ! - =up tuser ! - -: hex# ( u -- addr len ) 0 <# base @ >r hex =nl hold # # # # r> base ! #> ; -: save-hex ( -- ) - parse-word w/o create-file throw - there 0 do i t@ over >r hex# r> write-file throw 2 +loop - close-file throw ; -: save-target ( -- ) - parse-word w/o create-file throw >r - tflash there r@ write-file throw r> close-file ; - -: begin there ; -: until [a] ?branch ; - -: if there 0 [a] ?branch ; -: skip there 0 [a] branch ; -: then begin 2/ over t@ or swap t! ; -: else skip swap then ; -: while if swap ; -: repeat [a] branch then ; -: again [a] branch ; -: aft drop skip begin swap ; - -: noop ]asm t alu asm[ ; -: + ]asm t+n d-1 alu asm[ ; -: xor ]asm t^n d-1 alu asm[ ; -: and ]asm t&n d-1 alu asm[ ; -: or ]asm t|n d-1 alu asm[ ; -: invert ]asm ~t alu asm[ ; -: = ]asm n==t d-1 alu asm[ ; -: < ]asm nn alu asm[ ; -: dup ]asm t t->n d+1 alu asm[ ; -: drop ]asm n d-1 alu asm[ ; -: over ]asm n t->n d+1 alu asm[ ; -: nip ]asm t d-1 alu asm[ ; -: >r ]asm n t->r r+1 d-1 alu asm[ ; -: r> ]asm rt t->n r-1 d+1 alu asm[ ; -: r@ ]asm rt t->n d+1 alu asm[ ; -: @ ]asm [t] alu asm[ ; -: ! ]asm t n->[t] d-1 alu - n d-1 alu asm[ ; -: dsp ]asm dsp t->n d+1 alu asm[ ; -: lshift ]asm n<>t d-1 alu asm[ ; -: 1- ]asm t-1 alu asm[ ; -: 2r> ]asm rt t->n r-1 d+1 alu - rt t->n r-1 d+1 alu - n t->n alu asm[ ; -: 2>r ]asm n t->n alu - n t->r r+1 d-1 alu - n t->r r+1 d-1 alu asm[ ; -: 2r@ ]asm 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 asm[ ; -: unloop - ]asm t r-1 alu - t r-1 alu asm[ ; - -: dup@ ]asm [t] t->n d+1 alu asm[ ; -: dup>r ]asm t t->r r+1 alu asm[ ; -: 2dupxor ]asm t^n t->n d+1 alu asm[ ; -: 2dup= ]asm n==t t->n d+1 alu asm[ ; -: !nip ]asm t n->[t] d-1 alu asm[ ; -: 2dup! ]asm t n->[t] alu asm[ ; - -: up1 ]asm t d+1 alu asm[ ; -: down1 ]asm t d-1 alu asm[ ; -: copy ]asm n alu asm[ ; - -a: down e for down1 next copy exit ; -a: up e for up1 next noop exit ; - -: for >r begin ; -: next r@ while r> 1- >r repeat r> drop ; - -=pick org - - ]asm down up asm[ - -there constant =pickbody - - copy ]asm return asm[ - 9c ]asm call asm[ bc ]asm branch asm[ - 9a ]asm call asm[ ba ]asm branch asm[ - 98 ]asm call asm[ b8 ]asm branch asm[ - 96 ]asm call asm[ b6 ]asm branch asm[ - 94 ]asm call asm[ b4 ]asm branch asm[ - 92 ]asm call asm[ b2 ]asm branch asm[ - 90 ]asm call asm[ b0 ]asm branch asm[ - 8e ]asm call asm[ ae ]asm branch asm[ - 8c ]asm call asm[ ac ]asm branch asm[ - 8a ]asm call asm[ aa ]asm branch asm[ - 88 ]asm call asm[ a8 ]asm branch asm[ - 86 ]asm call asm[ a6 ]asm branch asm[ - 84 ]asm call asm[ a4 ]asm branch asm[ - 82 ]asm call asm[ a2 ]asm branch asm[ - 80 ]asm call asm[ a0 ]asm branch asm[ - ]asm return asm[ - -=cold org - -0 t, - -there constant =uzero - =base t, ( base ) - 0 t, ( temp ) - 0 t, ( >in ) - 0 t, ( #tib ) - =tib t, ( tib ) - 0 t, ( 'eval ) - 0 t, ( 'abort ) - 0 t, ( hld ) - - ( context ) - - 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, 0 t, - - ( forth-wordlist ) - - 0 t, ( na, of last definition, linked ) - 0 t, ( wid|0, next or last wordlist in chain ) - 0 t, ( na, wordlist name pointer ) - - ( current ) - - 0 t, ( wid, new definitions ) - 0 t, ( wid, head of chain ) - - 0 t, ( dp ) - 0 t, ( last ) - 0 t, ( '?key ) - 0 t, ( 'emit ) - 0 t, ( 'boot ) - 0 t, ( '\ ) - 0 t, ( '?name ) - 0 t, ( '$,n ) - 0 t, ( 'overt ) - 0 t, ( '; ) - 0 t, ( 'create ) -there constant =ulast -=ulast =uzero - constant =udiff - -=code org - -t: noop noop t; -t: + + t; -t: xor xor t; -t: and and t; -t: or or t; -t: invert invert t; -t: = = t; -t: < < t; -t: u< u< t; -t: swap swap t; -t: u> swap u< t; -t: dup dup t; -t: drop drop t; -t: over over t; -t: nip nip t; -t: lshift lshift t; -t: rshift rshift t; -t: 1- 1- t; -t: >r r> swap >r >r t; compile-only -t: r> r> r> swap >r t; compile-only -t: r@ r> r> dup >r swap >r t; compile-only -t: @ ( a -- w ) @ t; -t: ! ( w a -- ) ! t; - -t: <> = invert t; -t: 0< 0 literal < t; -t: 0= 0 literal = t; -t: > swap < t; -t: 0> 0 literal swap < t; -t: >= < invert t; -t: tuck swap over t; -t: -rot swap >r swap r> t; -t: 2/ 1 literal rshift t; -t: 2* 1 literal lshift t; -t: 1+ 1 literal + t; -t: sp@ dsp ff literal and t; -t: execute ( ca -- ) >r t; -t: bye ( -- ) 7002 literal ! t; -t: c@ ( b -- c ) - dup @ swap 1 literal and if - 8 literal rshift else ff literal and then exit t; -t: c! ( c b -- ) - swap ff literal and dup 8 literal lshift or swap - tuck dup @ swap 1 literal and 0 literal = ff literal xor - >r over xor r> and xor swap ! t; -t: um+ ( w w -- w cy ) - over over + >r - r@ 0 literal >= >r - over over and - 0< r> or >r - or 0< r> and invert 1+ - r> swap t; -t: dovar ( -- a ) r> t; compile-only -t: up dovar =up t, t; -t: douser ( -- a ) up @ r> @ + t; compile-only - -u: base -u: temp -u: >in -u: #tib -u: tib -u: 'eval -u: 'abort -u: hld -u: context - =vocs =cell * tuser +! -u: forth-wordlist - =cell tuser +! - =cell tuser +! -u: current - =cell tuser +! -u: dp -u: last -u: '?key -u: 'emit -u: 'boot -u: '\ -u: 'name? -u: '$,n -u: 'overt -u: '; -u: 'create - -t: ?dup ( w -- w w | 0 ) dup if dup then exit t; -t: rot ( w1 w2 w3 -- w2 w3 w1 ) >r swap r> swap t; -t: 2drop ( w w -- ) drop drop t; -t: 2dup ( w1 w2 -- w1 w2 w1 w2 ) over over t; -t: negate ( n -- -n ) invert 1+ t; -t: dnegate ( d -- -d ) - invert >r invert 1 literal um+ r> + t; -t: - ( n1 n2 -- n1-n2 ) negate + t; -t: abs ( n -- n ) dup 0< if negate then exit t; -t: max ( n n -- n ) 2dup > if drop exit then nip t; -t: min ( n n -- n ) 2dup < if drop exit then nip t; -t: within ( u ul uh -- t ) over - >r - r> u< t; -t: um/mod ( udl udh u -- ur uq ) - 2dup u< if - negate f literal - for >r dup um+ >r >r dup um+ r> + dup - r> r@ swap >r um+ r> or if - >r drop 1+ r> - else - drop - then r> - next drop swap exit - then drop 2drop -1 literal dup t; -t: m/mod ( d n -- r q ) - dup 0< dup >r if - negate >r dnegate r> - then >r dup 0< if - r@ + - then r> um/mod r> if - swap negate swap then exit t; -t: /mod ( n n -- r q ) over 0< swap m/mod t; -t: mod ( n n -- r ) /mod drop t; -t: / ( n n -- q ) /mod nip t; -t: um* ( u u -- ud ) - 0 literal swap f literal - for dup um+ >r >r dup um+ r> + r> if - >r over um+ r> + then - next rot drop t; -t: * ( n n -- n ) um* drop t; -t: m* ( n n -- d ) - 2dup xor 0< >r abs swap abs um* r> if - dnegate then exit t; -t: */mod ( n1 n2 n3 -- r q ) >r m* r> m/mod t; -t: */ ( n1 n2 n3 -- q ) */mod nip t; -t: cell+ ( a -- a ) =cell literal + t; -t: cell- ( a -- a ) =cell literal - t; -t: cells ( n -- n ) 1 literal lshift t; -t: bl ( -- 32 ) 20 literal t; -t: >char ( c -- c ) - 7f literal and dup 7f literal bl within if - drop 5f literal then exit t; -t: +! ( n a -- ) tuck @ + swap ! t; -t: 2! ( d a -- ) swap over ! cell+ ! t; -t: 2@ ( a -- d ) dup cell+ @ swap @ t; -t: count ( b -- b +n ) dup 1+ swap c@ t; -t: here ( -- a ) dp @ t; -t: aligned ( b -- a ) - dup 0 literal =cell literal um/mod drop dup if - =cell literal swap - then + t; -t: align ( -- ) here aligned dp ! t; -t: pad ( -- a ) here 50 literal + aligned t; -t: @execute ( a -- ) @ ?dup if execute then exit t; -t: fill ( b u c -- ) - swap for swap aft 2dup c! 1+ then next 2drop t; -t: erase 0 literal fill t; -t: digit ( u -- c ) 9 literal over < 7 literal and + 30 literal + t; -t: extract ( n base -- n c ) 0 literal swap um/mod swap digit t; -t: <# ( -- ) pad hld ! t; -t: hold ( c -- ) hld @ 1- dup hld ! c! t; -t: # ( u -- u ) base @ extract hold t; -t: #s ( u -- 0 ) begin # dup while repeat t; -t: sign ( n -- ) 0< if 2d literal hold then exit t; -t: #> ( w -- b u ) drop hld @ pad over - t; -t: str ( n -- b u ) dup >r abs <# #s r> sign #> t; -t: hex ( -- ) 10 literal base ! t; -t: decimal ( -- ) a literal base ! t; -t: digit? ( c base -- u t ) - >r 30 literal - 9 literal over < if - dup 20 literal > if - 20 literal - - then - 7 literal - dup a literal < or - then dup r> u< t; -t: number? ( a -- n t | a f ) - base @ >r 0 literal over count - over c@ 24 literal = if - hex swap 1+ swap 1- then - over c@ 2d literal = >r - swap r@ - swap r@ + ?dup if - 1- - for dup >r c@ base @ digit? - while swap base @ * + r> 1+ - next r@ nip if - negate then swap - else r> r> 2drop 2drop 0 literal - then dup - then r> 2drop r> base ! t; -t: ?rx ( -- c t | f ) 7001 literal @ 1 literal and 0= invert t; -t: tx! ( c -- ) - begin - 7001 literal @ 2 literal and 0= - until 7000 literal ! t; -t: ?key ( -- c ) '?key @execute t; -t: emit ( c -- ) 'emit @execute t; -t: key ( -- c ) - begin - ?key - until 7000 literal @ t; -t: nuf? ( -- t ) ?key dup if drop key =nl literal = then exit t; -t: space ( -- ) bl emit t; -t: spaces ( +n -- ) 0 literal max for aft space then next t; -t: type ( b u -- ) for aft count emit then next drop t; -t: cr ( -- ) =cr literal emit =nl literal emit t; -t: do$ ( -- a ) r> r@ r> count + aligned >r swap >r t; compile-only -t: $"| ( -- a ) do$ noop t; compile-only -t: .$ ( a -- ) count type t; -t: ."| ( -- ) do$ .$ t; compile-only -t: .r ( n +n -- ) >r str r> over - spaces type t; -t: u.r ( u +n -- ) >r <# #s #> r> over - spaces type t; -t: u. ( u -- ) <# #s #> space type t; -t: . ( w -- ) base @ a literal xor if u. exit then str space type t; -t: cmove ( b1 b2 u -- ) for aft >r dup c@ r@ c! 1+ r> 1+ then next 2drop t; -t: pack$ ( b u a -- a ) dup >r 2dup ! 1+ swap cmove r> t; -t: ? ( a -- ) @ . t; -t: (parse) ( b u c -- b u delta ; ) - temp ! over >r dup if - 1- temp @ bl = if - for - count temp @ swap - 0< invert r@ 0> and - while next r> drop 0 literal dup exit - then 1- r> - then over swap - for - count temp @ swap - temp @ bl = if - 0< then - while next dup >r else r> drop dup >r 1- - then over - r> r> - exit - then over r> - t; -t: parse ( c -- b u ; ) - >r - tib @ >in @ + - #tib @ >in @ - r> - (parse) - >in +! t; -t: .( ( -- ) 29 literal parse type t; immediate -t: ( ( -- ) 29 literal parse 2drop t; immediate -t: <\> ( -- ) #tib @ >in ! t; immediate -t: \ ( -- ) '\ @execute t; immediate -t: word ( c -- a ; ) parse here cell+ pack$ t; -t: token ( -- a ; ) bl word t; -t: name> ( na -- ca ) count 1f literal and + aligned t; -t: same? ( a a u -- a a f \ -0+ ) - 1- - for aft over r@ + c@ - over r@ + c@ - ?dup - if r> drop exit then then - next 0 literal t; -t: find ( a va -- ca na | a f ) - swap - dup c@ temp ! - dup @ >r - cell+ swap - begin @ dup - if dup @ =mask literal and r@ xor - if cell+ -1 literal else cell+ temp @ same? then - else r> drop swap cell- swap exit - then - while 2 literal cells - - repeat r> drop nip cell- dup name> swap t; -t: ( a -- ca na | a f ) - context dup 2@ xor if cell- then >r - begin - r> cell+ dup >r @ ?dup - while - find ?dup - until r> drop exit then r> drop 0 literal t; -t: name? ( a -- ca na | a f ) 'name? @execute t; -t: ^h ( bot eot cur -- bot eot cur ) - >r over r@ < dup if - =bksp literal dup emit space - emit then r> + t; -t: tap ( bot eot cur c -- bot eot cur ) - dup emit over c! 1+ t; -t: ktap ( bot eot cur c -- bot eot cur ) - dup =nl literal xor if - =bksp literal xor if - bl tap exit - then ^h exit - then drop nip dup t; -t: accept ( b u -- b u ) - over + over - begin - 2dup xor - while - key dup bl - 7f literal u< if tap else ktap then - repeat drop over - t; -t: query ( -- ) tib @ 50 literal accept #tib ! drop 0 literal >in ! t; -t: abort2 do$ drop t; -t: abort1 space .$ 3f literal emit cr 'abort @execute abort2 t; -t: if do$ abort1 exit then abort2 t; compile-only -t: forget ( -- ) - token name? ?dup if - cell- dup dp ! - @ dup context ! last ! - drop exit - then abort1 t; -t: $interpret ( a -- ) - name? ?dup if - @ =comp literal and - $literal compile-only" execute exit - else number? if - exit then abort1 then t; -t: [ ( -- ) [t] $interpret literal 'eval ! t; immediate -t: .ok ( -- ) - [t] $interpret literal 'eval @ = if - ."| $literal ok" - then cr t; -t: eval ( -- ) - begin - token dup c@ - while - 'eval @execute - repeat drop .ok t; -t: $eval ( a u -- ) - >in @ >r #tib @ >r tib @ >r - [t] >in literal 0 literal swap ! - #tib ! tib ! eval r> tib ! r> #tib ! r> >in ! t; compile-only -t: preset ( -- ) =tib literal #tib cell+ ! t; -t: quit ( -- ) - [ begin - query eval - again t; -t: abort drop preset .ok quit t; -t: ' ( -- ca ) token name? if exit then abort1 t; -t: allot ( n -- ) aligned dp +! t; -t: , ( w -- ) here dup cell+ dp ! ! t; -t: call, ( ca -- ) 1 literal rshift 4000 literal or , t; compile-only -t: ?branch ( ca -- ) 1 literal rshift 2000 literal or , t; compile-only -t: branch ( ca -- ) 1 literal rshift 0000 literal or , t; compile-only -t: [compile] ( -- ; ) ' call, t; immediate -t: compile ( -- ) r> dup @ , cell+ >r t; compile-only -t: recurse last @ name> call, t; immediate -t: pick dup 2* 2* =pickbody literal + >r t; -t: literal ( w -- ) - dup 8000 literal and if - ffff literal xor [t] literal ]asm call asm[ compile invert - else - 8000 literal or , - then exit t; immediate -t: ['] ' [t] literal ]asm call asm[ t; immediate -t: $," ( -- ) 22 literal parse here pack$ count + aligned dp ! t; -t: for ( -- a ) compile [t] >r ]asm call asm[ here t; compile-only immediate -t: begin ( -- a ) here t; compile-only immediate -t: (next) ( n -- ) r> r> ?dup if 1- >r @ >r exit then cell+ >r t; compile-only -t: next ( -- ) compile (next) , t; compile-only immediate -t: (do) ( limit index -- index ) r> dup >r swap rot >r >r cell+ >r t; compile-only -t: do ( limit index -- ) compile (do) 0 literal , here t; compile-only immediate -t: (leave) r> drop r> drop r> drop t; compile-only -t: leave compile (leave) noop t; compile-only immediate -t: (loop) - r> r> 1+ r> 2dup <> if - >r >r @ >r exit - then >r 1- >r cell+ >r t; compile-only -t: (unloop) r> r> drop r> drop r> drop >r t; compile-only -t: unloop compile (unloop) noop t; compile-only immediate -t: (?do) - 2dup <> if - r> dup >r swap rot >r >r cell+ >r exit - then 2drop exit t; compile-only -t: ?do ( limit index -- ) compile (?do) 0 literal , here t; compile-only immediate -t: loop ( -- ) compile (loop) dup , compile (unloop) cell- here 1 literal rshift swap ! t; compile-only immediate -t: (+loop) - r> swap r> r> 2dup - >r - 2 literal pick r@ + r@ xor 0< 0= - 3 literal pick r> xor 0< 0= or if - >r + >r @ >r exit - then >r >r drop cell+ >r t; compile-only -t: +loop ( n -- ) compile (+loop) dup , compile (unloop) cell- here 1 literal rshift swap ! t; compile-only immediate -t: (i) ( -- index ) r> r> tuck >r >r t; compile-only -t: i ( -- index ) compile (i) noop t; compile-only immediate -t: until ( a -- ) ?branch t; compile-only immediate -t: again ( a -- ) branch t; compile-only immediate -t: if ( -- a ) here 0 literal ?branch t; compile-only immediate -t: then ( a -- ) here 1 literal rshift over @ or swap ! t; compile-only immediate -t: repeat ( a a -- ) branch [t] then ]asm call asm[ t; compile-only immediate -t: skip here 0 literal branch t; compile-only immediate -t: aft ( a -- a a ) drop [t] skip ]asm call asm[ [t] begin ]asm call asm[ swap t; compile-only immediate -t: else ( a -- a ) [t] skip ]asm call asm[ swap [t] then ]asm call asm[ t; compile-only immediate -t: while ( a -- a a ) [t] if ]asm call asm[ swap t; compile-only immediate -t: (case) r> swap >r >r t; compile-only -t: case compile (case) 30 literal t; compile-only immediate -t: (of) r> r@ swap >r = t; compile-only -t: of compile (of) [t] if ]asm call asm[ t; compile-only immediate -t: endof [t] else ]asm call asm[ 31 literal t; compile-only immediate -t: (endcase) r> r> drop >r t; -t: endcase - begin - dup 31 literal = - while - drop - [t] then ]asm call asm[ - repeat - 30 literal <> $literal bad case construct." - compile (endcase) noop t; compile-only immediate -t: $" ( -- ; ) compile $"| $," t; compile-only immediate -t: ." ( -- ; ) compile ."| $," t; compile-only immediate -t: >body ( ca -- pa ) cell+ t; -t: (to) ( n -- ) r> dup cell+ >r @ ! t; compile-only -t: to ( n -- ) compile (to) ' >body , t; compile-only immediate -t: (+to) ( n -- ) r> dup cell+ >r @ +! t; compile-only -t: +to ( n -- ) compile (+to) ' >body , t; compile-only immediate -t: get-current ( -- wid ) current @ t; -t: set-current ( wid -- ) current ! t; -t: definitions ( -- ) context @ set-current t; -t: ?unique ( a -- a ) - dup get-current find if ."| $literal redef " over .$ then drop t; -t: <$,n> ( na -- ) - dup c@ if - ?unique - dup count + aligned - dp ! - dup last ! - cell- - get-current @ - swap ! exit - then drop $"| $literal name" abort1 t; -t: $,n ( na -- ) '$,n @execute t; -t: $compile ( a -- ) - name? ?dup if - @ =imed literal and if - execute exit - else call, exit - then - then - number? if - [t] literal ]asm call asm[ exit then abort1 t; -t: abort" compile $," t; immediate -t: ( -- ) last @ get-current ! t; -t: overt ( -- ) 'overt @execute t; -t: exit r> drop t; -t: <;> ( -- ) - compile [t] exit ]asm call asm[ - [ overt 0 literal here ! t; compile-only immediate -t: ; ( -- ) '; @execute t; compile-only immediate -t: ] ( -- ) [t] $compile literal 'eval ! t; -t: : ( -- ; ) token $,n ] t; -t: immediate ( -- ) =imed literal last @ @ or last @ ! t; -t: user ( u -- ; ) token $,n overt compile douser , t; -t: ( -- ; ) token $,n overt [t] dovar ]asm literal asm[ call, t; -t: create ( -- ; ) 'create @execute t; -t: variable ( -- ; ) create 0 literal , t; -t: (does>) ( -- ) - r> 1 literal rshift here 1 literal rshift - last @ name> dup cell+ ]asm 8000 literal asm[ or , ! , t; compile-only -t: compile-only ( -- ) =comp literal last @ @ or last @ ! t; -t: does> ( -- ) compile (does>) noop t; immediate -t: char ( -- char ) ( -- c ) bl word 1+ c@ t; -t: [char] char [t] literal ]asm call asm[ t; immediate -t: constant create , (does>) @ t; -t: defer create 0 literal , - (does>) - @ ?dup 0 literal = - $literal uninitialized" execute t; -t: is ' >body ! t; immediate -t: .id ( na -- ) - ?dup if - count 1f literal and type exit then - cr ."| $literal {noname}" t; -t: wordlist ( -- wid ) align here 0 literal , dup current cell+ dup @ , ! 0 literal , t; -t: order@ ( a -- u*wid u ) dup @ dup if >r cell+ order@ r> swap 1+ exit then nip t; -t: get-order ( -- u*wid u ) context order@ t; -t: >wid ( wid -- ) cell+ t; -t: .wid ( wid -- ) - space dup >wid cell+ @ ?dup if .id drop exit then 0 literal u.r t; -t: !wid ( wid -- ) >wid cell+ last @ swap ! t; -t: vocs ( -- ) ( list all wordlists ) - cr ."| $literal vocs:" current cell+ - begin - @ ?dup - while - dup .wid >wid - repeat t; -t: order ( -- ) ( list search order ) - cr ."| $literal search:" get-order - begin - ?dup - while - swap .wid 1- - repeat - cr ."| $literal define:" get-current .wid t; -t: set-order ( u*wid n -- ) ( 16.6.1.2197 ) - dup -1 literal = if - drop forth-wordlist 1 literal then - =vocs literal over u< $literal over size of #vocs" - context swap - begin - dup - while - >r swap over ! cell+ r> - 1- - repeat swap ! t; -t: only ( -- ) -1 literal set-order t; -t: also ( -- ) get-order over swap 1+ set-order t; -t: previous ( -- ) get-order swap drop 1- set-order t; -t: >voc ( wid 'name' -- ) - create dup , !wid - (does>) - @ >r get-order swap drop r> swap set-order t; -t: widof ( "vocabulary" -- wid ) ' >body @ t; -t: vocabulary ( 'name' -- ) wordlist >voc t; -t: _type ( b u -- ) for aft count >char emit then next drop t; -t: dm+ ( a u -- a ) - over 4 literal u.r space - for aft count 3 literal u.r then next t; -t: dump ( a u -- ) - base @ >r hex 10 literal / - for cr 10 literal 2dup dm+ -rot - 2 literal spaces _type - next drop r> base ! t; -t: .s ( ... -- ... ) cr sp@ 1- f literal and for r@ pick . next ."| $literal name) ( ca va -- na | f ) - begin - @ ?dup - while - 2dup name> xor - while cell- - repeat nip exit - then drop 0 literal t; -t: >name ( ca -- na | f ) - >r get-order - begin - ?dup - while - swap - r@ swap - (>name) - ?dup if - >r - 1- for aft drop then next - r> r> drop - exit - then - 1- - repeat - r> drop 0 literal t; -t: see ( -- ; ) - ' cr - begin - dup @ ?dup 700c literal xor - while - 3fff literal and 1 literal lshift - >name ?dup if - space .id - else - dup @ 7fff literal and u. - then - cell+ - repeat 2drop t; -t: (words) ( -- ) - cr - begin - @ ?dup - while - dup .id space cell- - repeat t; -t: words - get-order - begin - ?dup - while - swap - cr cr ."| $literal :" dup .wid cr - (words) - 1- - repeat t; -t: ver ( -- n ) =major literal 100 literal * =minor literal + t; -t: hi ( -- ) - cr ."| $literal eforth j1 v" - base @ hex - ver <# # # 2e literal hold # #> - type base ! cr t; -t: cold ( -- ) - =uzero literal =up literal =udiff literal cmove - preset forth-wordlist dup context ! dup current 2! overt - 4000 literal cell+ dup cell- @ $eval - 'boot @execute - quit - cold t; - -target.1 -order set-current - -there [u] dp t! -[last] [u] last t! -[t] ?rx [u] '?key t! -[t] tx! [u] 'emit t! -[t] <\> [u] '\ t! -[t] $interpret [u] 'eval t! -[t] abort [u] 'abort t! -[t] hi [u] 'boot t! -[t] [u] 'name? t! -[t] [u] 'overt t! -[t] <$,n> [u] '$,n t! -[t] <;> [u] '; t! -[t] [u] 'create t! -[t] cold 2/ =cold t! - -save-target j1.bin -save-hex j1.hex - -meta.1 -order - -bye diff --git a/j1eforth/j1.c b/j1eforth/j1.c deleted file mode 100644 index 926adb5..0000000 --- a/j1eforth/j1.c +++ /dev/null @@ -1,162 +0,0 @@ -#include -#include -#include -#include -#include -#if defined(unix) || defined(__unix__) || defined(__unix) || (defined(__APPLE__) && defined(__MACH__)) -#include -#include -int getch(void) { /* reads from keypress, doesn't echo */ - struct termios oldattr, newattr; - int ch; - tcgetattr( STDIN_FILENO, &oldattr ); - newattr = oldattr; - // newattr.c_iflag &= ~( ICRNL ); - newattr.c_lflag &= ~( ICANON | ECHO ); - tcsetattr( STDIN_FILENO, TCSANOW, &newattr ); - ch = getchar(); - tcsetattr( STDIN_FILENO, TCSANOW, &oldattr ); - // printf("%d\n", ch); - if(ch==0x1b) exit(0); - return ch==127 ? 8 : ch; -} -int putch(int c) { /* output character to sstdout & flush */ - int res=putchar(c); - fflush(stdout); - return res; -} -#endif -int len = 0; -static unsigned short t; -static unsigned short s; -static unsigned short d[0x20]; /* data stack */ -static unsigned short r[0x20]; /* return stack */ -static unsigned short pc; /* program counter, counts cells */ -static unsigned char dsp, rsp; /* point to top entry */ -static unsigned short* memory; /* ram */ -static int sx[4] = { 0, 1, -2, -1 }; /* 2-bit sign extension */ - -static void push(int v) // push v on the data stack -{ - dsp = 0x1f & (dsp + 1); - d[dsp] = t; - t = v; -} - -static int pop(void) // pop value from the data stack and return it -{ - int v = t; - t = d[dsp]; - dsp = 0x1f & (dsp - 1); - return v; -} - -static void execute(int entrypoint) -{ - int i = 0; - int j = 0; - int _pc, _t; - int insn = 0x4000 | entrypoint; // first insn: "call entrypoint" - do { - _pc = pc + 1; - if (insn & 0x8000) { // literal - push(insn & 0x7fff); - } else { - int target = insn & 0x1fff; - switch (insn >> 13) { - case 0: // jump - _pc = target; - break; - case 1: // conditional jump - if (pop() == 0) - _pc = target; - break; - case 2: // call - rsp = 31 & (rsp + 1); - r[rsp] = _pc << 1; - _pc = target; - break; - case 3: // alu - if (insn & 0x1000) {/* r->pc */ - _pc = r[rsp] >> 1; - } - s = d[dsp]; - switch ((insn >> 8) & 0xf) { - case 0: _t = t; break; /* noop */ - case 1: _t = s; break; /* copy */ - case 2: _t = t+s; break; /* + */ - case 3: _t = t&s; break; /* and */ - case 4: _t = t|s; break; /* or */ - case 5: _t = t^s; break; /* xor */ - case 6: _t = ~t; break; /* invert */ - case 7: _t = -(t==s); break; /* = */ - case 8: _t = -((signed short)s < (signed short)t); break; /* < */ - case 9: _t = s>>t; break; /* rshift */ - case 0xa: _t = t-1; break; /* 1- */ - case 0xb: _t = r[rsp]; break; /* r@ */ - case 0xc: switch (t) { - case 0x7001: _t = 1; break; - case 0x7000: _t = getch(); break; - default: _t = memory[t>>1]; break; - } - break; /* @ */ - case 0xd: _t = s<> 2) & 3]); /* rstack+- */ - if (insn & 0x80) /* t->s */ - d[dsp] = t; - if (insn & 0x40) /* t->r */ - r[rsp] = t; - if (insn & 0x20) /* s->[t] */ - switch (t) { - case 0x7002: rsp = 0; break; - case 0x7000: putch(s); break; - default: memory[t>>1]=s; break; /* ! */ - } - t = _t; - break; - } - } - pc = _pc; - insn = memory[pc]; -#if DEBUG - printf("%d: pc: %0.4x; sp: %0.4x\n", i, pc, t); - printf("\td:"); - for (j = 0; j < dsp; j++) { - printf(" %0.4x", d[j]); - } - printf("\n\tr:"); - for (j = 0; j < rsp; j++) { - printf(" %0.4x", r[j]); - } - printf("\n"); -#endif - i++; - } while (1); -} -/* end of cpu */ - -/* start of i/o demo */ - - -int main(int argc , char *argv[]) -{ - unsigned short m[0x4000]; /* 32kb or RAM */ - FILE *f = fopen("j1.bin", "rb"); - fread(m, 0x2000, sizeof(m[0]), f); /* 0kb - 16kb data and code */ - fclose(f); - if (argc>1) { // program name is counted as one - struct stat st; - f = fopen(argv[1], "r"); - stat(argv[1], &st); - (&m[0x2000])[0] = st.st_size; /* 16kb - 32kb memory mapped i/o */ - fread(&m[0x2001], 0x2000, sizeof(m[0]), f); - fclose(f); - } - memory = m; - execute(0x00); - return 0; -} diff --git a/jonesforth/Dockerfile b/jonesforth/Dockerfile deleted file mode 100644 index 14c1c0a..0000000 --- a/jonesforth/Dockerfile +++ /dev/null @@ -1,6 +0,0 @@ -FROM debian -RUN apt-get update && apt-get install -y libc6-dev-i386 -COPY jonesforth.* / -RUN gcc -m32 -nostdlib -static -Wl,-Ttext,0 -Wl,--build-id=none -o jonesforth jonesforth.S -CMD cat jonesforth.fs - | ./jonesforth -# NOTE requires SYS_RAWIO diff --git a/jonesforth/docker-compose.yml b/jonesforth/docker-compose.yml deleted file mode 100644 index b78971c..0000000 --- a/jonesforth/docker-compose.yml +++ /dev/null @@ -1,6 +0,0 @@ -version: '3' -services: - jonesforth: - build: . - cap_add: - - SYS_RAWIO diff --git a/jonesforth/jonesforth.S b/jonesforth/jonesforth.S deleted file mode 100644 index 8d13286..0000000 --- a/jonesforth/jonesforth.S +++ /dev/null @@ -1,2313 +0,0 @@ -/* A sometimes minimal FORTH compiler and tutorial for Linux / i386 systems. -*- asm -*- - By Richard W.M. Jones http://annexia.org/forth - This is PUBLIC DOMAIN (see public domain release statement below). - $Id: jonesforth.S,v 1.45 2007/10/22 18:53:13 rich Exp $ - - gcc -m32 -nostdlib -static -Wl,-Ttext,0 -Wl,--build-id=none -o jonesforth jonesforth.S -*/ - .set JONES_VERSION,45 -/* - INTRODUCTION ---------------------------------------------------------------------- - - FORTH is one of those alien languages which most working programmers regard in the same - way as Haskell, LISP, and so on. Something so strange that they'd rather any thoughts - of it just go away so they can get on with writing this paying code. But that's wrong - and if you care at all about programming then you should at least understand all these - languages, even if you will never use them. - - LISP is the ultimate high-level language, and features from LISP are being added every - decade to the more common languages. But FORTH is in some ways the ultimate in low level - programming. Out of the box it lacks features like dynamic memory management and even - strings. In fact, at its primitive level it lacks even basic concepts like IF-statements - and loops. - - Why then would you want to learn FORTH? There are several very good reasons. First - and foremost, FORTH is minimal. You really can write a complete FORTH in, say, 2000 - lines of code. I don't just mean a FORTH program, I mean a complete FORTH operating - system, environment and language. You could boot such a FORTH on a bare PC and it would - come up with a prompt where you could start doing useful work. The FORTH you have here - isn't minimal and uses a Linux process as its 'base PC' (both for the purposes of making - it a good tutorial). It's possible to completely understand the system. Who can say they - completely understand how Linux works, or gcc? - - Secondly FORTH has a peculiar bootstrapping property. By that I mean that after writing - a little bit of assembly to talk to the hardware and implement a few primitives, all the - rest of the language and compiler is written in FORTH itself. Remember I said before - that FORTH lacked IF-statements and loops? Well of course it doesn't really because - such a lanuage would be useless, but my point was rather that IF-statements and loops are - written in FORTH itself. - - Now of course this is common in other languages as well, and in those languages we call - them 'libraries'. For example in C, 'printf' is a library function written in C. But - in FORTH this goes way beyond mere libraries. Can you imagine writing C's 'if' in C? - And that brings me to my third reason: If you can write 'if' in FORTH, then why restrict - yourself to the usual if/while/for/switch constructs? You want a construct that iterates - over every other element in a list of numbers? You can add it to the language. What - about an operator which pulls in variables directly from a configuration file and makes - them available as FORTH variables? Or how about adding Makefile-like dependencies to - the language? No problem in FORTH. How about modifying the FORTH compiler to allow - complex inlining strategies -- simple. This concept isn't common in programming languages, - but it has a name (in fact two names): "macros" (by which I mean LISP-style macros, not - the lame C preprocessor) and "domain specific languages" (DSLs). - - This tutorial isn't about learning FORTH as the language. I'll point you to some references - you should read if you're not familiar with using FORTH. This tutorial is about how to - write FORTH. In fact, until you understand how FORTH is written, you'll have only a very - superficial understanding of how to use it. - - So if you're not familiar with FORTH or want to refresh your memory here are some online - references to read: - - http://en.wikipedia.org/wiki/Forth_%28programming_language%29 - - http://galileo.phys.virginia.edu/classes/551.jvn.fall01/primer.htm - - http://wiki.laptop.org/go/Forth_Lessons - - http://www.albany.net/~hello/simple.htm - - Here is another "Why FORTH?" essay: http://www.jwdt.com/~paysan/why-forth.html - - Discussion and criticism of this FORTH here: http://lambda-the-ultimate.org/node/2452 - - ACKNOWLEDGEMENTS ---------------------------------------------------------------------- - - This code draws heavily on the design of LINA FORTH (http://home.hccnet.nl/a.w.m.van.der.horst/lina.html) - by Albert van der Horst. Any similarities in the code are probably not accidental. - - Some parts of this FORTH are also based on this IOCCC entry from 1992: - http://ftp.funet.fi/pub/doc/IOCCC/1992/buzzard.2.design. - I was very proud when Sean Barrett, the original author of the IOCCC entry, commented in the LtU thread - http://lambda-the-ultimate.org/node/2452#comment-36818 about this FORTH. - - And finally I'd like to acknowledge the (possibly forgotten?) authors of ARTIC FORTH because their - original program which I still have on original cassette tape kept nagging away at me all these years. - http://en.wikipedia.org/wiki/Artic_Software - - PUBLIC DOMAIN ---------------------------------------------------------------------- - - I, the copyright holder of this work, hereby release it into the public domain. This applies worldwide. - - In case this is not legally possible, I grant any entity the right to use this work for any purpose, - without any conditions, unless such conditions are required by law. - - SETTING UP ---------------------------------------------------------------------- - - Let's get a few housekeeping things out of the way. Firstly because I need to draw lots of - ASCII-art diagrams to explain concepts, the best way to look at this is using a window which - uses a fixed width font and is at least this wide: - - <------------------------------------------------------------------------------------------------------------------------> - - Secondly make sure TABS are set to 8 characters. The following should be a vertical - line. If not, sort out your tabs. - - | - | - | - - Thirdly I assume that your screen is at least 50 characters high. - - ASSEMBLING ---------------------------------------------------------------------- - - If you want to actually run this FORTH, rather than just read it, you will need Linux on an - i386. Linux because instead of programming directly to the hardware on a bare PC which I - could have done, I went for a simpler tutorial by assuming that the 'hardware' is a Linux - process with a few basic system calls (read, write and exit and that's about all). i386 - is needed because I had to write the assembly for a processor, and i386 is by far the most - common. (Of course when I say 'i386', any 32- or 64-bit x86 processor will do. I'm compiling - this on a 64 bit AMD Opteron). - - Again, to assemble this you will need gcc and gas (the GNU assembler). The commands to - assemble and run the code (save this file as 'jonesforth.S') are: - - gcc -m32 -nostdlib -static -Wl,-Ttext,0 -Wl,--build-id=none -o jonesforth jonesforth.S - cat jonesforth.f - | ./jonesforth - - If you want to run your own FORTH programs you can do: - - cat jonesforth.f myprog.f | ./jonesforth - - If you want to load your own FORTH code and then continue reading user commands, you can do: - - cat jonesforth.f myfunctions.f - | ./jonesforth - - ASSEMBLER ---------------------------------------------------------------------- - - (You can just skip to the next section -- you don't need to be able to read assembler to - follow this tutorial). - - However if you do want to read the assembly code here are a few notes about gas (the GNU assembler): - - (1) Register names are prefixed with '%', so %eax is the 32 bit i386 accumulator. The registers - available on i386 are: %eax, %ebx, %ecx, %edx, %esi, %edi, %ebp and %esp, and most of them - have special purposes. - - (2) Add, mov, etc. take arguments in the form SRC,DEST. So mov %eax,%ecx moves %eax -> %ecx - - (3) Constants are prefixed with '$', and you mustn't forget it! If you forget it then it - causes a read from memory instead, so: - mov $2,%eax moves number 2 into %eax - mov 2,%eax reads the 32 bit word from address 2 into %eax (ie. most likely a mistake) - - (4) gas has a funky syntax for local labels, where '1f' (etc.) means label '1:' "forwards" - and '1b' (etc.) means label '1:' "backwards". Notice that these labels might be mistaken - for hex numbers (eg. you might confuse 1b with $0x1b). - - (5) 'ja' is "jump if above", 'jb' for "jump if below", 'je' "jump if equal" etc. - - (6) gas has a reasonably nice .macro syntax, and I use them a lot to make the code shorter and - less repetitive. - - For more help reading the assembler, do "info gas" at the Linux prompt. - - Now the tutorial starts in earnest. - - THE DICTIONARY ---------------------------------------------------------------------- - - In FORTH as you will know, functions are called "words", and just as in other languages they - have a name and a definition. Here are two FORTH words: - - : DOUBLE DUP + ; \ name is "DOUBLE", definition is "DUP +" - : QUADRUPLE DOUBLE DOUBLE ; \ name is "QUADRUPLE", definition is "DOUBLE DOUBLE" - - Words, both built-in ones and ones which the programmer defines later, are stored in a dictionary - which is just a linked list of dictionary entries. - - <--- DICTIONARY ENTRY (HEADER) -----------------------> - +------------------------+--------+---------- - - - - +----------- - - - - - | LINK POINTER | LENGTH/| NAME | DEFINITION - | | FLAGS | | - +--- (4 bytes) ----------+- byte -+- n bytes - - - - +----------- - - - - - - I'll come to the definition of the word later. For now just look at the header. The first - 4 bytes are the link pointer. This points back to the previous word in the dictionary, or, for - the first word in the dictionary it is just a NULL pointer. Then comes a length/flags byte. - The length of the word can be up to 31 characters (5 bits used) and the top three bits are used - for various flags which I'll come to later. This is followed by the name itself, and in this - implementation the name is rounded up to a multiple of 4 bytes by padding it with zero bytes. - That's just to ensure that the definition starts on a 32 bit boundary. - - A FORTH variable called LATEST contains a pointer to the most recently defined word, in - other words, the head of this linked list. - - DOUBLE and QUADRUPLE might look like this: - - pointer to previous word - ^ - | - +--|------+---+---+---+---+---+---+---+---+------------- - - - - - | LINK | 6 | D | O | U | B | L | E | 0 | (definition ...) - +---------+---+---+---+---+---+---+---+---+------------- - - - - - ^ len padding - | - +--|------+---+---+---+---+---+---+---+---+---+---+---+---+------------- - - - - - | LINK | 9 | Q | U | A | D | R | U | P | L | E | 0 | 0 | (definition ...) - +---------+---+---+---+---+---+---+---+---+---+---+---+---+------------- - - - - - ^ len padding - | - | - LATEST - - You should be able to see from this how you might implement functions to find a word in - the dictionary (just walk along the dictionary entries starting at LATEST and matching - the names until you either find a match or hit the NULL pointer at the end of the dictionary); - and add a word to the dictionary (create a new definition, set its LINK to LATEST, and set - LATEST to point to the new word). We'll see precisely these functions implemented in - assembly code later on. - - One interesting consequence of using a linked list is that you can redefine words, and - a newer definition of a word overrides an older one. This is an important concept in - FORTH because it means that any word (even "built-in" or "standard" words) can be - overridden with a new definition, either to enhance it, to make it faster or even to - disable it. However because of the way that FORTH words get compiled, which you'll - understand below, words defined using the old definition of a word continue to use - the old definition. Only words defined after the new definition use the new definition. - - DIRECT THREADED CODE ---------------------------------------------------------------------- - - Now we'll get to the really crucial bit in understanding FORTH, so go and get a cup of tea - or coffee and settle down. It's fair to say that if you don't understand this section, then you - won't "get" how FORTH works, and that would be a failure on my part for not explaining it well. - So if after reading this section a few times you don't understand it, please email me - (rich@annexia.org). - - Let's talk first about what "threaded code" means. Imagine a peculiar version of C where - you are only allowed to call functions without arguments. (Don't worry for now that such a - language would be completely useless!) So in our peculiar C, code would look like this: - - f () - { - a (); - b (); - c (); - } - - and so on. How would a function, say 'f' above, be compiled by a standard C compiler? - Probably into assembly code like this. On the right hand side I've written the actual - i386 machine code. - - f: - CALL a E8 08 00 00 00 - CALL b E8 1C 00 00 00 - CALL c E8 2C 00 00 00 - ; ignore the return from the function for now - - "E8" is the x86 machine code to "CALL" a function. In the first 20 years of computing - memory was hideously expensive and we might have worried about the wasted space being used - by the repeated "E8" bytes. We can save 20% in code size (and therefore, in expensive memory) - by compressing this into just: - - 08 00 00 00 Just the function addresses, without - 1C 00 00 00 the CALL prefix. - 2C 00 00 00 - - On a 16-bit machine like the ones which originally ran FORTH the savings are even greater - 33%. - - [Historical note: If the execution model that FORTH uses looks strange from the following - paragraphs, then it was motivated entirely by the need to save memory on early computers. - This code compression isn't so important now when our machines have more memory in their L1 - caches than those early computers had in total, but the execution model still has some - useful properties]. - - Of course this code won't run directly on the CPU any more. Instead we need to write an - interpreter which takes each set of bytes and calls it. - - On an i386 machine it turns out that we can write this interpreter rather easily, in just - two assembly instructions which turn into just 3 bytes of machine code. Let's store the - pointer to the next word to execute in the %esi register: - - 08 00 00 00 <- We're executing this one now. %esi is the _next_ one to execute. - %esi -> 1C 00 00 00 - 2C 00 00 00 - - The all-important i386 instruction is called LODSL (or in Intel manuals, LODSW). It does - two things. Firstly it reads the memory at %esi into the accumulator (%eax). Secondly it - increments %esi by 4 bytes. So after LODSL, the situation now looks like this: - - 08 00 00 00 <- We're still executing this one - 1C 00 00 00 <- %eax now contains this address (0x0000001C) - %esi -> 2C 00 00 00 - - Now we just need to jump to the address in %eax. This is again just a single x86 instruction - written JMP *(%eax). And after doing the jump, the situation looks like: - - 08 00 00 00 - 1C 00 00 00 <- Now we're executing this subroutine. - %esi -> 2C 00 00 00 - - To make this work, each subroutine is followed by the two instructions 'LODSL; JMP *(%eax)' - which literally make the jump to the next subroutine. - - And that brings us to our first piece of actual code! Well, it's a macro. -*/ - -/* NEXT macro. */ - .macro NEXT - lodsl - jmp *(%eax) - .endm - -/* The macro is called NEXT. That's a FORTH-ism. It expands to those two instructions. - - Every FORTH primitive that we write has to be ended by NEXT. Think of it kind of like - a return. - - The above describes what is known as direct threaded code. - - To sum up: We compress our function calls down to a list of addresses and use a somewhat - magical macro to act as a "jump to next function in the list". We also use one register (%esi) - to act as a kind of instruction pointer, pointing to the next function in the list. - - I'll just give you a hint of what is to come by saying that a FORTH definition such as: - - : QUADRUPLE DOUBLE DOUBLE ; - - actually compiles (almost, not precisely but we'll see why in a moment) to a list of - function addresses for DOUBLE, DOUBLE and a special function called EXIT to finish off. - - At this point, REALLY EAGLE-EYED ASSEMBLY EXPERTS are saying "JONES, YOU'VE MADE A MISTAKE!". - - I lied about JMP *(%eax). - - INDIRECT THREADED CODE ---------------------------------------------------------------------- - - It turns out that direct threaded code is interesting but only if you want to just execute - a list of functions written in assembly language. So QUADRUPLE would work only if DOUBLE - was an assembly language function. In the direct threaded code, QUADRUPLE would look like: - - +------------------+ - | addr of DOUBLE --------------------> (assembly code to do the double) - +------------------+ NEXT - %esi -> | addr of DOUBLE | - +------------------+ - - We can add an extra indirection to allow us to run both words written in assembly language - (primitives written for speed) and words written in FORTH themselves as lists of addresses. - - The extra indirection is the reason for the brackets in JMP *(%eax). - - Let's have a look at how QUADRUPLE and DOUBLE really look in FORTH: - - : QUADRUPLE DOUBLE DOUBLE ; - - +------------------+ - | codeword | : DOUBLE DUP + ; - +------------------+ - | addr of DOUBLE ---------------> +------------------+ - +------------------+ | codeword | - | addr of DOUBLE | +------------------+ - +------------------+ | addr of DUP --------------> +------------------+ - | addr of EXIT | +------------------+ | codeword -------+ - +------------------+ %esi -> | addr of + --------+ +------------------+ | - +------------------+ | | assembly to <-----+ - | addr of EXIT | | | implement DUP | - +------------------+ | | .. | - | | .. | - | | NEXT | - | +------------------+ - | - +-----> +------------------+ - | codeword -------+ - +------------------+ | - | assembly to <------+ - | implement + | - | .. | - | .. | - | NEXT | - +------------------+ - - This is the part where you may need an extra cup of tea/coffee/favourite caffeinated - beverage. What has changed is that I've added an extra pointer to the beginning of - the definitions. In FORTH this is sometimes called the "codeword". The codeword is - a pointer to the interpreter to run the function. For primitives written in - assembly language, the "interpreter" just points to the actual assembly code itself. - They don't need interpreting, they just run. - - In words written in FORTH (like QUADRUPLE and DOUBLE), the codeword points to an interpreter - function. - - I'll show you the interpreter function shortly, but let's recall our indirect - JMP *(%eax) with the "extra" brackets. Take the case where we're executing DOUBLE - as shown, and DUP has been called. Note that %esi is pointing to the address of + - - The assembly code for DUP eventually does a NEXT. That: - - (1) reads the address of + into %eax %eax points to the codeword of + - (2) increments %esi by 4 - (3) jumps to the indirect %eax jumps to the address in the codeword of +, - ie. the assembly code to implement + - - +------------------+ - | codeword | - +------------------+ - | addr of DOUBLE ---------------> +------------------+ - +------------------+ | codeword | - | addr of DOUBLE | +------------------+ - +------------------+ | addr of DUP --------------> +------------------+ - | addr of EXIT | +------------------+ | codeword -------+ - +------------------+ | addr of + --------+ +------------------+ | - +------------------+ | | assembly to <-----+ - %esi -> | addr of EXIT | | | implement DUP | - +------------------+ | | .. | - | | .. | - | | NEXT | - | +------------------+ - | - +-----> +------------------+ - | codeword -------+ - +------------------+ | - now we're | assembly to <-----+ - executing | implement + | - this | .. | - function | .. | - | NEXT | - +------------------+ - - So I hope that I've convinced you that NEXT does roughly what you'd expect. This is - indirect threaded code. - - I've glossed over four things. I wonder if you can guess without reading on what they are? - - . - . - . - - My list of four things are: (1) What does "EXIT" do? (2) which is related to (1) is how do - you call into a function, ie. how does %esi start off pointing at part of QUADRUPLE, but - then point at part of DOUBLE. (3) What goes in the codeword for the words which are written - in FORTH? (4) How do you compile a function which does anything except call other functions - ie. a function which contains a number like : DOUBLE 2 * ; ? - - THE INTERPRETER AND RETURN STACK ------------------------------------------------------------ - - Going at these in no particular order, let's talk about issues (3) and (2), the interpreter - and the return stack. - - Words which are defined in FORTH need a codeword which points to a little bit of code to - give them a "helping hand" in life. They don't need much, but they do need what is known - as an "interpreter", although it doesn't really "interpret" in the same way that, say, - Java bytecode used to be interpreted (ie. slowly). This interpreter just sets up a few - machine registers so that the word can then execute at full speed using the indirect - threaded model above. - - One of the things that needs to happen when QUADRUPLE calls DOUBLE is that we save the old - %esi ("instruction pointer") and create a new one pointing to the first word in DOUBLE. - Because we will need to restore the old %esi at the end of DOUBLE (this is, after all, like - a function call), we will need a stack to store these "return addresses" (old values of %esi). - - As you will have seen in the background documentation, FORTH has two stacks, an ordinary - stack for parameters, and a return stack which is a bit more mysterious. But our return - stack is just the stack I talked about in the previous paragraph, used to save %esi when - calling from a FORTH word into another FORTH word. - - In this FORTH, we are using the normal stack pointer (%esp) for the parameter stack. - We will use the i386's "other" stack pointer (%ebp, usually called the "frame pointer") - for our return stack. - - I've got two macros which just wrap up the details of using %ebp for the return stack. - You use them as for example "PUSHRSP %eax" (push %eax on the return stack) or "POPRSP %ebx" - (pop top of return stack into %ebx). -*/ - -/* Macros to deal with the return stack. */ - .macro PUSHRSP reg - lea -4(%ebp),%ebp // push reg on to return stack - movl \reg,(%ebp) - .endm - - .macro POPRSP reg - mov (%ebp),\reg // pop top of return stack to reg - lea 4(%ebp),%ebp - .endm - -/* - And with that we can now talk about the interpreter. - - In FORTH the interpreter function is often called DOCOL (I think it means "DO COLON" because - all FORTH definitions start with a colon, as in : DOUBLE DUP + ; - - The "interpreter" (it's not really "interpreting") just needs to push the old %esi on the - stack and set %esi to the first word in the definition. Remember that we jumped to the - function using JMP *(%eax)? Well a consequence of that is that conveniently %eax contains - the address of this codeword, so just by adding 4 to it we get the address of the first - data word. Finally after setting up %esi, it just does NEXT which causes that first word - to run. -*/ - -/* DOCOL - the interpreter! */ - .text - .align 4 -DOCOL: - PUSHRSP %esi // push %esi on to the return stack - addl $4,%eax // %eax points to codeword, so make - movl %eax,%esi // %esi point to first data word - NEXT - -/* - Just to make this absolutely clear, let's see how DOCOL works when jumping from QUADRUPLE - into DOUBLE: - - QUADRUPLE: - +------------------+ - | codeword | - +------------------+ DOUBLE: - | addr of DOUBLE ---------------> +------------------+ - +------------------+ %eax -> | addr of DOCOL | - %esi -> | addr of DOUBLE | +------------------+ - +------------------+ | addr of DUP | - | addr of EXIT | +------------------+ - +------------------+ | etc. | - - First, the call to DOUBLE calls DOCOL (the codeword of DOUBLE). DOCOL does this: It - pushes the old %esi on the return stack. %eax points to the codeword of DOUBLE, so we - just add 4 on to it to get our new %esi: - - QUADRUPLE: - +------------------+ - | codeword | - +------------------+ DOUBLE: - | addr of DOUBLE ---------------> +------------------+ -top of return +------------------+ %eax -> | addr of DOCOL | -stack points -> | addr of DOUBLE | + 4 = +------------------+ - +------------------+ %esi -> | addr of DUP | - | addr of EXIT | +------------------+ - +------------------+ | etc. | - - Then we do NEXT, and because of the magic of threaded code that increments %esi again - and calls DUP. - - Well, it seems to work. - - One minor point here. Because DOCOL is the first bit of assembly actually to be defined - in this file (the others were just macros), and because I usually compile this code with the - text segment starting at address 0, DOCOL has address 0. So if you are disassembling the - code and see a word with a codeword of 0, you will immediately know that the word is - written in FORTH (it's not an assembler primitive) and so uses DOCOL as the interpreter. - - STARTING UP ---------------------------------------------------------------------- - - Now let's get down to nuts and bolts. When we start the program we need to set up - a few things like the return stack. But as soon as we can, we want to jump into FORTH - code (albeit much of the "early" FORTH code will still need to be written as - assembly language primitives). - - This is what the set up code does. Does a tiny bit of house-keeping, sets up the - separate return stack (NB: Linux gives us the ordinary parameter stack already), then - immediately jumps to a FORTH word called QUIT. Despite its name, QUIT doesn't quit - anything. It resets some internal state and starts reading and interpreting commands. - (The reason it is called QUIT is because you can call QUIT from your own FORTH code - to "quit" your program and go back to interpreting). -*/ - -/* Assembler entry point. */ - .text - .globl _start -_start: - cld - mov %esp,var_S0 // Save the initial data stack pointer in FORTH variable S0. - mov $return_stack_top,%ebp // Initialise the return stack. - call set_up_data_segment - - mov $cold_start,%esi // Initialise interpreter. - NEXT // Run interpreter! - - .section .rodata -cold_start: // High-level code without a codeword. - .int QUIT - -/* - BUILT-IN WORDS ---------------------------------------------------------------------- - - Remember our dictionary entries (headers)? Let's bring those together with the codeword - and data words to see how : DOUBLE DUP + ; really looks in memory. - - pointer to previous word - ^ - | - +--|------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ - | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | - +---------+---+---+---+---+---+---+---+---+------------+--|---------+------------+------------+ - ^ len pad codeword | - | V - LINK in next word points to codeword of DUP - - Initially we can't just write ": DOUBLE DUP + ;" (ie. that literal string) here because we - don't yet have anything to read the string, break it up at spaces, parse each word, etc. etc. - So instead we will have to define built-in words using the GNU assembler data constructors - (like .int, .byte, .string, .ascii and so on -- look them up in the gas info page if you are - unsure of them). - - The long way would be: - - .int - .byte 6 // len - .ascii "DOUBLE" // string - .byte 0 // padding -DOUBLE: .int DOCOL // codeword - .int DUP // pointer to codeword of DUP - .int PLUS // pointer to codeword of + - .int EXIT // pointer to codeword of EXIT - - That's going to get quite tedious rather quickly, so here I define an assembler macro - so that I can just write: - - defword "DOUBLE",6,,DOUBLE - .int DUP,PLUS,EXIT - - and I'll get exactly the same effect. - - Don't worry too much about the exact implementation details of this macro - it's complicated! -*/ - -/* Flags - these are discussed later. */ - .set F_IMMED,0x80 - .set F_HIDDEN,0x20 - .set F_LENMASK,0x1f // length mask - - // Store the chain of links. - .set link,0 - - .macro defword name, namelen, flags=0, label - .section .rodata - .align 4 - .globl name_\label -name_\label : - .int link // link - .set link,name_\label - .byte \flags+\namelen // flags + length byte - .ascii "\name" // the name - .align 4 // padding to next 4 byte boundary - .globl \label -\label : - .int DOCOL // codeword - the interpreter - // list of word pointers follow - .endm - -/* - Similarly I want a way to write words written in assembly language. There will quite a few - of these to start with because, well, everything has to start in assembly before there's - enough "infrastructure" to be able to start writing FORTH words, but also I want to define - some common FORTH words in assembly language for speed, even though I could write them in FORTH. - - This is what DUP looks like in memory: - - pointer to previous word - ^ - | - +--|------+---+---+---+---+------------+ - | LINK | 3 | D | U | P | code_DUP ---------------------> points to the assembly - +---------+---+---+---+---+------------+ code used to write DUP, - ^ len codeword which ends with NEXT. - | - LINK in next word - - Again, for brevity in writing the header I'm going to write an assembler macro called defcode. - As with defword above, don't worry about the complicated details of the macro. -*/ - - .macro defcode name, namelen, flags=0, label - .section .rodata - .align 4 - .globl name_\label -name_\label : - .int link // link - .set link,name_\label - .byte \flags+\namelen // flags + length byte - .ascii "\name" // the name - .align 4 // padding to next 4 byte boundary - .globl \label -\label : - .int code_\label // codeword - .text - //.align 4 - .globl code_\label -code_\label : // assembler code follows - .endm - -/* - Now some easy FORTH primitives. These are written in assembly for speed. If you understand - i386 assembly language then it is worth reading these. However if you don't understand assembly - you can skip the details. -*/ - - defcode "DROP",4,,DROP - pop %eax // drop top of stack - NEXT - - defcode "SWAP",4,,SWAP - pop %eax // swap top two elements on stack - pop %ebx - push %eax - push %ebx - NEXT - - defcode "DUP",3,,DUP - mov (%esp),%eax // duplicate top of stack - push %eax - NEXT - - defcode "OVER",4,,OVER - mov 4(%esp),%eax // get the second element of stack - push %eax // and push it on top - NEXT - - defcode "ROT",3,,ROT - pop %eax - pop %ebx - pop %ecx - push %eax - push %ecx - push %ebx - NEXT - - defcode "-ROT",4,,NROT - pop %eax - pop %ebx - pop %ecx - push %ebx - push %eax - push %ecx - NEXT - - defcode "2DROP",5,,TWODROP // drop top two elements of stack - pop %eax - pop %eax - NEXT - - defcode "2DUP",4,,TWODUP // duplicate top two elements of stack - mov (%esp),%eax - mov 4(%esp),%ebx - push %ebx - push %eax - NEXT - - defcode "2SWAP",5,,TWOSWAP // swap top two pairs of elements of stack - pop %eax - pop %ebx - pop %ecx - pop %edx - push %ebx - push %eax - push %edx - push %ecx - NEXT - - defcode "?DUP",4,,QDUP // duplicate top of stack if non-zero - movl (%esp),%eax - test %eax,%eax - jz 1f - push %eax -1: NEXT - - defcode "1+",2,,INCR - incl (%esp) // increment top of stack - NEXT - - defcode "1-",2,,DECR - decl (%esp) // decrement top of stack - NEXT - - defcode "4+",2,,INCR4 - addl $4,(%esp) // add 4 to top of stack - NEXT - - defcode "4-",2,,DECR4 - subl $4,(%esp) // subtract 4 from top of stack - NEXT - - defcode "+",1,,ADD - pop %eax // get top of stack - addl %eax,(%esp) // and add it to next word on stack - NEXT - - defcode "-",1,,SUB - pop %eax // get top of stack - subl %eax,(%esp) // and subtract it from next word on stack - NEXT - - defcode "*",1,,MUL - pop %eax - pop %ebx - imull %ebx,%eax - push %eax // ignore overflow - NEXT - -/* - In this FORTH, only /MOD is primitive. Later we will define the / and MOD words in - terms of the primitive /MOD. The design of the i386 assembly instruction idiv which - leaves both quotient and remainder makes this the obvious choice. -*/ - - defcode "/MOD",4,,DIVMOD - xor %edx,%edx - pop %ebx - pop %eax - idivl %ebx - push %edx // push remainder - push %eax // push quotient - NEXT - -/* - Lots of comparison operations like =, <, >, etc.. - - ANS FORTH says that the comparison words should return all (binary) 1's for - TRUE and all 0's for FALSE. However this is a bit of a strange convention - so this FORTH breaks it and returns the more normal (for C programmers ...) - 1 meaning TRUE and 0 meaning FALSE. -*/ - - defcode "=",1,,EQU // top two words are equal? - pop %eax - pop %ebx - cmp %ebx,%eax - sete %al - movzbl %al,%eax - pushl %eax - NEXT - - defcode "<>",2,,NEQU // top two words are not equal? - pop %eax - pop %ebx - cmp %ebx,%eax - setne %al - movzbl %al,%eax - pushl %eax - NEXT - - defcode "<",1,,LT - pop %eax - pop %ebx - cmp %eax,%ebx - setl %al - movzbl %al,%eax - pushl %eax - NEXT - - defcode ">",1,,GT - pop %eax - pop %ebx - cmp %eax,%ebx - setg %al - movzbl %al,%eax - pushl %eax - NEXT - - defcode "<=",2,,LE - pop %eax - pop %ebx - cmp %eax,%ebx - setle %al - movzbl %al,%eax - pushl %eax - NEXT - - defcode ">=",2,,GE - pop %eax - pop %ebx - cmp %eax,%ebx - setge %al - movzbl %al,%eax - pushl %eax - NEXT - - defcode "0=",2,,ZEQU // top of stack equals 0? - pop %eax - test %eax,%eax - setz %al - movzbl %al,%eax - pushl %eax - NEXT - - defcode "0<>",3,,ZNEQU // top of stack not 0? - pop %eax - test %eax,%eax - setnz %al - movzbl %al,%eax - pushl %eax - NEXT - - defcode "0<",2,,ZLT // comparisons with 0 - pop %eax - test %eax,%eax - setl %al - movzbl %al,%eax - pushl %eax - NEXT - - defcode "0>",2,,ZGT - pop %eax - test %eax,%eax - setg %al - movzbl %al,%eax - pushl %eax - NEXT - - defcode "0<=",3,,ZLE - pop %eax - test %eax,%eax - setle %al - movzbl %al,%eax - pushl %eax - NEXT - - defcode "0>=",3,,ZGE - pop %eax - test %eax,%eax - setge %al - movzbl %al,%eax - pushl %eax - NEXT - - defcode "AND",3,,AND // bitwise AND - pop %eax - andl %eax,(%esp) - NEXT - - defcode "OR",2,,OR // bitwise OR - pop %eax - orl %eax,(%esp) - NEXT - - defcode "XOR",3,,XOR // bitwise XOR - pop %eax - xorl %eax,(%esp) - NEXT - - defcode "INVERT",6,,INVERT // this is the FORTH bitwise "NOT" function (cf. NEGATE and NOT) - notl (%esp) - NEXT - -/* - RETURNING FROM FORTH WORDS ---------------------------------------------------------------------- - - Time to talk about what happens when we EXIT a function. In this diagram QUADRUPLE has called - DOUBLE, and DOUBLE is about to exit (look at where %esi is pointing): - - QUADRUPLE - +------------------+ - | codeword | - +------------------+ DOUBLE - | addr of DOUBLE ---------------> +------------------+ - +------------------+ | codeword | - | addr of DOUBLE | +------------------+ - +------------------+ | addr of DUP | - | addr of EXIT | +------------------+ - +------------------+ | addr of + | - +------------------+ - %esi -> | addr of EXIT | - +------------------+ - - What happens when the + function does NEXT? Well, the following code is executed. -*/ - - defcode "EXIT",4,,EXIT - POPRSP %esi // pop return stack into %esi - NEXT - -/* - EXIT gets the old %esi which we saved from before on the return stack, and puts it in %esi. - So after this (but just before NEXT) we get: - - QUADRUPLE - +------------------+ - | codeword | - +------------------+ DOUBLE - | addr of DOUBLE ---------------> +------------------+ - +------------------+ | codeword | - %esi -> | addr of DOUBLE | +------------------+ - +------------------+ | addr of DUP | - | addr of EXIT | +------------------+ - +------------------+ | addr of + | - +------------------+ - | addr of EXIT | - +------------------+ - - And NEXT just completes the job by, well, in this case just by calling DOUBLE again :-) - - LITERALS ---------------------------------------------------------------------- - - The final point I "glossed over" before was how to deal with functions that do anything - apart from calling other functions. For example, suppose that DOUBLE was defined like this: - - : DOUBLE 2 * ; - - It does the same thing, but how do we compile it since it contains the literal 2? One way - would be to have a function called "2" (which you'd have to write in assembler), but you'd need - a function for every single literal that you wanted to use. - - FORTH solves this by compiling the function using a special word called LIT: - - +---------------------------+-------+-------+-------+-------+-------+ - | (usual header of DOUBLE) | DOCOL | LIT | 2 | * | EXIT | - +---------------------------+-------+-------+-------+-------+-------+ - - LIT is executed in the normal way, but what it does next is definitely not normal. It - looks at %esi (which now points to the number 2), grabs it, pushes it on the stack, then - manipulates %esi in order to skip the number as if it had never been there. - - What's neat is that the whole grab/manipulate can be done using a single byte single - i386 instruction, our old friend LODSL. Rather than me drawing more ASCII-art diagrams, - see if you can find out how LIT works: -*/ - - defcode "LIT",3,,LIT - // %esi points to the next command, but in this case it points to the next - // literal 32 bit integer. Get that literal into %eax and increment %esi. - // On x86, it's a convenient single byte instruction! (cf. NEXT macro) - lodsl - push %eax // push the literal number on to stack - NEXT - -/* - MEMORY ---------------------------------------------------------------------- - - As important point about FORTH is that it gives you direct access to the lowest levels - of the machine. Manipulating memory directly is done frequently in FORTH, and these are - the primitive words for doing it. -*/ - - defcode "!",1,,STORE - pop %ebx // address to store at - pop %eax // data to store there - mov %eax,(%ebx) // store it - NEXT - - defcode "@",1,,FETCH - pop %ebx // address to fetch - mov (%ebx),%eax // fetch it - push %eax // push value onto stack - NEXT - - defcode "+!",2,,ADDSTORE - pop %ebx // address - pop %eax // the amount to add - addl %eax,(%ebx) // add it - NEXT - - defcode "-!",2,,SUBSTORE - pop %ebx // address - pop %eax // the amount to subtract - subl %eax,(%ebx) // add it - NEXT - -/* - ! and @ (STORE and FETCH) store 32-bit words. It's also useful to be able to read and write bytes - so we also define standard words C@ and C!. - - Byte-oriented operations only work on architectures which permit them (i386 is one of those). - */ - - defcode "C!",2,,STOREBYTE - pop %ebx // address to store at - pop %eax // data to store there - movb %al,(%ebx) // store it - NEXT - - defcode "C@",2,,FETCHBYTE - pop %ebx // address to fetch - xor %eax,%eax - movb (%ebx),%al // fetch it - push %eax // push value onto stack - NEXT - -/* C@C! is a useful byte copy primitive. */ - defcode "C@C!",4,,CCOPY - movl 4(%esp),%ebx // source address - movb (%ebx),%al // get source character - pop %edi // destination address - stosb // copy to destination - push %edi // increment destination address - incl 4(%esp) // increment source address - NEXT - -/* and CMOVE is a block copy operation. */ - defcode "CMOVE",5,,CMOVE - mov %esi,%edx // preserve %esi - pop %ecx // length - pop %edi // destination address - pop %esi // source address - rep movsb // copy source to destination - mov %edx,%esi // restore %esi - NEXT - -/* - BUILT-IN VARIABLES ---------------------------------------------------------------------- - - These are some built-in variables and related standard FORTH words. Of these, the only one that we - have discussed so far was LATEST, which points to the last (most recently defined) word in the - FORTH dictionary. LATEST is also a FORTH word which pushes the address of LATEST (the variable) - on to the stack, so you can read or write it using @ and ! operators. For example, to print - the current value of LATEST (and this can apply to any FORTH variable) you would do: - - LATEST @ . CR - - To make defining variables shorter, I'm using a macro called defvar, similar to defword and - defcode above. (In fact the defvar macro uses defcode to do the dictionary header). -*/ - - .macro defvar name, namelen, flags=0, label, initial=0 - defcode \name,\namelen,\flags,\label - push $var_\name - NEXT - .data - .align 4 -var_\name : - .int \initial - .endm - -/* - The built-in variables are: - - STATE Is the interpreter executing code (0) or compiling a word (non-zero)? - LATEST Points to the latest (most recently defined) word in the dictionary. - HERE Points to the next free byte of memory. When compiling, compiled words go here. - S0 Stores the address of the top of the parameter stack. - BASE The current base for printing and reading numbers. - -*/ - defvar "STATE",5,,STATE - defvar "HERE",4,,HERE - defvar "LATEST",6,,LATEST,name_SYSCALL0 // SYSCALL0 must be last in built-in dictionary - defvar "S0",2,,SZ - defvar "BASE",4,,BASE,10 - -/* - BUILT-IN CONSTANTS ---------------------------------------------------------------------- - - It's also useful to expose a few constants to FORTH. When the word is executed it pushes a - constant value on the stack. - - The built-in constants are: - - VERSION Is the current version of this FORTH. - R0 The address of the top of the return stack. - DOCOL Pointer to DOCOL. - F_IMMED The IMMEDIATE flag's actual value. - F_HIDDEN The HIDDEN flag's actual value. - F_LENMASK The length mask in the flags/len byte. - - SYS_* and the numeric codes of various Linux syscalls (from ) -*/ - -//#include // you might need this instead -#include - - .macro defconst name, namelen, flags=0, label, value - defcode \name,\namelen,\flags,\label - push $\value - NEXT - .endm - - defconst "VERSION",7,,VERSION,JONES_VERSION - defconst "R0",2,,RZ,return_stack_top - defconst "DOCOL",5,,__DOCOL,DOCOL - defconst "F_IMMED",7,,__F_IMMED,F_IMMED - defconst "F_HIDDEN",8,,__F_HIDDEN,F_HIDDEN - defconst "F_LENMASK",9,,__F_LENMASK,F_LENMASK - - defconst "SYS_EXIT",8,,SYS_EXIT,__NR_exit - defconst "SYS_OPEN",8,,SYS_OPEN,__NR_open - defconst "SYS_CLOSE",9,,SYS_CLOSE,__NR_close - defconst "SYS_READ",8,,SYS_READ,__NR_read - defconst "SYS_WRITE",9,,SYS_WRITE,__NR_write - defconst "SYS_CREAT",9,,SYS_CREAT,__NR_creat - defconst "SYS_BRK",7,,SYS_BRK,__NR_brk - - defconst "O_RDONLY",8,,__O_RDONLY,0 - defconst "O_WRONLY",8,,__O_WRONLY,1 - defconst "O_RDWR",6,,__O_RDWR,2 - defconst "O_CREAT",7,,__O_CREAT,0100 - defconst "O_EXCL",6,,__O_EXCL,0200 - defconst "O_TRUNC",7,,__O_TRUNC,01000 - defconst "O_APPEND",8,,__O_APPEND,02000 - defconst "O_NONBLOCK",10,,__O_NONBLOCK,04000 - -/* - RETURN STACK ---------------------------------------------------------------------- - - These words allow you to access the return stack. Recall that the register %ebp always points to - the top of the return stack. -*/ - - defcode ">R",2,,TOR - pop %eax // pop parameter stack into %eax - PUSHRSP %eax // push it on to the return stack - NEXT - - defcode "R>",2,,FROMR - POPRSP %eax // pop return stack on to %eax - push %eax // and push on to parameter stack - NEXT - - defcode "RSP@",4,,RSPFETCH - push %ebp - NEXT - - defcode "RSP!",4,,RSPSTORE - pop %ebp - NEXT - - defcode "RDROP",5,,RDROP - addl $4,%ebp // pop return stack and throw away - NEXT - -/* - PARAMETER (DATA) STACK ---------------------------------------------------------------------- - - These functions allow you to manipulate the parameter stack. Recall that Linux sets up the parameter - stack for us, and it is accessed through %esp. -*/ - - defcode "DSP@",4,,DSPFETCH - mov %esp,%eax - push %eax - NEXT - - defcode "DSP!",4,,DSPSTORE - pop %esp - NEXT - -/* - INPUT AND OUTPUT ---------------------------------------------------------------------- - - These are our first really meaty/complicated FORTH primitives. I have chosen to write them in - assembler, but surprisingly in "real" FORTH implementations these are often written in terms - of more fundamental FORTH primitives. I chose to avoid that because I think that just obscures - the implementation. After all, you may not understand assembler but you can just think of it - as an opaque block of code that does what it says. - - Let's discuss input first. - - The FORTH word KEY reads the next byte from stdin (and pushes it on the parameter stack). - So if KEY is called and someone hits the space key, then the number 32 (ASCII code of space) - is pushed on the stack. - - In FORTH there is no distinction between reading code and reading input. We might be reading - and compiling code, we might be reading words to execute, we might be asking for the user - to type their name -- ultimately it all comes in through KEY. - - The implementation of KEY uses an input buffer of a certain size (defined at the end of this - file). It calls the Linux read(2) system call to fill this buffer and tracks its position - in the buffer using a couple of variables, and if it runs out of input buffer then it refills - it automatically. The other thing that KEY does is if it detects that stdin has closed, it - exits the program, which is why when you hit ^D the FORTH system cleanly exits. - - buffer bufftop - | | - V V - +-------------------------------+--------------------------------------+ - | INPUT READ FROM STDIN ....... | unused part of the buffer | - +-------------------------------+--------------------------------------+ - ^ - | - currkey (next character to read) - - <---------------------- BUFFER_SIZE (4096 bytes) ----------------------> -*/ - - defcode "KEY",3,,KEY - call _KEY - push %eax // push return value on stack - NEXT -_KEY: - mov (currkey),%ebx - cmp (bufftop),%ebx - jge 1f // exhausted the input buffer? - xor %eax,%eax - mov (%ebx),%al // get next key from input buffer - inc %ebx - mov %ebx,(currkey) // increment currkey - ret - -1: // Out of input; use read(2) to fetch more input from stdin. - xor %ebx,%ebx // 1st param: stdin - mov $buffer,%ecx // 2nd param: buffer - mov %ecx,currkey - mov $BUFFER_SIZE,%edx // 3rd param: max length - mov $__NR_read,%eax // syscall: read - int $0x80 - test %eax,%eax // If %eax <= 0, then exit. - jbe 2f - addl %eax,%ecx // buffer+%eax = bufftop - mov %ecx,bufftop - jmp _KEY - -2: // Error or end of input: exit the program. - xor %ebx,%ebx - mov $__NR_exit,%eax // syscall: exit - int $0x80 - - .data - .align 4 -currkey: - .int buffer // Current place in input buffer (next character to read). -bufftop: - .int buffer // Last valid data in input buffer + 1. - -/* - By contrast, output is much simpler. The FORTH word EMIT writes out a single byte to stdout. - This implementation just uses the write system call. No attempt is made to buffer output, but - it would be a good exercise to add it. -*/ - - defcode "EMIT",4,,EMIT - pop %eax - call _EMIT - NEXT -_EMIT: - mov $1,%ebx // 1st param: stdout - - // write needs the address of the byte to write - mov %al,emit_scratch - mov $emit_scratch,%ecx // 2nd param: address - - mov $1,%edx // 3rd param: nbytes = 1 - - mov $__NR_write,%eax // write syscall - int $0x80 - ret - - .data // NB: easier to fit in the .data section -emit_scratch: - .space 1 // scratch used by EMIT - -/* - Back to input, WORD is a FORTH word which reads the next full word of input. - - What it does in detail is that it first skips any blanks (spaces, tabs, newlines and so on). - Then it calls KEY to read characters into an internal buffer until it hits a blank. Then it - calculates the length of the word it read and returns the address and the length as - two words on the stack (with the length at the top of stack). - - Notice that WORD has a single internal buffer which it overwrites each time (rather like - a static C string). Also notice that WORD's internal buffer is just 32 bytes long and - there is NO checking for overflow. 31 bytes happens to be the maximum length of a - FORTH word that we support, and that is what WORD is used for: to read FORTH words when - we are compiling and executing code. The returned strings are not NUL-terminated. - - Start address+length is the normal way to represent strings in FORTH (not ending in an - ASCII NUL character as in C), and so FORTH strings can contain any character including NULs - and can be any length. - - WORD is not suitable for just reading strings (eg. user input) because of all the above - peculiarities and limitations. - - Note that when executing, you'll see: - WORD FOO - which puts "FOO" and length 3 on the stack, but when compiling: - : BAR WORD FOO ; - is an error (or at least it doesn't do what you might expect). Later we'll talk about compiling - and immediate mode, and you'll understand why. -*/ - - defcode "WORD",4,,WORD - call _WORD - push %edi // push base address - push %ecx // push length - NEXT - -_WORD: - /* Search for first non-blank character. Also skip \ comments. */ -1: - call _KEY // get next key, returned in %eax - cmpb $'\\',%al // start of a comment? - je 3f // if so, skip the comment - cmpb $' ',%al - jbe 1b // if so, keep looking - - /* Search for the end of the word, storing chars as we go. */ - mov $word_buffer,%edi // pointer to return buffer -2: - stosb // add character to return buffer - call _KEY // get next key, returned in %al - cmpb $' ',%al // is blank? - ja 2b // if not, keep looping - - /* Return the word (well, the static buffer) and length. */ - sub $word_buffer,%edi - mov %edi,%ecx // return length of the word - mov $word_buffer,%edi // return address of the word - ret - - /* Code to skip \ comments to end of the current line. */ -3: - call _KEY - cmpb $'\n',%al // end of line yet? - jne 3b - jmp 1b - - .data // NB: easier to fit in the .data section - // A static buffer where WORD returns. Subsequent calls - // overwrite this buffer. Maximum word length is 32 chars. -word_buffer: - .space 32 - -/* - As well as reading in words we'll need to read in numbers and for that we are using a function - called NUMBER. This parses a numeric string such as one returned by WORD and pushes the - number on the parameter stack. - - The function uses the variable BASE as the base (radix) for conversion, so for example if - BASE is 2 then we expect a binary number. Normally BASE is 10. - - If the word starts with a '-' character then the returned value is negative. - - If the string can't be parsed as a number (or contains characters outside the current BASE) - then we need to return an error indication. So NUMBER actually returns two items on the stack. - At the top of stack we return the number of unconverted characters (ie. if 0 then all characters - were converted, so there is no error). Second from top of stack is the parsed number or a - partial value if there was an error. -*/ - defcode "NUMBER",6,,NUMBER - pop %ecx // length of string - pop %edi // start address of string - call _NUMBER - push %eax // parsed number - push %ecx // number of unparsed characters (0 = no error) - NEXT - -_NUMBER: - xor %eax,%eax - xor %ebx,%ebx - - test %ecx,%ecx // trying to parse a zero-length string is an error, but will return 0. - jz 5f - - movl var_BASE,%edx // get BASE (in %dl) - - // Check if first character is '-'. - movb (%edi),%bl // %bl = first character in string - inc %edi - push %eax // push 0 on stack - cmpb $'-',%bl // negative number? - jnz 2f - pop %eax - push %ebx // push <> 0 on stack, indicating negative - dec %ecx - jnz 1f - pop %ebx // error: string is only '-'. - movl $1,%ecx - ret - - // Loop reading digits. -1: imull %edx,%eax // %eax *= BASE - movb (%edi),%bl // %bl = next character in string - inc %edi - - // Convert 0-9, A-Z to a number 0-35. -2: subb $'0',%bl // < '0'? - jb 4f - cmp $10,%bl // <= '9'? - jb 3f - subb $17,%bl // < 'A'? (17 is 'A'-'0') - jb 4f - addb $10,%bl - -3: cmp %dl,%bl // >= BASE? - jge 4f - - // OK, so add it to %eax and loop. - add %ebx,%eax - dec %ecx - jnz 1b - - // Negate the result if first character was '-' (saved on the stack). -4: pop %ebx - test %ebx,%ebx - jz 5f - neg %eax - -5: ret - -/* - DICTIONARY LOOK UPS ---------------------------------------------------------------------- - - We're building up to our prelude on how FORTH code is compiled, but first we need yet more infrastructure. - - The FORTH word FIND takes a string (a word as parsed by WORD -- see above) and looks it up in the - dictionary. What it actually returns is the address of the dictionary header, if it finds it, - or 0 if it didn't. - - So if DOUBLE is defined in the dictionary, then WORD DOUBLE FIND returns the following pointer: - - pointer to this - | - | - V - +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ - | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | - +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ - - See also >CFA and >DFA. - - FIND doesn't find dictionary entries which are flagged as HIDDEN. See below for why. -*/ - - defcode "FIND",4,,FIND - pop %ecx // %ecx = length - pop %edi // %edi = address - call _FIND - push %eax // %eax = address of dictionary entry (or NULL) - NEXT - -_FIND: - push %esi // Save %esi so we can use it in string comparison. - - // Now we start searching backwards through the dictionary for this word. - mov var_LATEST,%edx // LATEST points to name header of the latest word in the dictionary -1: test %edx,%edx // NULL pointer? (end of the linked list) - je 4f - - // Compare the length expected and the length of the word. - // Note that if the F_HIDDEN flag is set on the word, then by a bit of trickery - // this won't pick the word (the length will appear to be wrong). - xor %eax,%eax - movb 4(%edx),%al // %al = flags+length field - andb $(F_HIDDEN|F_LENMASK),%al // %al = name length - cmpb %cl,%al // Length is the same? - jne 2f - - // Compare the strings in detail. - push %ecx // Save the length - push %edi // Save the address (repe cmpsb will move this pointer) - lea 5(%edx),%esi // Dictionary string we are checking against. - repe cmpsb // Compare the strings. - pop %edi - pop %ecx - jne 2f // Not the same. - - // The strings are the same - return the header pointer in %eax - pop %esi - mov %edx,%eax - ret - -2: mov (%edx),%edx // Move back through the link field to the previous word - jmp 1b // .. and loop. - -4: // Not found. - pop %esi - xor %eax,%eax // Return zero to indicate not found. - ret - -/* - FIND returns the dictionary pointer, but when compiling we need the codeword pointer (recall - that FORTH definitions are compiled into lists of codeword pointers). The standard FORTH - word >CFA turns a dictionary pointer into a codeword pointer. - - The example below shows the result of: - - WORD DOUBLE FIND >CFA - - FIND returns a pointer to this - | >CFA converts it to a pointer to this - | | - V V - +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ - | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | - +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ - codeword - - Notes: - - Because names vary in length, this isn't just a simple increment. - - In this FORTH you cannot easily turn a codeword pointer back into a dictionary entry pointer, but - that is not true in most FORTH implementations where they store a back pointer in the definition - (with an obvious memory/complexity cost). The reason they do this is that it is useful to be - able to go backwards (codeword -> dictionary entry) in order to decompile FORTH definitions - quickly. - - What does CFA stand for? My best guess is "Code Field Address". -*/ - - defcode ">CFA",4,,TCFA - pop %edi - call _TCFA - push %edi - NEXT -_TCFA: - xor %eax,%eax - add $4,%edi // Skip link pointer. - movb (%edi),%al // Load flags+len into %al. - inc %edi // Skip flags+len byte. - andb $F_LENMASK,%al // Just the length, not the flags. - add %eax,%edi // Skip the name. - addl $3,%edi // The codeword is 4-byte aligned. - andl $~3,%edi - ret - -/* - Related to >CFA is >DFA which takes a dictionary entry address as returned by FIND and - returns a pointer to the first data field. - - FIND returns a pointer to this - | >CFA converts it to a pointer to this - | | - | | >DFA converts it to a pointer to this - | | | - V V V - +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ - | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | - +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ - codeword - - (Note to those following the source of FIG-FORTH / ciforth: My >DFA definition is - different from theirs, because they have an extra indirection). - - You can see that >DFA is easily defined in FORTH just by adding 4 to the result of >CFA. -*/ - - defword ">DFA",4,,TDFA - .int TCFA // >CFA (get code field address) - .int INCR4 // 4+ (add 4 to it to get to next word) - .int EXIT // EXIT (return from FORTH word) - -/* - COMPILING ---------------------------------------------------------------------- - - Now we'll talk about how FORTH compiles words. Recall that a word definition looks like this: - - : DOUBLE DUP + ; - - and we have to turn this into: - - pointer to previous word - ^ - | - +--|------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ - | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | - +---------+---+---+---+---+---+---+---+---+------------+--|---------+------------+------------+ - ^ len pad codeword | - | V - LATEST points here points to codeword of DUP - - There are several problems to solve. Where to put the new word? How do we read words? How - do we define the words : (COLON) and ; (SEMICOLON)? - - FORTH solves this rather elegantly and as you might expect in a very low-level way which - allows you to change how the compiler works on your own code. - - FORTH has an INTERPRET function (a true interpreter this time, not DOCOL) which runs in a - loop, reading words (using WORD), looking them up (using FIND), turning them into codeword - pointers (using >CFA) and deciding what to do with them. - - What it does depends on the mode of the interpreter (in variable STATE). - - When STATE is zero, the interpreter just runs each word as it looks them up. This is known as - immediate mode. - - The interesting stuff happens when STATE is non-zero -- compiling mode. In this mode the - interpreter appends the codeword pointer to user memory (the HERE variable points to the next - free byte of user memory -- see DATA SEGMENT section below). - - So you may be able to see how we could define : (COLON). The general plan is: - - (1) Use WORD to read the name of the function being defined. - - (2) Construct the dictionary entry -- just the header part -- in user memory: - - pointer to previous word (from LATEST) +-- Afterwards, HERE points here, where - ^ | the interpreter will start appending - | V codewords. - +--|------+---+---+---+---+---+---+---+---+------------+ - | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | - +---------+---+---+---+---+---+---+---+---+------------+ - len pad codeword - - (3) Set LATEST to point to the newly defined word, ... - - (4) .. and most importantly leave HERE pointing just after the new codeword. This is where - the interpreter will append codewords. - - (5) Set STATE to 1. This goes into compile mode so the interpreter starts appending codewords to - our partially-formed header. - - After : has run, our input is here: - - : DOUBLE DUP + ; - ^ - | - Next byte returned by KEY will be the 'D' character of DUP - - so the interpreter (now it's in compile mode, so I guess it's really the compiler) reads "DUP", - looks it up in the dictionary, gets its codeword pointer, and appends it: - - +-- HERE updated to point here. - | - V - +---------+---+---+---+---+---+---+---+---+------------+------------+ - | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | - +---------+---+---+---+---+---+---+---+---+------------+------------+ - len pad codeword - - Next we read +, get the codeword pointer, and append it: - - +-- HERE updated to point here. - | - V - +---------+---+---+---+---+---+---+---+---+------------+------------+------------+ - | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | - +---------+---+---+---+---+---+---+---+---+------------+------------+------------+ - len pad codeword - - The issue is what happens next. Obviously what we _don't_ want to happen is that we - read ";" and compile it and go on compiling everything afterwards. - - At this point, FORTH uses a trick. Remember the length byte in the dictionary definition - isn't just a plain length byte, but can also contain flags. One flag is called the - IMMEDIATE flag (F_IMMED in this code). If a word in the dictionary is flagged as - IMMEDIATE then the interpreter runs it immediately _even if it's in compile mode_. - - This is how the word ; (SEMICOLON) works -- as a word flagged in the dictionary as IMMEDIATE. - - And all it does is append the codeword for EXIT on to the current definition and switch - back to immediate mode (set STATE back to 0). Shortly we'll see the actual definition - of ; and we'll see that it's really a very simple definition, declared IMMEDIATE. - - After the interpreter reads ; and executes it 'immediately', we get this: - - +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ - | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | - +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ - len pad codeword ^ - | - HERE - STATE is set to 0. - - And that's it, job done, our new definition is compiled, and we're back in immediate mode - just reading and executing words, perhaps including a call to test our new word DOUBLE. - - The only last wrinkle in this is that while our word was being compiled, it was in a - half-finished state. We certainly wouldn't want DOUBLE to be called somehow during - this time. There are several ways to stop this from happening, but in FORTH what we - do is flag the word with the HIDDEN flag (F_HIDDEN in this code) just while it is - being compiled. This prevents FIND from finding it, and thus in theory stops any - chance of it being called. - - The above explains how compiling, : (COLON) and ; (SEMICOLON) works and in a moment I'm - going to define them. The : (COLON) function can be made a little bit more general by writing - it in two parts. The first part, called CREATE, makes just the header: - - +-- Afterwards, HERE points here. - | - V - +---------+---+---+---+---+---+---+---+---+ - | LINK | 6 | D | O | U | B | L | E | 0 | - +---------+---+---+---+---+---+---+---+---+ - len pad - - and the second part, the actual definition of : (COLON), calls CREATE and appends the - DOCOL codeword, so leaving: - - +-- Afterwards, HERE points here. - | - V - +---------+---+---+---+---+---+---+---+---+------------+ - | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | - +---------+---+---+---+---+---+---+---+---+------------+ - len pad codeword - - CREATE is a standard FORTH word and the advantage of this split is that we can reuse it to - create other types of words (not just ones which contain code, but words which contain variables, - constants and other data). -*/ - - defcode "CREATE",6,,CREATE - - // Get the name length and address. - pop %ecx // %ecx = length - pop %ebx // %ebx = address of name - - // Link pointer. - movl var_HERE,%edi // %edi is the address of the header - movl var_LATEST,%eax // Get link pointer - stosl // and store it in the header. - - // Length byte and the word itself. - mov %cl,%al // Get the length. - stosb // Store the length/flags byte. - push %esi - mov %ebx,%esi // %esi = word - rep movsb // Copy the word - pop %esi - addl $3,%edi // Align to next 4 byte boundary. - andl $~3,%edi - - // Update LATEST and HERE. - movl var_HERE,%eax - movl %eax,var_LATEST - movl %edi,var_HERE - NEXT - -/* - Because I want to define : (COLON) in FORTH, not assembler, we need a few more FORTH words - to use. - - The first is , (COMMA) which is a standard FORTH word which appends a 32 bit integer to the user - memory pointed to by HERE, and adds 4 to HERE. So the action of , (COMMA) is: - - previous value of HERE - | - V - +---------+---+---+---+---+---+---+---+---+-- - - - - --+------------+ - | LINK | 6 | D | O | U | B | L | E | 0 | | | - +---------+---+---+---+---+---+---+---+---+-- - - - - --+------------+ - len pad ^ - | - new value of HERE - - and is whatever 32 bit integer was at the top of the stack. - - , (COMMA) is quite a fundamental operation when compiling. It is used to append codewords - to the current word that is being compiled. -*/ - - defcode ",",1,,COMMA - pop %eax // Code pointer to store. - call _COMMA - NEXT -_COMMA: - movl var_HERE,%edi // HERE - stosl // Store it. - movl %edi,var_HERE // Update HERE (incremented) - ret - -/* - Our definitions of : (COLON) and ; (SEMICOLON) will need to switch to and from compile mode. - - Immediate mode vs. compile mode is stored in the global variable STATE, and by updating this - variable we can switch between the two modes. - - For various reasons which may become apparent later, FORTH defines two standard words called - [ and ] (LBRAC and RBRAC) which switch between modes: - - Word Assembler Action Effect - [ LBRAC STATE := 0 Switch to immediate mode. - ] RBRAC STATE := 1 Switch to compile mode. - - [ (LBRAC) is an IMMEDIATE word. The reason is as follows: If we are in compile mode and the - interpreter saw [ then it would compile it rather than running it. We would never be able to - switch back to immediate mode! So we flag the word as IMMEDIATE so that even in compile mode - the word runs immediately, switching us back to immediate mode. -*/ - - defcode "[",1,F_IMMED,LBRAC - xor %eax,%eax - movl %eax,var_STATE // Set STATE to 0. - NEXT - - defcode "]",1,,RBRAC - movl $1,var_STATE // Set STATE to 1. - NEXT - -/* - Now we can define : (COLON) using CREATE. It just calls CREATE, appends DOCOL (the codeword), sets - the word HIDDEN and goes into compile mode. -*/ - - defword ":",1,,COLON - .int WORD // Get the name of the new word - .int CREATE // CREATE the dictionary entry / header - .int LIT, DOCOL, COMMA // Append DOCOL (the codeword). - .int LATEST, FETCH, HIDDEN // Make the word hidden (see below for definition). - .int RBRAC // Go into compile mode. - .int EXIT // Return from the function. - -/* - ; (SEMICOLON) is also elegantly simple. Notice the F_IMMED flag. -*/ - - defword ";",1,F_IMMED,SEMICOLON - .int LIT, EXIT, COMMA // Append EXIT (so the word will return). - .int LATEST, FETCH, HIDDEN // Toggle hidden flag -- unhide the word (see below for definition). - .int LBRAC // Go back to IMMEDIATE mode. - .int EXIT // Return from the function. - -/* - EXTENDING THE COMPILER ---------------------------------------------------------------------- - - Words flagged with IMMEDIATE (F_IMMED) aren't just for the FORTH compiler to use. You can define - your own IMMEDIATE words too, and this is a crucial aspect when extending basic FORTH, because - it allows you in effect to extend the compiler itself. Does gcc let you do that? - - Standard FORTH words like IF, WHILE, ." and so on are all written as extensions to the basic - compiler, and are all IMMEDIATE words. - - The IMMEDIATE word toggles the F_IMMED (IMMEDIATE flag) on the most recently defined word, - or on the current word if you call it in the middle of a definition. - - Typical usage is: - - : MYIMMEDWORD IMMEDIATE - ...definition... - ; - - but some FORTH programmers write this instead: - - : MYIMMEDWORD - ...definition... - ; IMMEDIATE - - The two usages are equivalent, to a first approximation. -*/ - - defcode "IMMEDIATE",9,F_IMMED,IMMEDIATE - movl var_LATEST,%edi // LATEST word. - addl $4,%edi // Point to name/flags byte. - xorb $F_IMMED,(%edi) // Toggle the IMMED bit. - NEXT - -/* - 'addr HIDDEN' toggles the hidden flag (F_HIDDEN) of the word defined at addr. To hide the - most recently defined word (used above in : and ; definitions) you would do: - - LATEST @ HIDDEN - - 'HIDE word' toggles the flag on a named 'word'. - - Setting this flag stops the word from being found by FIND, and so can be used to make 'private' - words. For example, to break up a large word into smaller parts you might do: - - : SUB1 ... subword ... ; - : SUB2 ... subword ... ; - : SUB3 ... subword ... ; - : MAIN ... defined in terms of SUB1, SUB2, SUB3 ... ; - HIDE SUB1 - HIDE SUB2 - HIDE SUB3 - - After this, only MAIN is 'exported' or seen by the rest of the program. -*/ - - defcode "HIDDEN",6,,HIDDEN - pop %edi // Dictionary entry. - addl $4,%edi // Point to name/flags byte. - xorb $F_HIDDEN,(%edi) // Toggle the HIDDEN bit. - NEXT - - defword "HIDE",4,,HIDE - .int WORD // Get the word (after HIDE). - .int FIND // Look up in the dictionary. - .int HIDDEN // Set F_HIDDEN flag. - .int EXIT // Return. - -/* - ' (TICK) is a standard FORTH word which returns the codeword pointer of the next word. - - The common usage is: - - ' FOO , - - which appends the codeword of FOO to the current word we are defining (this only works in compiled code). - - You tend to use ' in IMMEDIATE words. For example an alternate (and rather useless) way to define - a literal 2 might be: - - : LIT2 IMMEDIATE - ' LIT , \ Appends LIT to the currently-being-defined word - 2 , \ Appends the number 2 to the currently-being-defined word - ; - - So you could do: - - : DOUBLE LIT2 * ; - - (If you don't understand how LIT2 works, then you should review the material about compiling words - and immediate mode). - - This definition of ' uses a cheat which I copied from buzzard92. As a result it only works in - compiled code. It is possible to write a version of ' based on WORD, FIND, >CFA which works in - immediate mode too. -*/ - defcode "'",1,,TICK - lodsl // Get the address of the next word and skip it. - pushl %eax // Push it on the stack. - NEXT - -/* - BRANCHING ---------------------------------------------------------------------- - - It turns out that all you need in order to define looping constructs, IF-statements, etc. - are two primitives. - - BRANCH is an unconditional branch. 0BRANCH is a conditional branch (it only branches if the - top of stack is zero). - - The diagram below shows how BRANCH works in some imaginary compiled word. When BRANCH executes, - %esi starts by pointing to the offset field (compare to LIT above): - - +---------------------+-------+---- - - ---+------------+------------+---- - - - ----+------------+ - | (Dictionary header) | DOCOL | | BRANCH | offset | (skipped) | word | - +---------------------+-------+---- - - ---+------------+-----|------+---- - - - ----+------------+ - ^ | ^ - | | | - | +-----------------------+ - %esi added to offset - - The offset is added to %esi to make the new %esi, and the result is that when NEXT runs, execution - continues at the branch target. Negative offsets work as expected. - - 0BRANCH is the same except the branch happens conditionally. - - Now standard FORTH words such as IF, THEN, ELSE, WHILE, REPEAT, etc. can be implemented entirely - in FORTH. They are IMMEDIATE words which append various combinations of BRANCH or 0BRANCH - into the word currently being compiled. - - As an example, code written like this: - - condition-code IF true-part THEN rest-code - - compiles to: - - condition-code 0BRANCH OFFSET true-part rest-code - | ^ - | | - +-------------+ -*/ - - defcode "BRANCH",6,,BRANCH - add (%esi),%esi // add the offset to the instruction pointer - NEXT - - defcode "0BRANCH",7,,ZBRANCH - pop %eax - test %eax,%eax // top of stack is zero? - jz code_BRANCH // if so, jump back to the branch function above - lodsl // otherwise we need to skip the offset - NEXT - -/* - LITERAL STRINGS ---------------------------------------------------------------------- - - LITSTRING is a primitive used to implement the ." and S" operators (which are written in - FORTH). See the definition of those operators later. - - TELL just prints a string. It's more efficient to define this in assembly because we - can make it a single Linux syscall. -*/ - - defcode "LITSTRING",9,,LITSTRING - lodsl // get the length of the string - push %esi // push the address of the start of the string - push %eax // push it on the stack - addl %eax,%esi // skip past the string - addl $3,%esi // but round up to next 4 byte boundary - andl $~3,%esi - NEXT - - defcode "TELL",4,,TELL - mov $1,%ebx // 1st param: stdout - pop %edx // 3rd param: length of string - pop %ecx // 2nd param: address of string - mov $__NR_write,%eax // write syscall - int $0x80 - NEXT - -/* - QUIT AND INTERPRET ---------------------------------------------------------------------- - - QUIT is the first FORTH function called, almost immediately after the FORTH system "boots". - As explained before, QUIT doesn't "quit" anything. It does some initialisation (in particular - it clears the return stack) and it calls INTERPRET in a loop to interpret commands. The - reason it is called QUIT is because you can call it from your own FORTH words in order to - "quit" your program and start again at the user prompt. - - INTERPRET is the FORTH interpreter ("toploop", "toplevel" or "REPL" might be a more accurate - description -- see: http://en.wikipedia.org/wiki/REPL). -*/ - - // QUIT must not return (ie. must not call EXIT). - defword "QUIT",4,,QUIT - .int RZ,RSPSTORE // R0 RSP!, clear the return stack - .int INTERPRET // interpret the next word - .int BRANCH,-8 // and loop (indefinitely) - -/* - This interpreter is pretty simple, but remember that in FORTH you can always override - it later with a more powerful one! - */ - defcode "INTERPRET",9,,INTERPRET - call _WORD // Returns %ecx = length, %edi = pointer to word. - - // Is it in the dictionary? - xor %eax,%eax - movl %eax,interpret_is_lit // Not a literal number (not yet anyway ...) - call _FIND // Returns %eax = pointer to header or 0 if not found. - test %eax,%eax // Found? - jz 1f - - // In the dictionary. Is it an IMMEDIATE codeword? - mov %eax,%edi // %edi = dictionary entry - movb 4(%edi),%al // Get name+flags. - push %ax // Just save it for now. - call _TCFA // Convert dictionary entry (in %edi) to codeword pointer. - pop %ax - andb $F_IMMED,%al // Is IMMED flag set? - mov %edi,%eax - jnz 4f // If IMMED, jump straight to executing. - - jmp 2f - -1: // Not in the dictionary (not a word) so assume it's a literal number. - incl interpret_is_lit - call _NUMBER // Returns the parsed number in %eax, %ecx > 0 if error - test %ecx,%ecx - jnz 6f - mov %eax,%ebx - mov $LIT,%eax // The word is LIT - -2: // Are we compiling or executing? - movl var_STATE,%edx - test %edx,%edx - jz 4f // Jump if executing. - - // Compiling - just append the word to the current dictionary definition. - call _COMMA - mov interpret_is_lit,%ecx // Was it a literal? - test %ecx,%ecx - jz 3f - mov %ebx,%eax // Yes, so LIT is followed by a number. - call _COMMA -3: NEXT - -4: // Executing - run it! - mov interpret_is_lit,%ecx // Literal? - test %ecx,%ecx // Literal? - jnz 5f - - // Not a literal, execute it now. This never returns, but the codeword will - // eventually call NEXT which will reenter the loop in QUIT. - jmp *(%eax) - -5: // Executing a literal, which means push it on the stack. - push %ebx - NEXT - -6: // Parse error (not a known word or a number in the current BASE). - // Print an error message followed by up to 40 characters of context. - mov $2,%ebx // 1st param: stderr - mov $errmsg,%ecx // 2nd param: error message - mov $errmsgend-errmsg,%edx // 3rd param: length of string - mov $__NR_write,%eax // write syscall - int $0x80 - - mov (currkey),%ecx // the error occurred just before currkey position - mov %ecx,%edx - sub $buffer,%edx // %edx = currkey - buffer (length in buffer before currkey) - cmp $40,%edx // if > 40, then print only 40 characters - jle 7f - mov $40,%edx -7: sub %edx,%ecx // %ecx = start of area to print, %edx = length - mov $__NR_write,%eax // write syscall - int $0x80 - - mov $errmsgnl,%ecx // newline - mov $1,%edx - mov $__NR_write,%eax // write syscall - int $0x80 - - NEXT - - .section .rodata -errmsg: .ascii "PARSE ERROR: " -errmsgend: -errmsgnl: .ascii "\n" - - .data // NB: easier to fit in the .data section - .align 4 -interpret_is_lit: - .int 0 // Flag used to record if reading a literal - -/* - ODDS AND ENDS ---------------------------------------------------------------------- - - CHAR puts the ASCII code of the first character of the following word on the stack. For example - CHAR A puts 65 on the stack. - - EXECUTE is used to run execution tokens. See the discussion of execution tokens in the - FORTH code for more details. - - SYSCALL0, SYSCALL1, SYSCALL2, SYSCALL3 make a standard Linux system call. (See - for a list of system call numbers). As their name suggests these forms take between 0 and 3 - syscall parameters, plus the system call number. - - In this FORTH, SYSCALL0 must be the last word in the built-in (assembler) dictionary because we - initialise the LATEST variable to point to it. This means that if you want to extend the assembler - part, you must put new words before SYSCALL0, or else change how LATEST is initialised. -*/ - - defcode "CHAR",4,,CHAR - call _WORD // Returns %ecx = length, %edi = pointer to word. - xor %eax,%eax - movb (%edi),%al // Get the first character of the word. - push %eax // Push it onto the stack. - NEXT - - defcode "EXECUTE",7,,EXECUTE - pop %eax // Get xt into %eax - jmp *(%eax) // and jump to it. - // After xt runs its NEXT will continue executing the current word. - - defcode "SYSCALL3",8,,SYSCALL3 - pop %eax // System call number (see ) - pop %ebx // First parameter. - pop %ecx // Second parameter - pop %edx // Third parameter - int $0x80 - push %eax // Result (negative for -errno) - NEXT - - defcode "SYSCALL2",8,,SYSCALL2 - pop %eax // System call number (see ) - pop %ebx // First parameter. - pop %ecx // Second parameter - int $0x80 - push %eax // Result (negative for -errno) - NEXT - - defcode "SYSCALL1",8,,SYSCALL1 - pop %eax // System call number (see ) - pop %ebx // First parameter. - int $0x80 - push %eax // Result (negative for -errno) - NEXT - - defcode "SYSCALL0",8,,SYSCALL0 - pop %eax // System call number (see ) - int $0x80 - push %eax // Result (negative for -errno) - NEXT - -/* - DATA SEGMENT ---------------------------------------------------------------------- - - Here we set up the Linux data segment, used for user definitions and variously known as just - the 'data segment', 'user memory' or 'user definitions area'. It is an area of memory which - grows upwards and stores both newly-defined FORTH words and global variables of various - sorts. - - It is completely analogous to the C heap, except there is no generalised 'malloc' and 'free' - (but as with everything in FORTH, writing such functions would just be a Simple Matter - Of Programming). Instead in normal use the data segment just grows upwards as new FORTH - words are defined/appended to it. - - There are various "features" of the GNU toolchain which make setting up the data segment - more complicated than it really needs to be. One is the GNU linker which inserts a random - "build ID" segment. Another is Address Space Randomization which means we can't tell - where the kernel will choose to place the data segment (or the stack for that matter). - - Therefore writing this set_up_data_segment assembler routine is a little more complicated - than it really needs to be. We ask the Linux kernel where it thinks the data segment starts - using the brk(2) system call, then ask it to reserve some initial space (also using brk(2)). - - You don't need to worry about this code. -*/ - .text - .set INITIAL_DATA_SEGMENT_SIZE,65536 -set_up_data_segment: - xor %ebx,%ebx // Call brk(0) - movl $__NR_brk,%eax - int $0x80 - movl %eax,var_HERE // Initialise HERE to point at beginning of data segment. - addl $INITIAL_DATA_SEGMENT_SIZE,%eax // Reserve nn bytes of memory for initial data segment. - movl %eax,%ebx // Call brk(HERE+INITIAL_DATA_SEGMENT_SIZE) - movl $__NR_brk,%eax - int $0x80 - ret - -/* - We allocate static buffers for the return static and input buffer (used when - reading in files and text that the user types in). -*/ - .set RETURN_STACK_SIZE,8192 - .set BUFFER_SIZE,4096 - - .bss -/* FORTH return stack. */ - .align 4096 -return_stack: - .space RETURN_STACK_SIZE -return_stack_top: // Initial top of return stack. - -/* This is used as a temporary input buffer when reading from files or the terminal. */ - .align 4096 -buffer: - .space BUFFER_SIZE - -/* - START OF FORTH CODE ---------------------------------------------------------------------- - - We've now reached the stage where the FORTH system is running and self-hosting. All further - words can be written as FORTH itself, including words like IF, THEN, .", etc which in most - languages would be considered rather fundamental. - - I used to append this here in the assembly file, but I got sick of fighting against gas's - crack-smoking (lack of) multiline string syntax. So now that is in a separate file called - jonesforth.f - - If you don't already have that file, download it from http://annexia.org/forth in order - to continue the tutorial. -*/ - -/* END OF jonesforth.S */ diff --git a/jonesforth/jonesforth.fs b/jonesforth/jonesforth.fs deleted file mode 100644 index 5a998cc..0000000 --- a/jonesforth/jonesforth.fs +++ /dev/null @@ -1,1790 +0,0 @@ -\ -*- text -*- -\ A sometimes minimal FORTH compiler and tutorial for Linux / i386 systems. -*- asm -*- -\ By Richard W.M. Jones http://annexia.org/forth -\ This is PUBLIC DOMAIN (see public domain release statement below). -\ $Id: jonesforth.f,v 1.17 2007/10/12 20:07:44 rich Exp $ -\ -\ The first part of this tutorial is in jonesforth.S. Get if from http://annexia.org/forth -\ -\ PUBLIC DOMAIN ---------------------------------------------------------------------- -\ -\ I, the copyright holder of this work, hereby release it into the public domain. This applies worldwide. -\ -\ In case this is not legally possible, I grant any entity the right to use this work for any purpose, -\ without any conditions, unless such conditions are required by law. -\ -\ SETTING UP ---------------------------------------------------------------------- -\ -\ Let's get a few housekeeping things out of the way. Firstly because I need to draw lots of -\ ASCII-art diagrams to explain concepts, the best way to look at this is using a window which -\ uses a fixed width font and is at least this wide: -\ -\<------------------------------------------------------------------------------------------------------------------------> -\ -\ Secondly make sure TABS are set to 8 characters. The following should be a vertical -\ line. If not, sort out your tabs. -\ -\ | -\ | -\ | -\ -\ Thirdly I assume that your screen is at least 50 characters high. -\ -\ START OF FORTH CODE ---------------------------------------------------------------------- -\ -\ We've now reached the stage where the FORTH system is running and self-hosting. All further -\ words can be written as FORTH itself, including words like IF, THEN, .", etc which in most -\ languages would be considered rather fundamental. -\ -\ Some notes about the code: -\ -\ I use indenting to show structure. The amount of whitespace has no meaning to FORTH however -\ except that you must use at least one whitespace character between words, and words themselves -\ cannot contain whitespace. -\ -\ FORTH is case-sensitive. Use capslock! - -\ The primitive word /MOD (DIVMOD) leaves both the quotient and the remainder on the stack. (On -\ i386, the idivl instruction gives both anyway). Now we can define the / and MOD in terms of /MOD -\ and a few other primitives. -: / /MOD SWAP DROP ; -: MOD /MOD DROP ; - -\ Define some character constants -: '\n' 10 ; -: BL 32 ; \ BL (BLank) is a standard FORTH word for space. - -\ CR prints a carriage return -: CR '\n' EMIT ; - -\ SPACE prints a space -: SPACE BL EMIT ; - -\ NEGATE leaves the negative of a number on the stack. -: NEGATE 0 SWAP - ; - -\ Standard words for booleans. -: TRUE 1 ; -: FALSE 0 ; -: NOT 0= ; - -\ LITERAL takes whatever is on the stack and compiles LIT -: LITERAL IMMEDIATE - ' LIT , \ compile LIT - , \ compile the literal itself (from the stack) - ; - -\ Now we can use [ and ] to insert literals which are calculated at compile time. (Recall that -\ [ and ] are the FORTH words which switch into and out of immediate mode.) -\ Within definitions, use [ ... ] LITERAL anywhere that '...' is a constant expression which you -\ would rather only compute once (at compile time, rather than calculating it each time your word runs). -: ':' - [ \ go into immediate mode (temporarily) - CHAR : \ push the number 58 (ASCII code of colon) on the parameter stack - ] \ go back to compile mode - LITERAL \ compile LIT 58 as the definition of ':' word -; - -\ A few more character constants defined the same way as above. -: ';' [ CHAR ; ] LITERAL ; -: '(' [ CHAR ( ] LITERAL ; -: ')' [ CHAR ) ] LITERAL ; -: '"' [ CHAR " ] LITERAL ; -: 'A' [ CHAR A ] LITERAL ; -: '0' [ CHAR 0 ] LITERAL ; -: '-' [ CHAR - ] LITERAL ; -: '.' [ CHAR . ] LITERAL ; - -\ While compiling, '[COMPILE] word' compiles 'word' if it would otherwise be IMMEDIATE. -: [COMPILE] IMMEDIATE - WORD \ get the next word - FIND \ find it in the dictionary - >CFA \ get its codeword - , \ and compile that -; - -\ RECURSE makes a recursive call to the current word that is being compiled. -\ -\ Normally while a word is being compiled, it is marked HIDDEN so that references to the -\ same word within are calls to the previous definition of the word. However we still have -\ access to the word which we are currently compiling through the LATEST pointer so we -\ can use that to compile a recursive call. -: RECURSE IMMEDIATE - LATEST @ \ LATEST points to the word being compiled at the moment - >CFA \ get the codeword - , \ compile it -; - -\ CONTROL STRUCTURES ---------------------------------------------------------------------- -\ -\ So far we have defined only very simple definitions. Before we can go further, we really need to -\ make some control structures, like IF ... THEN and loops. Luckily we can define arbitrary control -\ structures directly in FORTH. -\ -\ Please note that the control structures as I have defined them here will only work inside compiled -\ words. If you try to type in expressions using IF, etc. in immediate mode, then they won't work. -\ Making these work in immediate mode is left as an exercise for the reader. - -\ condition IF true-part THEN rest -\ -- compiles to: --> condition 0BRANCH OFFSET true-part rest -\ where OFFSET is the offset of 'rest' -\ condition IF true-part ELSE false-part THEN -\ -- compiles to: --> condition 0BRANCH OFFSET true-part BRANCH OFFSET2 false-part rest -\ where OFFSET if the offset of false-part and OFFSET2 is the offset of rest - -\ IF is an IMMEDIATE word which compiles 0BRANCH followed by a dummy offset, and places -\ the address of the 0BRANCH on the stack. Later when we see THEN, we pop that address -\ off the stack, calculate the offset, and back-fill the offset. -: IF IMMEDIATE - ' 0BRANCH , \ compile 0BRANCH - HERE @ \ save location of the offset on the stack - 0 , \ compile a dummy offset -; - -: THEN IMMEDIATE - DUP - HERE @ SWAP - \ calculate the offset from the address saved on the stack - SWAP ! \ store the offset in the back-filled location -; - -: ELSE IMMEDIATE - ' BRANCH , \ definite branch to just over the false-part - HERE @ \ save location of the offset on the stack - 0 , \ compile a dummy offset - SWAP \ now back-fill the original (IF) offset - DUP \ same as for THEN word above - HERE @ SWAP - - SWAP ! -; - -\ BEGIN loop-part condition UNTIL -\ -- compiles to: --> loop-part condition 0BRANCH OFFSET -\ where OFFSET points back to the loop-part -\ This is like do { loop-part } while (condition) in the C language -: BEGIN IMMEDIATE - HERE @ \ save location on the stack -; - -: UNTIL IMMEDIATE - ' 0BRANCH , \ compile 0BRANCH - HERE @ - \ calculate the offset from the address saved on the stack - , \ compile the offset here -; - -\ BEGIN loop-part AGAIN -\ -- compiles to: --> loop-part BRANCH OFFSET -\ where OFFSET points back to the loop-part -\ In other words, an infinite loop which can only be returned from with EXIT -: AGAIN IMMEDIATE - ' BRANCH , \ compile BRANCH - HERE @ - \ calculate the offset back - , \ compile the offset here -; - -\ BEGIN condition WHILE loop-part REPEAT -\ -- compiles to: --> condition 0BRANCH OFFSET2 loop-part BRANCH OFFSET -\ where OFFSET points back to condition (the beginning) and OFFSET2 points to after the whole piece of code -\ So this is like a while (condition) { loop-part } loop in the C language -: WHILE IMMEDIATE - ' 0BRANCH , \ compile 0BRANCH - HERE @ \ save location of the offset2 on the stack - 0 , \ compile a dummy offset2 -; - -: REPEAT IMMEDIATE - ' BRANCH , \ compile BRANCH - SWAP \ get the original offset (from BEGIN) - HERE @ - , \ and compile it after BRANCH - DUP - HERE @ SWAP - \ calculate the offset2 - SWAP ! \ and back-fill it in the original location -; - -\ UNLESS is the same as IF but the test is reversed. -\ -\ Note the use of [COMPILE]: Since IF is IMMEDIATE we don't want it to be executed while UNLESS -\ is compiling, but while UNLESS is running (which happens to be when whatever word using UNLESS is -\ being compiled -- whew!). So we use [COMPILE] to reverse the effect of marking IF as immediate. -\ This trick is generally used when we want to write our own control words without having to -\ implement them all in terms of the primitives 0BRANCH and BRANCH, but instead reusing simpler -\ control words like (in this instance) IF. -: UNLESS IMMEDIATE - ' NOT , \ compile NOT (to reverse the test) - [COMPILE] IF \ continue by calling the normal IF -; - -\ COMMENTS ---------------------------------------------------------------------- -\ -\ FORTH allows ( ... ) as comments within function definitions. This works by having an IMMEDIATE -\ word called ( which just drops input characters until it hits the corresponding ). -: ( IMMEDIATE - 1 \ allowed nested parens by keeping track of depth - BEGIN - KEY \ read next character - DUP '(' = IF \ open paren? - DROP \ drop the open paren - 1+ \ depth increases - ELSE - ')' = IF \ close paren? - 1- \ depth decreases - THEN - THEN - DUP 0= UNTIL \ continue until we reach matching close paren, depth 0 - DROP \ drop the depth counter -; - -( - From now on we can use ( ... ) for comments. - - STACK NOTATION ---------------------------------------------------------------------- - - In FORTH style we can also use ( ... -- ... ) to show the effects that a word has on the - parameter stack. For example: - - ( n -- ) means that the word consumes an integer (n) from the parameter stack. - ( b a -- c ) means that the word uses two integers (a and b, where a is at the top of stack) - and returns a single integer (c). - ( -- ) means the word has no effect on the stack -) - -( Some more complicated stack examples, showing the stack notation. ) -: NIP ( x y -- y ) SWAP DROP ; -: TUCK ( x y -- y x y ) DUP ROT ; -: PICK ( x_u ... x_1 x_0 u -- x_u ... x_1 x_0 x_u ) - 1+ ( add one because of 'u' on the stack ) - 4 * ( multiply by the word size ) - DSP@ + ( add to the stack pointer ) - @ ( and fetch ) -; - -( With the looping constructs, we can now write SPACES, which writes n spaces to stdout. ) -: SPACES ( n -- ) - BEGIN - DUP 0> ( while n > 0 ) - WHILE - SPACE ( print a space ) - 1- ( until we count down to 0 ) - REPEAT - DROP -; - -( Standard words for manipulating BASE. ) -: DECIMAL ( -- ) 10 BASE ! ; -: HEX ( -- ) 16 BASE ! ; - -( - PRINTING NUMBERS ---------------------------------------------------------------------- - - The standard FORTH word . (DOT) is very important. It takes the number at the top - of the stack and prints it out. However first I'm going to implement some lower-level - FORTH words: - - U.R ( u width -- ) which prints an unsigned number, padded to a certain width - U. ( u -- ) which prints an unsigned number - .R ( n width -- ) which prints a signed number, padded to a certain width. - - For example: - -123 6 .R - will print out these characters: - - 1 2 3 - - In other words, the number padded left to a certain number of characters. - - The full number is printed even if it is wider than width, and this is what allows us to - define the ordinary functions U. and . (we just set width to zero knowing that the full - number will be printed anyway). - - Another wrinkle of . and friends is that they obey the current base in the variable BASE. - BASE can be anything in the range 2 to 36. - - While we're defining . &c we can also define .S which is a useful debugging tool. This - word prints the current stack (non-destructively) from top to bottom. -) - -( This is the underlying recursive definition of U. ) -: U. ( u -- ) - BASE @ /MOD ( width rem quot ) - ?DUP IF ( if quotient <> 0 then ) - RECURSE ( print the quotient ) - THEN - - ( print the remainder ) - DUP 10 < IF - '0' ( decimal digits 0..9 ) - ELSE - 10 - ( hex and beyond digits A..Z ) - 'A' - THEN - + - EMIT -; - -( - FORTH word .S prints the contents of the stack. It doesn't alter the stack. - Very useful for debugging. -) -: .S ( -- ) - DSP@ ( get current stack pointer ) - BEGIN - DUP S0 @ < - WHILE - DUP @ U. ( print the stack element ) - SPACE - 4+ ( move up ) - REPEAT - DROP -; - -( This word returns the width (in characters) of an unsigned number in the current base ) -: UWIDTH ( u -- width ) - BASE @ / ( rem quot ) - ?DUP IF ( if quotient <> 0 then ) - RECURSE 1+ ( return 1+recursive call ) - ELSE - 1 ( return 1 ) - THEN -; - -: U.R ( u width -- ) - SWAP ( width u ) - DUP ( width u u ) - UWIDTH ( width u uwidth ) - -ROT ( u uwidth width ) - SWAP - ( u width-uwidth ) - ( At this point if the requested width is narrower, we'll have a negative number on the stack. - Otherwise the number on the stack is the number of spaces to print. But SPACES won't print - a negative number of spaces anyway, so it's now safe to call SPACES ... ) - SPACES - ( ... and then call the underlying implementation of U. ) - U. -; - -( - .R prints a signed number, padded to a certain width. We can't just print the sign - and call U.R because we want the sign to be next to the number ('-123' instead of '- 123'). -) -: .R ( n width -- ) - SWAP ( width n ) - DUP 0< IF - NEGATE ( width u ) - 1 ( save a flag to remember that it was negative | width n 1 ) - ROT ( 1 width u ) - SWAP ( 1 u width ) - 1- ( 1 u width-1 ) - ELSE - 0 ( width u 0 ) - ROT ( 0 width u ) - SWAP ( 0 u width ) - THEN - SWAP ( flag width u ) - DUP ( flag width u u ) - UWIDTH ( flag width u uwidth ) - -ROT ( flag u uwidth width ) - SWAP - ( flag u width-uwidth ) - - SPACES ( flag u ) - SWAP ( u flag ) - - IF ( was it negative? print the - character ) - '-' EMIT - THEN - - U. -; - -( Finally we can define word . in terms of .R, with a trailing space. ) -: . 0 .R SPACE ; - -( The real U., note the trailing space. ) -: U. U. SPACE ; - -( ? fetches the integer at an address and prints it. ) -: ? ( addr -- ) @ . ; - -( c a b WITHIN returns true if a <= c and c < b ) -: WITHIN - ROT ( b c a ) - OVER ( b c a c ) - <= IF - > IF ( b c -- ) - TRUE - ELSE - FALSE - THEN - ELSE - 2DROP ( b c -- ) - FALSE - THEN -; - -( DEPTH returns the depth of the stack. ) -: DEPTH ( -- n ) - S0 @ DSP@ - - 4- ( adjust because S0 was on the stack when we pushed DSP ) -; - -( - ALIGNED takes an address and rounds it up (aligns it) to the next 4 byte boundary. -) -: ALIGNED ( addr -- addr ) - 3 + 3 INVERT AND ( (addr+3) & ~3 ) -; - -( - ALIGN aligns the HERE pointer, so the next word appended will be aligned properly. -) -: ALIGN HERE @ ALIGNED HERE ! ; - -( - STRINGS ---------------------------------------------------------------------- - - S" string" is used in FORTH to define strings. It leaves the address of the string and - its length on the stack, (length at the top of stack). The space following S" is the normal - space between FORTH words and is not a part of the string. - - This is tricky to define because it has to do different things depending on whether - we are compiling or in immediate mode. (Thus the word is marked IMMEDIATE so it can - detect this and do different things). - - In compile mode we append - LITSTRING - to the current word. The primitive LITSTRING does the right thing when the current - word is executed. - - In immediate mode there isn't a particularly good place to put the string, but in this - case we put the string at HERE (but we _don't_ change HERE). This is meant as a temporary - location, likely to be overwritten soon after. -) -( C, appends a byte to the current compiled word. ) -: C, - HERE @ C! ( store the character in the compiled image ) - 1 HERE +! ( increment HERE pointer by 1 byte ) -; - -: S" IMMEDIATE ( -- addr len ) - STATE @ IF ( compiling? ) - ' LITSTRING , ( compile LITSTRING ) - HERE @ ( save the address of the length word on the stack ) - 0 , ( dummy length - we don't know what it is yet ) - BEGIN - KEY ( get next character of the string ) - DUP '"' <> - WHILE - C, ( copy character ) - REPEAT - DROP ( drop the double quote character at the end ) - DUP ( get the saved address of the length word ) - HERE @ SWAP - ( calculate the length ) - 4- ( subtract 4 (because we measured from the start of the length word) ) - SWAP ! ( and back-fill the length location ) - ALIGN ( round up to next multiple of 4 bytes for the remaining code ) - ELSE ( immediate mode ) - HERE @ ( get the start address of the temporary space ) - BEGIN - KEY - DUP '"' <> - WHILE - OVER C! ( save next character ) - 1+ ( increment address ) - REPEAT - DROP ( drop the final " character ) - HERE @ - ( calculate the length ) - HERE @ ( push the start address ) - SWAP ( addr len ) - THEN -; - -( - ." is the print string operator in FORTH. Example: ." Something to print" - The space after the operator is the ordinary space required between words and is not - a part of what is printed. - - In immediate mode we just keep reading characters and printing them until we get to - the next double quote. - - In compile mode we use S" to store the string, then add TELL afterwards: - LITSTRING TELL - - It may be interesting to note the use of [COMPILE] to turn the call to the immediate - word S" into compilation of that word. It compiles it into the definition of .", - not into the definition of the word being compiled when this is running (complicated - enough for you?) -) -: ." IMMEDIATE ( -- ) - STATE @ IF ( compiling? ) - [COMPILE] S" ( read the string, and compile LITSTRING, etc. ) - ' TELL , ( compile the final TELL ) - ELSE - ( In immediate mode, just read characters and print them until we get - to the ending double quote. ) - BEGIN - KEY - DUP '"' = IF - DROP ( drop the double quote character ) - EXIT ( return from this function ) - THEN - EMIT - AGAIN - THEN -; - -( - CONSTANTS AND VARIABLES ---------------------------------------------------------------------- - - In FORTH, global constants and variables are defined like this: - - 10 CONSTANT TEN when TEN is executed, it leaves the integer 10 on the stack - VARIABLE VAR when VAR is executed, it leaves the address of VAR on the stack - - Constants can be read but not written, eg: - - TEN . CR prints 10 - - You can read a variable (in this example called VAR) by doing: - - VAR @ leaves the value of VAR on the stack - VAR @ . CR prints the value of VAR - VAR ? CR same as above, since ? is the same as @ . - - and update the variable by doing: - - 20 VAR ! sets VAR to 20 - - Note that variables are uninitialised (but see VALUE later on which provides initialised - variables with a slightly simpler syntax). - - How can we define the words CONSTANT and VARIABLE? - - The trick is to define a new word for the variable itself (eg. if the variable was called - 'VAR' then we would define a new word called VAR). This is easy to do because we exposed - dictionary entry creation through the CREATE word (part of the definition of : above). - A call to WORD [TEN] CREATE (where [TEN] means that "TEN" is the next word in the input) - leaves the dictionary entry: - - +--- HERE - | - V - +---------+---+---+---+---+ - | LINK | 3 | T | E | N | - +---------+---+---+---+---+ - len - - For CONSTANT we can continue by appending DOCOL (the codeword), then LIT followed by - the constant itself and then EXIT, forming a little word definition that returns the - constant: - - +---------+---+---+---+---+------------+------------+------------+------------+ - | LINK | 3 | T | E | N | DOCOL | LIT | 10 | EXIT | - +---------+---+---+---+---+------------+------------+------------+------------+ - len codeword - - Notice that this word definition is exactly the same as you would have got if you had - written : TEN 10 ; - - Note for people reading the code below: DOCOL is a constant word which we defined in the - assembler part which returns the value of the assembler symbol of the same name. -) -: CONSTANT - WORD ( get the name (the name follows CONSTANT) ) - CREATE ( make the dictionary entry ) - DOCOL , ( append DOCOL (the codeword field of this word) ) - ' LIT , ( append the codeword LIT ) - , ( append the value on the top of the stack ) - ' EXIT , ( append the codeword EXIT ) -; - -( - VARIABLE is a little bit harder because we need somewhere to put the variable. There is - nothing particularly special about the user memory (the area of memory pointed to by HERE - where we have previously just stored new word definitions). We can slice off bits of this - memory area to store anything we want, so one possible definition of VARIABLE might create - this: - - +--------------------------------------------------------------+ - | | - V | - +---------+---------+---+---+---+---+------------+------------+---|--------+------------+ - | | LINK | 3 | V | A | R | DOCOL | LIT | | EXIT | - +---------+---------+---+---+---+---+------------+------------+------------+------------+ - len codeword - - where is the place to store the variable, and points back to it. - - To make this more general let's define a couple of words which we can use to allocate - arbitrary memory from the user memory. - - First ALLOT, where n ALLOT allocates n bytes of memory. (Note when calling this that - it's a very good idea to make sure that n is a multiple of 4, or at least that next time - a word is compiled that HERE has been left as a multiple of 4). -) -: ALLOT ( n -- addr ) - HERE @ SWAP ( here n ) - HERE +! ( adds n to HERE, after this the old value of HERE is still on the stack ) -; - -( - Second, CELLS. In FORTH the phrase 'n CELLS ALLOT' means allocate n integers of whatever size - is the natural size for integers on this machine architecture. On this 32 bit machine therefore - CELLS just multiplies the top of stack by 4. -) -: CELLS ( n -- n ) 4 * ; - -( - So now we can define VARIABLE easily in much the same way as CONSTANT above. Refer to the - diagram above to see what the word that this creates will look like. -) -: VARIABLE - 1 CELLS ALLOT ( allocate 1 cell of memory, push the pointer to this memory ) - WORD CREATE ( make the dictionary entry (the name follows VARIABLE) ) - DOCOL , ( append DOCOL (the codeword field of this word) ) - ' LIT , ( append the codeword LIT ) - , ( append the pointer to the new memory ) - ' EXIT , ( append the codeword EXIT ) -; - -( - VALUES ---------------------------------------------------------------------- - - VALUEs are like VARIABLEs but with a simpler syntax. You would generally use them when you - want a variable which is read often, and written infrequently. - - 20 VALUE VAL creates VAL with initial value 20 - VAL pushes the value (20) directly on the stack - 30 TO VAL updates VAL, setting it to 30 - VAL pushes the value (30) directly on the stack - - Notice that 'VAL' on its own doesn't return the address of the value, but the value itself, - making values simpler and more obvious to use than variables (no indirection through '@'). - The price is a more complicated implementation, although despite the complexity there is no - performance penalty at runtime. - - A naive implementation of 'TO' would be quite slow, involving a dictionary search each time. - But because this is FORTH we have complete control of the compiler so we can compile TO more - efficiently, turning: - TO VAL - into: - LIT ! - and calculating (the address of the value) at compile time. - - Now this is the clever bit. We'll compile our value like this: - - +---------+---+---+---+---+------------+------------+------------+------------+ - | LINK | 3 | V | A | L | DOCOL | LIT | | EXIT | - +---------+---+---+---+---+------------+------------+------------+------------+ - len codeword - - where is the actual value itself. Note that when VAL executes, it will push the - value on the stack, which is what we want. - - But what will TO use for the address ? Why of course a pointer to that : - - code compiled - - - - --+------------+------------+------------+-- - - - - - by TO VAL | LIT | | ! | - - - - - --+------------+-----|------+------------+-- - - - - - | - V - +---------+---+---+---+---+------------+------------+------------+------------+ - | LINK | 3 | V | A | L | DOCOL | LIT | | EXIT | - +---------+---+---+---+---+------------+------------+------------+------------+ - len codeword - - In other words, this is a kind of self-modifying code. - - (Note to the people who want to modify this FORTH to add inlining: values defined this - way cannot be inlined). -) -: VALUE ( n -- ) - WORD CREATE ( make the dictionary entry (the name follows VALUE) ) - DOCOL , ( append DOCOL ) - ' LIT , ( append the codeword LIT ) - , ( append the initial value ) - ' EXIT , ( append the codeword EXIT ) -; - -: TO IMMEDIATE ( n -- ) - WORD ( get the name of the value ) - FIND ( look it up in the dictionary ) - >DFA ( get a pointer to the first data field (the 'LIT') ) - 4+ ( increment to point at the value ) - STATE @ IF ( compiling? ) - ' LIT , ( compile LIT ) - , ( compile the address of the value ) - ' ! , ( compile ! ) - ELSE ( immediate mode ) - ! ( update it straightaway ) - THEN -; - -( x +TO VAL adds x to VAL ) -: +TO IMMEDIATE - WORD ( get the name of the value ) - FIND ( look it up in the dictionary ) - >DFA ( get a pointer to the first data field (the 'LIT') ) - 4+ ( increment to point at the value ) - STATE @ IF ( compiling? ) - ' LIT , ( compile LIT ) - , ( compile the address of the value ) - ' +! , ( compile +! ) - ELSE ( immediate mode ) - +! ( update it straightaway ) - THEN -; - -( - PRINTING THE DICTIONARY ---------------------------------------------------------------------- - - ID. takes an address of a dictionary entry and prints the word's name. - - For example: LATEST @ ID. would print the name of the last word that was defined. -) -: ID. - 4+ ( skip over the link pointer ) - DUP C@ ( get the flags/length byte ) - F_LENMASK AND ( mask out the flags - just want the length ) - - BEGIN - DUP 0> ( length > 0? ) - WHILE - SWAP 1+ ( addr len -- len addr+1 ) - DUP C@ ( len addr -- len addr char | get the next character) - EMIT ( len addr char -- len addr | and print it) - SWAP 1- ( len addr -- addr len-1 | subtract one from length ) - REPEAT - 2DROP ( len addr -- ) -; - -( - 'WORD word FIND ?HIDDEN' returns true if 'word' is flagged as hidden. - - 'WORD word FIND ?IMMEDIATE' returns true if 'word' is flagged as immediate. -) -: ?HIDDEN - 4+ ( skip over the link pointer ) - C@ ( get the flags/length byte ) - F_HIDDEN AND ( mask the F_HIDDEN flag and return it (as a truth value) ) -; -: ?IMMEDIATE - 4+ ( skip over the link pointer ) - C@ ( get the flags/length byte ) - F_IMMED AND ( mask the F_IMMED flag and return it (as a truth value) ) -; - -( - WORDS prints all the words defined in the dictionary, starting with the word defined most recently. - However it doesn't print hidden words. - - The implementation simply iterates backwards from LATEST using the link pointers. -) -: WORDS - LATEST @ ( start at LATEST dictionary entry ) - BEGIN - ?DUP ( while link pointer is not null ) - WHILE - DUP ?HIDDEN NOT IF ( ignore hidden words ) - DUP ID. ( but if not hidden, print the word ) - SPACE - THEN - @ ( dereference the link pointer - go to previous word ) - REPEAT - CR -; - -( - FORGET ---------------------------------------------------------------------- - - So far we have only allocated words and memory. FORTH provides a rather primitive method - to deallocate. - - 'FORGET word' deletes the definition of 'word' from the dictionary and everything defined - after it, including any variables and other memory allocated after. - - The implementation is very simple - we look up the word (which returns the dictionary entry - address). Then we set HERE to point to that address, so in effect all future allocations - and definitions will overwrite memory starting at the word. We also need to set LATEST to - point to the previous word. - - Note that you cannot FORGET built-in words (well, you can try but it will probably cause - a segfault). - - XXX: Because we wrote VARIABLE to store the variable in memory allocated before the word, - in the current implementation VARIABLE FOO FORGET FOO will leak 1 cell of memory. -) -: FORGET - WORD FIND ( find the word, gets the dictionary entry address ) - DUP @ LATEST ! ( set LATEST to point to the previous word ) - HERE ! ( and store HERE with the dictionary address ) -; - -( - DUMP ---------------------------------------------------------------------- - - DUMP is used to dump out the contents of memory, in the 'traditional' hexdump format. - - Notice that the parameters to DUMP (address, length) are compatible with string words - such as WORD and S". - - You can dump out the raw code for the last word you defined by doing something like: - - LATEST @ 128 DUMP -) -: DUMP ( addr len -- ) - BASE @ ROT ( save the current BASE at the bottom of the stack ) - HEX ( and switch to hexadecimal mode ) - - BEGIN - ?DUP ( while len > 0 ) - WHILE - OVER 8 U.R ( print the address ) - SPACE - - ( print up to 16 words on this line ) - 2DUP ( addr len addr len ) - 1- 15 AND 1+ ( addr len addr linelen ) - BEGIN - ?DUP ( while linelen > 0 ) - WHILE - SWAP ( addr len linelen addr ) - DUP C@ ( addr len linelen addr byte ) - 2 .R SPACE ( print the byte ) - 1+ SWAP 1- ( addr len linelen addr -- addr len addr+1 linelen-1 ) - REPEAT - DROP ( addr len ) - - ( print the ASCII equivalents ) - 2DUP 1- 15 AND 1+ ( addr len addr linelen ) - BEGIN - ?DUP ( while linelen > 0) - WHILE - SWAP ( addr len linelen addr ) - DUP C@ ( addr len linelen addr byte ) - DUP 32 128 WITHIN IF ( 32 <= c < 128? ) - EMIT - ELSE - DROP '.' EMIT - THEN - 1+ SWAP 1- ( addr len linelen addr -- addr len addr+1 linelen-1 ) - REPEAT - DROP ( addr len ) - CR - - DUP 1- 15 AND 1+ ( addr len linelen ) - DUP ( addr len linelen linelen ) - ROT ( addr linelen len linelen ) - - ( addr linelen len-linelen ) - ROT ( len-linelen addr linelen ) - + ( len-linelen addr+linelen ) - SWAP ( addr-linelen len-linelen ) - REPEAT - - DROP ( restore stack ) - BASE ! ( restore saved BASE ) -; - -( - CASE ---------------------------------------------------------------------- - - CASE...ENDCASE is how we do switch statements in FORTH. There is no generally - agreed syntax for this, so I've gone for the syntax mandated by the ISO standard - FORTH (ANS-FORTH). - - ( some value on the stack ) - CASE - test1 OF ... ENDOF - test2 OF ... ENDOF - testn OF ... ENDOF - ... ( default case ) - ENDCASE - - The CASE statement tests the value on the stack by comparing it for equality with - test1, test2, ..., testn and executes the matching piece of code within OF ... ENDOF. - If none of the test values match then the default case is executed. Inside the ... of - the default case, the value is still at the top of stack (it is implicitly DROP-ed - by ENDCASE). When ENDOF is executed it jumps after ENDCASE (ie. there is no "fall-through" - and no need for a break statement like in C). - - The default case may be omitted. In fact the tests may also be omitted so that you - just have a default case, although this is probably not very useful. - - An example (assuming that 'q', etc. are words which push the ASCII value of the letter - on the stack): - - 0 VALUE QUIT - 0 VALUE SLEEP - KEY CASE - 'q' OF 1 TO QUIT ENDOF - 's' OF 1 TO SLEEP ENDOF - ( default case: ) - ." Sorry, I didn't understand key <" DUP EMIT ." >, try again." CR - ENDCASE - - (In some versions of FORTH, more advanced tests are supported, such as ranges, etc. - Other versions of FORTH need you to write OTHERWISE to indicate the default case. - As I said above, this FORTH tries to follow the ANS FORTH standard). - - The implementation of CASE...ENDCASE is somewhat non-trivial. I'm following the - implementations from here: - http://www.uni-giessen.de/faq/archiv/forthfaq.case_endcase/msg00000.html - - The general plan is to compile the code as a series of IF statements: - - CASE (push 0 on the immediate-mode parameter stack) - test1 OF ... ENDOF test1 OVER = IF DROP ... ELSE - test2 OF ... ENDOF test2 OVER = IF DROP ... ELSE - testn OF ... ENDOF testn OVER = IF DROP ... ELSE - ... ( default case ) ... - ENDCASE DROP THEN [THEN [THEN ...]] - - The CASE statement pushes 0 on the immediate-mode parameter stack, and that number - is used to count how many THEN statements we need when we get to ENDCASE so that each - IF has a matching THEN. The counting is done implicitly. If you recall from the - implementation above of IF, each IF pushes a code address on the immediate-mode stack, - and these addresses are non-zero, so by the time we get to ENDCASE the stack contains - some number of non-zeroes, followed by a zero. The number of non-zeroes is how many - times IF has been called, so how many times we need to match it with THEN. - - This code uses [COMPILE] so that we compile calls to IF, ELSE, THEN instead of - actually calling them while we're compiling the words below. - - As is the case with all of our control structures, they only work within word - definitions, not in immediate mode. -) -: CASE IMMEDIATE - 0 ( push 0 to mark the bottom of the stack ) -; - -: OF IMMEDIATE - ' OVER , ( compile OVER ) - ' = , ( compile = ) - [COMPILE] IF ( compile IF ) - ' DROP , ( compile DROP ) -; - -: ENDOF IMMEDIATE - [COMPILE] ELSE ( ENDOF is the same as ELSE ) -; - -: ENDCASE IMMEDIATE - ' DROP , ( compile DROP ) - - ( keep compiling THEN until we get to our zero marker ) - BEGIN - ?DUP - WHILE - [COMPILE] THEN - REPEAT -; - -( - DECOMPILER ---------------------------------------------------------------------- - - CFA> is the opposite of >CFA. It takes a codeword and tries to find the matching - dictionary definition. (In truth, it works with any pointer into a word, not just - the codeword pointer, and this is needed to do stack traces). - - In this FORTH this is not so easy. In fact we have to search through the dictionary - because we don't have a convenient back-pointer (as is often the case in other versions - of FORTH). Because of this search, CFA> should not be used when performance is critical, - so it is only used for debugging tools such as the decompiler and printing stack - traces. - - This word returns 0 if it doesn't find a match. -) -: CFA> - LATEST @ ( start at LATEST dictionary entry ) - BEGIN - ?DUP ( while link pointer is not null ) - WHILE - 2DUP SWAP ( cfa curr curr cfa ) - < IF ( current dictionary entry < cfa? ) - NIP ( leave curr dictionary entry on the stack ) - EXIT - THEN - @ ( follow link pointer back ) - REPEAT - DROP ( restore stack ) - 0 ( sorry, nothing found ) -; - -( - SEE decompiles a FORTH word. - - We search for the dictionary entry of the word, then search again for the next - word (effectively, the end of the compiled word). This results in two pointers: - - +---------+---+---+---+---+------------+------------+------------+------------+ - | LINK | 3 | T | E | N | DOCOL | LIT | 10 | EXIT | - +---------+---+---+---+---+------------+------------+------------+------------+ - ^ ^ - | | - Start of word End of word - - With this information we can have a go at decompiling the word. We need to - recognise "meta-words" like LIT, LITSTRING, BRANCH, etc. and treat those separately. -) -: SEE - WORD FIND ( find the dictionary entry to decompile ) - - ( Now we search again, looking for the next word in the dictionary. This gives us - the length of the word that we will be decompiling. (Well, mostly it does). ) - HERE @ ( address of the end of the last compiled word ) - LATEST @ ( word last curr ) - BEGIN - 2 PICK ( word last curr word ) - OVER ( word last curr word curr ) - <> ( word last curr word<>curr? ) - WHILE ( word last curr ) - NIP ( word curr ) - DUP @ ( word curr prev (which becomes: word last curr) ) - REPEAT - - DROP ( at this point, the stack is: start-of-word end-of-word ) - SWAP ( end-of-word start-of-word ) - - ( begin the definition with : NAME [IMMEDIATE] ) - ':' EMIT SPACE DUP ID. SPACE - DUP ?IMMEDIATE IF ." IMMEDIATE " THEN - - >DFA ( get the data address, ie. points after DOCOL | end-of-word start-of-data ) - - ( now we start decompiling until we hit the end of the word ) - BEGIN ( end start ) - 2DUP > - WHILE - DUP @ ( end start codeword ) - - CASE - ' LIT OF ( is it LIT ? ) - 4 + DUP @ ( get next word which is the integer constant ) - . ( and print it ) - ENDOF - ' LITSTRING OF ( is it LITSTRING ? ) - [ CHAR S ] LITERAL EMIT '"' EMIT SPACE ( print S" ) - 4 + DUP @ ( get the length word ) - SWAP 4 + SWAP ( end start+4 length ) - 2DUP TELL ( print the string ) - '"' EMIT SPACE ( finish the string with a final quote ) - + ALIGNED ( end start+4+len, aligned ) - 4 - ( because we're about to add 4 below ) - ENDOF - ' 0BRANCH OF ( is it 0BRANCH ? ) - ." 0BRANCH ( " - 4 + DUP @ ( print the offset ) - . - ." ) " - ENDOF - ' BRANCH OF ( is it BRANCH ? ) - ." BRANCH ( " - 4 + DUP @ ( print the offset ) - . - ." ) " - ENDOF - ' ' OF ( is it ' (TICK) ? ) - [ CHAR ' ] LITERAL EMIT SPACE - 4 + DUP @ ( get the next codeword ) - CFA> ( and force it to be printed as a dictionary entry ) - ID. SPACE - ENDOF - ' EXIT OF ( is it EXIT? ) - ( We expect the last word to be EXIT, and if it is then we don't print it - because EXIT is normally implied by ;. EXIT can also appear in the middle - of words, and then it needs to be printed. ) - 2DUP ( end start end start ) - 4 + ( end start end start+4 ) - <> IF ( end start | we're not at the end ) - ." EXIT " - THEN - ENDOF - ( default case: ) - DUP ( in the default case we always need to DUP before using ) - CFA> ( look up the codeword to get the dictionary entry ) - ID. SPACE ( and print it ) - ENDCASE - - 4 + ( end start+4 ) - REPEAT - - ';' EMIT CR - - 2DROP ( restore stack ) -; - -( - EXECUTION TOKENS ---------------------------------------------------------------------- - - Standard FORTH defines a concept called an 'execution token' (or 'xt') which is very - similar to a function pointer in C. We map the execution token to a codeword address. - - execution token of DOUBLE is the address of this codeword - | - V - +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ - | LINK | 6 | D | O | U | B | L | E | 0 | DOCOL | DUP | + | EXIT | - +---------+---+---+---+---+---+---+---+---+------------+------------+------------+------------+ - len pad codeword ^ - - There is one assembler primitive for execution tokens, EXECUTE ( xt -- ), which runs them. - - You can make an execution token for an existing word the long way using >CFA, - ie: WORD [foo] FIND >CFA will push the xt for foo onto the stack where foo is the - next word in input. So a very slow way to run DOUBLE might be: - - : DOUBLE DUP + ; - : SLOW WORD FIND >CFA EXECUTE ; - 5 SLOW DOUBLE . CR \ prints 10 - - We also offer a simpler and faster way to get the execution token of any word FOO: - - ['] FOO - - (Exercises for readers: (1) What is the difference between ['] FOO and ' FOO? - (2) What is the relationship between ', ['] and LIT?) - - More useful is to define anonymous words and/or to assign xt's to variables. - - To define an anonymous word (and push its xt on the stack) use :NONAME ... ; as in this - example: - - :NONAME ." anon word was called" CR ; \ pushes xt on the stack - DUP EXECUTE EXECUTE \ executes the anon word twice - - Stack parameters work as expected: - - :NONAME ." called with parameter " . CR ; - DUP - 10 SWAP EXECUTE \ prints 'called with parameter 10' - 20 SWAP EXECUTE \ prints 'called with parameter 20' - - Notice that the above code has a memory leak: the anonymous word is still compiled - into the data segment, so even if you lose track of the xt, the word continues to - occupy memory. A good way to keep track of the xt and thus avoid the memory leak is - to assign it to a CONSTANT, VARIABLE or VALUE: - - 0 VALUE ANON - :NONAME ." anon word was called" CR ; TO ANON - ANON EXECUTE - ANON EXECUTE - - Another use of :NONAME is to create an array of functions which can be called quickly - (think: fast switch statement). This example is adapted from the ANS FORTH standard: - - 10 CELLS ALLOT CONSTANT CMD-TABLE - : SET-CMD CELLS CMD-TABLE + ! ; - : CALL-CMD CELLS CMD-TABLE + @ EXECUTE ; - - :NONAME ." alternate 0 was called" CR ; 0 SET-CMD - :NONAME ." alternate 1 was called" CR ; 1 SET-CMD - \ etc... - :NONAME ." alternate 9 was called" CR ; 9 SET-CMD - - 0 CALL-CMD - 1 CALL-CMD -) - -: :NONAME - 0 0 CREATE ( create a word with no name - we need a dictionary header because ; expects it ) - HERE @ ( current HERE value is the address of the codeword, ie. the xt ) - DOCOL , ( compile DOCOL (the codeword) ) - ] ( go into compile mode ) -; - -: ['] IMMEDIATE - ' LIT , ( compile LIT ) -; - -( - EXCEPTIONS ---------------------------------------------------------------------- - - Amazingly enough, exceptions can be implemented directly in FORTH, in fact rather easily. - - The general usage is as follows: - - : FOO ( n -- ) THROW ; - - : TEST-EXCEPTIONS - 25 ['] FOO CATCH \ execute 25 FOO, catching any exception - ?DUP IF - ." called FOO and it threw exception number: " - . CR - DROP \ we have to drop the argument of FOO (25) - THEN - ; - \ prints: called FOO and it threw exception number: 25 - - CATCH runs an execution token and detects whether it throws any exception or not. The - stack signature of CATCH is rather complicated: - - ( a_n-1 ... a_1 a_0 xt -- r_m-1 ... r_1 r_0 0 ) if xt did NOT throw an exception - ( a_n-1 ... a_1 a_0 xt -- ?_n-1 ... ?_1 ?_0 e ) if xt DID throw exception 'e' - - where a_i and r_i are the (arbitrary number of) argument and return stack contents - before and after xt is EXECUTEd. Notice in particular the case where an exception - is thrown, the stack pointer is restored so that there are n of _something_ on the - stack in the positions where the arguments a_i used to be. We don't really guarantee - what is on the stack -- perhaps the original arguments, and perhaps other nonsense -- - it largely depends on the implementation of the word that was executed. - - THROW, ABORT and a few others throw exceptions. - - Exception numbers are non-zero integers. By convention the positive numbers can be used - for app-specific exceptions and the negative numbers have certain meanings defined in - the ANS FORTH standard. (For example, -1 is the exception thrown by ABORT). - - 0 THROW does nothing. This is the stack signature of THROW: - - ( 0 -- ) - ( * e -- ?_n-1 ... ?_1 ?_0 e ) the stack is restored to the state from the corresponding CATCH - - The implementation hangs on the definitions of CATCH and THROW and the state shared - between them. - - Up to this point, the return stack has consisted merely of a list of return addresses, - with the top of the return stack being the return address where we will resume executing - when the current word EXITs. However CATCH will push a more complicated 'exception stack - frame' on the return stack. The exception stack frame records some things about the - state of execution at the time that CATCH was called. - - When called, THROW walks up the return stack (the process is called 'unwinding') until - it finds the exception stack frame. It then uses the data in the exception stack frame - to restore the state allowing execution to continue after the matching CATCH. (If it - unwinds the stack and doesn't find the exception stack frame then it prints a message - and drops back to the prompt, which is also normal behaviour for so-called 'uncaught - exceptions'). - - This is what the exception stack frame looks like. (As is conventional, the return stack - is shown growing downwards from higher to lower memory addresses). - - +------------------------------+ - | return address from CATCH | Notice this is already on the - | | return stack when CATCH is called. - +------------------------------+ - | original parameter stack | - | pointer | - +------------------------------+ ^ - | exception stack marker | | - | (EXCEPTION-MARKER) | | Direction of stack - +------------------------------+ | unwinding by THROW. - | - | - - The EXCEPTION-MARKER marks the entry as being an exception stack frame rather than an - ordinary return address, and it is this which THROW "notices" as it is unwinding the - stack. (If you want to implement more advanced exceptions such as TRY...WITH then - you'll need to use a different value of marker if you want the old and new exception stack - frame layouts to coexist). - - What happens if the executed word doesn't throw an exception? It will eventually - return and call EXCEPTION-MARKER, so EXCEPTION-MARKER had better do something sensible - without us needing to modify EXIT. This nicely gives us a suitable definition of - EXCEPTION-MARKER, namely a function that just drops the stack frame and itself - returns (thus "returning" from the original CATCH). - - One thing to take from this is that exceptions are a relatively lightweight mechanism - in FORTH. -) - -: EXCEPTION-MARKER - RDROP ( drop the original parameter stack pointer ) - 0 ( there was no exception, this is the normal return path ) -; - -: CATCH ( xt -- exn? ) - DSP@ 4+ >R ( save parameter stack pointer (+4 because of xt) on the return stack ) - ' EXCEPTION-MARKER 4+ ( push the address of the RDROP inside EXCEPTION-MARKER ... ) - >R ( ... on to the return stack so it acts like a return address ) - EXECUTE ( execute the nested function ) -; - -: THROW ( n -- ) - ?DUP IF ( only act if the exception code <> 0 ) - RSP@ ( get return stack pointer ) - BEGIN - DUP R0 4- < ( RSP < R0 ) - WHILE - DUP @ ( get the return stack entry ) - ' EXCEPTION-MARKER 4+ = IF ( found the EXCEPTION-MARKER on the return stack ) - 4+ ( skip the EXCEPTION-MARKER on the return stack ) - RSP! ( restore the return stack pointer ) - - ( Restore the parameter stack. ) - DUP DUP DUP ( reserve some working space so the stack for this word - doesn't coincide with the part of the stack being restored ) - R> ( get the saved parameter stack pointer | n dsp ) - 4- ( reserve space on the stack to store n ) - SWAP OVER ( dsp n dsp ) - ! ( write n on the stack ) - DSP! EXIT ( restore the parameter stack pointer, immediately exit ) - THEN - 4+ - REPEAT - - ( No matching catch - print a message and restart the INTERPRETer. ) - DROP - - CASE - 0 1- OF ( ABORT ) - ." ABORTED" CR - ENDOF - ( default case ) - ." UNCAUGHT THROW " - DUP . CR - ENDCASE - QUIT - THEN -; - -: ABORT ( -- ) - 0 1- THROW -; - -( Print a stack trace by walking up the return stack. ) -: PRINT-STACK-TRACE - RSP@ ( start at caller of this function ) - BEGIN - DUP R0 4- < ( RSP < R0 ) - WHILE - DUP @ ( get the return stack entry ) - CASE - ' EXCEPTION-MARKER 4+ OF ( is it the exception stack frame? ) - ." CATCH ( DSP=" - 4+ DUP @ U. ( print saved stack pointer ) - ." ) " - ENDOF - ( default case ) - DUP - CFA> ( look up the codeword to get the dictionary entry ) - ?DUP IF ( and print it ) - 2DUP ( dea addr dea ) - ID. ( print word from dictionary entry ) - [ CHAR + ] LITERAL EMIT - SWAP >DFA 4+ - . ( print offset ) - THEN - ENDCASE - 4+ ( move up the stack ) - REPEAT - DROP - CR -; - -( - C STRINGS ---------------------------------------------------------------------- - - FORTH strings are represented by a start address and length kept on the stack or in memory. - - Most FORTHs don't handle C strings, but we need them in order to access the process arguments - and environment left on the stack by the Linux kernel, and to make some system calls. - - Operation Input Output FORTH word Notes - ---------------------------------------------------------------------- - - Create FORTH string addr len S" ..." - - Create C string c-addr Z" ..." - - C -> FORTH c-addr addr len DUP STRLEN - - FORTH -> C addr len c-addr CSTRING Allocated in a temporary buffer, so - should be consumed / copied immediately. - FORTH string should not contain NULs. - - For example, DUP STRLEN TELL prints a C string. -) - -( - Z" .." is like S" ..." except that the string is terminated by an ASCII NUL character. - - To make it more like a C string, at runtime Z" just leaves the address of the string - on the stack (not address & length as with S"). To implement this we need to add the - extra NUL to the string and also a DROP instruction afterwards. Apart from that the - implementation just a modified S". -) -: Z" IMMEDIATE - STATE @ IF ( compiling? ) - ' LITSTRING , ( compile LITSTRING ) - HERE @ ( save the address of the length word on the stack ) - 0 , ( dummy length - we don't know what it is yet ) - BEGIN - KEY ( get next character of the string ) - DUP '"' <> - WHILE - HERE @ C! ( store the character in the compiled image ) - 1 HERE +! ( increment HERE pointer by 1 byte ) - REPEAT - 0 HERE @ C! ( add the ASCII NUL byte ) - 1 HERE +! - DROP ( drop the double quote character at the end ) - DUP ( get the saved address of the length word ) - HERE @ SWAP - ( calculate the length ) - 4- ( subtract 4 (because we measured from the start of the length word) ) - SWAP ! ( and back-fill the length location ) - ALIGN ( round up to next multiple of 4 bytes for the remaining code ) - ' DROP , ( compile DROP (to drop the length) ) - ELSE ( immediate mode ) - HERE @ ( get the start address of the temporary space ) - BEGIN - KEY - DUP '"' <> - WHILE - OVER C! ( save next character ) - 1+ ( increment address ) - REPEAT - DROP ( drop the final " character ) - 0 SWAP C! ( store final ASCII NUL ) - HERE @ ( push the start address ) - THEN -; - -: STRLEN ( str -- len ) - DUP ( save start address ) - BEGIN - DUP C@ 0<> ( zero byte found? ) - WHILE - 1+ - REPEAT - - SWAP - ( calculate the length ) -; - -: CSTRING ( addr len -- c-addr ) - SWAP OVER ( len saddr len ) - HERE @ SWAP ( len saddr daddr len ) - CMOVE ( len ) - - HERE @ + ( daddr+len ) - 0 SWAP C! ( store terminating NUL char ) - - HERE @ ( push start address ) -; - -( - THE ENVIRONMENT ---------------------------------------------------------------------- - - Linux makes the process arguments and environment available to us on the stack. - - The top of stack pointer is saved by the early assembler code when we start up in the FORTH - variable S0, and starting at this pointer we can read out the command line arguments and the - environment. - - Starting at S0, S0 itself points to argc (the number of command line arguments). - - S0+4 points to argv[0], S0+8 points to argv[1] etc up to argv[argc-1]. - - argv[argc] is a NULL pointer. - - After that the stack contains environment variables, a set of pointers to strings of the - form NAME=VALUE and on until we get to another NULL pointer. - - The first word that we define, ARGC, pushes the number of command line arguments (note that - as with C argc, this includes the name of the command). -) -: ARGC - S0 @ @ -; - -( - n ARGV gets the nth command line argument. - - For example to print the command name you would do: - 0 ARGV TELL CR -) -: ARGV ( n -- str u ) - 1+ CELLS S0 @ + ( get the address of argv[n] entry ) - @ ( get the address of the string ) - DUP STRLEN ( and get its length / turn it into a FORTH string ) -; - -( - ENVIRON returns the address of the first environment string. The list of strings ends - with a NULL pointer. - - For example to print the first string in the environment you could do: - ENVIRON @ DUP STRLEN TELL -) -: ENVIRON ( -- addr ) - ARGC ( number of command line parameters on the stack to skip ) - 2 + ( skip command line count and NULL pointer after the command line args ) - CELLS ( convert to an offset ) - S0 @ + ( add to base stack address ) -; - -( - SYSTEM CALLS AND FILES ---------------------------------------------------------------------- - - Miscellaneous words related to system calls, and standard access to files. -) - -( BYE exits by calling the Linux exit(2) syscall. ) -: BYE ( -- ) - 0 ( return code (0) ) - SYS_EXIT ( system call number ) - SYSCALL1 -; - -( - UNUSED returns the number of cells remaining in the user memory (data segment). - - For our implementation we will use Linux brk(2) system call to find out the end - of the data segment and subtract HERE from it. -) -: GET-BRK ( -- brkpoint ) - 0 SYS_BRK SYSCALL1 ( call brk(0) ) -; - -: UNUSED ( -- n ) - GET-BRK ( get end of data segment according to the kernel ) - HERE @ ( get current position in data segment ) - - - 4 / ( returns number of cells ) -; - -( - MORECORE increases the data segment by the specified number of (4 byte) cells. - - NB. The number of cells requested should normally be a multiple of 1024. The - reason is that Linux can't extend the data segment by less than a single page - (4096 bytes or 1024 cells). - - This FORTH doesn't automatically increase the size of the data segment "on demand" - (ie. when , (COMMA), ALLOT, CREATE, and so on are used). Instead the programmer - needs to be aware of how much space a large allocation will take, check UNUSED, and - call MORECORE if necessary. A simple programming exercise is to change the - implementation of the data segment so that MORECORE is called automatically if - the program needs more memory. -) -: BRK ( brkpoint -- ) - SYS_BRK SYSCALL1 -; - -: MORECORE ( cells -- ) - CELLS GET-BRK + BRK -; - -( - Standard FORTH provides some simple file access primitives which we model on - top of Linux syscalls. - - The main complication is converting FORTH strings (address & length) into C - strings for the Linux kernel. - - Notice there is no buffering in this implementation. -) - -: R/O ( -- fam ) O_RDONLY ; -: R/W ( -- fam ) O_RDWR ; - -: OPEN-FILE ( addr u fam -- fd 0 (if successful) | c-addr u fam -- fd errno (if there was an error) ) - ROT ( fam addr u ) - CSTRING ( fam cstring ) - SYS_OPEN SYSCALL2 ( open (filename, flags) ) - DUP ( fd fd ) - DUP 0< IF ( errno? ) - NEGATE ( fd errno ) - ELSE - DROP 0 ( fd 0 ) - THEN -; - -: CREATE-FILE ( addr u fam -- fd 0 (if successful) | c-addr u fam -- fd errno (if there was an error) ) - O_CREAT OR - O_TRUNC OR - ROT ( fam addr u ) - CSTRING ( fam cstring ) - 420 ROT ( 0644 fam cstring ) - SYS_OPEN SYSCALL3 ( open (filename, flags|O_TRUNC|O_CREAT, 0644) ) - DUP ( fd fd ) - DUP 0< IF ( errno? ) - NEGATE ( fd errno ) - ELSE - DROP 0 ( fd 0 ) - THEN -; - -: CLOSE-FILE ( fd -- 0 (if successful) | fd -- errno (if there was an error) ) - SYS_CLOSE SYSCALL1 - NEGATE -; - -: READ-FILE ( addr u fd -- u2 0 (if successful) | addr u fd -- 0 0 (if EOF) | addr u fd -- u2 errno (if error) ) - ROT SWAP -ROT ( u addr fd ) - SYS_READ SYSCALL3 - - DUP ( u2 u2 ) - DUP 0< IF ( errno? ) - NEGATE ( u2 errno ) - ELSE - DROP 0 ( u2 0 ) - THEN -; - -( - PERROR prints a message for an errno, similar to C's perror(3) but we don't have the extensive - list of strerror strings available, so all we can do is print the errno. -) -: PERROR ( errno addr u -- ) - TELL - ':' EMIT SPACE - ." ERRNO=" - . CR -; - -( - ASSEMBLER CODE ---------------------------------------------------------------------- - - This is just the outline of a simple assembler, allowing you to write FORTH primitives - in assembly language. - - Assembly primitives begin ': NAME' in the normal way, but are ended with ;CODE. ;CODE - updates the header so that the codeword isn't DOCOL, but points instead to the assembled - code (in the DFA part of the word). - - We provide a convenience macro NEXT (you guessed what it does). However you don't need to - use it because ;CODE will put a NEXT at the end of your word. - - The rest consists of some immediate words which expand into machine code appended to the - definition of the word. Only a very tiny part of the i386 assembly space is covered, just - enough to write a few assembler primitives below. -) - -HEX - -( Equivalent to the NEXT macro ) -: NEXT IMMEDIATE AD C, FF C, 20 C, ; - -: ;CODE IMMEDIATE - [COMPILE] NEXT ( end the word with NEXT macro ) - ALIGN ( machine code is assembled in bytes so isn't necessarily aligned at the end ) - LATEST @ DUP - HIDDEN ( unhide the word ) - DUP >DFA SWAP >CFA ! ( change the codeword to point to the data area ) - [COMPILE] [ ( go back to immediate mode ) -; - -( The i386 registers ) -: EAX IMMEDIATE 0 ; -: ECX IMMEDIATE 1 ; -: EDX IMMEDIATE 2 ; -: EBX IMMEDIATE 3 ; -: ESP IMMEDIATE 4 ; -: EBP IMMEDIATE 5 ; -: ESI IMMEDIATE 6 ; -: EDI IMMEDIATE 7 ; - -( i386 stack instructions ) -: PUSH IMMEDIATE 50 + C, ; -: POP IMMEDIATE 58 + C, ; - -( RDTSC instruction ) -: RDTSC IMMEDIATE 0F C, 31 C, ; - -DECIMAL - -( - RDTSC is an assembler primitive which reads the Pentium timestamp counter (a very fine- - grained counter which counts processor clock cycles). Because the TSC is 64 bits wide - we have to push it onto the stack in two slots. -) -: RDTSC ( -- lsb msb ) - RDTSC ( writes the result in %edx:%eax ) - EAX PUSH ( push lsb ) - EDX PUSH ( push msb ) -;CODE - -( - INLINE can be used to inline an assembler primitive into the current (assembler) - word. - - For example: - - : 2DROP INLINE DROP INLINE DROP ;CODE - - will build an efficient assembler word 2DROP which contains the inline assembly code - for DROP followed by DROP (eg. two 'pop %eax' instructions in this case). - - Another example. Consider this ordinary FORTH definition: - - : C@++ ( addr -- addr+1 byte ) DUP 1+ SWAP C@ ; - - (it is equivalent to the C operation '*p++' where p is a pointer to char). If we - notice that all of the words used to define C@++ are in fact assembler primitives, - then we can write a faster (but equivalent) definition like this: - - : C@++ INLINE DUP INLINE 1+ INLINE SWAP INLINE C@ ;CODE - - One interesting point to note is that this "concatenative" style of programming - allows you to write assembler words portably. The above definition would work - for any CPU architecture. - - There are several conditions that must be met for INLINE to be used successfully: - - (1) You must be currently defining an assembler word (ie. : ... ;CODE). - - (2) The word that you are inlining must be known to be an assembler word. If you try - to inline a FORTH word, you'll get an error message. - - (3) The assembler primitive must be position-independent code and must end with a - single NEXT macro. - - Exercises for the reader: (a) Generalise INLINE so that it can inline FORTH words when - building FORTH words. (b) Further generalise INLINE so that it does something sensible - when you try to inline FORTH into assembler and vice versa. - - The implementation of INLINE is pretty simple. We find the word in the dictionary, - check it's an assembler word, then copy it into the current definition, byte by byte, - until we reach the NEXT macro (which is not copied). -) -HEX -: =NEXT ( addr -- next? ) - DUP C@ AD <> IF DROP FALSE EXIT THEN - 1+ DUP C@ FF <> IF DROP FALSE EXIT THEN - 1+ C@ 20 <> IF FALSE EXIT THEN - TRUE -; -DECIMAL - -( (INLINE) is the lowlevel inline function. ) -: (INLINE) ( cfa -- ) - @ ( remember codeword points to the code ) - BEGIN ( copy bytes until we hit NEXT macro ) - DUP =NEXT NOT - WHILE - DUP C@ C, - 1+ - REPEAT - DROP -; - -: INLINE IMMEDIATE - WORD FIND ( find the word in the dictionary ) - >CFA ( codeword ) - - DUP @ DOCOL = IF ( check codeword <> DOCOL (ie. not a FORTH word) ) - ." Cannot INLINE FORTH words" CR ABORT - THEN - - (INLINE) -; - -HIDE =NEXT - -( - NOTES ---------------------------------------------------------------------- - - DOES> isn't possible to implement with this FORTH because we don't have a separate - data pointer. -) - -( - WELCOME MESSAGE ---------------------------------------------------------------------- - - Print the version and OK prompt. -) - -: WELCOME - S" TEST-MODE" FIND NOT IF - ." JONESFORTH VERSION " VERSION . CR - UNUSED . ." CELLS REMAINING" CR - ." OK " - THEN -; - -WELCOME -HIDE WELCOME diff --git a/jonesforth/run.sh b/jonesforth/run.sh deleted file mode 100755 index 8ba83b3..0000000 --- a/jonesforth/run.sh +++ /dev/null @@ -1,3 +0,0 @@ -#!/bin/sh -docker build -t jonesforth . -docker run --cap-add=SYS_RAWIO -ti --rm jonesforth -- cgit v1.2.3