From 98a18b797c63ea9baab31768ed720ad32c0004e8 Mon Sep 17 00:00:00 2001 From: Guillaume Cottenceau Date: Mon, 14 May 2001 21:47:42 +0000 Subject: i can compile slang and newt with dietlibc now --- mdk-stage1/slang/slarith.c | 1656 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1656 insertions(+) create mode 100644 mdk-stage1/slang/slarith.c (limited to 'mdk-stage1/slang/slarith.c') diff --git a/mdk-stage1/slang/slarith.c b/mdk-stage1/slang/slarith.c new file mode 100644 index 000000000..07ad68687 --- /dev/null +++ b/mdk-stage1/slang/slarith.c @@ -0,0 +1,1656 @@ + +/* Copyright (c) 1998, 1999, 2001 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" + +#include + +#ifdef HAVE_LOCALE_H +# include +#endif + +#include "slang.h" +#include "_slang.h" + +/* + * This file defines binary and unary operations on all integer types. + * Supported types include: + * + * SLANG_CHAR_TYPE (char) + * SLANG_SHORT_TYPE (short) + * SLANG_INT_TYPE (int) + * SLANG_LONG_TYPE (long) + * SLANG_FLOAT_TYPE (float) + * SLANG_DOUBLE_TYPE (double) + * + * as well as unsigned types. The result-type of an arithmentic operation + * will depend upon the data types involved. I am going to distinguish + * between the boolean operations such as `and' and `or' from the arithmetic + * operations such as `plus'. Since the result of a boolean operation is + * either 1 or 0, a boolean result will be represented by SLANG_CHAR_TYPE. + * Ordinarily I would use an integer but for arrays it makes more sense to + * use a character data type. + * + * So, the following will be assumed (`+' is any arithmetic operator) + * + * char + char = int + * char|short + short = int + * char|short|int + int = int + * char|short|int|long + long = long + * char|short|int|long|float + float = float + * char|short|int|long|float|double + double = double + * + * In the actual implementation, a brute force approach is avoided. Such + * an approach would mean defining different functions for all possible + * combinations of types. Including the unsigned types, and not including + * the complex number type, there are 10 arithmetic types and 10*10=100 + * different combinations of types. Clearly this would be too much. + * + * One approach would be to define binary functions only between operands of + * the same type and then convert types as appropriate. This would require + * just 6 such functions (int, uint, long, ulong, float, double). + * However, many conversion functions are going to be required, particularly + * since we are going to allow typecasting from one arithmetic to another. + * Since the bit pattern of signed and unsigned types are the same, and only + * the interpretation differs, there will be no functions to convert between + * signed and unsigned forms of a given type. + */ + +#define MAX_ARITHMETIC_TYPES 10 + +unsigned char _SLarith_Is_Arith_Type [256]; + +unsigned char _SLarith_Arith_Types[] = +{ + SLANG_CHAR_TYPE, + SLANG_UCHAR_TYPE, + SLANG_SHORT_TYPE, + SLANG_USHORT_TYPE, + SLANG_INT_TYPE, + SLANG_UINT_TYPE, + SLANG_LONG_TYPE, + SLANG_ULONG_TYPE, + SLANG_FLOAT_TYPE, + SLANG_DOUBLE_TYPE, + 0 +}; + +/* Here are a bunch of functions to convert from one type to another. To + * facilitate the process, a macros will be used. + */ + +#define DEFUN_1(f,from_type,to_type) \ +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]; \ +} + +#define DEFUN_2(f,from_type,to_type,copy_fun) \ +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; \ +} +typedef VOID_STAR (*Convert_Fun_Type)(VOID_STAR, unsigned int); + +DEFUN_1(copy_char_to_char,char,char) +#if SIZEOF_INT != SIZEOF_SHORT +DEFUN_1(copy_char_to_short,char,short) +DEFUN_1(copy_char_to_ushort,char,unsigned short) +#else +# define copy_char_to_short copy_char_to_int +# define copy_char_to_ushort copy_char_to_uint +#endif +DEFUN_1(copy_char_to_int,char,int) +DEFUN_1(copy_char_to_uint,char,unsigned int) +#if SIZEOF_INT != SIZEOF_LONG +DEFUN_1(copy_char_to_long,char,long) +DEFUN_1(copy_char_to_ulong,char,unsigned long) +#else +# define copy_char_to_long copy_char_to_int +# define copy_char_to_ulong copy_char_to_uint +#endif +DEFUN_1(copy_char_to_float,char,float) +DEFUN_1(copy_char_to_double,char,double) + +#if SIZEOF_INT != SIZEOF_SHORT +DEFUN_1(copy_uchar_to_short,unsigned char,short) +DEFUN_1(copy_uchar_to_ushort,unsigned char,unsigned short) +#else +# define copy_uchar_to_short copy_uchar_to_int +# define copy_uchar_to_ushort copy_uchar_to_uint +#endif +DEFUN_1(copy_uchar_to_int,unsigned char,int) +DEFUN_1(copy_uchar_to_uint,unsigned char,unsigned int) +#if SIZEOF_INT != SIZEOF_LONG +DEFUN_1(copy_uchar_to_long,unsigned char,long) +DEFUN_1(copy_uchar_to_ulong,unsigned char,unsigned long) +#else +# define copy_uchar_to_long copy_uchar_to_int +# define copy_uchar_to_ulong copy_uchar_to_uint +#endif +DEFUN_1(copy_uchar_to_float,unsigned char,float) +DEFUN_1(copy_uchar_to_double,unsigned char,double) + +#if SIZEOF_INT != SIZEOF_SHORT +DEFUN_1(copy_short_to_char,short,char) +DEFUN_1(copy_short_to_uchar,short,unsigned char) +DEFUN_1(copy_short_to_short,short,short) +DEFUN_1(copy_short_to_int,short,int) +DEFUN_1(copy_short_to_uint,short,unsigned int) +DEFUN_1(copy_short_to_long,short,long) +DEFUN_1(copy_short_to_ulong,short,unsigned long) +DEFUN_1(copy_short_to_float,short,float) +DEFUN_1(copy_short_to_double,short,double) +DEFUN_1(copy_ushort_to_char,unsigned short,char) +DEFUN_1(copy_ushort_to_uchar,unsigned short,unsigned char) +DEFUN_1(copy_ushort_to_int,unsigned short,int) +DEFUN_1(copy_ushort_to_uint,unsigned short,unsigned int) +DEFUN_1(copy_ushort_to_long,unsigned short,long) +DEFUN_1(copy_ushort_to_ulong,unsigned short,unsigned long) +DEFUN_1(copy_ushort_to_float,unsigned short,float) +DEFUN_1(copy_ushort_to_double,unsigned short,double) +#else +# define copy_short_to_char copy_int_to_char +# define copy_short_to_uchar copy_int_to_uchar +# define copy_short_to_short copy_int_to_int +# define copy_short_to_int copy_int_to_int +# define copy_short_to_uint copy_int_to_int +# define copy_short_to_long copy_int_to_long +# define copy_short_to_ulong copy_int_to_ulong +# define copy_short_to_float copy_int_to_float +# define copy_short_to_double copy_int_to_double +# define copy_ushort_to_char copy_uint_to_char +# define copy_ushort_to_uchar copy_uint_to_uchar +# define copy_ushort_to_int copy_int_to_int +# define copy_ushort_to_uint copy_int_to_int +# define copy_ushort_to_long copy_uint_to_long +# define copy_ushort_to_ulong copy_uint_to_ulong +# define copy_ushort_to_float copy_uint_to_float +# define copy_ushort_to_double copy_uint_to_double +#endif + +DEFUN_1(copy_int_to_char,int,char) +DEFUN_1(copy_int_to_uchar,int,unsigned char) +DEFUN_1(copy_uint_to_char,unsigned int,char) +DEFUN_1(copy_uint_to_uchar,unsigned int,unsigned char) +#if SIZEOF_INT != SIZEOF_SHORT +DEFUN_1(copy_int_to_short,int,short) +DEFUN_1(copy_int_to_ushort,int,unsigned short) +DEFUN_1(copy_uint_to_short,unsigned int,short) +DEFUN_1(copy_uint_to_ushort,unsigned int,unsigned short) +#else +# define copy_int_to_short copy_int_to_int +# define copy_int_to_ushort copy_int_to_int +# define copy_uint_to_short copy_int_to_int +# define copy_uint_to_ushort copy_int_to_int +#endif +DEFUN_1(copy_int_to_int,int,int) +#if SIZEOF_INT != SIZEOF_LONG +DEFUN_1(copy_int_to_long,int,long) +DEFUN_1(copy_int_to_ulong,int,unsigned long) +DEFUN_1(copy_uint_to_long,unsigned int,long) +DEFUN_1(copy_uint_to_ulong,unsigned int,unsigned long) +#else +# define copy_int_to_long copy_int_to_int +# define copy_int_to_ulong copy_int_to_int +# define copy_uint_to_long copy_int_to_int +# define copy_uint_to_ulong copy_int_to_int +#endif +DEFUN_1(copy_int_to_float,int,float) +DEFUN_1(copy_int_to_double,int,double) +DEFUN_1(copy_uint_to_float,unsigned int,float) +DEFUN_1(copy_uint_to_double,unsigned int,double) + +#if SIZEOF_INT != SIZEOF_LONG +DEFUN_1(copy_long_to_char,long,char) +DEFUN_1(copy_long_to_uchar,long,unsigned char) +DEFUN_1(copy_long_to_short,long,short) +DEFUN_1(copy_long_to_ushort,long,unsigned short) +DEFUN_1(copy_long_to_int,long,int) +DEFUN_1(copy_long_to_uint,long,unsigned int) +DEFUN_1(copy_long_to_long,long,long) +DEFUN_1(copy_long_to_float,long,float) +DEFUN_1(copy_long_to_double,long,double) +DEFUN_1(copy_ulong_to_char,unsigned long,char) +DEFUN_1(copy_ulong_to_uchar,unsigned long,unsigned char) +DEFUN_1(copy_ulong_to_short,unsigned long,short) +DEFUN_1(copy_ulong_to_ushort,unsigned long,unsigned short) +DEFUN_1(copy_ulong_to_int,unsigned long,int) +DEFUN_1(copy_ulong_to_uint,unsigned long,unsigned int) +DEFUN_1(copy_ulong_to_float,unsigned long,float) +DEFUN_1(copy_ulong_to_double,unsigned long,double) +#else +#define copy_long_to_char copy_int_to_char +#define copy_long_to_uchar copy_int_to_uchar +#define copy_long_to_short copy_int_to_short +#define copy_long_to_ushort copy_int_to_ushort +#define copy_long_to_int copy_int_to_int +#define copy_long_to_uint copy_int_to_int +#define copy_long_to_long copy_int_to_int +#define copy_long_to_float copy_int_to_float +#define copy_long_to_double copy_int_to_double +#define copy_ulong_to_char copy_uint_to_char +#define copy_ulong_to_uchar copy_uint_to_uchar +#define copy_ulong_to_short copy_uint_to_short +#define copy_ulong_to_ushort copy_uint_to_ushort +#define copy_ulong_to_int copy_int_to_int +#define copy_ulong_to_uint copy_int_to_int +#define copy_ulong_to_float copy_uint_to_float +#define copy_ulong_to_double copy_uint_to_double +#endif + +DEFUN_1(copy_float_to_char,float,char) +DEFUN_1(copy_float_to_uchar,float,unsigned char) +#if SIZEOF_INT != SIZEOF_SHORT +DEFUN_1(copy_float_to_short,float,short) +DEFUN_1(copy_float_to_ushort,float,unsigned short) +#else +# define copy_float_to_short copy_float_to_int +# define copy_float_to_ushort copy_float_to_uint +#endif +DEFUN_1(copy_float_to_int,float,int) +DEFUN_1(copy_float_to_uint,float,unsigned int) +#if SIZEOF_INT != SIZEOF_LONG +DEFUN_1(copy_float_to_long,float,long) +DEFUN_1(copy_float_to_ulong,float,unsigned long) +#else +# define copy_float_to_long copy_float_to_int +# define copy_float_to_ulong copy_float_to_uint +#endif +DEFUN_1(copy_float_to_float,float,float) +DEFUN_1(copy_float_to_double,float,double) + +DEFUN_1(copy_double_to_char,double,char) +DEFUN_1(copy_double_to_uchar,double,unsigned char) +#if SIZEOF_INT != SIZEOF_SHORT +DEFUN_1(copy_double_to_short,double,short) +DEFUN_1(copy_double_to_ushort,double,unsigned short) +#else +# define copy_double_to_short copy_double_to_int +# define copy_double_to_ushort copy_double_to_uint +#endif +DEFUN_1(copy_double_to_int,double,int) +DEFUN_1(copy_double_to_uint,double,unsigned int) +#if SIZEOF_INT != SIZEOF_LONG +DEFUN_1(copy_double_to_long,double,long) +DEFUN_1(copy_double_to_ulong,double,unsigned long) +#else +# define copy_double_to_long copy_double_to_int +# define copy_double_to_ulong copy_double_to_uint +#endif +DEFUN_1(copy_double_to_float,double,float) +DEFUN_1(copy_double_to_double,double,double) + +DEFUN_2(char_to_int,char,int,copy_char_to_int) +DEFUN_2(char_to_uint,char,unsigned int,copy_char_to_uint) +#if SIZEOF_INT != SIZEOF_LONG +DEFUN_2(char_to_long,char,long,copy_char_to_long) +DEFUN_2(char_to_ulong,char,unsigned long,copy_char_to_ulong) +#else +# define char_to_long char_to_int +# define char_to_ulong char_to_uint +#endif +DEFUN_2(char_to_float,char,float,copy_char_to_float) +DEFUN_2(char_to_double,char,double,copy_char_to_double) + +DEFUN_2(uchar_to_int,unsigned char,int,copy_uchar_to_int) +DEFUN_2(uchar_to_uint,unsigned char,unsigned int,copy_uchar_to_uint) +#if SIZEOF_INT != SIZEOF_LONG +DEFUN_2(uchar_to_long,unsigned char,long,copy_uchar_to_long) +DEFUN_2(uchar_to_ulong,unsigned char,unsigned long,copy_uchar_to_ulong) +#else +# define uchar_to_long uchar_to_int +# define uchar_to_ulong uchar_to_uint +#endif +DEFUN_2(uchar_to_float,unsigned char,float,copy_uchar_to_float) +DEFUN_2(uchar_to_double,unsigned char,double,copy_uchar_to_double) + +#if SIZEOF_INT != SIZEOF_SHORT +DEFUN_2(short_to_int,short,int,copy_short_to_int) +DEFUN_2(short_to_uint,short,unsigned int,copy_short_to_uint) +DEFUN_2(short_to_long,short,long,copy_short_to_long) +DEFUN_2(short_to_ulong,short,unsigned long,copy_short_to_ulong) +DEFUN_2(short_to_float,short,float,copy_short_to_float) +DEFUN_2(short_to_double,short,double,copy_short_to_double) +DEFUN_2(ushort_to_int,unsigned short,int,copy_ushort_to_int) +DEFUN_2(ushort_to_uint,unsigned short,unsigned int,copy_ushort_to_uint) +DEFUN_2(ushort_to_long,unsigned short,long,copy_ushort_to_long) +DEFUN_2(ushort_to_ulong,unsigned short,unsigned long,copy_ushort_to_ulong) +DEFUN_2(ushort_to_float,unsigned short,float,copy_ushort_to_float) +DEFUN_2(ushort_to_double,unsigned short,double,copy_ushort_to_double) +#else +# define short_to_int NULL +# define short_to_uint NULL +# define short_to_long int_to_long +# define short_to_ulong int_to_ulong +# define short_to_float int_to_float +# define short_to_double int_to_double +# define ushort_to_int NULL +# define ushort_to_uint NULL +# define ushort_to_long uint_to_long +# define ushort_to_ulong uint_to_ulong +# define ushort_to_float uint_to_float +# define ushort_to_double uint_to_double +#endif + +#if SIZEOF_INT != SIZEOF_LONG +DEFUN_2(int_to_long,int,long,copy_int_to_long) +DEFUN_2(int_to_ulong,int,unsigned long,copy_int_to_ulong) +#else +# define int_to_long NULL +# define int_to_ulong NULL +#endif +DEFUN_2(int_to_float,int,float,copy_int_to_float) +DEFUN_2(int_to_double,int,double,copy_int_to_double) + +#if SIZEOF_INT != SIZEOF_LONG +DEFUN_2(uint_to_long,unsigned int,long,copy_uint_to_long) +DEFUN_2(uint_to_ulong,unsigned int,unsigned long,copy_uint_to_ulong) +#else +# define uint_to_long NULL +# define uint_to_ulong NULL +#endif +DEFUN_2(uint_to_float,unsigned int,float,copy_uint_to_float) +DEFUN_2(uint_to_double,unsigned int,double,copy_uint_to_double) + +#if SIZEOF_INT != SIZEOF_LONG +DEFUN_2(long_to_float,long,float,copy_long_to_float) +DEFUN_2(long_to_double,long,double,copy_long_to_double) +DEFUN_2(ulong_to_float,unsigned long,float,copy_ulong_to_float) +DEFUN_2(ulong_to_double,unsigned long,double,copy_ulong_to_double) +#else +# define long_to_float int_to_float +# define long_to_double int_to_double +# define ulong_to_float uint_to_float +# define ulong_to_double uint_to_double +#endif + +DEFUN_2(float_to_double,float,double,copy_float_to_double) + +#define TO_DOUBLE_FUN(name,type) \ +static double name (VOID_STAR x) { return (double) *(type *) x; } +TO_DOUBLE_FUN(char_to_one_double,char) +TO_DOUBLE_FUN(uchar_to_one_double,unsigned char) +#if SIZEOF_INT != SIZEOF_SHORT +TO_DOUBLE_FUN(short_to_one_double,short) +TO_DOUBLE_FUN(ushort_to_one_double,unsigned short) +#else +# define short_to_one_double int_to_one_double +# define ushort_to_one_double uint_to_one_double +#endif +TO_DOUBLE_FUN(int_to_one_double,int) +TO_DOUBLE_FUN(uint_to_one_double,unsigned int) +#if SIZEOF_INT != SIZEOF_LONG +TO_DOUBLE_FUN(long_to_one_double,long) +TO_DOUBLE_FUN(ulong_to_one_double,unsigned long) +#else +# define long_to_one_double int_to_one_double +# define ulong_to_one_double uint_to_one_double +#endif +TO_DOUBLE_FUN(float_to_one_double,float) +TO_DOUBLE_FUN(double_to_one_double,double) + +SLang_To_Double_Fun_Type +SLarith_get_to_double_fun (unsigned char type, unsigned int *sizeof_type) +{ + unsigned int da; + SLang_To_Double_Fun_Type to_double; + + switch (type) + { + default: + return NULL; + + case SLANG_CHAR_TYPE: + da = sizeof (char); to_double = char_to_one_double; + break; + case SLANG_UCHAR_TYPE: + da = sizeof (unsigned char); to_double = uchar_to_one_double; + break; + case SLANG_SHORT_TYPE: + da = sizeof (short); to_double = short_to_one_double; + break; + case SLANG_USHORT_TYPE: + da = sizeof (unsigned short); to_double = ushort_to_one_double; + break; + case SLANG_INT_TYPE: + da = sizeof (int); to_double = int_to_one_double; + break; + case SLANG_UINT_TYPE: + da = sizeof (unsigned int); to_double = uint_to_one_double; + break; + case SLANG_LONG_TYPE: + da = sizeof (long); to_double = long_to_one_double; + break; + case SLANG_ULONG_TYPE: + da = sizeof (unsigned long); to_double = ulong_to_one_double; + break; + case SLANG_FLOAT_TYPE: + da = sizeof (float); to_double = float_to_one_double; + break; + case SLANG_DOUBLE_TYPE: + da = sizeof (double); to_double = double_to_one_double; + break; + } + + if (sizeof_type != NULL) *sizeof_type = da; + return to_double; +} + +/* Each element of the matrix determines how the row maps onto the column. + * That is, let the matrix be B_ij. Where the i,j indices refer to + * precedence of the type. Then, + * B_ij->copy_function copies type i to type j. Similarly, + * B_ij->convert_function mallocs a new array of type j and copies i to it. + * + * Since types are always converted to higher levels of precedence for binary + * operations, many of the elements are NULL. + * + * Is the idea clear? + */ +typedef struct +{ + FVOID_STAR copy_function; + Convert_Fun_Type convert_function; +} +Binary_Matrix_Type; + +static Binary_Matrix_Type Binary_Matrix [MAX_ARITHMETIC_TYPES][MAX_ARITHMETIC_TYPES] = +{ + { + {(FVOID_STAR)copy_char_to_char, NULL}, + {(FVOID_STAR)copy_char_to_char, NULL}, + {(FVOID_STAR) copy_char_to_short, NULL}, + {(FVOID_STAR) copy_char_to_ushort, NULL}, + {(FVOID_STAR) copy_char_to_int, char_to_int}, + {(FVOID_STAR) copy_char_to_uint, char_to_uint}, + {(FVOID_STAR) copy_char_to_long, char_to_long}, + {(FVOID_STAR) copy_char_to_ulong, char_to_ulong}, + {(FVOID_STAR) copy_char_to_float, char_to_float}, + {(FVOID_STAR) copy_char_to_double, char_to_double}, + }, + + { + {(FVOID_STAR)copy_char_to_char, NULL}, + {(FVOID_STAR)copy_char_to_char, NULL}, + {(FVOID_STAR) copy_uchar_to_short, NULL}, + {(FVOID_STAR) copy_uchar_to_ushort, NULL}, + {(FVOID_STAR) copy_uchar_to_int, uchar_to_int}, + {(FVOID_STAR) copy_uchar_to_uint, uchar_to_uint}, + {(FVOID_STAR) copy_uchar_to_long, uchar_to_long}, + {(FVOID_STAR) copy_uchar_to_ulong, uchar_to_ulong}, + {(FVOID_STAR) copy_uchar_to_float, uchar_to_float}, + {(FVOID_STAR) copy_uchar_to_double, uchar_to_double}, + }, + + { + {(FVOID_STAR) copy_short_to_char, NULL}, + {(FVOID_STAR) copy_short_to_uchar, NULL}, + {(FVOID_STAR) copy_short_to_short, NULL}, + {(FVOID_STAR) copy_short_to_short, NULL}, + {(FVOID_STAR) copy_short_to_int, short_to_int}, + {(FVOID_STAR) copy_short_to_uint, short_to_uint}, + {(FVOID_STAR) copy_short_to_long, short_to_long}, + {(FVOID_STAR) copy_short_to_ulong, short_to_ulong}, + {(FVOID_STAR) copy_short_to_float, short_to_float}, + {(FVOID_STAR) copy_short_to_double, short_to_double}, + }, + + { + {(FVOID_STAR) copy_ushort_to_char, NULL}, + {(FVOID_STAR) copy_ushort_to_uchar, NULL}, + {(FVOID_STAR) copy_short_to_short, NULL}, + {(FVOID_STAR) copy_short_to_short, NULL}, + {(FVOID_STAR) copy_ushort_to_int, ushort_to_int}, + {(FVOID_STAR) copy_ushort_to_uint, ushort_to_uint}, + {(FVOID_STAR) copy_ushort_to_long, ushort_to_long}, + {(FVOID_STAR) copy_ushort_to_ulong, ushort_to_ulong}, + {(FVOID_STAR) copy_ushort_to_float, ushort_to_float}, + {(FVOID_STAR) copy_ushort_to_double, ushort_to_double}, + }, + + { + {(FVOID_STAR) copy_int_to_char, NULL}, + {(FVOID_STAR) copy_int_to_uchar, NULL}, + {(FVOID_STAR) copy_int_to_short, NULL}, + {(FVOID_STAR) copy_int_to_ushort, NULL}, + {(FVOID_STAR) copy_int_to_int, NULL}, + {(FVOID_STAR) copy_int_to_int, NULL}, + {(FVOID_STAR) copy_int_to_long, int_to_long}, + {(FVOID_STAR) copy_int_to_ulong, int_to_ulong}, + {(FVOID_STAR) copy_int_to_float, int_to_float}, + {(FVOID_STAR) copy_int_to_double, int_to_double}, + }, + + { + {(FVOID_STAR) copy_uint_to_char, NULL}, + {(FVOID_STAR) copy_uint_to_uchar, NULL}, + {(FVOID_STAR) copy_uint_to_short, NULL}, + {(FVOID_STAR) copy_uint_to_ushort, NULL}, + {(FVOID_STAR) copy_int_to_int, NULL}, + {(FVOID_STAR) copy_int_to_int, NULL}, + {(FVOID_STAR) copy_uint_to_long, uint_to_long}, + {(FVOID_STAR) copy_uint_to_ulong, uint_to_ulong}, + {(FVOID_STAR) copy_uint_to_float, uint_to_float}, + {(FVOID_STAR) copy_uint_to_double, uint_to_double}, + }, + + { + {(FVOID_STAR) copy_long_to_char, NULL}, + {(FVOID_STAR) copy_long_to_uchar, NULL}, + {(FVOID_STAR) copy_long_to_short, NULL}, + {(FVOID_STAR) copy_long_to_ushort, NULL}, + {(FVOID_STAR) copy_long_to_int, NULL}, + {(FVOID_STAR) copy_long_to_uint, NULL}, + {(FVOID_STAR) copy_long_to_long, NULL}, + {(FVOID_STAR) copy_long_to_long, NULL}, + {(FVOID_STAR) copy_long_to_float, long_to_float}, + {(FVOID_STAR) copy_long_to_double, long_to_double}, + }, + + { + {(FVOID_STAR) copy_ulong_to_char, NULL}, + {(FVOID_STAR) copy_ulong_to_uchar, NULL}, + {(FVOID_STAR) copy_ulong_to_short, NULL}, + {(FVOID_STAR) copy_ulong_to_ushort, NULL}, + {(FVOID_STAR) copy_ulong_to_int, NULL}, + {(FVOID_STAR) copy_ulong_to_uint, NULL}, + {(FVOID_STAR) copy_long_to_long, NULL}, + {(FVOID_STAR) copy_long_to_long, NULL}, + {(FVOID_STAR) copy_ulong_to_float, ulong_to_float}, + {(FVOID_STAR) copy_ulong_to_double, ulong_to_double}, + }, + + { + {(FVOID_STAR) copy_float_to_char, NULL}, + {(FVOID_STAR) copy_float_to_uchar, NULL}, + {(FVOID_STAR) copy_float_to_short, NULL}, + {(FVOID_STAR) copy_float_to_ushort, NULL}, + {(FVOID_STAR) copy_float_to_int, NULL}, + {(FVOID_STAR) copy_float_to_uint, NULL}, + {(FVOID_STAR) copy_float_to_long, NULL}, + {(FVOID_STAR) copy_float_to_ulong, NULL}, + {(FVOID_STAR) copy_float_to_float, NULL}, + {(FVOID_STAR) copy_float_to_double, float_to_double}, + }, + + { + {(FVOID_STAR) copy_double_to_char, NULL}, + {(FVOID_STAR) copy_double_to_uchar, NULL}, + {(FVOID_STAR) copy_double_to_short, NULL}, + {(FVOID_STAR) copy_double_to_ushort, NULL}, + {(FVOID_STAR) copy_double_to_int, NULL}, + {(FVOID_STAR) copy_double_to_uint, NULL}, + {(FVOID_STAR) copy_double_to_long, NULL}, + {(FVOID_STAR) copy_double_to_ulong, NULL}, + {(FVOID_STAR) copy_double_to_float, NULL}, + {(FVOID_STAR) copy_double_to_double, NULL}, + } +}; + +#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 GENERIC_UNARY_FUNCTION int_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 +#include "slarith.inc" + +#define GENERIC_BINARY_FUNCTION uint_uint_bin_op +#define GENERIC_BIT_OPERATIONS +#define GENERIC_TYPE unsigned int +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define GENERIC_UNARY_FUNCTION uint_unary_op +#define ABS_FUNCTION(a) (a) +#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) +#define SCALAR_BINARY_FUNCTION uint_uint_scalar_bin_op +#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_int_obj(SLANG_UINT_TYPE,(int)(x)) +#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) +#define CMP_FUNCTION uint_cmp_function +#include "slarith.inc" + +#if SIZEOF_LONG != SIZEOF_INT +#define GENERIC_BINARY_FUNCTION long_long_bin_op +#define GENERIC_BIT_OPERATIONS +#define GENERIC_TYPE long +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define GENERIC_UNARY_FUNCTION long_unary_op +#define ABS_FUNCTION(a) (((a) >= 0) ? (a) : -(a)) +#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) +#define SCALAR_BINARY_FUNCTION long_long_scalar_bin_op +#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_long_obj(SLANG_LONG_TYPE,(x)) +#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) +#define CMP_FUNCTION long_cmp_function +#include "slarith.inc" + +#define GENERIC_BINARY_FUNCTION ulong_ulong_bin_op +#define GENERIC_BIT_OPERATIONS +#define GENERIC_TYPE unsigned long +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) ((a) % (b)) +#define GENERIC_UNARY_FUNCTION ulong_unary_op +#define ABS_FUNCTION(a) (a) +#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) +#define SCALAR_BINARY_FUNCTION ulong_ulong_scalar_bin_op +#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_long_obj(SLANG_ULONG_TYPE,(long)(x)) +#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) +#define CMP_FUNCTION ulong_cmp_function +#include "slarith.inc" +#else +#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 +#endif /* SIZEOF_INT != SIZEOF_LONG */ + +#define GENERIC_BINARY_FUNCTION float_float_bin_op +#define GENERIC_TYPE float +#define POW_FUNCTION(a,b) (float)pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE float +#define MOD_FUNCTION(a,b) (float)fmod((a),(b)) +#define GENERIC_UNARY_FUNCTION float_unary_op +#define ABS_FUNCTION(a) (float)fabs((double) a) +#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) +#define SCALAR_BINARY_FUNCTION float_float_scalar_bin_op +#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_float_obj(SLANG_FLOAT_TYPE,(x)) +#define PUSH_POW_OBJ_FUN(x) SLclass_push_float_obj(SLANG_FLOAT_TYPE, (x)) +#define CMP_FUNCTION float_cmp_function +#include "slarith.inc" + +#define GENERIC_BINARY_FUNCTION double_double_bin_op +#define GENERIC_TYPE double +#define POW_FUNCTION(a,b) pow((double)(a),(double)(b)) +#define POW_RESULT_TYPE double +#define MOD_FUNCTION(a,b) (float)fmod((a),(b)) +#define GENERIC_UNARY_FUNCTION double_unary_op +#define ABS_FUNCTION(a) fabs(a) +#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) +#define SCALAR_BINARY_FUNCTION double_double_scalar_bin_op +#define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE,(x)) +#define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x)) +#define CMP_FUNCTION double_cmp_function +#include "slarith.inc" + +#define GENERIC_UNARY_FUNCTION char_unary_op +#define GENERIC_BIT_OPERATIONS +#define GENERIC_TYPE signed char +#define ABS_FUNCTION abs +#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) +#define CMP_FUNCTION char_cmp_function +#include "slarith.inc" + +#define GENERIC_UNARY_FUNCTION uchar_unary_op +#define GENERIC_BIT_OPERATIONS +#define GENERIC_TYPE unsigned char +#define ABS_FUNCTION(x) (x) +#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) +#define CMP_FUNCTION uchar_cmp_function +#include "slarith.inc" + +#if SIZEOF_SHORT != SIZEOF_INT +#define GENERIC_UNARY_FUNCTION short_unary_op +#define GENERIC_BIT_OPERATIONS +#define GENERIC_TYPE short +#define ABS_FUNCTION abs +#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0)) +#define CMP_FUNCTION short_cmp_function +#include "slarith.inc" + +#define GENERIC_UNARY_FUNCTION ushort_unary_op +#define GENERIC_BIT_OPERATIONS +#define GENERIC_TYPE unsigned short +#define ABS_FUNCTION(x) (x) +#define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0) +#define CMP_FUNCTION ushort_cmp_function +#include "slarith.inc" +#endif /* SIZEOF_INT != SIZEOF_SHORT */ + +/* Unfortunately, the numbers that were assigned to the data-types were + * not well thought out. So, I need to use the following table. + */ +#define MAXIMUM_ARITH_TYPE_VALUE SLANG_FLOAT_TYPE +#define IS_INTEGER_TYPE(x) \ + (((x) <= MAXIMUM_ARITH_TYPE_VALUE) \ + && (Type_Precedence_Table[x] < 8) && (Type_Precedence_Table[x] != -1)) +#define IS_ARITHMETIC_TYPE(x) \ + (((x) <= MAXIMUM_ARITH_TYPE_VALUE) && (Type_Precedence_Table[x] != -1)) + +#define LONG_PRECEDENCE_VALUE 6 +#define FLOAT_PRECEDENCE_VALUE 8 + +static signed char Type_Precedence_Table [MAXIMUM_ARITH_TYPE_VALUE + 1] = +{ + -1, /* SLANG_UNDEFINED_TYPE */ + -1, /* SLANG_VOID_TYPE */ + 4, /* SLANG_INT_TYPE */ + 9, /* SLANG_DOUBLE_TYPE */ + 0, /* SLANG_CHAR_TYPE */ + -1, /* SLANG_INTP_TYPE */ + -1, /* SLANG_REF_TYPE */ + -1, /* SLANG_COMPLEX_TYPE */ + -1, /* SLANG_NULL_TYPE */ + 1, /* SLANG_UCHAR_TYPE */ + 2, /* SLANG_SHORT_TYPE */ + 3, /* SLANG_USHORT_TYPE */ + 5, /* SLANG_UINT_TYPE */ + 6, /* SLANG_LONG_TYPE */ + 7, /* SLANG_ULONG_TYPE */ + -1, /* SLANG_STRING_TYPE */ + 8 /* SLANG_FLOAT_TYPE */ +}; + +int _SLarith_get_precedence (unsigned char type) +{ + if (type > MAXIMUM_ARITH_TYPE_VALUE) + return -1; + + return Type_Precedence_Table[type]; +} + +unsigned char _SLarith_promote_type (unsigned char t) +{ + switch (t) + { + case SLANG_FLOAT_TYPE: + case SLANG_DOUBLE_TYPE: + case SLANG_LONG_TYPE: + case SLANG_ULONG_TYPE: + case SLANG_INT_TYPE: + case SLANG_UINT_TYPE: + break; + + case SLANG_USHORT_TYPE: +#if SIZEOF_INT == SIZEOF_SHORT + t = SLANG_UINT_TYPE; + break; +#endif + /* drop */ + case SLANG_CHAR_TYPE: + case SLANG_UCHAR_TYPE: + case SLANG_SHORT_TYPE: + default: + t = SLANG_INT_TYPE; + } + + return t; +} + +static unsigned char promote_to_common_type (unsigned char a, unsigned char b) +{ + a = _SLarith_promote_type (a); + b = _SLarith_promote_type (b); + + return (Type_Precedence_Table[a] > Type_Precedence_Table[b]) ? a : b; +} + +static int arith_bin_op_result (int op, unsigned char a_type, unsigned char b_type, + unsigned char *c_type) +{ + switch (op) + { + case SLANG_EQ: + case SLANG_NE: + case SLANG_GT: + case SLANG_GE: + case SLANG_LT: + case SLANG_LE: + case SLANG_OR: + case SLANG_AND: + *c_type = SLANG_CHAR_TYPE; + return 1; + + case SLANG_POW: + if (SLANG_FLOAT_TYPE == promote_to_common_type (a_type, b_type)) + *c_type = SLANG_FLOAT_TYPE; + else + *c_type = SLANG_DOUBLE_TYPE; + return 1; + + case SLANG_BAND: + case SLANG_BXOR: + case SLANG_BOR: + case SLANG_SHL: + case SLANG_SHR: + /* The bit-level operations are defined just for integer types */ + if ((0 == IS_INTEGER_TYPE (a_type)) + || (0 == IS_INTEGER_TYPE(b_type))) + return 0; + break; + + default: + break; + } + + *c_type = promote_to_common_type (a_type, b_type); + return 1; +} + +typedef int (*Bin_Fun_Type) (int, + unsigned char, VOID_STAR, unsigned int, + unsigned char, VOID_STAR, unsigned int, + VOID_STAR); + +/* This array of functions must be indexed by precedence after arithmetic + * promotions. + */ +static Bin_Fun_Type Bin_Fun_Map [MAX_ARITHMETIC_TYPES] = +{ + NULL, + NULL, + NULL, + NULL, + int_int_bin_op, + uint_uint_bin_op, + long_long_bin_op, + ulong_ulong_bin_op, + float_float_bin_op, + double_double_bin_op +}; + +static int arith_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) +{ + Convert_Fun_Type af, bf; + Bin_Fun_Type binfun; + int a_indx, b_indx, c_indx; + unsigned char c_type; + int ret; + + c_type = promote_to_common_type (a_type, b_type); + + a_indx = Type_Precedence_Table [a_type]; + b_indx = Type_Precedence_Table [b_type]; + c_indx = Type_Precedence_Table [c_type]; + + af = Binary_Matrix[a_indx][c_indx].convert_function; + bf = Binary_Matrix[b_indx][c_indx].convert_function; + binfun = Bin_Fun_Map[c_indx]; + + if ((af != NULL) + && (NULL == (ap = (VOID_STAR) (*af) (ap, na)))) + return -1; + + if ((bf != NULL) + && (NULL == (bp = (VOID_STAR) (*bf) (bp, nb)))) + { + if (af != NULL) SLfree ((char *) ap); + return -1; + } + + ret = (*binfun) (op, a_type, ap, na, b_type, bp, nb, cp); + if (af != NULL) SLfree ((char *) ap); + if (bf != NULL) SLfree ((char *) bp); + + return ret; +} + +static int arith_unary_op_result (int op, unsigned char a, unsigned char *b) +{ + (void) a; + switch (op) + { + default: + return 0; + + case SLANG_SQR: + case SLANG_MUL2: + case SLANG_PLUSPLUS: + case SLANG_MINUSMINUS: + case SLANG_CHS: + case SLANG_ABS: + *b = a; + break; + + case SLANG_NOT: + case SLANG_BNOT: + if (0 == IS_INTEGER_TYPE(a)) + return 0; + *b = a; + break; + + case SLANG_SIGN: + *b = SLANG_INT_TYPE; + break; + } + return 1; +} + +static int integer_pop (unsigned char type, VOID_STAR ptr) +{ + SLang_Object_Type obj; + int i, j; + void (*f)(VOID_STAR, VOID_STAR, unsigned int); + + if (-1 == SLang_pop (&obj)) + return -1; + + if ((obj.data_type > MAXIMUM_ARITH_TYPE_VALUE) + || ((j = Type_Precedence_Table[obj.data_type]) == -1) + || (j >= FLOAT_PRECEDENCE_VALUE)) + { + _SLclass_type_mismatch_error (type, obj.data_type); + SLang_free_object (&obj); + return -1; + } + + i = Type_Precedence_Table[type]; + f = (void (*)(VOID_STAR, VOID_STAR, unsigned int)) + Binary_Matrix[j][i].copy_function; + + (*f) (ptr, (VOID_STAR)&obj.v, 1); + + return 0; +} + +static int integer_push (unsigned char type, VOID_STAR ptr) +{ + SLang_Object_Type obj; + int i; + void (*f)(VOID_STAR, VOID_STAR, unsigned int); + + i = Type_Precedence_Table[type]; + f = (void (*)(VOID_STAR, VOID_STAR, unsigned int)) + Binary_Matrix[i][i].copy_function; + + obj.data_type = type; + + (*f) ((VOID_STAR)&obj.v, ptr, 1); + + return SLang_push (&obj); +} + +int SLang_pop_char (char *i) +{ + return integer_pop (SLANG_CHAR_TYPE, (VOID_STAR) i); +} + +int SLang_pop_uchar (unsigned char *i) +{ + return integer_pop (SLANG_UCHAR_TYPE, (VOID_STAR) i); +} + +int SLang_pop_short (short *i) +{ + return integer_pop (SLANG_SHORT_TYPE, (VOID_STAR) i); +} + +int SLang_pop_ushort (unsigned short *i) +{ + return integer_pop (SLANG_USHORT_TYPE, (VOID_STAR) i); +} + +int SLang_pop_long (long *i) +{ + return integer_pop (SLANG_LONG_TYPE, (VOID_STAR) i); +} + +int SLang_pop_ulong (unsigned long *i) +{ + return integer_pop (SLANG_ULONG_TYPE, (VOID_STAR) i); +} + +int SLang_pop_integer (int *i) +{ +#if _SLANG_OPTIMIZE_FOR_SPEED + SLang_Object_Type obj; + + if (-1 == _SLang_pop_object_of_type (SLANG_INT_TYPE, &obj, 0)) + return -1; + *i = obj.v.int_val; + return 0; +#else + return integer_pop (SLANG_INT_TYPE, (VOID_STAR) i); +#endif +} + +int SLang_pop_uinteger (unsigned int *i) +{ + return integer_pop (SLANG_UINT_TYPE, (VOID_STAR) i); +} + +int SLang_push_integer (int i) +{ + return SLclass_push_int_obj (SLANG_INT_TYPE, i); +} +int SLang_push_uinteger (unsigned int i) +{ + return SLclass_push_int_obj (SLANG_UINT_TYPE, (int) i); +} +int SLang_push_char (char i) +{ + return SLclass_push_char_obj (SLANG_CHAR_TYPE, i); +} +int SLang_push_uchar (unsigned char i) +{ + return SLclass_push_char_obj (SLANG_UCHAR_TYPE, (char) i); +} +int SLang_push_short (short i) +{ + return SLclass_push_short_obj (SLANG_SHORT_TYPE, i); +} +int SLang_push_ushort (unsigned short i) +{ + return SLclass_push_short_obj (SLANG_USHORT_TYPE, (unsigned short) i); +} +int SLang_push_long (long i) +{ + return SLclass_push_long_obj (SLANG_LONG_TYPE, i); +} +int SLang_push_ulong (unsigned long i) +{ + return SLclass_push_long_obj (SLANG_ULONG_TYPE, (long) i); +} + +_INLINE_ +int _SLarith_typecast (unsigned char a_type, VOID_STAR ap, unsigned int na, + unsigned char b_type, VOID_STAR bp) +{ + int i, j; + + void (*copy)(VOID_STAR, VOID_STAR, unsigned int); + + i = Type_Precedence_Table[a_type]; + j = Type_Precedence_Table[b_type]; + + copy = (void (*)(VOID_STAR, VOID_STAR, unsigned int)) + Binary_Matrix[i][j].copy_function; + + (*copy) (bp, ap, na); + return 1; +} + +#if SLANG_HAS_FLOAT + +int SLang_pop_double(double *x, int *convertp, int *ip) +{ + SLang_Object_Type obj; + int i, convert; + + if (0 != SLang_pop (&obj)) + return -1; + + i = 0; + convert = 0; + + switch (obj.data_type) + { + case SLANG_FLOAT_TYPE: + *x = (double) obj.v.float_val; + break; + + case SLANG_DOUBLE_TYPE: + *x = obj.v.double_val; + break; + + case SLANG_INT_TYPE: + i = (int) obj.v.long_val; + *x = (double) i; + convert = 1; + break; + + case SLANG_CHAR_TYPE: *x = (double) obj.v.char_val; break; + case SLANG_UCHAR_TYPE: *x = (double) obj.v.uchar_val; break; + case SLANG_SHORT_TYPE: *x = (double) obj.v.short_val; break; + case SLANG_USHORT_TYPE: *x = (double) obj.v.ushort_val; break; + case SLANG_UINT_TYPE: *x = (double) obj.v.uint_val; break; + case SLANG_LONG_TYPE: *x = (double) obj.v.long_val; break; + case SLANG_ULONG_TYPE: *x = (double) obj.v.ulong_val; break; + + default: + _SLclass_type_mismatch_error (SLANG_DOUBLE_TYPE, obj.data_type); + SLang_free_object (&obj); + return -1; + } + + if (convertp != NULL) *convertp = convert; + if (ip != NULL) *ip = i; + + return 0; +} + +int SLang_push_double (double x) +{ + return SLclass_push_double_obj (SLANG_DOUBLE_TYPE, x); +} + +int SLang_pop_float (float *x) +{ + double d; + + /* Pop it as a double and let the double function do all the typcasting */ + if (-1 == SLang_pop_double (&d, NULL, NULL)) + return -1; + + *x = (float) d; + return 0; +} + +int SLang_push_float (float f) +{ + return SLclass_push_float_obj (SLANG_FLOAT_TYPE, (double) f); +} + +/* Double */ +static int double_push (unsigned char unused, VOID_STAR ptr) +{ + (void) unused; + SLang_push_double (*(double *) ptr); + return 0; +} + +static int double_push_literal (unsigned char type, VOID_STAR ptr) +{ + (void) type; + return SLang_push_double (**(double **)ptr); +} + +static int double_pop (unsigned char unused, VOID_STAR ptr) +{ + (void) unused; + return SLang_pop_double ((double *) ptr, NULL, NULL); +} + +static void double_byte_code_destroy (unsigned char unused, VOID_STAR ptr) +{ + (void) unused; + SLfree (*(char **) ptr); +} + +static int float_push (unsigned char unused, VOID_STAR ptr) +{ + (void) unused; + SLang_push_float (*(float *) ptr); + return 0; +} + +static int float_pop (unsigned char unused, VOID_STAR ptr) +{ + (void) unused; + return SLang_pop_float ((float *) ptr); +} + +#endif /* SLANG_HAS_FLOAT */ + +#if SLANG_HAS_FLOAT +static char Double_Format[16] = "%g"; + +void _SLset_double_format (char *s) +{ + strncpy (Double_Format, s, 15); + Double_Format[15] = 0; +} +#endif + +static char *arith_string (unsigned char type, VOID_STAR v) +{ + char buf [256]; + char *s; + + s = buf; + + switch (type) + { + default: + s = SLclass_get_datatype_name (type); + break; + + case SLANG_CHAR_TYPE: + sprintf (s, "%d", *(char *) v); + break; + case SLANG_UCHAR_TYPE: + sprintf (s, "%u", *(unsigned char *) v); + break; + case SLANG_SHORT_TYPE: + sprintf (s, "%d", *(short *) v); + break; + case SLANG_USHORT_TYPE: + sprintf (s, "%u", *(unsigned short *) v); + break; + case SLANG_INT_TYPE: + sprintf (s, "%d", *(int *) v); + break; + case SLANG_UINT_TYPE: + sprintf (s, "%u", *(unsigned int *) v); + break; + case SLANG_LONG_TYPE: + sprintf (s, "%ld", *(long *) v); + break; + case SLANG_ULONG_TYPE: + sprintf (s, "%lu", *(unsigned long *) v); + break; +#if SLANG_HAS_FLOAT + case SLANG_FLOAT_TYPE: + if (EOF == _SLsnprintf (buf, sizeof (buf), Double_Format, *(float *) v)) + sprintf (s, "%e", *(float *) v); + break; + case SLANG_DOUBLE_TYPE: + if (EOF == _SLsnprintf (buf, sizeof (buf), Double_Format, *(double *) v)) + sprintf (s, "%e", *(double *) v); + break; +#endif + } + + return SLmake_string (s); +} + +static int integer_to_bool (unsigned char type, int *t) +{ + (void) type; + return SLang_pop_integer (t); +} + +static int push_int_literal (unsigned char type, VOID_STAR ptr) +{ + return SLclass_push_int_obj (type, (int) *(long *) ptr); +} + +static int push_char_literal (unsigned char type, VOID_STAR ptr) +{ + return SLclass_push_char_obj (type, (char) *(long *) ptr); +} + +#if SIZEOF_SHORT != SIZEOF_INT +static int push_short_literal (unsigned char type, VOID_STAR ptr) +{ + return SLclass_push_short_obj (type, (short) *(long *) ptr); +} +#endif + +#if SIZEOF_INT != SIZEOF_LONG +static int push_long_literal (unsigned char type, VOID_STAR ptr) +{ + return SLclass_push_long_obj (type, *(long *) ptr); +} +#endif + +typedef struct +{ + char *name; + unsigned char data_type; + unsigned int sizeof_type; + int (*unary_fun)(int, unsigned char, VOID_STAR, unsigned int, VOID_STAR); + int (*push_literal) (unsigned char, VOID_STAR); + int (*cmp_fun) (unsigned char, VOID_STAR, VOID_STAR, int *); +} +Integer_Info_Type; + +static Integer_Info_Type Integer_Types [8] = +{ + {"Char_Type", SLANG_CHAR_TYPE, sizeof (char), char_unary_op, push_char_literal, char_cmp_function}, + {"UChar_Type", SLANG_UCHAR_TYPE, sizeof (unsigned char), uchar_unary_op, push_char_literal, uchar_cmp_function}, +#if SIZEOF_INT != SIZEOF_SHORT + {"Short_Type", SLANG_SHORT_TYPE, sizeof (short), short_unary_op, push_short_literal, short_cmp_function}, + {"UShort_Type", SLANG_USHORT_TYPE, sizeof (unsigned short), ushort_unary_op, push_short_literal, ushort_cmp_function}, +#else + {NULL, SLANG_SHORT_TYPE}, + {NULL, SLANG_USHORT_TYPE}, +#endif + + {"Integer_Type", SLANG_INT_TYPE, sizeof (int), int_unary_op, push_int_literal, int_cmp_function}, + {"UInteger_Type", SLANG_UINT_TYPE, sizeof (unsigned int), uint_unary_op, push_int_literal, uint_cmp_function}, + +#if SIZEOF_INT != SIZEOF_LONG + {"Long_Type", SLANG_LONG_TYPE, sizeof (long), long_unary_op, push_long_literal, long_cmp_function}, + {"ULong_Type", SLANG_ULONG_TYPE, sizeof (unsigned long), ulong_unary_op, push_long_literal, ulong_cmp_function} +#else + {NULL, SLANG_LONG_TYPE, 0, NULL, NULL, NULL}, + {NULL, SLANG_ULONG_TYPE, 0, NULL, NULL, NULL} +#endif +}; + +static int create_synonyms (void) +{ + static char *names[8] = + { + "Int16_Type", "UInt16_Type", "Int32_Type", "UInt32_Type", + "Int64_Type", "UInt64_Type", + "Float32_Type", "Float64_Type" + }; + int types[8]; + unsigned int i; + + memset ((char *) types, 0, sizeof (types)); + + /* The assumption is that sizeof(unsigned X) == sizeof (X) */ +#if SIZEOF_INT == 2 + types[0] = SLANG_INT_TYPE; + types[1] = SLANG_UINT_TYPE; +#else +# if SIZEOF_SHORT == 2 + types[0] = SLANG_SHORT_TYPE; + types[1] = SLANG_USHORT_TYPE; +# else +# if SIZEOF_LONG == 2 + types[0] = SLANG_LONG_TYPE; + types[1] = SLANG_ULONG_TYPE; +# endif +# endif +#endif + +#if SIZEOF_INT == 4 + types[2] = SLANG_INT_TYPE; + types[3] = SLANG_UINT_TYPE; +#else +# if SIZEOF_SHORT == 4 + types[2] = SLANG_SHORT_TYPE; + types[3] = SLANG_USHORT_TYPE; +# else +# if SIZEOF_LONG == 4 + types[2] = SLANG_LONG_TYPE; + types[3] = SLANG_ULONG_TYPE; +# endif +# endif +#endif + +#if SIZEOF_INT == 8 + types[4] = SLANG_INT_TYPE; + types[5] = SLANG_UINT_TYPE; +#else +# if SIZEOF_SHORT == 8 + types[4] = SLANG_SHORT_TYPE; + types[5] = SLANG_USHORT_TYPE; +# else +# if SIZEOF_LONG == 8 + types[4] = SLANG_LONG_TYPE; + types[5] = SLANG_ULONG_TYPE; +# endif +# endif +#endif + +#if SLANG_HAS_FLOAT + +#if SIZEOF_FLOAT == 4 + types[6] = SLANG_FLOAT_TYPE; +#else +# if SIZEOF_DOUBLE == 4 + types[6] = SLANG_DOUBLE_TYPE; +# endif +#endif +#if SIZEOF_FLOAT == 8 + types[7] = SLANG_FLOAT_TYPE; +#else +# if SIZEOF_DOUBLE == 8 + types[7] = SLANG_DOUBLE_TYPE; +# endif +#endif + +#endif + + if ((-1 == SLclass_create_synonym ("Int_Type", SLANG_INT_TYPE)) + || (-1 == SLclass_create_synonym ("UInt_Type", SLANG_UINT_TYPE))) + return -1; + + for (i = 0; i < 8; i++) + { + if (types[i] == 0) continue; + + if (-1 == SLclass_create_synonym (names[i], types[i])) + return -1; + } + +#if SIZEOF_INT == SIZEOF_SHORT + if ((-1 == SLclass_create_synonym ("Short_Type", SLANG_INT_TYPE)) + || (-1 == SLclass_create_synonym ("UShort_Type", SLANG_UINT_TYPE)) + || (-1 == _SLclass_copy_class (SLANG_SHORT_TYPE, SLANG_INT_TYPE)) + || (-1 == _SLclass_copy_class (SLANG_USHORT_TYPE, SLANG_UINT_TYPE))) + return -1; +#endif +#if SIZEOF_INT == SIZEOF_LONG + if ((-1 == SLclass_create_synonym ("Long_Type", SLANG_INT_TYPE)) + || (-1 == SLclass_create_synonym ("ULong_Type", SLANG_UINT_TYPE)) + || (-1 == _SLclass_copy_class (SLANG_LONG_TYPE, SLANG_INT_TYPE)) + || (-1 == _SLclass_copy_class (SLANG_ULONG_TYPE, SLANG_UINT_TYPE))) + return -1; +#endif + return 0; +} + +int _SLarith_register_types (void) +{ + SLang_Class_Type *cl; + int a_type, b_type; + int i, j; + +#if defined(HAVE_SETLOCALE) && defined(LC_NUMERIC) + /* make sure decimal point it used --- the parser requires it */ + (void) setlocale (LC_NUMERIC, "C"); +#endif + + for (i = 0; i < 8; i++) + { + Integer_Info_Type *info; + + info = Integer_Types + i; + + if (info->name == NULL) + { + /* This happens when the object is the same size as an integer + * For this case, we really want to copy the integer class. + * We will handle that when the synonym is created. + */ + continue; + } + + if (NULL == (cl = SLclass_allocate_class (info->name))) + return -1; + + (void) SLclass_set_string_function (cl, arith_string); + (void) SLclass_set_push_function (cl, integer_push); + (void) SLclass_set_pop_function (cl, integer_pop); + cl->cl_push_literal = info->push_literal; + cl->cl_to_bool = integer_to_bool; + + cl->cl_cmp = info->cmp_fun; + + if (-1 == SLclass_register_class (cl, info->data_type, info->sizeof_type, + SLANG_CLASS_TYPE_SCALAR)) + return -1; + if (-1 == SLclass_add_unary_op (info->data_type, info->unary_fun, arith_unary_op_result)) + return -1; + + _SLarith_Is_Arith_Type [info->data_type] = 1; + } + +#if SLANG_HAS_FLOAT + if (NULL == (cl = SLclass_allocate_class ("Double_Type"))) + return -1; + (void) SLclass_set_push_function (cl, double_push); + (void) SLclass_set_pop_function (cl, double_pop); + (void) SLclass_set_string_function (cl, arith_string); + cl->cl_byte_code_destroy = double_byte_code_destroy; + cl->cl_push_literal = double_push_literal; + cl->cl_cmp = double_cmp_function; + + if (-1 == SLclass_register_class (cl, SLANG_DOUBLE_TYPE, sizeof (double), + SLANG_CLASS_TYPE_SCALAR)) + return -1; + if (-1 == SLclass_add_unary_op (SLANG_DOUBLE_TYPE, double_unary_op, arith_unary_op_result)) + return -1; + _SLarith_Is_Arith_Type [SLANG_DOUBLE_TYPE] = 2; + + if (NULL == (cl = SLclass_allocate_class ("Float_Type"))) + return -1; + (void) SLclass_set_string_function (cl, arith_string); + (void) SLclass_set_push_function (cl, float_push); + (void) SLclass_set_pop_function (cl, float_pop); + cl->cl_cmp = float_cmp_function; + + if (-1 == SLclass_register_class (cl, SLANG_FLOAT_TYPE, sizeof (float), + SLANG_CLASS_TYPE_SCALAR)) + return -1; + if (-1 == SLclass_add_unary_op (SLANG_FLOAT_TYPE, float_unary_op, arith_unary_op_result)) + return -1; + _SLarith_Is_Arith_Type [SLANG_FLOAT_TYPE] = 2; +#endif + + if (-1 == create_synonyms ()) + return -1; + + for (a_type = 0; a_type <= MAXIMUM_ARITH_TYPE_VALUE; a_type++) + { + if (-1 == (i = Type_Precedence_Table [a_type])) + continue; + + for (b_type = 0; b_type <= MAXIMUM_ARITH_TYPE_VALUE; b_type++) + { + int implicit_ok; + + if (-1 == (j = Type_Precedence_Table [b_type])) + continue; + + /* Allow implicit typecast, except from into to float */ + implicit_ok = ((j >= FLOAT_PRECEDENCE_VALUE) + || (i < FLOAT_PRECEDENCE_VALUE)); + + if (-1 == SLclass_add_binary_op (a_type, b_type, arith_bin_op, arith_bin_op_result)) + return -1; + + if (i != j) + if (-1 == SLclass_add_typecast (a_type, b_type, _SLarith_typecast, implicit_ok)) + return -1; + } + } + + return 0; +} + +#if _SLANG_OPTIMIZE_FOR_SPEED + +static void promote_objs (SLang_Object_Type *a, SLang_Object_Type *b, + SLang_Object_Type *c, SLang_Object_Type *d) +{ + unsigned char ia, ib, ic, id; + int i, j; + void (*copy)(VOID_STAR, VOID_STAR, unsigned int); + + ia = a->data_type; + ib = b->data_type; + + ic = _SLarith_promote_type (ia); + + if (ic == ib) id = ic; /* already promoted */ + else id = _SLarith_promote_type (ib); + + i = Type_Precedence_Table[ic]; + j = Type_Precedence_Table[id]; + if (i > j) + { + id = ic; + j = i; + } + + c->data_type = d->data_type = id; + + i = Type_Precedence_Table[ia]; + copy = (void (*)(VOID_STAR, VOID_STAR, unsigned int)) + Binary_Matrix[i][j].copy_function; + (*copy) ((VOID_STAR) &c->v, (VOID_STAR)&a->v, 1); + + i = Type_Precedence_Table[ib]; + copy = (void (*)(VOID_STAR, VOID_STAR, unsigned int)) + Binary_Matrix[i][j].copy_function; + (*copy) ((VOID_STAR) &d->v, (VOID_STAR)&b->v, 1); +} + +int _SLarith_bin_op (SLang_Object_Type *oa, SLang_Object_Type *ob, int op) +{ + unsigned char a_type, b_type; + + a_type = oa->data_type; + b_type = ob->data_type; + + if (a_type != b_type) + { + SLang_Object_Type obj_a, obj_b; + + /* Handle common cases */ + if ((a_type == SLANG_INT_TYPE) + && (b_type == SLANG_DOUBLE_TYPE)) + return double_double_scalar_bin_op (oa->v.int_val, ob->v.double_val, op); + + if ((a_type == SLANG_DOUBLE_TYPE) + && (b_type == SLANG_INT_TYPE)) + return double_double_scalar_bin_op (oa->v.double_val, ob->v.int_val, op); + + /* Otherwise do it the hard way */ + promote_objs (oa, ob, &obj_a, &obj_b); + oa = &obj_a; + ob = &obj_b; + + a_type = oa->data_type; + b_type = ob->data_type; + } + + + switch (a_type) + { + case SLANG_CHAR_TYPE: + return int_int_scalar_bin_op (oa->v.char_val, ob->v.char_val, op); + + case SLANG_UCHAR_TYPE: + return int_int_scalar_bin_op (oa->v.uchar_val, ob->v.uchar_val, op); + + case SLANG_SHORT_TYPE: + return int_int_scalar_bin_op (oa->v.short_val, ob->v.short_val, op); + + case SLANG_USHORT_TYPE: +# if SIZEOF_INT == SIZEOF_SHORT + return uint_uint_scalar_bin_op (oa->v.ushort_val, ob->v.ushort_val, op); +# else + return int_int_scalar_bin_op ((int)oa->v.ushort_val, (int)ob->v.ushort_val, op); +# endif + +#if SIZEOF_LONG == SIZEOF_INT + case SLANG_LONG_TYPE: +#endif + case SLANG_INT_TYPE: + return int_int_scalar_bin_op (oa->v.int_val, ob->v.int_val, op); + +#if SIZEOF_LONG == SIZEOF_INT + case SLANG_ULONG_TYPE: +#endif + case SLANG_UINT_TYPE: + return uint_uint_scalar_bin_op (oa->v.uint_val, ob->v.uint_val, op); + +#if SIZEOF_LONG != SIZEOF_INT + case SLANG_LONG_TYPE: + return long_long_scalar_bin_op (oa->v.long_val, ob->v.long_val, op); + case SLANG_ULONG_TYPE: + return ulong_ulong_scalar_bin_op (oa->v.ulong_val, ob->v.ulong_val, op); +#endif + case SLANG_FLOAT_TYPE: + return float_float_scalar_bin_op (oa->v.float_val, ob->v.float_val, op); + case SLANG_DOUBLE_TYPE: + return double_double_scalar_bin_op (oa->v.double_val, ob->v.double_val, op); + } + + return 1; +} +#endif -- cgit v1.2.1