Exemplo n.º 1
0
int enterforth(xt_t xt)
{
    ucell *_cfa = (ucell*)cell2pointer(xt);
    cell tmp;

    if (read_ucell(_cfa) != DOCOL) {
        trampoline[1] = target_ucell(xt);
        _cfa = trampoline;
    }

    if (rstackcnt < 0) {
        rstackcnt = 0;
    }

    tmp = rstackcnt;
    interruptforth = FORTH_INTSTAT_CLR;

    PUSHR(PC);
    PC = pointer2cell(_cfa);

    while (rstackcnt > tmp && !(interruptforth & FORTH_INTSTAT_STOP)) {
        if (debug_xt_list->next == NULL) {
            while (rstackcnt > tmp && !interruptforth) {
                dbg_interp_printk("enterforth: NEXT\n");
                next();
            }
        } else {
            while (rstackcnt > tmp && !interruptforth) {
                dbg_interp_printk("enterforth: NEXT_DBG\n");
                next_dbg();
            }
        }

        /* Always clear the debug mode change flag */
        interruptforth = interruptforth & (~FORTH_INTSTAT_DBG);
    }

#if 0
    /* return true if we took an exception. The caller should normally
     * handle exceptions by returning immediately since the throw
     * is supposed to abort the execution of this C-code too.
     */

    if (rstackcnt != tmp) {
        printk("EXCEPTION DETECTED!\n");
    }
#endif
    return rstackcnt != tmp;
}
Exemplo n.º 2
0
static void docol(void)
{                               /* DOCOL */
    PUSHR(PC);
    PC = read_ucell(cell2pointer(PC));

    dbg_interp_printk("docol: %s\n", cell2pointer( lfa2nfa(PC - sizeof(cell)) ));
}
Exemplo n.º 3
0
static
int printf_console(const char *fmt, ...)
{
    cell tmp;

    char buf[512];
    va_list args;
    int i;

    va_start(args, fmt);
    i = vsnprintf(buf, sizeof(buf), fmt, args);
    va_end(args);

    /* Push to the Forth interpreter for console output */
    tmp = rstackcnt;

    PUSH(pointer2cell(buf));
    PUSH((int)strlen(buf));
    trampoline[1] = findword("type");

    PUSHR(PC);
    PC = pointer2cell(trampoline);

    while (rstackcnt > tmp) {
        dbg_interp_printk("printf_console: NEXT\n");
        next();
    }

    return i;
}
Exemplo n.º 4
0
static inline void next_dbg(void)
{
    struct debug_xt *debug_xt_item;
    void (*tokenp) (void);

    PC += sizeof(ucell);

    /* If the PC lies within a debug range, run the source debugger */
    debug_xt_item = debug_xt_list;
    while (debug_xt_item->next) {
        if (PC >= debug_xt_item->xt_docol && PC <= debug_xt_item->xt_semis &&
            debug_xt_item->mode != DEBUG_MODE_STEPUP) {
            do_source_dbg(debug_xt_item);
        }

        debug_xt_item = debug_xt_item->next;
    }

    dbg_interp_printk("next_dbg: PC is now %x\n", PC);

    /* Intercept DOCOL and SEMIS and redirect to debug versions */
    if (read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))) == DOCOL) {
        tokenp = docol_dbg;
        tokenp();
    } else if (read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))) == DOSEMIS) {
        tokenp = semis_dbg;
        tokenp();
    } else {
        /* Otherwise process as normal */
        processxt(read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))));
    }
}
Exemplo n.º 5
0
static inline void next(void)
{
    PC += sizeof(ucell);

    dbg_interp_printk("next: PC is now %x\n", PC);
    processxt(read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))));
}
Exemplo n.º 6
0
static inline void processxt(ucell xt)
{
    void (*tokenp) (void);

    dbg_interp_printk("processxt: pc=%x, xt=%x\n", PC, xt);
    tokenp = words[xt];
    tokenp();
}
Exemplo n.º 7
0
static void execute(void)
{                               /* EXECUTE */
    ucell address = POP();
    dbg_interp_printk("execute: %x\n", address);

    PUSHR(PC);
    trampoline[1] = target_ucell(address);
    PC = pointer2cell(trampoline);
}
Exemplo n.º 8
0
static void doival(void)
{
	ucell r, *p = (ucell *)(*(ucell *) PC + sizeof(ucell));
	ucell ibase = get_myself();

	dbg_interp_printk("ivar, offset: %d size: %d\n", p[0], p[1] );

	r = ibase ? ibase + p[0] : (ucell)&p[2];
	PUSH( *(ucell *)r );
}
Exemplo n.º 9
0
static void doival(void)
{
    ucell r, *p = (ucell *)(*(ucell *) cell2pointer(PC) + sizeof(ucell));
    ucell ibase = get_myself();

    dbg_interp_printk("ivar, offset: %d size: %d\n", p[0], p[1] );

    r = ibase ? ibase + p[0] : pointer2cell(&p[2]);
    PUSH( *(ucell *)cell2pointer(r) );
}
Exemplo n.º 10
0
static void doidefer(void)
{
    ucell *p = (ucell *)(*(ucell *) cell2pointer(PC) + sizeof(ucell));
    ucell ibase = get_myself();

    dbg_interp_printk("doidefer, offset: %d size: %d\n", p[0], p[1] );

    PUSHR(PC);
    PC = ibase ? ibase + p[0] : pointer2cell(&p[2]);
    PC -= sizeof(ucell);
}
Exemplo n.º 11
0
/*
 * call ( ... function-ptr -- ??? )
 */
static void call(void)
{
#ifdef FCOMPILER
    printk("Sorry. Usage of Forth2C binding is forbidden during bootstrap.\n");
    exit(1);
#else
    void (*funcptr) (void);
    funcptr=(void *)cell2pointer(POP());
    dbg_interp_printk("call: %x", funcptr);
    funcptr();
#endif
}
Exemplo n.º 12
0
static void dodoes(void)
{                               /* DODOES */
    ucell data = read_ucell(cell2pointer(PC)) + (2 * sizeof(ucell));
    ucell word = read_ucell(cell2pointer(read_ucell(cell2pointer(PC)) + sizeof(ucell)));

    dbg_interp_printk("DODOES data=%x word=%x\n", data, word);

    PUSH(data);
    PUSH(word);

    execute();
}
Exemplo n.º 13
0
static
int getchar_console(void)
{
    cell tmp;

    /* Push to the Forth interpreter for console output */
    tmp = rstackcnt;

    trampoline[1] = findword("key");

    PUSHR(PC);
    PC = pointer2cell(trampoline);

    while (rstackcnt > tmp) {
        dbg_interp_printk("getchar_console: NEXT\n");
        next();
    }

    return POP();
}
Exemplo n.º 14
0
static void docol_dbg(void)
{                               /* DOCOL */
    struct debug_xt *debug_xt_item;

    PUSHR(PC);
    PC = read_ucell(cell2pointer(PC));

    /* If current xt is in our debug xt list, display word name */
    debug_xt_item = debug_xt_list;
    while (debug_xt_item->next) {
        if (debug_xt_item->xt_docol == PC) {
            fstrncpy(xtname, lfa2nfa(PC - sizeof(cell)), MAXNFALEN);
            printf_console("\n: %s ", xtname);

            /* Step mode is the default */
            debug_xt_item->mode = DEBUG_MODE_STEP;
        }

        debug_xt_item = debug_xt_item->next;
    }

    dbg_interp_printk("docol_dbg: %s\n", cell2pointer(lfa2nfa(PC - sizeof(cell))));
}
Exemplo n.º 15
0
/* called inline thus a slightly different behaviour */
static void lit(void)
{                               /* LIT */
    PC += sizeof(cell);
    PUSH(read_ucell(cell2pointer(PC)));
    dbg_interp_printk("lit: %x\n", read_ucell(cell2pointer(PC)));
}
Exemplo n.º 16
0
static void docon(void)
{                               /* DOCON */
    ucell tmp = read_ucell(cell2pointer(read_ucell(cell2pointer(PC)) + sizeof(ucell)));
    PUSH(tmp);
    dbg_interp_printk("docon: PC=%x, value=%x\n", PC, tmp);
}
Exemplo n.º 17
0
static void dovar(void)
{                               /* DOVAR */
    ucell tmp = read_ucell(cell2pointer(PC)) + sizeof(ucell);
    PUSH(tmp);              /* returns address to variable */
    dbg_interp_printk("dovar: PC: %x, %x\n", PC, tmp);
}