Merge branch 'native' of ssh://code.bitgloo.com:222/bitgloo/alee-forth into native

alee-standalone.cpp

@@ -40,6 +40,9 @@ int main(int argc, char *argv[])
     SplitMemDict<sizeof(alee_dat)> dict (alee_dat);
     State state (dict, readchar);
 
+    dict.initialize();
+    CoreWords::initialize(state);
+
     std::vector args (argv + 1, argv + argc);
     for (const auto& a : args) {
         std::ifstream file (a);

alee.cpp

@@ -46,6 +46,7 @@ int main(int argc, char *argv[])
 #endif // ALEE_MSP430
 
     dict.initialize();
+    CoreWords::initialize(state);
 
     {
         std::vector args (argv + 1, argv + argc);

forth/core.fth

@@ -99,10 +99,6 @@
 : j        postpone 2r> ['] r> , postpone r@ ['] swap ,
            ['] >r , ['] -rot , postpone 2>r ; imm
 
-: aligned  dup [ 1 cells 1- ] literal swap over & if [ 1 cells ] literal
-           swap - + else drop then ;
-: align    here dup aligned swap - allot ;
-
 : and      & ;
 : or       | ;
 : xor      ^ ;
@@ -114,6 +110,9 @@
 : _msb     [ 1 1 cells 8 * 1- << ] literal ;
 : 2/       dup 1 >> swap 0< if _msb or then ;
 
+: aligned  [ 1 cells 1- ] literal swap over + swap invert and ;
+: align    here dup aligned swap - allot ;
+
 : /mod     2dup % -rot / ;
 : */       >r m* r> _/ ;
 : sm/rem   >r 2dup r@ _% -rot r> _/ ;
@@ -221,8 +220,8 @@
            dup _isdigit - _uma
            r> char+ r> 1- repeat ;
 
-: <#       40 here c! ;
-: #>       2drop here dup c@ + 40 here c@ - ;
+: <#       [ 20 cells ] literal here c! ;
+: #>       2drop here dup c@ + [ 20 cells ] literal here c@ - ;
 : hold     -1 here +! here dup c@ + c! ;
 : #        base @
            >r 0 i um/mod r> swap >r um/mod r>

forth/tools.fth

@@ -6,8 +6,8 @@
 : words    _latest @ begin
            dup @ dup 31 &
            2 pick cell+ \ lt l len ws
-           2 pick 6 >> 1023 < if \ lt l len ws
-           rot 6 >> else \ lt len ws adv
+           2 pick 7 >> 1023 < if \ lt l len ws
+           rot 7 >> else \ lt len ws adv
            >r cell+ rot drop r> @ then
            -rot swap type space \ lt adv
            over _begin <> while - repeat 2drop ;

libalee/corewords.cpp

@@ -24,6 +24,48 @@ static void find(State&, Word);
 static DoubleCell popd(State&);
 static void pushd(State&, DoubleCell);
 
+LIBALEE_SECTION
+void CoreWords::initialize(State& state)
+{
+    auto& d = state.dict;
+    //d.addNativeWord("_lit", word_lit);
+    d.addNativeWord("drop", word_drop);
+    d.addNativeWord("dup", word_dup);
+    d.addNativeWord("swap", word_swap);
+    d.addNativeWord("pick", word_pick);
+    d.addNativeWord("sys", word_sys);
+    d.addNativeWord("+", word_add);
+    d.addNativeWord("-", word_sub);
+    d.addNativeWord("m*", word_mul);
+    d.addNativeWord("_/", word_div);
+    d.addNativeWord("_%", word_mod);
+    d.addNativeWord("_@", word_peek);
+    d.addNativeWord("_!", word_poke);
+    d.addNativeWord(">r", word_rpush);
+    d.addNativeWord("r>", word_rpop);
+    d.addNativeWord("=", word_eq);
+    d.addNativeWord("<", word_lt);
+    d.addNativeWord("&", word_and);
+    d.addNativeWord("|", word_or);
+    d.addNativeWord("^", word_xor);
+    d.addNativeWord("<<", word_shl);
+    d.addNativeWord(">>", word_shr);
+    d.addNativeWord(":", word_colon);
+    d.addNativeWord("_'", word_tick);
+    //d.addNativeWord("exit", word_exit);
+    //d.addNativeWord(";", word_semic);
+    d.addNativeWord("_jmp0", word_jmp0);
+    d.addNativeWord("_jmp", word_jmp);
+    d.addNativeWord("depth", word_depth);
+    d.addNativeWord("_rdepth", word_rdepth);
+    d.addNativeWord("_in", word_in);
+    d.addNativeWord("_ev", word_ev);
+    d.addNativeWord("find", word_find);
+    d.addNativeWord("_uma", word_uma);
+    d.addNativeWord("u<", word_ult);
+    d.addNativeWord("um/mod", word_ummod);
+}
+
 LIBALEE_SECTION
 void CoreWords::run(Cell ins, State& state)
 {
@@ -38,45 +80,18 @@ execute:
         return;
     } else switch (index) {
     case token("_lit"): word_lit(state); break;// Execution semantics of `literal`.
-    case token("drop"): word_drop(state); break;
-    case token("dup"): word_dup(state); break;
-    case token("swap"): word_swap(state); break;
-    case token("pick"): word_pick(state); break;
-    case token("sys"): word_sys(state); break; // Calls user-defined "system" handler.
-    case token("+"): word_add(state); break;
-    case token("-"): word_sub(state); break;
-    case token("m*"): word_mul(state); break; // ( n n -- d )
-    case token("_/"): word_div(state); break; // ( d n -- n )
-    case token("_%"): word_mod(state); break; // ( d n -- n )
-    case token("_@"): word_peek(state); break; // ( addr cell? -- n )
-    case token("_!"): word_poke(state); break; // ( n addr cell? -- )
-    case token(">r"): word_rpush(state); break;
-    case token("r>"): word_rpop(state); break;
-    case token("="): word_eq(state); break;
-    case token("<"): word_lt(state); break;
-    case token("&"): word_and(state); break;
-    case token("|"): word_or(state); break;
-    case token("^"): word_xor(state); break;
-    case token("<<"): word_shl(state); break;
-    case token(">>"): word_shr(state); break;
-    case token(":"): word_colon(state); break; // Begins definition/compilation of new word.
-    case token("_'"): word_tick(state); break; // Collects input word and finds execution token.
     case token("execute"):
         // TODO reimplement
         index = state.pop();
         goto execute;
     case token("exit"): word_exit(state); break;
     case token(";"): word_semic(state); break; // Concludes word definition.
-    case token("_jmp0"): word_jmp0(state); break; // Jump if popped value equals zero.
-    case token("_jmp"): word_jmp(state); break; // Unconditional jump.
-    case token("depth"): word_depth(state); break;
-    case token("_rdepth"): word_rdepth(state); break;
-    case token("_in"): word_in(state); break; // Fetches more input from the user input source.
-    case token("_ev"): word_ev(state); break; // Evaluates words from current input source.
-    case token("find"): word_find(state); break;
-    case token("_uma"): word_uma(state); break; // ( d u u -- d ): Unsigned multiply-add.
-    case token("u<"): word_ult(state); break;
-    case token("um/mod"): word_ummod(state); break;
+    case token("_nx"):
+        { auto f = state.beyondip();
+          state.ip() = state.popr();
+          ((void (*)(State&))f)(state);
+          state.verify(state.ip() != 0, Error::exit); }
+        break;
     }
 
     ip += sizeof(Cell);
@@ -147,17 +162,17 @@ void CoreWords::word_sub(State& state) {
 }
 void CoreWords::word_mul(State& state) { // ( n n -- d )
     auto cell = state.pop();
-    auto dcell = state.pop() * cell;
+    auto dcell = (DoubleCell)state.pop() * cell;
     pushd(state, dcell);
 }
 void CoreWords::word_div(State& state) { // ( d n -- n )
     auto cell = state.pop();
-    auto dcell = popd(state);
+    auto dcell = (DoubleCell)popd(state);
     state.push(static_cast<Cell>(dcell / cell));
 }
 void CoreWords::word_mod(State& state) { // ( d n -- n )
     auto cell = state.pop();
-    auto dcell = popd(state);
+    auto dcell = (DoubleCell)popd(state);
     state.push(static_cast<Cell>(dcell % cell));
 }
 void CoreWords::word_peek(State& state) { // ( addr cell? -- n )
@@ -233,7 +248,7 @@ void CoreWords::word_semic(State& state) { // Concludes word definition.
     state.compiling(false);
 
     auto cell = state.pop();
-    auto dcell = cell - state.dict.latest();
+    auto dcell = (DoubleCell)cell - state.dict.latest();
     if (dcell >= Dictionary::MaxDistance) {
         // Large distance to previous entry: store in dedicated cell.
         state.dict.write(static_cast<Addr>(cell) + sizeof(Cell),

libalee/corewords.hpp

@@ -43,6 +43,8 @@ void user_sys(State& state);
 class CoreWords
 {
 public:
+    static void initialize(State& state);
+
     /**
      * Searches for the token/index of the given word if it is part of the
      * fundamental word-set.
@@ -81,7 +83,7 @@ public:
         "<<\0>>\0:\0_'\0execute\0"
         "exit\0;\0_jmp0\0_jmp\0"
         "depth\0_rdepth\0_in\0_ev\0find\0"
-        "_uma\0u<\0um/mod\0";
+        "_uma\0u<\0um/mod\0_nx\0";
 
     /**
      * Count of total fundamental words.
@@ -114,6 +116,7 @@ private:
         return -1;
     }
 
+public:
     static void word_lit(State&);
     static void word_drop(State&);
     static void word_dup(State&);

libalee/dictionary.cpp

@@ -28,6 +28,22 @@ void Dictionary::initialize()
     write(Source, Input + sizeof(Cell));
 }
 
+LIBALEE_SECTION
+void Dictionary::addNativeWord(const char *s, void (*func)(State&))
+{
+    const Addr h = read(Here);
+    Addr n = h + sizeof(Cell);
+    for (; *s; ++s, ++n)
+        writebyte(n, *s);
+    addDefinition(Word(h + sizeof(Cell), n));
+    add(CoreWords::token("_nx"));
+    add((Cell)func);
+
+    const auto dcell = h - latest();
+    write(h, (read(h) & 0x1F) | Native | static_cast<Cell>(dcell << DistancePos));
+    latest(h);
+}
+
 LIBALEE_SECTION
 Addr Dictionary::allot(Cell amount) noexcept
 {
@@ -91,14 +107,14 @@ Addr Dictionary::find(Word word) noexcept
         const Addr len = l & 0x1F;
         Word lw;
 
-        if ((l >> Dictionary::DistancePos) < MaxDistance) {
+        if ((l >> DistancePos) < MaxDistance) {
             lw = Word::fromLength(lt + sizeof(Cell), len);
             if (equal(word, lw))
                 return lt;
             else if (lt == Begin)
                 break;
             else
-                lt -= l >> Dictionary::DistancePos;
+                lt -= l >> DistancePos;
         } else {
             lw = Word::fromLength(lt + 2 * sizeof(Cell), len);
             if (equal(word, lw))
@@ -120,7 +136,7 @@ Addr Dictionary::getexec(Addr addr) noexcept
     const Addr len = l & 0x1Fu;
 
     addr += sizeof(Cell);
-    if ((l >> Dictionary::DistancePos) == MaxDistance)
+    if ((l >> DistancePos) == MaxDistance)
         addr += sizeof(Cell);
 
     addr += len;

libalee/dictionary.hpp

@@ -75,6 +75,7 @@ public:
     constexpr static Cell Immediate = (1 << 5);
 
     constexpr static Cell DistancePos = 6;
+
     /** Maximum "short" distance between two definitions. */
     constexpr static Cell MaxDistance = (1 << (sizeof(Cell) * 8 - DistancePos)) - 1;
 
@@ -157,6 +158,8 @@ public:
      */
     void addDefinition(Word word) noexcept;
 
+    void addNativeWord(const char *s, void (*func)(State&));
+
     /**
      * Searches the dictionary for an entry for the given word.
      * @param word The dictionary-stored word to search for.