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