diff --git a/alee-standalone.cpp b/alee-standalone.cpp index 9f5eae5..95c72e5 100644 --- a/alee-standalone.cpp +++ b/alee-standalone.cpp @@ -40,6 +40,9 @@ int main(int argc, char *argv[]) SplitMemDict 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); diff --git a/alee.cpp b/alee.cpp index cc9abde..e8194c6 100644 --- a/alee.cpp +++ b/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); diff --git a/forth/core.fth b/forth/core.fth index d198583..ff4c18f 100644 --- a/forth/core.fth +++ b/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> diff --git a/forth/tools.fth b/forth/tools.fth index b27955d..3cee2bf 100644 --- a/forth/tools.fth +++ b/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 ; diff --git a/libalee/corewords.cpp b/libalee/corewords.cpp index 8ff7ac6..c564cdb 100644 --- a/libalee/corewords.cpp +++ b/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(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(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(cell) + sizeof(Cell), diff --git a/libalee/corewords.hpp b/libalee/corewords.hpp index 959d2e8..5d2e5ca 100644 --- a/libalee/corewords.hpp +++ b/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&); diff --git a/libalee/dictionary.cpp b/libalee/dictionary.cpp index 0abc038..e946c59 100644 --- a/libalee/dictionary.cpp +++ b/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(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; diff --git a/libalee/dictionary.hpp b/libalee/dictionary.hpp index 78bc19d..d465e60 100644 --- a/libalee/dictionary.hpp +++ b/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.