Source Jam - slang-2.0.6

static void f (to_type *y, from_type *x, unsigned int n) \
{ \
   unsigned int i; \
   for (i = 0; i < n; i++) y[i] = (to_type) x[i]; \
}

static VOID_STAR f (VOID_STAR xp, unsigned int n) \
{ \
   from_type *x; \
   to_type *y; \
   x = (from_type *) xp; \
   if (NULL == (y = (to_type *) SLmalloc (sizeof (to_type) * n))) return NULL; \
   copy_fun (y, x, n); \
   return (VOID_STAR) y; \
}

01416 {
01417    SLtype a_type, b_type;
01418    SLang_Object_Type obj_a, obj_b;
01419 
01420    a_type = oa->data_type;
01421    b_type = ob->data_type;
01422 
01423    if (a_type != b_type)
01424      {
01425         /* Handle common cases */
01426 #if SLANG_HAS_FLOAT
01427         if ((a_type == SLANG_INT_TYPE)
01428             && (b_type == SLANG_DOUBLE_TYPE))
01429           return double_double_scalar_bin_op (oa->v.int_val, ob->v.double_val, op);
01430 
01431         if ((a_type == SLANG_DOUBLE_TYPE)
01432             && (b_type == SLANG_INT_TYPE))
01433           return double_double_scalar_bin_op (oa->v.double_val, ob->v.int_val, op);
01434 #endif
01435         /* Otherwise do it the hard way */
01436         promote_objs (oa, ob, &obj_a, &obj_b);
01437         oa = &obj_a;
01438         ob = &obj_b;
01439         
01440         a_type = oa->data_type;
01441         /* b_type = ob->data_type; */
01442      }
01443    
01444           
01445    switch (a_type)
01446      {
01447       case SLANG_CHAR_TYPE:
01448         return int_int_scalar_bin_op (oa->v.char_val, ob->v.char_val, op);
01449 
01450       case SLANG_UCHAR_TYPE:
01451         return int_int_scalar_bin_op (oa->v.uchar_val, ob->v.uchar_val, op);
01452 
01453       case SLANG_SHORT_TYPE:
01454         return int_int_scalar_bin_op (oa->v.short_val, ob->v.short_val, op);
01455 
01456       case SLANG_USHORT_TYPE:
01457 # if SHORT_IS_INT
01458         return uint_uint_scalar_bin_op (oa->v.ushort_val, ob->v.ushort_val, op);
01459 # else
01460         return int_int_scalar_bin_op ((int)oa->v.ushort_val, (int)ob->v.ushort_val, op);
01461 # endif
01462 
01463 #if LONG_IS_INT
01464       case SLANG_LONG_TYPE:
01465 #endif
01466       case SLANG_INT_TYPE:
01467         return int_int_scalar_bin_op (oa->v.int_val, ob->v.int_val, op);
01468 
01469 #if LONG_IS_INT
01470       case SLANG_ULONG_TYPE:
01471 #endif
01472       case SLANG_UINT_TYPE:
01473         return uint_uint_scalar_bin_op (oa->v.uint_val, ob->v.uint_val, op);
01474         
01475 #if LONG_IS_NOT_INT
01476       case SLANG_LONG_TYPE:
01477         return long_long_scalar_bin_op (oa->v.long_val, ob->v.long_val, op);
01478       case SLANG_ULONG_TYPE:
01479         return ulong_ulong_scalar_bin_op (oa->v.ulong_val, ob->v.ulong_val, op);
01480 #endif
01481 #ifdef HAVE_LONG_LONG
01482       case SLANG_LLONG_TYPE:
01483         return llong_llong_scalar_bin_op (oa->v.llong_val, ob->v.llong_val, op);
01484       case SLANG_ULLONG_TYPE:
01485         return ullong_ullong_scalar_bin_op (oa->v.ullong_val, ob->v.ullong_val, op);
01486 #endif
01487 #if SLANG_HAS_FLOAT
01488       case SLANG_FLOAT_TYPE:
01489         return float_float_scalar_bin_op (oa->v.float_val, ob->v.float_val, op);
01490       case SLANG_DOUBLE_TYPE:
01491         return double_double_scalar_bin_op (oa->v.double_val, ob->v.double_val, op);
01492 #endif
01493      }
01494 
01495    return 1;
01496 }

00418 {
00419    if ((type < SLANG_CHAR_TYPE) || (type > MAX_SLARITH_TYPE))
00420      return -1;
00421  
00422    type = Alias_Map[TYPE_TO_TABLE_INDEX(type)];
00423    return type - SLANG_CHAR_TYPE;
00424 }

00427 {
00428    t = Alias_Map[TYPE_TO_TABLE_INDEX(t)];
00429 
00430    switch (t)
00431      {
00432       case SLANG_INT_TYPE:
00433       case SLANG_UINT_TYPE:
00434       case SLANG_LONG_TYPE:
00435       case SLANG_ULONG_TYPE:
00436 #ifdef HAVE_LONG_LONG
00437       case SLANG_LLONG_TYPE:
00438       case SLANG_ULLONG_TYPE:
00439 #endif
00440       case SLANG_FLOAT_TYPE:
00441       case SLANG_DOUBLE_TYPE:
00442         break;
00443 
00444       case SLANG_USHORT_TYPE:
00445 #if SHORT_IS_INT
00446         t = SLANG_UINT_TYPE;
00447         break;
00448 #endif
00449         /* drop */
00450       case SLANG_CHAR_TYPE:
00451       case SLANG_UCHAR_TYPE:
00452       case SLANG_SHORT_TYPE:
00453       default:
00454         t = SLANG_INT_TYPE;
00455      }
00456 
00457    return t;
00458 }

01232 {
01233    SLang_Class_Type *cl;
01234    SLtype a_type, b_type;
01235    int i, j;
01236 
01237 #if defined(HAVE_SETLOCALE) && defined(LC_NUMERIC)
01238    /* make sure decimal point it used --- the parser requires it */
01239    (void) setlocale (LC_NUMERIC, "C"); 
01240 #endif
01241 
01242    for (i = 0; i < NUM_INTEGER_TYPES; i++)
01243      {
01244         Integer_Info_Type *info;
01245 
01246         info = Integer_Types + i;
01247 
01248         _pSLang_set_arith_type (info->data_type, 1);
01249 
01250         if (info->name == NULL)
01251           {
01252              /* This happens when the object is the same size as an integer
01253               * For this case, we really want to copy the integer class.
01254               * We will handle that when the synonym is created.
01255               */
01256              continue;
01257           }
01258 
01259         if (NULL == (cl = SLclass_allocate_class (info->name)))
01260           return -1;
01261 
01262         (void) SLclass_set_string_function (cl, arith_string);
01263         (void) SLclass_set_push_function (cl, integer_push);
01264         (void) SLclass_set_pop_function (cl, integer_pop);
01265         cl->cl_push_literal = info->push_literal;
01266         cl->cl_to_bool = integer_to_bool;
01267         cl->cl_byte_code_destroy = info->byte_code_destroy;
01268 
01269         cl->cl_cmp = info->cmp_fun;
01270 
01271         if (-1 == SLclass_register_class (cl, info->data_type, info->sizeof_type,
01272                                           SLANG_CLASS_TYPE_SCALAR))
01273           return -1;
01274         if (-1 == SLclass_add_unary_op (info->data_type, info->unary_fun, arith_unary_op_result))
01275           return -1;
01276 #if 0
01277         if (-1 == _pSLclass_add_arith_unary_op (info->data_type, info->arith_unary_fun, arith_unary_arith_op_result))
01278           return -1;
01279 #endif
01280      }
01281 
01282 #if SLANG_HAS_FLOAT
01283    if (NULL == (cl = SLclass_allocate_class ("Double_Type")))
01284      return -1;
01285    (void) SLclass_set_push_function (cl, double_push);
01286    (void) SLclass_set_pop_function (cl, double_pop);
01287    (void) SLclass_set_string_function (cl, arith_string);
01288    cl->cl_byte_code_destroy = double_byte_code_destroy;
01289    cl->cl_push_literal = double_push_literal;
01290    cl->cl_cmp = double_cmp_function;
01291 
01292    if (-1 == SLclass_register_class (cl, SLANG_DOUBLE_TYPE, sizeof (double),
01293                                      SLANG_CLASS_TYPE_SCALAR))
01294      return -1;
01295    if (-1 == SLclass_add_unary_op (SLANG_DOUBLE_TYPE, double_unary_op, arith_unary_op_result))
01296      return -1;
01297 #if 0
01298    if (-1 == _pSLclass_add_arith_unary_op (SLANG_DOUBLE_TYPE, double_arith_unary_op, arith_unary_op_result))
01299      return -1;
01300 #endif
01301    _pSLang_set_arith_type (SLANG_DOUBLE_TYPE, 2);
01302 
01303    if (NULL == (cl = SLclass_allocate_class ("Float_Type")))
01304      return -1;
01305    (void) SLclass_set_string_function (cl, arith_string);
01306    (void) SLclass_set_push_function (cl, float_push);
01307    (void) SLclass_set_pop_function (cl, float_pop);
01308    cl->cl_cmp = float_cmp_function;
01309 
01310    if (-1 == SLclass_register_class (cl, SLANG_FLOAT_TYPE, sizeof (float),
01311                                      SLANG_CLASS_TYPE_SCALAR))
01312      return -1;
01313    if (-1 == SLclass_add_unary_op (SLANG_FLOAT_TYPE, float_unary_op, arith_unary_op_result))
01314      return -1;
01315 #if 0
01316    if (-1 == _pSLclass_add_arith_unary_op (SLANG_FLOAT_TYPE, float_arith_unary_op, arith_unary_op_result))
01317      return -1;
01318 #endif
01319    _pSLang_set_arith_type (SLANG_FLOAT_TYPE, 2);
01320 #endif
01321 
01322    if (-1 == create_synonyms ())
01323      return -1;
01324 
01325    for (i = 0; i < MAX_ARITHMETIC_TYPES; i++)
01326      {
01327         a_type = _pSLarith_Arith_Types[i];
01328 #if 0
01329         if (Alias_Map[TYPE_TO_TABLE_INDEX(a_type)] != a_type)
01330           continue;
01331 #endif
01332         if (a_type == 0) 
01333           continue;
01334 
01335         for (j = 0; j < MAX_ARITHMETIC_TYPES; j++)
01336           {
01337              int implicit_ok;
01338 
01339              b_type = _pSLarith_Arith_Types[j];
01340              if (b_type == 0)
01341                continue;
01342              /* Allow implicit typecast, except from int to float */
01343              implicit_ok = ((b_type >= SLANG_FLOAT_TYPE) 
01344                             || (a_type < SLANG_FLOAT_TYPE));
01345 
01346              if (-1 == SLclass_add_binary_op (a_type, b_type, arith_bin_op, arith_bin_op_result))
01347                return -1;
01348 
01349              if (a_type != b_type)
01350                if (-1 == SLclass_add_typecast (a_type, b_type, _pSLarith_typecast, implicit_ok))
01351                  return -1;
01352           }
01353      }
01354 
01355    if (-1 == _pSLadd_arith_unary_table (Unary_Table, NULL))
01356      return -1;
01357    if (-1 == _pSLadd_arith_binary_table (Binary_Table, NULL))
01358      return -1;
01359 
01360    if ((-1 == SLadd_iconstant_table (IConst_Table, NULL))
01361 #if SLANG_HAS_FLOAT
01362        || (-1 == SLadd_fconstant_table (FConst_Table, NULL))
01363        || (-1 == SLadd_dconstant_table (DConst_Table, NULL))
01364 #endif
01365 #if HAVE_LONG_LONG
01366        || (-1 == SLadd_llconstant_table (LLConst_Table, NULL))
01367 #endif
01368        )
01369      return -1;
01370 
01371    return 0;
01372 }

00760 {
00761    int i, j;
00762 
00763    void (*copy)(VOID_STAR, VOID_STAR, unsigned int);
00764 
00765    i = TYPE_TO_TABLE_INDEX (a_type);
00766    j = TYPE_TO_TABLE_INDEX (b_type);
00767 
00768    copy = (void (*)(VOID_STAR, VOID_STAR, unsigned int))
00769      Binary_Matrix[i][j].copy_function;
00770 
00771    (*copy) (bp, ap, na);
00772    return 1;
00773 }

00888 {
00889    strncpy (Double_Format, s, 15);
00890    Double_Format[15] = 0;
00891 }

00542 {
00543    Convert_Fun_Type af, bf;
00544    Bin_Fun_Type binfun;
00545    int a_indx, b_indx, c_indx;
00546    SLtype c_type;
00547    int ret;
00548 
00549    c_type = promote_to_common_type (a_type, b_type);
00550 
00551    a_indx = TYPE_TO_TABLE_INDEX(a_type);
00552    b_indx = TYPE_TO_TABLE_INDEX(b_type);
00553    c_indx = TYPE_TO_TABLE_INDEX(c_type);
00554 
00555    af = Binary_Matrix[a_indx][c_indx].convert_function;
00556    bf = Binary_Matrix[b_indx][c_indx].convert_function;
00557    binfun = Bin_Fun_Map[c_indx];
00558 
00559    if ((af != NULL)
00560        && (NULL == (ap = (VOID_STAR) (*af) (ap, na))))
00561      return -1;
00562 
00563    if ((bf != NULL)
00564        && (NULL == (bp = (VOID_STAR) (*bf) (bp, nb))))
00565      {
00566         if (af != NULL) SLfree ((char *) ap);
00567         return -1;
00568      }
00569 
00570    ret = (*binfun) (op, a_type, ap, na, b_type, bp, nb, cp);
00571    if (af != NULL) SLfree ((char *) ap);
00572    if (bf != NULL) SLfree ((char *) bp);
00573 
00574    return ret;
00575 }

00470 {
00471    switch (op)
00472      {
00473       case SLANG_EQ:
00474       case SLANG_NE:
00475       case SLANG_GT:
00476       case SLANG_GE:
00477       case SLANG_LT:
00478       case SLANG_LE:
00479       case SLANG_OR:
00480       case SLANG_AND:
00481         *c_type = SLANG_CHAR_TYPE;
00482         return 1;
00483 #if SLANG_HAS_FLOAT
00484       case SLANG_POW:
00485         if (SLANG_FLOAT_TYPE == promote_to_common_type (a_type, b_type))
00486           *c_type = SLANG_FLOAT_TYPE;
00487         else
00488           *c_type = SLANG_DOUBLE_TYPE;
00489         return 1;
00490 #endif
00491       case SLANG_BAND:
00492       case SLANG_BXOR:
00493       case SLANG_BOR:
00494       case SLANG_SHL:
00495       case SLANG_SHR:
00496         /* The bit-level operations are defined just for integer types */
00497         if ((0 == IS_INTEGER_TYPE (a_type))
00498             || (0 == IS_INTEGER_TYPE(b_type)))
00499           return 0;
00500         break;
00501 
00502       default:
00503         break;
00504      }
00505 
00506    *c_type = promote_to_common_type (a_type, b_type);
00507    return 1;
00508 }

00895 {
00896    char buf [1024];
00897    char *s;
00898 
00899    s = buf;
00900 
00901    switch (type)
00902      {
00903       default:
00904         s = SLclass_get_datatype_name (type);
00905         break;
00906 
00907       case SLANG_CHAR_TYPE:
00908         sprintf (s, "%d", *(char *) v);
00909         break;
00910       case SLANG_UCHAR_TYPE:
00911         sprintf (s, "%u", *(unsigned char *) v);
00912         break;
00913       case SLANG_SHORT_TYPE:
00914         sprintf (s, "%d", *(short *) v);
00915         break;
00916       case SLANG_USHORT_TYPE:
00917         sprintf (s, "%u", *(unsigned short *) v);
00918         break;
00919       case SLANG_INT_TYPE:
00920         sprintf (s, "%d", *(int *) v);
00921         break;
00922       case SLANG_UINT_TYPE:
00923         sprintf (s, "%u", *(unsigned int *) v);
00924         break;
00925       case SLANG_LONG_TYPE:
00926         sprintf (s, "%ld", *(long *) v);
00927         break;
00928       case SLANG_ULONG_TYPE:
00929         sprintf (s, "%lu", *(unsigned long *) v);
00930         break;
00931 #ifdef HAVE_LONG_LONG
00932       case SLANG_LLONG_TYPE:
00933         sprintf (s, "%lld", *(long long *) v);
00934         break;
00935       case SLANG_ULLONG_TYPE:
0093


Classes
struct	Binary_Matrix_Type
struct	Integer_Info_Type
Defines
#define	MAX_SLARITH_INT_TYPE SLANG_ULONG_TYPE
#define	MAX_SLARITH_TYPE SLANG_LDOUBLE_TYPE
#define	MAX_ARITHMETIC_TYPES (MAX_SLARITH_TYPE-SLANG_CHAR_TYPE+1)
#define	TYPE_TO_TABLE_INDEX(t) ((t)-SLANG_CHAR_TYPE)
#define	TABLE_INDEX_TO_TYPE(i) ((i)+SLANG_CHAR_TYPE)
#define	IS_INTEGER_TYPE(t) (((t) >= SLANG_CHAR_TYPE) && ((t) <= MAX_SLARITH_INT_TYPE))
#define	DEFUN_1(f, from_type, to_type)
#define	DEFUN_2(f, from_type, to_type, copy_fun)
#define	TO_DOUBLE_FUN(name, type) static double name (VOID_STAR x) { return (double) (type ) x; }
#define	GENERIC_BINARY_FUNCTION int_int_bin_op
#define	GENERIC_BIT_OPERATIONS
#define	GENERIC_TYPE int
#define	POW_FUNCTION(a, b) pow((double)(a),(double)(b))
#define	POW_RESULT_TYPE double
#define	ABS_FUNCTION abs
#define	MOD_FUNCTION(a, b) ((a) % (b))
#define	TRAP_DIV_ZERO 1
#define	GENERIC_UNARY_FUNCTION int_unary_op
#define	GENERIC_ARITH_UNARY_FUNCTION int_arith_unary_op
#define	SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0))
#define	SCALAR_BINARY_FUNCTION int_int_scalar_bin_op
#define	PUSH_SCALAR_OBJ_FUN(x) SLclass_push_int_obj(SLANG_INT_TYPE,(x))
#define	PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x))
#define	CMP_FUNCTION int_cmp_function
#define	GENERIC_TYPE_IS_UNSIGNED
#define	long_long_bin_op int_int_bin_op
#define	ulong_ulong_bin_op uint_uint_bin_op
#define	long_unary_op int_unary_op
#define	ulong_unary_op uint_unary_op
#define	long_cmp_function int_cmp_function
#define	ulong_cmp_function uint_cmp_function
#define	NUM_INTEGER_TYPES 8
Typedefs
typedef VOID_STAR(*	Convert_Fun_Type )(VOID_STAR, unsigned int)
struct {
char * name
unsigned int type
unsigned int sizeof_type
double(* to_double_fun )(VOID_STAR)
char * name
SLtt_Char_Type color
char * msg
int sys_errno
char * symbolic_name
char name [3]
int offset
}	To_Double_Fun_Table_Type
typedef int(*	Bin_Fun_Type )(int, SLtype, VOID_STAR, unsigned int, SLtype, VOID_STAR, unsigned int, VOID_STAR)
Functions
SLang_To_Double_Fun_Type	SLarith_get_to_double_fun (SLtype type, unsigned int *sizeof_type)
int	_pSLarith_get_precedence (SLtype type)
SLtype	_pSLarith_promote_type (SLtype t)
static SLtype	promote_to_common_type (SLtype a, SLtype b)
static int	arith_bin_op_result (int op, SLtype a_type, SLtype b_type, SLtype *c_type)
static int	arith_bin_op (int op, SLtype a_type, VOID_STAR ap, unsigned int na, SLtype b_type, VOID_STAR bp, unsigned int nb, VOID_STAR cp)
static int	arith_unary_op_result (int op, SLtype a, SLtype *b)
static int	integer_pop (SLtype type, VOID_STAR ptr)
static int	integer_push (SLtype type, VOID_STAR ptr)
int	SLang_pop_char (char *i)
int	SLang_pop_uchar (unsigned char *i)
int	SLang_pop_short (short *i)
int	SLang_pop_ushort (unsigned short *i)
int	SLang_pop_long (long *i)
int	SLang_pop_ulong (unsigned long *i)
int	SLang_pop_uint (unsigned int *i)
int	SLang_push_int (int i)
int	SLang_push_uint (unsigned int i)
int	SLang_push_char (char i)
int	SLang_push_uchar (unsigned char i)
int	SLang_push_short (short i)
int	SLang_push_ushort (unsigned short i)
int	SLang_push_long (long i)
int	SLang_push_ulong (unsigned long i)
_INLINE_ int	_pSLarith_typecast (SLtype a_type, VOID_STAR ap, unsigned int na, SLtype b_type, VOID_STAR bp)
int	SLang_pop_double (double *x)
int	SLang_push_double (double x)
int	SLang_pop_float (float *x)
int	SLang_push_float (float f)
static int	double_push (SLtype type, VOID_STAR ptr)
static int	double_push_literal (SLtype type, VOID_STAR ptr)
static int	double_pop (SLtype unused, VOID_STAR ptr)
static void	double_byte_code_destroy (SLtype unused, VOID_STAR ptr)
static int	float_push (SLtype unused, VOID_STAR ptr)
static int	float_pop (SLtype unused, VOID_STAR ptr)
void	_pSLset_double_format (char *s)
static char *	arith_string (SLtype type, VOID_STAR v)
static int	integer_to_bool (SLtype type, int *t)
static int	push_int_literal (SLtype type, VOID_STAR ptr)
static int	push_char_literal (SLtype type, VOID_STAR ptr)
static int	create_synonyms (void)
int	_pSLarith_register_types (void)
static void	promote_objs (SLang_Object_Type a, SLang_Object_Type b, SLang_Object_Type c, SLang_Object_Type d)
int	_pSLarith_bin_op (SLang_Object_Type oa, SLang_Object_Type ob, int op)
Variables
SLtype	_pSLarith_Arith_Types [MAX_ARITHMETIC_TYPES+1]
static SLtype	Alias_Map [MAX_ARITHMETIC_TYPES]
static Bin_Fun_Type	Bin_Fun_Map [MAX_ARITHMETIC_TYPES]
static char	Double_Format [16] = "%g"
static Integer_Info_Type	Integer_Types [NUM_INTEGER_TYPES]
static SLang_Arith_Unary_Type	Unary_Table []
static SLang_Arith_Binary_Type	Binary_Table []
static SLang_IConstant_Type	IConst_Table []
static SLang_FConstant_Type	FConst_Table []
static SLang_DConstant_Type	DConst_Table []

slarith.c File Reference

Classes

Defines

Typedefs

Functions

Variables

Define Documentation

Typedef Documentation

Function Documentation