bitgloo
/
alee-forth
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

major compliance refactor; undo packed literals for now

Browse Source
llvm
Clyne 2 years ago
parent d175fa6a88
commit 2ece0e4993
Signed by: clyne
GPG Key ID: 3267C8EBF3F9AFC7
11 changed files with 1238 additions and 110 deletions
Show Stats Download Patch File Download Diff File

15
README.md
Unescape Escape View File

@ -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. 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 ## Building
Alee requires `make` and a C++17-compatible compiler. 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`. 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.

38
alee.cpp
Unescape Escape View File

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

73
core.fth
Unescape Escape View File

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

63
corewords.cpp
Unescape Escape View File

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

4
corewords.hpp
Unescape Escape View File

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

30
dictionary.cpp
Unescape Escape View File

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

7
dictionary.hpp
Unescape Escape View File

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

2
memdict.hpp
Unescape Escape View File

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

33
parser.cpp
Unescape Escape View File

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

1017
test/core.fr
View File

File diff suppressed because it is too large Load Diff

66
test/tester.fr
Unescape Escape View File

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