slclass.c

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

	     if (c == a) *c_cl = a_cl;
	     else if (c == b) *c_cl = b_cl;
	     else *c_cl = _SLclass_get_class (c);

	     return bt->binary_function;
	  }

	bt = bt->next;
     }

   if (do_error)
     SLang_verror (SL_TYPE_MISMATCH, "%s %s %s is not possible",
		   a_cl->cl_name, get_binary_op_string (op), b_cl->cl_name);

   *c_cl = NULL;
   return NULL;
}

int (*_SLclass_get_unary_fun (int op,
			      SLang_Class_Type *a_cl,
			      SLang_Class_Type **b_cl,
			      int utype))
(int, unsigned char, VOID_STAR, unsigned int, VOID_STAR)
{
   int (*f)(int, unsigned char, VOID_STAR, unsigned int, VOID_STAR);
   int (*r)(int, unsigned char, unsigned char *);
   unsigned char a;
   unsigned char b;

   switch (utype)
     {
      case _SLANG_BC_UNARY:
	f = a_cl->cl_unary_op;
	r = a_cl->cl_unary_op_result_type;
	break;

      case _SLANG_BC_MATH_UNARY:
	f = a_cl->cl_math_op;
	r = a_cl->cl_math_op_result_type;
	break;

      case _SLANG_BC_APP_UNARY:
	f = a_cl->cl_app_unary_op;
	r = a_cl->cl_app_unary_op_result_type;
	break;

      default:
	f = NULL;
	r = NULL;
     }

   a = a_cl->cl_data_type;
   if ((f != NULL) && (r != NULL) && (1 == (*r) (op, a, &b)))
     {
	if (a == b)
	  *b_cl = a_cl;
	else
	  *b_cl = _SLclass_get_class (b);
	return f;
     }

   SLang_verror (SL_TYPE_MISMATCH, "undefined unary operation/function on %s",
		 a_cl->cl_name);

   *b_cl = NULL;

   return NULL;
}

int
SLclass_typecast (unsigned char to_type, int is_implicit, int allow_array)
{
   unsigned char from_type;
   SLang_Class_Type *cl_to, *cl_from;
   SLang_Object_Type obj;
   VOID_STAR ap;
   VOID_STAR bp;
   int status;

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

   from_type = obj.data_type;
   if (from_type == to_type)
     {
	SLang_push (&obj);
	return 0;
     }

   cl_from = _SLclass_get_class (from_type);
   
   /* Since the typecast functions are designed to work on arrays, 
    * get the pointer to the value instead of just &obj.v.
    */
   ap = _SLclass_get_ptr_to_value (cl_from, &obj);

   if ((from_type == SLANG_ARRAY_TYPE)
       && (allow_array || (to_type != SLANG_ANY_TYPE)))
     {
	if (allow_array == 0)
	  goto return_error;

	cl_to = _SLclass_get_class (SLANG_ARRAY_TYPE);
	bp = cl_to->cl_transfer_buf;
	status = _SLarray_typecast (from_type, ap, 1, to_type, bp, is_implicit);
     }
   else
     {
	int (*t) (unsigned char, VOID_STAR, unsigned int, unsigned char, VOID_STAR);

	if (NULL == (t = _SLclass_get_typecast (from_type, to_type, is_implicit)))
	  {
	     SLang_free_object (&obj);
	     return -1;
	  }

	cl_to = _SLclass_get_class (to_type);
	bp = cl_to->cl_transfer_buf;
	status = (*t) (from_type, ap, 1, to_type, bp);
     }

   if (1 == status)
     {
	/* AnyType apush will do a reference, which is undesirable here.
	 * So, to avoid that, perform push instead of apush.  Yes, this is
	 * an ugly hack.
	 */
	if (to_type == SLANG_ANY_TYPE)
	  status = (*cl_to->cl_push)(to_type, bp);
	else 
	  status = (*cl_to->cl_apush)(to_type, bp);
	
	if (status == -1)
	  {
	     (*cl_to->cl_adestroy) (to_type, bp);
	     SLang_free_object (&obj);
	     return -1;
	  }

	/* cl_apush will push a copy, so destry this one */
	(*cl_to->cl_adestroy) (to_type, bp);
	SLang_free_object (&obj);
	return 0;
     }

   return_error:

   SLang_verror (SL_TYPE_MISMATCH, "Unable to typecast %s to %s",
		 cl_from->cl_name,
		 SLclass_get_datatype_name (to_type));
   SLang_free_object (&obj);
   return -1;
}

int (*_SLclass_get_typecast (unsigned char from, unsigned char to, int is_implicit))
(unsigned char, VOID_STAR, unsigned int,
 unsigned char, VOID_STAR)
{
   SL_Typecast_Type *t;
   SLang_Class_Type *cl_from;

   cl_from = _SLclass_get_class (from);

   t = cl_from->cl_typecast_funs;
   while (t != NULL)
     {
	if (t->data_type != to)
	  {
	     t = t->next;
	     continue;
	  }

	if (is_implicit && (t->allow_implicit == 0))
	  break;

	return t->typecast;
     }

   if (to == SLANG_ANY_TYPE)
     return _SLanytype_typecast;

   if ((is_implicit == 0)
       && (cl_from->cl_void_typecast != NULL))
     return cl_from->cl_void_typecast;

   SLang_verror (SL_TYPE_MISMATCH, "Unable to typecast %s to %s",
		 cl_from->cl_name,
		 SLclass_get_datatype_name (to));

   return NULL;
}

int
SLclass_add_typecast (unsigned char from, unsigned char to,
		      int (*f)_PROTO((unsigned char, VOID_STAR, unsigned int,
				      unsigned char, VOID_STAR)),
		      int allow_implicit)
{
   SL_Typecast_Type *t;
   SLang_Class_Type *cl;

   cl = _SLclass_get_class (from);
   if (to == SLANG_VOID_TYPE)
     {
	cl->cl_void_typecast = f;
	return 0;
     }

   (void) _SLclass_get_class (to);

   if (NULL == (t = (SL_Typecast_Type *) SLmalloc (sizeof (SL_Typecast_Type))))
     return -1;

   SLMEMSET((char *) t, 0, sizeof(SL_Typecast_Type));
   t->data_type = to;
   t->next = cl->cl_typecast_funs;
   t->typecast = f;
   t->allow_implicit = allow_implicit;

   cl->cl_typecast_funs = t;

   return 0;
}

SLang_MMT_Type *SLang_pop_mmt (unsigned char type) /*{{{*/
{
   SLang_MMT_Type *mmt;

   if (-1 == SLclass_pop_ptr_obj (type, (VOID_STAR *) &mmt))
     mmt = NULL;
   return mmt;

#if 0
   SLang_Object_Type obj;
   SLang_Class_Type *cl;

   if (_SLang_pop_object_of_type (type, &obj))
     return NULL;

   cl = _SLclass_get_class (type);
   if ((cl->cl_class_type == SLANG_CLASS_TYPE_MMT)
       && (obj.data_type == type))
     {
	return obj.v.ref;
     }

   _SLclass_type_mismatch_error (type, obj.data_type);
   SLang_free_object (&obj);
   return NULL;
#endif
}

/*}}}*/

int SLang_push_mmt (SLang_MMT_Type *ref) /*{{{*/
{
   if (ref == NULL)
     return SLang_push_null ();

   ref->count += 1;

   if (0 == SLclass_push_ptr_obj (ref->data_type, (VOID_STAR) ref))
     return 0;

   ref->count -= 1;
   return -1;
}

/*}}}*/

void SLang_inc_mmt (SLang_MMT_Type *ref)
{
   if (ref != NULL)
     ref->count += 1;
}

VOID_STAR SLang_object_from_mmt (SLang_MMT_Type *ref)
{
   if (ref == NULL)
     return NULL;

   return ref->user_data;
}

SLang_MMT_Type *SLang_create_mmt (unsigned char t, VOID_STAR p)
{
   SLang_MMT_Type *ref;

   (void) _SLclass_get_class (t);      /* check to see if it is registered */

   if (NULL == (ref = (SLang_MMT_Type *) SLmalloc (sizeof (SLang_MMT_Type))))
     return NULL;

   SLMEMSET ((char *) ref, 0, sizeof (SLang_MMT_Type));

   ref->data_type = t;
   ref->user_data = p;
   /* FIXME!!  To be consistent with other types, the reference count should 
    * be set to 1 here.  However, doing so will require other code changes
    * involving the use of MMTs.  For instance, SLang_free_mmt would have
    * to be called after every push of the MMT.
    */
   return ref;
}

void SLang_free_mmt (SLang_MMT_Type *ref)
{
   unsigned char type;
   SLang_Class_Type *cl;

   if (ref == NULL)
     return;

   /* This can be zero if SLang_create_mmt is called followed
    * by this routine before anything gets a chance to attach itself
    * to it.
    */
   if (ref->count > 1)
     {
	ref->count -= 1;
	return;
     }

   type = ref->data_type;
   cl = _SLclass_get_class (type);
   (*cl->cl_user_destroy_fun) (type, ref->user_data);
   SLfree ((char *)ref);
}

int SLang_push_value (unsigned char type, VOID_STAR v)
{
   SLang_Class_Type *cl;

   cl = _SLclass_get_class (type);
   return (*cl->cl_apush)(type, v);
}

int SLang_pop_value (unsigned char type, VOID_STAR v)
{
   SLang_Class_Type *cl;

   cl = _SLclass_get_class (type);
   return (*cl->cl_apop)(type, v);
}

void SLang_free_value (unsigned char type, VOID_STAR v)
{
   SLang_Class_Type *cl;

   cl = _SLclass_get_class (type);
   (*cl->cl_adestroy) (type, v);
}

/* These routines are very low-level and are designed for application data
 * types to access the stack from their push/pop methods.  The int and
 * pointer versions are in slang.c
 */
#if SLANG_HAS_FLOAT
int SLclass_push_float_obj (unsigned char type, float x)
{
   SLang_Object_Type obj;
   obj.data_type = type;
   obj.v.float_val = x;
   return SLang_push (&obj);
}
#endif

int SLclass_push_long_obj (unsigned char type, long x)
{
   SLang_Object_Type obj;
   obj.data_type = type;
   obj.v.long_val = x;
   return SLang_push (&obj);
}

int SLclass_push_short_obj (unsigned char type, short x)
{
   SLang_Object_Type obj;
   obj.data_type = type;
   obj.v.short_val = x;
   return SLang_push (&obj);
}

int SLclass_push_char_obj (unsigned char type, char x)
{
   SLang_Object_Type obj;
   obj.data_type = type;
   obj.v.char_val = x;
   return SLang_push (&obj);
}

#if SLANG_HAS_FLOAT
int SLclass_pop_double_obj (unsigned char type, double *x)
{
   SLang_Object_Type obj;

   if (-1 == _SLang_pop_object_of_type (type, &obj, 0))
     return -1;

   *x = obj.v.double_val;
   return 0;
}

int SLclass_pop_float_obj (unsigned char type, float *x)
{
   SLang_Object_Type obj;

   if (-1 == _SLang_pop_object_of_type (type, &obj, 0))
     return -1;

   *x = obj.v.float_val;
   return 0;
}
#endif

int SLclass_pop_long_obj (unsigned char type, long *x)
{
   SLang_Object_Type obj;

   if (-1 == _SLang_pop_object_of_type (type, &obj, 0))
     return -1;

   *x = obj.v.long_val;
   return 0;
}

int SLclass_pop_int_obj (unsigned char type, int *x)
{
   SLang_Object_Type obj;

   if (-1 == _SLang_pop_object_of_type (type, &obj, 0))
     return -1;

   *x = obj.v.int_val;
   return 0;
}

int SLclass_pop_short_obj (unsigned char type, short *x)
{
   SLang_Object_Type obj;

   if (-1 == _SLang_pop_object_of_type (type, &obj, 0))
     return -1;

   *x = obj.v.short_val;
   return 0;
}

int SLclass_pop_char_obj (unsigned char type, char *x)
{
   SLang_Object_Type obj;

   if (-1 == _SLang_pop_object_of_type (type, &obj, 0))
     return -1;

   *x = obj.v.char_val;
   return 0;
}

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

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