major compliance refactor; undo packed literals for now

README.md

@@ -4,11 +4,17 @@
 
 Alee is a portable and concise Forth implementation in modern C++. Its primary aims are for reduced program size and execution efficiency. Portability includes bare-metal platforms, with intentions to support microcontrollers with kilobytes of memory.
 
-## Compatibility
+## Cross-platform compatibility
 
-A base dictionary is being built by working through the "core" and "core extension" [glossaries](https://forth-standard.org/standard/core). These word lists are included in `compat.txt`, with "yes" indicating that the word is implemented either in `core.fth` or within Alee itself.
+Alee relies on the C++17 standard. Alee *does not* rely on operating-system-specific functions, making portability easy. See the `msp430` target for an example of a port.
 
-A `sys` word is available to provide access to user-defined C++ functions.
+System-specific functionality such as text output is contained to a `sys` word. This word calls a user-supplied `user_sys` C++ function that should implement the necessary (or any additional) system-specific functionality.
+
+# Forth compatibility
+
+A base dictionary is being built by working through the "core" and "core extension" [glossaries](https://forth-standard.org/standard/core). These glossaries are listed in `compat.txt`, with "yes" indicating that the word is implemented either in `core.fth` or within Alee itself. `core.fth` may be compiled into a binary for loading on targets without filesystems.
+
+Alee Forth aims for compliance with common Forth standards like Forth 2012 and ANS Forth. Compliance is tested using a [Forth 2012 test suite](https://github.com/gerryjackson/forth2012-test-suite). Supported test files are in the `test` directory, with non-passing or unimplemented tests commented out.
 
 ## Building
 
@@ -16,4 +22,5 @@ Alee requires `make` and a C++17-compatible compiler.
 
 To compile, simply run the `make` command. This will produce a library, `libalee.a`, as well as a REPL binary named `alee`.  
 A `small` target exists that optimizes the build for size.  
+A `fast` target exists that optimizes for maximum performance on the host (not target) system.
 

alee.cpp

@@ -19,6 +19,7 @@
 #include "alee.hpp"
 #include "memdict.hpp"
 
+#include <charconv>
 #include <fstream>
 #include <iostream>
 #include <vector>
@@ -35,11 +36,7 @@ int main(int argc, char *argv[])
     State state (dict, readchar);
     Parser parser;
 
-    dict.write(Dictionary::Base, 10);
-    dict.write(Dictionary::Here, Dictionary::Begin);
-    dict.write(Dictionary::Latest, Dictionary::Begin);
-    dict.write(Dictionary::Compiling, 0);
-    dict.write(Dictionary::Postpone, 0);
+    dict.initialize();
 
     std::vector args (argv + 1, argv + argc);
     for (const auto& a : args) {
@@ -63,6 +60,8 @@ static void readchar(State& state)
         state.dict.writebyte(addr, state.dict.readbyte(addr + 1));
 
     auto c = std::cin.get();
+    if (isupper(c))
+        c += 32;
     state.dict.writebyte(addr, c ? c : ' ');
     state.dict.write(Dictionary::Input, len + 1);
 }
@@ -88,19 +87,31 @@ static void load(State& state)
 
 void user_sys(State& state)
 {
+    char buf[32] = {0};
+
     switch (state.pop()) {
-    case 0:
-        std::cout << state.pop() << ' ';
+    case 0: // .
+        std::to_chars(buf, buf + sizeof(buf), state.pop(),
+                      state.dict.read(Dictionary::Base));
+        std::cout << buf << ' ';
         break;
-    case 1:
+    case 1: // emit
         std::cout << static_cast<char>(state.pop());
         break;
-    case 2:
+    case 2: // save
         save(state);
         break;
-    case 3:
+    case 3: // load
         load(state);
         break;
+    case 4: // u.
+        {
+        Addr ucell = static_cast<Addr>(state.pop());
+        std::to_chars(buf, buf + sizeof(buf), ucell,
+                      state.dict.read(Dictionary::Base));
+        std::cout << buf << ' ';
+        }
+        break;
     }
 }
 
@@ -132,6 +143,12 @@ void parseLine(Parser& parser, State& state, const std::string& line)
             std::cout << "error: " << r << std::endl;
             break;
         }
+
+        while (state.size())
+            state.pop();
+        while (state.rsize())
+            state.popr();
+        state.dict.write(Dictionary::Compiling, 0);
     }
 }
 
@@ -140,6 +157,7 @@ void parseFile(Parser& parser, State& state, std::istream& file)
     while (file.good()) {
         std::string line;
         std::getline(file, line);
+
         if (line == "bye")
             exit(0);
 

core.fth

@@ -1,16 +1,19 @@
 : *        m* drop ;
-: /        0 swap _/ ;
-: %        0 swap _% ;
+: s>d      1 m* ;
+: /        >r s>d r> _/ ;
+: %        >r s>d r> _% ;
 
 : cell+    2 + ;
 : cells    2 * ;
 
 : .        0 sys ;
 : emit     1 sys ;
+: u.       4 sys ;
 
 : 1+       1 + ;
 : 1-       1 - ;
 
+: '        _' drop ;
 : !        1 _! ;
 : @        1 _@ ;
 : +!       dup >r swap r> @ + swap ! ;
@@ -19,13 +22,27 @@
 : here     1 cells @ ;
 : allot    1 cells +! ;
 : _latest  2 cells ;
-: imm      _latest @ dup @ 1 6 << | swap ! ;
+: imm      _latest @ dup @ 1 5 << | swap ! ;
+: immediate imm ;
 : state    3 cells ;
-: postpone 1 4 cells ! ; imm
-: _input   5 cells ;
+: _input   4 cells ;
 
 : ,        here ! 1 cells allot ;
 
+: [        0 state ! ; imm
+: ]        1 state ! ;
+
+: literal  [ ' _lit dup , , ] , , ; imm
+: [']      ' [ ' literal , ] ; imm
+
+: if       ['] _jmp0 , here 0 , ; imm
+: then     here swap ! ; imm
+: else     ['] _jmp , here 0 , swap here swap ! ; imm
+
+: postpone _' dup 0 = if exit then
+           1 = swap ['] _lit , , if ['] execute ,
+           else ['] , , then ; imm
+
 : over     1 pick ;
 : rot      >r swap r> swap ;
 : -rot     rot rot ;
@@ -46,11 +63,6 @@
 : decimal  10 base ! ;
 : hex      16 base ! ;
 
-: literal  1 , , ; imm
-: [']      ' postpone literal ; imm
-: [        0 state ! ; imm
-: ]        1 state ! ;
-
 : 2r>      ['] r> , ['] r> , ['] swap , ; imm
 : 2>r      ['] swap , ['] >r , ['] >r , ; imm
 : 2r@      ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm
@@ -61,16 +73,12 @@
 
 : 0=       0 = ;
 : 0<       0 < ;
-: <=       - 1- 0< ;
+: <=       2dup < >r = r> | ;
 : >        swap < ;
 : <>       = 0= ;
 : 0<>      0= 0= ;
 : 0>       0 > ;
 
-: if       ['] _jmp0 , here 0 , ; imm
-: then     here swap ! ; imm
-: else     ['] _jmp , here 0 , here rot ! ; imm
-
 : begin    0 here ; imm
 : while    swap 1+ swap postpone if -rot ; imm
 : repeat   ['] _jmp , , if postpone then then ; imm
@@ -81,21 +89,20 @@
 : ?do      ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if
            ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] exit ,
            postpone then postpone 2>r here ; imm
-: unloop   postpone 2r> ['] 2drop , ; imm
-: leave    postpone unloop postpone 2r>
+: unloop   postpone 2r> ['] 2drop , ['] r> , ['] drop , ; imm
+: leave    postpone 2r> ['] 2drop , postpone 2r>
            ['] drop , ['] >r , ['] exit , ; imm
 : +loop    postpone 2r> ['] 2dup , ['] swap , ['] < , ['] >r ,
            ['] rot , ['] + , ['] 2dup , ['] swap , ['] < ,
            ['] r> , ['] ^ , ['] -rot ,
            postpone 2>r ['] _jmp0 , ,
-           postpone unloop
-           here swap ! ['] r> , ['] drop , ; imm
+           postpone unloop here swap ! ; imm
 : loop     postpone 2r> ['] 1+ , ['] 2dup ,
            postpone 2>r ['] = , ['] _jmp0 , ,
-           postpone unloop
-           here swap ! ['] r> , ['] drop , ; imm
+           postpone unloop here swap ! ; imm
 : i        postpone r@ ; imm 
-: j        postpone 2r> postpone r@ ['] -rot , postpone 2>r ; imm
+: j        postpone 2r> ['] r> , postpone r@ ['] swap ,
+           ['] >r , ['] -rot , postpone 2>r ; imm
 
 : align    here 1 cells 1- tuck & if 1 cells swap - allot else drop then ;
 : aligned  dup 1 cells 1- tuck & if 1 cells swap - + else drop then ;
@@ -108,10 +115,10 @@
 : invert   -1 ^ ;
 : mod      % ;
 : 2*       2 * ;
-: 2/       2 / ;
+: _msb     1 1 cells 8 * 1- << ;
+: 2/       dup 1 >> swap 0< if _msb or then ;
 
 : /mod     2dup % -rot / ;
-: s>d      1 m* ;
 : */       >r m* r> _/ ;
 : */mod    >r m* 2dup r@ _% r> _/ ;
 : sm/rem   >r 2dup r@ _% -rot r> _/ ;
@@ -162,10 +169,8 @@
 
 : create   align here bl word count nip cell+ allot align
            ['] _lit , here 3 cells + , ['] exit dup , ,
-           dup @ 31 & over _latest @ - 7 << or over ! _latest ! ;
-: _latword _latest @
-           dup @ 31 & + cell+ aligned ;
-: _does>   _latword 2 cells +
+           dup @ 31 & over _latest @ - 6 << or over ! _latest ! ;
+: _does>   _latest @ dup @ 31 & + cell+ aligned 2 cells +
            ['] _jmp over ! cell+
            r@ 1 cells - @ swap ! ;
 : does>    ['] _jmp , here 2 cells + dup , 2 cells + ,
@@ -196,12 +201,14 @@
            postpone if ['] type , ['] abort ,
            postpone else ['] 2drop , postpone then ; imm
 
-: recurse  _latword , ; imm
+: recurse  depth 1- pick dup @ 31 & + cell+ aligned , ; imm
 
-: move     begin dup 0 > while
-           rot dup @ >r 1+
-           rot r> over ! 1+
-           rot 1- repeat drop 2drop ;
+: move     dup 0 <= if drop 2drop exit then
+           >r 2dup < r> swap if
+           1- 0 swap do over i + c@ over i + c! -1 +loop
+           else
+           0 do over i + c@ over i + c! loop
+           then 2drop ;
 : fill     -rot begin dup 0 > while
            >r 2dup c! char+ r> 1- repeat
            2drop drop ;

corewords.cpp

@@ -30,40 +30,29 @@ Word getword(State& state)
     }
     return word;
 }
-void newdef(Dictionary& dict, Word word)
+void newdef(State& state, Word word)
 {
+    auto& dict = state.dict;
+
     auto addr = dict.alignhere();
     dict.addDefinition(word);
-    dict.write(addr,
-        (dict.read(addr) & 0x1F) |
-        ((addr - dict.latest()) << 7));
-    dict.latest(addr);
+    state.push(addr);
 };
 void tick(State& state)
 {
     auto word = getword(state);
-    if (auto j = state.dict.find(word); j > 0)
+    if (auto j = state.dict.find(word); j > 0) {
         state.push(state.dict.getexec(j));
-    else if (auto i = CoreWords::findi(state, word); i >= 0)
-        state.push(((i & ~CoreWords::Immediate) << 1) | 1);
-    else
+        auto imm = state.dict.read(j) & CoreWords::Immediate;
+        state.push(imm ? 1 : -1);
+    } else if (auto i = CoreWords::findi(state, word); i >= 0) {
+        state.push(i);
+        state.push(i == CoreWords::Semicolon ? 1 : -1);
+    } else {
+        state.push(0);
         state.push(0);
+    }
 }
-//    auto addr = state.pop();
-//    auto count = state.dict.read(addr++);
-//    Word word (addr, addr + count);
-//
-//    if (auto j = state.dict.find(word); j > 0) {
-//        state.push(state.dict.getexec(j));
-//        auto imm = state.dict.read(ins) & CoreWords::Immediate;
-//        state.push(imm ? 1 : -1);
-//    } else if (auto i = CoreWords::findi(state, word); i >= 0) {
-//        state.push(((i & ~CoreWords::Immediate) << 1) | 1);
-//        state.push((i & CoreWords::Immediate) ? 1 : -1);
-//    } else {
-//        state.push(addr);
-//        state.push(0);
-//    }
 
 void CoreWords::run(unsigned int index, State& state)
 {
@@ -71,14 +60,14 @@ void CoreWords::run(unsigned int index, State& state)
     DoubleCell dcell;
 
 execute:
-    if ((index & 1) == 0) {
+    if (/*(index & 1) == 0 &&*/ index >= WordCount) {
         // must be calling a defined subroutine
         state.pushr(state.ip);
         state.ip = index;
         return;
-    } else switch ((index & 0x3E) >> 1) {
+    } else switch (index & 0x1F) {
     case 0: // _lit
-        state.push((index & 0xFF00) ? (index >> 8) - 1 : state.beyondip());
+        state.push(/*(index & 0xFF00) ? ((Addr)index >> 8u) - 1 :*/ state.beyondip());
         break;
     case 1: // drop
         state.pop();
@@ -144,11 +133,11 @@ execute:
         break;
     case 15: // equal
         cell = state.pop();
-        state.top() = state.top() == cell;
+        state.top() = state.top() == cell ? -1 : 0;
         break;
     case 16: // lt
         cell = state.pop();
-        state.top() = state.top() < cell;
+        state.top() = state.top() < cell ? -1 : 0;
         break;
     case 17: // and
         cell = state.pop();
@@ -164,14 +153,14 @@ execute:
         break;
     case 20: // shl
         cell = state.pop();
-        state.top() <<= cell;
+        reinterpret_cast<Addr&>(state.top()) <<= static_cast<Addr>(cell);
         break;
     case 21: // shr
         cell = state.pop();
-        state.top() >>= cell;
+        reinterpret_cast<Addr&>(state.top()) >>= static_cast<Addr>(cell);
         break;
     case 22: // colon
-        newdef(state.dict, getword(state));
+        newdef(state, getword(state));
         state.compiling(true);
         break;
     case 23: // tick
@@ -188,8 +177,16 @@ execute:
         }
         break;
     case 26: // semic
-        state.dict.add((findi("exit") << 1) | 1);
+        {
+        state.dict.add(findi("exit"));
         state.compiling(false);
+
+        auto addr = state.pop();
+        state.dict.write(addr,
+            (state.dict.read(addr) & 0x1F) |
+            ((addr - state.dict.latest()) << 6));
+        state.dict.latest(addr);
+        }
         break;
     case 27: // _jmp0
         if (state.pop()) {

corewords.hpp

@@ -29,7 +29,7 @@ class CoreWords
 public:
     constexpr static std::size_t WordCount = 32;
 
-    constexpr static Cell Immediate = (1 << 6);
+    constexpr static Cell Immediate = (1 << 5);
 
     constexpr static int Semicolon = 26;
 
@@ -43,7 +43,7 @@ private:
         "+\0-\0m*\0_/\0_%\0"
         "_@\0_!\0>r\0r>\0=\0"
         "<\0&\0|\0^\0"
-        "<<\0>>\0:\0'\0execute\0"
+        "<<\0>>\0:\0_'\0execute\0"
         "exit\0;\0_jmp0\0_jmp\0"
         "depth\0_rdepth\0_in\0";
 };

dictionary.cpp

@@ -21,6 +21,14 @@
 #include <cctype>
 #include <cstring>
 
+void Dictionary::initialize()
+{
+    write(Base, 10);
+    write(Here, Begin);
+    write(Latest, Begin);
+    write(Compiling, 0);
+}
+
 Addr Dictionary::allot(Cell amount) noexcept
 {
     Addr old = here();
@@ -62,7 +70,7 @@ Addr Dictionary::find(Word word) noexcept
     Addr lt = latest(), oldlt;
     do {
         oldlt = lt;
-        const Cell l = read(lt);
+        const auto l = static_cast<Addr>(read(lt));
         const Addr len = l & 0x1F;
         const Word lw {
             static_cast<Addr>(lt + sizeof(Cell)),
@@ -72,7 +80,7 @@ Addr Dictionary::find(Word word) noexcept
         if (equal(word, lw))
             return lt;
         else
-            lt -= l >> 7;
+            lt -= l >> 6;
     } while (lt != oldlt);
 
     return 0;
@@ -118,8 +126,15 @@ bool Dictionary::equal(Word word, const char *str, unsigned len) const noexcept
         return false;
 
     for (auto w = word.start; w != word.end; ++w) {
-        if (readbyte(w) != *str)
+        auto wc = readbyte(w);
+        if (wc != *str) {
+            if (isalpha(wc) && isalpha(*str) && (wc | 32) == (*str | 32)) {
+                ++str;
+                continue;
+            }
+
             return false;
+        }
 
         ++str;
     }
@@ -134,8 +149,15 @@ bool Dictionary::equal(Word word, Word other) const noexcept
 
     auto w = word.start, o = other.start;
     while (w != word.end) {
-        if (readbyte(w) != readbyte(o))
+        auto wc = readbyte(w), oc = readbyte(o);
+        if (wc != oc) {
+            if (isalpha(wc) && isalpha(oc) && (wc | 32) == (oc | 32)) {
+                ++w, ++o;
+                continue;
+            }
+
             return false;
+        }
 
         ++w, ++o;
     }

dictionary.hpp

@@ -31,10 +31,11 @@ public:
     constexpr static Addr Here       = sizeof(Cell);
     constexpr static Addr Latest     = sizeof(Cell) * 2;
     constexpr static Addr Compiling  = sizeof(Cell) * 3;
-    constexpr static Addr Postpone   = sizeof(Cell) * 4;
-    constexpr static Addr Input      = sizeof(Cell) * 5; // len data...
+    constexpr static Addr Input      = sizeof(Cell) * 4; // len data...
     constexpr static Addr InputCells = 80; // bytes!
-    constexpr static Addr Begin      = sizeof(Cell) * 6 + InputCells;
+    constexpr static Addr Begin      = sizeof(Cell) * 5 + InputCells;
+
+    void initialize();
 
     Addr here() const noexcept { return read(Here); }
     void here(Addr l) noexcept { write(Here, l); }

memdict.hpp

@@ -22,7 +22,7 @@
 #include "dictionary.hpp"
 
 #ifndef MEMDICTSIZE
-#define MEMDICTSIZE (4096)
+#define MEMDICTSIZE (65536)
 #endif
 constexpr unsigned long int MemDictSize = MEMDICTSIZE;
 

parser.cpp

@@ -59,27 +59,19 @@ int Parser::parseWord(State& state, Word word)
     if (ins <= 0) {
         ins = CoreWords::findi(state, word);
 
-        if (ins < 0) {
+        if (ins < 0)
             return parseNumber(state, word);
-        } else {
+        else
             imm = ins == CoreWords::Semicolon;
-            ins &= ~CoreWords::Immediate;
-            ins = (ins << 1) | 1;
-        }
     } else {
         imm = state.dict.read(ins) & CoreWords::Immediate;
         ins = state.dict.getexec(ins);
     }
 
-    if (state.dict.read(Dictionary::Postpone)) {
-        state.dict.add(ins);
-        state.dict.write(Dictionary::Postpone, 0);
-    } else if (state.compiling() && !imm) {
+    if (state.compiling() && !imm)
         state.dict.add(ins);
-    } else {
-        if (auto stat = state.execute(ins); stat != State::Error::none)
-            return static_cast<int>(stat);
-    }
+    else if (auto stat = state.execute(ins); stat != State::Error::none)
+        return static_cast<int>(stat);
 
     return 0;
 }
@@ -93,19 +85,20 @@ int Parser::parseNumber(State& state, Word word)
     buf[i] = '\0';
 
     auto base = state.dict.read(0);
-    Cell l;
-    auto [ptr, ec] = std::from_chars(buf, buf + i, l, base);
+    DoubleCell dl;
+    auto [ptr, ec] = std::from_chars(buf, buf + i, dl, base);
+    Cell l = static_cast<Cell>(dl);
 
     if (ec == std::errc() && ptr == buf + i) {
         if (state.compiling()) {
-            auto ins = (CoreWords::findi("_lit") << 1) | 1;
+            auto ins = CoreWords::findi("_lit");
 
-            if (l >= 0 && l < 0xFF) {
-                state.dict.add(ins | ((l + 1) << 8));
-            } else {
+            //if (l >= 0 && l < 0xFF) {
+            //    state.dict.add(ins | ((l + 1) << 8));
+            //} else {
                 state.dict.add(ins);
                 state.dict.add(l);
-            }
+            //}
         } else {
             state.push(l);
         }

test/tester.fr

@@ -0,0 +1,66 @@
+\ From: John Hayes S1I
+\ Subject: tester.fr
+\ Date: Mon, 27 Nov 95 13:10:09 PST  
+
+\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
+\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
+\ VERSION 1.2
+
+\ 24/11/2015 Replaced Core Ext word <> with = 0=
+\ 31/3/2015 Variable #ERRORS added and incremented for each error reported.
+\ 22/1/09 The words { and } have been changed to T{ and }T respectively to
+\ agree with the Forth 200X file ttester.fs. This avoids clashes with
+\ locals using { ... } and the FSL use of } 
+
+HEX
+
+\ SET THE FOLLOWING FLAG TO TRUE FOR MORE VERBOSE OUTPUT; THIS MAY
+\ ALLOW YOU TO TELL WHICH TEST CAUSED YOUR SYSTEM TO HANG.
+VARIABLE VERBOSE
+   FALSE VERBOSE !
+\   TRUE VERBOSE !
+
+: EMPTY-STACK   \ ( ... -- ) EMPTY STACK: HANDLES UNDERFLOWED STACK TOO.
+   DEPTH ?DUP IF DUP 0< IF NEGATE 0 DO 0 LOOP ELSE 0 DO DROP LOOP THEN THEN ;
+
+VARIABLE #ERRORS 0 #ERRORS !
+
+: ERROR      \ ( C-ADDR U -- ) DISPLAY AN ERROR MESSAGE FOLLOWED BY
+      \ THE LINE THAT HAD THE ERROR.
+   CR TYPE SOURCE TYPE       \ DISPLAY LINE CORRESPONDING TO ERROR
+   EMPTY-STACK               \ THROW AWAY EVERY THING ELSE
+   #ERRORS @ 1 + #ERRORS !
+\   QUIT  \ *** Uncomment this line to QUIT on an error
+;
+
+VARIABLE ACTUAL-DEPTH         \ STACK RECORD
+CREATE ACTUAL-RESULTS 20 CELLS ALLOT
+
+: T{      \ ( -- ) SYNTACTIC SUGAR.
+   ;
+
+: ->      \ ( ... -- ) RECORD DEPTH AND CONTENT OF STACK.
+   DEPTH DUP ACTUAL-DEPTH !      \ RECORD DEPTH
+   ?DUP IF            \ IF THERE IS SOMETHING ON STACK
+      0 DO ACTUAL-RESULTS I CELLS + ! LOOP \ SAVE THEM
+   THEN ;
+
+: }T      \ ( ... -- ) COMPARE STACK (EXPECTED) CONTENTS WITH SAVED
+      \ (ACTUAL) CONTENTS.
+   DEPTH ACTUAL-DEPTH @ = IF      \ IF DEPTHS MATCH
+      DEPTH ?DUP IF         \ IF THERE IS SOMETHING ON THE STACK
+         0  DO            \ FOR EACH STACK ITEM
+           ACTUAL-RESULTS I CELLS + @   \ COMPARE ACTUAL WITH EXPECTED
+           = 0= IF S" INCORRECT RESULT: " ERROR LEAVE THEN
+         LOOP
+      THEN
+   ELSE               \ DEPTH MISMATCH
+      S" WRONG NUMBER OF RESULTS: " ERROR
+   THEN ;
+
+: TESTING   \ ( -- ) TALKING COMMENT.
+  SOURCE VERBOSE @
+   IF DUP >R TYPE CR R> >IN !
+   ELSE >IN ! DROP [CHAR] * EMIT
+   THEN ;
+