forth/src/fh_see.c

#include "forth_internal.h"

static void show_word(struct fh_thread_s *fh, const struct fh_word_s *w)
{
  if (!w) {
    LOGE("NULL!");
    return;
  }
  FHPRINT("Dict entry at 0x%08x\n", word_addr(fh, w));
  if (w->flags & WORDFLAG_WORD) {
    if (w->handler == w_user_word) {
      uint32_t execptr = w->param;

      FHPRINT("Compiled word %s%s\n", w->name, (w->flags & WORDFLAG_IMMEDIATE) ? " IMMEDIATE" : "");
      while (1) {
        // make sure it's aligned
        execptr = WORDALIGNED(execptr);
        
        if (execptr == 0 || execptr > fh->here) {
          LOGE("Exec overrun without ENDWORD!");
          break;
        }
        
        FHPRINT("0x%08x: ", execptr);
        const struct fh_instruction_s *instr = fh_instr_at(fh, execptr);
        if (!instr) {
          LOGE("Word pointer out of bounds!");
          return;
        }

        execptr += INSTR_SIZE;

        uint32_t strl;
        const struct fh_word_s *w2;
        switch (instr->kind) {
          case FH_INSTR_NUMBER:
            FHPRINT("Number(%d / 0x%08x)\n", instr->data, instr->data);
            break;

          case FH_INSTR_WORD:
            w2 = fh_word_at(fh, instr->data);
            if (w2) {
              FHPRINT("Call(word %s)\n", w2->name);
            } else {
              FHPRINT("Call(BAD ADDRESS!!! 0x%08x)\n", instr->data);
            }
            break;

          case FH_INSTR_POSTPONED_WORD:
            w2 = fh_word_at(fh, instr->data);
            if (w2) {
              if (w2->name[0]) {
                FHPRINT("Postpone(word %s)\n", w2->name);
              } else {
                FHPRINT("Postpone(word 0x%08x)\n", instr->data);
              }
            } else {
              FHPRINT("Postpone(BAD ADDRESS!!! 0x%08x)\n", instr->data);
            }
            break;

          case FH_INSTR_OF:
            FHPRINT("OF(value %d / 0x%08x)\n", instr->data, instr->data);
            break;

          case FH_INSTR_ENDCASE:
            FHPRINT("ENDCASE\n");
            break;

          case FH_INSTR_TO:
            w2 = fh_word_at(fh, instr->data);
            if (w2) {
              if (w2->name[0]) {
                FHPRINT("To(var %s)\n", w2->name);
              } else {
                FHPRINT("To(var 0x%08x)\n", instr->data);
              }
            } else {
              FHPRINT("To(BAD ADDRESS!!! 0x%08x)\n", instr->data);
            }
            break;

          case FH_INSTR_JUMPZERO:
            FHPRINT("JumpIfZero(dest 0x%08x)\n", instr->data);
            break;

          case FH_INSTR_JUMP:
            FHPRINT("Jump(dest 0x%08x)\n", instr->data);
            break;

          case FH_INSTR_ACTIONOF:
            FHPRINT("ActionOf(word 0x%08x)\n", instr->data);
            break;

          case FH_INSTR_ISDEFER:
            FHPRINT("IsDefer(word 0x%08x)\n", instr->data);
            break;

          case FH_INSTR_DO:
            FHPRINT("DO\n");
            break;

          case FH_INSTR_DO_QUESTION:
            FHPRINT("DO?(end 0x%08x)\n", instr->data);
            break;

          case FH_INSTR_LOOP:
            FHPRINT("LOOP(start 0x%08x)\n", instr->data);
            break;

          case FH_INSTR_LOOP_PLUS:
            FHPRINT("LOOP+(start 0x%08x)\n", instr->data);
            break;

            /* special case for strings stored in compile memory */
          case FH_INSTR_ALLOCSTR:
            strl = instr->data;
            FHPRINT("AllocStr(\"%.*s\")\n", strl, fh_str_at(fh, execptr));
            execptr += strl;
            break;

          case FH_INSTR_TYPESTR:
            strl = instr->data;
            FHPRINT("PrintStr(\"%.*s\")\n", strl, fh_str_at(fh, execptr));
            execptr += strl;
            break;

          case FH_INSTR_ABORTSTR:
            strl = instr->data;
            FHPRINT("AbortStr(\"%.*s\")\n", strl, fh_str_at(fh, execptr));
            execptr += strl;
            break;

          case FH_INSTR_ALLOCSTR_C:
            strl = instr->data;
            FHPRINT("AllocStrC(%d, \"%.*s\")\n", fh->heap[execptr], fh->heap[execptr], fh_str_at(fh, execptr + 1));
            execptr += strl;
            break;

          case FH_INSTR_ENDWORD:
            if (instr->data == 1) {
              FHPRINT("END (synthetic for DOES>)\n");
              break;
            } else {
              FHPRINT("END\n");
              return;
            }

          default:
            FHPRINT("Unknown(kind 0x%08x, data 0x%08x)\n", instr->kind, instr->data);
        }
      }
    } else {
      FHPRINT("Built-in word %s\n", w->name);
    }
  } else if (w->flags & WORDFLAG_VARIABLE) {
    FHPRINT("Variable %s, value %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
  } else if (w->flags & WORDFLAG_CONSTANT) {
    FHPRINT("Constant %s, value %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
  } else if (w->flags & WORDFLAG_CREATED) {
    FHPRINT("CREATE'd entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
  } else if (w->flags & WORDFLAG_DEFER) {
    FHPRINT("DEFER'd entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
  } else {
    FHPRINT("Unknown entry %s, param %d (0x%08x)\n", w->name, (int32_t) w->param, w->param);
  }
}

/** Decompile a word */
enum fh_error fh_see_word(
    struct fh_thread_s *fh,
    const char *name,
    const size_t wordlen
)
{
  enum fh_error rv;
  uint32_t addr;
  // TODO allow see with addr to inspect :NONAME defined words
  TRY(fh_find_word(fh, name, wordlen, &addr));
  show_word(fh, fh_word_at(fh, addr));
  return FH_OK;
}