i can compile slang and newt with dietlibc now

1 files changed, 5547 insertions, 0 deletions

diff --git a/mdk-stage1/slang/slang.c b/mdk-stage1/slang/slang.c
new file mode 100644
index 000000000..6edc7df37
--- /dev/null
+++ b/mdk-stage1/slang/slang.c
@@ -0,0 +1,5547 @@
+/* -*- mode: C; mode: fold; -*- */
+/* slang.c  --- guts of S-Lang interpreter */
+/* Copyright (c) 1992, 1999, 2001 John E. Davis
+ * This file is part of the S-Lang library.
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Perl Artistic License.
+ */
+
+#include "slinclud.h"
+
+#if SLANG_HAS_FLOAT
+# include <math.h>
+#endif
+
+#include "slang.h"
+#include "_slang.h"
+
+#define USE_COMBINED_BYTECODES	0
+
+struct _SLBlock_Type;
+
+typedef struct
+{
+   struct _SLBlock_Type *body;
+   unsigned int num_refs;
+}
+_SLBlock_Header_Type;
+
+typedef struct
+{
+   char *name;
+   SLang_Name_Type *next;
+   char name_type;
+
+   union
+     {
+	_SLBlock_Header_Type *header;    /* body of function */
+	char *autoload_filename;
+     }
+   v;
+#if _SLANG_HAS_DEBUG_CODE
+   char *file;
+#endif
+#define SLANG_MAX_LOCAL_VARIABLES 254
+#define AUTOLOAD_NUM_LOCALS (SLANG_MAX_LOCAL_VARIABLES + 1)
+   unsigned char nlocals;	       /* number of local variables */
+   unsigned char nargs;		       /* number of arguments */
+}
+_SLang_Function_Type;
+
+typedef struct
+{
+   char *name;
+   SLang_Name_Type *next;
+   char name_type;
+
+   SLang_Object_Type obj;
+}
+SLang_Global_Var_Type;
+
+typedef struct
+{
+   char *name;
+   SLang_Name_Type *next;
+   char name_type;
+
+   int local_var_number;
+}
+SLang_Local_Var_Type;
+
+typedef struct _SLBlock_Type
+{
+   unsigned char bc_main_type;
+   unsigned char bc_sub_type;
+   union
+     {
+	struct _SLBlock_Type *blk;
+	int i_blk;
+
+	SLang_Name_Type *nt_blk;
+	SLang_App_Unary_Type *nt_unary_blk;
+	SLang_Intrin_Var_Type *nt_ivar_blk;
+	SLang_Intrin_Fun_Type *nt_ifun_blk;
+	SLang_Global_Var_Type *nt_gvar_blk;
+	SLang_IConstant_Type *iconst_blk;
+	SLang_DConstant_Type *dconst_blk;
+	_SLang_Function_Type *nt_fun_blk;
+
+	VOID_STAR ptr_blk;
+	char *s_blk;
+	SLang_BString_Type *bs_blk;
+
+#if SLANG_HAS_FLOAT
+	double *double_blk;		       /*literal double is a pointer */
+#endif
+	float float_blk;
+	long l_blk;
+	struct _SLang_Struct_Type *struct_blk;
+	int (*call_function)(void);
+     }
+   b;
+}
+SLBlock_Type;
+
+/* Debugging and tracing variables */
+
+void (*SLang_Enter_Function)(char *) = NULL;
+void (*SLang_Exit_Function)(char *) = NULL;
+/* If non null, these call C functions before and after a slang function. */
+
+int _SLang_Trace = 0;
+/* If _SLang_Trace = -1, do not trace intrinsics */
+static int Trace_Mode = 0;
+
+static char *Trace_Function;	       /* function to be traced */
+int SLang_Traceback = 0;
+/* non zero means do traceback.  If less than 0, do not show local variables */
+
+/* These variables handle _NARGS processing by the parser */
+int SLang_Num_Function_Args;
+static int *Num_Args_Stack;
+static unsigned int Recursion_Depth;
+static SLang_Object_Type *Frame_Pointer;
+static int Next_Function_Num_Args;
+static unsigned int Frame_Pointer_Depth;
+static unsigned int *Frame_Pointer_Stack;
+
+static int Lang_Break_Condition = 0;
+/* true if any one below is true.  This keeps us from testing 3 variables.
+ * I know this can be perfomed with a bitmapped variable, but...
+ */
+static int Lang_Break = 0;
+static int Lang_Return = 0;
+/* static int Lang_Continue = 0; */
+
+SLang_Object_Type *_SLRun_Stack;
+SLang_Object_Type *_SLStack_Pointer;
+static SLang_Object_Type *_SLStack_Pointer_Max;
+
+/* Might want to increase this. */
+static SLang_Object_Type Local_Variable_Stack[SLANG_MAX_LOCAL_STACK];
+static SLang_Object_Type *Local_Variable_Frame = Local_Variable_Stack;
+
+static void free_function_header (_SLBlock_Header_Type *);
+
+void (*SLang_Dump_Routine)(char *);
+
+static void call_dump_routine (char *fmt, ...)
+{
+   char buf[1024];
+   va_list ap;
+
+   va_start (ap, fmt);
+   if (SLang_Dump_Routine != NULL)
+     {
+	(void) _SLvsnprintf (buf, sizeof (buf), fmt, ap);
+	(*SLang_Dump_Routine) (buf);
+     }
+   else
+     {
+	vfprintf (stderr, fmt, ap);
+	fflush (stderr);
+     }
+   va_end (ap);
+}
+
+static void do_traceback (char *, unsigned int, char *);
+static int init_interpreter (void);
+
+/*{{{ push/pop/etc stack manipulation functions */
+
+/* This routine is assumed to work even in the presence of a SLang_Error. */
+_INLINE_
+int SLang_pop (SLang_Object_Type *x)
+{
+   register SLang_Object_Type *y;
+
+   y = _SLStack_Pointer;
+   if (y == _SLRun_Stack)
+     {
+	if (SLang_Error == 0) SLang_Error = SL_STACK_UNDERFLOW;
+	x->data_type = 0;
+	return -1;
+     }
+   y--;
+   *x = *y;
+
+   _SLStack_Pointer = y;
+   return 0;
+}
+
+static int pop_ctrl_integer (int *i)
+{
+   int type;
+   SLang_Class_Type *cl;
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   register SLang_Object_Type *y;
+
+   /* Most of the time, either an integer or a char will be on the stack.
+    * Optimize these cases.
+    */
+   y = _SLStack_Pointer;
+   if (y == _SLRun_Stack)
+     {
+	if (SLang_Error == 0) SLang_Error = SL_STACK_UNDERFLOW;
+	return -1;
+     }
+   y--;
+   
+   type = y->data_type;
+   if (type == SLANG_INT_TYPE)
+     {
+	_SLStack_Pointer = y;   
+	*i = y->v.int_val;
+	return 0;
+     }
+   if (type == SLANG_CHAR_TYPE)
+     {
+	_SLStack_Pointer = y;   
+	*i = y->v.char_val;
+	return 0;
+     }
+#else
+   if (-1 == (type = SLang_peek_at_stack ()))
+     return -1;
+#endif
+
+   cl = _SLclass_get_class ((unsigned char) type);
+   if (cl->cl_to_bool == NULL)
+     {
+	SLang_verror (SL_TYPE_MISMATCH,
+		      "%s cannot be used in a boolean context",
+		      cl->cl_name);
+	return -1;
+     }
+   return cl->cl_to_bool ((unsigned char) type, i);
+}
+
+_INLINE_
+int SLang_peek_at_stack (void)
+{
+   if (_SLStack_Pointer == _SLRun_Stack)
+     {
+	if (SLang_Error == 0)
+	  SLang_Error = SL_STACK_UNDERFLOW;
+	return -1;
+     }
+
+   return (_SLStack_Pointer - 1)->data_type;
+}
+
+int SLang_peek_at_stack1 (void)
+{
+   int type;
+
+   type = SLang_peek_at_stack ();
+   if (type == SLANG_ARRAY_TYPE)
+     type = (_SLStack_Pointer - 1)->v.array_val->data_type;
+
+   return type;
+}
+
+_INLINE_
+void SLang_free_object (SLang_Object_Type *obj)
+{
+   unsigned char data_type;
+   SLang_Class_Type *cl;
+
+   if (obj == NULL) return;
+   data_type = obj->data_type;
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type [data_type])
+     return;
+   if (data_type == SLANG_STRING_TYPE)
+     {
+	SLang_free_slstring (obj->v.s_val);
+	return;
+     }
+#endif
+   cl = _SLclass_get_class (data_type);
+#if !_SLANG_OPTIMIZE_FOR_SPEED
+   if (cl->cl_class_type != SLANG_CLASS_TYPE_SCALAR)
+#endif
+     (*cl->cl_destroy) (data_type, (VOID_STAR) &obj->v);
+}
+
+_INLINE_
+int SLang_push (SLang_Object_Type *x)
+{
+   register SLang_Object_Type *y;
+   y = _SLStack_Pointer;
+
+   /* if there is a SLang_Error, probably not much harm will be done
+    if it is ignored here */
+   /* if (SLang_Error) return; */
+
+   /* flag it now */
+   if (y >= _SLStack_Pointer_Max)
+     {
+	if (!SLang_Error) SLang_Error = SL_STACK_OVERFLOW;
+	return -1;
+     }
+
+   *y = *x;
+   _SLStack_Pointer = y + 1;
+   return 0;
+}
+
+/* _INLINE_ */
+int SLclass_push_ptr_obj (unsigned char type, VOID_STAR pval)
+{
+   register SLang_Object_Type *y;
+   y = _SLStack_Pointer;
+
+   if (y >= _SLStack_Pointer_Max)
+     {
+	if (!SLang_Error) SLang_Error = SL_STACK_OVERFLOW;
+	return -1;
+     }
+
+   y->data_type = type;
+   y->v.ptr_val = pval;
+
+   _SLStack_Pointer = y + 1;
+   return 0;
+}
+
+_INLINE_
+int SLclass_push_int_obj (unsigned char type, int x)
+{
+   register SLang_Object_Type *y;
+   y = _SLStack_Pointer;
+
+   if (y >= _SLStack_Pointer_Max)
+     {
+	if (!SLang_Error) SLang_Error = SL_STACK_OVERFLOW;
+	return -1;
+     }
+
+   y->data_type = type;
+   y->v.int_val = x;
+
+   _SLStack_Pointer = y + 1;
+   return 0;
+}
+
+_INLINE_
+int _SLang_pop_object_of_type (unsigned char type, SLang_Object_Type *obj,
+			       int allow_arrays)
+{
+   register SLang_Object_Type *y;
+
+   y = _SLStack_Pointer;
+   if (y == _SLRun_Stack)
+     return SLang_pop (obj);
+   y--;
+   if (y->data_type != type)
+     {
+#if _SLANG_OPTIMIZE_FOR_SPEED
+	/* This is an implicit typecast.  We do not want to typecast
+	 * floats to ints implicitly.  
+	 */
+	if (_SLarith_Is_Arith_Type [type]
+	    && _SLarith_Is_Arith_Type [y->data_type]
+	    && (_SLarith_Is_Arith_Type [type] >= _SLarith_Is_Arith_Type[y->data_type]))
+	  {
+	     /* This should not fail */
+	     (void) _SLarith_typecast (y->data_type, (VOID_STAR)&y->v, 1, 
+				       type, (VOID_STAR)&obj->v);
+	     obj->data_type = type;
+	     _SLStack_Pointer = y;
+	     return 0;
+	  }
+#endif
+	
+	if ((allow_arrays == 0)
+	    || (y->data_type != SLANG_ARRAY_TYPE)
+	    || (y->v.array_val->data_type != type))
+	  if (-1 == SLclass_typecast (type, 1, 0))
+	    return -1;
+     }
+   *obj = *y;
+   _SLStack_Pointer = y;
+   return 0;
+}
+
+/*  This function reverses the top n items on the stack and returns a
+ *  an offset from the start of the stack to the last item.
+ */
+int SLreverse_stack (int n)
+{
+   SLang_Object_Type *otop, *obot, tmp;
+
+   otop = _SLStack_Pointer;
+   if ((n > otop - _SLRun_Stack) || (n < 0))
+     {
+	SLang_Error = SL_STACK_UNDERFLOW;
+	return -1;
+     }
+   obot = otop - n;
+   otop--;
+   while (otop > obot)
+     {
+	tmp = *obot;
+	*obot = *otop;
+	*otop = tmp;
+	otop--;
+	obot++;
+     }
+   return (int) ((_SLStack_Pointer - n) - _SLRun_Stack);
+}
+
+_INLINE_
+int SLroll_stack (int np)
+{
+   int n, i;
+   SLang_Object_Type *otop, *obot, tmp;
+
+   if ((n = abs(np)) <= 1) return 0;    /* identity */
+
+   obot = otop = _SLStack_Pointer;
+   i = n;
+   while (i != 0)
+     {
+	if (obot <= _SLRun_Stack)
+	  {
+	     SLang_Error = SL_STACK_UNDERFLOW;
+	     return -1;
+	  }
+	obot--;
+	i--;
+     }
+   otop--;
+
+   if (np > 0)
+     {
+	/* Put top on bottom and roll rest up. */
+	tmp = *otop;
+	while (otop > obot)
+	  {
+	     *otop = *(otop - 1);
+	     otop--;
+	  }
+	*otop = tmp;
+     }
+   else
+     {
+	/* Put bottom on top and roll rest down. */
+	tmp = *obot;
+	while (obot < otop)
+	  {
+	     *obot = *(obot + 1);
+	     obot++;
+	  }
+	*obot = tmp;
+     }
+   return 0;
+}
+
+int _SLstack_depth (void)
+{
+   return (int) (_SLStack_Pointer - _SLRun_Stack);
+}
+
+int SLdup_n (int n)
+{
+   SLang_Object_Type *bot, *top;
+
+   if (n <= 0)
+     return 0;
+   
+   top = _SLStack_Pointer;
+   if (top < _SLRun_Stack + n)
+     {
+	if (SLang_Error == 0)
+	  SLang_Error = SL_STACK_UNDERFLOW;
+	return -1;
+     }
+   if (top + n > _SLStack_Pointer_Max)
+     {
+	if (SLang_Error == 0)
+	  SLang_Error = SL_STACK_OVERFLOW;
+	return -1;
+     }
+   bot = top - n;
+
+   while (bot < top)
+     {
+	SLang_Class_Type *cl;
+	unsigned char data_type = bot->data_type;
+
+#if _SLANG_OPTIMIZE_FOR_SPEED
+	if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type [data_type])
+	  {
+	     *_SLStack_Pointer++ = *bot++;
+	     continue;
+	  }
+#endif
+	cl = _SLclass_get_class (data_type);
+	if (-1 == (*cl->cl_push) (data_type, (VOID_STAR) &bot->v))
+	  return -1;
+	bot++;
+     }
+   return 0;
+}
+
+/*}}}*/
+
+/*{{{ inner interpreter and support functions */
+
+_INLINE_
+int _SL_increment_frame_pointer (void)
+{
+   if (Recursion_Depth >= SLANG_MAX_RECURSIVE_DEPTH)
+     {
+	SLang_verror (SL_STACK_OVERFLOW, "Num Args Stack Overflow");
+	return -1;
+     }
+   Num_Args_Stack [Recursion_Depth] = SLang_Num_Function_Args;
+
+   SLang_Num_Function_Args = Next_Function_Num_Args;
+   Next_Function_Num_Args = 0;
+   Recursion_Depth++;
+   return 0;
+}
+
+_INLINE_
+int _SL_decrement_frame_pointer (void)
+{
+   if (Recursion_Depth == 0)
+     {
+	SLang_verror (SL_STACK_UNDERFLOW, "Num Args Stack Underflow");
+	return -1;
+     }
+
+   Recursion_Depth--;
+   if (Recursion_Depth < SLANG_MAX_RECURSIVE_DEPTH)
+     SLang_Num_Function_Args = Num_Args_Stack [Recursion_Depth];
+
+   return 0;
+}
+
+_INLINE_
+int SLang_start_arg_list (void)
+{
+   if (Frame_Pointer_Depth < SLANG_MAX_RECURSIVE_DEPTH)
+     {
+	Frame_Pointer_Stack [Frame_Pointer_Depth] = (unsigned int) (Frame_Pointer - _SLRun_Stack);
+	Frame_Pointer = _SLStack_Pointer;
+	Frame_Pointer_Depth++;
+	Next_Function_Num_Args = 0;
+	return 0;
+     }
+
+   SLang_verror (SL_STACK_OVERFLOW, "Frame Stack Overflow");
+   return -1;
+}
+
+_INLINE_
+int SLang_end_arg_list (void)
+{
+   if (Frame_Pointer_Depth == 0)
+     {
+	SLang_verror (SL_STACK_UNDERFLOW, "Frame Stack Underflow");
+	return -1;
+     }
+   Frame_Pointer_Depth--;
+   if (Frame_Pointer_Depth < SLANG_MAX_RECURSIVE_DEPTH)
+     {
+	Next_Function_Num_Args = (int) (_SLStack_Pointer - Frame_Pointer);
+	Frame_Pointer = _SLRun_Stack + Frame_Pointer_Stack [Frame_Pointer_Depth];
+     }
+   return 0;
+}
+
+_INLINE_
+static int do_bc_call_direct_frame (int (*f)(void))
+{
+   if ((0 == SLang_end_arg_list ())
+       && (0 == _SL_increment_frame_pointer ()))
+     {
+	(void) (*f) ();
+	_SL_decrement_frame_pointer ();
+     }
+   if (SLang_Error)
+     return -1;
+   return 0;
+}
+
+static int do_name_type_error (SLang_Name_Type *nt)
+{
+   char buf[256];
+   if (nt != NULL)
+     {
+	(void) _SLsnprintf (buf, sizeof (buf), "(Error occurred processing %s)", nt->name);
+	do_traceback (buf, 0, NULL);
+     }
+   return -1;
+}
+
+/* local and global variable assignments */
+
+static int do_binary_ab (int op, SLang_Object_Type *obja, SLang_Object_Type *objb)
+{
+   SLang_Class_Type *a_cl, *b_cl, *c_cl;
+   unsigned char b_data_type, a_data_type, c_data_type;
+   int (*binary_fun) (int,
+		      unsigned char, VOID_STAR, unsigned int,
+		      unsigned char, VOID_STAR, unsigned int,
+		      VOID_STAR);
+   VOID_STAR pa;
+   VOID_STAR pb;
+   VOID_STAR pc;
+   int ret;
+
+   b_data_type = objb->data_type;
+   a_data_type = obja->data_type;
+
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (_SLarith_Is_Arith_Type[a_data_type]
+       && _SLarith_Is_Arith_Type[b_data_type])
+     {
+	int status;
+	status = _SLarith_bin_op (obja, objb, op);
+	if (status != 1)
+	  return status;
+	/* drop and try it the hard way */
+     }
+#endif
+
+   a_cl = _SLclass_get_class (a_data_type);
+   if (a_data_type == b_data_type)
+     b_cl = a_cl;
+   else
+     b_cl = _SLclass_get_class (b_data_type);
+
+   if (NULL == (binary_fun = _SLclass_get_binary_fun (op, a_cl, b_cl, &c_cl, 1)))
+     return -1;
+
+   c_data_type = c_cl->cl_data_type;
+
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type [a_data_type])
+     pa = (VOID_STAR) &obja->v;
+   else
+#endif
+     pa = _SLclass_get_ptr_to_value (a_cl, obja);
+
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type [b_data_type])
+     pb = (VOID_STAR) &objb->v;
+   else
+#endif
+     pb = _SLclass_get_ptr_to_value (b_cl, objb);
+
+   pc = c_cl->cl_transfer_buf;
+
+   if (1 != (*binary_fun) (op,
+			   a_data_type, pa, 1,
+			   b_data_type, pb, 1,
+			   pc))
+     {
+	SLang_verror (SL_NOT_IMPLEMENTED,
+		      "Binary operation between %s and %s failed",
+		      a_cl->cl_name, b_cl->cl_name);
+
+	return -1;
+     }
+
+   /* apush will create a copy, so make sure we free after the push */
+   ret = (*c_cl->cl_apush)(c_data_type, pc);
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [c_data_type])
+#endif
+     (*c_cl->cl_adestroy)(c_data_type, pc);
+
+   return ret;
+}
+
+_INLINE_
+static void do_binary (int op)
+{
+   SLang_Object_Type obja, objb;
+
+   if (SLang_pop (&objb)) return;
+   if (0 == SLang_pop (&obja))
+     {
+	(void) do_binary_ab (op, &obja, &objb);
+#if _SLANG_OPTIMIZE_FOR_SPEED
+	if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [obja.data_type])
+#endif
+	  SLang_free_object (&obja);
+     }
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [objb.data_type])
+#endif
+     SLang_free_object (&objb);
+}
+
+static int do_unary_op (int op, SLang_Object_Type *obj, int unary_type)
+{
+   int (*f) (int, unsigned char, VOID_STAR, unsigned int, VOID_STAR);
+   VOID_STAR pa;
+   VOID_STAR pb;
+   SLang_Class_Type *a_cl, *b_cl;
+   unsigned char a_type, b_type;
+   int ret;
+
+   a_type = obj->data_type;
+   a_cl = _SLclass_get_class (a_type);
+
+   if (NULL == (f = _SLclass_get_unary_fun (op, a_cl, &b_cl, unary_type)))
+     return -1;
+
+   b_type = b_cl->cl_data_type;
+
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type [a_type])
+     pa = (VOID_STAR) &obj->v;
+   else
+#endif
+     pa = _SLclass_get_ptr_to_value (a_cl, obj);
+
+   pb = b_cl->cl_transfer_buf;
+
+   if (1 != (*f) (op, a_type, pa, 1, pb))
+     {
+	SLang_verror (SL_NOT_IMPLEMENTED,
+		      "Unary operation for %s failed", a_cl->cl_name);
+	return -1;
+     }
+
+   ret = (*b_cl->cl_apush)(b_type, pb);
+   /* cl_apush creates a copy, so make sure we call cl_adestroy */
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [b_type])
+#endif
+     (*b_cl->cl_adestroy)(b_type, pb);
+
+   return ret;
+}
+
+_INLINE_
+static int do_unary (int op, int unary_type)
+{
+   SLang_Object_Type obj;
+   int ret;
+
+   if (-1 == SLang_pop (&obj)) return -1;
+   ret = do_unary_op (op, &obj, unary_type);
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [obj.data_type])
+#endif
+     SLang_free_object (&obj);
+   return ret;
+}
+
+static int do_assignment_binary (int op, SLang_Object_Type *obja_ptr)
+{
+   SLang_Object_Type objb;
+   int ret;
+
+   if (SLang_pop (&objb))
+     return -1;
+
+   ret = do_binary_ab (op, obja_ptr, &objb);
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [objb.data_type])
+#endif
+     SLang_free_object (&objb);
+   return ret;
+}
+
+/* The order of these is assumed to match the binary operators
+ * defined in slang.h
+ */
+static int
+map_assignment_op_to_binary (unsigned char op_type, int *op, int *is_unary)
+{
+   *is_unary = 0;
+   switch (op_type)
+     {
+      case _SLANG_BCST_PLUSEQS:
+      case _SLANG_BCST_MINUSEQS:
+      case _SLANG_BCST_TIMESEQS:
+      case _SLANG_BCST_DIVEQS:
+	*op = SLANG_PLUS + (op_type - _SLANG_BCST_PLUSEQS);
+	break;
+
+      case _SLANG_BCST_BOREQS:
+	*op = SLANG_BOR;
+	break;
+
+      case _SLANG_BCST_BANDEQS:
+	*op = SLANG_BAND;
+	break;
+
+      case _SLANG_BCST_POST_MINUSMINUS:
+      case _SLANG_BCST_MINUSMINUS:
+	*op = SLANG_MINUS;
+	*is_unary = 1;
+	break;
+
+      case _SLANG_BCST_PLUSPLUS:
+      case _SLANG_BCST_POST_PLUSPLUS:
+	*op = SLANG_PLUS;
+	*is_unary = 1;
+	break;
+
+      default:
+	SLang_verror (SL_NOT_IMPLEMENTED, "Assignment operator not implemented");
+	return -1;
+     }
+   return 0;
+}
+
+static int
+perform_lvalue_operation (unsigned char op_type, SLang_Object_Type *obja_ptr)
+{
+   switch (op_type)
+     {
+      case _SLANG_BCST_ASSIGN:
+	break;
+
+	/* The order of these is assumed to match the binary operators
+	 * defined in slang.h
+	 */
+      case _SLANG_BCST_PLUSEQS:
+      case _SLANG_BCST_MINUSEQS:
+      case _SLANG_BCST_TIMESEQS:
+      case _SLANG_BCST_DIVEQS:
+	if (-1 == do_assignment_binary (SLANG_PLUS + (op_type - _SLANG_BCST_PLUSEQS), obja_ptr))
+	  return -1;
+	break;
+
+      case _SLANG_BCST_BOREQS:
+	if (-1 == do_assignment_binary (SLANG_BOR, obja_ptr))
+	  return -1;
+	break;
+
+      case _SLANG_BCST_BANDEQS:
+	if (-1 == do_assignment_binary (SLANG_BAND, obja_ptr))
+	  return -1;
+	break;
+
+      case _SLANG_BCST_PLUSPLUS:
+      case _SLANG_BCST_POST_PLUSPLUS:
+#if _SLANG_OPTIMIZE_FOR_SPEED
+	if (obja_ptr->data_type == SLANG_INT_TYPE)
+	  return SLclass_push_int_obj (SLANG_INT_TYPE, obja_ptr->v.int_val + 1);
+#endif
+	if (-1 == do_unary_op (SLANG_PLUSPLUS, obja_ptr, _SLANG_BC_UNARY))
+	  return -1;
+	break;
+
+      case _SLANG_BCST_MINUSMINUS:
+      case _SLANG_BCST_POST_MINUSMINUS:
+#if _SLANG_OPTIMIZE_FOR_SPEED
+	if (obja_ptr->data_type == SLANG_INT_TYPE)
+	  return SLclass_push_int_obj (SLANG_INT_TYPE, obja_ptr->v.int_val - 1);
+#endif
+	if (-1 == do_unary_op (SLANG_MINUSMINUS, obja_ptr, _SLANG_BC_UNARY))
+	  return -1;
+	break;
+
+      default:
+	SLang_Error = SL_INTERNAL_ERROR;
+	return -1;
+     }
+   return 0;
+}
+
+_INLINE_
+static int
+set_lvalue_obj (unsigned char op_type, SLang_Object_Type *obja_ptr)
+{
+   if (op_type != _SLANG_BCST_ASSIGN)
+     {
+	if (-1 == perform_lvalue_operation (op_type, obja_ptr))
+	  return -1;
+     }
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [obja_ptr->data_type])
+#endif
+     SLang_free_object (obja_ptr);
+
+   return SLang_pop(obja_ptr);
+}
+
+static int
+set_struct_lvalue (SLBlock_Type *bc_blk)
+{
+   int type;
+   SLang_Class_Type *cl;
+   char *name;
+   int op;
+
+   if (-1 == (type = SLang_peek_at_stack ()))
+     return -1;
+
+   cl = _SLclass_get_class (type);
+   if ((cl->cl_sput == NULL)
+       || (cl->cl_sget == NULL))
+     {
+	SLang_verror (SL_NOT_IMPLEMENTED,
+		      "%s does not support structure access",
+		      cl->cl_name);
+	SLdo_pop_n (2);		       /* object plus what was to be assigned */
+	return -1;
+     }
+   name = bc_blk->b.s_blk;
+   op = bc_blk->bc_sub_type;
+
+   if (op != _SLANG_BCST_ASSIGN)
+     {
+	/* We have something like (A.x += b) or (A.x++).  In either case,
+	 * we need A.x.
+	 */
+	SLang_Object_Type obj_A;
+	SLang_Object_Type obj;
+
+	if (-1 == SLang_pop (&obj_A))
+	  return -1;
+
+	if ((-1 == _SLpush_slang_obj (&obj_A))
+	    || (-1 == cl->cl_sget ((unsigned char) type, name))
+	    || (-1 == SLang_pop (&obj)))
+	  {
+	     SLang_free_object (&obj_A);
+	     return -1;
+	  }
+	/* Now the value of A.x is in obj. */
+	if (-1 == perform_lvalue_operation (op, &obj))
+	  {
+	     SLang_free_object (&obj);
+	     SLang_free_object (&obj_A);
+	     return -1;
+	  }
+	SLang_free_object (&obj);
+	/* The result of the operation is now on the stack.
+	 * Perform assignment */
+	if (-1 == SLang_push (&obj_A))
+	  {
+	     SLang_free_object (&obj_A);
+	     return -1;
+	  }
+     }
+
+   return (*cl->cl_sput) ((unsigned char) type, name);
+}
+
+static int make_unit_object (SLang_Object_Type *a, SLang_Object_Type *u)
+{
+   unsigned char type;
+   
+   type = a->data_type;
+   if (type == SLANG_ARRAY_TYPE)
+     type = a->v.array_val->data_type;
+   
+   u->data_type = type;
+   switch (type)
+     {
+      case SLANG_UCHAR_TYPE:
+      case SLANG_CHAR_TYPE:
+	u->v.char_val = 1;
+	break;
+
+      case SLANG_SHORT_TYPE:
+      case SLANG_USHORT_TYPE:
+	u->v.short_val = 1;
+	break;
+
+      case SLANG_LONG_TYPE:
+      case SLANG_ULONG_TYPE:
+	u->v.long_val = 1;
+	break;
+
+#if SLANG_HAS_FLOAT
+      case SLANG_FLOAT_TYPE:
+	u->v.float_val = 1;
+	break;
+	
+      case SLANG_COMPLEX_TYPE:
+	u->data_type = SLANG_DOUBLE_TYPE;
+      case SLANG_DOUBLE_TYPE:
+	u->v.double_val = 1;
+	break;
+#endif
+      default:
+	u->data_type = SLANG_INT_TYPE;
+	u->v.int_val = 1;
+     }
+   return 0;
+}
+
+
+/* We want to convert 'A[i] op X' to 'A[i] = A[i] op X'.  The code that
+ * has been generated is:  X __args i A __aput-op
+ * where __aput-op represents this function.  We need to generate:
+ * __args i A __eargs __aget X op __args i A __eargs __aput
+ * Here, __eargs implies a call to do_bc_call_direct_frame with either
+ * the aput or aget function.  In addition, __args represents a call to 
+ * SLang_start_arg_list.  Of course, i represents a set of indices.
+ * 
+ * Note: If op is an unary operation (e.g., ++ or --), then X will not
+ * b present an will have to be taken to be 1.
+ * 
+ * Implementation note: For efficiency, calls to setup the frame, start
+ * arg list will be omitted and SLang_Num_Function_Args will be set.
+ * This is ugly but the alternative is much less efficient rendering these
+ * assignment operators useless.  So, the plan is to roll the stack to get X,
+ * then duplicate the next N values, call __aget followed by op X, finally
+ * calling __aput.  Hence, the sequence is:
+ * 
+ *     start:   X i .. j A 
+ *      dupN:   X i .. j A i .. j A
+ *    __aget:   X i .. j A Y
+ *      roll:   i .. j A Y X
+ *        op:   i .. j A Z
+ *      roll:   Z i .. j A
+ *    __aput:
+ */
+static int
+set_array_lvalue (int op)
+{
+   SLang_Object_Type x, y;
+   int num_args, is_unary;
+
+   if (-1 == map_assignment_op_to_binary (op, &op, &is_unary))
+     return -1;
+
+   /* Grab the indices and the array.  Do not start a new frame. */
+   if (-1 == SLang_end_arg_list ())
+     return -1;
+   num_args = Next_Function_Num_Args;
+   Next_Function_Num_Args = 0;
+
+   if (-1 == SLdup_n (num_args))
+     return -1;
+
+   SLang_Num_Function_Args = num_args;
+   if (-1 == _SLarray_aget ())
+     return -1;
+
+   if (-1 == SLang_pop (&y))
+     return -1;
+   
+   if (is_unary == 0)
+     {
+	if ((-1 == SLroll_stack (-(num_args + 1)))
+	    || (-1 == SLang_pop (&x)))
+	  {
+	     SLang_free_object (&y);
+	     return -1;
+	  }
+     }
+   else if (-1 == make_unit_object (&y, &x))
+     {
+	SLang_free_object (&y);
+	return -1;
+     }
+   
+   if (-1 == do_binary_ab (op, &y, &x))
+     {
+	SLang_free_object (&y);
+	SLang_free_object (&x);
+	return -1;
+     }
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [y.data_type])
+#endif
+     SLang_free_object (&y);
+   
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [x.data_type])
+#endif
+     SLang_free_object (&x);
+
+   if (-1 == SLroll_stack (num_args + 1))
+     return -1;
+
+   SLang_Num_Function_Args = num_args;
+   return _SLarray_aput ();
+}
+
+
+static int
+set_intrin_lvalue (SLBlock_Type *bc_blk)
+{
+   unsigned char op_type;
+   SLang_Object_Type obja;
+   SLang_Class_Type *cl;
+   SLang_Intrin_Var_Type *ivar;
+   VOID_STAR intrinsic_addr;
+   unsigned char intrinsic_type;
+
+   ivar = bc_blk->b.nt_ivar_blk;
+
+   intrinsic_type = ivar->type;
+   intrinsic_addr = ivar->addr;
+
+   op_type = bc_blk->bc_sub_type;
+
+   cl = _SLclass_get_class (intrinsic_type);
+
+   if (op_type != _SLANG_BCST_ASSIGN)
+     {
+	/* We want to get the current value into obja.  This is the
+	 * easiest way.
+	 */
+	if ((-1 == (*cl->cl_push) (intrinsic_type, intrinsic_addr))
+	    || (-1 == SLang_pop (&obja)))
+	  return -1;
+
+	(void) perform_lvalue_operation (op_type, &obja);
+	SLang_free_object (&obja);
+
+	if (SLang_Error)
+	  return -1;
+     }
+
+   return (*cl->cl_pop) (intrinsic_type, intrinsic_addr);
+}
+
+int _SLang_deref_assign (SLang_Ref_Type *ref)
+{
+   SLang_Object_Type *objp;
+   SLang_Name_Type *nt;
+   SLBlock_Type blk;
+
+   if (ref->is_global == 0)
+     {
+	objp = ref->v.local_obj;
+	if (objp > Local_Variable_Frame)
+	  {
+	     SLang_verror (SL_UNDEFINED_NAME, "Local variable reference is out of scope");
+	     return -1;
+	  }
+	return set_lvalue_obj (_SLANG_BCST_ASSIGN, objp);
+     }
+
+   nt = ref->v.nt;
+   switch (nt->name_type)
+     {
+      case SLANG_GVARIABLE:
+      case SLANG_PVARIABLE:
+	if (-1 == set_lvalue_obj (_SLANG_BCST_ASSIGN,
+				  &((SLang_Global_Var_Type *)nt)->obj))
+	  {
+	     do_name_type_error (nt);
+	     return -1;
+	  }
+	break;
+
+      case SLANG_IVARIABLE:
+	blk.b.nt_blk = nt;
+	blk.bc_sub_type = _SLANG_BCST_ASSIGN;
+	if (-1 == set_intrin_lvalue (&blk))
+	  {
+	     do_name_type_error (nt);
+	     return -1;
+	  }
+	break;
+
+      case SLANG_LVARIABLE:
+	SLang_Error = SL_INTERNAL_ERROR;
+	/* set_intrin_lvalue (&blk); */
+	return -1;
+
+      case SLANG_RVARIABLE:
+      default:
+	SLang_verror (SL_READONLY_ERROR, "deref assignment to %s not allowed", nt->name);
+	return -1;
+     }
+
+   return 0;
+}
+
+static void set_deref_lvalue (SLBlock_Type *bc_blk)
+{
+   SLang_Object_Type *objp;
+   SLang_Ref_Type *ref;
+
+   switch (bc_blk->bc_sub_type)
+     {
+      case SLANG_LVARIABLE:
+	objp =  (Local_Variable_Frame - bc_blk->b.i_blk);
+	break;
+      case SLANG_GVARIABLE:
+      case SLANG_PVARIABLE:
+	objp = &bc_blk->b.nt_gvar_blk->obj;
+	break;
+      default:
+	SLang_Error = SL_INTERNAL_ERROR;
+	return;
+     }
+
+   if (-1 == _SLpush_slang_obj (objp))
+     return;
+
+   if (-1 == SLang_pop_ref (&ref))
+     return;
+   (void) _SLang_deref_assign (ref);
+   SLang_free_ref (ref);
+}
+
+static int push_struct_field (char *name)
+{
+   int type;
+   SLang_Class_Type *cl;
+
+   if (-1 == (type = SLang_peek_at_stack ()))
+     return -1;
+
+   cl = _SLclass_get_class ((unsigned char) type);
+   if (cl->cl_sget == NULL)
+     {
+	SLang_verror (SL_NOT_IMPLEMENTED,
+		      "%s does not permit structure access",
+		      cl->cl_name);
+	SLdo_pop_n (2);
+	return -1;
+     }
+
+   return (*cl->cl_sget) ((unsigned char) type, name);
+}
+
+static void trace_dump (char *format, char *name, SLang_Object_Type *objs, int n, int dir)
+{
+   unsigned int len;
+   char prefix [52];
+
+   len = Trace_Mode - 1;
+   if (len + 2 >= sizeof (prefix))
+     len = sizeof (prefix) - 2;
+
+   SLMEMSET (prefix, ' ', len);
+   prefix[len] = 0;
+
+   call_dump_routine (prefix);
+   call_dump_routine (format, name, n);
+
+   if (n > 0)
+     {
+	prefix[len] = ' ';
+	len++;
+	prefix[len] = 0;
+
+	_SLdump_objects (prefix, objs, n, dir);
+     }
+}
+
+/*  Pop a data item from the stack and return a pointer to it.
+ *  Strings are not freed from stack so use another routine to do it.
+ */
+static VOID_STAR pop_pointer (SLang_Object_Type *obj, unsigned char type)
+{
+#ifndef _SLANG_OPTIMIZE_FOR_SPEED
+   SLang_Class_Type *cl;
+#endif
+
+   SLang_Array_Type *at;
+
+   /* Arrays are special.  Allow scalars to automatically convert to arrays.
+    */
+   if (type == SLANG_ARRAY_TYPE)
+     {
+	if (-1 == SLang_pop_array (&at, 1))
+	  return NULL;
+	obj->data_type = SLANG_ARRAY_TYPE;
+	return obj->v.ptr_val = (VOID_STAR) at;
+     }
+
+   if (type == 0)
+     {
+	/* This happens when an intrinsic is declared without any information
+	 * regarding parameter types.
+	 */
+	if (-1 == SLang_pop (obj))
+	  return NULL;
+	type = obj->data_type;
+     }
+   else if (-1 == _SLang_pop_object_of_type (type, obj, 0))
+     return NULL;
+
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   type = _SLclass_Class_Type [type];
+#else
+   type = _SLclass_get_class (type)->cl_class_type;
+#endif
+
+   if (type == SLANG_CLASS_TYPE_SCALAR)
+     return (VOID_STAR) &obj->v;
+   else if (type == SLANG_CLASS_TYPE_MMT)
+     return SLang_object_from_mmt (obj->v.ref);
+   else
+     return obj->v.ptr_val;
+}
+
+/* This is ugly.  Does anyone have a advice for a cleaner way of doing
+ * this??
+ */
+typedef void (*VF0_Type)(void);
+typedef void (*VF1_Type)(VOID_STAR);
+typedef void (*VF2_Type)(VOID_STAR, VOID_STAR);
+typedef void (*VF3_Type)(VOID_STAR, VOID_STAR, VOID_STAR);
+typedef void (*VF4_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR);
+typedef void (*VF5_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR);
+typedef void (*VF6_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR);
+typedef void (*VF7_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR);
+typedef long (*LF0_Type)(void);
+typedef long (*LF1_Type)(VOID_STAR);
+typedef long (*LF2_Type)(VOID_STAR, VOID_STAR);
+typedef long (*LF3_Type)(VOID_STAR, VOID_STAR, VOID_STAR);
+typedef long (*LF4_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR);
+typedef long (*LF5_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR);
+typedef long (*LF6_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR);
+typedef long (*LF7_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR);
+#if SLANG_HAS_FLOAT
+typedef double (*FF0_Type)(void);
+typedef double (*FF1_Type)(VOID_STAR);
+typedef double (*FF2_Type)(VOID_STAR, VOID_STAR);
+typedef double (*FF3_Type)(VOID_STAR, VOID_STAR, VOID_STAR);
+typedef double (*FF4_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR);
+typedef double (*FF5_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR);
+typedef double (*FF6_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR);
+typedef double (*FF7_Type)(VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR, VOID_STAR);
+#endif
+
+static int execute_intrinsic_fun (SLang_Intrin_Fun_Type *objf)
+{
+#if SLANG_HAS_FLOAT
+   double xf;
+#endif
+   VOID_STAR p[SLANG_MAX_INTRIN_ARGS];
+   SLang_Object_Type objs[SLANG_MAX_INTRIN_ARGS];
+   long ret;
+   unsigned char type;
+   unsigned int argc;
+   unsigned int i;
+   FVOID_STAR fptr;
+   unsigned char *arg_types;
+   int stk_depth;
+
+   fptr = objf->i_fun;
+   argc = objf->num_args;
+   type = objf->return_type;
+   arg_types = objf->arg_types;
+
+   if (argc > SLANG_MAX_INTRIN_ARGS)
+     {
+	SLang_verror(SL_APPLICATION_ERROR,
+		     "Intrinsic function %s requires too many parameters", objf->name);
+	return -1;
+     }
+
+   if (-1 == _SL_increment_frame_pointer ())
+     return -1;
+
+   stk_depth = -1;
+   if (Trace_Mode && (_SLang_Trace > 0))
+     {
+	int nargs;
+
+	stk_depth = _SLstack_depth ();
+
+	nargs = SLang_Num_Function_Args;
+	if (nargs == 0)
+	  nargs = (int)argc;
+
+	stk_depth -= nargs;
+
+	if (stk_depth >= 0)
+	  trace_dump (">>%s (%d args)\n",
+		      objf->name,
+		      _SLStack_Pointer - nargs,
+		      nargs,
+		      1);
+     }
+
+   i = argc;
+   while (i != 0)
+     {
+	i--;
+	if (NULL == (p[i] = pop_pointer (objs + i, arg_types[i])))
+	  {
+	     i++;
+	     goto free_and_return;
+	  }
+     }
+
+   ret = 0;
+#if SLANG_HAS_FLOAT
+   xf = 0.0;
+#endif
+
+   switch (argc)
+     {
+      case 0:
+	if (type == SLANG_VOID_TYPE) ((VF0_Type) fptr) ();
+#if SLANG_HAS_FLOAT
+	else if (type == SLANG_DOUBLE_TYPE) xf = ((FF0_Type) fptr)();
+#endif
+	else ret = ((LF0_Type) fptr)();
+	break;
+
+      case 1:
+	if (type == SLANG_VOID_TYPE) ((VF1_Type) fptr)(p[0]);
+#if SLANG_HAS_FLOAT
+	else if (type == SLANG_DOUBLE_TYPE) xf =  ((FF1_Type) fptr)(p[0]);
+#endif
+	else ret =  ((LF1_Type) fptr)(p[0]);
+	break;
+
+      case 2:
+	if (type == SLANG_VOID_TYPE)  ((VF2_Type) fptr)(p[0], p[1]);
+#if SLANG_HAS_FLOAT
+	else if (type == SLANG_DOUBLE_TYPE) xf = ((FF2_Type) fptr)(p[0], p[1]);
+#endif
+	else ret = ((LF2_Type) fptr)(p[0], p[1]);
+	break;
+
+      case 3:
+	if (type == SLANG_VOID_TYPE) ((VF3_Type) fptr)(p[0], p[1], p[2]);
+#if SLANG_HAS_FLOAT
+	else if (type == SLANG_DOUBLE_TYPE) xf = ((FF3_Type) fptr)(p[0], p[1], p[2]);
+#endif
+	else ret = ((LF3_Type) fptr)(p[0], p[1], p[2]);
+	break;
+
+      case 4:
+	if (type == SLANG_VOID_TYPE) ((VF4_Type) fptr)(p[0], p[1], p[2], p[3]);
+#if SLANG_HAS_FLOAT
+	else if (type == SLANG_DOUBLE_TYPE) xf = ((FF4_Type) fptr)(p[0], p[1], p[2], p[3]);
+#endif
+	else ret = ((LF4_Type) fptr)(p[0], p[1], p[2], p[3]);
+	break;
+
+      case 5:
+	if (type == SLANG_VOID_TYPE) ((VF5_Type) fptr)(p[0], p[1], p[2], p[3], p[4]);
+#if SLANG_HAS_FLOAT
+	else if (type == SLANG_DOUBLE_TYPE) xf = ((FF5_Type) fptr)(p[0], p[1], p[2], p[3], p[4]);
+#endif
+	else ret = ((LF5_Type) fptr)(p[0], p[1], p[2], p[3], p[4]);
+	break;
+
+      case 6:
+	if (type == SLANG_VOID_TYPE) ((VF6_Type) fptr)(p[0], p[1], p[2], p[3], p[4], p[5]);
+#if SLANG_HAS_FLOAT
+	else if (type == SLANG_DOUBLE_TYPE) xf = ((FF6_Type) fptr)(p[0], p[1], p[2], p[3], p[4], p[5]);
+#endif
+	else ret = ((LF6_Type) fptr)(p[0], p[1], p[2], p[3], p[4], p[5]);
+	break;
+
+      case 7:
+	if (type == SLANG_VOID_TYPE) ((VF7_Type) fptr)(p[0], p[1], p[2], p[3], p[4], p[5], p[6]);
+#if SLANG_HAS_FLOAT
+	else if (type == SLANG_DOUBLE_TYPE) xf = ((FF7_Type) fptr)(p[0], p[1], p[2], p[3], p[4], p[5], p[6]);
+#endif
+	else ret = ((LF7_Type) fptr)(p[0], p[1], p[2], p[3], p[4], p[5], p[6]);
+	break;
+     }
+
+   switch (type)
+     {
+      case SLANG_VOID_TYPE:
+	break;
+	
+#if SLANG_HAS_FLOAT
+      case SLANG_DOUBLE_TYPE:
+	(void) SLang_push_double (xf);
+	break;
+#endif
+      case SLANG_UINT_TYPE:
+      case SLANG_INT_TYPE: (void) SLclass_push_int_obj (type, (int) ret);
+	break;
+	
+      case SLANG_CHAR_TYPE:
+      case SLANG_UCHAR_TYPE: (void) SLclass_push_char_obj (type, (char) ret);
+	break;
+
+      case SLANG_SHORT_TYPE:
+      case SLANG_USHORT_TYPE: (void) SLclass_push_short_obj (type, (short) ret);
+	break;
+
+      case SLANG_LONG_TYPE:
+      case SLANG_ULONG_TYPE: (void) SLclass_push_long_obj (type, ret);
+	break;
+	
+      case SLANG_STRING_TYPE:
+	if (NULL == (char *)ret)
+	  {
+	     if (SLang_Error == 0) SLang_Error = SL_INTRINSIC_ERROR;
+	  }
+	else (void) SLang_push_string ((char *)ret);
+	break;
+	
+      default:
+	SLang_verror (SL_NOT_IMPLEMENTED,
+		      "Support for intrinsic functions returning %s is not provided",
+		      SLclass_get_datatype_name (type));
+     }
+
+   if (stk_depth >= 0)
+     {
+	stk_depth = _SLstack_depth () - stk_depth;
+
+	trace_dump ("<<%s (returning %d values)\n",
+		      objf->name,
+		      _SLStack_Pointer - stk_depth,
+		      stk_depth,
+		      1);
+     }
+
+   free_and_return:
+   while (i < argc)
+     {
+	SLang_free_object (objs + i);
+	i++;
+     }
+
+   return _SL_decrement_frame_pointer ();
+}
+
+static int inner_interp(register SLBlock_Type *);
+
+/* Switch_Obj_Ptr points to the NEXT available free switch object */
+static SLang_Object_Type Switch_Objects[SLANG_MAX_NESTED_SWITCH];
+static SLang_Object_Type *Switch_Obj_Ptr = Switch_Objects;
+static SLang_Object_Type *Switch_Obj_Max = Switch_Objects + SLANG_MAX_NESTED_SWITCH;
+
+static void
+lang_do_loops (unsigned char stype, SLBlock_Type *block, unsigned int num_blocks)
+{
+   int i, ctrl;
+   int first, last;
+   SLBlock_Type *blks[4];
+   char *loop_name;
+   SLang_Foreach_Context_Type *foreach_context;
+   SLang_Class_Type *cl;
+   int type;
+   unsigned int j;
+
+   j = 0;
+   for (i = 0; i < (int) num_blocks; i++)
+     {
+	if (block[i].bc_main_type != _SLANG_BC_BLOCK)
+	  {
+	     if (block[i].bc_main_type == _SLANG_BC_LINE_NUM)
+	       continue;
+
+	     SLang_verror (SL_SYNTAX_ERROR, "Bytecode is not a looping block");
+	     return;
+	  }
+	blks[j] = block[i].b.blk;
+	j++;
+     }
+
+   num_blocks = j;
+   block = blks[0];
+
+   switch (stype)
+     {
+      case _SLANG_BCST_FOREACH:
+	loop_name = "foreach";
+	if (num_blocks != 1)
+	  goto wrong_num_blocks_error;
+
+	/* We should find Next_Function_Num_Args + 1 items on the stack.
+	 * The first Next_Function_Num_Args items represent the arguments to
+	 * to USING.  The last item (deepest in stack) is the object to loop
+	 * over.  So, roll the stack up and grab it.
+	 */
+	if ((-1 == SLroll_stack (-(Next_Function_Num_Args + 1)))
+	    || (-1 == (type = SLang_peek_at_stack ())))
+	  goto return_error;
+
+	cl = _SLclass_get_class ((unsigned char) type);
+	if ((cl->cl_foreach == NULL)
+	    || (cl->cl_foreach_open == NULL)
+	    || (cl->cl_foreach_close == NULL))
+	  {
+	     SLang_verror (SL_NOT_IMPLEMENTED, "%s does not permit foreach", cl->cl_name);
+	     SLdo_pop_n (Next_Function_Num_Args + 1);
+	     goto return_error;
+	  }
+
+	if (NULL == (foreach_context = (*cl->cl_foreach_open) ((unsigned char)type, Next_Function_Num_Args)))
+	  goto return_error;
+
+	while (1)
+	  {
+	     int status;
+
+	     if (SLang_Error)
+	       {
+		  (*cl->cl_foreach_close) ((unsigned char) type, foreach_context);
+		  goto return_error;
+	       }
+
+	     status = (*cl->cl_foreach) ((unsigned char) type, foreach_context);
+	     if (status <= 0)
+	       {
+		  if (status == 0)
+		    break;
+
+		  (*cl->cl_foreach_close) ((unsigned char) type, foreach_context);
+		  goto return_error;
+	       }
+
+	     inner_interp (block);
+	     if (Lang_Break) break;
+	     Lang_Break_Condition = /* Lang_Continue = */ 0;
+	  }
+	(*cl->cl_foreach_close) ((unsigned char) type, foreach_context);
+	break;
+
+      case _SLANG_BCST_WHILE:
+	loop_name = "while";
+
+	if (num_blocks != 2)
+	  goto wrong_num_blocks_error;
+
+	type = blks[1]->bc_main_type;
+	while (1)
+	  {
+	     if (SLang_Error)
+	       goto return_error;
+
+	     inner_interp (block);
+	     if (Lang_Break) break;
+
+	     if (-1 == pop_ctrl_integer (&ctrl))
+	       goto return_error;
+
+	     if (ctrl == 0) break;
+
+	     if (type)
+	       {
+		  inner_interp (blks[1]);
+		  if (Lang_Break) break;
+		  Lang_Break_Condition = /* Lang_Continue = */ 0;
+	       }
+	  }
+	break;
+
+      case _SLANG_BCST_DOWHILE:
+	loop_name = "do...while";
+
+	if (num_blocks != 2)
+	  goto wrong_num_blocks_error;
+
+	while (1)
+	  {
+	     if (SLang_Error)
+	       goto return_error;
+
+	     Lang_Break_Condition = /* Lang_Continue = */ 0;
+	     inner_interp (block);
+	     if (Lang_Break) break;
+	     Lang_Break_Condition = /* Lang_Continue = */ 0;
+	     inner_interp (blks[1]);
+	     if (-1 == pop_ctrl_integer (&ctrl))
+	       goto return_error;
+
+	     if (ctrl == 0) break;
+	  }
+	break;
+
+      case _SLANG_BCST_CFOR:
+	loop_name = "for";
+
+	/* we need 4 blocks: first 3 control, the last is code */
+	if (num_blocks != 4) goto wrong_num_blocks_error;
+
+	inner_interp (block);
+	while (1)
+	  {
+	     if (SLang_Error)
+	       goto return_error;
+
+	     inner_interp(blks[1]);       /* test */
+	     if (-1 == pop_ctrl_integer (&ctrl))
+	       goto return_error;
+
+	     if (ctrl == 0) break;
+	     inner_interp(blks[3]);       /* code */
+	     if (Lang_Break) break;
+	     inner_interp(blks[2]);       /* bump */
+	     Lang_Break_Condition = /* Lang_Continue = */ 0;
+	  }
+	break;
+
+      case _SLANG_BCST_FOR:
+	loop_name = "_for";
+
+	if (num_blocks != 1)
+	  goto wrong_num_blocks_error;
+
+	/* 3 elements: first, last, step */
+	if ((-1 == SLang_pop_integer (&ctrl))
+	    || (-1 == SLang_pop_integer (&last))
+	    || (-1 == SLang_pop_integer (&first)))
+	  goto return_error;
+
+	i = first;
+	while (1)
+	  {
+	     /* It is ugly to have this test here but I do not know of a
+	      * simple way to do this without using two while loops.
+	      */
+	     if (ctrl >= 0)
+	       {
+		  if (i > last) break;
+	       }
+	     else if (i < last) break;
+
+	     if (SLang_Error) goto return_error;
+
+	     SLclass_push_int_obj (SLANG_INT_TYPE, i);
+	     inner_interp (block);
+	     if (Lang_Break) break;
+	     Lang_Break_Condition = /* Lang_Continue = */ 0;
+
+	     i += ctrl;
+	  }
+	break;
+
+      case _SLANG_BCST_LOOP:
+	loop_name = "loop";
+	if (num_blocks != 1)
+	  goto wrong_num_blocks_error;
+
+	if (-1 == SLang_pop_integer (&ctrl))
+	  goto return_error;
+	while (ctrl > 0)
+	  {
+	     ctrl--;
+
+	     if (SLang_Error)
+	       goto return_error;
+
+	     inner_interp (block);
+	     if (Lang_Break) break;
+	     Lang_Break_Condition = /* Lang_Continue = */ 0;
+	  }
+	break;
+
+      case _SLANG_BCST_FOREVER:
+	loop_name = "forever";
+
+	if (num_blocks != 1)
+	  goto wrong_num_blocks_error;
+
+	while (1)
+	  {
+	     if (SLang_Error)
+	       goto return_error;
+
+	     inner_interp (block);
+	     if (Lang_Break) break;
+	     Lang_Break_Condition = /* Lang_Continue = */ 0;
+	  }
+	break;
+
+      default:  SLang_verror(SL_INTERNAL_ERROR, "Unknown loop type");
+	return;
+     }
+   Lang_Break = /* Lang_Continue = */ 0;
+   Lang_Break_Condition = Lang_Return;
+   return;
+
+   wrong_num_blocks_error:
+   SLang_verror (SL_SYNTAX_ERROR, "Wrong number of blocks for '%s' construct", loop_name);
+
+   /* drop */
+   return_error:
+   do_traceback (loop_name, 0, NULL);
+}
+
+static void lang_do_and_orelse (unsigned char stype, SLBlock_Type *addr, SLBlock_Type *addr_max)
+{
+   int test = 0;
+   int is_or;
+
+   is_or = (stype == _SLANG_BCST_ORELSE);
+
+   while (addr <= addr_max)
+     {
+	if (addr->bc_main_type == _SLANG_BC_LINE_NUM)
+	  {
+	     addr++;
+	     continue;
+	  }
+
+	inner_interp (addr->b.blk);
+	if (SLang_Error
+	    || Lang_Break_Condition
+	    || (-1 == pop_ctrl_integer (&test)))
+	  return;
+
+	if (is_or == (test != 0))
+	  break;
+
+	/* if (((stype == _SLANG_BCST_ANDELSE) && (test == 0))
+	 *   || ((stype == _SLANG_BCST_ORELSE) && test))
+	 * break;
+	 */
+
+	addr++;
+     }
+   SLclass_push_int_obj (SLANG_INT_TYPE, test);
+}
+
+static void do_else_if (SLBlock_Type *zero_block, SLBlock_Type *non_zero_block)
+{
+   int test;
+
+   if (-1 == pop_ctrl_integer (&test))
+     return;
+
+   if (test == 0)
+     non_zero_block = zero_block;
+
+   if (non_zero_block != NULL)
+     inner_interp (non_zero_block->b.blk);
+}
+
+int _SLang_trace_fun (char *f)
+{
+   if (NULL == (f = SLang_create_slstring (f)))
+     return -1;
+
+   SLang_free_slstring (Trace_Function);
+   Trace_Function = f;
+   _SLang_Trace = 1;
+   return 0;
+}
+
+int _SLdump_objects (char *prefix, SLang_Object_Type *x, unsigned int n, int dir)
+{
+   char *s;
+   SLang_Class_Type *cl;
+
+   while (n)
+     {
+	cl = _SLclass_get_class (x->data_type);
+
+	if (NULL == (s = _SLstringize_object (x)))
+	  s = "??";
+
+	call_dump_routine ("%s[%s]:%s\n", prefix, cl->cl_name, s);
+
+	SLang_free_slstring (s);
+
+	x += dir;
+	n--;
+     }
+   return 0;
+}
+
+static SLBlock_Type *Exit_Block_Ptr;
+static SLBlock_Type *Global_User_Block[5];
+static SLBlock_Type **User_Block_Ptr = Global_User_Block;
+char *_SLang_Current_Function_Name = NULL;
+
+static int execute_slang_fun (_SLang_Function_Type *fun)
+{
+   register unsigned int i;
+   register SLang_Object_Type *frame, *lvf;
+   register unsigned int n_locals;
+   _SLBlock_Header_Type *header;
+   /* SLBlock_Type *val; */
+   SLBlock_Type *exit_block_save;
+   SLBlock_Type **user_block_save;
+   SLBlock_Type *user_blocks[5];
+   char *save_fname;
+
+   exit_block_save = Exit_Block_Ptr;
+   user_block_save = User_Block_Ptr;
+   User_Block_Ptr = user_blocks;
+   *(user_blocks) = NULL;
+   *(user_blocks + 1) = NULL;
+   *(user_blocks + 2) = NULL;
+   *(user_blocks + 3) = NULL;
+   *(user_blocks + 4) = NULL;
+
+   Exit_Block_Ptr = NULL;
+
+   save_fname = _SLang_Current_Function_Name;
+   _SLang_Current_Function_Name = fun->name;
+
+   _SL_increment_frame_pointer ();
+
+   /* need loaded?  */
+   if (fun->nlocals == AUTOLOAD_NUM_LOCALS)
+     {
+	header = NULL;
+	if (-1 == SLang_load_file(fun->v.autoload_filename))
+	  goto the_return;
+
+	if (fun->nlocals == AUTOLOAD_NUM_LOCALS)
+	  {
+	     SLang_verror (SL_UNDEFINED_NAME, "%s: Function did not autoload",
+			   _SLang_Current_Function_Name);
+             goto the_return;
+	  }
+     }
+
+   n_locals = fun->nlocals;
+
+   /* let the error propagate through since it will do no harm
+    and allow us to restore stack. */
+
+   /* set new stack frame */
+   lvf = frame = Local_Variable_Frame;
+   i = n_locals;
+   if ((lvf + i) > Local_Variable_Stack + SLANG_MAX_LOCAL_STACK)
+     {
+	SLang_verror(SL_STACK_OVERFLOW, "%s: Local Variable Stack Overflow",
+		     _SLang_Current_Function_Name);
+	goto the_return;
+     }
+
+   /* Make sure we do not allow this header to get destroyed by something
+    * like:  define crash () { eval ("define crash ();") }
+    */
+   header = fun->v.header;
+   header->num_refs++;
+
+   while (i--)
+     {
+	lvf++;
+	lvf->data_type = SLANG_UNDEFINED_TYPE;
+     }
+   Local_Variable_Frame = lvf;
+
+   /* read values of function arguments */
+   i = fun->nargs;
+   while (i > 0)
+     {
+	i--;
+	(void) SLang_pop (Local_Variable_Frame - i);
+     }
+
+   if (SLang_Enter_Function != NULL) (*SLang_Enter_Function)(_SLang_Current_Function_Name);
+
+   if (_SLang_Trace)
+     {
+	int stack_depth;
+
+	stack_depth = _SLstack_depth ();
+
+	if ((Trace_Function != NULL)
+	    && (0 == strcmp (Trace_Function, _SLang_Current_Function_Name))
+	    && (Trace_Mode == 0))
+	  Trace_Mode = 1;
+
+	if (Trace_Mode)
+	  {
+	     /* The local variable frame grows backwards */
+	     trace_dump (">>%s (%d args)\n",
+			 _SLang_Current_Function_Name,
+			 Local_Variable_Frame,
+			 (int) fun->nargs,
+			 -1);
+	     Trace_Mode++;
+	  }
+
+	inner_interp (header->body);
+	Lang_Break_Condition = Lang_Return = Lang_Break = 0;
+	if (Exit_Block_Ptr != NULL) inner_interp(Exit_Block_Ptr);
+
+	if (Trace_Mode)
+	  {
+	     Trace_Mode--;
+	     stack_depth = _SLstack_depth () - stack_depth;
+
+	     trace_dump ("<<%s (returning %d values)\n",
+			 _SLang_Current_Function_Name,
+			 _SLStack_Pointer - stack_depth,
+			 stack_depth,
+			 1);
+
+	     if (Trace_Mode == 1)
+	       Trace_Mode = 0;
+	  }
+     }
+   else
+     {
+	inner_interp (header->body);
+	Lang_Break_Condition = Lang_Return = Lang_Break = 0;
+	if (Exit_Block_Ptr != NULL) inner_interp(Exit_Block_Ptr);
+     }
+
+   if (SLang_Exit_Function != NULL) (*SLang_Exit_Function)(_SLang_Current_Function_Name);
+
+   if (SLang_Error)
+     do_traceback(fun->name, n_locals,
+#if _SLANG_HAS_DEBUG_CODE
+		  fun->file
+#else
+		  NULL
+#endif
+		  );
+
+   /* free local variables.... */
+   lvf = Local_Variable_Frame;
+   while (lvf > frame)
+     {
+#if _SLANG_OPTIMIZE_FOR_SPEED
+	if (SLANG_CLASS_TYPE_SCALAR != _SLclass_Class_Type [lvf->data_type])
+#endif
+	  SLang_free_object (lvf);
+	lvf--;
+     }
+   Local_Variable_Frame = lvf;
+
+   if (header->num_refs == 1)
+     free_function_header (header);
+   else
+     header->num_refs--;
+
+   the_return:
+
+   Lang_Break_Condition = Lang_Return = Lang_Break = 0;
+   Exit_Block_Ptr = exit_block_save;
+   User_Block_Ptr = user_block_save;
+   _SLang_Current_Function_Name = save_fname;
+   _SL_decrement_frame_pointer ();
+
+   if (SLang_Error)
+     return -1;
+
+   return 0;
+}
+
+static void do_traceback (char *name, unsigned int locals, char *file)
+{
+   char *s;
+   unsigned int i;
+   SLang_Object_Type *objp;
+   unsigned short stype;
+
+   /* FIXME: Priority=low
+    * I need to make this configurable!!! That is, let the
+    * application decide whether or not a usage error should result in a
+    * traceback.
+    */
+   if (SLang_Error == SL_USAGE_ERROR)
+     return;
+
+   if (SLang_Traceback == 0)
+     return;
+
+   call_dump_routine ("S-Lang Traceback: %s\n", name);
+   if (SLang_Traceback < 0)
+     return;
+
+   if (file != NULL)
+     call_dump_routine ("File: %s\n", file);
+
+   if (locals == 0)
+     return;
+
+   call_dump_routine ("  Local Variables:\n");
+
+   for (i = 0; i < locals; i++)
+     {
+	SLang_Class_Type *cl;
+	char *class_name;
+
+	objp = Local_Variable_Frame - i;
+	stype = objp->data_type;
+
+	s = _SLstringize_object (objp);
+	cl = _SLclass_get_class (stype);
+	class_name = cl->cl_name;
+
+	call_dump_routine ("\t$%d: Type: %s,\tValue:\t", i, class_name);
+
+	if (s == NULL) call_dump_routine("??\n");
+	else
+	  {
+	     char *q = "";
+#ifndef HAVE_VSNPRINTF
+	     char buf[256];
+	     if (strlen (s) >= sizeof (buf))
+	       {
+		  strncpy (buf, s, sizeof(buf));
+		  s = buf;
+		  s[sizeof(buf) - 1] = 0;
+	       }
+#endif
+	     if (SLANG_STRING_TYPE == stype) q = "\"";
+	     call_dump_routine ("%s%s%s\n", q, s, q);
+	  }
+     }
+}
+
+static void do_app_unary (SLang_App_Unary_Type *nt)
+{
+   if (-1 == do_unary (nt->unary_op, nt->name_type))
+     do_traceback (nt->name, 0, NULL);
+}
+
+static int inner_interp_nametype (SLang_Name_Type *nt)
+{
+   SLBlock_Type bc_blks[2];
+
+   bc_blks[0].b.nt_blk = nt;
+   bc_blks[0].bc_main_type = nt->name_type;
+   bc_blks[1].bc_main_type = 0;
+   return inner_interp(bc_blks);
+}
+
+int _SLang_dereference_ref (SLang_Ref_Type *ref)
+{
+   if (ref == NULL)
+     {
+	SLang_Error = SL_INTERNAL_ERROR;
+	return -1;
+     }
+
+   if (ref->is_global == 0)
+     {
+	SLang_Object_Type *obj = ref->v.local_obj;
+	if (obj > Local_Variable_Frame)
+	  {
+	     SLang_verror (SL_UNDEFINED_NAME, "Local variable deref is out of scope");
+	     return -1;
+	  }
+	return _SLpush_slang_obj (ref->v.local_obj);
+     }
+
+   (void) inner_interp_nametype (ref->v.nt);
+   return 0;
+}
+
+int _SLang_is_ref_initialized (SLang_Ref_Type *ref)
+{
+   unsigned char type;
+
+   if (ref == NULL)
+     {
+	SLang_Error = SL_INTERNAL_ERROR;
+	return -1;
+     }
+
+   if (ref->is_global == 0)
+     {
+	SLang_Object_Type *obj = ref->v.local_obj;
+	if (obj > Local_Variable_Frame)
+	  {
+	     SLang_verror (SL_UNDEFINED_NAME, "Local variable deref is out of scope");
+	     return -1;
+	  }
+	type = ref->v.local_obj->data_type;
+     }
+   else
+     {
+	SLang_Name_Type *nt = ref->v.nt;
+	if ((nt->name_type != SLANG_GVARIABLE)
+	    && (nt->name_type != SLANG_PVARIABLE))
+	  return 1;
+	type = ((SLang_Global_Var_Type *)nt)->obj.data_type;
+     }
+   return type != SLANG_UNDEFINED_TYPE;
+}
+
+int _SLang_uninitialize_ref (SLang_Ref_Type *ref)
+{
+   SLang_Object_Type *obj;
+
+   if (ref == NULL)
+     {
+	SLang_Error = SL_INTERNAL_ERROR;
+	return -1;
+     }
+
+   if (ref->is_global == 0)
+     {
+	obj = ref->v.local_obj;
+	if (obj > Local_Variable_Frame)
+	  {
+	     SLang_verror (SL_UNDEFINED_NAME, "Local variable deref is out of scope");
+	     return -1;
+	  }
+	obj = ref->v.local_obj;
+     }
+   else
+     {
+	SLang_Name_Type *nt = ref->v.nt;
+	if ((nt->name_type != SLANG_GVARIABLE)
+	    && (nt->name_type != SLANG_PVARIABLE))
+	  return -1;
+	obj = &((SLang_Global_Var_Type *)nt)->obj;
+     }
+   SLang_free_object (obj);
+   obj->data_type = SLANG_UNDEFINED_TYPE;
+   obj->v.ptr_val = NULL;
+   return 0;
+}
+
+void (*SLang_Interrupt)(void);
+static int Last_Error;
+void (*SLang_User_Clear_Error)(void);
+void _SLang_clear_error (void)
+{
+   if (Last_Error <= 0)
+     {
+	Last_Error = 0;
+	return;
+     }
+   Last_Error--;
+   if (SLang_User_Clear_Error != NULL) (*SLang_User_Clear_Error)();
+}
+
+int _SLpush_slang_obj (SLang_Object_Type *obj)
+{
+   unsigned char subtype;
+   SLang_Class_Type *cl;
+
+   if (obj == NULL) return SLang_push_null ();
+
+   subtype = obj->data_type;
+
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type[subtype])
+     return SLang_push (obj);
+#endif
+
+   cl = _SLclass_get_class (subtype);
+   return (*cl->cl_push) (subtype, (VOID_STAR) &obj->v);
+}
+
+_INLINE_
+static int push_local_variable (int i)
+{
+   SLang_Class_Type *cl;
+   SLang_Object_Type *obj;
+   unsigned char subtype;
+
+   obj = Local_Variable_Frame - i;
+   subtype = obj->data_type;
+
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type[subtype])
+     return SLang_push (obj);
+   if (subtype == SLANG_STRING_TYPE)
+     return _SLang_dup_and_push_slstring (obj->v.s_val);
+#endif
+
+   cl = _SLclass_get_class (subtype);
+   return (*cl->cl_push) (subtype, (VOID_STAR) &obj->v);
+}
+
+static int push_intrinsic_variable (SLang_Intrin_Var_Type *ivar)
+{
+   SLang_Class_Type *cl;
+   unsigned char stype;
+
+   stype = ivar->type;
+   cl = _SLclass_get_class (stype);
+
+   if (-1 == (*cl->cl_push_intrinsic) (stype, ivar->addr))
+     {
+	do_name_type_error ((SLang_Name_Type *) ivar);
+	return -1;
+     }
+   return 0;
+}
+
+static int dereference_object (void)
+{
+   SLang_Object_Type obj;
+   SLang_Class_Type *cl;
+   unsigned char type;
+   int ret;
+
+   if (-1 == SLang_pop (&obj))
+     return -1;
+
+   type = obj.data_type;
+
+   cl = _SLclass_get_class (type);
+   ret = (*cl->cl_dereference)(type, (VOID_STAR) &obj.v);
+
+   SLang_free_object (&obj);
+   return ret;
+}
+
+static int case_function (void)
+{
+   unsigned char type;
+   SLang_Object_Type obj;
+   SLang_Object_Type *swobjptr;
+
+   swobjptr = Switch_Obj_Ptr - 1;
+
+   if ((swobjptr < Switch_Objects)
+       || (0 == (type = swobjptr->data_type)))
+     {
+	SLang_verror (SL_SYNTAX_ERROR, "Misplaced 'case' keyword");
+	return -1;
+     }
+
+   if (-1 == SLang_pop (&obj))
+     return -1;
+
+   if (obj.data_type != type)
+     {
+	SLang_Class_Type *a_cl, *b_cl;
+
+	a_cl = _SLclass_get_class (obj.data_type);
+	b_cl = _SLclass_get_class (type);
+
+	if (NULL == _SLclass_get_binary_fun (SLANG_EQ, a_cl, b_cl, &a_cl, 0))
+	  {
+	     (void) SLclass_push_int_obj (SLANG_INT_TYPE, 0);
+	     SLang_free_object (&obj);
+	     return 0;
+	  }
+     }
+
+   (void) do_binary_ab (SLANG_EQ, swobjptr, &obj);
+   SLang_free_object (&obj);
+   return 0;
+}
+
+static void tmp_variable_function (SLBlock_Type *addr)
+{
+   SLang_Object_Type *obj;
+
+   switch (addr->bc_sub_type)
+     {
+      case SLANG_GVARIABLE:
+      case SLANG_PVARIABLE:
+	obj = &addr->b.nt_gvar_blk->obj;
+	break;
+
+      case SLANG_LVARIABLE:
+	obj = Local_Variable_Frame - addr->b.i_blk;
+	break;
+
+      default:
+	SLang_Error = SL_INTERNAL_ERROR;
+	return;
+     }
+
+   /* There is no need to go through higher level routines since we are
+    * not creating or destroying extra copies.
+    */
+   if (-1 == SLang_push (obj))
+     return;
+
+   obj->data_type = SLANG_UNDEFINED_TYPE;
+   obj->v.ptr_val = NULL;
+}
+
+
+static int
+do_inner_interp_error (SLBlock_Type *err_block,
+		       SLBlock_Type *addr_start,
+		       SLBlock_Type *addr)
+{
+   int save_err, slerr;
+
+   /* Someday I can use the these variable to provide extra information
+    * about what went wrong.
+    */
+   (void) addr_start;
+   (void) addr;
+
+   if (err_block == NULL)
+     goto return_error;
+
+   if (SLang_Error < 0)		       /* errors less than 0 are severe */
+     goto return_error;
+
+   save_err = Last_Error++;
+   slerr = SLang_Error;
+   SLang_Error = 0;
+   inner_interp (err_block->b.blk);
+
+   if (Last_Error <= save_err)
+     {
+	/* Caught error and cleared it */
+	Last_Error = save_err;
+	if ((Lang_Break_Condition == 0)
+	    /* An error may have cleared the error and then caused the
+	     * function to return.  We will allow that but let's not allow
+	     * 'break' nor 'continue' statements until later.
+	     */
+	    || Lang_Return)
+	  return 0;
+
+	/* drop--- either a break or continue was called */
+     }
+
+   Last_Error = save_err;
+   SLang_Error = slerr;
+
+   return_error:
+#if _SLANG_HAS_DEBUG_CODE
+   while (addr >= addr_start)
+     {
+	if (addr->bc_main_type == _SLANG_BC_LINE_NUM)
+	  {
+	     char buf[256];
+	     sprintf (buf, "(Error occurred on line %lu)", addr->b.l_blk);
+	     do_traceback (buf, 0, NULL);
+	     break;
+	  }
+	/* Special hack for 16 bit systems to prevent pointer wrapping. */
+#if defined(__16_BIT_SYSTEM__)
+	if (addr == addr_start)
+	  break;
+#endif
+	addr--;
+     }
+#endif
+   return -1;
+}
+
+
+#define GATHER_STATISTICS 0
+#if GATHER_STATISTICS
+static unsigned int Bytecodes[0xFFFF];
+
+static void print_stats (void)
+{
+   unsigned int i;
+   unsigned long total;
+   FILE *fp = fopen ("stats.txt", "w");
+   if (fp == NULL)
+     return;
+   
+   total = 0;
+   for (i = 0; i < 0xFFFF; i++)
+     total += Bytecodes[i];
+   
+   if (total == 0)
+     total = 1;
+
+   for (i = 0; i < 0xFFFF; i++)
+     {
+	if (Bytecodes[i])
+	  fprintf (fp, "0x%04X %9u %e\n", i, Bytecodes[i], Bytecodes[i]/(double) total);
+     }
+   fclose (fp);
+}
+
+static void add_to_statistics (SLBlock_Type *b)
+{
+   unsigned short x, y;
+   
+   x = b->bc_main_type;
+   if (x == 0)
+     {
+	Bytecodes[0] += 1;
+	return;
+     }
+   b++;
+   y = b->bc_main_type;
+
+   Bytecodes[(x << 8) | y] += 1;
+}
+
+#endif
+
+/* inner interpreter */
+/* The return value from this function is only meaningful when it is used
+ * to process blocks for the switch statement.  If it returns 0, the calling
+ * routine should pass the next block to it.  Otherwise it will
+ * return non-zero, with or without error.
+ */
+static int inner_interp (SLBlock_Type *addr_start)
+{
+   SLBlock_Type *block, *err_block, *addr;
+#if GATHER_STATISTICS
+   static int inited = 0;
+
+   if (inited == 0)
+     {
+	(void) SLang_add_cleanup_function (print_stats);
+	inited = 1;
+     }
+#endif
+
+   /* for systems that have no real interrupt facility (e.g. go32 on dos) */
+   if (SLang_Interrupt != NULL) (*SLang_Interrupt)();
+
+   block = err_block = NULL;
+   addr = addr_start;
+
+#if GATHER_STATISTICS
+   add_to_statistics (addr);
+#endif
+   while (1)
+     {
+	switch (addr->bc_main_type)
+	  {
+	   case 0:
+	     return 1;
+	   case _SLANG_BC_LVARIABLE:
+	     push_local_variable (addr->b.i_blk);
+	     break;
+	   case _SLANG_BC_GVARIABLE:
+	     if (-1 == _SLpush_slang_obj (&addr->b.nt_gvar_blk->obj))
+	       do_name_type_error (addr->b.nt_blk);
+	     break;
+
+	   case _SLANG_BC_IVARIABLE:
+	   case _SLANG_BC_RVARIABLE:
+	     push_intrinsic_variable (addr->b.nt_ivar_blk);
+	     break;
+
+	   case _SLANG_BC_INTRINSIC:
+	     execute_intrinsic_fun (addr->b.nt_ifun_blk);
+	     if (SLang_Error)
+	       do_traceback(addr->b.nt_ifun_blk->name, 0, NULL);
+	     break;
+
+	   case _SLANG_BC_FUNCTION:
+	     execute_slang_fun (addr->b.nt_fun_blk);
+	     if (Lang_Break_Condition) goto handle_break_condition;
+	     break;
+
+	   case _SLANG_BC_MATH_UNARY:
+	   case _SLANG_BC_APP_UNARY:
+	     /* Make sure we treat these like function calls since the
+	      * parser took sin(x) to be a function call.
+	      */
+	     if (0 == _SL_increment_frame_pointer ())
+	       {
+		  do_app_unary (addr->b.nt_unary_blk);
+		  (void) _SL_decrement_frame_pointer ();
+	       }
+	     break;
+
+	   case _SLANG_BC_ICONST:
+	     SLclass_push_int_obj (SLANG_INT_TYPE, addr->b.iconst_blk->i);
+	     break;
+
+#if SLANG_HAS_FLOAT
+	   case _SLANG_BC_DCONST:
+	     SLang_push_double (addr->b.dconst_blk->d);
+	     break;
+#endif
+
+	   case _SLANG_BC_PVARIABLE:
+	     if (-1 == _SLpush_slang_obj (&addr->b.nt_gvar_blk->obj))
+	       do_name_type_error (addr->b.nt_blk);
+	     break;
+
+	   case _SLANG_BC_PFUNCTION:
+	     execute_slang_fun (addr->b.nt_fun_blk);
+	     if (Lang_Break_Condition) goto handle_break_condition;
+	     break;
+
+	   case _SLANG_BC_BINARY:
+	     do_binary (addr->b.i_blk);
+	     break;
+	     
+	   case _SLANG_BC_LITERAL:
+#if !_SLANG_OPTIMIZE_FOR_SPEED
+	   case _SLANG_BC_LITERAL_INT:
+	   case _SLANG_BC_LITERAL_STR:
+#endif
+	       {
+		  SLang_Class_Type *cl = _SLclass_get_class (addr->bc_sub_type);
+		  (*cl->cl_push_literal) (addr->bc_sub_type, (VOID_STAR) &addr->b.ptr_blk);
+	       }
+	     break;
+#if _SLANG_OPTIMIZE_FOR_SPEED
+	   case _SLANG_BC_LITERAL_INT:
+	     SLclass_push_int_obj (addr->bc_sub_type, (int) addr->b.l_blk);
+	     break;
+
+	   case _SLANG_BC_LITERAL_STR:
+	     _SLang_dup_and_push_slstring (addr->b.s_blk);
+	     break;
+#endif
+	   case _SLANG_BC_BLOCK:
+	     switch (addr->bc_sub_type)
+	       {
+		case _SLANG_BCST_ERROR_BLOCK:
+		  err_block = addr;
+		  break;
+
+		case _SLANG_BCST_EXIT_BLOCK:
+		  Exit_Block_Ptr = addr->b.blk;
+		  break;
+
+		case _SLANG_BCST_USER_BLOCK0:
+		case _SLANG_BCST_USER_BLOCK1:
+		case _SLANG_BCST_USER_BLOCK2:
+		case _SLANG_BCST_USER_BLOCK3:
+		case _SLANG_BCST_USER_BLOCK4:
+		  User_Block_Ptr[addr->bc_sub_type - _SLANG_BCST_USER_BLOCK0] = addr->b.blk;
+		  break;
+
+		case _SLANG_BCST_LOOP:
+		case _SLANG_BCST_WHILE:
+		case _SLANG_BCST_FOR:
+		case _SLANG_BCST_FOREVER:
+		case _SLANG_BCST_CFOR:
+		case _SLANG_BCST_DOWHILE:
+		case _SLANG_BCST_FOREACH:
+		  if (block == NULL) block = addr;
+		  lang_do_loops(addr->bc_sub_type, block, 1 + (unsigned int) (addr - block));
+		  block = NULL;
+		  break;
+
+		case _SLANG_BCST_IFNOT:
+#if _SLANG_OPTIMIZE_FOR_SPEED
+		    {
+		       int i;
+		       
+		       if ((0 == pop_ctrl_integer (&i)) && (i == 0))
+			 inner_interp (addr->b.blk);
+		    }
+#else
+		  do_else_if (addr, NULL);
+#endif
+		  break;
+
+		case _SLANG_BCST_IF:
+#if _SLANG_OPTIMIZE_FOR_SPEED
+		    {
+		       int i;
+		       
+		       if ((0 == pop_ctrl_integer (&i)) && i)
+			 inner_interp (addr->b.blk);
+		    }
+#else
+		  do_else_if (NULL, addr);
+#endif
+		  break;
+
+		case _SLANG_BCST_NOTELSE:
+		  do_else_if (block, addr);
+		  block = NULL;
+		  break;
+
+		case _SLANG_BCST_ELSE:
+		  do_else_if (addr, block);
+		  block = NULL;
+		  break;
+
+		case _SLANG_BCST_SWITCH:
+		  if (Switch_Obj_Ptr == Switch_Obj_Max)
+		    {
+		       SLang_doerror("switch nesting too deep");
+		       break;
+		    }
+		  (void) SLang_pop (Switch_Obj_Ptr);
+		  Switch_Obj_Ptr++;
+
+		  if (block == NULL) block = addr;
+		  while ((SLang_Error == 0)
+			 && (block <= addr)
+			 && (Lang_Break_Condition == 0)
+			 && (0 == inner_interp (block->b.blk)))
+		    block++;
+		  Switch_Obj_Ptr--;
+		  SLang_free_object (Switch_Obj_Ptr);
+		  Switch_Obj_Ptr->data_type = 0;
+		  block = NULL;
+		  break;
+
+		case _SLANG_BCST_ANDELSE:
+		case _SLANG_BCST_ORELSE:
+		  if (block == NULL) block = addr;
+		  lang_do_and_orelse (addr->bc_sub_type, block, addr);
+		  block = NULL;
+		  break;
+
+		default:
+		  if (block == NULL) block =  addr;
+		  break;
+	       }
+	     if (Lang_Break_Condition) goto handle_break_condition;
+	     break;
+
+	   case _SLANG_BC_RETURN:
+	     Lang_Break_Condition = Lang_Return = Lang_Break = 1; return 1;
+	   case _SLANG_BC_BREAK:
+	     Lang_Break_Condition = Lang_Break = 1; return 1;
+	   case _SLANG_BC_CONTINUE:
+	     Lang_Break_Condition = /* Lang_Continue = */ 1; return 1;
+
+	   case _SLANG_BC_EXCH:
+	     (void) SLreverse_stack (2);
+	     break;
+
+	   case _SLANG_BC_LABEL:
+	       {
+		  int test;
+		  if ((0 == SLang_pop_integer (&test))
+		      && (test == 0))
+		    return 0;
+	       }
+	     break;
+
+	   case _SLANG_BC_LOBJPTR:
+	     (void)_SLang_push_ref (0, (VOID_STAR)(Local_Variable_Frame - addr->b.i_blk));
+	     break;
+
+	   case _SLANG_BC_GOBJPTR:
+	     (void)_SLang_push_ref (1, (VOID_STAR)addr->b.nt_blk);
+	     break;
+
+	   case _SLANG_BC_X_ERROR:
+	     if (err_block != NULL)
+	       {
+		  inner_interp(err_block->b.blk);
+		  if (SLang_Error) err_block = NULL;
+	       }
+	     else SLang_verror(SL_SYNTAX_ERROR, "No ERROR_BLOCK");
+	     if (Lang_Break_Condition) goto handle_break_condition;
+	     break;
+
+	   case _SLANG_BC_X_USER0:
+	   case _SLANG_BC_X_USER1:
+	   case _SLANG_BC_X_USER2:
+	   case _SLANG_BC_X_USER3:
+	   case _SLANG_BC_X_USER4:
+	     if (User_Block_Ptr[addr->bc_main_type - _SLANG_BC_X_USER0] != NULL)
+	       {
+		  inner_interp(User_Block_Ptr[addr->bc_main_type - _SLANG_BC_X_USER0]);
+	       }
+	     else SLang_verror(SL_SYNTAX_ERROR, "No block for X_USERBLOCK");
+	     if (Lang_Break_Condition) goto handle_break_condition;
+	     break;
+
+	   case _SLANG_BC_CALL_DIRECT:
+	     (*addr->b.call_function) ();
+	     break;
+
+	   case _SLANG_BC_CALL_DIRECT_FRAME:
+	     do_bc_call_direct_frame (addr->b.call_function);
+	     break;
+
+	   case _SLANG_BC_UNARY:
+	     do_unary (addr->b.i_blk, _SLANG_BC_UNARY);
+	     break;
+	     
+	   case _SLANG_BC_UNARY_FUNC:
+	     /* Make sure we treat these like function calls since the
+	      * parser took abs(x) to be a function call.
+	      */
+	     if (0 == _SL_increment_frame_pointer ())
+	       {
+		  do_unary (addr->b.i_blk, _SLANG_BC_UNARY);
+		  (void) _SL_decrement_frame_pointer ();
+	       }
+	     break;
+	     
+	   case _SLANG_BC_DEREF_ASSIGN:
+	     set_deref_lvalue (addr);
+	     break;
+	   case _SLANG_BC_SET_LOCAL_LVALUE:
+	     set_lvalue_obj (addr->bc_sub_type, Local_Variable_Frame - addr->b.i_blk);
+	     break;
+	   case _SLANG_BC_SET_GLOBAL_LVALUE:
+	     if (-1 == set_lvalue_obj (addr->bc_sub_type, &addr->b.nt_gvar_blk->obj))
+	       do_name_type_error (addr->b.nt_blk);
+	     break;
+	   case _SLANG_BC_SET_INTRIN_LVALUE:
+	     set_intrin_lvalue (addr);
+	     break;
+	   case _SLANG_BC_SET_STRUCT_LVALUE:
+	     set_struct_lvalue (addr);
+	     break;
+
+	   case _SLANG_BC_FIELD:
+	     (void) push_struct_field (addr->b.s_blk);
+	     break;
+
+	   case _SLANG_BC_SET_ARRAY_LVALUE:
+	     set_array_lvalue (addr->bc_sub_type);
+	     break;
+
+#if _SLANG_HAS_DEBUG_CODE
+	   case _SLANG_BC_LINE_NUM:
+	     break;
+#endif
+	     
+	   case _SLANG_BC_TMP:
+	     tmp_variable_function (addr);
+	     break;
+
+#if _SLANG_OPTIMIZE_FOR_SPEED
+	   case _SLANG_BC_LVARIABLE_AGET:
+	     if (0 == push_local_variable (addr->b.i_blk))
+	       do_bc_call_direct_frame (_SLarray_aget);
+	     break;
+
+	   case _SLANG_BC_LVARIABLE_APUT:
+	     if (0 == push_local_variable (addr->b.i_blk))
+	       do_bc_call_direct_frame (_SLarray_aput);
+	     break;
+	   case _SLANG_BC_INTEGER_PLUS:
+	     if (0 == SLclass_push_int_obj (addr->bc_sub_type, (int) addr->b.l_blk))
+	       do_binary (SLANG_PLUS);
+	     break;
+
+	   case _SLANG_BC_INTEGER_MINUS:
+	     if (0 == SLclass_push_int_obj (addr->bc_sub_type, (int) addr->b.l_blk))
+	       do_binary (SLANG_MINUS);
+	     break;
+#endif
+#if 0
+	   case _SLANG_BC_ARG_LVARIABLE:
+	     (void) SLang_start_arg_list ();
+	     push_local_variable (addr->b.i_blk);
+	     break;
+#endif
+	   case _SLANG_BC_EARG_LVARIABLE:
+	     push_local_variable (addr->b.i_blk);
+	     (void) SLang_end_arg_list ();
+	     break;
+
+#if USE_COMBINED_BYTECODES
+	   case _SLANG_BC_CALL_DIRECT_INTRINSIC:
+	     (*addr->b.call_function) ();
+	     addr++;
+	     execute_intrinsic_fun (addr->b.nt_ifun_blk);
+	     if (SLang_Error)
+	       do_traceback(addr->b.nt_ifun_blk->name, 0, NULL);
+	     break;
+
+	   case _SLANG_BC_INTRINSIC_CALL_DIRECT:
+	     execute_intrinsic_fun (addr->b.nt_ifun_blk);
+	     if (SLang_Error)
+	       {
+		  do_traceback(addr->b.nt_ifun_blk->name, 0, NULL);
+		  break;
+	       }
+	     addr++;
+	     (*addr->b.call_function) ();
+	     break;
+
+	   case _SLANG_BC_CALL_DIRECT_LSTR:
+	     (*addr->b.call_function) ();
+	     addr++;
+	     _SLang_dup_and_push_slstring (addr->b.s_blk);
+	     break;
+
+	   case _SLANG_BC_CALL_DIRECT_SLFUN:
+	     (*addr->b.call_function) ();
+	     addr++;
+	     execute_slang_fun (addr->b.nt_fun_blk);
+	     if (Lang_Break_Condition) goto handle_break_condition;
+	     break;
+
+	   case _SLANG_BC_CALL_DIRECT_INTRSTOP:
+	     (*addr->b.call_function) ();
+	     addr++;
+	     /* drop */
+	   case _SLANG_BC_INTRINSIC_STOP:
+	     execute_intrinsic_fun (addr->b.nt_ifun_blk);
+	     if (SLang_Error == 0)
+	       return 1;
+	     do_traceback(addr->b.nt_ifun_blk->name, 0, NULL);
+	     break;
+
+	   case _SLANG_BC_CALL_DIRECT_EARG_LVAR:
+	     (*addr->b.call_function) ();
+	     addr++;
+	     push_local_variable (addr->b.i_blk);
+	     (void) SLang_end_arg_list ();
+	     break;
+
+	   case _SLANG_BC_CALL_DIRECT_LINT:
+	     (*addr->b.call_function) ();
+	     addr++;
+	     SLclass_push_int_obj (addr->bc_sub_type, (int) addr->b.l_blk);
+	     break;
+
+	   case _SLANG_BC_CALL_DIRECT_LVAR:
+	     (*addr->b.call_function) ();
+	     addr++;
+	     push_local_variable (addr->b.i_blk);
+	     break;
+#endif				       /* USE_COMBINED_BYTECODES */
+
+	   default:
+	     SLang_verror (SL_INTERNAL_ERROR, "Byte-Code 0x%X is not valid", addr->bc_main_type);
+	  }
+
+	/* Someday I plan to add a 'signal' intrinsic function.  Then when a
+	 * signal is caught, a variable will be set to one and that value of
+	 * that variable will need to be monitored here, e.g.,
+	 * if (Handle_Signal) handle_signal ();
+	 * It would be nice to check only one variable instead of Handle_Signal
+	 * and SLang_Error.  Perhaps I should phase out SLang_Error = xxx
+	 * and used something like: SLang_set_error (code);  Then, I could
+	 * use:
+	 * if (Handle_Condition)
+	 *   {
+	 *      Handle_Condition = 0;
+	 *      if (SLang_Error) ....
+	 *      else if (Handle_Signal) handle_signal ();
+	 *      else....
+	 *   }
+	 */
+	if (SLang_Error)
+	  {
+	     if (-1 == do_inner_interp_error (err_block, addr_start, addr))
+	       return 1;
+	     if (SLang_Error)
+	       return 1;
+
+	     /* Otherwise, error cleared.  Continue onto next bytecode.
+	      * Someday I need to add something to indicate where the
+	      * next statement begins since continuing on the next
+	      * bytecode is not really what is desired.
+	      */
+	     if (Lang_Break_Condition) goto handle_break_condition;
+	  }
+	addr++;
+     }
+
+   handle_break_condition:
+   /* Get here if Lang_Break_Condition != 0, which implies that either
+    * Lang_Return, Lang_Break, or Lang_Continue is non zero
+    */
+   if (Lang_Return)
+     Lang_Break = 1;
+
+   return 1;
+}
+
+/*}}}*/
+
+/* The functions below this point are used to implement the parsed token
+ * to byte-compiled code.
+ */
+/* static SLang_Name_Type **Static_Hash_Table; */
+
+static SLang_Name_Type **Locals_Hash_Table;
+static int Local_Variable_Number;
+static unsigned int Function_Args_Number;
+int _SLang_Auto_Declare_Globals = 0;
+int (*SLang_Auto_Declare_Var_Hook) (char *);
+
+static SLang_NameSpace_Type *This_Static_NameSpace;
+static SLang_NameSpace_Type *Global_NameSpace;
+
+#if _SLANG_HAS_DEBUG_CODE
+static char *This_Compile_Filename;
+#endif
+static SLBlock_Type SLShort_Blocks[6];
+/* These are initialized in add_table below.  I cannot init a Union!! */
+
+static int Lang_Defining_Function;
+static void (*Default_Variable_Mode) (_SLang_Token_Type *);
+static void (*Default_Define_Function) (char *, unsigned long);
+
+static int push_compile_context (char *);
+static int pop_compile_context (void);
+
+typedef struct
+{
+   int block_type;
+   SLBlock_Type *block;		       /* beginning of block definition */
+   SLBlock_Type *block_ptr;	       /* current location */
+   SLBlock_Type *block_max;	       /* end of definition */
+   SLang_NameSpace_Type *static_namespace;
+}
+Block_Context_Type;
+
+static Block_Context_Type Block_Context_Stack [SLANG_MAX_BLOCK_STACK_LEN];
+static unsigned int Block_Context_Stack_Len;
+
+static SLBlock_Type *Compile_ByteCode_Ptr;
+static SLBlock_Type *This_Compile_Block;
+static SLBlock_Type *This_Compile_Block_Max;
+static int This_Compile_Block_Type;
+#define COMPILE_BLOCK_TYPE_FUNCTION	1
+#define COMPILE_BLOCK_TYPE_BLOCK	2
+#define COMPILE_BLOCK_TYPE_TOP_LEVEL	3
+
+/* If it returns 0, DO NOT FREE p */
+static int lang_free_branch (SLBlock_Type *p)
+{
+   /* Note: we look at 0,2,4, since these blocks are 0 terminated */
+   if ((p == SLShort_Blocks)
+       || (p == SLShort_Blocks + 2)
+       || (p == SLShort_Blocks + 4)
+       )
+     return 0;
+
+   while (1)
+     {
+	SLang_Class_Type *cl;
+
+        switch (p->bc_main_type)
+	  {
+	   case _SLANG_BC_BLOCK:
+	     if (lang_free_branch(p->b.blk))
+	       SLfree((char *)p->b.blk);
+	     break;
+
+	   case _SLANG_BC_LITERAL:
+	   case _SLANG_BC_LITERAL_STR:
+	     /* No user types should be here. */
+	     cl = _SLclass_get_class (p->bc_sub_type);
+	     (*cl->cl_byte_code_destroy) (p->bc_sub_type, (VOID_STAR) &p->b.ptr_blk);
+	     break;
+
+	   case _SLANG_BC_FIELD:
+	   case _SLANG_BC_SET_STRUCT_LVALUE:
+	     SLang_free_slstring (p->b.s_blk);
+	     break;
+
+	   default:
+	     break;
+
+	   case 0:
+	     return 1;
+	  }
+	p++;
+     }
+}
+
+static void free_function_header (_SLBlock_Header_Type *h)
+{
+   if (h->num_refs > 1)
+     {
+	h->num_refs--;
+	return;
+     }
+
+   if (h->body != NULL)
+     {
+	if (lang_free_branch (h->body))
+	  SLfree ((char *) h->body);
+     }
+
+   SLfree ((char *) h);
+}
+
+static int push_block_context (int type)
+{
+   Block_Context_Type *c;
+   unsigned int num;
+   SLBlock_Type *b;
+
+   if (Block_Context_Stack_Len == SLANG_MAX_BLOCK_STACK_LEN)
+     {
+	SLang_verror (SL_STACK_OVERFLOW, "Block stack overflow");
+	return -1;
+     }
+
+   num = 5;    /* 40 bytes */
+   if (NULL == (b = (SLBlock_Type *) SLcalloc (num, sizeof (SLBlock_Type))))
+     return -1;
+
+   c = Block_Context_Stack + Block_Context_Stack_Len;
+   c->block = This_Compile_Block;
+   c->block_ptr = Compile_ByteCode_Ptr;
+   c->block_max = This_Compile_Block_Max;
+   c->block_type = This_Compile_Block_Type;
+   c->static_namespace = This_Static_NameSpace;
+
+   Compile_ByteCode_Ptr = This_Compile_Block = b;
+   This_Compile_Block_Max = b + num;
+   This_Compile_Block_Type = type;
+
+   Block_Context_Stack_Len += 1;
+   return 0;
+}
+
+static int pop_block_context (void)
+{
+   Block_Context_Type *c;
+
+   if (Block_Context_Stack_Len == 0)
+     return -1;
+
+   Block_Context_Stack_Len -= 1;
+   c = Block_Context_Stack + Block_Context_Stack_Len;
+
+   This_Compile_Block = c->block;
+   This_Compile_Block_Max = c->block_max;
+   This_Compile_Block_Type = c->block_type;
+   Compile_ByteCode_Ptr = c->block_ptr;
+   This_Static_NameSpace = c->static_namespace;
+
+   return 0;
+}
+
+int _SLcompile_push_context (SLang_Load_Type *load_object)
+{
+   if (-1 == push_compile_context (load_object->name))
+     return -1;
+
+   if (NULL == (This_Static_NameSpace = _SLns_allocate_namespace (load_object->name, SLSTATIC_HASH_TABLE_SIZE)))
+     {
+	pop_compile_context ();
+	return -1;
+     }
+
+   if (-1 == push_block_context (COMPILE_BLOCK_TYPE_TOP_LEVEL))
+     {
+	pop_compile_context ();
+	return -1;
+     }
+
+   return 0;
+}
+
+int _SLcompile_pop_context (void)
+{
+   if (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_TOP_LEVEL)
+     {
+	Compile_ByteCode_Ptr->bc_main_type = 0;
+	if (lang_free_branch (This_Compile_Block))
+	  SLfree ((char *) This_Compile_Block);
+     }
+
+   (void) pop_block_context ();
+   (void) pop_compile_context ();
+
+   if (This_Compile_Block == NULL)
+     return 0;
+
+#if 0
+   if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL)
+     {
+	SLang_verror (SL_INTERNAL_ERROR, "Not at top-level");
+	return -1;
+     }
+#endif
+
+   return 0;
+}
+
+/*{{{ Hash and Name Table Functions */
+
+static SLang_Name_Type *locate_name_in_table (char *name, unsigned long hash,
+					      SLang_Name_Type **table, unsigned int table_size)
+{
+   SLang_Name_Type *t;
+   char ch;
+
+   t = table [(unsigned int) (hash % table_size)];
+   ch = *name++;
+
+   while (t != NULL)
+     {
+	if ((ch == t->name[0])
+	    && (0 == strcmp (t->name + 1, name)))
+	  break;
+
+	t = t->next;
+     }
+
+   return t;
+}
+
+static SLang_Name_Type *locate_namespace_encoded_name (char *name, int err_on_bad_ns)
+{
+   char *ns, *ns1;
+   SLang_NameSpace_Type *table;
+   SLang_Name_Type *nt;
+
+   ns = name;
+   name = strchr (name, '-');
+   if ((name == NULL) || (name [1] != '>'))
+     name = ns;
+
+   ns1 = SLang_create_nslstring (ns, (unsigned int) (name - ns));
+   if (ns1 == NULL)
+     return NULL;
+   if (ns != name)
+     name += 2;
+   ns = ns1;
+
+   if (*ns == 0)
+     {
+	/* Use Global Namespace */
+	SLang_free_slstring (ns);
+	return locate_name_in_table (name, _SLcompute_string_hash (name),
+				     Global_NameSpace->table, Global_NameSpace->table_size);
+     }
+
+   if (NULL == (table = _SLns_find_namespace (ns)))
+     {
+	if (err_on_bad_ns)
+	  SLang_verror (SL_SYNTAX_ERROR, "Unable to find namespace called %s", ns);
+	SLang_free_slstring (ns);
+	return NULL;
+     }
+   SLang_free_slstring (ns);
+
+   /* FIXME: the hash table size should be stored in the hash table itself */
+   nt = locate_name_in_table (name, _SLcompute_string_hash (name),
+			      table->table, table->table_size);
+   if (nt == NULL)
+     return NULL;
+
+   switch (nt->name_type)
+     {
+	/* These are private and cannot be accessed through the namespace. */
+      case SLANG_PVARIABLE:
+      case SLANG_PFUNCTION:
+	return NULL;
+     }
+   return nt;
+}
+
+static SLang_Name_Type *locate_hashed_name (char *name, unsigned long hash)
+{
+   SLang_Name_Type *t;
+
+   if (Lang_Defining_Function)
+     {
+	t = locate_name_in_table (name, hash, Locals_Hash_Table, SLLOCALS_HASH_TABLE_SIZE);
+	if (t != NULL)
+	  return t;
+     }
+
+   if ((This_Static_NameSpace != NULL)
+       && (NULL != (t = locate_name_in_table (name, hash, This_Static_NameSpace->table, This_Static_NameSpace->table_size))))
+     return t;
+
+   t = locate_name_in_table (name, hash, Global_NameSpace->table, Global_NameSpace->table_size);
+   if (NULL != t)
+     return t;
+
+   return locate_namespace_encoded_name (name, 1);
+}
+
+SLang_Name_Type *_SLlocate_name (char *name)
+{
+   return locate_hashed_name (name, _SLcompute_string_hash (name));
+}
+
+static SLang_Name_Type *
+add_name_to_hash_table (char *name, unsigned long hash,
+			unsigned int sizeof_obj, unsigned char name_type,
+			SLang_Name_Type **table, unsigned int table_size,
+			int check_existing)
+{
+   SLang_Name_Type *t;
+
+   if (check_existing)
+     {
+	t = locate_name_in_table (name, hash, table, table_size);
+	if (t != NULL)
+	  return t;
+     }
+
+   if (-1 == _SLcheck_identifier_syntax (name))
+     return NULL;
+
+   t = (SLang_Name_Type *) SLmalloc (sizeof_obj);
+   if (t == NULL)
+     return t;
+
+   memset ((char *) t, 0, sizeof_obj);
+   if (NULL == (t->name = _SLstring_dup_hashed_string (name, hash)))
+     {
+	SLfree ((char *) t);
+	return NULL;
+     }
+   t->name_type = name_type;
+
+   hash = hash % table_size;
+   t->next = table [(unsigned int)hash];
+   table [(unsigned int) hash] = t;
+
+   return t;
+}
+
+static SLang_Name_Type *
+add_global_name (char *name, unsigned long hash,
+		 unsigned char name_type, unsigned int sizeof_obj,
+		 SLang_NameSpace_Type *ns)
+{
+   SLang_Name_Type *nt;
+   SLang_Name_Type **table;
+   unsigned int table_size;
+   
+   table = ns->table;
+   table_size = ns->table_size;
+
+   nt = locate_name_in_table (name, hash, table, table_size);
+   if (nt != NULL)
+     {
+	if (nt->name_type == name_type)
+	  return nt;
+
+	SLang_verror (SL_DUPLICATE_DEFINITION, "%s cannot be re-defined", name);
+	return NULL;
+     }
+
+   return add_name_to_hash_table (name, hash, sizeof_obj, name_type,
+				  table, table_size, 0);
+}
+
+static int add_intrinsic_function (SLang_NameSpace_Type *ns,
+				   char *name, FVOID_STAR addr, unsigned char ret_type,
+				   unsigned int nargs, va_list ap)
+{
+   SLang_Intrin_Fun_Type *f;
+   unsigned int i;
+
+   if (-1 == init_interpreter ())
+     return -1;
+   
+   if (ns == NULL) ns = Global_NameSpace;
+
+   if (nargs > SLANG_MAX_INTRIN_ARGS)
+     {
+	SLang_verror (SL_APPLICATION_ERROR, "Function %s requires too many arguments", name);
+	return -1;
+     }
+
+   if (ret_type == SLANG_FLOAT_TYPE)
+     {
+	SLang_verror (SL_NOT_IMPLEMENTED, "Function %s is not permitted to return float", name);
+	return -1;
+     }
+
+   f = (SLang_Intrin_Fun_Type *) add_global_name (name, _SLcompute_string_hash (name),
+						  SLANG_INTRINSIC, sizeof (SLang_Intrin_Fun_Type),
+						  ns);
+
+   if (f == NULL)
+     return -1;
+
+   f->i_fun = addr;
+   f->num_args = nargs;
+   f->return_type = ret_type;
+
+   for (i = 0; i < nargs; i++)
+     f->arg_types [i] = va_arg (ap, unsigned int);
+
+   return 0;
+}
+
+int SLadd_intrinsic_function (char *name, FVOID_STAR addr, unsigned char ret_type,
+			      unsigned int nargs, ...)
+{
+   va_list ap;
+   int status;
+
+   va_start (ap, nargs);
+   status = add_intrinsic_function (NULL, name, addr, ret_type, nargs, ap);
+   va_end (ap);
+
+   return status;
+}
+
+int SLns_add_intrinsic_function (SLang_NameSpace_Type *ns, 
+				 char *name, FVOID_STAR addr, unsigned char ret_type,
+				 unsigned int nargs, ...)
+{
+   va_list ap;
+   int status;
+
+   va_start (ap, nargs);
+   status = add_intrinsic_function (ns, name, addr, ret_type, nargs, ap);
+   va_end (ap);
+
+   return status;
+}
+
+int SLns_add_intrinsic_variable (SLang_NameSpace_Type *ns,
+				   char *name, VOID_STAR addr, unsigned char data_type, int ro)
+{
+   SLang_Intrin_Var_Type *v;
+
+   if (-1 == init_interpreter ())
+     return -1;
+   
+   if (ns == NULL) ns = Global_NameSpace;
+
+   v = (SLang_Intrin_Var_Type *)add_global_name (name,
+						 _SLcompute_string_hash (name),
+						 (ro ? SLANG_RVARIABLE : SLANG_IVARIABLE),
+						 sizeof (SLang_Intrin_Var_Type),
+						 ns);
+   if (v == NULL)
+     return -1;
+
+   v->addr = addr;
+   v->type = data_type;
+   return 0;
+}
+  
+int SLadd_intrinsic_variable (char *name, VOID_STAR addr, unsigned char data_type, int ro)
+{
+   return SLns_add_intrinsic_variable (NULL, name, addr, data_type, ro);
+}
+
+static int
+add_slang_function (char *name, unsigned char type, unsigned long hash,
+		    unsigned int num_args, unsigned int num_locals,
+#if _SLANG_HAS_DEBUG_CODE
+		    char *file,
+#endif
+		    _SLBlock_Header_Type *h, 
+		    SLang_NameSpace_Type *ns)
+{
+   _SLang_Function_Type *f;
+   
+#if _SLANG_HAS_DEBUG_CODE
+   if ((file != NULL)
+       && (NULL == (file = SLang_create_slstring (file))))
+     return -1;
+#endif
+
+   f = (_SLang_Function_Type *)add_global_name (name, hash,
+						type,
+						sizeof (_SLang_Function_Type),
+						ns);
+   if (f == NULL)
+     {
+#if _SLANG_HAS_DEBUG_CODE
+	SLang_free_slstring (file);    /* NULL ok */
+#endif
+	return -1;
+     }
+
+   if (f->v.header != NULL)
+     {
+	if (f->nlocals == AUTOLOAD_NUM_LOCALS)
+	  SLang_free_slstring ((char *)f->v.autoload_filename); /* autoloaded filename */
+	else
+	  free_function_header (f->v.header);
+     }
+
+#if _SLANG_HAS_DEBUG_CODE
+   if (f->file != NULL) SLang_free_slstring (f->file);
+   f->file = file;
+#endif
+   f->v.header = h;
+   f->nlocals = num_locals;
+   f->nargs = num_args;
+
+   return 0;
+}
+
+int SLang_autoload (char *name, char *file)
+{
+   _SLang_Function_Type *f;
+   unsigned long hash;
+
+   hash = _SLcompute_string_hash (name);
+   f = (_SLang_Function_Type *)locate_name_in_table (name, hash, Global_NameSpace->table, Global_NameSpace->table_size);
+
+   if ((f != NULL)
+       && (f->name_type == SLANG_FUNCTION)
+       && (f->v.header != NULL)
+       && (f->nlocals != AUTOLOAD_NUM_LOCALS))
+     {
+	/* already loaded */
+	return 0;
+     }
+
+   file = SLang_create_slstring (file);
+   if (-1 == add_slang_function (name, SLANG_FUNCTION, hash, 0, AUTOLOAD_NUM_LOCALS,
+#if _SLANG_HAS_DEBUG_CODE
+				 file,
+#endif
+				 (_SLBlock_Header_Type *) file,
+				 Global_NameSpace))
+     {
+	SLang_free_slstring (file);
+	return -1;
+     }
+
+   return 0;
+}
+
+SLang_Name_Type *_SLlocate_global_name (char *name)
+{
+   unsigned long hash;
+
+   hash = _SLcompute_string_hash (name);
+   return locate_name_in_table (name, hash, Global_NameSpace->table, 
+				Global_NameSpace->table_size);
+}
+
+/*}}}*/
+
+static void free_local_variable_table (void)
+{
+   unsigned int i;
+   SLang_Name_Type *t, *t1;
+
+   for (i = 0; i < SLLOCALS_HASH_TABLE_SIZE; i++)
+     {
+	t = Locals_Hash_Table [i];
+	while (t != NULL)
+	  {
+	     SLang_free_slstring (t->name);
+	     t1 = t->next;
+	     SLfree ((char *) t);
+	     t = t1;
+	  }
+	Locals_Hash_Table [i] = NULL;
+     }
+   Local_Variable_Number = 0;
+}
+
+/* call inner interpreter or return for more */
+static void lang_try_now(void)
+{
+   Compile_ByteCode_Ptr++;
+   if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL)
+     return;
+
+   Compile_ByteCode_Ptr->bc_main_type = 0;  /* so next command stops after this */
+
+   /* now do it */
+   inner_interp (This_Compile_Block);
+   (void) lang_free_branch (This_Compile_Block);
+   Compile_ByteCode_Ptr = This_Compile_Block;
+}
+
+SLang_Name_Type *SLang_get_fun_from_ref (SLang_Ref_Type *ref)
+{
+   if (ref->is_global)
+     {
+	SLang_Name_Type *nt = ref->v.nt;
+
+	switch (nt->name_type)
+	  {
+	   case SLANG_PFUNCTION:
+	   case SLANG_FUNCTION:
+	   case SLANG_INTRINSIC:
+	   case SLANG_MATH_UNARY:
+	   case SLANG_APP_UNARY:
+	     return nt;
+	  }
+	SLang_verror (SL_TYPE_MISMATCH,
+		      "Reference to a function expected.  Found &%s", 
+		      nt->name);
+     }
+
+   SLang_verror (SL_TYPE_MISMATCH,
+		 "Reference to a function expected");
+   return NULL;
+}
+
+int SLexecute_function (SLang_Name_Type *nt)
+{
+   unsigned char type;
+   char *name;
+
+   if (SLang_Error)
+     return -1;
+
+   type = nt->name_type;
+   name = nt->name;
+
+   switch (type)
+     {
+      case SLANG_PFUNCTION:
+      case SLANG_FUNCTION:
+	execute_slang_fun ((_SLang_Function_Type *) nt);
+	break;
+
+      case SLANG_INTRINSIC:
+	execute_intrinsic_fun ((SLang_Intrin_Fun_Type *) nt);
+	break;
+
+      case SLANG_MATH_UNARY:
+      case SLANG_APP_UNARY:
+	inner_interp_nametype (nt);
+	break;
+
+      default:
+	SLang_verror (SL_TYPE_MISMATCH, "%s is not a function", name);
+	return -1;
+     }
+
+   if (SLang_Error)
+     {
+	SLang_verror (SLang_Error, "Error while executing %s", name);
+	return -1;
+     }
+
+   return 1;
+}
+
+int SLang_execute_function (char *name)
+{
+   SLang_Name_Type *entry;
+
+   if (NULL == (entry = SLang_get_function (name)))
+     return 0;
+
+   return SLexecute_function (entry);
+}
+
+/* return S-Lang function or NULL */
+SLang_Name_Type *SLang_get_function (char *name)
+{
+   SLang_Name_Type *entry;
+
+   if (NULL == (entry = locate_namespace_encoded_name (name, 0)))
+     return NULL;
+
+   if ((entry->name_type == SLANG_FUNCTION)
+       || (entry->name_type == SLANG_INTRINSIC))
+     return entry;
+
+   return NULL;
+}
+
+static void lang_begin_function (void)
+{
+   if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL)
+     {
+	SLang_verror (SL_SYNTAX_ERROR, "Function nesting is illegal");
+	return;
+     }
+   Lang_Defining_Function = 1;
+   (void) push_block_context (COMPILE_BLOCK_TYPE_FUNCTION);
+}
+
+#if USE_COMBINED_BYTECODES
+static void optimize_block (SLBlock_Type *b)
+{
+   while (1)
+     {
+	switch (b->bc_main_type)
+	  {
+	   case 0:
+	     return;
+	     
+	   default:
+	     b++;
+	     break;
+
+	   case _SLANG_BC_CALL_DIRECT:
+	     b++;
+	     switch (b->bc_main_type)
+	       {
+		case 0:
+		  return;
+		case _SLANG_BC_INTRINSIC:
+		  if ((b+1)->bc_main_type == 0)
+		    {
+		       (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_INTRSTOP;
+		       return;
+		    }
+		  (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_INTRINSIC;
+		  b++;
+		  break;
+		case _SLANG_BC_LITERAL_STR:
+		  (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_LSTR;
+		  b++;
+		  break;
+		case _SLANG_BC_FUNCTION:
+		case _SLANG_BC_PFUNCTION:
+		  (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_SLFUN;
+		  b++;
+		  break;
+		case _SLANG_BC_EARG_LVARIABLE:
+		  (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_EARG_LVAR;
+		  b++;
+		  break;
+		case _SLANG_BC_LITERAL_INT:
+		  (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_LINT;
+		  b++;
+		  break;
+		case _SLANG_BC_LVARIABLE:
+		  (b-1)->bc_main_type = _SLANG_BC_CALL_DIRECT_LVAR;
+		  b++;
+		  break;
+	       }
+	     break;
+	     
+	   case _SLANG_BC_INTRINSIC:
+	     b++;
+	     switch (b->bc_main_type)
+	       {
+		case _SLANG_BC_CALL_DIRECT:
+		  (b-1)->bc_main_type = _SLANG_BC_INTRINSIC_CALL_DIRECT;
+		  b++;
+		  break;
+#if 0
+		case _SLANG_BC_BLOCK:
+		  (b-1)->bc_main_type = _SLANG_BC_INTRINSIC_BLOCK;
+		  b++;
+		  break;
+#endif
+
+		case 0:
+		  (b-1)->bc_main_type = _SLANG_BC_INTRINSIC_STOP;
+		  return;
+	       }	     
+	     break;
+	  }
+     }
+}
+
+#endif
+
+
+/* name will be NULL if the object is to simply terminate the function
+ * definition.  See SLang_restart.
+ */
+static int lang_define_function (char *name, unsigned char type, unsigned long hash,
+				 SLang_NameSpace_Type *ns)
+{
+   if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_FUNCTION)
+     {
+	SLang_verror (SL_SYNTAX_ERROR, "Premature end of function");
+	return -1;
+     }
+
+   /* terminate function */
+   Compile_ByteCode_Ptr->bc_main_type = 0;
+
+   if (name != NULL)
+     {
+	_SLBlock_Header_Type *h;
+
+	h = (_SLBlock_Header_Type *)SLmalloc (sizeof (_SLBlock_Header_Type));
+	if (h != NULL)
+	  {
+	     h->num_refs = 1;
+	     h->body = This_Compile_Block;
+	     
+#if USE_COMBINED_BYTECODES
+	     optimize_block (h->body);
+#endif
+
+	     if (-1 == add_slang_function (name, type, hash,
+					   Function_Args_Number,
+					   Local_Variable_Number,
+#if _SLANG_HAS_DEBUG_CODE
+					   This_Compile_Filename,
+#endif
+					   h, ns))
+	       SLfree ((char *) h);
+	  }
+	/* Drop through for clean-up */
+     }
+
+   free_local_variable_table ();
+
+   Function_Args_Number = 0;
+   Lang_Defining_Function = 0;
+
+   if (SLang_Error) return -1;
+   /* SLang_restart will finish this if there is a slang error. */
+
+   pop_block_context ();
+
+   /* A function is only defined at top-level */
+   if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL)
+     {
+	SLang_verror (SL_INTERNAL_ERROR, "Not at top-level");
+	return -1;
+     }
+   Compile_ByteCode_Ptr = This_Compile_Block;
+   return 0;
+}
+
+static void define_static_function (char *name, unsigned long hash)
+{
+   (void) lang_define_function (name, SLANG_FUNCTION, hash, This_Static_NameSpace);
+}
+
+static void define_private_function (char *name, unsigned long hash)
+{
+   (void) lang_define_function (name, SLANG_PFUNCTION, hash, This_Static_NameSpace);
+}
+
+static void define_public_function (char *name, unsigned long hash)
+{
+   (void) lang_define_function (name, SLANG_FUNCTION, hash, Global_NameSpace);
+}
+
+static void lang_end_block (void)
+{
+   SLBlock_Type *node, *branch;
+   unsigned char mtype;
+
+   if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_BLOCK)
+     {
+	SLang_verror (SL_SYNTAX_ERROR, "Not defining a block");
+	return;
+     }
+
+   /* terminate the block */
+   Compile_ByteCode_Ptr->bc_main_type = 0;
+   branch = This_Compile_Block;
+
+   /* Try to save some space by using the cached blocks. */
+   if (Compile_ByteCode_Ptr == branch + 1)
+     {
+	mtype = branch->bc_main_type;
+	if (((mtype == _SLANG_BC_BREAK)
+	     || (mtype == _SLANG_BC_CONTINUE)
+	     || (mtype == _SLANG_BC_RETURN))
+	    && (SLang_Error == 0))
+	  {
+	     SLfree ((char *)branch);
+	     branch = SLShort_Blocks + 2 * (int) (mtype - _SLANG_BC_RETURN);
+	  }
+     }
+
+#if USE_COMBINED_BYTECODES
+   optimize_block (branch);
+#endif
+
+   pop_block_context ();
+   node = Compile_ByteCode_Ptr++;
+
+   node->bc_main_type = _SLANG_BC_BLOCK;
+   node->bc_sub_type = 0;
+   node->b.blk = branch;
+}
+
+static int lang_begin_block (void)
+{
+   return push_block_context (COMPILE_BLOCK_TYPE_BLOCK);
+}
+
+static int lang_check_space (void)
+{
+   unsigned int n;
+   SLBlock_Type *p;
+
+   if (NULL == (p = This_Compile_Block))
+     {
+	SLang_verror (SL_INTERNAL_ERROR, "Top-level block not present");
+	return -1;
+     }
+
+   /* Allow 1 extra for terminator */
+   if (Compile_ByteCode_Ptr + 1 < This_Compile_Block_Max)
+     return 0;
+
+   n = (unsigned int) (This_Compile_Block_Max - p);
+
+   /* enlarge the space by 2 objects */
+   n += 2;
+
+   if (NULL == (p = (SLBlock_Type *) SLrealloc((char *)p, n * sizeof(SLBlock_Type))))
+     return -1;
+
+   This_Compile_Block_Max = p + n;
+   n = (unsigned int) (Compile_ByteCode_Ptr - This_Compile_Block);
+   This_Compile_Block = p;
+   Compile_ByteCode_Ptr = p + n;
+
+   return 0;
+}
+
+/* returns positive number if name is a function or negative number if it
+ is a variable.  If it is intrinsic, it returns magnitude of 1, else 2 */
+int SLang_is_defined(char *name)
+{
+   SLang_Name_Type *t;
+
+   if (-1 == init_interpreter ())
+     return -1;
+
+   t = locate_namespace_encoded_name (name, 0);
+   if (t == NULL)
+     return 0;
+
+   switch (t->name_type)
+     {
+      case SLANG_FUNCTION:
+      /* case SLANG_PFUNCTION: */
+	return 2;
+      case SLANG_GVARIABLE:
+      /* case SLANG_PVARIABLE: */
+	return -2;
+
+      case SLANG_ICONSTANT:
+      case SLANG_DCONSTANT:
+      case SLANG_RVARIABLE:
+      case SLANG_IVARIABLE:
+	return -1;
+
+      case SLANG_INTRINSIC:
+      default:
+	return 1;
+     }
+}
+
+static int add_global_variable (char *name, char name_type, unsigned long hash,
+				SLang_NameSpace_Type *ns)
+{
+   SLang_Name_Type *g;
+
+   /* Note the importance of checking if it is already defined or not.  For example,
+    * suppose X is defined as an intrinsic variable.  Then S-Lang code like:
+    * !if (is_defined("X")) { variable X; }
+    * will not result in a global variable X.  On the other hand, this would
+    * not be an issue if 'variable' statements always were not processed
+    * immediately.  That is, as it is now, 'if (0) {variable ZZZZ;}' will result
+    * in the variable ZZZZ being defined because of the immediate processing.
+    * The current solution is to do: if (0) { eval("variable ZZZZ;"); }
+    */
+   /* hash = _SLcompute_string_hash (name); */
+   g = locate_name_in_table (name, hash, ns->table, ns->table_size);
+
+   if (g != NULL)
+     {
+	if (g->name_type == name_type)
+	  return 0;
+     }
+
+   if (NULL == add_global_name (name, hash, name_type,
+				sizeof (SLang_Global_Var_Type), ns))
+     return -1;
+
+   return 0;
+}
+
+int SLadd_global_variable (char *name)
+{
+   if (-1 == init_interpreter ())
+     return -1;
+
+   return add_global_variable (name, SLANG_GVARIABLE,
+			       _SLcompute_string_hash (name),
+			       Global_NameSpace);
+}
+
+static int add_local_variable (char *name, unsigned long hash)
+{
+   SLang_Local_Var_Type *t;
+
+   /* local variable */
+   if (Local_Variable_Number >= SLANG_MAX_LOCAL_VARIABLES)
+     {
+	SLang_verror (SL_SYNTAX_ERROR, "Too many local variables");
+	return -1;
+     }
+
+   if (NULL != locate_name_in_table (name, hash, Locals_Hash_Table, SLLOCALS_HASH_TABLE_SIZE))
+     {
+	SLang_verror (SL_SYNTAX_ERROR, "Local variable %s has already been defined", name);
+	return -1;
+     }
+
+   t = (SLang_Local_Var_Type *)
+     add_name_to_hash_table (name, hash,
+			     sizeof (SLang_Local_Var_Type), SLANG_LVARIABLE,
+			     Locals_Hash_Table, SLLOCALS_HASH_TABLE_SIZE, 0);
+   if (t == NULL)
+     return -1;
+
+   t->local_var_number = Local_Variable_Number;
+   Local_Variable_Number++;
+   return 0;
+}
+
+static void (*Compile_Mode_Function) (_SLang_Token_Type *);
+static void compile_basic_token_mode (_SLang_Token_Type *);
+
+/* if an error occurs, discard current object, block, function, etc... */
+void SLang_restart (int localv)
+{
+   int save = SLang_Error;
+
+   SLang_Error = SL_UNKNOWN_ERROR;
+
+   _SLcompile_ptr = _SLcompile;
+   Compile_Mode_Function = compile_basic_token_mode;
+
+   Lang_Break = /* Lang_Continue = */ Lang_Return = 0;
+   Trace_Mode = 0;
+
+   while (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_BLOCK)
+     lang_end_block();
+
+   if (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_FUNCTION)
+     {
+	/* Terminate function definition and free variables */
+	lang_define_function (NULL, SLANG_FUNCTION, 0, Global_NameSpace);
+	if (lang_free_branch (This_Compile_Block))
+	  SLfree((char *)This_Compile_Block);
+     }
+   Lang_Defining_Function = 0;
+
+   SLang_Error = save;
+
+   if (SLang_Error == SL_STACK_OVERFLOW)
+     {
+	/* This loop guarantees that the stack is properly cleaned. */
+	while (_SLStack_Pointer != _SLRun_Stack)
+	  {
+	     SLdo_pop ();
+	  }
+     }
+
+   while ((This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL)
+	  && (0 == pop_block_context ()))
+     ;
+
+   if (localv)
+     {
+	Next_Function_Num_Args = SLang_Num_Function_Args = 0;
+	Local_Variable_Frame = Local_Variable_Stack;
+	Recursion_Depth = 0;
+	Frame_Pointer = _SLStack_Pointer;
+	Frame_Pointer_Depth = 0;
+	Switch_Obj_Ptr = Switch_Objects;
+	while (Switch_Obj_Ptr < Switch_Obj_Max)
+	  {
+	     SLang_free_object (Switch_Obj_Ptr);
+	     Switch_Obj_Ptr++;
+	  }
+	Switch_Obj_Ptr = Switch_Objects;
+     }
+}
+
+static void compile_directive (unsigned char sub_type)
+{
+   /* This function is called only from compile_directive_mode which is
+    * only possible when a block is available.
+    */
+
+   /* use BLOCK */
+   Compile_ByteCode_Ptr--;
+   Compile_ByteCode_Ptr->bc_sub_type = sub_type;
+
+   lang_try_now ();
+}
+
+static void compile_unary (int op, unsigned char mt)
+{
+   Compile_ByteCode_Ptr->bc_main_type = mt;
+   Compile_ByteCode_Ptr->b.i_blk = op;
+   Compile_ByteCode_Ptr->bc_sub_type = 0;
+
+   lang_try_now ();
+}
+
+
+static void compile_binary (int op)
+{
+   Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_BINARY;
+   Compile_ByteCode_Ptr->b.i_blk = op;
+   Compile_ByteCode_Ptr->bc_sub_type = 0;
+
+   lang_try_now ();
+}
+
+#if _SLANG_OPTIMIZE_FOR_SPEED
+static int try_compressed_bytecode (unsigned char last_bc, unsigned char bc)
+{
+   if (Compile_ByteCode_Ptr != This_Compile_Block)
+     {
+	SLBlock_Type *b;
+	b = Compile_ByteCode_Ptr - 1;
+	if (b->bc_main_type == last_bc)
+	  {
+	     Compile_ByteCode_Ptr = b;
+	     b->bc_main_type = bc;
+	     lang_try_now ();
+	     return 0;
+	  }
+     }
+   return -1;
+}
+#endif
+
+static void compile_fast_binary (int op, unsigned char bc)
+{
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (0 == try_compressed_bytecode (_SLANG_BC_LITERAL_INT, bc))
+     return;
+#else
+   (void) bc;
+#endif
+   compile_binary (op);
+}
+
+/* This is a hack */
+typedef struct _Special_NameTable_Type
+{
+   char *name;
+   int (*fun) (struct _Special_NameTable_Type *, _SLang_Token_Type *);
+   VOID_STAR blk_data;
+   unsigned char main_type;
+}
+Special_NameTable_Type;
+
+static int handle_special (Special_NameTable_Type *nt, _SLang_Token_Type *tok)
+{
+   (void) tok;
+   Compile_ByteCode_Ptr->bc_main_type = nt->main_type;
+   Compile_ByteCode_Ptr->b.ptr_blk = nt->blk_data;
+   return 0;
+}
+
+static int handle_special_file (Special_NameTable_Type *nt, _SLang_Token_Type *tok)
+{
+   char *name;
+
+   (void) nt; (void) tok;
+
+   if (This_Static_NameSpace == NULL) name = "***Unknown***";
+   else
+     name = This_Static_NameSpace->name;
+
+   name = SLang_create_slstring (name);
+   if (name == NULL)
+     return -1;
+
+   Compile_ByteCode_Ptr->b.s_blk = name;
+   Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LITERAL_STR;
+   Compile_ByteCode_Ptr->bc_sub_type = SLANG_STRING_TYPE;
+   return 0;
+}
+
+static int handle_special_line (Special_NameTable_Type *nt, _SLang_Token_Type *tok)
+{
+   (void) nt;
+
+#if _SLANG_HAS_DEBUG_CODE
+   Compile_ByteCode_Ptr->b.l_blk = (long) tok->line_number;
+#endif
+   Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LITERAL;
+   Compile_ByteCode_Ptr->bc_sub_type = SLANG_UINT_TYPE;
+
+   return 0;
+}
+
+static Special_NameTable_Type Special_Name_Table [] =
+{
+     {"EXECUTE_ERROR_BLOCK", handle_special, NULL, _SLANG_BC_X_ERROR},
+     {"X_USER_BLOCK0", handle_special, NULL, _SLANG_BC_X_USER0},
+     {"X_USER_BLOCK1", handle_special, NULL, _SLANG_BC_X_USER1},
+     {"X_USER_BLOCK2", handle_special, NULL, _SLANG_BC_X_USER2},
+     {"X_USER_BLOCK3", handle_special, NULL, _SLANG_BC_X_USER3},
+     {"X_USER_BLOCK4", handle_special, NULL, _SLANG_BC_X_USER4},
+     {"__FILE__", handle_special_file, NULL, 0},
+     {"__LINE__", handle_special_line, NULL, 0},
+#if 0
+     {"__NAMESPACE__", handle_special_namespace, NULL, 0},
+#endif
+     {NULL, NULL, NULL, 0}
+};
+
+static void compile_hashed_identifier (char *name, unsigned long hash, _SLang_Token_Type *tok)
+{
+   SLang_Name_Type *entry;
+   unsigned char name_type;
+
+   entry = locate_hashed_name (name, hash);
+
+   if (entry == NULL)
+     {
+	Special_NameTable_Type *nt = Special_Name_Table;
+
+	while (nt->name != NULL)
+	  {
+	     if (strcmp (name, nt->name))
+	       {
+		  nt++;
+		  continue;
+	       }
+
+	     if (0 == (*nt->fun)(nt, tok))
+	       lang_try_now ();
+	     return;
+	  }
+
+	SLang_verror (SL_UNDEFINED_NAME, "%s is undefined", name);
+	return;
+     }
+
+   name_type = entry->name_type;
+   Compile_ByteCode_Ptr->bc_main_type = name_type;
+
+   if (name_type == SLANG_LVARIABLE)
+     Compile_ByteCode_Ptr->b.i_blk = ((SLang_Local_Var_Type *) entry)->local_var_number;
+   else
+     Compile_ByteCode_Ptr->b.nt_blk = entry;
+
+   lang_try_now ();
+}
+
+static void compile_tmp_variable (char *name, unsigned long hash)
+{
+   SLang_Name_Type *entry;
+   unsigned char name_type;
+
+   if (NULL == (entry = locate_hashed_name (name, hash)))
+     {
+	SLang_verror (SL_UNDEFINED_NAME, "%s is undefined", name);
+	return;
+     }
+
+   name_type = entry->name_type;
+   switch (name_type)
+     {
+      case SLANG_LVARIABLE:
+	Compile_ByteCode_Ptr->b.i_blk = ((SLang_Local_Var_Type *) entry)->local_var_number;
+	break;
+
+      case SLANG_GVARIABLE:
+      case SLANG_PVARIABLE:
+	Compile_ByteCode_Ptr->b.nt_blk = entry;
+	break;
+
+      default:
+	SLang_verror (SL_SYNTAX_ERROR, "__tmp(%s) does not specifiy a variable", name);
+	return;
+     }
+
+   Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_TMP;
+   Compile_ByteCode_Ptr->bc_sub_type = name_type;
+
+   lang_try_now ();
+}
+
+static void compile_simple (unsigned char main_type)
+{
+   Compile_ByteCode_Ptr->bc_main_type = main_type;
+   Compile_ByteCode_Ptr->bc_sub_type = 0;
+   Compile_ByteCode_Ptr->b.blk = NULL;
+   lang_try_now ();
+}
+
+static void compile_identifier (char *name, _SLang_Token_Type *tok)
+{
+   compile_hashed_identifier (name, _SLcompute_string_hash (name), tok);
+}
+
+static void compile_call_direct (int (*f) (void), unsigned char byte_code)
+{
+   Compile_ByteCode_Ptr->b.call_function = f;
+   Compile_ByteCode_Ptr->bc_main_type = byte_code;
+   Compile_ByteCode_Ptr->bc_sub_type = 0;
+   lang_try_now ();
+}
+
+static void compile_lvar_call_direct (int (*f)(void), unsigned char bc,
+				      unsigned char frame_op)
+{
+#if _SLANG_OPTIMIZE_FOR_SPEED
+   if (0 == try_compressed_bytecode (_SLANG_BC_LVARIABLE, bc))
+     return;
+#else
+   (void) bc;
+#endif
+
+   compile_call_direct (f, frame_op);
+}
+
+static void compile_integer (long i, unsigned char bc_main_type, unsigned char bc_sub_type)
+{
+   Compile_ByteCode_Ptr->b.l_blk = i;
+   Compile_ByteCode_Ptr->bc_main_type = bc_main_type;
+   Compile_ByteCode_Ptr->bc_sub_type = bc_sub_type;
+
+   lang_try_now ();
+}
+
+#if SLANG_HAS_FLOAT
+static void compile_double (char *str, unsigned char type)
+{
+   double d;
+   unsigned int factor = 1;
+   double *ptr;
+
+#if 1
+   d = _SLang_atof (str);
+#else
+   if (1 != sscanf (str, "%lf", &d))
+     {
+	SLang_verror (SL_SYNTAX_ERROR, "Unable to convert %s to double", str);
+	return;
+     }
+#endif
+
+#if SLANG_HAS_COMPLEX
+   if (type == SLANG_COMPLEX_TYPE) factor = 2;
+#endif
+   if (NULL == (ptr = (double *) SLmalloc(factor * sizeof(double))))
+     return;
+
+   Compile_ByteCode_Ptr->b.double_blk = ptr;
+#if SLANG_HAS_COMPLEX
+   if (type == SLANG_COMPLEX_TYPE)
+     *ptr++ = 0;
+#endif
+   *ptr = d;
+
+   Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LITERAL;
+   Compile_ByteCode_Ptr->bc_sub_type = type;
+   lang_try_now ();
+}
+
+static void compile_float (char *s)
+{
+   float x;
+
+#if 1
+   x = (float) _SLang_atof (s);
+#else
+   if (1 != sscanf (s, "%f", &x))
+     {
+	SLang_verror (SL_SYNTAX_ERROR, "Unable to convert %s to float", s);
+	return;
+     }
+#endif
+   Compile_ByteCode_Ptr->b.float_blk = x;
+   Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LITERAL;
+   Compile_ByteCode_Ptr->bc_sub_type = SLANG_FLOAT_TYPE;
+   lang_try_now ();
+}
+
+#endif
+
+static void compile_string (char *s, unsigned long hash)
+{
+   if (NULL == (Compile_ByteCode_Ptr->b.s_blk = _SLstring_dup_hashed_string (s, hash)))
+     return;
+
+   Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LITERAL_STR;
+   Compile_ByteCode_Ptr->bc_sub_type = SLANG_STRING_TYPE;
+
+   lang_try_now ();
+}
+
+static void compile_bstring (SLang_BString_Type *s)
+{
+   if (NULL == (Compile_ByteCode_Ptr->b.bs_blk = SLbstring_dup (s)))
+     return;
+
+   Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LITERAL;
+   Compile_ByteCode_Ptr->bc_sub_type = SLANG_BSTRING_TYPE;
+
+   lang_try_now ();
+}
+
+/* assign_type is one of _SLANG_BCST_ASSIGN, ... values */
+static void compile_assign (unsigned char assign_type,
+			    char *name, unsigned long hash)
+{
+   SLang_Name_Type *v;
+   unsigned char main_type;
+   SLang_Class_Type *cl;
+
+   v = locate_hashed_name (name, hash);
+   if (v == NULL)
+     {
+	if ((_SLang_Auto_Declare_Globals == 0)
+	    || (NULL != strchr (name, '-'))   /* namespace->name form */
+	    || Lang_Defining_Function
+	    || (assign_type != _SLANG_BCST_ASSIGN)
+	    || (This_Static_NameSpace == NULL))
+	  {
+	     SLang_verror (SL_UNDEFINED_NAME, "%s is undefined", name);
+	     return;
+	  }
+	/* Note that function local variables are not at top level */
+
+	/* Variables that are automatically declared are given static
+	 * scope.
+	 */
+	if ((NULL != SLang_Auto_Declare_Var_Hook)
+	    && (-1 == (*SLang_Auto_Declare_Var_Hook) (name)))
+	  return;
+
+	if ((-1 == add_global_variable (name, SLANG_GVARIABLE, hash, This_Static_NameSpace))
+	    || (NULL == (v = locate_hashed_name (name, hash))))
+	  return;
+     }
+
+   switch (v->name_type)
+     {
+      case SLANG_LVARIABLE:
+	main_type = _SLANG_BC_SET_LOCAL_LVALUE;
+	Compile_ByteCode_Ptr->b.i_blk = ((SLang_Local_Var_Type *) v)->local_var_number;
+	break;
+
+      case SLANG_GVARIABLE:
+      case SLANG_PVARIABLE:
+	main_type = _SLANG_BC_SET_GLOBAL_LVALUE;
+	Compile_ByteCode_Ptr->b.nt_blk = v;
+	break;
+
+      case SLANG_IVARIABLE:
+	cl = _SLclass_get_class (((SLang_Intrin_Var_Type *)v)->type);
+	if (cl->cl_class_type != SLANG_CLASS_TYPE_SCALAR)
+	  {
+	     SLang_verror (SL_SYNTAX_ERROR, "Assignment to %s is not allowed", name);
+	     return;
+	  }
+	main_type = _SLANG_BC_SET_INTRIN_LVALUE;
+	Compile_ByteCode_Ptr->b.nt_blk = v;
+	break;
+
+      case SLANG_RVARIABLE:
+	SLang_verror (SL_READONLY_ERROR, "%s is read-only", name);
+	return;
+
+      default:
+	SLang_verror (SL_DUPLICATE_DEFINITION, "%s may not be used as an lvalue", name);
+	return;
+     }
+
+   Compile_ByteCode_Ptr->bc_sub_type = assign_type;
+   Compile_ByteCode_Ptr->bc_main_type = main_type;
+
+   lang_try_now ();
+}
+
+static void compile_deref_assign (char *name, unsigned long hash)
+{
+   SLang_Name_Type *v;
+
+   v = locate_hashed_name (name, hash);
+
+   if (v == NULL)
+     {
+	SLang_verror (SL_UNDEFINED_NAME, "%s is undefined", name);
+	return;
+     }
+
+   switch (v->name_type)
+     {
+      case SLANG_LVARIABLE:
+	Compile_ByteCode_Ptr->b.i_blk = ((SLang_Local_Var_Type *) v)->local_var_number;
+	break;
+
+      case SLANG_GVARIABLE:
+      case SLANG_PVARIABLE:
+	Compile_ByteCode_Ptr->b.nt_blk = v;
+	break;
+
+      default:
+	/* FIXME: Priority=low
+	 * This could be made to work.  It is not a priority because
+	 * I cannot imagine application intrinsics which are references.
+	 */
+	SLang_verror (SL_NOT_IMPLEMENTED, "Deref assignment to %s is not allowed", name);
+	return;
+     }
+
+   Compile_ByteCode_Ptr->bc_sub_type = v->name_type;
+   Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_DEREF_ASSIGN;
+
+   lang_try_now ();
+}
+
+static void
+compile_struct_assign (_SLang_Token_Type *t)
+{
+   Compile_ByteCode_Ptr->bc_sub_type = _SLANG_BCST_ASSIGN + (t->type - _STRUCT_ASSIGN_TOKEN);
+   Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_SET_STRUCT_LVALUE;
+   Compile_ByteCode_Ptr->b.s_blk = _SLstring_dup_hashed_string (t->v.s_val, t->hash);
+   lang_try_now ();
+}
+
+static void
+compile_array_assign (_SLang_Token_Type *t)
+{
+   Compile_ByteCode_Ptr->bc_sub_type = _SLANG_BCST_ASSIGN + (t->type - _ARRAY_ASSIGN_TOKEN);
+   Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_SET_ARRAY_LVALUE;
+   Compile_ByteCode_Ptr->b.s_blk = NULL;
+   lang_try_now ();
+}
+
+static void compile_dot(_SLang_Token_Type *t)
+{
+   Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_FIELD;
+   Compile_ByteCode_Ptr->b.s_blk = _SLstring_dup_hashed_string(t->v.s_val, t->hash);
+   lang_try_now ();
+}
+
+static void compile_ref (char *name, unsigned long hash)
+{
+   SLang_Name_Type *entry;
+   unsigned char main_type;
+
+   if (NULL == (entry = locate_hashed_name (name, hash)))
+     {
+	SLang_verror (SL_UNDEFINED_NAME, "%s is undefined", name);
+	return;
+     }
+
+   main_type = entry->name_type;
+
+   if (main_type == SLANG_LVARIABLE)
+     {
+	main_type = _SLANG_BC_LOBJPTR;
+	Compile_ByteCode_Ptr->b.i_blk = ((SLang_Local_Var_Type *)entry)->local_var_number;
+     }
+   else
+     {
+	main_type = _SLANG_BC_GOBJPTR;
+	Compile_ByteCode_Ptr->b.nt_blk = entry;
+     }
+
+   Compile_ByteCode_Ptr->bc_main_type = main_type;
+   lang_try_now ();
+}
+
+static void compile_break (unsigned char break_type,
+			   int requires_block, int requires_fun,
+			   char *str)
+{
+   if ((requires_fun
+	&& (Lang_Defining_Function == 0))
+       || (requires_block
+	   && (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_BLOCK)))
+     {
+	SLang_verror (SL_SYNTAX_ERROR, "misplaced %s", str);
+	return;
+     }
+
+   Compile_ByteCode_Ptr->bc_main_type = break_type;
+   Compile_ByteCode_Ptr->bc_sub_type = 0;
+
+   lang_try_now ();
+}
+
+static void compile_public_variable_mode (_SLang_Token_Type *t)
+{
+   if (t->type == IDENT_TOKEN)
+     {
+	/* If the variable is already defined in the static hash table,
+	 * generate an error.
+	 */
+	if ((This_Static_NameSpace != NULL)
+	    && (NULL != locate_name_in_table (t->v.s_val, t->hash, This_Static_NameSpace->table, This_Static_NameSpace->table_size)))
+	  {
+	     SLang_verror (SL_DUPLICATE_DEFINITION,
+			   "%s already has static or private linkage in this unit",
+			   t->v.s_val);
+	     return;
+	  }
+	add_global_variable (t->v.s_val, SLANG_GVARIABLE, t->hash, Global_NameSpace);
+     }
+   else if (t->type == CBRACKET_TOKEN)
+     Compile_Mode_Function = compile_basic_token_mode;
+   else
+     SLang_verror (SL_SYNTAX_ERROR, "Misplaced token in variable list");
+}
+
+static void compile_local_variable_mode (_SLang_Token_Type *t)
+{
+   if (t->type == IDENT_TOKEN)
+     add_local_variable (t->v.s_val, t->hash);
+   else if (t->type == CBRACKET_TOKEN)
+     Compile_Mode_Function = compile_basic_token_mode;
+   else
+     SLang_verror (SL_SYNTAX_ERROR, "Misplaced token in variable list");
+}
+
+static void compile_static_variable_mode (_SLang_Token_Type *t)
+{
+   if (t->type == IDENT_TOKEN)
+     add_global_variable (t->v.s_val, SLANG_GVARIABLE, t->hash, This_Static_NameSpace);
+   else if (t->type == CBRACKET_TOKEN)
+     Compile_Mode_Function = compile_basic_token_mode;
+   else
+     SLang_verror (SL_SYNTAX_ERROR, "Misplaced token in variable list");
+}
+
+static void compile_private_variable_mode (_SLang_Token_Type *t)
+{
+   if (t->type == IDENT_TOKEN)
+     add_global_variable (t->v.s_val, SLANG_PVARIABLE, t->hash, This_Static_NameSpace);
+   else if (t->type == CBRACKET_TOKEN)
+     Compile_Mode_Function = compile_basic_token_mode;
+   else
+     SLang_verror (SL_SYNTAX_ERROR, "Misplaced token in variable list");
+}
+
+static void compile_function_mode (_SLang_Token_Type *t)
+{
+   if (-1 == lang_check_space ())
+     return;
+
+   if (t->type != IDENT_TOKEN)
+     SLang_verror (SL_SYNTAX_ERROR, "Expecting function name");
+   else
+     lang_define_function (t->v.s_val, SLANG_FUNCTION, t->hash, Global_NameSpace);
+
+   Compile_Mode_Function = compile_basic_token_mode;
+}
+
+/* An error block is not permitted to contain continue or break statements.
+ * This restriction may be removed later but for now reject them.
+ */
+static int check_error_block (void)
+{
+   SLBlock_Type *p;
+   unsigned char t;
+
+   /* Back up to the block and then scan it. */
+   p = (Compile_ByteCode_Ptr - 1)->b.blk;
+
+   while (0 != (t = p->bc_main_type))
+     {
+	if ((t == _SLANG_BC_BREAK)
+	    || (t == _SLANG_BC_CONTINUE))
+	  {
+	     SLang_verror (SL_SYNTAX_ERROR,
+			   "An ERROR_BLOCK is not permitted to contain continue or break statements");
+	     return -1;
+	  }
+	p++;
+     }
+   return 0;
+}
+
+/* The only allowed tokens are the directives and another block start.
+ * The mode is only active if a block is available.  The inner_interp routine
+ * expects such safety checks.
+ */
+static void compile_directive_mode (_SLang_Token_Type *t)
+{
+   int bc_sub_type;
+
+   if (-1 == lang_check_space ())
+     return;
+
+   bc_sub_type = -1;
+
+   switch (t->type)
+     {
+      case FOREVER_TOKEN:
+	bc_sub_type = _SLANG_BCST_FOREVER;
+	break;
+
+      case IFNOT_TOKEN:
+	bc_sub_type = _SLANG_BCST_IFNOT;
+	break;
+
+      case IF_TOKEN:
+	bc_sub_type = _SLANG_BCST_IF;
+	break;
+
+      case ANDELSE_TOKEN:
+	bc_sub_type = _SLANG_BCST_ANDELSE;
+	break;
+
+      case SWITCH_TOKEN:
+	bc_sub_type = _SLANG_BCST_SWITCH;
+	break;
+
+      case EXITBLK_TOKEN:
+	if (Lang_Defining_Function == 0)
+	  {
+	     SLang_verror (SL_SYNTAX_ERROR, "misplaced EXIT_BLOCK");
+	     break;
+	  }
+	bc_sub_type = _SLANG_BCST_EXIT_BLOCK;
+	break;
+
+      case ERRBLK_TOKEN:
+	if (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_TOP_LEVEL)
+	  {
+	     SLang_verror (SL_SYNTAX_ERROR, "misplaced ERROR_BLOCK");
+	     break;
+	  }
+	if (0 == check_error_block ())
+	  bc_sub_type = _SLANG_BCST_ERROR_BLOCK;
+	break;
+
+      case USRBLK0_TOKEN:
+      case USRBLK1_TOKEN:
+      case USRBLK2_TOKEN:
+      case USRBLK3_TOKEN:
+      case USRBLK4_TOKEN:
+	if (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_TOP_LEVEL)
+	  {
+	     SLang_verror (SL_SYNTAX_ERROR, "misplaced USER_BLOCK");
+	     break;
+	  }
+	bc_sub_type = _SLANG_BCST_USER_BLOCK0 + (t->type - USRBLK0_TOKEN);
+	break;
+
+      case NOTELSE_TOKEN:
+	bc_sub_type = _SLANG_BCST_NOTELSE;
+	break;
+
+      case ELSE_TOKEN:
+	bc_sub_type = _SLANG_BCST_ELSE;
+	break;
+
+      case LOOP_TOKEN:
+	bc_sub_type = _SLANG_BCST_LOOP;
+	break;
+
+      case DOWHILE_TOKEN:
+	bc_sub_type = _SLANG_BCST_DOWHILE;
+	break;
+
+      case WHILE_TOKEN:
+	bc_sub_type = _SLANG_BCST_WHILE;
+	break;
+
+      case ORELSE_TOKEN:
+	bc_sub_type = _SLANG_BCST_ORELSE;
+	break;
+
+      case _FOR_TOKEN:
+	bc_sub_type = _SLANG_BCST_FOR;
+	break;
+
+      case FOR_TOKEN:
+	bc_sub_type = _SLANG_BCST_CFOR;
+	break;
+
+      case FOREACH_TOKEN:
+	bc_sub_type = _SLANG_BCST_FOREACH;
+	break;
+
+      case OBRACE_TOKEN:
+	lang_begin_block ();
+	break;
+
+      default:
+	SLang_verror (SL_SYNTAX_ERROR, "Expecting directive token.  Found 0x%X", t->type);
+	break;
+     }
+
+   /* Reset this pointer first because compile_directive may cause a
+    * file to be loaded.
+    */
+   Compile_Mode_Function = compile_basic_token_mode;
+
+   if (bc_sub_type != -1)
+     compile_directive (bc_sub_type);
+}
+
+static unsigned int Assign_Mode_Type;
+static void compile_assign_mode (_SLang_Token_Type *t)
+{
+   if (t->type != IDENT_TOKEN)
+     {
+	SLang_verror (SL_SYNTAX_ERROR, "Expecting identifier for assignment");
+	return;
+     }
+
+   compile_assign (Assign_Mode_Type, t->v.s_val, t->hash);
+   Compile_Mode_Function = compile_basic_token_mode;
+}
+
+static void compile_basic_token_mode (_SLang_Token_Type *t)
+{
+   if (-1 == lang_check_space ())
+     return;
+
+   switch (t->type)
+     {
+      case PUSH_TOKEN:
+      case NOP_TOKEN:
+      case EOF_TOKEN:
+      case READONLY_TOKEN:
+      case DO_TOKEN:
+      case VARIABLE_TOKEN:
+      case SEMICOLON_TOKEN:
+      default:
+	SLang_verror (SL_SYNTAX_ERROR, "Unknown or unsupported token type 0x%X", t->type);
+	break;
+
+      case DEREF_TOKEN:
+	compile_call_direct (dereference_object, _SLANG_BC_CALL_DIRECT);
+	break;
+
+      case STRUCT_TOKEN:
+	compile_call_direct (_SLstruct_define_struct, _SLANG_BC_CALL_DIRECT);
+	break;
+
+      case TYPEDEF_TOKEN:
+	compile_call_direct (_SLstruct_define_typedef, _SLANG_BC_CALL_DIRECT);
+	break;
+
+      case TMP_TOKEN:
+	compile_tmp_variable (t->v.s_val, t->hash);
+	break;
+
+      case DOT_TOKEN:		       /* X . field */
+	compile_dot (t);
+	break;
+
+      case COMMA_TOKEN:
+	break;			       /* do nothing */
+
+      case IDENT_TOKEN:
+	compile_hashed_identifier (t->v.s_val, t->hash, t);
+	break;
+
+      case _REF_TOKEN:
+	compile_ref (t->v.s_val, t->hash);
+	break;
+
+      case ARG_TOKEN:
+	compile_call_direct (SLang_start_arg_list, _SLANG_BC_CALL_DIRECT);
+	break;
+
+      case EARG_TOKEN:
+	compile_lvar_call_direct (SLang_end_arg_list, _SLANG_BC_EARG_LVARIABLE, _SLANG_BC_CALL_DIRECT);
+	break;
+
+      case COLON_TOKEN:
+	if (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_BLOCK)
+	  compile_simple (_SLANG_BC_LABEL);
+	else SLang_Error = SL_SYNTAX_ERROR;
+	break;
+
+      case POP_TOKEN:
+	compile_call_direct (SLdo_pop, _SLANG_BC_CALL_DIRECT);
+	break;
+
+      case CASE_TOKEN:
+	if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_BLOCK)
+	  SLang_verror (SL_SYNTAX_ERROR, "Misplaced 'case'");
+	else
+	  compile_call_direct (case_function, _SLANG_BC_CALL_DIRECT);
+	break;
+
+      case CHAR_TOKEN:
+	compile_integer (t->v.long_val, _SLANG_BC_LITERAL, SLANG_CHAR_TYPE);
+	break;
+      case SHORT_TOKEN:
+	compile_integer (t->v.long_val, _SLANG_BC_LITERAL, SLANG_SHORT_TYPE);
+	break;
+      case INT_TOKEN:
+	compile_integer (t->v.long_val, _SLANG_BC_LITERAL_INT, SLANG_INT_TYPE);
+	break;
+      case UCHAR_TOKEN:
+	compile_integer (t->v.long_val, _SLANG_BC_LITERAL, SLANG_UCHAR_TYPE);
+	break;
+      case USHORT_TOKEN:
+	compile_integer (t->v.long_val, _SLANG_BC_LITERAL, SLANG_USHORT_TYPE);
+	break;
+      case UINT_TOKEN:
+	compile_integer (t->v.long_val, _SLANG_BC_LITERAL_INT, SLANG_UINT_TYPE);
+	break;
+      case LONG_TOKEN:
+	compile_integer (t->v.long_val, _SLANG_BC_LITERAL, SLANG_LONG_TYPE);
+	break;
+      case ULONG_TOKEN:
+	compile_integer (t->v.long_val, _SLANG_BC_LITERAL, SLANG_ULONG_TYPE);
+	break;
+
+#if SLANG_HAS_FLOAT
+      case FLOAT_TOKEN:
+	compile_float (t->v.s_val);
+	break;
+
+      case DOUBLE_TOKEN:
+	compile_double (t->v.s_val, SLANG_DOUBLE_TYPE);
+	break;
+#endif
+#if SLANG_HAS_COMPLEX
+      case COMPLEX_TOKEN:
+	compile_double (t->v.s_val, SLANG_COMPLEX_TYPE);
+	break;
+#endif
+
+      case STRING_TOKEN:
+	compile_string (t->v.s_val, t->hash);
+	break;
+
+      case _BSTRING_TOKEN:
+	compile_bstring (SLbstring_create ((unsigned char *)t->v.s_val, (unsigned int) t->hash));
+	break;
+
+      case BSTRING_TOKEN:
+	compile_bstring (t->v.b_val);
+	break;
+
+      case _NULL_TOKEN:
+	compile_identifier ("NULL", t);
+	break;
+
+      case _INLINE_WILDCARD_ARRAY_TOKEN:
+	compile_call_direct (_SLarray_wildcard_array, _SLANG_BC_CALL_DIRECT);
+	break;
+
+      case _INLINE_ARRAY_TOKEN:
+	compile_call_direct (_SLarray_inline_array, _SLANG_BC_CALL_DIRECT_FRAME);
+	break;
+
+      case _INLINE_IMPLICIT_ARRAY_TOKEN:
+	compile_call_direct (_SLarray_inline_implicit_array, _SLANG_BC_CALL_DIRECT_FRAME);
+	break;
+
+      case ARRAY_TOKEN:
+	compile_lvar_call_direct (_SLarray_aget, _SLANG_BC_LVARIABLE_AGET, _SLANG_BC_CALL_DIRECT_FRAME);
+	break;
+
+	/* Note: I need to add the other _ARRAY assign tokens. */
+      case _ARRAY_PLUSEQS_TOKEN:
+      case _ARRAY_MINUSEQS_TOKEN:
+      case _ARRAY_TIMESEQS_TOKEN:
+      case _ARRAY_DIVEQS_TOKEN:
+      case _ARRAY_BOREQS_TOKEN:
+      case _ARRAY_BANDEQS_TOKEN:
+      case _ARRAY_POST_MINUSMINUS_TOKEN:
+      case _ARRAY_MINUSMINUS_TOKEN:
+      case _ARRAY_POST_PLUSPLUS_TOKEN:
+      case _ARRAY_PLUSPLUS_TOKEN:
+	compile_array_assign (t);
+	break;
+
+      case _ARRAY_ASSIGN_TOKEN:
+	compile_lvar_call_direct (_SLarray_aput, _SLANG_BC_LVARIABLE_APUT, _SLANG_BC_CALL_DIRECT_FRAME);
+	break;
+
+      case _STRUCT_ASSIGN_TOKEN:
+      case _STRUCT_PLUSEQS_TOKEN:
+      case _STRUCT_MINUSEQS_TOKEN:
+      case _STRUCT_TIMESEQS_TOKEN:
+      case _STRUCT_DIVEQS_TOKEN:
+      case _STRUCT_BOREQS_TOKEN:
+      case _STRUCT_BANDEQS_TOKEN:
+      case _STRUCT_POST_MINUSMINUS_TOKEN:
+      case _STRUCT_MINUSMINUS_TOKEN:
+      case _STRUCT_POST_PLUSPLUS_TOKEN:
+      case _STRUCT_PLUSPLUS_TOKEN:
+	compile_struct_assign (t);
+	break;
+
+      case _SCALAR_ASSIGN_TOKEN:
+      case _SCALAR_PLUSEQS_TOKEN:
+      case _SCALAR_MINUSEQS_TOKEN:
+      case _SCALAR_TIMESEQS_TOKEN:
+      case _SCALAR_DIVEQS_TOKEN:
+      case _SCALAR_BOREQS_TOKEN:
+      case _SCALAR_BANDEQS_TOKEN:
+      case _SCALAR_POST_MINUSMINUS_TOKEN:
+      case _SCALAR_MINUSMINUS_TOKEN:
+      case _SCALAR_POST_PLUSPLUS_TOKEN:
+      case _SCALAR_PLUSPLUS_TOKEN:
+	compile_assign (_SLANG_BCST_ASSIGN + (t->type - _SCALAR_ASSIGN_TOKEN),
+			t->v.s_val, t->hash);
+	break;
+
+      case _DEREF_ASSIGN_TOKEN:
+	compile_deref_assign (t->v.s_val, t->hash);
+	break;
+
+ 	/* For processing RPN tokens */
+      case ASSIGN_TOKEN:
+      case PLUSEQS_TOKEN:
+      case MINUSEQS_TOKEN:
+      case TIMESEQS_TOKEN:
+      case DIVEQS_TOKEN:
+      case BOREQS_TOKEN:
+      case BANDEQS_TOKEN:
+      case POST_MINUSMINUS_TOKEN:
+      case MINUSMINUS_TOKEN:
+      case POST_PLUSPLUS_TOKEN:
+      case PLUSPLUS_TOKEN:
+	Compile_Mode_Function = compile_assign_mode;
+	Assign_Mode_Type = _SLANG_BCST_ASSIGN + (t->type - ASSIGN_TOKEN);
+	break;
+
+      case LT_TOKEN:
+	compile_binary (SLANG_LT);
+	break;
+
+      case LE_TOKEN:
+	compile_binary (SLANG_LE);
+	break;
+
+      case GT_TOKEN:
+	compile_binary (SLANG_GT);
+	break;
+
+      case GE_TOKEN:
+	compile_binary (SLANG_GE);
+	break;
+
+      case EQ_TOKEN:
+	compile_binary (SLANG_EQ);
+	break;
+
+      case NE_TOKEN:
+	compile_binary (SLANG_NE);
+	break;
+
+      case AND_TOKEN:
+	compile_binary (SLANG_AND);
+	break;
+
+      case ADD_TOKEN:
+	compile_fast_binary (SLANG_PLUS, _SLANG_BC_INTEGER_PLUS);
+	break;
+
+      case SUB_TOKEN:
+	compile_fast_binary (SLANG_MINUS, _SLANG_BC_INTEGER_MINUS);
+	break;
+
+      case TIMES_TOKEN:
+	compile_binary (SLANG_TIMES);
+	break;
+
+      case DIV_TOKEN:
+	compile_binary (SLANG_DIVIDE);
+	break;
+
+      case POW_TOKEN:
+	compile_binary (SLANG_POW);
+	break;
+
+      case BXOR_TOKEN:
+	compile_binary (SLANG_BXOR);
+	break;
+
+      case BAND_TOKEN:
+	compile_binary (SLANG_BAND);
+	break;
+
+      case BOR_TOKEN:
+	compile_binary (SLANG_BOR);
+	break;
+
+      case SHR_TOKEN:
+	compile_binary (SLANG_SHR);
+	break;
+
+      case SHL_TOKEN:
+	compile_binary (SLANG_SHL);
+	break;
+
+      case MOD_TOKEN:
+	compile_binary (SLANG_MOD);
+	break;
+
+      case OR_TOKEN:
+	compile_binary (SLANG_OR);
+	break;
+
+      case NOT_TOKEN:
+	compile_unary (SLANG_NOT, _SLANG_BC_UNARY);
+	break;
+
+      case BNOT_TOKEN:
+	compile_unary (SLANG_BNOT, _SLANG_BC_UNARY);
+	break;
+
+      case MUL2_TOKEN:
+	compile_unary (SLANG_MUL2, _SLANG_BC_UNARY_FUNC);
+	break;
+
+      case CHS_TOKEN:
+	compile_unary (SLANG_CHS, _SLANG_BC_UNARY_FUNC);
+	break;
+
+      case ABS_TOKEN:
+	compile_unary (SLANG_ABS, _SLANG_BC_UNARY_FUNC);
+	break;
+
+      case SQR_TOKEN:
+	compile_unary (SLANG_SQR, _SLANG_BC_UNARY_FUNC);
+	break;
+
+      case SIGN_TOKEN:
+	compile_unary (SLANG_SIGN, _SLANG_BC_UNARY_FUNC);
+	break;
+
+      case BREAK_TOKEN:
+	compile_break (_SLANG_BC_BREAK, 1, 0, "break");
+	break;
+
+      case RETURN_TOKEN:
+	compile_break (_SLANG_BC_RETURN, 0, 1, "return");
+	break;
+
+      case CONT_TOKEN:
+	compile_break (_SLANG_BC_CONTINUE, 1, 0, "continue");
+	break;
+
+      case EXCH_TOKEN:
+	compile_break (_SLANG_BC_EXCH, 0, 0, "");   /* FIXME: Priority=low */
+	break;
+
+      case STATIC_TOKEN:
+	if (Lang_Defining_Function == 0)
+	  Compile_Mode_Function = compile_static_variable_mode;
+	else
+	  SLang_verror (SL_NOT_IMPLEMENTED, "static variables not permitted in functions");
+	break;
+
+      case PRIVATE_TOKEN:
+	if (Lang_Defining_Function == 0)
+	  Compile_Mode_Function = compile_private_variable_mode;
+	else
+	  SLang_verror (SL_NOT_IMPLEMENTED, "private variables not permitted in functions");
+	break;
+
+      case PUBLIC_TOKEN:
+	if (Lang_Defining_Function == 0)
+	  Compile_Mode_Function = compile_public_variable_mode;
+	else
+	  SLang_verror (SL_NOT_IMPLEMENTED, "public variables not permitted in functions");
+	break;
+
+      case OBRACKET_TOKEN:
+	if (Lang_Defining_Function == 0)
+	  Compile_Mode_Function = Default_Variable_Mode;
+	else
+	  Compile_Mode_Function = compile_local_variable_mode;
+	break;
+
+      case OPAREN_TOKEN:
+	lang_begin_function ();
+	break;
+
+      case DEFINE_STATIC_TOKEN:
+	if (Lang_Defining_Function)
+	  define_static_function (t->v.s_val, t->hash);
+	else SLang_Error = SL_SYNTAX_ERROR;
+	break;
+
+      case DEFINE_PRIVATE_TOKEN:
+	if (Lang_Defining_Function)
+	  define_private_function (t->v.s_val, t->hash);
+	else SLang_Error = SL_SYNTAX_ERROR;
+	break;
+
+      case DEFINE_PUBLIC_TOKEN:
+	if (Lang_Defining_Function)
+	  define_public_function (t->v.s_val, t->hash);
+	else SLang_Error = SL_SYNTAX_ERROR;
+	break;
+
+      case DEFINE_TOKEN:
+	if (Lang_Defining_Function)
+	  (*Default_Define_Function) (t->v.s_val, t->hash);
+	else
+	  SLang_Error = SL_SYNTAX_ERROR;
+	break;
+
+      case CPAREN_TOKEN:
+	if (Lang_Defining_Function)
+	  Compile_Mode_Function = compile_function_mode;
+	else SLang_Error = SL_SYNTAX_ERROR;
+	break;
+
+      case CBRACE_TOKEN:
+	lang_end_block ();
+	Compile_Mode_Function = compile_directive_mode;
+	break;
+
+      case OBRACE_TOKEN:
+	lang_begin_block ();
+	break;
+
+      case FARG_TOKEN:
+	Function_Args_Number = Local_Variable_Number;
+	break;
+
+#if _SLANG_HAS_DEBUG_CODE
+      case LINE_NUM_TOKEN:
+	Compile_ByteCode_Ptr->bc_main_type = _SLANG_BC_LINE_NUM;
+	Compile_ByteCode_Ptr->b.l_blk = t->v.long_val;
+	lang_try_now ();
+	break;
+#endif
+      case POUND_TOKEN:
+	compile_call_direct (_SLarray_matrix_multiply, _SLANG_BC_CALL_DIRECT);
+	break;
+     }
+}
+
+void _SLcompile (_SLang_Token_Type *t)
+{
+   if (SLang_Error == 0)
+     {
+	if (Compile_Mode_Function != compile_basic_token_mode)
+	  {
+	     if (Compile_Mode_Function == NULL)
+	       Compile_Mode_Function = compile_basic_token_mode;
+#if _SLANG_HAS_DEBUG_CODE
+	     if (t->type == LINE_NUM_TOKEN)
+	       {
+		  compile_basic_token_mode (t);
+		  return;
+	       }
+#endif
+	  }
+
+	(*Compile_Mode_Function) (t);
+     }
+
+   if (SLang_Error)
+     {
+	Compile_Mode_Function = compile_basic_token_mode;
+	SLang_restart (0);
+     }
+}
+
+void (*_SLcompile_ptr)(_SLang_Token_Type *) = _SLcompile;
+
+typedef struct _Compile_Context_Type
+{
+   struct _Compile_Context_Type *next;
+   SLang_NameSpace_Type *static_namespace;
+   void (*compile_variable_mode) (_SLang_Token_Type *);
+   void (*define_function) (char *, unsigned long);
+   int lang_defining_function;
+   int local_variable_number;
+   unsigned int function_args_number;
+   SLang_Name_Type **locals_hash_table;
+   void (*compile_mode_function)(_SLang_Token_Type *);
+#if _SLANG_HAS_DEBUG_CODE
+   char *compile_filename;
+#endif
+}
+Compile_Context_Type;
+
+static Compile_Context_Type *Compile_Context_Stack;
+
+/* The only way the push/pop_context functions can get called is via
+ * an eval type function.  That can only happen when executed from a
+ * top level block.  This means that Compile_ByteCode_Ptr can always be
+ * rest back to the beginning of a block.
+ */
+
+static int pop_compile_context (void)
+{
+   Compile_Context_Type *cc;
+
+   if (NULL == (cc = Compile_Context_Stack))
+     return -1;
+
+   This_Static_NameSpace = cc->static_namespace;
+   Compile_Context_Stack = cc->next;
+   Default_Variable_Mode = cc->compile_variable_mode;
+   Default_Define_Function = cc->define_function;
+   Compile_Mode_Function = cc->compile_mode_function;
+
+   Lang_Defining_Function = cc->lang_defining_function;
+   Local_Variable_Number = cc->local_variable_number;
+   Function_Args_Number = cc->function_args_number;
+
+#if _SLANG_HAS_DEBUG_CODE
+   SLang_free_slstring (This_Compile_Filename);
+   This_Compile_Filename = cc->compile_filename;
+#endif
+
+   SLfree ((char *) Locals_Hash_Table);
+   Locals_Hash_Table = cc->locals_hash_table;
+
+   SLfree ((char *) cc);
+
+   return 0;
+}
+
+static int push_compile_context (char *name)
+{
+   Compile_Context_Type *cc;
+   SLang_Name_Type **lns;
+
+   cc = (Compile_Context_Type *)SLmalloc (sizeof (Compile_Context_Type));
+   if (cc == NULL)
+     return -1;
+   memset ((char *) cc, 0, sizeof (Compile_Context_Type));
+
+   lns = (SLang_Name_Type **) SLcalloc (sizeof (SLang_Name_Type *), SLLOCALS_HASH_TABLE_SIZE);
+   if (lns == NULL)
+     {
+	SLfree ((char *) cc);
+	return -1;
+     }
+
+#if _SLANG_HAS_DEBUG_CODE
+   if ((name != NULL)
+       && (NULL == (name = SLang_create_slstring (name))))
+     {
+	SLfree ((char *) cc);
+	SLfree ((char *) lns);
+	return -1;
+     }
+		
+   cc->compile_filename = This_Compile_Filename;
+   This_Compile_Filename = name;
+#endif
+
+   cc->static_namespace = This_Static_NameSpace;
+   cc->compile_variable_mode = Default_Variable_Mode;
+   cc->define_function = Default_Define_Function;
+   cc->locals_hash_table = Locals_Hash_Table;
+
+   cc->lang_defining_function = Lang_Defining_Function;
+   cc->local_variable_number = Local_Variable_Number;
+   cc->function_args_number = Function_Args_Number;
+   cc->locals_hash_table = Locals_Hash_Table;
+   cc->compile_mode_function = Compile_Mode_Function;
+
+   cc->next = Compile_Context_Stack;
+   Compile_Context_Stack = cc;
+
+   Compile_Mode_Function = compile_basic_token_mode;
+   Default_Variable_Mode = compile_public_variable_mode;
+   Default_Define_Function = define_public_function;
+   Lang_Defining_Function = 0;
+   Local_Variable_Number = 0;
+   Function_Args_Number = 0;
+   Locals_Hash_Table = lns;
+   return 0;
+}
+
+static int init_interpreter (void)
+{
+   SLang_NameSpace_Type *ns;
+
+   if (Global_NameSpace != NULL)
+     return 0;
+
+   if (NULL == (ns = _SLns_allocate_namespace ("***GLOBAL***", SLGLOBALS_HASH_TABLE_SIZE)))
+     return -1;
+   if (-1 == _SLns_set_namespace_name (ns, "Global"))
+     return -1;
+   Global_NameSpace = ns;
+
+   _SLRun_Stack = (SLang_Object_Type *) SLcalloc (SLANG_MAX_STACK_LEN,
+						  sizeof (SLang_Object_Type));
+   if (_SLRun_Stack == NULL)
+     return -1;
+
+   _SLStack_Pointer = _SLRun_Stack;
+   _SLStack_Pointer_Max = _SLRun_Stack + SLANG_MAX_STACK_LEN;
+
+   SLShort_Blocks[0].bc_main_type = _SLANG_BC_RETURN;
+   SLShort_Blocks[2].bc_main_type = _SLANG_BC_BREAK;
+   SLShort_Blocks[4].bc_main_type = _SLANG_BC_CONTINUE;
+
+   Num_Args_Stack = (int *) SLmalloc (sizeof (int) * SLANG_MAX_RECURSIVE_DEPTH);
+   if (Num_Args_Stack == NULL)
+     {
+	SLfree ((char *) _SLRun_Stack);
+	return -1;
+     }
+   Recursion_Depth = 0;
+   Frame_Pointer_Stack = (unsigned int *) SLmalloc (sizeof (unsigned int) * SLANG_MAX_RECURSIVE_DEPTH);
+   if (Frame_Pointer_Stack == NULL)
+     {
+	SLfree ((char *) _SLRun_Stack);
+	SLfree ((char *)Num_Args_Stack);
+	return -1;
+     }
+   Frame_Pointer_Depth = 0;
+   Frame_Pointer = _SLRun_Stack;
+
+   Default_Variable_Mode = compile_public_variable_mode;
+   Default_Define_Function = define_public_function;
+   return 0;
+}
+
+static int add_generic_table (SLang_NameSpace_Type *ns,
+			      SLang_Name_Type *table, char *pp_name,
+			      unsigned int entry_len)
+{
+   SLang_Name_Type *t, **ns_table;
+   char *name;
+   unsigned int table_size;
+   
+   if (-1 == init_interpreter ())
+     return -1;
+   
+   if (ns == NULL) 
+     ns = Global_NameSpace;
+   
+   ns_table = ns->table;
+   table_size = ns->table_size;
+	
+   if ((pp_name != NULL)
+       && (-1 == SLdefine_for_ifdef (pp_name)))
+     return -1;
+
+   t = table;
+   while (NULL != (name = t->name))
+     {
+	unsigned long hash;
+
+	/* Backward compatibility: '.' WAS used as hash marker */
+	if (*name == '.')
+	  {
+	     name++;
+	     t->name = name;
+	  }
+
+	if (NULL == (name = SLang_create_slstring (name)))
+	  return -1;
+
+	t->name = name;
+
+	hash = _SLcompute_string_hash (name);
+	hash = hash % table_size;
+
+	t->next = ns_table [(unsigned int) hash];
+	ns_table [(unsigned int) hash] = t;
+
+	t = (SLang_Name_Type *) ((char *)t + entry_len);
+     }
+
+   return 0;
+}
+
+int SLadd_intrin_fun_table (SLang_Intrin_Fun_Type *tbl, char *pp)
+{
+   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Intrin_Fun_Type));
+}
+
+int SLadd_intrin_var_table (SLang_Intrin_Var_Type *tbl, char *pp)
+{
+   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Intrin_Var_Type));
+}
+
+int SLadd_app_unary_table (SLang_App_Unary_Type *tbl, char *pp)
+{
+   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_App_Unary_Type));
+}
+
+int SLadd_math_unary_table (SLang_Math_Unary_Type *tbl, char *pp)
+{
+   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Math_Unary_Type));
+}
+
+int SLadd_iconstant_table (SLang_IConstant_Type *tbl, char *pp)
+{
+   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_IConstant_Type));
+}
+
+#if SLANG_HAS_FLOAT
+int SLadd_dconstant_table (SLang_DConstant_Type *tbl, char *pp)
+{
+   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_DConstant_Type));
+}
+#endif
+
+/* ----------- */
+int SLns_add_intrin_fun_table (SLang_NameSpace_Type *ns, SLang_Intrin_Fun_Type *tbl, char *pp)
+{
+   return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Intrin_Fun_Type));
+}
+
+int SLns_add_intrin_var_table (SLang_NameSpace_Type *ns, SLang_Intrin_Var_Type *tbl, char *pp)
+{
+   return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Intrin_Var_Type));
+}
+
+int SLns_add_app_unary_table (SLang_NameSpace_Type *ns, SLang_App_Unary_Type *tbl, char *pp)
+{
+   return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_App_Unary_Type));
+}
+
+int SLns_add_math_unary_table (SLang_NameSpace_Type *ns, SLang_Math_Unary_Type *tbl, char *pp)
+{
+   return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Math_Unary_Type));
+}
+
+int SLns_add_iconstant_table (SLang_NameSpace_Type *ns, SLang_IConstant_Type *tbl, char *pp)
+{
+   return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_IConstant_Type));
+}
+
+#if SLANG_HAS_FLOAT
+int SLns_add_dconstant_table (SLang_NameSpace_Type *ns, SLang_DConstant_Type *tbl, char *pp)
+{
+   return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_DConstant_Type));
+}
+#endif
+
+/* what is a bitmapped value:
+ * 1 intrin fun
+ * 2 user fun
+ * 4 intrin var
+ * 8 user defined var
+ */
+SLang_Array_Type *_SLang_apropos (char *namespace_name, char *pat, unsigned int what)
+{
+   SLang_NameSpace_Type *ns;
+
+   if (namespace_name == NULL)
+     namespace_name = "Global";
+
+   if (*namespace_name == 0)
+     ns = This_Static_NameSpace;
+   else ns = _SLns_find_namespace (namespace_name);
+
+   return _SLnspace_apropos (ns, pat, what);
+}
+
+void _SLang_implements_intrinsic (char *name)
+{
+   if (This_Static_NameSpace == NULL)
+     {
+	SLang_verror (SL_INTRINSIC_ERROR, "No namespace available");
+	return;
+     }
+
+   (void) _SLns_set_namespace_name (This_Static_NameSpace, name);
+
+   Default_Define_Function = define_static_function;
+   Default_Variable_Mode = compile_static_variable_mode;
+}
+
+void _SLang_use_namespace_intrinsic (char *name)
+{
+   SLang_NameSpace_Type *ns;
+   
+   if (NULL == (ns = _SLns_find_namespace (name)))
+     {
+	SLang_verror (SL_INTRINSIC_ERROR, "Namespace %s does not exist", name);
+	return;
+     }
+   This_Static_NameSpace = ns;
+   if (Global_NameSpace == ns)
+     {
+	Default_Define_Function = define_public_function;
+	Default_Variable_Mode = compile_public_variable_mode;
+     }
+   else
+     {
+	Default_Define_Function = define_static_function;
+	Default_Variable_Mode = compile_static_variable_mode;
+     }
+}
+
+
+char *_SLang_cur_namespace_intrinsic (void)
+{
+   if (This_Static_NameSpace == NULL)
+     return "Global";
+
+   if (This_Static_NameSpace->namespace_name == NULL)
+     return "";
+   
+   return This_Static_NameSpace->namespace_name;
+}