major compliance refactor; undo packed literals for now

llvm
Clyne 2 years ago
parent d175fa6a88
commit 2ece0e4993
Signed by: clyne
GPG Key ID: 3267C8EBF3F9AFC7

@ -4,16 +4,23 @@
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
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 `small` target exists that optimizes the build for size.
A `fast` target exists that optimizes for maximum performance on the host (not target) system.

@ -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);

@ -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 ;

@ -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()) {

@ -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";
};

@ -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;
}

@ -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); }

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

@ -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);
}

File diff suppressed because it is too large Load Diff

@ -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 ;
Loading…
Cancel
Save