#include "forth.h"

/* number limits on phylo:
 * 4294967295 4294967296 2 print_stack
 * Stack's first 2 items:
 * 0
 * 4294967295
 */

funcptr **pc;  /* Program Counter for address interpreter. */
funcptr **rp;  /* The "top" of the Return Stack */
long *dp;      /* The Dictionary Pointer (HERE). */
long *sp;      /* The "top" of the Data Stack */
char *tb;      /* The Text Input Buffer. */

FILE *infile;
FILE *outfile;

long arena[ARENA_SIZE];     /* Where everything happens. */

/* Initialize the stack pointers and the dictionary. */
void
init_arena ()
{
  /* The dictionary grows up from the beginning of the arena. */
  dp = arena;

  /* The TIB grows up, from the back of the data and return stacks. */
  tb = (char *) arena + (ARENA_SIZE - TB_SIZE);

  /* The return stack grows down. */
  rp = (funcptr **) arena + (ARENA_SIZE - TB_SIZE - 1);

  /* As does the data stack -- interleaved with the return stack. */
  sp = arena + (ARENA_SIZE - TB_SIZE - 2);
}     


/* Take a string (length calculated if 0 is passed), and look it up
 * in the dictionary.  Return the address if found, else NULL.
 *
 * Forth word "find" uses this.
 */
long *
dict_lookup (char *str, int len)
{
  long *this_dp = last_dp;

  /* Decide how you want to call this function... */
  if (!len)
    len = strlen (str);

  while (this_dp)
    {
      if (len == ENTRY_NAME_LENGTH (this_dp)
          && (! strncmp (ENTRY_NAME (this_dp), str, len)))
        {
          /* We found it. */
          return (ENTRY_CFA (this_dp));
        }
      else
        /* Else try the next one. */
        this_dp = ENTRY_LINK (this_dp);
    }

  /* Else we didn't find it. */
  return (long *) NULL;
}


/* This function exists only for testing. */
void
display_dictionary ()
{
  long *this_dp = last_dp;
  char *name;
  int len, i;

  fprintf (outfile, "-*-   DICTIONARY   -*-\n\n");

  while (this_dp)
    {
      len = ENTRY_NAME_LENGTH (this_dp);
      name = ENTRY_NAME (this_dp);

      if (ENTRY_IMMEDIATE_P (this_dp))
        fprintf (outfile, "(IMMEDIATE) ");
      else
        fprintf (outfile, "(NON IMMEDIATE) ");

      fprintf (outfile, "address: %u, link: %u, cfa: %u, name: \"",
               this_dp, ENTRY_LINK (this_dp), ENTRY_CFA (this_dp));
      fwrite (name, sizeof (char), len, outfile);
      fprintf (outfile, "\"\n  (first) pfa: %u, *pfa: %u\n\n",
               ENTRY_PFA (this_dp), *(ENTRY_PFA (this_dp)));

      this_dp = ENTRY_LINK (this_dp);
    }

  fprintf (outfile, "\n-*- END DICTIONARY -*-\n\n");
}


/* This is found in the CFA of most words except primitives (those have
 * the primitive itself).  It's job is to jump when the system says
 * "frog" -- and the system is _always_ saying "frog".
 *
 * It pushes the address one past the current PC onto the return
 * stack, then sets the PC to the address just past the CFA being run
 * (which contains this invokation of address_interpreter).  That next
 * address is none other than the first PFA.
 *
 * It bounces down the list of PFAs, running each one in turn (some of
 * them may recursively invoke address_interpreter), and then restores
 * the PC from the return stack, thus allowing the invocation of
 * address_interpreter that invoked _this_ instance to continue on its
 * merry way doing all the things we just did here.  */

void
address_interpreter ()
{
  RPUSH ((funcptr *) pc);
  pc = (funcptr **) ((*pc) + 1);

  while (*pc)
    {
      (**pc) ();
      pc++;
    }

  pc = (funcptr **) RPOP;
}


void
load_library ()
{
  /* Load the Forth library that defines things like IF, THEN, etc. */

  if (infile = fopen (STD_LIB, "r"))
    /* Evaluate the code. */
    Finterpret ();
  else
    {
      fprintf (stderr,
               "soforth: unable to open standard library %s.\n",
               STD_LIB);
      infile = stdin;
    }
}


handle_command_line (int argc, char **argv)
{
  int i;

  for (i = 1; i < argc; i++)
    {
      if (infile = fopen (argv[i], "r"))
        /* Evaluate the code in the file. */
        Finterpret ();
      else
        {
          fprintf (stderr, "soforth: unable to open file %s.\n", argv[i]);
          infile = stdin;
        }
    }
}


int
main (int argc, char **argv)
{
  infile = stdin;
  outfile = stdout;

  init_arena ();
  init_prims ();

  load_library ();

  /* This may set infile and/or outfile. */
  handle_command_line (argc, argv);

  Finterpret ();

  return 0;
}