xref: /plan9-contrib/sys/src/cmd/gs/src/zmath.c (revision 9a747e4fd48b9f4522c70c07e8f882a15030f964)
1 /* Copyright (C) 1989, 1992, 1993, 1997, 1998, 1999 Aladdin Enterprises.  All rights reserved.
2 
3    This file is part of Aladdin Ghostscript.
4 
5    Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
6    or distributor accepts any responsibility for the consequences of using it,
7    or for whether it serves any particular purpose or works at all, unless he
8    or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
9    License (the "License") for full details.
10 
11    Every copy of Aladdin Ghostscript must include a copy of the License,
12    normally in a plain ASCII text file named PUBLIC.  The License grants you
13    the right to copy, modify and redistribute Aladdin Ghostscript, but only
14    under certain conditions described in the License.  Among other things, the
15    License requires that the copyright notice and this notice be preserved on
16    all copies.
17  */
18 
19 /*$Id: zmath.c,v 1.1 2000/03/09 08:40:45 lpd Exp $ */
20 /* Mathematical operators */
21 #include "math_.h"
22 #include "ghost.h"
23 #include "gxfarith.h"
24 #include "oper.h"
25 #include "store.h"
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 /*
33  * Define the current state of random number generator for operators.  We
34  * have to implement this ourselves because the Unix rand doesn't provide
35  * anything equivalent to rrand.  Note that the value always lies in the
36  * range [0..0x7ffffffe], even if longs are longer than 32 bits.
37  *
38  * The state must be public so that context switching can save and
39  * restore it.  (Even though the Red Book doesn't mention this,
40  * we verified with Adobe that this is the case.)
41  */
42 #define zrand_state (i_ctx_p->rand_state)
43 
44 /* Initialize the random number generator. */
45 const long rand_state_initial = 1;
46 
47 /****** NOTE: none of these operators currently ******/
48 /****** check for floating over- or underflow.	******/
49 
50 /* <num> sqrt <real> */
51 int
52 zsqrt(i_ctx_t *i_ctx_p)
53 {
54     os_ptr op = osp;
55     double num;
56     int code = real_param(op, &num);
57 
58     if (code < 0)
59 	return code;
60     if (num < 0.0)
61 	return_error(e_rangecheck);
62     make_real(op, sqrt(num));
63     return 0;
64 }
65 
66 /* <num> arccos <real> */
67 private int
68 zarccos(i_ctx_t *i_ctx_p)
69 {
70     os_ptr op = osp;
71     double num, result;
72     int code = real_param(op, &num);
73 
74     if (code < 0)
75 	return code;
76     result = acos(num) * radians_to_degrees;
77     make_real(op, result);
78     return 0;
79 }
80 
81 /* <num> arcsin <real> */
82 private int
83 zarcsin(i_ctx_t *i_ctx_p)
84 {
85     os_ptr op = osp;
86     double num, result;
87     int code = real_param(op, &num);
88 
89     if (code < 0)
90 	return code;
91     result = asin(num) * radians_to_degrees;
92     make_real(op, result);
93     return 0;
94 }
95 
96 /* <num> <denom> atan <real> */
97 int
98 zatan(i_ctx_t *i_ctx_p)
99 {
100     os_ptr op = osp;
101     double args[2];
102     double result;
103     int code = num_params(op, 2, args);
104 
105     if (code < 0)
106 	return code;
107     if (args[0] == 0) {		/* on X-axis, special case */
108 	if (args[1] == 0)
109 	    return_error(e_undefinedresult);
110 	result = (args[1] < 0 ? 180 : 0);
111     } else {
112 	result = atan2(args[0], args[1]) * radians_to_degrees;
113 	if (result < 0)
114 	    result += 360;
115     }
116     make_real(op - 1, result);
117     pop(1);
118     return 0;
119 }
120 
121 /* <num> cos <real> */
122 int
123 zcos(i_ctx_t *i_ctx_p)
124 {
125     os_ptr op = osp;
126     double angle;
127     int code = real_param(op, &angle);
128 
129     if (code < 0)
130 	return code;
131     make_real(op, gs_cos_degrees(angle));
132     return 0;
133 }
134 
135 /* <num> sin <real> */
136 int
137 zsin(i_ctx_t *i_ctx_p)
138 {
139     os_ptr op = osp;
140     double angle;
141     int code = real_param(op, &angle);
142 
143     if (code < 0)
144 	return code;
145     make_real(op, gs_sin_degrees(angle));
146     return 0;
147 }
148 
149 /* <base> <exponent> exp <real> */
150 int
151 zexp(i_ctx_t *i_ctx_p)
152 {
153     os_ptr op = osp;
154     double args[2];
155     double result;
156     double ipart;
157     int code = num_params(op, 2, args);
158 
159     if (code < 0)
160 	return code;
161     if (args[0] == 0.0 && args[1] == 0.0)
162 	return_error(e_undefinedresult);
163     if (args[0] < 0.0 && modf(args[1], &ipart) != 0.0)
164 	return_error(e_undefinedresult);
165     result = pow(args[0], args[1]);
166     make_real(op - 1, result);
167     pop(1);
168     return 0;
169 }
170 
171 /* <posnum> ln <real> */
172 int
173 zln(i_ctx_t *i_ctx_p)
174 {
175     os_ptr op = osp;
176     double num;
177     int code = real_param(op, &num);
178 
179     if (code < 0)
180 	return code;
181     if (num <= 0.0)
182 	return_error(e_rangecheck);
183     make_real(op, log(num));
184     return 0;
185 }
186 
187 /* <posnum> log <real> */
188 int
189 zlog(i_ctx_t *i_ctx_p)
190 {
191     os_ptr op = osp;
192     double num;
193     int code = real_param(op, &num);
194 
195     if (code < 0)
196 	return code;
197     if (num <= 0.0)
198 	return_error(e_rangecheck);
199     make_real(op, log10(num));
200     return 0;
201 }
202 
203 /* - rand <int> */
204 private int
205 zrand(i_ctx_t *i_ctx_p)
206 {
207     os_ptr op = osp;
208 
209 	/*
210 	 * We use an algorithm from CACM 31 no. 10, pp. 1192-1201,
211 	 * October 1988.  According to a posting by Ed Taft on
212 	 * comp.lang.postscript, Level 2 (Adobe) PostScript interpreters
213 	 * use this algorithm too:
214 	 *      x[n+1] = (16807 * x[n]) mod (2^31 - 1)
215 	 */
216 #define A 16807
217 #define M 0x7fffffff
218 #define Q 127773		/* M / A */
219 #define R 2836			/* M % A */
220     zrand_state = A * (zrand_state % Q) - R * (zrand_state / Q);
221     /* Note that zrand_state cannot be 0 here. */
222     if (zrand_state <= 0)
223 	zrand_state += M;
224 #undef A
225 #undef M
226 #undef Q
227 #undef R
228     push(1);
229     make_int(op, zrand_state);
230     return 0;
231 }
232 
233 /* <int> srand - */
234 private int
235 zsrand(i_ctx_t *i_ctx_p)
236 {
237     os_ptr op = osp;
238     long state;
239 
240     check_type(*op, t_integer);
241     state = op->value.intval;
242 #if arch_sizeof_long > 4
243     /* Trim the state back to 32 bits. */
244     state = (int)state;
245 #endif
246     /*
247      * The following somewhat bizarre adjustments are according to
248      * public information from Adobe describing their implementation.
249      */
250     if (state < 1)
251 	state = -(state % 0x7ffffffe) + 1;
252     else if (state > 0x7ffffffe)
253 	state = 0x7ffffffe;
254     zrand_state = state;
255     pop(1);
256     return 0;
257 }
258 
259 /* - rrand <int> */
260 private int
261 zrrand(i_ctx_t *i_ctx_p)
262 {
263     os_ptr op = osp;
264 
265     push(1);
266     make_int(op, zrand_state);
267     return 0;
268 }
269 
270 /* ------ Initialization procedure ------ */
271 
272 const op_def zmath_op_defs[] =
273 {
274     {"1arccos", zarccos},	/* extension */
275     {"1arcsin", zarcsin},	/* extension */
276     {"2atan", zatan},
277     {"1cos", zcos},
278     {"2exp", zexp},
279     {"1ln", zln},
280     {"1log", zlog},
281     {"0rand", zrand},
282     {"0rrand", zrrand},
283     {"1sin", zsin},
284     {"1sqrt", zsqrt},
285     {"1srand", zsrand},
286     op_def_end(0)
287 };
288