1 
2 /* Copyright (c) 1998, 1999, 2001, 2002 John E. Davis
3  * This file is part of the S-Lang library.
4  *
5  * You may distribute under the terms of either the GNU General Public
6  * License or the Perl Artistic License.
7  */
8 
9 #include "slinclud.h"
10 
11 #include <math.h>
12 
13 #ifdef HAVE_LOCALE_H
14 # include <locale.h>
15 #endif
16 
17 #include "slang.h"
18 #include "_slang.h"
19 
20 /*
21  * This file defines binary and unary operations on all integer types.
22  * Supported types include:
23  *
24  *    SLANG_CHAR_TYPE     (char)
25  *    SLANG_SHORT_TYPE    (short)
26  *    SLANG_INT_TYPE      (int)
27  *    SLANG_LONG_TYPE     (long)
28  *    SLANG_FLOAT_TYPE    (float)
29  *    SLANG_DOUBLE_TYPE   (double)
30  *
31  * as well as unsigned types.  The result-type of an arithmentic operation
32  * will depend upon the data types involved.  I am going to distinguish
33  * between the boolean operations such as `and' and `or' from the arithmetic
34  * operations such as `plus'.  Since the result of a boolean operation is
35  * either 1 or 0, a boolean result will be represented by SLANG_CHAR_TYPE.
36  * Ordinarily I would use an integer but for arrays it makes more sense to
37  * use a character data type.
38  *
39  * So, the following will be assumed (`+' is any arithmetic operator)
40  *
41  *    char + char = int
42  *    char|short + short = int
43  *    char|short|int + int = int
44  *    char|short|int|long + long = long
45  *    char|short|int|long|float + float = float
46  *    char|short|int|long|float|double + double = double
47  *
48  * In the actual implementation, a brute force approach is avoided.  Such
49  * an approach would mean defining different functions for all possible
50  * combinations of types.  Including the unsigned types, and not including
51  * the complex number type, there are 10 arithmetic types and 10*10=100
52  * different combinations of types.  Clearly this would be too much.
53  *
54  * One approach would be to define binary functions only between operands of
55  * the same type and then convert types as appropriate.  This would require
56  * just 6 such functions (int, uint, long, ulong, float, double).
57  * However, many conversion functions are going to be required, particularly
58  * since we are going to allow typecasting from one arithmetic to another.
59  * Since the bit pattern of signed and unsigned types are the same, and only
60  * the interpretation differs, there will be no functions to convert between
61  * signed and unsigned forms of a given type.
62  */
63 
64 #define MAX_ARITHMETIC_TYPES	10
65 
66 unsigned char _SLarith_Is_Arith_Type [256];
67 
68 unsigned char _SLarith_Arith_Types[] =
69 {
70    SLANG_CHAR_TYPE,
71    SLANG_UCHAR_TYPE,
72    SLANG_SHORT_TYPE,
73    SLANG_USHORT_TYPE,
74    SLANG_INT_TYPE,
75    SLANG_UINT_TYPE,
76    SLANG_LONG_TYPE,
77    SLANG_ULONG_TYPE,
78    SLANG_FLOAT_TYPE,
79    SLANG_DOUBLE_TYPE,
80    0
81 };
82 
83 /* Here are a bunch of functions to convert from one type to another.  To
84  * facilitate the process, a macros will be used.
85  */
86 
87 #define DEFUN_1(f,from_type,to_type) \
88 static void f (to_type *y, from_type *x, unsigned int n) \
89 { \
90    unsigned int i; \
91    for (i = 0; i < n; i++) y[i] = (to_type) x[i]; \
92 }
93 
94 #define DEFUN_2(f,from_type,to_type,copy_fun) \
95 static VOID_STAR f (VOID_STAR xp, unsigned int n) \
96 { \
97    from_type *x; \
98    to_type *y; \
99    x = (from_type *) xp; \
100    if (NULL == (y = (to_type *) SLmalloc (sizeof (to_type) * n))) return NULL; \
101    copy_fun (y, x, n); \
102    return (VOID_STAR) y; \
103 }
104 typedef VOID_STAR (*Convert_Fun_Type)(VOID_STAR, unsigned int);
105 
DEFUN_1(copy_char_to_char,char,char)106 DEFUN_1(copy_char_to_char,char,char)
107 #if SIZEOF_INT != SIZEOF_SHORT
108 DEFUN_1(copy_char_to_short,char,short)
109 DEFUN_1(copy_char_to_ushort,char,unsigned short)
110 #else
111 # define copy_char_to_short	copy_char_to_int
112 # define copy_char_to_ushort	copy_char_to_uint
113 #endif
114 DEFUN_1(copy_char_to_int,char,int)
115 DEFUN_1(copy_char_to_uint,char,unsigned int)
116 #if SIZEOF_INT != SIZEOF_LONG
117 DEFUN_1(copy_char_to_long,char,long)
118 DEFUN_1(copy_char_to_ulong,char,unsigned long)
119 #else
120 # define copy_char_to_long	copy_char_to_int
121 # define copy_char_to_ulong	copy_char_to_uint
122 #endif
123 DEFUN_1(copy_char_to_float,char,float)
124 DEFUN_1(copy_char_to_double,char,double)
125 
126 #if SIZEOF_INT != SIZEOF_SHORT
127 DEFUN_1(copy_uchar_to_short,unsigned char,short)
128 DEFUN_1(copy_uchar_to_ushort,unsigned char,unsigned short)
129 #else
130 # define copy_uchar_to_short	copy_uchar_to_int
131 # define copy_uchar_to_ushort	copy_uchar_to_uint
132 #endif
133 DEFUN_1(copy_uchar_to_int,unsigned char,int)
134 DEFUN_1(copy_uchar_to_uint,unsigned char,unsigned int)
135 #if SIZEOF_INT != SIZEOF_LONG
136 DEFUN_1(copy_uchar_to_long,unsigned char,long)
137 DEFUN_1(copy_uchar_to_ulong,unsigned char,unsigned long)
138 #else
139 # define copy_uchar_to_long	copy_uchar_to_int
140 # define copy_uchar_to_ulong	copy_uchar_to_uint
141 #endif
142 DEFUN_1(copy_uchar_to_float,unsigned char,float)
143 DEFUN_1(copy_uchar_to_double,unsigned char,double)
144 
145 #if SIZEOF_INT != SIZEOF_SHORT
146 DEFUN_1(copy_short_to_char,short,char)
147 DEFUN_1(copy_short_to_uchar,short,unsigned char)
148 DEFUN_1(copy_short_to_short,short,short)
149 DEFUN_1(copy_short_to_int,short,int)
150 DEFUN_1(copy_short_to_uint,short,unsigned int)
151 DEFUN_1(copy_short_to_long,short,long)
152 DEFUN_1(copy_short_to_ulong,short,unsigned long)
153 DEFUN_1(copy_short_to_float,short,float)
154 DEFUN_1(copy_short_to_double,short,double)
155 DEFUN_1(copy_ushort_to_char,unsigned short,char)
156 DEFUN_1(copy_ushort_to_uchar,unsigned short,unsigned char)
157 DEFUN_1(copy_ushort_to_int,unsigned short,int)
158 DEFUN_1(copy_ushort_to_uint,unsigned short,unsigned int)
159 DEFUN_1(copy_ushort_to_long,unsigned short,long)
160 DEFUN_1(copy_ushort_to_ulong,unsigned short,unsigned long)
161 DEFUN_1(copy_ushort_to_float,unsigned short,float)
162 DEFUN_1(copy_ushort_to_double,unsigned short,double)
163 #else
164 # define copy_short_to_char	copy_int_to_char
165 # define copy_short_to_uchar	copy_int_to_uchar
166 # define copy_short_to_short	copy_int_to_int
167 # define copy_short_to_int	copy_int_to_int
168 # define copy_short_to_uint	copy_int_to_int
169 # define copy_short_to_long	copy_int_to_long
170 # define copy_short_to_ulong	copy_int_to_ulong
171 # define copy_short_to_float	copy_int_to_float
172 # define copy_short_to_double	copy_int_to_double
173 # define copy_ushort_to_char	copy_uint_to_char
174 # define copy_ushort_to_uchar	copy_uint_to_uchar
175 # define copy_ushort_to_int	copy_int_to_int
176 # define copy_ushort_to_uint	copy_int_to_int
177 # define copy_ushort_to_long	copy_uint_to_long
178 # define copy_ushort_to_ulong	copy_uint_to_ulong
179 # define copy_ushort_to_float	copy_uint_to_float
180 # define copy_ushort_to_double	copy_uint_to_double
181 #endif
182 
183 DEFUN_1(copy_int_to_char,int,char)
184 DEFUN_1(copy_int_to_uchar,int,unsigned char)
185 DEFUN_1(copy_uint_to_char,unsigned int,char)
186 DEFUN_1(copy_uint_to_uchar,unsigned int,unsigned char)
187 #if SIZEOF_INT != SIZEOF_SHORT
188 DEFUN_1(copy_int_to_short,int,short)
189 DEFUN_1(copy_int_to_ushort,int,unsigned short)
190 DEFUN_1(copy_uint_to_short,unsigned int,short)
191 DEFUN_1(copy_uint_to_ushort,unsigned int,unsigned short)
192 #else
193 # define copy_int_to_short	copy_int_to_int
194 # define copy_int_to_ushort	copy_int_to_int
195 # define copy_uint_to_short	copy_int_to_int
196 # define copy_uint_to_ushort	copy_int_to_int
197 #endif
198 DEFUN_1(copy_int_to_int,int,int)
199 #if SIZEOF_INT != SIZEOF_LONG
200 DEFUN_1(copy_int_to_long,int,long)
201 DEFUN_1(copy_int_to_ulong,int,unsigned long)
202 DEFUN_1(copy_uint_to_long,unsigned int,long)
203 DEFUN_1(copy_uint_to_ulong,unsigned int,unsigned long)
204 #else
205 # define copy_int_to_long	copy_int_to_int
206 # define copy_int_to_ulong	copy_int_to_int
207 # define copy_uint_to_long	copy_int_to_int
208 # define copy_uint_to_ulong	copy_int_to_int
209 #endif
210 DEFUN_1(copy_int_to_float,int,float)
211 DEFUN_1(copy_int_to_double,int,double)
212 DEFUN_1(copy_uint_to_float,unsigned int,float)
213 DEFUN_1(copy_uint_to_double,unsigned int,double)
214 
215 #if SIZEOF_INT != SIZEOF_LONG
216 DEFUN_1(copy_long_to_char,long,char)
217 DEFUN_1(copy_long_to_uchar,long,unsigned char)
218 DEFUN_1(copy_long_to_short,long,short)
219 DEFUN_1(copy_long_to_ushort,long,unsigned short)
220 DEFUN_1(copy_long_to_int,long,int)
221 DEFUN_1(copy_long_to_uint,long,unsigned int)
222 DEFUN_1(copy_long_to_long,long,long)
223 DEFUN_1(copy_long_to_float,long,float)
224 DEFUN_1(copy_long_to_double,long,double)
225 DEFUN_1(copy_ulong_to_char,unsigned long,char)
226 DEFUN_1(copy_ulong_to_uchar,unsigned long,unsigned char)
227 DEFUN_1(copy_ulong_to_short,unsigned long,short)
228 DEFUN_1(copy_ulong_to_ushort,unsigned long,unsigned short)
229 DEFUN_1(copy_ulong_to_int,unsigned long,int)
230 DEFUN_1(copy_ulong_to_uint,unsigned long,unsigned int)
231 DEFUN_1(copy_ulong_to_float,unsigned long,float)
232 DEFUN_1(copy_ulong_to_double,unsigned long,double)
233 #else
234 #define copy_long_to_char	copy_int_to_char
235 #define copy_long_to_uchar	copy_int_to_uchar
236 #define copy_long_to_short	copy_int_to_short
237 #define copy_long_to_ushort	copy_int_to_ushort
238 #define copy_long_to_int	copy_int_to_int
239 #define copy_long_to_uint	copy_int_to_int
240 #define copy_long_to_long	copy_int_to_int
241 #define copy_long_to_float	copy_int_to_float
242 #define copy_long_to_double	copy_int_to_double
243 #define copy_ulong_to_char	copy_uint_to_char
244 #define copy_ulong_to_uchar	copy_uint_to_uchar
245 #define copy_ulong_to_short	copy_uint_to_short
246 #define copy_ulong_to_ushort	copy_uint_to_ushort
247 #define copy_ulong_to_int	copy_int_to_int
248 #define copy_ulong_to_uint	copy_int_to_int
249 #define copy_ulong_to_float	copy_uint_to_float
250 #define copy_ulong_to_double	copy_uint_to_double
251 #endif
252 
253 DEFUN_1(copy_float_to_char,float,char)
254 DEFUN_1(copy_float_to_uchar,float,unsigned char)
255 #if SIZEOF_INT != SIZEOF_SHORT
256 DEFUN_1(copy_float_to_short,float,short)
257 DEFUN_1(copy_float_to_ushort,float,unsigned short)
258 #else
259 # define copy_float_to_short	copy_float_to_int
260 # define copy_float_to_ushort	copy_float_to_uint
261 #endif
262 DEFUN_1(copy_float_to_int,float,int)
263 DEFUN_1(copy_float_to_uint,float,unsigned int)
264 #if SIZEOF_INT != SIZEOF_LONG
265 DEFUN_1(copy_float_to_long,float,long)
266 DEFUN_1(copy_float_to_ulong,float,unsigned long)
267 #else
268 # define copy_float_to_long	copy_float_to_int
269 # define copy_float_to_ulong	copy_float_to_uint
270 #endif
271 DEFUN_1(copy_float_to_float,float,float)
272 DEFUN_1(copy_float_to_double,float,double)
273 
274 DEFUN_1(copy_double_to_char,double,char)
275 DEFUN_1(copy_double_to_uchar,double,unsigned char)
276 #if SIZEOF_INT != SIZEOF_SHORT
277 DEFUN_1(copy_double_to_short,double,short)
278 DEFUN_1(copy_double_to_ushort,double,unsigned short)
279 #else
280 # define copy_double_to_short	copy_double_to_int
281 # define copy_double_to_ushort	copy_double_to_uint
282 #endif
283 DEFUN_1(copy_double_to_int,double,int)
284 DEFUN_1(copy_double_to_uint,double,unsigned int)
285 #if SIZEOF_INT != SIZEOF_LONG
286 DEFUN_1(copy_double_to_long,double,long)
287 DEFUN_1(copy_double_to_ulong,double,unsigned long)
288 #else
289 # define copy_double_to_long	copy_double_to_int
290 # define copy_double_to_ulong	copy_double_to_uint
291 #endif
292 DEFUN_1(copy_double_to_float,double,float)
293 DEFUN_1(copy_double_to_double,double,double)
294 
295 DEFUN_2(char_to_int,char,int,copy_char_to_int)
296 DEFUN_2(char_to_uint,char,unsigned int,copy_char_to_uint)
297 #if SIZEOF_INT != SIZEOF_LONG
298 DEFUN_2(char_to_long,char,long,copy_char_to_long)
299 DEFUN_2(char_to_ulong,char,unsigned long,copy_char_to_ulong)
300 #else
301 # define char_to_long	char_to_int
302 # define char_to_ulong	char_to_uint
303 #endif
304 DEFUN_2(char_to_float,char,float,copy_char_to_float)
305 DEFUN_2(char_to_double,char,double,copy_char_to_double)
306 
307 DEFUN_2(uchar_to_int,unsigned char,int,copy_uchar_to_int)
308 DEFUN_2(uchar_to_uint,unsigned char,unsigned int,copy_uchar_to_uint)
309 #if SIZEOF_INT != SIZEOF_LONG
310 DEFUN_2(uchar_to_long,unsigned char,long,copy_uchar_to_long)
311 DEFUN_2(uchar_to_ulong,unsigned char,unsigned long,copy_uchar_to_ulong)
312 #else
313 # define uchar_to_long		uchar_to_int
314 # define uchar_to_ulong		uchar_to_uint
315 #endif
316 DEFUN_2(uchar_to_float,unsigned char,float,copy_uchar_to_float)
317 DEFUN_2(uchar_to_double,unsigned char,double,copy_uchar_to_double)
318 
319 #if SIZEOF_INT != SIZEOF_SHORT
320 DEFUN_2(short_to_int,short,int,copy_short_to_int)
321 DEFUN_2(short_to_uint,short,unsigned int,copy_short_to_uint)
322 DEFUN_2(short_to_long,short,long,copy_short_to_long)
323 DEFUN_2(short_to_ulong,short,unsigned long,copy_short_to_ulong)
324 DEFUN_2(short_to_float,short,float,copy_short_to_float)
325 DEFUN_2(short_to_double,short,double,copy_short_to_double)
326 DEFUN_2(ushort_to_int,unsigned short,int,copy_ushort_to_int)
327 DEFUN_2(ushort_to_uint,unsigned short,unsigned int,copy_ushort_to_uint)
328 DEFUN_2(ushort_to_long,unsigned short,long,copy_ushort_to_long)
329 DEFUN_2(ushort_to_ulong,unsigned short,unsigned long,copy_ushort_to_ulong)
330 DEFUN_2(ushort_to_float,unsigned short,float,copy_ushort_to_float)
331 DEFUN_2(ushort_to_double,unsigned short,double,copy_ushort_to_double)
332 #else
333 # define short_to_int		NULL
334 # define short_to_uint		NULL
335 # define short_to_long		int_to_long
336 # define short_to_ulong		int_to_ulong
337 # define short_to_float		int_to_float
338 # define short_to_double	int_to_double
339 # define ushort_to_int		NULL
340 # define ushort_to_uint		NULL
341 # define ushort_to_long		uint_to_long
342 # define ushort_to_ulong	uint_to_ulong
343 # define ushort_to_float	uint_to_float
344 # define ushort_to_double	uint_to_double
345 #endif
346 
347 #if SIZEOF_INT != SIZEOF_LONG
348 DEFUN_2(int_to_long,int,long,copy_int_to_long)
349 DEFUN_2(int_to_ulong,int,unsigned long,copy_int_to_ulong)
350 #else
351 # define int_to_long		NULL
352 # define int_to_ulong		NULL
353 #endif
354 DEFUN_2(int_to_float,int,float,copy_int_to_float)
355 DEFUN_2(int_to_double,int,double,copy_int_to_double)
356 
357 #if SIZEOF_INT != SIZEOF_LONG
358 DEFUN_2(uint_to_long,unsigned int,long,copy_uint_to_long)
359 DEFUN_2(uint_to_ulong,unsigned int,unsigned long,copy_uint_to_ulong)
360 #else
361 # define uint_to_long		NULL
362 # define uint_to_ulong		NULL
363 #endif
364 DEFUN_2(uint_to_float,unsigned int,float,copy_uint_to_float)
365 DEFUN_2(uint_to_double,unsigned int,double,copy_uint_to_double)
366 
367 #if SIZEOF_INT != SIZEOF_LONG
368 DEFUN_2(long_to_float,long,float,copy_long_to_float)
369 DEFUN_2(long_to_double,long,double,copy_long_to_double)
370 DEFUN_2(ulong_to_float,unsigned long,float,copy_ulong_to_float)
371 DEFUN_2(ulong_to_double,unsigned long,double,copy_ulong_to_double)
372 #else
373 # define long_to_float		int_to_float
374 # define long_to_double		int_to_double
375 # define ulong_to_float		uint_to_float
376 # define ulong_to_double	uint_to_double
377 #endif
378 
379 DEFUN_2(float_to_double,float,double,copy_float_to_double)
380 
381 #define TO_DOUBLE_FUN(name,type) \
382 static double name (VOID_STAR x) { return (double) *(type *) x; }
383 TO_DOUBLE_FUN(char_to_one_double,char)
384 TO_DOUBLE_FUN(uchar_to_one_double,unsigned char)
385 #if SIZEOF_INT != SIZEOF_SHORT
386 TO_DOUBLE_FUN(short_to_one_double,short)
387 TO_DOUBLE_FUN(ushort_to_one_double,unsigned short)
388 #else
389 # define short_to_one_double	int_to_one_double
390 # define ushort_to_one_double	uint_to_one_double
391 #endif
392 TO_DOUBLE_FUN(int_to_one_double,int)
393 TO_DOUBLE_FUN(uint_to_one_double,unsigned int)
394 #if SIZEOF_INT != SIZEOF_LONG
395 TO_DOUBLE_FUN(long_to_one_double,long)
396 TO_DOUBLE_FUN(ulong_to_one_double,unsigned long)
397 #else
398 # define long_to_one_double	int_to_one_double
399 # define ulong_to_one_double	uint_to_one_double
400 #endif
401 TO_DOUBLE_FUN(float_to_one_double,float)
402 TO_DOUBLE_FUN(double_to_one_double,double)
403 
404 SLang_To_Double_Fun_Type
405 SLarith_get_to_double_fun (unsigned char type, unsigned int *sizeof_type)
406 {
407    unsigned int da;
408    SLang_To_Double_Fun_Type to_double;
409 
410    switch (type)
411      {
412       default:
413 	return NULL;
414 
415       case SLANG_CHAR_TYPE:
416 	da = sizeof (char); to_double = char_to_one_double;
417 	break;
418       case SLANG_UCHAR_TYPE:
419 	da = sizeof (unsigned char); to_double = uchar_to_one_double;
420 	break;
421       case SLANG_SHORT_TYPE:
422 	da = sizeof (short); to_double = short_to_one_double;
423 	break;
424       case SLANG_USHORT_TYPE:
425 	da = sizeof (unsigned short); to_double = ushort_to_one_double;
426 	break;
427       case SLANG_INT_TYPE:
428 	da = sizeof (int); to_double = int_to_one_double;
429 	break;
430       case SLANG_UINT_TYPE:
431 	da = sizeof (unsigned int); to_double = uint_to_one_double;
432 	break;
433       case SLANG_LONG_TYPE:
434 	da = sizeof (long); to_double = long_to_one_double;
435 	break;
436       case SLANG_ULONG_TYPE:
437 	da = sizeof (unsigned long); to_double = ulong_to_one_double;
438 	break;
439       case SLANG_FLOAT_TYPE:
440 	da = sizeof (float); to_double = float_to_one_double;
441 	break;
442      case SLANG_DOUBLE_TYPE:
443 	da = sizeof (double); to_double = double_to_one_double;
444 	break;
445      }
446 
447    if (sizeof_type != NULL) *sizeof_type = da;
448    return to_double;
449 }
450 
451 /* Each element of the matrix determines how the row maps onto the column.
452  * That is, let the matrix be B_ij.  Where the i,j indices refer to
453  * precedence of the type.  Then,
454  * B_ij->copy_function copies type i to type j.  Similarly,
455  * B_ij->convert_function mallocs a new array of type j and copies i to it.
456  *
457  * Since types are always converted to higher levels of precedence for binary
458  * operations, many of the elements are NULL.
459  *
460  * Is the idea clear?
461  */
462 typedef struct
463 {
464    FVOID_STAR copy_function;
465    Convert_Fun_Type convert_function;
466 }
467 Binary_Matrix_Type;
468 
469 static Binary_Matrix_Type Binary_Matrix [MAX_ARITHMETIC_TYPES][MAX_ARITHMETIC_TYPES] =
470 {
471      {
472 	  {(FVOID_STAR)copy_char_to_char, NULL},
473 	  {(FVOID_STAR)copy_char_to_char, NULL},
474 	{(FVOID_STAR) copy_char_to_short, NULL},
475 	{(FVOID_STAR) copy_char_to_ushort, NULL},
476 	{(FVOID_STAR) copy_char_to_int, char_to_int},
477 	{(FVOID_STAR) copy_char_to_uint, char_to_uint},
478 	{(FVOID_STAR) copy_char_to_long, char_to_long},
479 	{(FVOID_STAR) copy_char_to_ulong, char_to_ulong},
480 	{(FVOID_STAR) copy_char_to_float, char_to_float},
481 	{(FVOID_STAR) copy_char_to_double, char_to_double},
482      },
483 
484      {
485 	  {(FVOID_STAR)copy_char_to_char, NULL},
486 	  {(FVOID_STAR)copy_char_to_char, NULL},
487 	{(FVOID_STAR) copy_uchar_to_short, NULL},
488 	{(FVOID_STAR) copy_uchar_to_ushort, NULL},
489 	{(FVOID_STAR) copy_uchar_to_int, uchar_to_int},
490 	{(FVOID_STAR) copy_uchar_to_uint, uchar_to_uint},
491 	{(FVOID_STAR) copy_uchar_to_long, uchar_to_long},
492 	{(FVOID_STAR) copy_uchar_to_ulong, uchar_to_ulong},
493 	{(FVOID_STAR) copy_uchar_to_float, uchar_to_float},
494 	{(FVOID_STAR) copy_uchar_to_double, uchar_to_double},
495      },
496 
497      {
498 	{(FVOID_STAR) copy_short_to_char, NULL},
499 	{(FVOID_STAR) copy_short_to_uchar, NULL},
500 	{(FVOID_STAR) copy_short_to_short, NULL},
501 	{(FVOID_STAR) copy_short_to_short, NULL},
502 	{(FVOID_STAR) copy_short_to_int, short_to_int},
503 	{(FVOID_STAR) copy_short_to_uint, short_to_uint},
504 	{(FVOID_STAR) copy_short_to_long, short_to_long},
505 	{(FVOID_STAR) copy_short_to_ulong, short_to_ulong},
506 	{(FVOID_STAR) copy_short_to_float, short_to_float},
507 	{(FVOID_STAR) copy_short_to_double, short_to_double},
508      },
509 
510      {
511 	{(FVOID_STAR) copy_ushort_to_char, NULL},
512 	{(FVOID_STAR) copy_ushort_to_uchar, NULL},
513 	{(FVOID_STAR) copy_short_to_short, NULL},
514 	{(FVOID_STAR) copy_short_to_short, NULL},
515 	{(FVOID_STAR) copy_ushort_to_int, ushort_to_int},
516 	{(FVOID_STAR) copy_ushort_to_uint, ushort_to_uint},
517 	{(FVOID_STAR) copy_ushort_to_long, ushort_to_long},
518 	{(FVOID_STAR) copy_ushort_to_ulong, ushort_to_ulong},
519 	{(FVOID_STAR) copy_ushort_to_float, ushort_to_float},
520 	{(FVOID_STAR) copy_ushort_to_double, ushort_to_double},
521      },
522 
523      {
524 	{(FVOID_STAR) copy_int_to_char, NULL},
525 	{(FVOID_STAR) copy_int_to_uchar, NULL},
526 	{(FVOID_STAR) copy_int_to_short, NULL},
527 	{(FVOID_STAR) copy_int_to_ushort, NULL},
528 	{(FVOID_STAR) copy_int_to_int, NULL},
529 	{(FVOID_STAR) copy_int_to_int, NULL},
530 	{(FVOID_STAR) copy_int_to_long, int_to_long},
531 	{(FVOID_STAR) copy_int_to_ulong, int_to_ulong},
532 	{(FVOID_STAR) copy_int_to_float, int_to_float},
533 	{(FVOID_STAR) copy_int_to_double, int_to_double},
534      },
535 
536      {
537 	{(FVOID_STAR) copy_uint_to_char, NULL},
538 	{(FVOID_STAR) copy_uint_to_uchar, NULL},
539 	{(FVOID_STAR) copy_uint_to_short, NULL},
540 	{(FVOID_STAR) copy_uint_to_ushort, NULL},
541 	{(FVOID_STAR) copy_int_to_int, NULL},
542 	{(FVOID_STAR) copy_int_to_int, NULL},
543 	{(FVOID_STAR) copy_uint_to_long, uint_to_long},
544 	{(FVOID_STAR) copy_uint_to_ulong, uint_to_ulong},
545 	{(FVOID_STAR) copy_uint_to_float, uint_to_float},
546 	{(FVOID_STAR) copy_uint_to_double, uint_to_double},
547      },
548 
549      {
550 	{(FVOID_STAR) copy_long_to_char, NULL},
551 	{(FVOID_STAR) copy_long_to_uchar, NULL},
552 	{(FVOID_STAR) copy_long_to_short, NULL},
553 	{(FVOID_STAR) copy_long_to_ushort, NULL},
554 	{(FVOID_STAR) copy_long_to_int, NULL},
555 	{(FVOID_STAR) copy_long_to_uint, NULL},
556 	{(FVOID_STAR) copy_long_to_long, NULL},
557 	{(FVOID_STAR) copy_long_to_long, NULL},
558 	{(FVOID_STAR) copy_long_to_float, long_to_float},
559 	{(FVOID_STAR) copy_long_to_double, long_to_double},
560      },
561 
562      {
563 	{(FVOID_STAR) copy_ulong_to_char, NULL},
564 	{(FVOID_STAR) copy_ulong_to_uchar, NULL},
565 	{(FVOID_STAR) copy_ulong_to_short, NULL},
566 	{(FVOID_STAR) copy_ulong_to_ushort, NULL},
567 	{(FVOID_STAR) copy_ulong_to_int, NULL},
568 	{(FVOID_STAR) copy_ulong_to_uint, NULL},
569 	{(FVOID_STAR) copy_long_to_long, NULL},
570 	{(FVOID_STAR) copy_long_to_long, NULL},
571 	{(FVOID_STAR) copy_ulong_to_float, ulong_to_float},
572 	{(FVOID_STAR) copy_ulong_to_double, ulong_to_double},
573      },
574 
575      {
576 	{(FVOID_STAR) copy_float_to_char, NULL},
577 	{(FVOID_STAR) copy_float_to_uchar, NULL},
578 	{(FVOID_STAR) copy_float_to_short, NULL},
579 	{(FVOID_STAR) copy_float_to_ushort, NULL},
580 	{(FVOID_STAR) copy_float_to_int, NULL},
581 	{(FVOID_STAR) copy_float_to_uint, NULL},
582 	{(FVOID_STAR) copy_float_to_long, NULL},
583 	{(FVOID_STAR) copy_float_to_ulong, NULL},
584 	{(FVOID_STAR) copy_float_to_float, NULL},
585 	{(FVOID_STAR) copy_float_to_double, float_to_double},
586      },
587 
588      {
589 	{(FVOID_STAR) copy_double_to_char, NULL},
590 	{(FVOID_STAR) copy_double_to_uchar, NULL},
591 	{(FVOID_STAR) copy_double_to_short, NULL},
592 	{(FVOID_STAR) copy_double_to_ushort, NULL},
593 	{(FVOID_STAR) copy_double_to_int, NULL},
594 	{(FVOID_STAR) copy_double_to_uint, NULL},
595 	{(FVOID_STAR) copy_double_to_long, NULL},
596 	{(FVOID_STAR) copy_double_to_ulong, NULL},
597 	{(FVOID_STAR) copy_double_to_float, NULL},
598 	{(FVOID_STAR) copy_double_to_double, NULL},
599      }
600 };
601 
602 #define GENERIC_BINARY_FUNCTION int_int_bin_op
603 #define GENERIC_BIT_OPERATIONS
604 #define GENERIC_TYPE int
605 #define POW_FUNCTION(a,b) pow((double)(a),(double)(b))
606 #define POW_RESULT_TYPE double
607 #define ABS_FUNCTION abs
608 #define MOD_FUNCTION(a,b) ((a) % (b))
609 #define GENERIC_UNARY_FUNCTION int_unary_op
610 #define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0))
611 #if _SLANG_OPTIMIZE_FOR_SPEED
612 # define SCALAR_BINARY_FUNCTION int_int_scalar_bin_op
613 #endif
614 #define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_int_obj(SLANG_INT_TYPE,(x))
615 #define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x))
616 #define CMP_FUNCTION int_cmp_function
617 #include "slarith.inc"
618 
619 #define GENERIC_BINARY_FUNCTION uint_uint_bin_op
620 #define GENERIC_BIT_OPERATIONS
621 #define GENERIC_TYPE unsigned int
622 #define POW_FUNCTION(a,b) pow((double)(a),(double)(b))
623 #define POW_RESULT_TYPE double
624 #define MOD_FUNCTION(a,b) ((a) % (b))
625 #define GENERIC_UNARY_FUNCTION uint_unary_op
626 #define ABS_FUNCTION(a) (a)
627 #define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0)
628 #if _SLANG_OPTIMIZE_FOR_SPEED
629 # define SCALAR_BINARY_FUNCTION uint_uint_scalar_bin_op
630 #endif
631 #define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_int_obj(SLANG_UINT_TYPE,(int)(x))
632 #define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x))
633 #define CMP_FUNCTION uint_cmp_function
634 #include "slarith.inc"
635 
636 #if SIZEOF_LONG != SIZEOF_INT
637 #define GENERIC_BINARY_FUNCTION long_long_bin_op
638 #define GENERIC_BIT_OPERATIONS
639 #define GENERIC_TYPE long
640 #define POW_FUNCTION(a,b) pow((double)(a),(double)(b))
641 #define POW_RESULT_TYPE double
642 #define MOD_FUNCTION(a,b) ((a) % (b))
643 #define GENERIC_UNARY_FUNCTION long_unary_op
644 #define ABS_FUNCTION(a) (((a) >= 0) ? (a) : -(a))
645 #define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0))
646 #if _SLANG_OPTIMIZE_FOR_SPEED
647 # define SCALAR_BINARY_FUNCTION long_long_scalar_bin_op
648 #endif
649 #define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_long_obj(SLANG_LONG_TYPE,(x))
650 #define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x))
651 #define CMP_FUNCTION long_cmp_function
652 #include "slarith.inc"
653 
654 #define GENERIC_BINARY_FUNCTION ulong_ulong_bin_op
655 #define GENERIC_BIT_OPERATIONS
656 #define GENERIC_TYPE unsigned long
657 #define POW_FUNCTION(a,b) pow((double)(a),(double)(b))
658 #define POW_RESULT_TYPE double
659 #define MOD_FUNCTION(a,b) ((a) % (b))
660 #define GENERIC_UNARY_FUNCTION ulong_unary_op
661 #define ABS_FUNCTION(a) (a)
662 #define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0)
663 #if _SLANG_OPTIMIZE_FOR_SPEED
664 # define SCALAR_BINARY_FUNCTION ulong_ulong_scalar_bin_op
665 #endif
666 #define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_long_obj(SLANG_ULONG_TYPE,(long)(x))
667 #define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x))
668 #define CMP_FUNCTION ulong_cmp_function
669 #include "slarith.inc"
670 #else
671 #define long_long_bin_op	int_int_bin_op
672 #define ulong_ulong_bin_op	uint_uint_bin_op
673 #define long_unary_op		int_unary_op
674 #define ulong_unary_op		uint_unary_op
675 #define long_cmp_function	int_cmp_function
676 #define ulong_cmp_function	uint_cmp_function
677 #endif				       /* SIZEOF_INT != SIZEOF_LONG */
678 
679 #define GENERIC_BINARY_FUNCTION float_float_bin_op
680 #define GENERIC_TYPE float
681 #define POW_FUNCTION(a,b) (float)pow((double)(a),(double)(b))
682 #define POW_RESULT_TYPE float
683 #define MOD_FUNCTION(a,b) (float)fmod((a),(b))
684 #define GENERIC_UNARY_FUNCTION float_unary_op
685 #define ABS_FUNCTION(a) (float)fabs((double) a)
686 #define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0))
687 #if _SLANG_OPTIMIZE_FOR_SPEED
688 # define SCALAR_BINARY_FUNCTION float_float_scalar_bin_op
689 #endif
690 #define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_float_obj(SLANG_FLOAT_TYPE,(x))
691 #define PUSH_POW_OBJ_FUN(x) SLclass_push_float_obj(SLANG_FLOAT_TYPE, (x))
692 #define CMP_FUNCTION float_cmp_function
693 #include "slarith.inc"
694 
695 #define GENERIC_BINARY_FUNCTION double_double_bin_op
696 #define GENERIC_TYPE double
697 #define POW_FUNCTION(a,b) pow((double)(a),(double)(b))
698 #define POW_RESULT_TYPE double
699 #define MOD_FUNCTION(a,b) (float)fmod((a),(b))
700 #define GENERIC_UNARY_FUNCTION double_unary_op
701 #define ABS_FUNCTION(a) fabs(a)
702 #define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0))
703 #if _SLANG_OPTIMIZE_FOR_SPEED
704 # define SCALAR_BINARY_FUNCTION double_double_scalar_bin_op
705 #endif
706 #define PUSH_SCALAR_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE,(x))
707 #define PUSH_POW_OBJ_FUN(x) SLclass_push_double_obj(SLANG_DOUBLE_TYPE, (x))
708 #define CMP_FUNCTION double_cmp_function
709 #include "slarith.inc"
710 
711 #define GENERIC_UNARY_FUNCTION char_unary_op
712 #define GENERIC_BIT_OPERATIONS
713 #define GENERIC_TYPE signed char
714 #define ABS_FUNCTION abs
715 #define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0))
716 #define CMP_FUNCTION char_cmp_function
717 #include "slarith.inc"
718 
719 #define GENERIC_UNARY_FUNCTION uchar_unary_op
720 #define GENERIC_BIT_OPERATIONS
721 #define GENERIC_TYPE unsigned char
722 #define ABS_FUNCTION(x) (x)
723 #define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0)
724 #define CMP_FUNCTION uchar_cmp_function
725 #include "slarith.inc"
726 
727 #if SIZEOF_SHORT != SIZEOF_INT
728 #define GENERIC_UNARY_FUNCTION short_unary_op
729 #define GENERIC_BIT_OPERATIONS
730 #define GENERIC_TYPE short
731 #define ABS_FUNCTION abs
732 #define SIGN_FUNCTION(x) (((x) > 0) ? 1 : (((x) < 0) ? -1 : 0))
733 #define CMP_FUNCTION short_cmp_function
734 #include "slarith.inc"
735 
736 #define GENERIC_UNARY_FUNCTION ushort_unary_op
737 #define GENERIC_BIT_OPERATIONS
738 #define GENERIC_TYPE unsigned short
739 #define ABS_FUNCTION(x) (x)
740 #define SIGN_FUNCTION(x) (((x) > 0) ? 1 : 0)
741 #define CMP_FUNCTION ushort_cmp_function
742 #include "slarith.inc"
743 #endif				       /* SIZEOF_INT != SIZEOF_SHORT */
744 
745 /* Unfortunately, the numbers that were assigned to the data-types were
746  * not well thought out.  So, I need to use the following table.
747  */
748 #define MAXIMUM_ARITH_TYPE_VALUE	SLANG_FLOAT_TYPE
749 #define IS_INTEGER_TYPE(x) \
750   (((x) <= MAXIMUM_ARITH_TYPE_VALUE) \
751       && (Type_Precedence_Table[x] < 8) && (Type_Precedence_Table[x] != -1))
752 #define IS_ARITHMETIC_TYPE(x) \
753   (((x) <= MAXIMUM_ARITH_TYPE_VALUE) && (Type_Precedence_Table[x] != -1))
754 
755 #define LONG_PRECEDENCE_VALUE	6
756 #define FLOAT_PRECEDENCE_VALUE	8
757 
758 static signed char Type_Precedence_Table [MAXIMUM_ARITH_TYPE_VALUE + 1] =
759 {
760    -1,				       /* SLANG_UNDEFINED_TYPE */
761    -1,				       /* SLANG_VOID_TYPE */
762    4,				       /* SLANG_INT_TYPE */
763    9,				       /* SLANG_DOUBLE_TYPE */
764    0,				       /* SLANG_CHAR_TYPE */
765    -1,				       /* SLANG_INTP_TYPE */
766    -1,				       /* SLANG_REF_TYPE */
767    -1,				       /* SLANG_COMPLEX_TYPE */
768    -1,				       /* SLANG_NULL_TYPE */
769    1,				       /* SLANG_UCHAR_TYPE */
770    2,				       /* SLANG_SHORT_TYPE */
771    3,				       /* SLANG_USHORT_TYPE */
772    5,				       /* SLANG_UINT_TYPE */
773    6,				       /* SLANG_LONG_TYPE */
774    7,				       /* SLANG_ULONG_TYPE */
775    -1,				       /* SLANG_STRING_TYPE */
776    8				       /* SLANG_FLOAT_TYPE */
777 };
778 
_SLarith_get_precedence(unsigned char type)779 int _SLarith_get_precedence (unsigned char type)
780 {
781    if (type > MAXIMUM_ARITH_TYPE_VALUE)
782      return -1;
783 
784    return Type_Precedence_Table[type];
785 }
786 
_SLarith_promote_type(unsigned char t)787 unsigned char _SLarith_promote_type (unsigned char t)
788 {
789    switch (t)
790      {
791       case SLANG_FLOAT_TYPE:
792       case SLANG_DOUBLE_TYPE:
793       case SLANG_LONG_TYPE:
794       case SLANG_ULONG_TYPE:
795       case SLANG_INT_TYPE:
796       case SLANG_UINT_TYPE:
797 	break;
798 
799       case SLANG_USHORT_TYPE:
800 #if SIZEOF_INT == SIZEOF_SHORT
801 	t = SLANG_UINT_TYPE;
802 	break;
803 #endif
804 	/* drop */
805       case SLANG_CHAR_TYPE:
806       case SLANG_UCHAR_TYPE:
807       case SLANG_SHORT_TYPE:
808       default:
809 	t = SLANG_INT_TYPE;
810      }
811 
812    return t;
813 }
814 
promote_to_common_type(unsigned char a,unsigned char b)815 static unsigned char promote_to_common_type (unsigned char a, unsigned char b)
816 {
817    a = _SLarith_promote_type (a);
818    b = _SLarith_promote_type (b);
819 
820    return (Type_Precedence_Table[a] > Type_Precedence_Table[b]) ? a : b;
821 }
822 
arith_bin_op_result(int op,unsigned char a_type,unsigned char b_type,unsigned char * c_type)823 static int arith_bin_op_result (int op, unsigned char a_type, unsigned char b_type,
824 				unsigned char *c_type)
825 {
826    switch (op)
827      {
828       case SLANG_EQ:
829       case SLANG_NE:
830       case SLANG_GT:
831       case SLANG_GE:
832       case SLANG_LT:
833       case SLANG_LE:
834       case SLANG_OR:
835       case SLANG_AND:
836 	*c_type = SLANG_CHAR_TYPE;
837 	return 1;
838 
839       case SLANG_POW:
840 	if (SLANG_FLOAT_TYPE == promote_to_common_type (a_type, b_type))
841 	  *c_type = SLANG_FLOAT_TYPE;
842 	else
843 	  *c_type = SLANG_DOUBLE_TYPE;
844 	return 1;
845 
846       case SLANG_BAND:
847       case SLANG_BXOR:
848       case SLANG_BOR:
849       case SLANG_SHL:
850       case SLANG_SHR:
851 	/* The bit-level operations are defined just for integer types */
852 	if ((0 == IS_INTEGER_TYPE (a_type))
853 	    || (0 == IS_INTEGER_TYPE(b_type)))
854 	  return 0;
855 	break;
856 
857       default:
858 	break;
859      }
860 
861    *c_type = promote_to_common_type (a_type, b_type);
862    return 1;
863 }
864 
865 typedef int (*Bin_Fun_Type) (int,
866 			     unsigned char, VOID_STAR, unsigned int,
867 			     unsigned char, VOID_STAR, unsigned int,
868 			     VOID_STAR);
869 
870 /* This array of functions must be indexed by precedence after arithmetic
871  * promotions.
872  */
873 static Bin_Fun_Type Bin_Fun_Map [MAX_ARITHMETIC_TYPES] =
874 {
875    NULL,
876    NULL,
877    NULL,
878    NULL,
879    int_int_bin_op,
880    uint_uint_bin_op,
881    long_long_bin_op,
882    ulong_ulong_bin_op,
883    float_float_bin_op,
884    double_double_bin_op
885 };
886 
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)887 static int arith_bin_op (int op,
888 			 unsigned char a_type, VOID_STAR ap, unsigned int na,
889 			 unsigned char b_type, VOID_STAR bp, unsigned int nb,
890 			 VOID_STAR cp)
891 {
892    Convert_Fun_Type af, bf;
893    Bin_Fun_Type binfun;
894    int a_indx, b_indx, c_indx;
895    unsigned char c_type;
896    int ret;
897 
898    c_type = promote_to_common_type (a_type, b_type);
899 
900    a_indx = Type_Precedence_Table [a_type];
901    b_indx = Type_Precedence_Table [b_type];
902    c_indx = Type_Precedence_Table [c_type];
903 
904    af = Binary_Matrix[a_indx][c_indx].convert_function;
905    bf = Binary_Matrix[b_indx][c_indx].convert_function;
906    binfun = Bin_Fun_Map[c_indx];
907 
908    if ((af != NULL)
909        && (NULL == (ap = (VOID_STAR) (*af) (ap, na))))
910      return -1;
911 
912    if ((bf != NULL)
913        && (NULL == (bp = (VOID_STAR) (*bf) (bp, nb))))
914      {
915 	if (af != NULL) SLfree ((char *) ap);
916 	return -1;
917      }
918 
919    ret = (*binfun) (op, a_type, ap, na, b_type, bp, nb, cp);
920    if (af != NULL) SLfree ((char *) ap);
921    if (bf != NULL) SLfree ((char *) bp);
922 
923    return ret;
924 }
925 
arith_unary_op_result(int op,unsigned char a,unsigned char * b)926 static int arith_unary_op_result (int op, unsigned char a, unsigned char *b)
927 {
928    (void) a;
929    switch (op)
930      {
931       default:
932 	return 0;
933 
934       case SLANG_SQR:
935       case SLANG_MUL2:
936       case SLANG_PLUSPLUS:
937       case SLANG_MINUSMINUS:
938       case SLANG_CHS:
939       case SLANG_ABS:
940 	*b = a;
941 	break;
942 
943       case SLANG_NOT:
944       case SLANG_BNOT:
945 	if (0 == IS_INTEGER_TYPE(a))
946 	  return 0;
947 	*b = a;
948 	break;
949 
950       case SLANG_SIGN:
951 	*b = SLANG_INT_TYPE;
952 	break;
953      }
954    return 1;
955 }
956 
integer_pop(unsigned char type,VOID_STAR ptr)957 static int integer_pop (unsigned char type, VOID_STAR ptr)
958 {
959    SLang_Object_Type obj;
960    int i, j;
961    void (*f)(VOID_STAR, VOID_STAR, unsigned int);
962 
963    if (-1 == SLang_pop (&obj))
964      return -1;
965 
966    if ((obj.data_type > MAXIMUM_ARITH_TYPE_VALUE)
967        || ((j = Type_Precedence_Table[obj.data_type]) == -1)
968        || (j >= FLOAT_PRECEDENCE_VALUE))
969      {
970 	_SLclass_type_mismatch_error (type, obj.data_type);
971        	SLang_free_object (&obj);
972 	return -1;
973      }
974 
975    i = Type_Precedence_Table[type];
976    f = (void (*)(VOID_STAR, VOID_STAR, unsigned int))
977      Binary_Matrix[j][i].copy_function;
978 
979    (*f) (ptr, (VOID_STAR)&obj.v, 1);
980 
981    return 0;
982 }
983 
integer_push(unsigned char type,VOID_STAR ptr)984 static int integer_push (unsigned char type, VOID_STAR ptr)
985 {
986    SLang_Object_Type obj;
987    int i;
988    void (*f)(VOID_STAR, VOID_STAR, unsigned int);
989 
990    i = Type_Precedence_Table[type];
991    f = (void (*)(VOID_STAR, VOID_STAR, unsigned int))
992      Binary_Matrix[i][i].copy_function;
993 
994    obj.data_type = type;
995 
996    (*f) ((VOID_STAR)&obj.v, ptr, 1);
997 
998    return SLang_push (&obj);
999 }
1000 
SLang_pop_char(char * i)1001 int SLang_pop_char (char *i)
1002 {
1003    return integer_pop (SLANG_CHAR_TYPE, (VOID_STAR) i);
1004 }
1005 
SLang_pop_uchar(unsigned char * i)1006 int SLang_pop_uchar (unsigned char *i)
1007 {
1008    return integer_pop (SLANG_UCHAR_TYPE, (VOID_STAR) i);
1009 }
1010 
SLang_pop_short(short * i)1011 int SLang_pop_short (short *i)
1012 {
1013    return integer_pop (SLANG_SHORT_TYPE, (VOID_STAR) i);
1014 }
1015 
SLang_pop_ushort(unsigned short * i)1016 int SLang_pop_ushort (unsigned short *i)
1017 {
1018    return integer_pop (SLANG_USHORT_TYPE, (VOID_STAR) i);
1019 }
1020 
SLang_pop_long(long * i)1021 int SLang_pop_long (long *i)
1022 {
1023    return integer_pop (SLANG_LONG_TYPE, (VOID_STAR) i);
1024 }
1025 
SLang_pop_ulong(unsigned long * i)1026 int SLang_pop_ulong (unsigned long *i)
1027 {
1028    return integer_pop (SLANG_ULONG_TYPE, (VOID_STAR) i);
1029 }
1030 
SLang_pop_integer(int * i)1031 int SLang_pop_integer (int *i)
1032 {
1033 #if _SLANG_OPTIMIZE_FOR_SPEED
1034    SLang_Object_Type obj;
1035 
1036    if (-1 == _SLang_pop_object_of_type (SLANG_INT_TYPE, &obj, 0))
1037      return -1;
1038    *i = obj.v.int_val;
1039    return 0;
1040 #else
1041   return integer_pop (SLANG_INT_TYPE, (VOID_STAR) i);
1042 #endif
1043 }
1044 
SLang_pop_uinteger(unsigned int * i)1045 int SLang_pop_uinteger (unsigned int *i)
1046 {
1047    return integer_pop (SLANG_UINT_TYPE, (VOID_STAR) i);
1048 }
1049 
SLang_push_integer(int i)1050 int SLang_push_integer (int i)
1051 {
1052    return SLclass_push_int_obj (SLANG_INT_TYPE, i);
1053 }
SLang_push_uinteger(unsigned int i)1054 int SLang_push_uinteger (unsigned int i)
1055 {
1056    return SLclass_push_int_obj (SLANG_UINT_TYPE, (int) i);
1057 }
SLang_push_char(char i)1058 int SLang_push_char (char i)
1059 {
1060    return SLclass_push_char_obj (SLANG_CHAR_TYPE, i);
1061 }
SLang_push_uchar(unsigned char i)1062 int SLang_push_uchar (unsigned char i)
1063 {
1064    return SLclass_push_char_obj (SLANG_UCHAR_TYPE, (char) i);
1065 }
SLang_push_short(short i)1066 int SLang_push_short (short i)
1067 {
1068    return SLclass_push_short_obj (SLANG_SHORT_TYPE, i);
1069 }
SLang_push_ushort(unsigned short i)1070 int SLang_push_ushort (unsigned short i)
1071 {
1072    return SLclass_push_short_obj (SLANG_USHORT_TYPE, (unsigned short) i);
1073 }
SLang_push_long(long i)1074 int SLang_push_long (long i)
1075 {
1076    return SLclass_push_long_obj (SLANG_LONG_TYPE, i);
1077 }
SLang_push_ulong(unsigned long i)1078 int SLang_push_ulong (unsigned long i)
1079 {
1080    return SLclass_push_long_obj (SLANG_ULONG_TYPE, (long) i);
1081 }
1082 
1083 _INLINE_
_SLarith_typecast(unsigned char a_type,VOID_STAR ap,unsigned int na,unsigned char b_type,VOID_STAR bp)1084 int _SLarith_typecast (unsigned char a_type, VOID_STAR ap, unsigned int na,
1085 		       unsigned char b_type, VOID_STAR bp)
1086 {
1087    int i, j;
1088 
1089    void (*copy)(VOID_STAR, VOID_STAR, unsigned int);
1090 
1091    i = Type_Precedence_Table[a_type];
1092    j = Type_Precedence_Table[b_type];
1093 
1094    copy = (void (*)(VOID_STAR, VOID_STAR, unsigned int))
1095      Binary_Matrix[i][j].copy_function;
1096 
1097    (*copy) (bp, ap, na);
1098    return 1;
1099 }
1100 
1101 #if SLANG_HAS_FLOAT
1102 
SLang_pop_double(double * x,int * convertp,int * ip)1103 int SLang_pop_double(double *x, int *convertp, int *ip)
1104 {
1105    SLang_Object_Type obj;
1106    int i, convert;
1107 
1108    if (0 != SLang_pop (&obj))
1109      return -1;
1110 
1111    i = 0;
1112    convert = 0;
1113 
1114    switch (obj.data_type)
1115      {
1116       case SLANG_FLOAT_TYPE:
1117 	*x = (double) obj.v.float_val;
1118 	break;
1119 
1120       case SLANG_DOUBLE_TYPE:
1121 	*x = obj.v.double_val;
1122 	break;
1123 
1124       case SLANG_INT_TYPE:
1125 	i = (int) obj.v.long_val;
1126 	*x = (double) i;
1127 	convert = 1;
1128 	break;
1129 
1130       case SLANG_CHAR_TYPE: *x = (double) obj.v.char_val; break;
1131       case SLANG_UCHAR_TYPE: *x = (double) obj.v.uchar_val; break;
1132       case SLANG_SHORT_TYPE: *x = (double) obj.v.short_val; break;
1133       case SLANG_USHORT_TYPE: *x = (double) obj.v.ushort_val; break;
1134       case SLANG_UINT_TYPE: *x = (double) obj.v.uint_val; break;
1135       case SLANG_LONG_TYPE: *x = (double) obj.v.long_val; break;
1136       case SLANG_ULONG_TYPE: *x = (double) obj.v.ulong_val; break;
1137 
1138       default:
1139 	_SLclass_type_mismatch_error (SLANG_DOUBLE_TYPE, obj.data_type);
1140 	SLang_free_object (&obj);
1141 	return -1;
1142      }
1143 
1144    if (convertp != NULL) *convertp = convert;
1145    if (ip != NULL) *ip = i;
1146 
1147    return 0;
1148 }
1149 
SLang_push_double(double x)1150 int SLang_push_double (double x)
1151 {
1152    return SLclass_push_double_obj (SLANG_DOUBLE_TYPE, x);
1153 }
1154 
SLang_pop_float(float * x)1155 int SLang_pop_float (float *x)
1156 {
1157    double d;
1158 
1159    /* Pop it as a double and let the double function do all the typcasting */
1160    if (-1 == SLang_pop_double (&d, NULL, NULL))
1161      return -1;
1162 
1163    *x = (float) d;
1164    return 0;
1165 }
1166 
SLang_push_float(float f)1167 int SLang_push_float (float f)
1168 {
1169    return SLclass_push_float_obj (SLANG_FLOAT_TYPE, (double) f);
1170 }
1171 
1172 /* Double */
double_push(unsigned char unused,VOID_STAR ptr)1173 static int double_push (unsigned char unused, VOID_STAR ptr)
1174 {
1175    (void) unused;
1176    SLang_push_double (*(double *) ptr);
1177    return 0;
1178 }
1179 
double_push_literal(unsigned char type,VOID_STAR ptr)1180 static int double_push_literal (unsigned char type, VOID_STAR ptr)
1181 {
1182    (void) type;
1183    return SLang_push_double (**(double **)ptr);
1184 }
1185 
double_pop(unsigned char unused,VOID_STAR ptr)1186 static int double_pop (unsigned char unused, VOID_STAR ptr)
1187 {
1188    (void) unused;
1189    return SLang_pop_double ((double *) ptr, NULL, NULL);
1190 }
1191 
double_byte_code_destroy(unsigned char unused,VOID_STAR ptr)1192 static void double_byte_code_destroy (unsigned char unused, VOID_STAR ptr)
1193 {
1194    (void) unused;
1195    SLfree (*(char **) ptr);
1196 }
1197 
float_push(unsigned char unused,VOID_STAR ptr)1198 static int float_push (unsigned char unused, VOID_STAR ptr)
1199 {
1200    (void) unused;
1201    SLang_push_float (*(float *) ptr);
1202    return 0;
1203 }
1204 
float_pop(unsigned char unused,VOID_STAR ptr)1205 static int float_pop (unsigned char unused, VOID_STAR ptr)
1206 {
1207    (void) unused;
1208    return SLang_pop_float ((float *) ptr);
1209 }
1210 
1211 #endif				       /* SLANG_HAS_FLOAT */
1212 
1213 #if SLANG_HAS_FLOAT
1214 static char Double_Format[16] = "%g";
1215 
_SLset_double_format(char * s)1216 void _SLset_double_format (char *s)
1217 {
1218    strncpy (Double_Format, s, 15);
1219    Double_Format[15] = 0;
1220 }
1221 #endif
1222 
arith_string(unsigned char type,VOID_STAR v)1223 static char *arith_string (unsigned char type, VOID_STAR v)
1224 {
1225    char buf [256];
1226    char *s;
1227 
1228    s = buf;
1229 
1230    switch (type)
1231      {
1232       default:
1233 	s = SLclass_get_datatype_name (type);
1234 	break;
1235 
1236       case SLANG_CHAR_TYPE:
1237 	sprintf (s, "%d", *(char *) v);
1238 	break;
1239       case SLANG_UCHAR_TYPE:
1240 	sprintf (s, "%u", *(unsigned char *) v);
1241 	break;
1242       case SLANG_SHORT_TYPE:
1243 	sprintf (s, "%d", *(short *) v);
1244 	break;
1245       case SLANG_USHORT_TYPE:
1246 	sprintf (s, "%u", *(unsigned short *) v);
1247 	break;
1248       case SLANG_INT_TYPE:
1249 	sprintf (s, "%d", *(int *) v);
1250 	break;
1251       case SLANG_UINT_TYPE:
1252 	sprintf (s, "%u", *(unsigned int *) v);
1253 	break;
1254       case SLANG_LONG_TYPE:
1255 	sprintf (s, "%ld", *(long *) v);
1256 	break;
1257       case SLANG_ULONG_TYPE:
1258 	sprintf (s, "%lu", *(unsigned long *) v);
1259 	break;
1260 #if SLANG_HAS_FLOAT
1261       case SLANG_FLOAT_TYPE:
1262 	if (EOF == _SLsnprintf (buf, sizeof (buf), Double_Format, *(float *) v))
1263 	  sprintf (s, "%e", *(float *) v);
1264 	break;
1265       case SLANG_DOUBLE_TYPE:
1266 	if (EOF == _SLsnprintf (buf, sizeof (buf), Double_Format, *(double *) v))
1267 	  sprintf (s, "%e", *(double *) v);
1268 	break;
1269 #endif
1270      }
1271 
1272    return SLmake_string (s);
1273 }
1274 
integer_to_bool(unsigned char type,int * t)1275 static int integer_to_bool (unsigned char type, int *t)
1276 {
1277    (void) type;
1278    return SLang_pop_integer (t);
1279 }
1280 
push_int_literal(unsigned char type,VOID_STAR ptr)1281 static int push_int_literal (unsigned char type, VOID_STAR ptr)
1282 {
1283    return SLclass_push_int_obj (type, (int) *(long *) ptr);
1284 }
1285 
push_char_literal(unsigned char type,VOID_STAR ptr)1286 static int push_char_literal (unsigned char type, VOID_STAR ptr)
1287 {
1288    return SLclass_push_char_obj (type, (char) *(long *) ptr);
1289 }
1290 
1291 #if SIZEOF_SHORT != SIZEOF_INT
push_short_literal(unsigned char type,VOID_STAR ptr)1292 static int push_short_literal (unsigned char type, VOID_STAR ptr)
1293 {
1294    return SLclass_push_short_obj (type, (short) *(long *) ptr);
1295 }
1296 #endif
1297 
1298 #if SIZEOF_INT != SIZEOF_LONG
push_long_literal(unsigned char type,VOID_STAR ptr)1299 static int push_long_literal (unsigned char type, VOID_STAR ptr)
1300 {
1301    return SLclass_push_long_obj (type, *(long *) ptr);
1302 }
1303 #endif
1304 
1305 typedef struct
1306 {
1307    char *name;
1308    unsigned char data_type;
1309    unsigned int sizeof_type;
1310    int (*unary_fun)(int, unsigned char, VOID_STAR, unsigned int, VOID_STAR);
1311    int (*push_literal) (unsigned char, VOID_STAR);
1312    int (*cmp_fun) (unsigned char, VOID_STAR, VOID_STAR, int *);
1313 }
1314 Integer_Info_Type;
1315 
1316 static Integer_Info_Type Integer_Types [8] =
1317 {
1318      {"Char_Type", SLANG_CHAR_TYPE, sizeof (char), char_unary_op, push_char_literal, char_cmp_function},
1319      {"UChar_Type", SLANG_UCHAR_TYPE, sizeof (unsigned char), uchar_unary_op, push_char_literal, uchar_cmp_function},
1320 #if SIZEOF_INT != SIZEOF_SHORT
1321      {"Short_Type", SLANG_SHORT_TYPE, sizeof (short), short_unary_op, push_short_literal, short_cmp_function},
1322      {"UShort_Type", SLANG_USHORT_TYPE, sizeof (unsigned short), ushort_unary_op, push_short_literal, ushort_cmp_function},
1323 #else
1324      {NULL, SLANG_SHORT_TYPE},
1325      {NULL, SLANG_USHORT_TYPE},
1326 #endif
1327 
1328      {"Integer_Type", SLANG_INT_TYPE, sizeof (int), int_unary_op, push_int_literal, int_cmp_function},
1329      {"UInteger_Type", SLANG_UINT_TYPE, sizeof (unsigned int), uint_unary_op, push_int_literal, uint_cmp_function},
1330 
1331 #if SIZEOF_INT != SIZEOF_LONG
1332      {"Long_Type", SLANG_LONG_TYPE, sizeof (long), long_unary_op, push_long_literal, long_cmp_function},
1333      {"ULong_Type", SLANG_ULONG_TYPE, sizeof (unsigned long), ulong_unary_op, push_long_literal, ulong_cmp_function}
1334 #else
1335      {NULL, SLANG_LONG_TYPE, 0, NULL, NULL, NULL},
1336      {NULL, SLANG_ULONG_TYPE, 0, NULL, NULL, NULL}
1337 #endif
1338 };
1339 
create_synonyms(void)1340 static int create_synonyms (void)
1341 {
1342    static char *names[8] =
1343      {
1344 	"Int16_Type", "UInt16_Type", "Int32_Type", "UInt32_Type",
1345 	"Int64_Type", "UInt64_Type",
1346 	"Float32_Type", "Float64_Type"
1347      };
1348    int types[8];
1349    unsigned int i;
1350 
1351    memset ((char *) types, 0, sizeof (types));
1352 
1353    /* The assumption is that sizeof(unsigned X) == sizeof (X) */
1354 #if SIZEOF_INT == 2
1355    types[0] = SLANG_INT_TYPE;
1356    types[1] = SLANG_UINT_TYPE;
1357 #else
1358 # if SIZEOF_SHORT == 2
1359    types[0] = SLANG_SHORT_TYPE;
1360    types[1] = SLANG_USHORT_TYPE;
1361 # else
1362 #  if SIZEOF_LONG == 2
1363    types[0] = SLANG_LONG_TYPE;
1364    types[1] = SLANG_ULONG_TYPE;
1365 #  endif
1366 # endif
1367 #endif
1368 
1369 #if SIZEOF_INT == 4
1370    types[2] = SLANG_INT_TYPE;
1371    types[3] = SLANG_UINT_TYPE;
1372 #else
1373 # if SIZEOF_SHORT == 4
1374    types[2] = SLANG_SHORT_TYPE;
1375    types[3] = SLANG_USHORT_TYPE;
1376 # else
1377 #  if SIZEOF_LONG == 4
1378    types[2] = SLANG_LONG_TYPE;
1379    types[3] = SLANG_ULONG_TYPE;
1380 #  endif
1381 # endif
1382 #endif
1383 
1384 #if SIZEOF_INT == 8
1385    types[4] = SLANG_INT_TYPE;
1386    types[5] = SLANG_UINT_TYPE;
1387 #else
1388 # if SIZEOF_SHORT == 8
1389    types[4] = SLANG_SHORT_TYPE;
1390    types[5] = SLANG_USHORT_TYPE;
1391 # else
1392 #  if SIZEOF_LONG == 8
1393    types[4] = SLANG_LONG_TYPE;
1394    types[5] = SLANG_ULONG_TYPE;
1395 #  endif
1396 # endif
1397 #endif
1398 
1399 #if SLANG_HAS_FLOAT
1400 
1401 #if SIZEOF_FLOAT == 4
1402    types[6] = SLANG_FLOAT_TYPE;
1403 #else
1404 # if SIZEOF_DOUBLE == 4
1405    types[6] = SLANG_DOUBLE_TYPE;
1406 # endif
1407 #endif
1408 #if SIZEOF_FLOAT == 8
1409    types[7] = SLANG_FLOAT_TYPE;
1410 #else
1411 # if SIZEOF_DOUBLE == 8
1412    types[7] = SLANG_DOUBLE_TYPE;
1413 # endif
1414 #endif
1415 
1416 #endif
1417 
1418    if ((-1 == SLclass_create_synonym ("Int_Type", SLANG_INT_TYPE))
1419        || (-1 == SLclass_create_synonym ("UInt_Type", SLANG_UINT_TYPE)))
1420      return -1;
1421 
1422    for (i = 0; i < 8; i++)
1423      {
1424 	if (types[i] == 0) continue;
1425 
1426 	if (-1 == SLclass_create_synonym (names[i], types[i]))
1427 	  return -1;
1428      }
1429 
1430 #if SIZEOF_INT == SIZEOF_SHORT
1431    if ((-1 == SLclass_create_synonym ("Short_Type", SLANG_INT_TYPE))
1432        || (-1 == SLclass_create_synonym ("UShort_Type", SLANG_UINT_TYPE))
1433        || (-1 == _SLclass_copy_class (SLANG_SHORT_TYPE, SLANG_INT_TYPE))
1434        || (-1 == _SLclass_copy_class (SLANG_USHORT_TYPE, SLANG_UINT_TYPE)))
1435      return -1;
1436 #endif
1437 #if SIZEOF_INT == SIZEOF_LONG
1438    if ((-1 == SLclass_create_synonym ("Long_Type", SLANG_INT_TYPE))
1439        || (-1 == SLclass_create_synonym ("ULong_Type", SLANG_UINT_TYPE))
1440        || (-1 == _SLclass_copy_class (SLANG_LONG_TYPE, SLANG_INT_TYPE))
1441        || (-1 == _SLclass_copy_class (SLANG_ULONG_TYPE, SLANG_UINT_TYPE)))
1442      return -1;
1443 #endif
1444    return 0;
1445 }
1446 
_SLarith_register_types(void)1447 int _SLarith_register_types (void)
1448 {
1449    SLang_Class_Type *cl;
1450    int a_type, b_type;
1451    int i, j;
1452 
1453 #if defined(HAVE_SETLOCALE) && defined(LC_NUMERIC)
1454    /* make sure decimal point it used --- the parser requires it */
1455    (void) setlocale (LC_NUMERIC, "C");
1456 #endif
1457 
1458    for (i = 0; i < 8; i++)
1459      {
1460 	Integer_Info_Type *info;
1461 
1462 	info = Integer_Types + i;
1463 
1464 	if (info->name == NULL)
1465 	  {
1466 	     /* This happens when the object is the same size as an integer
1467 	      * For this case, we really want to copy the integer class.
1468 	      * We will handle that when the synonym is created.
1469 	      */
1470 	     continue;
1471 	  }
1472 
1473 	if (NULL == (cl = SLclass_allocate_class (info->name)))
1474 	  return -1;
1475 
1476 	(void) SLclass_set_string_function (cl, arith_string);
1477 	(void) SLclass_set_push_function (cl, integer_push);
1478 	(void) SLclass_set_pop_function (cl, integer_pop);
1479 	cl->cl_push_literal = info->push_literal;
1480 	cl->cl_to_bool = integer_to_bool;
1481 
1482 	cl->cl_cmp = info->cmp_fun;
1483 
1484 	if (-1 == SLclass_register_class (cl, info->data_type, info->sizeof_type,
1485 					  SLANG_CLASS_TYPE_SCALAR))
1486 	  return -1;
1487 	if (-1 == SLclass_add_unary_op (info->data_type, info->unary_fun, arith_unary_op_result))
1488 	  return -1;
1489 
1490 	_SLarith_Is_Arith_Type [info->data_type] = 1;
1491      }
1492 
1493 #if SLANG_HAS_FLOAT
1494    if (NULL == (cl = SLclass_allocate_class ("Double_Type")))
1495      return -1;
1496    (void) SLclass_set_push_function (cl, double_push);
1497    (void) SLclass_set_pop_function (cl, double_pop);
1498    (void) SLclass_set_string_function (cl, arith_string);
1499    cl->cl_byte_code_destroy = double_byte_code_destroy;
1500    cl->cl_push_literal = double_push_literal;
1501    cl->cl_cmp = double_cmp_function;
1502 
1503    if (-1 == SLclass_register_class (cl, SLANG_DOUBLE_TYPE, sizeof (double),
1504 				     SLANG_CLASS_TYPE_SCALAR))
1505      return -1;
1506    if (-1 == SLclass_add_unary_op (SLANG_DOUBLE_TYPE, double_unary_op, arith_unary_op_result))
1507      return -1;
1508    _SLarith_Is_Arith_Type [SLANG_DOUBLE_TYPE] = 2;
1509 
1510    if (NULL == (cl = SLclass_allocate_class ("Float_Type")))
1511      return -1;
1512    (void) SLclass_set_string_function (cl, arith_string);
1513    (void) SLclass_set_push_function (cl, float_push);
1514    (void) SLclass_set_pop_function (cl, float_pop);
1515    cl->cl_cmp = float_cmp_function;
1516 
1517    if (-1 == SLclass_register_class (cl, SLANG_FLOAT_TYPE, sizeof (float),
1518 				     SLANG_CLASS_TYPE_SCALAR))
1519      return -1;
1520    if (-1 == SLclass_add_unary_op (SLANG_FLOAT_TYPE, float_unary_op, arith_unary_op_result))
1521      return -1;
1522    _SLarith_Is_Arith_Type [SLANG_FLOAT_TYPE] = 2;
1523 #endif
1524 
1525    if (-1 == create_synonyms ())
1526      return -1;
1527 
1528    for (a_type = 0; a_type <= MAXIMUM_ARITH_TYPE_VALUE; a_type++)
1529      {
1530 	if (-1 == (i = Type_Precedence_Table [a_type]))
1531 	  continue;
1532 
1533 	for (b_type = 0; b_type <= MAXIMUM_ARITH_TYPE_VALUE; b_type++)
1534 	  {
1535 	     int implicit_ok;
1536 
1537 	     if (-1 == (j = Type_Precedence_Table [b_type]))
1538 	       continue;
1539 
1540 	     /* Allow implicit typecast, except from into to float */
1541 	     implicit_ok = ((j >= FLOAT_PRECEDENCE_VALUE)
1542 			    || (i < FLOAT_PRECEDENCE_VALUE));
1543 
1544 	     if (-1 == SLclass_add_binary_op (a_type, b_type, arith_bin_op, arith_bin_op_result))
1545 	       return -1;
1546 
1547 	     if (i != j)
1548 	       if (-1 == SLclass_add_typecast (a_type, b_type, _SLarith_typecast, implicit_ok))
1549 		 return -1;
1550 	  }
1551      }
1552 
1553    return 0;
1554 }
1555 
1556 #if _SLANG_OPTIMIZE_FOR_SPEED
1557 
promote_objs(SLang_Object_Type * a,SLang_Object_Type * b,SLang_Object_Type * c,SLang_Object_Type * d)1558 static void promote_objs (SLang_Object_Type *a, SLang_Object_Type *b,
1559 			  SLang_Object_Type *c, SLang_Object_Type *d)
1560 {
1561    unsigned char ia, ib, ic, id;
1562    int i, j;
1563    void (*copy)(VOID_STAR, VOID_STAR, unsigned int);
1564 
1565    ia = a->data_type;
1566    ib = b->data_type;
1567 
1568    ic = _SLarith_promote_type (ia);
1569 
1570    if (ic == ib) id = ic;	       /* already promoted */
1571    else id = _SLarith_promote_type (ib);
1572 
1573    i = Type_Precedence_Table[ic];
1574    j = Type_Precedence_Table[id];
1575    if (i > j)
1576      {
1577 	id = ic;
1578 	j = i;
1579      }
1580 
1581    c->data_type = d->data_type = id;
1582 
1583    i = Type_Precedence_Table[ia];
1584    copy = (void (*)(VOID_STAR, VOID_STAR, unsigned int))
1585      Binary_Matrix[i][j].copy_function;
1586    (*copy) ((VOID_STAR) &c->v, (VOID_STAR)&a->v, 1);
1587 
1588    i = Type_Precedence_Table[ib];
1589    copy = (void (*)(VOID_STAR, VOID_STAR, unsigned int))
1590      Binary_Matrix[i][j].copy_function;
1591    (*copy) ((VOID_STAR) &d->v, (VOID_STAR)&b->v, 1);
1592 }
1593 
_SLarith_bin_op(SLang_Object_Type * oa,SLang_Object_Type * ob,int op)1594 int _SLarith_bin_op (SLang_Object_Type *oa, SLang_Object_Type *ob, int op)
1595 {
1596    unsigned char a_type, b_type;
1597 
1598    a_type = oa->data_type;
1599    b_type = ob->data_type;
1600 
1601    if (a_type != b_type)
1602      {
1603 	SLang_Object_Type obj_a, obj_b;
1604 
1605 	/* Handle common cases */
1606 	if ((a_type == SLANG_INT_TYPE)
1607 	    && (b_type == SLANG_DOUBLE_TYPE))
1608 	  return double_double_scalar_bin_op (oa->v.int_val, ob->v.double_val, op);
1609 
1610 	if ((a_type == SLANG_DOUBLE_TYPE)
1611 	    && (b_type == SLANG_INT_TYPE))
1612 	  return double_double_scalar_bin_op (oa->v.double_val, ob->v.int_val, op);
1613 
1614 	/* Otherwise do it the hard way */
1615 	promote_objs (oa, ob, &obj_a, &obj_b);
1616 	oa = &obj_a;
1617 	ob = &obj_b;
1618 
1619 	a_type = oa->data_type;
1620 	/* b_type = ob->data_type; */
1621      }
1622 
1623 
1624    switch (a_type)
1625      {
1626       case SLANG_CHAR_TYPE:
1627 	return int_int_scalar_bin_op (oa->v.char_val, ob->v.char_val, op);
1628 
1629       case SLANG_UCHAR_TYPE:
1630 	return int_int_scalar_bin_op (oa->v.uchar_val, ob->v.uchar_val, op);
1631 
1632       case SLANG_SHORT_TYPE:
1633 	return int_int_scalar_bin_op (oa->v.short_val, ob->v.short_val, op);
1634 
1635       case SLANG_USHORT_TYPE:
1636 # if SIZEOF_INT == SIZEOF_SHORT
1637 	return uint_uint_scalar_bin_op (oa->v.ushort_val, ob->v.ushort_val, op);
1638 # else
1639 	return int_int_scalar_bin_op ((int)oa->v.ushort_val, (int)ob->v.ushort_val, op);
1640 # endif
1641 
1642 #if SIZEOF_LONG == SIZEOF_INT
1643       case SLANG_LONG_TYPE:
1644 #endif
1645       case SLANG_INT_TYPE:
1646 	return int_int_scalar_bin_op (oa->v.int_val, ob->v.int_val, op);
1647 
1648 #if SIZEOF_LONG == SIZEOF_INT
1649       case SLANG_ULONG_TYPE:
1650 #endif
1651       case SLANG_UINT_TYPE:
1652 	return uint_uint_scalar_bin_op (oa->v.uint_val, ob->v.uint_val, op);
1653 
1654 #if SIZEOF_LONG != SIZEOF_INT
1655       case SLANG_LONG_TYPE:
1656 	return long_long_scalar_bin_op (oa->v.long_val, ob->v.long_val, op);
1657       case SLANG_ULONG_TYPE:
1658 	return ulong_ulong_scalar_bin_op (oa->v.ulong_val, ob->v.ulong_val, op);
1659 #endif
1660       case SLANG_FLOAT_TYPE:
1661 	return float_float_scalar_bin_op (oa->v.float_val, ob->v.float_val, op);
1662       case SLANG_DOUBLE_TYPE:
1663 	return double_double_scalar_bin_op (oa->v.double_val, ob->v.double_val, op);
1664      }
1665 
1666    return 1;
1667 }
1668 #endif
1669