aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDimitri Sokolyuk <demon@dim13.org>2017-06-10 23:18:31 +0200
committerDimitri Sokolyuk <demon@dim13.org>2017-06-10 23:18:31 +0200
commitda312e375eb0a0758a4dd72e287d3aba86c04d99 (patch)
treeaa7d3631273b516e7f10ef40a53a5edd21a81b7e
parente4d7ac43458f9f96a15041d35feddecca20ddbba (diff)
Add FIRST & THIRD almost FORTH
-rw-r--r--buzzard/README1
-rw-r--r--buzzard/buzzard.2.README22
-rw-r--r--buzzard/buzzard.2.c61
-rw-r--r--buzzard/buzzard.2.design780
-rw-r--r--buzzard/buzzard.2.hint217
-rw-r--r--buzzard/buzzard.2.orig.c61
-rw-r--r--buzzard/demo1.1st12
-rw-r--r--buzzard/demo1.th4
-rw-r--r--buzzard/demo2.th10
-rw-r--r--buzzard/demo3.th15
-rw-r--r--buzzard/demo4.th30
-rw-r--r--buzzard/demo5.th27
-rw-r--r--buzzard/demo6.th18
-rw-r--r--buzzard/help.th54
-rw-r--r--buzzard/third367
15 files changed, 1679 insertions, 0 deletions
diff --git a/buzzard/README b/buzzard/README
new file mode 100644
index 0000000..e95ba91
--- /dev/null
+++ b/buzzard/README
@@ -0,0 +1 @@
+See http://www.ioccc.org/1992/
diff --git a/buzzard/buzzard.2.README b/buzzard/buzzard.2.README
new file mode 100644
index 0000000..ee59a3b
--- /dev/null
+++ b/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/buzzard/buzzard.2.c b/buzzard/buzzard.2.c
new file mode 100644
index 0000000..4765458
--- /dev/null
+++ b/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/buzzard/buzzard.2.design b/buzzard/buzzard.2.design
new file mode 100644
index 0000000..49b2e2d
--- /dev/null
+++ b/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/buzzard/buzzard.2.hint b/buzzard/buzzard.2.hint
new file mode 100644
index 0000000..b0fe22b
--- /dev/null
+++ b/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/buzzard/buzzard.2.orig.c b/buzzard/buzzard.2.orig.c
new file mode 100644
index 0000000..7f77ab1
--- /dev/null
+++ b/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/buzzard/demo1.1st b/buzzard/demo1.1st
new file mode 100644
index 0000000..b836967
--- /dev/null
+++ b/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/buzzard/demo1.th b/buzzard/demo1.th
new file mode 100644
index 0000000..99d22bd
--- /dev/null
+++ b/buzzard/demo1.th
@@ -0,0 +1,4 @@
+: demo1 " Hello world!
+" ;
+
+demo1
diff --git a/buzzard/demo2.th b/buzzard/demo2.th
new file mode 100644
index 0000000..8bf8eee
--- /dev/null
+++ b/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/buzzard/demo3.th b/buzzard/demo3.th
new file mode 100644
index 0000000..c061b74
--- /dev/null
+++ b/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/buzzard/demo4.th b/buzzard/demo4.th
new file mode 100644
index 0000000..3f9a76d
--- /dev/null
+++ b/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/buzzard/demo5.th b/buzzard/demo5.th
new file mode 100644
index 0000000..d16ca1e
--- /dev/null
+++ b/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/buzzard/demo6.th b/buzzard/demo6.th
new file mode 100644
index 0000000..75ec667
--- /dev/null
+++ b/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/buzzard/help.th b/buzzard/help.th
new file mode 100644
index 0000000..7afab27
--- /dev/null
+++ b/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/buzzard/third b/buzzard/third
new file mode 100644
index 0000000..b5d3802
--- /dev/null
+++ b/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