aboutsummaryrefslogtreecommitdiff
path: root/docs
diff options
context:
space:
mode:
authorDimitri Sokolyuk <demon@dim13.org>2019-10-30 20:04:56 +0100
committerDimitri Sokolyuk <demon@dim13.org>2019-10-30 20:04:56 +0100
commita76977af62010a392c16010c367185e61e856ffe (patch)
tree56cf4177d5bc0e3ead781d1c60818c13b1df0f3c /docs
parentc0165d167d7cb40d80028bcf7a4a6b160b5a7e83 (diff)
mv to docs
Diffstat (limited to 'docs')
-rw-r--r--docs/README.md6
-rw-r--r--docs/buzzard/README1
-rw-r--r--docs/buzzard/buzzard.2.README22
-rw-r--r--docs/buzzard/buzzard.2.c61
-rw-r--r--docs/buzzard/buzzard.2.design780
-rw-r--r--docs/buzzard/buzzard.2.hint217
-rw-r--r--docs/buzzard/buzzard.2.orig.c61
-rw-r--r--docs/buzzard/demo1.1st12
-rw-r--r--docs/buzzard/demo1.th4
-rw-r--r--docs/buzzard/demo2.th10
-rw-r--r--docs/buzzard/demo3.th15
-rw-r--r--docs/buzzard/demo4.th30
-rw-r--r--docs/buzzard/demo5.th27
-rw-r--r--docs/buzzard/demo6.th18
-rw-r--r--docs/buzzard/first.c113
-rw-r--r--docs/buzzard/help.th54
-rw-r--r--docs/buzzard/third367
-rw-r--r--docs/eForthOverviewv5.pdfbin0 -> 455143 bytes
-rw-r--r--docs/j1.txt57
-rw-r--r--docs/j1/.gitignore2
-rw-r--r--docs/j1/Makefile14
-rw-r--r--docs/j1/README.md4
-rw-r--r--docs/j1/build/.empty0
-rw-r--r--docs/j1/build/.gitignore2
-rw-r--r--docs/j1/go5
-rw-r--r--docs/j1/sim_main.cpp76
-rw-r--r--docs/j1/toolchain/basewords.fs92
-rw-r--r--docs/j1/toolchain/cross.fs321
-rw-r--r--docs/j1/toolchain/demo1.fs7
-rw-r--r--docs/j1/toolchain/dump.py36
-rw-r--r--docs/j1/toolchain/go3
-rw-r--r--docs/j1/toolchain/nuc.fs604
-rw-r--r--docs/j1/toolchain/strings.fs25
-rw-r--r--docs/j1/verilog/common.h3
-rw-r--r--docs/j1/verilog/j1.v123
-rw-r--r--docs/j1/verilog/stack.v22
-rw-r--r--docs/j1/verilog/testbench.v30
-rw-r--r--docs/j1/verilog/top.v9
-rw-r--r--docs/j1/verilog/uart.v180
-rw-r--r--docs/j1/verilog/xilinx-top.v215
-rw-r--r--docs/j1/xilinx/.gitignore44
-rw-r--r--docs/j1/xilinx/Makefile11
-rw-r--r--docs/j1/xilinx/go22
-rw-r--r--docs/j1/xilinx/j1-papilioduo.bmm24
-rw-r--r--docs/j1/xilinx/j1-papilioduo.ucf183
-rw-r--r--docs/j1/xilinx/shell.py78
-rw-r--r--docs/j1/xilinx/xilinx.mk176
-rw-r--r--docs/j1/xilinx/xilinx.opt42
-rw-r--r--docs/j1demo/firmware/Makefile26
-rw-r--r--docs/j1demo/firmware/ans.fs46
-rw-r--r--docs/j1demo/firmware/arp.fs225
-rw-r--r--docs/j1demo/firmware/basewords.fs60
-rw-r--r--docs/j1demo/firmware/clock.fs90
-rw-r--r--docs/j1demo/firmware/crossj1.fs527
-rw-r--r--docs/j1demo/firmware/defines_tcpip.fs70
-rw-r--r--docs/j1demo/firmware/defines_tcpip.py94
-rw-r--r--docs/j1demo/firmware/defines_tcpip2.fs150
-rw-r--r--docs/j1demo/firmware/defines_tcpip2.py215
-rw-r--r--docs/j1demo/firmware/dhcp.fs176
-rw-r--r--docs/j1demo/firmware/dns.fs81
-rw-r--r--docs/j1demo/firmware/doc.fs20
-rw-r--r--docs/j1demo/firmware/document.fs3
-rw-r--r--docs/j1demo/firmware/encode.py28
-rw-r--r--docs/j1demo/firmware/eth-ax88796.fs506
-rw-r--r--docs/j1demo/firmware/font8x8bin0 -> 768 bytes
-rw-r--r--docs/j1demo/firmware/fsm-32.pngbin0 -> 1489 bytes
-rw-r--r--docs/j1demo/firmware/genoffsets.py11
-rw-r--r--docs/j1demo/firmware/go16
-rw-r--r--docs/j1demo/firmware/hwdefs.fs57
-rw-r--r--docs/j1demo/firmware/intelhex.py643
-rw-r--r--docs/j1demo/firmware/invaders.fs362
-rw-r--r--docs/j1demo/firmware/ip.fs124
-rw-r--r--docs/j1demo/firmware/ip0.fs70
-rw-r--r--docs/j1demo/firmware/j1.pngbin0 -> 3262 bytes
-rw-r--r--docs/j1demo/firmware/keycodes.fs28
-rw-r--r--docs/j1demo/firmware/loader.fs114
-rw-r--r--docs/j1demo/firmware/main.fs799
-rw-r--r--docs/j1demo/firmware/mkblob.py14
-rw-r--r--docs/j1demo/firmware/ntp.fs36
-rw-r--r--docs/j1demo/firmware/nuc.fs546
-rw-r--r--docs/j1demo/firmware/packet.fs11
-rw-r--r--docs/j1demo/firmware/ps2kb.fs434
-rw-r--r--docs/j1demo/firmware/sincos.fs36
-rw-r--r--docs/j1demo/firmware/sprite.fs20
-rw-r--r--docs/j1demo/firmware/tftp.fs67
-rw-r--r--docs/j1demo/firmware/time.fs33
-rw-r--r--docs/j1demo/firmware/twist.py311
-rw-r--r--docs/j1demo/firmware/udp.fs41
-rw-r--r--docs/j1demo/firmware/version.fs2
-rw-r--r--docs/j1demo/j1.pdfbin0 -> 124188 bytes
-rw-r--r--docs/j1demo/synth/Makefile9
-rw-r--r--docs/j1demo/synth/j1.bmm12
-rw-r--r--docs/j1demo/synth/j1.ucf327
-rw-r--r--docs/j1demo/synth/xilinx.mk174
-rw-r--r--docs/j1demo/synth/xilinx.opt42
-rw-r--r--docs/j1demo/verilog/ck_div.v41
-rw-r--r--docs/j1demo/verilog/j1.v187
-rw-r--r--docs/j1demo/verilog/rams.v36
-rw-r--r--docs/j1demo/verilog/top.v667
-rw-r--r--docs/j1eforth/Makefile12
-rw-r--r--docs/j1eforth/README.md99
-rw-r--r--docs/j1eforth/fpga/papilio-pro-j1.xise422
-rw-r--r--docs/j1eforth/fpga/papilio_pro_j1.bitbin0 -> 340703 bytes
-rw-r--r--docs/j1eforth/fpga/src/Rxunit.vhd97
-rw-r--r--docs/j1eforth/fpga/src/Txunit.vhd100
-rw-r--r--docs/j1eforth/fpga/src/clock.vhd78
-rw-r--r--docs/j1eforth/fpga/src/j1.v199
-rw-r--r--docs/j1eforth/fpga/src/miniuart.vhd146
-rw-r--r--docs/j1eforth/fpga/src/papilio-pro-j1.vhd117
-rw-r--r--docs/j1eforth/fpga/src/papilio-pro.ucf143
-rw-r--r--docs/j1eforth/fpga/src/utils.vhd132
-rw-r--r--docs/j1eforth/fpga/test/miniuart2_tb.vhd128
-rw-r--r--docs/j1eforth/fpga/test/papilio_pro_j1_tb.vhd96
-rw-r--r--docs/j1eforth/ipv4.4th249
-rw-r--r--docs/j1eforth/j1.4th910
-rw-r--r--docs/j1eforth/j1.c162
-rw-r--r--docs/jonesforth/Dockerfile6
-rw-r--r--docs/jonesforth/docker-compose.yml6
-rw-r--r--docs/jonesforth/jonesforth.S2313
-rw-r--r--docs/jonesforth/jonesforth.fs1790
-rwxr-xr-xdocs/jonesforth/run.sh3
-rw-r--r--docs/learnforth.fs205
-rw-r--r--docs/samples.fs2
-rw-r--r--docs/tcjassem.txt805
124 files changed, 20015 insertions, 0 deletions
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] <builds and does> .
+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 )
+;
+
+: <build immediate
+ make-immediate ( make the word compiled so far immediate )
+ ' :: , ( compile '::', so we read next word )
+ 2 , ( compile 'pushint' )
+ here 0 , ( write out a 0 but save address for does> )
+ ' , , ( 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 <build , does> ;
+: constant <build , does> @ ;
+: array <build allot does> + ;
+
+: [ 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 <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+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
+(*) <build does> 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 )
+;
+
+: <build immediate
+ make-immediate ( make the word compiled so far immediate )
+ ' :: , ( compile '::', so we read next word )
+ 2 , ( compile 'pushint' )
+ here 0 , ( write out a 0 but save address for does> )
+ ' , , ( 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 <build , does> ;
+: constant <build , does> @ ;
+: array <build allot does> + ;
+
+: [ 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
--- /dev/null
+++ b/docs/eForthOverviewv5.pdf
Binary files 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 0 1 . . . . . . . . N>>T
+. . . . 1 0 1 0 . . . . . . . . N<<T
+. . . . 1 0 1 1 . . . . . . . . rT
+. . . . 1 1 0 0 . . . . . . . . [T]
+. . . . 1 1 0 1 . . . . . . . . io[T]
+. . . . 1 1 1 0 . . . . . . . . status
+. . . . 1 1 1 1 . . . . . . . . Nu<T
+
+. . . . . . . . 1 . . . . . . . RET
+
+. . . . . . . . . 0 0 1 . . . . T->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
--- /dev/null
+++ b/docs/j1/build/.empty
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 <stdio.h>
+#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 <hex-file>\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# 0800 ;
+: N>>T h# 0900 ;
+: N<<T h# 0a00 ;
+: rT h# 0b00 ;
+: [T] h# 0c00 ;
+: io[T] h# 0d00 ;
+: status h# 0e00 ;
+: Nu<T h# 0f00 ;
+
+: T->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 ;
+:: < N<T d-1 alu ;
+:: u< Nu<T d-1 alu ;
+:: swap N T->N alu ;
+:: dup T T->N d+1 alu ;
+:: drop N d-1 alu ;
+:: over N T->N d+1 alu ;
+:: nip T d-1 alu ;
+:: >r N T->R r+1 d-1 alu ;
+:: r> rT T->N r-1 d+1 alu ;
+:: r@ rT T->N d+1 alu ;
+:: @ [T] alu ;
+:: 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<<T d-1 alu ;
+:: depths status T->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< N<T T->N 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< Nu<T T->N 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<T alu ;
+:: over= N==T alu ;
+:: overor T|N alu ;
+:: over+ T+N alu ;
+:: overu> Nu<T alu ;
+:: overxor T^N alu ;
+:: rdrop T r-1 alu ;
+:: tuck! T N->[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 <machine.fs> <program.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<<T d-1 alu
+ $7fff and recurse
+ T|N d-1 alu
+ else
+ $8000 or tw,
+ then
+ then
+;
+
+( Defining words for target JCB 19:04 05/02/12)
+
+: codeptr tdp @ 2/ ; \ target data pointer as a jump address
+
+: wordstr ( "name" -- c-addr u )
+ >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 = "<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)/<libname>/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 ;
+: < N<T d-1 alu ;
+: u< Nu<T d-1 alu ;
+: swap N T->N alu ;
+: dup T T->N d+1 alu ;
+: drop N d-1 alu ;
+: over N T->N d+1 alu ;
+: nip T d-1 alu ;
+: >r N T->R r+1 d-1 alu ;
+: r> rT T->N r-1 d+1 alu ;
+: r@ rT T->N d+1 alu ;
+: @ [T] alu ;
+: ! T N->[T] d-1 alu
+ N d-1 alu ;
+: dsp dsp T->N d+1 alu ;
+: lshift N<<T d-1 alu ;
+: rshift N>>T d-1 alu ;
+: 1- T-1 alu ;
+: 2r> rT T->N r-1 d+1 alu
+ rT T->N r-1 d+1 alu
+ N T->N alu ;
+: 2>r N T->N alu
+ N T->R r+1 d-1 alu
+ N T->R r+1 d-1 alu ;
+: 2r@ rT T->N r-1 d+1 alu
+ rT T->N r-1 d+1 alu
+ N T->N d+1 alu
+ N T->N d+1 alu
+ N T->R r+1 d-1 alu
+ N T->R r+1 d-1 alu
+ N T->N alu ;
+: unloop
+ T r-1 alu
+ T r-1 alu ;
+: exit return ;
+
+\ Elided words
+: dup@ [T] T->N d+1 alu ;
+: dup>r T T->R r+1 alu ;
+: 2dupxor T^N T->N d+1 alu ;
+: 2dup= N==T T->N d+1 alu ;
+: !nip T N->[T] d-1 alu ;
+: 2dup! T N->[T] alu ;
+
+\ Words used to implement pick
+: up1 T d+1 alu ;
+: down1 T d-1 alu ;
+: copy N alu ;
+
+: module[ there [char] " parse preserve ;
+: ]module s" Compiled " type count type space there swap - . cr ;
diff --git a/docs/j1demo/firmware/clock.fs b/docs/j1demo/firmware/clock.fs
new file mode 100644
index 0000000..4bb35bb
--- /dev/null
+++ b/docs/j1demo/firmware/clock.fs
@@ -0,0 +1,90 @@
+( Clock JCB 10:54 11/17/10)
+
+variable seconds
+variable minutes
+variable hours
+variable days
+variable months
+variable years
+variable weekday
+
+: show2 ( a -- ) @ s>d <# # # #> type ;
+
+: setdate ( ud -- )
+ [ -8 3600 * ] literal s>d d+
+ d# 1 d# 60 m*/mod seconds !
+ d# 1 d# 60 m*/mod minutes !
+ d# 1 d# 24 m*/mod hours !
+ d# 59. d- \ Days since Mar 1 1900
+ 2dup d# 1 d# 7 m*/mod weekday ! 2drop
+ d# 365 um/mod ( days years )
+ dup d# 1900 + years !
+ d# 4 / 1- - \ subtract leaps ( daynum 0-365 )
+ dup d# 5 * d# 308 + d# 153 / d# 2 - months !
+ months @ d# 4 + d# 153 d# 5 */ - d# 122 + days !
+
+ home
+ 'emit @ >r
+ ['] vga-bigemit 'emit !
+
+ s" ThuFriSatSunMonTueWed" drop
+ weekday @ d# 3 * + d# 3 type cr
+ s" MarAprMayJunJulAugSepOctNovDecJanFeb" drop
+ months @ d# 3 * + d# 3 type
+ space days @ d# 0 .r cr
+ years @ . cr
+
+ true if
+ hours show2
+ minutes show2
+ seconds show2
+ home
+ then
+
+ r> 'emit !
+;
+
+: setdelay ( ud -- )
+ 'emit @ >r
+ ['] vga-emit 'emit !
+ d# 32 d# 0 vga-at-xy
+ s" ntp " type <# # # # [char] . hold #s #> type
+ s" ms " type
+ r> 'emit !
+;
+
+include ntp.fs
+
+2variable ntp-alarm
+
+: clock-main
+ vga-page
+ d# 1000000. ntp-alarm setalarm
+ begin
+ begin
+ mac-fullness
+ while
+ arp-handler
+ OFFSET_ETH_TYPE packet@ h# 800 =
+ if
+ d# 2 OFFSET_IP_DSTIP mac-inoffset mac@n net-my-ip d=
+ if
+ icmp-handler
+ then
+ loader-handler
+ ntp-handler
+ then
+
+ depth if .s cr then
+ mac-consume
+ repeat
+
+ ntp-alarm isalarm if
+ ntp-request
+ d# 1000000. ntp-alarm setalarm
+ then
+
+ next?
+ until
+;
+
diff --git a/docs/j1demo/firmware/crossj1.fs b/docs/j1demo/firmware/crossj1.fs
new file mode 100644
index 0000000..d034611
--- /dev/null
+++ b/docs/j1demo/firmware/crossj1.fs
@@ -0,0 +1,527 @@
+( Cross-compiler for the J1 JCB 13:12 08/24/10)
+decimal
+
+( outfile is fileid or zero JCB 12:30 11/27/10)
+
+0 value outfile
+
+: type ( c-addr u )
+ outfile if
+ outfile write-file throw
+ else
+ type
+ then
+;
+: emit ( u )
+ outfile if
+ pad c! pad 1 outfile write-file throw
+ else
+ emit
+ then
+;
+: cr ( u )
+ outfile if
+ s" " outfile write-line throw
+ else
+ cr
+ then
+;
+: space bl emit ;
+: spaces dup 0> if 0 do space loop then ;
+
+vocabulary j1assembler \ assembly storage and instructions
+vocabulary metacompiler \ the cross-compiling words
+vocabulary j1target \ actual target words
+
+: j1asm
+ only
+ metacompiler
+ also j1assembler definitions
+ also forth ;
+: meta
+ only
+ j1target also
+ j1assembler also
+ metacompiler definitions also
+ forth ;
+: target
+ only
+ metacompiler also
+ j1target definitions ;
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+
+j1asm
+
+: tcell 2 ;
+: tcells tcell * ;
+: tcell+ tcell + ;
+65536 allocate throw constant tflash
+
+: h#
+ base @ >r 16 base !
+ 0. bl parse >number throw 2drop postpone literal
+ r> base ! ; immediate
+
+variable tdp
+: there tdp @ ;
+: islegal dup h# 7fff u> abort" illegal address" ;
+: tc! islegal tflash + c! ;
+: tc@ islegal tflash + c@ ;
+: t! islegal over h# ff and over tc! swap 8 rshift swap 1+ tc! ;
+: t@ islegal dup tc@ swap 1+ tc@ 8 lshift or ;
+: talign tdp @ 1 + h# fffe and tdp ! ;
+: tc, there tc! 1 tdp +! ;
+: t, there t! tcell tdp +! ;
+: org tdp ! ;
+
+tflash 65536 255 fill
+
+65536 cells allocate throw constant references
+: referenced cells references + 1 swap +! ;
+
+65536 cells allocate throw constant labels
+labels 65536 cells 0 fill
+: atlabel? ( -- f = are we at a label )
+ labels there cells + @ 0<>
+;
+
+: preserve ( c-addr1 u -- c-addr )
+ dup 1+ allocate throw dup >r
+ 2dup c! 1+
+ swap cmove r> ;
+
+: setlabel ( c-addr u -- )
+ atlabel? if 2drop else preserve labels there cells + ! then ;
+
+j1asm
+
+: hex-literal ( u -- c-addr u ) s>d <# bl hold #s [char] $ hold #> ;
+
+: imm h# 8000 or t, ;
+
+: T h# 0000 ;
+: N h# 0100 ;
+: T+N h# 0200 ;
+: T&N h# 0300 ;
+: T|N h# 0400 ;
+: T^N h# 0500 ;
+: ~T h# 0600 ;
+: N==T h# 0700 ;
+: N<T h# 0800 ;
+: N>>T h# 0900 ;
+: T-1 h# 0a00 ;
+: rT h# 0b00 ;
+: [T] h# 0c00 ;
+: N<<T h# 0d00 ;
+: dsp h# 0e00 ;
+: Nu<T h# 0f00 ;
+
+: T->N h# 0080 or ;
+: T->R h# 0040 or ;
+: N->[T] h# 0020 or ;
+: d-1 h# 0003 or ;
+: d+1 h# 0001 or ;
+: r-1 h# 000c or ;
+: r-2 h# 0008 or ;
+: r+1 h# 0004 or ;
+
+: alu h# 6000 or t, ;
+
+: return T h# 1000 or r-1 alu ;
+: ubranch 2/ h# 0000 or t, ;
+: 0branch 2/ h# 2000 or t, ;
+: scall 2/ h# 4000 or t, ;
+
+: dump-words ( c-addr n -- ) \ Write n/2 words from c-addr
+ dup 6 > abort" invalid byte count"
+ 2/ dup >r
+ 0 do
+ dup t@ s>d <# # # # # #> type space
+ 2 +
+ loop drop
+ 3 r> - 5 * spaces
+;
+
+variable padc
+: pad+ ( c-addr u -- ) \ append to pad
+ dup >r
+ pad padc @ + swap cmove
+ r> padc +! ;
+
+: pad+loc ( addr -- )
+ dup cells labels + @ ?dup if
+ nip count pad+
+ else
+ s>d <# #s [char] $ hold #> pad+
+ then
+ s" " pad+
+;
+
+
+: disassemble-j
+ 0 padc !
+ dup t@ h# 8000 and if
+ s" LIT " pad+
+ dup t@ h# 7fff and hex-literal pad+ exit
+ else
+ dup t@ h# e000 and h# 6000 = if
+ s" ALU " pad+
+ dup t@ pad+loc exit
+ else
+ dup t@ h# e000 and h# 4000 = if
+ s" CALL "
+ else
+ dup t@ h# 2000 and if
+ s" 0BRANCH "
+ else
+ s" BRANCH "
+ then
+ then
+ pad+
+ dup t@ h# 1fff and 2* pad+loc
+ then
+ then
+;
+
+: disassemble-line ( offset -- offset' )
+ dup cells labels + @ ?dup if s" \ " type count type cr then
+ dup s>d <# # # # # #> type space
+ dup 2 dump-words
+ disassemble-j
+ pad padc @ type
+ 2 +
+ cr
+;
+
+: disassemble-block
+ 0 do
+ disassemble-line
+ loop
+ drop
+;
+
+j1asm
+
+\ tcompile is like "STATE": it is true when compiling
+
+variable tcompile
+: tcompile? tcompile @ ;
+: +tcompile tcompile? abort" Already in compilation mode" 1 tcompile ! ;
+: -tcompile 0 tcompile ! ;
+
+: (literal)
+ \ dup $f rshift over $e rshift xor 1 and throw
+ dup h# 8000 and if
+ h# ffff xor recurse
+ ~T alu
+ else
+ h# 8000 or t,
+ then
+
+;
+: (t-constant)
+ tcompile? if
+ (literal)
+ then
+;
+
+meta
+
+\ Find name - without consuming it - and return a counted string
+: wordstr ( "name" -- c-addr u )
+ >in @ >r bl word count r> >in !
+;
+
+
+: literal (literal) ; immediate
+: 2literal swap (literal) (literal) ; immediate
+: call,
+ dup referenced
+ scall
+;
+
+: t:
+ talign
+ wordstr setlabel
+ create
+ there ,
+ +tcompile
+ 947947
+ does>
+ @
+ tcompile? if
+ call,
+ then
+;
+
+: lookback ( offset -- v ) there swap - t@ ;
+: prevcall? 2 lookback h# e000 and h# 4000 = ;
+: call>goto dup t@ h# 1fff and swap t! ;
+: prevsafe?
+ 2 lookback h# e000 and h# 6000 = \ is an ALU
+ 2 lookback h# 004c and 0= and ; \ does not touch RStack
+: alu>return dup t@ h# 1000 or r-1 swap t! ;
+
+: t; 947947 <> if abort" Unstructured" then
+ true if
+ atlabel? invert prevcall? and if
+ there 2 - call>goto
+ else
+ atlabel? invert prevsafe? and if
+ there 2 - alu>return
+ else
+ return
+ then
+ then
+ else
+ return
+ then
+ -tcompile
+;
+
+: t;fallthru 947947 <> if abort" Unstructured" then
+ -tcompile
+;
+
+variable shadow-tcompile
+wordlist constant escape]-wordlist
+escape]-wordlist set-current
+: ] shadow-tcompile @ tcompile ! previous previous ;
+
+meta
+
+: [
+ tcompile @ shadow-tcompile !
+ -tcompile get-order forth-wordlist escape]-wordlist rot 2 + set-order
+;
+
+: : t: ;
+: ; t; ;
+: ;fallthru t;fallthru ;
+: , t, ;
+: c, tc, ;
+
+: constant ( n "name" -- ) create , immediate does> @ (t-constant) ;
+
+: ]asm
+ -tcompile also forth also j1target also j1assembler ;
+: asm[ +tcompile previous previous previous ;
+: code t: ]asm ;
+
+j1asm
+
+: end-code
+ 947947 <> if abort" Unstructured" then
+ previous previous previous ;
+
+meta
+
+\ Some Forth words are safe to use in target mode, so import them
+
+: ( postpone ( ;
+: \ postpone \ ;
+
+: import ( "name" -- )
+ >in @ ' swap >in !
+ create , does> @ execute ;
+
+import meta
+import org
+import include
+import [if]
+import [else]
+import [then]
+
+: do-number ( n -- |n )
+ state @ if
+ postpone literal
+ else
+ tcompile? if
+ (literal)
+ then
+ then
+;
+
+decimal
+
+: [char] ( "name" -- ) ( run: -- ascii) char (literal) ;
+
+: ['] ( "name" -- ) ( run: -- xt )
+ ' tcompile @ >r -tcompile execute r> tcompile !
+ dup referenced
+ (literal)
+;
+
+: (sliteral--h) ( addr n -- ptr ) ( run: -- eeaddr n )
+ s" sliteral" evaluate
+ there >r
+ dup tc,
+ 0 do count tc, loop
+ drop
+ talign
+ r>
+;
+
+: (sliteral) (sliteral--h) drop ;
+: s" ( "ccc<quote>" -- ) ( run: -- eaddr n ) [char] " parse (sliteral) ;
+: s' ( "ccc<quote>" -- ) ( run: -- eaddr n ) [char] ' parse (sliteral) ;
+
+: create
+ wordstr setlabel
+ create there ,
+ does> @ do-number
+;
+
+: allot tdp +! ;
+
+: variable wordstr setlabel create there , 0 t,
+ does> @ do-number ;
+: 2variable wordstr setlabel create there , 0 t, 0 t,
+ does> @ do-number ;
+
+: createdoes
+ wordstr setlabel
+ create there , ' ,
+ does> dup @ dup referenced (literal) cell+ @ execute
+;
+
+: jumptable
+ wordstr setlabel
+ create there ,
+ does> s" 2*" evaluate @ dup referenced (literal) s" + @" evaluate
+;
+
+: | ' execute dup referenced t, ;
+
+: ', ' execute t, ;
+
+( DEFER JCB 11:18 11/12/10)
+
+: defer
+ wordstr setlabel
+ create there , 0 t,
+ does> @ tcompile? if do-number s" @ execute" evaluate then ;
+
+: is ( xt "name" -- )
+ tcompile? if
+ ' >body @ do-number
+ s" ! " evaluate
+ else
+ ' execute t!
+ then ;
+
+: ' ' execute ;
+
+( VALUE JCB 13:06 11/12/10)
+
+: value
+ wordstr setlabel
+ create there , t,
+ does> @ do-number s" @" evaluate ;
+
+: to ( u "name" -- )
+ ' >body @ do-number s" !" evaluate ;
+
+( ARRAY JCB 13:34 11/12/10)
+
+: array
+ wordstr setlabel
+ create there , 0 do 0 t, loop
+ does> s" cells" evaluate @ do-number s" +" evaluate ;
+: 2array
+ wordstr setlabel
+ create there , 2* 0 do 0 t, loop
+ does> s" 2* cells" evaluate @ do-number s" +" evaluate ;
+
+( eforth's way of handling constants JCB 13:12 09/03/10)
+
+: sign>number
+ over c@ [char] - = if
+ 1- swap 1+ swap
+ >number
+ 2swap dnegate 2swap
+ else
+ >number
+ then
+;
+
+: base>number ( caddr u base -- )
+ base @ >r base !
+ sign>number
+ r> base !
+ dup 0= if
+ 2drop drop do-number
+ else
+ 1 = swap c@ [char] . = and if
+ drop dup do-number 16 rshift do-number
+ else
+ -1 abort" bad number"
+ then
+ then ;
+
+: d# 0. bl parse 10 base>number ;
+: h# 0. bl parse 16 base>number ;
+
+( Conditionals JCB 13:12 09/03/10)
+: if
+ there
+ 0 0branch
+;
+
+: resolve
+ dup t@ there 2/ or swap t!
+;
+
+: then
+ resolve
+ s" (then)" setlabel
+;
+
+: else
+ there
+ 0 ubranch
+ swap resolve
+ s" (else)" setlabel
+;
+
+
+: begin s" (begin)" setlabel there ;
+: again
+ ubranch
+;
+: until
+ 0branch
+;
+: while
+ there
+ 0 0branch
+;
+: repeat
+ swap ubranch
+ resolve
+ s" (repeat)" setlabel
+;
+
+: 0do s" >r d# 0 >r" evaluate there s" (do)" setlabel ;
+: do s" 2>r" evaluate there s" (do)" setlabel ;
+: loop
+ s" looptest" evaluate 0branch
+;
+: i s" r@" evaluate ;
+
+77 constant sourceline#
+s" none" 2constant sourcefilename
+
+: line# sourceline# (literal) ;
+create currfilename 1 cells 80 + allot
+variable currfilename#
+: savestr ( c-addr u dst -- ) 2dup c! 1+ swap cmove ;
+: getfilename sourcefilename currfilename count compare 0<>
+ if
+ sourcefilename 2dup currfilename savestr (sliteral--h) currfilename# !
+ else
+ currfilename# @ dup 1+ (literal) tc@ (literal)
+ then ;
+: snap line# getfilename s" (snap)" evaluate ; immediate
+: assert 0= if line# sourcefilename (sliteral) s" (assert)" evaluate then ; immediate
diff --git a/docs/j1demo/firmware/defines_tcpip.fs b/docs/j1demo/firmware/defines_tcpip.fs
new file mode 100644
index 0000000..90d3990
--- /dev/null
+++ b/docs/j1demo/firmware/defines_tcpip.fs
@@ -0,0 +1,70 @@
+42 constant OFFSET_DHCP
+70 constant OFFSET_DHCP_CHADDR
+54 constant OFFSET_DHCP_CIADDR
+150 constant OFFSET_DHCP_FILE
+52 constant OFFSET_DHCP_FLAGS
+66 constant OFFSET_DHCP_GIADDR
+44 constant OFFSET_DHCP_HLEN
+45 constant OFFSET_DHCP_HOPS
+43 constant OFFSET_DHCP_HTYPE
+42 constant OFFSET_DHCP_OP
+278 constant OFFSET_DHCP_OPTIONS
+50 constant OFFSET_DHCP_SECS
+62 constant OFFSET_DHCP_SIADDR
+548 constant OFFSET_DHCP_SIZE
+86 constant OFFSET_DHCP_SNAME
+46 constant OFFSET_DHCP_XID
+58 constant OFFSET_DHCP_YIADDR
+42 constant OFFSET_DNS
+44 constant OFFSET_DNS_FLAGS
+42 constant OFFSET_DNS_IDENTIFICATION
+48 constant OFFSET_DNS_NOA
+52 constant OFFSET_DNS_NOARR
+46 constant OFFSET_DNS_NOQ
+50 constant OFFSET_DNS_NORR
+54 constant OFFSET_DNS_QUERY
+13 constant OFFSET_DNS_SIZE
+0 constant OFFSET_ETH
+0 constant OFFSET_ETH_DST
+14 constant OFFSET_ETH_SIZE
+6 constant OFFSET_ETH_SRC
+12 constant OFFSET_ETH_TYPE
+34 constant OFFSET_ICMP
+36 constant OFFSET_ICMP_CHKSUM
+38 constant OFFSET_ICMP_IDENTIFIER
+40 constant OFFSET_ICMP_SEQUENCE
+8 constant OFFSET_ICMP_SIZE
+34 constant OFFSET_ICMP_TYPECODE
+14 constant OFFSET_IP
+24 constant OFFSET_IP_CHKSUM
+30 constant OFFSET_IP_DSTIP
+18 constant OFFSET_IP_IPID
+20 constant OFFSET_IP_IPOFFSET
+16 constant OFFSET_IP_LENGTH
+20 constant OFFSET_IP_SIZE
+26 constant OFFSET_IP_SRCIP
+22 constant OFFSET_IP_TTLPROTO
+14 constant OFFSET_IP_VHLTOS
+42 constant OFFSET_JUICE
+68 constant OFFSET_JUICE_COMMAND
+42 constant OFFSET_JUICE_HASH
+62 constant OFFSET_JUICE_MAGIC
+70 constant OFFSET_JUICE_PAYLOAD
+66 constant OFFSET_JUICE_SEQ
+30 constant OFFSET_JUICE_SIZE
+34 constant OFFSET_TCP
+42 constant OFFSET_TCP_ACK
+50 constant OFFSET_TCP_CHECKSUM
+36 constant OFFSET_TCP_DESTPORT
+46 constant OFFSET_TCP_FLAGS
+38 constant OFFSET_TCP_SEQNUM
+20 constant OFFSET_TCP_SIZE
+34 constant OFFSET_TCP_SOURCEPORT
+52 constant OFFSET_TCP_URGENT
+48 constant OFFSET_TCP_WINDOW
+34 constant OFFSET_UDP
+40 constant OFFSET_UDP_CHECKSUM
+36 constant OFFSET_UDP_DESTPORT
+38 constant OFFSET_UDP_LENGTH
+8 constant OFFSET_UDP_SIZE
+34 constant OFFSET_UDP_SOURCEPORT
diff --git a/docs/j1demo/firmware/defines_tcpip.py b/docs/j1demo/firmware/defines_tcpip.py
new file mode 100644
index 0000000..bbeb16b
--- /dev/null
+++ b/docs/j1demo/firmware/defines_tcpip.py
@@ -0,0 +1,94 @@
+layout = [
+ ('ETH', [
+ ('DST', 6),
+ ('SRC', 6),
+ ('TYPE', 2),
+ [
+ ('IP', [
+ ('VHLTOS', 2),
+ ('LENGTH', 2),
+ ('IPID', 2),
+ ('IPOFFSET', 2),
+ ('TTLPROTO', 2),
+ ('CHKSUM', 2),
+ ('SRCIP', 4),
+ ('DSTIP', 4),
+ [
+ ('ICMP', [
+ ('TYPECODE', 2),
+ ('CHKSUM', 2),
+ ('IDENTIFIER', 2),
+ ('SEQUENCE', 2) ]),
+ ('TCP', [
+ ('SOURCEPORT', 2),
+ ('DESTPORT', 2),
+ ('SEQNUM', 4),
+ ('ACK', 4),
+ ('FLAGS', 2),
+ ('WINDOW', 2),
+ ('CHECKSUM', 2),
+ ('URGENT', 2) ]),
+ ('UDP', [
+ ('SOURCEPORT', 2),
+ ('DESTPORT', 2),
+ ('LENGTH', 2),
+ ('CHECKSUM', 2),
+ [
+ ('DHCP', [
+ ('OP', 1),
+ ('HTYPE', 1),
+ ('HLEN', 1),
+ ('HOPS', 1),
+ ('XID', 4),
+ ('SECS', 2),
+ ('FLAGS', 2),
+ ('CIADDR', 4),
+ ('YIADDR', 4),
+ ('SIADDR', 4),
+ ('GIADDR', 4),
+ ('CHADDR', 16),
+ ('SNAME', 64),
+ ('FILE', 128),
+ ('OPTIONS', 312)
+ ]),
+ ('DNS', [
+ ('IDENTIFICATION', 2),
+ ('FLAGS', 2),
+ ('NOQ', 2),
+ ('NOA', 2),
+ ('NORR', 2),
+ ('NOARR', 2),
+ ('QUERY', 1)
+ ]),
+ ('JUICE', [
+ ('HASH', 20),
+ ('MAGIC', 4),
+ ('SEQ', 2),
+ ('COMMAND', 2),
+ ('PAYLOAD', 2)
+ ])
+ ]
+ ])
+ ]
+ ])
+ ]])
+]
+
+offsets = {}
+def descend(offset, prefix, node):
+ (name, members) = node
+ offsets[prefix + name] = offset
+ start = offset
+ for m in members:
+ if isinstance(m, tuple):
+ (field, size) = m
+ # print prefix, name, field, offset
+ offsets["%s%s_%s" % (prefix, name, field)] = offset
+ offset += size
+ else:
+ for n in m:
+ descend(offset, prefix, n)
+ # print prefix, name, "SIZE", offset - start
+ offsets["%s%s_SIZE" % (prefix, name)] = offset - start
+
+descend(0, 'OFFSET_', layout[0])
diff --git a/docs/j1demo/firmware/defines_tcpip2.fs b/docs/j1demo/firmware/defines_tcpip2.fs
new file mode 100644
index 0000000..4d38a13
--- /dev/null
+++ b/docs/j1demo/firmware/defines_tcpip2.fs
@@ -0,0 +1,150 @@
+0 constant ETH
+14 constant ETH.ARP
+32 constant ETH.ARP.DST_ETH
+38 constant ETH.ARP.DST_IP
+20 constant ETH.ARP.OPCODE
+14 constant ETH.ARP.SOMETHING
+22 constant ETH.ARP.SRC_ETH
+28 constant ETH.ARP.SRC_IP
+0 constant ETH.DST
+14 constant ETH.IP
+24 constant ETH.IP.CHKSUM
+30 constant ETH.IP.DSTIP
+34 constant ETH.IP.ICMP
+36 constant ETH.IP.ICMP.CHKSUM
+38 constant ETH.IP.ICMP.IDENTIFIER
+40 constant ETH.IP.ICMP.SEQUENCE
+34 constant ETH.IP.ICMP.TYPECODE
+18 constant ETH.IP.IPID
+20 constant ETH.IP.IPOFFSET
+16 constant ETH.IP.LENGTH
+26 constant ETH.IP.SRCIP
+34 constant ETH.IP.TCP
+42 constant ETH.IP.TCP.ACK
+50 constant ETH.IP.TCP.CHECKSUM
+36 constant ETH.IP.TCP.DESTPORT
+46 constant ETH.IP.TCP.FLAGS
+38 constant ETH.IP.TCP.SEQNUM
+34 constant ETH.IP.TCP.SOURCEPORT
+52 constant ETH.IP.TCP.URGENT
+48 constant ETH.IP.TCP.WINDOW
+22 constant ETH.IP.TTLPROTO
+34 constant ETH.IP.UDP
+40 constant ETH.IP.UDP.CHECKSUM
+36 constant ETH.IP.UDP.DESTPORT
+42 constant ETH.IP.UDP.DHCP
+70 constant ETH.IP.UDP.DHCP.CHADDR
+54 constant ETH.IP.UDP.DHCP.CIADDR
+150 constant ETH.IP.UDP.DHCP.FILE
+52 constant ETH.IP.UDP.DHCP.FLAGS
+66 constant ETH.IP.UDP.DHCP.GIADDR
+44 constant ETH.IP.UDP.DHCP.HLEN
+45 constant ETH.IP.UDP.DHCP.HOPS
+43 constant ETH.IP.UDP.DHCP.HTYPE
+42 constant ETH.IP.UDP.DHCP.OP
+278 constant ETH.IP.UDP.DHCP.OPTIONS
+50 constant ETH.IP.UDP.DHCP.SECS
+62 constant ETH.IP.UDP.DHCP.SIADDR
+86 constant ETH.IP.UDP.DHCP.SNAME
+46 constant ETH.IP.UDP.DHCP.XID
+58 constant ETH.IP.UDP.DHCP.YIADDR
+42 constant ETH.IP.UDP.DNS
+44 constant ETH.IP.UDP.DNS.FLAGS
+42 constant ETH.IP.UDP.DNS.IDENTIFICATION
+48 constant ETH.IP.UDP.DNS.NOA
+52 constant ETH.IP.UDP.DNS.NOARR
+46 constant ETH.IP.UDP.DNS.NOQ
+50 constant ETH.IP.UDP.DNS.NORR
+54 constant ETH.IP.UDP.DNS.QUERY
+38 constant ETH.IP.UDP.LENGTH
+42 constant ETH.IP.UDP.LOADER
+46 constant ETH.IP.UDP.LOADER.FLASHREAD
+46 constant ETH.IP.UDP.LOADER.FLASHREAD.ADDR
+46 constant ETH.IP.UDP.LOADER.FLASHWRITE
+46 constant ETH.IP.UDP.LOADER.FLASHWRITE.ADDR
+50 constant ETH.IP.UDP.LOADER.FLASHWRITE.DATA
+44 constant ETH.IP.UDP.LOADER.OPCODE
+46 constant ETH.IP.UDP.LOADER.RAMREAD
+46 constant ETH.IP.UDP.LOADER.RAMREAD.ADDR
+46 constant ETH.IP.UDP.LOADER.RAMWRITE
+46 constant ETH.IP.UDP.LOADER.RAMWRITE.ADDR
+48 constant ETH.IP.UDP.LOADER.RAMWRITE.DATA
+42 constant ETH.IP.UDP.LOADER.SEQNO
+42 constant ETH.IP.UDP.NTP
+42 constant ETH.IP.UDP.NTP.FLAGS
+66 constant ETH.IP.UDP.NTP.ORIGINATE
+74 constant ETH.IP.UDP.NTP.RECEIVE
+58 constant ETH.IP.UDP.NTP.REFERENCE
+54 constant ETH.IP.UDP.NTP.REFID
+46 constant ETH.IP.UDP.NTP.ROOTDELAY
+50 constant ETH.IP.UDP.NTP.ROOTDISPERSION
+82 constant ETH.IP.UDP.NTP.TRANSMIT
+34 constant ETH.IP.UDP.SOURCEPORT
+42 constant ETH.IP.UDP.TFTP
+44 constant ETH.IP.UDP.TFTP.ACK
+44 constant ETH.IP.UDP.TFTP.ACK.BLOCK
+44 constant ETH.IP.UDP.TFTP.DATA
+44 constant ETH.IP.UDP.TFTP.DATA.BLOCK
+46 constant ETH.IP.UDP.TFTP.DATA.DATA
+44 constant ETH.IP.UDP.TFTP.ERROR
+46 constant ETH.IP.UDP.TFTP.ERROR.MESSAGE
+44 constant ETH.IP.UDP.TFTP.ERROR.NUMBER
+42 constant ETH.IP.UDP.TFTP.OPCODE
+44 constant ETH.IP.UDP.TFTP.RWRQ
+44 constant ETH.IP.UDP.TFTP.RWRQ.FILENAME
+42 constant ETH.IP.UDP.WGE
+82 constant ETH.IP.UDP.WGE.CONFIGURE
+90 constant ETH.IP.UDP.WGE.CONFIGURE.IP
+82 constant ETH.IP.UDP.WGE.CONFIGURE.PRODUCT
+86 constant ETH.IP.UDP.WGE.CONFIGURE.SERIAL
+82 constant ETH.IP.UDP.WGE.DISCOVER
+82 constant ETH.IP.UDP.WGE.DISCOVER.IP
+82 constant ETH.IP.UDP.WGE.FLASHREAD
+82 constant ETH.IP.UDP.WGE.FLASHREAD.ADDRESS
+82 constant ETH.IP.UDP.WGE.FLASHWRITE
+82 constant ETH.IP.UDP.WGE.FLASHWRITE.ADDRESS
+86 constant ETH.IP.UDP.WGE.FLASHWRITE.DATA
+50 constant ETH.IP.UDP.WGE.HRT
+82 constant ETH.IP.UDP.WGE.IMAGERMODE
+82 constant ETH.IP.UDP.WGE.IMAGERMODE.MODE
+82 constant ETH.IP.UDP.WGE.IMAGERSETRES
+82 constant ETH.IP.UDP.WGE.IMAGERSETRES.HORIZONTAL
+84 constant ETH.IP.UDP.WGE.IMAGERSETRES.VERTICAL
+42 constant ETH.IP.UDP.WGE.MAGIC
+80 constant ETH.IP.UDP.WGE.PAD
+66 constant ETH.IP.UDP.WGE.REPLYTO
+74 constant ETH.IP.UDP.WGE.REPLYTO.IP
+66 constant ETH.IP.UDP.WGE.REPLYTO.MAC
+78 constant ETH.IP.UDP.WGE.REPLYTO.PORT
+82 constant ETH.IP.UDP.WGE.SENSORREAD
+82 constant ETH.IP.UDP.WGE.SENSORREAD.ADDRESS
+82 constant ETH.IP.UDP.WGE.SENSORSELECT
+83 constant ETH.IP.UDP.WGE.SENSORSELECT.ADDRESS
+82 constant ETH.IP.UDP.WGE.SENSORSELECT.INDEX
+82 constant ETH.IP.UDP.WGE.SENSORWRITE
+82 constant ETH.IP.UDP.WGE.SENSORWRITE.ADDRESS
+83 constant ETH.IP.UDP.WGE.SENSORWRITE.DATA
+82 constant ETH.IP.UDP.WGE.SYSCONFIG
+82 constant ETH.IP.UDP.WGE.SYSCONFIG.MAC
+88 constant ETH.IP.UDP.WGE.SYSCONFIG.SERIAL
+82 constant ETH.IP.UDP.WGE.TRIGCONTROL
+82 constant ETH.IP.UDP.WGE.TRIGCONTROL.TRIGSTATE
+46 constant ETH.IP.UDP.WGE.TYPE
+82 constant ETH.IP.UDP.WGE.VIDSTART
+90 constant ETH.IP.UDP.WGE.VIDSTART.IP
+82 constant ETH.IP.UDP.WGE.VIDSTART.MAC
+94 constant ETH.IP.UDP.WGE.VIDSTART.PORT
+14 constant ETH.IP.VHLTOS
+6 constant ETH.SRC
+12 constant ETH.TYPE
+1 constant IP_PROTO_ICMP
+2 constant IP_PROTO_IGMP
+6 constant IP_PROTO_TCP
+17 constant IP_PROTO_UDP
+2 constant NUM_TCPS
+16 constant TCP_ACK
+1 constant TCP_FIN
+8 constant TCP_PSH
+4 constant TCP_RST
+2 constant TCP_SYN
+32 constant TCP_URG
diff --git a/docs/j1demo/firmware/defines_tcpip2.py b/docs/j1demo/firmware/defines_tcpip2.py
new file mode 100644
index 0000000..1d9e556
--- /dev/null
+++ b/docs/j1demo/firmware/defines_tcpip2.py
@@ -0,0 +1,215 @@
+layout = [
+ ('ETH', [
+ ('DST', 6),
+ ('SRC', 6),
+ ('TYPE', 2),
+ [
+ ('ARP', [
+ ('SOMETHING', 6),
+ ('OPCODE', 2),
+ ('SRC_ETH', 6),
+ ('SRC_IP', 4),
+ ('DST_ETH', 6),
+ ('DST_IP', 4) ]),
+ ('IP', [
+ ('VHLTOS', 2),
+ ('LENGTH', 2),
+ ('IPID', 2),
+ ('IPOFFSET', 2),
+ ('TTLPROTO', 2),
+ ('CHKSUM', 2),
+ ('SRCIP', 4),
+ ('DSTIP', 4),
+ [
+ ('ICMP', [
+ ('TYPECODE', 2),
+ ('CHKSUM', 2),
+ ('IDENTIFIER', 2),
+ ('SEQUENCE', 2) ]),
+ ('TCP', [
+ ('SOURCEPORT', 2),
+ ('DESTPORT', 2),
+ ('SEQNUM', 4),
+ ('ACK', 4),
+ ('FLAGS', 2),
+ ('WINDOW', 2),
+ ('CHECKSUM', 2),
+ ('URGENT', 2) ]),
+ ('UDP', [
+ ('SOURCEPORT', 2),
+ ('DESTPORT', 2),
+ ('LENGTH', 2),
+ ('CHECKSUM', 2),
+ [
+ ('DHCP', [
+ ('OP', 1),
+ ('HTYPE', 1),
+ ('HLEN', 1),
+ ('HOPS', 1),
+ ('XID', 4),
+ ('SECS', 2),
+ ('FLAGS', 2),
+ ('CIADDR', 4),
+ ('YIADDR', 4),
+ ('SIADDR', 4),
+ ('GIADDR', 4),
+ ('CHADDR', 16),
+ ('SNAME', 64),
+ ('FILE', 128),
+ ('OPTIONS', 312)
+ ]),
+ ('DNS', [
+ ('IDENTIFICATION', 2),
+ ('FLAGS', 2),
+ ('NOQ', 2),
+ ('NOA', 2),
+ ('NORR', 2),
+ ('NOARR', 2),
+ ('QUERY', 1)
+ ]),
+ ('NTP', [
+ ('FLAGS', 4),
+ ('ROOTDELAY', 4),
+ ('ROOTDISPERSION', 4),
+ ('REFID', 4),
+ ('REFERENCE', 8),
+ ('ORIGINATE', 8),
+ ('RECEIVE', 8),
+ ('TRANSMIT', 8),
+ ]),
+ ('TFTP', [
+ ('OPCODE', 2),
+ [
+ ('RWRQ', [
+ ('FILENAME', 512)
+ ]),
+ ('DATA', [
+ ('BLOCK', 2),
+ ('DATA', 512)
+ ]),
+ ('ACK', [
+ ('BLOCK', 2),
+ ]),
+ ('ERROR', [
+ ('NUMBER', 2),
+ ('MESSAGE', 512),
+ ]),
+ ]
+ ]),
+ ('LOADER', [
+ ('SEQNO', 2),
+ ('OPCODE', 2),
+ [
+ ('RAMREAD', [
+ ('ADDR', 2)
+ ]),
+ ('RAMWRITE', [
+ ('ADDR', 2),
+ ('DATA', 128)
+ ]),
+ ('FLASHREAD', [
+ ('ADDR', 4)
+ ]),
+ ('FLASHWRITE', [
+ ('ADDR', 4),
+ ('DATA', 128)
+ ]),
+ ]
+ ]),
+ ('WGE', [
+ ('MAGIC', 4),
+ ('TYPE', 4),
+ ('HRT', 16),
+ ('REPLYTO', [
+ ('MAC', 8),
+ ('IP', 4),
+ ('PORT', 2),
+ ]),
+ ('PAD', 2),
+ [
+ ('DISCOVER', [
+ ('IP', 4)
+ ]),
+ ('CONFIGURE', [
+ ('PRODUCT', 4),
+ ('SERIAL', 4),
+ ('IP', 4)
+ ]),
+ ('FLASHREAD', [
+ ('ADDRESS', 4)
+ ]),
+ ('FLASHWRITE', [
+ ('ADDRESS', 4),
+ ('DATA', 264),
+ ]),
+ ('TRIGCONTROL', [
+ ('TRIGSTATE', 4),
+ ]),
+ ('SENSORREAD', [
+ ('ADDRESS', 1),
+ ]),
+ ('SENSORWRITE', [
+ ('ADDRESS', 1),
+ ('DATA', 2),
+ ]),
+ ('SENSORSELECT', [
+ ('INDEX', 1),
+ ('ADDRESS', 4),
+ ]),
+ ('IMAGERMODE', [
+ ('MODE', 4),
+ ]),
+ ('IMAGERSETRES', [
+ ('HORIZONTAL', 2),
+ ('VERTICAL', 2),
+ ]),
+ ('SYSCONFIG', [
+ ('MAC', 6),
+ ('SERIAL', 4),
+ ]),
+ ('VIDSTART', [
+ ('MAC', 8),
+ ('IP', 4),
+ ('PORT', 2),
+ ]),
+ ]
+ ]),
+ ]
+ ])
+ ]
+ ])
+ ]])
+]
+
+offsets = {}
+def descend(offset, prefix, node):
+ start = offset
+ if isinstance(node, list):
+ for n in node:
+ descend(offset, prefix, n)
+ else:
+ (name, members) = node
+ offsets[".".join((prefix + [name]))] = offset
+ if isinstance(members, int):
+ offset += members
+ else:
+ for n in members:
+ offset = descend(offset, prefix + [name], n)
+ # offsets["%s%s_SIZE" % (prefix, name)] = offset - start
+ return offset
+
+descend(0, [], layout[0])
+
+offsets['TCP_FIN'] = 1
+offsets['TCP_SYN'] = 2
+offsets['TCP_RST'] = 4
+offsets['TCP_PSH'] = 8
+offsets['TCP_ACK'] = 16
+offsets['TCP_URG'] = 32
+
+offsets['IP_PROTO_ICMP'] = 1
+offsets['IP_PROTO_IGMP'] = 2
+offsets['IP_PROTO_TCP'] = 6
+offsets['IP_PROTO_UDP'] = 17
+
+offsets['NUM_TCPS'] = 2
diff --git a/docs/j1demo/firmware/dhcp.fs b/docs/j1demo/firmware/dhcp.fs
new file mode 100644
index 0000000..971e567
--- /dev/null
+++ b/docs/j1demo/firmware/dhcp.fs
@@ -0,0 +1,176 @@
+( DHCP: Dynamic Host Configuration Protocol JCB 13:13 08/24/10)
+module[ dhcp"
+
+\ Since DHCP alarm is only used when there is no lease, it is
+\ safe to use the ip-subnetmask for the same purpose.
+
+ip-subnetmask constant dhcp-alarm
+
+: dhcp-xid
+ ip-router 2@
+;
+
+: dhcp-xid!
+ ip-router 2!
+;
+
+: dhcp-option \ ( ... n code -- )
+ mac-pkt-c,
+ dup mac-pkt-c,
+ 0do
+ mac-pkt-c,
+ loop
+;
+
+: dhcp-common \ ( messagetype -- )
+ d# 67 d# 68
+ d# 0 invert dup
+ d# 0 dup
+ d# 0 \ broadcast ethaddr
+ ( dst-port src-port dst-ip src-ip *ethaddr -- )
+ udp-header
+ h# 0101 h# 0600 mac-pkt-2,
+ dhcp-xid mac-pkt-2,
+ d# 10 mac-pkt-,0
+ net-my-mac mac-pkt-3,
+ d# 101 mac-pkt-,0 \ d# 5 + d# 96 zeroes
+
+ h# 6382 h# 5363
+ mac-pkt-2,
+
+ \ DHCP option 53: DHCP Discover
+ \ messagetype
+ d# 1 d# 53 \ messagetype 1 53
+ dhcp-option
+
+ \ DHCP option 50: 192.168.1.100 requested
+
+ \ DHCP option 55: Parameter Request List:
+ \ Request Subnet Mask (1), Router (3),
+ \ Domain Name Server (6)
+ d# 1 d# 3 d# 6 d# 3 d# 55 dhcp-option
+;
+
+: dhcp-wrapup
+ \ Finish options
+ h# ff mac-pkt-c,
+ \ mac-wrptr @ d# 1 and
+ d# 1 if \ XXX
+ h# ff mac-pkt-c,
+ then
+
+ udp-wrapup
+ mac-send
+;
+
+\ memory layout is little-endian
+
+: macc@++ ( c-addr -- c-addr+1 c )
+ dup 1+ swap macc@ ;
+
+: dhcp-field \ ( match -- ptr/0 )
+ OFFSET_DHCP_OPTIONS d# 4 + mac-inoffset
+ \ match ptr
+ begin
+ macc@++ \ match ptr code
+ dup h# ff <>
+ while \ match ptr code
+ d# 2 pick =
+ if
+ nip \ ptr
+ exit
+ then \ match ptr
+ macc@++ + \ match ptr'
+ repeat
+ \ fail - return false
+ 2drop false
+;
+
+: dhcp-yiaddr
+ d# 2 OFFSET_DHCP_YIADDR mac-inoffset mac@n
+;
+
+: dhcp-field4
+ dhcp-field d# 1 +
+ macc@++ swap macc@++ swap macc@++ swap macc@
+ ( a b c d )
+ swap d# 8 lshift or -rot
+ swap d# 8 lshift or
+ swap
+;
+
+build-debug? [IF]
+: .pad ( ip. c-addr u -- ) d# 14 typepad ip-pretty cr ;
+
+: dhcp-status
+ ip-addr 2@ s" IP" .pad
+ ip-router 2@ s" router" .pad
+ ip-subnetmask 2@ s" subnetmask" .pad
+;
+[ELSE]
+: dhcp-status ;
+[THEN]
+
+: lease-setalarm
+ d# 0 >r
+ begin
+ 2dup d# 63. d>
+ while
+ d2/ r> 1+ >r
+ repeat
+ r>
+ hex4 space hex8 cr
+;
+
+: dhcp-wait-offer
+ h# 11 ip-isproto
+ OFFSET_UDP_SOURCEPORT packet@ d# 67 = and
+ OFFSET_UDP_DESTPORT packet@ d# 68 = and
+ d# 2 OFFSET_DHCP_XID mac-inoffset mac@n dhcp-xid d= and
+ if
+ snap
+ d# 53 dhcp-field ?dup
+ snap
+ if
+ d# 1 + macc@
+ snap
+ dup d# 2 =
+ if
+ \ [char] % emit
+ d# 3 dhcp-common
+
+ \ option 50: request IP
+ h# 3204
+ dhcp-yiaddr
+ mac-pkt-3,
+
+ \ Option 54: server
+ h# 3604
+ d# 54 dhcp-field4
+ mac-pkt-3,
+
+ dhcp-wrapup
+ then
+ d# 5 =
+ if
+ \ clrwdt
+ \ [char] & emit
+
+ dhcp-yiaddr ip-addr 2!
+ d# 1 dhcp-field4 ip-subnetmask 2!
+ \ For the router and DNS server, send out ARP requests right now. This
+ \ reduces start-up time.
+ d# 3 dhcp-field4 2dup ip-router 2! arp-lookup drop
+ d# 6 dhcp-field4 2dup ip-dns 2! arp-lookup drop
+ \ Option 51: lease time
+ s" expires in " type
+ d# 51 dhcp-field4 swap d. cr
+ then
+ then
+ snap
+ then
+;
+
+: dhcp-discover d# 1 dhcp-common dhcp-wrapup ;
+
+]module
diff --git a/docs/j1demo/firmware/dns.fs b/docs/j1demo/firmware/dns.fs
new file mode 100644
index 0000000..96ec36c
--- /dev/null
+++ b/docs/j1demo/firmware/dns.fs
@@ -0,0 +1,81 @@
+( DNS JCB 19:44 11/27/10)
+module[ dns"
+
+: ip-dns@ ip-dns 2@ ;
+
+\ ( offset -- offset' ) advance pointer past DNS label
+\ 0 means end
+\ >h# c0 means ptr to end
+\ N means word of N bytes
+
+: dns-skiplabel
+ begin
+ dup 1+ swap mac-inoffset macc@ \ offset+1 v
+ dup 0= if
+ drop exit
+ then
+ dup h# c0 >= if
+ drop 1+ exit
+ then
+ +
+ again
+;
+
+\ Query DNS. xt is a word that appends domainname to packet. id is DNS
+\ id field, used to route responses.
+
+: dns-query ( xt id -- )
+ >r
+ \ dst-port src-port dst-ip src-ip *ethaddr
+ d# 53 d# 31947
+ ip-dns@
+ net-my-ip
+ ip-dns@ arp-lookup
+ udp-header
+ r> \ IDENTIFICATION
+ h# 0100 \ FLAGS
+ d# 1 \ NOQ
+ mac-pkt-3,
+ d# 3 mac-pkt-,0
+
+ execute
+
+ d# 1 \ query type A
+ dup \ query class internet
+ mac-pkt-2,
+ udp-wrapup
+
+ ip-dns@ arp-lookup if
+ mac-send
+ then
+;
+
+: dns-handler ( srcport dstport -- 0 / ip. id 1 )
+ d# 53 d# 31947 d=
+ OFFSET_DNS_FLAGS packet@ 0< and
+ OFFSET_DNS_NOA packet@ 0<> and
+ if
+ OFFSET_DNS_QUERY
+ dns-skiplabel
+ d# 4 +
+ dns-skiplabel
+ d# 10 +
+ mac-inoffset d# 2 swap mac@n
+ OFFSET_DNS_IDENTIFICATION packet@
+ d# 1
+ else
+ d# 0
+ then
+;
+
+: dns-appendname ( str -- )
+ dup mac-pkt-c,
+ mac-pkt-s,
+;
+
+: dns-append.com ( str -- )
+ dns-appendname
+ s" com" dns-appendname
+ d# 0 mac-pkt-c,
+;
+]module
diff --git a/docs/j1demo/firmware/doc.fs b/docs/j1demo/firmware/doc.fs
new file mode 100644
index 0000000..8b3c07d
--- /dev/null
+++ b/docs/j1demo/firmware/doc.fs
@@ -0,0 +1,20 @@
+( Documentation conventions JCB 14:37 10/26/10)
+
+meta
+
+: getword ( -- a u )
+ begin
+ bl word count dup 0=
+ while
+ 2drop refill true <> abort" Failed to find word"
+ repeat
+;
+
+: ================================================================
+ begin
+ getword
+ nip 64 =
+ until
+;
+
+target
diff --git a/docs/j1demo/firmware/document.fs b/docs/j1demo/firmware/document.fs
new file mode 100644
index 0000000..53c741c
--- /dev/null
+++ b/docs/j1demo/firmware/document.fs
@@ -0,0 +1,3 @@
+\ For use with docforth.fs
+
+s" ans.fs" included
diff --git a/docs/j1demo/firmware/encode.py b/docs/j1demo/firmware/encode.py
new file mode 100644
index 0000000..54022d2
--- /dev/null
+++ b/docs/j1demo/firmware/encode.py
@@ -0,0 +1,28 @@
+import sys
+import Image
+from array import array
+
+def getch(im, x, y):
+ return tuple(tuple((int(0 != im.getpixel((x + j, y + i)))) for j in range(8)) for i in range(8))
+
+def main(filename):
+ sm = Image.open(filename).convert("L")
+ im = Image.new("L", (512, 256))
+ im.paste(sm, (0,0))
+ charset = {}
+ picture = []
+ for y in range(0, im.size[1], 8):
+ for x in range(0, im.size[0], 8):
+ glyph = getch(im, x, y)
+ if not glyph in charset:
+ charset[glyph] = 96 + len(charset)
+ picture.append(charset[glyph])
+ open(filename + ".pic", "w").write(array('B', picture).tostring())
+ cd = array('B', [0] * 8 * len(charset))
+ for d,i in charset.items():
+ i -= 96
+ for y in range(8):
+ cd[8 * i + y] = sum([(d[y][x] << (7 - x)) for x in range(8)])
+ open(filename + ".chr", "w").write(cd.tostring())
+
+main(sys.argv[1])
diff --git a/docs/j1demo/firmware/eth-ax88796.fs b/docs/j1demo/firmware/eth-ax88796.fs
new file mode 100644
index 0000000..0a630d6
--- /dev/null
+++ b/docs/j1demo/firmware/eth-ax88796.fs
@@ -0,0 +1,506 @@
+( Low-level MAC actions JCB 13:23 08/24/10)
+
+================================================================
+
+Initialization:
+ mac-cold
+
+Packet reception and reading:
+ mac-fullness
+ mac-inoffset
+ mac@
+ macc@
+ mac@n
+ mac-consume
+
+Packet construction and transmission:
+ mac-pkt-begin
+ mac-pkt-,
+ mac-pkt-c,
+ mac-pkt-d,
+ mac-pkt-2,
+ mac-pkt-3,
+ mac-pkt-,0
+ mac-pkt-s,
+ mac-pkt-src
+ packetout-off
+ mac!
+ macc!
+ mac-complete
+ mac-checksum
+ mac-send
+
+================================================================
+
+( NE2K JCB 10:23 11/08/10)
+
+: ne2sel
+ false ether_cs_n ! ;
+: ne2unsel
+ true ether_cs_n ! ;
+: ne2a ( a -- )
+ pb_a ! ;
+
+: ne2rc@ ( a -- u ) \ NE2 byte reg read
+ true ether_bhe_n !
+ true ether_aen !
+ ne2sel
+ ne2a
+ false pb_rd_n !
+ \ pause144
+ pb_d @ h# ff and
+ true pb_rd_n !
+ \ false ether_aen !
+ \ ne2unsel
+;
+
+: ne2rc! ( u a -- )
+ \ over hex2 s" -> " type dup hex2 cr
+
+ true ether_bhe_n !
+
+ ne2sel
+ ne2a
+ pb_d !
+ d# 0 ddir !
+ false pb_wr_n !
+ true pb_wr_n !
+ \ ne2unsel
+ d# 1 ddir !
+;
+
+: ne2r! ( u a -- )
+ over d# 8 rshift over 1+ ne2rc! ne2rc! ;
+
+: ne2r. \ dump registers
+ d# 16 0do
+ d# 1000 0do pause144 loop
+ i hex2 space
+ i ne2rc@ hex4 cr
+ loop
+;
+
+h# 00 constant ne2-CR
+h# 01 constant ne2-PSTART
+h# 01 constant ne2-PAR0
+h# 03 constant ne2-PAR2
+h# 05 constant ne2-PAR4
+h# 01 constant ne2-CR9346
+h# 02 constant ne2-PSTOP
+h# 03 constant ne2-BNRY
+h# 04 constant ne2-TSR
+h# 04 constant ne2-TPSR
+h# 05 constant ne2-TBCR0
+h# 05 constant ne2-NCR
+h# 06 constant ne2-CPR
+h# 06 constant ne2-TBCR1
+h# 07 constant ne2-ISR
+h# 07 constant ne2-CURR
+h# 08 constant ne2-RSAR0
+h# 08 constant ne2-CRDA0
+h# 09 constant ne2-RSAR1
+h# 09 constant ne2-CRDA1
+h# 0A constant ne2-RBCR0
+h# 0B constant ne2-RBCR1
+h# 0C constant ne2-RSR
+h# 0C constant ne2-RCR
+h# 0D constant ne2-TCR
+h# 0D constant ne2-CNTR0
+h# 0E constant ne2-DCR
+h# 0E constant ne2-CNTR1
+h# 0F constant ne2-IMR
+h# 0F constant ne2-CNTR2
+h# 10 constant ne2-RDMAPORT
+h# 14 constant ne2-MIIEEP
+h# 15 constant ne2-TR
+h# 17 constant ne2-GPOC
+h# 17 constant ne2-GPI
+h# 1F constant ne2-RSTPORT
+
+: ne2-page0 h# 22 ne2-CR ne2rc! ;
+: ne2-page1 h# 62 ne2-CR ne2rc! ;
+
+: ne2-clrisr \ clear the ISR
+ h# ff ne2-ISR ne2rc! ;
+
+
+: ne2r.2
+ s" Page 0" type cr
+ ne2-page0
+ ne2r.
+ s" Page 1" type cr
+ ne2-page1
+ ne2r.
+ ne2-page0 ;
+
+( The MII interface JCB 12:47 11/09/10)
+
+h# 08 constant MII_EEP_MDO
+h# 04 constant MII_EEP_MDI
+h# 01 constant MII_EEP_MDC
+
+: eep-on ( u ) ne2-MIIEEP ne2rc@ or ne2-MIIEEP ne2rc! ;
+: eep-off ( u ) invert ne2-MIIEEP ne2rc@ and ne2-MIIEEP ne2rc! ;
+
+: miix ( u c -- u ) \ Send c bit data u
+ tuck
+ d# 16 swap - lshift
+ swap
+ 0do
+ MII_EEP_MDO over 0< if
+ eep-on
+ else
+ eep-off
+ then
+ MII_EEP_MDC eep-on \ clock up
+ 2*
+ ne2-MIIEEP ne2rc@ MII_EEP_MDI and if 1+ then
+ MII_EEP_MDC eep-off \ clock down
+ loop
+;
+
+: phy@ ( a -- u )
+ h# ffff d# 16 miix drop
+ h# ffff d# 16 miix drop
+ h# 0d0 d# 9 miix drop
+ d# 5 miix drop
+ h# 0 d# 1 miix drop
+ h# 0 d# 16 miix
+;
+
+: phy! ( u a -- )
+ h# ffff d# 16 miix drop
+ h# ffff d# 16 miix drop
+ h# 0b0 d# 9 miix drop
+ d# 5 miix drop
+ h# 2 d# 2 miix drop
+ d# 16 miix drop
+;
+
+: phy.
+ d# 32 0do
+ i hex2 space i phy@ hex4 cr
+ loop
+ cr
+;
+
+: phy-cold
+ \ h# b000 d# 0 phy!
+ h# 0800 d# 0 phy!
+ s" PHY power down for 2.5s" type cr
+ d# 2500000. sleepus
+ \ h# 1200 d# 0 phy!
+ h# 0000 d# 0 phy!
+ exit
+ sleep1
+ sleep1
+ sleep1
+ sleep1
+ sleep1
+ sleep1
+
+ \ h# 6030 d# 30 phy!
+
+ phy. sleep1
+ cr
+ phy.
+;
+
+: mac-cold ( ethaddr -- )
+
+ false RESET_TRIGGER !
+ sleep1
+ true RESET_TRIGGER !
+ sleep1
+
+ true pb_rd_n !
+ true pb_wr_n !
+ true ether_cs_n !
+ false ether_aen !
+ true ether_bhe_n !
+ d# 0 pb_a !
+ d# 1 ddir !
+
+ \ d# 4 0do ne2-RSTPORT ne2rc@ ne2-RSTPORT ne2rc! sleep1 loop
+
+ phy-cold
+
+ \ Wait for TR RST_B to go low and GPI link up
+ s" TR GPI" type cr
+ begin
+ ne2-TR ne2rc@ hex2 d# 3 spaces
+ ne2-GPI ne2rc@ hex2 d# 3 spaces
+ sleep.1
+ cr
+ ne2-TR ne2rc@ d# 2 and 0=
+ ne2-GPI ne2rc@ d# 1 and 0<> and
+ until
+
+ \ Wait for TR RST_B to go low
+\ begin
+\ sleep1
+\ ne2-TR ne2rc@ dup hex2 cr
+\ d# 2 and 0=
+\ until
+
+ true if
+ h# 21 ne2-CR ne2rc! \ Stop the NIC, abort DMA, page 0
+ h# 00 ne2-DCR ne2rc! \ Selects byte-wide DMA transfers
+ h# 00 ne2-RBCR0 ne2rc! \ Load data byte count for remote DMA
+ h# 00 ne2-RBCR1 ne2rc!
+ h# 20 ne2-RCR ne2rc! \ Temporarily set receiver to monitor mode
+ h# 02 ne2-TCR ne2rc! \ Transmitter set to internal loopback mode
+ \ Initialize Receive Buffer Ring: Boundary Pointer
+ \ (BNDRY), Page Start (PSTART), and Page Stop
+ \ (PSTOP)
+ h# 46 ne2-PSTART ne2rc!
+ h# 46 ne2-BNRY ne2rc!
+ h# 80 ne2-PSTOP ne2rc!
+ h# ff ne2-ISR ne2rc! \ Clear Interrupt Status Register (ISR) by writing 0FFh to it.
+ h# 01 ne2-IMR ne2rc! \ Initialize interrupt mask
+ h# 61 ne2-CR ne2rc! \ Stop the NIC, abort DMA, page 1
+ h# 12 d# 1 ne2rc! \ Set Physical Address
+ h# 34 d# 2 ne2rc!
+ h# 56 d# 3 ne2rc!
+ h# 77 d# 4 ne2rc!
+ h# 77 d# 5 ne2rc!
+ h# 77 d# 6 ne2rc!
+ d# 16 d# 8 do \ Set multicast address
+ h# 00 i ne2rc!
+ loop
+
+ h# 47 ne2-CURR ne2rc! \ Initialize CURRent pointer
+ h# 22 ne2-CR ne2rc! \ Start the NIC, Abort DMA, page 0
+ h# 10 ne2-GPOC ne2rc! \ Select media interface
+ s" GPI = " type ne2-GPI ne2rc@ hex2 cr
+ h# 00 ne2-TCR ne2rc! \ Transmitter full duplex
+ h# 04 ne2-RCR ne2rc! \ Enable receiver and set accept broadcast
+ else
+ h# 21 ne2-CR ne2rc! \ Stop the NIC, abort DMA, page 0
+ sleep.1
+
+ h# 00 ne2-DCR ne2rc! \ Selects word-wide DMA transfers
+ h# 00 ne2-RBCR0 ne2rc! \ Load data byte count for remote DMA
+ h# 00 ne2-RBCR1 ne2rc!
+
+ h# 20 ne2-RCR ne2rc! \ Temporarily set receiver to monitor mode
+ h# 02 ne2-TCR ne2rc! \ Transmitter set to internal loopback mode
+
+ h# 40 ne2-TPSR ne2rc! \ Set Tx start page
+ \ Initialize Receive Buffer Ring: Boundary Pointer
+ \ (BNDRY), Page Start (PSTART), and Page Stop
+ \ (PSTOP)
+ h# 46 ne2-PSTART ne2rc!
+ h# 46 ne2-BNRY ne2rc!
+ h# 80 ne2-PSTOP ne2rc!
+ h# ff ne2-ISR ne2rc! \ Clear Interrupt Status Register (ISR) by writing 0FFh to it.
+ h# 01 ne2-IMR ne2rc! \ Initialize interrupt mask
+
+ h# 61 ne2-CR ne2rc! \ Stop the NIC, abort DMA, page 1
+ sleep.1
+ h# 12 d# 1 ne2rc! \ Set Physical Address
+ h# 34 d# 2 ne2rc!
+ h# 56 d# 3 ne2rc!
+ h# 77 d# 4 ne2rc!
+ h# 77 d# 5 ne2rc!
+ h# 77 d# 6 ne2rc!
+ d# 16 d# 8 do \ Set multicast address
+ h# ff i ne2rc!
+ loop
+
+ h# 47 ne2-CURR ne2rc! \ Initialize CURRent pointer
+
+ h# 20 ne2-CR ne2rc! \ DMA abort, page 0
+
+ h# 10 ne2-GPOC ne2rc! \ Select media interface
+ s" GPI = " type ne2-GPI ne2rc@ hex2 cr
+ h# 1c ne2-RCR ne2rc! \ Enable receiver and set accept broadcast
+ h# 00 ne2-TCR ne2rc! \ Transmitter full duplex
+
+ h# ff ne2-ISR ne2rc! \ Clear Interrupt Status Register (ISR) by writing 0FFh to it.
+ h# 22 ne2-CR ne2rc! \ Start the NIC, Abort DMA, page 0
+ then
+;
+
+: NicCompleteDma
+ h# 22 ne2-CR ne2rc! \ Complete remote DMA
+;
+
+: maca ( a -- ) \ set DMA address a
+ dup d# 8 rshift ne2-RSAR1 ne2rc! ne2-RSAR0 ne2rc! ;
+: mac1b \ set DMA transfer for 1 byte
+ h# 01 ne2-RBCR0 ne2rc!
+ h# 00 ne2-RBCR1 ne2rc! ;
+: mac2b \ set DMA transfer for 2 bytes
+ h# 02 ne2-RBCR0 ne2rc!
+ h# 00 ne2-RBCR1 ne2rc! ;
+: macc@ ( a -- u )
+ maca mac1b
+ h# 0a ne2-CR ne2rc! \ running, DMA read
+ ne2-RDMAPORT ne2rc@
+ NicCompleteDma ;
+: macc! ( u a -- )
+ maca mac1b
+ h# 12 ne2-CR ne2rc! \ running, DMA write
+ ne2-RDMAPORT ne2rc! ;
+: mac@ ( a -- u )
+ maca mac2b
+ h# 0a ne2-CR ne2rc! \ running, DMA read
+ ne2-RDMAPORT ne2rc@ d# 8 lshift ne2-RDMAPORT ne2rc@ or
+ NicCompleteDma ;
+: mac! ( u a -- )
+ maca mac2b
+ h# 12 ne2-CR ne2rc! \ running, DMA write
+ dup d# 8 rshift ne2-RDMAPORT ne2rc! ne2-RDMAPORT ne2rc! ;
+
+: mac-dump ( a u -- )
+ bounds
+ begin
+ 2dup u>
+ while
+ dup h# f and 0= if
+ cr dup hex4 [char] : emit space
+ then
+ dup mac@ hex4 space
+ 2+
+ repeat 2drop cr ;
+
+variable currpkt
+
+: mac-inoffset ( u -- u ) \ compute offset into current incoming packet
+ currpkt @ +
+ dup 0< if
+ h# 8000 -
+ h# 4600 +
+ then
+;
+
+: mac@n ( n addr -- d0 .. dn )
+ swap 0do dup mac@ swap 2+ loop drop ;
+
+
+( words for constructing packet data JCB 07:01 08/20/10)
+variable writer
+
+: mac-pkt-begin h# 4000 writer ! ;
+: bump ( n -- ) writer +! ;
+: mac-pkt-c, ( n -- ) writer @ macc! d# 1 bump ;
+: mac-pkt-, ( n -- ) writer @ mac! d# 2 bump ;
+: mac-pkt-d, ( d -- ) mac-pkt-, mac-pkt-, ;
+: mac-pkt-2, ( n0 n1 -- ) swap mac-pkt-, mac-pkt-, ;
+: mac-pkt-3, rot mac-pkt-, mac-pkt-2, ;
+: mac-pkt-,0 ( n -- ) 0do d# 0 mac-pkt-, loop ;
+: mac-pkt-s, ( caddr u -- )
+ 0do
+ dup c@
+ mac-pkt-c,
+ 1+
+ loop
+ drop
+;
+
+: mac-pkt-src ( n offset -- ) \ copy n words from incoming+offset
+ swap 0do
+ dup mac-inoffset mac@ mac-pkt-,
+ 2+
+ loop
+ drop
+;
+
+: mac-pkt-complete ( -- length ) \ set up size
+ writer @ h# 4000 -
+ \ h# 4000 over mac-dump
+ dup ne2-TBCR0 ne2r! ;
+
+: mac-checksum ( addr nwords -- sum )
+ d# 0 swap
+ 0do
+ over mac@ ( addr sum v )
+ +1c
+ swap 2+ swap
+ loop
+ nip
+ invert
+;
+
+: mac-snap
+ s" CR PSTART PSTOP BNRY TSR NCR CPR ISR CRDA0 CRDA1 - - RSR CNTR0 CNTR1 CNTR2" type cr
+ d# 16 0do
+ i ne2rc@ hex2 d# 5 spaces
+ loop
+;
+
+: mac-fullness ( -- f )
+ ether_irq @ if
+ ne2-BNRY ne2rc@ 1+ ne2-CPR ne2rc@ <> dup if
+ \ mac-snap
+ ne2-BNRY ne2rc@ 1+ d# 8 lshift d# 4 + currpkt !
+ \ s" currpkt=" type currpkt @ hex4 space
+ \ currpkt @ d# 4 - macc@ hex2
+ \ cr
+ \ currpkt @ d# 4 - d# 16 mac-dump
+ else
+ ne2-clrisr
+ then
+ else
+ false
+ then
+;
+
+: mac-consume ( -- ) \ finished with current packet, move on
+ ne2-BNRY ne2rc@ 1+ d# 8 lshift 1+ macc@ \ next pkt
+ 1- ne2-BNRY ne2rc!
+;
+
+variable ne2cold
+
+: mac-send
+ ne2cold @ 0= if
+ h# 21 ne2-CR ne2rc!
+ h# 22 ne2-CR ne2rc!
+ true ne2cold !
+ then
+
+ h# 40 ne2-TPSR ne2rc!
+ h# 26 ne2-CR ne2rc! \ START
+ ;
+
+: packetout-off \ compute offset in output packet
+ h# 4000 + ;
+
+: nicwork
+
+ \ ISA mode
+
+ \ begin
+ s" TR= " type h# 15 ne2rc@ hex2 space
+ s" ether_irq=" type ether_irq @ hex1 space
+ s" ISR=" type ne2-ISR ne2rc@ hex2 space
+ cr
+ \ again
+
+ false if
+ h# 0000 ne2-RSAR0 ne2r!
+ cr
+ d# 16 0do
+ ne2-RDMAPORT ne2rc@ hex2 space
+ loop
+ cr
+ then
+
+ s" CR PSTART PSTOP BNRY TSR NCR CPR ISR CRDA0 CRDA1 - - RSR CNTR0 CNTR1 CNTR2" type cr
+ begin
+ d# 16 0do
+ i ne2rc@ hex2 d# 5 spaces
+ loop
+ ether_irq @ hex1
+ cr
+ sleep1
+ ne2-CPR ne2rc@ h# 47 <>
+ until
+
+ \ h# 4700 h# 100 mac-dump
+ \ cr
+ \ h# 0947 h# 4700 mac!
+ \ h# 4700 h# 100 mac-dump
+;
diff --git a/docs/j1demo/firmware/font8x8 b/docs/j1demo/firmware/font8x8
new file mode 100644
index 0000000..fbdaf14
--- /dev/null
+++ b/docs/j1demo/firmware/font8x8
Binary files differ
diff --git a/docs/j1demo/firmware/fsm-32.png b/docs/j1demo/firmware/fsm-32.png
new file mode 100644
index 0000000..974f70c
--- /dev/null
+++ b/docs/j1demo/firmware/fsm-32.png
Binary files differ
diff --git a/docs/j1demo/firmware/genoffsets.py b/docs/j1demo/firmware/genoffsets.py
new file mode 100644
index 0000000..2ed279e
--- /dev/null
+++ b/docs/j1demo/firmware/genoffsets.py
@@ -0,0 +1,11 @@
+from defines_tcpip import offsets
+
+d = open("defines_tcpip.fs", "w")
+for nm,o in sorted(offsets.items()):
+ print >>d, "%d constant %s" % (o, nm)
+
+import defines_tcpip2
+
+d = open("defines_tcpip2.fs", "w")
+for nm,o in sorted(defines_tcpip2.offsets.items()):
+ print >>d, "%d constant %s" % (o, nm)
diff --git a/docs/j1demo/firmware/go b/docs/j1demo/firmware/go
new file mode 100644
index 0000000..0adb2d0
--- /dev/null
+++ b/docs/j1demo/firmware/go
@@ -0,0 +1,16 @@
+# make doc
+# python encode.py j1.png
+# python mkblob.py ; exit
+make j1.bin || exit
+
+# for ADDR in 0 80000 100000 180000
+# do
+# (. /opt/Xilinx/11.1/ISE/settings32.sh ; promgen -u $ADDR j1_program.bit -p mcs -w -o j1_program_$ADDR.mcs )
+# done
+# ./boot
+# ping -c 4 192.168.0.99 && python twist.py
+
+python twist.py
+
+(. /opt/Xilinx/11.1/ISE/settings32.sh ; data2mem -bm ../synth/j1_bd.bmm -bd j1.mem tag jram -bt ../synth/j1.bit -o b j1_program.bit )
+scp j1_program.bit leonard:.
diff --git a/docs/j1demo/firmware/hwdefs.fs b/docs/j1demo/firmware/hwdefs.fs
new file mode 100644
index 0000000..4539d1a
--- /dev/null
+++ b/docs/j1demo/firmware/hwdefs.fs
@@ -0,0 +1,57 @@
+h# 4100 constant flash_ddir
+h# 4102 constant flash_ce_n
+h# 4104 constant flash_oe_n
+h# 4106 constant flash_we_n
+h# 4108 constant flash_byte_n
+h# 410a constant flash_rdy
+h# 410c constant flash_rst_n
+h# 410e constant flash_a
+h# 4110 constant flash_a_hi
+h# 4112 constant flash_d
+
+h# 4200 constant ps2_clk
+h# 4202 constant ps2_dat
+h# 4204 constant ps2_clk_dir
+h# 4206 constant ps2_dat_dir
+h# 4208 constant kbfifocount
+h# 4210 constant kbfifo
+
+h# 4300 constant vga_scroll
+h# 4302 constant vga_spritea
+h# 4304 constant vga_spriteport
+h# 4306 constant vga_line
+h# 4308 constant vga_addsprites
+
+h# 4400 constant vga_spritex
+h# 4402 constant vga_spritey
+
+h# 4420 constant vga_spritec
+h# 4430 constant vga_spritep
+
+h# 4500 constant sw2_n
+h# 4502 constant sw3_n
+
+h# 5000 constant RS232_TXD
+h# 5001 constant RESET_TRIGGER
+h# 5100 constant ether_cs_n
+h# 5101 constant ether_aen
+h# 5102 constant ether_bhe_n
+h# 5103 constant pb_a
+h# 5104 constant ddir
+h# 5105 constant pb_d
+h# 5106 constant pb_rd_n
+h# 5107 constant pb_wr_n
+h# 5108 constant ether_rdy
+h# 5109 constant ether_irq
+h# 510a constant pb_a_dir
+
+h# 6000 constant time
+h# 6100 constant mult_a
+h# 6102 constant mult_b
+h# 6104 constant mult_p
+
+\ Pushbuttons
+
+h# 1 constant pb2
+h# 2 constant pb3
+h# 4 constant pb4
diff --git a/docs/j1demo/firmware/intelhex.py b/docs/j1demo/firmware/intelhex.py
new file mode 100644
index 0000000..ecf8b28
--- /dev/null
+++ b/docs/j1demo/firmware/intelhex.py
@@ -0,0 +1,643 @@
+#!/usr/bin/python
+
+# Copyright (c) 2005-2007, Alexander Belchenko
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms,
+# with or without modification, are permitted provided
+# that the following conditions are met:
+#
+# * Redistributions of source code must retain
+# the above copyright notice, this list of conditions
+# and the following disclaimer.
+# * Redistributions in binary form must reproduce
+# the above copyright notice, this list of conditions
+# and the following disclaimer in the documentation
+# and/or other materials provided with the distribution.
+# * Neither the name of the <Alexander Belchenko>
+# nor the names of its contributors may be used to endorse
+# or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING,
+# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+# AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+# IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
+# OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,
+# OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+# AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+# STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
+# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+'''Intel HEX file format reader and converter.
+
+This script also may be used as hex2bin convertor utility.
+
+@author Alexander Belchenko (bialix AT ukr net)
+@version 0.8.6
+@date 2007/04/26
+'''
+
+
+__docformat__ = "javadoc"
+
+
+from array import array
+from binascii import hexlify, unhexlify
+
+
+class IntelHex:
+ ''' Intel HEX file reader. '''
+
+ def __init__(self, fname):
+ ''' Constructor.
+ @param fname file name of HEX file or file object.
+ '''
+ #public members
+ self.Error = None
+ self.AddrOverlap = None
+ self.padding = 0x0FF
+ # Start Address
+ self.start_addr = None
+
+ # private members
+ self._fname = fname
+ self._buf = {}
+ self._readed = False
+ self._eof = False
+ self._offset = 0
+
+ def readfile(self):
+ ''' Read file into internal buffer.
+ @return True if successful.
+ '''
+ if self._readed:
+ return True
+
+ if not hasattr(self._fname, "read"):
+ f = file(self._fname, "rU")
+ fclose = f.close
+ else:
+ f = self._fname
+ fclose = None
+
+ self._offset = 0
+ self._eof = False
+
+ result = True
+
+ for s in f:
+ if not self.decode_record(s):
+ result = False
+ break
+
+ if self._eof:
+ break
+
+ if fclose:
+ fclose()
+
+ self._readed = result
+ return result
+
+ def decode_record(self, s):
+ ''' Decode one record of HEX file.
+ @param s line with HEX record.
+ @return True if line decode OK, or this is not HEX line.
+ False if this is invalid HEX line or checksum error.
+ '''
+ s = s.rstrip('\r\n')
+ if not s:
+ return True # empty line
+
+ if s[0] == ':':
+ try:
+ bin = array('B', unhexlify(s[1:]))
+ except TypeError:
+ # this might be raised by unhexlify when odd hexascii digits
+ self.Error = "Odd hexascii digits"
+ return False
+ length = len(bin)
+ if length < 5:
+ self.Error = "Too short line"
+ return False
+ else:
+ return True # first char must be ':'
+
+ record_length = bin[0]
+
+ if length != (5 + record_length):
+ self.Error = "Invalid line length"
+ return False
+
+ addr = bin[1]*256 + bin[2]
+
+ record_type = bin[3]
+ if not (0 <= record_type <= 5):
+ self.Error = "Invalid type of record: %d" % record_type
+ return False
+
+ crc = sum(bin)
+ crc &= 0x0FF
+ if crc != 0:
+ self.Error = "Invalid crc"
+ return False
+
+ if record_type == 0:
+ # data record
+ addr += self._offset
+ for i in xrange(4, 4+record_length):
+ if not self._buf.get(addr, None) is None:
+ self.AddrOverlap = addr
+ self._buf[addr] = bin[i]
+ addr += 1 # FIXME: addr should be wrapped on 64K boundary
+
+ elif record_type == 1:
+ # end of file record
+ if record_length != 0:
+ self.Error = "Bad End-of-File Record"
+ return False
+ self._eof = True
+
+ elif record_type == 2:
+ # Extended 8086 Segment Record
+ if record_length != 2 or addr != 0:
+ self.Error = "Bad Extended 8086 Segment Record"
+ return False
+ self._offset = (bin[4]*256 + bin[5]) * 16
+
+ elif record_type == 4:
+ # Extended Linear Address Record
+ if record_length != 2 or addr != 0:
+ self.Error = "Bad Extended Linear Address Record"
+ return False
+ self._offset = (bin[4]*256 + bin[5]) * 65536
+
+ elif record_type == 3:
+ # Start Segment Address Record
+ if record_length != 4 or addr != 0:
+ self.Error = "Bad Start Segment Address Record"
+ return False
+ if self.start_addr:
+ self.Error = "Start Address Record appears twice"
+ return False
+ self.start_addr = {'CS': bin[4]*256 + bin[5],
+ 'IP': bin[6]*256 + bin[7],
+ }
+
+ elif record_type == 5:
+ # Start Linear Address Record
+ if record_length != 4 or addr != 0:
+ self.Error = "Bad Start Linear Address Record"
+ return False
+ if self.start_addr:
+ self.Error = "Start Address Record appears twice"
+ return False
+ self.start_addr = {'EIP': (bin[4]*16777216 +
+ bin[5]*65536 +
+ bin[6]*256 +
+ bin[7]),
+ }
+
+ return True
+
+ def _get_start_end(self, start=None, end=None):
+ """Return default values for start and end if they are None
+ """
+ if start is None:
+ start = min(self._buf.keys())
+ if end is None:
+ end = max(self._buf.keys())
+ if start > end:
+ start, end = end, start
+ return start, end
+
+ def tobinarray(self, start=None, end=None, pad=None):
+ ''' Convert to binary form.
+ @param start start address of output bytes.
+ @param end end address of output bytes.
+ @param pad fill empty spaces with this value
+ (if None used self.padding).
+ @return array of unsigned char data.
+ '''
+ if pad is None:
+ pad = self.padding
+
+ bin = array('B')
+
+ if self._buf == {}:
+ return bin
+
+ start, end = self._get_start_end(start, end)
+
+ for i in xrange(start, end+1):
+ bin.append(self._buf.get(i, pad))
+
+ return bin
+
+ def tobinstr(self, start=None, end=None, pad=0xFF):
+ ''' Convert to binary form.
+ @param start start address of output bytes.
+ @param end end address of output bytes.
+ @param pad fill empty spaces with this value
+ (if None used self.padding).
+ @return string of binary data.
+ '''
+ return self.tobinarray(start, end, pad).tostring()
+
+ def tobinfile(self, fobj, start=None, end=None, pad=0xFF):
+ '''Convert to binary and write to file.
+
+ @param fobj file name or file object for writing output bytes.
+ @param start start address of output bytes.
+ @param end end address of output bytes.
+ @param pad fill empty spaces with this value
+ (if None used self.padding).
+ '''
+ if not hasattr(fobj, "write"):
+ fobj = file(fobj, "wb")
+ fclose = fobj.close
+ else:
+ fclose = None
+
+ fobj.write(self.tobinstr(start, end, pad))
+
+ if fclose:
+ fclose()
+
+ def minaddr(self):
+ ''' Get minimal address of HEX content. '''
+ aa = self._buf.keys()
+ if aa == []:
+ return 0
+ else:
+ return min(aa)
+
+ def maxaddr(self):
+ ''' Get maximal address of HEX content. '''
+ aa = self._buf.keys()
+ if aa == []:
+ return 0
+ else:
+ return max(aa)
+
+ def __getitem__(self, addr):
+ ''' Get byte from address.
+ @param addr address of byte.
+ @return byte if address exists in HEX file, or self.padding
+ if no data found.
+ '''
+ return self._buf.get(addr, self.padding)
+
+ def __setitem__(self, addr, byte):
+ self._buf[addr] = byte
+
+ def writefile(self, f, write_start_addr=True):
+ """Write data to file f in HEX format.
+
+ @param f filename or file-like object for writing
+ @param write_start_addr enable or disable writing start address
+ record to file (enabled by default).
+ If there is no start address nothing
+ will be written.
+
+ @return True if successful.
+ """
+ fwrite = getattr(f, "write", None)
+ if fwrite:
+ fobj = f
+ fclose = None
+ else:
+ fobj = file(f, 'w')
+ fwrite = fobj.write
+ fclose = fobj.close
+
+ # start address record if any
+ if self.start_addr and write_start_addr:
+ keys = self.start_addr.keys()
+ keys.sort()
+ bin = array('B', '\0'*9)
+ if keys == ['CS','IP']:
+ # Start Segment Address Record
+ bin[0] = 4 # reclen
+ bin[1] = 0 # offset msb
+ bin[2] = 0 # offset lsb
+ bin[3] = 3 # rectyp
+ cs = self.start_addr['CS']
+ bin[4] = (cs >> 8) & 0x0FF
+ bin[5] = cs & 0x0FF
+ ip = self.start_addr['IP']
+ bin[6] = (ip >> 8) & 0x0FF
+ bin[7] = ip & 0x0FF
+ bin[8] = (-sum(bin)) & 0x0FF # chksum
+ fwrite(':')
+ fwrite(hexlify(bin.tostring()).upper())
+ fwrite('\n')
+ elif keys == ['EIP']:
+ # Start Linear Address Record
+ bin[0] = 4 # reclen
+ bin[1] = 0 # offset msb
+ bin[2] = 0 # offset lsb
+ bin[3] = 5 # rectyp
+ eip = self.start_addr['EIP']
+ bin[4] = (eip >> 24) & 0x0FF
+ bin[5] = (eip >> 16) & 0x0FF
+ bin[6] = (eip >> 8) & 0x0FF
+ bin[7] = eip & 0x0FF
+ bin[8] = (-sum(bin)) & 0x0FF # chksum
+ fwrite(':')
+ fwrite(hexlify(bin.tostring()).upper())
+ fwrite('\n')
+ else:
+ self.Error = ('Invalid start address value: %r'
+ % self.start_addr)
+ return False
+
+ # data
+ minaddr = IntelHex.minaddr(self)
+ maxaddr = IntelHex.maxaddr(self)
+ if maxaddr > 65535:
+ offset = (minaddr/65536)*65536
+ else:
+ offset = None
+
+ while True:
+ if offset != None:
+ # emit 32-bit offset record
+ high_ofs = offset / 65536
+ offset_record = ":02000004%04X" % high_ofs
+ bytes = divmod(high_ofs, 256)
+ csum = 2 + 4 + bytes[0] + bytes[1]
+ csum = (-csum) & 0x0FF
+ offset_record += "%02X\n" % csum
+
+ ofs = offset
+ if (ofs + 65536) > maxaddr:
+ rng = xrange(maxaddr - ofs + 1)
+ else:
+ rng = xrange(65536)
+ else:
+ ofs = 0
+ offset_record = ''
+ rng = xrange(maxaddr + 1)
+
+ csum = 0
+ k = 0
+ record = ""
+ for addr in rng:
+ byte = self._buf.get(ofs+addr, None)
+ if byte != None:
+ if k == 0:
+ # optionally offset record
+ fobj.write(offset_record)
+ offset_record = ''
+ # start data record
+ record += "%04X00" % addr
+ bytes = divmod(addr, 256)
+ csum = bytes[0] + bytes[1]
+
+ k += 1
+ # continue data in record
+ record += "%02X" % byte
+ csum += byte
+
+ # check for length of record
+ if k < 16:
+ continue
+
+ if k != 0:
+ # close record
+ csum += k
+ csum = (-csum) & 0x0FF
+ record += "%02X" % csum
+ fobj.write(":%02X%s\n" % (k, record))
+ # cleanup
+ csum = 0
+ k = 0
+ record = ""
+ else:
+ if k != 0:
+ # close record
+ csum += k
+ csum = (-csum) & 0x0FF
+ record += "%02X" % csum
+ fobj.write(":%02X%s\n" % (k, record))
+
+ # advance offset
+ if offset is None:
+ break
+
+ offset += 65536
+ if offset > maxaddr:
+ break
+
+ # end-of-file record
+ fobj.write(":00000001FF\n")
+ if fclose:
+ fclose()
+
+ return True
+#/IntelHex
+
+
+class IntelHex16bit(IntelHex):
+ """Access to data as 16-bit words."""
+
+ def __init__(self, source):
+ """Construct class from HEX file
+ or from instance of ordinary IntelHex class.
+
+ @param source file name of HEX file or file object
+ or instance of ordinary IntelHex class
+ """
+ if isinstance(source, IntelHex):
+ # from ihex8
+ self.Error = source.Error
+ self.AddrOverlap = source.AddrOverlap
+ self.padding = source.padding
+
+ # private members
+ self._fname = source._fname
+ self._buf = source._buf
+ self._readed = source._readed
+ self._eof = source._eof
+ self._offset = source._offset
+ else:
+ IntelHex.__init__(self, source)
+
+ if self.padding == 0x0FF:
+ self.padding = 0x0FFFF
+
+ def __getitem__(self, addr16):
+ """Get 16-bit word from address.
+ Raise error if found only one byte from pair.
+
+ @param addr16 address of word (addr8 = 2 * addr16).
+ @return word if bytes exists in HEX file, or self.padding
+ if no data found.
+ """
+ addr1 = addr16 * 2
+ addr2 = addr1 + 1
+ byte1 = self._buf.get(addr1, None)
+ byte2 = self._buf.get(addr2, None)
+
+ if byte1 != None and byte2 != None:
+ return byte1 | (byte2 << 8) # low endian
+
+ if byte1 == None and byte2 == None:
+ return self.padding
+
+ raise Exception, 'Bad access in 16-bit mode (not enough data)'
+
+ def __setitem__(self, addr16, word):
+ addr_byte = addr16 * 2
+ bytes = divmod(word, 256)
+ self._buf[addr_byte] = bytes[1]
+ self._buf[addr_byte+1] = bytes[0]
+
+ def minaddr(self):
+ '''Get minimal address of HEX content in 16-bit mode.'''
+ aa = self._buf.keys()
+ if aa == []:
+ return 0
+ else:
+ return min(aa)/2
+
+ def maxaddr(self):
+ '''Get maximal address of HEX content in 16-bit mode.'''
+ aa = self._buf.keys()
+ if aa == []:
+ return 0
+ else:
+ return max(aa)/2
+
+#/class IntelHex16bit
+
+
+def hex2bin(fin, fout, start=None, end=None, size=None, pad=0xFF):
+ """Hex-to-Bin convertor engine.
+ @return 0 if all OK
+
+ @param fin input hex file (filename or file-like object)
+ @param fout output bin file (filename or file-like object)
+ @param start start of address range (optional)
+ @param end end of address range (optional)
+ @param size size of resulting file (in bytes) (optional)
+ @param pad padding byte (optional)
+ """
+ h = IntelHex(fin)
+ if not h.readfile():
+ print "Bad HEX file"
+ return 1
+
+ # start, end, size
+ if size != None and size != 0:
+ if end == None:
+ if start == None:
+ start = h.minaddr()
+ end = start + size - 1
+ else:
+ if (end+1) >= size:
+ start = end + 1 - size
+ else:
+ start = 0
+
+ try:
+ h.tobinfile(fout, start, end, pad)
+ except IOError:
+ print "Could not write to file: %s" % fout
+ return 1
+
+ return 0
+#/def hex2bin
+
+
+if __name__ == '__main__':
+ import getopt
+ import os
+ import sys
+
+ usage = '''Hex2Bin python converting utility.
+Usage:
+ python intelhex.py [options] file.hex [out.bin]
+
+Arguments:
+ file.hex name of hex file to processing.
+ out.bin name of output file.
+ If omitted then output write to file.bin.
+
+Options:
+ -h, --help this help message.
+ -p, --pad=FF pad byte for empty spaces (ascii hex value).
+ -r, --range=START:END specify address range for writing output
+ (ascii hex value).
+ Range can be in form 'START:' or ':END'.
+ -l, --length=NNNN,
+ -s, --size=NNNN size of output (decimal value).
+'''
+
+ pad = 0xFF
+ start = None
+ end = None
+ size = None
+
+ try:
+ opts, args = getopt.getopt(sys.argv[1:], "hp:r:l:s:",
+ ["help", "pad=", "range=",
+ "length=", "size="])
+
+ for o, a in opts:
+ if o in ("-h", "--help"):
+ print usage
+ sys.exit(0)
+ elif o in ("-p", "--pad"):
+ try:
+ pad = int(a, 16) & 0x0FF
+ except:
+ raise getopt.GetoptError, 'Bad pad value'
+ elif o in ("-r", "--range"):
+ try:
+ l = a.split(":")
+ if l[0] != '':
+ start = int(l[0], 16)
+ if l[1] != '':
+ end = int(l[1], 16)
+ except:
+ raise getopt.GetoptError, 'Bad range value(s)'
+ elif o in ("-l", "--lenght", "-s", "--size"):
+ try:
+ size = int(a, 10)
+ except:
+ raise getopt.GetoptError, 'Bad size value'
+
+ if start != None and end != None and size != None:
+ raise getopt.GetoptError, 'Cannot specify START:END and SIZE simultaneously'
+
+ if not args:
+ raise getopt.GetoptError, 'Hex file is not specified'
+
+ if len(args) > 2:
+ raise getopt.GetoptError, 'Too many arguments'
+
+ except getopt.GetoptError, msg:
+ print msg
+ print usage
+ sys.exit(2)
+
+ fin = args[0]
+ if len(args) == 1:
+ import os.path
+ name, ext = os.path.splitext(fin)
+ fout = name + ".bin"
+ else:
+ fout = args[1]
+
+ if not os.path.isfile(fin):
+ print "File not found"
+ sys.exit(1)
+
+ sys.exit(hex2bin(fin, fout, start, end, size, pad))
diff --git a/docs/j1demo/firmware/invaders.fs b/docs/j1demo/firmware/invaders.fs
new file mode 100644
index 0000000..f501a3e
--- /dev/null
+++ b/docs/j1demo/firmware/invaders.fs
@@ -0,0 +1,362 @@
+( Space invaders JCB 10:43 11/18/10)
+
+: whereis ( t -- x y )
+ >r
+ d# 384 r@ sin* d# 384 +
+ r@ d# 4 rshift d# 32 r> 2* sin* +
+;
+
+56 constant nsprites
+
+nsprites array invx
+nsprites array invy
+nsprites array alive
+nsprites array invnext
+nsprites array anim
+
+: invload ( i -- ) \ load sprite i
+ \ s" sprite " type dup . s" at " type dup invx @ . dup invy @ . cr
+ dup invx @ swap
+ dup invy @ swap
+ dup anim @ swap
+ d# 7 and
+ tuck cells vga_spritep + !
+ sprite!
+;
+
+: inv-makedl ( -- )
+ erasedl
+ nsprites 0do
+ \ invy -ve load sprite; +ve gives the dl offset
+ i alive @ if
+ i invy @ dup 0< if
+ drop i invload
+ else
+ dup d# 512 < if
+ \ dl[y] -> invnext[i]
+ \ i -> dl[y]
+ cells dl + dup
+ @ i invnext !
+ i swap !
+ else
+ drop
+ then
+ then
+ then
+ loop
+;
+
+: inv-chase
+ d# 512 0do
+ begin vga-line@ i = until
+ \ s" line" type i . cr
+ i cells dl + @
+ begin
+ dup d# 0 >=
+ while
+ dup invload
+ invnext @
+ repeat
+ loop
+;
+
+: born ( x y i ) \ sprite i born
+ dup alive on
+ tuck invy !
+ invx !
+;
+
+: kill ( i -- ) \ kill sprite i
+ d# 512 over invy !
+ alive off
+;
+
+: isalien ( u -- f)
+ d# 6 and d# 6 <> ;
+
+: moveto ( i -- ) \ move invader i to current position
+ dup d# 6 and d# 6 <>
+ over alive @ and if
+ >r
+ frame @ r@ d# 7 and d# 8 * + whereis
+ r@ d# 3 rshift d# 40 * +
+ r@ invy !
+ r> invx !
+ else
+ drop
+ then
+;
+
+: bomb ( u -- u ) d# 3 lshift d# 6 + ;
+: shot ( u -- u ) d# 3 lshift d# 7 + ;
+
+8 array lowest
+
+: findlowest
+ d# 8 0do d# -1 i lowest ! loop
+ d# 48 0do
+ i alive @ if
+ i dup d# 7 and lowest !
+ then
+ loop
+;
+
+create bias 0 , 1 , 2 , 3 , 4 , 5 , 0 , 5 ,
+: rand6
+ time @ d# 7 and cells bias + @
+;
+
+2variable bombalarm
+variable nextbomb
+
+2variable shotalarm
+variable nextshot
+
+variable playerx
+variable lives
+2variable score
+variable dying
+
+32 constant girth
+
+: 1+mod6 ( a )
+ dup @ dup d# 5 = if d# -5 else d# 1 then + swap ! ;
+
+: .status
+ 'emit @ >r ['] vga-emit 'emit !
+
+ home
+ s" LIVES " type lives @ .
+ d# 38 d# 0 vga-at-xy
+ s" SCORE " type score 2@ <# # # # # # # #> type
+ cr
+
+ lives @ 0= if
+ ['] vga-bigemit 'emit !
+ d# 8 d# 7 vga-at-xy s" GAME" type
+ d# 8 d# 17 vga-at-xy s" OVER" type
+ then
+
+ r> 'emit !
+;
+
+: newlife
+ d# -1 lives +! .status
+ d# 0 dying !
+ d# 100 playerx !
+;
+
+: parabolic ( dx dy i -- ) \ move sprite i in parabolic path
+ >r
+ swap r@ invx +!
+ dying @ d# 3 rshift +
+ r> invy +!
+;
+
+: exploding
+ d# 3 d# -4 d# 48 parabolic
+ d# -3 d# -4 d# 49 parabolic
+ d# -4 d# -3 d# 50 parabolic
+ d# 4 d# -3 d# 51 parabolic
+ d# -5 d# -2 d# 52 parabolic
+ d# 5 d# -2 d# 53 parabolic
+ d# 1 d# -2 d# 55 parabolic
+;
+
+: @xy ( i -- x y )
+ dup invx @ swap invy @ ;
+
+: dist ( u1 u2 )
+ invert + dup 0< xor ;
+
+: fall
+ d# 6 0do
+ i bomb
+ d# 4 over invy +!
+ @xy d# 470 dist d# 16 < swap
+ playerx @ dist girth < and
+ dying @ 0= and if
+ d# 1 dying !
+ then
+ loop
+;
+
+: trigger \ if shotalarm expired, launch new shot
+ shotalarm isalarm if
+ d# 400000. shotalarm setalarm
+ playerx @ d# 480
+ nextshot @ shot born
+ nextshot 1+mod6
+ then
+;
+
+: collide ( x y -- u )
+ d# 48 0do
+ i isalien i alive @ and if
+ over i invx @ dist d# 16 <
+ over i invy @ dist d# 16 < and if
+ 2drop i unloop exit
+ then
+ then
+ loop
+ 2drop
+ d# -1
+;
+
+: rise
+ d# 6 0do
+ i shot >r r@ alive @ if
+ d# -5 r@ invy +!
+ r@ invy @ d# -30 < if r@ kill then
+ r@ @xy collide dup 0< if
+ drop
+ else
+ kill r@ kill
+ d# 10. score 2@ d+ score 2!
+ .status
+ then
+ then
+ r> drop
+ loop
+;
+
+: doplayer
+ lives @ if
+ dying @ 0= if
+ buttons >r
+
+ girth 2/ playerx @ <
+ r@ pb2 and and if
+ d# -4 playerx +!
+ then
+
+ playerx @ d# 800 girth 2/ - <
+ r@ pb3 and and if
+ d# 4 playerx +!
+ then
+
+ r> pb4 and if
+ trigger
+ \ else trigger
+ then
+
+ d# 6 0do
+ frame @ d# 3 lshift i d# 42 * +
+ girth swap sin* playerx @ +
+ d# 480
+ i d# 48 +
+ dup anim on
+ born
+ loop
+ playerx @ d# 470 d# 55 born
+ else
+ exploding
+ d# 1 dying +!
+ dying @ d# 100 > if
+ newlife
+ then
+ then
+ then
+;
+
+create cscheme
+ h# 400 ,
+ h# 440 ,
+ h# 040 ,
+ h# 044 ,
+ h# 004 ,
+ h# 404 ,
+ h# 340 ,
+ h# 444 ,
+
+: invaders-cold
+ vga-page
+ d# 16384 0do
+ h# 208000. 2/ i s>d d+ flash@
+ i vga_spritea ! vga_spriteport !
+ loop
+
+ vga_addsprites on
+ rainbow
+
+ \ vga_spritep d# 6 cells + on
+
+ \ everything dead
+ nsprites 0do
+ i kill
+ loop
+
+ \ all aliens alive
+ d# 48 0do
+ i isalien i alive !
+ loop
+
+ d# 500000. bombalarm setalarm
+ d# 0 nextbomb !
+ d# 100000. shotalarm setalarm
+ d# 0 nextshot !
+ d# 4 lives !
+ d# 0. score 2!
+
+ newlife
+
+ time@ xor seed !
+ d# 0 frame !
+ d# 48 0do i moveto loop
+;
+
+0 [IF]
+: escape
+ vision isalarm next? or ;
+: restart
+ vision isalarm sw2_n @ 0= or ;
+[ELSE]
+: escape
+ next? ;
+: restart
+ sw2_n @ 0= ;
+[THEN]
+
+: gameloop
+ invaders-cold
+ begin
+depth if snap then
+ inv-makedl
+depth if snap then
+ inv-chase
+depth if snap then
+ frame @ 1+ frame !
+ d# 48 0do i moveto loop
+ findlowest
+ bombalarm isalarm if
+ d# 800000. bombalarm setalarm
+ rand6 lowest @ dup 0< if
+ drop
+ else
+ dup invx @ swap invy @
+ dup d# 460 > if d# 1 dying ! then
+ nextbomb @ bomb born
+ nextbomb 1+mod6
+ then
+ then
+depth if snap then
+ fall
+depth if snap then
+ rise
+depth if snap then
+ doplayer
+depth if snap then
+ escape if exit then
+ again
+;
+
+: invaders-main
+ invaders-cold
+ d# 9000000. vision setalarm
+
+ gameloop
+ snap
+
+ frame @ . s" frames" type cr
+;
+
diff --git a/docs/j1demo/firmware/ip.fs b/docs/j1demo/firmware/ip.fs
new file mode 100644
index 0000000..7c66137
--- /dev/null
+++ b/docs/j1demo/firmware/ip.fs
@@ -0,0 +1,124 @@
+( IP networking: headers and wrapup JCB 13:21 08/24/10)
+module[ ip"
+
+: ip-datalength ( -- u ) \ length of current IP packet in words
+ ETH.IP.LENGTH packet@
+ d# 20 - 2/
+;
+
+: ip-isproto ( u -- f ) \ true if packet PROTO is u
+ ETH.IP.TTLPROTO packet@ h# ff and =
+;
+
+: ip-identification
+ ip-id-counter d# 1 over +! @
+;
+
+: @ethaddr ( eth-addr -- mac01 mac23 mac45 )
+ ?dup
+ if
+ dup @ swap 2+ 2@
+ else
+ ethaddr-broadcast
+ then
+;
+
+: ip-header ( dst-ip src-ip eth-addr protocol -- )
+ >r
+ mac-pkt-begin
+
+ @ethaddr mac-pkt-3,
+ net-my-mac mac-pkt-3,
+ h# 800 mac-pkt-,
+
+ h# 4500
+ h# 0000 \ length
+ ip-identification
+ mac-pkt-3,
+ h# 4000 \ do not fragment
+ h# 4000 r> or \ TTL, protocol
+ d# 0 \ checksum
+ mac-pkt-3,
+ mac-pkt-2, \ src ip
+ mac-pkt-2, \ dst ip
+;
+
+: ip-wrapup ( bytelen -- )
+ \ write IP length
+ ETH.IP -
+ ETH.IP.LENGTH packetout-off mac!
+
+ \ write IP checksum
+ ETH.IP packetout-off d# 10 mac-checksum
+ ETH.IP.CHKSUM packetout-off mac!
+;
+
+: ip-packet-srcip
+ d# 2 ETH.IP.SRCIP mac-inoffset mac@n
+;
+
+( ICMP return and originate JCB 13:22 08/24/10)
+
+\ Someone pings us, generate a return packet
+
+: icmp-handler
+ IP_PROTO_ICMP ip-isproto
+ ETH.IP.ICMP.TYPECODE packet@ h# 800 =
+ and if
+ ip-packet-srcip
+ 2dup arp-lookup
+ ?dup if
+ \ transmit ICMP reply
+ \ dstip *ethaddr
+ net-my-ip rot \ dstip srcip *ethaddr
+ d# 1 ip-header
+
+ \ Now the ICMP header
+ d# 0 mac-pkt-,
+
+ s" =====> ICMP seq " type
+ ETH.IP.ICMP.SEQUENCE mac-inoffset mac@ u. cr
+
+ ETH.IP.ICMP.IDENTIFIER mac-inoffset
+ ip-datalength 2- ( offset n )
+ tuck
+ mac-checksum mac-pkt-,
+ ETH.IP.ICMP.IDENTIFIER mac-pkt-src
+
+ mac-pkt-complete
+ ip-wrapup
+ mac-send
+ else
+ 2drop
+ then
+ then
+;
+
+: ping ( ip. -- ) \ originate
+ 2dup arp-lookup
+ ?dup if
+ \ transmit ICMP request
+ \ dstip *ethaddr
+ net-my-ip rot \ dstip srcip *ethaddr
+ d# 1 ip-header
+
+ \ Now the ICMP header
+ h# 800 mac-pkt-,
+
+ \ id is h# 550b, seq is lo word of time
+ h# 550b time@ drop
+ 2dup +1c h# 800 +1c
+ d# 28 begin swap d# 0 +1c swap 1- dup 0= until drop
+ invert mac-pkt-, \ checksum
+ mac-pkt-2,
+ d# 28 mac-pkt-,0
+
+ mac-pkt-complete
+ ip-wrapup
+ mac-send
+ else
+ 2drop
+ then
+;
+
+]module
diff --git a/docs/j1demo/firmware/ip0.fs b/docs/j1demo/firmware/ip0.fs
new file mode 100644
index 0000000..1631d5f
--- /dev/null
+++ b/docs/j1demo/firmware/ip0.fs
@@ -0,0 +1,70 @@
+( Variables for IP networking JCB 13:21 08/24/10)
+
+module[ ip0"
+create ip-id-counter d# 2 allot
+create ip-addr d# 4 allot
+create ip-router d# 4 allot
+create ip-subnetmask d# 4 allot
+create ip-dns d# 4 allot
+create icmp-alarm-ptr d# 1 allot
+
+: ethaddr-broadcast
+ h# ffff dup dup
+;
+
+: net-my-ip
+ ip-addr 2@
+;
+
+: ethaddr-pretty-w
+ dup endian hex2
+ [char] : emit
+ hex2
+;
+
+: ethaddr-pretty
+ swap rot
+ ethaddr-pretty-w [char] : emit
+ ethaddr-pretty-w [char] : emit
+ ethaddr-pretty-w
+;
+
+: ip-pretty-byte
+ h# ff and
+ \ d# 0 u.r
+ hex2
+;
+
+: ip-pretty-2
+ dup swab ip-pretty-byte [char] . emit ip-pretty-byte
+;
+
+: ip-pretty
+ swap
+ ip-pretty-2 [char] . emit
+ ip-pretty-2
+;
+
+( IP address literals JCB 14:30 10/26/10)
+
+================================================================
+
+It is neat to write IP address literals e.g.
+ip# 192.168.0.1
+
+================================================================
+
+meta
+
+: octet# ( c -- u ) 0. rot parse >number throw 2drop ;
+
+: ip#
+ [char] . octet# 8 lshift
+ [char] . octet# or do-number
+ [char] . octet# 8 lshift
+ bl octet# or do-number
+;
+
+target
+
+]module
diff --git a/docs/j1demo/firmware/j1.png b/docs/j1demo/firmware/j1.png
new file mode 100644
index 0000000..552f8d3
--- /dev/null
+++ b/docs/j1demo/firmware/j1.png
Binary files differ
diff --git a/docs/j1demo/firmware/keycodes.fs b/docs/j1demo/firmware/keycodes.fs
new file mode 100644
index 0000000..bd9b814
--- /dev/null
+++ b/docs/j1demo/firmware/keycodes.fs
@@ -0,0 +1,28 @@
+9 constant TAB
+10 constant ENTER
+27 constant ESC
+
+h# 80 constant KDEL
+
+h# 81 constant KF1
+h# 82 constant KF2
+h# 83 constant KF3
+h# 84 constant KF4
+h# 85 constant KF5
+h# 86 constant KF6
+h# 87 constant KF7
+h# 88 constant KF8
+h# 89 constant KF9
+h# 8a constant KF10
+h# 8b constant KF11
+h# 8c constant KF12
+
+h# 90 constant KHOME
+h# 91 constant KPGUP
+h# 92 constant KPGDN
+h# 93 constant KEND
+h# 94 constant KLEFT
+h# 95 constant KRIGHT
+h# 96 constant KUP
+h# 97 constant KDOWN
+h# 98 constant KINS
diff --git a/docs/j1demo/firmware/loader.fs b/docs/j1demo/firmware/loader.fs
new file mode 100644
index 0000000..d4ae725
--- /dev/null
+++ b/docs/j1demo/firmware/loader.fs
@@ -0,0 +1,114 @@
+( LOADER PROTOCOL JCB 09:16 11/11/10)
+
+947 constant PORT
+
+: response0 ( -- )
+ ETH.IP.UDP.SOURCEPORT packet@
+ PORT
+ d# 2 ETH.IP.SRCIP mac-inoffset mac@n
+ net-my-ip
+ 2over arp-lookup
+ ( dst-port src-port dst-ip src-ip *ethaddr )
+ udp-header
+ d# 0 mac-pkt-,
+ ETH.IP.UDP.LOADER.SEQNO packet@ mac-pkt-,
+;
+
+: response1
+ udp-wrapup mac-send
+;
+
+: respond
+ response0
+ response1
+;
+
+: ramread
+ response0
+ ETH.IP.UDP.LOADER.RAMREAD.ADDR packet@
+ d# 128 bounds begin
+ dup @ mac-pkt-,
+ cell+
+ 2dup=
+ until
+ 2drop
+ response1
+;
+
+: ramwrite
+ ETH.IP.UDP.LOADER.RAMWRITE.ADDR packet@
+ d# 64 0do
+ ETH.IP.UDP.LOADER.RAMWRITE.DATA i cells + packet@
+ over !
+ cell+
+ loop
+ drop
+ respond
+;
+
+: reboot
+ respond bootloader ;
+
+: flashread
+ response0
+ ETH.IP.UDP.LOADER.FLASHREAD.ADDR packetd@ d2/
+ flash-reset
+ d# 64 0do
+ 2dup flash@
+ mac-pkt-,
+ d1+
+ loop
+ 2drop
+ response1
+;
+
+: flasherase
+ respond flash-chiperase ;
+
+: flashdone
+ response0
+ ETH.IP.UDP.LOADER.FLASHREAD.ADDR packetd@ d2/
+ flash-erased mac-pkt-,
+ response1
+;
+
+: flashwrite
+ ETH.IP.UDP.LOADER.FLASHWRITE.ADDR packetd@ d2/
+ d# 64 0do
+ 2dup
+ ETH.IP.UDP.LOADER.FLASHWRITE.DATA i cells + packet@
+ -rot flash!
+ d1+
+ loop
+ 2drop
+ respond
+;
+
+: flashsectorerase
+ ETH.IP.UDP.LOADER.FLASHWRITE.ADDR packetd@ d2/
+ flash-sectorerase
+ respond
+;
+
+jumptable opcodes
+( 0 ) | ramread
+( 1 ) | ramwrite
+( 2 ) | reboot
+( 3 ) | flashread
+( 4 ) | flasherase
+( 5 ) | flashdone
+( 6 ) | flashwrite
+( 7 ) | flashsectorerase
+
+: loader-handler ( -- )
+ IP_PROTO_UDP ip-isproto if
+ ETH.IP.UDP.DESTPORT packet@ PORT =
+ d# 2 ETH.IP.SRCIP mac-inoffset mac@n arp-lookup 0<> and if
+ udp-checksum? if
+ ETH.IP.UDP.LOADER.OPCODE packet@
+ \ s" loader opcode=" type dup hex4 cr
+ opcodes execute
+ then
+ then
+ then
+;
diff --git a/docs/j1demo/firmware/main.fs b/docs/j1demo/firmware/main.fs
new file mode 100644
index 0000000..16e4cf5
--- /dev/null
+++ b/docs/j1demo/firmware/main.fs
@@ -0,0 +1,799 @@
+( Main for WGE firmware JCB 13:24 08/24/10)
+
+\ warnings off
+\ require tags.fs
+
+include crossj1.fs
+meta
+ : TARGET? 1 ;
+ : build-debug? 1 ;
+
+include basewords.fs
+target
+include hwdefs.fs
+
+0 [IF]
+ h# 1f80 org
+ \ the RAM Bootloader copies 2000-3f80 to 0-1f80, then branches to zero
+ : bootloader
+ h# 1f80 h# 0
+ begin
+ 2dupxor
+ while
+ dup h# 2000 + @
+ over !
+ d# 2 +
+ repeat
+
+ begin dsp h# ff and while drop repeat
+ d# 0 >r
+ ;
+[ELSE]
+ h# 3f80 org
+ \ the Flash Bootloader copies 0x190000 to 0-3f80, then branches to zero
+ : bootloader
+ h# c flash_a_hi !
+ h# 0 begin
+ dup h# 8000 + flash_a !
+ d# 0 flash_oe_n !
+ flash_d @
+ d# 1 flash_oe_n !
+ over dup + !
+ d# 1 +
+ dup h# 1fc0 =
+ until
+
+ begin dsp h# ff and while drop repeat
+ d# 0 >r
+ ;
+[THEN]
+
+4 org
+module[ everything"
+include nuc.fs
+
+include version.fs
+
+\ 33333333 / 115200 = 289, half cycle is 144
+
+: pause144
+ d# 0 d# 45
+ begin
+ 1-
+ 2dup=
+ until
+ 2drop
+;
+
+: serout ( u -- )
+ h# 300 or \ 1 stop bits
+ 2* \ 0 start bit
+ \ Start bit
+ begin
+ dup RS232_TXD ! 2/
+ pause144
+ pause144
+ dup 0=
+ until
+ drop
+ pause144 pause144
+ pause144 pause144
+;
+
+: frac ( ud u -- d1 u1 ) \ d1+u1 is ud
+ >r 2dup d# 1 r@ m*/ 2swap 2over r> d# 1 m*/ d- drop ;
+: .2 s>d <# # # #> type ;
+: build.
+ decimal
+ builddate drop
+ [ -8 3600 * ] literal s>d d+
+ d# 1 d# 60 m*/mod >r
+ d# 1 d# 60 m*/mod >r
+ d# 1 d# 24 m*/mod >r
+ 2drop
+ r> .2 [char] : emit
+ r> .2 [char] : emit
+ r> .2 ;
+
+: net-my-mac h# 1234 h# 5677 h# 7777 ;
+
+include doc.fs
+include time.fs
+include eth-ax88796.fs
+include packet.fs
+include ip0.fs
+include defines_tcpip.fs
+include defines_tcpip2.fs
+include arp.fs
+include ip.fs
+include udp.fs
+include dhcp.fs
+
+code in end-code
+: on ( a -- ) d# 1 swap ! ;
+code out end-code
+: off ( a -- ) d# 0 swap ! ;
+
+: flash-reset
+ flash_rst_n off
+ flash_rst_n on
+;
+
+: flash-cold
+ flash_ddir on
+ flash_ce_n off
+ flash_oe_n on
+ flash_we_n on
+ flash_byte_n on
+ flash_rdy on
+ flash-reset
+;
+
+: flash-w ( u a -- )
+ flash_a !
+ flash_d !
+ flash_ddir off
+ flash_we_n off
+ flash_we_n on
+ flash_ddir on
+;
+
+: flash-r ( a -- u )
+ flash_a !
+ flash_oe_n off
+ flash_d @
+ flash_oe_n on
+;
+
+: flash-unlock ( -- )
+ h# aa h# 555 flash-w
+ h# 55 h# 2aa flash-w
+;
+
+: flash! ( u da. -- )
+ flash-unlock
+ h# a0 h# 555 flash-w
+ flash_a 2+ ! ( u a )
+ 2dup ( u a u a)
+ flash-w ( u a )
+ begin
+ 2dup flash-r xor
+ h# 80 and 0=
+ until
+ 2drop
+ flash-reset
+;
+
+: flash@ ( da. -- u )
+ flash_a 2+ ! ( u a )
+ flash-r
+;
+
+: flash-chiperase
+ flash-unlock
+ h# 80 h# 555 flash-w
+ h# aa h# 555 flash-w
+ h# 55 h# 2aa flash-w
+ h# 10 h# 555 flash-w
+;
+
+: flash-sectorerase ( da -- ) \ erase one sector
+ flash-unlock
+ h# 80 h# 555 flash-w
+ h# aa h# 555 flash-w
+ h# 55 h# 2aa flash-w
+ flash_a 2+ ! h# 30 swap flash-w
+;
+
+: flash-erased ( a -- f )
+ flash@ h# 80 and 0<> ;
+
+: flash-dump ( da u -- )
+ 0do
+ 2dup flash@ hex4 space
+ d1+
+ loop cr
+ 2drop
+;
+
+: flashc@
+ over d# 15 lshift flash_d !
+ d2/ flash@
+;
+
+: flash-bytes
+ s" BYTES: " type
+ flash_byte_n off
+ h# 0.
+ d# 1024 0do
+ i d# 15 and 0= if
+ cr
+ 2dup hex8 space space
+ then
+ 2dup flashc@ hex2 space
+ d1+
+ loop cr
+ 2drop
+ flash_byte_n on
+;
+
+0 [IF]
+: flash-demo
+ flash-unlock
+ h# 90 h# 555 flash-w
+ h# 00 flash-r hex4 cr
+ flash-reset
+
+ false if
+ flash-unlock
+ h# a0 h# 555 flash-w
+ h# 0947 h# 5 flash-w
+ sleep1
+ flash-reset
+ then
+
+ \ h# dead d# 11. flash!
+
+ h# 100 0do
+ i flash-r hex4 space
+ loop cr
+ cr cr
+ d# 0. h# 80 flash-dump
+ cr cr
+
+ flash-bytes
+
+ exit
+ flash-unlock
+ h# 80 h# 555 flash-w
+ h# aa h# 555 flash-w
+ h# 55 h# 2aa flash-w
+ h# 10 h# 555 flash-w
+ s" waiting for erase" type cr
+ begin
+ h# 0 flash-r dup hex4 cr
+ h# 80 and
+ until
+
+ h# 100 0do
+ i flash-r hex4 space
+ loop cr
+;
+[THEN]
+
+include sprite.fs
+
+variable cursory \ ptr to start of line in video memory
+variable cursorx \ offset to char
+
+64 constant width
+50 constant wrapcolumn
+
+: vga-at-xy ( u1 u2 )
+ cursory !
+ cursorx !
+;
+
+: home d# 0 vga_scroll ! d# 0 d# 0 vga-at-xy ;
+
+: vga-line ( -- a ) \ address of current line
+ cursory @ vga_scroll @ + d# 31 and d# 6 lshift
+ h# 8000 or
+;
+
+: vga-erase ( a u -- )
+ bounds begin
+ 2dupxor
+ while
+ h# 00 over ! 1+
+ repeat 2drop
+;
+
+: vga-page
+ home vga-line d# 2048 vga-erase
+ hide
+;
+
+: down1
+ cursory @ d# 31 <> if
+ d# 1 cursory +!
+ else
+ false if
+ d# 1 vga_scroll +!
+ vga-line width vga-erase
+ else
+ home
+ then
+ then
+;
+
+: vga-emit ( c -- )
+ dup d# 13 = if
+ drop d# 0 cursorx !
+ else
+ dup d# 10 = if
+ drop down1
+ else
+ d# -32 +
+ vga-line cursorx @ + !
+ d# 1 cursorx +!
+ cursorx @ wrapcolumn = if
+ d# 0 cursorx !
+ down1
+ then
+ then
+ then
+;
+
+: flash>ram ( d. a -- ) \ copy 2K from flash d to a
+ >r d2/ r>
+ d# 1024 0do
+ >r
+ 2dup flash@
+ r> ( d. u a )
+ over swab over !
+ 1+
+ tuck !
+ 1+
+ >r d1+ r>
+ loop
+ drop 2drop
+;
+
+: vga-cold
+ h# f800 h# f000 do
+ d# 0 i !
+ loop
+
+ vga-page
+
+ \ pic: Copy 2048 bytes from 180000 to 8000
+ \ chr: Copy 2048 bytes from 180800 to f000
+ h# 180000. h# 8000 flash>ram
+ h# 180800. h# f000 flash>ram
+
+ \ ['] vga-emit 'emit !
+;
+
+create glyph 8 allot
+: wide1 ( c -- )
+ swab
+ d# 8 0do
+ dup 0<
+ if d# 127 else sp then
+ \ if [char] * else [char] . then
+ vga-emit
+ 2*
+ loop drop
+;
+
+: vga-bigemit ( c -- )
+ dup d# 13 = if
+ drop d# 0 cursorx !
+ else
+ dup d# 10 = if
+ drop d# 8 0do down1 loop
+ else
+ sp - d# 8 * s>d
+ h# 00180800. d+ d2/
+ d# 4 0do
+ 2dup flash@ swab
+ i cells glyph + !
+ d1+
+ loop 2drop
+
+ d# 7 0do
+ i glyph + c@ wide1
+ d# -8 cursorx +! down1
+ loop
+ d# 7 glyph + c@ wide1
+
+ d# -7 cursory +!
+ then
+ then
+;
+
+( Demo utilities JCB 10:56 12/05/10)
+
+: statusline ( a u -- ) \ display string on the status line
+ d# 0 d# 31 2dup vga-at-xy
+ d# 50 spaces
+ vga-at-xy type
+;
+
+( Game stuff JCB 15:20 11/15/10)
+
+variable seed
+: random ( -- u )
+ seed @ d# 23947 * d# 57711 xor dup seed ! ;
+
+
+\ Each line is 20.8 us, so 1000 instructions
+
+include sincos.fs
+
+( Stars JCB 15:23 11/15/10)
+
+2variable vision
+variable frame
+128 constant nstars
+create stars 1024 allot
+
+: star 2* cells stars + ;
+: 15.* m* d2* nip ;
+
+\ >>> math.cos(math.pi / 180) * 32767
+\ 32762.009427189474
+\ >>> math.sin(math.pi / 180) * 32767
+\ 571.8630017304688
+
+[ pi 128e0 f/ fcos 32767e0 f* f>d drop ] constant COSa
+[ pi 128e0 f/ fsin 32767e0 f* f>d drop ] constant SINa
+
+: rotate ( i -- ) \ rotate star i
+ star dup 2@ ( x y )
+ over SINa 15.* over COSa 15.* + >r
+ swap COSa 15.* swap SINa 15.* - r>
+ rot 2!
+;
+
+: rotateall
+ d# 256 0do i rotate loop ;
+
+: scatterR
+ nstars 0do
+ random d# 0 i star 2!
+ rotateall
+ rotateall
+ rotateall
+ rotateall
+ loop
+;
+
+: scatterSpiral
+ nstars 0do
+ i d# 3 and 1+ d# 8000 *
+ d# 0 i star 2!
+ rotateall
+ rotateall
+ rotateall
+ rotateall
+ loop
+;
+
+: scatter
+ nstars 0do
+ \ d# 0 random
+ d# 0 i sin
+ i star 2!
+ i random d# 255 and 0do
+ dup rotate
+ loop drop
+ loop
+;
+
+: /128 dup 0< h# fe00 and swap d# 7 rshift or ;
+: tx /128 [ 400 ] literal + ;
+: ty /128 [ 256 ] literal + ;
+
+: plot ( i s ) \ plot star i in sprite s
+ >r
+ dup star @ tx swap d# 2 lshift
+ r> sprite!
+;
+
+( Display list JCB 16:10 11/15/10)
+
+create dl 1026 allot
+
+: erasedl
+ dl d# 1024 bounds begin
+ d# -1 over !
+ cell+ 2dup=
+ until 2drop
+;
+
+: makedl
+ erasedl
+
+ nstars 0do
+ i d# 2 lshift
+ cells dl +
+ \ cell occupied, use one below
+ \ dup @ 0< invert if cell+ then
+ i swap !
+ loop
+;
+
+variable lastsp
+: stars-chasebeam
+ hide
+ d# 0 lastsp !
+ d# 512 0do
+ begin vga-line@ i = until
+ i cells dl + @ dup 0< if
+ drop
+ else
+ lastsp @ 1+ d# 7 and dup lastsp ! plot
+ then
+ i nstars < if i rotate then
+ loop
+;
+
+
+
+: loadcolors
+ d# 8 0do
+ dup @
+ i cells vga_spritec + !
+ cell+
+ loop
+ drop
+;
+create cpastels
+h# 423 ,
+h# 243 ,
+h# 234 ,
+h# 444 ,
+h# 324 ,
+h# 432 ,
+h# 342 ,
+h# 244 ,
+: pastels cpastels loadcolors ;
+
+create crainbow
+h# 400 ,
+h# 440 ,
+h# 040 ,
+h# 044 ,
+h# 004 ,
+h# 404 ,
+h# 444 ,
+h# 444 ,
+: rainbow crainbow loadcolors ;
+
+variable prev_sw3_n
+
+: next? ( -- f ) \ has user requested next screen
+ sw3_n @ prev_sw3_n fall?
+;
+
+: loadsprites ( da -- )
+ 2/
+ d# 16384 0do
+ 2dup i s>d d+ flash@
+ i vga_spritea ! vga_spriteport !
+ loop
+ 2drop
+;
+
+: stars-main
+ vga-page
+ d# 16384 0do
+ h# 204000. 2/ i s>d d+ flash@
+ i vga_spritea ! vga_spriteport !
+ loop
+
+ vga_addsprites on
+ rainbow
+
+ time@ xor seed !
+ seed off
+ scatter
+
+ d# 7000000. vision setalarm
+ d# 0 frame !
+ begin
+ makedl
+ stars-chasebeam
+ \ d# 256 0do i i plot loop
+ \ rotateall
+ frame @ 1+ frame !
+ next?
+ until
+ frame @ . s" frames" type cr
+;
+
+: buttons ( -- u ) \ pb4 pb3 pb2
+ pb_a_dir on
+ pb_a @ d# 7 xor
+ pb_a_dir off
+;
+
+include loader.fs
+include dns.fs
+
+: preip-handler
+ begin
+ mac-fullness
+ while
+ OFFSET_ETH_TYPE packet@ h# 800 = if
+ dhcp-wait-offer
+ then
+ mac-consume
+ repeat
+;
+
+: haveip-handler
+ \ time@ begin ether_irq @ until time@ 2swap d- d. cr
+ \ begin ether_irq @ until
+ begin
+ mac-fullness
+ while
+ arp-handler
+ OFFSET_ETH_TYPE packet@ h# 800 =
+ if
+ d# 2 OFFSET_IP_DSTIP mac-inoffset mac@n net-my-ip d=
+ if
+ icmp-handler
+ then
+ loader-handler
+ then
+ depth if .s cr then
+ mac-consume
+ repeat
+;
+
+include invaders.fs
+
+: uptime
+ time@
+ d# 1 d# 1000 m*/
+ d# 1 d# 1000 m*/
+;
+
+( IP address formatting JCB 14:50 10/26/10)
+
+: #ip1 h# ff and s>d #s 2drop ;
+: #. [char] . hold ;
+: #ip2 dup #ip1 #. d# 8 rshift #ip1 ;
+: #ip ( ip -- c-addr u) dup #ip2 #. over #ip2 ;
+
+variable prev_sw2_n
+: sw2? sw2_n @ prev_sw2_n fall? ;
+
+include ps2kb.fs
+
+: istab?
+ key? dup if key TAB = and then
+;
+
+: welcome-main
+ vga-cold
+ home
+ s" F1 to set up network, TAB for next demo" statusline
+
+ rainbow
+ h# 200000. loadsprites
+ 'emit @ >r
+ d# 6 d# 26 vga-at-xy s" Softcore Forth CPU" type
+
+ d# 32 d# 6 vga-at-xy s" version " type version type
+ d# 32 d# 8 vga-at-xy s" built " type build.
+
+ kb-cold
+ home
+ begin
+ kbfifo-proc
+ d# 32 d# 10 vga-at-xy net-my-ip <# #ip #> type space space
+ d# 32 d# 12 vga-at-xy s" uptime " type uptime d.
+ haveip-handler
+
+ d# 8 0do
+ frame @ i d# 32 * + invert >r
+ d# 100 r@ sin* d# 600 +
+ d# 100 r> cos* d# 334 +
+ i sprite!
+ loop
+
+ waitblank
+ d# 1 frame +!
+ next?
+ istab? or
+ until
+ r> 'emit !
+;
+
+include clock.fs
+
+: frob
+ flash_ce_n on
+ flash_ddir off
+ d# 32 0do
+ d# 1 i d# 7 and lshift
+ flash_d !
+ d# 30000. sleepus
+ loop
+ flash_ddir on
+;
+
+: main
+ decimal
+ ['] serout 'emit !
+ \ sleep1
+
+ frob
+
+ d# 60 0do cr loop
+ s" Welcome! Built " type build. cr
+ snap
+
+ flash-cold
+ \ flash-demo
+ \ flash-bytes
+ vga-cold
+ ['] vga-emit 'emit !
+ s" Waiting for Ethernet NIC" statusline
+ mac-cold
+ nicwork
+ h# decafbad. dhcp-xid!
+ d# 3000000. dhcp-alarm setalarm
+ false if
+ ip-addr dz
+ begin
+ net-my-ip d0=
+ while
+ dhcp-alarm isalarm if
+ dhcp-discover
+ s" DISCOVER" type cr
+ d# 3000000. dhcp-alarm setalarm
+ then
+ preip-handler
+ repeat
+ else
+ ip# 192.168.0.99 ip-addr 2!
+ ip# 255.255.255.0 ip-subnetmask 2!
+ ip# 192.168.0.1 ip-router 2!
+ \ ip# 192.168.2.201 ip-addr 2!
+ \ ip# 255.255.255.0 ip-subnetmask 2!
+ \ ip# 192.168.2.1 ip-router 2!
+ then
+ dhcp-status
+ arp-reset
+
+ begin
+ welcome-main sleep.1
+ clock-main sleep.1
+ stars-main sleep.1
+ invaders-main sleep.1
+ s" looping" type cr
+ again
+
+ begin
+ haveip-handler
+ again
+;
+
+
+]module
+
+0 org
+
+code 0jump
+ \ h# 3e00 ubranch
+ main ubranch
+ main ubranch
+end-code
+
+meta
+
+hex
+
+: create-output-file w/o create-file throw to outfile ;
+
+\ .mem is a memory dump formatted for use with the Xilinx
+\ data2mem tool.
+s" j1.mem" create-output-file
+:noname
+ s" @ 20000" type cr
+ 4000 0 do i t@ s>d <# # # # # #> type cr 2 +loop
+; execute
+
+\ .bin is a big-endian binary memory dump
+s" j1.bin" create-output-file
+:noname 4000 0 do i t@ dup 8 rshift emit emit 2 +loop ; execute
+
+\ .lst file is a human-readable disassembly
+s" j1.lst" create-output-file
+d# 0
+h# 2000 disassemble-block
diff --git a/docs/j1demo/firmware/mkblob.py b/docs/j1demo/firmware/mkblob.py
new file mode 100644
index 0000000..6623f91
--- /dev/null
+++ b/docs/j1demo/firmware/mkblob.py
@@ -0,0 +1,14 @@
+import Image
+import math
+
+im = Image.new("L", (32,32))
+radius = 16
+for i in range(32):
+ for j in range(32):
+ x = abs(i - 16)
+ y = abs(j - 16)
+ d = math.sqrt(x * x + y * y)
+ if d < radius:
+ t = 1.0 - (d / radius)
+ im.putpixel((i, j), int(255 * (t * t)))
+im.save("blob.png")
diff --git a/docs/j1demo/firmware/ntp.fs b/docs/j1demo/firmware/ntp.fs
new file mode 100644
index 0000000..881296a
--- /dev/null
+++ b/docs/j1demo/firmware/ntp.fs
@@ -0,0 +1,36 @@
+( NTP JCB 09:54 11/17/10)
+
+: ntp-server
+ \ h# 02830a00.
+ \ ip# 91.189.94.4 \ time.ubuntu
+ ip# 17.151.16.20 \ time.apple.com
+;
+
+: ntp-request
+ d# 123 d# 9999
+ ntp-server
+ net-my-ip
+ 2over arp-lookup
+ ( dst-port src-port dst-ip src-ip *ethaddr )
+ udp-header
+ h# 2304 mac-pkt-, h# 04ec mac-pkt-,
+ d# 6 mac-pkt-,0
+
+ d# 4 mac-pkt-,0 \ originate
+ d# 4 mac-pkt-,0 \ reference
+ d# 4 mac-pkt-,0 \ receive
+ \ d# 4 mac-pkt-,0 \ transmit
+ time@ mac-pkt-d, d# 2 mac-pkt-,0
+ udp-wrapup mac-send
+;
+
+: ntp-handler
+ IP_PROTO_UDP ip-isproto
+ ETH.IP.UDP.SOURCEPORT packet@ d# 123 = and
+ ETH.IP.UDP.DESTPORT packet@ d# 9999 = and
+ if
+ ETH.IP.UDP.NTP.TRANSMIT packetd@ setdate
+ time@ ETH.IP.UDP.NTP.ORIGINATE packetd@ d- setdelay
+ then
+;
+
diff --git a/docs/j1demo/firmware/nuc.fs b/docs/j1demo/firmware/nuc.fs
new file mode 100644
index 0000000..deadcc7
--- /dev/null
+++ b/docs/j1demo/firmware/nuc.fs
@@ -0,0 +1,546 @@
+( Nucleus: ANS Forth core and ext words JCB 13:11 08/24/10)
+
+module[ nuc"
+
+32 constant sp
+0 constant false ( 6.2.1485 )
+: depth dsp h# ff and ;
+: true ( 6.2.2298 ) d# -1 ;
+: 1+ d# 1 + ;
+: rot >r swap r> swap ;
+: -rot swap >r swap r> ;
+: 0= d# 0 = ;
+: tuck swap over ;
+: 2drop drop drop ;
+: ?dup dup if dup then ;
+
+: split ( a m -- a&m a&~m )
+ over \ a m a
+ and \ a a&m
+ tuck \ a&m a a&m
+ xor \ a&m a&~m
+;
+
+: merge ( a b m -- m?b:a )
+ >r \ a b
+ over xor \ a a^b
+ r> and \ a (a^b)&m
+ xor \ ((a^b)&m)^a
+;
+
+: c@ dup @ swap d# 1 and if d# 8 rshift else d# 255 and then ;
+: c! ( u c-addr )
+ swap h# ff and dup d# 8 lshift or swap
+ tuck dup @ swap ( c-addr u v c-addr )
+ d# 1 and d# 0 = h# ff xor
+ merge swap !
+;
+: c!be d# 1 xor c! ;
+
+: looptest ( -- FIN )
+ r> ( xt )
+ r> ( xt i )
+ 1+
+ r@ over = ( xt i FIN )
+ dup if
+ nip r> drop
+ else
+ swap >r
+ then ( xt FIN )
+ swap
+ >r
+;
+
+\ Stack
+: 2dup over over ;
+: +! tuck @ + swap ! ;
+
+\ Comparisons
+: <> = invert ;
+: 0<> 0= invert ;
+: 0< d# 0 < ;
+: 0>= 0< invert ;
+: 0> d# 0 ;fallthru
+: > swap < ;
+: >= < invert ;
+: <= > invert ;
+: u> swap u< ;
+
+\ Arithmetic
+: negate invert 1+ ;
+: - negate + ;
+: abs dup 0< if negate then ;
+: min 2dup < ;fallthru
+: ?: ( xt xf f -- xt | xf) if drop else nip then ;
+: max 2dup > ?: ;
+code cells end-code
+code addrcells end-code
+: 2* d# 1 lshift ;
+code cell+ end-code
+code addrcell+ end-code
+: 2+ d# 2 + ;
+: 2- 1- 1- ;
+: 2/ d# 1 rshift ;
+: c+! tuck c@ + swap c! ;
+
+: count dup 1+ swap c@ ;
+: /string dup >r - swap r> + swap ;
+: aligned 1+ h# fffe and ;
+
+: sliteral
+ r>
+ count
+ 2dup
+ +
+ aligned
+;fallthru
+: execute >r ;
+
+: 15down down1 ;fallthru
+: 14down down1 ;fallthru
+: 13down down1 ;fallthru
+: 12down down1 ;fallthru
+: 11down down1 ;fallthru
+: 10down down1 ;fallthru
+: 9down down1 ;fallthru
+: 8down down1 ;fallthru
+: 7down down1 ;fallthru
+: 6down down1 ;fallthru
+: 5down down1 ;fallthru
+: 4down down1 ;fallthru
+: 3down down1 ;fallthru
+: 2down down1 ;fallthru
+: 1down down1 ;fallthru
+: 0down copy ;
+
+: 15up up1 ;fallthru
+: 14up up1 ;fallthru
+: 13up up1 ;fallthru
+: 12up up1 ;fallthru
+: 11up up1 ;fallthru
+: 10up up1 ;fallthru
+: 9up up1 ;fallthru
+: 8up up1 ;fallthru
+: 7up up1 ;fallthru
+: 6up up1 ;fallthru
+: 5up up1 ;fallthru
+: 4up up1 ;fallthru
+: 3up up1 ;fallthru
+: 2up up1 ;fallthru
+: 1up up1 ;fallthru
+: 0up ;
+
+code pickbody
+ copy return
+ 1down scall 1up ubranch
+ 2down scall 2up ubranch
+ 3down scall 3up ubranch
+ 4down scall 4up ubranch
+ 5down scall 5up ubranch
+ 6down scall 6up ubranch
+ 7down scall 7up ubranch
+ 8down scall 8up ubranch
+ 9down scall 9up ubranch
+ 10down scall 10up ubranch
+ 11down scall 11up ubranch
+ 12down scall 12up ubranch
+ 13down scall 13up ubranch
+ 14down scall 14up ubranch
+ 15down scall 15up ubranch
+end-code
+
+: pick
+ dup 2* 2* ['] pickbody + execute ;
+
+: swapdown
+ ]asm
+ N T->N alu
+ T d-1 alu
+ asm[
+;
+: swapdowns
+ swapdown swapdown swapdown swapdown
+ swapdown swapdown swapdown swapdown
+ swapdown swapdown swapdown swapdown
+ swapdown swapdown swapdown swapdown ;fallthru
+: swapdown0 ;
+: roll
+ 2*
+ ['] 0up over - >r
+ ['] swapdown0 swap - execute
+;
+
+\ ========================================================================
+\ Double
+\ ========================================================================
+
+: d= ( a b c d -- f )
+ >r \ a b c
+ rot xor \ b a^c
+ swap r> xor \ a^c b^d
+ or 0=
+;
+
+: 2@ ( ptr -- lo hi )
+ dup @ swap 2+ @
+;
+
+: 2! ( lo hi ptr -- )
+ rot over \ hi ptr lo ptr
+ ! 2+ !
+;
+
+: 2over >r >r 2dup r> r> ;fallthru
+: 2swap rot >r rot r> ;
+: 2nip rot drop rot drop ;
+: 2rot ( d1 d2 d3 -- d2 d3 d1 ) 2>r 2swap 2r> 2swap ;
+: 2pick
+ 2* 1+ dup 1+ \ lo hi ... 2k+1 2k+2
+ pick \ lo hi ... 2k+1 lo
+ swap \ lo hi ... lo 2k+1
+ pick \ lo hi ... lo hi
+;
+
+
+: d+ ( augend . addend . -- sum . )
+ rot + >r ( augend addend)
+ over + ( augend sum)
+ dup rot ( sum sum augend)
+ u< if ( sum)
+ r> 1+
+ else
+ r>
+ then ( sum . )
+;
+
+: +h ( u1 u2 -- u1+u2/2**16 )
+ over + ( a a+b )
+ u> d# 1 and
+;
+
+: +1c \ one's complement add, as in TCP checksum
+ 2dup +h + +
+;
+
+: s>d dup 0< ;
+: d1+ d# 1. d+ ;
+: dnegate
+ invert swap invert swap
+ d1+
+;
+: DABS ( d -- ud ) ( 8.6.1.1160 ) DUP 0< IF DNEGATE THEN ;
+
+: d- dnegate d+ ;
+
+\ Write zero to double
+: dz d# 0 dup rot 2! ;
+
+: dxor \ ( a b c d -- e f )
+ rot xor \ a c b^d
+ -rot xor \ b^d a^c
+ swap
+;
+
+: dand rot and -rot and swap ;
+: dor rot or -rot or swap ;
+
+: dinvert invert swap invert swap ;
+: d< \ ( al ah bl bh -- flag )
+ rot \ al bl bh ah
+ 2dup =
+ if
+ 2drop u<
+ else
+ 2nip >
+ then
+;
+
+: d> 2swap d< ;
+: d0<= d# 0. ;fallthru
+: d<= d> invert ;
+: d>= d< invert ;
+: d0= or 0= ;
+: d0< d# 0. d< ;
+: d0<> d0= invert ;
+: d<> d= invert ;
+: d2* 2dup d+ ;
+: d2/ dup d# 15 lshift >r 2/ swap 2/ r> or swap ;
+: dmax 2over 2over d< if 2swap then 2drop ;
+
+: d1- d# -1. d+ ;
+
+: d+! ( v. addr -- )
+ dup >r
+ 2@
+ d+
+ r>
+ 2!
+;
+
+: move ( addr1 addr2 u -- )
+ d# 0 do
+ over @ over !
+ 2+ swap 2+ swap
+ loop
+ 2drop
+;
+
+: cmove ( c-addr1 c-addr2 u -- )
+ d# 0 do
+ over c@ over c!
+ 1+ swap 1+ swap
+ loop
+ 2drop
+;
+
+: bounds ( a n -- a+n a ) OVER + SWAP ;
+: fill ( c-addr u char -- ) ( 6.1.1540 )
+ >R bounds
+ BEGIN 2dupxor
+ WHILE R@ OVER C! 1+
+ REPEAT R> DROP 2DROP ;
+
+\ Math
+
+0 [IF]
+create scratch d# 2 allot
+: um* ( u1 u2 -- ud )
+ scratch !
+ d# 0.
+ d# 16 0do
+ 2dup d+
+ rot dup 0< if
+ 2* -rot
+ scratch @ d# 0 d+
+ else
+ 2* -rot
+ then
+ loop
+ rot drop
+;
+[ELSE]
+: um* mult_a ! mult_b ! mult_p 2@ ;
+[THEN]
+
+: * um* drop ;
+: abssgn ( a b -- |a| |b| negf )
+ 2dup xor 0< >r abs swap abs swap r> ;
+
+: m* abssgn >r um* r> if dnegate then ;
+
+: divstep
+ ( divisor dq hi )
+ 2*
+ over 0< if 1+ then
+ swap 2* swap
+ rot ( dq hi divisor )
+ 2dup >= if
+ tuck ( dq divisor hi divisor )
+ -
+ swap ( dq hi divisor )
+ rot 1+ ( hi divisor dq )
+ rot ( divisor dq hi )
+ else
+ -rot
+ then
+ ;
+
+: um/mod ( ud u1 -- u2 u3 ) ( 6.1.2370 )
+ -rot
+ divstep divstep divstep divstep
+ divstep divstep divstep divstep
+ divstep divstep divstep divstep
+ divstep divstep divstep divstep
+ rot drop swap
+;
+
+: /mod >R S>D R> ;fallthru
+: SM/REM ( d n -- r q ) ( 6.1.2214 ) ( symmetric )
+ OVER >R >R DABS R@ ABS UM/MOD
+ R> R@ XOR 0< IF NEGATE THEN R> 0< IF >R NEGATE R> THEN ;
+: / /mod nip ;
+: mod /mod drop ;
+: */mod >R M* R> SM/REM ;
+: */ */mod nip ;
+
+: t2* over >r >r d2*
+ r> 2* r> 0< d# 1 and + ;
+
+variable divisor
+: m*/mod
+ divisor !
+ tuck um* 2swap um* ( hi. lo. )
+ ( m0 h l m1 )
+ swap >r d# 0 d+ r> ( m h l )
+ -rot ( l m h )
+ d# 32 0do
+ t2*
+ dup divisor @ >= if
+ divisor @ -
+ rot 1+ -rot
+ then
+ loop
+;
+: m*/ m*/mod drop ;
+
+
+\ Numeric output - from eforth
+
+variable base
+variable hld
+create pad 84 allot create pad|
+
+: <# ( -- ) ( 6.1.0490 )( h# 96 ) pad| HLD ! ;
+: DIGIT ( u -- c ) d# 9 OVER < d# 7 AND + [CHAR] 0 + ;
+: HOLD ( c -- ) ( 6.1.1670 ) HLD @ 1- DUP HLD ! C! ;
+
+: # ( d -- d ) ( 6.1.0030 )
+ d# 0 BASE @ UM/MOD >R BASE @ UM/MOD SWAP DIGIT HOLD R> ;
+
+: #S ( d -- d ) ( 6.1.0050 ) BEGIN # 2DUP OR 0= UNTIL ;
+: #> ( d -- a u ) ( 6.1.0040 ) 2DROP HLD @ pad| OVER - ;
+
+: SIGN ( n -- ) ( 6.1.2210 ) 0< IF [CHAR] - HOLD THEN ;
+
+\ hex(int((1<<24) * (115200 / 2400.) / (WB_CLOCK_FREQ / 2400.)))
+\ d# 42000000 constant WB_CLOCK_FREQ
+
+[ 48000000 17 12 */ ] constant WB_CLOCK_FREQ
+
+0 [IF]
+: uartbase
+ [ $100000000. 115200 WB_CLOCK_FREQ m*/ drop $ffffff00 and dup swap 16 rshift ] 2literal
+;
+: emit-uart
+ begin uart_0 @ 0= until
+ s>d
+ uartbase dor
+ uart_1 ! uart_0 !
+;
+[ELSE]
+: emit-uart drop ;
+[THEN]
+
+create 'emit
+meta emit-uart t, target
+
+: emit 'emit @ execute ;
+: cr d# 13 emit d# 10 emit ;
+d# 32 constant bl
+: space bl emit ;
+: spaces begin dup 0> while space 1- repeat drop ;
+
+: hex1 d# 15 and dup d# 10 < if d# 48 else d# 55 then + emit ;
+: hex2
+ dup
+ d# 4 rshift
+ hex1 hex1
+;
+: hex4
+ dup
+ d# 8 rshift
+ hex2 hex2 ;
+
+: hex8 hex4 hex4 ;
+
+: type
+ d# 0 do
+ dup c@ emit
+ 1+
+ loop
+ drop
+;
+
+: dump
+ ( addr u )
+ 0do
+ dup d# 15 and 0= if dup cr hex4 [char] : emit space space then
+ dup c@ hex2 space 1+
+ loop
+ cr drop
+;
+
+: dump16
+ ( addr u )
+ 0do
+ dup hex4 [char] : emit space dup @ hex4 cr 2+
+ loop
+ drop
+;
+
+: decimal d# 10 base ! ;
+: hex d# 16 base ! ;
+
+: S.R ( a u n -- ) OVER - SPACES TYPE ;
+: D.R ( d n -- ) ( 8.6.1.1070 ) >R DUP >R DABS <# #S R> SIGN #> R> S.R ;
+: U.R ( u n -- ) ( 6.2.2330 ) d# 0 SWAP D.R ;
+: .R ( n n -- ) ( 6.2.0210 ) >R S>D R> D.R ;
+
+: D. ( d -- ) ( 8.6.1.1060 ) d# 0 D.R SPACE ;
+: U. ( u -- ) ( 6.1.2320 ) d# 0 D. ;
+: . ( n -- ) ( 6.1.0180 ) BASE @ d# 10 XOR IF U. EXIT THEN S>D D. ;
+: ? ( a -- ) ( 15.6.1.0600 ) @ . ;
+
+( Numeric input )
+
+: DIGIT? ( c base -- u f ) ( 0xA3 )
+ >R [CHAR] 0 - D# 9 OVER <
+ IF D# 7 - DUP D# 10 < OR THEN DUP R> U< ;
+
+: >number ( ud a u -- ud a u ) ( 6.1.0570 )
+ begin
+ dup 0= if exit then
+ over c@ base @ digit? if
+ >r 2swap
+ drop base @ um*
+ r> s>d d+ 2swap
+ d# 1 /string >number
+ else
+ drop exit
+ then
+ again
+;
+
+: .s
+ [char] < emit
+ depth dup hex2
+ [char] > emit
+
+ d# 8 min
+ ?dup if
+ 0do
+ i pick hex4 space
+ loop
+ then
+;
+
+build-debug? [IF]
+: (assert)
+ s" **** ASSERTION FAILED **** " type
+ ;fallthru
+: (snap)
+ type space
+ s" LINE " type
+ .
+ [char] : emit
+ space
+ .s
+ cr
+;
+[THEN]
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+
+: endian dup d# 8 lshift swap d# 8 rshift or ;
+: 2endian endian swap endian ;
+: swab endian ;
+: typepad ( c-addr u w ) over - >r type r> spaces ;
+: even? d# 1 and 0= ;
+
+\ rise? and fall? act like ! - except that they leave a true
+\ if the value rose or fell, respectively.
+
+: rise? ( u a -- f ) 2dup @ u> >r ! r> ;
+: fall? ( u a -- f ) 2dup @ u< >r ! r> ;
+
+]module
diff --git a/docs/j1demo/firmware/packet.fs b/docs/j1demo/firmware/packet.fs
new file mode 100644
index 0000000..b188cc5
--- /dev/null
+++ b/docs/j1demo/firmware/packet.fs
@@ -0,0 +1,11 @@
+( Packet construction, tx, rx JCB 13:25 08/24/10)
+module[ packet"
+
+: packet@ ( u -- u )
+ mac-inoffset mac@ ;
+
+: packetd@ ( u -- ud )
+ mac-inoffset dup 2+ mac@ swap mac@ ;
+
+
+]module
diff --git a/docs/j1demo/firmware/ps2kb.fs b/docs/j1demo/firmware/ps2kb.fs
new file mode 100644
index 0000000..f151971
--- /dev/null
+++ b/docs/j1demo/firmware/ps2kb.fs
@@ -0,0 +1,434 @@
+( PS/2 keyboard handler JCB 18:29 11/21/10)
+
+================================================================
+
+Keycodes represent raw keypresses. Need to map these to
+ASCII characters. Each key can generate several ASCII
+codes depending on the state of the SHIFT/CTRL keys.
+
+Could use table giving keycode->ascii, but most keys
+generate two codes, so would need word for each.
+Keycodes 00-83. Storage 262 bytes.
+
+Table of N ascii codes, each entry specifies a keycode
+and shift state
+
+================================================================
+
+module[ ps2kb"
+
+meta
+
+create asciikb 144 allot
+asciikb 144 erase
+
+\ 1 word for each key.
+\ if high bit is zero, then
+
+h# 84 constant nscancodes
+create scanmap nscancodes cells allot
+scanmap nscancodes cells 2constant scanmap_
+scanmap_ erase
+
+: scanmap! ( n u -- ) \ write n to cell u in scanmap
+ cells scanmap + !
+;
+
+\ knowkey plain xx f0xx
+\ knowkey-n plain 3x, yy numlock exyy
+\ knowkey-h shift mask yy d0yy
+\ knowkey-s plain xx, shifted^caps yy xxyy
+
+h# f000 constant plainmask
+h# e000 constant numlockmask
+h# d000 constant shiftmask
+
+: wordval bl word count evaluate ;
+
+: knowkey
+ wordval
+ plainmask or
+ swap scanmap!
+;
+: knowkey-s
+ \ dup char asciikb + c!
+ \ 128 or
+ \ char asciikb + c!
+ char 8 lshift char or
+ swap scanmap!
+;
+: knowkey-h
+ wordval shiftmask or
+ swap scanmap!
+;
+: knowkey-n
+ \ dup char asciikb + c!
+ \ 128 or
+ \ char asciikb + c!
+ char [char] . - 8 lshift wordval or
+ numlockmask or
+ swap scanmap!
+;
+
+h# 01 constant SHIFTL
+h# 02 constant SHIFTR
+h# 04 constant CONTROL
+h# 08 constant ALT
+char * constant ASTERISK
+char - constant MINUS
+char + constant PLUS
+char 5 constant FIVE
+
+include keycodes.fs
+
+h# 76 knowkey ESC
+h# 05 knowkey KF1
+h# 06 knowkey KF2
+h# 04 knowkey KF3
+h# 0c knowkey KF4
+h# 03 knowkey KF5
+h# 0b knowkey KF6
+h# 83 knowkey KF7
+h# 0a knowkey KF8
+h# 01 knowkey KF9
+h# 09 knowkey KF10
+h# 78 knowkey KF11
+h# 07 knowkey KF12
+
+h# 0e knowkey-s ` ~
+h# 16 knowkey-s 1 !
+h# 1e knowkey-s 2 @
+h# 26 knowkey-s 3 #
+h# 25 knowkey-s 4 $
+h# 2e knowkey-s 5 %
+h# 36 knowkey-s 6 ^
+h# 3d knowkey-s 7 &
+h# 3e knowkey-s 8 *
+h# 46 knowkey-s 9 (
+h# 45 knowkey-s 0 )
+h# 4e knowkey-s - _
+h# 55 knowkey-s = +
+h# 5d knowkey-s \ |
+h# 66 knowkey KDEL
+
+h# 0d knowkey TAB
+h# 15 knowkey-s q Q
+h# 1d knowkey-s w W
+h# 24 knowkey-s e E
+h# 2d knowkey-s r R
+h# 2c knowkey-s t T
+h# 35 knowkey-s y Y
+h# 3c knowkey-s u U
+h# 43 knowkey-s i I
+h# 44 knowkey-s o O
+h# 4d knowkey-s p P
+h# 54 knowkey-s [ {
+h# 5b knowkey-s ] }
+h# 5a knowkey ENTER
+
+h# 58 knowkey -1
+h# 1c knowkey-s a A
+h# 1b knowkey-s s S
+h# 23 knowkey-s d D
+h# 2b knowkey-s f F
+h# 34 knowkey-s g G
+h# 33 knowkey-s h H
+h# 3b knowkey-s j J
+h# 42 knowkey-s k K
+h# 4b knowkey-s l L
+h# 4c knowkey-s ; :
+h# 52 knowkey-s ' "
+
+h# 1a knowkey-s z Z
+h# 22 knowkey-s x X
+h# 21 knowkey-s c C
+h# 2a knowkey-s v V
+h# 32 knowkey-s b B
+h# 31 knowkey-s n N
+h# 3a knowkey-s m M
+h# 41 knowkey-s , <
+h# 49 knowkey-s . >
+h# 4a knowkey-s / ?
+
+h# 29 knowkey BL
+
+h# 12 knowkey-h SHIFTL
+h# 59 knowkey-h SHIFTR
+h# 14 knowkey-h CONTROL
+h# 11 knowkey-h ALT
+
+h# 70 knowkey-n 0 KINS
+h# 71 knowkey-n . KDEL
+h# 69 knowkey-n 1 KEND
+h# 72 knowkey-n 2 KDOWN
+h# 7a knowkey-n 3 KPGDN
+h# 6b knowkey-n 4 KLEFT
+h# 73 knowkey FIVE
+h# 74 knowkey-n 6 KRIGHT
+h# 6c knowkey-n 7 KHOME
+h# 75 knowkey-n 8 KUP
+h# 7d knowkey-n 9 KPGUP
+h# 77 knowkey -2
+h# 7c knowkey ASTERISK
+h# 7b knowkey MINUS
+h# 79 knowkey PLUS
+
+: t,c ( c-addr u -- ) \ compile u cells into target memory
+ 0 do
+ dup @ t, cell+
+ loop
+ drop
+;
+
+target create scanmap meta
+scanmap nscancodes t,c
+
+target
+
+include keycodes.fs
+
+: scanmap@ ( u - u ) \ return scanmap entry u
+ cells scanmap + @ ;
+
+variable kbread \ read ptr into 64-bit KB fifo
+variable kbstate \ accumulates 11-bit code
+
+: ps2listening
+ ps2_clk_dir in
+ ps2_dat_dir in
+;
+: kbfifo@ ( u -- f ) \ read bit u from 64-bit KB fifo
+ dup d# 4 rshift 2* kbfifo + @
+ swap d# 15 and rshift d# 1 and
+;
+: kbnew ( -- ) \ start accumulating new code
+ h# 800 kbstate !
+;
+: kbfifo-cold
+ kbfifocount @ kbread !
+ kbnew
+;
+: kbfifo-fullness ( -- u ) \ how many unread bits in the kbfifo
+ kbfifocount @ kbread @ - h# ff and
+;
+
+variable ps2_clk'
+: waitfall \ wait for falling edge on ps2_clk
+ begin ps2_clk @ ps2_clk' fall? until ;
+
+: ps2-out1 ( u -- ) \ send lsb of u to keyboard
+ ps2_dat ! waitfall ;
+
+: oddparity ( u1 -- u2 ) \ u2 is odd parity of u1
+ dup d# 4 rshift xor
+ dup d# 2 rshift xor
+ dup 2/ xor
+;
+
+: kb-request
+ ps2_clk_dir out ps2_clk off \ clock low
+ d# 60. sleepus
+ ps2_dat_dir out ps2_dat off \ dat low
+ ps2_clk_dir in \ release clock
+
+ begin ps2_clk @ until
+ ps2_clk' on
+
+ \ bad keyboard hangs here
+ false ps2-out1 \ start
+
+ dup
+ d# 8 0do
+ dup ps2-out1 2/
+ loop
+ drop
+
+ oddparity ps2-out1 \ parity
+ true ps2-out1 \ stop
+
+ ps2listening \ waitfall
+ kbfifo-cold
+;
+
+: kbbit
+ d# 11 lshift kbstate @ 2/ or
+ kbstate !
+;
+: rawready? ( -- f) \ is the raw keycode ready?
+ kbstate @ d# 1 and ;
+
+: kbraw ( -- u ) \ get the current raw keycode
+ kbstate @ d# 2 rshift h# ff and
+ kbnew
+;
+
+variable lock
+
+: rawloop
+ begin
+ kbfifocount @ lock !
+ kbfifo-fullness 0<>
+ rawready? 0= and
+ while
+ kbfifo-fullness 1- kbfifo@
+ kbfifocount @ lock @ = if
+ kbbit d# 1 kbread +!
+ else
+ drop
+ then
+ repeat
+;
+
+: oneraw
+ begin
+ rawloop
+ rawready?
+ until
+ kbraw
+;
+
+: >leds ( u -- ) \ set keyboard leds (CAPS NUM SCROLL)
+ h# ed kb-request
+ oneraw drop
+ kb-request
+;
+
+( Decoding JCB 19:25 12/04/10)
+
+variable capslock
+variable numlock
+variable isrelease \ is this is key release
+variable ise0 \ is this an E0-prefix key
+0 value mods \ bitmask of modifier keys
+ \ RALT RCTRL -- -- LALT LCTRL RSHIFT LSHIFT
+
+: lrshift? ( -- f ) \ is either shift pressed?
+ mods h# 03 and ;
+: lrcontrol?
+ mods h# 44 and ;
+: lralt?
+ mods h# 88 and ;
+
+variable curkey
+
+: append ( u -- ) \ join u with mods write to curkey
+ h# ff and mods d# 8 lshift or
+ curkey !
+;
+
+: shiftmask
+ h# ff and
+ ise0 @ if d# 4 lshift then
+;
+: shift-press ( u -- ) \ a shift key was pressed
+ shiftmask mods or to mods ;
+: shift-release ( u -- ) \ a shift key was released
+ shiftmask invert mods and to mods ;
+
+: shiftable-press ( u -- ) \ a shiftable key was pressed
+ mods d# 3 and 0= capslock @ xor if
+ d# 8 rshift
+ then
+ append
+;
+: ignore drop ;
+
+: myleds \ compute led values from caps/numlock, send to KB
+ numlock @ d# 2 and
+ capslock @ d# 4 and
+ or
+ >leds
+;
+
+: toggle ( a -- ) \ invert cell at a
+ dup @ invert swap ! ;
+
+: plain-press ( u -- )
+ dup d# -1 = if
+ drop capslock toggle myleds
+ else
+ dup d# -2 = if
+ drop numlock toggle myleds
+ else
+ append
+ then
+ then
+;
+
+: num-press
+ \ if e0 prefix, low code, else hi code or 30
+ \ e0 numlock
+ \ 0 0 cursor
+ \ 0 1 num
+ \ 1 0 cursor
+ \ 1 1 cursor
+ ise0 @ 0= numlock @ and if
+ d# 8 rshift h# f and [char] . +
+ then
+ append
+;
+
+jumptable keyhandler
+\ PRESS RELEASE
+( 0 ) | shiftable-press | ignore
+( d ) | shift-press | shift-release
+( e ) | num-press | ignore
+( f ) | plain-press | ignore
+
+: handle-raw ( u -- )
+ dup h# e0 = if
+ drop ise0 on
+ else
+ dup h# f0 = if
+ drop isrelease on
+ else
+ dup h# 84 < if
+ scanmap@
+ \ hi 4 bits,
+ \ 1100 -> 0
+ \ 1101 -> 1
+ \ 1110 -> 2
+ \ 1111 -> 3
+ \
+ dup d# 12 rshift d# 12 - d# 0 max
+
+ 2* isrelease @ + keyhandler execute
+
+ isrelease off
+ ise0 off
+ else
+ drop
+ then
+ then
+ then
+;
+
+( kb: high-level keyboard JCB 19:45 12/04/10)
+
+: kb-cold
+ ps2listening kbfifo-cold
+ h# 7 >leds
+ sleep.1
+ h# 0 >leds
+
+ numlock off
+ capslock off
+ curkey off
+;
+
+: kbfifo-proc
+ rawloop
+ rawready? if
+ kbraw handle-raw
+ then
+;
+
+: key? ( -- flag )
+ kbfifo-proc
+ curkey @ 0<> ;
+: key ( -- u )
+ begin key? until
+ curkey @ curkey off ;
+
+]module
+
diff --git a/docs/j1demo/firmware/sincos.fs b/docs/j1demo/firmware/sincos.fs
new file mode 100644
index 0000000..6ad1ea4
--- /dev/null
+++ b/docs/j1demo/firmware/sincos.fs
@@ -0,0 +1,36 @@
+( Sine and cosine JCB 18:29 11/18/10)
+
+create sintab
+
+meta
+
+: mksin
+ 65 0 do
+ i s>d d>f 128e0 f/ pi f* fsin
+ 32767e0 f* f>d drop
+ t,
+ loop
+;
+mksin
+
+target
+
+: sin ( th -- v )
+ dup d# 128 and >r
+ d# 127 and
+ dup d# 63 > if
+ invert d# 129 + \ 64->64, 65->63
+ then
+ cells sintab + @
+ r> if
+ negate
+ then
+;
+
+: cos d# 64 + sin ;
+
+: sin* ( s th -- sinth * s )
+ sin swap 2* m* nip ;
+
+: cos* ( s th -- costh * s )
+ cos swap 2* m* nip ;
diff --git a/docs/j1demo/firmware/sprite.fs b/docs/j1demo/firmware/sprite.fs
new file mode 100644
index 0000000..877917a
--- /dev/null
+++ b/docs/j1demo/firmware/sprite.fs
@@ -0,0 +1,20 @@
+( Sprite low-level JCB 15:23 11/15/10)
+
+: vga-line@
+ begin
+ vga_line @
+ vga_line @
+ over xor
+ while
+ drop
+ repeat
+;
+
+: waitblank begin vga-line@ d# 512 = until ;
+
+: sprite! ( x y spr -- )
+ 2* cells vga_spritey + tuck ! 2- ! ;
+
+: hide \ hide all the sprites at (800,800)
+ d# 8 0do d# 800 dup i sprite! loop ;
+
diff --git a/docs/j1demo/firmware/tftp.fs b/docs/j1demo/firmware/tftp.fs
new file mode 100644
index 0000000..da40aa2
--- /dev/null
+++ b/docs/j1demo/firmware/tftp.fs
@@ -0,0 +1,67 @@
+( TFTP JCB 09:16 11/11/10)
+
+variable blocknum
+
+: tftp-ack ( -- )
+ d# 2 ETH.IP.SRCIP mac-inoffset mac@n arp-lookup if
+ ETH.IP.UDP.SOURCEPORT packet@
+ d# 1077
+ d# 2 ETH.IP.SRCIP mac-inoffset mac@n
+ net-my-ip
+ 2over arp-lookup
+ ( dst-port src-port dst-ip src-ip *ethaddr )
+ udp-header
+ d# 4 mac-pkt-,
+ blocknum @ mac-pkt-,
+ udp-wrapup mac-send
+ then
+;
+
+: tftp-handler ( -- )
+ IP_PROTO_UDP ip-isproto if
+ OFFSET_UDP_DESTPORT packet@ d# 69 = if
+ udp-checksum? if
+ ETH.IP.UDP.TFTP.OPCODE packet@
+ s" tftp opcode=" type dup hex4 cr
+ dup d# 2 = if
+ s" WRQ filename: " type
+ ETH.IP.UDP.TFTP.RWRQ.FILENAME mac-inoffset d# 32 mac-dump
+
+ d# 0 blocknum !
+ tftp-ack
+ then
+ drop
+ then
+ then
+ OFFSET_UDP_DESTPORT packet@ d# 1077 = if
+ udp-checksum? if
+ ETH.IP.UDP.TFTP.OPCODE packet@
+ s" tftp opcode=" type dup hex4 cr
+ dup d# 3 = if
+ s" tftp recv=" type ETH.IP.UDP.TFTP.DATA.BLOCK packet@ hex4 s" expected=" type blocknum @ 1+ hex4 cr
+ blocknum @ 1+
+ ETH.IP.UDP.TFTP.DATA.BLOCK packet@ = if
+ \ data at ETH.IP.UDP.TFTP.DATA.DATA
+ ETH.IP.UDP.TFTP.DATA.DATA mac-inoffset
+ blocknum @ d# 9 lshift h# 2000 +
+ d# 256 0do
+ over mac@ h# 5555 xor over h# 3ffe min !
+ 2+ swap 2+ swap
+ loop
+ 2drop
+ d# 1 blocknum +!
+ tftp-ack
+ ETH.IP.UDP.LENGTH packet@ d# 12 - 0= if
+ h# 2000 h# 100 dump
+ bootloader
+ then
+ else
+ s" unexpected blocknum" type cr
+ tftp-ack
+ then
+ then
+ drop
+ then
+ then
+ then
+;
diff --git a/docs/j1demo/firmware/time.fs b/docs/j1demo/firmware/time.fs
new file mode 100644
index 0000000..4d53113
--- /dev/null
+++ b/docs/j1demo/firmware/time.fs
@@ -0,0 +1,33 @@
+( Time access JCB 13:27 08/24/10)
+
+variable prevth \ previous high time
+2variable timeh \ high 32 bits of time
+
+: time@ ( -- time. )
+ begin
+ time 2@
+ time 2@
+ 2over d<>
+ while
+ 2drop
+ repeat
+
+\ dup prevth fall? if
+\ d# 1. timeh d+!
+\ then
+;
+
+: timeq ( -- d d ) \ 64-bit time
+ time@ timeh 2@ ;
+
+: setalarm ( d a -- ) \ set alarm a for d microseconds hence
+ >r time@ d+ r> 2! ;
+: isalarm ( a -- f )
+ 2@ time@ d- d0<= ;
+
+2variable sleeper
+: sleepus sleeper setalarm begin sleeper isalarm until ;
+: sleep.1 d# 100000. sleepus ;
+: sleep1 d# 1000000. sleepus ;
+
+: took ( d -- ) time@ 2swap d- s" took " type d. cr ;
diff --git a/docs/j1demo/firmware/twist.py b/docs/j1demo/firmware/twist.py
new file mode 100644
index 0000000..19743f6
--- /dev/null
+++ b/docs/j1demo/firmware/twist.py
@@ -0,0 +1,311 @@
+from twisted.internet.protocol import DatagramProtocol
+from twisted.internet import reactor, task
+from twisted.internet.task import deferLater
+
+import os
+import time
+import struct
+import sys
+import hashlib
+import operator
+import functools
+import random
+
+class Transporter(DatagramProtocol):
+
+ def __init__(self, jobs):
+ self.udp_transport = reactor.listenUDP(9947, self)
+ self.pending = {}
+ self.seq = 0
+ self.jobs = jobs
+ self.firstjob()
+ task.LoopingCall(self.earliest).start(0.1)
+ reactor.run()
+
+ def firstjob(self):
+ self.jobs[0].startwork(self)
+
+ def propose(self, cmd, rest):
+ seq = self.seq
+ self.seq += 1
+ data = struct.pack(">HH", seq, cmd) + rest;
+ self.pending[seq] = (time.time(), data)
+ return seq
+
+ def earliest(self):
+ bytime = [(t, k) for (k, (t, _)) in self.pending.items()]
+ for (t, seq) in sorted(bytime)[:32]:
+ self.send(seq)
+ self.pending[seq] = (time.time(), self.pending[seq][1])
+
+ def datagramReceived(self, data, (host, port)):
+ # print "received %r from %s:%d" % (data, host, port)
+ (opcode, seq) = struct.unpack(">HH", data[:4])
+ assert opcode == 0
+ if seq in self.pending:
+ del self.pending[seq]
+ try:
+ self.jobs[0].addresult(self, seq, data[4:])
+ except AssertionError as e:
+ print 'assertion failed', e
+ reactor.stop()
+ return
+ print "ACK ", seq, "pending", len(self.pending)
+ if len(self.pending) == 0:
+ self.jobs[0].close()
+ self.jobs = self.jobs[1:]
+ if self.jobs != []:
+ self.firstjob()
+ else:
+ reactor.stop()
+ # self.transport.write(data, (host, port))
+
+ def send(self, seq):
+ (_, data) = self.pending[seq]
+ # print "send %r" % data
+ self.udp_transport.write(data, ("192.168.0.99", 947))
+
+ def addresult(self, seq, payload):
+ pass
+
+
+class Action(object):
+ def addresult(self, tr, seq, payload):
+ pass
+
+ def close(self):
+ pass
+
+class ReadRAM(Action):
+
+ def startwork(self, tr):
+ self.result = 16384 * [None]
+ self.seqs = {}
+ for i in range(0, 128):
+ self.seqs[tr.propose(0, struct.pack(">H", i * 128))] = i * 128
+
+ def addresult(self, tr, seq, payload):
+ addr = self.seqs[seq]
+ assert len(payload) == 128
+ for i in range(128):
+ self.result[addr + i] = ord(payload[i])
+
+ def close(self):
+ for a in range(0, 16384, 16):
+ print ("%04x " % a) + " ".join("%02x" % x for x in self.result[a:a+16])
+
+
+class WriteRAM(Action):
+
+ def startwork(self, tr):
+ code = open('j1.bin').read()
+ for i in range(0x1f80 / 128):
+ print i
+ o = 128 * i
+ tr.propose(1, struct.pack(">H128s", 0x2000 + o, code[o:o+128]))
+
+class VerifyRAM(ReadRAM):
+ def close(self):
+ actual = "".join([chr(c) for c in self.result[0x2000:]])
+ expected = open('j1.bin').read()
+ l = 0x1f80
+ assert actual[:l] == expected[:l]
+
+class Reboot(Action):
+ def startwork(self, tr):
+ tr.propose(2, "")
+
+class ReadFlash(Action):
+
+ def startwork(self, tr):
+ self.result = 2 * 1024 * 1024 * [None]
+ self.seqs = {}
+ for addr in range(0, len(self.result), 128):
+ self.seqs[tr.propose(3, struct.pack(">I", addr))] = addr
+
+ def addresult(self, tr, seq, payload):
+ addr = self.seqs[seq]
+ assert len(payload) == 128
+ for i in range(128):
+ self.result[addr + i] = ord(payload[i])
+
+ def close(self):
+ open('flash.dump', 'w').write("".join([chr(x) for x in self.result]))
+ for a in range(0, 256, 16):
+ print ("%04x " % a) + " ".join("%02x" % x for x in self.result[a:a+16])
+
+class EraseFlash(Action):
+ def startwork(self, tr):
+ tr.propose(4, "")
+ def close(self):
+ time.sleep(5)
+
+class WaitFlash(Action):
+ def startwork(self, tr):
+ self.seq = tr.propose(5, struct.pack(">I", 0))
+ def addresult(self, tr, seq, payload):
+ (res,) = struct.unpack(">H", payload)
+ if res == 0:
+ self.startwork(tr)
+
+def bitload(bitfilename):
+ bit = open(bitfilename, "r")
+
+ def getH(fi):
+ return struct.unpack(">H", bit.read(2))[0]
+ def getI(fi):
+ return struct.unpack(">I", bit.read(4))[0]
+
+ bit.seek(getH(bit), os.SEEK_CUR)
+ assert getH(bit) == 1
+
+ # Search for the data section in the .bit file...
+ while True:
+ ty = ord(bit.read(1))
+ if ty == 0x65:
+ break
+ length = getH(bit)
+ bit.seek(length, os.SEEK_CUR)
+ fieldLength = getI(bit)
+ return bit.read(fieldLength)
+
+# open("xxx", "w").write(bitload("j1_program.bit"))
+
+import intelhex
+import array
+
+class Hexfile(object):
+ def __init__(self, filename):
+ self.hf = intelhex.IntelHex(filename)
+ self.hf.readfile()
+ while (self.hf.maxaddr() % 128) != 127:
+ self.hf[self.hf.maxaddr() + 1] = 0xff
+ print "%x %x" % (self.hf.minaddr(), self.hf.maxaddr())
+
+ def minmax(self):
+ return (self.hf.minaddr(), self.hf.maxaddr())
+
+ # The XESS CPLD bootloader runs the flash in byte mode,
+ # and the flash is littleendian, so must do the endian
+ # swap here
+ def blk(self, o):
+ b128 = array.array('B', [self.hf[o + i] for i in range(128)]).tostring()
+ hh = array.array('H', b128)
+ hh.byteswap()
+ return hh.tostring()
+
+class WriteFlash(Action, Hexfile):
+
+ def startwork(self, tr):
+ for o in range(self.hf.minaddr(), self.hf.maxaddr(), 128):
+ tr.propose(6, struct.pack(">I", o) + self.blk(o))
+
+class VerifyFlash(Action, Hexfile):
+
+ def startwork(self, tr):
+ self.seqs = {}
+ for o in range(self.hf.minaddr(), self.hf.maxaddr(), 128):
+ self.seqs[tr.propose(3, struct.pack(">I", o))] = o
+
+ def addresult(self, tr, seq, payload):
+ addr = self.seqs[seq]
+ assert len(payload) == 128, 'short packet'
+ assert self.blk(addr) == payload, "mismatch at %#x" % addr
+
+ def close(self):
+ print "Flash verified OK"
+
+class EraseSector(Action):
+ def __init__(self, a):
+ self.a = a
+ def startwork(self, tr):
+ tr.propose(7, struct.pack(">I", self.a))
+ def close(self):
+ time.sleep(.1)
+
+class WaitSector(Action):
+ def __init__(self, a):
+ self.a = a
+ def startwork(self, tr):
+ self.seq = tr.propose(5, struct.pack(">I", self.a))
+ def addresult(self, tr, seq, payload):
+ (res,) = struct.unpack(">H", payload)
+ if res == 0:
+ self.startwork(tr)
+
+class LoadSector(Action):
+ def __init__(self, a, data):
+ self.a = a
+ self.data = data
+ def startwork(self, tr):
+ for o in range(0, len(self.data), 128):
+ blk = self.data[o:o+128]
+ if blk != (128 * chr(0xff)):
+ tr.propose(6, struct.pack(">I", self.a + o) + blk)
+
+class DumpSector(Action):
+
+ def __init__(self, a):
+ self.a = a
+ def startwork(self, tr):
+ self.seqs = {}
+ for o in [0]:
+ self.seqs[tr.propose(3, struct.pack(">I", self.a + o))] = o
+
+ def addresult(self, tr, seq, payload):
+ addr = self.a + self.seqs[seq]
+ assert len(payload) == 128
+ print "result", repr(payload)
+
+# t = Transporter([WriteRAM(), VerifyRAM(), Reboot()])
+# t = Transporter([EraseFlash(), WaitFlash()])
+# sys.exit(0)
+
+erasing = [EraseFlash(), WaitFlash()]
+bases = [ 0 ]
+bases = [0, 0x80000, 0x100000, 0x180000]
+bases = [0x80000]
+# Transporter(erasing + [WriteFlash("j1_program_%x.mcs" % base) for base in bases])
+# Transporter([VerifyFlash("j1_program_%x.mcs" % base) for base in bases])
+# Transporter([EraseSector(seca), WaitSector(seca), ld, DumpSector(seca)])
+
+def loadcode(dsta, filenames):
+ data = "".join([open(fn).read() for fn in filenames])
+ return [EraseSector(dsta),
+ WaitSector(dsta),
+ LoadSector(dsta, data)]
+
+def pngstr(filename):
+ import Image
+ sa = array.array('B', Image.open(filename).convert("L").tostring())
+ return struct.pack('>1024H', *sa.tolist())
+
+def erasesecs(lo, hi):
+ r = []
+ for s in range(lo, hi, 65536):
+ r += [EraseSector(s), WaitSector(s)]
+ return r
+
+def loadhex(filename):
+ w = WriteFlash(filename)
+ (lo, hi) = w.minmax()
+ return erasesecs(lo, hi) + [w]
+
+def loadsprites(dsta, filenames):
+ data = "".join([pngstr(f) for f in filenames])
+ print "Loading %d bytes" % len(data)
+ return erasesecs(dsta, dsta + len(data)) + [LoadSector(dsta, data)]
+
+# Transporter(loadcode(0x180000, ["j1.png.pic", "font8x8", "j1.png.chr"]) + [Reboot()])
+spr = ["%d.png" % (i/2) for i in range(16)]
+spr += ["blob.png"] * 16
+spr += ["fsm-32.png", "pop.png"] * 6 + ["bomb.png", "pop.png", "shot.png", "pop.png"]
+
+# Transporter(loadsprites(0x200000, spr))
+# Transporter(loadcode(0x190000, ["j1.bin"]) + [Reboot()])
+# t = Transporter([ReadFlash()])
+
+Transporter(
+# loadhex("j1_program_80000.mcs")
+loadcode(0x190000, ["j1.bin"]) + [Reboot()]
+)
diff --git a/docs/j1demo/firmware/udp.fs b/docs/j1demo/firmware/udp.fs
new file mode 100644
index 0000000..835983a
--- /dev/null
+++ b/docs/j1demo/firmware/udp.fs
@@ -0,0 +1,41 @@
+( UDP header and wrapup JCB 13:22 08/24/10)
+
+: udp-header ( dst-port src-port dst-ip src-ip *ethaddr -- )
+ h# 11 ip-header
+ mac-pkt-, \ src port
+ mac-pkt-, \ dst port
+ d# 2 mac-pkt-,0 \ length and checksum
+;
+
+variable packetbase
+: packet packetbase @ + ;
+
+: udp-checksum ( addr -- u ) \ compute UDP checksum on packet
+ packetbase !
+ ETH.IP.UDP.LENGTH packet @ d# 1 and if
+ ETH.IP.UDP ETH.IP.UDP.LENGTH packet @ + packet
+ dup @ h# ff00 and swap !
+ then
+ ETH.IP.UDP packet
+ ETH.IP.UDP.LENGTH packet @ 1+ 2/
+ mac-checksum invert
+ d# 4 ETH.IP.SRCIP packet mac@n
+ +1c +1c +1c +1c
+ IP_PROTO_UDP +1c
+ ETH.IP.UDP.LENGTH packet @ +1c
+ invert
+;
+
+: udp-checksum? true ;
+ \ incoming udp-checksum 0= ;
+
+: udp-wrapup
+ mac-pkt-complete dup
+ ip-wrapup
+
+ OFFSET_UDP -
+ OFFSET_UDP_LENGTH packetout-off mac!
+
+ \ outgoing udp-checksum ETH.IP.UDP.CHECKSUM packetout-off !
+;
+
diff --git a/docs/j1demo/firmware/version.fs b/docs/j1demo/firmware/version.fs
new file mode 100644
index 0000000..75e63a9
--- /dev/null
+++ b/docs/j1demo/firmware/version.fs
@@ -0,0 +1,2 @@
+: version s" 649:659M" ;
+: builddate d# 1291578086. d# -0800 ;
diff --git a/docs/j1demo/j1.pdf b/docs/j1demo/j1.pdf
new file mode 100644
index 0000000..188ac02
--- /dev/null
+++ b/docs/j1demo/j1.pdf
Binary files 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)/<libname>/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 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no" ?>
+<project xmlns="http://www.xilinx.com/XMLSchema" xmlns:xil_pn="http://www.xilinx.com/XMLSchema">
+
+ <header>
+ <!-- ISE source project file created by Project Navigator. -->
+ <!-- -->
+ <!-- This file contains project source information including a list of -->
+ <!-- project source files, project and process properties. This file, -->
+ <!-- along with the project source files, is sufficient to open and -->
+ <!-- implement in ISE Project Navigator. -->
+ <!-- -->
+ <!-- Copyright (c) 1995-2013 Xilinx, Inc. All rights reserved. -->
+ </header>
+
+ <version xil_pn:ise_version="14.7" xil_pn:schema_version="2"/>
+
+ <files>
+ <file xil_pn:name="src/papilio-pro.ucf" xil_pn:type="FILE_UCF">
+ <association xil_pn:name="Implementation" xil_pn:seqID="0"/>
+ </file>
+ <file xil_pn:name="src/miniuart.vhd" xil_pn:type="FILE_VHDL">
+ <association xil_pn:name="BehavioralSimulation" xil_pn:seqID="4"/>
+ <association xil_pn:name="Implementation" xil_pn:seqID="4"/>
+ </file>
+ <file xil_pn:name="src/Rxunit.vhd" xil_pn:type="FILE_VHDL">
+ <association xil_pn:name="BehavioralSimulation" xil_pn:seqID="3"/>
+ <association xil_pn:name="Implementation" xil_pn:seqID="3"/>
+ </file>
+ <file xil_pn:name="src/Txunit.vhd" xil_pn:type="FILE_VHDL">
+ <association xil_pn:name="BehavioralSimulation" xil_pn:seqID="2"/>
+ <association xil_pn:name="Implementation" xil_pn:seqID="2"/>
+ </file>
+ <file xil_pn:name="src/utils.vhd" xil_pn:type="FILE_VHDL">
+ <association xil_pn:name="BehavioralSimulation" xil_pn:seqID="1"/>
+ <association xil_pn:name="Implementation" xil_pn:seqID="1"/>
+ </file>
+ <file xil_pn:name="test/miniuart2_tb.vhd" xil_pn:type="FILE_VHDL">
+ <association xil_pn:name="BehavioralSimulation" xil_pn:seqID="5"/>
+ <association xil_pn:name="PostMapSimulation" xil_pn:seqID="231"/>
+ <association xil_pn:name="PostRouteSimulation" xil_pn:seqID="231"/>
+ <association xil_pn:name="PostTranslateSimulation" xil_pn:seqID="231"/>
+ </file>
+ <file xil_pn:name="test/papilio_pro_j1_tb.vhd" xil_pn:type="FILE_VHDL">
+ <association xil_pn:name="BehavioralSimulation" xil_pn:seqID="0"/>
+ <association xil_pn:name="PostMapSimulation" xil_pn:seqID="15"/>
+ <association xil_pn:name="PostRouteSimulation" xil_pn:seqID="15"/>
+ <association xil_pn:name="PostTranslateSimulation" xil_pn:seqID="15"/>
+ </file>
+ <file xil_pn:name="src/papilio-pro-j1.vhd" xil_pn:type="FILE_VHDL">
+ <association xil_pn:name="BehavioralSimulation" xil_pn:seqID="0"/>
+ <association xil_pn:name="Implementation" xil_pn:seqID="7"/>
+ </file>
+ <file xil_pn:name="src/j1.v" xil_pn:type="FILE_VERILOG">
+ <association xil_pn:name="BehavioralSimulation" xil_pn:seqID="0"/>
+ <association xil_pn:name="Implementation" xil_pn:seqID="5"/>
+ </file>
+ <file xil_pn:name="src/clock.vhd" xil_pn:type="FILE_VHDL">
+ <association xil_pn:name="BehavioralSimulation" xil_pn:seqID="0"/>
+ <association xil_pn:name="Implementation" xil_pn:seqID="6"/>
+ </file>
+ </files>
+
+ <properties>
+ <property xil_pn:name="AES Initial Vector spartan6" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="AES Key (Hex String) spartan6" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Add I/O Buffers" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Allow Logic Optimization Across Hierarchy" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Allow SelectMAP Pins to Persist" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Allow Unexpanded Blocks" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Allow Unmatched LOC Constraints" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Allow Unmatched Timing Group Constraints" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Analysis Effort Level" xil_pn:value="Standard" xil_pn:valueState="default"/>
+ <property xil_pn:name="Asynchronous To Synchronous" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Auto Implementation Compile Order" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Auto Implementation Top" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Automatic BRAM Packing" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Automatically Insert glbl Module in the Netlist" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Automatically Run Generate Target PROM/ACE File" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="BRAM Utilization Ratio" xil_pn:value="100" xil_pn:valueState="default"/>
+ <property xil_pn:name="Bring Out Global Set/Reset Net as a Port" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Bring Out Global Tristate Net as a Port" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Bus Delimiter" xil_pn:value="&lt;>" xil_pn:valueState="default"/>
+ <property xil_pn:name="CLB Pack Factor Percentage" xil_pn:value="100" xil_pn:valueState="default"/>
+ <property xil_pn:name="Case" xil_pn:value="Maintain" xil_pn:valueState="default"/>
+ <property xil_pn:name="Case Implementation Style" xil_pn:value="None" xil_pn:valueState="default"/>
+ <property xil_pn:name="Change Device Speed To" xil_pn:value="-2" xil_pn:valueState="default"/>
+ <property xil_pn:name="Change Device Speed To Post Trace" xil_pn:value="-2" xil_pn:valueState="default"/>
+ <property xil_pn:name="Combinatorial Logic Optimization" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Compile EDK Simulation Library" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Compile SIMPRIM (Timing) Simulation Library" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Compile UNISIM (Functional) Simulation Library" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Compile XilinxCoreLib (CORE Generator) Simulation Library" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Compile for HDL Debugging" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Configuration Clk (Configuration Pins)" xil_pn:value="Pull Up" xil_pn:valueState="default"/>
+ <property xil_pn:name="Configuration Pin Done" xil_pn:value="Pull Up" xil_pn:valueState="default"/>
+ <property xil_pn:name="Configuration Pin M0" xil_pn:value="Pull Up" xil_pn:valueState="default"/>
+ <property xil_pn:name="Configuration Pin M1" xil_pn:value="Pull Up" xil_pn:valueState="default"/>
+ <property xil_pn:name="Configuration Pin M2" xil_pn:value="Pull Up" xil_pn:valueState="default"/>
+ <property xil_pn:name="Configuration Pin Program" xil_pn:value="Pull Up" xil_pn:valueState="default"/>
+ <property xil_pn:name="Configuration Rate" xil_pn:value="4" xil_pn:valueState="default"/>
+ <property xil_pn:name="Configuration Rate spartan6" xil_pn:value="2" xil_pn:valueState="default"/>
+ <property xil_pn:name="Correlate Output to Input Design" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Create ASCII Configuration File" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Create Binary Configuration File" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Create Bit File" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Create I/O Pads from Ports" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Create IEEE 1532 Configuration File spartan6" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Create Logic Allocation File" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Create Mask File" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Create ReadBack Data Files" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Cross Clock Analysis" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="DSP Utilization Ratio" xil_pn:value="100" xil_pn:valueState="default"/>
+ <property xil_pn:name="Decoder Extraction" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Delay Values To Be Read from SDF" xil_pn:value="Setup Time" xil_pn:valueState="default"/>
+ <property xil_pn:name="Device" xil_pn:value="xc6slx9" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Device Family" xil_pn:value="Spartan6" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Device Speed Grade/Select ABS Minimum" xil_pn:value="-2" xil_pn:valueState="default"/>
+ <property xil_pn:name="Disable Detailed Package Model Insertion" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Do Not Escape Signal and Instance Names in Netlist" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Done (Output Events)" xil_pn:value="Default (4)" xil_pn:valueState="default"/>
+ <property xil_pn:name="Drive Awake Pin During Suspend/Wake Sequence spartan6" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Drive Done Pin High" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Enable BitStream Compression" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Enable Cyclic Redundancy Checking (CRC) spartan6" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Enable Debugging of Serial Mode BitStream" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Enable External Master Clock spartan6" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Enable Hardware Co-Simulation" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Enable Internal Done Pipe" xil_pn:value="true" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Enable Message Filtering" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Enable Multi-Pin Wake-Up Suspend Mode spartan6" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Enable Multi-Threading" xil_pn:value="Off" xil_pn:valueState="default"/>
+ <property xil_pn:name="Enable Multi-Threading par spartan6" xil_pn:value="Off" xil_pn:valueState="default"/>
+ <property xil_pn:name="Enable Outputs (Output Events)" xil_pn:value="Default (5)" xil_pn:valueState="default"/>
+ <property xil_pn:name="Enable Suspend/Wake Global Set/Reset spartan6" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Encrypt Bitstream spartan6" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Encrypt Key Select spartan6" xil_pn:value="BBRAM" xil_pn:valueState="default"/>
+ <property xil_pn:name="Equivalent Register Removal Map" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Equivalent Register Removal XST" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Essential Bits" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Evaluation Development Board" xil_pn:value="None Specified" xil_pn:valueState="default"/>
+ <property xil_pn:name="Exclude Compilation of Deprecated EDK Cores" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Exclude Compilation of EDK Sub-Libraries" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Extra Cost Tables Map" xil_pn:value="0" xil_pn:valueState="default"/>
+ <property xil_pn:name="Extra Effort (Highest PAR level only)" xil_pn:value="None" xil_pn:valueState="default"/>
+ <property xil_pn:name="FPGA Start-Up Clock" xil_pn:value="CCLK" xil_pn:valueState="default"/>
+ <property xil_pn:name="FSM Encoding Algorithm" xil_pn:value="Auto" xil_pn:valueState="default"/>
+ <property xil_pn:name="FSM Style" xil_pn:value="LUT" xil_pn:valueState="default"/>
+ <property xil_pn:name="Filter Files From Compile Order" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Flatten Output Netlist" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Functional Model Target Language ArchWiz" xil_pn:value="Verilog" xil_pn:valueState="default"/>
+ <property xil_pn:name="Functional Model Target Language Coregen" xil_pn:value="Verilog" xil_pn:valueState="default"/>
+ <property xil_pn:name="Functional Model Target Language Schematic" xil_pn:value="Verilog" xil_pn:valueState="default"/>
+ <property xil_pn:name="GTS Cycle During Suspend/Wakeup Sequence spartan6" xil_pn:value="4" xil_pn:valueState="default"/>
+ <property xil_pn:name="GWE Cycle During Suspend/Wakeup Sequence spartan6" xil_pn:value="5" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Architecture Only (No Entity Declaration)" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Asynchronous Delay Report" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Clock Region Report" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Constraints Interaction Report" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Constraints Interaction Report Post Trace" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Datasheet Section" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Datasheet Section Post Trace" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Detailed MAP Report" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Multiple Hierarchical Netlist Files" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Post-Place &amp; Route Power Report" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Post-Place &amp; Route Simulation Model" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate RTL Schematic" xil_pn:value="Yes" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate SAIF File for Power Optimization/Estimation Par" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Testbench File" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Timegroups Section" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generate Timegroups Section Post Trace" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Generics, Parameters" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Global Optimization Goal" xil_pn:value="AllClockNets" xil_pn:valueState="default"/>
+ <property xil_pn:name="Global Optimization map spartan6" xil_pn:value="Off" xil_pn:valueState="default"/>
+ <property xil_pn:name="Global Set/Reset Port Name" xil_pn:value="GSR_PORT" xil_pn:valueState="default"/>
+ <property xil_pn:name="Global Tristate Port Name" xil_pn:value="GTS_PORT" xil_pn:valueState="default"/>
+ <property xil_pn:name="Hierarchy Separator" xil_pn:value="/" xil_pn:valueState="default"/>
+ <property xil_pn:name="ISim UUT Instance Name" xil_pn:value="UUT" xil_pn:valueState="default"/>
+ <property xil_pn:name="Ignore User Timing Constraints Map" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Ignore User Timing Constraints Par" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Implementation Top" xil_pn:value="Architecture|papilio_pro_j1|Behavioral" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Implementation Top File" xil_pn:value="src/papilio-pro-j1.vhd" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Implementation Top Instance Path" xil_pn:value="/papilio_pro_j1" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Include 'uselib Directive in Verilog File" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Include SIMPRIM Models in Verilog File" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Include UNISIM Models in Verilog File" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Include sdf_annotate task in Verilog File" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Incremental Compilation" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Insert Buffers to Prevent Pulse Swallowing" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Instantiation Template Target Language Xps" xil_pn:value="Verilog" xil_pn:valueState="default"/>
+ <property xil_pn:name="JTAG Pin TCK" xil_pn:value="Pull Up" xil_pn:valueState="default"/>
+ <property xil_pn:name="JTAG Pin TDI" xil_pn:value="Pull Up" xil_pn:valueState="default"/>
+ <property xil_pn:name="JTAG Pin TDO" xil_pn:value="Pull Up" xil_pn:valueState="default"/>
+ <property xil_pn:name="JTAG Pin TMS" xil_pn:value="Pull Up" xil_pn:valueState="default"/>
+ <property xil_pn:name="Keep Hierarchy" xil_pn:value="No" xil_pn:valueState="default"/>
+ <property xil_pn:name="LUT Combining Map" xil_pn:value="Off" xil_pn:valueState="default"/>
+ <property xil_pn:name="LUT Combining Xst" xil_pn:value="Auto" xil_pn:valueState="default"/>
+ <property xil_pn:name="Language" xil_pn:value="VHDL" xil_pn:valueState="default"/>
+ <property xil_pn:name="Last Applied Goal" xil_pn:value="Balanced" xil_pn:valueState="default"/>
+ <property xil_pn:name="Last Applied Strategy" xil_pn:value="Xilinx Default (unlocked)" xil_pn:valueState="default"/>
+ <property xil_pn:name="Last Unlock Status" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Launch SDK after Export" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Library for Verilog Sources" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Load glbl" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Logical Shifter Extraction" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Manual Implementation Compile Order" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Map Slice Logic into Unused Block RAMs" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Mask Pins for Multi-Pin Wake-Up Suspend Mode spartan6" xil_pn:value="0x00" xil_pn:valueState="default"/>
+ <property xil_pn:name="Max Fanout" xil_pn:value="100000" xil_pn:valueState="default"/>
+ <property xil_pn:name="Maximum Compression" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Maximum Number of Lines in Report" xil_pn:value="1000" xil_pn:valueState="default"/>
+ <property xil_pn:name="Maximum Signal Name Length" xil_pn:value="20" xil_pn:valueState="default"/>
+ <property xil_pn:name="Move First Flip-Flop Stage" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Move Last Flip-Flop Stage" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="MultiBoot: Insert IPROG CMD in the Bitfile spartan6" xil_pn:value="Enable" xil_pn:valueState="default"/>
+ <property xil_pn:name="MultiBoot: Next Configuration Mode spartan6" xil_pn:value="001" xil_pn:valueState="default"/>
+ <property xil_pn:name="MultiBoot: Starting Address for Golden Configuration spartan6" xil_pn:value="0x00000000" xil_pn:valueState="default"/>
+ <property xil_pn:name="MultiBoot: Starting Address for Next Configuration spartan6" xil_pn:value="0x00000000" xil_pn:valueState="default"/>
+ <property xil_pn:name="MultiBoot: Use New Mode for Next Configuration spartan6" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="MultiBoot: User-Defined Register for Failsafe Scheme spartan6" xil_pn:value="0x0000" xil_pn:valueState="default"/>
+ <property xil_pn:name="Multiplier Style" xil_pn:value="LUT" xil_pn:valueState="default"/>
+ <property xil_pn:name="Mux Extraction" xil_pn:value="Yes" xil_pn:valueState="default"/>
+ <property xil_pn:name="Mux Style" xil_pn:value="Auto" xil_pn:valueState="default"/>
+ <property xil_pn:name="Netlist Hierarchy" xil_pn:value="As Optimized" xil_pn:valueState="default"/>
+ <property xil_pn:name="Netlist Translation Type" xil_pn:value="Timestamp" xil_pn:valueState="default"/>
+ <property xil_pn:name="Number of Clock Buffers" xil_pn:value="16" xil_pn:valueState="default"/>
+ <property xil_pn:name="Number of Paths in Error/Verbose Report" xil_pn:value="3" xil_pn:valueState="default"/>
+ <property xil_pn:name="Number of Paths in Error/Verbose Report Post Trace" xil_pn:value="3" xil_pn:valueState="default"/>
+ <property xil_pn:name="Optimization Effort" xil_pn:value="Normal" xil_pn:valueState="default"/>
+ <property xil_pn:name="Optimization Effort spartan6" xil_pn:value="Normal" xil_pn:valueState="default"/>
+ <property xil_pn:name="Optimization Goal" xil_pn:value="Speed" xil_pn:valueState="default"/>
+ <property xil_pn:name="Optimization Strategy (Cover Mode)" xil_pn:value="Area" xil_pn:valueState="default"/>
+ <property xil_pn:name="Optimize Instantiated Primitives" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Bitgen Command Line Options" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Bitgen Command Line Options spartan6" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Compiler Options" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Compiler Options Map" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Compiler Options Par" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Compiler Options Translate" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Compxlib Command Line Options" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Map Command Line Options" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other NETGEN Command Line Options" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Ngdbuild Command Line Options" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Place &amp; Route Command Line Options" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Simulator Commands Behavioral" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Simulator Commands Post-Map" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Simulator Commands Post-Route" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other Simulator Commands Post-Translate" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other XPWR Command Line Options" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Other XST Command Line Options" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Output Extended Identifiers" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Output File Name" xil_pn:value="papilio_pro_forth" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Overwrite Compiled Libraries" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Pack I/O Registers into IOBs" xil_pn:value="Auto" xil_pn:valueState="default"/>
+ <property xil_pn:name="Pack I/O Registers/Latches into IOBs" xil_pn:value="Off" xil_pn:valueState="default"/>
+ <property xil_pn:name="Package" xil_pn:value="tqg144" xil_pn:valueState="default"/>
+ <property xil_pn:name="Perform Advanced Analysis" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Perform Advanced Analysis Post Trace" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Perform Timing-Driven Packing and Placement" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Place &amp; Route Effort Level (Overall)" xil_pn:value="High" xil_pn:valueState="default"/>
+ <property xil_pn:name="Place And Route Mode" xil_pn:value="Normal Place and Route" xil_pn:valueState="default"/>
+ <property xil_pn:name="Place MultiBoot Settings into Bitstream spartan6" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Placer Effort Level (Overrides Overall Level)" xil_pn:value="None" xil_pn:valueState="default"/>
+ <property xil_pn:name="Placer Effort Level Map" xil_pn:value="High" xil_pn:valueState="default"/>
+ <property xil_pn:name="Placer Extra Effort Map" xil_pn:value="None" xil_pn:valueState="default"/>
+ <property xil_pn:name="Port to be used" xil_pn:value="Auto - default" xil_pn:valueState="default"/>
+ <property xil_pn:name="Post Map Simulation Model Name" xil_pn:value="papilio_pro_forth_map.v" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Post Place &amp; Route Simulation Model Name" xil_pn:value="papilio_pro_forth_timesim.v" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Post Synthesis Simulation Model Name" xil_pn:value="papilio_pro_forth_synthesis.v" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Post Translate Simulation Model Name" xil_pn:value="papilio_pro_forth_translate.v" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Power Reduction Map" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Power Reduction Map spartan6" xil_pn:value="Off" xil_pn:valueState="default"/>
+ <property xil_pn:name="Power Reduction Par" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Power Reduction Xst" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Preferred Language" xil_pn:value="Verilog" xil_pn:valueState="default"/>
+ <property xil_pn:name="Priority Encoder Extraction" xil_pn:value="Yes" xil_pn:valueState="default"/>
+ <property xil_pn:name="Produce Verbose Report" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Project Description" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Project Generator" xil_pn:value="ProjNav" xil_pn:valueState="default"/>
+ <property xil_pn:name="Property Specification in Project File" xil_pn:value="Store all values" xil_pn:valueState="default"/>
+ <property xil_pn:name="RAM Extraction" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="RAM Style" xil_pn:value="Auto" xil_pn:valueState="default"/>
+ <property xil_pn:name="ROM Extraction" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="ROM Style" xil_pn:value="Auto" xil_pn:valueState="default"/>
+ <property xil_pn:name="Read Cores" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Reduce Control Sets" xil_pn:value="Auto" xil_pn:valueState="default"/>
+ <property xil_pn:name="Regenerate Core" xil_pn:value="Under Current Project Setting" xil_pn:valueState="default"/>
+ <property xil_pn:name="Register Balancing" xil_pn:value="No" xil_pn:valueState="default"/>
+ <property xil_pn:name="Register Duplication Map" xil_pn:value="Off" xil_pn:valueState="default"/>
+ <property xil_pn:name="Register Duplication Xst" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Register Ordering spartan6" xil_pn:value="4" xil_pn:valueState="default"/>
+ <property xil_pn:name="Release Write Enable (Output Events)" xil_pn:value="Default (6)" xil_pn:valueState="default"/>
+ <property xil_pn:name="Rename Design Instance in Testbench File to" xil_pn:value="UUT" xil_pn:valueState="default"/>
+ <property xil_pn:name="Rename Top Level Architecture To" xil_pn:value="Structure" xil_pn:valueState="default"/>
+ <property xil_pn:name="Rename Top Level Entity to" xil_pn:value="main" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Rename Top Level Module To" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Report Fastest Path(s) in Each Constraint" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Report Fastest Path(s) in Each Constraint Post Trace" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Report Paths by Endpoint" xil_pn:value="3" xil_pn:valueState="default"/>
+ <property xil_pn:name="Report Paths by Endpoint Post Trace" xil_pn:value="3" xil_pn:valueState="default"/>
+ <property xil_pn:name="Report Type" xil_pn:value="Verbose Report" xil_pn:valueState="default"/>
+ <property xil_pn:name="Report Type Post Trace" xil_pn:value="Verbose Report" xil_pn:valueState="default"/>
+ <property xil_pn:name="Report Unconstrained Paths" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Report Unconstrained Paths Post Trace" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Reset On Configuration Pulse Width" xil_pn:value="100" xil_pn:valueState="default"/>
+ <property xil_pn:name="Resource Sharing" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Retain Hierarchy" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Retry Configuration if CRC Error Occurs spartan6" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Revision Select" xil_pn:value="00" xil_pn:valueState="default"/>
+ <property xil_pn:name="Revision Select Tristate" xil_pn:value="Disable" xil_pn:valueState="default"/>
+ <property xil_pn:name="Router Effort Level (Overrides Overall Level)" xil_pn:value="None" xil_pn:valueState="default"/>
+ <property xil_pn:name="Run Design Rules Checker (DRC)" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Run for Specified Time" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Run for Specified Time Map" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Run for Specified Time Par" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Run for Specified Time Translate" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Safe Implementation" xil_pn:value="No" xil_pn:valueState="default"/>
+ <property xil_pn:name="Security" xil_pn:value="Enable Readback and Reconfiguration" xil_pn:valueState="default"/>
+ <property xil_pn:name="Selected Module Instance Name" xil_pn:value="/miniuart2_tb" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Selected Simulation Root Source Node Behavioral" xil_pn:value="work.miniuart2_tb" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Selected Simulation Root Source Node Post-Map" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Selected Simulation Root Source Node Post-Route" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Selected Simulation Root Source Node Post-Translate" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Selected Simulation Source Node" xil_pn:value="UUT" xil_pn:valueState="default"/>
+ <property xil_pn:name="Set SPI Configuration Bus Width spartan6" xil_pn:value="1" xil_pn:valueState="default"/>
+ <property xil_pn:name="Setup External Master Clock Division spartan6" xil_pn:value="1" xil_pn:valueState="default"/>
+ <property xil_pn:name="Shift Register Extraction" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Shift Register Minimum Size spartan6" xil_pn:value="2" xil_pn:valueState="default"/>
+ <property xil_pn:name="Show All Models" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Simulation Model Target" xil_pn:value="Verilog" xil_pn:valueState="default"/>
+ <property xil_pn:name="Simulation Run Time ISim" xil_pn:value="1000 ns" xil_pn:valueState="default"/>
+ <property xil_pn:name="Simulation Run Time Map" xil_pn:value="1000 ns" xil_pn:valueState="default"/>
+ <property xil_pn:name="Simulation Run Time Par" xil_pn:value="1000 ns" xil_pn:valueState="default"/>
+ <property xil_pn:name="Simulation Run Time Translate" xil_pn:value="1000 ns" xil_pn:valueState="default"/>
+ <property xil_pn:name="Simulator" xil_pn:value="ISim (VHDL/Verilog)" xil_pn:valueState="default"/>
+ <property xil_pn:name="Slice Packing" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Slice Utilization Ratio" xil_pn:value="100" xil_pn:valueState="default"/>
+ <property xil_pn:name="Specify 'define Macro Name and Value" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Specify Top Level Instance Names Behavioral" xil_pn:value="work.miniuart2_tb" xil_pn:valueState="default"/>
+ <property xil_pn:name="Specify Top Level Instance Names Post-Map" xil_pn:value="Default" xil_pn:valueState="default"/>
+ <property xil_pn:name="Specify Top Level Instance Names Post-Route" xil_pn:value="Default" xil_pn:valueState="default"/>
+ <property xil_pn:name="Specify Top Level Instance Names Post-Translate" xil_pn:value="Default" xil_pn:valueState="default"/>
+ <property xil_pn:name="Speed Grade" xil_pn:value="-2" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Starting Placer Cost Table (1-100) Map" xil_pn:value="1" xil_pn:valueState="default"/>
+ <property xil_pn:name="Starting Placer Cost Table (1-100) Map spartan6" xil_pn:value="1" xil_pn:valueState="default"/>
+ <property xil_pn:name="Starting Placer Cost Table (1-100) Par" xil_pn:value="1" xil_pn:valueState="default"/>
+ <property xil_pn:name="Synthesis Tool" xil_pn:value="XST (VHDL/Verilog)" xil_pn:valueState="default"/>
+ <property xil_pn:name="Target Simulator" xil_pn:value="Please Specify" xil_pn:valueState="default"/>
+ <property xil_pn:name="Target UCF File Name" xil_pn:value="src/papilio-one.ucf" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Timing Mode Map" xil_pn:value="Non Timing Driven" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Timing Mode Par" xil_pn:value="Performance Evaluation" xil_pn:valueState="default"/>
+ <property xil_pn:name="Top-Level Module Name in Output Netlist" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Top-Level Source Type" xil_pn:value="HDL" xil_pn:valueState="default"/>
+ <property xil_pn:name="Trim Unconnected Signals" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Tristate On Configuration Pulse Width" xil_pn:value="0" xil_pn:valueState="default"/>
+ <property xil_pn:name="Unused IOB Pins" xil_pn:value="Pull Down" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use 64-bit PlanAhead on 64-bit Systems" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Clock Enable" xil_pn:value="Auto" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Custom Project File Behavioral" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Custom Project File Post-Map" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Custom Project File Post-Route" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Custom Project File Post-Translate" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Custom Simulation Command File Behavioral" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Custom Simulation Command File Map" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Custom Simulation Command File Par" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Custom Simulation Command File Translate" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Custom Waveform Configuration File Behav" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Custom Waveform Configuration File Map" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Custom Waveform Configuration File Par" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Custom Waveform Configuration File Translate" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use DSP Block spartan6" xil_pn:value="Auto" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use LOC Constraints" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use RLOC Constraints" xil_pn:value="Yes" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Smart Guide" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Synchronous Reset" xil_pn:value="Auto" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Synchronous Set" xil_pn:value="Auto" xil_pn:valueState="default"/>
+ <property xil_pn:name="Use Synthesis Constraints File" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="User Browsed Strategy Files" xil_pn:value="/opt/Xilinx/14.7/ISE_DS/ISE/data/default.xds" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="UserID Code (8 Digit Hexadecimal)" xil_pn:value="0xFFFFFFFF" xil_pn:valueState="default"/>
+ <property xil_pn:name="VCCAUX Voltage Level spartan6" xil_pn:value="2.5V" xil_pn:valueState="default"/>
+ <property xil_pn:name="VHDL Source Analysis Standard" xil_pn:value="VHDL-93" xil_pn:valueState="default"/>
+ <property xil_pn:name="Value Range Check" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="Verilog 2001 Xst" xil_pn:value="true" xil_pn:valueState="default"/>
+ <property xil_pn:name="Verilog Macros" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="Wait for DCM and PLL Lock (Output Events) spartan6" xil_pn:value="Default (NoWait)" xil_pn:valueState="default"/>
+ <property xil_pn:name="Wait for DLL Lock (Output Events)" xil_pn:value="Default (NoWait)" xil_pn:valueState="default"/>
+ <property xil_pn:name="Wakeup Clock spartan6" xil_pn:value="Startup Clock" xil_pn:valueState="default"/>
+ <property xil_pn:name="Watchdog Timer Value spartan6" xil_pn:value="0xFFFF" xil_pn:valueState="default"/>
+ <property xil_pn:name="Working Directory" xil_pn:value="." xil_pn:valueState="non-default"/>
+ <property xil_pn:name="Write Timing Constraints" xil_pn:value="false" xil_pn:valueState="default"/>
+ <property xil_pn:name="XOR Collapsing" xil_pn:value="true" xil_pn:valueState="default"/>
+ <!-- -->
+ <!-- The following properties are for internal use only. These should not be modified.-->
+ <!-- -->
+ <property xil_pn:name="PROP_BehavioralSimTop" xil_pn:value="Architecture|miniuart2_tb|behavior" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="PROP_DesignName" xil_pn:value="forth" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="PROP_DevFamilyPMName" xil_pn:value="spartan6" xil_pn:valueState="default"/>
+ <property xil_pn:name="PROP_FPGAConfiguration" xil_pn:value="FPGAConfiguration" xil_pn:valueState="default"/>
+ <property xil_pn:name="PROP_PostMapSimTop" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="PROP_PostParSimTop" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="PROP_PostSynthSimTop" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="PROP_PostXlateSimTop" xil_pn:value="" xil_pn:valueState="default"/>
+ <property xil_pn:name="PROP_PreSynthesis" xil_pn:value="PreSynthesis" xil_pn:valueState="default"/>
+ <property xil_pn:name="PROP_intProjectCreationTimestamp" xil_pn:value="2012-03-04T11:05:19" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="PROP_intWbtProjectID" xil_pn:value="2646B868CC6AC035FC694292A405C58C" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="PROP_intWorkingDirLocWRTProjDir" xil_pn:value="Same" xil_pn:valueState="non-default"/>
+ <property xil_pn:name="PROP_intWorkingDirUsed" xil_pn:value="No" xil_pn:valueState="non-default"/>
+ </properties>
+
+ <bindings/>
+
+ <libraries/>
+
+ <autoManagedFiles>
+ <!-- The following files are identified by `include statements in verilog -->
+ <!-- source files and are automatically managed by Project Navigator. -->
+ <!-- -->
+ <!-- Do not hand-edit this section, as it will be overwritten when the -->
+ <!-- project is analyzed based on files automatically identified as -->
+ <!-- include files. -->
+ </autoManagedFiles>
+
+</project>
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
--- /dev/null
+++ b/docs/j1eforth/fpga/papilio_pro_j1.bit
Binary files 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 <email>
+-- 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 <email>
+-- 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 <email>
+-- 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 <email>
+-- 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 0800 ;
+a: n>>t 0900 ;
+a: t-1 0a00 ;
+a: rt 0b00 ;
+a: [t] 0c00 ;
+a: n<<t 0d00 ;
+a: dsp 0e00 ;
+a: nu<t 0f00 ;
+
+a: t->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 ( <name> -- )
+ 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 ( <name> -- )
+ 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 n<t d-1 alu asm[ ;
+: u< ]asm nu<t d-1 alu asm[ ;
+: swap ]asm n t->n 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[ ;
+: rshift ]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 ; <string> )
+ 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 ; <string> )
+ >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 ; <string> ) parse here cell+ pack$ t;
+t: token ( -- a ; <string> ) 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: <name?> ( 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: <?abort"> 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
+ <?abort"> $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] ( -- ; <string> ) ' 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 <> <?abort"> $literal bad case construct."
+ compile (endcase) noop t; compile-only immediate
+t: $" ( -- ; <string> ) compile $"| $," t; compile-only immediate
+t: ." ( -- ; <string> ) 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 <?abort"> $," t; immediate
+t: <overt> ( -- ) 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: : ( -- ; <string> ) token $,n ] t;
+t: immediate ( -- ) =imed literal last @ @ or last @ ! t;
+t: user ( u -- ; <string> ) token $,n overt compile douser , t;
+t: <create> ( -- ; <string> ) token $,n overt [t] dovar ]asm literal asm[ call, t;
+t: create ( -- ; <string> ) 'create @execute t;
+t: variable ( -- ; <string> ) 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> -- 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 =
+ <?abort"> $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< <?abort"> $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 <tos" t;
+t: (>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 ( -- ; <string> )
+ ' 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] <name?> [u] 'name? t!
+[t] <overt> [u] 'overt t!
+[t] <$,n> [u] '$,n t!
+[t] <;> [u] '; t!
+[t] <create> [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 <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stdint.h>
+#include <sys/stat.h>
+#if defined(unix) || defined(__unix__) || defined(__unix) || (defined(__APPLE__) && defined(__MACH__))
+#include <unistd.h>
+#include <termios.h>
+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<<t; break; /* lshift */
+ case 0xe: _t = (rsp<<8) + dsp; break; /* dsp */
+ case 0xf: _t = -(s<t); break; /* u< */
+ }
+ dsp = 31 & (dsp + sx[insn & 3]); /* dstack+- */
+ rsp = 31 & (rsp + sx[(insn >> 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 <rich@annexia.org> 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 <link to previous word>
+ .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 <asm/unistd.h>)
+*/
+
+//#include <asm-i386/unistd.h> // you might need this instead
+#include <asm/unistd.h>
+
+ .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 | | <data> |
+ +---------+---+---+---+---+---+---+---+---+-- - - - - --+------------+
+ len pad ^
+ |
+ new value of HERE
+
+ and <data> 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 <asm/unistd.h>
+ 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 <asm/unistd.h>)
+ 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 <asm/unistd.h>)
+ 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 <asm/unistd.h>)
+ pop %ebx // First parameter.
+ int $0x80
+ push %eax // Result (negative for -errno)
+ NEXT
+
+ defcode "SYSCALL0",8,,SYSCALL0
+ pop %eax // System call number (see <asm/unistd.h>)
+ 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 <rich@annexia.org> 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 <foo>
+: 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:
+ <space> <space> - 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 <string length> <string rounded up 4 bytes>
+ 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 <string length> <string rounded up to 4 bytes> 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 |
+ +---------+---------+---+---+---+---+------------+------------+---|--------+------------+
+ | <var> | LINK | 3 | V | A | R | DOCOL | LIT | <addr var> | EXIT |
+ +---------+---------+---+---+---+---+------------+------------+------------+------------+
+ len codeword
+
+ where <var> is the place to store the variable, and <addr var> 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 <addr> !
+ and calculating <addr> (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 | <value> | EXIT |
+ +---------+---+---+---+---+------------+------------+------------+------------+
+ len codeword
+
+ where <value> 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 <addr>? Why of course a pointer to that <value>:
+
+ code compiled - - - - --+------------+------------+------------+-- - - - -
+ by TO VAL | LIT | <addr> | ! |
+ - - - - --+------------+-----|------+------------+-- - - - -
+ |
+ V
+ +---------+---+---+---+---+------------+------------+------------+------------+
+ | LINK | 3 | V | A | L | DOCOL | LIT | <value> | 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"<space> )
+ 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` <stuff to do> `then` <rest of program>.
+: ?>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` <stuff to do> <flag> `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 <BUILDS and
+ DOES>.)
+
+ : 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