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