1 /* Copyright (C) 2001-2006 Artifex Software, Inc.
2 All Rights Reserved.
3
4 This software is provided AS-IS with no warranty, either express or
5 implied.
6
7 This software is distributed under license and may not be copied, modified
8 or distributed except as expressly authorized under the terms of that
9 license. Refer to licensing information at http://www.artifex.com/
10 or contact Artifex Software, Inc., 7 Mt. Lassen Drive - Suite A-134,
11 San Rafael, CA 94903, U.S.A., +1(415)492-9861, for further information.
12 */
13
14 /* $Id: zarith.c 9778 2009-06-05 05:55:54Z alexcher $ */
15 /* Arithmetic operators */
16 #include "math_.h"
17 #include "ghost.h"
18 #include "oper.h"
19 #include "store.h"
20
21 /****** NOTE: none of the arithmetic operators ******/
22 /****** currently check for floating exceptions ******/
23
24 /*
25 * Many of the procedures in this file are public only so they can be
26 * called from the FunctionType 4 interpreter (zfunc4.c).
27 */
28
29 /* Define max and min values for what will fit in value.intval. */
30 #define MIN_INTVAL 0x80000000
31 #define MAX_INTVAL 0x7fffffff
32 #define MAX_HALF_INTVAL 0x7fff
33
34 /* <num1> <num2> add <sum> */
35 /* We make this into a separate procedure because */
36 /* the interpreter will almost always call it directly. */
37 int
zop_add(register os_ptr op)38 zop_add(register os_ptr op)
39 {
40 switch (r_type(op)) {
41 default:
42 return_op_typecheck(op);
43 case t_real:
44 switch (r_type(op - 1)) {
45 default:
46 return_op_typecheck(op - 1);
47 case t_real:
48 op[-1].value.realval += op->value.realval;
49 break;
50 case t_integer:
51 make_real(op - 1, (double)op[-1].value.intval + op->value.realval);
52 }
53 break;
54 case t_integer:
55 switch (r_type(op - 1)) {
56 default:
57 return_op_typecheck(op - 1);
58 case t_real:
59 op[-1].value.realval += (double)op->value.intval;
60 break;
61 case t_integer: {
62 int int2 = op->value.intval;
63
64 if (((op[-1].value.intval += int2) ^ int2) < 0 &&
65 ((op[-1].value.intval - int2) ^ int2) >= 0
66 ) { /* Overflow, convert to real */
67 make_real(op - 1, (double)(op[-1].value.intval - int2) + int2);
68 }
69 }
70 }
71 }
72 return 0;
73 }
74 int
zadd(i_ctx_t * i_ctx_p)75 zadd(i_ctx_t *i_ctx_p)
76 {
77 os_ptr op = osp;
78 int code = zop_add(op);
79
80 if (code == 0) {
81 pop(1);
82 }
83 return code;
84 }
85
86 /* <num1> <num2> div <real_quotient> */
87 int
zdiv(i_ctx_t * i_ctx_p)88 zdiv(i_ctx_t *i_ctx_p)
89 {
90 os_ptr op = osp;
91 os_ptr op1 = op - 1;
92
93 /* We can't use the non_int_cases macro, */
94 /* because we have to check explicitly for op == 0. */
95 switch (r_type(op)) {
96 default:
97 return_op_typecheck(op);
98 case t_real:
99 if (op->value.realval == 0)
100 return_error(e_undefinedresult);
101 switch (r_type(op1)) {
102 default:
103 return_op_typecheck(op1);
104 case t_real:
105 op1->value.realval /= op->value.realval;
106 break;
107 case t_integer:
108 make_real(op1, (double)op1->value.intval / op->value.realval);
109 }
110 break;
111 case t_integer:
112 if (op->value.intval == 0)
113 return_error(e_undefinedresult);
114 switch (r_type(op1)) {
115 default:
116 return_op_typecheck(op1);
117 case t_real:
118 op1->value.realval /= (double)op->value.intval;
119 break;
120 case t_integer:
121 make_real(op1, (double)op1->value.intval / (double)op->value.intval);
122 }
123 }
124 pop(1);
125 return 0;
126 }
127
128 /* <num1> <num2> mul <product> */
129 int
zmul(i_ctx_t * i_ctx_p)130 zmul(i_ctx_t *i_ctx_p)
131 {
132 os_ptr op = osp;
133
134 switch (r_type(op)) {
135 default:
136 return_op_typecheck(op);
137 case t_real:
138 switch (r_type(op - 1)) {
139 default:
140 return_op_typecheck(op - 1);
141 case t_real:
142 op[-1].value.realval *= op->value.realval;
143 break;
144 case t_integer:
145 make_real(op - 1, (double)op[-1].value.intval * op->value.realval);
146 }
147 break;
148 case t_integer:
149 switch (r_type(op - 1)) {
150 default:
151 return_op_typecheck(op - 1);
152 case t_real:
153 op[-1].value.realval *= (double)op->value.intval;
154 break;
155 case t_integer: {
156 int int1 = op[-1].value.intval;
157 int int2 = op->value.intval;
158 uint abs1 = (uint)(int1 >= 0 ? int1 : -int1);
159 uint abs2 = (uint)(int2 >= 0 ? int2 : -int2);
160 float fprod;
161
162 if ((abs1 > MAX_HALF_INTVAL || abs2 > MAX_HALF_INTVAL) &&
163 /* At least one of the operands is very large. */
164 /* Check for integer overflow. */
165 abs1 != 0 &&
166 abs2 > MAX_INTVAL / abs1 &&
167 /* Check for the boundary case */
168 (fprod = (float)int1 * int2,
169 (int1 * int2 != MIN_INTVAL ||
170 fprod != (float)MIN_INTVAL))
171 )
172 make_real(op - 1, fprod);
173 else
174 op[-1].value.intval = int1 * int2;
175 }
176 }
177 }
178 pop(1);
179 return 0;
180 }
181
182 /* <num1> <num2> sub <difference> */
183 /* We make this into a separate procedure because */
184 /* the interpreter will almost always call it directly. */
185 int
zop_sub(register os_ptr op)186 zop_sub(register os_ptr op)
187 {
188 switch (r_type(op)) {
189 default:
190 return_op_typecheck(op);
191 case t_real:
192 switch (r_type(op - 1)) {
193 default:
194 return_op_typecheck(op - 1);
195 case t_real:
196 op[-1].value.realval -= op->value.realval;
197 break;
198 case t_integer:
199 make_real(op - 1, (double)op[-1].value.intval - op->value.realval);
200 }
201 break;
202 case t_integer:
203 switch (r_type(op - 1)) {
204 default:
205 return_op_typecheck(op - 1);
206 case t_real:
207 op[-1].value.realval -= (double)op->value.intval;
208 break;
209 case t_integer: {
210 int int1 = op[-1].value.intval;
211
212 if ((int1 ^ (op[-1].value.intval = int1 - op->value.intval)) < 0 &&
213 (int1 ^ op->value.intval) < 0
214 ) { /* Overflow, convert to real */
215 make_real(op - 1, (float)int1 - op->value.intval);
216 }
217 }
218 }
219 }
220 return 0;
221 }
222 int
zsub(i_ctx_t * i_ctx_p)223 zsub(i_ctx_t *i_ctx_p)
224 {
225 os_ptr op = osp;
226 int code = zop_sub(op);
227
228 if (code == 0) {
229 pop(1);
230 }
231 return code;
232 }
233
234 /* <num1> <num2> idiv <int_quotient> */
235 int
zidiv(i_ctx_t * i_ctx_p)236 zidiv(i_ctx_t *i_ctx_p)
237 {
238 os_ptr op = osp;
239
240 check_type(*op, t_integer);
241 check_type(op[-1], t_integer);
242 if ((op->value.intval == 0) || (op[-1].value.intval == MIN_INTVAL && op->value.intval == -1)) {
243 /* Anomalous boundary case: -MININT / -1, fail. */
244 return_error(e_undefinedresult);
245 }
246 op[-1].value.intval /= op->value.intval;
247 pop(1);
248 return 0;
249 }
250
251 /* <int1> <int2> mod <remainder> */
252 int
zmod(i_ctx_t * i_ctx_p)253 zmod(i_ctx_t *i_ctx_p)
254 {
255 os_ptr op = osp;
256
257 check_type(*op, t_integer);
258 check_type(op[-1], t_integer);
259 if (op->value.intval == 0)
260 return_error(e_undefinedresult);
261 op[-1].value.intval %= op->value.intval;
262 pop(1);
263 return 0;
264 }
265
266 /* <num1> neg <num2> */
267 int
zneg(i_ctx_t * i_ctx_p)268 zneg(i_ctx_t *i_ctx_p)
269 {
270 os_ptr op = osp;
271
272 switch (r_type(op)) {
273 default:
274 return_op_typecheck(op);
275 case t_real:
276 op->value.realval = -op->value.realval;
277 break;
278 case t_integer:
279 if (op->value.intval == MIN_INTVAL)
280 make_real(op, -(float)MIN_INTVAL);
281 else
282 op->value.intval = -op->value.intval;
283 }
284 return 0;
285 }
286
287 /* <num1> abs <num2> */
288 int
zabs(i_ctx_t * i_ctx_p)289 zabs(i_ctx_t *i_ctx_p)
290 {
291 os_ptr op = osp;
292
293 switch (r_type(op)) {
294 default:
295 return_op_typecheck(op);
296 case t_real:
297 if (op->value.realval >= 0)
298 return 0;
299 break;
300 case t_integer:
301 if (op->value.intval >= 0)
302 return 0;
303 break;
304 }
305 return zneg(i_ctx_p);
306 }
307
308 /* <num1> ceiling <num2> */
309 int
zceiling(i_ctx_t * i_ctx_p)310 zceiling(i_ctx_t *i_ctx_p)
311 {
312 os_ptr op = osp;
313
314 switch (r_type(op)) {
315 default:
316 return_op_typecheck(op);
317 case t_real:
318 op->value.realval = ceil(op->value.realval);
319 case t_integer:;
320 }
321 return 0;
322 }
323
324 /* <num1> floor <num2> */
325 int
zfloor(i_ctx_t * i_ctx_p)326 zfloor(i_ctx_t *i_ctx_p)
327 {
328 os_ptr op = osp;
329
330 switch (r_type(op)) {
331 default:
332 return_op_typecheck(op);
333 case t_real:
334 op->value.realval = floor(op->value.realval);
335 case t_integer:;
336 }
337 return 0;
338 }
339
340 /* <num1> round <num2> */
341 int
zround(i_ctx_t * i_ctx_p)342 zround(i_ctx_t *i_ctx_p)
343 {
344 os_ptr op = osp;
345
346 switch (r_type(op)) {
347 default:
348 return_op_typecheck(op);
349 case t_real:
350 op->value.realval = floor(op->value.realval + 0.5);
351 case t_integer:;
352 }
353 return 0;
354 }
355
356 /* <num1> truncate <num2> */
357 int
ztruncate(i_ctx_t * i_ctx_p)358 ztruncate(i_ctx_t *i_ctx_p)
359 {
360 os_ptr op = osp;
361
362 switch (r_type(op)) {
363 default:
364 return_op_typecheck(op);
365 case t_real:
366 op->value.realval =
367 (op->value.realval < 0.0 ?
368 ceil(op->value.realval) :
369 floor(op->value.realval));
370 case t_integer:;
371 }
372 return 0;
373 }
374
375 /* Non-standard operators */
376
377 /* <int1> <int2> .bitadd <sum> */
378 static int
zbitadd(i_ctx_t * i_ctx_p)379 zbitadd(i_ctx_t *i_ctx_p)
380 {
381 os_ptr op = osp;
382
383 check_type(*op, t_integer);
384 check_type(op[-1], t_integer);
385 op[-1].value.intval += op->value.intval;
386 pop(1);
387 return 0;
388 }
389
390 /* ------ Initialization table ------ */
391
392 const op_def zarith_op_defs[] =
393 {
394 {"1abs", zabs},
395 {"2add", zadd},
396 {"2.bitadd", zbitadd},
397 {"1ceiling", zceiling},
398 {"2div", zdiv},
399 {"2idiv", zidiv},
400 {"1floor", zfloor},
401 {"2mod", zmod},
402 {"2mul", zmul},
403 {"1neg", zneg},
404 {"1round", zround},
405 {"2sub", zsub},
406 {"1truncate", ztruncate},
407 op_def_end(0)
408 };
409