From d96bf65a2400fec6c34453392b8d30faa5b6ea5c Mon Sep 17 00:00:00 2001 From: Kyle Isom Date: Thu, 1 Mar 2018 16:09:06 -0800 Subject: [PATCH] misc/kforth: Mostly finished with nucleus layer. --- Makefile | 4 +- TODO.txt | 26 +-- dict.cc | 466 +++++++++++++++++++++++++++++++++++++++++++--- doc/part-0x01.rst | 6 + io.cc | 23 +++ io.h | 1 + linux/defs.h | 18 +- stack.h | 15 ++ system.cc | 10 + system.h | 6 +- word.cc | 45 +++++ word.h | 19 ++ 12 files changed, 587 insertions(+), 52 deletions(-) diff --git a/Makefile b/Makefile index ea8521b..ab9e689 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ CXXSTD := c++14 -CXXFLAGS := -std=$(CXXSTD) -Wall -Werror -O0 -g -static +CXXFLAGS := -std=$(CXXSTD) -Wall -Werror -O0 -g LDFLAGS := -static OBJS := linux/io.o \ io.o \ @@ -13,7 +13,7 @@ TARGET := kforth all: $(TARGET) $(TARGET): $(OBJS) - $(CXX) $(CXXFLAGS) -o $@ $(OBJS) + $(CXX) $(LDFLAGS) -o $@ $(OBJS) clean: rm -f $(OBJS) $(TARGET) diff --git a/TODO.txt b/TODO.txt index fa5e2de..cf70a30 100644 --- a/TODO.txt +++ b/TODO.txt @@ -1,20 +1,8 @@ nucleus layer: -+ ! -+ +! -+ @ -+ C! -+ C@ -+ CMOVE -+ CMOVE> -+ COUNT -+ FILL -+ EXECUTE -+ EXIT -+ I -+ J -+ >R -+ R> -+ R@ -+ U< -+ UM* -+ UM/MOD ++ EXIT: requires better execution control ++ I: requires support for loop index ++ J: requires support for loop index + +return addressing / rstack +dictionary -> fixed size stack / array + diff --git a/dict.cc b/dict.cc index baf7e21..90a798e 100644 --- a/dict.cc +++ b/dict.cc @@ -7,8 +7,6 @@ #include #include -constexpr size_t dshift = (sizeof(KF_INT) * 8) - 1; - static bool pop_long(System *sys, KF_LONG *d) { @@ -30,18 +28,6 @@ pop_long(System *sys, KF_LONG *d) return true; } -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; -} - static bool push_long(System *sys, KF_LONG d) { @@ -62,6 +48,33 @@ push_long(System *sys, KF_LONG d) return true; } +static bool +pop_addr(System *sys, KF_ADDR *a) +{ + KF_LONG b; + if (!pop_long(sys, &b)) { + // Status is already set. + return false; + } + + *a = static_cast(b); + sys->status = STATUS_OK; + return true; +} + +static bool +push_addr(System *sys, KF_ADDR a) +{ + KF_LONG b = static_cast(a); + if (!push_long(sys, b)) { + // Status is already set. + return false; + } + + sys->status = STATUS_OK; + return true; +} + static bool add(System *sys) { @@ -468,27 +481,25 @@ divide_mod(System *sys) return true; } - -/* static bool store(System *sys) { - KF_INT a = 0; // address + KF_ADDR a = 0; // address KF_INT b = 0; // value + KF_LONG c = 0; // temporary - if (!sys->dstack.pop(&a)) { + if (!pop_long(sys, &c)) { sys->status = STATUS_STACK_UNDERFLOW; return false; } + a = static_cast(c); if (!sys->dstack.pop(&b)) { sys->status = STATUS_STACK_UNDERFLOW; return false; } - KF_INT *p = (KF_INT *)(a); - *p = b; - + *((KF_INT *)a) = b; sys->status = STATUS_OK; return true; } @@ -496,26 +507,47 @@ store(System *sys) static bool plus_store(System *sys) { - KF_INT a = 0; // address + KF_ADDR a = 0; // address KF_INT b = 0; // value + KF_LONG c = 0; // temporary - if (!sys->dstack.pop(&a)) { + if (!pop_long(sys, &c)) { sys->status = STATUS_STACK_UNDERFLOW; return false; } + a = static_cast(c); if (!sys->dstack.pop(&b)) { sys->status = STATUS_STACK_UNDERFLOW; return false; } - KF_INT *p = (KF_INT *)(a); - *p += b; - + *((KF_INT *)a) += b; sys->status = STATUS_OK; return true; } -*/ + +static bool +fetch(System *sys) +{ + KF_ADDR a = 0; // address + KF_INT b = 0; // value + KF_LONG c = 0; // temporary + + if (!pop_long(sys, &c)) { + sys->status = STATUS_STACK_UNDERFLOW; + return false; + } + a = static_cast(c); + + b = *((KF_INT *)a); + if (!sys->dstack.push(b)) { + sys->status = STATUS_STACK_OVERFLOW; + return false; + } + sys->status = STATUS_OK; + return true; +} static bool zero_less(System *sys) @@ -1173,14 +1205,379 @@ mod(System *sys) return true; } +static bool +to_r(System *sys) +{ + KF_INT a; + + if (!sys->dstack.pop(&a)) { + sys->status = STATUS_STACK_UNDERFLOW; + return false; + } + + if (!sys->rstack.push(static_cast(a))) { + sys->status = STATUS_RSTACK_OVERFLOW; + return false; + } + + sys->status = STATUS_OK; + return true; +} + +static bool +from_r(System *sys) +{ + KF_ADDR a; + + if (!sys->rstack.pop(&a)) { + sys->status = STATUS_RSTACK_UNDERFLOW; + return false; + } + + if (!sys->dstack.push(static_cast(a))) { + sys->status = STATUS_STACK_OVERFLOW; + return false; + } + + sys->status = STATUS_OK; + return true; +} + +static bool +r_fetch(System *sys) +{ + KF_ADDR a; + + if (!sys->rstack.peek(&a)) { + sys->status = STATUS_RSTACK_UNDERFLOW; + return false; + } + + if (!sys->dstack.push(static_cast(a))) { + sys->status = STATUS_STACK_OVERFLOW; + return false; + } + + sys->status = STATUS_OK; + return true; +} + +static bool +c_fetch(System *sys) +{ + KF_ADDR a; + uint8_t b; // the standard explicitly calls for a byte. + + if (!pop_addr(sys, &a)) { + // Status is already set. + return false; + } + + b = *(reinterpret_cast(a)); + if (!sys->dstack.push(static_cast(b))) { + sys->status = STATUS_STACK_OVERFLOW; + return false; + } + + sys->status = STATUS_OK; + return true; +} + +static bool +c_store(System *sys) +{ + KF_ADDR a; + KF_INT b; + + if (!pop_addr(sys, &a)) { + // Status is already set. + return false; + } + + if (!sys->dstack.pop(&b)) { + sys->status = STATUS_STACK_UNDERFLOW; + return false; + } + + b &= 0xFF; + + *(reinterpret_cast(a)) = b; + sys->status = STATUS_OK; + return true; +} + + +static bool +c_move(System *sys) +{ + KF_UINT a; + KF_INT b; + KF_ADDR c, d; + + if (!sys->dstack.pop(&b)) { + sys->status = STATUS_STACK_UNDERFLOW; + return false; + } + a = static_cast(b); + + if (!pop_addr(sys, &d)) { + // Status is already set. + return false; + } + + if (!pop_addr(sys, &c)) { + // Status is already set. + return false; + } + + for (KF_UINT i = 0; i < a; i++) { + *reinterpret_cast(d + i) = + *reinterpret_cast(c + i); + } + + sys->status = STATUS_OK; + return true; +} + +static bool +c_move_up(System *sys) +{ + KF_UINT a; + KF_INT b; + KF_ADDR c, d; + + if (!sys->dstack.pop(&b)) { + sys->status = STATUS_STACK_UNDERFLOW; + return false; + } + a = static_cast(b); + + if (!pop_addr(sys, &d)) { + // Status is already set. + return false; + } + + if (!pop_addr(sys, &c)) { + // Status is already set. + return false; + } + + for (KF_UINT i = 0; i < a; i++) { + *reinterpret_cast(d - i) = + *reinterpret_cast(c - i); + } + + sys->status = STATUS_OK; + return true; +} + +static bool +fill(System *sys) +{ + KF_INT a, c; + uint8_t b; + KF_UINT d; + KF_ADDR e; + + if (!sys->dstack.pop(&a)) { + sys->status = STATUS_STACK_UNDERFLOW; + return false; + } + b = static_cast(a); + + if (!sys->dstack.pop(&c)) { + sys->status = STATUS_STACK_UNDERFLOW; + return false; + } + d = static_cast(c); + + if (!pop_addr(sys, &e)) { + // Status is already set. + return false; + } + + for (KF_UINT i = 0; i < d; i++) { + *reinterpret_cast(e + i) = b; + } + + sys->status = STATUS_OK; + return true; +} + +static bool +count(System *sys) +{ + uint8_t a; + KF_ADDR b; + + if (!pop_addr(sys, &b)) { + // Status is already set. + return false; + } + + a = *reinterpret_cast(b); + b++; + + if (!push_addr(sys, b)) { + // Status is already set. + return false; + } + + if (!sys->dstack.push(static_cast(a))) { + sys->status = STATUS_STACK_OVERFLOW; + return false; + } + + sys->status = STATUS_OK; + return true; +} + +static bool +execute(System *sys) +{ + KF_ADDR a; + Word *b; + + if (!pop_addr(sys, &a)) { + // Status is already set. + return false; + } + + b = reinterpret_cast(a); + char buf[MAX_TOKEN_LENGTH]; + size_t buflen; + + b->getname(buf, &buflen); + sys->interface->wrbuf((char *)"executing word: ", 16); + sys->interface->wrbuf(buf, buflen); + sys->interface->newline(); + return b->eval(sys); +} + +static bool +u_dot(System *sys) +{ + KF_INT a; + KF_UINT b; + + if (!sys->dstack.pop(&a)) { + sys->status = STATUS_STACK_UNDERFLOW; + return false; + } + b = static_cast(a); + + write_unum(sys->interface, b); + sys->interface->newline(); + sys->status = STATUS_OK; + return true; +} + +static bool +ult(System *sys) +{ + KF_INT a, b; + bool ok; + + 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 (static_cast(b) < static_cast(a)) { + ok = sys->dstack.push(-1); + } + else { + ok = sys->dstack.push(0); + } + + if (!ok) { + sys->status = STATUS_STACK_OVERFLOW; + return false; + } + + sys->status = STATUS_OK; + return true; +} + +static bool +u_times(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; + } + + a = static_cast(a) * static_cast(b); + if (!sys->dstack.push(a)) { + sys->status = STATUS_STACK_OVERFLOW; + return false; + } + + sys->status = STATUS_OK; + return true; +} + +static bool +udivide_mod(System *sys) +{ + KF_INT a, b; + KF_INT y, z; + + if (!sys->dstack.pop(&a)) { + sys->status = STATUS_STACK_UNDERFLOW; + return false; + } + + if (!sys->dstack.pop(&b)) { + sys->status = STATUS_STACK_UNDERFLOW; + return false; + } + + + z = (KF_UINT)b / (KF_UINT)a; + y = (KF_UINT)b % (KF_UINT)a; + + if (!sys->dstack.push(y)) { + sys->status = STATUS_STACK_OVERFLOW; + return false; + } + + if (!sys->dstack.push(z)) { + 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 *)"U/MOD", 5, sys->dict, udivide_mod); + sys->dict = new Builtin((const char *)"UM*", 3, sys->dict, u_times); + sys->dict = new Builtin((const char *)"U<", 2, sys->dict, ult); + sys->dict = new Builtin((const char *)"U.", 2, sys->dict, u_dot); + sys->dict = new Builtin((const char *)"SWAP", 4, sys->dict, swap); 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 *)"R@", 2, sys->dict, r_fetch); + sys->dict = new Builtin((const char *)"R>", 2, sys->dict, from_r); 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); @@ -1188,6 +1585,8 @@ init_dict(System *sys) 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 *)"FILL", 4, sys->dict, fill); + sys->dict = new Builtin((const char *)"EXECUTE", 7, sys->dict, execute); 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); @@ -1196,10 +1595,17 @@ init_dict(System *sys) 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 *)"COUNT", 5, sys->dict, count); + sys->dict = new Builtin((const char *)"CMOVE>", 6, sys->dict, c_move_up); + sys->dict = new Builtin((const char *)"CMOVE", 5, sys->dict, c_move); + sys->dict = new Builtin((const char *)"C@", 2, sys->dict, c_fetch); + sys->dict = new Builtin((const char *)"C!", 2, sys->dict, c_store); sys->dict = new Builtin((const char *)"BYE", 3, sys->dict, bye); sys->dict = new Builtin((const char *)"ABS", 3, sys->dict, absolute); sys->dict = new Builtin((const char *)"AND", 3, sys->dict, land); + sys->dict = new Builtin((const char *)"@", 1, sys->dict, fetch); sys->dict = new Builtin((const char *)"?DUP", 4, sys->dict, question_dupe); + sys->dict = new Builtin((const char *)">R", 2, sys->dict, to_r); sys->dict = new Builtin((const char *)">", 1, sys->dict, greater_than); sys->dict = new Builtin((const char *)"=", 1, sys->dict, equals); sys->dict = new Builtin((const char *)"<", 1, sys->dict, less_than); @@ -1218,10 +1624,12 @@ init_dict(System *sys) sys->dict = new Builtin((const char *)".S", 2, sys->dict, dotess); sys->dict = new Builtin((const char *)".", 1, sys->dict, dot); sys->dict = new Builtin((const char *)"-", 1, sys->dict, sub); - // sys->dict = new Builtin((const char *)"+!", 2, sys->dict, plus_store); + sys->dict = new Builtin((const char *)"+!", 2, sys->dict, plus_store); sys->dict = new Builtin((const char *)"+", 1, sys->dict, add); sys->dict = new Builtin((const char *)"*", 1, sys->dict, mul); - // sys->dict = new Builtin((const char *)"!", 1, sys->dict, store); + sys->dict = new Builtin((const char *)"!", 1, sys->dict, store); + sys->dict = new Address((const char *)"ARENA", 5, sys->dict, reinterpret_cast(&sys->arena)); + sys->dict = new Address((const char *)"DICT", 5, sys->dict, reinterpret_cast(&sys->dict)); } bool diff --git a/doc/part-0x01.rst b/doc/part-0x01.rst index eb5feb4..72fecf4 100644 --- a/doc/part-0x01.rst +++ b/doc/part-0x01.rst @@ -9,6 +9,12 @@ X-type series where I'll write up my thinking and planning as I go. .. _last post: https://dl.kyleisom.net/posts/2018/02/21/2018-02-21-revisiting-forth/ +I've always wanted to write a Forth_; I've made a few attempts_ at it in the +past. This time, I'm actually going to do it. + +.. _Forth: https://en.wikipedia.org/wiki/Forth_(programming_language) +.. _attempts: https://github.com/isrlabs/avr-forth + The basics ^^^^^^^^^^ diff --git a/io.cc b/io.cc index f2521c8..a04dc6f 100644 --- a/io.cc +++ b/io.cc @@ -30,6 +30,29 @@ write_num(IO *interface, KF_INT n) interface->wrbuf(buf+i, nbuflen - i); } +void +write_unum(IO *interface, KF_UINT n) +{ + static constexpr size_t nbuflen = 11; + char buf[nbuflen]; + uint8_t i = nbuflen - 1; + memset(buf, 0, nbuflen); + + if (n == 0) { + interface->wrch('0'); + return; + } + + while (n != 0) { + char x = n % 10; + x += '0'; + buf[i--] = x; + n /= 10; + } + + interface->wrbuf(buf+i, nbuflen - i); +} + void write_dnum(IO *interface, KF_LONG n) { diff --git a/io.h b/io.h index 6e876a6..d5a75c1 100644 --- a/io.h +++ b/io.h @@ -25,6 +25,7 @@ public: }; void write_num(IO *, KF_INT); +void write_unum(IO *, KF_UINT); void write_dnum(IO *, KF_LONG); void write_dstack(IO *, Stack); diff --git a/linux/defs.h b/linux/defs.h index edcbdb2..c007fee 100644 --- a/linux/defs.h +++ b/linux/defs.h @@ -5,8 +5,24 @@ #include typedef int32_t KF_INT; +typedef uint32_t KF_UINT; typedef int64_t KF_LONG; +constexpr size_t dshift = (sizeof(KF_INT) * 8) - 1; -constexpr uint8_t STACK_SIZE = 128; +typedef uintptr_t KF_ADDR; +constexpr uint8_t STACK_SIZE = 128; +constexpr size_t ARENA_SIZE = 65535; + +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; +} #endif \ No newline at end of file diff --git a/stack.h b/stack.h index a4f31a8..b909dad 100644 --- a/stack.h +++ b/stack.h @@ -8,6 +8,7 @@ class Stack { public: bool push(T val); bool pop(T *val); + bool peek(T *val); bool get(size_t, T &); bool remove(size_t, T *); size_t size(void) { return this->arrlen; } @@ -44,6 +45,20 @@ Stack::pop(T *val) return true; } +// peek returns false if there was a stack underflow. +template +bool +Stack::peek(T *val) +{ + if (this->arrlen == 0) { + return false; + } + + *val = this->arr[this->arrlen - 1]; + return true; +} + + // get returns false on invalid bounds. template bool diff --git a/system.cc b/system.cc index aebd834..e3ab8de 100644 --- a/system.cc +++ b/system.cc @@ -8,6 +8,8 @@ constexpr static char STATE_STR_STACK_OVERFLOW[] = "stack overflow"; constexpr static char STATE_STR_STACK_UNDERFLOW[] = "stack underflow"; constexpr static char STATE_STR_EXECUTION_FAILURE[] = "execution failure"; constexpr static char STATE_STR_UNKNOWN_WORD[] = "unknown word"; +constexpr static char STATE_STR_RSTACK_OVERFLOW[] = "return stack overflow"; +constexpr static char STATE_STR_RSTACK_UNDERFLOW[] = "return stack underflow"; constexpr static char STATE_STR_UNKNOWN_STATE[] = "undefined state"; constexpr static char STATE_STR_ERROR_CODE[] = " (error code "; @@ -48,6 +50,14 @@ system_write_status(System *sys) buf = (char *)(STATE_STR_UNKNOWN_WORD); len = sizeof STATE_STR_UNKNOWN_WORD; break; + case STATUS_RSTACK_OVERFLOW: + buf = (char *)(STATE_STR_RSTACK_OVERFLOW); + len = sizeof STATE_STR_RSTACK_OVERFLOW; + break; + case STATUS_RSTACK_UNDERFLOW: + buf = (char *)(STATE_STR_RSTACK_UNDERFLOW); + len = sizeof STATE_STR_RSTACK_UNDERFLOW; + break; default: buf = (char *)(STATE_STR_UNKNOWN_STATE); len = sizeof STATE_STR_UNKNOWN_STATE; diff --git a/system.h b/system.h index 91aa1fa..79de2b3 100644 --- a/system.h +++ b/system.h @@ -10,16 +10,20 @@ typedef enum _SYS_STATUS : uint8_t { STATUS_STACK_OVERFLOW = 1, STATUS_STACK_UNDERFLOW = 2, STATUS_EXECUTION_FAILURE = 3, - STATUS_UNKNOWN_WORD = 4 + STATUS_UNKNOWN_WORD = 4, + STATUS_RSTACK_OVERFLOW = 5, + STATUS_RSTACK_UNDERFLOW = 6 } SYS_STATUS; class Word; typedef struct _System { Stack dstack; + Stack rstack; IO *interface; Word *dict; SYS_STATUS status; + uint8_t arena[ARENA_SIZE]; } System; void system_clear_error(System *sys); diff --git a/word.cc b/word.cc index 399b275..9e09188 100644 --- a/word.cc +++ b/word.cc @@ -33,6 +33,51 @@ Builtin::match(struct Token *token) void Builtin::getname(char *buf, size_t *buflen) +{ + memcpy(buf, this->name, this->namelen); + *buflen = namelen; +} + + +Address::Address(const char *name, size_t namelen, Word *head, KF_ADDR addr) + : prev(head), addr(addr) +{ + memcpy(this->name, name, namelen); + this->namelen = namelen; +} + +bool +Address::eval(System *sys) +{ + KF_INT a; + + a = static_cast(this->addr & mask(dshift)); + if (!sys->dstack.push(a)) { + return false; + } + + a = static_cast((this->addr >> dshift) & mask(dshift)); + if (!sys->dstack.push(a)) { + return false; + } + + return true; +} + +Word * +Address::next(void) +{ + return this->prev; +} + +bool +Address::match(struct Token *token) +{ + return match_token(this->name, this->namelen, token->token, token->length); +} + +void +Address::getname(char *buf, size_t *buflen) { memcpy(buf, this->name, this->namelen); *buflen = namelen; diff --git a/word.h b/word.h index 1989e88..03557df 100644 --- a/word.h +++ b/word.h @@ -14,6 +14,7 @@ public: virtual Word *next(void) = 0; virtual bool match(struct Token *) = 0; virtual void getname(char *, size_t *) = 0; + virtual uintptr_t address(void) = 0; }; class Builtin : public Word { @@ -25,6 +26,7 @@ public: Word *next(void); bool match(struct Token *); void getname(char *, size_t *); + uintptr_t address(void) { return reinterpret_cast(this); } private: char name[MAX_TOKEN_LENGTH]; size_t namelen; @@ -32,4 +34,21 @@ private: bool (*fun)(System *); }; +class Address : public Word { +public: + ~Address() {}; + Address(const char *name, size_t namelen, Word *head, KF_ADDR addr); + + bool eval(System *); + Word *next(void); + bool match(struct Token *); + void getname(char *, size_t *); + uintptr_t address(void) { return reinterpret_cast(this); } +private: + char name[MAX_TOKEN_LENGTH]; + size_t namelen; + Word *prev; + KF_ADDR addr; +}; + #endif // __KF_WORD_H__ \ No newline at end of file