xref: /plan9-contrib/sys/src/cmd/gs/src/zmath.c (revision a84536681645e23c630ce4ef2e5c3b284d4c590b)
1 /* Copyright (C) 1989, 2000 Aladdin Enterprises.  All rights reserved.
2 
3   This file is part of AFPL Ghostscript.
4 
5   AFPL Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author or
6   distributor accepts any responsibility for the consequences of using it, or
7   for whether it serves any particular purpose or works at all, unless he or
8   she says so in writing.  Refer to the Aladdin Free Public License (the
9   "License") for full details.
10 
11   Every copy of AFPL Ghostscript must include a copy of the License, normally
12   in a plain ASCII text file named PUBLIC.  The License grants you the right
13   to copy, modify and redistribute AFPL Ghostscript, but only under certain
14   conditions described in the License.  Among other things, the License
15   requires that the copyright notice and this notice be preserved on all
16   copies.
17 */
18 
19 /*$Id: zmath.c,v 1.3 2000/09/19 19:00:54 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     code = gs_atan2_degrees(args[0], args[1], &result);
108     if (code < 0)
109 	return code;
110     make_real(op - 1, result);
111     pop(1);
112     return 0;
113 }
114 
115 /* <num> cos <real> */
116 int
117 zcos(i_ctx_t *i_ctx_p)
118 {
119     os_ptr op = osp;
120     double angle;
121     int code = real_param(op, &angle);
122 
123     if (code < 0)
124 	return code;
125     make_real(op, gs_cos_degrees(angle));
126     return 0;
127 }
128 
129 /* <num> sin <real> */
130 int
131 zsin(i_ctx_t *i_ctx_p)
132 {
133     os_ptr op = osp;
134     double angle;
135     int code = real_param(op, &angle);
136 
137     if (code < 0)
138 	return code;
139     make_real(op, gs_sin_degrees(angle));
140     return 0;
141 }
142 
143 /* <base> <exponent> exp <real> */
144 int
145 zexp(i_ctx_t *i_ctx_p)
146 {
147     os_ptr op = osp;
148     double args[2];
149     double result;
150     double ipart;
151     int code = num_params(op, 2, args);
152 
153     if (code < 0)
154 	return code;
155     if (args[0] == 0.0 && args[1] == 0.0)
156 	return_error(e_undefinedresult);
157     if (args[0] < 0.0 && modf(args[1], &ipart) != 0.0)
158 	return_error(e_undefinedresult);
159     result = pow(args[0], args[1]);
160     make_real(op - 1, result);
161     pop(1);
162     return 0;
163 }
164 
165 /* <posnum> ln <real> */
166 int
167 zln(i_ctx_t *i_ctx_p)
168 {
169     os_ptr op = osp;
170     double num;
171     int code = real_param(op, &num);
172 
173     if (code < 0)
174 	return code;
175     if (num <= 0.0)
176 	return_error(e_rangecheck);
177     make_real(op, log(num));
178     return 0;
179 }
180 
181 /* <posnum> log <real> */
182 int
183 zlog(i_ctx_t *i_ctx_p)
184 {
185     os_ptr op = osp;
186     double num;
187     int code = real_param(op, &num);
188 
189     if (code < 0)
190 	return code;
191     if (num <= 0.0)
192 	return_error(e_rangecheck);
193     make_real(op, log10(num));
194     return 0;
195 }
196 
197 /* - rand <int> */
198 private int
199 zrand(i_ctx_t *i_ctx_p)
200 {
201     os_ptr op = osp;
202 
203 	/*
204 	 * We use an algorithm from CACM 31 no. 10, pp. 1192-1201,
205 	 * October 1988.  According to a posting by Ed Taft on
206 	 * comp.lang.postscript, Level 2 (Adobe) PostScript interpreters
207 	 * use this algorithm too:
208 	 *      x[n+1] = (16807 * x[n]) mod (2^31 - 1)
209 	 */
210 #define A 16807
211 #define M 0x7fffffff
212 #define Q 127773		/* M / A */
213 #define R 2836			/* M % A */
214     zrand_state = A * (zrand_state % Q) - R * (zrand_state / Q);
215     /* Note that zrand_state cannot be 0 here. */
216     if (zrand_state <= 0)
217 	zrand_state += M;
218 #undef A
219 #undef M
220 #undef Q
221 #undef R
222     push(1);
223     make_int(op, zrand_state);
224     return 0;
225 }
226 
227 /* <int> srand - */
228 private int
229 zsrand(i_ctx_t *i_ctx_p)
230 {
231     os_ptr op = osp;
232     long state;
233 
234     check_type(*op, t_integer);
235     state = op->value.intval;
236 #if arch_sizeof_long > 4
237     /* Trim the state back to 32 bits. */
238     state = (int)state;
239 #endif
240     /*
241      * The following somewhat bizarre adjustments are according to
242      * public information from Adobe describing their implementation.
243      */
244     if (state < 1)
245 	state = -(state % 0x7ffffffe) + 1;
246     else if (state > 0x7ffffffe)
247 	state = 0x7ffffffe;
248     zrand_state = state;
249     pop(1);
250     return 0;
251 }
252 
253 /* - rrand <int> */
254 private int
255 zrrand(i_ctx_t *i_ctx_p)
256 {
257     os_ptr op = osp;
258 
259     push(1);
260     make_int(op, zrand_state);
261     return 0;
262 }
263 
264 /* ------ Initialization procedure ------ */
265 
266 const op_def zmath_op_defs[] =
267 {
268     {"1arccos", zarccos},	/* extension */
269     {"1arcsin", zarcsin},	/* extension */
270     {"2atan", zatan},
271     {"1cos", zcos},
272     {"2exp", zexp},
273     {"1ln", zln},
274     {"1log", zlog},
275     {"0rand", zrand},
276     {"0rrand", zrrand},
277     {"1sin", zsin},
278     {"1sqrt", zsqrt},
279     {"1srand", zsrand},
280     op_def_end(0)
281 };
282