slclass.c

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

{
   if (-1 == SLang_pop_datatype (&type))
     return -1;

   *(int *) ptr = type;
   return 0;
}

int _SLclass_init (void)
{
   SLang_Class_Type *cl;

   /* First initialize the container classes.  This is so binary operations
    * added later will work with them.
    */
   if (-1 == _SLarray_init_slarray ())
     return -1;

   /* DataType_Type */
   if (NULL == (cl = SLclass_allocate_class ("DataType_Type")))
     return -1;
   cl->cl_pop = datatype_pop;
   cl->cl_push = datatype_push;
   cl->cl_dereference = datatype_deref;
   if (-1 == SLclass_register_class (cl, SLANG_DATATYPE_TYPE, sizeof(int),
				     SLANG_CLASS_TYPE_SCALAR))
     return -1;

   return 0;
}

static int register_new_datatype (char *name, unsigned char type)
{
   DataType_Ids [type] = type;
   return SLadd_intrinsic_variable (name, (VOID_STAR) (DataType_Ids + type),
				    SLANG_DATATYPE_TYPE, 1);
}

int SLclass_create_synonym (char *name, unsigned char type)
{
   if (NULL == _SLclass_get_class (type))
     return -1;

   return register_new_datatype (name, type);
}

int _SLclass_copy_class (unsigned char to, unsigned char from)
{
   SLang_Class_Type *cl = _SLclass_get_class (from);

   if (Registered_Types[to] != NULL)
     SLang_exit_error ("Application error: Class already exists");

   Registered_Types[to] = cl;

#if _SLANG_OPTIMIZE_FOR_SPEED
   if (to != SLANG_UNDEFINED_TYPE)
     _SLang_set_class_type(to, cl->cl_class_type);
#endif
   return 0;
}

int SLclass_register_class (SLang_Class_Type *cl, unsigned char type, unsigned int type_size, unsigned char class_type)
{
   char *name;
   unsigned int i;
   int can_binop = 1;		       /* scalar_vector_bin_op should work
					* for all data types.
					*/

   if (type == SLANG_VOID_TYPE) for (i = _SLANG_MIN_UNUSED_TYPE; i < 256; i++)
     {
	if (Registered_Types[i] == NULL)
	  {
	     type = (unsigned char) i;
	     break;
	  }
     }

   if ((NULL != Registered_Types [type])
       || (type == SLANG_VOID_TYPE))
     {
	SLang_verror (SL_APPLICATION_ERROR, "Class type %d already in use", (int) type);
	return -1;
     }

   cl->cl_data_type = type;
   cl->cl_class_type = class_type;
   name = cl->cl_name;

   switch (class_type)
     {
      case SLANG_CLASS_TYPE_MMT:
	if (cl->cl_push == NULL) cl->cl_push = default_push_mmt;
	if (cl->cl_destroy == NULL)
	  return method_undefined_error (type, "destroy", name);
	cl->cl_user_destroy_fun = cl->cl_destroy;
	cl->cl_destroy = default_destroy_user;
	type_size = sizeof (VOID_STAR);
	break;

      case SLANG_CLASS_TYPE_SCALAR:
	if (cl->cl_destroy == NULL) cl->cl_destroy = default_destroy_simple;
	if ((type_size == 0)
	    || (type_size > sizeof (_SL_Object_Union_Type)))
	  {
	     SLang_verror (SL_INVALID_PARM,
			   "Type size for %s not appropriate for SCALAR type",
			   name);
	     return -1;
	  }
	if (cl->cl_pop == NULL)
	  return method_undefined_error (type, "pop", name);
	if (cl->cl_fread == NULL) cl->cl_fread = scalar_fread;
	if (cl->cl_fwrite == NULL) cl->cl_fwrite = scalar_fwrite;
	if (cl->cl_acopy == NULL) cl->cl_acopy = scalar_acopy;

	can_binop = 1;
	break;

      case SLANG_CLASS_TYPE_PTR:
	if (cl->cl_destroy == NULL)
	  return method_undefined_error (type, "destroy", name);
	type_size = sizeof (VOID_STAR);
	break;

      case SLANG_CLASS_TYPE_VECTOR:
	if (cl->cl_destroy == NULL)
	  return method_undefined_error (type, "destroy", name);
	if (cl->cl_pop == NULL)
	  return method_undefined_error (type, "pop", name);
	cl->cl_apop = vector_apop;
	cl->cl_apush = vector_apush;
	cl->cl_adestroy = default_destroy_simple;
	if (cl->cl_fread == NULL) cl->cl_fread = scalar_fread;
	if (cl->cl_fwrite == NULL) cl->cl_fwrite = scalar_fwrite;
	if (cl->cl_acopy == NULL) cl->cl_acopy = scalar_acopy;
	can_binop = 1;
	break;

      default:
	SLang_verror (SL_INVALID_PARM, "%s: unknown class type (%d)", name, class_type);
	return -1;
     }

#if _SLANG_OPTIMIZE_FOR_SPEED
   if (type != SLANG_UNDEFINED_TYPE)
     _SLang_set_class_type (type, class_type);
#endif

   if (type_size == 0)
     {
	SLang_verror (SL_INVALID_PARM, "type size must be non-zero for %s", name);
	return -1;
     }

   if (cl->cl_string == NULL) cl->cl_string = default_string;
   if (cl->cl_acopy == NULL) cl->cl_acopy = default_acopy;
   if (cl->cl_datatype_deref == NULL) cl->cl_datatype_deref = default_datatype_deref;

   if (cl->cl_pop == NULL) cl->cl_pop = default_pop;

   if (cl->cl_push == NULL)
     return method_undefined_error (type, "push", name);

   if (cl->cl_byte_code_destroy == NULL)
     cl->cl_byte_code_destroy = cl->cl_destroy;
   if (cl->cl_push_literal == NULL)
     cl->cl_push_literal = cl->cl_push;

   if (cl->cl_dereference == NULL)
     cl->cl_dereference = default_dereference_object;

   if (cl->cl_apop == NULL) cl->cl_apop = cl->cl_pop;
   if (cl->cl_apush == NULL) cl->cl_apush = cl->cl_push;
   if (cl->cl_adestroy == NULL) cl->cl_adestroy = cl->cl_destroy;
   if (cl->cl_push_intrinsic == NULL) cl->cl_push_intrinsic = cl->cl_push;

   if ((cl->cl_foreach == NULL)
       || (cl->cl_foreach_open == NULL)
       || (cl->cl_foreach_close == NULL))
     {
	cl->cl_foreach = _SLarray_cl_foreach;
	cl->cl_foreach_open = _SLarray_cl_foreach_open;
	cl->cl_foreach_close = _SLarray_cl_foreach_close;
     }

   cl->cl_sizeof_type = type_size;

   if (NULL == (cl->cl_transfer_buf = (VOID_STAR) SLmalloc (type_size)))
     return -1;

   Registered_Types[type] = cl;

   if (-1 == register_new_datatype (name, type))
     return -1;

   if (cl->cl_cmp != NULL)
     {
	if (-1 == SLclass_add_binary_op (type, type, use_cmp_bin_op, use_cmp_bin_op_result))
	  return -1;
     }
   else if (can_binop
	    && (-1 == SLclass_add_binary_op (type, type, scalar_vector_bin_op, scalar_vector_bin_op_result)))
     return -1;

   cl->cl_anytype_typecast = _SLanytype_typecast;

   return 0;
}

int SLclass_add_math_op (unsigned char type,
			 int (*handler)(int,
					unsigned char, VOID_STAR, unsigned int,
					VOID_STAR),
			 int (*result) (int, unsigned char, unsigned char *))
{
   SLang_Class_Type *cl = _SLclass_get_class (type);

   cl->cl_math_op = handler;
   cl->cl_math_op_result_type = result;
   return 0;
}

int SLclass_add_binary_op (unsigned char a, unsigned char b,
			   int (*f) (int,
				     unsigned char, VOID_STAR, unsigned int,
				     unsigned char, VOID_STAR, unsigned int,
				     VOID_STAR),
			   int (*r) (int, unsigned char, unsigned char, unsigned char *))
{
   SLang_Class_Type *cl;
   SL_OOBinary_Type *ab;

   if ((f == NULL) || (r == NULL))
     {
	SLang_verror (SL_INVALID_PARM, "SLclass_add_binary_op");
	return -1;
     }

   cl = _SLclass_get_class (a);
   (void) _SLclass_get_class (b);

   if (NULL == (ab = (SL_OOBinary_Type *) SLmalloc (sizeof(SL_OOBinary_Type))))
     return -1;

   ab->data_type = b;
   ab->binary_function = f;
   ab->binary_result = r;
   ab->next = cl->cl_binary_ops;
   cl->cl_binary_ops = ab;

   if ((a != SLANG_ARRAY_TYPE)
       && (b != SLANG_ARRAY_TYPE))
     {
	if ((-1 == _SLarray_add_bin_op (a))
	    || (-1 == _SLarray_add_bin_op (b)))
	  return -1;
     }

   return 0;
}

int SLclass_add_unary_op (unsigned char type,
			  int (*f)(int,
				   unsigned char, VOID_STAR, unsigned int,
				   VOID_STAR),
			  int (*r)(int, unsigned char, unsigned char *))
{
   SLang_Class_Type *cl;

   cl = _SLclass_get_class (type);
   if ((f == NULL) || (r == NULL))
     {
	SLang_verror (SL_INVALID_PARM, "SLclass_add_unary_op");
	return -1;
     }

   cl->cl_unary_op = f;
   cl->cl_unary_op_result_type = r;

   return 0;
}

int SLclass_add_app_unary_op (unsigned char type,
			      int (*f)(int,
				       unsigned char, VOID_STAR, unsigned int,
				       VOID_STAR),
			      int (*r)(int, unsigned char, unsigned char *))
{
   SLang_Class_Type *cl;

   cl = _SLclass_get_class (type);
   if ((f == NULL) || (r == NULL))
     {
	SLang_verror (SL_INVALID_PARM, "SLclass_add_app_unary_op");
	return -1;
     }

   cl->cl_app_unary_op = f;
   cl->cl_app_unary_op_result_type = r;

   return 0;
}

int SLclass_set_pop_function (SLang_Class_Type *cl, int (*f)(unsigned char, VOID_STAR))
{
   if (cl == NULL) return -1;
   cl->cl_pop = f;

   return 0;
}

int SLclass_set_push_function (SLang_Class_Type *cl, int (*f)(SLtype, VOID_STAR))
{
   if (cl == NULL) return -1;
   cl->cl_push = f;

   return 0;
}

int SLclass_set_apush_function (SLang_Class_Type *cl, int (*f)(SLtype, VOID_STAR))
{
   if (cl == NULL) return -1;
   cl->cl_apush = f;

   return 0;
}

int SLclass_set_acopy_function (SLang_Class_Type *cl, int (*f)(SLtype, VOID_STAR, VOID_STAR))
{
   if (cl == NULL) return -1;
   cl->cl_acopy = f;

   return 0;
}

int SLclass_set_string_function (SLang_Class_Type *cl, char *(*f)(unsigned char, VOID_STAR))
{
   if (cl == NULL) return -1;

   cl->cl_string = f;
   return 0;
}

int SLclass_set_destroy_function (SLang_Class_Type *cl, void (*f)(unsigned char, VOID_STAR))
{
   if (cl == NULL) return -1;

   cl->cl_destroy = f;
   return 0;
}

int SLclass_set_sget_function (SLang_Class_Type *cl, int (*f)(unsigned char, char *))
{
   if (cl == NULL) return -1;
   cl->cl_sget = f;
   return 0;
}

int SLclass_set_sput_function (SLang_Class_Type *cl, int (*f)(unsigned char, char *))
{
   if (cl == NULL) return -1;
   cl->cl_sput = f;
   return 0;
}

int SLclass_set_aget_function (SLang_Class_Type *cl, int (*f)(unsigned char, unsigned int))
{
   if (cl == NULL) return -1;
   cl->cl_aget = f;
   return 0;
}

int SLclass_set_aput_function (SLang_Class_Type *cl, int (*f)(unsigned char, unsigned int))
{
   if (cl == NULL) return -1;
   cl->cl_aput = f;
   return 0;
}

int SLclass_set_anew_function (SLang_Class_Type *cl, int (*f)(unsigned char, unsigned int))
{
   if (cl == NULL) return -1;
   cl->cl_anew = f;
   return 0;
}

/* Misc */
void _SLclass_type_mismatch_error (unsigned char a, unsigned char b)
{
   SLang_verror (SL_TYPE_MISMATCH, "Expecting %s, found %s",
		 SLclass_get_datatype_name (a),
		 SLclass_get_datatype_name (b));
}

/* */

static int null_binary_fun (int op,
			    unsigned char a, VOID_STAR ap, unsigned int na,
			    unsigned char b, VOID_STAR bp, unsigned int nb,
			    VOID_STAR cp)
{
   int *ic;
   unsigned int i;
   int c;

   (void) ap; (void) bp;

   switch (op)
     {
      case SLANG_EQ:
	c = (a == b);
	break;

      case SLANG_NE:
	c = (a != b);
	break;

      default:
	return 0;
     }

   if (na > nb) nb = na;
   ic = (int *) cp;
   for (i = 0; i < nb; i++)
     ic[i] = c;

   return 1;
}

static char *get_binary_op_string (int op)
{
   static char *ops[SLANG_MOD] =
     {
	"+", "=", "*", "/", "==", "!=", ">", ">=", "<", "<=", "^",
	"or", "and", "&", "|", "xor", "shl", "shr", "mod"
     };

   if ((op > SLANG_MOD) || (op <= 0))
     return "- ?? -";		       /* Note: -??- is a trigraph (sigh) */
   return ops[op - 1];
}

int (*_SLclass_get_binary_fun (int op,
			       SLang_Class_Type *a_cl, SLang_Class_Type *b_cl,
			       SLang_Class_Type **c_cl, int do_error))
(int,
 unsigned char, VOID_STAR, unsigned int,
 unsigned char, VOID_STAR, unsigned int,
 VOID_STAR)
{
   SL_OOBinary_Type *bt;
   unsigned char a, b, c;

   a = a_cl->cl_data_type;
   b = b_cl->cl_data_type;

   if ((a == SLANG_NULL_TYPE) || (b == SLANG_NULL_TYPE))
     {
	*c_cl = _SLclass_get_class (SLANG_INT_TYPE);
	return null_binary_fun;
     }

   bt = a_cl->cl_binary_ops;

   while (bt != NULL)
     {
	if (bt->data_type == b)
	  {
	     if (1 != (*bt->binary_result)(op, a, b, &c))
	       break;