/* * d i c t A l i g n * Align the dictionary's free space pointer */ void ficlDictionaryAlign(ficlDictionary *dictionary) { dictionary->here = ficlAlignPointer(dictionary->here); }
FICL_PLATFORM_EXTERN void *alignPtr(void *ptr) { return ficlAlignPointer(ptr); }
void ficlDictionarySee(ficlDictionary *dictionary, ficlWord *word, ficlCallback *callback) { char *trace; ficlCell *cell = word->param; ficlCell *param0 = cell; char buffer[128]; for (; cell->i != ficlInstructionSemiParen; cell++) { ficlWord *word = (ficlWord *)(cell->p); trace = buffer; if ((void *)cell == (void *)buffer) *trace++ = '>'; else *trace++ = ' '; trace += sprintf(trace, "%3ld ", (long)(cell - param0)); if (ficlDictionaryIsAWord(dictionary, word)) { ficlWordKind kind = ficlWordClassify(word); ficlCell c, c2; switch (kind) { case FICL_WORDKIND_INSTRUCTION: (void) sprintf(trace, "%s (instruction %ld)", ficlDictionaryInstructionNames[(long)word], (long)word); break; case FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT: c = *++cell; (void) sprintf(trace, "%s (instruction %ld), " "with argument %ld (%#lx)", ficlDictionaryInstructionNames[(long)word], (long)word, (long)c.i, (unsigned long)c.u); break; case FICL_WORDKIND_INSTRUCTION_WORD: (void) sprintf(trace, "%s :: executes %s (instruction word %ld)", word->name, ficlDictionaryInstructionNames[ (long)word->code], (long)word->code); break; case FICL_WORDKIND_LITERAL: c = *++cell; if (ficlDictionaryIsAWord(dictionary, c.p) && (c.i >= ficlInstructionLast)) { ficlWord *word = (ficlWord *)c.p; (void) sprintf(trace, "%.*s ( %#lx literal )", word->length, word->name, (unsigned long)c.u); } else (void) sprintf(trace, "literal %ld (%#lx)", (long)c.i, (unsigned long)c.u); break; case FICL_WORDKIND_2LITERAL: c = *++cell; c2 = *++cell; (void) sprintf(trace, "2literal %ld %ld (%#lx %#lx)", (long)c2.i, (long)c.i, (unsigned long)c2.u, (unsigned long)c.u); break; #if FICL_WANT_FLOAT case FICL_WORDKIND_FLITERAL: c = *++cell; (void) sprintf(trace, "fliteral %f (%#lx)", (double)c.f, (unsigned long)c.u); break; #endif /* FICL_WANT_FLOAT */ case FICL_WORDKIND_STRING_LITERAL: { ficlCountedString *counted; counted = (ficlCountedString *)(void *)++cell; cell = (ficlCell *) ficlAlignPointer(counted->text + counted->length + 1) - 1; (void) sprintf(trace, "s\" %.*s\"", counted->length, counted->text); } break; case FICL_WORDKIND_CSTRING_LITERAL: { ficlCountedString *counted; counted = (ficlCountedString *)(void *)++cell; cell = (ficlCell *) ficlAlignPointer(counted->text + counted->length + 1) - 1; (void) sprintf(trace, "c\" %.*s\"", counted->length, counted->text); } break; case FICL_WORDKIND_BRANCH0: c = *++cell; (void) sprintf(trace, "branch0 %ld", (long)(cell + c.i - param0)); break; case FICL_WORDKIND_BRANCH: c = *++cell; (void) sprintf(trace, "branch %ld", (long)(cell + c.i - param0)); break; case FICL_WORDKIND_QDO: c = *++cell; (void) sprintf(trace, "?do (leave %ld)", (long)((ficlCell *)c.p - param0)); break; case FICL_WORDKIND_DO: c = *++cell; (void) sprintf(trace, "do (leave %ld)", (long)((ficlCell *)c.p - param0)); break; case FICL_WORDKIND_LOOP: c = *++cell; (void) sprintf(trace, "loop (branch %ld)", (long)(cell + c.i - param0)); break; case FICL_WORDKIND_OF: c = *++cell; (void) sprintf(trace, "of (branch %ld)", (long)(cell + c.i - param0)); break; case FICL_WORDKIND_PLOOP: c = *++cell; (void) sprintf(trace, "+loop (branch %ld)", (long)(cell + c.i - param0)); break; default: (void) sprintf(trace, "%.*s", word->length, word->name); break; } } else { /* probably not a word - punt and print value */ (void) sprintf(trace, "%ld ( %#lx )", (long)cell->i, (unsigned long)cell->u); } ficlCallbackTextOut(callback, buffer); ficlCallbackTextOut(callback, "\n"); } ficlCallbackTextOut(callback, ";\n"); }