misc/kforth: Filling out more words.

Makefile

@@ -1,5 +1,5 @@
 CXXSTD :=	c++14
-CXXFLAGS :=	-std=$(CXXSTD) -Wall -Werror -Os -static
+CXXFLAGS :=	-std=$(CXXSTD) -Wall -Werror -O0 -g -static
 LDFLAGS :=	-static
 OBJS :=		linux/io.o	\
 		io.o		\
@@ -14,7 +14,6 @@ all: $(TARGET)
 
 $(TARGET): $(OBJS)
 	$(CXX) $(CXXFLAGS) -o $@ $(OBJS)
-	strip $@
 
 clean:
 	rm -f $(OBJS) $(TARGET)

TODO.txt

@@ -0,0 +1,20 @@
+nucleus layer:
++ !
++ +!
++ @
++ C!
++ C@
++ CMOVE
++ CMOVE>
++ COUNT
++ FILL
++ EXECUTE
++ EXIT
++ I
++ J
++ >R
++ R>
++ R@
++ U<
++ UM*
++ UM/MOD

dict.cc

@@ -24,8 +24,8 @@ pop_long(System *sys, KF_LONG *d)
 		return false;
 	}
 	
-	*d = a << dshift;
+	*d = static_cast<KF_LONG>(a) << dshift;
-	*d += b;
+	*d += static_cast<KF_LONG>(b);
 	sys->status = STATUS_OK;
 	return true;
 }
@@ -1001,6 +1001,22 @@ dlt(System *sys)
 	return true;
 }
 
+static bool
+ddot(System *sys)
+{
+	KF_LONG	da;
+
+	if (!pop_long(sys, &da)) {
+		// Status is already set.
+		return false;
+	}
+
+	write_dnum(sys->interface, da);
+	sys->interface->newline();
+	sys->status = STATUS_OK;
+	return true;
+}
+
 static bool
 negate(System *sys)
 {
@@ -1023,20 +1039,161 @@ negate(System *sys)
 	return true;
 }
 
+static bool
+dnegate(System *sys)
+{
+	KF_LONG	da;
+
+	if (!pop_long(sys, &da)) {
+		// Status is already set.
+		return false;
+	}
+
+	da = ~da;
+	da++;
+
+	if (!push_long(sys, da)) {
+		// Status is already set.
+		return false;
+	}
+
+	sys->status = STATUS_OK;
+	return true;
+}
+
+static bool
+pick(System *sys)
+{
+	KF_INT	a, b;
+	if (!sys->dstack.pop(&a)) {
+		sys->status = STATUS_STACK_UNDERFLOW;
+		return false;
+	}
+
+	size_t	i = sys->dstack.size() - a - 1;
+	if (!sys->dstack.get(i, b)) {
+		sys->status = STATUS_STACK_UNDERFLOW;
+		return false;
+	}
+
+	if (!sys->dstack.push(b)) {
+		sys->status = STATUS_STACK_OVERFLOW;
+		return false;
+	}
+
+	sys->status = STATUS_OK;
+	return true;
+}
+
+static bool
+min(System *sys)
+{
+	KF_INT	a, b;
+	if (!sys->dstack.pop(&a)) {
+		sys->status = STATUS_STACK_UNDERFLOW;
+		return false;
+	}
+	if (!sys->dstack.pop(&b)) {
+		sys->status = STATUS_STACK_UNDERFLOW;
+		return false;
+	}
+
+	if (!sys->dstack.push(a < b ? a : b)) {
+		sys->status = STATUS_STACK_OVERFLOW;
+		return false;
+	}
+
+	sys->status = STATUS_OK;
+	return true;
+}
+
+static bool
+max(System *sys)
+{
+	KF_INT	a, b;
+	if (!sys->dstack.pop(&a)) {
+		sys->status = STATUS_STACK_UNDERFLOW;
+		return false;
+	}
+	if (!sys->dstack.pop(&b)) {
+		sys->status = STATUS_STACK_UNDERFLOW;
+		return false;
+	}
+
+	if (!sys->dstack.push(a > b ? a : b)) {
+		sys->status = STATUS_STACK_OVERFLOW;
+		return false;
+	}
+
+	sys->status = STATUS_OK;
+	return true;
+}
+
+static bool
+exclusive_or(System *sys)
+{
+	KF_INT	a, b;
+	if (!sys->dstack.pop(&a)) {
+		sys->status = STATUS_STACK_UNDERFLOW;
+		return false;
+	}
+	if (!sys->dstack.pop(&b)) {
+		sys->status = STATUS_STACK_UNDERFLOW;
+		return false;
+	}
+
+	if (!sys->dstack.push(a ^ b)) {
+		sys->status = STATUS_STACK_OVERFLOW;
+		return false;
+	}
+
+	sys->status = STATUS_OK;
+	return true;
+}
+
+static bool
+mod(System *sys)
+{
+	KF_INT	a, b;
+	if (!sys->dstack.pop(&a)) {
+		sys->status = STATUS_STACK_UNDERFLOW;
+		return false;
+	}
+	if (!sys->dstack.pop(&b)) {
+		sys->status = STATUS_STACK_UNDERFLOW;
+		return false;
+	}
+
+	if (!sys->dstack.push(b % a)) {
+		sys->status = STATUS_STACK_OVERFLOW;
+		return false;
+	}
+
+	sys->status = STATUS_OK;
+	return true;
+}
+
 void
 init_dict(System *sys)
 {
 	sys->dict = nullptr;
 	sys->dict = new Builtin((const char *)"SWAP", 4, sys->dict, swap);
+	sys->dict = new Builtin((const char *)"XOR", 3, sys->dict, exclusive_or);
 	sys->dict = new Builtin((const char *)"ROT", 3, sys->dict, rot);
 	sys->dict = new Builtin((const char *)"ROLL", 4, sys->dict, roll);
+	sys->dict = new Builtin((const char *)"PICK", 4, sys->dict, pick);
 	sys->dict = new Builtin((const char *)"OVER", 4, sys->dict, over);
 	sys->dict = new Builtin((const char *)"NEGATE", 6, sys->dict, negate);
 	sys->dict = new Builtin((const char *)"OR", 2, sys->dict, lor);
+	sys->dict = new Builtin((const char *)"MOD", 3, sys->dict, mod);
+	sys->dict = new Builtin((const char *)"MIN", 3, sys->dict, min);
+	sys->dict = new Builtin((const char *)"MAX", 3, sys->dict, max);
 	sys->dict = new Builtin((const char *)"DUP", 3, sys->dict, dup);
 	sys->dict = new Builtin((const char *)"DROP", 4, sys->dict, drop);
 	sys->dict = new Builtin((const char *)"DEPTH", 5, sys->dict, depth);
 	sys->dict = new Builtin((const char *)"DEFINITIONS", 11, sys->dict, definitions);
+	sys->dict = new Builtin((const char *)"DNEGATE", 7, sys->dict, dnegate);
+	sys->dict = new Builtin((const char *)"D.", 2, sys->dict, ddot);
 	sys->dict = new Builtin((const char *)"D<", 2, sys->dict, dlt);
 	sys->dict = new Builtin((const char *)"D+", 2, sys->dict, dplus);
 	sys->dict = new Builtin((const char *)"BYE", 3, sys->dict, bye);

doc/part-0x06.rst

@@ -0,0 +1,322 @@
+Write You a Forth, 0x06
+-----------------------
+
+:date: 2018-02-28 22:55
+:tags: wyaf, forth
+
+Lots of updates last night; SLOC-wise, I added a bunch of new definitions:
+
++ ``DEPTH``, ``.`` and ``.S`` to inspect the stack
++ ``/MOD``, ``*/``, and ``*/MOD``, which required adding some idea of a long
+  type
++  ``0<``, ``0=``, ``0>``, ``<``, ``=``, and ``>`` for conditionals
++ ``DUP`` and ``?DUP``
++ the logical operators ``AND``, ``OR``, and ``NEGATE``
++ ``ABS``
++ ``BYE`` moved from an interpreter hack to a defined word
++ ``D+`` and ``D-`` started me off on the concept of double numbers
++ ``DROP``, ``OVER``, and ``ROLL`` are more stack manipulation functions
+
+It's starting to feel a lot like a Forth...
+
+Speaking of SLOC, for shits and grins I decided to see how the code base has
+grown:
+
++-----------+---------------+--------+----------------------+---------------+
+| revision  | lines of code | growth |         focus        | exec size (b) |
++-----------+---------------+--------+----------------------+---------------+
+| 0x02      |      133      |   n/a  | starting point       |     38368     |
++-----------+---------------+--------+----------------------+---------------+
+| 0x03      |      245      |   1.8x | parsing              |     40920     |
++-----------+---------------+--------+----------------------+---------------+
+| 0x04      |      369      |   1.5x | stack / numerics     |     48736     |
++-----------+---------------+--------+----------------------+---------------+
+| 0x05      |      677      |   1.8x | initial dictionary   |     62896     |
++-----------+---------------+--------+----------------------+---------------+
+| 0x06      |     1436      |   2.1x | expanding vocabulary |     85256     |
++-----------+---------------+--------+----------------------+---------------+
+
+Note that the executable is compiled with ``-O0 -g`` on the
+``x86_64-linux-gnu`` target.
+
+It makes sense that expanding the vocabulary is going to be a huge code
+expansion. I did do more than that; so, I'm not really going to show most of
+the work I did for the new words (a lot of it is repetative and mechanical).
+
+System updates
+^^^^^^^^^^^^^^
+
+Before I started expanding the dictionary, though, I made some changes to
+the ``System``::
+
+        $ git diff HEAD^ system.h 
+        diff --git a/system.h b/system.h
+        index 00f4a34..91aa1fa 100644
+        --- a/system.h
+        +++ b/system.h
+        @@ -5,11 +5,24 @@
+        #include "io.h"
+        #include "stack.h"
+        
+        +typedef enum _SYS_STATUS : uint8_t {
+        +       STATUS_OK = 0,
+        +       STATUS_STACK_OVERFLOW = 1,
+        +       STATUS_STACK_UNDERFLOW = 2,
+        +       STATUS_EXECUTION_FAILURE = 3,
+        +       STATUS_UNKNOWN_WORD = 4
+        +} SYS_STATUS;
+        +
+        +class Word;
+        +
+        typedef struct _System {
+                Stack<KF_INT>    dstack;
+                IO              *interface;
+        -       struct Word     *dict;
+        +       Word            *dict;
+        +       SYS_STATUS       status;
+        } System;
+        
+        +void   system_clear_error(System *sys);
+        +void   system_write_status(System *sys);
+        
+        #endif // __KF_CORE_H__
+        \ No newline at end of file
+
+I've started adding a notion of system state, which I've deliberately kept
+separate from the parser state. The new functions aren't particularly
+interesting; they just write a string to the ``interface`` field so you
+get things like::
+
+        $ ./kforth
+        kforth interpreter
+        ? swap
+        stack underflow (error code 2).
+        ? what-word?
+        unknown word (error code 4).
+        ? 2
+        ok.
+
+Note that this is separate from the parser errors::
+
+        $ ./kforth 
+        kforth interpreter
+        ? AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+        ok.
+        parse error: token too long
+        ? unknown word (error code 4).
+        ? 
+
+Though this test does show that the interpreter could be made more robust.
+
+I/O updates
+^^^^^^^^^^^
+
+The next thing I did was move the ``write_dstack`` function into ``io.cc``;
+this is needed to implement ``.S``. While I was at it, I decided to make
+``write_num`` finally work well and correctly, and I think I've got the final
+version done::
+
+        void
+        write_num(IO *interface, KF_INT n)
+        {
+                char buf[nbuflen];
+                uint8_t i = nbuflen - 1;
+                memset(buf, 0, nbuflen);
+
+                if (n < 0) {
+                        interface->wrch('-');
+                }
+
+I'm still not proud of this hack, but it seems to be the best way to deal with
+this right now::
+
+                else if (n == 0) {
+                        interface->wrch('0');
+                        return;
+                }
+
+                while (n != 0) {
+                        char x = n % 10;
+
+This was the magic that finally got it right: negating the digits as they're
+going into the buffer. No more trying to invert the whole number, just each
+digit::
+
+                        x = x < 0 ? -x : x;
+                        x += '0';
+                        buf[i--] = x;
+                        n /= 10;
+                }
+
+                interface->wrbuf(buf+i, nbuflen - i);
+        }
+
+My first pass at this wrote the string forwards, then reversed it. I didn't
+like that; while performance isn't my first concern, it just seemed like a
+fun challenge to get the reversed buffer written correctly.
+
+While I was in the I/O subsystem, I also decided to update the ``IO`` base
+class to include a ``newline`` method; I had a few instances of
+``interface->wrch('\n')`` sprinkled throughout, but that won't necessarily be
+correct elsewhere.
+
+Miscellaneous updates
+^^^^^^^^^^^^^^^^^^^^^^
+
+I add a new definition to the ``defs.h`` files: a ``KF_LONG`` type to prepare
+for the double numbers mentioned in the next section, and switched to static
+compilation.
+
+New words!
+^^^^^^^^^^
+
+Finally, I started adding the new words in. I'm still trying to figure out a
+good way to handle the address types (I think I'll just introduce a ``KF_ADDR``
+type) so I've punted on those for now.
+
+.. _pforth: http://www.softsynth.com/pforth/
+.. _gforth: https://www.gnu.org/software/gforth/
+
+One of the interesting challenges is dealing with the double numbers. These are
+on the stack as a pair of smaller numbers, e.g. if the double number type is 64
+bits and the standard number type is 32 bits, then you might see something like
+this (via pforth_)::
+
+        0 1 0 1 D+
+        ok
+        Stack<10> 0 2 
+
+So, how to deal with this? There's a ``D.`` word, which I don't have
+implemented yet, that will let me see what pforth_ and gforth_ do::
+
+        $ pforth -q
+        Begin AUTO.INIT ------
+        0 1 D. 1 0 D.
+        4294967296 1 
+        ^C
+        $ gforth   
+        Gforth 0.7.2, Copyright (C) 1995-2008 Free Software Foundation, Inc.
+        Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'
+        Type `bye' to exit
+        0 1 D. 1 0 D. 18446744073709551616 1  ok
+
+So, it looks like the first number on the stack is the low part, and the second
+is the high part. This is, once again, pretty straightforward: I'll need to
+shift the first number by the appropriate number of bits and then add the
+second number to it.
+
+        constexpr size_t dshift = (sizeof(KF_INT) * 8) - 1;
+
+        static bool
+        pop_long(System *sys, KF_LONG *d)
+        {
+                KF_INT	a = 0;
+                KF_INT	b = 0;
+                if (!sys->dstack.pop(&a)) {
+                        sys->status = STATUS_STACK_UNDERFLOW;
+                        return false;
+                }
+                
+                if (!sys->dstack.pop(&b)) {
+                        sys->status = STATUS_STACK_UNDERFLOW;
+                        return false;
+                }
+                
+                *d = static_cast<KF_LONG>(a) << dshift;
+                *d += static_cast<KF_LONG>(b);
+                sys->status = STATUS_OK;
+                return true;
+        }
+
+This function also shows off the new status work and how that turns out. I've
+kept the exec interface as a boolean to indicate success or failure.
+
+To push the results back onto the stack, I needed to first write a masking
+function to make sure to clear out any lingering bits::
+
+        static inline KF_INT
+        mask(size_t bits)
+        {
+                KF_INT m = 0;
+
+                for (size_t i = 0; i < bits; i++) {
+                        m += 1 << i;
+                }
+                
+                return m;
+        }
+
+I should probably check `Hacker's Delight <http://hackersdelight.org/>`_ to see
+if there's any tricks for this.
+
+With the mask available, getting a long into a pair of ints requires shifting
+and clearing for the high part and clearing for the low part::
+
+        static bool
+        push_long(System *sys, KF_LONG d)
+        {
+                KF_INT	a = static_cast<KF_INT>((d >> dshift) & mask(dshift));
+                KF_INT	b = static_cast<KF_INT>(d & mask(dshift));
+
+                if (!sys->dstack.push(b)) {
+                        sys->status = STATUS_STACK_OVERFLOW;
+                        return false;
+                }
+                
+                if (!sys->dstack.push(a)) {
+                        sys->status = STATUS_STACK_OVERFLOW;
+                        return false;
+                }
+                
+                sys->status = STATUS_OK;
+                return true;
+        }
+
+One of the words that interacts with doubles is ``D+``::
+
+        static bool
+        dplus(System *sys)
+        {
+                KF_LONG	da, db;
+                
+                if (!pop_long(sys, &da)) {
+                        // Status is already set.
+                        return false;
+                }
+                
+                if (!pop_long(sys, &db)) {
+                        // Status is already set.
+                        return false;
+                }
+                
+                da += db;
+                
+                if (!push_long(sys, da)) {
+                        // Status is already set.
+                        return false;
+                }
+                
+                // Status is already set.
+                return true;
+        }
+
+The only other thing I really did was to add a ``remove`` method to the Stack
+class to support ``ROLL``.
+
+Huge diff, but not as much to say about it --- next up, I think I'm going to
+introduce the ``KF_ADDR`` type and start working on some of the address
+interaction stuff. I'll also add more of the double number words, too. The
+words I still have to implement from the `FORTH-83 standard`_ nuclear layer
+are:
+
++ ``!``, ``+!``, ``@``, ``C!``, ``C@``, ``CMOVE``, ``CMOVE>``, ``COUNT``,
+  ``FILL``: memory manipulation words
++ ``DNEGATE``, ``MAX``, ``MIN``, ``MOD``, ``XOR``: more arithmetic words
++ ``EXECUTE``, ``EXIT``, ``I``, ``J``, ``PICK``: various words
++  ``>R``, ``R>``, ``R@``: return stack words
++ ``U<``, ``UM*``, ``UM/MOD``: unsigned math words
+
+.. _FORTH-83 standard: http://forth.sourceforge.net/standard/fst83/fst83-12.htm
+
+As before, the snapshot for this update is tagged `part-0x06
+<https://github.com/kisom/kforth/tree/part-0x06>`_.

io.cc

@@ -3,11 +3,10 @@
 
 #include <string.h>
 
-static constexpr size_t	nbuflen = 11;
-
 void
 write_num(IO *interface, KF_INT n)
 {
+	static constexpr size_t	nbuflen = 11;
 	char buf[nbuflen];
 	uint8_t i = nbuflen - 1;
 	memset(buf, 0, nbuflen);
@@ -31,6 +30,34 @@ write_num(IO *interface, KF_INT n)
 	interface->wrbuf(buf+i, nbuflen - i);
 }
 
+void
+write_dnum(IO *interface, KF_LONG n)
+{
+	static constexpr size_t	dnbuflen = 21;
+	char buf[dnbuflen];
+	uint8_t i = dnbuflen - 1;
+	memset(buf, 0, dnbuflen);
+
+	if (n < 0) {
+		interface->wrch('-');
+	}
+	else if (n == 0) {
+		interface->wrch('0');
+		return;
+	}
+
+	while (n != 0) {
+		char x = n % 10;
+		x = x < 0 ? -x : x;
+		x += '0';
+		buf[i--] = x;
+		n /= 10;
+	}
+
+	interface->wrbuf(buf+i, dnbuflen - i);
+}
+
+
 void
 write_dstack(IO *interface, Stack<KF_INT> dstack)
 {

io.h

@@ -25,6 +25,7 @@ public:
 };
 
 void	write_num(IO *, KF_INT);
+void	write_dnum(IO *, KF_LONG);
 void	write_dstack(IO *, Stack<KF_INT>);