static void key(void)
{
while (!availchar());
#ifdef FCOMPILER
PUSH(get_inputbyte());
#else
PUSH(getchar());
#endif
}
int availchar(void)
{
int tmp;
if( cursrc < 1 ) {
interruptforth |= FORTH_INTSTAT_STOP;
/* return -1 in order to exit the loop in key() */
return -1;
}
tmp = getc( srcfiles[cursrc-1] );
if (tmp != EOF) {
ungetc(tmp, srcfiles[cursrc-1]);
return -1;
}
fclose(srcfiles[--cursrc]);
return availchar();
}
static void iskey(void)
{
PUSH((cell) availchar());
}
static void
do_source_dbg( struct debug_xt *debug_xt_item )
{
/* Forth source debugger implementation */
char k, done = 0;
/* Display current dstack */
display_dbg_dstack();
printf_console("\n");
fstrncpy(xtname, lfa2nfa(read_ucell(cell2pointer(PC)) - sizeof(cell)), MAXNFALEN);
printf_console("%p: %s ", cell2pointer(PC), xtname);
/* If in trace mode, we just carry on */
if (debug_xt_item->mode == DEBUG_MODE_TRACE)
return;
/* Otherwise in step mode, prompt for a keypress */
while (!availchar());
k = getchar();
/* Only proceed if done is true */
while (!done)
{
switch (k) {
case ' ':
case '\n':
/* Perform a single step */
done = 1;
break;
case 'u':
case 'U':
/* Up - unmark current word for debug, mark its caller for
* debugging and finish executing current word */
/* Since this word could alter the rstack during its execution,
* we only know the caller when (semis) is called for this xt.
* Hence we mark the xt as a special DEBUG_MODE_STEPUP which
* means we run as normal, but schedule the xt for deletion
* at its corresponding (semis) word when we know the rstack
* will be set to its final parent value */
debug_xt_item->mode = DEBUG_MODE_STEPUP;
done = 1;
break;
case 'd':
case 'D':
/* Down - mark current word for debug and step into it */
done = add_debug_xt(read_ucell(cell2pointer(PC)));
if (!done) {
while (!availchar());
k = getchar();
}
break;
case 't':
case 'T':
/* Trace mode */
debug_xt_item->mode = DEBUG_MODE_TRACE;
done = 1;
break;
case 'r':
case 'R':
/* Display rstack */
display_dbg_rstack();
done = 0;
while (!availchar());
k = getchar();
break;
case 'f':
case 'F':
/* Start subordinate Forth interpreter */
PUSHR(PC - sizeof(cell));
PC = pointer2cell(findword("outer-interpreter")) + sizeof(ucell);
/* Save rstack position for when we return */
dbgrstackcnt = rstackcnt;
done = 1;
break;
default:
/* Display debug banner */
printk(DEBUG_BANNER);
while (!availchar());
k = getchar();
}
}
}
