#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdarg.h>
#include <errno.h>
#include <setjmp.h>

/* Later, this will be a run-time option, and also the default will be
 * something more reasonable.  For now, I'd like to gather some stats
 * before I lower it.
 */
#define ARENA_SIZE 1024000

/* This is usually defined in the Makefile. */
#ifndef STD_LIB
/* #define STD_LIB "soforth.fth" */
#endif

/* This should get us enough room: 400 chars. */
/* The size of the Text Input Buffer -- in words, not bytes. */
#define TB_SIZE 100

#ifndef TRUE
#define TRUE 1
#endif

#define UL_SIZE (sizeof (unsigned long))
#define CHAR_SIZE (sizeof char)
#define INT_SIZE (sizeof int)

#ifndef FALSE
#define FALSE 0
#endif

#ifndef MIN
#define MIN(x, y) (x < y ? x : y)
#endif

#ifndef MAX
#define MAX(x, y) (x > y ? x : y)
#endif


/* Now I know why Brodie says the stack usually has a 0 at the bottom! */

/* Be careful of combining these macros.  They both side-effect the
 * stack pointer and use the stack itself.  So PUSH (POP) probably
 * doesn't do what you want it to.
 */
#define PUSH(val) (sp[-2] = (val), sp -= 2)
#define POP (sp += 2, sp[-2])
#define STACKREF(idx) (sp[idx * 2])

/* Same, but for the return stack. */
#define RPUSH(val) (rp[-2] = (val), rp -= 2)
#define RPOP (rp += 2, rp[-2])

#define BL PUSH(' ')

#define IMMEDIATE 128
#define NON_IMMEDIATE 0

#define END_OF_PARAMS 0

typedef void (* funcptr) ();

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

extern long *last_dp; /* For linking entries. */ 

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

/* These are normally stdin and stdout, but that can be changed. */
extern FILE *outfile;
extern FILE *infile;


/* Compute the address of the next aligned word boundary after a
 * string which starts at ADDR and runs for LENGTH bytes.
 */
#define ALIGN_STRING(addr, length) \
   ((long *) ((unsigned long) \
              ((unsigned long) addr + length + \
               ((4 - (((unsigned long) addr + length) % 4)) % 4))))


/* Non-zero iff the entry has its precedence bit set. */
#define ENTRY_IMMEDIATE_P(dict_entry) \
   (((char *) dict_entry)[0] & 128)


/* This does not include the length/precedence byte, of course. */
#define ENTRY_MAX_NAME_LENGTH 31


/* How long is this entry's name? */
#define ENTRY_NAME_LENGTH(dict_entry) \
   (unsigned int) (*((char *) dict_entry) & 127)


/* This returns a string which is not necessarily null-terminated.
 * You really should get the name's length before using it.
 */
#define ENTRY_NAME(dict_entry) \
   (char *) ((char *) dict_entry + 1)


/* The link field. */
#define ENTRY_LINK(dict_entry) \
   (long *) (*(dict_entry + 8))


/* The code pointer pointer of the entry. */
#define ENTRY_CFA(dict_entry) \
    (long *) ((dict_entry + 9))


/* The entry -- from the code pointer! */
#define CFA_ENTRY(cfa) \
    (long *) ((((long *) cfa) - 9))


/* Just returns the start of the PFs. */
#define ENTRY_PFA(dict_entry) \
    (long *) (dict_entry + 10)


/* This is what add_primitive wants. */
struct prim_skel
{
  char *name;
  funcptr func;
  int precedence;
};


/* This macro is like the DEFUN macro in the Emacs sources.
 * 
 * Primitives take no arguments -- they deal entirely with global
 * stacks.
 *
 * You have to remember to call add_primitive(struct_name) after
 * defining the thing, sigh.  I want a *real* macro system, or maybe a
 * language that allows top-level calls.
 * 
 * "visible_name" is what you use from the Forth level.
 * "internal_name" is the name of the C-callable function we're
 * defining.
 * "precedence" is IMMEDIATE or NON_IMMEDIATE.
 * "stack_effect" is an ignored, but required, comment.
 */
#define PRIMITIVE(visible_name,  \
                  internal_name, \
                  struct_name,   \
                  precedence,    \
                  stack_effect)  \
void internal_name (); \
struct prim_skel struct_name = {visible_name, internal_name, precedence}; \
void internal_name ()


/* Testing macros, not needed in the final product. */
#define RUN(word) PUSH((long) dict_lookup(word, 0)); Fexecute();


#define PRINT_STACK(depth) {long i;                                         \
                           if (depth <= 1)                                  \
                             printf ("Stack's first item:\n");              \
                           else                                             \
                             printf ("Stack's first %d items:\n", depth);   \
                           for (i = 0; i < depth; i++)                      \
                             printf ("   %u\n", sp[i * 2]);                 \
                           }


#define PRINT_RSTACK(depth) {long i;                                        \
                           if (depth <= 1)                                  \
                             printf ("R-stack's first item:\n");            \
                           else                                             \
                             printf ("R-stack's first %d items:\n", depth); \
                           for (i = 0; i < depth; i++)                      \
                             printf ("   %u\n", rp[i * 2]);                 \
                           }


/* Global functions. */
void init_arena ();
void init_prims ();
void add_primitive ();
long *dict_lookup (char *, int);
void display_dictionary ();
void address_interpreter ();
void start_word (char *name, char length, char immediate_p);