do loops, executor fixes

README.md

@@ -4,22 +4,16 @@
 
 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.
 
-## Built-in words
+## Compatibility
 
-```
-drop dup swap pick rot >r r>
-here allot const imm @ ! : ; (
-+ - * / %
-= <
-& | ^ << >>
-sys
-```
+A base dictionary is being built following the "core" [glossary](https://forth-standard.org/standard/core). Progress on implementation of these words is documented in `compat.txt`.
 
-The `sys` word links to a C++ function for user-defined functionality.
+A `sys` is available which links to a C++ function for user-defined functionality.
 
 ## Building
 
 Alee requires `make` and a C++17-compatible compiler.
 
-To compile, simply run the `make` command. The resulting binary, `alee`, runs a read-eval-print loop.
+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.
 

alee.cpp

@@ -67,10 +67,10 @@ void user_sys(State& state)
 {
     switch (state.pop()) {
     case 0:
-        std::cout << state.pop() << std::endl;
+        std::cout << state.pop() << ' ';
         break;
     case 1:
-        std::cout << static_cast<char>(state.pop()) << std::endl;
+        std::cout << static_cast<char>(state.pop());
         break;
     }
 }
@@ -81,7 +81,7 @@ void parseLine(Parser& parser, State& state, std::string_view line)
 
     if (r == ParseStatus::Finished) {
         if (okay)
-            std::cout << " ok" << std::endl;
+            std::cout << "ok" << std::endl;
     } else {
         std::cout << to_string(r) << ": " << line << std::endl;
     }

compat.txt

@@ -0,0 +1,136 @@
+6.1 Core words
+
+yes 6.1.0010 !
+    6.1.0030 #
+    6.1.0040 #>
+    6.1.0050 #S
+yes 6.1.0070 '
+yes 6.1.0080 (
+yes 6.1.0090 *
+    6.1.0100 */
+    6.1.0110 */MOD
+yes 6.1.0120 +
+yes 6.1.0130 +!
+yes 6.1.0140 +LOOP
+yes 6.1.0150 ,
+yes 6.1.0160 -
+yes 6.1.0180 .
+    6.1.0190 ."
+yes 6.1.0230 /
+    6.1.0240 /MOD
+yes 6.1.0250 0<
+yes 6.1.0270 0=
+yes 6.1.0290 1+
+yes 6.1.0300 1-
+yes 6.1.0310 2!
+yes 6.1.0320 2*
+yes 6.1.0330 2/
+yes 6.1.0350 2@
+yes 6.1.0370 2DROP
+yes 6.1.0380 2DUP
+yes 6.1.0400 2OVER
+yes 6.1.0430 2SWAP
+yes 6.1.0450 :
+yes 6.1.0460 ;
+yes 6.1.0480 <
+    6.1.0490 <#
+yes 6.1.0530 =
+yes 6.1.0540 >
+    6.1.0550 >BODY
+    6.1.0560 >IN
+    6.1.0570 >NUMBER
+yes 6.1.0580 >R
+yes 6.1.0630 ?DUP
+yes 6.1.0650 @
+    6.1.0670 ABORT
+    6.1.0680 ABORT"
+yes 6.1.0690 ABS
+    6.1.0695 ACCEPT
+yes 6.1.0705 ALIGN
+yes 6.1.0706 ALIGNED
+yes 6.1.0710 ALLOT
+yes 6.1.0720 AND
+yes 6.1.0750 BASE
+yes 6.1.0760 BEGIN
+yes 6.1.0770 BL
+yes 6.1.0850 C!
+yes 6.1.0860 C,
+yes 6.1.0870 C@
+yes 6.1.0880 CELL+
+yes 6.1.0890 CELLS
+    6.1.0895 CHAR
+yes 6.1.0897 CHAR+
+yes 6.1.0898 CHARS
+    6.1.0950 CONSTANT
+    6.1.0980 COUNT
+yes 6.1.0990 CR
+    6.1.1000 CREATE
+yes 6.1.1170 DECIMAL
+yes 6.1.1200 DEPTH
+yes 6.1.1240 DO
+    6.1.1250 DOES>
+yes 6.1.1260 DROP
+yes 6.1.1290 DUP
+yes 6.1.1310 ELSE
+yes 6.1.1320 EMIT
+    6.1.1345 ENVIRONMENT?
+    6.1.1360 EVALUATE
+yes 6.1.1370 EXECUTE
+yes 6.1.1380 EXIT
+    6.1.1540 FILL
+    6.1.1550 FIND
+    6.1.1561 FM/MOD
+yes 6.1.1650 HERE
+    6.1.1670 HOLD
+yes 6.1.1680 I
+yes 6.1.1700 IF
+yes 6.1.1710 IMMEDIATE (as "imm")
+    6.1.1720 INVERT
+    6.1.1730 J
+yes 6.1.1750 KEY
+    6.1.1760 LEAVE
+yes 6.1.1780 LITERAL
+yes 6.1.1800 LOOP
+yes 6.1.1805 LSHIFT
+    6.1.1810 M*
+yes 6.1.1870 MAX
+yes 6.1.1880 MIN
+yes 6.1.1890 MOD
+    6.1.1900 MOVE
+yes 6.1.1910 NEGATE
+yes 6.1.1980 OR
+yes 6.1.1990 OVER
+yes 6.1.2033 POSTPONE
+    6.1.2050 QUIT
+yes 6.1.2060 R>
+yes 6.1.2070 R@
+    6.1.2120 RECURSE
+yes 6.1.2140 REPEAT
+yes 6.1.2160 ROT
+yes 6.1.2162 RSHIFT
+    6.1.2165 S"
+    6.1.2170 S>D
+    6.1.2210 SIGN
+    6.1.2214 SM/REM
+    6.1.2216 SOURCE
+yes 6.1.2220 SPACE
+    6.1.2230 SPACES
+yes 6.1.2250 STATE
+yes 6.1.2260 SWAP
+yes 6.1.2270 THEN
+    6.1.2310 TYPE
+    6.1.2320 U.
+    6.1.2340 U<
+    6.1.2360 UM*
+    6.1.2370 UM/MOD
+    6.1.2380 UNLOOP
+yes 6.1.2390 UNTIL
+    6.1.2410 VARIABLE
+yes 6.1.2430 WHILE
+    6.1.2450 WORD
+yes 6.1.2490 XOR
+    6.1.2500 [
+yes 6.1.2510 [']
+    6.1.2520 [CHAR]
+    6.1.2540 ]
+

core.fth

@@ -1,6 +1,9 @@
 ( : variable create 0 , ; )
 ( : create here const ; )
 
+: .        0 sys ;
+: emit     1 sys ;
+
 : 1+       1 + ;
 : 1-       1 - ;
 
@@ -15,6 +18,29 @@
 : nip      swap drop ;
 : tuck     swap over ;
 
+: 2drop    drop drop ;
+: 2dup     over over ;
+: 2over    3 pick 3 pick ;
+: 2swap    rot >r rot r> ;
+
+: c!       1 _! ;
+: c@       1 _@ ;
+: c,       here c! 1 allot ;
+: char+    1+ ;
+: chars    ;
+
+: 2r>      r> r> swap ;
+: 2>r      swap >r >r ;
+
+: 2!       swap over ! cell+ ! ;
+: 2@       dup cell+ @ swap @ ;
+: +!       swap over @ + swap ! ;
+
+: 0=       0 = ;
+: 0<       0 < ;
+: <=       - 1- 0< ;
+: >        <= 0= ;
+
 : base     0 ;
 : state    2 ;
 : decimal  1 1+ base ! 1010 base ! ;
@@ -22,24 +48,27 @@
 : postpone 1 4 ! ; imm
 : [']      ' postpone literal ; imm
 
+: r@       ['] r> , ['] dup , ['] >r , ; imm
+
 : if       ['] _jmp0 , here 0 , ; imm
 : then     here swap ! ; imm
 : else     ['] _jmp , here 0 , here rot ! ; imm
 
-: c!       1 _! ;
-: c@       1 _@ ;
-: c,       here c! 1 allot ;
-: char+    1+ ;
-: chars    ;
+: begin    here 0 ; imm
+: while    1+ postpone if swap ; imm
+: repeat   ['] _jmp , if swap , postpone then else , then ; imm
+: until    drop ['] _jmp0 , , ; imm
+
+: do       ['] swap , ['] >r , ['] >r , here ; imm
+: +loop    ['] r> , ['] r> , ['] swap , ['] rot , ['] + , ['] 2dup ,
+           ['] swap , ['] >r , ['] >r , ['] - , ['] 0= ,
+           ['] _jmp0 , , ['] r> , ['] r> , ['] swap , ['] 2drop , ; imm
+: loop     1 postpone literal postpone +loop ; imm
+: i        postpone r@ ; imm 
 
 : align    here 1 & if 1 allot then ;
 : aligned  dup 1 & if 1+ then ;
 
-: .        0 sys ;
-: emit     1 sys ;
-
-: +!       swap over @ + swap ! ;
-
 : and      & ;
 : or       | ;
 : xor      ^ ;
@@ -49,20 +78,6 @@
 : 2*       2 * ;
 : 2/       2 / ;
 
-: 2drop    drop drop ;
-: 2dup     over over ;
-: 2over    3 pick 3 pick ;
-: 2swap    rot >r rot r> ;
-
-: r@       r> dup >r ;
-: 2!       swap over ! cell+ ! ;
-: 2@       dup cell+ @ swap @ ;
-
-: 0=       0 = ;
-: 0<       0 < ;
-: <=       - 1- 0< ;
-: >        <= 0= ;
-
 : cr       9 emit ;
 : bl       32 ;
 : space    bl emit ;
@@ -73,7 +88,3 @@
 : abs      dup 0< if negate then ;
 : min      2dup <= if drop else nip then ;
 : max      2dup <= if nip else drop then ;
-
-
-: begin    here ; imm
-: do       postpone >r postpone >r here ; imm

corewords.cpp

@@ -185,7 +185,7 @@ void CoreWords::op_tick(State& state) {
     if (auto i = CoreWords::findi(state, word); i >= 0) {
         xt = i & ~CoreWords::Compiletime;
     } else if (auto j = state.dict.find(word); j > 0) {
-        xt = state.dict.getexec(j) - sizeof(Cell);
+        xt = state.dict.getexec(j);
     }
 
     state.push(xt);
@@ -256,7 +256,7 @@ void CoreWords::op_literal(State& state)
 void CoreWords::op_jump(State& state)
 {
     state.pushr(state.ip + sizeof(Cell));
-    state.ip = state.beyondip() - sizeof(Cell);
+    op_jmp(state);
 }
 
 void CoreWords::op_jmp(State& state)
@@ -280,8 +280,10 @@ void CoreWords::op_depth(State& state)
 void CoreWords::op_key(State& state)
 {
     auto len = state.dict.read(Dictionary::Input);
-    while (len <= 0)
+    while (len <= 0) {
         state.input(state);
+        len = state.dict.read(Dictionary::Input);
+    }
 
     state.dict.write(Dictionary::Input, len - 1);
     Addr addr = Dictionary::Input + sizeof(Cell) +
@@ -337,11 +339,16 @@ Func CoreWords::find(State& state, Word word)
     return i >= 0 ? get(i & ~Compiletime) : nullptr;
 }
 
-void CoreWords::run(int i, State& state)
+struct corewords_run {};
+
+bool CoreWords::run(int i, State& state)
 {
     i &= ~Compiletime;
 
-    if (i >= 0 && i < WordCount)
+    bool isaword = i >= 0 && i < WordCount;
+    if (isaword)
         get(i)(state);
+
+    return isaword;
 }
 

corewords.hpp

@@ -39,7 +39,7 @@ public:
     static int findi(std::string_view);
     static int findi(State&, Word);
     static Func find(State&, Word);
-    static void run(int, State&);
+    static bool run(int, State&);
 
 private:
     // Ends with '\0': regular word

dictionary.cpp

@@ -32,11 +32,17 @@ void Dictionary::add(Cell value)
     write(allot(sizeof(Cell)), value);
 }
 
-Addr Dictionary::alignhere()
+Addr Dictionary::aligned(Addr addr) const noexcept
 {
-    if (here & (sizeof(Cell) - sizeof(uint8_t)))
-        here = (here + sizeof(Cell)) & ~(sizeof(Cell) - sizeof(uint8_t));
+    if (addr & (sizeof(Cell) - sizeof(uint8_t)))
+        addr = (addr + sizeof(Cell)) & ~(sizeof(Cell) - sizeof(uint8_t));
+
+    return addr;
+}
 
+Addr Dictionary::alignhere()
+{
+    here = aligned(here);
     return here;
 }
 
@@ -45,13 +51,12 @@ void Dictionary::addDefinition(Word word)
     add(word.size());
     for (unsigned i = 0; i < word.size(); ++i)
         writebyte(allot(1), readbyte(word.start + i));
+
+    alignhere();
 }
 
 Addr Dictionary::find(Word word)
 {
-    if (latest == 0)
-        return 0;
-
     Addr lt = latest, oldlt;
     do {
         oldlt = lt;
@@ -74,7 +79,7 @@ Addr Dictionary::find(Word word)
 Addr Dictionary::getexec(Addr addr)
 {
     const auto len = read(addr) & 0x1F;
-    return addr + sizeof(Cell) + len;
+    return aligned(addr + sizeof(Cell) + len);
 }
 
 Word Dictionary::input()

dictionary.hpp

@@ -44,6 +44,7 @@ public:
     virtual void writebyte(Addr, uint8_t) = 0;
 
     Addr alignhere();
+    Addr aligned(Addr) const noexcept;
     Addr allot(Cell);
     void add(Cell);
     void addDefinition(Word);

state.cpp

@@ -49,7 +49,12 @@ void State::execute(Addr addr)
 
         do {
             ip += sizeof(Cell);
-            CoreWords::run(dict.read(ip), *this);
+
+            const auto ins = dict.read(ip);
+            if (!CoreWords::run(ins, *this)) {
+                pushr(ip);
+                ip = ins - sizeof(Cell);
+            }
         } while (ip);
     }
 }