static void ummult(void)
{
const ucell u2 = POP();
const ucell u1 = POP();
#ifdef NEED_FAKE_INT128_T
ducell c;
if (0) { // XXX How to detect overflow?
fprintf(stderr, "ummult called (%016llx * 0x%016llx)\n", u1, u2);
exit(-1);
}
c.hi = 0;
c.lo = u1 * u2;
DPUSH(c);
#else
DPUSH((ducell) u1 * u2);
#endif
}
static void dminus(void)
{
const dcell d2 = DPOP();
const dcell d1 = DPOP();
#ifdef NEED_FAKE_INT128_T
ducell c;
if (d1.hi != 0 || d2.hi != 0) {
fprintf(stderr, "dminus called (0x%016llx %016llx + 0x%016llx %016llx)\n",
d1.hi, d1.lo, d2.hi, d2.lo);
exit(-1);
}
c.hi = 0;
c.lo = d1.lo - d2.lo;
DPUSH(c);
#else
DPUSH(d1 - d2);
#endif
}
static void mudivmod(void)
{
const ucell b = POP();
const ducell a = DPOP();
#ifdef NEED_FAKE_INT128_T
if (a.hi != 0) {
fprintf(stderr, "mudivmod called (0x%016llx %016llx / 0x%016llx)\n",
a.hi, a.lo, b);
exit(-1);
} else {
ducell c;
PUSH(a.lo % b);
c.hi = 0;
c.lo = a.lo / b;
DPUSH(c);
}
#else
PUSH(a % b);
DPUSH(a / b);
#endif
}
void SimForth::interpreteWordCaseInterprete(std::string const& word)
{
ASpreadSheetCell *c;
if ((c = isACell(word)) != nullptr)
{
//std::cout << "interpreteWordCaseInterprete: cell " << word << std::endl;
auto cell = c->value();
if (!cell.first)
{
abort("Cell not yet evaluated");
}
Cell32 number = cell.second;
DPUSH(number);
isStackUnderOverFlow(forth::DataStack);
}
else
{
//std::cout << "interpreteWordCaseInterprete: forth " << word << std::endl;
Forth::interpreteWordCaseInterprete(word);
}
}
// **************************************************************
//! \param idPrimitive the token of a primitive else an exception
//! is triggered.
//! UnknownForthPrimitive if idPrimitive is not the token of a
//! primitive (idPrimitive >= NUM_PRIMITIVES).
//! \throw UnfinishedStream called by Forth::nextWord() if the
//! stream does not contain a Forth word.
//! \throw UnknownForthWord if the extracted word by Forth::nextWord()
//! is not present in the dictionary.
//! \throw AbortForth if triggered by the Forth word ABORT.
//! \throw ModifiedStackDepth if the data stack depth is modified
//! during a definition.
//! \throw OutOfBoundDictionary if attempting to store data outside
//! the dictionary bounds.
//! \throw NoSpaceDictionary if attempting to add a new entry in a
//! full dictionary.
// **************************************************************
void Forth::execPrimitive(const Cell16 idPrimitive)
{
//std::cout << "execPrimitive " << idPrimitive << std::endl;
switch (idPrimitive)
{
// Dummy word / No operation
case FORTH_PRIMITIVE_NOP:
std::cout << "NOP\n";
break;
// Begin of commentary
case FORTH_PRIMITIVE_LPARENTHESIS:
m_saved_state = m_state;
m_state = forth::Comment;
break;
// End of commentary
case FORTH_PRIMITIVE_RPARENTHESIS:
m_state = m_saved_state;
break;
// Line of commentary
case FORTH_PRIMITIVE_COMMENTARY:
STREAM.skipLine();
break;
// Begin the definition of a new word
case FORTH_PRIMITIVE_COLON:
create(nextWord());
m_state = forth::Compile;
break;
// End the definition of a new word
case FORTH_PRIMITIVE_SEMICOLON:
m_dictionary.appendCell16(FORTH_PRIMITIVE_EXIT);
m_state = forth::Interprete;
if (m_depth_at_colon != stackDepth(forth::DataStack))
{
m_dictionary.m_last = m_last_at_colon;
m_dictionary.m_here = m_here_at_colon;
ModifiedStackDepth e(m_creating_word);
throw e;
}
break;
// Push in data stack the next free slot in the dictionary
case FORTH_PRIMITIVE_PCREATE:
DPUSH(m_tos);
m_tos = m_ip + 4U;
break;
// Give a name to the next free slot in the dictionary.
// (note: HERE is not moved)
// https://fr.wikiversity.org/wiki/Forth/Conserver_des_donn%C3%A9es
case FORTH_PRIMITIVE_CREATE:
create(nextWord());
m_dictionary.appendCell16(FORTH_PRIMITIVE_PCREATE);
m_dictionary.appendCell16(FORTH_PRIMITIVE_EXIT);
break;
case FORTH_PRIMITIVE_BUILDS:
create(nextWord());
break;
case FORTH_PRIMITIVE_DOES:
break;
// Set immediate the last word
case FORTH_PRIMITIVE_IMMEDIATE:
m_dictionary.m_dictionary[m_dictionary.m_last] |= FLAG_IMMEDIATE;
break;
case FORTH_PRIMITIVE_INCLUDE:
// Restore TOS register (because execToken() poped TOS)
DPUSH(m_tos);
includeFile(nextWord());
DPOP(m_tos);
break;
case FORTH_PRIMITIVE_STATE:
DPUSH(m_tos);
m_tos = m_state;
break;
case FORTH_PRIMITIVE_TRACE_ON:
LOGI("Forth trace: ON");
m_trace = true;
break;
case FORTH_PRIMITIVE_TRACE_OFF:
LOGI("Forth trace: OFF");
m_trace = false;
break;
case FORTH_PRIMITIVE_SMUDGE:
{
std::string const& word = nextWord();
if (false == m_dictionary.smudge(word))
{
std::cout << FORTH_WARNING_COLOR << "[WARNING] Unknown word '"
<< word << "'. Word SMUDGE Ignored !"
<< FORTH_NORMAL_COLOR << std::endl;
}
}
break;
case FORTH_PRIMITIVE_TICK:
{
std::string const& word = nextWord();
Cell16 token;
bool immediate;
if (false == m_dictionary.find(word, token, immediate))
{
token = 0;
std::cout << FORTH_WARNING_COLOR << "[WARNING] Unknown word '"
<< word << "'. Word TICK Ignored !"
<< FORTH_NORMAL_COLOR << std::endl;
}
DPUSH(m_tos);
m_tos = token;
}
break;
case FORTH_PRIMITIVE_COMPILE:
m_ip += 2;
m_dictionary.appendCell16(m_dictionary.read16at(m_ip));
break;
// Append to the dictionary the next word
case FORTH_PRIMITIVE_ICOMPILE:
{
Cell16 token;
bool immediate;
std::string const& word = nextWord();
//m_ip += 2;
if (m_dictionary.find(word, token, immediate))
{
m_dictionary.appendCell16(token);
}
else
{
UnknownForthWord e(word); throw e;
}
}
break;
// ANSI word to replace [COMPILE] and COMPILE
case FORTH_PRIMITIVE_POSTPONE:
{
Cell16 token;
bool immediate;
std::string const& word = nextWord();
if (m_dictionary.find(word, token, immediate))
{
if (immediate)
{
m_dictionary.appendCell16(token);
}
else
{
m_ip += 2;
m_dictionary.appendCell16(m_dictionary.read16at(m_ip));
}
}
else
{
UnknownForthWord e(word); throw e;
}
}
break;
case FORTH_PRIMITIVE_ABORT:
abort("COUCOU");
break;
case FORTH_PRIMITIVE_EXECUTE:
execToken(m_tos);
break;
case FORTH_PRIMITIVE_LBRACKET:
m_state = forth::Interprete;
break;
case FORTH_PRIMITIVE_RBRACKET:
m_state = forth::Compile;
break;
case FORTH_PRIMITIVE_HERE:
DPUSH(m_tos);
m_tos = m_dictionary.here();
break;
case FORTH_PRIMITIVE_LAST:
DPUSH(m_tos);
m_tos = m_dictionary.last();
break;
case FORTH_PRIMITIVE_ALLOT:
m_dictionary.allot((int32_t) m_tos);
DPOP(m_tos);
break;
// Reserve one cell of data space and store x in the cell.
case FORTH_PRIMITIVE_COMMA32:
m_dictionary.appendCell32(m_tos);
DPOP(m_tos);
break;
// Reserve one cell of data space and store x in the cell.
case FORTH_PRIMITIVE_COMMA16:
m_dictionary.appendCell16(m_tos);
DPOP(m_tos);
break;
// Reserve one cell of data space and store x in the cell.
case FORTH_PRIMITIVE_COMMA8:
m_dictionary.appendCell8(m_tos);
DPOP(m_tos);
break;
// ( a-addr -- x )
// x is the value stored at a-addr.
case FORTH_PRIMITIVE_FETCH:
m_tos = m_dictionary.read32at(m_tos);
break;
// Store x at a-addr.
// ( x a-addr -- )
case FORTH_PRIMITIVE_STORE32:
DPOP(m_tos1);
m_dictionary.write32at(m_tos, m_tos1);
DPOP(m_tos);
break;
case FORTH_PRIMITIVE_STORE16:
DPOP(m_tos1);
m_dictionary.write16at(m_tos, m_tos1);
DPOP(m_tos);
break;
case FORTH_PRIMITIVE_STORE8:
DPOP(m_tos1);
m_dictionary.write8at(m_tos, m_tos1);
DPOP(m_tos);
break;
/* ( src dst n -- ) */
case FORTH_PRIMITIVE_CMOVE:
DPOP(m_tos2); // dst
DPOP(m_tos1); // src
m_dictionary.move(m_tos2, m_tos1, m_tos);
DPOP(m_tos);
break;
/* case FORTH_PRIMITIVE_THROW:
if (m_tos)
{
M_THROW(m_tos);
}
else DPOP(m_tos);
break;*/
// Restore the IP when interpreting the definition
// of a non primitive word
case FORTH_PRIMITIVE_EXIT:
RPOP(m_ip);
if (m_trace) {
std::cout << "POPed: " << std::hex << (int) m_ip << std::endl;
}
break;
// Change IP
case FORTH_PRIMITIVE_BRANCH:
m_ip += m_dictionary.read16at(m_ip + 2U);
// Do not forget that m_ip will be += 2 next iteration
break;
// Change IP if top of stack is 0
case FORTH_PRIMITIVE_0BRANCH:
if (0 == m_tos)
{
m_ip += m_dictionary.read16at(m_ip + 2U);
}
else
{
m_ip += 2U;
}
// Do not forget that m_ip will be += 2 next iteration
DPOP(m_tos);
break;
// Move x to the return stack.
// ( x -- ) ( R: -- x )
case FORTH_PRIMITIVE_TO_RSTACK:
RPUSH(m_tos);
DPOP(m_tos);
break;
// Transfer cell pair x1 x2 to the return stack
// ( x1 x2 -- ) ( R: -- x1 x2 )
case FORTH_PRIMITIVE_2TO_RSTACK:
DPOP(m_tos1);
RPUSH(m_tos1);
RPUSH(m_tos);
DPOP(m_tos);
break;
case FORTH_PRIMITIVE_FROM_RSTACK:
DPUSH(m_tos);
RPOP(m_tos);
break;
case FORTH_PRIMITIVE_2FROM_RSTACK:
DPUSH(m_tos);
RPOP(m_tos);
RPOP(m_tos1);
DPUSH(m_tos1);
break;
#if 0
case FORTH_PRIMITIVE_DO:
std::cout << "(DO)" << std::endl;
RPUSH(m_tos);
DPOP(m_tos1); // FIXME: optim: RPUSH(DPOP);
RPUSH(m_tos1);
m_tos = DDROP();
break;
case FORTH_PRIMITIVE_LOOP:
std::cout << "(LOOP)" << std::endl;
RPOP(m_tos1); /* limit */
RPOP(m_tos2); /* index */
++m_tos2;
if (m_tos2 == m_tos1)
{
++m_ip; /* skip branch offset, exit loop */
}
else
{
/* Push index and limit back to R */
RPUSH(m_tos2);
RPUSH(m_tos1);
/* Branch back to just after (DO) */
m_ip = m_dictionary.read16at(m_ip);
}
break;
#endif
case FORTH_PRIMITIVE_I:
DPUSH(m_tos);
m_tos = RPICK(0);
break;
case FORTH_PRIMITIVE_J:
DPUSH(m_tos);
m_tos = RPICK(2);
break;
case FORTH_PRIMITIVE_CELL:
DPUSH(m_tos);
m_tos = sizeof (Cell32);
break;
case FORTH_PRIMITIVE_CELLS:
m_tos = m_tos * sizeof (Cell32);
break;
case FORTH_PRIMITIVE_LITERAL_16:
DPUSH(m_tos);
m_ip += 2U; // Skip primitive LITERAL
m_tos = m_dictionary.read16at(m_ip);
break;
case FORTH_PRIMITIVE_LITERAL_32:
DPUSH(m_tos);
m_ip += 2U; // Skip primitive LITERAL
m_tos = m_dictionary.read32at(m_ip);
m_ip += 2U; // Skip the number - 2 because of next ip
break;
case FORTH_PRIMITIVE_1MINUS:
--m_tos;
break;
case FORTH_PRIMITIVE_1PLUS:
++m_tos;
break;
case FORTH_PRIMITIVE_2MINUS:
m_tos -= 2;
break;
case FORTH_PRIMITIVE_2PLUS:
m_tos += 2;
break;
// drop ( a -- )
case FORTH_PRIMITIVE_DROP:
DPOP(m_tos);
break;
case FORTH_PRIMITIVE_DEPTH:
DPUSH(m_tos);
m_tos = stackDepth(forth::DataStack);
break;
// nip ( a b -- b ) swap drop ;
case FORTH_PRIMITIVE_NIP:
DPOP(m_tos1);
break;
case FORTH_PRIMITIVE_ROLL:
{
m_tos1 = DPICK(m_tos);
uint32_t *src = &DPICK(m_tos - 1);
uint32_t *dst = &DPICK(m_tos);
uint32_t ri = m_tos;
while (ri--)
{
*dst-- = *src--;
}
m_tos = m_tos1;
++m_dsp;
}
break;
// ( ... n -- sp(n) )
case FORTH_PRIMITIVE_PICK:
m_tos = DPICK(m_tos);
break;
// dup ( a -- a a )
case FORTH_PRIMITIVE_DUP:
DPUSH(m_tos);
break;
case FORTH_PRIMITIVE_QDUP:
if (m_tos)
{
DPUSH(m_tos);
}
break;
// swap ( a b -- b a )
case FORTH_PRIMITIVE_SWAP:
m_tos2 = m_tos;
DPOP(m_tos);
DPUSH(m_tos2);
break;
// over ( a b -- a b a )
case FORTH_PRIMITIVE_OVER:
DPUSH(m_tos);
m_tos = DPICK(1);
break;
// rot ( a b c -- b c a )
case FORTH_PRIMITIVE_ROT:
DPOP(m_tos2);
DPOP(m_tos3);
DPUSH(m_tos2);
DPUSH(m_tos);
m_tos = m_tos3;
break;
// tuck ( a b -- b a b ) swap over ;
case FORTH_PRIMITIVE_TUCK:
DPOP(m_tos2);
DPUSH(m_tos);
DPUSH(m_tos2);
break;
// 2dup ( a b -- a b a b ) over over ;
case FORTH_PRIMITIVE_2DUP:
DPUSH(m_tos);
m_tos2 = DPICK(1);
DPUSH(m_tos2);
break;
// 2over ( a b c d -- a b c d a b )
case FORTH_PRIMITIVE_2OVER:
DPUSH(m_tos);
m_tos2 = DPICK(3);
DPUSH(m_tos2);
m_tos = DPICK(3);
break;
// 2swap ( a b c d -- c d a b )
case FORTH_PRIMITIVE_2SWAP:
DPOP(m_tos1);
DPOP(m_tos2);
DPOP(m_tos3);
DPUSH(m_tos1);
DPUSH(m_tos);
DPUSH(m_tos3);
m_tos = m_tos2;
break;
// 2drop ( a b -- ) drop drop ;
case FORTH_PRIMITIVE_2DROP:
DPOP(m_tos);
DPOP(m_tos);
break;
//
case FORTH_PRIMITIVE_BINARY:
changeDisplayBase(2U);
break;
case FORTH_PRIMITIVE_OCTAL:
changeDisplayBase(8U);
break;
case FORTH_PRIMITIVE_HEXADECIMAL:
changeDisplayBase(16U);
break;
case FORTH_PRIMITIVE_DECIMAL:
changeDisplayBase(10U);
break;
case FORTH_PRIMITIVE_GET_BASE:
DPUSH(m_tos);
m_tos = m_base;
break;
case FORTH_PRIMITIVE_SET_BASE:
if (false == changeDisplayBase(m_tos))
{
std::cerr << FORTH_WARNING_COLOR << "[WARNING] '"
<< m_tos << "' is an invalid base and shall be [2..36]. Ignored !"
<< FORTH_NORMAL_COLOR << std::endl;
}
break;
case FORTH_PRIMITIVE_NEGATE:
m_tos = -m_tos;
break;
case FORTH_PRIMITIVE_ABS:
m_tos = std::abs((int32_t) m_tos);
break;
case FORTH_PRIMITIVE_PLUS:
BINARY_OP(+);
break;
case FORTH_PRIMITIVE_MINUS:
BINARY_OP(-);
break;
case FORTH_PRIMITIVE_DIV:
BINARY_OP(/);
break;
case FORTH_PRIMITIVE_TIMES:
BINARY_OP(*);
break;
case FORTH_PRIMITIVE_RSHIFT:
BINARY_OP(>>);
break;
case FORTH_PRIMITIVE_LSHIFT:
BINARY_OP(<<);
break;
case FORTH_PRIMITIVE_FALSE:
m_tos = 0;
DPUSH(m_tos);
break;
case FORTH_PRIMITIVE_TRUE:
m_tos = -1;
DPUSH(m_tos);
break;
case FORTH_PRIMITIVE_GREATER_EQUAL:
LOGICAL_OP(>=);
break;
case FORTH_PRIMITIVE_LOWER_EQUAL:
LOGICAL_OP(<=);
break;
case FORTH_PRIMITIVE_GREATER:
LOGICAL_OP(>);
break;
case FORTH_PRIMITIVE_LOWER:
LOGICAL_OP(<);
break;
case FORTH_PRIMITIVE_EQUAL:
LOGICAL_OP(==);
break;
case FORTH_PRIMITIVE_0EQUAL:
DPUSH(0U);
LOGICAL_OP(==);
break;
case FORTH_PRIMITIVE_NOT_EQUAL:
LOGICAL_OP(!=);
break;
case FORTH_PRIMITIVE_AND:
BINARY_OP(&);
break;
case FORTH_PRIMITIVE_OR:
BINARY_OP(|);
break;
case FORTH_PRIMITIVE_XOR:
BINARY_OP(^);
break;
case FORTH_PRIMITIVE_MIN:
DPOP(m_tos1);
m_tos = ((int32_t) m_tos < (int32_t) m_tos1) ? m_tos : m_tos1;
break;
case FORTH_PRIMITIVE_MAX:
DPOP(m_tos1);
m_tos = ((int32_t) m_tos > (int32_t) m_tos1) ? m_tos : m_tos1;
break;
case FORTH_PRIMITIVE_DISP:
std::cout << std::setbase(m_base) << (int32_t) m_tos << " ";
DPOP(m_tos);
break;
case FORTH_PRIMITIVE_UDISP:
std::cout << std::setbase(m_base) << (uint32_t) m_tos << " ";
DPOP(m_tos);
break;
case FORTH_PRIMITIVE_CARRIAGE_RETURN:
std::cout << std::endl;
break;
case FORTH_PRIMITIVE_DISPLAY_DSTACK:
DPUSH(m_tos);
displayStack(std::cout, forth::DataStack);
DPOP(m_tos);
break;
case FORTH_PRIMITIVE_BEGIN_C_LIB:
{
std::pair<bool, std::string> res = m_dynamic_libs.begin(STREAM);
if (!res.first)
{
abort(res.second);
}
}
break;
case FORTH_PRIMITIVE_END_C_LIB:
{
std::pair<bool, std::string> res = m_dynamic_libs.end(/*nth*/); // FIXME
if (res.first)
{
uint16_t i = 0;
for (auto it: m_dynamic_libs/*[nth]*/.m_functions)
{
create(it.func_forth_name);
m_dictionary.appendCell16(FORTH_PRIMITIVE_EXEC_C_FUNC);
m_dictionary.appendCell16(i);
m_dictionary.appendCell16(FORTH_PRIMITIVE_EXIT);
++i;
}
}
else
{
abort(res.second);
}
}
break;
case FORTH_PRIMITIVE_EXEC_C_FUNC:
DPUSH(m_tos);
m_ip += 2U; // Skip the index of pointer function
m_tos = m_dictionary.read16at(m_ip);
//std::cout << "Pile avant: ";
//displayStack(std::cout, forth::DataStack);
m_dynamic_libs/*[nth]*/.m_functions[m_tos].fun_ptr(&m_dsp);
//std::cout << "Pile apres: ";
//displayStack(std::cout, forth::DataStack);
DPOP(m_tos);
break;
case FORTH_PRIMITIVE_C_FUNCTION:
{
std::pair<bool, std::string> res = m_dynamic_libs.function(STREAM);
if (!res.first)
{
abort(res.second);
}
}
break;
case FORTH_PRIMITIVE_C_CODE:
{
std::pair<bool, std::string> res = m_dynamic_libs.code(STREAM);
if (!res.first)
{
abort(res.second);
}
}
break;
case FORTH_PRIMITIVE_ADD_EXT_C_LIB:
{
std::pair<bool, std::string> res = m_dynamic_libs.extlib(STREAM);
if (!res.first)
{
abort(res.second);
}
}
break;
default:
UnknownForthPrimitive e(idPrimitive, __PRETTY_FUNCTION__); throw e;
break;
}
}
/* ( -- success? ) */
static void
dlabel_open( dlabel_info_t *di )
{
char *path;
char block0[512];
phandle_t ph;
int success=0;
cell status;
path = my_args_copy();
DPRINTF("dlabel-open '%s'\n", path );
di->part_ih = 0;
/* Find parent methods */
di->filesystem_ph = 0;
di->parent_seek_xt = find_parent_method("seek");
di->parent_tell_xt = find_parent_method("tell");
di->parent_read_xt = find_parent_method("read");
/* If arguments have been passed, determine the partition/filesystem type */
if (path && strlen(path)) {
/* Read first block from parent device */
DPUSH(0);
call_package(di->parent_seek_xt, my_parent());
POP();
PUSH(pointer2cell(block0));
PUSH(sizeof(block0));
call_package(di->parent_read_xt, my_parent());
status = POP();
if (status != sizeof(block0))
goto out;
/* Find partition handler */
PUSH( pointer2cell(block0) );
selfword("find-part-handler");
ph = POP_ph();
if( ph ) {
/* We found a suitable partition handler, so interpose it */
DPRINTF("Partition found on disk - scheduling interpose with ph " FMT_ucellx "\n", ph);
push_str(path);
PUSH_ph(ph);
fword("interpose");
success = 1;
} else {
/* unknown (or missing) partition map,
* try the whole disk
*/
DPRINTF("Unknown or missing partition map; trying whole disk\n");
/* Probe for filesystem from start of device */
DPUSH ( 0 );
PUSH_ih( my_self() );
selfword("find-filesystem");
ph = POP_ph();
if( ph ) {
/* If we have been asked to open a particular file, interpose the filesystem package with the passed filename as an argument */
di->filesystem_ph = ph;
DPRINTF("Located filesystem with ph " FMT_ucellx "\n", ph);
DPRINTF("path: %s length: %d\n", path, strlen(path));
if (path && strlen(path)) {
DPRINTF("INTERPOSE!\n");
push_str( path );
PUSH_ph( ph );
fword("interpose");
}
} else if (path && strcmp(path, "%BOOT") != 0) {
goto out;
}
success = 1;
}
} else {
/* No arguments were passed, so we just use the parent raw device directly */
success = 1;
}
out:
if( path )
free( path );
if( !success ) {
dlabel_close( di );
RET(0);
}
PUSH(-1);
}
