xref: /dports/devel/libslang2/slang-2.3.2/src/slang.c

/* -*- mode: C; mode: fold; -*- */
/* slang.c  --- guts of S-Lang interpreter */
/*
Copyright (C) 2004-2017,2018 John E. Davis

This file is part of the S-Lang Library.

The S-Lang Library is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.

The S-Lang Library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
USA.
*/

#include "slinclud.h"

#if SLANG_HAS_FLOAT
# include <math.h>
#endif

#include "slang.h"
#include "_slang.h"

#if SLANG_OPTIMIZE_FOR_SPEED
# define USE_COMBINED_BYTECODES		1
#else
# define USE_COMBINED_BYTECODES		0
#endif

#define USE_UNUSED_BYCODES_IN_SWITCH	1

struct _pSLBlock_Type;

typedef struct
{
   struct _pSLBlock_Type *body;
   unsigned int num_refs;

   SLFUTURE_CONST char *file;
#define SLANG_MAX_LOCAL_VARIABLES 255
   unsigned char nlocals;	       /* number of local variables */
   unsigned char nargs;		       /* number of arguments */
   char **local_variables;
   SLang_NameSpace_Type *static_ns;  /* namespace containing this function */
   SLang_NameSpace_Type *private_ns;  /* private namespace where this function was declared */
#if SLANG_HAS_BOSEOS
   int issue_bofeof_info;
#endif
}
Function_Header_Type;

typedef struct
{
   SLFUTURE_CONST char *name;
   SLang_Name_Type *next;
   char name_type;

   /* If header is NULL, then the autoload_file field will be used.  The file
    * is to be loaded into the ns namespace.
    */
   Function_Header_Type *header;    /* body of function */
   SLFUTURE_CONST char *autoload_file;
   SLang_NameSpace_Type *autoload_ns;
}
_pSLang_Function_Type;
static char *Local_Variable_Names[SLANG_MAX_LOCAL_VARIABLES];

typedef struct
{
   char *name;
   SLang_Name_Type *next;
   char name_type;

   int local_var_number;
}
SLang_Local_Var_Type;

#if SLANG_HAS_DEBUG_CODE
typedef struct
{
   int linenum;
   char *filename;
}
Linenum_Info_Type;
#endif

typedef struct _pSLBlock_Type
{
   _pSLang_BC_Type bc_main_type;
   unsigned char bc_sub_type;	       /* no types greater than 255 allowed here */
   unsigned char bc_flags;
#define BC_LITERAL_MASK 0x1	       /* if object is a literal */

   unsigned short linenum;
   union
     {
	struct _pSLBlock_Type *blk;
	int i_blk;

	SLang_Name_Type *nt_blk;
	SLang_App_Unary_Type *nt_unary_blk;
	SLang_Arith_Binary_Type *nt_binary_blk;
	SLang_Intrin_Var_Type *nt_ivar_blk;
	SLang_Intrin_Fun_Type *nt_ifun_blk;
	SLang_Global_Var_Type *nt_gvar_blk;
	SLang_HConstant_Type *hconst_blk;
	SLang_IConstant_Type *iconst_blk;
	SLang_LConstant_Type *lconst_blk;
	SLang_FConstant_Type *fconst_blk;
	SLang_DConstant_Type *dconst_blk;
#ifdef HAVE_LONG_LONG
	_pSLang_LLConstant_Type *llconst_blk;
#endif
	_pSLang_Function_Type *nt_fun_blk;

	VOID_STAR ptr_blk;
	SLFUTURE_CONST char *s_blk;
	SLang_BString_Type *bs_blk;

#if SLANG_HAS_FLOAT
	double *double_blk;		       /*literal double is a pointer */
#endif
#ifdef HAVE_LONG_LONG
	long long *llong_blk;
#endif
	float float_blk;
	long l_blk;
	struct _pSLang_Struct_Type *struct_blk;
	int (*call_function)(void);
#if SLANG_HAS_DEBUG_CODE
	Linenum_Info_Type *line_info;
#endif
     }
   b;
}
SLBlock_Type;

/* Debugging and tracing variables */

void (*SLang_Enter_Function)(SLFUTURE_CONST char *) = NULL;
void (*SLang_Exit_Function)(SLFUTURE_CONST char *) = NULL;
/* If non null, these call C functions before and after a slang function. */

int _pSLang_Trace = 0;
/* If _pSLang_Trace = -1, do not trace intrinsics */
static int Trace_Mode = 0;

static SLFUTURE_CONST char *Trace_Function;	       /* function to be traced */

int SLang_Traceback = SL_TB_PARTIAL;

#if SLANG_HAS_BOSEOS
static int BOS_Stack_Depth;
#endif

static SLFUTURE_CONST char *This_Compile_Filename;
static unsigned int This_Compile_Linenum;

/* These variables handle _NARGS processing by the parser */
int SLang_Num_Function_Args = 0;
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;

#if SLANG_HAS_QUALIFIERS
static SLang_Struct_Type *Next_Function_Qualifiers;
static SLang_Struct_Type *Function_Qualifiers;
static SLang_Struct_Type **Function_Qualifiers_Stack;
#endif

static _pSLang_Function_Type *Current_Function = NULL;
static Function_Header_Type *Current_Function_Header;

typedef struct
{
   _pSLang_Function_Type *function;
   Function_Header_Type *header;       /* could be different from function->header */
   SLang_Object_Type *local_variable_frame;
   SLang_NameSpace_Type *static_ns;
   SLang_NameSpace_Type *private_ns;
   /* file and line where function call occurs, 0 if no-info */
   SLCONST char *file;
   unsigned int line;
}
Function_Stack_Type;
static Function_Stack_Type *Function_Stack;
static Function_Stack_Type *Function_Stack_Ptr;
/* static Function_Stack_Type *Function_Stack_Ptr_Max; */

static SLang_NameSpace_Type *This_Private_NameSpace;
static SLang_NameSpace_Type *This_Static_NameSpace;
static SLang_NameSpace_Type *Global_NameSpace;
static SLang_NameSpace_Type *Locals_NameSpace;

static SLang_Name_Type *
  find_global_hashed_name (SLCONST char *, unsigned long,
			   SLang_NameSpace_Type *, SLang_NameSpace_Type *,
			   SLang_NameSpace_Type *, int);

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...
 *
 * Note that Lang_Break is positive when handling the break statements,
 * and is negative when handling continue-N forms.  The reason this variable
 * is involved is that continue-N is equivalent to break, break,...,continue.
 */
static int Lang_Break = 0;
static int Lang_Return = 0;
/* static int Lang_Continue = 0; */

static SLang_Object_Type *Run_Stack;
static SLang_Object_Type *Stack_Pointer;
static SLang_Object_Type *Stack_Pointer_Max;

static SLang_Object_Type *Local_Variable_Stack;
static SLang_Object_Type *Local_Variable_Stack_Max;
static SLang_Object_Type *Local_Variable_Frame;   /* points into Local_Variable_Stack */

#define INTERRUPT_ERROR		0x01
#define INTERRUPT_SIGNAL	0x02
static volatile int Handle_Interrupt;	       /* bitmapped value */
#define IS_SLANG_ERROR	(Handle_Interrupt & INTERRUPT_ERROR)

static void free_function_header (Function_Header_Type *);

#if SLANG_HAS_SIGNALS
static int check_signals (void);
#endif

#if SLANG_OPTIMIZE_FOR_SPEED
# define NUM_CLASSES 512		       /* must be large enough for built-ins */
static SLclass_Type The_Class_Types [NUM_CLASSES];
static SLang_Class_Type *The_Classes[NUM_CLASSES];

# define GET_CLASS_TYPE(x) \
   (((x) < NUM_CLASSES) ? The_Class_Types[(x)] : _pSLang_get_class_type(x))

void _pSLang_set_class_info (SLtype t, SLang_Class_Type *cl)
{
   if (t < NUM_CLASSES)
     {
	The_Class_Types[t] = cl->cl_class_type;
	The_Classes [t] = cl;
     }
}
# define GET_CLASS(cl,t) \
   if (((t)>=NUM_CLASSES) || (NULL == (cl = The_Classes[(t)]))) \
       cl = _pSLclass_get_class(t)
# define GET_BUILTIN_CLASS(cl,t) \
   if (NULL == (cl = The_Classes[(t)])) \
       cl = _pSLclass_get_class(t)
#else
# define GET_CLASS(cl,t) cl = _pSLclass_get_class(t)
# define GET_BUILTIN_CLASS(cl,t) cl = _pSLclass_get_class(t)
# define GET_CLASS_TYPE(t) _pSLclass_get_class(t)->cl_class_type
#endif

#if SLANG_OPTIMIZE_FOR_SPEED
SLclass_Type _pSLang_get_class_type (SLtype t)
{
   SLang_Class_Type *cl;
#if SLANG_OPTIMIZE_FOR_SPEED
   if (t < NUM_CLASSES)
     return The_Class_Types[t];
#endif
   cl = _pSLclass_get_class (t);
   return cl->cl_class_type;
}
#endif

/* If 0, not an arith type.  Otherwise it is.  Also, value implies precedence
 * See slarith.c for how this is used.
 */
static int Is_Arith_Type_Array [256];
#define IS_ARITH_TYPE(t) \
   (((t) < 256) ? Is_Arith_Type_Array[t] : 0)

static void do_traceback (SLCONST char *);
static void do_function_traceback (Function_Header_Type *, unsigned int);

static int init_interpreter (void);

/*{{{ push/pop/etc stack manipulation functions */

/* These routines are assumed to work even in the presence of a SLang_Error. */

_INLINE_ static int pop_object (SLang_Object_Type *x)
{
   register SLang_Object_Type *y;

   y = Stack_Pointer;
   IF_UNLIKELY(y == Run_Stack)
     {
	(void) SLang_set_error (SL_STACK_UNDERFLOW);
	x->o_data_type = 0;
	return -1;
     }
   y--;
   *x = *y;

   Stack_Pointer = y;
   return 0;
}

int SLang_pop (SLang_Object_Type *x)
{
   return pop_object (x);
}

#if 0
static int pop_2_objs (SLang_Object_Type *a, SLang_Object_Type *b)
{
   register SLang_Object_Type *y;

   y = Stack_Pointer;

   if (Run_Stack + 2 > y)
     {
	(void) SLang_set_error (SL_STACK_UNDERFLOW);
	a->o_data_type = 0;
	b->o_data_type = 0;
	SLdo_pop_n (y - Run_Stack);
	return -1;
     }
   *b = *(--y);
   *a = *(--y);
   Stack_Pointer = y;
   return 0;
}
#endif

/* This function pops the top of the stack to x[0], next to x[1], etc...  This is
 * backwards from what might be expected but this corresponds to the order of the local
 * variable stack.
 */
_INLINE_
static int pop_n_objs_reverse (SLang_Object_Type *x, unsigned int n)
{
   register SLang_Object_Type *y;
   unsigned int i;

   y = Stack_Pointer;

   if (Run_Stack + n > y)
     {
	(void) SLang_set_error (SL_STACK_UNDERFLOW);
	for (i = 0; i < n; i++)
	  x[i].o_data_type = 0;
	(void) SLdo_pop_n ((unsigned int) (y - Run_Stack));
	return -1;
     }

   for (i = 0; i < n; i++)
     {
	y--;
	x[i] = *y;
     }
   Stack_Pointer = y;
   return 0;
}

_INLINE_
static int peek_at_stack (void)
{
   IF_UNLIKELY(Stack_Pointer == Run_Stack)
     {
	(void) SLang_set_error (SL_STACK_UNDERFLOW);
	return -1;
     }

   return (int) (Stack_Pointer - 1)->o_data_type;
}

int SLang_peek_at_stack (void)
{
   return peek_at_stack ();
}

int _pSLang_peek_at_stack2 (SLtype *_typep)
{
   SLtype type;
   if (Stack_Pointer == Run_Stack)
     {
	(void) SLang_set_error (SL_STACK_UNDERFLOW);
	return -1;
     }

   type = (Stack_Pointer - 1)->o_data_type;
   if (type == SLANG_ARRAY_TYPE)
     *_typep = (Stack_Pointer - 1)->v.array_val->data_type;
   else
     *_typep = type;
   return (int) type;
}

int SLang_peek_at_stack_n (unsigned int n)
{
   unsigned int stklen = (unsigned int)(Stack_Pointer - Run_Stack);

   if (n >= stklen)
     {
	(void) SLang_set_error (SL_STACK_UNDERFLOW);
	return -1;
     }
   return (int) (Stack_Pointer - (n+1))->o_data_type;
}

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 = Stack_Pointer;
   IF_UNLIKELY(y == Run_Stack)
     {
	(void) SLang_set_error (SL_STACK_UNDERFLOW);
	return -1;
     }
   y--;

   type = (int) y->o_data_type;
   if (type == SLANG_INT_TYPE)
     {
	Stack_Pointer = y;
	*i = y->v.int_val;
	return 0;
     }
   if (type == SLANG_CHAR_TYPE)
     {
	Stack_Pointer = y;
	*i = y->v.char_val;
	return 0;
     }
#else
   if (-1 == (type = peek_at_stack ()))
     return -1;
#endif

   GET_CLASS(cl,type);
   if (cl->cl_to_bool == NULL)
     {
	_pSLang_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);
}

int SLang_peek_at_stack1_n (unsigned int n)
{
   int type;

   type = SLang_peek_at_stack_n (n);
   if (type == SLANG_ARRAY_TYPE)
     type = (Stack_Pointer - (n+1))->v.array_val->data_type;

   return type;
}

int SLang_peek_at_stack1 (void)
{
   return SLang_peek_at_stack1_n (0);
}

/* _INLINE_ */
static void free_object (SLang_Object_Type *obj, SLang_Class_Type *cl)
{
   if ((obj == NULL)
       || (cl->cl_class_type == SLANG_CLASS_TYPE_SCALAR))
     return;

#if SLANG_OPTIMIZE_FOR_SPEED
   if (obj->o_data_type == SLANG_STRING_TYPE)
     {
	_pSLang_free_slstring (obj->v.s_val);
	return;
     }
#endif
   (*cl->cl_destroy) (obj->o_data_type, (VOID_STAR) &obj->v);
}

void SLang_free_object (SLang_Object_Type *obj)
{
   SLtype data_type;
   SLang_Class_Type *cl;

   if (obj == NULL) return;
   data_type = obj->o_data_type;
   GET_CLASS(cl,data_type);
   free_object (obj, cl);
}

_INLINE_ static int push_object (SLang_Object_Type *x)
{
   register SLang_Object_Type *y;
   y = Stack_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_UNLIKELY(y >= Stack_Pointer_Max)
     {
	(void) SLang_set_error (SL_STACK_OVERFLOW);
	return -1;
     }

   *y = *x;
   Stack_Pointer = y + 1;
   return 0;
}

int SLang_push (SLang_Object_Type *x)
{
   return push_object (x);
}

/* _INLINE_ */
int SLclass_push_ptr_obj (SLtype type, VOID_STAR pval)
{
   register SLang_Object_Type *y;
   y = Stack_Pointer;

   IF_UNLIKELY(y >= Stack_Pointer_Max)
     {
	(void) SLang_set_error (SL_STACK_OVERFLOW);
	return -1;
     }

   y->o_data_type = type;
   y->v.ptr_val = pval;

   Stack_Pointer = y + 1;
   return 0;
}

_INLINE_ static int push_int_object (SLtype type, int x)
{
   register SLang_Object_Type *y;
   y = Stack_Pointer;

   IF_UNLIKELY(y >= Stack_Pointer_Max)
     {
	(void) SLang_set_error (SL_STACK_OVERFLOW);
	return -1;
     }

   y->o_data_type = type;
   y->v.int_val = x;

   Stack_Pointer = y + 1;
   return 0;
}

#if (SLANG_ARRAY_INDEX_TYPE == SLANG_INT_TYPE)
# define push_array_index push_int_object
#else
_INLINE_ static int push_array_index (SLtype type, SLindex_Type x)
{
   register SLang_Object_Type *y;
   y = Stack_Pointer;

   IF_UNLIKELY(y >= Stack_Pointer_Max)
     {
	(void) SLang_set_error (SL_STACK_OVERFLOW);
	return -1;
     }

   y->o_data_type = type;
   y->v.index_val = x;

   Stack_Pointer = y + 1;
   return 0;
}
#endif

int SLclass_push_int_obj (SLtype type, int x)
{
   return push_int_object (type, x);
}

int _pSLang_push_array (SLang_Array_Type *at, int free_array)
{
   register SLang_Object_Type *y;

   y = Stack_Pointer;

   IF_UNLIKELY(y >= Stack_Pointer_Max)
     {
	(void) SLang_set_error (SL_STACK_OVERFLOW);
	if (free_array) SLang_free_array (at);
	return -1;
     }

   if (free_array == 0) at->num_refs++;
   y->o_data_type = SLANG_ARRAY_TYPE;
   y->v.ptr_val = (VOID_STAR)at;

   Stack_Pointer = y + 1;
   return 0;
}

#if SLANG_HAS_FLOAT
_INLINE_ static int push_double_object (SLtype type, double x)
{
   register SLang_Object_Type *y;
   y = Stack_Pointer;

   IF_UNLIKELY(y >= Stack_Pointer_Max)
     {
	(void) SLang_set_error (SL_STACK_OVERFLOW);
	return -1;
     }

   y->o_data_type = type;
   y->v.double_val = x;

   Stack_Pointer = y + 1;
   return 0;
}

int SLclass_push_double_obj (SLtype type, double x)
{
   return push_double_object (type, x);
}
#endif

_INLINE_ static int push_char_object (SLtype type, char x)
{
   register SLang_Object_Type *y;
   y = Stack_Pointer;

   IF_UNLIKELY(y >= Stack_Pointer_Max)
     {
	(void) SLang_set_error (SL_STACK_OVERFLOW);
	return -1;
     }

   y->o_data_type = type;
   y->v.char_val = x;

   Stack_Pointer = y + 1;
   return 0;
}

int SLclass_push_char_obj (SLtype type, char x)
{
   return push_char_object (type, x);
}

/* This function is "fragile".  It is a helper routine and assumes that y is on the stack */
static int _typecast_object_to_type (SLang_Object_Type *y, SLang_Object_Type *obj, SLtype type, int allow_arrays)
{
#if SLANG_OPTIMIZE_FOR_SPEED
   /* This is an implicit typecast.  We do not want to typecast
    * floats to ints implicitly.
    */
   if (IS_ARITH_TYPE(type)
       && IS_ARITH_TYPE(y->o_data_type)
       && (type >= y->o_data_type))
     {
	/* This should not fail */
	(void) _pSLarith_typecast (y->o_data_type, (VOID_STAR)&y->v, 1,
				   type, (VOID_STAR)&obj->v);
	obj->o_data_type = type;
	return 0;
     }
#endif
   if ((allow_arrays == 0)
       || (y->o_data_type != SLANG_ARRAY_TYPE)
       || (y->v.array_val->data_type != type))
     {
	if (-1 == SLclass_typecast (type, 1, 0))
	  return -1;
     }

   /* Here, *y has been replaced by the object of the specified type */
   *obj = *y;
   return 0;
}

_INLINE_
  static int pop_int (int *i)
{
   SLang_Object_Type *y;
   SLang_Object_Type obj;

   y = Stack_Pointer;
   IF_UNLIKELY(y == Run_Stack)
     return SLang_pop(&obj);	       /* let it fail */
   y--;
   if (y->o_data_type == SLANG_INT_TYPE)
     {
	*i = y->v.int_val;
	Stack_Pointer = y;
	return 0;
     }
   if (-1 == _typecast_object_to_type (y, &obj, SLANG_INT_TYPE, 0))
     {
	/* Stack_Pointer = y; */
	return -1;
     }
   *i = obj.v.int_val;
   Stack_Pointer = y;
   return 0;
}

int SLang_pop_int (int *i)
{
   return pop_int (i);
}

int SLang_pop_array_index (SLindex_Type *i)
{
   SLang_Object_Type *y;
   SLang_Object_Type obj;

   y = Stack_Pointer;
   if (y == Run_Stack)
     return SLang_pop (&obj);	       /* let it fail */
   y--;
   if (y->o_data_type == SLANG_ARRAY_INDEX_TYPE)
     {
	*i = y->v.index_val;
	Stack_Pointer = y;
	return 0;
     }
   if (-1 == _typecast_object_to_type (y, &obj, SLANG_ARRAY_INDEX_TYPE, 0))
     {
	/* Stack_Pointer = y; */
	return -1;
     }
   *i = obj.v.index_val;
   Stack_Pointer = y;
   return 0;
}

int SLang_push_array_index (SLindex_Type i)
{
   return push_array_index (SLANG_ARRAY_INDEX_TYPE, i);
}

_INLINE_ static int pop_object_of_type (SLtype type, SLang_Object_Type *obj,
					int allow_arrays)
{
   register SLang_Object_Type *y;

   y = Stack_Pointer;
   IF_UNLIKELY(y == Run_Stack)
     return SLang_pop(obj);	       /* let it fail */
   y--;
   if (y->o_data_type == type)
     {
	*obj = *y;
	Stack_Pointer = y;
	return 0;
     }
   if (-1 == _typecast_object_to_type (y, obj, type, allow_arrays))
     {
	/* Stack_Pointer = y; */
	return -1;
     }
   Stack_Pointer = y;
   return 0;
}

int SLclass_pop_ptr_obj (SLtype type, VOID_STAR *s)
{
   SLang_Object_Type obj;

   if (-1 == pop_object_of_type (type, &obj, 0))
     {
	*s = (VOID_STAR) NULL;
	return -1;
     }
   *s = obj.v.ptr_val;
   return 0;
}

int _pSLang_pop_object_of_type (SLtype type, SLang_Object_Type *obj,
			       int allow_arrays)
{
   return pop_object_of_type (type, obj, allow_arrays);
}

/*  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 = Stack_Pointer;
   if ((n > otop - Run_Stack) || (n < 0))
     {
	(void) SLang_set_error (SL_STACK_UNDERFLOW);
	return -1;
     }
   obot = otop - n;
   otop--;
   while (otop > obot)
     {
	tmp = *obot;
	*obot = *otop;
	*otop = tmp;
	otop--;
	obot++;
     }
   return (int) ((Stack_Pointer - n) - Run_Stack);
}

/* _INLINE_ */
static int roll_stack (int np)
{
   int n, i;
   SLang_Object_Type *otop, *obot, tmp;

   if ((n = abs(np)) <= 1) return 0;    /* identity */

   obot = otop = Stack_Pointer;
   i = n;
   while (i != 0)
     {
	if (obot <= Run_Stack)
	  {
	     (void) SLang_set_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 SLroll_stack (int np)
{
   return roll_stack (np);
}

int SLstack_exch (unsigned int a, unsigned int b)
{
   SLang_Object_Type *ap, *bp;
   SLang_Object_Type tmp;
   unsigned int stklen = (unsigned int)(Stack_Pointer - Run_Stack);

   if ((a >= stklen) || (b >= stklen))
     {
	(void) SLang_set_error (SL_STACK_UNDERFLOW);
	return -1;
     }
   ap = Stack_Pointer - (a+1);
   bp = Stack_Pointer - (b+1);

   tmp = *ap;
   *ap = *bp;
   *bp = tmp;

   return 0;
}

int SLstack_depth (void)
{
   return (int) (Stack_Pointer - Run_Stack);
}

int SLdup_n (int n)
{
   SLang_Object_Type *bot, *top;

   if (n <= 0)
     return 0;

   top = Stack_Pointer;
   if (top < Run_Stack + n)
     {
	(void) SLang_set_error (SL_STACK_UNDERFLOW);
	return -1;
     }
   if (top + n > Stack_Pointer_Max)
     {
	(void) SLang_set_error (SL_STACK_OVERFLOW);
	return -1;
     }
   bot = top - n;

   while (bot < top)
     {
	SLang_Class_Type *cl;
	SLtype data_type = bot->o_data_type;

#if SLANG_OPTIMIZE_FOR_SPEED
	if (SLANG_CLASS_TYPE_SCALAR == GET_CLASS_TYPE(data_type))
	  {
	     *Stack_Pointer++ = *bot++;
	     continue;
	  }
#endif
	GET_CLASS(cl,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 _pSL_increment_frame_pointer (void)
{
   IF_UNLIKELY(Recursion_Depth >= SLANG_MAX_RECURSIVE_DEPTH)
     {
#if SLANG_HAS_QUALIFIERS
	if (Next_Function_Qualifiers != NULL)
	  {
	     SLang_free_struct (Next_Function_Qualifiers);
	     Next_Function_Qualifiers = NULL;
	  }
#endif
	_pSLang_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;
#if SLANG_HAS_QUALIFIERS
   Function_Qualifiers_Stack[Recursion_Depth] = Function_Qualifiers;
   Function_Qualifiers = Next_Function_Qualifiers;
   Next_Function_Qualifiers = NULL;
#endif
   Recursion_Depth++;
   return 0;
}

_INLINE_
int _pSL_decrement_frame_pointer (void)
{
#if SLANG_HAS_QUALIFIERS
   if (Function_Qualifiers != NULL)
     {
	SLang_free_struct (Function_Qualifiers);
	Function_Qualifiers = NULL;
     }
#endif
   IF_UNLIKELY(Recursion_Depth == 0)
     {
	_pSLang_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];
#if SLANG_HAS_QUALIFIERS
	Function_Qualifiers = Function_Qualifiers_Stack[Recursion_Depth];
#endif
     }
   return 0;
}

static int decrement_slang_frame_pointer (void)
{
   Function_Stack_Type *s;

   if (-1 == _pSL_decrement_frame_pointer ())
     return -1;

   Function_Stack_Ptr--;
   s = Function_Stack_Ptr;
   Current_Function = s->function;
   Current_Function_Header = s->header;
   This_Compile_Linenum = s->line;
   return 0;
}

static int increment_slang_frame_pointer (_pSLang_Function_Type *fun, unsigned int linenum)
{
   Function_Stack_Type *s;

   if (-1 == _pSL_increment_frame_pointer ())
     return -1;

   /* No need to check for stack underflow/overflow errors here since
    * this stack is the same size as the "frame pointer stack".
    */
   s = Function_Stack_Ptr++;
   s->function = Current_Function;
   s->header = Current_Function_Header;
   s->local_variable_frame = Local_Variable_Frame;
   s->line = linenum;
   if (Current_Function_Header != NULL)
     {
	s->file = Current_Function_Header->file;
	s->static_ns = Current_Function_Header->static_ns;
	s->private_ns = Current_Function_Header->private_ns;
     }
   else
     {
	s->file = This_Compile_Filename;
	s->static_ns = This_Static_NameSpace;
	s->private_ns = This_Private_NameSpace;
     }
   if (fun == NULL)
     return 0;			       /* called from SLexecute_function */

   if (fun->header == NULL)
     {
	if (fun->autoload_ns == NULL)
	  {
	     if (-1 == SLang_load_file(fun->autoload_file))
	       {
		  (void) decrement_slang_frame_pointer ();
		  return -1;
	       }
	  }
	else if (-1 == SLns_load_file (fun->autoload_file, fun->autoload_ns->namespace_name))
	  {
	     (void) decrement_slang_frame_pointer ();
	     return -1;
	  }

	if (NULL == fun->header)
	  {
	     _pSLang_verror (SL_UNDEFINED_NAME, "%s: Function did not autoload",
			   fun->name);
             (void) decrement_slang_frame_pointer ();
	     return -1;
	  }
     }
   Current_Function = fun;
   Current_Function_Header = fun->header;
   return 0;
}

#if SLANG_HAS_QUALIFIERS
static int set_qualifier (void)
{
   if (SLANG_NULL_TYPE == peek_at_stack ())
     {
	Next_Function_Qualifiers = NULL;
	return SLang_pop_null ();
     }
   return SLang_pop_struct (&Next_Function_Qualifiers);
}

/* This function is called from slang code */
int _pSLang_get_qualifiers_intrin (SLang_Struct_Type **qp)
{
   /* The assumption is that this is being called from a function one level up.
    * Grab the qualifiers from the previous frame stack.
    */
   if (Recursion_Depth > 1)
     *qp = Function_Qualifiers_Stack[Recursion_Depth-1];
   else
     *qp = NULL;

   return 0;
}

/* This may be called from intrinsic functions */
int SLang_qualifier_exists (SLCONST char *name)
{
   if (Function_Qualifiers == NULL)
     return 0;

   return (NULL != _pSLstruct_get_field_value (Function_Qualifiers, name));
}

/* returns -1 upon error, 0 if qualifier does not exist,
 * 1 if qualifier exists and has correct type,
 * 2 if qualifier had to be converted to requested type.
 * If 1, then use the first object pointer but do not free it.
 * If 2, then use the second object pointer and free it.
 */
static int check_qualifier (SLCONST char *name, SLtype t,
			    SLang_Object_Type **op, SLang_Object_Type *o)
{
   SLang_Object_Type *objp;

   if ((Function_Qualifiers == NULL)
       || (NULL == (objp = _pSLstruct_get_field_value (Function_Qualifiers, name)))
       || (objp->o_data_type == SLANG_NULL_TYPE)
      )
     {
	*op = NULL;
	return 0;
     }

   if (objp->o_data_type == t)
     {
	*op = objp;
	return 1;
     }

   if (-1 == _pSLpush_slang_obj (objp))
     return -1;

   if (-1 == pop_object_of_type (t, o, 0))
     {
	SLang_verror (0, "Expecting '%s' qualifier to be %s",
		      name, SLclass_get_datatype_name (t));
	return -1;
     }
   return 2;
}

int SLang_get_int_qualifier (SLCONST char *name, int *p, int def)
{
   SLang_Object_Type *objp;
   SLang_Object_Type obj;
   int status;

   status = check_qualifier (name, SLANG_INT_TYPE, &objp, &obj);
   if (status <= 0)
     {
	*p = def;
	return status;
     }
   if (status == 1)
     {
	*p = objp->v.int_val;
	return 0;
     }
   *p = obj.v.int_val;
   /* SLang_free_object (&obj); not necessary for scalars */
   return 0;
}

int SLang_get_long_qualifier (SLCONST char *name, long *p, long def)
{
   SLang_Object_Type *objp;
   SLang_Object_Type obj;
   int status;

   status = check_qualifier (name, SLANG_LONG_TYPE, &objp, &obj);
   if (status <= 0)
     {
	*p = def;
	return status;
     }
   if (status == 1)
     {
	*p = objp->v.long_val;
	return 0;
     }
   *p = obj.v.long_val;
   /* SLang_free_object (&obj); not necessary for scalars */
   return 0;
}

#if SLANG_HAS_FLOAT
int SLang_get_double_qualifier (SLCONST char *name, double *p, double def)
{
   SLang_Object_Type *objp;
   SLang_Object_Type obj;
   int status;

   status = check_qualifier (name, SLANG_DOUBLE_TYPE, &objp, &obj);
   if (status <= 0)
     {
	*p = def;
	return status;
     }
   if (status == 1)
     {
	*p = objp->v.double_val;
	return 0;
     }
   *p = obj.v.double_val;
   /* SLang_free_object (&obj); not necessary for scalars */
   return 0;
}
#endif

int SLang_get_string_qualifier (SLCONST char *name, char **p, SLFUTURE_CONST char *def)
{
   SLang_Object_Type *objp;
   SLang_Object_Type obj;
   int status;

   status = check_qualifier (name, SLANG_STRING_TYPE, &objp, &obj);
   if (status <= 0)
     {
	if (status == 0)
	  {
	     if ((def != NULL)
		 && (NULL == (def = SLang_create_slstring (def))))
	       status = -1;
	     else *p = (char *)def;
	  }
	return status;
     }

   if (status == 1)
     {
	if (NULL == (*p = SLang_create_slstring (objp->v.s_val)))
	  return -1;
	return 0;
     }

   *p = obj.v.s_val;
   /* SLang_free_object (&obj); not necessary, since we own v.s_val */
   return 0;
}
#endif

_INLINE_
static int start_arg_list (void)
{
   IF_LIKELY(Frame_Pointer_Depth < SLANG_MAX_RECURSIVE_DEPTH)
     {
	Frame_Pointer_Stack [Frame_Pointer_Depth] = (unsigned int) (Frame_Pointer - Run_Stack);
	Frame_Pointer = Stack_Pointer;
	Frame_Pointer_Depth++;
	Next_Function_Num_Args = 0;
	return 0;
     }

   _pSLang_verror (SL_STACK_OVERFLOW, "Frame Stack Overflow");
   return -1;
}

int SLang_start_arg_list (void)
{
   return start_arg_list ();
}

int _pSLang_restart_arg_list (int nargs)
{
   if (Frame_Pointer_Depth < SLANG_MAX_RECURSIVE_DEPTH)
     {
	if ((nargs < 0) || (Run_Stack + nargs > Stack_Pointer))
	  {
	     _pSLang_verror (SL_Internal_Error, "restart_arg_list: stack underflow");
	     return -1;
	  }
	Frame_Pointer_Stack [Frame_Pointer_Depth] = (unsigned int) (Frame_Pointer - Run_Stack);
	Frame_Pointer = Stack_Pointer - nargs;
	Frame_Pointer_Depth++;
	Next_Function_Num_Args = 0;
	return 0;
     }

   _pSLang_verror (SL_STACK_OVERFLOW, "Frame Stack Overflow");
   return -1;
}

_INLINE_ static int end_arg_list (void)
{
   IF_UNLIKELY(Frame_Pointer_Depth == 0)
     {
	_pSLang_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) (Stack_Pointer - Frame_Pointer);
	Frame_Pointer = Run_Stack + Frame_Pointer_Stack [Frame_Pointer_Depth];
     }
   return 0;
}

int SLang_end_arg_list (void)
{
   return end_arg_list ();
}

_INLINE_
static int do_bc_call_direct_frame (int (*f)(void))
{
   if ((0 == end_arg_list ())
       && (0 == _pSL_increment_frame_pointer ()))
     {
	(void) (*f) ();
	_pSL_decrement_frame_pointer ();
     }
   if (IS_SLANG_ERROR)
     return -1;
   return 0;
}

_INLINE_
static int do_bc_call_direct_nargs (int (*f)(void))
{
   if (0 == end_arg_list ())
     {
	int nargs = SLang_Num_Function_Args;

	SLang_Num_Function_Args = Next_Function_Num_Args;
	Next_Function_Num_Args = 0;
	(void) (*f) ();
	SLang_Num_Function_Args = nargs;
     }
   if (IS_SLANG_ERROR)
     return -1;
   return 0;
}

static int do_name_type_error (SLang_Name_Type *nt)
{
   if (nt != NULL)
     {
	char buf[256];
	(void) _pSLsnprintf (buf, sizeof (buf), "(Error occurred processing %s)", nt->name);
	do_traceback (buf);
     }
   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;
   SLtype b_data_type, a_data_type, c_data_type;
   int (*binary_fun) (int,
		      SLtype, VOID_STAR, SLuindex_Type,
		      SLtype, VOID_STAR, SLuindex_Type,
		      VOID_STAR);
   VOID_STAR pa;
   VOID_STAR pb;
   VOID_STAR pc;
   int ret;

   b_data_type = objb->o_data_type;
   a_data_type = obja->o_data_type;

#if SLANG_OPTIMIZE_FOR_SPEED
   if (IS_ARITH_TYPE(a_data_type)
       && IS_ARITH_TYPE(b_data_type))
     {
	int status;
	status = _pSLarith_bin_op (obja, objb, op);
	if (status != 1)
	  return status;
	/* drop and try it the hard way */
     }

   if (a_data_type == b_data_type)
     {
	if (a_data_type == SLANG_ARRAY_TYPE)
	  return _pSLarray_bin_op (obja, objb, op);

	if ((a_data_type == SLANG_STRING_TYPE)
	    && (op == SLANG_PLUS))
	  {
	     char *stra = obja->v.s_val, *strb = objb->v.s_val, *strc;

	     strc = SLang_concat_slstrings (stra, strb);
	     if (strc == NULL)
	       return -1;

	     return _pSLang_push_slstring (strc);   /* frees strc */
	  }
     }
#endif

   GET_CLASS(a_cl,a_data_type);
   if (a_data_type == b_data_type)
     b_cl = a_cl;
   else
     GET_CLASS(b_cl, b_data_type);

   if (NULL == (binary_fun = _pSLclass_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_VECTOR == a_cl->cl_class_type)
     pa = (VOID_STAR) obja->v.ptr_val;
   else
     pa = (VOID_STAR) &obja->v;
#else
   pa = _pSLclass_get_ptr_to_value (a_cl, obja);
#endif

#if SLANG_OPTIMIZE_FOR_SPEED
   if (SLANG_CLASS_TYPE_VECTOR == b_cl->cl_class_type)
     pb = (VOID_STAR) objb->v.ptr_val;
   else
     pb = (VOID_STAR) &objb->v;
#else
   pb = _pSLclass_get_ptr_to_value (b_cl, objb);
#endif

   pc = c_cl->cl_transfer_buf;

   if (1 != (*binary_fun) (op,
			   a_data_type, pa, 1,
			   b_data_type, pb, 1,
			   pc))
     {
	_pSLang_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 != c_cl->cl_class_type)
       && (SLANG_CLASS_TYPE_VECTOR != c_cl->cl_class_type))
#endif
     (*c_cl->cl_adestroy)(c_data_type, pc);

   return ret;
}

#if SLANG_OPTIMIZE_FOR_SPEED
static int int_int_binary_result (int op, SLang_Object_Type *obja, SLang_Object_Type *objb, SLang_Object_Type *objc)
{
   int a, b;

   a = obja->v.int_val; b = objb->v.int_val;
   switch (op)
     {
      case SLANG_PLUS:
	objc->v.int_val = a + b;  objc->o_data_type = SLANG_INT_TYPE;
	return 0;
      case SLANG_MINUS:
	objc->v.int_val = a - b;  objc->o_data_type = SLANG_INT_TYPE;
	return 0;
      case SLANG_TIMES:
	objc->v.int_val = a * b;  objc->o_data_type = SLANG_INT_TYPE;
	return 0;
      case SLANG_DIVIDE:
	if (b == 0)
	  {
	     SLang_set_error (SL_DIVIDE_ERROR);
	     return -1;
	  }
	objc->v.int_val = a/b;  objc->o_data_type = SLANG_INT_TYPE;
	return 0;
      case SLANG_MOD:
	if (b == 0)
	  {
	     SLang_set_error (SL_DIVIDE_ERROR);
	     return -1;
	  }
	objc->v.int_val = a % b;  objc->o_data_type = SLANG_INT_TYPE;
	return 0;

      case SLANG_BAND:
	objc->v.int_val = (a & b); objc->o_data_type = SLANG_INT_TYPE;
	return 0;
      case SLANG_BXOR:
	objc->v.int_val = (a ^ b); objc->o_data_type = SLANG_INT_TYPE;
	return 0;
      case SLANG_BOR:
	objc->v.int_val = (a | b); objc->o_data_type = SLANG_INT_TYPE;
	return 0;
      case SLANG_SHL:
	objc->v.int_val = (a << b); objc->o_data_type = SLANG_INT_TYPE;
	return 0;
      case SLANG_SHR:
	objc->v.int_val = (a >> b); objc->o_data_type = SLANG_INT_TYPE;
	return 0;

      case SLANG_EQ:
	objc->v.char_val = (a == b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_NE:
	objc->v.char_val = (a != b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_GT:
	objc->v.char_val = (a > b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_GE:
	objc->v.char_val = (a >= b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_LT:
	objc->v.char_val = (a < b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_LE:
	objc->v.char_val = (a <= b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
     }
   if (-1 == do_binary_ab (op, obja, objb))
     return -1;

   return pop_object (objc);
}

static int int_int_binary (int op, SLang_Object_Type *obja, SLang_Object_Type *objb)
{
   int a = obja->v.int_val;
   int b = objb->v.int_val;

   switch (op)
     {
      case SLANG_PLUS:
	return push_int_object (SLANG_INT_TYPE, a + b);
      case SLANG_MINUS:
	return push_int_object (SLANG_INT_TYPE, a - b);
      case SLANG_TIMES:
	return push_int_object (SLANG_INT_TYPE, a * b);
      case SLANG_DIVIDE:
	if (b == 0)
	  {
	     SLang_set_error (SL_DIVIDE_ERROR);
	     return -1;
	  }
	return push_int_object (SLANG_INT_TYPE, a/b);
      case SLANG_MOD:
	if (b == 0)
	  {
	     SLang_set_error (SL_DIVIDE_ERROR);
	     return -1;
	  }
	return push_int_object (SLANG_INT_TYPE, a%b);

      case SLANG_BAND:
	return push_int_object (SLANG_INT_TYPE, a&b);
      case SLANG_BXOR:
	return push_int_object (SLANG_INT_TYPE, a^b);
      case SLANG_BOR:
	return push_int_object (SLANG_INT_TYPE, a|b);
      case SLANG_SHL:
	return push_int_object (SLANG_INT_TYPE, a<<b);
      case SLANG_SHR:
	return push_int_object (SLANG_INT_TYPE, a>>b);

      case SLANG_EQ:
	return push_char_object (SLANG_CHAR_TYPE, a == b);
      case SLANG_NE:
	return push_char_object (SLANG_CHAR_TYPE, a != b);
      case SLANG_GT:
	return push_char_object (SLANG_CHAR_TYPE, a > b);
      case SLANG_GE:
	return push_char_object (SLANG_CHAR_TYPE, a >= b);
      case SLANG_LT:
	return push_char_object (SLANG_CHAR_TYPE, a < b);
      case SLANG_LE:
	return push_char_object (SLANG_CHAR_TYPE, a <= b);
     }
   return do_binary_ab (op, obja, objb);
}

#if SLANG_HAS_FLOAT
static int dbl_dbl_binary (int op, SLang_Object_Type *obja, SLang_Object_Type *objb)
{
   switch (op)
     {
      case SLANG_PLUS:
	return push_double_object (SLANG_DOUBLE_TYPE, obja->v.double_val + objb->v.double_val);
      case SLANG_MINUS:
	return push_double_object (SLANG_DOUBLE_TYPE, obja->v.double_val - objb->v.double_val);
      case SLANG_TIMES:
	return push_double_object (SLANG_DOUBLE_TYPE, obja->v.double_val * objb->v.double_val);
      case SLANG_DIVIDE:
	return push_double_object (SLANG_DOUBLE_TYPE, obja->v.double_val / objb->v.double_val);
      case SLANG_EQ:
	return push_char_object (SLANG_CHAR_TYPE, obja->v.double_val == objb->v.double_val);
      case SLANG_NE:
	return push_char_object (SLANG_CHAR_TYPE, obja->v.double_val != objb->v.double_val);
      case SLANG_GT:
	return push_char_object (SLANG_CHAR_TYPE, obja->v.double_val > objb->v.double_val);
      case SLANG_GE:
	return push_char_object (SLANG_CHAR_TYPE, obja->v.double_val >= objb->v.double_val);
      case SLANG_LT:
	return push_char_object (SLANG_CHAR_TYPE, obja->v.double_val < objb->v.double_val);
      case SLANG_LE:
	return push_char_object (SLANG_CHAR_TYPE, obja->v.double_val <= objb->v.double_val);
      case SLANG_POW:
	return push_double_object (SLANG_DOUBLE_TYPE, pow(obja->v.double_val, objb->v.double_val));
     }
   return do_binary_ab (op, obja, objb);
}

static int int_dbl_binary_result (int op, SLang_Object_Type *obja, SLang_Object_Type *objb, SLang_Object_Type *objc)
{
   int a = obja->v.int_val;
   double b = objb->v.double_val;

   switch (op)
     {
      case SLANG_PLUS:
	objc->v.double_val = a + b;  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
      case SLANG_MINUS:
	objc->v.double_val = a - b;  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
      case SLANG_TIMES:
	objc->v.double_val = a * b;  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
      case SLANG_DIVIDE:
	objc->v.double_val = a / b;  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
      case SLANG_EQ:
	objc->v.char_val = (a == b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_NE:
	objc->v.char_val = (a != b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_GT:
	objc->v.char_val = (a > b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_GE:
	objc->v.char_val = (a >= b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_LT:
	objc->v.char_val = (a < b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_LE:
	objc->v.char_val = (a <= b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_POW:
	objc->v.double_val = pow(a,b);  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
     }
   if (-1 == do_binary_ab (op, obja, objb))
     return -1;

   return pop_object (objc);
}

static int dbl_int_binary_result (int op, SLang_Object_Type *obja, SLang_Object_Type *objb, SLang_Object_Type *objc)
{
   double a = obja->v.double_val;
   int b = objb->v.int_val;

   switch (op)
     {
      case SLANG_PLUS:
	objc->v.double_val = a + b;  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
      case SLANG_MINUS:
	objc->v.double_val = a - b;  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
      case SLANG_TIMES:
	objc->v.double_val = a * b;  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
      case SLANG_DIVIDE:
	objc->v.double_val = a / b;  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
      case SLANG_EQ:
	objc->v.char_val = (a == b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_NE:
	objc->v.char_val = (a != b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_GT:
	objc->v.char_val = (a > b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_GE:
	objc->v.char_val = (a >= b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_LT:
	objc->v.char_val = (a < b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_LE:
	objc->v.char_val = (a <= b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_POW:
	objc->v.double_val = pow(a,b);  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
     }
   if (-1 == do_binary_ab (op, obja, objb))
     return -1;

   return pop_object (objc);
}

static int dbl_dbl_binary_result (int op, SLang_Object_Type *obja, SLang_Object_Type *objb, SLang_Object_Type *objc)
{
   double a = obja->v.double_val;
   double b = objb->v.double_val;

   switch (op)
     {
      case SLANG_PLUS:
	objc->v.double_val = a + b;  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
      case SLANG_MINUS:
	objc->v.double_val = a - b;  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
      case SLANG_TIMES:
	objc->v.double_val = a * b;  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
      case SLANG_DIVIDE:
	objc->v.double_val = a / b;  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
      case SLANG_EQ:
	objc->v.char_val = (a == b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_NE:
	objc->v.char_val = (a != b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_GT:
	objc->v.char_val = (a > b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_GE:
	objc->v.char_val = (a >= b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_LT:
	objc->v.char_val = (a < b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_LE:
	objc->v.char_val = (a <= b);  objc->o_data_type = SLANG_CHAR_TYPE;
	return 0;
      case SLANG_POW:
	objc->v.double_val = pow(a,b);  objc->o_data_type = SLANG_DOUBLE_TYPE;
	return 0;
     }
   if (-1 == do_binary_ab (op, obja, objb))
     return -1;

   return pop_object (objc);
}
#endif				       /* SLANG_HAS_FLOAT */
#endif				       /* SLANG_OPTIMIZE_FOR_SPEED */

int _pSLang_do_binary_ab (int op, SLang_Object_Type *obja, SLang_Object_Type *objb)
{
#if SLANG_OPTIMIZE_FOR_SPEED
   if (obja->o_data_type == objb->o_data_type)
     {
	if (obja->o_data_type == SLANG_INT_TYPE)
	  return int_int_binary (op, obja, objb);
#if SLANG_HAS_FLOAT
	if (obja->o_data_type == SLANG_DOUBLE_TYPE)
	  return dbl_dbl_binary (op, obja, objb);
#endif
     }
#endif
   return do_binary_ab (op, obja, objb);
}

#define INC_REF(cl,type,addr,dr) \
   if (cl->cl_inc_ref != NULL) (*cl->cl_inc_ref)(type,addr,dr)

/* _INLINE_ */
static int do_binary_ab_inc_ref (int op, SLang_Object_Type *obja, SLang_Object_Type *objb)
{
   int ret;
   SLang_Class_Type *cl_a, *cl_b;
   SLtype atype = obja->o_data_type;
   SLtype btype = objb->o_data_type;

   if (atype == SLANG_INT_TYPE)
     {
	if (btype == SLANG_INT_TYPE)
	  {
	     int a, b;

	     a = obja->v.int_val; b = objb->v.int_val;
	     switch (op)
	       {
		case SLANG_PLUS:
		  return push_int_object (SLANG_INT_TYPE, a+b);
		case SLANG_MINUS:
		  return push_int_object (SLANG_INT_TYPE, a-b);
		case SLANG_TIMES:
		  return push_int_object (SLANG_INT_TYPE, a*b);
		case SLANG_DIVIDE:
		  if (b == 0)
		    {
		       SLang_set_error (SL_DIVIDE_ERROR);
		       return -1;
		    }
		  return push_int_object (SLANG_INT_TYPE, a/b);
		case SLANG_MOD:
		  if (b == 0)
		    {
		       SLang_set_error (SL_DIVIDE_ERROR);
		       return -1;
		    }
		  return push_int_object (SLANG_INT_TYPE, a%b);

		case SLANG_BAND:
		  return push_int_object (SLANG_INT_TYPE, a&b);
		case SLANG_BXOR:
		  return push_int_object (SLANG_INT_TYPE, a^b);
		case SLANG_BOR:
		  return push_int_object (SLANG_INT_TYPE, a|b);
		case SLANG_SHL:
		  return push_int_object (SLANG_INT_TYPE, a<<b);
		case SLANG_SHR:
		  return push_int_object (SLANG_INT_TYPE, a>>b);

		case SLANG_EQ:
		  return push_char_object (SLANG_CHAR_TYPE, a==b);
		case SLANG_NE:
		  return push_char_object (SLANG_CHAR_TYPE, a!=b);
		case SLANG_GT:
		  return push_char_object (SLANG_CHAR_TYPE, a>b);
		case SLANG_GE:
		  return push_char_object (SLANG_CHAR_TYPE, a>=b);
		case SLANG_LT:
		  return push_char_object (SLANG_CHAR_TYPE, a<b);
		case SLANG_LE:
		  return push_char_object (SLANG_CHAR_TYPE, a<=b);
	       }
	     return do_binary_ab (op, obja, objb);
	  }
#if SLANG_HAS_FLOAT
	if (btype == SLANG_DOUBLE_TYPE)
	  {
	     int a;
	     double b;

	     a = obja->v.int_val; b = objb->v.double_val;
	     switch (op)
	       {
		case SLANG_PLUS:
		  return push_double_object (SLANG_DOUBLE_TYPE, a+b);
		case SLANG_MINUS:
		  return push_double_object (SLANG_DOUBLE_TYPE, a-b);
		case SLANG_TIMES:
		  return push_double_object (SLANG_DOUBLE_TYPE, a*b);
		case SLANG_DIVIDE:
		  return push_double_object (SLANG_DOUBLE_TYPE, a/b);
		case SLANG_EQ:
		  return push_char_object (SLANG_CHAR_TYPE, a==b);
		case SLANG_NE:
		  return push_char_object (SLANG_CHAR_TYPE, a!=b);
		case SLANG_GT:
		  return push_char_object (SLANG_CHAR_TYPE, a>b);
		case SLANG_GE:
		  return push_char_object (SLANG_CHAR_TYPE, a>=b);
		case SLANG_LT:
		  return push_char_object (SLANG_CHAR_TYPE, a<b);
		case SLANG_LE:
		  return push_char_object (SLANG_CHAR_TYPE, a<=b);
		case SLANG_POW:
		  return push_double_object (SLANG_DOUBLE_TYPE, pow(a, b));
	       }
	     return do_binary_ab (op, obja, objb);
	  }
#endif				       /* SLANG_HAS_FLOAT */
     }
#if SLANG_HAS_FLOAT
   else if (atype == SLANG_DOUBLE_TYPE)
     {
	double a, b;

	if (btype == SLANG_DOUBLE_TYPE)
	  b = objb->v.double_val;
	else if (btype == SLANG_INT_TYPE)
	  b = (double) objb->v.int_val;
	else
	  goto the_hard_way;

	a = obja->v.double_val;
	switch (op)
	  {
	   case SLANG_PLUS:
	     return push_double_object (SLANG_DOUBLE_TYPE, a+b);
	   case SLANG_MINUS:
	     return push_double_object (SLANG_DOUBLE_TYPE, a-b);
	   case SLANG_TIMES:
	     return push_double_object (SLANG_DOUBLE_TYPE, a*b);
	   case SLANG_DIVIDE:
	     return push_double_object (SLANG_DOUBLE_TYPE, a/b);
	   case SLANG_EQ:
	     return push_char_object (SLANG_CHAR_TYPE, a==b);
	   case SLANG_NE:
	     return push_char_object (SLANG_CHAR_TYPE, a!=b);
	   case SLANG_GT:
	     return push_char_object (SLANG_CHAR_TYPE, a>b);
	   case SLANG_GE:
	     return push_char_object (SLANG_CHAR_TYPE, a>=b);
	   case SLANG_LT:
	     return push_char_object (SLANG_CHAR_TYPE, a<b);
	   case SLANG_LE:
	     return push_char_object (SLANG_CHAR_TYPE, a<=b);
	   case SLANG_POW:
	     return push_double_object (SLANG_DOUBLE_TYPE, pow(a, b));
	  }
	return do_binary_ab (op, obja, objb);
     }
#endif				       /* SLANG_HAS_FLOAT */

the_hard_way:

   GET_CLASS(cl_a, atype);
   GET_CLASS(cl_b, btype);
   INC_REF(cl_a, atype, &obja->v, 1);
   INC_REF(cl_b, btype, &objb->v, 1);
   ret = do_binary_ab (op, obja, objb);
   INC_REF(cl_a, atype, &obja->v, -1);
   INC_REF(cl_b, btype, &objb->v, -1);

   return ret;
}

#if SLANG_OPTIMIZE_FOR_SPEED
/* Only for SLANG_BCST_ASSIGN */
/* _INLINE_ */
static int do_binary_ab_inc_ref_assign (int op, SLang_Object_Type *obja, SLang_Object_Type *objb, SLang_Object_Type *objc)
{
   int ret;
   SLang_Class_Type *cl, *cl_a, *cl_b;
   int c_needs_freed;
   SLtype atype, btype;

   GET_CLASS(cl, objc->o_data_type);
   c_needs_freed = (SLANG_CLASS_TYPE_SCALAR != cl->cl_class_type);

   atype = obja->o_data_type;
   btype = objb->o_data_type;

   if (atype == SLANG_INT_TYPE)
     {
	if (btype == SLANG_INT_TYPE)
	  {
	     if (c_needs_freed)
	       {
		  ret = int_int_binary (op, obja, objb);
		  goto the_return;
	       }
	     return int_int_binary_result (op, obja, objb, objc);
	  }
#if SLANG_HAS_FLOAT
	if (btype == SLANG_DOUBLE_TYPE)
	  {
	     if (c_needs_freed)
	       {
		  ret = do_binary_ab (op, obja, objb);
		  goto the_return;
	       }
	     return int_dbl_binary_result (op, obja, objb, objc);
	  }
#endif				       /* SLANG_HAS_FLOAT */
     }
#if SLANG_HAS_FLOAT
   else if (atype == SLANG_DOUBLE_TYPE)
     {
	if (btype == SLANG_DOUBLE_TYPE)
	  {
	     if (c_needs_freed)
	       {
		  ret = dbl_dbl_binary (op, obja, objb);
		  goto the_return;
	       }
	     return dbl_dbl_binary_result (op, obja, objb, objc);
	  }

	if (btype == SLANG_INT_TYPE)
	  {
	     if (c_needs_freed)
	       {
		  ret = do_binary_ab (op, obja, objb);
		  goto the_return;
	       }

	     return dbl_int_binary_result (op, obja, objb, objc);
	  }
     }
#endif				       /* SLANG_HAS_FLOAT */

   GET_CLASS(cl_a, atype);
   GET_CLASS(cl_b, btype);
   INC_REF(cl_a, atype, &obja->v, 1);
   INC_REF(cl_b, btype, &objb->v, 1);
   ret = do_binary_ab (op, obja, objb);
   INC_REF(cl_b, btype, &objb->v, -1);
   INC_REF(cl_a, atype, &obja->v, -1);

   the_return:

   if (ret != 0)
     return ret;

   if (c_needs_freed)
     free_object (objc, cl);

   return pop_object(objc);
}
#endif

/* _INLINE_ */
static int do_binary (int op)
{
   SLang_Object_Type obja, objb, *objap, *objbp;
#if SLANG_OPTIMIZE_FOR_SPEED
   SLang_Class_Type *cl;
#endif
   int ret;

   objbp = Stack_Pointer;
   if (Run_Stack + 2 > objbp)
     {
	(void) SLang_set_error (SL_STACK_UNDERFLOW);
	SLdo_pop_n (objbp - Run_Stack);
	return -1;
     }
   objbp--;
   objap = objbp-1;

   Stack_Pointer = objap;
#if SLANG_OPTIMIZE_FOR_SPEED
   if (objbp->o_data_type == objap->o_data_type)
     {
	if (objbp->o_data_type == SLANG_INT_TYPE)
	  return int_int_binary (op, objap, objbp);
#if SLANG_HAS_FLOAT
	if (objbp->o_data_type == SLANG_DOUBLE_TYPE)
	  return dbl_dbl_binary (op, objap, objbp);
#endif
     }
#endif

   obja = *objap;
   objb = *objbp;

   ret = do_binary_ab (op, &obja, &objb);
#if SLANG_OPTIMIZE_FOR_SPEED
   GET_CLASS(cl, obja.o_data_type);
   if (SLANG_CLASS_TYPE_SCALAR != cl->cl_class_type)
     free_object (&obja, cl);
#else
     SLang_free_object (&obja);
#endif

#if SLANG_OPTIMIZE_FOR_SPEED
   if (obja.o_data_type != objb.o_data_type)
     {
	GET_CLASS(cl, objb.o_data_type);
     }
   if (SLANG_CLASS_TYPE_SCALAR != cl->cl_class_type)
     free_object (&objb, cl);
#else
     SLang_free_object (&objb);
#endif

   return ret;
}

_INLINE_
static int do_binary_b (int op, SLang_Object_Type *bp)
{
   SLang_Object_Type a;
#if SLANG_OPTIMIZE_FOR_SPEED
   SLang_Class_Type *cl;
#endif
   int ret;

   if (pop_object(&a)) return -1;
#if SLANG_OPTIMIZE_FOR_SPEED
   if (a.o_data_type == bp->o_data_type)
     {
	if (a.o_data_type == SLANG_INT_TYPE)
	  return int_int_binary (op, &a, bp);

#if SLANG_HAS_FLOAT
	if (a.o_data_type == SLANG_DOUBLE_TYPE)
	  return dbl_dbl_binary (op, &a, bp);
#endif
     }
#endif
   ret = do_binary_ab (op, &a, bp);
#if SLANG_OPTIMIZE_FOR_SPEED
   GET_CLASS(cl, a.o_data_type);
   if (SLANG_CLASS_TYPE_SCALAR != cl->cl_class_type)
     free_object (&a, cl);
#else
     SLang_free_object (&a);
#endif
   return ret;
}

#if SLANG_OPTIMIZE_FOR_SPEED
/* _INLINE_ */
static void do_binary_b_inc_ref (int op, SLang_Object_Type *objbp)
{
   SLang_Object_Type obja;
   SLang_Class_Type *cl_a, *cl_b;
   SLang_Object_Type *objap;
   SLtype atype, btype;

   btype = objbp->o_data_type;

   if (btype == SLANG_INT_TYPE)
     {
	if (Stack_Pointer == Run_Stack)
	  {
	     (void) SLang_set_error (SL_STACK_UNDERFLOW);
	     return;
	  }
	objap = (Stack_Pointer-1);
	atype = objap->o_data_type;

	if (atype == SLANG_INT_TYPE)
	  {
	     int a, b;

	     a = objap->v.int_val; b = objbp->v.int_val;
	     switch (op)
	       {
		case SLANG_PLUS:
		  objap->v.int_val = a + b; return;
		case SLANG_MINUS:
		  objap->v.int_val = a - b; return;
		case SLANG_TIMES:
		  objap->v.int_val = a * b; return;
		case SLANG_EQ:
		  objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a == b); return;
		case SLANG_NE:
		  objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a != b); return;
		case SLANG_GT:
		  objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a > b); return;
		case SLANG_GE:
		  objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a >= b); return;
		case SLANG_LT:
		  objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a < b); return;
		case SLANG_LE:
		  objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a <= b); return;
	       }
	     (void) pop_object (&obja);
	     do_binary_ab (op, &obja, objbp);
	     return;
	  }
#if SLANG_HAS_FLOAT
	if (atype == SLANG_DOUBLE_TYPE)
	  {
	     double a;
	     int b;

	     a = objap->v.double_val; b = objbp->v.int_val;
	     switch (op)
	       {
		case SLANG_PLUS:
		  objap->v.double_val = a + b; return;
		case SLANG_MINUS:
		  objap->v.double_val = a - b; return;
		case SLANG_TIMES:
		  objap->v.double_val = a * b; return;
		case SLANG_DIVIDE:
		  objap->v.double_val = a / b; return;
		case SLANG_EQ:
		  objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a == b); return;
		case SLANG_NE:
		  objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a != b); return;
		case SLANG_GT:
		  objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a > b); return;
		case SLANG_GE:
		  objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a >= b); return;
		case SLANG_LT:
		  objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a < b); return;
		case SLANG_LE:
		  objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a <= b); return;
		case SLANG_POW:
		  objap->v.double_val = pow(a,b); return;
	       }
	     (void) pop_object (&obja);
	     do_binary_ab (op, &obja, objbp);
	     return;
	  }
#endif				       /* SLANG_HAS_FLOAT */
     }
#if SLANG_HAS_FLOAT
   else if (btype == SLANG_DOUBLE_TYPE)
     {
	double a, b;

	if (Stack_Pointer == Run_Stack)
	  {
	     (void) SLang_set_error (SL_STACK_UNDERFLOW);
	     return;
	  }
	objap = (Stack_Pointer-1);
	atype = objap->o_data_type;

	if (atype == SLANG_DOUBLE_TYPE)
	  a = objap->v.double_val;
	else if (atype == SLANG_INT_TYPE)
	  a = (double) objap->v.int_val;
	else
	  goto the_hard_way;

	b = objbp->v.double_val;
	switch (op)
	  {
	   case SLANG_PLUS:
	     objap->o_data_type = SLANG_DOUBLE_TYPE; objap->v.double_val = a + b; return;
	   case SLANG_MINUS:
	     objap->o_data_type = SLANG_DOUBLE_TYPE; objap->v.double_val = a - b; return;
	   case SLANG_TIMES:
	     objap->o_data_type = SLANG_DOUBLE_TYPE; objap->v.double_val = a * b; return;
	   case SLANG_DIVIDE:
	     objap->o_data_type = SLANG_DOUBLE_TYPE; objap->v.double_val = a / b; return;
	   case SLANG_EQ:
	     objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a == b); return;
	   case SLANG_NE:
	     objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a != b); return;
	   case SLANG_GT:
	     objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a > b); return;
	   case SLANG_GE:
	     objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a >= b); return;
	   case SLANG_LT:
	     objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a < b); return;
	   case SLANG_LE:
	     objap->o_data_type = SLANG_CHAR_TYPE; objap->v.char_val = (a <= b); return;
	   case SLANG_POW:
	     objap->o_data_type = SLANG_DOUBLE_TYPE; objap->v.double_val = pow(a,b); return;
	  }
	(void) pop_object (&obja);
	do_binary_ab (op, &obja, objbp);
	return;
     }
#endif				       /* SLANG_HAS_FLOAT */

the_hard_way:

   if (-1 == pop_object (&obja))
     return;

   GET_CLASS(cl_a, obja.o_data_type);
   GET_CLASS(cl_b, btype);

   INC_REF(cl_b, btype, &objbp->v, 1);
   (void) do_binary_ab (op, &obja, objbp);
   INC_REF(cl_b, btype, &objbp->v, -1);

   if (SLANG_CLASS_TYPE_SCALAR != cl_a->cl_class_type)
     free_object (&obja, cl_a);
}
#endif

static int do_unary_op (int op, SLang_Object_Type *obj, int unary_type)
{
   int (*f) (int, SLtype, VOID_STAR, SLuindex_Type, VOID_STAR);
   VOID_STAR pa;
   VOID_STAR pb;
   SLang_Class_Type *a_cl, *b_cl;
   SLtype a_type, b_type;
   int ret;

   a_type = obj->o_data_type;
   GET_CLASS (a_cl, a_type);

   if (NULL == (f = _pSLclass_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_VECTOR == a_cl->cl_class_type)
     pa = (VOID_STAR) obj->v.ptr_val;
   else
     pa = (VOID_STAR) &obj->v;
#else
   pa = _pSLclass_get_ptr_to_value (a_cl, obj);
#endif
   pb = b_cl->cl_transfer_buf;

   if (1 != (*f) (op, a_type, pa, 1, pb))
     {
	_pSLang_verror (SL_NOT_IMPLEMENTED,
		      "Unary operation/function 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 != b_cl->cl_class_type)
       && (SLANG_CLASS_TYPE_VECTOR != b_cl->cl_class_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;
#if SLANG_OPTIMIZE_FOR_SPEED
   SLang_Class_Type *cl;
#endif
   int ret;

   if (-1 == pop_object(&obj)) return -1;
   ret = do_unary_op (op, &obj, unary_type);
#if SLANG_OPTIMIZE_FOR_SPEED
   GET_CLASS(cl, obj.o_data_type);
   if (SLANG_CLASS_TYPE_SCALAR != cl->cl_data_type)
     free_object (&obj, cl);
#else
   SLang_free_object (&obj);
#endif
   return ret;
}

static int do_assignment_binary (int op, SLang_Object_Type *obja_ptr)
{
   SLang_Object_Type objb;
#if SLANG_OPTIMIZE_FOR_SPEED
   SLtype btype;
   SLang_Class_Type *cl;
#endif
   int ret;

   if (pop_object(&objb))
     return -1;
#if SLANG_OPTIMIZE_FOR_SPEED
   btype = objb.o_data_type;
#endif

#if 0 && SLANG_OPTIMIZE_FOR_SPEED
   if (op == SLANG_PLUS)
     {
	if (obja_ptr->o_data_type == SLANG_BSTRING_TYPE)
	  {
	     if (btype == SLANG_BSTRING_TYPE)
	       {
		  ret = _pSLbstring_concat_bstr (obja_ptr, (SLang_BString_Type*)objb.v.ptr_val);
		  SLbstring_free ((SLang_BString_Type *) objb.v.ptr_val);
		  return ret;
	       }
	     if (btype == SLANG_STRING_TYPE)
	       {
		  ret = _pSLbstring_concat_str (obja_ptr, objb.v.s_val);
		  _pSLang_free_slstring (objb.v.s_val);
		  return ret;
	       }
	  }
     }
#endif

   ret = do_binary_ab (op, obja_ptr, &objb);
#if SLANG_OPTIMIZE_FOR_SPEED
   GET_CLASS(cl, btype);
   if (SLANG_CLASS_TYPE_SCALAR != cl->cl_class_type)
     free_object (&objb, cl);
#else
   SLang_free_object (&objb);
#endif
   return ret;
}

/* The order of these is assumed to match the binary operators
 * defined in slang.h
 */
static int
map_assignment_op_to_binary (int 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:
	_pSLang_verror (SL_NOT_IMPLEMENTED, "Assignment operator not implemented");
	return -1;
     }
   return 0;
}

static int
perform_lvalue_operation (int 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->o_data_type == SLANG_INT_TYPE)
	  return push_int_object (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->o_data_type == SLANG_INT_TYPE)
	  return push_int_object (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:
	(void) SLang_set_error (SL_INTERNAL_ERROR);
	return -1;
     }
   return 0;
}

_INLINE_
static int
set_lvalue_obj (int op_type, SLang_Object_Type *obja_ptr)
{
#if SLANG_OPTIMIZE_FOR_SPEED
   SLang_Class_Type *cl;
#endif
   if (op_type != SLANG_BCST_ASSIGN)
     {
	if (-1 == perform_lvalue_operation (op_type, obja_ptr))
	  return -1;
     }
#if SLANG_OPTIMIZE_FOR_SPEED
   GET_CLASS(cl, obja_ptr->o_data_type);
   if (SLANG_CLASS_TYPE_SCALAR != cl->cl_class_type)
     free_object (obja_ptr, cl);
#else
   SLang_free_object (obja_ptr);
#endif

   return pop_object(obja_ptr);
}

/* a = b; a += b; ... */
_INLINE_
static int
set_lvalue_obj_with_obj (int op_type, SLang_Object_Type *obja_ptr, SLang_Object_Type *objb_ptr)
{
   SLang_Class_Type *cl;

   if (op_type != SLANG_BCST_ASSIGN)
     {
	if (-1 == _pSLpush_slang_obj (objb_ptr))
	  return -1;
	if (-1 == perform_lvalue_operation (op_type, obja_ptr))
	  return -1;

	goto pop_method;
     }

   if (SLANG_CLASS_TYPE_SCALAR == GET_CLASS_TYPE(objb_ptr->o_data_type))
     {
	/* We can copy b to a */
#if SLANG_OPTIMIZE_FOR_SPEED
	GET_CLASS(cl, obja_ptr->o_data_type);
	if (SLANG_CLASS_TYPE_SCALAR != cl->cl_class_type)
	  free_object (obja_ptr, cl);
#else
	SLang_free_object (obja_ptr);
#endif
	*obja_ptr = *objb_ptr;
	return 0;
     }

   /* a and b could refer to the same object.  So push b first before freeing a */

   GET_CLASS(cl, objb_ptr->o_data_type);
   if (-1 == (*cl->cl_push)(objb_ptr->o_data_type, (VOID_STAR)&objb_ptr->v))
     return -1;

pop_method:

#if SLANG_OPTIMIZE_FOR_SPEED
   GET_CLASS(cl, obja_ptr->o_data_type);
   if (SLANG_CLASS_TYPE_SCALAR != cl->cl_class_type)
     free_object (obja_ptr, cl);
#else
   SLang_free_object (obja_ptr);
#endif

   return pop_object(obja_ptr);
}

/* A.x = stackobj;  A.x += stackobj, etc... */
static int
set_struct_obj_lvalue (SLBlock_Type *bc_blk, SLang_Object_Type *objA, int do_free)
{
   SLtype type;
   SLang_Class_Type *cl;
   SLFUTURE_CONST char *name;
   int op, ret;

   type = objA->o_data_type;

   GET_CLASS(cl,type);
   if ((cl->cl_sput == NULL)
       || (cl->cl_sget == NULL))
     {
	_pSLang_verror (SL_NOT_IMPLEMENTED,
		      "%s does not support structure access",
		      cl->cl_name);
	if (do_free)
	  free_object (objA, cl);
	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;
#if SLANG_USE_TMP_OPTIMIZATION
	SLang_Class_Type *cl_obj;
#endif
	if (cl->is_struct)
	  {
	     if ((-1 == _pSLstruct_push_field (objA->v.struct_val, name, 0))
		 || (-1 == pop_object(&obj)))
	       {
		  if (do_free) free_object (objA, cl);
		  return -1;
	       }
	  }
	else if ((-1 == _pSLpush_slang_obj (objA))
		 || (-1 == cl->cl_sget ((SLtype) type, name))
		 || (-1 == pop_object(&obj)))
	  {
	     if (do_free) free_object (objA, cl);
	     return -1;
	  }

	/* Now the value of A.x is in obj. */
#if SLANG_USE_TMP_OPTIMIZATION
	/*
	 * It has at least 2 references: A.x and obj.  Decrement its reference
	 * to allow for the possibility of __tmp optimization.
	 */
	GET_CLASS(cl_obj,obj.o_data_type);
	INC_REF(cl_obj, obj.o_data_type, &obj.v, -1);
#endif
	ret = perform_lvalue_operation (op, &obj);
#if SLANG_USE_TMP_OPTIMIZATION
	INC_REF(cl_obj, obj.o_data_type, &obj.v, 1);
#endif
	if (ret == -1)
	  {
	     SLang_free_object (&obj);
	     if (do_free) free_object (objA, cl);
	     return -1;
	  }
#if SLANG_USE_TMP_OPTIMIZATION
	free_object (&obj, cl_obj);
#endif
     }

   /* The result of the operation is now on the stack.
    * Perform assignment
    */
   if (cl->is_struct)
     {
	ret = _pSLstruct_pop_field (objA->v.struct_val, name, 0);
	if (do_free) free_object (objA, cl);
	return ret;
     }

   if (-1 == _pSLpush_slang_obj (objA))
     {
	if (do_free) free_object (objA, cl);
	return -1;
     }

   ret = (*cl->cl_sput) ((SLtype) type, name);
   if (do_free) free_object (objA, cl);
   return ret;
}

/* A.x = stack, A.x += stack, ...  A is also on the stack. */
static int set_struct_lvalue (SLBlock_Type *bc_blk)
{
   SLang_Object_Type objA;

   if (-1 == pop_object (&objA))
     return -1;

   return set_struct_obj_lvalue (bc_blk, &objA, 1);
}

/* handle: @x op y
 *         @x++, @x--
 */
static int set_deref_lvalue (int op)
{
   int ret;
   SLang_Object_Type x;
   SLang_Ref_Type *ref;

   if (-1 == SLang_pop_ref (&ref))
     return -1;

   if (op == SLANG_BCST_ASSIGN)
     {
	ret = _pSLang_deref_assign (ref);
	SLang_free_ref (ref);
	return ret;
     }

   ret = -1;
   if ((0 == _pSLang_dereference_ref (ref))
       && (0 == pop_object(&x)))
     {
	if (0 == perform_lvalue_operation (op, &x))
	  ret = _pSLang_deref_assign (ref);

	SLang_free_object (&x);
     }

   SLang_free_ref (ref);
   return ret;
}

static int make_unit_object (SLang_Object_Type *a, SLang_Object_Type *u)
{
   SLtype type;

   type = a->o_data_type;
   if (type == SLANG_ARRAY_TYPE)
     type = a->v.array_val->data_type;

   u->o_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->o_data_type = SLANG_DOUBLE_TYPE;
      case SLANG_DOUBLE_TYPE:
	u->v.double_val = 1;
	break;
#endif
      default:
	u->o_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_nargs with either
 * the aput or aget function.  In addition, __args represents a call to
 * 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
 * be 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 is_unary;
   int status;
#if SLANG_OPTIMIZE_FOR_SPEED
   int class_type;
   SLang_Class_Type *cl;
#endif
   int num_args;

   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 == end_arg_list ())
     return -1;
   if ((num_args = Next_Function_Num_Args) <= 0)
     {
	SLang_verror (SL_INTERNAL_ERROR, "set_array_lvalue: Next_Function_Num_Args<=0");
	return -1;
     }
   Next_Function_Num_Args = 0;

   if (is_unary)		       /* PLUSPLUS, MINUSMINUS */
     {
	int type = peek_at_stack ();
	if (type == SLANG_ASSOC_TYPE)
	  {
	     return _pSLassoc_inc_value (num_args-1,
					 (op == SLANG_PLUS) ? +1 : -1);
	  }
     }

   if (-1 == SLdup_n (num_args))
     return -1;

   if (-1 == _pSLarray_aget1 (num_args-1))
     return -1;

   if (-1 == pop_object(&y))
     return -1;

   if (is_unary == 0)
     {
	if ((-1 == roll_stack (-(num_args + 1)))
	    || (-1 == pop_object(&x)))
	  {
	     SLang_free_object (&y);
	     return -1;
	  }
     }
   else if (-1 == make_unit_object (&y, &x))
     {
	SLang_free_object (&y);
	return -1;
     }
#if SLANG_OPTIMIZE_FOR_SPEED
   if (x.o_data_type == y.o_data_type)
     {
	if (x.o_data_type == SLANG_INT_TYPE)
	  status = int_int_binary (op, &y, &x);
#if SLANG_HAS_FLOAT
	else if (x.o_data_type == SLANG_DOUBLE_TYPE)
	  status = dbl_dbl_binary (op, &y, &x);
#endif
	else status = do_binary_ab (op, &y, &x);
     }
   else
#endif
     status = do_binary_ab (op, &y, &x);

   if (status != 0)
     {
	SLang_free_object (&y);
	SLang_free_object (&x);
	return -1;
     }

#if SLANG_OPTIMIZE_FOR_SPEED
   GET_CLASS(cl, y.o_data_type);
   class_type = cl->cl_class_type;
   if (SLANG_CLASS_TYPE_SCALAR != class_type)
     free_object (&y, cl);
#else
   SLang_free_object (&y);
#endif

#if SLANG_OPTIMIZE_FOR_SPEED
   if (cl->cl_data_type != x.o_data_type)
     {
	GET_CLASS(cl, x.o_data_type);
	class_type = cl->cl_class_type;
     }
   if (SLANG_CLASS_TYPE_SCALAR != class_type)
     free_object (&x, cl);
#else
   SLang_free_object (&x);
#endif

   if (-1 == roll_stack (num_args + 1))
     return -1;

   return _pSLarray_aput1 (num_args-1);
}

static int
set_intrin_lvalue (SLBlock_Type *bc_blk)
{
   int op_type;
   SLang_Object_Type obja;
   SLang_Class_Type *cl;
   SLang_Intrin_Var_Type *ivar;
   VOID_STAR intrinsic_addr;
   SLtype intrinsic_type;

   ivar = bc_blk->b.nt_ivar_blk;

   intrinsic_type = ivar->type;
   intrinsic_addr = ivar->addr;

   op_type = bc_blk->bc_sub_type;

   GET_CLASS(cl, 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 == pop_object(&obja)))
	  return -1;

	(void) perform_lvalue_operation (op_type, &obja);
	SLang_free_object (&obja);

	if (IS_SLANG_ERROR)
	  return -1;
     }

   return (*cl->cl_pop) (intrinsic_type, intrinsic_addr);
}

static int push_intrinsic_variable (SLang_Intrin_Var_Type *ivar)
{
   SLang_Class_Type *cl;
   SLtype stype;

   stype = ivar->type;
   GET_CLASS(cl,stype);

   if (-1 == (*cl->cl_push_intrinsic) (stype, ivar->addr))
     {
	do_name_type_error ((SLang_Name_Type *) ivar);
	return -1;
     }
   return 0;
}

static int push_nametype_variable (SLang_Name_Type *nt)
{
   switch (nt->name_type)
     {
      case SLANG_PVARIABLE:
      case SLANG_GVARIABLE:
	return _pSLpush_slang_obj (&((SLang_Global_Var_Type *)nt)->obj);

      case SLANG_IVARIABLE:
      case SLANG_RVARIABLE:
	return push_intrinsic_variable ((SLang_Intrin_Var_Type *)nt);

      case SLANG_HCONSTANT:
	return SLclass_push_short_obj (((SLang_HConstant_Type *)nt)->data_type, ((SLang_HConstant_Type*)nt)->value);
      case SLANG_ICONSTANT:
	return push_int_object (((SLang_IConstant_Type *)nt)->data_type, ((SLang_IConstant_Type*)nt)->value);
      case SLANG_LCONSTANT:
	return SLclass_push_long_obj (((SLang_LConstant_Type *)nt)->data_type, ((SLang_LConstant_Type*)nt)->value);

#if SLANG_HAS_FLOAT
      case SLANG_DCONSTANT:
	return push_double_object (SLANG_DOUBLE_TYPE, ((SLang_DConstant_Type*)nt)->d);
      case SLANG_FCONSTANT:
	return SLclass_push_float_obj (SLANG_FLOAT_TYPE, ((SLang_FConstant_Type*)nt)->f);
#endif
#ifdef HAVE_LONG_LONG
      case SLANG_LLCONSTANT:
	return SLclass_push_llong_obj (SLANG_LLONG_TYPE, ((SLang_LLConstant_Type*)nt)->ll);
#endif
     }
   _pSLang_verror (SL_TYPE_MISMATCH, "Symbol %s is not a variable", nt->name);
   return -1;
}

static int set_nametype_variable (SLang_Name_Type *nt)
{
   SLBlock_Type blk;

   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:
	(void) SLang_set_error (SL_INTERNAL_ERROR);
	return -1;

      case SLANG_RVARIABLE:
      default:
	_pSLang_verror (SL_READONLY_ERROR, "%s is read-only", nt->name);
	return -1;
     }

   return 0;
}

/* References to Nametype objects */
static char *nt_ref_string (VOID_STAR vdata)
{
   SLang_NameSpace_Type *ns;
   SLang_Name_Type *nt = *(SLang_Name_Type **)vdata;
   SLCONST char *name;
   SLstrlen_Type len;
   char *s;

   ns = _pSLns_find_object_namespace (nt);
   if (ns == NULL)
     return NULL;

   name = nt->name;
   len = strlen (name);

   if ((ns->namespace_name != NULL)
       && (0 != strcmp (ns->namespace_name, "Global")))
     {
	SLstrlen_Type dlen = strlen (ns->namespace_name);
	s = (char *)SLmalloc (len + dlen + 4);
	if (s == NULL)
	  return NULL;
	(void) sprintf (s, "&%s->%s", ns->namespace_name, name);
	return s;
     }

   if (NULL == (s = (char *)SLmalloc (len + 2)))
     return NULL;

   *s = '&';
   strcpy (s + 1, name);
   return s;
}

static void nt_ref_destroy (VOID_STAR vdata)
{
   /* SLang_free_function ((SLang_Name_Type *)nt) -- someday */
   (void) vdata;
}

static int nt_ref_deref_assign (VOID_STAR vdata)
{
   return set_nametype_variable (*(SLang_Name_Type **) vdata);
}

static int inner_interp_nametype (SLang_Name_Type *, int);
static int nt_ref_deref (VOID_STAR vdata)
{
   (void) inner_interp_nametype (*(SLang_Name_Type **)vdata, 0);
   return 0;
}

static int nt_ref_is_initialized (VOID_STAR v)
{
   SLang_Name_Type *nt = *(SLang_Name_Type **)v;

   if ((nt->name_type != SLANG_GVARIABLE)
       && (nt->name_type != SLANG_PVARIABLE))
     return 1;

   return ((SLang_Global_Var_Type *)nt)->obj.o_data_type != SLANG_UNDEFINED_TYPE;
}

static int nt_ref_uninitialize (VOID_STAR v)
{
   SLang_Name_Type *nt = *(SLang_Name_Type **)v;
   SLang_Object_Type *obj;

   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->o_data_type = SLANG_UNDEFINED_TYPE;
   obj->v.ptr_val = NULL;
   return 0;
}

static SLang_Ref_Type *create_ref_to_nametype (SLang_Name_Type *nt)
{
   SLang_Ref_Type *ref;

   if (NULL == (ref = _pSLang_new_ref (sizeof (SLang_Name_Type *))))
     return NULL;

   ref->data_is_nametype = 1;
   *(SLang_Name_Type **)ref->data = nt;
   ref->destroy = nt_ref_destroy;
   ref->string = nt_ref_string;
   ref->deref = nt_ref_deref;
   ref->deref_assign = nt_ref_deref_assign;
   ref->is_initialized = nt_ref_is_initialized;
   ref->uninitialize = nt_ref_uninitialize;
   return ref;
}

int SLang_assign_nametype_to_ref (SLang_Ref_Type *ref, SLang_Name_Type *nt)
{
   SLang_Ref_Type *r;

   if ((nt == NULL) || (ref == NULL))
     return -1;

   if (NULL == (r = create_ref_to_nametype (nt)))
     return -1;

   if (-1 == SLang_assign_to_ref (ref, SLANG_REF_TYPE, (VOID_STAR) &r))
     {
	SLang_free_ref (r);
	return -1;
     }
   SLang_free_ref (r);
   return 0;
}

/* Note: This is ok if nt is NULL.  Some routines rely on this behavior */
int _pSLang_push_nt_as_ref (SLang_Name_Type *nt)
{
   SLang_Ref_Type *r;
   int ret;

   if (nt == NULL)
     return SLang_push_null ();

   r = create_ref_to_nametype (nt);
   if (r == NULL) return -1;

   ret = SLang_push_ref (r);
   SLang_free_ref (r);
   return ret;
}

/* Local variable references */
static SLang_Object_Type *lv_ref_check_object (VOID_STAR vdata)
{
   SLang_Object_Type *obj = *(SLang_Object_Type **)vdata;

   if (obj > Local_Variable_Frame)
     {
	_pSLang_verror (SL_UNDEFINED_NAME, "Local variable reference is out of scope");
	return NULL;
     }
   return obj;
}

static int lv_ref_deref (VOID_STAR vdata)
{
   SLang_Object_Type *obj = lv_ref_check_object (vdata);
   if (obj == NULL)
     return -1;
   return _pSLpush_slang_obj (obj);
}

static int lv_ref_deref_assign (VOID_STAR vdata)
{
   SLang_Object_Type *objp = lv_ref_check_object (vdata);
   if (objp == NULL)
     return -1;
   return set_lvalue_obj (SLANG_BCST_ASSIGN, objp);
}

static void lv_ref_destroy (VOID_STAR vdata)
{
   (void)vdata;
}

static char *lv_ref_string (VOID_STAR vdata)
{
   (void) vdata;
   return SLmake_string ("Local variable reference");
}

static int lv_ref_is_initialized (VOID_STAR v)
{
   SLang_Object_Type *objp = lv_ref_check_object (v);
   if (objp == NULL)
     return -1;

   return objp->o_data_type != SLANG_UNDEFINED_TYPE;
}

static int lv_ref_uninitialize (VOID_STAR v)
{
   SLang_Object_Type *obj = lv_ref_check_object (v);
   if (obj == NULL)
     return -1;

   SLang_free_object (obj);
   obj->o_data_type = SLANG_UNDEFINED_TYPE;
   obj->v.ptr_val = NULL;
   return 0;
}

static SLang_Ref_Type *lv_new_ref (SLang_Object_Type *objp)
{
   SLang_Ref_Type *ref;

   if (NULL == (ref = _pSLang_new_ref (sizeof (SLang_Object_Type *))))
     return NULL;
   *(SLang_Object_Type **)ref->data = objp;
   ref->destroy = lv_ref_destroy;
   ref->string = lv_ref_string;
   ref->deref = lv_ref_deref;
   ref->deref_assign = lv_ref_deref_assign;
   ref->is_initialized = lv_ref_is_initialized;
   ref->uninitialize = lv_ref_uninitialize;
   return ref;
}

static int push_lv_as_ref (SLang_Object_Type *objp)
{
   int ret;
   SLang_Ref_Type *ref = lv_new_ref (objp);

   if (ref == NULL)
     return -1;

   ret = SLang_push_ref (ref);
   SLang_free_ref (ref);
   return ret;
}

#if 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:
	(void) SLang_set_error (SL_INTERNAL_ERROR);
	return;
     }

   if (-1 == _pSLpush_slang_obj (objp))
     return;

   if (-1 == SLang_pop_ref (&ref))
     return;
   (void) _pSLang_deref_assign (ref);
   SLang_free_ref (ref);
}
#endif

static int push_struct_field (SLFUTURE_CONST char *name)
{
   SLang_Class_Type *cl;
   SLang_Object_Type obj;
   SLtype type;

   if (-1 == pop_object (&obj))
     return -1;

   if (SLANG_STRUCT_TYPE == (type = obj.o_data_type))
     return _pSLstruct_push_field (obj.v.struct_val, name, 1);

   GET_CLASS(cl, (SLtype) type);

   if (cl->is_struct)
     return _pSLstruct_push_field (obj.v.struct_val, name, 1);

   if (cl->cl_sget == NULL)
     {
	_pSLang_verror (SL_NOT_IMPLEMENTED,
		      "%s does not permit structure access",
		      cl->cl_name);
	free_object (&obj, cl);
	return -1;
     }
   if (-1 == push_object (&obj))
     {
	free_object (&obj, cl);
	return -1;
     }
   return (*cl->cl_sget) ((SLtype) type, name);
}

static int is_nametype_callable (SLang_Name_Type *nt)
{
   switch (nt->name_type)
     {
      case SLANG_PFUNCTION:
      case SLANG_FUNCTION:
      case SLANG_INTRINSIC:
      case SLANG_ARITH_UNARY:
      case SLANG_MATH_UNARY:
      case SLANG_APP_UNARY:
      case SLANG_ARITH_BINARY:
	return 1;
     }
   return 0;
}

int _pSLang_ref_is_callable (SLang_Ref_Type *ref)
{
   if (ref->data_is_nametype == 0)
     return 0;

   return is_nametype_callable (*(SLang_Name_Type **)ref->data);
}

static int inner_interp(register SLBlock_Type *);
static int inner_interp_nametype (SLang_Name_Type *nt, int linenum)
{
   SLBlock_Type bc_blks[2];

   bc_blks[0].b.nt_blk = nt;
   bc_blks[0].bc_main_type = (_pSLang_BC_Type)nt->name_type;
   bc_blks[0].bc_sub_type = 0;
   bc_blks[0].linenum = linenum;
   bc_blks[1].bc_main_type = SLANG_BC_LAST_BLOCK;

   return inner_interp(bc_blks);
}

/* This function also frees the object */
static int deref_call_object (SLang_Object_Type *obj, int linenum)
{
   if (obj->o_data_type == SLANG_REF_TYPE)
     {
	SLang_Ref_Type *ref = (SLang_Ref_Type *)obj->v.ref;
	if ((ref != NULL) && ref->data_is_nametype
	    && is_nametype_callable (*(SLang_Name_Type **)ref->data))
	  {
	     int ret = inner_interp_nametype (*(SLang_Name_Type**)ref->data, linenum);
	     SLang_free_ref (ref);
	     return ret;
	  }
     }
   _pSLang_verror (SL_TYPE_MISMATCH, "Expected a reference to a function");
   SLang_free_object (obj);
   return -1;
}

/*  This arises from code such as a.f(x,y) with the following on the stack:
 *
 *     __args x y a
 *
 *  This function turns this into
 *
 *     __args a x y _eargs (@a.field)
 *
 */
static int do_struct_method (SLFUTURE_CONST char *name, int linenum)
{
   SLang_Object_Type obj;

   if (-1 == SLdup_n (1))
     return -1;			       /* stack: __args x y a a */

   if (-1 == push_struct_field (name))
     return -1;			       /* stack: __args x y a a.name */

   if (-1 == pop_object(&obj))
     return -1;

   if (-1 == end_arg_list ())
     {
	SLang_free_object (&obj);
	return -1;
     }
   /* stack: __args x y a __eargs */
   if (-1 == roll_stack (Next_Function_Num_Args))
     {
	SLang_free_object (&obj);
	return -1;
     }
   return deref_call_object (&obj, linenum);    /* frees obj */
}

#if defined(__GNUC__)
# pragma GCC diagnostic ignored "-Wformat-nonliteral"
#endif
static void trace_dump (SLFUTURE_CONST 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;

   _pSLerr_dump_msg ("%s", prefix);
   _pSLerr_dump_msg (format, name, n);

   if (n > 0)
     {
	prefix[len] = ' ';
	len++;
	prefix[len] = 0;

	_pSLerr_dump_msg (prefix, objs, n, dir);
     }
}
#if defined(__GNUC__)
# pragma GCC diagnostic warning "-Wformat-nonliteral"
#endif

/*  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, SLtype 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->o_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 == pop_object(obj))
	  return NULL;
	type = obj->o_data_type;
     }
   else if (-1 == pop_object_of_type (type, obj, 0))
     return NULL;

   type = GET_CLASS_TYPE(type);

   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];
   ptrdiff_t ret;
   SLtype ret_type;
   unsigned int argc;
   unsigned int i;
   FVOID_STAR fptr;
   SLtype *arg_types;
   int stk_depth;
   int num_args;

   fptr = objf->i_fun;
   argc = objf->num_args;
   ret_type = objf->return_type;
   arg_types = objf->arg_types;

   if (argc > SLANG_MAX_INTRIN_ARGS)
     {
	_pSLang_verror(SL_APPLICATION_ERROR,
		     "Intrinsic function %s requires too many parameters", objf->name);
	return -1;
     }

   if (-1 == _pSL_increment_frame_pointer ())
     return -1;
   num_args = SLang_Num_Function_Args;

   stk_depth = -1;
   if (Trace_Mode && (_pSLang_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",
		      (char *) objf->name,
		      Stack_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 (ret_type == SLANG_VOID_TYPE) ((VF0_Type) fptr) ();
#if SLANG_HAS_FLOAT
	else if (ret_type == SLANG_DOUBLE_TYPE) xf = ((FF0_Type) fptr)();
#endif
	else ret = ((LF0_Type) fptr)();
	break;

      case 1:
	if (ret_type == SLANG_VOID_TYPE) ((VF1_Type) fptr)(p[0]);
#if SLANG_HAS_FLOAT
	else if (ret_type == SLANG_DOUBLE_TYPE) xf =  ((FF1_Type) fptr)(p[0]);
#endif
	else ret =  ((LF1_Type) fptr)(p[0]);
	break;

      case 2:
	if (ret_type == SLANG_VOID_TYPE)  ((VF2_Type) fptr)(p[0], p[1]);
#if SLANG_HAS_FLOAT
	else if (ret_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 (ret_type == SLANG_VOID_TYPE) ((VF3_Type) fptr)(p[0], p[1], p[2]);
#if SLANG_HAS_FLOAT
	else if (ret_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 (ret_type == SLANG_VOID_TYPE) ((VF4_Type) fptr)(p[0], p[1], p[2], p[3]);
#if SLANG_HAS_FLOAT
	else if (ret_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 (ret_type == SLANG_VOID_TYPE) ((VF5_Type) fptr)(p[0], p[1], p[2], p[3], p[4]);
#if SLANG_HAS_FLOAT
	else if (ret_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 (ret_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 (ret_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 (ret_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 (ret_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 (ret_type)
     {
      case SLANG_VOID_TYPE:
	break;

#if SLANG_HAS_FLOAT
      case SLANG_DOUBLE_TYPE:
	(void) push_double_object (SLANG_DOUBLE_TYPE, xf);
	break;
#endif
      case SLANG_UINT_TYPE:
      case SLANG_INT_TYPE: (void) push_int_object (ret_type, (int) ret);
	break;

      case SLANG_CHAR_TYPE:
      case SLANG_UCHAR_TYPE: (void) push_char_object (ret_type, (char) ret);
	break;

      case SLANG_SHORT_TYPE:
	(void) SLclass_push_short_obj (_pSLANG_SHORT_TYPE, (short) ret);
	break;
      case SLANG_USHORT_TYPE:
	(void) SLclass_push_short_obj (_pSLANG_USHORT_TYPE, (short) ret);
	break;

      case SLANG_LONG_TYPE:
	(void) SLclass_push_long_obj (_pSLANG_LONG_TYPE, ret);
	break;
      case SLANG_ULONG_TYPE:
	(void) SLclass_push_long_obj (_pSLANG_ULONG_TYPE, ret);
	break;

      case SLANG_STRING_TYPE:
	if (NULL == (char *)ret)
	  (void) SLang_set_error (SL_INTRINSIC_ERROR);
	else (void) SLang_push_string ((char *)ret);
	break;

      default:
	_pSLang_verror (SL_NOT_IMPLEMENTED,
		      "Support for intrinsic functions returning %s is not provided.  Use the appropriate push function.",
		      SLclass_get_datatype_name (ret_type));
     }

   if (stk_depth >= 0)
     {
	stk_depth = SLstack_depth () - stk_depth;

	trace_dump ("<<%s (returning %d values)\n",
		      (char *) objf->name,
		      Stack_Pointer - stk_depth,
		      stk_depth,
		      1);
     }

   free_and_return:
   while (i < argc)
     {
#if SLANG_OPTIMIZE_FOR_SPEED
	SLang_Class_Type *cl;
	SLtype type = objs[i].o_data_type;
	GET_CLASS(cl, type);
	if (SLANG_CLASS_TYPE_SCALAR != cl->cl_class_type)
	  free_object (objs+i, cl);
#else
	SLang_free_object (objs + i);
#endif
	i++;
     }

   if (num_args != SLang_Num_Function_Args)
     SLang_verror (SL_INTERNAL_ERROR, "execute_intrinsic_fun: SLang_Num_Function_Args changed");

   return _pSL_decrement_frame_pointer ();
}

/* 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;

/* Returns 0 if the loops were completed, 1 if they were terminated via break,
 * or -1 if an error occured.
 */
static int
lang_do_loops (int stype, SLBlock_Type *block, unsigned int num_blocks)
{
   int i, ctrl;
   int first, last;
   SLBlock_Type *blks[4];
   SLCONST 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 USE_BC_LINE_NUM
	     if (block[i].bc_main_type == SLANG_BC_LINE_NUM)
	       continue;
#endif
	     _pSLang_verror (SL_SYNTAX_ERROR, "Bytecode is not a looping block");
	     return -1;
	  }
	blks[j] = block[i].b.blk;
	j++;
     }

   num_blocks = j;
   block = blks[0];

   switch (stype)
     {
	int next_fn_args;

      case SLANG_BCST_FOREACH_EARGS:
	if (-1 == end_arg_list ())
	  goto return_error;
	/* drop */
      case SLANG_BCST_FOREACH:	       /* obsolete */
	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.
	 */
	next_fn_args = Next_Function_Num_Args;
	Next_Function_Num_Args = 0;
	if ((-1 == roll_stack (-(next_fn_args + 1)))
	    || (-1 == (type = peek_at_stack ())))
	  goto return_error;

	GET_CLASS(cl, (SLtype)type);
	if ((cl->cl_foreach == NULL)
	    || (cl->cl_foreach_open == NULL)
	    || (cl->cl_foreach_close == NULL))
	  {
	     _pSLang_verror (SL_NOT_IMPLEMENTED, "%s does not permit foreach", cl->cl_name);
	     SLdo_pop_n (next_fn_args + 1);
	     goto return_error;
	  }

	if (NULL == (foreach_context = (*cl->cl_foreach_open) ((SLtype)type, next_fn_args)))
	  goto return_error;

	while (1)
	  {
	     int status;

	     if (IS_SLANG_ERROR)
	       {
		  (*cl->cl_foreach_close) ((SLtype) type, foreach_context);
		  goto return_error;
	       }

	     status = (*cl->cl_foreach) ((SLtype) type, foreach_context);
	     if (status <= 0)
	       {
		  if (status == 0)
		    break;

		  (*cl->cl_foreach_close) ((SLtype) type, foreach_context);
		  goto return_error;
	       }

	     inner_interp (block);
	     if (Lang_Break) break;
	     Lang_Break_Condition = /* Lang_Continue = */ 0;
	  }
	(*cl->cl_foreach_close) ((SLtype) 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 (IS_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 (IS_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 (IS_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:
	  {
#if SLANG_OPTIMIZE_FOR_SPEED
	     SLang_Object_Type *objp;
#endif
	     loop_name = "_for";

	     if (num_blocks != 1)
	       goto wrong_num_blocks_error;

	     /* 3 elements: first, last, step */
	     if ((-1 == pop_int (&ctrl))
		 || (-1 == pop_int (&last))
		 || (-1 == pop_int (&first)))
	       goto return_error;

#if SLANG_OPTIMIZE_FOR_SPEED
	     objp = NULL;
	     if ((block->bc_main_type == SLANG_BC_SET_LOCAL_LVALUE)
		 && (block->bc_sub_type == SLANG_BCST_ASSIGN))
	       {
		  objp = Local_Variable_Frame - block->b.i_blk;
		  block++;
	       }
#endif
	     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 (IS_SLANG_ERROR) goto return_error;
#if SLANG_OPTIMIZE_FOR_SPEED
		  if (objp != NULL)
		    {
		       if (objp->o_data_type != SLANG_INT_TYPE)
			 {
			    if (SLANG_CLASS_TYPE_SCALAR != GET_CLASS_TYPE(objp->o_data_type))
			      SLang_free_object (objp);
			    objp->o_data_type = SLANG_INT_TYPE;
			 }
		       objp->v.int_val = i;
		    }
		  else
#endif
		    push_int_object (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 == pop_int (&ctrl))
	  goto return_error;
	while (ctrl > 0)
	  {
	     ctrl--;

	     if (IS_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 (IS_SLANG_ERROR)
	       goto return_error;

	     inner_interp (block);
	     if (Lang_Break) break;
	     Lang_Break_Condition = /* Lang_Continue = */ 0;
	  }
	break;

      default:  _pSLang_verror(SL_INTERNAL_ERROR, "Unknown loop type");
	return -1;
     }
   if (Lang_Break == 0)
     {
	Lang_Break_Condition = Lang_Return;
	return 0;
     }

   if (Lang_Break < 0)
     {
	Lang_Break++;
	Lang_Break_Condition = 1;
     }
   else
     {
	Lang_Break--;
	Lang_Break_Condition = (Lang_Return || Lang_Break);
     }
   return 1;

   wrong_num_blocks_error:
   _pSLang_verror (SL_SYNTAX_ERROR, "Wrong number of blocks for '%s' construct", loop_name);

   /* drop */
   return_error:
   return -1;
   /* do_traceback (loop_name, NULL, -1); */
}

static void lang_do_and_orelse (int is_or, SLBlock_Type *addr, SLBlock_Type *addr_max)
{
   int test = 0;

   while (addr <= addr_max)
     {
#if USE_BC_LINE_NUM
	if (addr->bc_main_type == SLANG_BC_LINE_NUM)
	  {
	     addr++;
	     continue;
	  }
#endif
	inner_interp (addr->b.blk);
	if (IS_SLANG_ERROR
	    || Lang_Break_Condition
	    || (-1 == pop_ctrl_integer (&test)))
	  return;

	test = (test != 0);
	if (is_or == test)
	  break;

	/* if (((stype == SLANG_BCST_ANDELSE) && (test == 0))
	 *   || ((stype == SLANG_BCST_ORELSE) && test))
	 * break;
	 */

	addr++;
     }
   push_char_object (SLANG_CHAR_TYPE, (char) test);
}

/* Executes the block in error-free context.  If execution goes wrong, returns -1 */
static int try_interp_block (SLBlock_Type **bp)
{
   SLBlock_Type *b = *bp;

#if USE_BC_LINE_NUM
   while (b->bc_main_type == SLANG_BC_LINE_NUM)
     b++;
   *bp = b;
#endif

   b = b->b.blk;
   if (b->bc_main_type == 0)
     return 0;

   (void) inner_interp (b);

   if (IS_SLANG_ERROR)
     return -1;

   return 0;
}

static int do_try_internal (SLBlock_Type *ev_block, SLBlock_Type *final)
{
   SLBlock_Type *b;
   int stack_depth, num;
   unsigned int frame_depth, recurs_depth;
#if SLANG_HAS_BOSEOS
   int bos_stack_depth;
#endif
   int e1;
   int status;

   /* Try blocks have the form:
    * {ev_block} {try-statements} {exception-list}{catch-block}...{final}
    *
    * The parser guarantees that the first, second, and final blocks will be
    * present.  Line number blocks may also be present.
    */
   stack_depth = SLstack_depth ();
   frame_depth = Frame_Pointer_Depth;
   recurs_depth = Recursion_Depth;

#if SLANG_HAS_BOSEOS
   bos_stack_depth = BOS_Stack_Depth;
#endif
   b = ev_block + 1;
#if USE_BC_LINE_NUM
   while (b->bc_main_type == SLANG_BC_LINE_NUM)
     b++;
#endif
   (void) inner_interp (b->b.blk); /* try-block */

   if (0 == (e1 = SLang_get_error ()))
     return 0;

   num = SLstack_depth () - stack_depth;
   if (num > 0)
     SLdo_pop_n (num);

#if SLANG_HAS_BOSEOS
   while (bos_stack_depth < BOS_Stack_Depth)
     {
	(void) _pSLcall_eos_handler ();
	BOS_Stack_Depth--;
     }
#endif
   while (Recursion_Depth > recurs_depth)
     {
	(void) _pSL_decrement_frame_pointer ();
     }
   while (frame_depth < Frame_Pointer_Depth)
     {
	end_arg_list ();
     }

   if (-1 == _pSLang_push_error_context ())
     return -1;

   status = -1;

   if (-1 == try_interp_block (&ev_block))   /* evaluate the exception */
     goto return_error;

   b++;				       /* skip try-block */

   while (b < final)
     {
	stack_depth = SLstack_depth ();

	if (-1 == try_interp_block (&b))/* exception-list */
	  goto return_error;

	num = SLstack_depth () - stack_depth;
	if (num < 0)
	  {
	     _pSLang_verror (SL_StackUnderflow_Error, "Exception list is invalid");
	     goto return_error;
	  }

	if (num > 0)
	  {
	     while (num)
	       {
		  int e;
		  if (-1 == _pSLerr_pop_exception (&e))
		    goto return_error;

		  if (SLerr_exception_eqs (e1, e))
		    break;

		  num--;
	       }
	     if (num == 0)
	       {
		  /* No match, skip the exception-list */
		  b++;
#if USE_BC_LINE_NUM
		  while (b->bc_main_type == SLANG_BC_LINE_NUM)
		    b++;
#endif
		  /* And the block associated with it */
		  b++;
		  continue;
	       }
	     if (num > 1)
	       SLdo_pop_n (num-1);
	  }

	/* Found a match--- move on to the code to be executed */
	b++;
	/* _pSLerr_clear_error (); */
#if USE_BC_LINE_NUM
	while (b->bc_main_type == SLANG_BC_LINE_NUM)
	  b++;
#endif
	status = try_interp_block (&b);
	_pSLang_pop_error_context (status);
	if (status == 0)
	  _pSLerr_clear_error (0);
	return status;
     }

   if (b == final)
     {
	/* No matching catch block */
	status = 0;
     }

   return_error:
   _pSLang_pop_error_context (status);

   return -1;
}

static void do_try (SLBlock_Type *ev_block, SLBlock_Type *final)
{
   (void) do_try_internal (ev_block, final);

   if (final->b.blk->bc_main_type)
     {
	int bc = Lang_Break_Condition, r = Lang_Return, br = Lang_Break;
	/* Need to reset these so that loops work in the finally block */
	Lang_Break_Condition = Lang_Break = Lang_Return = 0;
	if (-1 == _pSLang_push_error_context ())
	  return;

	if (-1 == try_interp_block (&final))
	  _pSLang_pop_error_context (1);
	else
	  _pSLang_pop_error_context (0);

	Lang_Break = br; Lang_Return = r; Lang_Break_Condition = bc;
     }
}

/* This evaluates:
 *  (x0 op1 x1) and (x1 op2 x2) ... and (x{N-1} opN xN)
 * On stack: x0 x1 ... xN
 * Need to perform:
 *  x0 x1 op1 x1 x2 op2 and x2 x3 op3 and ... x{N-1} xN opN and
 *  --------  --------      --------  ....... -------------
 *     y1        y2            y3                    yN
 *     y1 y2 and y3 and ... yN and
 */
static int do_compare (SLBlock_Type *ops1)
{
   SLang_Object_Type a, b, c;
   SLang_Object_Type *ap, *bp, *cp;
   SLBlock_Type *ops = ops1;
   int ret = -1;

   /* skip to opN */
   while ((ops->bc_main_type == SLANG_BC_BINARY)
	  || (ops->bc_main_type == SLANG_BC_BINARY2)
	  || (ops->bc_main_type == SLANG_BC_COMBINED)
	  || (ops->bc_main_type == SLANG_BC_BINARY_LASTBLOCK)
	  || (ops->bc_main_type == SLANG_BC_BINARY_SET_LOCLVAL))
     ops++;

   bp = &b;
   if (-1 == SLang_pop (bp))
     return -1;

   ap = &a;
   cp = NULL;
   while (1)
     {
	SLang_Object_Type *tmp;
	ops--;
	if (-1 == SLang_pop (ap))
	  goto return_error;

	if (-1 == do_binary_ab_inc_ref (ops->b.i_blk, ap, bp))
	  {
	     SLang_free_object (ap);
	     goto return_error;
	  }
	SLang_free_object (bp);
	tmp = bp; bp = ap; ap = tmp;

	if (cp == NULL)
	  {
	     if (-1 == SLang_pop (&c))
	       goto return_error;
	     cp = &c;
	     continue;
	  }

	if (-1 == do_binary_b (SLANG_AND, cp))
	  goto return_error;
	SLang_free_object (cp);

	if (ops == ops1)
	  {
	     cp = NULL;
	     break;
	  }

	if (-1 == SLang_pop (cp))
	  {
	     cp = NULL;
	     goto return_error;
	  }
     }
   ret = 0;
   /* drop */
   return_error:
   if (cp != NULL)
     SLang_free_object (cp);
   SLang_free_object (bp);
   return ret;
}

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 _pSLang_trace_fun (SLFUTURE_CONST char *f)
{
   if (NULL == (f = SLang_create_slstring (f)))
     return -1;

   SLang_free_slstring ((char *) Trace_Function);
   Trace_Function = f;
   _pSLang_Trace = 1;
   return 0;
}

int _pSLdump_objects (char *prefix, SLang_Object_Type *x, unsigned int n, int dir)
{
   while (n)
     {
	SLang_Class_Type *cl;
	char *s;

	GET_CLASS(cl,x->o_data_type);

	s = _pSLstringize_object (x);

	_pSLerr_dump_msg ("%s[%s]:%s\n", prefix, cl->cl_name,
			  ((s != NULL) ? s : "??"));
	SLang_free_slstring (s);

	x += dir;
	n--;
     }
   return 0;
}

/* Do NOT change this-- it corresponds to USRBLK[0-4]_TOKEN */
#define MAX_USER_BLOCKS	5
static SLBlock_Type *Exit_Block_Ptr;
static SLBlock_Type *Global_User_Block[MAX_USER_BLOCKS];
static SLBlock_Type **User_Block_Ptr = Global_User_Block;

static int find_local_variable_index (Function_Header_Type *header, char *name)
{
   char **local_variables;
   unsigned int nlocals;
   unsigned int i;

   if (header == NULL)
     return -1;
   local_variables = header->local_variables;
   nlocals = header->nlocals;

   for (i = 0; i < nlocals; i++)
     {
	if ((*name == local_variables[i][0])
	    && (0 == strcmp (name, local_variables[i])))
	  return (int)i;
     }
   return -1;
}

static SLang_Name_Type *
  find_global_name (char *name,
		    SLang_NameSpace_Type *pns, SLang_NameSpace_Type *sns,
		    SLang_NameSpace_Type *gns,
		    int do_error)
{
   return find_global_hashed_name (name, SLcompute_string_hash (name), pns, sns, gns, do_error);
}

#if SLANG_HAS_DEBUGGER_SUPPORT
/* frame depth numbered two ways:
 *
 *  positive:  12345..N
 *  negative:  ..543210
 */
int _pSLang_get_frame_depth (void)
{
   return (int) (Function_Stack_Ptr - Function_Stack);
}
static int get_function_stack_info (int depth, Function_Stack_Type *sp)
{
   int current_depth = _pSLang_get_frame_depth ();

   if (depth <= 0)
     depth += current_depth;

   if (depth == current_depth)
     {
	sp->function = Current_Function;
	sp->header = Current_Function_Header;
	sp->local_variable_frame = Local_Variable_Frame;
	sp->line = This_Compile_Linenum;
	sp->file = This_Compile_Filename;
	sp->static_ns = This_Static_NameSpace;
	sp->private_ns = This_Private_NameSpace;
	return 0;
     }

   if ((depth >= current_depth) || (depth <= 0))
     {
	_pSLang_verror (SL_INVALID_PARM, "Invalid Frame Depth");
	return -1;
     }
   *sp = *(Function_Stack + depth);
   return 0;
}

int _pSLang_get_frame_fun_info (int depth, _pSLang_Frame_Info_Type *f)
{
   Function_Stack_Type s;

   if (-1 == get_function_stack_info (depth, &s))
     return -1;

   f->locals = NULL;
   f->nlocals = 0;
   f->function = NULL;

   f->line = s.line;
   f->file = s.file;
   f->ns = s.static_ns->namespace_name;

   if (s.header != NULL)
     {
	f->locals = s.header->local_variables;
	f->nlocals = s.header->nlocals;
     }

   if (s.function != NULL)
     f->function = s.function->name;

   return 0;
}

int _pSLang_set_frame_variable (int depth, char *name)
{
   Function_Stack_Type s;
   SLang_Name_Type *nt;
   int i;

   if (-1 == get_function_stack_info (depth, &s))
     return -1;

   if (-1 != (i = find_local_variable_index (s.header, name)))
     {
	SLang_Object_Type *obj = s.local_variable_frame - i;
	return set_lvalue_obj (SLANG_BCST_ASSIGN, obj);
     }

   if (NULL == (nt = find_global_name (name, s.private_ns, s.static_ns, Global_NameSpace, 1)))
     return -1;

   return set_nametype_variable (nt);
}

int _pSLang_get_frame_variable (int depth, char *name)
{
   Function_Stack_Type s;
   SLang_Name_Type *nt;
   int i;

   if (-1 == get_function_stack_info (depth, &s))
     return -1;

   if (-1 != (i = find_local_variable_index (s.header, name)))
     {
	SLang_Class_Type *cl;
	SLang_Object_Type *obj = s.local_variable_frame - i;
	GET_CLASS(cl,obj->o_data_type);
	return (*cl->cl_push) (obj->o_data_type, (VOID_STAR) &obj->v);
     }

   if (NULL == (nt = find_global_name (name, s.private_ns, s.static_ns, Global_NameSpace, 1)))
     return -1;

   return push_nametype_variable (nt);
}

#endif

static void execute_slang_fun (_pSLang_Function_Type *fun, unsigned int linenum)
{
   register unsigned int i;
   register SLang_Object_Type *frame, *lvf;
   register unsigned int n_locals;
   Function_Header_Type *header;
   /* SLBlock_Type *val; */
   SLBlock_Type *exit_block_save;
   SLBlock_Type **user_block_save;
   SLBlock_Type *user_blocks[MAX_USER_BLOCKS];
   int issue_bofeof_info = 0;
   int nargs;

   exit_block_save = Exit_Block_Ptr;
   user_block_save = User_Block_Ptr;
   User_Block_Ptr = user_blocks;
   memset ((char *)user_blocks, 0, MAX_USER_BLOCKS*sizeof (SLBlock_Type *));
   Exit_Block_Ptr = NULL;

   if (-1 == increment_slang_frame_pointer (fun, linenum))
     return;
   nargs = SLang_Num_Function_Args;

   header = fun->header;
   /* Make sure we do not allow this header to get destroyed by something
    * like:  define crash () { eval ("define crash ();") }
    */
   header->num_refs++;
   n_locals = header->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_Max)
     {
	_pSLang_verror(SL_STACK_OVERFLOW, "%s: Local Variable Stack Overflow",
		     fun->name);
	goto the_return;
     }

   while (i--)
     {
	lvf++;
	lvf->o_data_type = SLANG_UNDEFINED_TYPE;
     }
   Local_Variable_Frame = lvf;

   /* read values of function arguments */
   if (header->nargs)
     (void) pop_n_objs_reverse (Local_Variable_Frame - (header->nargs-1), header->nargs);

#if SLANG_HAS_BOSEOS
   if (header->issue_bofeof_info)
     {
	issue_bofeof_info = 1;
	(void) _pSLcall_bof_handler (fun->name, header->file);
     }
#endif
   if (SLang_Enter_Function != NULL)
     (*SLang_Enter_Function) (fun->name);

   if (_pSLang_Trace)
     {
	int stack_depth;

	stack_depth = SLstack_depth ();

	if ((Trace_Function != NULL)
	    && (0 == strcmp (Trace_Function, fun->name))
	    && (Trace_Mode == 0))
	  Trace_Mode = 1;

	if (Trace_Mode)
	  {
	     /* The local variable frame grows backwards */
	     trace_dump (">>%s (%d args)\n",
			 (char *) fun->name,
			 Local_Variable_Frame,
			 (int) header->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", (char *) fun->name,
			 Stack_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)(fun->name);

   if (IS_SLANG_ERROR)
     {
	do_function_traceback (header, linenum);
#if SLANG_HAS_BOSEOS && SLANG_HAS_DEBUGGER_SUPPORT
	/* (void) _pSLcall_debug_hook (); */
#endif
     }

   /* free local variables.... */
   lvf = Local_Variable_Frame;
   while (lvf > frame)
     {
#if SLANG_OPTIMIZE_FOR_SPEED
	SLang_Class_Type *cl;
	GET_CLASS(cl, lvf->o_data_type);
	if (SLANG_CLASS_TYPE_SCALAR != cl->cl_class_type)
	  free_object (lvf, cl);
#else
	SLang_free_object (lvf);
#endif
	lvf--;
     }
   Local_Variable_Frame = lvf;

   the_return:

   if (header->num_refs == 1)
     free_function_header (header);
   else
     header->num_refs--;

   Lang_Break_Condition = Lang_Return = Lang_Break = 0;
   Exit_Block_Ptr = exit_block_save;
   User_Block_Ptr = user_block_save;

   if (nargs != SLang_Num_Function_Args)
     SLang_verror (SL_INTERNAL_ERROR, "execute_slang_fun: SLang_Num_Function_Args changed");

   (void) decrement_slang_frame_pointer ();
#if SLANG_HAS_BOSEOS
   if (issue_bofeof_info)
     (void) _pSLcall_eof_handler ();
#endif
}

static void do_traceback (SLCONST char *message)
{
   if (SLang_Traceback == SL_TB_NONE)
     return;

   if (message != NULL)
     _pSLerr_traceback_msg ("Traceback: %s\n", message);
}

static void do_function_traceback (Function_Header_Type *header, unsigned int linenum)
{
   unsigned int nlocals;
   unsigned int i;
   SLang_Object_Type *objp;

   if (SLang_Traceback == SL_TB_NONE)
     return;

   /* Doing this will allow line number errors in recursive functions to be reported */
   _pSLerr_set_line_info (header->file, (int)linenum, "");

   if ((0 == (SLang_Traceback & SL_TB_FULL))
       || (SLang_Traceback & SL_TB_OMIT_LOCALS)
       || (0 == (nlocals = header->nlocals))
       || (header->local_variables == NULL))
     return;

   _pSLerr_traceback_msg ("  Local variables for %s:\n", Current_Function->name);

   for (i = 0; i < nlocals; i++)
     {
	SLang_Class_Type *cl;
	char *class_name;
	char *s;
	SLtype stype;

	objp = Local_Variable_Frame - i;
	stype = objp->o_data_type;

	s = _pSLstringize_object (objp);
	GET_CLASS(cl,stype);
	class_name = cl->cl_name;

	_pSLerr_traceback_msg ("\t%s %s = ", class_name, header->local_variables[i]);

	if (s == NULL) _pSLerr_traceback_msg ("??\n");
	else
	  {
	     SLCONST 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 = "\"";
	     _pSLerr_traceback_msg ("%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);
}

static void do_arith_binary (SLang_Arith_Binary_Type *nt)
{
   if (-1 == do_binary (nt->binary_op))
     do_traceback (nt->name);
}

int _pSLang_dereference_ref (SLang_Ref_Type *ref)
{
   return ref->deref (ref->data);
}

int _pSLang_is_ref_initialized (SLang_Ref_Type *ref)
{
   if (ref->is_initialized != NULL)
     return ref->is_initialized (ref->data);

   return 1;			       /* punt */
}

int _pSLang_uninitialize_ref (SLang_Ref_Type *ref)
{
   if (ref->uninitialize != NULL)
     return (*ref->uninitialize) (ref->data);

   return 0;
}

void (*SLang_Interrupt)(void) = NULL;

int _pSLpush_slang_obj (SLang_Object_Type *obj)
{
   SLtype subtype;
   SLang_Class_Type *cl;

   if (obj == NULL) return SLang_push_null ();

   subtype = obj->o_data_type;

#if SLANG_OPTIMIZE_FOR_SPEED
   if (SLANG_CLASS_TYPE_SCALAR == GET_CLASS_TYPE(subtype))
     return push_object (obj);
#endif

   GET_CLASS(cl,subtype);
   return (*cl->cl_push) (subtype, (VOID_STAR) &obj->v);
}

_INLINE_
static int carefully_push_object (SLang_Object_Type *obj)
{
   SLang_Class_Type *cl;
   SLtype subtype;

   subtype = obj->o_data_type;

   GET_CLASS(cl,subtype);

#if SLANG_OPTIMIZE_FOR_SPEED
   if (SLANG_CLASS_TYPE_SCALAR == cl->cl_class_type)
     return push_object (obj);
   if (subtype == SLANG_STRING_TYPE)
     return _pSLang_dup_and_push_slstring (obj->v.s_val);
   if (subtype == SLANG_ARRAY_TYPE)
     return _pSLang_push_array (obj->v.array_val, 0);
#endif

   return (*cl->cl_push) (subtype, (VOID_STAR) &obj->v);
}

int _pSLslang_copy_obj (SLang_Object_Type *obja, SLang_Object_Type *objb)
{
   SLtype type;

   type = obja->o_data_type;

#if SLANG_OPTIMIZE_FOR_SPEED
   if (SLANG_CLASS_TYPE_SCALAR == GET_CLASS_TYPE(type))
     {
	*objb = *obja;
	return 0;
     }
#endif

   if (-1 == carefully_push_object (obja))
     return -1;

   return pop_object (objb);
}

#define PUSH_LOCAL_VARIABLE(_indx) \
   { \
      SLang_Object_Type *_obj = Local_Variable_Frame - (_indx); \
      (void) carefully_push_object (_obj); \
   }

static int push_local_variable (int i)
{
   SLang_Object_Type *obj = Local_Variable_Frame - i;
   SLang_Class_Type *cl;
   SLtype subtype;

   subtype = obj->o_data_type;

#if SLANG_OPTIMIZE_FOR_SPEED
   if (SLANG_CLASS_TYPE_SCALAR == GET_CLASS_TYPE(subtype))
     return push_object (obj);
   if (subtype == SLANG_STRING_TYPE)
     return _pSLang_dup_and_push_slstring (obj->v.s_val);
   if (subtype == SLANG_ARRAY_TYPE)
     return _pSLang_push_array (obj->v.array_val, 0);
#endif

   GET_CLASS(cl,subtype);
   return (*cl->cl_push) (subtype, (VOID_STAR) &obj->v);
}

#if SLANG_OPTIMIZE_FOR_SPEED
static int push_array_element (int lvaridx, SLindex_Type idx)
{
   SLang_Object_Type *obj = Local_Variable_Frame - lvaridx;

   if (obj->o_data_type == SLANG_ARRAY_TYPE)
     {
	SLang_Array_Type *at = obj->v.array_val;

	if (at->num_dims == 1)
	  {
	     if (at->data_type == SLANG_INT_TYPE)
	       {
		  int *ptr = (int *)at->index_fun (at, &idx);
		  if (ptr == NULL)
		    return -1;
		  return push_int_object (SLANG_INT_TYPE, *ptr);
	       }
# if SLANG_HAS_FLOAT
	     else if (at->data_type == SLANG_DOUBLE_TYPE)
	       {
		  double *ptr = (double *)at->index_fun (at, &idx);
		  if (ptr == NULL)
		    return -1;
		  return push_double_object (SLANG_DOUBLE_TYPE, *ptr);
	       }
# endif
	     return _pSLarray1d_push_elem (at, idx);
	  }
	/* drop and fail */
     }

   /* Do it the hard way */
   if ((0 == push_array_index (SLANG_ARRAY_INDEX_TYPE, idx))
       && (0 == push_local_variable (lvaridx)))
     return _pSLarray_aget1 (1);

   return -1;
}
#endif

#if SLANG_OPTIMIZE_FOR_SPEED
static int pop_to_lvar_array_element (int lvaridx, SLindex_Type idx)
{
   SLang_Object_Type *obj = Local_Variable_Frame - lvaridx;

   if ((obj->o_data_type == SLANG_ARRAY_TYPE)
       && (idx >= 0))
     {
	SLang_Array_Type *at = obj->v.array_val;

	if ((at->num_dims == 1)
	    && (at->flags == 0)
	    && (idx < (SLindex_Type) at->num_elements))
	  {
	     if (at->data_type == SLANG_INT_TYPE)
	       return pop_int ((int *)at->data + idx);
#if SLANG_HAS_FLOAT
	     else if (at->data_type == SLANG_DOUBLE_TYPE)
	       {
		  SLang_Object_Type dobj;
		  if (-1 == pop_object_of_type (SLANG_DOUBLE_TYPE, &dobj, 0))
		    return -1;
		  *((double *)at->data + idx) = dobj.v.double_val;
		  return 0;
	       }
#endif
	  }
     }
   /* Do it the hard way */
   if ((0 == push_array_index (SLANG_ARRAY_INDEX_TYPE, idx))
       && (0 == push_local_variable (lvaridx)))
     return _pSLarray_aput1 (1);

   return -1;
}
#endif

#if SLANG_OPTIMIZE_FOR_SPEED
static int aget1_from_lvar_binary (int lvaridx, SLindex_Type idx, int op,
				  SLang_Object_Type *objb)
{
   SLang_Object_Type *obj;

   obj = Local_Variable_Frame - lvaridx;

   if (obj->o_data_type == SLANG_ARRAY_TYPE)
     {
	SLang_Array_Type *at = obj->v.array_val;

	if (at->num_dims == 1)
	  {
	     SLang_Object_Type a, c;
	     if (at->data_type == SLANG_INT_TYPE)
	       {
		  int *ptr = (int *)at->index_fun (at, &idx);
		  if (ptr == NULL)
		    return -1;
		  a.o_data_type = SLANG_INT_TYPE;
		  a.v.int_val = *ptr;
		  if (objb->o_data_type == SLANG_INT_TYPE)
		    return int_int_binary (op, &a, objb);
#if SLANG_HAS_FLOAT
		  else if (objb->o_data_type == SLANG_DOUBLE_TYPE)
		    {
		       if (-1 == int_dbl_binary_result (op, &a, objb, &c))
			 return -1;
		       return push_object (&c);
		    }
#endif
		  /* else handled below */
	       }
# if SLANG_HAS_FLOAT
	     else if (at->data_type == SLANG_DOUBLE_TYPE)
	       {
		  double *ptr;

		  ptr = (double *)at->index_fun (at, &idx);
		  if (ptr == NULL)
		    return -1;

		  a.o_data_type = SLANG_DOUBLE_TYPE;
		  a.v.double_val = *ptr;

		  if (objb->o_data_type == SLANG_DOUBLE_TYPE)
		    return dbl_dbl_binary (op, &a, objb);
		  else if (objb->o_data_type == SLANG_INT_TYPE)
		    {
		       if (-1 == dbl_int_binary_result (op, &a, objb, &c))
			 return -1;
		       return push_object (&c);
		    }
		  /* else handled below */
	       }
# endif
	     if (-1 == _pSLarray1d_push_elem (at, idx))
	       return -1;
	     return do_binary_b (op, objb);
	  }
     }

   if (-1 == push_array_element (lvaridx, idx))
     return -1;

   return do_binary_b (op, objb);
}
#endif

static int dereference_object (void)
{
   SLang_Object_Type obj;
   SLang_Class_Type *cl;
   SLtype type;
   int ret;

   if (-1 == pop_object(&obj))
     return -1;

   type = obj.o_data_type;

   GET_CLASS(cl,type);
   ret = (*cl->cl_dereference)(type, (VOID_STAR) &obj.v);

   free_object (&obj, cl);
   return ret;
}

/* This function gets called with the stack of the form:
 *   ... func __args ...
 * We need to pop func from within the stack.
 */
/* End the argument list, and make the function call */
static int deref_fun_call (int linenum)
{
   SLang_Object_Type obj;

   if (-1 == end_arg_list ())
     return -1;

   if (-1 == roll_stack (-(Next_Function_Num_Args + 1)))
     return -1;

   if (-1 == pop_object(&obj))
     return -1;

   return deref_call_object (&obj, linenum);
}

static int obsolete_deref_fun_call (int linenum)
{
   SLang_Object_Type obj;

   if (-1 == end_arg_list ())
     return -1;

  Next_Function_Num_Args--;          /* do not include function to be derefed. */

   if (-1 == pop_object(&obj))
     return -1;

   return deref_call_object (&obj, linenum);
}

static int case_function (void)
{
   SLang_Object_Type a_obj;
   SLang_Object_Type *swobjptr;
   int eqs;

   swobjptr = Switch_Obj_Ptr - 1;

   if ((swobjptr < Switch_Objects)
       || (0 == swobjptr->o_data_type))
     {
	_pSLang_verror (SL_SYNTAX_ERROR, "Misplaced 'case' keyword");
	return -1;
     }

   if (-1 == pop_object(&a_obj))
     return -1;

   eqs = _pSLclass_obj_eqs (&a_obj, swobjptr);
   SLang_free_object (&a_obj);

   if (eqs == -1)
     return -1;

   return push_int_object (SLANG_INT_TYPE, eqs);
}

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:
	(void) SLang_set_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 == push_object (obj))
     return;

   obj->o_data_type = SLANG_UNDEFINED_TYPE;
   obj->v.ptr_val = NULL;
}

static
int _pSLang_parse_dollar_string (SLFUTURE_CONST char *str, char ***argvp, unsigned int *argcp)
{
   unsigned int len;
   SLFUTURE_CONST char *s;
   char *fmt;
   char **argv;
   char ch;
   unsigned int num_dollars;
   unsigned int i, argc;

   len = 0;
   num_dollars = 1;		       /* allow for argv[0]=fmt */
   s = str;
   while ((ch = *s++) != 0)
     {
	len++;
	if (ch == '%')
	  {
	     len++;
	     continue;
	  }
	if (ch == '$')
	  {
	     num_dollars++;
	     continue;
	  }
     }
   fmt = (char *)SLmalloc (len+1);
   if (fmt == NULL)
     return -1;

   argv = (char **)SLcalloc (sizeof (char *), num_dollars);
   if (argv == NULL)
     {
	SLfree (fmt);
	return -1;
     }

   argc = 0;
   argv[argc] = fmt;
   argc++;

   s = str;
   while ((ch = *s++) != 0)
     {
	SLFUTURE_CONST char *s0, *s1;
	char *arg;

	if (ch != '$')
	  {
	     *fmt++ = ch;
	     if (ch == '%')
	       *fmt++ = ch;
	     continue;
	  }
	ch = *s++;
	if (ch == '$')
	  {
	     *fmt++ = '$';
	     continue;
	  }
	if (ch == 0)
	  {
	     *fmt++ = '$';
	     break;
	  }

	if ((ch != '_')
	    && (0 == SLwchar_isalnum (ch)))
	  {
	     if (ch != '{')
	       {
		  *fmt++ = '$';
		  *fmt++ = ch;
		  continue;
	       }
	     s0 = s;
	     while (*s && (*s != '}'))
	       s++;
	     if (*s == 0)
	       {
		  _pSLang_verror (SL_SYNTAX_ERROR, "Unable to find matching }");
		  goto return_error;
	       }
	     s1 = s + 1;
	  }
	else
	  {
	     s0 = s-1;
	     if (SLwchar_isdigit (ch)) /* e.g., $1 */
	       s0--;

	     while ((*s == '_')
		    || SLwchar_isalnum (*s))
	       s++;
	     s1 = s;
	  }

	if (NULL == (arg = SLmake_nstring (s0, s-s0)))
	  goto return_error;

	argv[argc] = arg;
	argc++;

	*fmt++ = '%';
	*fmt++ = 'S';

	s = s1;
     }
   *fmt = 0;

   *argvp = argv;
   *argcp = argc;
   return 0;

   return_error:
   for (i = 0; i < argc; i++)
     SLfree (argv[i]);
   SLfree ((char *)argv);
   return -1;
}

/* Convert "bla bla $foo bla" to sprintf ("bla bla %S bla", foo)
 */
int _pSLpush_dollar_string (SLFUTURE_CONST char *str)
{
   /* return SLang_push_string (str); */
   char **argv;
   unsigned int argc;
   unsigned int i;
   SLang_NameSpace_Type *private_ns, *static_ns;
   int status = -1;

   if (-1 == _pSLang_parse_dollar_string (str, &argv, &argc))
     return -1;

   if (-1 == SLang_push_string (argv[0]))
     goto free_return;

   if (Current_Function_Header == NULL)
     {
	private_ns = This_Private_NameSpace;
	static_ns = This_Static_NameSpace;
     }
   else
     {
	private_ns = Current_Function_Header->private_ns;
	static_ns = Current_Function_Header->static_ns;
     }

   for (i = 1; i < argc; i++)
     {
	char *name = argv[i];
	SLang_Name_Type *nt;
	SLFUTURE_CONST char *env;
	int j;

	if (*name == 0)
	  {
	     if (-1 == SLang_push_string (name))
	       goto free_return;

	     continue;
	  }

	j = find_local_variable_index (Current_Function_Header, name);
	if (j != -1)
	  {
	     if (-1 == push_local_variable (j))
	       goto free_return;

	     continue;
	  }
	if (NULL != (nt = find_global_name (name, private_ns, static_ns, Global_NameSpace, 0)))
	  {
	     if (-1 == push_nametype_variable (nt))
	       goto free_return;
	     continue;
	  }

	/* Assume it is an environment variable */
	env = getenv (name);
	if (env == NULL)
	  env = "";
	if (-1 == SLang_push_string (env))
	  goto free_return;
     }

   status = _pSLstrops_do_sprintf_n (argc-1);
   /* drop */

   free_return:
   for (i = 0; i < argc; i++)
     SLfree (argv[i]);

   SLfree ((char *) argv);
   return status;
}

static int
do_inner_interp_error (SLBlock_Type *err_block,
		       SLBlock_Type *addr_start,
		       SLBlock_Type *addr)
{
   SLFUTURE_CONST char *file = NULL, *funname = NULL;
   int line;

   /* Someday I can use the theses variable to provide extra information
    * about what went wrong.
    */
   (void) addr_start;
   (void) addr;

   if (Current_Function_Header != NULL)
     {
	file = Current_Function_Header->file;
	funname = Current_Function->name;
     }
   else file = This_Compile_Filename;

   line = addr->linenum;

/* #if SLANG_HAS_BOSEOS && SLANG_HAS_DEBUGGER_SUPPORT */
/*    if (SLang_get_error () == SL_USER_BREAK) */
/*      (void) _pSLcall_debug_hook (file, linenum); */
/* #endif */

   if (err_block == NULL)
     goto return_error;

   if (-1 == _pSLang_push_error_context ())
     goto return_error;

   inner_interp (err_block->b.blk);

   (void) _pSLang_pop_error_context (0);
   if (SLang_get_error () == 0)
     return 0;

   return_error:
#if SLANG_HAS_DEBUG_CODE
   if ((_pSLang_Error == SL_USAGE_ERROR)
       && (SLang_Traceback == SL_TB_NONE))
     return -1;

   if (file != NULL)
     (void) _pSLerr_set_line_info (file, line, funname);
#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;

   while (1)
     {
	x = b->bc_main_type;
	if (x == 0)
	  {
	     Bytecodes[0] += 1;
	     return;
	  }
	b++;

	while (SLANG_IS_BC_COMBINED(b->bc_main_type))
	  b++;

	y = b->bc_main_type;

	Bytecodes[(x << 8) | y] += 1;
     }
}

#endif

#define EXECUTE_INTRINSIC(addr) \
   { \
      SLang_Intrin_Fun_Type *f = (addr)->b.nt_ifun_blk; \
      if ((f->num_args == 0) && (f->return_type == SLANG_VOID_TYPE) && (Trace_Mode == 0)) \
	{ \
	   if (0 == _pSL_increment_frame_pointer ()) \
	     { \
		((VF0_Type) f->i_fun)(); \
		(void) _pSL_decrement_frame_pointer (); \
	     } \
	} \
      else execute_intrinsic_fun (f); \
   }

/* 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 (IS_SLANG_ERROR)
     {
	(void) do_inner_interp_error (err_block, addr_start, addr);
	return 0;
     }

#if GATHER_STATISTICS
   add_to_statistics (addr);
#endif
   /* Moving addr++ to top of switch instead of bottom was suggested by
    * Paul Boekholt to improve branch-prediction.
    */
   addr--;

   while (1)
     {
	addr++;
	switch (addr->bc_main_type)
	  {
	   case SLANG_BC_LAST_BLOCK:
	     goto return_1;
	   case SLANG_BC_LVARIABLE:
	     PUSH_LOCAL_VARIABLE (addr->b.i_blk)
	     break;
	   case SLANG_BC_GVARIABLE:
	     if (-1 == _pSLpush_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(addr)
	     if (IS_SLANG_ERROR)
	       do_traceback(addr->b.nt_ifun_blk->name);
	     break;

	   case SLANG_BC_FUNCTION:
	     execute_slang_fun (addr->b.nt_fun_blk, addr->linenum);
	     if (Lang_Break_Condition) goto handle_break_condition;
	     break;

	   case SLANG_BC_MATH_UNARY:
	   case SLANG_BC_APP_UNARY:
	   case SLANG_BC_ARITH_UNARY:
	     /* Make sure we treat these like function calls since the
	      * parser took abs(x), sin(x), etc to be a function call.
	      */
	     if (0 == _pSL_increment_frame_pointer ())
	       {
		  do_app_unary (addr->b.nt_unary_blk);
		  (void) _pSL_decrement_frame_pointer ();
	       }
	     break;

	   case SLANG_BC_ARITH_BINARY:
	     /* Make sure we treat these like function calls since the
	      * parser took _op_eqs, etc as function calls.
	      */
	     if (0 == _pSL_increment_frame_pointer ())
	       {
		  do_arith_binary (addr->b.nt_binary_blk);
		  (void) _pSL_decrement_frame_pointer ();
	       }
	     break;

	   case SLANG_BC_ICONST:
	     push_int_object (addr->b.iconst_blk->data_type, addr->b.iconst_blk->value);
	     break;

#if SLANG_HAS_FLOAT
	   case SLANG_BC_DCONST:
	     push_double_object (SLANG_DOUBLE_TYPE, addr->b.dconst_blk->d);
	     break;
	   case SLANG_BC_FCONST:
	     SLclass_push_float_obj (SLANG_FLOAT_TYPE, addr->b.fconst_blk->f);
	     break;
#endif
#ifdef HAVE_LONG_LONG
	   case SLANG_BC_LLCONST:
	     SLclass_push_llong_obj (addr->b.llconst_blk->data_type, addr->b.llconst_blk->value);
	     break;
#endif
	   case SLANG_BC_PVARIABLE:
	     if (-1 == _pSLpush_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, addr->linenum);
	     if (Lang_Break_Condition) goto handle_break_condition;
	     break;
	   case SLANG_BC_HCONST:
	     SLclass_push_short_obj (addr->b.iconst_blk->data_type, addr->b.hconst_blk->value);
	     break;
	   case SLANG_BC_LCONST:
	     SLclass_push_long_obj (addr->b.iconst_blk->data_type, addr->b.lconst_blk->value);
	     break;

#if USE_UNUSED_BYCODES_IN_SWITCH
# ifndef HAVE_LONG_LONG
	   case SLANG_BC_LLCONST:
# endif
	   case SLANG_BC_UNUSED_0x13:
	   case SLANG_BC_UNUSED_0x14:
	   case SLANG_BC_UNUSED_0x15:
	   case SLANG_BC_UNUSED_0x16:
	   case SLANG_BC_UNUSED_0x17:
	   case SLANG_BC_UNUSED_0x18:
	   case SLANG_BC_UNUSED_0x19:
	   case SLANG_BC_UNUSED_0x1A:
	   case SLANG_BC_UNUSED_0x1B:
	   case SLANG_BC_UNUSED_0x1C:
	   case SLANG_BC_UNUSED_0x1D:
	   case SLANG_BC_UNUSED_0x1E:
	   case SLANG_BC_UNUSED_0x1F:
	     _pSLang_verror (SL_INTERNAL_ERROR, "Byte-Code 0x%X is not valid", addr->bc_main_type);
	     break;
#endif
	   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_SET_ARRAY_LVALUE:
	     set_array_lvalue (addr->bc_sub_type);
	     break;
	   case SLANG_BC_SET_DEREF_LVALUE:
	     set_deref_lvalue (addr->bc_sub_type);
	     break;

	   case SLANG_BC_FIELD:
	     (void) push_struct_field (addr->b.s_blk);
	     break;
	   case SLANG_BC_METHOD:
	     do_struct_method (addr->b.s_blk, addr->linenum);
	     break;
#if SLANG_OPTIMIZE_FOR_SPEED
	   case SLANG_BC_LVARIABLE_AGET:
	       {
		  SLang_Object_Type *obj = Local_Variable_Frame - addr->b.i_blk;
		  if (0 == carefully_push_object (obj))
		    do_bc_call_direct_nargs (_pSLarray_aget);
	       }
	     break;

	   case SLANG_BC_LVARIABLE_APUT:
	       {
		  SLang_Object_Type *obj = Local_Variable_Frame - addr->b.i_blk;
		  if (0 == carefully_push_object (obj))
		    do_bc_call_direct_nargs (_pSLarray_aput);
	       }
	     break;
#else
	   case SLANG_BC_LVARIABLE_AGET:
	   case SLANG_BC_LVARIABLE_APUT:
	     _pSLang_verror (SL_INTERNAL_ERROR, "Byte-Code 0x%X is not valid", addr->bc_main_type);
	     break;
#endif
	   case SLANG_BC_LOBJPTR:
	     (void)push_lv_as_ref (Local_Variable_Frame - addr->b.i_blk);
	     break;

	   case SLANG_BC_GOBJPTR:
	     (void)_pSLang_push_nt_as_ref (addr->b.nt_blk);
	     break;

	   case SLANG_BC_FIELD_REF:
	     (void) _pSLstruct_push_field_ref (addr->b.s_blk);
	     break;

	   case SLANG_BC_OBSOLETE_DEREF_FUN_CALL:
	     (void) obsolete_deref_fun_call (addr->linenum);
	     break;

	   case SLANG_BC_DEREF_FUN_CALL:
	     (void) deref_fun_call (addr->linenum);
	     break;

#if USE_UNUSED_BYCODES_IN_SWITCH
	   case SLANG_BC_UNUSED_0x2F:
	   case SLANG_BC_UNUSED_0x30:
	   case SLANG_BC_UNUSED_0x31:
	   case SLANG_BC_UNUSED_0x32:
	   case SLANG_BC_UNUSED_0x33:
	   case SLANG_BC_UNUSED_0x34:
	   case SLANG_BC_UNUSED_0x35:
	   case SLANG_BC_UNUSED_0x36:
	   case SLANG_BC_UNUSED_0x37:
	   case SLANG_BC_UNUSED_0x38:
	   case SLANG_BC_UNUSED_0x39:
	   case SLANG_BC_UNUSED_0x3A:
	   case SLANG_BC_UNUSED_0x3B:
	   case SLANG_BC_UNUSED_0x3C:
	   case SLANG_BC_UNUSED_0x3D:
	   case SLANG_BC_UNUSED_0x3E:
	   case SLANG_BC_UNUSED_0x3F:
	     _pSLang_verror (SL_INTERNAL_ERROR, "Byte-Code 0x%X is not valid", addr->bc_main_type);
	     break;
#endif
	   case SLANG_BC_LITERAL:
#if !SLANG_OPTIMIZE_FOR_SPEED
	   case SLANG_BC_LITERAL_INT:
# if SLANG_HAS_FLOAT
	   case SLANG_BC_LITERAL_DBL:
# endif
	   case SLANG_BC_LITERAL_STR:
#endif
	       {
		  SLang_Class_Type *cl;

		  /* No user types should be here */
		  GET_BUILTIN_CLASS(cl, 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:
	     push_int_object (addr->bc_sub_type, (int) addr->b.l_blk);
	     break;
#if SLANG_HAS_FLOAT
	   case SLANG_BC_LITERAL_DBL:
	     push_double_object (addr->bc_sub_type, *addr->b.double_blk);
	     break;
#endif
	   case SLANG_BC_LITERAL_STR:
	     _pSLang_dup_and_push_slstring (addr->b.s_blk);
	     break;
#endif
	   case SLANG_BC_DOLLAR_STR:
	     (void) _pSLpush_dollar_string (addr->b.s_blk);
	     break;

#if USE_UNUSED_BYCODES_IN_SWITCH
	   case SLANG_BC_UNUSED_0x45:
	   case SLANG_BC_UNUSED_0x46:
	   case SLANG_BC_UNUSED_0x47:
	   case SLANG_BC_UNUSED_0x48:
	   case SLANG_BC_UNUSED_0x49:
	   case SLANG_BC_UNUSED_0x4A:
	   case SLANG_BC_UNUSED_0x4B:
	   case SLANG_BC_UNUSED_0x4C:
	   case SLANG_BC_UNUSED_0x4D:
	   case SLANG_BC_UNUSED_0x4E:
	   case SLANG_BC_UNUSED_0x4F:
	     _pSLang_verror (SL_INTERNAL_ERROR, "Byte-Code 0x%X is not valid", addr->bc_main_type);
	     break;
#endif
	   case SLANG_BC_UNARY:
	     do_unary (addr->b.i_blk, SLANG_BC_UNARY);
	     break;

	   case SLANG_BC_BINARY:
	     (void) do_binary (addr->b.i_blk);
	     break;

#if SLANG_OPTIMIZE_FOR_SPEED
	   case SLANG_BC_INTEGER_PLUS:
	     if (0 == push_int_object (addr->bc_sub_type, (int) addr->b.l_blk))
	       (void) do_binary (SLANG_PLUS);
	     break;

	   case SLANG_BC_INTEGER_MINUS:
	     if (0 == push_int_object (addr->bc_sub_type, (int) addr->b.l_blk))
	       (void) do_binary (SLANG_MINUS);
	     break;
#endif
#if USE_UNUSED_BYCODES_IN_SWITCH
# if !SLANG_OPTIMIZE_FOR_SPEED
	   case SLANG_BC_INTEGER_PLUS:
	   case SLANG_BC_INTEGER_MINUS:
	     break;
# endif
	   case SLANG_BC_UNUSED_0x54:
	   case SLANG_BC_UNUSED_0x55:
	   case SLANG_BC_UNUSED_0x56:
	   case SLANG_BC_UNUSED_0x57:
	   case SLANG_BC_UNUSED_0x58:
	   case SLANG_BC_UNUSED_0x59:
	   case SLANG_BC_UNUSED_0x5A:
	   case SLANG_BC_UNUSED_0x5B:
	   case SLANG_BC_UNUSED_0x5C:
	   case SLANG_BC_UNUSED_0x5D:
	   case SLANG_BC_UNUSED_0x5E:
	   case SLANG_BC_UNUSED_0x5F:
	     _pSLang_verror (SL_INTERNAL_ERROR, "Byte-Code 0x%X is not valid", addr->bc_main_type);
	     break;
#endif
	   case SLANG_BC_TMP:
	     tmp_variable_function (addr);
	     break;
	   case SLANG_BC_EXCH:
	     (void) SLreverse_stack (2);
	     break;
	   case SLANG_BC_LABEL:
	       {
		  int test;
		  if ((0 == pop_int (&test))
		      && (test == 0))
		    goto return_0;
	       }
	     break;

	   case SLANG_BC_BLOCK:
#if SLANG_OPTIMIZE_FOR_SPEED
	     while ((addr->bc_main_type == SLANG_BC_BLOCK)
		    && (addr->bc_sub_type == 0))
	       {
		  if (block == NULL)
		    block = addr;

		  addr++;
	       }
	     if (addr->bc_main_type != SLANG_BC_BLOCK)
	       {
		  addr--;
		  break;
	       }
#endif
	     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:
		case SLANG_BCST_FOREACH_EARGS:
		    {
		       int status;
		       SLBlock_Type *addr1 = addr + 1;
		       if (block == NULL) block = addr;

		       status = lang_do_loops(addr->bc_sub_type, block, 1 + (unsigned int) (addr - block));
		       block = NULL;
		       while (addr1->bc_main_type == SLANG_BC_BLOCK)
			 {
			    if (addr1->bc_sub_type == SLANG_BCST_LOOP_THEN)
			      {
				 addr = addr1;
				 if (status == 0)
				   inner_interp (addr->b.blk);
				 addr1++;
				 continue;
			      }
#ifdef LOOP_ELSE_TOKEN
			    if (addr1->bc_sub_type == SLANG_BCST_LOOP_ELSE)
			      {
				 addr = addr1;
				 if (status == 1)
				   inner_interp (addr->b.blk);
				 addr1++;
				 continue;
			      }
#endif
			    break;
			 }
		    }
		  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)
		    {
		       _pSLang_verror (SL_BUILTIN_LIMIT_EXCEEDED, "switch nesting too deep");
		       break;
		    }
		  (void) pop_object(Switch_Obj_Ptr);
		  Switch_Obj_Ptr++;

		  if (block == NULL) block = addr;
		  while ((0 == IS_SLANG_ERROR)
			 && (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->o_data_type = 0;
		  block = NULL;
		  break;

		case SLANG_BCST_SC_AND:
		    {
		       int i;
		       if ((0 == pop_ctrl_integer (&i)) && (i == 0))
			 {
			    (void) push_char_object (SLANG_CHAR_TYPE, 0);
			    block = NULL;
			    break;
			 }
		    }
		  /* drop */
		case SLANG_BCST_ANDELSE:
		  if (block == NULL) block = addr;
		  lang_do_and_orelse (0, block, addr);
		  block = NULL;
		  break;

		case SLANG_BCST_SC_OR:
		    {
		       int i;
		       if ((0 == pop_ctrl_integer (&i)) && i)
			 {
			    i = (i != 0);
			    (void) push_char_object (SLANG_CHAR_TYPE, (char)i);
			    block = NULL;
			    break;
			 }
		    }
		  /* drop */
		case SLANG_BCST_ORELSE:
		  if (block == NULL) block = addr;
		  lang_do_and_orelse (1, block, addr);
		  block = NULL;
		  break;

		case SLANG_BCST_TRY:
		  do_try (block, addr);
		  block = NULL;
		  break;

		case SLANG_BCST_COMPARE:
		  do_compare (addr->b.blk);
		  block = NULL;
		  break;

		default:
		  if (block == NULL) block =  addr;
		  break;
	       }

/*}}}*/

	     if (Lang_Break_Condition) goto handle_break_condition;
	     break;
	  /* End of SLANG_BC_BLOCK */

	   case SLANG_BC_RETURN:
	     Lang_Break_Condition = Lang_Return = Lang_Break = 1; goto return_1;
	   case SLANG_BC_BREAK:
	     Lang_Break_Condition = Lang_Break = 1; goto return_1;
	   case SLANG_BC_CONTINUE:
	     Lang_Break_Condition = /* Lang_Continue = */ 1; goto return_1;

#if USE_UNUSED_BYCODES_IN_SWITCH
	   case SLANG_BC_UNUSED_0x67:
	     _pSLang_verror (SL_INTERNAL_ERROR, "Byte-Code 0x%X is not valid", addr->bc_main_type);
	     break;
#endif
	   case SLANG_BC_BREAK_N:
	     Lang_Break_Condition = Lang_Break = addr->b.i_blk;
	     goto return_1;

	   case SLANG_BC_CONTINUE_N:
	     Lang_Break = -(addr->b.i_blk - 1);
	     Lang_Break_Condition = 1;
	     goto return_1;

	   case SLANG_BC_X_ERROR:
	     if (err_block != NULL)
	       {
		  inner_interp(err_block->b.blk);
		  if (SLang_get_error ()) err_block = NULL;
	       }
	     else _pSLang_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 _pSLang_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_CALL_DIRECT_NARGS:
	     do_bc_call_direct_nargs (addr->b.call_function);
	     break;

	   case SLANG_BC_EARG_LVARIABLE:
	     PUSH_LOCAL_VARIABLE(addr->b.i_blk)
	     (void) end_arg_list ();
	     break;
#if USE_BC_LINE_NUM
	   case SLANG_BC_LINE_NUM:
	     break;
#else
# if USE_UNUSED_BYCODES_IN_SWITCH
	   case SLANG_BC_UNUSED_0x74:
	     _pSLang_verror (SL_INTERNAL_ERROR, "Byte-Code 0x%X is not valid", addr->bc_main_type);
	     break;
# endif
#endif
	   case SLANG_BC_BOS:
#if SLANG_HAS_BOSEOS
	     BOS_Stack_Depth++;
	     This_Compile_Linenum = addr->b.line_info->linenum;
	     (void) _pSLcall_bos_handler (addr->b.line_info->filename, addr->b.line_info->linenum);
#endif
	     break;
	   case SLANG_BC_EOS:
#if SLANG_HAS_BOSEOS
	     This_Compile_Linenum = addr->linenum;
	     (void) _pSLcall_eos_handler ();
	     BOS_Stack_Depth--;
#endif
	     break;

#if USE_UNUSED_BYCODES_IN_SWITCH
	   case SLANG_BC_UNUSED_0x77:
	   case SLANG_BC_UNUSED_0x78:
	   case SLANG_BC_UNUSED_0x79:
	   case SLANG_BC_UNUSED_0x7A:
	   case SLANG_BC_UNUSED_0x7B:
	   case SLANG_BC_UNUSED_0x7C:
	   case SLANG_BC_UNUSED_0x7D:
	   case SLANG_BC_UNUSED_0x7E:
	   case SLANG_BC_UNUSED_0x7F:
	     _pSLang_verror (SL_INTERNAL_ERROR, "Byte-Code 0x%X is not valid", addr->bc_main_type);
	     break;
#endif

#if USE_COMBINED_BYTECODES
	   case SLANG_BC_CALL_DIRECT_INTRINSIC:
	     (*addr->b.call_function) ();
	     addr++;
	     EXECUTE_INTRINSIC(addr)
	     if (IS_SLANG_ERROR)
	       do_traceback(addr->b.nt_ifun_blk->name);
	     break;

	   case SLANG_BC_INTRINSIC_CALL_DIRECT:
	     EXECUTE_INTRINSIC(addr)
	     if (IS_SLANG_ERROR)
	       {
		  do_traceback(addr->b.nt_ifun_blk->name);
		  break;
	       }
	     addr++;
	     (*addr->b.call_function) ();
	     break;

	   case SLANG_BC_CALL_DIRECT_LSTR:
	     (*addr->b.call_function) ();
	     addr++;
	     _pSLang_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, addr->linenum);
	     if (Lang_Break_Condition) goto handle_break_condition;
	     break;

	   case SLANG_BC_CALL_DIRECT_RETINTR:
	     (*addr->b.call_function) ();
	     addr++;
	     /* drop */
	   case SLANG_BC_RET_INTRINSIC:
	     EXECUTE_INTRINSIC (addr)
	     if (0 == Handle_Interrupt)
	       return 1;
	     if (IS_SLANG_ERROR)
	       do_traceback(addr->b.nt_ifun_blk->name);
	     break;

	   case SLANG_BC_CALL_DIRECT_EARG_LVAR:
	     (*addr->b.call_function) ();
	     addr++;
	     PUSH_LOCAL_VARIABLE (addr->b.i_blk)
	     (void) end_arg_list ();
	     break;

	   case SLANG_BC_CALL_DIRECT_LINT:
	     (*addr->b.call_function) ();
	     addr++;
	     push_int_object (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;

	   case SLANG_BC_LLVARIABLE_BINARY:
	       {
		  SLang_Object_Type *obj1 = Local_Variable_Frame - (addr+1)->b.i_blk;
		  SLang_Object_Type *obj2 = Local_Variable_Frame - (addr+2)->b.i_blk;
		  if (obj1->o_data_type == obj2->o_data_type)
		    {
		       if (obj1->o_data_type == SLANG_INT_TYPE)
			 (void) int_int_binary (addr->b.i_blk, obj1, obj2);
# if SLANG_HAS_FLOAT
		       else if (obj1->o_data_type == SLANG_DOUBLE_TYPE)
			 (void) dbl_dbl_binary (addr->b.i_blk, obj1, obj2);
# endif
		       else
			 (void) do_binary_ab_inc_ref (addr->b.i_blk, obj1, obj2);
		    }
		  else do_binary_ab_inc_ref (addr->b.i_blk, obj1, obj2);
		  addr += 2;
	       }
	     break;

	   case SLANG_BC_LGVARIABLE_BINARY:
	     do_binary_ab_inc_ref (addr->b.i_blk,
			   Local_Variable_Frame - (addr+1)->b.i_blk,
			   &(addr+2)->b.nt_gvar_blk->obj);
	     addr += 2;
	     break;

	   case SLANG_BC_GLVARIABLE_BINARY:
	     do_binary_ab_inc_ref (addr->b.i_blk,
			   &(addr+1)->b.nt_gvar_blk->obj,
			   Local_Variable_Frame - (addr+2)->b.i_blk);
	     addr += 2;
	     break;
	   case SLANG_BC_GGVARIABLE_BINARY:
	     do_binary_ab_inc_ref (addr->b.i_blk,
			   &(addr+1)->b.nt_gvar_blk->obj,
			   &(addr+2)->b.nt_gvar_blk->obj);
	     addr += 2;
	     break;

	   case SLANG_BC_LIVARIABLE_BINARY:
	       {
		  SLang_Object_Type o, *obj1;
		  o.o_data_type = SLANG_INT_TYPE;
		  o.v.int_val = (int) (addr+2)->b.l_blk;
		  obj1 = Local_Variable_Frame - (addr+1)->b.i_blk;
		  if (obj1->o_data_type == SLANG_INT_TYPE)
		    (void) int_int_binary (addr->b.i_blk, obj1, &o);
		  else
		    do_binary_ab_inc_ref (addr->b.i_blk, obj1, &o);
	       }
	     addr += 2;
	     break;
# if SLANG_HAS_FLOAT
	   case SLANG_BC_LDVARIABLE_BINARY:
	       {
		  SLang_Object_Type o, *obj1;
		  o.o_data_type = SLANG_DOUBLE_TYPE;
		  o.v.double_val = *(addr+2)->b.double_blk;
		  obj1 = Local_Variable_Frame - (addr+1)->b.i_blk;
		  if (obj1->o_data_type == SLANG_DOUBLE_TYPE)
		    (void) dbl_dbl_binary (addr->b.i_blk, obj1, &o);
		  else
		    do_binary_ab_inc_ref (addr->b.i_blk, obj1, &o);
	       }
	     addr += 2;
	     break;
# endif
	   case SLANG_BC_ILVARIABLE_BINARY:
	       {
		  SLang_Object_Type o, *obj1;
		  o.o_data_type = SLANG_INT_TYPE;
		  o.v.int_val = (int) (addr+1)->b.l_blk;
		  obj1 = Local_Variable_Frame - (addr+2)->b.i_blk;
		  if (obj1->o_data_type == SLANG_INT_TYPE)
		    (void) int_int_binary (addr->b.i_blk, &o, obj1);
		  else
		    (void) do_binary_ab_inc_ref (addr->b.i_blk, &o, obj1);
	       }
	     addr += 2;
	     break;
# if SLANG_HAS_FLOAT
	   case SLANG_BC_DLVARIABLE_BINARY:
	       {
		  SLang_Object_Type o, *obj1;
		  o.o_data_type = SLANG_DOUBLE_TYPE;
		  o.v.double_val = *(addr+1)->b.double_blk;
		  obj1 = Local_Variable_Frame - (addr+2)->b.i_blk;
		  if (obj1->o_data_type == SLANG_DOUBLE_TYPE)
		    (void) dbl_dbl_binary (addr->b.i_blk, &o, obj1);
		  else
		    (void) do_binary_ab_inc_ref (addr->b.i_blk, &o, obj1);

	       }
	     addr += 2;
	     break;
# endif
	   case SLANG_BC_LVARIABLE_BINARY:
	     do_binary_b_inc_ref (addr->b.i_blk,
			  Local_Variable_Frame - (addr+1)->b.i_blk);
	     addr++;
	     break;

	   case SLANG_BC_GVARIABLE_BINARY:
	     do_binary_b_inc_ref (addr->b.i_blk,
			  &(addr+1)->b.nt_gvar_blk->obj);
	     addr++;
	     break;

	   case SLANG_BC_LITERAL_INT_BINARY:
	       {
		  SLang_Object_Type o;
		  o.o_data_type = SLANG_INT_TYPE;
		  o.v.int_val = (int) (addr+1)->b.l_blk;
		  (void) do_binary_b (addr->b.i_blk, &o);
	       }
	     addr++;
	     break;
# if SLANG_HAS_FLOAT
	   case SLANG_BC_LITERAL_DBL_BINARY:
	       {
		  SLang_Object_Type o;
		  o.o_data_type = SLANG_DOUBLE_TYPE;
		  o.v.double_val = *(addr+1)->b.double_blk;
		  (void) do_binary_b (addr->b.i_blk, &o);
	       }
	     addr++;
	     break;
# endif
	   case SLANG_BC_LASSIGN_LLBINARY:
	     (void) do_binary_ab_inc_ref_assign ((addr+1)->b.i_blk,
						 Local_Variable_Frame - (addr+2)->b.i_blk,
						 Local_Variable_Frame - (addr+3)->b.i_blk,
						 Local_Variable_Frame - addr->b.i_blk);
	     addr += 3;
	     break;

	   case SLANG_BC_LASSIGN_LIBINARY:
	       {
		  SLang_Object_Type o;
		  o.o_data_type = SLANG_INT_TYPE;
		  o.v.int_val = (int) (addr+3)->b.l_blk;

		  (void) do_binary_ab_inc_ref_assign ((addr+1)->b.i_blk,
						      Local_Variable_Frame - (addr+2)->b.i_blk,
						      &o,
						      Local_Variable_Frame - addr->b.i_blk);
	       }
	     addr += 3;
	     break;
	   case SLANG_BC_LASSIGN_ILBINARY:
	       {
		  SLang_Object_Type o;
		  o.o_data_type = SLANG_INT_TYPE;
		  o.v.int_val = (int) (addr+2)->b.l_blk;

		  (void) do_binary_ab_inc_ref_assign ((addr+1)->b.i_blk,
						      &o,
						      Local_Variable_Frame - (addr+3)->b.i_blk,
						      Local_Variable_Frame - addr->b.i_blk);
	       }
	     addr += 3;
	     break;
# if SLANG_HAS_FLOAT
	   case SLANG_BC_LASSIGN_LDBINARY:
	       {
		  SLang_Object_Type o;
		  o.o_data_type = SLANG_DOUBLE_TYPE;
		  o.v.double_val = *(addr+3)->b.double_blk;

		  (void) do_binary_ab_inc_ref_assign ((addr+1)->b.i_blk,
						      Local_Variable_Frame - (addr+2)->b.i_blk,
						      &o,
						      Local_Variable_Frame - addr->b.i_blk);
	       }
	     addr += 3;
	     break;
	   case SLANG_BC_LASSIGN_DLBINARY:
	       {
		  SLang_Object_Type o;
		  o.o_data_type = SLANG_DOUBLE_TYPE;
		  o.v.double_val = *(addr+2)->b.double_blk;

		  (void) do_binary_ab_inc_ref_assign ((addr+1)->b.i_blk,
						      &o,
						      Local_Variable_Frame - (addr+3)->b.i_blk,
						      Local_Variable_Frame - addr->b.i_blk);
	       }
	     addr += 3;
	     break;
# endif
	   case SLANG_BC_RET_LVARIABLE:
	     if (0 != push_local_variable (addr->b.i_blk))
	       break;
	     Lang_Break_Condition = Lang_Return = Lang_Break = 1;
	     goto return_1;

	   case SLANG_BC_RET_LITERAL_INT:
	     if (-1 == push_int_object (addr->bc_sub_type, (int) addr->b.l_blk))
	       break;
	     Lang_Break_Condition = Lang_Return = Lang_Break = 1;
	     goto return_1;

	   case SLANG_BC_MANY_LVARIABLE:
	     (void) push_local_variable (addr->b.i_blk);
	     addr++;
	     (void) push_local_variable (addr->b.i_blk);
	     addr++;
	     while (addr->bc_main_type == SLANG_BC_LVARIABLE_COMBINED)
	       {
		  (void) push_local_variable (addr->b.i_blk);
		  addr++;
	       }
	     addr--;
	     break;

	   case SLANG_BC_MANY_LVARIABLE_DIR:
	     (void) push_local_variable (addr->b.i_blk);
	     addr++;
	     (void) push_local_variable (addr->b.i_blk);
	     addr++;
	     while (addr->bc_main_type == SLANG_BC_LVARIABLE_COMBINED)
	       {
		  (void) push_local_variable (addr->b.i_blk);
		  addr++;
	       }
	     (*addr->b.call_function) ();
	     break;

	   case SLANG_BC_LVARIABLE_AGET1:
	       {
		  SLang_Object_Type *o;

		  addr++;		       /* not used */
		  o = (Local_Variable_Frame - addr->b.i_blk);
		  if (o->o_data_type == SLANG_INT_TYPE)
		    {
		       addr++;
		       (void) push_array_element (addr->b.i_blk, o->v.int_val);
		       break;
		    }
		  if (-1 == push_local_variable (addr->b.i_blk))
		    break;
		  addr++;
		  if (-1 == push_local_variable (addr->b.i_blk))
		    break;
		  (void) _pSLarray_aget1 (1);
		  break;
	       }

	   case SLANG_BC_LITERAL_AGET1:
	     addr++;		       /* not used */
	     push_array_element ((addr+1)->b.i_blk, (int) addr->b.l_blk);
	     addr++;
	     break;

	   case SLANG_BC_LVAR_LVAR_APUT1:
	     if (-1 == push_local_variable (addr->b.i_blk))
	       break;
	     addr++;
	     /* drop */
	   case SLANG_BC_LVARIABLE_APUT1:
	       {
		  SLang_Object_Type *o;

		  addr++;		       /* not used */
		  o = (Local_Variable_Frame - addr->b.i_blk);
		  if (o->o_data_type == SLANG_INT_TYPE)
		    {
		       addr++;
		       (void) pop_to_lvar_array_element (addr->b.i_blk, o->v.int_val);
		       break;
		    }
		  if (-1 == push_local_variable (addr->b.i_blk))
		    break;
		  addr++;
		  if (-1 == push_local_variable (addr->b.i_blk))
		    break;
		  (void) _pSLarray_aput1 (1);
	       }
	     break;

	   case SLANG_BC_LITERAL_APUT1:
	     (void) pop_to_lvar_array_element ((addr+2)->b.i_blk, (SLindex_Type)((addr+1)->b.l_blk));
	     addr += 2;
	     break;

	   case SLANG_BC_LLVARIABLE_BINARY2:
	       {
		  SLang_Object_Type *obj1 = Local_Variable_Frame - (addr+1)->b.i_blk;
		  SLang_Object_Type *obj2 = Local_Variable_Frame - (addr+2)->b.i_blk;
		  SLang_Object_Type obj3;

		  if (obj1->o_data_type == obj2->o_data_type)
		    {
		       if (obj1->o_data_type == SLANG_INT_TYPE)
			 {
			    if (-1 == int_int_binary_result (addr->b.i_blk, obj1, obj2, &obj3))
			      break;
			    addr += 3;
			    (void) do_binary_b (addr->b.i_blk, &obj3);
			    break;
			 }
# if SLANG_HAS_FLOAT
		       else if (obj1->o_data_type == SLANG_DOUBLE_TYPE)
			 {
			    if (-1 == dbl_dbl_binary_result (addr->b.i_blk, obj1, obj2, &obj3))
			      break;
			    addr += 3;
			    (void) do_binary_b (addr->b.i_blk, &obj3);
			    break;
			 }
# endif
		    }

		  obj3.o_data_type = SLANG_UNDEFINED_TYPE;
		  if (-1 == do_binary_ab_inc_ref_assign (addr->b.i_blk, obj1, obj2, &obj3))
		    break;
		  addr += 3;
		  (void) do_binary_b (addr->b.i_blk, &obj3);
		  SLang_free_object (&obj3);
	       }
	     break;

	   case SLANG_BC_SET_LOCLV_LIT_INT:
	     set_lvalue_obj (addr->bc_sub_type, Local_Variable_Frame - addr->b.i_blk);
	     addr++;
	     push_int_object (addr->bc_sub_type, (int) addr->b.l_blk);
	     break;

	   case SLANG_BC_SET_LOCLV_LIT_AGET1:
	     set_lvalue_obj (addr->bc_sub_type, Local_Variable_Frame - addr->b.i_blk);
	     addr += 3;
	     push_array_element (addr->b.i_blk, (int) (addr-1)->b.l_blk);
	     break;

	   case SLANG_BC_SET_LOCLV_LVAR:
	     set_lvalue_obj (addr->bc_sub_type, Local_Variable_Frame - addr->b.i_blk);
	     addr++;
	     PUSH_LOCAL_VARIABLE (addr->b.i_blk)
	     break;

	   case SLANG_BC_SET_LOCLV_LASTBLOCK:
	     if (0 == set_lvalue_obj (addr->bc_sub_type, Local_Variable_Frame - addr->b.i_blk))
	       goto return_1;
	     break;

	   case SLANG_BC_LVAR_EARG_LVAR:
	     PUSH_LOCAL_VARIABLE (addr->b.i_blk);
	     addr++;
	     PUSH_LOCAL_VARIABLE(addr->b.i_blk);
	     (void) end_arg_list ();
	     break;

	   case SLANG_BC_LVAR_FIELD:
	     PUSH_LOCAL_VARIABLE (addr->b.i_blk);
	     addr++;
	     (void) push_struct_field (addr->b.s_blk);
	     break;

	   case SLANG_BC_BINARY_LASTBLOCK:
	     if (-1 == do_binary (addr->b.i_blk))
	       break;
	     goto return_1;

	   case SLANG_BC_EARG_LVARIABLE_INTRINSIC:
	     PUSH_LOCAL_VARIABLE(addr->b.i_blk);
	     if (0 == end_arg_list ())
	       {
		  addr++;
		  EXECUTE_INTRINSIC(addr)
		  if (IS_SLANG_ERROR)
		    do_traceback(addr->b.nt_ifun_blk->name);
	       }
	     break;

	   case SLANG_BC_LVAR_LITERAL_INT:
	     PUSH_LOCAL_VARIABLE (addr->b.i_blk);
	     addr++;
	     push_int_object (addr->bc_sub_type, (int) addr->b.l_blk);
	     break;

	   case SLANG_BC_BINARY_SET_LOCLVAL:
	     if (-1 == do_binary (addr->b.i_blk))
	       break;
	     addr++;
	     (void) set_lvalue_obj (addr->bc_sub_type, Local_Variable_Frame - addr->b.i_blk);
	     break;

	   case SLANG_BC_LVAR_AGET_SET_LOCLVAL:
	       {
		  SLang_Object_Type *obj = Local_Variable_Frame - addr->b.i_blk;
		  if ((0 == carefully_push_object (obj))
		      && (0 == do_bc_call_direct_nargs (_pSLarray_aget)))
		    {
		       addr++;
		       (void) set_lvalue_obj (addr->bc_sub_type, Local_Variable_Frame - addr->b.i_blk);
		    }
	       }
	     break;

	   case SLANG_BC_LLVAR_BINARY_IF:
	       {
		  SLang_Object_Type *obj1 = Local_Variable_Frame - (addr+1)->b.i_blk;
		  SLang_Object_Type *obj2 = Local_Variable_Frame - (addr+2)->b.i_blk;
		  SLang_Object_Type obj3;

		  if (obj1->o_data_type == obj2->o_data_type)
		    {
		       if (obj1->o_data_type == SLANG_INT_TYPE)
			 {
			    if (-1 == int_int_binary_result (addr->b.i_blk, obj1, obj2, &obj3))
			      break;
			 }
# if SLANG_HAS_FLOAT
		       else if (obj1->o_data_type == SLANG_DOUBLE_TYPE)
			 {
			    if (-1 == dbl_dbl_binary_result (addr->b.i_blk, obj1, obj2, &obj3))
			      break;
			 }
# endif
		       else
			 {
			    obj3.o_data_type = SLANG_UNDEFINED_TYPE;
			    if (-1 == do_binary_ab_inc_ref_assign (addr->b.i_blk, obj1, obj2, &obj3))
			      break;
			 }
		    }
		  else
		    {
		       obj3.o_data_type = SLANG_UNDEFINED_TYPE;
		       if (-1 == do_binary_ab_inc_ref_assign (addr->b.i_blk, obj1, obj2, &obj3))
			 break;
		    }
		  addr += 3;
		  if (obj3.o_data_type == SLANG_CHAR_TYPE)
		    {
		       if (obj3.v.char_val)
			 goto execute_BC_IF_BLOCK;
		       break;
		    }
		  if (obj3.o_data_type == SLANG_INT_TYPE)
		    {
		       if (obj3.v.int_val)
			 goto execute_BC_IF_BLOCK;
		       break;
		    }

		  /* Otherwise let pop_ctrl_integer do the dirty work */
		  if (-1 == push_object (&obj3))
		    break;
	       }
	     /* drop */
	   case SLANG_BC_IF_BLOCK:
	       {
		  int i;

		  if ((-1 == pop_ctrl_integer (&i)) || (i == 0))
		    break;
	       }

execute_BC_IF_BLOCK:
	       {
		  SLBlock_Type *addr1 = addr->b.blk;
		  if (addr1->bc_main_type == SLANG_BC_RETURN)
		    {
		       Lang_Break_Condition = Lang_Return = Lang_Break = 1;
		       goto return_1;
		    }
		  if (addr1->bc_main_type == SLANG_BC_RET_LVARIABLE)
		    {
		       if (0 != push_local_variable (addr1->b.i_blk))
			 break;
		       Lang_Break_Condition = Lang_Return = Lang_Break = 1;
		       goto return_1;
		    }
		  inner_interp (addr1);
		  if (Lang_Break_Condition) goto handle_break_condition;
	       }
	     break;

	   case SLANG_BC_LVAR_SET_FIELD:
	     (void) set_struct_obj_lvalue (addr+1, Local_Variable_Frame - addr->b.i_blk, 0);
	     addr++;
	     break;

	   case SLANG_BC_PVAR_SET_GLOB_LVAL:
	     addr++;
	     if (-1 == set_lvalue_obj_with_obj (addr->bc_sub_type,
						&addr->b.nt_gvar_blk->obj,
						&(addr-1)->b.nt_gvar_blk->obj))
	       do_name_type_error (addr->b.nt_blk);
	     break;
	   case SLANG_BC_LVAR_SET_GLOB_LVAL:
	     addr++;
	     if (-1 == set_lvalue_obj_with_obj (addr->bc_sub_type,
						&addr->b.nt_gvar_blk->obj,
						Local_Variable_Frame - (addr-1)->b.i_blk))
	       do_name_type_error (addr->b.nt_blk);
	     break;

	   case SLANG_BC_LIT_AGET1_INT_BINARY:
	       {
		  SLang_Object_Type o;
		  o.o_data_type = SLANG_INT_TYPE;
		  o.v.int_val = (int)(addr+4)->b.l_blk;
		  (void) aget1_from_lvar_binary ((addr+2)->b.i_blk, (SLindex_Type) (addr+1)->b.l_blk,
						 (addr+3)->b.i_blk, &o);
	       }
	     addr += 4;
	     break;
	   case SLANG_BC_BINARY2:
	     if (0 == do_binary (addr->b.i_blk))
	       {
		  addr++;
		  (void) do_binary (addr->b.i_blk);
	       }
	     break;

	   case SLANG_BC_LVAR_LIT_AGET1:
	     PUSH_LOCAL_VARIABLE(addr->b.i_blk);
	     (void) push_array_element ((addr+3)->b.i_blk, (int)((addr+2)->b.l_blk));
	     addr += 3;
	     break;
#endif				       /* USE_COMBINED_BYTECODES */

#if USE_UNUSED_BYCODES_IN_SWITCH
# if !USE_COMBINED_BYTECODES
	   case SLANG_BC_CALL_DIRECT_INTRINSIC:
	   case SLANG_BC_INTRINSIC_CALL_DIRECT:
	   case SLANG_BC_CALL_DIRECT_LSTR:
	   case SLANG_BC_CALL_DIRECT_SLFUN:
	   case SLANG_BC_CALL_DIRECT_RETINTR:
	   case SLANG_BC_RET_INTRINSIC:
	   case SLANG_BC_CALL_DIRECT_EARG_LVAR:
	   case SLANG_BC_CALL_DIRECT_LINT:
	   case SLANG_BC_CALL_DIRECT_LVAR:
	   case SLANG_BC_LLVARIABLE_BINARY:
	   case SLANG_BC_LGVARIABLE_BINARY:
	   case SLANG_BC_GLVARIABLE_BINARY:
	   case SLANG_BC_GGVARIABLE_BINARY:
	   case SLANG_BC_LIVARIABLE_BINARY:
	   case SLANG_BC_LDVARIABLE_BINARY:
	   case SLANG_BC_ILVARIABLE_BINARY:
	   case SLANG_BC_DLVARIABLE_BINARY:
	   case SLANG_BC_LVARIABLE_BINARY:
	   case SLANG_BC_GVARIABLE_BINARY:
	   case SLANG_BC_LITERAL_INT_BINARY:
	   case SLANG_BC_LITERAL_DBL_BINARY:
	   case SLANG_BC_LASSIGN_LLBINARY:
	   case SLANG_BC_LASSIGN_LIBINARY:
	   case SLANG_BC_LASSIGN_ILBINARY:
	   case SLANG_BC_LASSIGN_LDBINARY:
	   case SLANG_BC_LASSIGN_DLBINARY:
	   case SLANG_BC_RET_LVARIABLE:
	   case SLANG_BC_RET_LITERAL_INT:
	   case SLANG_BC_MANY_LVARIABLE:
	   case SLANG_BC_MANY_LVARIABLE_DIR:
	   case SLANG_BC_LVARIABLE_AGET1:
	   case SLANG_BC_LITERAL_AGET1:
	   case SLANG_BC_LVAR_LVAR_APUT1:
	   case SLANG_BC_LVARIABLE_APUT1:
	   case SLANG_BC_LITERAL_APUT1:
	   case SLANG_BC_LLVARIABLE_BINARY2:
	   case SLANG_BC_SET_LOCLV_LIT_INT:
	   case SLANG_BC_SET_LOCLV_LIT_AGET1:
	   case SLANG_BC_SET_LOCLV_LVAR:
	   case SLANG_BC_SET_LOCLV_LASTBLOCK:
	   case SLANG_BC_LVAR_EARG_LVAR:
	   case SLANG_BC_LVAR_FIELD:
	   case SLANG_BC_BINARY_LASTBLOCK:
	   case SLANG_BC_EARG_LVARIABLE_INTRINSIC:
	   case SLANG_BC_LVAR_LITERAL_INT:
	   case SLANG_BC_BINARY_SET_LOCLVAL:
	   case SLANG_BC_LVAR_AGET_SET_LOCLVAL:
	   case SLANG_BC_LLVAR_BINARY_IF:
	   case SLANG_BC_IF_BLOCK:
	   case SLANG_BC_LVAR_SET_FIELD:
	   case SLANG_BC_PVAR_SET_GLOB_LVAL:
	   case SLANG_BC_LVAR_SET_GLOB_LVAL:
	   case SLANG_BC_LIT_AGET1_INT_BINARY:
	   case SLANG_BC_BINARY2:
	   case SLANG_BC_LVAR_LIT_AGET1:
# endif
	   case SLANG_BC_UNUSED_0xB7:
	   case SLANG_BC_UNUSED_0xB8:
	   case SLANG_BC_UNUSED_0xB9:
	   case SLANG_BC_UNUSED_0xBA:
	   case SLANG_BC_UNUSED_0xBB:
	   case SLANG_BC_UNUSED_0xBC:
	   case SLANG_BC_UNUSED_0xBD:
	   case SLANG_BC_UNUSED_0xBE:
	   case SLANG_BC_UNUSED_0xBF:
	   case SLANG_BC_LVARIABLE_COMBINED:
	   case SLANG_BC_GVARIABLE_COMBINED:
	   case SLANG_BC_LITERAL_COMBINED:
	   case SLANG_BC_CALL_DIRECT_COMB:
	   case SLANG_BC_COMBINED:
	   case SLANG_BC_BLOCK_COMBINED:
	   case SLANG_BC_UNUSED_0xC6:
	   case SLANG_BC_UNUSED_0xC7:
	   case SLANG_BC_UNUSED_0xC8:
	   case SLANG_BC_UNUSED_0xC9:
	   case SLANG_BC_UNUSED_0xCA:
	   case SLANG_BC_UNUSED_0xCB:
	   case SLANG_BC_UNUSED_0xCC:
	   case SLANG_BC_UNUSED_0xCD:
	   case SLANG_BC_UNUSED_0xCE:
	   case SLANG_BC_UNUSED_0xCF:
	   case SLANG_BC_UNUSED_0xD0:
	   case SLANG_BC_UNUSED_0xD1:
	   case SLANG_BC_UNUSED_0xD2:
	   case SLANG_BC_UNUSED_0xD3:
	   case SLANG_BC_UNUSED_0xD4:
	   case SLANG_BC_UNUSED_0xD5:
	   case SLANG_BC_UNUSED_0xD6:
	   case SLANG_BC_UNUSED_0xD7:
	   case SLANG_BC_UNUSED_0xD8:
	   case SLANG_BC_UNUSED_0xD9:
	   case SLANG_BC_UNUSED_0xDA:
	   case SLANG_BC_UNUSED_0xDB:
	   case SLANG_BC_UNUSED_0xDC:
	   case SLANG_BC_UNUSED_0xDD:
	   case SLANG_BC_UNUSED_0xDE:
	   case SLANG_BC_UNUSED_0xDF:
	   case SLANG_BC_UNUSED_0xE0:
	   case SLANG_BC_UNUSED_0xE1:
	   case SLANG_BC_UNUSED_0xE2:
	   case SLANG_BC_UNUSED_0xE3:
	   case SLANG_BC_UNUSED_0xE4:
	   case SLANG_BC_UNUSED_0xE5:
	   case SLANG_BC_UNUSED_0xE6:
	   case SLANG_BC_UNUSED_0xE7:
	   case SLANG_BC_UNUSED_0xE8:
	   case SLANG_BC_UNUSED_0xE9:
	   case SLANG_BC_UNUSED_0xEA:
	   case SLANG_BC_UNUSED_0xEB:
	   case SLANG_BC_UNUSED_0xEC:
	   case SLANG_BC_UNUSED_0xED:
	   case SLANG_BC_UNUSED_0xEE:
	   case SLANG_BC_UNUSED_0xEF:
	   case SLANG_BC_UNUSED_0xF0:
	   case SLANG_BC_UNUSED_0xF1:
	   case SLANG_BC_UNUSED_0xF2:
	   case SLANG_BC_UNUSED_0xF3:
	   case SLANG_BC_UNUSED_0xF4:
	   case SLANG_BC_UNUSED_0xF5:
	   case SLANG_BC_UNUSED_0xF6:
	   case SLANG_BC_UNUSED_0xF7:
	   case SLANG_BC_UNUSED_0xF8:
	   case SLANG_BC_UNUSED_0xF9:
	   case SLANG_BC_UNUSED_0xFA:
	   case SLANG_BC_UNUSED_0xFB:
	   case SLANG_BC_UNUSED_0xFC:
	   case SLANG_BC_UNUSED_0xFD:
	   case SLANG_BC_UNUSED_0xFE:
	   case SLANG_BC_UNUSED_0xFF:
#else
	   default:
#endif
	     _pSLang_verror (SL_INTERNAL_ERROR, "Byte-Code 0x%X is not valid", addr->bc_main_type);
	  }

	IF_UNLIKELY(Handle_Interrupt != 0)
	  {
	     if (SLang_get_error ())
	       {
		  if (-1 == do_inner_interp_error (err_block, addr_start, addr))
		    return 1;
		  if (SLang_get_error ())
		    return 1;
		  /* Otherwise, error cleared.  Continue onto next bytecode */
	       }
#if SLANG_HAS_SIGNALS
	     (void) check_signals ();
#endif
	     if (Lang_Break_Condition) goto handle_break_condition;
	  }
     }

   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:
#if SLANG_HAS_SIGNALS
   if (Handle_Interrupt)
     check_signals ();
#endif
   return 1;

return_0:
#if SLANG_HAS_SIGNALS
   if (Handle_Interrupt)
     check_signals ();
#endif
   return 0;
}

/*}}}*/

/* 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; */
int _pSLang_Auto_Declare_Globals = 0;
int (*SLang_Auto_Declare_Var_Hook) (SLFUTURE_CONST char *);

static int Local_Variable_Number;
static unsigned int Function_Args_Number;

static int Lang_Defining_Function;
static void (*Default_Variable_Mode) (_pSLang_Token_Type *);
static void (*Default_Define_Function) (SLFUTURE_CONST char *, unsigned long);
static int setup_default_compile_linkage (int);

static int push_compile_context (SLFUTURE_CONST 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;

#define COMPILE_BLOCK_TYPE_NONE		0
#define COMPILE_BLOCK_TYPE_FUNCTION	1
#define COMPILE_BLOCK_TYPE_BLOCK	2
#define COMPILE_BLOCK_TYPE_TOP_LEVEL	3
static int This_Compile_Block_Type = COMPILE_BLOCK_TYPE_NONE;

/* If it returns 0, DO NOT FREE p */
static int lang_free_branch (SLBlock_Type *p)
{
   while (1)
     {
	SLang_Class_Type *cl;

        switch (p->bc_main_type)
	  {
	   case SLANG_BC_BLOCK:
	   case SLANG_BC_IF_BLOCK:
	   case SLANG_BC_BLOCK_COMBINED:
	     if (lang_free_branch(p->b.blk))
	       SLfree((char *)p->b.blk);
	     break;

	   case SLANG_BC_COMBINED:
	     if (0 == (p->bc_flags & BC_LITERAL_MASK))
	       break;
	     /* drop */
	   case SLANG_BC_LITERAL:
	   case SLANG_BC_LITERAL_STR:
	   case SLANG_BC_LITERAL_DBL:
	   case SLANG_BC_LITERAL_COMBINED:
	     /* No user types should be here. */
	     GET_BUILTIN_CLASS(cl, 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_FIELD_REF:
	   case SLANG_BC_SET_STRUCT_LVALUE:
	     SLang_free_slstring ((char *) p->b.s_blk);
	     break;
	   case SLANG_BC_BOS:
#if USE_BC_LINE_NUM
	   case SLANG_BC_LINE_NUM:
#endif
#if SLANG_HAS_DEBUG_CODE
	     if (p->b.line_info != NULL)
	       {
		  SLang_free_slstring (p->b.line_info->filename);
		  SLfree ((char *) p->b.line_info);
	       }
#endif
	     break;
	   default:
	     break;

	   case 0:
	     return 1;
	  }
	p++;
     }
}

static void free_local_variable_names (char **list, unsigned int num)
{
   unsigned int i;

   if (list == NULL)
     return;

   for (i = 0; i < num; i++)
     SLang_free_slstring (list[i]);

   SLfree ((char *) list);
}

static void free_function_header (Function_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);
     }

   if (h->file != NULL) SLang_free_slstring ((char *) h->file);

   if (h->local_variables != NULL)
     free_local_variable_names (h->local_variables, h->nlocals);

   SLfree ((char *) h);
}

static Function_Header_Type *
  allocate_function_header (unsigned int nargs, unsigned int nlocals, SLFUTURE_CONST char *file)
{
   Function_Header_Type *h;
   char **local_variables;
   unsigned int i;

   if (NULL == (h = (Function_Header_Type *)SLcalloc (sizeof (Function_Header_Type), 1)))
     return h;

   h->num_refs = 1;
   /* h->body = NULL; */		       /* body added later */
   h->nlocals = nlocals;
   h->nargs = nargs;
   if (NULL == (h->file = SLang_create_slstring (file)))
     {
	free_function_header (h);
	return NULL;
     }

#if SLANG_HAS_BOSEOS
   h->issue_bofeof_info = (_pSLang_Compile_BOFEOF != 0);
#endif

   if (nlocals == 0)
     return h;

   if (NULL == (local_variables = (char **)SLcalloc (nlocals, sizeof (char *))))
     {
	free_function_header (h);
	return NULL;
     }
   h->local_variables = local_variables;

   for (i = 0; i < nlocals; i++)
     {
	if (NULL == (local_variables[i] = SLang_create_slstring (Local_Variable_Names[i])))
	  {
	     free_function_header (h);
	     return NULL;
	  }
     }
   return 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)
     {
	_pSLang_verror (SL_STACK_OVERFLOW, "Block stack overflow");
	return -1;
     }

   num = 20;
   if (NULL == (b = (SLBlock_Type *) _SLcalloc (num, sizeof (SLBlock_Type))))
     return -1;
   memset ((char *)b, 0, num*sizeof(SLBlock_Type));   /* not done by _SLcalloc */

   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)
     {
	if (_pSLang_Error == 0)
	  SLang_verror (SL_StackUnderflow_Error, "block context stack underflow");
	return -1;
     }

   Block_Context_Stack_Len -= 1;
   c = Block_Context_Stack + Block_Context_Stack_Len;

   if (This_Compile_Block != NULL)
     {
	SLang_verror (SL_Internal_Error, "pop_block_context: block is not NULL");
     }

   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;
}

static int setup_compile_namespaces (SLFUTURE_CONST char *name, SLFUTURE_CONST char *namespace_name)
{
   SLang_NameSpace_Type *static_ns = NULL, *private_ns = NULL;

   if (NULL == (private_ns = _pSLns_get_private_namespace (name, namespace_name)))
     return -1;

   /* The Global namespace is special.  It does not have the same semantics as
    * the static namespace since the Global namespace is _always_ available.
    */
   if ((namespace_name != NULL)
       && (*namespace_name)
       && (0 != strcmp (namespace_name, "Global")))
     {
	if (NULL == (static_ns = _pSLns_create_namespace2 (name, namespace_name)))
	  return -1;
     }
   else static_ns = private_ns;

   setup_default_compile_linkage (static_ns == private_ns);

   This_Static_NameSpace = static_ns;
   This_Private_NameSpace = private_ns;
   return 0;
}

int _pSLcompile_push_context (SLang_Load_Type *load_object)
{
   SLFUTURE_CONST char *name = load_object->name;
   char *ext;
   int status = -1;
   int free_name = 0;

   ext = SLpath_extname (name);
   if (((0 == strncmp (ext, ".slc", 4)) || (0 == strncmp (ext, ".SLC", 4)))
       && ((ext[4] == 0)
#ifdef VMS
	   || (ext[4] == ';')
#endif
	  ))
     {
	unsigned int len = (unsigned int) (ext - name) + 3;

	if (NULL == (name = SLang_create_nslstring (name, len)))
	  return -1;
	free_name = 1;
     }

   if (-1 == push_compile_context (name))
     goto free_return;

   if (-1 == setup_compile_namespaces (name, load_object->namespace_name))
     {
	pop_compile_context ();
	goto free_return;
     }

   if (-1 == push_block_context (COMPILE_BLOCK_TYPE_TOP_LEVEL))
     {
	pop_compile_context ();
	goto free_return;
     }

   (void) _pSLerr_suspend_messages ();
   status = 0;
   /* drop */

   free_return:
   if (free_name)
     SLang_free_slstring ((char *) name);

   return status;
}

static void reset_compiler_state (void);
int _pSLcompile_pop_context (void)
{
   (void) _pSLerr_resume_messages ();

   if (_pSLang_Error) reset_compiler_state ();

   if (This_Compile_Block_Type == COMPILE_BLOCK_TYPE_TOP_LEVEL)
     {
	Compile_ByteCode_Ptr->bc_main_type = SLANG_BC_LAST_BLOCK;
	if (lang_free_branch (This_Compile_Block))
	  {
	     SLfree ((char *) This_Compile_Block);
	     This_Compile_Block = NULL;
	  }
     }

   (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)
     {
	_pSLang_verror (SL_INTERNAL_ERROR, "Not at top-level");
	return -1;
     }
#endif

   return 0;
}

/*{{{ Hash and Name Table Functions */

/* Returns a pointer to the first character past "->" in name.  If "->" does
 * not exist, then it returns a pointer to the beginning of name.
 */
_INLINE_
static char *parse_namespace_encoded_name (SLCONST char *name)
{
   char *ns;

   ns = (char *)name;
   name = strchr (name, '-');
   if ((name == NULL) || (name [1] != '>'))
     return ns;

   return (char*)name + 2;
}

static SLang_Name_Type *locate_namespace_encoded_name (SLCONST char *name, int err_on_bad_ns)
{
   char *ns;
   SLang_NameSpace_Type *table;
   SLang_Name_Type *nt;

   ns = (char *) name;
   name = parse_namespace_encoded_name (ns);

   if (name == ns)
     {
	/* Use Global Namespace */
	return _pSLns_locate_hashed_name (Global_NameSpace, name, SLcompute_string_hash (name));
     }

   ns = SLang_create_nslstring (ns, (unsigned int) ((name-2) - ns));
   if (ns == NULL)
     return NULL;
   if (NULL == (table = _pSLns_find_namespace (ns)))
     {
	if (err_on_bad_ns)
	  _pSLang_verror (SL_SYNTAX_ERROR, "Unable to find namespace called %s", ns);
	SLang_free_slstring (ns);
	return NULL;
     }
   SLang_free_slstring (ns);

   nt = _pSLns_locate_hashed_name (table, name, SLcompute_string_hash (name));
   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 *
  find_global_hashed_name (SLCONST char *name, unsigned long hash,
			   SLang_NameSpace_Type *pns, SLang_NameSpace_Type *sns,
			   SLang_NameSpace_Type *gns,
			   int do_error)
{
   SLang_Name_Type *nt;

   if ((pns != NULL) && (pns != sns))
     {
	if (NULL != (nt = _pSLns_locate_hashed_name (pns, name, hash)))
	  return nt;
     }
   if ((sns != NULL) && (sns != gns))
     {
	if (NULL != (nt = _pSLns_locate_hashed_name (sns, name, hash)))
	  return nt;
     }

   if (gns != NULL)
     {
	if (NULL != (nt = _pSLns_locate_hashed_name (gns, name, hash)))
	  return nt;
     }

   if (do_error)
     _pSLang_verror (SL_UNDEFINED_NAME, "Unable to locate '%s'", name);

   return NULL;
}

static SLang_Name_Type *locate_hashed_name (SLCONST char *name, unsigned long hash, int err_on_bad_ns)
{
   SLang_Name_Type *t;

   if (Locals_NameSpace != NULL)
     {
	t = _pSLns_locate_hashed_name (Locals_NameSpace, name, hash);
	if (t != NULL)
	  return t;
     }

   t = find_global_hashed_name (name, hash, This_Private_NameSpace, This_Static_NameSpace, Global_NameSpace, 0);
   if (t == NULL)
     t = locate_namespace_encoded_name (name, err_on_bad_ns);
   return t;
}

SLang_Name_Type *_pSLlocate_name (SLCONST char *name)
{
   return locate_hashed_name (name, SLcompute_string_hash (name), 0);
}

SLang_Name_Type *_pSLlocate_global_name (SLCONST char *name)
{
   return _pSLns_locate_name (Global_NameSpace, name);
}

static SLang_Name_Type *
  add_name_to_namespace (SLCONST char *name, unsigned long hash,
			 unsigned int sizeof_obj, unsigned char name_type,
			 SLang_NameSpace_Type *ns)
{
   SLang_Name_Type *t;

   if (-1 == _pSLcheck_identifier_syntax (name))
     return NULL;

   t = (SLang_Name_Type *) SLcalloc (sizeof_obj, 1);
   if (t == NULL)
     return t;

   t->name_type = name_type;

   if ((NULL == (t->name = _pSLstring_dup_hashed_string (name, hash)))
       || (-1 == _pSLns_add_hashed_name (ns, t, hash)))
     {
	SLfree ((char *) t);
	return NULL;
     }
   return t;
}

static SLang_Name_Type *
add_global_name (SLCONST char *name, unsigned long hash,
		 unsigned char name_type, unsigned int sizeof_obj,
		 SLang_NameSpace_Type *ns)
{
   SLang_Name_Type *nt;

   nt = _pSLns_locate_hashed_name (ns, name, hash);
   if (nt != NULL)
     {
	if (nt->name_type == name_type)
	  return nt;

	_pSLang_verror (SL_DUPLICATE_DEFINITION, "%s cannot be re-defined", name);
	return NULL;
     }

   return add_name_to_namespace (name, hash, sizeof_obj, name_type, ns);
}

static int add_intrinsic_function (SLang_NameSpace_Type *ns,
				   SLCONST char *name, FVOID_STAR addr, SLtype ret_type,
				   unsigned int nargs, SLtype *arg_types)
{
   SLang_Intrin_Fun_Type *f;
   unsigned int i;

   if (-1 == init_interpreter ())
     return -1;

   if (ns == NULL) ns = Global_NameSpace;

   if (ret_type == SLANG_FLOAT_TYPE)
     {
	_pSLang_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] = arg_types[i];

   return 0;
}

static int va_add_intrinsic_function (SLang_NameSpace_Type *ns,
				      SLCONST char *name, FVOID_STAR addr, SLtype ret_type,
				      unsigned int nargs, va_list ap)
{
   SLtype arg_types [SLANG_MAX_INTRIN_ARGS];
   unsigned int i;

   if (nargs > SLANG_MAX_INTRIN_ARGS)
     {
	_pSLang_verror (SL_APPLICATION_ERROR, "Function %s requires too many arguments", name);
	return -1;
     }

   for (i = 0; i < nargs; i++)
     arg_types [i] = va_arg (ap, unsigned int);

   return add_intrinsic_function (ns, name, addr, ret_type, nargs, arg_types);
}

int SLadd_intrinsic_function (SLFUTURE_CONST char *name, FVOID_STAR addr, SLtype ret_type,
			      unsigned int nargs, ...)
{
   va_list ap;
   int status;

   va_start (ap, nargs);
   status = va_add_intrinsic_function (NULL, name, addr, ret_type, nargs, ap);
   va_end (ap);

   return status;
}

int SLns_add_intrinsic_function (SLang_NameSpace_Type *ns,
				 SLFUTURE_CONST char *name, FVOID_STAR addr, SLtype ret_type,
				 unsigned int nargs, ...)
{
   va_list ap;
   int status;

   va_start (ap, nargs);
   status = va_add_intrinsic_function (ns, name, addr, ret_type, nargs, ap);
   va_end (ap);

   return status;
}

static SLang_Name_Type *add_xxx_helper (SLang_NameSpace_Type *ns, SLCONST char *name,
					int what, unsigned int sizeof_what)
{
   if (-1 == init_interpreter ())
     return NULL;

   if (ns == NULL) ns = Global_NameSpace;

   return add_global_name (name,
			   SLcompute_string_hash (name),
			   what, sizeof_what, ns);
}

int SLns_add_hconstant (SLang_NameSpace_Type *ns, SLFUTURE_CONST char *name, SLtype type, short value)
{
   SLang_HConstant_Type *v;

   v = (SLang_HConstant_Type *)add_xxx_helper (ns, name, SLANG_HCONSTANT, sizeof (SLang_HConstant_Type));
   if (v == NULL)
     return -1;
   v->value = value;
   v->data_type = type;
   return 0;
}

int SLns_add_iconstant (SLang_NameSpace_Type *ns, SLFUTURE_CONST char *name, SLtype type, int value)
{
   SLang_IConstant_Type *v;

   v = (SLang_IConstant_Type *)add_xxx_helper (ns, name, SLANG_ICONSTANT, sizeof (SLang_IConstant_Type));
   if (v == NULL)
     return -1;
   v->value = value;
   v->data_type = type;
   return 0;
}

int SLns_add_lconstant (SLang_NameSpace_Type *ns, SLFUTURE_CONST char *name, SLtype type, long value)
{
   SLang_LConstant_Type *v;

   v = (SLang_LConstant_Type *)add_xxx_helper (ns, name, SLANG_LCONSTANT, sizeof (SLang_LConstant_Type));
   if (v == NULL)
     return -1;
   v->value = value;
   v->data_type = type;
   return 0;
}

#ifdef HAVE_LONG_LONG
int _pSLns_add_llconstant (SLang_NameSpace_Type *ns, SLFUTURE_CONST char *name, SLtype type, long long value)
{
   _pSLang_LLConstant_Type *v;

   v = (_pSLang_LLConstant_Type *)add_xxx_helper (ns, name, SLANG_LLCONSTANT, sizeof (_pSLang_LLConstant_Type));
   if (v == NULL)
     return -1;
   v->value = value;
   v->data_type = type;
   return 0;
}
#endif

#if SLANG_HAS_FLOAT
int SLns_add_dconstant (SLang_NameSpace_Type *ns, SLFUTURE_CONST char *name, double value)
{
   SLang_DConstant_Type *v;

   v = (SLang_DConstant_Type *)add_xxx_helper (ns, name, SLANG_DCONSTANT, sizeof (SLang_DConstant_Type));
   if (v == NULL)
     return -1;
   v->d = value;
   return 0;
}

int SLns_add_fconstant (SLang_NameSpace_Type *ns, SLFUTURE_CONST char *name, float value)
{
   SLang_FConstant_Type *v;

   v = (SLang_FConstant_Type *)add_xxx_helper (ns, name, SLANG_FCONSTANT, sizeof (SLang_FConstant_Type));
   if (v == NULL)
     return -1;
   v->f = value;
   return 0;
}
#endif

#ifdef HAVE_LONG_LONG
int SLns_add_llconstant (SLang_NameSpace_Type *ns, SLFUTURE_CONST char *name, long long value)
{
   SLang_LLConstant_Type *v;

   v = (SLang_LLConstant_Type *)add_xxx_helper (ns, name, SLANG_LLCONSTANT, sizeof (SLang_LLConstant_Type));
   if (v == NULL)
     return -1;
   v->ll = value;
   return 0;
}

#endif
int SLns_add_intrinsic_variable (SLang_NameSpace_Type *ns,
				 SLFUTURE_CONST char *name, VOID_STAR addr, SLtype data_type, int ro)
{
   SLang_Intrin_Var_Type *v;

   v = (SLang_Intrin_Var_Type *)add_xxx_helper (ns, name,
						(ro ? SLANG_RVARIABLE : SLANG_IVARIABLE),
						 sizeof (SLang_Intrin_Var_Type));
   if (v == NULL)
     return -1;

   v->addr = addr;
   v->type = data_type;
   return 0;
}

int SLadd_intrinsic_variable (SLFUTURE_CONST char *name, VOID_STAR addr, SLtype data_type, int ro)
{
   return SLns_add_intrinsic_variable (NULL, name, addr, data_type, ro);
}

static int
add_slang_function (SLFUTURE_CONST char *name, unsigned char type, unsigned long hash,
		    Function_Header_Type *h, SLFUTURE_CONST char *file,
		    SLang_NameSpace_Type *ns)
{
   _pSLang_Function_Type *f;

   if (file != NULL)
     {
	if (NULL == (file = SLang_create_slstring (file)))
	  return -1;
     }

   f = (_pSLang_Function_Type *)add_global_name (name, hash,
						 type,
						 sizeof (_pSLang_Function_Type),
						 ns);
   if (f == NULL)
     {
	SLang_free_slstring ((char *) file);
	return -1;
     }

   if (f->header != NULL)
     {
	free_function_header (f->header);
	/* free_namespace (f->v.ns); */
     }
   else if (f->autoload_file != NULL)
     {
	SLang_free_slstring ((char *) f->autoload_file);
	f->autoload_file = NULL;
     }

   f->header = h;

   if (h != NULL)
     {
	h->private_ns = This_Private_NameSpace;
	h->static_ns = This_Static_NameSpace;
     }
   else
     {
	f->autoload_ns = ns;
	f->autoload_file = file;
     }

   return 0;
}

static int SLns_autoload (SLFUTURE_CONST char *name, SLFUTURE_CONST char *file, SLFUTURE_CONST char *nsname)
{
   unsigned long hash;
   SLang_NameSpace_Type *ns;
   SLFUTURE_CONST char *cnsname = nsname;

   if (cnsname == NULL)
     cnsname = _pSLang_cur_namespace_intrinsic ();

   if (*cnsname == 0)
     cnsname = "Global";

   hash = SLcompute_string_hash (name);
   if (NULL != (ns = _pSLns_find_namespace (cnsname)))
     {
	_pSLang_Function_Type *f;

	f = (_pSLang_Function_Type *)_pSLns_locate_hashed_name (ns, name, hash);

	if ((f != NULL)
	    && (f->name_type == SLANG_FUNCTION)
	    && (f->header != NULL))
	  {
	     /* already loaded */
	     return 0;
	  }
     }
   else if (NULL == (ns = SLns_create_namespace (cnsname)))
     return -1;

   if (-1 == add_slang_function (name, SLANG_FUNCTION, hash,
				 NULL, file, ns))
     return -1;

   return 0;
}

int SLang_autoload (SLFUTURE_CONST char *name, SLFUTURE_CONST char *file)
{
   SLFUTURE_CONST char *ns;
   int status;

   ns = name;
   name = parse_namespace_encoded_name (ns);
   if (ns == name)
     return SLns_autoload (name, file, NULL);

   /* At this point, name points past "->" in ns. */
   if (NULL == (ns = SLmake_nstring (ns, ((name-2) - ns))))
     return -1;

   status = SLns_autoload (name, file, ns);
   SLfree ((char *) ns);
   return status;
}

/*}}}*/

/* call inner interpreter or return for more */
static void lang_try_now(void)
{
/* #if SLANG_HAS_DEBUG_CODE */
   Compile_ByteCode_Ptr->linenum = (unsigned short) This_Compile_Linenum;
/* #endif */
   Compile_ByteCode_Ptr++;
   if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL)
     return;

/* #if SLANG_HAS_DEBUG_CODE */
   Compile_ByteCode_Ptr->linenum = (unsigned short) This_Compile_Linenum;
/* #endif */
   Compile_ByteCode_Ptr->bc_main_type = SLANG_BC_LAST_BLOCK;

   /* now do it */
   inner_interp (This_Compile_Block);
   (void) lang_free_branch (This_Compile_Block);
   Compile_ByteCode_Ptr = This_Compile_Block;
   Lang_Break = Lang_Break_Condition = Lang_Return = 0;
}

static void interp_pending_blocks (void)
{
   if ((This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL)
       || (Compile_ByteCode_Ptr == This_Compile_Block))
     return;

   Compile_ByteCode_Ptr->linenum = (unsigned short) This_Compile_Linenum;
   Compile_ByteCode_Ptr->bc_main_type = SLANG_BC_LAST_BLOCK;

   inner_interp (This_Compile_Block);
   (void) lang_free_branch (This_Compile_Block);
   Compile_ByteCode_Ptr = This_Compile_Block;
   Lang_Break = Lang_Break_Condition = Lang_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(SLFUTURE_CONST 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_HCONSTANT:
      case SLANG_ICONSTANT:
      case SLANG_LCONSTANT:
      case SLANG_LLCONSTANT:
      case SLANG_FCONSTANT:
      case SLANG_DCONSTANT:
      case SLANG_RVARIABLE:
      case SLANG_IVARIABLE:
	return -1;

      case SLANG_INTRINSIC:
      case SLANG_MATH_UNARY:
      case SLANG_APP_UNARY:
      case SLANG_ARITH_UNARY:
      case SLANG_ARITH_BINARY:
      default:
	return 1;
     }
}

SLang_Name_Type *SLang_get_fun_from_ref (SLang_Ref_Type *ref)
{
   if (ref->data_is_nametype)
     {
	SLang_Name_Type *nt = *(SLang_Name_Type **)ref->data;

	if (_pSLang_ref_is_callable (ref))
	  return nt;

	_pSLang_verror (SL_TYPE_MISMATCH,
		      "Reference to a function expected.  Found &%s",
		      nt->name);
     }
   else
     _pSLang_verror (SL_TYPE_MISMATCH,
		   "Reference to a function expected");
   return NULL;
}

/* This function shall never run if there is an error */
int SLexecute_function (SLang_Name_Type *nt)
{
   unsigned char type;
   SLCONST char *name;
   int status = 1;

   if (nt == NULL)
     return -1;

   if (IS_SLANG_ERROR)
     return -1;

   (void) _pSLerr_suspend_messages ();

   type = nt->name_type;
   name = nt->name;

   switch (type)
     {
      case SLANG_PFUNCTION:
      case SLANG_FUNCTION:
	execute_slang_fun ((_pSLang_Function_Type *) nt, This_Compile_Linenum);
	break;

      case SLANG_INTRINSIC:
	execute_intrinsic_fun ((SLang_Intrin_Fun_Type *) nt);
	break;

      case SLANG_MATH_UNARY:
      case SLANG_APP_UNARY:
      case SLANG_ARITH_UNARY:
      case SLANG_ARITH_BINARY:
	inner_interp_nametype (nt, 0);
	break;

      default:
	_pSLang_verror (SL_TYPE_MISMATCH, "%s is not a function", name);
     }

   if (IS_SLANG_ERROR)
     {
	if (SLang_Traceback & SL_TB_FULL)
	  _pSLang_verror (0, "Error encountered while executing %s", name);
	status = -1;
     }

   (void) _pSLerr_resume_messages ();
   return status;
}

int SLang_execute_function (SLFUTURE_CONST 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 (SLFUTURE_CONST char *name)
{
   SLang_Name_Type *entry;

   if (NULL == (entry = locate_namespace_encoded_name (name, 0)))
     return NULL;

   if (is_nametype_callable (entry))
     return entry;

   return NULL;
}

static void lang_begin_function (void)
{
   if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL)
     {
	_pSLang_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 rearrange_optimized_binary (SLBlock_Type *b, _pSLang_BC_Type t1, _pSLang_BC_Type t2, _pSLang_BC_Type t3)
{
   SLBlock_Type tmp;

   b->bc_main_type = t1;
   (b-1)->bc_main_type = t3;
   (b-2)->bc_main_type = t2;

   tmp = *b;
   *b = *(b-1);
   *(b-1) = *(b-2);
   *(b-2) = tmp;
}

static void rearrange_optimized_optimized (SLBlock_Type *b, _pSLang_BC_Type t1)
{
   SLBlock_Type tmp;
   b->bc_main_type = t1;

   tmp = *b;
   *b = *(b-1);
   *(b-1) = *(b-2);
   *(b-2) = *(b-3);
   *(b-3) = tmp;
# if 1
   (b)->bc_main_type = SLANG_BC_COMBINED;
   (b-1)->bc_main_type = SLANG_BC_COMBINED;
   (b-2)->bc_main_type = SLANG_BC_COMBINED;
# endif
}

static void rearrange_optimized_unary (SLBlock_Type *b, _pSLang_BC_Type t1, _pSLang_BC_Type t2)
{
   SLBlock_Type tmp;

   b->bc_main_type = t1;
   (b-1)->bc_main_type = t2;

   tmp = *b;
   *b = *(b-1);
   *(b-1) = tmp;
}

#define COMPILE_COMBINE_STATS 0
#if COMPILE_COMBINE_STATS
static unsigned int Combine_Statistics [0x10000U];
static void write_combine_stats (void)
{
   unsigned int i;
   FILE *fp = fopen ("combine_stats.dat", "w");
   if (fp == NULL)
     return;

   for (i = 0; i < 0x10000U; i++)
     {
	if (Combine_Statistics[i])
	  fprintf (fp, "%5d\t0x%04X\n", Combine_Statistics[i], i);
     }
   (void) fclose (fp);
}

static void gather_statistics (SLBlock_Type *b)
{
   static int inited = 0;
   unsigned char last, next;

   if (inited == 0)
     SLang_add_cleanup_function (write_combine_stats);

   last = 0;
   while ((next = b->bc_main_type) != 0)
     {
	Combine_Statistics[last*256 + next] += 1;
	last = next;
	b++;
     }
}

#endif

static void optimize_block4 (SLBlock_Type *b)
{
   while (1)
     {
	switch (b->bc_main_type)
	  {
	   case SLANG_BC_LAST_BLOCK:
	     return;

	   default:
	     b++;
	     break;

   	   case SLANG_BC_LVARIABLE:
	     b++;
	     if (b->bc_main_type == SLANG_BC_LVARIABLE)
	       {
		  SLBlock_Type *b0 = b - 1;
		  b0->bc_main_type = SLANG_BC_MANY_LVARIABLE;
		  do
		    {
		       b->bc_main_type = SLANG_BC_LVARIABLE_COMBINED;
		       b++;
		    }
		  while (b->bc_main_type == SLANG_BC_LVARIABLE);
		  if (b->bc_main_type == SLANG_BC_CALL_DIRECT)
		    {
		       b0->bc_main_type = SLANG_BC_MANY_LVARIABLE_DIR;
		       b->bc_main_type = SLANG_BC_CALL_DIRECT_COMB;
		       b++;
		    }
		  break;
	       }
	     if (b->bc_main_type == SLANG_BC_LITERAL_AGET1)
	       {
		  (b-1)->bc_main_type = SLANG_BC_LVAR_LIT_AGET1;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b += 3;
		  break;
	       }
	     break;
	  }
     }
}

static void optimize_block3 (SLBlock_Type *b)
{
   while (1)
     {
	switch (b->bc_main_type)
	  {
	   case SLANG_BC_LAST_BLOCK:
	     return;

	   default:
	     b++;
	     break;

	   case SLANG_BC_SET_LOCAL_LVALUE:
	     b++;
	     if (b->bc_main_type == SLANG_BC_LITERAL_INT)
	       {
		  (b-1)->bc_main_type = SLANG_BC_SET_LOCLV_LIT_INT;
		  b->bc_main_type = SLANG_BC_LITERAL_COMBINED;
		  b++;
		  break;
	       }
	     if (b->bc_main_type == SLANG_BC_LITERAL_AGET1)
	       {
		  (b-1)->bc_main_type = SLANG_BC_SET_LOCLV_LIT_AGET1;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
	       }
	     if (b->bc_main_type == SLANG_BC_LVARIABLE)
	       {
		  (b-1)->bc_main_type = SLANG_BC_SET_LOCLV_LVAR;
		  b->bc_main_type = SLANG_BC_LVARIABLE_COMBINED;
		  b++;
		  break;
	       }
	     if (b->bc_main_type == SLANG_BC_LAST_BLOCK)
	       {
		  (b-1)->bc_main_type = SLANG_BC_SET_LOCLV_LASTBLOCK;
		  return;
	       }
	     break;

	   case SLANG_BC_LVARIABLE:
	     b++;
	     if (b->bc_main_type == SLANG_BC_EARG_LVARIABLE)
	       {
		  (b-1)->bc_main_type = SLANG_BC_LVAR_EARG_LVAR;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
	       }
	     if (b->bc_main_type == SLANG_BC_FIELD)
	       {
		  (b-1)->bc_main_type = SLANG_BC_LVAR_FIELD;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
	       }
	     if (b->bc_main_type == SLANG_BC_LITERAL_INT)
	       {
		  (b-1)->bc_main_type = SLANG_BC_LVAR_LITERAL_INT;
		  b->bc_main_type = SLANG_BC_LITERAL_COMBINED;
		  b++;
		  break;
	       }
	     if (b->bc_main_type == SLANG_BC_LVARIABLE_APUT1)
	       {
		  (b-1)->bc_main_type = SLANG_BC_LVAR_LVAR_APUT1;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
	       }
	     if (b->bc_main_type == SLANG_BC_SET_STRUCT_LVALUE)
	       {
		  (b-1)->bc_main_type = SLANG_BC_LVAR_SET_FIELD;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
	       }
	     if (b->bc_main_type == SLANG_BC_SET_GLOBAL_LVALUE)
	       {
		  (b-1)->bc_main_type = SLANG_BC_LVAR_SET_GLOB_LVAL;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
	       }
	     break;

	   case SLANG_BC_PVARIABLE:
	     b++;
	     if (b->bc_main_type == SLANG_BC_SET_GLOBAL_LVALUE)
	       {
		  (b-1)->bc_main_type = SLANG_BC_PVAR_SET_GLOB_LVAL;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
	       }
	     break;

	   case SLANG_BC_BINARY:
	     /* Anything added here may need to be accounted for in do_compare() */
	     b++;
	     if (b->bc_main_type == SLANG_BC_LAST_BLOCK)
	       {
		  (b-1)->bc_main_type = SLANG_BC_BINARY_LASTBLOCK;
		  return;
	       }
	     if (b->bc_main_type == SLANG_BC_SET_LOCAL_LVALUE)
	       {
		  (b-1)->bc_main_type = SLANG_BC_BINARY_SET_LOCLVAL;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
	       }
	     if (b->bc_main_type == SLANG_BC_BINARY)
	       {
		  (b-1)->bc_main_type = SLANG_BC_BINARY2;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
	       }
	     break;

	   case SLANG_BC_EARG_LVARIABLE:
	     b++;
	     if (b->bc_main_type == SLANG_BC_INTRINSIC)
	       {
		  (b-1)->bc_main_type = SLANG_BC_EARG_LVARIABLE_INTRINSIC;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
	       }
	     break;

	   case SLANG_BC_LVARIABLE_AGET:
	     b++;
	     if (b->bc_main_type == SLANG_BC_SET_LOCAL_LVALUE)
	       {
		  (b-1)->bc_main_type = SLANG_BC_LVAR_AGET_SET_LOCLVAL;
		  b->bc_main_type= SLANG_BC_COMBINED;
		  b++;
		  break;
	       }
	     break;

	   case SLANG_BC_LLVARIABLE_BINARY:
	     b += 3;
	     if (b->bc_main_type == SLANG_BC_BINARY)
	       {
		  (b-3)->bc_main_type = SLANG_BC_LLVARIABLE_BINARY2;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
	       }
	     if (b->bc_main_type == SLANG_BC_IF_BLOCK)
	       {
		  (b-3)->bc_main_type = SLANG_BC_LLVAR_BINARY_IF;
		  b->bc_main_type = SLANG_BC_BLOCK_COMBINED;
		  b++;
		  break;
	       }
	     break;

	   case SLANG_BC_LITERAL_AGET1:
	     b += 3;
	     if (b->bc_main_type == SLANG_BC_LITERAL_INT_BINARY)
	       {
		  (b-3)->bc_main_type = SLANG_BC_LIT_AGET1_INT_BINARY;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b += 2;
		  break;
	       }
	     break;
	  }
     }
}

static void optimize_block2 (SLBlock_Type *b)
{
   while (1)
     {
	switch (b->bc_main_type)
	  {
	   default:
	     b++;
	     break;

	   case SLANG_BC_LAST_BLOCK:
	     return;

	   case SLANG_BC_CALL_DIRECT_LVAR:
	     if (b->b.call_function != start_arg_list)
	       {
		  b += 2;	       /* combined code, add 2 */
		  break;
	       }
	     b += 2;		       /* combined code */
	     if (((b-1)->bc_main_type == SLANG_BC_LVARIABLE_COMBINED)
		 && (b->bc_main_type == SLANG_BC_LVARIABLE_AGET))
	       {
		  b->bc_main_type = SLANG_BC_COMBINED;
		  (b-2)->bc_main_type = SLANG_BC_LVARIABLE_AGET1;
		  b++;
		  break;
	       }
	     if (((b-1)->bc_main_type == SLANG_BC_LVARIABLE_COMBINED)
		 && (b->bc_main_type == SLANG_BC_LVARIABLE_APUT))
	       {
		  b->bc_main_type = SLANG_BC_COMBINED;
		  (b-2)->bc_main_type = SLANG_BC_LVARIABLE_APUT1;
		  b++;
		  break;
	       }
	     break;

	   case SLANG_BC_CALL_DIRECT_LINT:
	     if (b->b.call_function != start_arg_list)
	       {
		  b += 2;	       /* combined code, add 2 */
		  break;
	       }
	     b += 2;		       /* combined code */
	     if (((b-1)->bc_main_type == SLANG_BC_LITERAL_COMBINED)
		 && (b->bc_main_type == SLANG_BC_LVARIABLE_AGET))
	       {
		  b->bc_main_type = SLANG_BC_COMBINED;
		  (b-2)->bc_main_type = SLANG_BC_LITERAL_AGET1;
		  b++;
		  break;
	       }
	     if (((b-1)->bc_main_type == SLANG_BC_LITERAL_COMBINED)
		 && (b->bc_main_type == SLANG_BC_LVARIABLE_APUT))
	       {
		  b->bc_main_type = SLANG_BC_COMBINED;
		  (b-2)->bc_main_type = SLANG_BC_LITERAL_APUT1;
		  b++;
		  break;
	       }
	     break;
	  }
     }
}

/* Note: Make sure lang_free_branch is suitably modified to account for
 * changes here.
 */
static void optimize_block1 (SLBlock_Type *b)
{
   SLBlock_Type *bstart, *b1, *b2;
   SLtype b2_main_type;

   bstart = b;

   while (1)
     {
	switch (b->bc_main_type)
	  {
	   case 0:
	     return;

	   default:
	     b++;
	     break;

	   case SLANG_BC_SET_LOCAL_LVALUE:
	     if ((b->bc_sub_type != SLANG_BCST_ASSIGN)
		 || (bstart + 3 > b))
	       {
		  b++;
		  continue;
	       }
	     b2 = b - 3;
	     b2_main_type = b2->bc_main_type;

	     switch (b2_main_type)
	       {
		case SLANG_BC_LLVARIABLE_BINARY:
		  rearrange_optimized_optimized (b, SLANG_BC_LASSIGN_LLBINARY);
		  break;
		case SLANG_BC_LIVARIABLE_BINARY:
		  rearrange_optimized_optimized (b, SLANG_BC_LASSIGN_LIBINARY);
		  break;
		case SLANG_BC_ILVARIABLE_BINARY:
		  rearrange_optimized_optimized (b, SLANG_BC_LASSIGN_ILBINARY);
		  break;
		case SLANG_BC_LDVARIABLE_BINARY:
		  rearrange_optimized_optimized (b, SLANG_BC_LASSIGN_LDBINARY);
		  break;
		case SLANG_BC_DLVARIABLE_BINARY:
		  rearrange_optimized_optimized (b, SLANG_BC_LASSIGN_DLBINARY);
		  break;
	       }
	     b++;
	     break;

	   case SLANG_BC_BINARY:
	     if (bstart + 2 > b)
	       {
		  b++;
		  break;
	       }
	     b2 = b-1;
	     b1 = b2-1;
	     b2_main_type = b2->bc_main_type;

	     switch (b1->bc_main_type)
	       {
		case SLANG_LVARIABLE:
		  if (b2_main_type == SLANG_LVARIABLE)
		    rearrange_optimized_binary (b,
						SLANG_BC_LLVARIABLE_BINARY,
						SLANG_BC_LVARIABLE_COMBINED,
						SLANG_BC_LVARIABLE_COMBINED);
		  else if (b2_main_type == SLANG_GVARIABLE)
		    rearrange_optimized_binary (b,
						SLANG_BC_LGVARIABLE_BINARY,
						SLANG_BC_LVARIABLE_COMBINED,
						SLANG_BC_GVARIABLE_COMBINED);
		  else if (b2_main_type == SLANG_BC_LITERAL_INT)
		    rearrange_optimized_binary (b,
						SLANG_BC_LIVARIABLE_BINARY,
						SLANG_BC_LVARIABLE_COMBINED,
						SLANG_BC_LITERAL_COMBINED);
		  else if (b2_main_type == SLANG_BC_LITERAL_DBL)
		    rearrange_optimized_binary (b,
						SLANG_BC_LDVARIABLE_BINARY,
						SLANG_BC_LVARIABLE_COMBINED,
						SLANG_BC_LITERAL_COMBINED);
		  break;

		case SLANG_GVARIABLE:
		  if (b2_main_type == SLANG_LVARIABLE)
		    rearrange_optimized_binary (b,
						SLANG_BC_GLVARIABLE_BINARY,
						SLANG_BC_GVARIABLE_COMBINED,
						SLANG_BC_LVARIABLE_COMBINED);
		  else if (b2_main_type == SLANG_GVARIABLE)
		    rearrange_optimized_binary (b,
						SLANG_BC_GGVARIABLE_BINARY,
						SLANG_BC_GVARIABLE_COMBINED,
						SLANG_BC_GVARIABLE_COMBINED);
		  break;

		case SLANG_BC_LITERAL_INT:
		  if (b2_main_type == SLANG_LVARIABLE)
		    rearrange_optimized_binary (b,
						SLANG_BC_ILVARIABLE_BINARY,
						SLANG_BC_LITERAL_COMBINED,
						SLANG_BC_LVARIABLE_COMBINED);
		  break;

		case SLANG_BC_LITERAL_DBL:
		  if (b2_main_type == SLANG_LVARIABLE)
		    rearrange_optimized_binary (b,
						SLANG_BC_DLVARIABLE_BINARY,
						SLANG_BC_LITERAL_COMBINED,
						SLANG_BC_LVARIABLE_COMBINED);
		  break;

		default:
		  if (b2_main_type == SLANG_LVARIABLE)
		    rearrange_optimized_unary (b,
					       SLANG_BC_LVARIABLE_BINARY,
					       SLANG_BC_LVARIABLE_COMBINED);
		  else if (b2_main_type == SLANG_GVARIABLE)
		    rearrange_optimized_unary (b,
					       SLANG_BC_GVARIABLE_BINARY,
					       SLANG_BC_GVARIABLE_COMBINED);
		  else if (b2_main_type == SLANG_BC_LITERAL_INT)
		    rearrange_optimized_unary (b,
					       SLANG_BC_LITERAL_INT_BINARY,
					       SLANG_BC_LITERAL_COMBINED);
		  else if (b2_main_type == SLANG_BC_LITERAL_DBL)
		    rearrange_optimized_unary (b,
					       SLANG_BC_LITERAL_DBL_BINARY,
					       SLANG_BC_LITERAL_COMBINED);
	       }
	     b++;
	     break;

	   case SLANG_BC_CALL_DIRECT:
	     b++;
	     switch (b->bc_main_type)
	       {
		default:
		  break;

		case 0:
		  return;

		case SLANG_BC_INTRINSIC:
		  b->bc_main_type = SLANG_BC_COMBINED;
		  if ((b+1)->bc_main_type == 0)
		    {
		       (b-1)->bc_main_type = SLANG_BC_CALL_DIRECT_RETINTR;
		       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->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
		case SLANG_BC_FUNCTION:
		case SLANG_BC_PFUNCTION:
		  (b-1)->bc_main_type = SLANG_BC_CALL_DIRECT_SLFUN;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
		case SLANG_BC_EARG_LVARIABLE:
		  (b-1)->bc_main_type = SLANG_BC_CALL_DIRECT_EARG_LVAR;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
		case SLANG_BC_LITERAL_INT:
		  b->bc_main_type = SLANG_BC_LITERAL_COMBINED;
		  (b-1)->bc_main_type = SLANG_BC_CALL_DIRECT_LINT;
		  b++;
		  break;
		case SLANG_BC_LVARIABLE:
		  b->bc_main_type = SLANG_BC_LVARIABLE_COMBINED;
		  (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->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
#if 0
		case SLANG_BC_BLOCK:
		  (b-1)->bc_main_type = SLANG_BC_INTRINSIC_BLOCK;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
		  break;
#endif

		case 0:
		  (b-1)->bc_main_type = SLANG_BC_RET_INTRINSIC;
		  return;

		default:
		  break;
	       }
	     break;

	   case SLANG_BC_BLOCK:
	     if (b->bc_sub_type == SLANG_BCST_IF)
	       {
		  b->bc_main_type = SLANG_BC_IF_BLOCK;
		  b++;
		  break;
	       }
	     b++;
	     break;
	   case SLANG_BC_LITERAL_INT:
	     b++;
	     if (b->bc_main_type == SLANG_BC_RETURN)
	       {
		  (b-1)->bc_main_type = SLANG_BC_RET_LITERAL_INT;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
	       }
	     break;

	   case SLANG_BC_LVARIABLE:
	     b++;
	     if (b->bc_main_type == SLANG_BC_RETURN)
	       {
		  (b-1)->bc_main_type = SLANG_BC_RET_LVARIABLE;
		  b->bc_main_type = SLANG_BC_COMBINED;
		  b++;
	       }
	     break;
	  }
     }
}

static void optimize_block (SLBlock_Type *b)
{
   optimize_block1 (b);
   optimize_block2 (b);
   optimize_block3 (b);
   optimize_block4 (b);
}

#endif

static void end_define_function (void)
{
   /* free_local_variable_table (); */
   _pSLns_deallocate_namespace (Locals_NameSpace);
   Locals_NameSpace = NULL;
   Local_Variable_Number = 0;
   Function_Args_Number = 0;
   Lang_Defining_Function = 0;
}

/* name will be NULL if the object is to simply terminate the function
 * definition.  See SLang_restart.
 */
static int lang_define_function (SLFUTURE_CONST char *name, unsigned char type, unsigned long hash,
				 SLang_NameSpace_Type *ns)
{
   Function_Header_Type *h;

   if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_FUNCTION)
     {
	_pSLang_verror (SL_SYNTAX_ERROR, "Premature end of function");
	return -1;
     }

   /* terminate function */
   Compile_ByteCode_Ptr->bc_main_type = SLANG_BC_LAST_BLOCK;
   if (name == NULL)
     {
	end_define_function ();
	return -1;
     }

   h = allocate_function_header (Function_Args_Number,
				 Local_Variable_Number,
				 This_Compile_Filename);
   if (h == NULL)
     {
	end_define_function ();
	return -1;
     }

   if (-1 == add_slang_function (name, type, hash, h, NULL, ns))
     {
	free_function_header (h);
	end_define_function ();
	return -1;
     }

   h->body = This_Compile_Block;
   This_Compile_Block = NULL;
#if USE_COMBINED_BYTECODES
   optimize_block (h->body);
#endif
   end_define_function ();
   pop_block_context ();

   /* A function is only defined at top-level */
   if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL)
     {
	_pSLang_verror (SL_INTERNAL_ERROR, "Not at top-level");
	return -1;
     }
   Compile_ByteCode_Ptr = This_Compile_Block;
   return 0;
}

static int check_linkage (SLCONST char *name, unsigned long hash, int check_static)
{
   SLang_NameSpace_Type *ns;
   int found = 0;

   /* If the variable is already defined in the static hash table,
    * generate an error.
    */
   ns = This_Private_NameSpace;
   if ((ns != NULL) && (This_Static_NameSpace != ns))
     found = (NULL != _pSLns_locate_hashed_name (ns, name, hash));

   if ((found == 0) && (check_static))
     {
	ns = This_Static_NameSpace;
	if ((ns != NULL) && (Global_NameSpace != ns))
	  found = (NULL != _pSLns_locate_hashed_name (ns, name, hash));
     }

   if (found == 0)
     return 0;

   _pSLang_verror (SL_DUPLICATE_DEFINITION,
		 "%s already has static or private linkage in this unit",
		 name);
   return -1;
}

static void define_private_function (SLFUTURE_CONST char *name, unsigned long hash)
{
   (void) lang_define_function (name, SLANG_PFUNCTION, hash, This_Private_NameSpace);
}

static void define_static_function (SLFUTURE_CONST char *name, unsigned long hash)
{
   if (0 == check_linkage (name, hash, 0))
     (void) lang_define_function (name, SLANG_FUNCTION, hash, This_Static_NameSpace);
}

static void define_public_function (SLFUTURE_CONST char *name, unsigned long hash)
{
   if (0 == check_linkage (name, hash, 1))
     (void) lang_define_function (name, SLANG_FUNCTION, hash, Global_NameSpace);
}

static void lang_end_block (void)
{
   SLBlock_Type *node, *branch;

   if (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_BLOCK)
     {
	_pSLang_verror (SL_SYNTAX_ERROR, "Not defining a block");
	return;
     }

   /* terminate the block */
/* #if SLANG_HAS_DEBUG_CODE */
   Compile_ByteCode_Ptr->linenum = (unsigned short) This_Compile_Linenum;
/* #endif */
   Compile_ByteCode_Ptr->bc_main_type = SLANG_BC_LAST_BLOCK;
   branch = This_Compile_Block;  This_Compile_Block = NULL;

#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)
{
   size_t dn, n;
   SLBlock_Type *p;

   if (NULL == (p = This_Compile_Block))
     {
	_pSLang_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 = (This_Compile_Block_Max - p);

   /* enlarge the space by 20 objects */
   dn = 20;

   if (NULL == (p = (SLBlock_Type *) _SLrecalloc((char *)p, n+dn, sizeof(SLBlock_Type))))
     return -1;
   memset ((char *)(p+n), 0, dn*sizeof(SLBlock_Type));

   n = Compile_ByteCode_Ptr - This_Compile_Block;
   This_Compile_Block = p;
   Compile_ByteCode_Ptr = p + n;
   This_Compile_Block_Max = Compile_ByteCode_Ptr + dn;

   return 0;
}

static int add_global_variable (SLCONST 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 = _pSLns_locate_hashed_name (ns, name, hash);

   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 (SLCONST 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 (SLCONST char *name, unsigned long hash)
{
   SLang_Local_Var_Type *t;

   /* local variable */
   if (Local_Variable_Number >= SLANG_MAX_LOCAL_VARIABLES)
     {
	_pSLang_verror (SL_SYNTAX_ERROR, "Too many local variables");
	return -1;
     }

   if (NULL != _pSLns_locate_hashed_name (Locals_NameSpace, name, hash))
     {
	_pSLang_verror (SL_SYNTAX_ERROR, "Local variable %s has already been defined", name);
	return -1;
     }

   t = (SLang_Local_Var_Type *)
     add_name_to_namespace (name, hash,
			    sizeof (SLang_Local_Var_Type), SLANG_LVARIABLE,
			    Locals_NameSpace);
   if (t == NULL)
     return -1;

   t->local_var_number = Local_Variable_Number;
   Local_Variable_Names[Local_Variable_Number] = t->name;
   /* we will copy this later -- it is an slstring and will persist as long
    * as the Locals_NameSpace persists
    */

   Local_Variable_Number++;
   return 0;
}

static void (*Compile_Mode_Function) (_pSLang_Token_Type *);
static void compile_basic_token_mode (_pSLang_Token_Type *);

/* This function could be called when an error has occured during parsing.
 * Its purpose is to "close" any currently opened blocks and functions.
 */
void reset_compiler_state (void)
{
   _pSLcompile_ptr = _pSLcompile;
   Compile_Mode_Function = compile_basic_token_mode;

   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);
	     This_Compile_Block = NULL;
	  }
     }
   Lang_Defining_Function = 0;

   while ((This_Compile_Block_Type != COMPILE_BLOCK_TYPE_TOP_LEVEL)
	  && (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_NONE)
	  && (0 == pop_block_context ()))
     ;
}

/* The active interpreter is the one that is currently executing.  We may
 * have a situation where:  slang -> C -> slang
 * Each "slang" is an interpreter and only one is active.
 */
static void reset_active_interpreter (void)
{
   reset_compiler_state ();

   Trace_Mode = 0;
   Lang_Break = Lang_Return = 0;
}

static void free_local_variables (void)
{
   while (Local_Variable_Frame > Local_Variable_Stack)
     {
	SLang_free_object (Local_Variable_Frame);
	Local_Variable_Frame--;
     }
}

static void clear_switch_objects (void)
{
   SLang_Object_Type *p;

   p = Switch_Objects;
   while (p < Switch_Obj_Max)
     {
	if (p->o_data_type != 0)
	  {
	     SLang_free_object (p);
	     p->o_data_type = 0;
	  }
	p++;
     }
   Switch_Obj_Ptr = Switch_Objects;
}

void SLang_restart (int localv)
{
   reset_active_interpreter ();

   if (SLang_get_error () == SL_STACK_OVERFLOW)
     {
	/* This loop guarantees that the stack is properly cleaned. */
	/* The validity of this step needs to be reexamined in the context
	 * of the new exception handling for slang 2
	 */
	while (Stack_Pointer != Run_Stack)
	  {
	     SLdo_pop ();
	  }
     }

   if (localv)
     {
	free_local_variables ();
	clear_switch_objects ();
	while (0 == pop_compile_context ())
	  ;
     }
   _pSLerr_print_message_queue ();
   _pSLerr_clear_error (0);
}

#if SLANG_HAS_DEBUG_CODE
static void compile_line_info (_pSLang_BC_Type bc_main_type, SLFUTURE_CONST char *file, long linenum)
{
   Linenum_Info_Type *info;

   if (NULL == (info = (Linenum_Info_Type *) SLmalloc (sizeof (Linenum_Info_Type))))
     return;

   info->linenum = (int) linenum;
   if (file == NULL)
     file = "";

   if (NULL == (info->filename = SLang_create_slstring (file)))
     {
	SLfree ((char *) info);
	return;
     }
   Compile_ByteCode_Ptr->bc_main_type = bc_main_type;
   Compile_ByteCode_Ptr->b.line_info = info;
   lang_try_now ();
}

static void set_line_number_info (long val)
{
   This_Compile_Linenum = (unsigned int) val;
}
#endif

static void compile_directive (unsigned char sub_type, int delay_inner_interp)
{
   /* 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;

   if (delay_inner_interp)
     {
	Compile_ByteCode_Ptr->linenum = (unsigned short) This_Compile_Linenum;
	Compile_ByteCode_Ptr++;
	return;
     }
   lang_try_now ();
}

static void compile_unary (int op, _pSLang_BC_Type 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 (_pSLang_BC_Type last_bc, _pSLang_BC_Type 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

/* This is a hack */
typedef struct _Special_NameTable_Type
{
   SLCONST char *name;
   int (*fun) (struct _Special_NameTable_Type *, _pSLang_Token_Type *);
   VOID_STAR blk_data;
   _pSLang_BC_Type main_type;
}
Special_NameTable_Type;

static int handle_special (Special_NameTable_Type *nt, _pSLang_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, _pSLang_Token_Type *tok)
{
   SLFUTURE_CONST char *name;

   (void) nt; (void) tok;

   if (This_Private_NameSpace == NULL) name = "***Unknown***";
   else
     name = This_Private_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;
   Compile_ByteCode_Ptr->bc_flags |= BC_LITERAL_MASK;
   return 0;
}

static int handle_special_line (Special_NameTable_Type *nt, _pSLang_Token_Type *tok)
{
   (void) nt;
#if SLANG_HAS_DEBUG_CODE
   if ((Compile_ByteCode_Ptr->b.l_blk = (long) tok->line_number) <= 0)
     Compile_ByteCode_Ptr->b.l_blk = This_Compile_Linenum;
#else
   (void) tok;
#endif
   Compile_ByteCode_Ptr->bc_main_type = SLANG_BC_LITERAL;
   Compile_ByteCode_Ptr->bc_sub_type = SLANG_UINT_TYPE;
   Compile_ByteCode_Ptr->bc_flags |= BC_LITERAL_MASK;

   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, SLANG_BC_LAST_BLOCK},
     {"__LINE__", handle_special_line, NULL, SLANG_BC_LAST_BLOCK},
#if 0
     {"__NAMESPACE__", handle_special_namespace, NULL, SLANG_BC_LAST_BLOCK},
#endif
     {NULL, NULL, NULL, SLANG_BC_LAST_BLOCK}
};

static void compile_hashed_identifier (SLCONST char *name, unsigned long hash, _pSLang_Token_Type *tok)
{
   SLang_Name_Type *entry;
   _pSLang_BC_Type name_type;

   entry = locate_hashed_name (name, hash, 1);

   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;
	  }

	_pSLang_verror (SL_UNDEFINED_NAME, "%s is undefined", name);
	return;
     }

   name_type = (_pSLang_BC_Type)entry->name_type;
   Compile_ByteCode_Ptr->bc_main_type = name_type;

   if (name_type == SLANG_LVARIABLE)   /* == SLANG_BC_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 (SLCONST char *name, unsigned long hash)
{
   SLang_Name_Type *entry;
   unsigned char name_type;

   if (NULL == (entry = locate_hashed_name (name, hash, 1)))
     {
	_pSLang_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:
	_pSLang_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 (_pSLang_BC_Type 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 (SLCONST char *name, _pSLang_Token_Type *tok)
{
   compile_hashed_identifier (name, SLcompute_string_hash (name), tok);
}

static void compile_call_direct (int (*f) (void), _pSLang_BC_Type 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), _pSLang_BC_Type bc,
				      _pSLang_BC_Type frame_op)
{
#if 1 && 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, _pSLang_BC_Type bc_main_type, SLtype 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;
   Compile_ByteCode_Ptr->bc_flags |= BC_LITERAL_MASK;

   lang_try_now ();
}

#ifdef HAVE_LONG_LONG
static void compile_llong (long long i, _pSLang_BC_Type bc_main_type, SLtype bc_sub_type)
{
# if LLONG_IS_NOT_LONG
   long long *ptr;

   if (NULL == (ptr = (long long *) SLmalloc (sizeof(long long))))
     return;
   *ptr = i;

   Compile_ByteCode_Ptr->b.llong_blk = ptr;
# else
   Compile_ByteCode_Ptr->b.l_blk = i;
# endif
   Compile_ByteCode_Ptr->bc_main_type = bc_main_type;
   Compile_ByteCode_Ptr->bc_sub_type = bc_sub_type;
   Compile_ByteCode_Ptr->bc_flags |= BC_LITERAL_MASK;

   lang_try_now ();
}
#endif

#if SLANG_HAS_FLOAT
static void compile_double (_pSLang_Token_Type *t, _pSLang_BC_Type main_type, SLtype type)
{
   unsigned int factor = 1;
   double *ptr;
   double d;

   d = _pSLang_atof (t->v.s_val);

#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 = main_type;
   Compile_ByteCode_Ptr->bc_sub_type = type;
   Compile_ByteCode_Ptr->bc_flags |= BC_LITERAL_MASK;
   lang_try_now ();
}

static void compile_float (_pSLang_Token_Type *t)
{
   float f = (float) _pSLang_atof (t->v.s_val);

   Compile_ByteCode_Ptr->b.float_blk = f;
   Compile_ByteCode_Ptr->bc_main_type = SLANG_BC_LITERAL;
   Compile_ByteCode_Ptr->bc_sub_type = SLANG_FLOAT_TYPE;
   Compile_ByteCode_Ptr->bc_flags |= BC_LITERAL_MASK;
   lang_try_now ();
}

#endif

static void compile_string (SLCONST char *s, unsigned long hash)
{
   if (NULL == (Compile_ByteCode_Ptr->b.s_blk = _pSLstring_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;
   Compile_ByteCode_Ptr->bc_flags |= BC_LITERAL_MASK;

   lang_try_now ();
}

static void compile_string_dollar (SLCONST char *s, unsigned long hash)
{
   if (NULL == (Compile_ByteCode_Ptr->b.s_blk = _pSLstring_dup_hashed_string (s, hash)))
     return;

   Compile_ByteCode_Ptr->bc_main_type = SLANG_BC_DOLLAR_STR;
   Compile_ByteCode_Ptr->bc_sub_type = SLANG_STRING_TYPE;
   Compile_ByteCode_Ptr->bc_flags |= BC_LITERAL_MASK;

   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;
   Compile_ByteCode_Ptr->bc_flags |= BC_LITERAL_MASK;

   lang_try_now ();
}

static SLang_Name_Type *locate_hashed_name_autodeclare (SLFUTURE_CONST char *name, unsigned long hash,
							unsigned char assign_type)
{
   SLang_Name_Type *v;

   v = locate_hashed_name (name, hash, 1);

   if (v != NULL)
     return v;

   if ((_pSLang_Auto_Declare_Globals == 0)
       || Lang_Defining_Function
       || (NULL != strchr (name, '-'))   /* namespace->name form */
       || (assign_type != SLANG_BCST_ASSIGN)
       || (This_Static_NameSpace == NULL))
     {
	_pSLang_verror (SL_UNDEFINED_NAME, "%s is undefined", name);
	return NULL;
     }
   /* 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 NULL;

   if ((-1 == add_global_variable (name, SLANG_GVARIABLE, hash, This_Static_NameSpace))
       || (NULL == (v = locate_hashed_name (name, hash, 1))))
     return NULL;

   return v;
}

/* assign_type is one of SLANG_BCST_ASSIGN, ... values */
static void compile_assign (unsigned char assign_type,
			    SLFUTURE_CONST char *name, unsigned long hash)
{
   SLang_Name_Type *v;
   _pSLang_BC_Type main_type;
   SLang_Class_Type *cl;

   if (NULL == (v = locate_hashed_name_autodeclare (name, hash, assign_type)))
     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:
	GET_CLASS(cl, ((SLang_Intrin_Var_Type *)v)->type);
	if (cl->cl_class_type != SLANG_CLASS_TYPE_SCALAR)
	  {
	     _pSLang_verror (SL_Forbidden_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:
	_pSLang_verror (SL_READONLY_ERROR, "%s is read-only", name);
	return;

      default:
	_pSLang_verror (SL_Forbidden_Error, "%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 ();
}

#if 0
static void compile_deref_assign (char *name, unsigned long hash)
{
   SLang_Name_Type *v;

   v = locate_hashed_name (name, hash, 1);

   if (v == NULL)
     {
	_pSLang_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.
	 */
	_pSLang_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 ();
}
#endif
static void
compile_struct_assign (_pSLang_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 = _pSLstring_dup_hashed_string (t->v.s_val, t->hash);
   lang_try_now ();
}

static void
compile_array_assign (_pSLang_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_deref_assign (_pSLang_Token_Type *t)
{
   Compile_ByteCode_Ptr->bc_sub_type = SLANG_BCST_ASSIGN + (t->type - _DEREF_ASSIGN_TOKEN);
   Compile_ByteCode_Ptr->bc_main_type = SLANG_BC_SET_DEREF_LVALUE;
   Compile_ByteCode_Ptr->b.s_blk = NULL;
   lang_try_now ();
}

static void compile_dot (_pSLang_Token_Type *t, _pSLang_BC_Type bc_main_type)
{
   Compile_ByteCode_Ptr->bc_main_type = bc_main_type;
   Compile_ByteCode_Ptr->b.s_blk = _pSLstring_dup_hashed_string(t->v.s_val, t->hash);
   lang_try_now ();
}

static void compile_ref (SLFUTURE_CONST char *name, unsigned long hash)
{
   SLang_Name_Type *entry;
   _pSLang_BC_Type main_type;

   if (NULL == (entry = locate_hashed_name_autodeclare (name, hash, SLANG_BCST_ASSIGN)))
     return;

   main_type = (_pSLang_BC_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 (_pSLang_BC_Type break_type,
			   int requires_block, int requires_fun,
			   SLCONST char *str, int opt_val)
{
   if ((requires_fun
	&& (Lang_Defining_Function == 0))
       || (requires_block
	   && (This_Compile_Block_Type != COMPILE_BLOCK_TYPE_BLOCK)))
     {
	_pSLang_verror (SL_SYNTAX_ERROR, "misplaced %s", str);
	return;
     }

   Compile_ByteCode_Ptr->bc_main_type = break_type;
   Compile_ByteCode_Ptr->bc_sub_type = 0;
   Compile_ByteCode_Ptr->b.i_blk = opt_val;

   lang_try_now ();
}

static void compile_public_variable_mode (_pSLang_Token_Type *t)
{
   if (t->type == IDENT_TOKEN)
     {
	if (-1 == check_linkage (t->v.s_val, t->hash, 1))
	  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
     _pSLang_verror (SL_SYNTAX_ERROR, "Misplaced token in variable list");
}

static void compile_local_variable_mode (_pSLang_Token_Type *t)
{
   if (Locals_NameSpace == NULL)
     {
	Locals_NameSpace = _pSLns_allocate_namespace ("**locals**", SLLOCALS_HASH_TABLE_SIZE);
	if (Locals_NameSpace == NULL)
	  return;
     }

   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
     _pSLang_verror (SL_SYNTAX_ERROR, "Misplaced token in variable list");
}

static void compile_static_variable_mode (_pSLang_Token_Type *t)
{
   if (t->type == IDENT_TOKEN)
     {
	if (-1 == check_linkage (t->v.s_val, t->hash, 0))
	  return;
	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
     _pSLang_verror (SL_SYNTAX_ERROR, "Misplaced token in variable list");
}

static void compile_private_variable_mode (_pSLang_Token_Type *t)
{
   if (t->type == IDENT_TOKEN)
     add_global_variable (t->v.s_val, SLANG_PVARIABLE, t->hash, This_Private_NameSpace);
   else if (t->type == CBRACKET_TOKEN)
     Compile_Mode_Function = compile_basic_token_mode;
   else
     _pSLang_verror (SL_SYNTAX_ERROR, "Misplaced token in variable list");
}

static void compile_function_mode (_pSLang_Token_Type *t)
{
   if (-1 == lang_check_space ())
     return;

   if (t->type != IDENT_TOKEN)
     _pSLang_verror (SL_SYNTAX_ERROR, "Expecting a 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;
   _pSLang_BC_Type 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))
	  {
	     _pSLang_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 (_pSLang_Token_Type *t)
{
   int bc_sub_type;
   int delay;

   if (-1 == lang_check_space ())
     return;

   bc_sub_type = -1;
   delay = 0;
   switch (t->type)
     {
      case FOREVER_TOKEN:
	bc_sub_type = SLANG_BCST_FOREVER;
	delay = 1;
	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)
	  {
	     _pSLang_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)
	  {
	     _pSLang_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) */
	if (Lang_Defining_Function == 0)
	  {
	     _pSLang_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;
#ifdef LOOP_ELSE_TOKEN
      case LOOP_ELSE_TOKEN:
	bc_sub_type = SLANG_BCST_LOOP_ELSE;
	break;
#endif
      case LOOP_THEN_TOKEN:
	bc_sub_type = SLANG_BCST_LOOP_THEN;
	break;

      case LOOP_TOKEN:
	bc_sub_type = SLANG_BCST_LOOP;
	delay = 1;
	break;

      case DOWHILE_TOKEN:
	bc_sub_type = SLANG_BCST_DOWHILE;
	delay = 1;
	break;

      case WHILE_TOKEN:
	bc_sub_type = SLANG_BCST_WHILE;
	delay = 1;
	break;

      case ORELSE_TOKEN:
	bc_sub_type = SLANG_BCST_ORELSE;
	break;

      case _FOR_TOKEN:
	bc_sub_type = SLANG_BCST_FOR;
	delay = 1;
	break;

      case FOR_TOKEN:
	bc_sub_type = SLANG_BCST_CFOR;
	delay = 1;
	break;

      case FOREACH_TOKEN:
	delay = 1;
	bc_sub_type = SLANG_BCST_FOREACH;
	break;

      case FOREACH_EARGS_TOKEN:
	delay = 1;
	bc_sub_type = SLANG_BCST_FOREACH_EARGS;
	break;

      case OBRACE_TOKEN:
	lang_begin_block ();
	break;

      case TRY_TOKEN:
	bc_sub_type = SLANG_BCST_TRY;
	break;

      case SC_OR_TOKEN:
	bc_sub_type = SLANG_BCST_SC_OR;
	break;

      case SC_AND_TOKEN:
	bc_sub_type = SLANG_BCST_SC_AND;
	break;

      case _COMPARE_TOKEN:
	bc_sub_type = SLANG_BCST_COMPARE;
	break;

      default:
	_pSLang_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, delay);
}

static unsigned int Assign_Mode_Type;
static void compile_assign_mode (_pSLang_Token_Type *t)
{
   if (t->type != IDENT_TOKEN)
     {
	_pSLang_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 (_pSLang_Token_Type *t)
{
   if (-1 == lang_check_space ())
     return;

   switch (t->type)
     {
      case EOF_TOKEN:
      case NOP_TOKEN:
	interp_pending_blocks ();
	break;

      case PUSH_TOKEN:
      case READONLY_TOKEN:
      case DO_TOKEN:
      case VARIABLE_TOKEN:
      case SEMICOLON_TOKEN:
      default:
	_pSLang_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 _DEREF_OBSOLETE_FUNCALL_TOKEN:
	compile_simple (SLANG_BC_OBSOLETE_DEREF_FUN_CALL);
	break;

      case _DEREF_FUNCALL_TOKEN:
	compile_simple (SLANG_BC_DEREF_FUN_CALL);
	break;

      case STRUCT_TOKEN:
	compile_call_direct (_pSLstruct_define_struct, SLANG_BC_CALL_DIRECT);
	break;

      case STRUCT_WITH_ASSIGN_TOKEN:
	compile_call_direct (_pSLstruct_define_struct2, SLANG_BC_CALL_DIRECT);
	break;

      case TYPEDEF_TOKEN:
	compile_call_direct (_pSLstruct_define_typedef, SLANG_BC_CALL_DIRECT);
	break;

      case DOT_TOKEN:		       /* X . field */
	compile_dot (t, SLANG_BC_FIELD);
	break;

      case DOT_METHOD_CALL_TOKEN:      /* X . field (args) */
	compile_dot (t, SLANG_BC_METHOD);
	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 (start_arg_list, SLANG_BC_CALL_DIRECT);
	break;

      case EARG_TOKEN:
	compile_lvar_call_direct (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 (void) SLang_set_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)
	  _pSLang_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 UCHAR_TOKEN:
	compile_integer (t->v.long_val, SLANG_BC_LITERAL, SLANG_UCHAR_TYPE);
	break;
#if SHORT_IS_NOT_INT
      case SHORT_TOKEN:
	compile_integer (t->v.long_val, SLANG_BC_LITERAL, SLANG_SHORT_TYPE);
	break;
      case USHORT_TOKEN:
	compile_integer (t->v.long_val, SLANG_BC_LITERAL, SLANG_USHORT_TYPE);
	break;
#endif
#if SHORT_IS_INT
      case SHORT_TOKEN:
#endif
#if LONG_IS_INT
      case LONG_TOKEN:
#endif
      case INT_TOKEN:
	compile_integer (t->v.long_val, SLANG_BC_LITERAL_INT, SLANG_INT_TYPE);
	break;
#if SHORT_IS_INT
      case USHORT_TOKEN:
#endif
#if LONG_IS_INT
      case ULONG_TOKEN:
#endif
      case UINT_TOKEN:
	compile_integer (t->v.long_val, SLANG_BC_LITERAL, SLANG_UINT_TYPE);
	break;
#if LONG_IS_NOT_INT
      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;
#endif

#if SLANG_HAS_FLOAT
      case FLOAT_TOKEN:
	compile_float (t);
	break;

      case DOUBLE_TOKEN:
	compile_double (t, SLANG_BC_LITERAL_DBL, SLANG_DOUBLE_TYPE);
	break;
#endif
#if SLANG_HAS_COMPLEX
      case COMPLEX_TOKEN:
	compile_double (t, SLANG_BC_LITERAL, SLANG_COMPLEX_TYPE);
	break;
#endif
#ifdef HAVE_LONG_LONG
      case LLONG_TOKEN:
	compile_llong (t->v.llong_val, SLANG_BC_LITERAL, _pSLANG_LLONG_TYPE);
	break;
      case ULLONG_TOKEN:
	compile_llong (t->v.ullong_val, SLANG_BC_LITERAL, _pSLANG_ULLONG_TYPE);
	break;
#endif
      case STRING_TOKEN:
	compile_string (t->v.s_val, t->hash);
	break;

      case STRING_DOLLAR_TOKEN:
	compile_string_dollar (t->v.s_val, t->hash);
	break;

      case _BSTRING_TOKEN:
	  {
	     SLang_BString_Type *b = SLbstring_create ((unsigned char *)t->v.s_val, (unsigned int) t->hash);
	     if (b != NULL)
	       {
		  compile_bstring (b);
		  SLbstring_free (b);
	       }
	  }
	break;

      case BSTRING_TOKEN:
	compile_bstring (t->v.b_val);
	break;

      case MULTI_STRING_TOKEN:
	  {
	     _pSLang_Multiline_String_Type *m = t->v.multistring_val;
	     if (m->type == STRING_TOKEN)
	       compile_string (m->v.s_val, m->hash);
	     else if (m->type == STRING_DOLLAR_TOKEN)
	       compile_string_dollar (m->v.s_val, m->hash);
	     else if (m->type == BSTRING_TOKEN)
	       compile_bstring (m->v.b_val);
	  }
	break;

      case _NULL_TOKEN:
	compile_identifier ("NULL", t);
	break;

      case _INLINE_WILDCARD_ARRAY_TOKEN:
	compile_call_direct (_pSLarray_wildcard_array, SLANG_BC_CALL_DIRECT);
	break;

      case _INLINE_ARRAY_TOKEN:
	compile_call_direct (_pSLarray_inline_array, SLANG_BC_CALL_DIRECT_NARGS);
	break;

      case _INLINE_IMPLICIT_ARRAY_TOKEN:
	compile_call_direct (_pSLarray_inline_implicit_array, SLANG_BC_CALL_DIRECT_NARGS);
	break;

      case _INLINE_LIST_TOKEN:
	compile_call_direct (_pSLlist_inline_list, SLANG_BC_CALL_DIRECT_NARGS);
	break;

      case ARRAY_TOKEN:
	compile_lvar_call_direct (_pSLarray_aget, SLANG_BC_LVARIABLE_AGET, SLANG_BC_CALL_DIRECT_NARGS);
	break;

      case _INLINE_IMPLICIT_ARRAYN_TOKEN:
	compile_call_direct (_pSLarray_inline_implicit_arrayn, SLANG_BC_CALL_DIRECT_NARGS);
	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 (_pSLarray_aput, SLANG_BC_LVARIABLE_APUT, SLANG_BC_CALL_DIRECT_NARGS);
	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:
      case _DEREF_PLUSEQS_TOKEN:
      case _DEREF_MINUSEQS_TOKEN:
      case _DEREF_TIMESEQS_TOKEN:
      case _DEREF_DIVEQS_TOKEN:
      case _DEREF_BOREQS_TOKEN:
      case _DEREF_BANDEQS_TOKEN:
      case _DEREF_PLUSPLUS_TOKEN:
      case _DEREF_POST_PLUSPLUS_TOKEN:
      case _DEREF_MINUSMINUS_TOKEN:
      case _DEREF_POST_MINUSMINUS_TOKEN:
	compile_deref_assign (t);
	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_binary (SLANG_PLUS);
	break;

      case SUB_TOKEN:
	compile_binary (SLANG_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 CHS_TOKEN:
	compile_unary (SLANG_CHS, SLANG_BC_UNARY);
	break;
#if 0
      case MUL2_TOKEN:
	compile_unary (SLANG_MUL2, SLANG_BC_ARITH_UNARY);
	break;
      case ABS_TOKEN:
	compile_unary (SLANG_ABS, SLANG_BC_ARITH_UNARY);
	break;
      case SQR_TOKEN:
	compile_unary (SLANG_SQR, SLANG_BC_ARITH_UNARY);
	break;
      case SIGN_TOKEN:
	compile_unary (SLANG_SIGN, SLANG_BC_ARITH_UNARY);
	break;
#endif
      case BREAK_TOKEN:
	compile_break (SLANG_BC_BREAK, 1, 0, "break", 1);
	break;

      case BREAK_N_TOKEN:
	compile_break (SLANG_BC_BREAK_N, 1, 0, "break", abs((int)t->v.long_val));
	break;

      case RETURN_TOKEN:
	compile_break (SLANG_BC_RETURN, 0, 1, "return", 1);
	break;

      case CONT_TOKEN:
	compile_break (SLANG_BC_CONTINUE, 1, 0, "continue", 1);
	break;
      case CONT_N_TOKEN:
	compile_break (SLANG_BC_CONTINUE_N, 1, 0, "continue", abs((int)t->v.long_val));
	break;
      case EXCH_TOKEN:
	compile_break (SLANG_BC_EXCH, 0, 0, "", 0);   /* FIXME: Priority=low */
	break;

      case STATIC_TOKEN:
	interp_pending_blocks ();
	if (Lang_Defining_Function == 0)
	  Compile_Mode_Function = compile_static_variable_mode;
	else
	  _pSLang_verror (SL_NOT_IMPLEMENTED, "static variables not permitted in functions");
	break;

      case PRIVATE_TOKEN:
	interp_pending_blocks ();
	if (Lang_Defining_Function == 0)
	  Compile_Mode_Function = compile_private_variable_mode;
	else
	  _pSLang_verror (SL_NOT_IMPLEMENTED, "private variables not permitted in functions");
	break;

      case PUBLIC_TOKEN:
	interp_pending_blocks ();
	if (Lang_Defining_Function == 0)
	  Compile_Mode_Function = compile_public_variable_mode;
	else
	  _pSLang_verror (SL_NOT_IMPLEMENTED, "public variables not permitted in functions");
	break;

      case OBRACKET_TOKEN:
	interp_pending_blocks ();
	if (Lang_Defining_Function == 0)
	  Compile_Mode_Function = Default_Variable_Mode;
	else
	  Compile_Mode_Function = compile_local_variable_mode;
	break;

      case OPAREN_TOKEN:
	interp_pending_blocks ();
	lang_begin_function ();
	break;

      case DEFINE_STATIC_TOKEN:
	if (Lang_Defining_Function)
	  define_static_function (t->v.s_val, t->hash);
	else (void) SLang_set_error (SL_SYNTAX_ERROR);
	break;

      case DEFINE_PRIVATE_TOKEN:
	interp_pending_blocks ();
	if (Lang_Defining_Function)
	  define_private_function (t->v.s_val, t->hash);
	else (void) SLang_set_error (SL_SYNTAX_ERROR);
	break;

      case DEFINE_PUBLIC_TOKEN:
	if (Lang_Defining_Function)
	  define_public_function (t->v.s_val, t->hash);
	else (void) SLang_set_error (SL_SYNTAX_ERROR);
	break;

      case THROW_TOKEN:
	compile_call_direct (_pSLerr_throw, SLANG_BC_CALL_DIRECT_NARGS);
	break;

      case DEFINE_TOKEN:
	if (Lang_Defining_Function)
	  (*Default_Define_Function) (t->v.s_val, t->hash);
	else
	  (void) SLang_set_error (SL_SYNTAX_ERROR);
	break;

      case CPAREN_TOKEN:
	if (Lang_Defining_Function)
	  Compile_Mode_Function = compile_function_mode;
	else (void) SLang_set_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;

      case TMP_TOKEN:
	compile_tmp_variable (t->v.s_val, t->hash);
	break;
#if SLANG_HAS_QUALIFIERS
      case QUALIFIER_TOKEN:
	compile_call_direct (set_qualifier, SLANG_BC_CALL_DIRECT);
	break;
#endif
      case BOS_TOKEN:
#if SLANG_HAS_DEBUG_CODE && SLANG_HAS_BOSEOS
	compile_line_info (SLANG_BC_BOS, This_Compile_Filename, t->v.long_val);
#endif
	break;
      case EOS_TOKEN:
#if SLANG_HAS_DEBUG_CODE && SLANG_HAS_BOSEOS
	compile_simple (SLANG_BC_EOS);
#endif
	break;

      case LINE_NUM_TOKEN:
#if SLANG_HAS_DEBUG_CODE
	set_line_number_info (t->v.long_val);
#endif
	break;

      case _ARRAY_ELEM_REF_TOKEN:
	compile_call_direct (_pSLarray_push_elem_ref, SLANG_BC_CALL_DIRECT_NARGS);
	break;

      case _STRUCT_FIELD_REF_TOKEN:
	compile_dot (t, SLANG_BC_FIELD_REF);
	break;

      case POUND_TOKEN:
	compile_call_direct (_pSLarray_matrix_multiply, SLANG_BC_CALL_DIRECT);
	break;
     }
}

void _pSLcompile (_pSLang_Token_Type *t)
{
   if (SLang_get_error () == 0)
     {
	if (Compile_Mode_Function != compile_basic_token_mode)
	  {
	     if (Compile_Mode_Function == NULL)
	       Compile_Mode_Function = compile_basic_token_mode;
	     if (t->type == LINE_NUM_TOKEN)
	       {
		  compile_basic_token_mode (t);
		  return;
	       }
	  }

	(*Compile_Mode_Function) (t);
     }

   if (SLang_get_error ())
     {
	Compile_Mode_Function = compile_basic_token_mode;
	reset_active_interpreter ();
     }
}

void (*_pSLcompile_ptr)(_pSLang_Token_Type *) = _pSLcompile;

typedef struct _Compile_Context_Type
{
   struct _Compile_Context_Type *next;
   SLang_NameSpace_Type *static_namespace;
   SLang_NameSpace_Type *private_namespace;
   SLang_NameSpace_Type *locals_namespace;
   void (*compile_variable_mode) (_pSLang_Token_Type *);
   void (*define_function) (SLFUTURE_CONST char *, unsigned long);
   int lang_defining_function;
   int local_variable_number;
   char *local_variable_names[SLANG_MAX_LOCAL_VARIABLES];
   unsigned int function_args_number;
   void (*compile_mode_function)(_pSLang_Token_Type *);
   SLFUTURE_CONST char *compile_filename;
   unsigned int compile_linenum;
   _pSLang_Function_Type *current_function;
   Function_Header_Type *current_function_header;
}
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
 * reset 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;
   This_Private_NameSpace = cc->private_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;
   memcpy ((char *)Local_Variable_Names, (char *)cc->local_variable_names, sizeof(Local_Variable_Names));

   Function_Args_Number = cc->function_args_number;

   SLang_free_slstring ((char *) This_Compile_Filename);
   This_Compile_Filename = cc->compile_filename;
   This_Compile_Linenum = cc->compile_linenum;

   Current_Function_Header = cc->current_function_header;
   Current_Function = cc->current_function;

   Locals_NameSpace = cc->locals_namespace;

   /* These should be when returning from a compile context */
   Lang_Return = 0;
   Lang_Break = 0;
   Lang_Break_Condition = 0;

   SLfree ((char *) cc);

   return decrement_slang_frame_pointer ();
}

static int push_compile_context (SLFUTURE_CONST char *name)
{
   Compile_Context_Type *cc;

   cc = (Compile_Context_Type *)SLmalloc (sizeof (Compile_Context_Type));
   if (cc == NULL)
     return -1;
   memset ((char *) cc, 0, sizeof (Compile_Context_Type));

   if ((name != NULL)
       && (NULL == (name = SLang_create_slstring (name))))
     {
	SLfree ((char *) cc);
	return -1;
     }

   /* This is necessary since Current_Function and Current_Function_Header
    * will be set to NULL.  Otherwise, top-level blocks would not get
    * properly counted by the _get_frame_depth function.  It is also probably
    * not necessary to add the current_function and current_function_header
    * to the compile context structure.
    */
   if (-1 == increment_slang_frame_pointer (NULL, This_Compile_Linenum))
     {
	SLfree ((char *)cc);
	SLang_free_slstring ((char *) name);    /* NULL ok */
	return -1;
     }

   cc->compile_filename = This_Compile_Filename;
   This_Compile_Filename = name;
   cc->compile_linenum = This_Compile_Linenum;
   This_Compile_Linenum = 0;

   cc->static_namespace = This_Static_NameSpace;
   cc->private_namespace = This_Private_NameSpace;
   cc->compile_variable_mode = Default_Variable_Mode;
   cc->define_function = Default_Define_Function;
   cc->locals_namespace = Locals_NameSpace;

   cc->lang_defining_function = Lang_Defining_Function;
   cc->local_variable_number = Local_Variable_Number;
   memcpy ((char *)cc->local_variable_names, (char *)Local_Variable_Names, sizeof(Local_Variable_Names));

   cc->function_args_number = Function_Args_Number;
   cc->compile_mode_function = Compile_Mode_Function;

   cc->current_function_header = Current_Function_Header;
   cc->current_function = Current_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;
   Function_Args_Number = 0;
   Local_Variable_Number = 0;
   Locals_NameSpace = NULL;
   Current_Function = NULL;
   Current_Function_Header = NULL;

   This_Static_NameSpace = NULL;       /* allocated by caller-- here for completeness */
   This_Private_NameSpace = NULL;       /* allocated by caller-- here for completeness */
   return 0;
}

/* Error handling */
static int unset_interrupt_state (VOID_STAR maskp)
{
   Handle_Interrupt &= ~(*(int *)maskp);
   return 0;
}

static int set_interrupt_state (VOID_STAR maskp)
{
   Handle_Interrupt |= *(int *)maskp;
   return 0;
}

static void interpreter_error_hook (int set)
{
   int mask = INTERRUPT_ERROR;
   if (set)
     (void) _pSLsig_block_and_call (set_interrupt_state, (VOID_STAR) &mask);
   else
     (void) _pSLsig_block_and_call (unset_interrupt_state, (VOID_STAR) &mask);
}

#if SLANG_HAS_SIGNALS
void _pSLang_signal_interrupt (void)
{
   int mask = INTERRUPT_SIGNAL;
   (void) _pSLsig_block_and_call (set_interrupt_state, (VOID_STAR)&mask);
}

#define CHECK_SIGNALS_NOT_REENTRANT 0
static int check_signals (void)
{
#if CHECK_SIGNALS_NOT_REENTRANT
   static volatile int inprogress = 0;
#endif
   int nargs = SLang_Num_Function_Args;
   int nnargs = Next_Function_Num_Args;
   int bc, r, br;
   int status;

   if (0 == (Handle_Interrupt & INTERRUPT_SIGNAL))
     return 0;
#if CHECK_SIGNALS_NOT_REENTRANT
   if (inprogress)
     return 0;
   inprogress = 1;
#endif
   bc = Lang_Break_Condition; r = Lang_Return; br = Lang_Break;
   status = 0;
   /* The race condition that may be here can be ignored as long
    * as the Handle_Interrupt variable is modified before the
    * call to _pSLinterp_handle_signals.
    */
   Handle_Interrupt &= ~INTERRUPT_SIGNAL;
   if (-1 == _pSLsig_handle_signals ())
     status = -1;

   SLang_Num_Function_Args = nargs;
   Next_Function_Num_Args = nnargs;
   Lang_Break = br; Lang_Return = r; Lang_Break_Condition = bc;
#if CHECK_SIGNALS_NOT_REENTRANT
   inprogress = 0;
#endif
   return status;
}

int _pSLang_check_signals_hook (VOID_STAR unused)
{
   (void) unused;
   (void) check_signals ();
   if (_pSLang_Error)
     return -1;
   return 0;
}

#endif				       /* SLANG_HAS_SIGNALS */

static void free_stacks (void)
{
   /* SLfree can grok NULLs */
   SLfree ((char *)Num_Args_Stack); Num_Args_Stack = NULL;
   SLfree ((char *)Run_Stack); Run_Stack = NULL;
   SLfree ((char *)Num_Args_Stack); Num_Args_Stack = NULL;
   SLfree ((char *)Frame_Pointer_Stack); Frame_Pointer_Stack = NULL;
#if SLANG_HAS_QUALIFIERS
   SLfree ((char *)Function_Qualifiers_Stack); Function_Qualifiers_Stack = NULL;
#endif
   SLfree ((char *)Local_Variable_Stack); Local_Variable_Stack = NULL;
}

static void delete_interpreter (void)
{
   if (Run_Stack != NULL)
     {
	/* Allow any object destructors to run */
	while (Stack_Pointer != Run_Stack)
	  {
	     SLdo_pop ();
	  }
     }

   SLang_restart (0);

   while ((This_Compile_Block_Type != COMPILE_BLOCK_TYPE_NONE)
	  && (0 == _pSLcompile_pop_context ()))
     ;

   _pSLns_delete_namespaces ();
   free_stacks ();
}

static int init_interpreter (void)
{
   SLang_NameSpace_Type *ns;

   if (Global_NameSpace != NULL)
     return 0;

   free_stacks ();

   _pSLinterpreter_Error_Hook = interpreter_error_hook;

   if (NULL == (ns = _pSLns_new_namespace (NULL, SLGLOBALS_HASH_TABLE_SIZE)))
     return -1;
   if (-1 == _pSLns_set_namespace_name (ns, "Global"))
     return -1;
   Global_NameSpace = ns;

   Run_Stack = (SLang_Object_Type *) SLcalloc (SLANG_MAX_STACK_LEN,
						  sizeof (SLang_Object_Type));
   if (Run_Stack == NULL)
     goto return_error;

   Stack_Pointer = Run_Stack;
   Stack_Pointer_Max = Run_Stack + SLANG_MAX_STACK_LEN;

   Num_Args_Stack = (int *) _SLcalloc (SLANG_MAX_RECURSIVE_DEPTH, sizeof(int));
   if (Num_Args_Stack == NULL)
     goto return_error;

   Recursion_Depth = 0;
   Frame_Pointer_Stack = (unsigned int *) _SLcalloc (SLANG_MAX_RECURSIVE_DEPTH, sizeof(unsigned int));
   if (Frame_Pointer_Stack == NULL)
     goto return_error;
   Frame_Pointer_Depth = 0;
   Frame_Pointer = Run_Stack;

   Local_Variable_Stack = (SLang_Object_Type *) _SLcalloc (SLANG_MAX_LOCAL_STACK, sizeof(SLang_Object_Type));
   if (Local_Variable_Stack == NULL)
     goto return_error;
   Local_Variable_Frame = Local_Variable_Stack;
   Local_Variable_Stack_Max = Local_Variable_Stack + SLANG_MAX_LOCAL_STACK;

#if SLANG_HAS_QUALIFIERS
   Function_Qualifiers_Stack = (SLang_Struct_Type **) SLcalloc (SLANG_MAX_RECURSIVE_DEPTH, sizeof (SLang_Struct_Type *));
   if (Function_Qualifiers_Stack == NULL)
     goto return_error;
#endif

   Function_Stack = (Function_Stack_Type *) _SLcalloc (SLANG_MAX_RECURSIVE_DEPTH, sizeof (Function_Stack_Type));
   if (Function_Stack == NULL)
     goto return_error;

   Function_Stack_Ptr = Function_Stack;
   /* Function_Stack_Ptr_Max = Function_Stack_Ptr + SLANG_MAX_RECURSIVE_DEPTH; */

   (void) setup_default_compile_linkage (1);
   if (-1 == SLang_add_cleanup_function (delete_interpreter))
     goto return_error;

   return 0;

return_error:
   free_stacks ();
   return -1;
}

static int add_generic_table (SLang_NameSpace_Type *ns,
			      SLang_Name_Type *table, SLFUTURE_CONST char *pp_name,
			      unsigned int entry_len)
{
   SLang_Name_Type *t, **ns_table;
   SLFUTURE_CONST char *name;
   unsigned int table_size;

   if (-1 == init_interpreter ())
     return -1;

   if (ns == NULL)
     ns = Global_NameSpace;

   if ((pp_name != NULL)
       && (-1 == SLdefine_for_ifdef (pp_name)))
     return -1;

   ns_table = ns->table;
   table_size = ns->table_size;

   t = table;
   while (NULL != (name = t->name))
     {
	unsigned long hash;

	/* Backward compatibility: '.' WAS used as hash marker */
	if (*name == '.')
	  {
	     name++;
	     t->name = name;
	  }

	if (-1 == _pSLcheck_identifier_syntax (name))
	  return -1;

	if (NULL == (name = SLang_create_slstring (name)))
	  return -1;

	t->name = name;

	hash = SLcompute_string_hash (name);
	hash = hash % table_size;

	/* First time.  Make sure this has not already been added */
	if (t == table)
	  {
	     SLang_Name_Type *tt = ns_table[(unsigned int) hash];
	     while (tt != NULL)
	       {
		  if (tt == t)
		    {
		       _pSLang_verror (SL_APPLICATION_ERROR,
				     "An intrinsic symbol table may not be added twice. [%s]",
				     pp_name == NULL ? "" : pp_name);
		       return -1;
		    }
		  tt = tt->next;
	       }
	  }

	t->next = ns_table [(unsigned int) hash];
	ns_table [(unsigned int) hash] = t;

	t = (SLang_Name_Type *) ((char *)t + entry_len);
     }

   return 0;
}

/* FIXME: I should add code to make sure that the objects in, e.g., an iconstant table
 * have sizeof(int).
 */
int SLadd_intrin_fun_table (SLang_Intrin_Fun_Type *tbl, SLFUTURE_CONST 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, SLFUTURE_CONST 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, SLFUTURE_CONST char *pp)
{
   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_App_Unary_Type));
}

int _pSLadd_arith_unary_table (SLang_Arith_Unary_Type *tbl, SLFUTURE_CONST char *pp)
{
   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Arith_Unary_Type));
}

int _pSLadd_arith_binary_table (SLang_Arith_Binary_Type *tbl, SLFUTURE_CONST char *pp)
{
   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Arith_Binary_Type));
}

int SLadd_math_unary_table (SLang_Math_Unary_Type *tbl, SLFUTURE_CONST 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, SLFUTURE_CONST char *pp)
{
   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_IConstant_Type));
}

int SLadd_lconstant_table (SLang_LConstant_Type *tbl, SLFUTURE_CONST char *pp)
{
   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_LConstant_Type));
}

#if SLANG_HAS_FLOAT
int SLadd_dconstant_table (SLang_DConstant_Type *tbl, SLFUTURE_CONST char *pp)
{
   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_DConstant_Type));
}
int SLadd_fconstant_table (SLang_FConstant_Type *tbl, SLFUTURE_CONST char *pp)
{
   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_FConstant_Type));
}
#endif
#ifdef HAVE_LONG_LONG
int SLadd_llconstant_table (SLang_LLConstant_Type *tbl, SLFUTURE_CONST char *pp)
{
   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (SLang_LLConstant_Type));
}
int _pSLadd_llconstant_table (_pSLang_LLConstant_Type *tbl, SLFUTURE_CONST char *pp)
{
   return add_generic_table (NULL, (SLang_Name_Type *) tbl, pp, sizeof (_pSLang_LLConstant_Type));
}
#endif

/* ----------- */
int SLns_add_intrin_fun_table (SLang_NameSpace_Type *ns, SLang_Intrin_Fun_Type *tbl, SLFUTURE_CONST char *pp)
{
   if ((ns == NULL) || (ns == (Global_NameSpace)))
     return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Intrin_Fun_Type));

   if ((pp != NULL)
       && (-1 == SLdefine_for_ifdef (pp)))
     return -1;

   while (tbl->name != NULL)
     {
	if (-1 == add_intrinsic_function (ns, tbl->name, tbl->i_fun,
					  tbl->return_type, tbl->num_args,
					  tbl->arg_types))
	  return -1;
	tbl++;
     }
   return 0;
}

int SLns_add_intrin_var_table (SLang_NameSpace_Type *ns, SLang_Intrin_Var_Type *tbl, SLFUTURE_CONST char *pp)
{
   if ((ns == NULL) || (ns == Global_NameSpace))
     return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Intrin_Var_Type));

   if ((pp != NULL)
       && (-1 == SLdefine_for_ifdef (pp)))
     return -1;

   while (tbl->name != NULL)
     {
	if (-1 == SLns_add_intrinsic_variable (ns, tbl->name, tbl->addr, tbl->type, tbl->name_type == SLANG_RVARIABLE))
	  return -1;

	tbl++;
     }
   return 0;
}

int SLns_add_app_unary_table (SLang_NameSpace_Type *ns, SLang_App_Unary_Type *tbl, SLFUTURE_CONST char *pp)
{
   if ((ns == NULL) || (ns == (Global_NameSpace)))
     return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_App_Unary_Type));

   if ((pp != NULL)
       && (-1 == SLdefine_for_ifdef (pp)))
     return -1;

   while (tbl->name != NULL)
     {
	SLang_App_Unary_Type *a;

	a = (SLang_App_Unary_Type *)add_xxx_helper (ns, tbl->name, SLANG_APP_UNARY, sizeof(SLang_App_Unary_Type));
	if (a == NULL)
	  return -1;
	a->unary_op = tbl->unary_op;
	tbl++;
     }
   return 0;
}

int SLns_add_math_unary_table (SLang_NameSpace_Type *ns, SLang_Math_Unary_Type *tbl, SLFUTURE_CONST char *pp)
{
   if ((ns == NULL) || (ns == (Global_NameSpace)))
     return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_Math_Unary_Type));

   if ((pp != NULL)
       && (-1 == SLdefine_for_ifdef (pp)))
     return -1;

   while (tbl->name != NULL)
     {
	SLang_Math_Unary_Type *a;

	a = (SLang_Math_Unary_Type *)add_xxx_helper (ns, tbl->name, SLANG_MATH_UNARY, sizeof(SLang_Math_Unary_Type));
	if (a == NULL)
	  return -1;
	a->unary_op = tbl->unary_op;
	tbl++;
     }
   return 0;
}

int SLns_add_hconstant_table (SLang_NameSpace_Type *ns, SLang_HConstant_Type *tbl, SLFUTURE_CONST char *pp)
{
   if ((ns == NULL) || (ns == (Global_NameSpace)))
     return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_HConstant_Type));

   if ((pp != NULL)
       && (-1 == SLdefine_for_ifdef (pp)))
     return -1;

   while (tbl->name != NULL)
     {
	if (-1 == SLns_add_hconstant (ns, tbl->name, tbl->data_type, tbl->value))
	  return -1;
	tbl++;
     }
   return 0;
}

int SLns_add_iconstant_table (SLang_NameSpace_Type *ns, SLang_IConstant_Type *tbl, SLFUTURE_CONST char *pp)
{
   if ((ns == NULL) || (ns == (Global_NameSpace)))
     return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_IConstant_Type));

   if ((pp != NULL)
       && (-1 == SLdefine_for_ifdef (pp)))
     return -1;

   while (tbl->name != NULL)
     {
	if (-1 == SLns_add_iconstant (ns, tbl->name, tbl->data_type, tbl->value))
	  return -1;
	tbl++;
     }
   return 0;
}

int SLns_add_lconstant_table (SLang_NameSpace_Type *ns, SLang_LConstant_Type *tbl, SLFUTURE_CONST char *pp)
{
   if ((ns == NULL) || (ns == (Global_NameSpace)))
     return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_LConstant_Type));

   if ((pp != NULL)
       && (-1 == SLdefine_for_ifdef (pp)))
     return -1;

   while (tbl->name != NULL)
     {
	if (-1 == SLns_add_lconstant (ns, tbl->name, tbl->data_type, tbl->value))
	  return -1;
	tbl++;
     }
   return 0;
}

#ifdef HAVE_LONG_LONG
int _pSLns_add_llconstant_table (SLang_NameSpace_Type *ns, _pSLang_LLConstant_Type *tbl, SLFUTURE_CONST char *pp)
{
   if ((ns == NULL) || (ns == (Global_NameSpace)))
     return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (_pSLang_LLConstant_Type));

   if ((pp != NULL)
       && (-1 == SLdefine_for_ifdef (pp)))
     return -1;

   while (tbl->name != NULL)
     {
	if (-1 == _pSLns_add_llconstant (ns, tbl->name, tbl->data_type, tbl->value))
	  return -1;
	tbl++;
     }
   return 0;
}
#endif

#if SLANG_HAS_FLOAT
int SLns_add_dconstant_table (SLang_NameSpace_Type *ns, SLang_DConstant_Type *tbl, SLFUTURE_CONST char *pp)
{
   if ((ns == NULL) || (ns == (Global_NameSpace)))
     return add_generic_table (ns, (SLang_Name_Type *) tbl, pp, sizeof (SLang_DConstant_Type));

   if ((pp != NULL)
       && (-1 == SLdefine_for_ifdef (pp)))
     return -1;

   while (tbl->name != NULL)
     {
	if (-1 == SLns_add_dconstant (ns, tbl->name, tbl->d))
	  return -1;
	tbl++;
     }
   return 0;
}
#endif

static int setup_default_compile_linkage (int is_public)
{
   if (is_public)
     {
	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;
     }

   return 0;
}

/* what is a bitmapped value:
 * 1 intrin fun
 * 2 user fun
 * 4 intrin var
 * 8 user defined var
 */
SLang_Array_Type *_pSLang_apropos (SLFUTURE_CONST char *namespace_name, SLFUTURE_CONST 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 = _pSLns_find_namespace (namespace_name);

   return _pSLnspace_apropos (ns, pat, what);
}

/* An anonymous namespace in one in which the private and static objects share
 * the same namespace.  This function causes a new namespace to be created or
 * an existing one used, and where the static objects will be placed.  The
 * private objects will continue using the private namespace.
 */
static int implements_ns (SLFUTURE_CONST char *namespace_name)
{
   SLang_NameSpace_Type *ns;
   SLFUTURE_CONST char *name;

   if (-1 == _pSLns_check_name (namespace_name))
     return -1;

   if ((This_Private_NameSpace == NULL) || (This_Static_NameSpace == NULL))
     {
	/* This error should never happen */
	_pSLang_verror (SL_INTERNAL_ERROR, "No namespace available");
	return -1;
     }
   name = This_Private_NameSpace->name;

   if (NULL != (ns = _pSLns_find_namespace (namespace_name)))
     {
	/* If it exists but is associated with the private namespace, the it is ok */
	if (ns->name != name)
	  {
	     _pSLang_verror (SL_Namespace_Error, "Namespace %s already exists", namespace_name);
	     return -1;
	  }
     }
   return setup_compile_namespaces (name, namespace_name);
}

void _pSLang_implements_intrinsic (SLFUTURE_CONST char *name)
{
   (void) implements_ns (name);
}

void _pSLang_use_namespace_intrinsic (char *name)
{
   SLang_NameSpace_Type *ns;

   if (NULL == (ns = _pSLns_find_namespace (name)))
     {
	_pSLang_verror (SL_Namespace_Error, "Namespace %s does not exist", name);
	return;
     }
   This_Static_NameSpace = ns;
   (void) setup_default_compile_linkage (ns == Global_NameSpace);
}

static SLang_NameSpace_Type *_pSLang_cur_namespace (void)
{
   if (This_Static_NameSpace == NULL)
     return Global_NameSpace;

   if (This_Static_NameSpace->namespace_name == NULL)
     return NULL;

   return This_Static_NameSpace;
}

SLFUTURE_CONST char *_pSLang_cur_namespace_intrinsic (void)
{
   SLang_NameSpace_Type *ns = _pSLang_cur_namespace ();
   if (ns == NULL)
     return "";
   return ns->namespace_name;
}

SLCONST char *_pSLang_current_function_name (void)
{
   if (Current_Function == NULL)
     return NULL;

   return Current_Function->name;
}

SLang_Object_Type *_pSLang_get_run_stack_pointer (void)
{
   return Stack_Pointer;
}

SLang_Object_Type *_pSLang_get_run_stack_base (void)
{
   return Run_Stack;
}

int _pSLang_dump_stack (void) /*{{{*/
{
   char buf[32];
   unsigned int n;

   n = (unsigned int) (Stack_Pointer - Run_Stack);
   while (n)
     {
	n--;
	sprintf (buf, "(%u)", n);
	_pSLdump_objects (buf, Run_Stack + n, 1, 1);
     }
   return 0;
}

/*}}}*/

int _pSLang_is_arith_type (SLtype t)
{
   return (int) IS_ARITH_TYPE(t);
}
void _pSLang_set_arith_type (SLtype t, unsigned char v)
{
   if (t < 256)
     Is_Arith_Type_Array[t] = v;
}

#if SLANG_HAS_DEBUGGER_SUPPORT
void _pSLang_use_frame_namespace (int depth)
{
   Function_Stack_Type s;
   if (-1 == get_function_stack_info (depth, &s))
     return;

   This_Static_NameSpace = s.static_ns;
   This_Private_NameSpace = s.private_ns;
   (void) setup_default_compile_linkage (s.static_ns == Global_NameSpace);
}
#endif