slang.c

一个C格式的脚本处理函数库源代码,可让你的C程序具有执行C格式的脚本文件

	  goto wrong_num_blocks_error;

	type = blks[1]->bc_main_type;
	while (1)
	  {
	     if (SLang_Error)
	       goto return_error;

	     inner_interp (block);
	     if (Lang_Break) break;

	     if (-1 == pop_ctrl_integer (&ctrl))
	       goto return_error;

	     if (ctrl == 0) break;

	     if (type)
	       {
		  inner_interp (blks[1]);
		  if (Lang_Break) break;
		  Lang_Break_Condition = /* Lang_Continue = */ 0;
	       }
	  }
	break;

      case _SLANG_BCST_DOWHILE:
	loop_name = "do...while";

	if (num_blocks != 2)
	  goto wrong_num_blocks_error;

	while (1)
	  {
	     if (SLang_Error)
	       goto return_error;

	     Lang_Break_Condition = /* Lang_Continue = */ 0;
	     inner_interp (block);
	     if (Lang_Break) break;
	     Lang_Break_Condition = /* Lang_Continue = */ 0;
	     inner_interp (blks[1]);
	     if (-1 == pop_ctrl_integer (&ctrl))
	       goto return_error;

	     if (ctrl == 0) break;
	  }
	break;

      case _SLANG_BCST_CFOR:
	loop_name = "for";

	/* we need 4 blocks: first 3 control, the last is code */
	if (num_blocks != 4) goto wrong_num_blocks_error;

	inner_interp (block);
	while (1)
	  {
	     if (SLang_Error)
	       goto return_error;

	     inner_interp(blks[1]);       /* test */
	     if (-1 == pop_ctrl_integer (&ctrl))
	       goto return_error;

	     if (ctrl == 0) break;
	     inner_interp(blks[3]);       /* code */
	     if (Lang_Break) break;
	     inner_interp(blks[2]);       /* bump */
	     Lang_Break_Condition = /* Lang_Continue = */ 0;
	  }
	break;

      case _SLANG_BCST_FOR:
	loop_name = "_for";

	if (num_blocks != 1)
	  goto wrong_num_blocks_error;

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

	i = first;
	while (1)
	  {
	     /* It is ugly to have this test here but I do not know of a
	      * simple way to do this without using two while loops.
	      */
	     if (ctrl >= 0)
	       {
		  if (i > last) break;
	       }
	     else if (i < last) break;

	     if (SLang_Error) goto return_error;

	     SLclass_push_int_obj (SLANG_INT_TYPE, i);
	     inner_interp (block);
	     if (Lang_Break) break;
	     Lang_Break_Condition = /* Lang_Continue = */ 0;

	     i += ctrl;
	  }
	break;

      case _SLANG_BCST_LOOP:
	loop_name = "loop";
	if (num_blocks != 1)
	  goto wrong_num_blocks_error;

	if (-1 == SLang_pop_integer (&ctrl))
	  goto return_error;
	while (ctrl > 0)
	  {
	     ctrl--;

	     if (SLang_Error)
	       goto return_error;

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

      case _SLANG_BCST_FOREVER:
	loop_name = "forever";

	if (num_blocks != 1)
	  goto wrong_num_blocks_error;

	while (1)
	  {
	     if (SLang_Error)
	       goto return_error;

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

      default:  SLang_verror(SL_INTERNAL_ERROR, "Unknown loop type");
	return;
     }
   Lang_Break = /* Lang_Continue = */ 0;
   Lang_Break_Condition = Lang_Return;
   return;

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

   /* drop */
   return_error:
   do_traceback (loop_name, 0, NULL);
}

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

   is_or = (stype == _SLANG_BCST_ORELSE);

   while (addr <= addr_max)
     {
	if (addr->bc_main_type == _SLANG_BC_LINE_NUM)
	  {
	     addr++;
	     continue;
	  }

	inner_interp (addr->b.blk);
	if (SLang_Error
	    || Lang_Break_Condition
	    || (-1 == pop_ctrl_integer (&test)))
	  return;

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

	/* if (((stype == _SLANG_BCST_ANDELSE) && (test == 0))
	 *   || ((stype == _SLANG_BCST_ORELSE) && test))
	 * break;
	 */

	addr++;
     }
   SLclass_push_int_obj (SLANG_INT_TYPE, test);
}

static void do_else_if (SLBlock_Type *zero_block, SLBlock_Type *non_zero_block)
{
   int test;

   if (-1 == pop_ctrl_integer (&test))
     return;

   if (test == 0)
     non_zero_block = zero_block;

   if (non_zero_block != NULL)
     inner_interp (non_zero_block->b.blk);
}

int _SLang_trace_fun (char *f)
{
   if (NULL == (f = SLang_create_slstring (f)))
     return -1;

   SLang_free_slstring (Trace_Function);
   Trace_Function = f;
   _SLang_Trace = 1;
   return 0;
}

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

   while (n)
     {
	cl = _SLclass_get_class (x->data_type);

	if (NULL == (s = _SLstringize_object (x)))
	  s = "??";

	call_dump_routine ("%s[%s]:%s\n", prefix, cl->cl_name, s);

	SLang_free_slstring (s);

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

static SLBlock_Type *Exit_Block_Ptr;
static SLBlock_Type *Global_User_Block[5];
static SLBlock_Type **User_Block_Ptr = Global_User_Block;
static char *Current_Function_Name = NULL;

static int execute_slang_fun (_SLang_Function_Type *fun)
{
   register unsigned int i;
   register SLang_Object_Type *frame, *lvf;
   register unsigned int n_locals;
   _SLBlock_Header_Type *header;
   /* SLBlock_Type *val; */
   SLBlock_Type *exit_block_save;
   SLBlock_Type **user_block_save;
   SLBlock_Type *user_blocks[5];
   char *save_fname;

   exit_block_save = Exit_Block_Ptr;
   user_block_save = User_Block_Ptr;
   User_Block_Ptr = user_blocks;
   *(user_blocks) = NULL;
   *(user_blocks + 1) = NULL;
   *(user_blocks + 2) = NULL;
   *(user_blocks + 3) = NULL;
   *(user_blocks + 4) = NULL;

   Exit_Block_Ptr = NULL;

   save_fname = Current_Function_Name;
   Current_Function_Name = fun->name;

   _SL_increment_frame_pointer ();

   /* need loaded?  */
   if (fun->nlocals == AUTOLOAD_NUM_LOCALS)
     {
	/* header = NULL; */
	if (-1 == SLang_load_file(fun->v.autoload_filename))
	  goto the_return;

	if (fun->nlocals == AUTOLOAD_NUM_LOCALS)
	  {
	     SLang_verror (SL_UNDEFINED_NAME, "%s: Function did not autoload",
			   Current_Function_Name);
             goto the_return;
	  }
     }

   n_locals = fun->nlocals;

   /* let the error propagate through since it will do no harm
    and allow us to restore stack. */

   /* set new stack frame */
   lvf = frame = Local_Variable_Frame;
   i = n_locals;
   if ((lvf + i) > Local_Variable_Stack + SLANG_MAX_LOCAL_STACK)
     {
	SLang_verror(SL_STACK_OVERFLOW, "%s: Local Variable Stack Overflow",
		     Current_Function_Name);
	goto the_return;
     }

   /* Make sure we do not allow this header to get destroyed by something
    * like:  define crash () { eval ("define crash ();") }
    */
   header = fun->v.header;
   header->num_refs++;

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

   /* read values of function arguments */
   i = fun->nargs;
   while (i > 0)
     {
	i--;
	(void) SLang_pop (Local_Variable_Frame - i);
     }

   if (SLang_Enter_Function != NULL) (*SLang_Enter_Function)(Current_Function_Name);

   if (_SLang_Trace)
     {
	int stack_depth;

	stack_depth = _SLstack_depth ();

	if ((Trace_Function != NULL)
	    && (0 == strcmp (Trace_Function, Current_Function_Name))
	    && (Trace_Mode == 0))
	  Trace_Mode = 1;

	if (Trace_Mode)
	  {
	     /* The local variable frame grows backwards */
	     trace_dump (">>%s (%d args)\n",
			 Current_Function_Name,
			 Local_Variable_Frame,
			 (int) fun->nargs,
			 -1);
	     Trace_Mode++;
	  }

	inner_interp (header->body);
	Lang_Break_Condition = Lang_Return = Lang_Break = 0;
	if (Exit_Block_Ptr != NULL) inner_interp(Exit_Block_Ptr);

	if (Trace_Mode)
	  {
	     Trace_Mode--;
	     stack_depth = _SLstack_depth () - stack_depth;

	     trace_dump ("<<%s (returning %d values)\n",
			 Current_Function_Name,
			 _SLStack_Pointer - stack_depth,
			 stack_depth,
			 1);

	     if (Trace_Mode == 1)
	       Trace_Mode = 0;
	  }
     }
   else
     {
	inner_interp (header->body);
	Lang_Break_Condition = Lang_Return = Lang_Break = 0;
	if (Exit_Block_Ptr != NULL) inner_interp(Exit_Block_Ptr);
     }

   if (SLang_Exit_Function != NULL) (*SLang_Exit_Function)(Current_Function_Name);

   if (SLang_Error)
     do_traceback(fun->name, n_locals,
#if _SLANG_HAS_DEBUG_CODE
		  fun->file
#else
		  NULL
#endif
		  );

   /* free local variables.... */
   lvf = Local_Variable_Frame;
   while (lvf > frame)
     {
#if _SLANG_OPTIMIZE_FOR_SPEED
	if (SLANG_CLASS_TYPE_SCALAR != Class_Type [lvf->data_type])
#endif
	  SLang_free_object (lvf);
	lvf--;
     }
   Local_Variable_Frame = lvf;

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

   the_return:

   Lang_Break_Condition = Lang_Return = Lang_Break = 0;
   Exit_Block_Ptr = exit_block_save;
   User_Block_Ptr = user_block_save;
   Current_Function_Name = save_fname;
   _SL_decrement_frame_pointer ();

   if (SLang_Error)
     return -1;

   return 0;
}

static void do_traceback (char *name, unsigned int locals, char *file)
{
   char *s;
   unsigned int i;
   SLang_Object_Type *objp;
   unsigned short stype;

   /* FIXME: Priority=low
    * I need to make this configurable!!! That is, let the
    * application decide whether or not a usage error should result in a
    * traceback.
    */
   if (SLang_Error == SL_USAGE_ERROR)
     return;

   if (SLang_Traceback == 0)
     return;

   call_dump_routine ("S-Lang Traceback: %s\n", name);
   if (SLang_Traceback < 0)
     return;

   if (file != NULL)
     call_dump_routine ("File: %s\n", file);

   if (locals == 0)
     return;

   call_dump_routine ("  Local Variables:\n");

   for (i = 0; i < locals; i++)
     {
	SLang_Class_Type *cl;
	char *class_name;

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

	s = _SLstringize_object (objp);
	cl = _SLclass_get_class (stype);
	class_name = cl->cl_name;

	call_dump_routine ("\t$%d: Type: %s,\tValue:\t", i, class_name);

	if (s == NULL) call_dump_routine("??\n");
	else
	  {
	     char *q = "";
#ifndef HAVE_VSNPRINTF
	     char buf[256];
	     if (strlen (s) >= sizeof (buf))
	       {
		  strncpy (buf, s, sizeof(buf));
		  s = buf;
		  s[sizeof(buf) - 1] = 0;
	       }
#endif
	     if (SLANG_STRING_TYPE == stype) q = "\"";
	     call_dump_routine ("%s%s%s\n", q, s, q);
	  }
     }
}

static void do_app_unary (SLang_App_Unary_Type *nt)
{
   if (-1 == do_unary (nt->unary_op, nt->name_type))
     do_traceback (nt->name, 0, NULL);
}

static int inner_interp_nametype (SLang_Name_Type *nt)
{
   SLBlock_Type bc_blks[2];

   bc_blks[0].b.nt_blk = nt;
   bc_blks[0].bc_main_type = nt->name_type;
   bc_blks[1].bc_main_type = 0;
   return inner_interp(bc_blks);
}

int _SLang_dereference_ref (SLang_Ref_Type *ref)
{
   if (ref == NULL)
     {
	SLang_Error = SL_INTERNAL_ERROR;
	return -1;
     }

   if (ref->is_global == 0)
     {
	SLang_Object_Type *obj = ref->v.local_obj;
	if (obj > Local_Variable_Frame)
	  {
	     SLang_verror (SL_UNDEFINED_NAME, "Local variable deref is out of scope");
	     return -1;
	  }
	return _SLpush_slang_obj (ref->v.local_obj);
     }

   (void) inner_interp_nametype (ref->v.nt);
   return 0;
}

int _SLang_is_ref_initialized (SLang_Ref_Type *ref)
{
   unsigned char type;

   if (ref == NULL)
     {
	SLang_Error = SL_INTERNAL_ERROR;
	return -1;
     }

   if (ref->is_global == 0)
     {
	SLang_Object_Type *obj = ref->v.local_obj;
	if (obj > Local_Variable_Frame)
	  {
	     SLang_verror (SL_UNDEFINED_NAME, "Local variable deref is out of scope");
	     return -1;
	  }
	type = ref->v.local_obj->data_type;
     }
   else
     {
	SLang_Name_Type *nt = ref->v.nt;
	if ((nt->name_type != SLANG_GVARIABLE)
	    && (nt->name_type != SLANG_PVARIABLE))
	  return 1;
	type = ((SLang_Global_Var_Type *)nt)->obj.data_type;
     }
   return type != SLANG_UNDEFINED_TYPE;
}

int _SLang_uninitialize_ref (SLang_Ref_Type *ref)
{
   SLang_Object_Type *obj;

   if (ref == NULL)
     {
	SLang_Error = SL_INTERNAL_ERROR;
	return -1;
     }

   if (ref->is_global == 0)
     {
	obj = ref->v.local_obj;
	if (obj > Local_Variable_Frame)
	  {
	     SLang_verror (SL_UNDEFINED_NAME, "Local variable deref is out of scope");
	     return -1;
	  }
	obj = ref->v.local_obj;
     }
   else
     {
	SLang_Name_Type *nt = ref->v.nt;