slclass.c

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

/* User defined objects */
/* Copyright (c) 1992, 1999, 2001, 2002, 2003 John E. Davis
 * This file is part of the S-Lang library.
 *
 * You may distribute under the terms of either the GNU General Public
 * License or the Perl Artistic License.
 */
#include "slinclud.h"

/* #define SL_APP_WANTS_FOREACH */
#include "slang.h"
#include "_slang.h"

static SLang_Class_Type *Registered_Types[256];
SLang_Class_Type *_SLclass_get_class (unsigned char type)
{
   SLang_Class_Type *cl;

   cl = Registered_Types [type];
   if (cl == NULL)
     SLang_exit_error ("Application error: Type %d not registered", (int) type);

   return cl;
}

int SLclass_is_class_defined (unsigned char type)
{
   return (NULL != Registered_Types[type]);
}

VOID_STAR _SLclass_get_ptr_to_value (SLang_Class_Type *cl,
				     SLang_Object_Type *obj)
{
   VOID_STAR p;

   switch (cl->cl_class_type)
     {
      case SLANG_CLASS_TYPE_MMT:
      case SLANG_CLASS_TYPE_PTR:
      case SLANG_CLASS_TYPE_SCALAR:
	p = (VOID_STAR) &obj->v;
	break;

      case SLANG_CLASS_TYPE_VECTOR:
	p = obj->v.ptr_val;
	break;

      default:
	p = NULL;
     }
   return p;
}

char *SLclass_get_datatype_name (unsigned char stype)
{
   SLang_Class_Type *cl;

   cl = _SLclass_get_class (stype);
   return cl->cl_name;
}

static int method_undefined_error (unsigned char type, char *method, char *name)
{
   if (name == NULL) name = SLclass_get_datatype_name (type);

   SLang_verror (SL_TYPE_MISMATCH, "%s method not defined for %s",
		 method, name);
   return -1;
}

static int
scalar_vector_bin_op_result (int op, unsigned char a, unsigned char b,
			     unsigned char *c)
{
   (void) a; (void) b;
   switch (op)
     {
      case SLANG_NE:
      case SLANG_EQ:
	*c = SLANG_INT_TYPE;
	return 1;
     }
   return 0;
}

static int
scalar_vector_bin_op (int op,
		      unsigned char a_type, VOID_STAR ap, unsigned int na,
		      unsigned char b_type, VOID_STAR bp, unsigned int nb,
		      VOID_STAR cp)
{
   int *c;
   char *a, *b;
   unsigned int da, db;
   unsigned int n, n_max;
   unsigned int data_type_len;
   SLang_Class_Type *cl;

   (void) b_type;
   cl = _SLclass_get_class (a_type);

   data_type_len = cl->cl_sizeof_type;

   a = (char *) ap;
   b = (char *) bp;
   c = (int *) cp;

   if (na == 1) da = 0; else da = data_type_len;
   if (nb == 1) db = 0; else db = data_type_len;
   if (na > nb) n_max = na; else n_max = nb;

   switch (op)
     {
      default:
	return 0;

      case SLANG_NE:
	for (n = 0; n < n_max; n++)
	  {
	     c[n] = (0 != SLMEMCMP(a, b, data_type_len));
	     a += da; b += db;
	  }
	break;

      case SLANG_EQ:
	for (n = 0; n < n_max; n++)
	  {
	     c[n] = (0 == SLMEMCMP(a, b, data_type_len));
	     a += da; b += db;
	  }
	break;
     }
   return 1;
}

static int scalar_fread (unsigned char type, FILE *fp, VOID_STAR ptr,
			 unsigned int desired, unsigned int *actual)
{
   unsigned int n;

   n = fread ((char *) ptr, _SLclass_get_class (type)->cl_sizeof_type,
	      desired, fp);
   *actual = n;
   return 0;
}

static int scalar_fwrite (unsigned char type, FILE *fp, VOID_STAR ptr,
			  unsigned int desired, unsigned int *actual)
{
   unsigned int n;

   n = fwrite ((char *) ptr, _SLclass_get_class (type)->cl_sizeof_type,
	       desired, fp);
   *actual = n;
   return 0;
}

static int vector_apush (unsigned char type, VOID_STAR ptr)
{
   SLang_Class_Type *cl;

   cl = _SLclass_get_class (type);
   return (*cl->cl_push)(type, (VOID_STAR) &ptr);
}

static int vector_apop (unsigned char type, VOID_STAR ptr)
{
   SLang_Class_Type *cl;

   cl = _SLclass_get_class (type);
   return (*cl->cl_pop)(type, (VOID_STAR) &ptr);
}

static int default_push_mmt (unsigned char type_unused, VOID_STAR ptr)
{
   SLang_MMT_Type *ref;

   (void) type_unused;
   ref = *(SLang_MMT_Type **) ptr;
   return SLang_push_mmt (ref);
}

static void default_destroy_simple (unsigned char type_unused, VOID_STAR ptr_unused)
{
   (void) type_unused;
   (void) ptr_unused;
}

static void default_destroy_user (unsigned char type, VOID_STAR ptr)
{
   (void) type;
   SLang_free_mmt (*(SLang_MMT_Type **) ptr);
}

static int default_pop (unsigned char type, VOID_STAR ptr)
{
   return SLclass_pop_ptr_obj (type, (VOID_STAR *) ptr);
}

static int default_datatype_deref (unsigned char type)
{
   return method_undefined_error (type, "datatype_deref", NULL);
}

static int default_acopy (unsigned char type, VOID_STAR from, VOID_STAR to)
{
   SLang_Class_Type *cl;

   cl = _SLclass_get_class (type);
   if (-1 == (*cl->cl_apush) (type, from))
     return -1;
   return (*cl->cl_apop) (type, to);
}

static int scalar_acopy (SLtype type, VOID_STAR from, VOID_STAR to)
{
   memcpy ((char *)to, (char *)from, _SLclass_get_class (type)->cl_sizeof_type);
   return 0;
}

int SLclass_dup_object (SLtype type, VOID_STAR from, VOID_STAR to)
{
   SLang_Class_Type *cl = _SLclass_get_class (type);
   return cl->cl_acopy (type, from, to);
}

static int default_dereference_object (unsigned char type, VOID_STAR ptr)
{
   (void) ptr;
   return method_undefined_error (type, "dereference", NULL);
}

static char *default_string (unsigned char stype, VOID_STAR v)
{
   char buf [256];
   char *s;
#if SLANG_HAS_COMPLEX
   double *cplx;
#endif
   s = buf;

   switch (stype)
     {
      case SLANG_STRING_TYPE:
	s = *(char **) v;
	break;

      case SLANG_NULL_TYPE:
	s = "NULL";
	break;

      case SLANG_DATATYPE_TYPE:
	s = SLclass_get_datatype_name ((unsigned char) *(int *)v);
	break;

#if SLANG_HAS_COMPLEX
      case SLANG_COMPLEX_TYPE:
	cplx = *(double **) v;
	if (cplx[1] < 0)
	  sprintf (s, "(%g - %gi)", cplx [0], -cplx [1]);
	else
	  sprintf (s, "(%g + %gi)", cplx [0], cplx [1]);
	break;
#endif
      default:
	s = SLclass_get_datatype_name (stype);
     }

   return SLmake_string (s);
}

static int
use_cmp_bin_op_result (int op, unsigned char a, unsigned char b,
		       unsigned char *c)
{
   if (a != b)
     return 0;
   switch (op)
     {
      case SLANG_NE:
      case SLANG_EQ:
      case SLANG_LT:
      case SLANG_LE:
      case SLANG_GT:
      case SLANG_GE:
	*c = SLANG_INT_TYPE;
	return 1;
     }
   return 0;
}

static int
use_cmp_bin_op (int op,
		unsigned char a_type, VOID_STAR ap, unsigned int na,
		unsigned char b_type, VOID_STAR bp, unsigned int nb,
		VOID_STAR cp)
{
   int *c;
   char *a, *b;
   unsigned int da, db;
   unsigned int n, n_max;
   unsigned int data_type_len;
   SLang_Class_Type *cl;
   int (*cmp)(unsigned char, VOID_STAR, VOID_STAR, int *);

   (void) b_type;
   cl = _SLclass_get_class (a_type);
   cmp = cl->cl_cmp;
   data_type_len = cl->cl_sizeof_type;

   a = (char *) ap;
   b = (char *) bp;
   c = (int *) cp;

   if (na == 1) da = 0; else da = data_type_len;
   if (nb == 1) db = 0; else db = data_type_len;
   if (na > nb) n_max = na; else n_max = nb;

   switch (op)
     {
	int result;
	
      default:
	return 0;

      case SLANG_NE:
	for (n = 0; n < n_max; n++)
	  {
	     if (-1 == (*cmp) (a_type, (VOID_STAR)a, (VOID_STAR)b, &result))
	       return -1;
	     c[n] = (result != 0);
	     a += da; b += db;
	  }
	break;

      case SLANG_EQ:
	for (n = 0; n < n_max; n++)
	  {
	     if (-1 == (*cmp) (a_type, (VOID_STAR)a, (VOID_STAR)b, &result))
	       return -1;
	     c[n] = (result == 0);
	     a += da; b += db;
	  }
	break;

      case SLANG_GT:
	for (n = 0; n < n_max; n++)
	  {
	     if (-1 == (*cmp) (a_type, (VOID_STAR)a, (VOID_STAR)b, &result))
	       return -1;
	     c[n] = (result > 0);
	     a += da; b += db;
	  }
	break;
      case SLANG_GE:
	for (n = 0; n < n_max; n++)
	  {
	     if (-1 == (*cmp) (a_type, (VOID_STAR)a, (VOID_STAR)b, &result))
	       return -1;
	     c[n] = (result >= 0);
	     a += da; b += db;
	  }
	break;
      case SLANG_LT:
	for (n = 0; n < n_max; n++)
	  {
	     if (-1 == (*cmp) (a_type, (VOID_STAR)a, (VOID_STAR)b, &result))
	       return -1;
	     c[n] = (result < 0);
	     a += da; b += db;
	  }
	break;
      case SLANG_LE:
	for (n = 0; n < n_max; n++)
	  {
	     if (-1 == (*cmp) (a_type, (VOID_STAR)a, (VOID_STAR)b, &result))
	       return -1;
	     c[n] = (result <= 0);
	     a += da; b += db;
	  }
	break;
     }
   return 1;
}


int SLclass_get_class_id (SLang_Class_Type *cl)
{
   if (cl == NULL)
     return -1;
   return (int) cl->cl_data_type;
}

SLang_Class_Type *SLclass_allocate_class (char *name)
{
   SLang_Class_Type *cl;
   unsigned int i;

   for (i = 0; i < 256; i++)
     {
	cl = Registered_Types [i];
	if ((cl != NULL)
	    && (0 == strcmp (cl->cl_name, name)))
	  {
	     SLang_verror (SL_DUPLICATE_DEFINITION, "Type name %s already exists", name);
	     return NULL;
	  }
     }

   cl = (SLang_Class_Type *) SLmalloc (sizeof (SLang_Class_Type));
   if (cl == NULL) return NULL;

   SLMEMSET ((char *) cl, 0, sizeof (SLang_Class_Type));

   if (NULL == (cl->cl_name = SLang_create_slstring (name)))
     {
	SLfree ((char *) cl);
	return NULL;
     }

   return cl;
}

static int DataType_Ids [256];

int SLang_push_datatype (unsigned char data_type)
{
   /* This data type could be a copy of another type, e.g., short and
    * int if they are the same size (Int16 == Short).  So, make sure
    * we push the original and not the copy. 
    */
   data_type = _SLclass_get_class (data_type)->cl_data_type;
   return SLclass_push_int_obj (SLANG_DATATYPE_TYPE, (int) data_type);
}

static int datatype_deref (unsigned char type, VOID_STAR ptr)
{
   SLang_Class_Type *cl;
   int status;

   /* The parser generated code for this as if a function call were to be
    * made.  However, we are calling the deref object routine
    * instead of the function call.  So, I must simulate the function call.
    */
   if (-1 == _SL_increment_frame_pointer ())
     return -1;

   type = (unsigned char) *(int *) ptr;
   cl = _SLclass_get_class (type);
   status = (*cl->cl_datatype_deref) (type);

   (void) _SL_decrement_frame_pointer ();
   return status;
}

static int datatype_push (unsigned char type_unused, VOID_STAR ptr)
{
   (void) type_unused;
   return SLang_push_datatype (*(int *) ptr);
}

int SLang_pop_datatype (unsigned char *type)
{
   int i;

   if (-1 == SLclass_pop_int_obj (SLANG_DATATYPE_TYPE, &i))
     return -1;

   *type = (unsigned char) i;
   return 0;
}

static int datatype_pop (unsigned char type, VOID_STAR ptr)