Subversion Repositories planix.SVN

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 - 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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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 
};