1 /*
2 *class++
3 * Name:
4 * MathMap
5
6 * Purpose:
7 * Transform coordinates using mathematical expressions.
8
9 * Constructor Function:
10 c astMathMap
11 f AST_MATHMAP
12
13 * Description:
14 c A MathMap is a Mapping which allows you to specify a set of forward
15 c and/or inverse transformation functions using arithmetic operations
16 c and mathematical functions similar to those available in C. The
17 c MathMap interprets these functions at run-time, whenever its forward
18 c or inverse transformation is required. Because the functions are not
19 c compiled in the normal sense (unlike an IntraMap), they may be used to
20 c describe coordinate transformations in a transportable manner. A
21 c MathMap therefore provides a flexible way of defining new types of
22 c Mapping whose descriptions may be stored as part of a dataset and
23 c interpreted by other programs.
24 f A MathMap is a Mapping which allows you to specify a set of forward
25 f and/or inverse transformation functions using arithmetic operations
26 f and mathematical functions similar to those available in Fortran. The
27 f MathMap interprets these functions at run-time, whenever its forward
28 f or inverse transformation is required. Because the functions are not
29 f compiled in the normal sense (unlike an IntraMap), they may be used to
30 f describe coordinate transformations in a transportable manner. A
31 f MathMap therefore provides a flexible way of defining new types of
32 f Mapping whose descriptions may be stored as part of a dataset and
33 f interpreted by other programs.
34
35 * Inheritance:
36 * The MathMap class inherits from the Mapping class.
37
38 * Attributes:
39 * In addition to those attributes common to all Mappings, every
40 * MathMap also has the following attributes:
41 * - Seed: Random number seed
42 * - SimpFI: Forward-inverse MathMap pairs simplify?
43 * - SimpIF: Inverse-forward MathMap pairs simplify?
44
45 * Functions:
46 c The MathMap class does not define any new functions beyond those
47 f The MathMap class does not define any new routines beyond those
48 * which are applicable to all Mappings.
49
50 * Copyright:
51 * Copyright (C) 1997-2006 Council for the Central Laboratory of the
52 * Research Councils
53
54 * Licence:
55 * This program is free software: you can redistribute it and/or
56 * modify it under the terms of the GNU Lesser General Public
57 * License as published by the Free Software Foundation, either
58 * version 3 of the License, or (at your option) any later
59 * version.
60 *
61 * This program is distributed in the hope that it will be useful,
62 * but WITHOUT ANY WARRANTY; without even the implied warranty of
63 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
64 * GNU Lesser General Public License for more details.
65 *
66 * You should have received a copy of the GNU Lesser General
67 * License along with this program. If not, see
68 * <http://www.gnu.org/licenses/>.
69
70 * Authors:
71 * RFWS: R.F. Warren-Smith (Starlink)
72
73 * History:
74 * 3-SEP-1999 (RFWS):
75 * Original version.
76 * 8-JAN-2003 (DSB):
77 * Changed private InitVtab method to protected astInitMathMapVtab
78 * method.
79 * 14-FEB-2006 (DSB):
80 * Override astGetObjSize.
81 * 14-MAR-2006 (DSB):
82 * - Add QIF function.
83 * - Override astEqual method.
84 * 20-NOV-2006 (DSB):
85 * Re-implement the Equal method to avoid use of astSimplify.
86 * 30-AUG-2012 (DSB):
87 * Fix bug in undocumented Gaussian noise function.
88 *class--
89 */
90
91 /* Module Macros. */
92 /* ============== */
93 /* Set the name of the class we are implementing. This indicates to
94 the header files that define class interfaces that they should make
95 "protected" symbols available. */
96 #define astCLASS MathMap
97
98 /* Allocate pointer array. */
99 /* ----------------------- */
100 /* This macro allocates an array of pointers. If successful, each element
101 of the array is initialised to NULL. */
102 #define MALLOC_POINTER_ARRAY(array_name,array_type,array_size) \
103 \
104 /* Allocate the array. */ \
105 (array_name) = astMalloc( sizeof(array_type) * (size_t) (array_size) ); \
106 if ( astOK ) { \
107 \
108 /* If successful, loop to initialise each element. */ \
109 int array_index_; \
110 for ( array_index_ = 0; array_index_ < (array_size); array_index_++ ) { \
111 (array_name)[ array_index_ ] = NULL; \
112 } \
113 }
114
115 /* Free pointer array. */
116 /* ------------------- */
117 /* This macro frees a dynamically allocated array of pointers, each of
118 whose elements may point at a further dynamically allocated array
119 (which is also to be freed). It also allows for the possibility of any
120 of the pointers being NULL. */
121 #define FREE_POINTER_ARRAY(array_name,array_size) \
122 \
123 /* Check that the main array pointer is not NULL. */ \
124 if ( (array_name) ) { \
125 \
126 /* If OK, loop to free each of the sub-arrays. */ \
127 int array_index_; \
128 for ( array_index_ = 0; array_index_ < (array_size); array_index_++ ) { \
129 \
130 /* Check that each sub-array pointer is not NULL before freeing it. */ \
131 if ( (array_name)[ array_index_ ] ) { \
132 (array_name)[ array_index_ ] = \
133 astFree( (array_name)[ array_index_ ] ); \
134 } \
135 } \
136 \
137 /* Free the main pointer array. */ \
138 (array_name) = astFree( (array_name) ); \
139 }
140
141 /* SizeOf pointer array. */
142 /* --------------------- */
143 /* This macro increments "result" by the number of bytes allocated for an
144 array of pointers, each of whose elements may point at a further
145 dynamically allocated array (which is also to be included). It also
146 allows for the possibility of any of the pointers being NULL. */
147 #define SIZEOF_POINTER_ARRAY(array_name,array_size) \
148 \
149 /* Check that the main array pointer is not NULL. */ \
150 if ( (array_name) ) { \
151 \
152 /* If OK, loop to measure each of the sub-arrays. */ \
153 int array_index_; \
154 for ( array_index_ = 0; array_index_ < (array_size); array_index_++ ) { \
155 \
156 /* Check that each sub-array pointer is not NULL before measuring it. */ \
157 if ( (array_name)[ array_index_ ] ) { \
158 result += astTSizeOf( (array_name)[ array_index_ ] ); \
159 } \
160 } \
161 \
162 /* Include the main pointer array. */ \
163 result += astTSizeOf( (array_name) ); \
164 }
165
166 /* Header files. */
167 /* ============= */
168 /* Interface definitions. */
169 /* ---------------------- */
170 #include "channel.h" /* I/O channels */
171
172 #include "globals.h" /* Thread-safe global data access */
173 #include "error.h" /* Error reporting facilities */
174 #include "mapping.h" /* Coordinate mappings (parent class) */
175 #include "cmpmap.h" /* Compound Mappings */
176 #include "mathmap.h" /* Interface definition for this class */
177 #include "memory.h" /* Memory allocation facilities */
178 #include "globals.h" /* Thread-safe global data access */
179 #include "object.h" /* Base Object class */
180 #include "pointset.h" /* Sets of points */
181 #include "unitmap.h" /* Unit Mapping */
182
183 /* Error code definitions. */
184 /* ----------------------- */
185 #include "ast_err.h" /* AST error codes */
186
187 /* C header files. */
188 /* --------------- */
189 #include <ctype.h>
190 #include <errno.h>
191 #include <limits.h>
192 #include <math.h>
193 #include <stddef.h>
194 #include <stdio.h>
195 #include <stdlib.h>
196 #include <string.h>
197 #include <time.h>
198
199 /* Module Variables. */
200 /* ================= */
201 /* This type is made obscure since it is publicly accessible (but not
202 useful). Provide shorthand for use within this module. */
203 typedef AstMathMapRandContext_ Rcontext;
204
205
206
207 /* Address of this static variable is used as a unique identifier for
208 member of this class. */
209 static int class_check;
210
211 /* Pointers to parent class methods which are extended by this class. */
212 static int (* parent_getobjsize)( AstObject *, int * );
213 static AstPointSet *(* parent_transform)( AstMapping *, AstPointSet *, int, AstPointSet *, int * );
214 static const char *(* parent_getattrib)( AstObject *, const char *, int * );
215 static int (* parent_testattrib)( AstObject *, const char *, int * );
216 static void (* parent_clearattrib)( AstObject *, const char *, int * );
217 static void (* parent_setattrib)( AstObject *, const char *, int * );
218
219 /* This declaration enumerates the operation codes recognised by the
220 EvaluateFunction function which evaluates arithmetic expressions. */
221 typedef enum {
222
223 /* User-supplied constants and variables. */
224 OP_LDCON, /* Load constant */
225 OP_LDVAR, /* Load variable */
226
227 /* System constants. */
228 OP_LDBAD, /* Load bad value (AST__BAD) */
229 OP_LDDIG, /* Load # decimal digits (DBL_DIG) */
230 OP_LDEPS, /* Load relative precision (DBL_EPSILON) */
231 OP_LDMAX, /* Load largest value (DBL_MAX) */
232 OP_LDMAX10E, /* Max. decimal exponent (DBL_MAX_10_EXP) */
233 OP_LDMAXE, /* Load maximum exponent (DBL_MAX_EXP) */
234 OP_LDMDIG, /* Load # mantissa digits (DBL_MANT_DIG) */
235 OP_LDMIN, /* Load smallest value (DBL_MIN) */
236 OP_LDMIN10E, /* Min. decimal exponent (DBL_MIN_10_EXP) */
237 OP_LDMINE, /* Load minimum exponent (DBL_MIN_EXP) */
238 OP_LDRAD, /* Load floating radix (FLT_RADIX) */
239 OP_LDRND, /* Load rounding mode (FLT_ROUNDS) */
240
241 /* Mathematical constants. */
242 OP_LDE, /* Load e (base of natural logarithms) */
243 OP_LDPI, /* Load pi */
244
245 /* Functions with one argument. */
246 OP_ABS, /* Absolute value (sign removal) */
247 OP_ACOS, /* Inverse cosine (radians) */
248 OP_ACOSD, /* Inverse cosine (degrees) */
249 OP_ACOSH, /* Inverse hyperbolic cosine */
250 OP_ACOTH, /* Inverse hyperbolic cotangent */
251 OP_ACSCH, /* Inverse hyperbolic cosecant */
252 OP_ASECH, /* Inverse hyperbolic secant */
253 OP_ASIN, /* Inverse sine (radians) */
254 OP_ASIND, /* Inverse sine (degrees) */
255 OP_ASINH, /* Inverse hyperbolic sine */
256 OP_ATAN, /* Inverse tangent (radians) */
257 OP_ATAND, /* Inverse tangent (degrees) */
258 OP_ATANH, /* Inverse hyperbolic tangent */
259 OP_CEIL, /* C ceil function (round up) */
260 OP_COS, /* Cosine (radians) */
261 OP_COSD, /* Cosine (degrees) */
262 OP_COSH, /* Hyperbolic cosine */
263 OP_COTH, /* Hyperbolic cotangent */
264 OP_CSCH, /* Hyperbolic cosecant */
265 OP_EXP, /* Exponential function */
266 OP_FLOOR, /* C floor function (round down) */
267 OP_INT, /* Integer value (round towards zero) */
268 OP_ISBAD, /* Test for bad value */
269 OP_LOG, /* Natural logarithm */
270 OP_LOG10, /* Base 10 logarithm */
271 OP_NINT, /* Fortran NINT function (round to nearest) */
272 OP_POISS, /* Poisson random number */
273 OP_SECH, /* Hyperbolic secant */
274 OP_SIN, /* Sine (radians) */
275 OP_SINC, /* Sinc function [= sin(x)/x] */
276 OP_SIND, /* Sine (degrees) */
277 OP_SINH, /* Hyperbolic sine */
278 OP_SQR, /* Square */
279 OP_SQRT, /* Square root */
280 OP_TAN, /* Tangent (radians) */
281 OP_TAND, /* Tangent (degrees) */
282 OP_TANH, /* Hyperbolic tangent */
283
284 /* Functions with two arguments. */
285 OP_ATAN2, /* Inverse tangent (2 arguments, radians) */
286 OP_ATAN2D, /* Inverse tangent (2 arguments, degrees) */
287 OP_DIM, /* Fortran DIM (positive difference) fn. */
288 OP_GAUSS, /* Gaussian random number */
289 OP_MOD, /* Modulus function */
290 OP_POW, /* Raise to power */
291 OP_RAND, /* Uniformly distributed random number */
292 OP_SIGN, /* Transfer of sign function */
293
294 /* Functions with three arguments. */
295 OP_QIF, /* C "question mark" operator "a?b:c" */
296
297 /* Functions with variable numbers of arguments. */
298 OP_MAX, /* Maximum of 2 or more values */
299 OP_MIN, /* Minimum of 2 or more values */
300
301 /* Unary arithmetic operators. */
302 OP_NEG, /* Negate (change sign) */
303
304 /* Unary boolean operators. */
305 OP_NOT, /* Boolean NOT */
306
307 /* Binary arithmetic operators. */
308 OP_ADD, /* Add */
309 OP_DIV, /* Divide */
310 OP_MUL, /* Multiply */
311 OP_SUB, /* Subtract */
312
313 /* Bit-shift operators. */
314 OP_SHFTL, /* Shift bits left */
315 OP_SHFTR, /* Shift bits right */
316
317 /* Relational operators. */
318 OP_EQ, /* Relational equal */
319 OP_GE, /* Greater than or equal */
320 OP_GT, /* Greater than */
321 OP_LE, /* Less than or equal */
322 OP_LT, /* Less than */
323 OP_NE, /* Not equal */
324
325 /* Bit-wise operators. */
326 OP_BITAND, /* Bit-wise AND */
327 OP_BITOR, /* Bit-wise OR */
328 OP_BITXOR, /* Bit-wise exclusive OR */
329
330 /* Binary boolean operators. */
331 OP_AND, /* Boolean AND */
332 OP_EQV, /* Fortran logical .EQV. operation */
333 OP_OR, /* Boolean OR */
334 OP_XOR, /* Boolean exclusive OR */
335
336 /* Null operation. */
337 OP_NULL /* Null operation */
338 } Oper;
339
340 /* This structure holds a description of each symbol which may appear
341 in an expression. */
342 typedef struct {
343 const char *text; /* Symbol text as it appears in expressions */
344 const int size; /* Size of symbol text */
345 const int operleft; /* An operator when seen from the left? */
346 const int operright; /* An operator when seen from the right? */
347 const int unarynext; /* May be followed by a unary +/- ? */
348 const int unaryoper; /* Is a unary +/- ? */
349 const int leftpriority; /* Priority when seen from the left */
350 const int rightpriority; /* Priority when seen from the right */
351 const int parincrement; /* Change in parenthesis level */
352 const int stackincrement; /* Change in evaluation stack size */
353 const int nargs; /* Number of function arguments */
354 const Oper opcode; /* Resulting operation code */
355 } Symbol;
356
357 /* This initialises an array of Symbol structures to hold data on all
358 the supported symbols. The order is not important, but symbols are
359 arranged here in approximate order of descending evaluation
360 priority. The end of the array is indicated by an element with a NULL
361 "text" component. */
362 static const Symbol symbol[] = {
363
364 /* User-supplied constants and variables. */
365 { "" , 0, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDCON },
366 { "" , 0, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDVAR },
367
368 /* System constants. */
369 { "<bad>" , 5, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDBAD },
370 { "<dig>" , 5, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDDIG },
371 { "<epsilon>" , 9, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDEPS },
372 { "<mant_dig>" , 10, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDMDIG },
373 { "<max>" , 5, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDMAX },
374 { "<max_10_exp>", 12, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDMAX10E },
375 { "<max_exp>" , 9, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDMAXE },
376 { "<min>" , 5, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDMIN },
377 { "<min_10_exp>", 12, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDMIN10E },
378 { "<min_exp>" , 9, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDMINE },
379 { "<radix>" , 7, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDRAD },
380 { "<rounds>" , 8, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDRND },
381
382 /* Mathematical constants. */
383 { "<e>" , 3, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDE },
384 { "<pi>" , 4, 0, 0, 0, 0, 19, 19, 0, 1, 0, OP_LDPI },
385
386 /* Functions with one argument. */
387 { "abs(" , 4, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ABS },
388 { "acos(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ACOS },
389 { "acosd(" , 6, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ACOSD },
390 { "acosh(" , 6, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ACOSH },
391 { "acoth(" , 6, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ACOTH },
392 { "acsch(" , 6, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ACSCH },
393 { "aint(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_INT },
394 { "asech(" , 6, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ASECH },
395 { "asin(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ASIN },
396 { "asind(" , 6, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ASIND },
397 { "asinh(" , 6, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ASINH },
398 { "atan(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ATAN },
399 { "atand(" , 6, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ATAND },
400 { "atanh(" , 6, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ATANH },
401 { "ceil(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_CEIL },
402 { "cos(" , 4, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_COS },
403 { "cosd(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_COSD },
404 { "cosh(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_COSH },
405 { "coth(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_COTH },
406 { "csch(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_CSCH },
407 { "exp(" , 4, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_EXP },
408 { "fabs(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ABS },
409 { "floor(" , 6, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_FLOOR },
410 { "int(" , 4, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_INT },
411 { "isbad(" , 6, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_ISBAD },
412 { "log(" , 4, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_LOG },
413 { "log10(" , 6, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_LOG10 },
414 { "nint(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_NINT },
415 { "poisson(" , 8, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_POISS },
416 { "sech(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_SECH },
417 { "sin(" , 4, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_SIN },
418 { "sinc(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_SINC },
419 { "sind(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_SIND },
420 { "sinh(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_SINH },
421 { "sqr(" , 4, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_SQR },
422 { "sqrt(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_SQRT },
423 { "tan(" , 4, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_TAN },
424 { "tand(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_TAND },
425 { "tanh(" , 5, 0, 1, 1, 0, 19, 1, 1, 0, 1, OP_TANH },
426
427 /* Functions with two arguments. */
428 { "atan2(" , 6, 0, 1, 1, 0, 19, 1, 1, -1, 2, OP_ATAN2 },
429 { "atan2d(" , 7, 0, 1, 1, 0, 19, 1, 1, -1, 2, OP_ATAN2D },
430 { "dim(" , 4, 0, 1, 1, 0, 19, 1, 1, -1, 2, OP_DIM },
431 { "fmod(" , 5, 0, 1, 1, 0, 19, 1, 1, -1, 2, OP_MOD },
432 { "gauss(" , 6, 0, 1, 1, 0, 19, 1, 1, -1, 2, OP_GAUSS },
433 { "mod(" , 4, 0, 1, 1, 0, 19, 1, 1, -1, 2, OP_MOD },
434 { "pow(" , 4, 0, 1, 1, 0, 19, 1, 1, -1, 2, OP_POW },
435 { "rand(" , 5, 0, 1, 1, 0, 19, 1, 1, -1, 2, OP_RAND },
436 { "sign(" , 5, 0, 1, 1, 0, 19, 1, 1, -1, 2, OP_SIGN },
437
438 /* Functions with two arguments. */
439 { "qif(" , 4, 0, 1, 1, 0, 19, 1, 1, -2, 3, OP_QIF },
440
441 /* Functions with variable numbers of arguments. */
442 { "max(" , 4, 0, 1, 1, 0, 19, 1, 1, -1, -2, OP_MAX },
443 { "min(" , 4, 0, 1, 1, 0, 19, 1, 1, -1, -2, OP_MIN },
444
445 /* Parenthesised expressions. */
446 { ")" , 1, 1, 0, 0, 0, 2, 19, -1, 0, 0, OP_NULL },
447 { "(" , 1, 0, 1, 1, 0, 19, 1, 1, 0, 0, OP_NULL },
448
449 /* Unary arithmetic operators. */
450 { "+" , 1, 0, 1, 1, 1, 17, 16, 0, 0, 0, OP_NULL },
451 { "-" , 1, 0, 1, 1, 1, 17, 16, 0, 0, 0, OP_NEG },
452
453 /* Unary boolean operators. */
454 { "!" , 1, 0, 1, 1, 0, 17, 16, 0, 0, 0, OP_NOT },
455 { ".not." , 5, 0, 1, 1, 0, 17, 16, 0, 0, 0, OP_NOT },
456
457 /* Binary arithmetic operators. */
458 { "**" , 2, 1, 1, 1, 0, 18, 15, 0, -1, 0, OP_POW },
459 { "*" , 1, 1, 1, 1, 0, 14, 14, 0, -1, 0, OP_MUL },
460 { "/" , 1, 1, 1, 1, 0, 14, 14, 0, -1, 0, OP_DIV },
461 { "+" , 1, 1, 1, 1, 0, 13, 13, 0, -1, 0, OP_ADD },
462 { "-" , 1, 1, 1, 1, 0, 13, 13, 0, -1, 0, OP_SUB },
463
464 /* Bit-shift operators. */
465 { "<<" , 2, 1, 1, 1, 0, 12, 12, 0, -1, 0, OP_SHFTL },
466 { ">>" , 2, 1, 1, 1, 0, 12, 12, 0, -1, 0, OP_SHFTR },
467
468 /* Relational operators. */
469 { "<" , 1, 1, 1, 1, 0, 11, 11, 0, -1, 0, OP_LT },
470 { ".lt." , 4, 1, 1, 1, 0, 11, 11, 0, -1, 0, OP_LT },
471 { "<=" , 2, 1, 1, 1, 0, 11, 11, 0, -1, 0, OP_LE },
472 { ".le." , 4, 1, 1, 1, 0, 11, 11, 0, -1, 0, OP_LE },
473 { ">" , 1, 1, 1, 1, 0, 11, 11, 0, -1, 0, OP_GT },
474 { ".gt." , 4, 1, 1, 1, 0, 11, 11, 0, -1, 0, OP_GT },
475 { ">=" , 2, 1, 1, 1, 0, 11, 11, 0, -1, 0, OP_GE },
476 { ".ge." , 4, 1, 1, 1, 0, 11, 11, 0, -1, 0, OP_GE },
477 { "==" , 2, 1, 1, 1, 0, 10, 10, 0, -1, 0, OP_EQ },
478 { ".eq." , 4, 1, 1, 1, 0, 10, 10, 0, -1, 0, OP_EQ },
479 { "!=" , 2, 1, 1, 1, 0, 10, 10, 0, -1, 0, OP_NE },
480 { ".ne." , 4, 1, 1, 1, 0, 10, 10, 0, -1, 0, OP_NE },
481
482 /* Bit-wise operators. */
483 { "&" , 1, 1, 1, 1, 0, 9, 9, 0, -1, 0, OP_BITAND },
484 { "^" , 1, 1, 1, 1, 0, 8, 8, 0, -1, 0, OP_BITXOR },
485 { "|" , 1, 1, 1, 1, 0, 7, 7, 0, -1, 0, OP_BITOR },
486
487 /* Binary boolean operators. */
488 { "&&" , 2, 1, 1, 1, 0, 6, 6, 0, -1, 0, OP_AND },
489 { ".and." , 5, 1, 1, 1, 0, 6, 6, 0, -1, 0, OP_AND },
490 { "^^" , 2, 1, 1, 1, 0, 5, 5, 0, -1, 0, OP_XOR },
491 { "||" , 2, 1, 1, 1, 0, 4, 4, 0, -1, 0, OP_OR },
492 { ".or." , 4, 1, 1, 1, 0, 4, 4, 0, -1, 0, OP_OR },
493 { ".eqv." , 5, 1, 1, 1, 0, 3, 3, 0, -1, 0, OP_EQV },
494 { ".neqv." , 6, 1, 1, 1, 0, 3, 3, 0, -1, 0, OP_XOR },
495 { ".xor." , 5, 1, 1, 1, 0, 3, 3, 0, -1, 0, OP_XOR },
496
497 /* Separators. */
498 { "," , 1, 1, 1, 1, 0, 2, 2, 0, 0, 0, OP_NULL },
499
500 /* End of symbol data. */
501 { NULL , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, OP_NULL }
502 };
503
504 /* These variables identify indices in the above array which hold
505 special symbols used explicitly in the code. */
506 static const int symbol_ldcon = 0; /* Load a constant */
507 static const int symbol_ldvar = 1; /* Load a variable */
508
509 /* Define macros for accessing each item of thread specific global data. */
510 #ifdef THREAD_SAFE
511
512 /* Define how to initialise thread-specific globals. */
513 #define GLOBAL_inits \
514 globals->Class_Init = 0; \
515 globals->GetAttrib_Buff[ 0 ] = 0;
516
517 /* Create the function that initialises global data for this module. */
518 astMAKE_INITGLOBALS(MathMap)
519
520 /* Define macros for accessing each item of thread specific global data. */
521 #define class_init astGLOBAL(MathMap,Class_Init)
522 #define class_vtab astGLOBAL(MathMap,Class_Vtab)
523 #define getattrib_buff astGLOBAL(MathMap,GetAttrib_Buff)
524
525
526
527 static pthread_mutex_t mutex2 = PTHREAD_MUTEX_INITIALIZER;
528 #define LOCK_MUTEX2 pthread_mutex_lock( &mutex2 );
529 #define UNLOCK_MUTEX2 pthread_mutex_unlock( &mutex2 );
530
531 static pthread_mutex_t mutex3 = PTHREAD_MUTEX_INITIALIZER;
532 #define LOCK_MUTEX3 pthread_mutex_lock( &mutex3 );
533 #define UNLOCK_MUTEX3 pthread_mutex_unlock( &mutex3 );
534
535 static pthread_mutex_t mutex4 = PTHREAD_MUTEX_INITIALIZER;
536 #define LOCK_MUTEX4 pthread_mutex_lock( &mutex4 );
537 #define UNLOCK_MUTEX4 pthread_mutex_unlock( &mutex4 );
538
539 static pthread_mutex_t mutex5 = PTHREAD_MUTEX_INITIALIZER;
540 #define LOCK_MUTEX5 pthread_mutex_lock( &mutex5 );
541 #define UNLOCK_MUTEX5 pthread_mutex_unlock( &mutex5 );
542
543 static pthread_mutex_t mutex6 = PTHREAD_MUTEX_INITIALIZER;
544 #define LOCK_MUTEX6 pthread_mutex_lock( &mutex6 );
545 #define UNLOCK_MUTEX6 pthread_mutex_unlock( &mutex6 );
546
547 static pthread_mutex_t mutex7 = PTHREAD_MUTEX_INITIALIZER;
548 #define LOCK_MUTEX7 pthread_mutex_lock( &mutex7 );
549 #define UNLOCK_MUTEX7 pthread_mutex_unlock( &mutex7 );
550
551 /* If thread safety is not needed, declare and initialise globals at static
552 variables. */
553 #else
554
555 static char getattrib_buff[ 51 ];
556
557
558 /* Define the class virtual function table and its initialisation flag
559 as static variables. */
560 static AstMathMapVtab class_vtab; /* Virtual function table */
561 static int class_init = 0; /* Virtual function table initialised? */
562
563 #define LOCK_MUTEX2
564 #define UNLOCK_MUTEX2
565
566 #define LOCK_MUTEX3
567 #define UNLOCK_MUTEX3
568
569 #define LOCK_MUTEX4
570 #define UNLOCK_MUTEX4
571
572 #define LOCK_MUTEX5
573 #define UNLOCK_MUTEX5
574
575 #define LOCK_MUTEX6
576 #define UNLOCK_MUTEX6
577
578 #define LOCK_MUTEX7
579 #define UNLOCK_MUTEX7
580
581 #endif
582
583
584 /* External Interface Function Prototypes. */
585 /* ======================================= */
586 /* The following functions have public prototypes only (i.e. no
587 protected prototypes), so we must provide local prototypes for use
588 within this module. */
589 AstMathMap *astMathMapId_( int, int, int, const char *[], int, const char *[], const char *, ... );
590
591 /* Prototypes for Private Member Functions. */
592 /* ======================================== */
593 static AstPointSet *Transform( AstMapping *, AstPointSet *, int, AstPointSet *, int * );
594 static int GetObjSize( AstObject *, int * );
595 static const char *GetAttrib( AstObject *, const char *, int * );
596 static double Gauss( Rcontext *, int * );
597 static double LogGamma( double, int * );
598 static double Poisson( Rcontext *, double, int * );
599 static double Rand( Rcontext *, int * );
600 static int DefaultSeed( const Rcontext *, int * );
601 static int Equal( AstObject *, AstObject *, int * );
602 static int GetSeed( AstMathMap *, int * );
603 static int GetSimpFI( AstMathMap *, int * );
604 static int GetSimpIF( AstMathMap *, int * );
605 static int MapMerge( AstMapping *, int, int, int *, AstMapping ***, int **, int * );
606 static int TestAttrib( AstObject *, const char *, int * );
607 static int TestSeed( AstMathMap *, int * );
608 static int TestSimpFI( AstMathMap *, int * );
609 static int TestSimpIF( AstMathMap *, int * );
610 static void CleanFunctions( int, const char *[], char ***, int * );
611 static void ClearAttrib( AstObject *, const char *, int * );
612 static void ClearSeed( AstMathMap *, int * );
613 static void ClearSimpFI( AstMathMap *, int * );
614 static void ClearSimpIF( AstMathMap *, int * );
615 static void CompileExpression( const char *, const char *, const char *, int, const char *[], int **, double **, int *, int * );
616 static void CompileMapping( const char *, const char *, int, int, int, const char *[], int, const char *[], int ***, int ***, double ***, double ***, int *, int *, int * );
617 static void Copy( const AstObject *, AstObject *, int * );
618 static void Delete( AstObject *, int * );
619 static void Dump( AstObject *, AstChannel *, int * );
620 static void EvaluateFunction( Rcontext *, int, const double **, const int *, const double *, int, double *, int * );
621 static void EvaluationSort( const double [], int, int [], int **, int *, int * );
622 static void ExtractExpressions( const char *, const char *, int, const char *[], int, char ***, int * );
623 static void ExtractVariables( const char *, const char *, int, const char *[], int, int, int, int, int, char ***, int * );
624 static void ParseConstant( const char *, const char *, const char *, int, int *, double *, int * );
625 static void ParseName( const char *, int, int *, int * );
626 static void ParseVariable( const char *, const char *, const char *, int, int, const char *[], int *, int *, int * );
627 static void SetAttrib( AstObject *, const char *, int * );
628 static void SetSeed( AstMathMap *, int, int * );
629 static void SetSimpFI( AstMathMap *, int, int * );
630 static void SetSimpIF( AstMathMap *, int, int * );
631 static void ValidateSymbol( const char *, const char *, const char *, int, int, int *, int **, int **, int *, double **, int * );
632
633 /* Member functions. */
634 /* ================= */
CleanFunctions(int nfun,const char * fun[],char *** clean,int * status)635 static void CleanFunctions( int nfun, const char *fun[], char ***clean, int *status ) {
636 /*
637 * Name:
638 * CleanFunctions
639
640 * Purpose:
641 * Make a clean copy of a set of functions.
642
643 * Type:
644 * Private function.
645
646 * Synopsis:
647 * #include "mathmap.h"
648 * void CleanFunctions( int nfun, const char *fun[], char ***clean, int *status )
649
650 * Class Membership:
651 * MathMap member function.
652
653 * Description:
654 * This function copies an array of strings, eliminating any white space
655 * characters and converting to lower case. It is intended for cleaning
656 * up arrays of function definitions prior to compilation. The returned
657 * copy is stored in dynamically allocated memory.
658
659 * Parameters:
660 * nfun
661 * The number of functions to be cleaned.
662 * fun
663 * Pointer to an array, with "nfun" elements, of pointers to null
664 * terminated strings which contain each of the functions.
665 * clean
666 * Address in which to return a pointer to an array (with "nfun"
667 * elements) of pointers to null terminated strings containing the
668 * cleaned functions (i.e. this returns an array of strings).
669 *
670 * Both the returned array of pointers, and the strings to which they
671 * point, will be dynamically allocated and should be freed by the
672 * caller (using astFree) when no longer required.
673 * status
674 * Pointer to the inherited status variable.
675
676 * Notes:
677 * - A NULL value will be returned for "*clean" if this function is
678 * invoked with the global error status set, or if it should fail for
679 * any reason.
680 */
681
682 /* Local Variables: */
683 char c; /* Character from function string */
684 int i; /* Loop counter for characters */
685 int ifun; /* Loop counter for functions */
686 int nc; /* Count of non-blank characters */
687
688 /* Initialise. */
689 *clean = NULL;
690
691 /* Check the global error status. */
692 if ( !astOK ) return;
693
694 /* Allocate and initialise an array to hold the returned pointers. */
695 MALLOC_POINTER_ARRAY( *clean, char *, nfun )
696
697 /* Loop through all the input functions. */
698 if ( astOK ) {
699 for ( ifun = 0; ifun < nfun; ifun++ ) {
700
701 /* Count the number of non-blank characters in each function string. */
702 nc = 0;
703 for ( i = 0; ( c = fun[ ifun ][ i ] ); i++ ) nc += !isspace( c );
704
705 /* Allocate a string long enough to hold the function with all the
706 white space removed, storing its pointer in the array allocated
707 earlier. Check for errors. */
708 ( *clean )[ ifun ] = astMalloc( sizeof( char ) *
709 (size_t) ( nc + 1 ) );
710 if ( !astOK ) break;
711
712 /* Loop to copy the non-blank function characters into the new
713 string. */
714 nc = 0;
715 for ( i = 0; ( c = fun[ ifun ][ i ] ); i++ ) {
716 if ( !isspace( c ) ) ( *clean )[ ifun ][ nc++ ] = tolower( c );
717 }
718
719 /* Null-terminate the result. */
720 ( *clean )[ ifun ][ nc ] = '\0';
721 }
722
723 /* If an error occurred, then free the main pointer array together
724 with any strings that have been allocated, resetting the output
725 value. */
726 if ( !astOK ) {
727 FREE_POINTER_ARRAY( *clean, nfun )
728 }
729 }
730 }
731
ClearAttrib(AstObject * this_object,const char * attrib,int * status)732 static void ClearAttrib( AstObject *this_object, const char *attrib, int *status ) {
733 /*
734 * Name:
735 * ClearAttrib
736
737 * Purpose:
738 * Clear an attribute value for a MathMap.
739
740 * Type:
741 * Private function.
742
743 * Synopsis:
744 * #include "mathmap.h"
745 * void ClearAttrib( AstObject *this, const char *attrib, int *status )
746
747 * Class Membership:
748 * MathMap member function (over-rides the astClearAttrib protected
749 * method inherited from the Mapping class).
750
751 * Description:
752 * This function clears the value of a specified attribute for a
753 * MathMap, so that the default value will subsequently be used.
754
755 * Parameters:
756 * this
757 * Pointer to the MathMap.
758 * attrib
759 * Pointer to a null terminated string specifying the attribute
760 * name. This should be in lower case with no surrounding white
761 * space.
762 * status
763 * Pointer to the inherited status variable.
764 */
765
766 /* Local Variables: */
767 AstMathMap *this; /* Pointer to the MathMap structure */
768
769 /* Check the global error status. */
770 if ( !astOK ) return;
771
772 /* Obtain a pointer to the MathMap structure. */
773 this = (AstMathMap *) this_object;
774
775 /* Check the attribute name and clear the appropriate attribute. */
776
777 /* Seed. */
778 /* ----- */
779 if ( !strcmp( attrib, "seed" ) ) {
780 astClearSeed( this );
781
782 /* SimpFI. */
783 /* ------- */
784 } else if ( !strcmp( attrib, "simpfi" ) ) {
785 astClearSimpFI( this );
786
787 /* SimpIF. */
788 /* ------- */
789 } else if ( !strcmp( attrib, "simpif" ) ) {
790 astClearSimpIF( this );
791
792 /* If the attribute is not recognised, pass it on to the parent method
793 for further interpretation. */
794 } else {
795 (*parent_clearattrib)( this_object, attrib, status );
796 }
797 }
798
CompileExpression(const char * method,const char * class,const char * exprs,int nvar,const char * var[],int ** code,double ** con,int * stacksize,int * status)799 static void CompileExpression( const char *method, const char *class,
800 const char *exprs, int nvar, const char *var[],
801 int **code, double **con, int *stacksize, int *status ) {
802 /*
803 * Name:
804 * CompileExpression
805
806 * Purpose:
807 * Compile a mathematical expression.
808
809 * Type:
810 * Private function.
811
812 * Synopsis:
813 * #include "mathmap.h"
814 * void CompileExpression( const char *method, const char *class,
815 * const char *exprs, int nvar, const char *var[],
816 * int **code, double **con, int *stacksize )
817
818 * Class Membership:
819 * MathMap member function.
820
821 * Description:
822 * This function checks and compiles a mathematical expression. It
823 * produces a sequence of operation codes (opcodes) and a set of
824 * numerical constants which may subsequently be used to evaluate the
825 * expression on a push-down stack.
826
827 * Parameters:
828 * method
829 * Pointer to a constant null-terminated character string
830 * containing the name of the method that invoked this function.
831 * This method name is used solely for constructing error messages.
832 * class
833 * Pointer to a constant null-terminated character string containing the
834 * class name of the Object being processed. This name is used solely
835 * for constructing error messages.
836 * exprs
837 * Pointer to a null-terminated string containing the expression
838 * to be compiled. This is case sensitive and should contain no white
839 * space.
840 * nvar
841 * The number of variable names defined for use in the expression.
842 * var
843 * An array of pointers (with "nvar" elements) to null-terminated
844 * strings. Each of these should contain a variable name which may
845 * appear in the expression. These strings are case sensitive and
846 * should contain no white space.
847 * code
848 * Address of a pointer which will be set to point at a dynamically
849 * allocated array of int containing the set of opcodes (cast to int)
850 * produced by this function. The first element of this array will
851 * contain a count of the number of opcodes which follow.
852 *
853 * The allocated space must be freed by the caller (using astFree) when
854 * no longer required.
855 * con
856 * Address of a pointer which will be set to point at a dynamically
857 * allocated array of double containing the set of constants
858 * produced by this function (this may be NULL if no constants are
859 * produced).
860 *
861 * The allocated space must be freed by the caller (using astFree) when
862 * no longer required.
863 * stacksize
864 * Pointer to an int in which to return the size of the push-down stack
865 * required to evaluate the expression using the returned opcodes and
866 * constants.
867
868 * Algorithm:
869 * The function passes through the input expression searching for
870 * symbols. It looks for standard symbols (arithmetic operators,
871 * parentheses, function calls and delimiters) in the next part of the
872 * expression to be parsed, using identification information stored in
873 * the static "symbol" array. It ignores certain symbols, according to
874 * whether they appear to be operators or operands. The choice depends on
875 * what the previous symbol was; for instance, two operators may not
876 * occur in succession. Unary +/- operators are also ignored in
877 * situations where they are not permitted.
878 *
879 * If a standard symbol is found, it is passed to the ValidateSymbol
880 * function, which keeps track of the current level of parenthesis in the
881 * expression and of the number of arguments supplied to any (possibly
882 * nested) function calls. This function then accepts or rejects the
883 * symbol according to whether it is valid within the current context. An
884 * error is reported if it is rejected.
885 *
886 * If the part of the expression currently being parsed did not contain a
887 * standard symbol, an attempt is made to parse it first as a constant,
888 * then as a variable name. If either of these succeeds, an appropriate
889 * symbol number is added to the list of symbols identified so far, and a
890 * value is added to the list of constants - this is either the value of
891 * the constant itself, or the identification number of the variable. If
892 * the expression cannot be parsed, an error is reported.
893 *
894 * When the entire expression has been analysed as a sequence of symbols
895 * (and associated constants), the EvaluationSort function is
896 * invoked. This sorts the symbols into evaluation order, which is the
897 * order in which the associated operations must be performed on a
898 * push-down arithmetic stack to evaluate the expression. This routine
899 * also substitutes operation codes (defined in the "Oper" enum) for the
900 * symbol numbers and calculates the size of evaluation stack which will
901 * be required.
902
903 * Notes:
904 * - A value of NULL will be returned for the "*code" and "*con" pointers
905 * and a value of zero will be returned for the "*stacksize" value if this
906 * function is invoked with the global error status set, or if it should
907 * fail for any reason.
908 */
909
910 /* Local Variables: */
911 double c; /* Value of parsed constant */
912 int *argcount; /* Array of argument count information */
913 int *opensym; /* Array of opening parenthesis information */
914 int *symlist; /* Array of symbol indices */
915 int found; /* Standard symbol identified? */
916 int iend; /* Ending index in the expression string */
917 int istart; /* Staring index in the expression string */
918 int isym; /* Loop counter for symbols */
919 int ivar; /* Index of variable name */
920 int lpar; /* Parenthesis level */
921 int ncon; /* Number of constants generated */
922 int nsym; /* Number of symbols identified */
923 int opernext; /* Next symbol an operator (from left)? */
924 int size; /* Size of symbol matched */
925 int sym; /* Index of symbol in static "symbol" array */
926 int unarynext; /* Next symbol may be unary +/- ? */
927
928 /* Initialise. */
929 *code = NULL;
930 *con = NULL;
931 *stacksize = 0;
932
933 /* Check the global error status. */
934 if ( !astOK ) return;
935
936 /* Further initialisation. */
937 argcount = NULL;
938 lpar = 0;
939 ncon = 0;
940 nsym = 0;
941 opensym = NULL;
942 symlist = NULL;
943 sym = 0;
944 ivar = 0;
945
946 /* The first symbol to be encountered must not look like an operator
947 from the left. It may be a unary + or - operator. */
948 opernext = 0;
949 unarynext = 1;
950
951 /* Search through the expression to classify each symbol which appears
952 in it. Stop when there are no more input characters or an error is
953 detected. */
954 istart = 0;
955 for ( istart = 0; astOK && exprs[ istart ]; istart = iend + 1 ) {
956
957 /* Compare each of the symbols in the symbol data with the next
958 section of the expression, looking for the longest symbol text which
959 will match. Stop if a NULL "text" value is found, which acts as the
960 end flag. */
961 found = 0;
962 size = 0;
963 for ( isym = 0; symbol[ isym ].text; isym++ ) {
964
965 /* Only consider symbols which have text associated with them and
966 which look like operators or operands from the left, according to the
967 setting of the "opernext" flag. Thus, if an operator or operand is
968 missing from the input expression, the next symbol will not be
969 identified, because it will be of the wrong type. Also exclude unary
970 +/- operators if they are out of context. */
971 if ( symbol[ isym ].size &&
972 ( symbol[ isym ].operleft == opernext ) &&
973 ( !symbol[ isym ].unaryoper || unarynext ) ) {
974
975 /* Test if the text of the symbol matches the expression at the
976 current position. If so, note that a match has been found. */
977 if ( !strncmp( exprs + istart, symbol[ isym ].text,
978 (size_t) symbol[ isym ].size ) ) {
979 found = 1;
980
981 /* If this symbol matches more characters than any previous symbol,
982 then store the symbol's index and note its size. */
983 if ( symbol[ isym ].size > size ) {
984 sym = isym;
985 size = symbol[ isym ].size;
986
987 /* Calculate the index of the last symbol character in the expression
988 string. */
989 iend = istart + size - 1;
990 }
991 }
992 }
993 }
994
995 /* If the symbol was identified as one of the standard symbols, then
996 validate it, updating the parenthesis level and argument count
997 information at the same time. */
998 if ( found ) {
999 ValidateSymbol( method, class, exprs, iend, sym, &lpar, &argcount,
1000 &opensym, &ncon, con, status );
1001
1002 /* If it was not one of the standard symbols, then check if the next
1003 symbol was expected to be an operator. If so, then there is a missing
1004 operator, so report an error. */
1005 } else {
1006 if ( opernext ) {
1007 astError( AST__MIOPR,
1008 "%s(%s): Missing or invalid operator in the expression "
1009 "\"%.*s\".", status,
1010 method, class, istart + 1, exprs );
1011
1012 /* If the next symbol was expected to be an operand, then it may be a
1013 constant, so try to parse it as one. */
1014 } else {
1015 ParseConstant( method, class, exprs, istart, &iend, &c, status );
1016 if ( astOK ) {
1017
1018 /* If successful, set the symbol number to "symbol_ldcon" (load
1019 constant) and extend the "*con" array to accommodate a new
1020 constant. Check for errors. */
1021 if ( iend >= istart ) {
1022 sym = symbol_ldcon;
1023 *con = astGrow( *con, ncon + 1, sizeof( double ) );
1024 if ( astOK ) {
1025
1026 /* Append the constant to the "*con" array. */
1027 ( *con )[ ncon++ ] = c;
1028 }
1029
1030 /* If the symbol did not parse as a constant, then it may be a
1031 variable name, so try to parse it as one. */
1032 } else {
1033 ParseVariable( method, class, exprs, istart, nvar, var,
1034 &ivar, &iend, status );
1035 if ( astOK ) {
1036
1037 /* If successful, set the symbol to "symbol_ldvar" (load variable) and
1038 extend the "*con" array to accommodate a new constant. Check for
1039 errors. */
1040 if ( ivar != -1 ) {
1041 sym = symbol_ldvar;
1042 *con = astGrow( *con, ncon + 1, sizeof( double ) );
1043 if ( astOK ) {
1044
1045 /* Append the variable identification number as a constant to the
1046 "*con" array. */
1047 ( *con )[ ncon++ ] = (double) ivar;
1048 }
1049
1050 /* If the expression did not parse as a variable name, then there is a
1051 missing operand in the expression, so report an error. */
1052 } else {
1053 astError( AST__MIOPA,
1054 "%s(%s): Missing or invalid operand in the "
1055 "expression \"%.*s\".", status,
1056 method, class, istart + 1, exprs );
1057 }
1058 }
1059 }
1060 }
1061 }
1062 }
1063
1064 /* If there has been no error, then the next symbol in the input
1065 expression has been identified and is valid. */
1066 if ( astOK ) {
1067
1068 /* Decide whether the next symbol should look like an operator or an
1069 operand from the left. This is determined by the nature of the symbol
1070 just identified (seen from the right) - two operands or two operators
1071 cannot be adjacent. */
1072 opernext = !symbol[ sym ].operright;
1073
1074 /* Also decide whether the next symbol may be a unary +/- operator,
1075 according to the "unarynext" symbol data entry for the symbol just
1076 identified. */
1077 unarynext = symbol[ sym ].unarynext;
1078
1079 /* Extend the "symlist" array to accommodate the symbol just
1080 identified. Check for errors. */
1081 symlist = astGrow( symlist, nsym + 1, sizeof( int ) );
1082 if ( astOK ) {
1083
1084 /* Append the symbol's index to the end of this list. */
1085 symlist[ nsym++ ] = sym;
1086 }
1087 }
1088 }
1089
1090 /* If there has been no error, check the final context after
1091 identifying all the symbols... */
1092 if ( astOK ) {
1093
1094 /* If an operand is still expected, then there is an unsatisfied
1095 operator on the end of the expression, so report an error. */
1096 if ( !opernext ) {
1097 astError( AST__MIOPA,
1098 "%s(%s): Missing or invalid operand in the expression "
1099 "\"%s\".", status,
1100 method, class, exprs );
1101
1102 /* If the final parenthesis level is positive, then there is a missing
1103 right parenthesis, so report an error. */
1104 } else if ( lpar > 0 ) {
1105 astError( AST__MRPAR,
1106 "%s(%s): Missing right parenthesis in the expression "
1107 "\"%s\".", status,
1108 method, class, exprs );
1109 }
1110 }
1111
1112 /* Sort the symbols into evaluation order to produce output opcodes. */
1113 EvaluationSort( *con, nsym, symlist, code, stacksize, status );
1114
1115 /* Free any memory used as workspace. */
1116 if ( argcount ) argcount = astFree( argcount );
1117 if ( opensym ) opensym = astFree( opensym );
1118 if ( symlist ) symlist = astFree( symlist );
1119
1120 /* If OK, re-allocate the "*con" array to have the correct size (since
1121 astGrow may have over-allocated space). */
1122 if ( astOK && *con ) {
1123 *con = astRealloc( *con, sizeof( double ) * (size_t) ncon );
1124 }
1125
1126 /* If an error occurred, free any allocated memory and reset the
1127 output values. */
1128 if ( !astOK ) {
1129 *code = astFree( *code );
1130 *con = astFree( *con );
1131 *stacksize = 0;
1132 }
1133 }
1134
CompileMapping(const char * method,const char * class,int nin,int nout,int nfwd,const char * fwdfun[],int ninv,const char * invfun[],int *** fwdcode,int *** invcode,double *** fwdcon,double *** invcon,int * fwdstack,int * invstack,int * status)1135 static void CompileMapping( const char *method, const char *class,
1136 int nin, int nout,
1137 int nfwd, const char *fwdfun[],
1138 int ninv, const char *invfun[],
1139 int ***fwdcode, int ***invcode,
1140 double ***fwdcon, double ***invcon,
1141 int *fwdstack, int *invstack, int *status ) {
1142 /*
1143 * Name:
1144 * CompileMapping
1145
1146 * Purpose:
1147 * Compile the transformation functions for a MathMap.
1148
1149 * Type:
1150 * Private function.
1151
1152 * Synopsis:
1153 * #include "mathmap.h"
1154 * void CompileMapping( const char *method, const char *class,
1155 * int nin, int nout,
1156 * int nfwd, const char *fwdfun[],
1157 * int ninv, const char *invfun[],
1158 * int ***fwdcode, int ***invcode,
1159 * double ***fwdcon, double ***invcon,
1160 * int *fwdstack, int *invstack, int *status )
1161
1162 * Class Membership:
1163 * MathMap member function.
1164
1165 * Description:
1166 * This function checks and compiles the transformation functions required
1167 * to create a MathMap. It produces sequences of operation codes (opcodes)
1168 * and numerical constants which may subsequently be used to evaluate the
1169 * functions on a push-down stack.
1170
1171 * Parameters:
1172 * method
1173 * Pointer to a constant null-terminated character string
1174 * containing the name of the method that invoked this function.
1175 * This method name is used solely for constructing error messages.
1176 * class
1177 * Pointer to a constant null-terminated character string containing the
1178 * class name of the Object being processed. This name is used solely
1179 * for constructing error messages.
1180 * nin
1181 * Number of input variables for the MathMap.
1182 * nout
1183 * Number of output variables for the MathMap.
1184 * nfwd
1185 * The number of forward transformation functions being supplied.
1186 * This must be at least equal to "nout".
1187 * fwdfun
1188 * Pointer to an array, with "nfwd" elements, of pointers to null
1189 * terminated strings which contain each of the forward transformation
1190 * functions. These must be in lower case and should contain no white
1191 * space.
1192 * ninv
1193 * The number of inverse transformation functions being supplied.
1194 * This must be at least equal to "nin".
1195 * invfun
1196 * Pointer to an array, with "ninv" elements, of pointers to null
1197 * terminated strings which contain each of the inverse transformation
1198 * functions. These must be in lower case and should contain no white
1199 * space.
1200 * fwdcode
1201 * Address in which to return a pointer to an array (with "nfwd"
1202 * elements) of pointers to arrays of int containing the set of opcodes
1203 * (cast to int) for each forward transformation function. The number
1204 * of opcodes produced for each function is given by the first element
1205 * of the opcode array.
1206 *
1207 * Both the returned array of pointers, and the arrays of int to which
1208 * they point, will be stored in dynamically allocated memory and should
1209 * be freed by the caller (using astFree) when no longer required.
1210 *
1211 * If the right hand sides (including the "=" sign) of all the supplied
1212 * functions are absent, then this indicates an undefined transformation
1213 * and the returned pointer value will be NULL. An error results if
1214 * an "=" sign is present but no expression follows it.
1215 * invcode
1216 * Address in which to return a pointer to an array (with "ninv"
1217 * elements) of pointers to arrays of int containing the set of opcodes
1218 * (cast to int) for each inverse transformation function. The number
1219 * of opcodes produced for each function is given by the first element
1220 * of the opcode array.
1221 *
1222 * Both the returned array of pointers, and the arrays of int to which
1223 * they point, will be stored in dynamically allocated memory and should
1224 * be freed by the caller (using astFree) when no longer required.
1225 *
1226 * If the right hand sides (including the "=" sign) of all the supplied
1227 * functions are absent, then this indicates an undefined transformation
1228 * and the returned pointer value will be NULL. An error results if
1229 * an "=" sign is present but no expression follows it.
1230 * fwdcon
1231 * Address in which to return a pointer to an array (with "nfwd"
1232 * elements) of pointers to arrays of double containing the set of
1233 * constants for each forward transformation function.
1234 *
1235 * Both the returned array of pointers, and the arrays of double to which
1236 * they point, will be stored in dynamically allocated memory and should
1237 * be freed by the caller (using astFree) when no longer required. Note
1238 * that any of the pointers to the arrays of double may be NULL if no
1239 * constants are associated with a particular function.
1240 *
1241 * If the forward transformation is undefined, then the returned pointer
1242 * value will be NULL.
1243 * invcon
1244 * Address in which to return a pointer to an array (with "ninv"
1245 * elements) of pointers to arrays of double containing the set of
1246 * constants for each inverse transformation function.
1247 *
1248 * Both the returned array of pointers, and the arrays of double to which
1249 * they point, will be stored in dynamically allocated memory and should
1250 * be freed by the caller (using astFree) when no longer required. Note
1251 * that any of the pointers to the arrays of double may be NULL if no
1252 * constants are associated with a particular function.
1253 *
1254 * If the inverse transformation is undefined, then the returned pointer
1255 * value will be NULL.
1256 * fwdstack
1257 * Pointer to an int in which to return the size of the push-down stack
1258 * required to evaluate the forward transformation functions.
1259 * invstack
1260 * Pointer to an int in which to return the size of the push-down stack
1261 * required to evaluate the inverse transformation functions.
1262 * status
1263 * Pointer to the inherited status variable.
1264
1265 * Notes:
1266 * - A value of NULL will be returned for the "*fwdcode", "*invcode",
1267 * "*fwdcon" and "*invcon" pointers and a value of zero will be returned
1268 * for the "*fwdstack" and "*invstack" values if this function is invoked
1269 * with the global error status set, or if it should fail for any reason.
1270 */
1271
1272 /* Local Variables: */
1273 char **exprs; /* Pointer to array of expressions */
1274 char **var; /* Pointer to array of variable names */
1275 const char **strings; /* Pointer to temporary array of strings */
1276 int ifun; /* Loop counter for functions */
1277 int nvar; /* Number of variables to extract */
1278 int stacksize; /* Required stack size */
1279
1280 /* Initialise. */
1281 *fwdcode = NULL;
1282 *invcode = NULL;
1283 *fwdcon = NULL;
1284 *invcon = NULL;
1285 *fwdstack = 0;
1286 *invstack = 0;
1287 nvar = 0;
1288
1289 /* Check the global error status. */
1290 if ( !astOK ) return;
1291
1292 /* Further initialisation. */
1293 exprs = NULL;
1294 var = NULL;
1295
1296 /* Compile the forward transformation. */
1297 /* ----------------------------------- */
1298 /* Allocate space for an array of pointers to the functions from which
1299 we will extract variable names. */
1300 strings = astMalloc( sizeof( char * ) * (size_t) ( nin + nfwd ) );
1301
1302 /* Fill the first elements of this array with pointers to the inverse
1303 transformation functions ("nin" in number) which yield the final input
1304 values. These will have the names of the input variables on their left
1305 hand sides. */
1306 if ( astOK ) {
1307 nvar = 0;
1308 for ( ifun = ninv - nin; ifun < ninv; ifun++ ) {
1309 strings[ nvar++ ] = invfun[ ifun ];
1310 }
1311
1312 /* Fill the remaining elements of the array with pointers to the
1313 forward transformation functions. These will have the names of any
1314 intermediate variables plus the final output variables on their left
1315 hand sides. */
1316 for ( ifun = 0; ifun < nfwd; ifun++ ) strings[ nvar++ ] = fwdfun[ ifun ];
1317
1318 /* Extract the variable names from the left hand sides of these
1319 functions and check them for validity and absence of duplication. */
1320 ExtractVariables( method, class, nvar, strings, nin, nout, nfwd, ninv, 1,
1321 &var, status );
1322 }
1323
1324 /* Free the temporary array of string pointers. */
1325 strings = astFree( strings );
1326
1327 /* Extract the expressions from the right hand sides of the forward
1328 transformation functions. */
1329 ExtractExpressions( method, class, nfwd, fwdfun, 1, &exprs, status );
1330
1331 /* If OK, and the forward transformation is defined, then allocate and
1332 initialise space for an array of pointers to the opcodes for each
1333 expression and, similarly, for the constants for each expression. */
1334 if ( astOK && exprs ) {
1335 MALLOC_POINTER_ARRAY( *fwdcode, int *, nfwd )
1336 MALLOC_POINTER_ARRAY( *fwdcon, double *, nfwd )
1337
1338 /* If OK, loop to compile each of the expressions, storing pointers to
1339 the resulting opcodes and constants in the arrays allocated above. On
1340 each loop, we make progressively more of the variable names in "var"
1341 visible to the compilation function. This ensures that each expression
1342 can only use variables which have been defined earlier. */
1343 if ( astOK ) {
1344 for ( ifun = 0; ifun < nfwd; ifun++ ) {
1345 CompileExpression( method, class, exprs[ ifun ],
1346 nin + ifun, (const char **) var,
1347 &( *fwdcode )[ ifun ], &( *fwdcon )[ ifun ],
1348 &stacksize, status );
1349
1350 /* If an error occurs, then report contextual information and quit. */
1351 if ( !astOK ) {
1352 astError( astStatus,
1353 "Error in forward transformation function %d.", status,
1354 ifun + 1 );
1355 break;
1356 }
1357
1358 /* If OK, calculate the maximum evaluation stack size required by any
1359 of the expressions. */
1360 *fwdstack = ( *fwdstack > stacksize ) ? *fwdstack : stacksize;
1361 }
1362 }
1363 }
1364
1365 /* Free the memory containing the extracted expressions and variables. */
1366 FREE_POINTER_ARRAY( exprs, nfwd )
1367 FREE_POINTER_ARRAY( var, nvar )
1368
1369 /* Compile the inverse transformation. */
1370 /* ----------------------------------- */
1371 /* Allocate space for an array of pointers to the functions from which
1372 we will extract variable names. */
1373 strings = astMalloc( sizeof( char * ) * (size_t) ( nout + ninv ) );
1374
1375 /* Fill the first elements of this array with pointers to the forward
1376 transformation functions ("nout" in number) which yield the final
1377 output values. These will have the names of the output variables on
1378 their left hand sides. */
1379 if ( astOK ) {
1380 nvar = 0;
1381 for ( ifun = nfwd - nout; ifun < nfwd; ifun++ ) {
1382 strings[ nvar++ ] = fwdfun[ ifun ];
1383 }
1384
1385 /* Fill the remaining elements of the array with pointers to the
1386 inverse transformation functions. These will have the names of any
1387 intermediate variables plus the final input variables on their left
1388 hand sides. */
1389 for ( ifun = 0; ifun < ninv; ifun++ ) strings[ nvar++ ] = invfun[ ifun ];
1390
1391 /* Extract the variable names from the left hand sides of these
1392 functions and check them for validity and absence of duplication. */
1393 ExtractVariables( method, class, nvar, strings, nin, nout, nfwd, ninv, 0,
1394 &var, status );
1395 }
1396
1397 /* Free the temporary array of string pointers. */
1398 strings = astFree( strings );
1399
1400 /* Extract the expressions from the right hand sides of the inverse
1401 transformation functions. */
1402 ExtractExpressions( method, class, ninv, invfun, 0, &exprs, status );
1403
1404 /* If OK, and the forward transformation is defined, then allocate and
1405 initialise space for an array of pointers to the opcodes for each
1406 expression and, similarly, for the constants for each expression. */
1407 if ( astOK && exprs ) {
1408 MALLOC_POINTER_ARRAY( *invcode, int *, ninv )
1409 MALLOC_POINTER_ARRAY( *invcon, double *, ninv )
1410
1411 /* If OK, loop to compile each of the expressions, storing pointers to
1412 the resulting opcodes and constants in the arrays allocated above. On
1413 each loop, we make progressively more of the variable names in "var"
1414 visible to the compilation function. This ensures that each expression
1415 can only use variables which have been defined earlier. */
1416 if ( astOK ) {
1417 for ( ifun = 0; ifun < ninv; ifun++ ) {
1418 CompileExpression( method, class, exprs[ ifun ],
1419 nout + ifun, (const char **) var,
1420 &( *invcode )[ ifun ], &( *invcon )[ ifun ],
1421 &stacksize, status );
1422
1423 /* If an error occurs, then report contextual information and quit. */
1424 if ( !astOK ) {
1425 astError( astStatus,
1426 "Error in inverse transformation function %d.", status,
1427 ifun + 1 );
1428 break;
1429 }
1430
1431 /* If OK, calculate the maximum evaluation stack size required by any
1432 of the expressions. */
1433 *invstack = ( *invstack > stacksize ) ? *invstack : stacksize;
1434 }
1435 }
1436 }
1437
1438 /* Free the memory containing the extracted expressions and variables. */
1439 FREE_POINTER_ARRAY( exprs, ninv )
1440 FREE_POINTER_ARRAY( var, nvar )
1441
1442 /* If an error occurred, then free all remaining allocated memory and
1443 reset the output values. */
1444 if ( !astOK ) {
1445 FREE_POINTER_ARRAY( *fwdcode, nfwd )
1446 FREE_POINTER_ARRAY( *invcode, ninv )
1447 FREE_POINTER_ARRAY( *fwdcon, nfwd )
1448 FREE_POINTER_ARRAY( *invcon, ninv )
1449 *fwdstack = 0;
1450 *invstack = 0;
1451 }
1452 }
1453
DefaultSeed(const Rcontext * context,int * status)1454 static int DefaultSeed( const Rcontext *context, int *status ) {
1455 /*
1456 * Name:
1457 * DefaultSeed
1458
1459 * Purpose:
1460 * Generate an unpredictable seed for a random number generator.
1461
1462 * Type:
1463 * Private function.
1464
1465 * Synopsis:
1466 * #include "mathmap.h"
1467 * int DefaultSeed( Rcontext *context, int *status )
1468
1469 * Class Membership:
1470 * MathMap member function.
1471
1472 * Description:
1473 * On each invocation this function returns an integer value which is
1474 * highly unpredictable. This value may be used as a default seed for the
1475 * random number generator associated with a MathMap, so that it
1476 * generates a different sequence on each occasion.
1477
1478 * Parameters:
1479 * context
1480 * Pointer to the random number generator context associated with
1481 * the MathMap.
1482 * status
1483 * Pointer to the inherited status variable.
1484
1485 * Returned Value:
1486 * The unpredictable integer.
1487
1488 * Notes:
1489 * - This function does not perform error checking and will execute even
1490 * if the global error status is set.
1491 */
1492
1493 /* Local Constants: */
1494 const int nwarm = 5; /* Number of warm-up iterations */
1495 const long int a = 8121L; /* Constants for random number generator... */
1496 const long int c = 28411L;
1497 const long int m = 134456L;
1498
1499 /* Local Variables; */
1500 int iwarm; /* Loop counter for warm-up iterations */
1501 static long init = 0; /* Local initialisation performed? */
1502 static long int rand; /* Local random integer */
1503 unsigned long int bits; /* Bit pattern for producing result */
1504
1505 /* On the first invocation, initialise a local random number generator
1506 to a value derived by combining bit patterns obtained from the system
1507 clock and the processor time used. The result needs to be positive and
1508 lie in the range 0 to "m-1". */
1509 LOCK_MUTEX5
1510 if ( !init ) {
1511 rand = (long int) ( ( (unsigned long int) time( NULL ) ^
1512 (unsigned long int) clock() ) %
1513 (unsigned long int) m );
1514
1515 /* These values will typically only change in their least significant
1516 bits between programs run successively, but by using the bit pattern
1517 as a seed, we ensure that these differences are rapidly propagated to
1518 other bits. To hasten this process, we "warm up" the local generator
1519 with a few iterations. This is a quick and dirty generator using
1520 constants from Press et al. (Numerical recipes). */
1521 for ( iwarm = 0; iwarm < nwarm; iwarm++ ) {
1522 rand = ( rand * a + c ) % m;
1523 }
1524
1525 /* Note that this initialisation has been performed. */
1526 init = 1;
1527 }
1528 UNLOCK_MUTEX5
1529
1530 /* Generate a new bit pattern from the system time. Apart from the
1531 first invocation, this will be a different time to that used above. */
1532 bits = (unsigned long int) time( NULL );
1533
1534 /* Mask in a pattern derived from the CPU time used. */
1535 bits ^= (unsigned long int) clock();
1536
1537 /* The system time may change quite slowly (e.g. every second), so
1538 also mask in the address of the random number generator context
1539 supplied. This makes the seed depend on which MathMap is in use. */
1540 bits ^= (unsigned long int) context;
1541
1542 /* Now mask in the last random integer produced by the random number
1543 generator whose context has been supplied. This makes the seed depend
1544 on the MathMap's past use of random numbers. */
1545 bits ^= (unsigned long int) context->random_int;
1546
1547 /* Finally, in order to produce different seeds when this function is
1548 invoked twice in rapid succession on the same object (with no
1549 intermediate processing), we also mask in a pseudo-random value
1550 generated here. Generate the next local random integer. */
1551 rand = ( rand * a + c ) % m;
1552
1553 /* We then scale this value to give an integer in the range 0 to
1554 ULONG_MAX and mask the corresponding bit pattern into our seed. */
1555 bits ^= (unsigned long int) ( ( (double) rand / (double) ( m - 1UL ) ) *
1556 ( ( (double) ULONG_MAX + 1.0 ) *
1557 ( 1.0 - DBL_EPSILON ) ) );
1558
1559 /* Return the integer value of the seed (which may involve discarding
1560 some unwanted bits). */
1561 return (int) bits;
1562 }
1563
Equal(AstObject * this_object,AstObject * that_object,int * status)1564 static int Equal( AstObject *this_object, AstObject *that_object, int *status ) {
1565 /*
1566 * Name:
1567 * Equal
1568
1569 * Purpose:
1570 * Test if two MathMaps are equivalent.
1571
1572 * Type:
1573 * Private function.
1574
1575 * Synopsis:
1576 * #include "mapping.h"
1577 * int Equal( AstObject *this, AstObject *that, int *status )
1578
1579 * Class Membership:
1580 * MathMap member function (over-rides the astEqual protected
1581 * method inherited from the Object class).
1582
1583 * Description:
1584 * This function returns a boolean result (0 or 1) to indicate whether
1585 * two MathMaps are equivalent.
1586
1587 * Parameters:
1588 * this
1589 * Pointer to the first Object (a MathMap).
1590 * that
1591 * Pointer to the second Object.
1592 * status
1593 * Pointer to the inherited status variable.
1594
1595 * Returned Value:
1596 * One if the MathMaps are equivalent, zero otherwise.
1597
1598 * Notes:
1599 * - The two MathMaps are considered equivalent if the combination of
1600 * the first in series with the inverse of the second simplifies to a
1601 * UnitMap.
1602 * - A value of zero will be returned if this function is invoked
1603 * with the global status set, or if it should fail for any reason.
1604 */
1605
1606 /* Local Variables: */
1607 AstMathMap *that; /* Pointer to the second MathMap structure */
1608 AstMathMap *this; /* Pointer to the first MathMap structure */
1609 double **that_con; /* Lists of constants from "that" */
1610 double **this_con; /* Lists of constants from "this" */
1611 int **that_code; /* Lists of opcodes from "that" */
1612 int **this_code; /* Lists of opcodes from "this" */
1613 int code; /* Opcode value */
1614 int icode; /* Opcode index */
1615 int icon; /* Constant index */
1616 int ifun; /* Function index */
1617 int ncode; /* No. of opcodes for current "this" function */
1618 int ncode_that; /* No. of opcodes for current "that" function */
1619 int nin; /* Number of inputs */
1620 int nout; /* Number of outputs */
1621 int pass; /* Check fwd or inv */
1622 int result; /* Result value to return */
1623 int that_nfun; /* Number of functions from "that" */
1624 int this_nfun; /* Number of functions from "this" */
1625
1626 /* Initialise. */
1627 result = 0;
1628
1629 /* Check the global error status. */
1630 if ( !astOK ) return result;
1631
1632 /* Obtain pointers to the two MathMap structures. */
1633 this = (AstMathMap *) this_object;
1634 that = (AstMathMap *) that_object;
1635
1636 /* Check the second object is a MathMap. We know the first is a
1637 MathMap since we have arrived at this implementation of the virtual
1638 function. */
1639 if( astIsAMathMap( that ) ) {
1640
1641 /* Check they have the same number of inputs and outputs */
1642 nin = astGetNin( this );
1643 nout = astGetNout( this );
1644 if( astGetNout( that ) == nout && astGetNin( that ) == nin ) {
1645
1646 /* Assume equality. */
1647 result = 1;
1648
1649 /* The first pass through this next loop compares forward functions, and
1650 the second pass compares inverse functions. */
1651 for( pass = 0; pass < 2 && result; pass++ ) {
1652
1653 /* On the first pass, get pointers to the lists of opcodes and constants for
1654 the effective forward transformations (taking into account the value
1655 of the Invert attribute), together with the number of such functions. */
1656 if( pass == 0 ) {
1657 if( !astGetInvert( this ) ) {
1658 this_code = this->fwdcode;
1659 this_con = this->fwdcon;
1660 this_nfun = this->nfwd;
1661 } else {
1662 this_code = this->invcode;
1663 this_con = this->invcon;
1664 this_nfun = this->ninv;
1665 }
1666
1667 if( !astGetInvert( that ) ) {
1668 that_code = that->fwdcode;
1669 that_con = that->fwdcon;
1670 that_nfun = that->nfwd;
1671 } else {
1672 that_code = that->invcode;
1673 that_con = that->invcon;
1674 that_nfun = that->ninv;
1675 }
1676
1677 /* On the second pass, get pointers to the lists of opcodes and constants for
1678 the effective inverse transformations, together with the number of such
1679 functions. */
1680 } else {
1681
1682 if( astGetInvert( this ) ) {
1683 this_code = this->fwdcode;
1684 this_con = this->fwdcon;
1685 this_nfun = this->nfwd;
1686 } else {
1687 this_code = this->invcode;
1688 this_con = this->invcon;
1689 this_nfun = this->ninv;
1690 }
1691
1692 if( astGetInvert( that ) ) {
1693 that_code = that->fwdcode;
1694 that_con = that->fwdcon;
1695 that_nfun = that->nfwd;
1696 } else {
1697 that_code = that->invcode;
1698 that_con = that->invcon;
1699 that_nfun = that->ninv;
1700 }
1701 }
1702
1703 /* Check that "this" and "that" have the same number of functions */
1704 if( that_nfun != this_nfun ) result = 0;
1705
1706 /* Loop round each function. */
1707 for( ifun = 0; ifun < this_nfun && result; ifun++ ) {
1708
1709 /* The first element in the opcode array is the number of subsequent
1710 opcodes. Obtain and compare these counts. */
1711 ncode = this_code ? this_code[ ifun ][ 0 ] : 0;
1712 ncode_that = that_code ? that_code[ ifun ][ 0 ] : 0;
1713 if( ncode != ncode_that ) result = 0;
1714
1715 /* Compare the following opcodes. Some opcodes consume constants from the
1716 list of constants associated with the MathMap. Compare the constants
1717 for such opcodes. */
1718 icon = 0;
1719 for( icode = 0; icode < ncode && result; icode++ ){
1720 code = this_code[ ifun ][ icode ];
1721 if( that_code[ ifun ][ icode ] != code ) {
1722 result = 0;
1723
1724 } else if( code == OP_LDCON ||
1725 code == OP_LDVAR ||
1726 code == OP_MAX ||
1727 code == OP_MIN ) {
1728
1729 if( this_con[ ifun ][ icon ] !=
1730 that_con[ ifun ][ icon ] ) {
1731 result = 0;
1732 } else {
1733 icon++;
1734 }
1735 }
1736 }
1737 }
1738 }
1739 }
1740 }
1741
1742 /* If an error occurred, clear the result value. */
1743 if ( !astOK ) result = 0;
1744
1745 /* Return the result, */
1746 return result;
1747 }
1748
EvaluateFunction(Rcontext * rcontext,int npoint,const double ** ptr_in,const int * code,const double * con,int stacksize,double * out,int * status)1749 static void EvaluateFunction( Rcontext *rcontext, int npoint,
1750 const double **ptr_in, const int *code,
1751 const double *con, int stacksize, double *out, int *status ) {
1752 /*
1753 * Name:
1754 * EvaluateFunction
1755
1756 * Purpose:
1757 * Evaluate a compiled function.
1758
1759 * Type:
1760 * Private function.
1761
1762 * Synopsis:
1763 * #include "mathmap.h"
1764 * void EvaluateFunction( Rcontext *rcontext, int npoint,
1765 * const double **ptr_in, const int *code,
1766 * const double *con, int stacksize, double *out, int *status )
1767
1768 * Class Membership:
1769 * MathMap member function.
1770
1771 * Description:
1772 * This function implements a "virtual machine" which executes operations
1773 * on an arithmetic stack in order to evaluate transformation functions.
1774 * Each operation is specified by an input operation code (opcode) and
1775 * results in the execution of a vector operation on a stack. The final
1776 * result, after executing all the supplied opcodes, is returned as a
1777 * vector.
1778 *
1779 * This function detects arithmetic errors (such as overflow and division
1780 * by zero) and propagates any "bad" coordinate values, including those
1781 * present in the input, to the output.
1782
1783 * Parameters:
1784 * npoint
1785 * The number of points to be transformd (i.e. the size of the vector
1786 * of values on which operations are to be performed).
1787 * ptr_in
1788 * Pointer to an array of pointers to arrays of double (with "npoint"
1789 * elements). These arrays should contain the input coordinate values,
1790 * such that coordinate number "coord" for point number "point" can be
1791 * found in "ptr_in[coord][point]".
1792 * code
1793 * Pointer to an array of int containing the set of opcodes (cast to int)
1794 * for the operations to be performed. The first element of this array
1795 * should contain a count of the number of opcodes which follow.
1796 * con
1797 * Pointer to an array of double containing the set of constants required
1798 * to evaluate the function (this may be NULL if no constants are
1799 * required).
1800 * stacksize
1801 * The size of the stack required to evaluate the expression using the
1802 * opcodes and constants supplied. This value should be calculated during
1803 * expression compilation.
1804 * out
1805 * Pointer to an array of double (with "npoint" elements) in which to
1806 * return the vector of result values.
1807 * status
1808 * Pointer to the inherited status variable.
1809 */
1810
1811 /* Local Constants: */
1812 const int bits = /* Number of bits in an unsigned long */
1813 sizeof( unsigned long ) * CHAR_BIT;
1814 const double eps = /* Smallest number subtractable from 2.0 */
1815 2.0 * DBL_EPSILON;
1816 const double scale = /* 2.0 raised to the power "bits" */
1817 ldexp( 1.0, bits );
1818 const double scale1 = /* 2.0 raised to the power "bits-1" */
1819 scale * 0.5;
1820 const double rscale = /* Reciprocal scale factor */
1821 1.0 / scale;
1822 const double rscale1 = /* Reciprocal initial scale factor */
1823 1.0 / scale1;
1824 const int nblock = /* Number of blocks of bits to process */
1825 ( sizeof( double ) + sizeof( unsigned long ) - 1 ) /
1826 sizeof( unsigned long );
1827 const unsigned long signbit = /* Mask for extracting sign bit */
1828 1UL << ( bits - 1 );
1829
1830 /* Local Variables: */
1831 double **stack; /* Array of pointers to stack elements */
1832 double *work; /* Pointer to stack workspace */
1833 double *xv1; /* Pointer to first argument vector */
1834 double *xv2; /* Pointer to second argument vector */
1835 double *xv3; /* Pointer to third argument vector */
1836 double *xv; /* Pointer to sole argument vector */
1837 double *y; /* Pointer to result */
1838 double *yv; /* Pointer to result vector */
1839 double abs1; /* Absolute value (temporary variable) */
1840 double abs2; /* Absolute value (temporary variable) */
1841 double frac1; /* First (maybe normalised) fraction */
1842 double frac2; /* Second (maybe normalised) fraction */
1843 double frac; /* Sole normalised fraction */
1844 double newexp; /* New power of 2 exponent value */
1845 double ran; /* Random number */
1846 double result; /* Function result value */
1847 double unscale; /* Factor for removing scaling */
1848 double value; /* Value to be assigned to stack vector */
1849 double x1; /* First argument value */
1850 double x2; /* Second argument value */
1851 double x3; /* Third argument value */
1852 double x; /* Sole argument value */
1853 int expon1; /* First power of 2 exponent */
1854 int expon2; /* Second power of 2 exponent */
1855 int expon; /* Sole power of 2 exponent */
1856 int iarg; /* Loop counter for arguments */
1857 int iblock; /* Loop counter for blocks of bits */
1858 int icode; /* Opcode value */
1859 int icon; /* Counter for number of constants used */
1860 int istk; /* Loop counter for stack elements */
1861 int ivar; /* Input variable number */
1862 int narg; /* Number of function arguments */
1863 int ncode; /* Number of opcodes to process */
1864 int point; /* Loop counter for stack vector elements */
1865 int sign; /* Argument is non-negative? */
1866 int tos; /* Top of stack index */
1867 static double d2r; /* Degrees to radians conversion factor */
1868 static double log2; /* Natural logarithm of 2.0 */
1869 static double pi; /* Value of PI */
1870 static double r2d; /* Radians to degrees conversion factor */
1871 static double rsafe_sq; /* Reciprocal of "safe_sq" */
1872 static double safe_sq; /* Huge value that can safely be squared */
1873 static int init = 0; /* Initialisation performed? */
1874 unsigned long b1; /* Block of bits from first argument */
1875 unsigned long b2; /* Block of bits from second argument */
1876 unsigned long b; /* Block of bits for result */
1877 unsigned long neg; /* Result is negative? (sign bit) */
1878
1879 /* Check the global error status. */
1880 if ( !astOK ) return;
1881
1882 /* If this is the first invocation of this function, then initialise
1883 constant values. */
1884 LOCK_MUTEX2
1885 if ( !init ) {
1886
1887 /* Trigonometrical conversion factors. */
1888 pi = acos( -1.0 );
1889 r2d = 180.0 / pi;
1890 d2r = pi / 180.0;
1891
1892 /* Natural logarithm of 2.0. */
1893 log2 = log( 2.0 );
1894
1895 /* This value must be safe to square without producing overflow, yet
1896 large enough that adding or subtracting 1.0 from the square makes no
1897 difference. We also need its reciprocal. */
1898 safe_sq = 0.9 * sqrt( DBL_MAX );
1899 rsafe_sq = 1.0 / safe_sq;
1900
1901 /* Note that initialisation has been performed. */
1902 init = 1;
1903 }
1904 UNLOCK_MUTEX2
1905
1906 /* Allocate space for an array of pointers to elements of the
1907 workspace stack (each stack element being an array of double). */
1908 stack = astMalloc( sizeof( double * ) * (size_t) stacksize );
1909
1910 /* Allocate space for the stack itself. */
1911 work = astMalloc( sizeof( double ) *
1912 (size_t) ( npoint * ( stacksize - 1 ) ) );
1913
1914 /* If OK, then initialise the stack pointer array to identify the
1915 start of each vector on the stack. The first element points at the
1916 output array (in which the result will be accumulated), while other
1917 elements point at successive vectors within the workspace allocated
1918 above. */
1919 if ( astOK ) {
1920 stack[ 0 ] = out;
1921 for ( istk = 1; istk < stacksize; istk++ ) {
1922 stack[ istk ] = work + ( istk - 1 ) * npoint;
1923 }
1924
1925 /* Define stack operations. */
1926 /* ======================== */
1927 /* We now define a set of macros for performing vector operations on
1928 elements of the stack. Each is in the form of a "case" block for
1929 execution in response to the appropriate operation code (opcode). */
1930
1931 /* Zero-argument operation. */
1932 /* ------------------------ */
1933 /* This macro performs a zero-argument operation, which results in the
1934 insertion of a new vector on to the stack. */
1935 #define ARG_0(oper,setup,function) \
1936 \
1937 /* Test for the required opcode value. */ \
1938 case oper: \
1939 \
1940 /* Perform any required initialisation. */ \
1941 {setup;} \
1942 \
1943 /* Increment the top of stack index and obtain a pointer to the new stack \
1944 element (vector). */ \
1945 yv = stack[ ++tos ]; \
1946 \
1947 /* Loop to access each vector element, obtaining a pointer to it. */ \
1948 for ( point = 0; point < npoint; point++ ) { \
1949 y = yv + point; \
1950 \
1951 /* Perform the processing, which results in assignment to this element. */ \
1952 {function;} \
1953 } \
1954 \
1955 /* Break out of the "case" block. */ \
1956 break;
1957
1958 /* One-argument operation. */
1959 /* ----------------------- */
1960 /* This macro performs a one-argument operation, which processes the
1961 top stack element without changing the stack size. */
1962 #define ARG_1(oper,function) \
1963 \
1964 /* Test for the required opcode value. */ \
1965 case oper: \
1966 \
1967 /* Obtain a pointer to the top stack element (vector). */ \
1968 xv = stack[ tos ]; \
1969 \
1970 /* Loop to access each vector element, obtaining its value and \
1971 checking that it is not bad. */ \
1972 for ( point = 0; point < npoint; point++ ) { \
1973 if ( ( x = xv[ point ] ) != AST__BAD ) { \
1974 \
1975 /* Also obtain a pointer to the element. */ \
1976 y = xv + point; \
1977 \
1978 /* Perform the processing, which uses the element's value and then \
1979 assigns the result to this element. */ \
1980 {function;} \
1981 } \
1982 } \
1983 \
1984 /* Break out of the "case" block. */ \
1985 break;
1986
1987 /* One-argument boolean operation. */
1988 /* ------------------------------- */
1989 /* This macro is similar in function to ARG_1 above, except that no
1990 checks are made for bad argument values. It is intended for use with
1991 boolean functions where bad values are handled explicitly. */
1992 #define ARG_1B(oper,function) \
1993 \
1994 /* Test for the required opcode value. */ \
1995 case oper: \
1996 \
1997 /* Obtain a pointer to the top stack element (vector). */ \
1998 xv = stack[ tos ]; \
1999 \
2000 /* Loop to access each vector element, obtaining the argument value \
2001 and a pointer to the element. */ \
2002 for ( point = 0; point < npoint; point++ ) { \
2003 x = xv[ point ]; \
2004 y = xv + point; \
2005 \
2006 /* Perform the processing, which uses the element's value and then \
2007 assigns the result to this element. */ \
2008 {function;} \
2009 } \
2010 \
2011 /* Break out of the "case" block. */ \
2012 break;
2013
2014 /* Two-argument operation. */
2015 /* ----------------------- */
2016 /* This macro performs a two-argument operation, which processes the
2017 top two stack elements and produces a single result, resulting in the
2018 stack size decreasing by one. In this case, we first define a macro
2019 without the "case" block statements present. */
2020 #define DO_ARG_2(function) \
2021 \
2022 /* Obtain pointers to the top two stack elements (vectors), decreasing \
2023 the top of stack index by one. */ \
2024 xv2 = stack[ tos-- ]; \
2025 xv1 = stack[ tos ]; \
2026 \
2027 /* Loop to access each vector element, obtaining the value of the \
2028 first argument and checking that it is not bad. */ \
2029 for ( point = 0; point < npoint; point++ ) { \
2030 if ( ( x1 = xv1[ point ] ) != AST__BAD ) { \
2031 \
2032 /* Also obtain a pointer to the element which is to receive the \
2033 result. */ \
2034 y = xv1 + point; \
2035 \
2036 /* Obtain the value of the second argument, again checking that it is \
2037 not bad. */ \
2038 if ( ( x2 = xv2[ point ] ) != AST__BAD ) { \
2039 \
2040 /* Perform the processing, which uses the two argument values and then \
2041 assigns the result to the appropriate top of stack element. */ \
2042 {function;} \
2043 \
2044 /* If the second argument was bad, so is the result. */ \
2045 } else { \
2046 *y = AST__BAD; \
2047 } \
2048 } \
2049 }
2050
2051 /* This macro simply wraps the one above up in a "case" block. */
2052 #define ARG_2(oper,function) \
2053 case oper: \
2054 DO_ARG_2(function) \
2055 break;
2056
2057 /* Two-argument boolean operation. */
2058 /* ------------------------------- */
2059 /* This macro is similar in function to ARG_2 above, except that no
2060 checks are made for bad argument values. It is intended for use with
2061 boolean functions where bad values are handled explicitly. */
2062 #define ARG_2B(oper,function) \
2063 \
2064 /* Test for the required opcode value. */ \
2065 case oper: \
2066 \
2067 /* Obtain pointers to the top two stack elements (vectors), decreasing \
2068 the top of stack index by one. */ \
2069 xv2 = stack[ tos-- ]; \
2070 xv1 = stack[ tos ]; \
2071 \
2072 /* Loop to access each vector element, obtaining the value of both \
2073 arguments and a pointer to the element which is to receive the \
2074 result. */ \
2075 for ( point = 0; point < npoint; point++ ) { \
2076 x1 = xv1[ point ]; \
2077 x2 = xv2[ point ]; \
2078 y = xv1 + point; \
2079 \
2080 /* Perform the processing, which uses the two argument values and then \
2081 assigns the result to the appropriate top of stack element. */ \
2082 {function;} \
2083 } \
2084 \
2085 /* Break out of the "case" block. */ \
2086 break;
2087
2088 /* Three-argument boolean operation. */
2089 /* --------------------------------- */
2090 /* This macro is similar in function to ARG_2B above, except that it
2091 takes three values of the stack and puts one back. It performs no
2092 checks for bad values. */
2093 #define ARG_3B(oper,function) \
2094 \
2095 /* Test for the required opcode value. */ \
2096 case oper: \
2097 \
2098 /* Obtain pointers to the top three stack elements (vectors), decreasing \
2099 the top of stack index by two. */ \
2100 xv3 = stack[ tos-- ]; \
2101 xv2 = stack[ tos-- ]; \
2102 xv1 = stack[ tos ]; \
2103 \
2104 /* Loop to access each vector element, obtaining the value of all 3 \
2105 arguments and a pointer to the element which is to receive the \
2106 result. */ \
2107 for ( point = 0; point < npoint; point++ ) { \
2108 x1 = xv1[ point ]; \
2109 x2 = xv2[ point ]; \
2110 x3 = xv3[ point ]; \
2111 y = xv1 + point; \
2112 \
2113 /* Perform the processing, which uses the three argument values and then \
2114 assigns the result to the appropriate top of stack element. */ \
2115 {function;} \
2116 } \
2117 \
2118 /* Break out of the "case" block. */ \
2119 break;
2120
2121 /* Define arithmetic operations. */
2122 /* ============================= */
2123 /* We now define macros for performing some of the arithmetic
2124 operations we will require in a "safe" way - i.e. trapping numerical
2125 problems such as overflow and invalid arguments and translating them
2126 into the AST__BAD value. */
2127
2128 /* Absolute value. */
2129 /* --------------- */
2130 /* This is just shorthand. */
2131 #define ABS(x) ( ( (x) >= 0.0 ) ? (x) : -(x) )
2132
2133 /* Integer part. */
2134 /* ------------- */
2135 /* This implements rounding towards zero without involving conversion
2136 to an integer (which could overflow). */
2137 #define INT(x) ( ( (x) >= 0.0 ) ? floor( (x) ) : ceil( (x) ) )
2138
2139 /* Trap maths overflow. */
2140 /* -------------------- */
2141 /* This macro calls a C maths library function and checks for overflow
2142 in the result. */
2143 #define CATCH_MATHS_OVERFLOW(function) \
2144 ( \
2145 \
2146 /* Clear the "errno" value. */ \
2147 errno = 0, \
2148 \
2149 /* Evaluate the function. */ \
2150 result = (function), \
2151 \
2152 /* Check if "errno" and the returned result indicate overflow and \
2153 return the appropriate result. */ \
2154 ( ( errno == ERANGE ) && ( ABS( result ) == HUGE_VAL ) ) ? AST__BAD : \
2155 result \
2156 )
2157
2158 /* Trap maths errors. */
2159 /* ------------------ */
2160 /* This macro is similar to the one above, except that it also checks
2161 for domain errors (i.e. invalid argument values). */
2162 #define CATCH_MATHS_ERROR(function) \
2163 ( \
2164 \
2165 /* Clear the "errno" value. */ \
2166 errno = 0, \
2167 \
2168 /* Evaluate the function. */ \
2169 result = (function), \
2170 \
2171 /* Check if "errno" and the returned result indicate a domain error or \
2172 overflow and return the appropriate result. */ \
2173 ( ( errno == EDOM ) || \
2174 ( ( errno == ERANGE ) && ( ABS( result ) == HUGE_VAL ) ) ) ? \
2175 AST__BAD : result \
2176 )
2177
2178 /* Tri-state boolean OR. */
2179 /* --------------------- */
2180 /* This evaluates a boolean OR using tri-state logic. For example,
2181 "a||b" may evaluate to 1 if "a" is bad but "b" is non-zero, so that
2182 the normal rules of bad value propagation do not apply. */
2183 #define TRISTATE_OR(x1,x2) \
2184 \
2185 /* Test if the first argument is bad. */ \
2186 ( (x1) == AST__BAD ) ? ( \
2187 \
2188 /* If so, test the second argument. */ \
2189 ( ( (x2) == 0.0 ) || ( (x2) == AST__BAD ) ) ? AST__BAD : 1.0 \
2190 ) : ( \
2191 \
2192 /* Test if the second argument is bad. */ \
2193 ( (x2) == AST__BAD ) ? ( \
2194 \
2195 /* If so, test the first argument. */ \
2196 ( (x1) == 0.0 ) ? AST__BAD : 1.0 \
2197 \
2198 /* If neither argument is bad, use the normal OR operator. */ \
2199 ) : ( \
2200 ( (x1) != 0.0 ) || ( (x2) != 0.0 ) \
2201 ) \
2202 )
2203
2204 /* Tri-state boolean AND. */
2205 /* ---------------------- */
2206 /* This evaluates a boolean AND using tri-state logic. */
2207 #define TRISTATE_AND(x1,x2) \
2208 \
2209 /* Test if the first argument is bad. */ \
2210 ( (x1) == AST__BAD ) ? ( \
2211 \
2212 /* If so, test the second argument. */ \
2213 ( (x2) != 0.0 ) ? AST__BAD : 0.0 \
2214 ) : ( \
2215 \
2216 /* Test if the second argument is bad. */ \
2217 ( (x2) == AST__BAD ) ? ( \
2218 \
2219 /* If so, test the first argument. */ \
2220 ( (x1) != 0.0 ) ? AST__BAD : 0.0 \
2221 \
2222 /* If neither argument is bad, use the normal AND operator. */ \
2223 ) : ( \
2224 ( (x1) != 0.0 ) && ( (x2) != 0.0 ) \
2225 ) \
2226 )
2227
2228 /* Safe addition. */
2229 /* -------------- */
2230 /* This macro performs addition while avoiding possible overflow. */
2231 #define SAFE_ADD(x1,x2) ( \
2232 \
2233 /* Test if the first argument is non-negative. */ \
2234 ( (x1) >= 0.0 ) ? ( \
2235 \
2236 /* If so, then we can perform addition if the second argument is \
2237 non-positive. Otherwise, we must calculate the most positive safe \
2238 second argument value that can be added and test for this (the test \
2239 itself is safe against overflow). */ \
2240 ( ( (x2) <= 0.0 ) || ( ( (DBL_MAX) - (x1) ) >= (x2) ) ) ? ( \
2241 \
2242 /* Perform addition if it is safe, otherwise return AST__BAD. */ \
2243 (x1) + (x2) \
2244 ) : ( \
2245 AST__BAD \
2246 ) \
2247 \
2248 /* If the first argument is negative, then we can perform addition if \
2249 the second argument is non-negative. Otherwise, we must calculate the \
2250 most negative second argument value that can be added and test for \
2251 this (the test itself is safe against overflow). */ \
2252 ) : ( \
2253 ( ( (x2) >= 0.0 ) || ( ( (DBL_MAX) + (x1) ) >= -(x2) ) ) ? ( \
2254 \
2255 /* Perform addition if it is safe, otherwise return AST__BAD. */ \
2256 (x1) + (x2) \
2257 ) : ( \
2258 AST__BAD \
2259 ) \
2260 ) \
2261 )
2262
2263 /* Safe subtraction. */
2264 /* ----------------- */
2265 /* This macro performs subtraction while avoiding possible overflow. */
2266 #define SAFE_SUB(x1,x2) ( \
2267 \
2268 /* Test if the first argument is non-negative. */ \
2269 ( (x1) >= 0.0 ) ? ( \
2270 \
2271 /* If so, then we can perform subtraction if the second argument is \
2272 also non-negative. Otherwise, we must calculate the most negative safe \
2273 second argument value that can be subtracted and test for this (the \
2274 test itself is safe against overflow). */ \
2275 ( ( (x2) >= 0.0 ) || ( ( (DBL_MAX) - (x1) ) >= -(x2) ) ) ? ( \
2276 \
2277 /* Perform subtraction if it is safe, otherwise return AST__BAD. */ \
2278 (x1) - (x2) \
2279 ) : ( \
2280 AST__BAD \
2281 ) \
2282 \
2283 /* If the first argument is negative, then we can perform subtraction \
2284 if the second argument is non-positive. Otherwise, we must calculate \
2285 the most positive second argument value that can be subtracted and \
2286 test for this (the test itself is safe against overflow). */ \
2287 ) : ( \
2288 ( ( (x2) <= 0.0 ) || ( ( (DBL_MAX) + (x1) ) >= (x2) ) ) ? ( \
2289 \
2290 /* Perform subtraction if it is safe, otherwise return AST__BAD. */ \
2291 (x1) - (x2) \
2292 ) : ( \
2293 AST__BAD \
2294 ) \
2295 ) \
2296 )
2297
2298 /* Safe multiplication. */
2299 /* -------------------- */
2300 /* This macro performs multiplication while avoiding possible overflow. */
2301 #define SAFE_MUL(x1,x2) ( \
2302 \
2303 /* Multiplication is safe if the absolute value of either argument is \
2304 unity or less. Otherwise, we must use the first argument to calculate \
2305 the maximum absolute value that the second argument may have and test \
2306 for this (the test itself is safe against overflow). */ \
2307 ( ( ( abs1 = ABS( (x1) ) ) <= 1.0 ) || \
2308 ( ( abs2 = ABS( (x2) ) ) <= 1.0 ) || \
2309 ( ( (DBL_MAX) / abs1 ) >= abs2 ) ) ? ( \
2310 \
2311 /* Perform multiplication if it is safe, otherwise return AST__BAD. */ \
2312 (x1) * (x2) \
2313 ) : ( \
2314 AST__BAD \
2315 ) \
2316 )
2317
2318 /* Safe division. */
2319 /* -------------- */
2320 /* This macro performs division while avoiding possible overflow. */
2321 #define SAFE_DIV(x1,x2) ( \
2322 \
2323 /* Division is unsafe if the second argument is zero. Otherwise, it is \
2324 safe if the abolute value of the second argument is unity or \
2325 more. Otherwise, we must use the second argument to calculate the \
2326 maximum absolute value that the first argument may have and test for \
2327 this (the test itself is safe against overflow). */ \
2328 ( ( (x2) != 0.0 ) && \
2329 ( ( ( abs2 = ABS( (x2) ) ) >= 1.0 ) || \
2330 ( ( (DBL_MAX) * abs2 ) >= ABS( (x1) ) ) ) ) ? ( \
2331 \
2332 /* Perform division if it is safe, otherwise return AST__BAD. */ \
2333 (x1) / (x2) \
2334 ) : ( \
2335 AST__BAD \
2336 ) \
2337 )
2338
2339 /* Bit-shift operation. */
2340 /* -------------------- */
2341 /* This macro shifts the bits in a double value a specified number of
2342 places to the left, which simply corresponds to multiplying by the
2343 appropriate power of two. */
2344 #define SHIFT_BITS(x1,x2) ( \
2345 \
2346 /* Decompose the value into a normalised fraction and a power of 2. */ \
2347 frac = frexp( (x1), &expon ), \
2348 \
2349 /* Calculate the new power of 2 which should apply after the shift, \
2350 rounding towards zero to give an integer value. */ \
2351 newexp = INT( (x2) ) + (double) expon, \
2352 \
2353 /* If the new exponent is too negative to convert to an integer, then \
2354 the result must underflow to zero. */ \
2355 ( newexp < (double) -INT_MAX ) ? ( \
2356 0.0 \
2357 \
2358 /* Otherwise, if it is too positive to convert to an integer, then the \
2359 result must overflow, unless the normalised fraction is zero. */ \
2360 ) : ( ( newexp > (double) INT_MAX ) ? ( \
2361 ( frac == 0.0 ) ? 0.0 : AST__BAD \
2362 \
2363 /* Otherwise, convert the new exponent to an integer and apply \
2364 it. Trap any overflow which may still occur. */ \
2365 ) : ( \
2366 CATCH_MATHS_OVERFLOW( ldexp( frac, (int) newexp ) ) \
2367 ) ) \
2368 )
2369
2370 /* Two-argument bit-wise boolean operation. */
2371 /* ---------------------------------------- */
2372 /* This macro expands to code which performs a bit-wise boolean
2373 operation on a pair of arguments and assigns the result to the
2374 variable "result". It operates on floating point (double) values,
2375 which are regarded as if they are fixed-point binary numbers with
2376 negative values expressed in twos-complement notation. This means that
2377 it delivers the same results for integer values as the normal
2378 (integer) C bit-wise operations. However, it will also operate on the
2379 fraction bits of floating point numbers. It also offers greater
2380 precision (the first 53 or so significant bits of the result being
2381 preserved for typical IEEE floating point implementations). */
2382 #define BIT_OPER(oper,x1,x2) \
2383 \
2384 /* Convert each argument to a normalised fraction in the range \
2385 [0.5,1.0) and a power of two exponent, removing any sign \
2386 information. */ \
2387 frac1 = frexp( ABS( (x1) ), &expon1 ); \
2388 frac2 = frexp( ABS( (x2) ), &expon2 ); \
2389 \
2390 /* Set "expon" to be the larger of the two exponents. If the two \
2391 exponents are not equal, divide the fraction with the smaller exponent \
2392 by 2 to the power of the exponent difference. This gives both \
2393 fractions the same effective exponent (although one of them may no \
2394 longer be normalised). Note that overflow is avoided because all \
2395 numbers remain less than 1.0, but underflow may occur. */ \
2396 expon = expon1; \
2397 if ( expon2 > expon1 ) { \
2398 expon = expon2; \
2399 frac1 = ldexp( frac1, expon1 - expon ); \
2400 } else if ( expon1 > expon2 ) { \
2401 frac2 = ldexp( frac2, expon2 - expon ); \
2402 } \
2403 \
2404 /* If either of the original arguments is negative, we now subtract \
2405 the corresponding fraction from 2.0. If we think of the fraction as \
2406 represented in fixed-point binary notation, this corresponds to \
2407 converting negative numbers into the twos-complement form normally used \
2408 for integers (the sign bit being the bit with value 1) instead \
2409 of having a separate sign bit as for floating point numbers. \
2410 \
2411 Note that one of the fractions may have underflowed during the \
2412 scaling above. In that case (if the original argument was negative), \
2413 we must subtract the value "eps" (= 2.0 * DBL_EPSILON) from 2.0 \
2414 instead, so that we produce the largest number less than 2.0. In \
2415 twos-complement notation this represents the smallest possible \
2416 negative number and corresponds to extending the sign bit of the \
2417 original number up into more significant bits. This causes all bits to \
2418 be set as we require (rather than all being clear if the underflow \
2419 is simply ignored). */ \
2420 if ( (x1) < 0.0 ) frac1 = 2.0 - ( ( frac1 > eps ) ? frac1 : eps ); \
2421 if ( (x2) < 0.0 ) frac2 = 2.0 - ( ( frac2 > eps ) ? frac2 : eps ); \
2422 \
2423 /* We now extract the bits from the fraction values into integer \
2424 variables so that we may perform bit-wise operations on them. However, \
2425 since a double may be longer than any available integer, we may \
2426 have to handle several successive blocks of bits individually. */ \
2427 \
2428 /* Extract the first block of bits by scaling by the required power of \
2429 2 to shift the required bits to the left of the binary point. Then \
2430 extract the integer part. Note that this initial shift is one bit less \
2431 than the number of bits in an unsigned long, because we have \
2432 introduced an extra sign bit. */ \
2433 frac1 *= scale1; \
2434 frac2 *= scale1; \
2435 b1 = (unsigned long) frac1; \
2436 b2 = (unsigned long) frac2; \
2437 \
2438 /* Perform the required bit-wise operation on the extracted blocks of \
2439 bits. */ \
2440 b = b1 oper b2; \
2441 \
2442 /* Extract the sign bit from this initial result. This determines \
2443 whether the final result bit pattern should represent a negative \
2444 floating point number. */ \
2445 neg = b & signbit; \
2446 \
2447 /* Initialise the floating point result by setting it to the integer \
2448 result multipled by the reciprocal of the scale factor used to shift \
2449 the bits above. This returns the result bits to their correct \
2450 significance. */ \
2451 unscale = rscale1; \
2452 result = (double) b * unscale; \
2453 \
2454 /* We now loop to extract and process further blocks of bits (if \
2455 present). The number of blocks is determined by the relative lengths \
2456 of a double and an unsigned long. In practice, some bits of the double \
2457 will be used by its exponent, so the last block may be incomplete and \
2458 will simply be padded with zeros. */ \
2459 for ( iblock = 1; iblock < nblock; iblock++ ) { \
2460 \
2461 /* Subtract the integer part (which has already been processed) from \
2462 each fraction, to leave the bits which remain to be processed. Then \
2463 multiply by a scale factor to shift the next set of bits to the left \
2464 of the binary point. This time, we use as many bits as will fit into \
2465 an unsigned long. */ \
2466 frac1 = ( frac1 - (double) b1 ) * scale; \
2467 frac2 = ( frac2 - (double) b2 ) * scale; \
2468 \
2469 /* Extract the integer part, which contains the required bits. */ \
2470 b1 = (unsigned long) frac1; \
2471 b2 = (unsigned long) frac2; \
2472 \
2473 /* Perform the required bit-wise operation on the extracted blocks of \
2474 bits. */ \
2475 b = b1 oper b2; \
2476 \
2477 /* Update the result floating point value by adding the new integer \
2478 result multiplied by a scale factor to return the bits to their \
2479 original significance. */ \
2480 unscale *= rscale; \
2481 result += (double) b * unscale; \
2482 } \
2483 \
2484 /* If the (normalised fraction) result represents a negative number, \
2485 then subtract 2.0 from it (equivalent to subtracting it from 2 and \
2486 negating the result). This converts back to using a separate sign bit \
2487 instead of twos-complement notation. */ \
2488 if ( neg ) result -= 2.0; \
2489 \
2490 /* Scale by the required power of 2 to remove the initial \
2491 normalisation applied and assign the result to the "result" \
2492 variable. */ \
2493 result = ldexp( result, expon )
2494
2495 /* Gaussian random number. */
2496 /* ----------------------- */
2497 /* This macro expands to code which assigns a pseudo-random value to
2498 the "result" variable. The value is drawn from a Gaussian distribution
2499 with mean "x1" and standard deviation "ABS(x2)". */
2500 #define GAUSS(x1,x2) \
2501 \
2502 /* Loop until a satisfactory result is obtained. */ \
2503 do { \
2504 \
2505 /* Obtain a value drawn from a standard Gaussian distribution. */ \
2506 ran = Gauss( rcontext, status ); \
2507 \
2508 /* Multiply by "ABS(x2)", trapping possible overflow. */ \
2509 result = ABS( (x2) ); \
2510 result = SAFE_MUL( ran, result ); \
2511 \
2512 /* If OK, add "x1", again trapping possible overflow. */ \
2513 if ( result != AST__BAD ) result = SAFE_ADD( result, (x1) ); \
2514 \
2515 /* Continue generating values until one is found which does not cause \
2516 overflow. */ \
2517 } while ( result == AST__BAD );
2518
2519 /* Implement the stack-based arithmetic. */
2520 /* ===================================== */
2521 /* Initialise the top of stack index and constant counter. */
2522 tos = -1;
2523 icon = 0;
2524
2525 /* Determine the number of opcodes to be processed and loop to process
2526 them, executing the appropriate "case" block for each one. */
2527 ncode = code[ 0 ];
2528 for ( icode = 1; icode <= ncode; icode++ ) {
2529 switch ( (Oper) code[ icode ] ) {
2530
2531 /* Ignore any null opcodes (which shouldn't occur). */
2532 case OP_NULL: break;
2533
2534 /* Otherwise, perform the required vector operation on the stack... */
2535
2536 /* User-supplied constants and variables. */
2537 /* -------------------------------------- */
2538 /* Loading a constant involves incrementing the constant count and
2539 assigning the next constant's value to the top of stack element. */
2540 ARG_0( OP_LDCON, value = con[ icon++ ], *y = value )
2541
2542 /* Loading a variable involves obtaining the variable's index by
2543 consuming a constant (as above), and then copying the variable's
2544 values into the top of stack element. */
2545 ARG_0( OP_LDVAR, ivar = (int) ( con[ icon++ ] + 0.5 ),
2546 *y = ptr_in[ ivar ][ point ] )
2547
2548 /* System constants. */
2549 /* ----------------- */
2550 /* Loading a "bad" value simply means assigning AST__BAD to the top of
2551 stack element. */
2552 ARG_0( OP_LDBAD, ;, *y = AST__BAD )
2553
2554 /* The following load constants associated with the (double) floating
2555 point representation into the top of stack element. */
2556 ARG_0( OP_LDDIG, ;, *y = (double) DBL_DIG )
2557 ARG_0( OP_LDEPS, ;, *y = DBL_EPSILON )
2558 ARG_0( OP_LDMAX, ;, *y = DBL_MAX )
2559 ARG_0( OP_LDMAX10E, ;, *y = (double) DBL_MAX_10_EXP )
2560 ARG_0( OP_LDMAXE, ;, *y = (double) DBL_MAX_EXP )
2561 ARG_0( OP_LDMDIG, ;, *y = (double) DBL_MANT_DIG )
2562 ARG_0( OP_LDMIN, ;, *y = DBL_MIN )
2563 ARG_0( OP_LDMIN10E, ;, *y = (double) DBL_MIN_10_EXP )
2564 ARG_0( OP_LDMINE, ;, *y = (double) DBL_MIN_EXP )
2565 ARG_0( OP_LDRAD, ;, *y = (double) FLT_RADIX )
2566 ARG_0( OP_LDRND, ;, *y = (double) FLT_ROUNDS )
2567
2568 /* Mathematical constants. */
2569 /* ----------------------- */
2570 /* The following load mathematical constants into the top of stack
2571 element. */
2572 ARG_0( OP_LDE, value = exp( 1.0 ), *y = value )
2573 ARG_0( OP_LDPI, ;, *y = pi )
2574
2575 /* Functions with one argument. */
2576 /* ---------------------------- */
2577 /* The following simply evaluate a function of the top of stack
2578 element and assign the result to the same element. */
2579 ARG_1( OP_ABS, *y = ABS( x ) )
2580 ARG_1( OP_ACOS, *y = ( ABS( x ) <= 1.0 ) ?
2581 acos( x ) : AST__BAD )
2582 ARG_1( OP_ACOSD, *y = ( ABS( x ) <= 1.0 ) ?
2583 acos( x ) * r2d : AST__BAD )
2584 ARG_1( OP_ACOSH, *y = ( x < 1.0 ) ? AST__BAD :
2585 ( ( x > safe_sq ) ? log( x ) + log2 :
2586 log( x + sqrt( x * x - 1.0 ) ) ) )
2587 ARG_1( OP_ACOTH, *y = ( ABS( x ) <= 1.0 ) ? AST__BAD :
2588 0.5 * ( log( ( x + 1.0 ) /
2589 ( x - 1.0 ) ) ) )
2590 ARG_1( OP_ACSCH, *y = ( ( x == 0.0 ) ? AST__BAD :
2591 ( sign = ( x >= 0.0 ), x = ABS( x ),
2592 ( sign ? 1.0 : -1.0 ) *
2593 ( ( x < rsafe_sq ) ? log2 - log( x ) :
2594 ( x = 1.0 / x,
2595 log( x + sqrt( x * x + 1.0 ) ) ) ) ) ) )
2596 ARG_1( OP_ASECH, *y = ( ( x <= 0 ) || ( x > 1.0 ) ) ? AST__BAD :
2597 ( ( x < rsafe_sq ) ? log2 - log( x ) :
2598 ( x = 1.0 / x,
2599 log( x + sqrt( x * x - 1.0 ) ) ) ) )
2600 ARG_1( OP_ASIN, *y = ( ABS( x ) <= 1.0 ) ?
2601 asin( x ) : AST__BAD )
2602 ARG_1( OP_ASIND, *y = ( ABS( x ) <= 1.0 ) ?
2603 asin( x ) * r2d : AST__BAD )
2604 ARG_1( OP_ASINH, *y = ( sign = ( x >= 0.0 ), x = ABS( x ),
2605 ( sign ? 1.0 : -1.0 ) *
2606 ( ( x > safe_sq ) ? log( x ) + log2 :
2607 log( x + sqrt( x * x + 1.0 ) ) ) ) )
2608 ARG_1( OP_ATAN, *y = atan( x ) )
2609 ARG_1( OP_ATAND, *y = atan( x ) * r2d )
2610 ARG_1( OP_ATANH, *y = ( ABS( x ) >= 1.0 ) ? AST__BAD :
2611 0.5 * ( log( ( 1.0 + x ) /
2612 ( 1.0 - x ) ) ) )
2613 ARG_1( OP_CEIL, *y = ceil( x ) )
2614 ARG_1( OP_COS, *y = cos( x ) )
2615 ARG_1( OP_COSD, *y = cos( x * d2r ) )
2616 ARG_1( OP_COSH, *y = CATCH_MATHS_OVERFLOW( cosh( x ) ) )
2617 ARG_1( OP_COTH, *y = ( x = tanh( x ), SAFE_DIV( 1.0, x ) ) )
2618 ARG_1( OP_CSCH, *y = ( x = CATCH_MATHS_OVERFLOW( sinh( x ) ),
2619 ( x == AST__BAD ) ?
2620 0.0 : SAFE_DIV( 1.0, x ) ) )
2621 ARG_1( OP_EXP, *y = CATCH_MATHS_OVERFLOW( exp( x ) ) )
2622 ARG_1( OP_FLOOR, *y = floor( x ) )
2623 ARG_1( OP_INT, *y = INT( x ) )
2624 ARG_1B( OP_ISBAD, *y = ( x == AST__BAD ) )
2625 ARG_1( OP_LOG, *y = ( x > 0.0 ) ? log( x ) : AST__BAD )
2626 ARG_1( OP_LOG10, *y = ( x > 0.0 ) ? log10( x ) : AST__BAD )
2627 ARG_1( OP_NINT, *y = ( x >= 0 ) ?
2628 floor( x + 0.5 ) : ceil( x - 0.5 ) )
2629 ARG_1( OP_POISS, *y = Poisson( rcontext, x, status ) )
2630 ARG_1( OP_SECH, *y = ( x = CATCH_MATHS_OVERFLOW( cosh( x ) ),
2631 ( x == AST__BAD ) ? 0.0 : 1.0 / x ) )
2632 ARG_1( OP_SIN, *y = sin( x ) )
2633 ARG_1( OP_SINC, *y = ( x == 0.0 ) ? 1.0 : sin( x ) / x )
2634 ARG_1( OP_SIND, *y = sin( x * d2r ) )
2635 ARG_1( OP_SINH, *y = CATCH_MATHS_OVERFLOW( sinh( x ) ) )
2636 ARG_1( OP_SQR, *y = SAFE_MUL( x, x ) )
2637 ARG_1( OP_SQRT, *y = ( x >= 0.0 ) ? sqrt( x ) : AST__BAD )
2638 ARG_1( OP_TAN, *y = CATCH_MATHS_OVERFLOW( tan( x ) ) )
2639 ARG_1( OP_TAND, *y = tan( x * d2r ) )
2640 ARG_1( OP_TANH, *y = tanh( x ) )
2641
2642 /* Functions with two arguments. */
2643 /* ----------------------------- */
2644 /* These evaluate a function of the top two entries on the stack. */
2645 ARG_2( OP_ATAN2, *y = atan2( x1, x2 ) )
2646 ARG_2( OP_ATAN2D, *y = atan2( x1, x2 ) * r2d )
2647 ARG_2( OP_DIM, *y = ( x1 > x2 ) ? x1 - x2 : 0.0 )
2648 ARG_2( OP_GAUSS, GAUSS( x1, x2 ); *y = result )
2649 ARG_2( OP_MOD, *y = ( x2 != 0.0 ) ?
2650 fmod( x1, x2 ) : AST__BAD )
2651 ARG_2( OP_POW, *y = CATCH_MATHS_ERROR( pow( x1, x2 ) ) )
2652 ARG_2( OP_RAND, ran = Rand( rcontext, status );
2653 *y = x1 * ran + x2 * ( 1.0 - ran ); )
2654 ARG_2( OP_SIGN, *y = ( ( x1 >= 0.0 ) == ( x2 >= 0.0 ) ) ?
2655 x1 : -x1 )
2656
2657 /* Functions with three arguments. */
2658 /* ------------------------------- */
2659 /* These evaluate a function of the top three entries on the stack. */
2660 ARG_3B( OP_QIF, *y = ( ( x1 ) ? ( x2 ) : ( x3 ) ) )
2661
2662
2663 /* Functions with variable numbers of arguments. */
2664 /* --------------------------------------------- */
2665 /* These operations take a variable number of arguments, the actual
2666 number being determined by consuming a constant. We then loop to
2667 perform a 2-argument operation on the stack (as above) the required
2668 number of times. */
2669 case OP_MAX:
2670 narg = (int) ( con[ icon++ ] + 0.5 );
2671 for ( iarg = 0; iarg < ( narg - 1 ); iarg++ ) {
2672 DO_ARG_2( *y = ( x1 >= x2 ) ? x1 : x2 )
2673 }
2674 break;
2675 case OP_MIN:
2676 narg = (int) ( con[ icon++ ] + 0.5 );
2677 for ( iarg = 0; iarg < ( narg - 1 ); iarg++ ) {
2678 DO_ARG_2( *y = ( x1 <= x2 ) ? x1 : x2 )
2679 }
2680 break;
2681
2682 /* Unary arithmetic operators. */
2683 /* --------------------------- */
2684 ARG_1( OP_NEG, *y = -x )
2685
2686 /* Unary boolean operators. */
2687 /* ------------------------ */
2688 ARG_1( OP_NOT, *y = ( x == 0.0 ) )
2689
2690 /* Binary arithmetic operators. */
2691 /* ---------------------------- */
2692 ARG_2( OP_ADD, *y = SAFE_ADD( x1, x2 ) )
2693 ARG_2( OP_SUB, *y = SAFE_SUB( x1, x2 ) )
2694 ARG_2( OP_MUL, *y = SAFE_MUL( x1, x2 ) )
2695 ARG_2( OP_DIV , *y = SAFE_DIV( x1, x2 ) )
2696
2697 /* Bit-shift operators. */
2698 /* -------------------- */
2699 ARG_2( OP_SHFTL, *y = SHIFT_BITS( x1, x2 ) )
2700 ARG_2( OP_SHFTR, *y = SHIFT_BITS( x1, -x2 ) )
2701
2702 /* Relational operators. */
2703 /* --------------------- */
2704 ARG_2( OP_EQ, *y = ( x1 == x2 ) )
2705 ARG_2( OP_GE, *y = ( x1 >= x2 ) )
2706 ARG_2( OP_GT, *y = ( x1 > x2 ) )
2707 ARG_2( OP_LE, *y = ( x1 <= x2 ) )
2708 ARG_2( OP_LT, *y = ( x1 < x2 ) )
2709 ARG_2( OP_NE, *y = ( x1 != x2 ) )
2710
2711 /* Bit-wise operators. */
2712 /* ------------------- */
2713 ARG_2( OP_BITOR, BIT_OPER( |, x1, x2 ); *y = result )
2714 ARG_2( OP_BITXOR, BIT_OPER( ^, x1, x2 ); *y = result )
2715 ARG_2( OP_BITAND, BIT_OPER( &, x1, x2 ); *y = result )
2716
2717 /* Binary boolean operators. */
2718 /* ------------------------- */
2719 ARG_2B( OP_AND, *y = TRISTATE_AND( x1, x2 ) )
2720 ARG_2( OP_EQV, *y = ( ( x1 != 0.0 ) == ( x2 != 0.0 ) ) )
2721 ARG_2B( OP_OR, *y = TRISTATE_OR( x1, x2 ) )
2722 ARG_2( OP_XOR, *y = ( ( x1 != 0.0 ) != ( x2 != 0.0 ) ) )
2723 }
2724 }
2725 }
2726
2727 /* When all opcodes have been processed, the result of the function
2728 evaluation will reside in the lowest stack entry - i.e. the output
2729 array. */
2730
2731 /* Free the workspace arrays. */
2732 work = astFree( work );
2733 stack = astFree( stack );
2734
2735 /* Undefine macros local to this function. */
2736 #undef ARG_0
2737 #undef ARG_1
2738 #undef ARG_1B
2739 #undef DO_ARG_2
2740 #undef ARG_2
2741 #undef ARG_2B
2742 #undef ABS
2743 #undef INT
2744 #undef CATCH_MATHS_OVERFLOW
2745 #undef CATCH_MATHS_ERROR
2746 #undef TRISTATE_OR
2747 #undef TRISTATE_AND
2748 #undef SAFE_ADD
2749 #undef SAFE_SUB
2750 #undef SAFE_MUL
2751 #undef SAFE_DIV
2752 #undef SHIFT_BITS
2753 #undef BIT_OPER
2754 #undef GAUSS
2755 }
2756
EvaluationSort(const double con[],int nsym,int symlist[],int ** code,int * stacksize,int * status)2757 static void EvaluationSort( const double con[], int nsym, int symlist[],
2758 int **code, int *stacksize, int *status ) {
2759 /*
2760 * Name:
2761 * EvaluationSort
2762
2763 * Purpose:
2764 * Perform an evaluation-order sort on parsed expression symbols.
2765
2766 * Type:
2767 * Private function.
2768
2769 * Synopsis:
2770 * #include "mathmap.h"
2771 * void EvaluationSort( const double con[], int nsym, int symlist[],
2772 * int **code, int *stacksize, int *status )
2773
2774 * Class Membership:
2775 * MathMap member function.
2776
2777 * Description:
2778 * This function sorts a sequence of numbers representing symbols
2779 * identified in an expression. The symbols (i.e. the expression syntax)
2780 * must have been fully validated beforehand, as no validation is
2781 * performed here.
2782 *
2783 * The symbols are sorted into the order in which corresponding
2784 * operations must be performed on a push-down arithmetic stack in order
2785 * to evaluate the expression. Operation codes (opcodes), as defined in
2786 * the "Oper" enum, are then substituted for the symbol numbers.
2787
2788 * Parameters:
2789 * con
2790 * Pointer to an array of double containing the set of constants
2791 * generated while parsing the expression (these are required in order
2792 * to determine the number of arguments associated with functions which
2793 * take a variable number of arguments).
2794 * nsym
2795 * The number of symbols identified while parsing the expression.
2796 * symlist
2797 * Pointer to an array of int, with "nsym" elements. On entry, this
2798 * should contain the indices in the static "symbol" array of the
2799 * symbols identified while parsing the expression. On exit, the
2800 * contents are undefined.
2801 * code
2802 * Address of a pointer which will be set to point at a dynamically
2803 * allocated array of int containing the set of opcodes (cast to int)
2804 * produced by this function. The first element of this array will
2805 * contain a count of the number of opcodes which follow.
2806 *
2807 * The allocated space must be freed by the caller (using astFree) when
2808 * no longer required.
2809 * stacksize
2810 * Pointer to an int in which to return the size of the push-down stack
2811 * required to evaluate the expression using the returned opcodes.
2812 * status
2813 * Pointer to the inherited status variable.
2814
2815 * Notes:
2816 * - A value of NULL will be returned for the "*code" pointer and a value
2817 * of zero will be returned for the "*stacksize" value if this function is
2818 * invoked with the global error status set, or if it should fail for any
2819 * reason.
2820 */
2821
2822 /* Local Variables: */
2823 int flush; /* Flush parenthesised symbol sequence? */
2824 int icon; /* Input constant counter */
2825 int isym; /* Input symbol counter */
2826 int ncode; /* Number of opcodes generated */
2827 int nstack; /* Evaluation stack size */
2828 int push; /* Push a new symbol on to stack? */
2829 int sym; /* Variable for symbol number */
2830 int tos; /* Top of sort stack index */
2831
2832 /* Initialise */
2833 *code = NULL;
2834 *stacksize = 0;
2835
2836 /* Check the global error status. */
2837 if ( !astOK ) return;
2838
2839 /* Further initialisation. */
2840 flush = 0;
2841 icon = 0;
2842 isym = 0;
2843 ncode = 0;
2844 nstack = 0;
2845 tos = -1;
2846
2847 /* Loop to generate output opcodes until the sort stack is empty and
2848 there are no further symbols to process, or an error is detected. */
2849 while ( astOK && ( ( tos > -1 ) || ( isym < nsym ) ) ) {
2850
2851 /* Decide whether to push a symbol on to the sort stack (which
2852 "diverts" it so that higher-priority symbols can be output), or to pop
2853 the top symbol off the sort stack and send it to the output
2854 stream... */
2855
2856 /* We must push a symbol on to the sort stack if the stack is
2857 currently empty. */
2858 if ( tos == -1 ) {
2859 push = 1;
2860
2861 /* We must pop the top symbol off the sort stack if there are no more
2862 input symbols to process. */
2863 } else if ( isym >= nsym ) {
2864 push = 0;
2865
2866 /* If the sort stack is being flushed to complete the evaluation of a
2867 parenthesised expression, then the top symbol (which will be the
2868 opening parenthesis or function call) must be popped. This is only
2869 done once, so reset the "flush" flag before the next loop. */
2870 } else if ( flush ) {
2871 push = 0;
2872 flush = 0;
2873
2874 /* In all other circumstances, we must push a symbol on to the sort
2875 stack if its evaluation priority (seen from the left) is higher than
2876 that of the current top of stack symbol (seen from the right). This
2877 means it will eventually be sent to the output stream ahead of the
2878 current top of stack symbol. */
2879 } else {
2880 push = ( symbol[ symlist[ isym ] ].leftpriority >
2881 symbol[ symlist[ tos ] ].rightpriority );
2882 }
2883
2884 /* If a symbol is being pushed on to the sort stack, then get the next
2885 input symbol which is to be used. */
2886 if ( push ) {
2887 sym = symlist[ isym++ ];
2888
2889 /* If the symbol decreases the parenthesis level (a closing
2890 parenthesis), then all the sort stack entries down to the symbol which
2891 opened the current level of parenthesis (the matching opening
2892 parenthesis or function call) will already have been sent to the
2893 output stream as a consequence of the evaluation priority defined for
2894 a closing parenthesis in the symbol data. The opening parenthesis (or
2895 function call) must next be flushed from the sort stack, so set the
2896 "flush" flag which is interpreted on the next loop. Ignore the current
2897 symbol, which cancels with the opening parenthesis on the stack. */
2898 if ( symbol[ sym ].parincrement < 0 ) {
2899 flush = 1;
2900
2901 /* All other symbols are pushed on to the sort stack. The stack
2902 occupies that region of the "symlist" array from which the input
2903 symbol numbers have already been extracted. */
2904 } else {
2905 symlist[ ++tos ] = sym;
2906 }
2907
2908 /* If a symbol is being popped from the top of the sort stack, then
2909 the top of stack entry is transferred to the output stream. Obtain the
2910 symbol number from the stack. Increment the local constant counter if
2911 the associated operation will use a constant. */
2912 } else {
2913 sym = symlist[ tos-- ];
2914 icon += ( ( sym == symbol_ldvar ) || ( sym == symbol_ldcon ) );
2915
2916 /* If the output symbol does not represent a "null" operation,
2917 increase the size of the output opcode array to accommodate it,
2918 checking for errors. Note that we allocate one extra array element
2919 (the first) which will eventually hold a count of all the opcodes
2920 generated. */
2921 if ( symbol[ sym ].opcode != OP_NULL ) {
2922 *code = astGrow( *code, ncode + 2, sizeof( int ) );
2923 if ( astOK ) {
2924
2925 /* Append the new opcode to the end of this array. */
2926 ( *code )[ ++ncode ] = (int) symbol[ sym ].opcode;
2927
2928 /* Increment/decrement the counter representing the stack size
2929 required for evaluation of the expression. If the symbol is a
2930 function with a variable number of arguments (indicated by a negative
2931 "nargs" entry in the symbol data table), then the change in stack size
2932 must be determined from the argument number stored in the constant
2933 table. */
2934 if ( symbol[ sym ].nargs >= 0 ) {
2935 nstack += symbol[ sym ].stackincrement;
2936 } else {
2937 nstack -= (int) ( con[ icon++ ] + 0.5 ) - 1;
2938 }
2939
2940 /* Note the maximum size of the stack. */
2941 *stacksize = ( nstack > *stacksize ) ? nstack : *stacksize;
2942 }
2943 }
2944 }
2945 }
2946
2947 /* If no "*code" array has been allocated, then allocate one simply to
2948 store the number of opcodes generated, i.e. zero (this shouldn't
2949 normally happen as this represents an invalid expression). */
2950 if ( !*code ) *code = astMalloc( sizeof( int ) );
2951
2952 /* If no error has occurred, store the count of opcodes generated in
2953 the first element of the "*code" array and re-allocate the array to
2954 its final size (since astGrow may have over-allocated space). */
2955 if ( astOK ) {
2956 ( *code )[ 0 ] = ncode;
2957 *code = astRealloc( *code, sizeof( int ) * (size_t) ( ncode + 1 ) );
2958 }
2959
2960 /* If an error occurred, free any memory that was allocated and reset
2961 the output values. */
2962 if ( !astOK ) {
2963 *code = astFree( *code );
2964 *stacksize = 0;
2965 }
2966 }
2967
ExtractExpressions(const char * method,const char * class,int nfun,const char * fun[],int forward,char *** exprs,int * status)2968 static void ExtractExpressions( const char *method, const char *class,
2969 int nfun, const char *fun[], int forward,
2970 char ***exprs, int *status ) {
2971 /*
2972 * Name:
2973 * ExtractExpressions
2974
2975 * Purpose:
2976 * Extract and validate expressions.
2977
2978 * Type:
2979 * Private function.
2980
2981 * Synopsis:
2982 * #include "mathmap.h"
2983 * void ExtractExpressions( const char *method, const char *class,
2984 * int nfun, const char *fun[], int forward,
2985 * char ***exprs, int *status )
2986
2987 * Class Membership:
2988 * MathMap member function.
2989
2990 * Description:
2991 * This function extracts expressions from the right hand sides of a set
2992 * of functions. These expressions are then validated to check that they
2993 * are either all present, or all absent (absence indicating an undefined
2994 * transformation). An error is reported if anything is found to be
2995 * wrong.
2996 *
2997 * Note that the syntax of the expressions is not checked by this function
2998 * (i.e. they are not compiled).
2999
3000 * Parameters:
3001 * method
3002 * Pointer to a constant null-terminated character string
3003 * containing the name of the method that invoked this function.
3004 * This method name is used solely for constructing error messages.
3005 * class
3006 * Pointer to a constant null-terminated character string containing the
3007 * class name of the Object being processed. This name is used solely
3008 * for constructing error messages.
3009 * nfun
3010 * The number of functions to be analysed.
3011 * fun
3012 * Pointer to an array, with "nfun" elements, of pointers to null
3013 * terminated strings which contain each of the functions. These
3014 * strings should contain no white space.
3015 * forward
3016 * A non-zero value indicates the the MathMap's forward transformation
3017 * functions are being processed, while a zero value indicates processing
3018 * of the inverse transformation functions. This value is used solely for
3019 * constructing error messages.
3020 * exprs
3021 * Address in which to return a pointer to an array (with "nfun"
3022 * elements) of pointers to null terminated strings containing the
3023 * extracted expressions (i.e. this returns an array of strings).
3024 *
3025 * Both the returned array of pointers, and the strings to which they
3026 * point, will be stored in dynamically allocated memory and should
3027 * be freed by the caller (using astFree) when no longer required.
3028 *
3029 * If the right hand sides (including the "=" sign) of all the supplied
3030 * functions are absent, then this indicates an undefined transformation
3031 * and the returned pointer value will be NULL. An error results if
3032 * an "=" sign is present but no expression follows it.
3033 * status
3034 * Pointer to the inherited status variable.
3035
3036 * Notes:
3037 * - A NULL value will be returned for "*exprs" if this function is
3038 * invoked with the global error status set, or if it should fail for
3039 * any reason.
3040 */
3041
3042 /* Local Variables: */
3043 char *ex; /* Pointer to start of expression string */
3044 int ifun; /* Loop counter for functions */
3045 int iud; /* Index of first undefined function */
3046 int nud; /* Number of undefined expressions */
3047
3048 /* Initialise. */
3049 *exprs = NULL;
3050
3051 /* Check the global error status. */
3052 if ( !astOK ) return;
3053
3054 /* Further initialisation. */
3055 nud = 0;
3056 iud = 0;
3057
3058 /* Allocate and initialise memory for the returned array of pointers. */
3059 MALLOC_POINTER_ARRAY( *exprs, char *, nfun )
3060
3061 /* Loop to inspect each function in turn. */
3062 if ( astOK ) {
3063 for ( ifun = 0; ifun < nfun; ifun++ ) {
3064
3065 /* Search for the first "=" sign. */
3066 if ( ( ex = strchr( fun[ ifun ], '=' ) ) ) {
3067
3068 /* If found, and there are more characters after the "=" sign, then
3069 find the length of the expression which follows. Allocate a string to
3070 hold this expression, storing its pointer in the array allocated
3071 above. Check for errors. */
3072 if ( *++ex ) {
3073 ( *exprs )[ ifun ] = astMalloc( strlen( ex ) + (size_t) 1 );
3074 if ( !astOK ) break;
3075
3076 /* If OK, extract the expression string. */
3077 (void) strcpy( ( *exprs )[ ifun ], ex );
3078
3079 /* If an "=" sign was found but there are no characters following it,
3080 then there is a missing right hand side to a function, so report an
3081 error and quit. */
3082 } else {
3083 astError( AST__NORHS,
3084 "%s(%s): Missing right hand side in expression: "
3085 "\"%s\".", status,
3086 method, class, fun[ ifun ] );
3087 astError( astStatus,
3088 "Error in %s transformation function %d.", status,
3089 forward ? "forward" : "inverse", ifun + 1 );
3090 break;
3091 }
3092
3093 /* If no "=" sign was found, then the transformation may be undefined,
3094 in which case each function should only contain a variable name. Count
3095 the number of times this happens and record the index of the first
3096 instance. */
3097 } else {
3098 nud++;
3099 if ( nud == 1 ) iud = ifun;
3100 }
3101 }
3102 }
3103
3104 /* Either all functions should have an "=" sign (in which case the
3105 transformation is defined), or none of them should have (in which case
3106 it is undefined). If some do and some don't, then report an error,
3107 citing the first instance of a missing "=" sign. */
3108 if ( astOK && ( nud != 0 ) && ( nud != nfun ) ) {
3109 astError( AST__NORHS,
3110 "%s(%s): Missing right hand side in function: \"%s\".", status,
3111 method, class, fun[ iud ] );
3112 astError( astStatus,
3113 "Error in %s transformation function %d.", status,
3114 forward ? "forward" : "inverse", iud + 1 );
3115 }
3116
3117 /* If an error occurred, or all the expressions were absent, then free any
3118 allocated memory and reset the output value. */
3119 if ( !astOK || nud ) {
3120 FREE_POINTER_ARRAY( *exprs, nfun )
3121 }
3122 }
3123
ExtractVariables(const char * method,const char * class,int nfun,const char * fun[],int nin,int nout,int nfwd,int ninv,int forward,char *** var,int * status)3124 static void ExtractVariables( const char *method, const char *class,
3125 int nfun, const char *fun[],
3126 int nin, int nout, int nfwd, int ninv,
3127 int forward, char ***var, int *status ) {
3128 /*
3129 * Name:
3130 * ExtractVariables
3131
3132 * Purpose:
3133 * Extract and validate variable names.
3134
3135 * Type:
3136 * Private function.
3137
3138 * Synopsis:
3139 * #include "mathmap.h"
3140 * void ExtractVariables( const char *method, const char *class,
3141 * int nfun, const char *fun[],
3142 * int nin, int nout, int nfwd, int ninv,
3143 * int forward, char ***var, int *status )
3144
3145 * Class Membership:
3146 * MathMap member function.
3147
3148 * Description:
3149 * This function extracts variable names from the left hand sides of a
3150 * set of transformation functions belonging to a MathMap. These variable
3151 * names are then validated to check for correct syntax and no
3152 * duplication. An error is reported if anything is wrong with the
3153 * variable names obtained.
3154
3155 * Parameters:
3156 * method
3157 * Pointer to a constant null-terminated character string
3158 * containing the name of the method that invoked this function.
3159 * This method name is used solely for constructing error messages.
3160 * class
3161 * Pointer to a constant null-terminated character string containing the
3162 * class name of the Object being processed. This name is used solely
3163 * for constructing error messages.
3164 * nfun
3165 * The number of functions to be analysed.
3166 * fun
3167 * Pointer to an array, with "nfun" elements, of pointers to null
3168 * terminated strings which contain each of the functions. These strings
3169 * are case sensitive and should contain no white space.
3170 *
3171 * The first elements of this array should point to the functions that
3172 * define the primary input/output variables (depending on direction).
3173 * These should be followed by any functions which define intermediate
3174 * variables (taken from the set of functions which transform in the
3175 * opposite direction to the first ones).
3176 * nin
3177 * Number of input variables for the MathMap.
3178 * nout
3179 * Number of output variables for the MathMap.
3180 * nfwd
3181 * Number of forward transformation functions for the MathMap.
3182 * ninv
3183 * Number of inverse transformation functions for the MathMap.
3184 * forward
3185 * A non-zero value indicates the the MathMap's forward transformation
3186 * functions are being processed, while a zero value indicates processing
3187 * of the inverse transformation functions. This value, together with
3188 * "nin", "nout", "nfwd" and "ninv" are used solely for constructing
3189 * error messages.
3190 * var
3191 * Address in which to return a pointer to an array (with "nfun"
3192 * elements) of pointers to null terminated strings containing the
3193 * extracted variable names (i.e. this returns an array of strings).
3194 *
3195 * Both the returned array of pointers, and the strings to which they
3196 * point, will be stored in dynamically allocated memory and should
3197 * be freed by the caller (using astFree) when no longer required.
3198 * status
3199 * Pointer to the inherited status variable.
3200
3201 * Notes:
3202 * - A NULL value will be returned for "*var" if this function is
3203 * invoked with the global error status set, or if it should fail for
3204 * any reason.
3205 */
3206
3207 /* Local Variables: */
3208 char *duser1; /* Transformation direction for function */
3209 char *duser2; /* Transformation direction for function */
3210 char c; /* Extracted character */
3211 int i1; /* Loop counter for detecting duplicates */
3212 int i2; /* Loop counter for detecting duplicates */
3213 int i; /* Loop counter for characters */
3214 int iend; /* Last character index in parsed name */
3215 int ifun; /* Loop counter for functions */
3216 int iuser1; /* Function number as known to the user */
3217 int iuser2; /* Function number as known to the user */
3218 int nc; /* Character count */
3219 int nextra; /* Number of intermediate functions */
3220 int nprimary; /* Number of primary input/output variables */
3221
3222 /* Initialise. */
3223 *var = NULL;
3224
3225 /* Check the global error status. */
3226 if ( !astOK ) return;
3227
3228 /* Obtain the number of primary input/output variables, depending on
3229 the direction of the coordinate transformation. */
3230 nprimary = ( forward ? nin : nout );
3231
3232 /* Deterine the number of extra (intermediate) functions that come
3233 before these primary ones. These affect the numbering of
3234 transformation functions as known to the user, and must be accounted
3235 for when reporting error messages. */
3236 nextra = ( forward ? ninv - nin : nfwd - nout );
3237
3238 /* Allocate and initialise memory for the returned array of pointers. */
3239 MALLOC_POINTER_ARRAY( *var, char *, nfun )
3240
3241 /* Loop to process each function in turn. */
3242 if ( astOK ) {
3243 for ( ifun = 0; ifun < nfun; ifun++ ) {
3244
3245 /* Count the number of characters appearing before the "=" sign (or in
3246 the entire string if the "=" is absent). */
3247 for ( nc = 0; ( c = fun[ ifun ][ nc ] ); nc++ ) if ( c == '=' ) break;
3248
3249 /* If no characters were counted, then report an appropriate error
3250 message, depending on whether the function string was entirely
3251 blank. */
3252 if ( !nc ) {
3253 if ( c ) {
3254 astError( AST__MISVN,
3255 "%s(%s): No left hand side in expression: \"%s\".", status,
3256 method, class, fun[ ifun ] );
3257 } else {
3258 astError( AST__MISVN,
3259 "%s: Transformation function contains no variable "
3260 "name.", status,
3261 method );
3262 }
3263 break;
3264 }
3265
3266 /* If OK, allocate memory to hold the output string and check for
3267 errors. */
3268 ( *var )[ ifun ] = astMalloc( sizeof( char ) * (size_t) ( nc + 1 ) ) ;
3269 if ( !astOK ) break;
3270
3271 /* If OK, copy the characters before the "=" sign to the new
3272 string. */
3273 nc = 0;
3274 for ( i = 0; ( c = fun[ ifun ][ i ] ); i++ ) {
3275 if ( c == '=' ) break;
3276 ( *var )[ ifun ][ nc++] = c;
3277 }
3278
3279 /* Null terminate the result. */
3280 ( *var )[ ifun ][ nc ] = '\0';
3281
3282 /* Try to parse the contents of the extracted string as a name. */
3283 ParseName( ( *var )[ ifun ], 0, &iend, status );
3284
3285 /* If unsuccessful, or if all the characters were not parsed, then we
3286 have an invalid variable name, so report an error and quit. */
3287 if ( ( iend < 0 ) || ( *var )[ ifun ][ iend + 1 ] ) {
3288 astError( AST__VARIN,
3289 "%s(%s): Variable name is invalid: \"%s\".", status,
3290 method, class, ( *var )[ ifun ] );
3291 break;
3292 }
3293 }
3294
3295 /* If an error occurred above, then determine the function number, and
3296 the direction of the transformation of which it forms part, as known
3297 to the user. */
3298 if ( !astOK ) {
3299 if ( ifun < nprimary ) {
3300 iuser1 = ifun + 1 + nextra;
3301 duser1 = ( forward ? "inverse" : "forward" );
3302 } else {
3303 iuser1 = ifun + 1 - nprimary;
3304 duser1 = ( forward ? "forward" : "inverse" );
3305 }
3306
3307 /* Report a contextual error message. */
3308 astError( astStatus,
3309 "Error in %s transformation function %d.", status,
3310 duser1, iuser1 );
3311 }
3312 }
3313
3314 /* If there has been no error, loop to compare all the variable names
3315 with each other to detect duplication. */
3316 if ( astOK ) {
3317 for ( i1 = 1; i1 < nfun; i1++ ) {
3318 for ( i2 = 0; i2 < i1; i2++ ) {
3319
3320 /* If a duplicate variable name is found, report an error. */
3321 if ( !strcmp( ( *var )[ i1 ], ( *var )[ i2 ] ) ) {
3322 astError( AST__DUVAR,
3323 "%s(%s): Duplicate definition of variable name: "
3324 "\"%s\".", status,
3325 method, class, ( *var )[ i1 ] );
3326
3327 /* For each transformation function involved, determine the function
3328 number and the direction of the transformation of which it forms part,
3329 as known to the user. */
3330 if ( i1 < nprimary ) {
3331 iuser1 = i1 + 1 + nextra;
3332 duser1 = ( forward ? "inverse" : "forward" );
3333 } else {
3334 iuser1 = i1 + 1 - nprimary;
3335 duser1 = ( forward ? "forward" : "inverse" );
3336 }
3337 if ( i2 < nprimary ) {
3338 iuser2 = i2 + 1 + nextra;
3339 duser2 = ( forward ? "inverse" : "forward" );
3340 } else {
3341 iuser2 = i2 + 1 - nprimary;
3342 duser2 = ( forward ? "forward" : "inverse" );
3343 }
3344
3345 /* Report a contextual error message. */
3346 astError( astStatus,
3347 "Conflict between %s function %d and %s function %d.", status,
3348 duser1, iuser1, duser2, iuser2 );
3349 break;
3350 }
3351 }
3352 if ( !astOK ) break;
3353 }
3354 }
3355
3356 /* If an error occurred, free any allocated memory and reset the
3357 output value. */
3358 if ( !astOK ) {
3359 FREE_POINTER_ARRAY( *var, nfun )
3360 }
3361 }
3362
Gauss(Rcontext * context,int * status)3363 static double Gauss( Rcontext *context, int *status ) {
3364 /*
3365 * Name:
3366 * Gauss
3367
3368 * Purpose:
3369 * Produce a pseudo-random sample from a standard Gaussian distribution.
3370
3371 * Type:
3372 * Private function.
3373
3374 * Synopsis:
3375 * #include "mathmap.h"
3376 * double Gauss( Rcontext *context, int *status )
3377
3378 * Class Membership:
3379 * MathMap member function.
3380
3381 * Description:
3382 * On each invocation, this function returns a pseudo-random sample drawn
3383 * from a standard Gaussian distribution with mean zero and standard
3384 * deviation unity. The Box-Muller transformation method is used.
3385
3386 * Parameters:
3387 * context
3388 * Pointer to an Rcontext structure which holds the random number
3389 * generator's context between invocations.
3390 * status
3391 * Pointer to the inherited status variable.
3392
3393 * Returned Value:
3394 * A sample from a standard Gaussian distribution.
3395
3396 * Notes:
3397 * - The sequence of numbers returned is determined by the "seed"
3398 * value in the Rcontext structure supplied.
3399 * - If the seed value is changed, the "active" flag must also be cleared
3400 * so that this function can re-initiallise the Rcontext structure before
3401 * generating the next pseudo-random number. The "active" flag should
3402 * also be clear to force initialisation the first time an Rcontext
3403 * structure is used.
3404 * - This function does not perform error checking and does not generate
3405 * errors. It will execute even if the global error status is set.
3406 */
3407
3408 /* Local Variables: */
3409 double rsq; /* Squared radius */
3410 double s; /* Scale factor */
3411 double x; /* First result value */
3412 static double y; /* Second result value */
3413 static int ysaved = 0; /* Previously-saved value available? */
3414
3415 LOCK_MUTEX7
3416
3417 /* If the random number generator context is not active, then it will
3418 be (re)initialised on the first invocation of Rand (below). Ensure
3419 that any previously-saved value within this function is first
3420 discarded. */
3421 if ( !context->active ) ysaved = 0;
3422
3423 /* If there is a previously-saved value available, then use it and
3424 mark it as no longer available. */
3425 if ( ysaved ) {
3426 x = y;
3427 ysaved = 0;
3428
3429 /* Otherwise, loop until a suitable new pair of values has been
3430 obtained. */
3431 } else {
3432 while ( 1 ) {
3433
3434 /* Loop to obtain two random values uniformly distributed inside the
3435 unit circle, while avoiding the origin (which maps to an infinite
3436 result). */
3437 do {
3438 x = 2.0 * Rand( context, status ) - 1.0;
3439 y = 2.0 * Rand( context, status ) - 1.0;
3440 rsq = x * x + y * y;
3441 } while ( ( rsq >= 1.0 ) || ( rsq == 0.0 ) );
3442
3443 /* Perform the Box-Muller transformation, checking that this will not
3444 produce overflow (which is extremely unlikely). If overflow would
3445 occur, we simply repeat the above steps with a new pair of random
3446 numbers. */
3447 s = -2.0 * log( rsq );
3448 if ( ( DBL_MAX * rsq ) >= s ) {
3449 s = sqrt( s / rsq );
3450
3451 /* Scale the original random values to give a pair of results. One will be
3452 returned and the second kept until next time. */
3453 x *= s;
3454 y *= s;
3455 break;
3456 }
3457 }
3458
3459 /* Note that a saved value is available. */
3460 ysaved = 1;
3461 }
3462
3463 UNLOCK_MUTEX7
3464
3465 /* Return the current result. */
3466 return x;
3467 }
3468
GetObjSize(AstObject * this_object,int * status)3469 static int GetObjSize( AstObject *this_object, int *status ) {
3470 /*
3471 * Name:
3472 * GetObjSize
3473
3474 * Purpose:
3475 * Return the in-memory size of an Object.
3476
3477 * Type:
3478 * Private function.
3479
3480 * Synopsis:
3481 * #include "mathmap.h"
3482 * int GetObjSize( AstObject *this, int *status )
3483
3484 * Class Membership:
3485 * MathMap member function (over-rides the astGetObjSize protected
3486 * method inherited from the parent class).
3487
3488 * Description:
3489 * This function returns the in-memory size of the supplied MathMap,
3490 * in bytes.
3491
3492 * Parameters:
3493 * this
3494 * Pointer to the MathMap.
3495 * status
3496 * Pointer to the inherited status variable.
3497
3498 * Returned Value:
3499 * The Object size, in bytes.
3500
3501 * Notes:
3502 * - A value of zero will be returned if this function is invoked
3503 * with the global status set, or if it should fail for any reason.
3504 */
3505
3506 /* Local Variables: */
3507 AstMathMap *this; /* Pointer to MathMap structure */
3508 int result; /* Result value to return */
3509
3510 /* Initialise. */
3511 result = 0;
3512
3513 /* Check the global error status. */
3514 if ( !astOK ) return result;
3515
3516 /* Obtain a pointers to the MathMap structure. */
3517 this = (AstMathMap *) this_object;
3518
3519 /* Invoke the GetObjSize method inherited from the parent class, and then
3520 add on any components of the class structure defined by thsi class
3521 which are stored in dynamically allocated memory. */
3522 result = (*parent_getobjsize)( this_object, status );
3523
3524 SIZEOF_POINTER_ARRAY( this->fwdfun, this->nfwd )
3525 SIZEOF_POINTER_ARRAY( this->invfun, this->ninv )
3526 SIZEOF_POINTER_ARRAY( this->fwdcode, this->nfwd )
3527 SIZEOF_POINTER_ARRAY( this->invcode, this->ninv )
3528 SIZEOF_POINTER_ARRAY( this->fwdcon, this->nfwd )
3529 SIZEOF_POINTER_ARRAY( this->invcon, this->ninv )
3530
3531 /* If an error occurred, clear the result value. */
3532 if ( !astOK ) result = 0;
3533
3534 /* Return the result, */
3535 return result;
3536 }
3537
GetAttrib(AstObject * this_object,const char * attrib,int * status)3538 static const char *GetAttrib( AstObject *this_object, const char *attrib, int *status ) {
3539 /*
3540 * Name:
3541 * GetAttrib
3542
3543 * Purpose:
3544 * Get the value of a specified attribute for a MathMap.
3545
3546 * Type:
3547 * Private function.
3548
3549 * Synopsis:
3550 * #include "mathmap.h"
3551 * const char *GetAttrib( AstObject *this, const char *attrib, int *status )
3552
3553 * Class Membership:
3554 * MathMap member function (over-rides the protected astGetAttrib
3555 * method inherited from the Mapping class).
3556
3557 * Description:
3558 * This function returns a pointer to the value of a specified
3559 * attribute for a MathMap, formatted as a character string.
3560
3561 * Parameters:
3562 * this
3563 * Pointer to the MathMap.
3564 * attrib
3565 * Pointer to a null-terminated string containing the name of
3566 * the attribute whose value is required. This name should be in
3567 * lower case, with all white space removed.
3568 * status
3569 * Pointer to the inherited status variable.
3570
3571 * Returned Value:
3572 * - Pointer to a null-terminated string containing the attribute
3573 * value.
3574
3575 * Notes:
3576 * - The returned string pointer may point at memory allocated
3577 * within the MathMap, or at static memory. The contents of the
3578 * string may be over-written or the pointer may become invalid
3579 * following a further invocation of the same function or any
3580 * modification of the MathMap. A copy of the string should
3581 * therefore be made if necessary.
3582 * - A NULL pointer will be returned if this function is invoked
3583 * with the global error status set, or if it should fail for any
3584 * reason.
3585 */
3586
3587 /* Local Variables: */
3588 astDECLARE_GLOBALS /* Pointer to thread-specific global data */
3589 AstMathMap *this; /* Pointer to the MathMap structure */
3590 const char *result; /* Pointer value to return */
3591 int ival; /* Integer attribute value */
3592
3593 /* Initialise. */
3594 result = NULL;
3595
3596 /* Check the global error status. */
3597 if ( !astOK ) return result;
3598
3599 /* Get a pointer to the thread specific global data structure. */
3600 astGET_GLOBALS(this_object);
3601
3602 /* Obtain a pointer to the MathMap structure. */
3603 this = (AstMathMap *) this_object;
3604
3605 /* Compare "attrib" with each recognised attribute name in turn,
3606 obtaining the value of the required attribute. If necessary, write
3607 the value into "getattrib_buff" as a null-terminated string in an appropriate
3608 format. Set "result" to point at the result string. */
3609
3610 /* Seed. */
3611 /* ----- */
3612 if ( !strcmp( attrib, "seed" ) ) {
3613 ival = astGetSeed( this );
3614 if ( astOK ) {
3615 (void) sprintf( getattrib_buff, "%d", ival );
3616 result = getattrib_buff;
3617 }
3618
3619 /* SimpFI. */
3620 /* ------- */
3621 } else if ( !strcmp( attrib, "simpfi" ) ) {
3622 ival = astGetSimpFI( this );
3623 if ( astOK ) {
3624 (void) sprintf( getattrib_buff, "%d", ival );
3625 result = getattrib_buff;
3626 }
3627
3628 /* SimpIF. */
3629 /* ------- */
3630 } else if ( !strcmp( attrib, "simpif" ) ) {
3631 ival = astGetSimpIF( this );
3632 if ( astOK ) {
3633 (void) sprintf( getattrib_buff, "%d", ival );
3634 result = getattrib_buff;
3635 }
3636
3637 /* If the attribute name was not recognised, pass it on to the parent
3638 method for further interpretation. */
3639 } else {
3640 result = (*parent_getattrib)( this_object, attrib, status );
3641 }
3642
3643 /* Return the result. */
3644 return result;
3645
3646 }
3647
astInitMathMapVtab_(AstMathMapVtab * vtab,const char * name,int * status)3648 void astInitMathMapVtab_( AstMathMapVtab *vtab, const char *name, int *status ) {
3649 /*
3650 *+
3651 * Name:
3652 * astInitMathMapVtab
3653
3654 * Purpose:
3655 * Initialise a virtual function table for a MathMap.
3656
3657 * Type:
3658 * Protected function.
3659
3660 * Synopsis:
3661 * #include "mathmap.h"
3662 * void astInitMathMapVtab( AstMathMapVtab *vtab, const char *name )
3663
3664 * Class Membership:
3665 * MathMap vtab initialiser.
3666
3667 * Description:
3668 * This function initialises the component of a virtual function
3669 * table which is used by the MathMap class.
3670
3671 * Parameters:
3672 * vtab
3673 * Pointer to the virtual function table. The components used by
3674 * all ancestral classes will be initialised if they have not already
3675 * been initialised.
3676 * name
3677 * Pointer to a constant null-terminated character string which contains
3678 * the name of the class to which the virtual function table belongs (it
3679 * is this pointer value that will subsequently be returned by the Object
3680 * astClass function).
3681 *-
3682 */
3683
3684 /* Local Variables: */
3685 astDECLARE_GLOBALS /* Pointer to thread-specific global data */
3686 AstMappingVtab *mapping; /* Pointer to Mapping component of Vtab */
3687 AstObjectVtab *object; /* Pointer to Object component of Vtab */
3688
3689 /* Check the local error status. */
3690 if ( !astOK ) return;
3691
3692 /* Get a pointer to the thread specific global data structure. */
3693 astGET_GLOBALS(NULL);
3694
3695 /* Initialize the component of the virtual function table used by the
3696 parent class. */
3697 astInitMappingVtab( (AstMappingVtab *) vtab, name );
3698
3699 /* Store a unique "magic" value in the virtual function table. This
3700 will be used (by astIsAMathMap) to determine if an object belongs
3701 to this class. We can conveniently use the address of the (static)
3702 class_check variable to generate this unique value. */
3703 vtab->id.check = &class_check;
3704 vtab->id.parent = &(((AstMappingVtab *) vtab)->id);
3705
3706 /* Initialise member function pointers. */
3707 /* ------------------------------------ */
3708 /* Store pointers to the member functions (implemented here) that
3709 provide virtual methods for this class. */
3710 vtab->ClearSeed = ClearSeed;
3711 vtab->ClearSimpFI = ClearSimpFI;
3712 vtab->ClearSimpIF = ClearSimpIF;
3713 vtab->GetSeed = GetSeed;
3714 vtab->GetSimpFI = GetSimpFI;
3715 vtab->GetSimpIF = GetSimpIF;
3716 vtab->SetSeed = SetSeed;
3717 vtab->SetSimpFI = SetSimpFI;
3718 vtab->SetSimpIF = SetSimpIF;
3719 vtab->TestSeed = TestSeed;
3720 vtab->TestSimpFI = TestSimpFI;
3721 vtab->TestSimpIF = TestSimpIF;
3722
3723 /* Save the inherited pointers to methods that will be extended, and
3724 replace them with pointers to the new member functions. */
3725 object = (AstObjectVtab *) vtab;
3726 mapping = (AstMappingVtab *) vtab;
3727 parent_getobjsize = object->GetObjSize;
3728 object->GetObjSize = GetObjSize;
3729
3730 parent_clearattrib = object->ClearAttrib;
3731 object->ClearAttrib = ClearAttrib;
3732 parent_getattrib = object->GetAttrib;
3733 object->GetAttrib = GetAttrib;
3734 parent_setattrib = object->SetAttrib;
3735 object->SetAttrib = SetAttrib;
3736 parent_testattrib = object->TestAttrib;
3737 object->TestAttrib = TestAttrib;
3738
3739 parent_transform = mapping->Transform;
3740 mapping->Transform = Transform;
3741
3742 /* Store replacement pointers for methods which will be over-ridden by
3743 new member functions implemented here. */
3744 object->Equal = Equal;
3745 mapping->MapMerge = MapMerge;
3746
3747 /* Declare the copy constructor, destructor and class dump function. */
3748 astSetCopy( vtab, Copy );
3749 astSetDelete( vtab, Delete );
3750 astSetDump( vtab, Dump, "MathMap",
3751 "Transformation using mathematical functions" );
3752
3753 /* If we have just initialised the vtab for the current class, indicate
3754 that the vtab is now initialised, and store a pointer to the class
3755 identifier in the base "object" level of the vtab. */
3756 if( vtab == &class_vtab ) {
3757 class_init = 1;
3758 astSetVtabClassIdentifier( vtab, &(vtab->id) );
3759 }
3760 }
3761
LogGamma(double x,int * status)3762 static double LogGamma( double x, int *status ) {
3763 /*
3764 * Name:
3765 * LogGamma
3766
3767 * Purpose:
3768 * Calculate the logarithm of the gamma function.
3769
3770 * Type:
3771 * Private function.
3772
3773 * Synopsis:
3774 * #include "mathmap.h"
3775 * double LogGamma( double x, int *status )
3776
3777 * Class Membership:
3778 * MathMap member function.
3779
3780 * Description:
3781 * This function returns the natural logarithm of the gamma function
3782 * for real arguments x>0. It uses the approximation of Lanczos, with
3783 * constants from Press et al. (Numerical Recipes), giving a maximum
3784 * fractional error (on the gamma function) of less than 2e-10.
3785
3786 * Parameters:
3787 * x
3788 * The function argument, which must be greater than zero.
3789 * status
3790 * Pointer to the inherited status variable.
3791
3792 * Returned Value:
3793 * The natural logarithm of the gamma function with "x" as argument,
3794 * or AST__BAD if "x" is not greater than zero.
3795
3796 * Notes:
3797 * - This function does not generate errors and does not perform error
3798 * reporting. It will execute even if the global error status is set.
3799 */
3800
3801 /* Local Constants: */
3802 const double c0 = 1.000000000190015; /* Coefficients for series sum... */
3803 const double c1 = 76.18009172947146;
3804 const double c2 = -86.50532032941677;
3805 const double c3 = 24.01409824083091;
3806 const double c4 = -1.231739572450155;
3807 const double c5 = 0.1208650973866179e-2;
3808 const double c6 = -0.5395239384953e-5;
3809 const double g = 5.0;
3810
3811 /* Local Variables: */
3812 double result; /* Result value to return */
3813 double sum; /* Series sum */
3814 double xx; /* Denominator for summing series */
3815 static double root_twopi; /* sqrt( 2.0 * pi ) */
3816 static int init = 0; /* Initialisation performed? */
3817
3818 /* If initialisation has not yet been performed, calculate the
3819 constant required below. */
3820 LOCK_MUTEX3
3821 if ( !init ) {
3822 root_twopi = sqrt( 2.0 * acos( -1.0 ) );
3823
3824 /* Note that initialisation has been performed. */
3825 init = 1;
3826 }
3827 UNLOCK_MUTEX3
3828
3829 /* Return a bad value if "x" is not greater than zero. */
3830 if ( x <= 0.0 ) {
3831 result = AST__BAD;
3832
3833 /* Otherwise, form the series sum. Since we only use 6 terms, the loop
3834 that would normally be used has been completely unrolled here. */
3835 } else {
3836 xx = x;
3837 sum = c0;
3838 sum += c1 / ++xx;
3839 sum += c2 / ++xx;
3840 sum += c3 / ++xx;
3841 sum += c4 / ++xx;
3842 sum += c5 / ++xx;
3843 sum += c6 / ++xx;
3844
3845 /* Calculate the result. */
3846 result = x + g + 0.5;
3847 result -= ( x + 0.5 ) * log( result );
3848 result = log( root_twopi * sum / x ) - result;
3849 }
3850
3851 /* Return the result. */
3852 return result;
3853 }
3854
MapMerge(AstMapping * this,int where,int series,int * nmap,AstMapping *** map_list,int ** invert_list,int * status)3855 static int MapMerge( AstMapping *this, int where, int series, int *nmap,
3856 AstMapping ***map_list, int **invert_list, int *status ) {
3857 /*
3858 * Name:
3859 * MapMerge
3860
3861 * Purpose:
3862 * Simplify a sequence of Mappings containing a MathMap.
3863
3864 * Type:
3865 * Private function.
3866
3867 * Synopsis:
3868 * #include "mapping.h"
3869 * int MapMerge( AstMapping *this, int where, int series, int *nmap,
3870 * AstMapping ***map_list, int **invert_list, int *status )
3871
3872 * Class Membership:
3873 * MathMap method (over-rides the protected astMapMerge method
3874 * inherited from the Mapping class).
3875
3876 * Description:
3877 * This function attempts to simplify a sequence of Mappings by
3878 * merging a nominated MathMap in the sequence with its neighbours,
3879 * so as to shorten the sequence if possible.
3880 *
3881 * In many cases, simplification will not be possible and the
3882 * function will return -1 to indicate this, without further
3883 * action.
3884 *
3885 * In most cases of interest, however, this function will either
3886 * attempt to replace the nominated MathMap with one which it
3887 * considers simpler, or to merge it with the Mappings which
3888 * immediately precede it or follow it in the sequence (both will
3889 * normally be considered). This is sufficient to ensure the
3890 * eventual simplification of most Mapping sequences by repeated
3891 * application of this function.
3892 *
3893 * In some cases, the function may attempt more elaborate
3894 * simplification, involving any number of other Mappings in the
3895 * sequence. It is not restricted in the type or scope of
3896 * simplification it may perform, but will normally only attempt
3897 * elaborate simplification in cases where a more straightforward
3898 * approach is not adequate.
3899
3900 * Parameters:
3901 * this
3902 * Pointer to the nominated MathMap which is to be merged with
3903 * its neighbours. This should be a cloned copy of the MathMap
3904 * pointer contained in the array element "(*map_list)[where]"
3905 * (see below). This pointer will not be annulled, and the
3906 * MathMap it identifies will not be modified by this function.
3907 * where
3908 * Index in the "*map_list" array (below) at which the pointer
3909 * to the nominated MathMap resides.
3910 * series
3911 * A non-zero value indicates that the sequence of Mappings to
3912 * be simplified will be applied in series (i.e. one after the
3913 * other), whereas a zero value indicates that they will be
3914 * applied in parallel (i.e. on successive sub-sets of the
3915 * input/output coordinates).
3916 * nmap
3917 * Address of an int which counts the number of Mappings in the
3918 * sequence. On entry this should be set to the initial number
3919 * of Mappings. On exit it will be updated to record the number
3920 * of Mappings remaining after simplification.
3921 * map_list
3922 * Address of a pointer to a dynamically allocated array of
3923 * Mapping pointers (produced, for example, by the astMapList
3924 * method) which identifies the sequence of Mappings. On entry,
3925 * the initial sequence of Mappings to be simplified should be
3926 * supplied.
3927 *
3928 * On exit, the contents of this array will be modified to
3929 * reflect any simplification carried out. Any form of
3930 * simplification may be performed. This may involve any of: (a)
3931 * removing Mappings by annulling any of the pointers supplied,
3932 * (b) replacing them with pointers to new Mappings, (c)
3933 * inserting additional Mappings and (d) changing their order.
3934 *
3935 * The intention is to reduce the number of Mappings in the
3936 * sequence, if possible, and any reduction will be reflected in
3937 * the value of "*nmap" returned. However, simplifications which
3938 * do not reduce the length of the sequence (but improve its
3939 * execution time, for example) may also be performed, and the
3940 * sequence might conceivably increase in length (but normally
3941 * only in order to split up a Mapping into pieces that can be
3942 * more easily merged with their neighbours on subsequent
3943 * invocations of this function).
3944 *
3945 * If Mappings are removed from the sequence, any gaps that
3946 * remain will be closed up, by moving subsequent Mapping
3947 * pointers along in the array, so that vacated elements occur
3948 * at the end. If the sequence increases in length, the array
3949 * will be extended (and its pointer updated) if necessary to
3950 * accommodate any new elements.
3951 *
3952 * Note that any (or all) of the Mapping pointers supplied in
3953 * this array may be annulled by this function, but the Mappings
3954 * to which they refer are not modified in any way (although
3955 * they may, of course, be deleted if the annulled pointer is
3956 * the final one).
3957 * invert_list
3958 * Address of a pointer to a dynamically allocated array which,
3959 * on entry, should contain values to be assigned to the Invert
3960 * attributes of the Mappings identified in the "*map_list"
3961 * array before they are applied (this array might have been
3962 * produced, for example, by the astMapList method). These
3963 * values will be used by this function instead of the actual
3964 * Invert attributes of the Mappings supplied, which are
3965 * ignored.
3966 *
3967 * On exit, the contents of this array will be updated to
3968 * correspond with the possibly modified contents of the
3969 * "*map_list" array. If the Mapping sequence increases in
3970 * length, the "*invert_list" array will be extended (and its
3971 * pointer updated) if necessary to accommodate any new
3972 * elements.
3973 * status
3974 * Pointer to the inherited status variable.
3975
3976 * Returned Value:
3977 * If simplification was possible, the function returns the index
3978 * in the "map_list" array of the first element which was
3979 * modified. Otherwise, it returns -1 (and makes no changes to the
3980 * arrays supplied).
3981
3982 * Notes:
3983 * - A value of -1 will be returned if this function is invoked
3984 * with the global error status set, or if it should fail for any
3985 * reason.
3986 */
3987
3988 /* Local Variables: */
3989 AstMapping *new; /* Pointer to replacement Mapping */
3990 AstMathMap *mathmap1; /* Pointer to first MathMap */
3991 AstMathMap *mathmap2; /* Pointer to second MathMap */
3992 char **fwd1; /* Pointer to first forward function array */
3993 char **fwd2; /* Pointer to second forward function array */
3994 char **inv1; /* Pointer to first inverse function array */
3995 char **inv2; /* Pointer to second inverse function array */
3996 int ifun; /* Loop counter for functions */
3997 int imap1; /* Index of first Mapping */
3998 int imap2; /* Index of second Mapping */
3999 int imap; /* Loop counter for Mappings */
4000 int invert1; /* Invert flag for first MathMap */
4001 int invert2; /* Invert flag for second MathMap */
4002 int nfwd1; /* No. forward functions for first MathMap */
4003 int nfwd2; /* No. forward functions for second MathMap */
4004 int nin1; /* Number input coords for first MathMap */
4005 int ninv1; /* No. inverse functions for first MathMap */
4006 int ninv2; /* No. inverse functions for second MathMap */
4007 int nout2; /* Number output coords for second MathMap */
4008 int result; /* Result value to return */
4009 int simplify; /* Mappings may simplify? */
4010
4011 /* Initialise the returned result. */
4012 result = -1;
4013
4014 /* Check the global error status. */
4015 if ( !astOK ) return result;
4016
4017 /* Initialise variables to avoid "used of uninitialised variable"
4018 messages from dumb compilers. */
4019 mathmap1 = NULL;
4020 mathmap2 = NULL;
4021 imap1 = 0;
4022 imap2 = 0;
4023 invert1 = 0;
4024 invert2 = 0;
4025 nfwd1 = 0;
4026 nin1 = 0;
4027 ninv1 = 0;
4028
4029 /* MathMaps are only worth simplifying if they occur in series. */
4030 simplify = series;
4031
4032 /* If simplification appears possible, then obtain the indices of the
4033 nominated mapping and of the one which follows it. Check that a
4034 mapping exists for the second index. */
4035 if ( simplify ) {
4036 imap1 = where;
4037 imap2 = imap1 + 1;
4038 simplify = ( imap2 < *nmap );
4039 }
4040
4041 /* If OK, check whether the class of both Mappings is "MathMap" (a
4042 MathMap can only combine with another MathMap). */
4043 if ( simplify ) {
4044 simplify = !strcmp( astGetClass( ( *map_list )[ imap1 ] ), "MathMap" );
4045 }
4046 if ( astOK && simplify ) {
4047 simplify = !strcmp( astGetClass( ( *map_list )[ imap2 ] ), "MathMap" );
4048 }
4049
4050 /* If still OK, obtain pointers to the two MathMaps and the associated
4051 invert flag values. */
4052 if ( astOK && simplify ) {
4053 mathmap1 = (AstMathMap *) ( *map_list )[ imap1 ];
4054 mathmap2 = (AstMathMap *) ( *map_list )[ imap2 ];
4055 invert1 = ( *invert_list )[ imap1 ];
4056 invert2 = ( *invert_list )[ imap2 ];
4057
4058 /* Depending on the invert flag values, obtain the SimpFI or SimpIF
4059 attribute value from each MathMap and check whether they are set so as
4060 to permit simplification. */
4061 simplify = ( ( invert1 ? astGetSimpIF( mathmap1 ) :
4062 astGetSimpFI( mathmap1 ) ) &&
4063 ( invert2 ? astGetSimpFI( mathmap2 ) :
4064 astGetSimpIF( mathmap2 ) ) );
4065 }
4066
4067 /* If still OK, obtain the effective numbers of input coordinates for
4068 the first MathMap and output coordinates for the second. Take account
4069 of the associated invert flags and the way the Invert attribute of
4070 each MathMap is currently set. */
4071 if ( astOK && simplify ) {
4072 nin1 = ( invert1 == astGetInvert( mathmap1 ) ) ?
4073 astGetNin( mathmap1 ) : astGetNout( mathmap1 );
4074 nout2 = ( invert2 == astGetInvert( mathmap2 ) ) ?
4075 astGetNout( mathmap2 ) : astGetNin( mathmap2 );
4076
4077 /* Simplification is only possible if these two numbers are equal
4078 (otherwise the the two MathMaps cannot be identical). */
4079 simplify = ( nin1 == nout2 );
4080 }
4081
4082 /* If still OK, obtain the effective number of forward transformation
4083 functions for the first MathMap (allowing for the associated invert
4084 flag). Similarly, obtain the effective number of inverse
4085 transformation functions for the second MathMap. */
4086 if ( astOK && simplify ) {
4087 nfwd1 = !invert1 ? mathmap1->nfwd : mathmap1->ninv;
4088 ninv2 = !invert2 ? mathmap2->ninv : mathmap2->nfwd;
4089
4090 /* Check whether these values are equal. The MathMaps cannot be
4091 identical if they are not. */
4092 simplify = ( nfwd1 == ninv2 );
4093 }
4094
4095 /* As above, obtain pointers to the array of effective forward
4096 transformation functions for the first MathMap, and the effective
4097 inverse transformation functions for the second MathMap. */
4098 if ( astOK && simplify ) {
4099 fwd1 = !invert1 ? mathmap1->fwdfun : mathmap1->invfun;
4100 inv2 = !invert2 ? mathmap2->invfun : mathmap2->fwdfun;
4101
4102 /* Loop to check whether these two sets of functions are
4103 identical. The MathMaps cannot be merged unless they are. */
4104 for ( ifun = 0; ifun < nfwd1; ifun++ ) {
4105 simplify = !strcmp( fwd1[ ifun ], inv2[ ifun ] );
4106 if ( !simplify ) break;
4107 }
4108 }
4109
4110 /* If OK, repeat the above process to compare the effective inverse
4111 transformation functions of the first MathMap with the forward
4112 functions of the second one. */
4113 if ( astOK && simplify ) {
4114 ninv1 = !invert1 ? mathmap1->ninv : mathmap1->nfwd;
4115 nfwd2 = !invert2 ? mathmap2->nfwd : mathmap2->ninv;
4116 simplify = ( ninv1 == nfwd2 );
4117 }
4118 if ( astOK && simplify ) {
4119 inv1 = !invert1 ? mathmap1->invfun : mathmap1->fwdfun;
4120 fwd2 = !invert2 ? mathmap2->fwdfun : mathmap2->invfun;
4121 for ( ifun = 0; ifun < ninv1; ifun++ ) {
4122 simplify = !strcmp( inv1[ ifun ], fwd2[ ifun ] );
4123 if ( !simplify ) break;
4124 }
4125 }
4126
4127 /* If the two MathMaps can be merged, create a UnitMap as a
4128 replacement. */
4129 if ( astOK && simplify ) {
4130 new = (AstMapping *) astUnitMap( nin1, "", status );
4131
4132 /* If OK, annul the pointers to the original MathMaps. */
4133 if ( astOK ) {
4134 ( *map_list )[ imap1 ] = astAnnul( ( *map_list )[ imap1 ] );
4135 ( *map_list )[ imap2 ] = astAnnul( ( *map_list )[ imap2 ] );
4136
4137 /* Insert the pointer to the replacement UnitMap and store the
4138 associated invert flag. */
4139 ( *map_list )[ imap1 ] = new;
4140 ( *invert_list )[ imap1 ] = 0;
4141
4142 /* Loop to move the following Mapping pointers and invert flags down
4143 in their arrays to close the gap. */
4144 for ( imap = imap2 + 1; imap < *nmap; imap++ ) {
4145 ( *map_list )[ imap - 1 ] = ( *map_list )[ imap ];
4146 ( *invert_list )[ imap - 1 ] = ( *invert_list )[ imap ];
4147 }
4148
4149 /* Clear the final entry in each array. */
4150 ( *map_list )[ *nmap - 1 ] = NULL;
4151 ( *invert_list )[ *nmap - 1 ] = 0;
4152
4153 /* Decrement the Mapping count and return the index of the first
4154 modified element. */
4155 ( *nmap )--;
4156 result = imap1;
4157 }
4158 }
4159
4160 /* If an error occurred, clear the returned value. */
4161 if ( !astOK ) result = -1;
4162
4163 /* Return the result. */
4164 return result;
4165 }
4166
ParseConstant(const char * method,const char * class,const char * exprs,int istart,int * iend,double * con,int * status)4167 static void ParseConstant( const char *method, const char *class,
4168 const char *exprs, int istart, int *iend,
4169 double *con, int *status ) {
4170 /*
4171 * Name:
4172 * ParseConstant
4173
4174 * Purpose:
4175 * Parse a constant.
4176
4177 * Type:
4178 * Private function.
4179
4180 * Synopsis:
4181 * #include "mathmap.h"
4182 * void ParseConstant( const char *method, const char *class,
4183 * const char *exprs, int istart, int *iend,
4184 * double *con, int *status )
4185
4186 * Class Membership:
4187 * MathMap member function.
4188
4189 * Description:
4190 * This routine parses an expression, looking for a constant starting at
4191 * the character with index "istart" in the string "exprs". If it
4192 * identifies the constant successfully, "*con" it will return its value
4193 * and "*iend" will be set to the index of the final constant character
4194 * in "exprs".
4195 *
4196 * If the characters encountered are clearly not part of a constant (it
4197 * does not begin with a numeral or decimal point) the function returns
4198 * with "*con" set to zero and "*iend" set to -1, but without reporting
4199 * an error. However, if the first character appears to be a constant but
4200 * its syntax proves to be invalid, then an error is reported.
4201 *
4202 * The expression must be in lower case with no embedded white space.
4203 * The constant must not have a sign (+ or -) in front of it.
4204
4205 * Parameters:
4206 * method
4207 * Pointer to a constant null-terminated character string
4208 * containing the name of the method that invoked this function.
4209 * This method name is used solely for constructing error messages.
4210 * class
4211 * Pointer to a constant null-terminated character string containing the
4212 * class name of the Object being processed. This name is used solely
4213 * for constructing error messages.
4214 * exprs
4215 * Pointer to a null-terminated string containing the expression
4216 * to be parsed.
4217 * istart
4218 * Index of the first character in "exprs" to be considered by this
4219 * function.
4220 * iend
4221 * Pointer to an int in which to return the index in "exprs" of the
4222 * final character which forms part of the constant. If no constant is
4223 * found, a value of -1 is returned.
4224 * con
4225 * Pointer to a double, in which the value of the constant, if found,
4226 * will be returned.
4227 * status
4228 * Pointer to the inherited status variable.
4229 */
4230
4231 /* Local Variables: */
4232 char *str; /* Pointer to temporary string */
4233 char c; /* Single character from the expression */
4234 int dpoint; /* Decimal point encountered? */
4235 int expon; /* Exponent character encountered? */
4236 int i; /* Loop counter for characters */
4237 int iscon; /* Character is part of the constant? */
4238 int n; /* Number of values read by astSscanf */
4239 int nc; /* Number of characters read by astSscanf */
4240 int numer; /* Numeral encountered in current field? */
4241 int sign; /* Sign encountered? */
4242 int valid; /* Constant syntax valid? */
4243
4244 /* Check the global error status. */
4245 if ( !astOK ) return;
4246
4247 /* Initialise. */
4248 *con = 0.0;
4249 *iend = -1;
4250
4251 /* Check if the expression starts with a numeral or a decimal point. */
4252 c = exprs[ istart ];
4253 numer = isdigit( c );
4254 dpoint = ( c == '.' );
4255
4256 /* If it begins with any of these, the expression is clearly intended
4257 to be a constant, so any failure beyond this point will result in an
4258 error. Otherwise, failure to find a constant is not an error. */
4259 if ( numer || dpoint ) {
4260
4261 /* Initialise remaining variables specifying the parser context. */
4262 expon = 0;
4263 sign = 0;
4264 valid = 1;
4265
4266 /* Loop to increment the last constant character position until the
4267 following character in the expression does not look like part of the
4268 constant. */
4269 *iend = istart;
4270 iscon = 1;
4271 while ( ( c = exprs[ *iend + 1 ] ) && iscon ) {
4272 iscon = 0;
4273
4274 /* It may be part of a numerical constant if it is a numeral, wherever
4275 it occurs. */
4276 if ( isdigit( c ) ) {
4277 numer = 1;
4278 iscon = 1;
4279
4280 /* Or a decimal point, so long as it is the first one and is not in
4281 the exponent field. Otherwise it is invalid. */
4282 } else if ( c == '.' ) {
4283 if ( !( dpoint || expon ) ) {
4284 dpoint = 1;
4285 iscon = 1;
4286 } else {
4287 valid = 0;
4288 }
4289
4290 /* Or if it is a 'd' or 'e' exponent character, so long as it is the
4291 first one and at least one numeral has been encountered first.
4292 Otherwise it is invalid. */
4293 } else if ( ( c == 'd' ) || ( c == 'e' ) ) {
4294 if ( !expon && numer ) {
4295 expon = 1;
4296 numer = 0;
4297 iscon = 1;
4298 } else {
4299 valid = 0;
4300 }
4301
4302 /* Or if it is a sign, so long as it is in the exponent field and is
4303 the first sign with no previous numerals in the same field. Otherwise
4304 it is invalid (unless numerals have been encountered, in which case it
4305 marks the end of the constant). */
4306 } else if ( ( c == '+' ) || ( c == '-' ) ) {
4307 if ( expon && !sign && !numer ) {
4308 sign = 1;
4309 iscon = 1;
4310 } else if ( !numer ) {
4311 valid = 0;
4312 }
4313 }
4314
4315 /* Increment the character count if the next character may be part of
4316 the constant, or if it was invalid (it will then form part of the
4317 error message). */
4318 if ( iscon || !valid ) ( *iend )++;
4319 }
4320
4321 /* Finally, check that the last field contained a numeral. */
4322 valid = ( valid && numer );
4323
4324 /* If the constant appears valid, allocate a temporary string to hold
4325 it. */
4326 if ( valid ) {
4327 str = astMalloc( (size_t) ( *iend - istart + 2 ) );
4328 if ( astOK ) {
4329
4330 /* Copy the constant's characters, changing 'd' to 'e' so that
4331 "astSscanf" will recognise it as an exponent character. */
4332 for ( i = istart; i <= *iend; i++ ) {
4333 str[ i - istart ] = ( exprs[ i ] == 'd' ) ? 'e' : exprs[ i ];
4334 }
4335 str[ *iend - istart + 1 ] = '\0';
4336
4337 /* Attempt to read the constant as a double, noting how many values
4338 are read and how many characters consumed. */
4339 n = astSscanf( str, "%lf%n", con, &nc );
4340
4341 /* Check that one value was read and all the characters consumed. If
4342 not, then the constant's syntax is invalid. */
4343 if ( ( n != 1 ) || ( nc < ( *iend - istart + 1 ) ) ) valid = 0;
4344 }
4345
4346 /* Free the temporary string. */
4347 str = astFree( str );
4348 }
4349
4350 /* If the constant syntax is invalid, and no other error has occurred,
4351 then report an error. */
4352 if ( astOK && !valid ) {
4353 astError( AST__CONIN,
4354 "%s(%s): Invalid constant syntax in the expression "
4355 "\"%.*s\".", status,
4356 method, class, *iend + 1, exprs );
4357 }
4358
4359 /* If an error occurred, reset the output values. */
4360 if ( !astOK ) {
4361 *iend = -1;
4362 *con = 0.0;
4363 }
4364 }
4365 }
4366
ParseName(const char * exprs,int istart,int * iend,int * status)4367 static void ParseName( const char *exprs, int istart, int *iend, int *status ) {
4368 /*
4369 * Name:
4370 * ParseName
4371
4372 * Purpose:
4373 * Parse a name.
4374
4375 * Type:
4376 * Private function.
4377
4378 * Synopsis:
4379 * #include "mathmap.h"
4380 * void ParseName( const char *exprs, int istart, int *iend, int *status )
4381
4382 * Class Membership:
4383 * MathMap member function.
4384
4385 * Description:
4386 * This routine parses an expression, looking for a name starting at the
4387 * character with index "istart" in the string "exprs". If it identifies
4388 * a name successfully, "*iend" will return the index of the final name
4389 * character in "exprs". A name must begin with an alphabetic character
4390 * and subsequently contain only alphanumeric characters or underscores.
4391 *
4392 * If the expression does not contain a name at the specified location,
4393 * "*iend" is set to -1. No error results.
4394 *
4395 * The expression should not contain embedded white space.
4396
4397 * Parameters:
4398 * exprs
4399 * Pointer to a null-terminated string containing the expression
4400 * to be parsed.
4401 * istart
4402 * Index of the first character in "exprs" to be considered by this
4403 * function.
4404 * iend
4405 * Pointer to an int in which to return the index in "exprs" of the
4406 * final character which forms part of the name. If no name is
4407 * found, a value of -1 is returned.
4408 * status
4409 * Pointer to the inherited status variable.
4410 */
4411
4412 /* Local Variables: */
4413 char c; /* Single character from expression */
4414
4415 /* Check the global error status. */
4416 if ( !astOK ) return;
4417
4418 /* Initialise. */
4419 *iend = -1;
4420
4421 /* Check the first character is valid for a name (alphabetic). */
4422 if ( isalpha( exprs[ istart ] ) ) {
4423
4424 /* If so, loop to inspect each subsequent character until one is found
4425 which is not part of a name (not alphanumeric or underscore). */
4426 for ( *iend = istart; ( c = exprs[ *iend + 1 ] ); ( *iend )++ ) {
4427 if ( !( isalnum( c ) || ( c == '_' ) ) ) break;
4428 }
4429 }
4430 }
4431
ParseVariable(const char * method,const char * class,const char * exprs,int istart,int nvar,const char * var[],int * ivar,int * iend,int * status)4432 static void ParseVariable( const char *method, const char *class,
4433 const char *exprs, int istart, int nvar,
4434 const char *var[], int *ivar, int *iend, int *status ) {
4435 /*
4436 * Name:
4437 * ParseVariable
4438
4439 * Purpose:
4440 * Parse a variable name.
4441
4442 * Type:
4443 * Private function.
4444
4445 * Synopsis:
4446 * #include "mathmap.h"
4447 * void ParseVariable( const char *method, const char *class,
4448 * const char *exprs, int istart, int nvar,
4449 * const char *var[], int *ivar, int *iend, int *status )
4450
4451 * Class Membership:
4452 * MathMap member function.
4453
4454 * Description:
4455 * This routine parses an expression, looking for a recognised variable
4456 * name starting at the character with index "istart" in the string
4457 * "exprs". If it identifies a variable name successfully, "*ivar" will
4458 * return a value identifying it and "*iend" will return the index of the
4459 * final variable name character in "exprs". To be recognised, a name
4460 * must begin with an alphabetic character and subsequently contain only
4461 * alphanumeric characters or underscores. It must also appear in the
4462 * list of defined variable names supplied to this function.
4463 *
4464 * If the expression does not contain a name at the specified location,
4465 * "*ivar" and "*iend" are set to -1 and no error results. However, if
4466 * the expression contains a name but it is not in the list of defined
4467 * variable names supplied, then an error is reported.
4468 *
4469 * This function is case sensitive. The expression should not contain
4470 * embedded white space.
4471
4472 * Parameters:
4473 * method
4474 * Pointer to a constant null-terminated character string
4475 * containing the name of the method that invoked this function.
4476 * This method name is used solely for constructing error messages.
4477 * class
4478 * Pointer to a constant null-terminated character string containing the
4479 * class name of the Object being processed. This name is used solely
4480 * for constructing error messages.
4481 * exprs
4482 * Pointer to a null-terminated string containing the expression
4483 * to be parsed.
4484 * istart
4485 * Index of the first character in "exprs" to be considered by this
4486 * function.
4487 * nvar
4488 * The number of defined variable names.
4489 * var
4490 * An array of pointers (with "nvar" elements) to null-terminated
4491 * strings. Each of these should contain a variable name to be
4492 * recognised. These strings are case sensitive and should contain
4493 * no white space.
4494 * ivar
4495 * Pointer to an int in which to return the index in "vars" of the
4496 * variable name found. If no variable name is found, a value of -1
4497 * is returned.
4498 * iend
4499 * Pointer to an int in which to return the index in "exprs" of the
4500 * final character which forms part of the variable name. If no variable
4501 * name is found, a value of -1 is returned.
4502 * status
4503 * Pointer to the inherited status variable.
4504 */
4505
4506 /* Local Variables: */
4507 int found; /* Variable name recognised? */
4508 int nc; /* Number of characters in variable name */
4509
4510 /* Check the global error status. */
4511 if ( !astOK ) return;
4512
4513 /* Initialise. */
4514 *ivar = -1;
4515 *iend = -1;
4516
4517 /* Determine if the characters in the expression starting at index
4518 "istart" constitute a valid name. */
4519 ParseName( exprs, istart, iend, status );
4520
4521 /* If so, calculate the length of the name. */
4522 if ( *iend >= istart ) {
4523 nc = *iend - istart + 1;
4524
4525 /* Loop to compare the name with the list of variable names
4526 supplied. */
4527 found = 0;
4528 for ( *ivar = 0; *ivar < nvar; ( *ivar )++ ) {
4529 found = ( nc == (int) strlen( var[ *ivar ] ) ) &&
4530 !strncmp( exprs + istart, var[ *ivar ], (size_t) nc );
4531
4532 /* Break if the name is recognised. */
4533 if ( found ) break;
4534 }
4535
4536 /* If it was not recognised, then report an error and reset the output
4537 values. */
4538 if ( !found ) {
4539 astError( AST__UDVOF,
4540 "%s(%s): Undefined variable or function in the expression "
4541 "\"%.*s\".", status,
4542 method, class, *iend + 1, exprs );
4543 *ivar = -1;
4544 *iend = -1;
4545 }
4546 }
4547 }
4548
Poisson(Rcontext * context,double mean,int * status)4549 static double Poisson( Rcontext *context, double mean, int *status ) {
4550 /*
4551 * Name:
4552 * Poisson
4553
4554 * Purpose:
4555 * Produce a pseudo-random sample from a Poisson distribution.
4556
4557 * Type:
4558 * Private function.
4559
4560 * Synopsis:
4561 * #include "mathmap.h"
4562 * double Poisson( Rcontext *context, double mean, int *status )
4563
4564 * Class Membership:
4565 * MathMap member function.
4566
4567 * Description:
4568 * On each invocation, this function returns a pseudo-random sample drawn
4569 * from a Poisson distribution with a specified mean. A combination of
4570 * methods is used, depending on the value of the mean. The algorithm is
4571 * based on that given by Press et al. (Numerical Recipes), but
4572 * re-implemented and extended.
4573
4574 * Parameters:
4575 * context
4576 * Pointer to an Rcontext structure which holds the random number
4577 * generator's context between invocations.
4578 * mean
4579 * The mean of the Poisson distribution, which should not be
4580 * negative.
4581 * status
4582 * Pointer to the inherited status variable.
4583
4584 * Returned Value:
4585 * A sample (which will only take integer values) from the Poisson
4586 * distribution, or AST__BAD if the mean supplied is negative.
4587
4588 * Notes:
4589 * - The sequence of numbers returned is determined by the "seed"
4590 * value in the Rcontext structure supplied.
4591 * - If the seed value is changed, the "active" flag must also be cleared
4592 * so that this function can re-initiallise the Rcontext structure before
4593 * generating the next pseudo-random number. The "active" flag should
4594 * also be clear to force initialisation the first time an Rcontext
4595 * structure is used.
4596 * - This function does not perform error checking and does not generate
4597 * errors. It will execute even if the global error status is set.
4598 */
4599
4600 /* Local Constants: */
4601 const double small = 9.3; /* "Small" distribution mean value */
4602
4603 /* Local Variables: */
4604 double pfract; /* Probability of accepting sample */
4605 double product; /* Product of random samples */
4606 double ran; /* Sample from Lorentzian distribution */
4607 double result; /* Result value to return */
4608 static double beta; /* Constant for forming acceptance ratio */
4609 static double huge; /* Large mean where std. dev. is negligible */
4610 static double last_mean; /* Value of "mean" on last invocation */
4611 static double log_mean; /* Logarithm of "mean" */
4612 static double pi; /* Value of pi */
4613 static double ranmax; /* Maximum safe value of "ran" */
4614 static double root_2mean; /* sqrt( 2.0 * mean ) */
4615 static double sqrt_point9; /* Square root of 0.9 */
4616 static double thresh; /* Threshold for product of samples */
4617 static int init = 0; /* Local initialisation performed? */
4618
4619 LOCK_MUTEX6
4620
4621 /* If initialisation has not yet been performed, then perform it
4622 now. */
4623 if ( !init ) {
4624
4625 /* Initialise the mean value from the previous invocation. */
4626 last_mean = -1.0;
4627
4628 /* Calculate simple constants. */
4629 pi = acos( -1.0 );
4630 sqrt_point9 = sqrt( 0.9 );
4631
4632 /* Calculate the value of the distribution mean for which the smallest
4633 representable deviation from the mean permitted by the machine
4634 precision is one thousand standard deviations. */
4635 huge = pow( 1.0e3 / DBL_EPSILON, 2.0 );
4636
4637 /* Calculate the largest value such that
4638 (0.9+(sqrt_point9*ranmax)*(sqrt_point9*ranmax)) doesn't overflow,
4639 allowing a small margin for rounding error. */
4640 ranmax = ( sqrt( DBL_MAX - 0.9 ) / sqrt( 0.9 ) ) *
4641 ( 1.0 - 4.0 * DBL_EPSILON );
4642
4643 /* Note that initialisation has been performed. */
4644 init = 1;
4645 }
4646
4647 /* If the distribution mean is less than zero, then return a bad
4648 result. */
4649 if ( mean < 0.0 ) {
4650 result = AST__BAD;
4651
4652 /* If the mean is zero, then the result can only be zero. */
4653 } else if ( mean == 0.0 ) {
4654 result = 0.0;
4655
4656 /* Otherwise, if the mean is sufficiently small, we can use the direct
4657 method of summing a series of exponentially distributed random samples
4658 and counting the number which occur before the mean is exceeded. This
4659 is equivalent to multiplying a series of uniformly distributed
4660 samples and counting the number which occur before the product
4661 becomes less then an equivalent threshold. */
4662 } else if ( mean <= small ) {
4663
4664 /* If the mean has changed since the last invocation, store the new
4665 mean and calculate a new threshold. */
4666 if ( mean != last_mean ) {
4667 last_mean = mean;
4668 thresh = exp( -mean );
4669 }
4670
4671 /* Initialise the product and the result. */
4672 product = 1.0;
4673 result = -1.0;
4674
4675 /* Multiply the random samples, counting the number needed to reach
4676 the threshold. */
4677 do {
4678 product *= Rand( context, status );
4679 result += 1.0;
4680 } while ( product > thresh );
4681
4682 /* Otherwise, if the distribution mean is large (but not huge), we
4683 must use an indirect rejection method. */
4684 } else if ( mean <= huge ) {
4685
4686 /* If the mean has changed since the last invocation, then
4687 re-calculate the constants required below. Note that because of the
4688 restrictions we have placed on "mean", these calculations are safe
4689 against overflow. */
4690 if ( mean != last_mean ) {
4691 last_mean = mean;
4692 log_mean = log( mean );
4693 root_2mean = sqrt( 2.0 * mean );
4694 beta = mean * log_mean - LogGamma( mean + 1.0, status );
4695 }
4696
4697 /* Loop until a suitable random sample has been generated. */
4698 do {
4699 do {
4700
4701 /* First transform a sample from a uniform distribution to obtain a
4702 sample from a Lorentzian distribution. Check that the result is not so
4703 large as to cause overflow later. Also check for overflow in the maths
4704 library. If necessary, obtain a new sample. */
4705 do {
4706 errno = 0;
4707 ran = tan( pi * Rand( context, status ) );
4708 } while ( ( ran > ranmax ) ||
4709 ( ( errno == ERANGE ) &&
4710 ( ( ( ran >= 0.0 ) ? ran : -ran ) == HUGE_VAL ) ) );
4711
4712 /* If OK, scale the sample and add a constant so that the sample's
4713 distribution approximates the Poisson distribution we
4714 require. Overflow is prevented by the check on "ran" above, together
4715 with the restricted value of "mean". */
4716 result = ran * root_2mean + mean;
4717
4718 /* If the result is less than zero (where the Poisson distribution has
4719 value zero), then obtain a new sample. */
4720 } while ( result < 0.0 );
4721
4722 /* Round down to an integer, so that the sample is valid for a Poisson
4723 distribution. */
4724 result = floor( result );
4725
4726 /* Calculate the ratio between the required Poisson distribution and
4727 the Lorentzian from which we have sampled (the factor of 0.9 prevents
4728 this exceeding 1.0, and overflow is again prevented by the checks
4729 performed above). */
4730 ran *= sqrt_point9;
4731 pfract = ( 0.9 + ran * ran ) *
4732 exp( result * log_mean - LogGamma( result + 1.0, status ) - beta );
4733
4734 /* Accept the sample with this fractional probability, otherwise
4735 obtain a new sample. */
4736 } while ( Rand( context, status ) > pfract );
4737
4738 /* If the mean is huge, the relative standard deviation will be
4739 negligible compared to the machine precision. In such cases, the
4740 probability of getting a result that differs from the mean is
4741 effectively zero, so we can simply return the mean. */
4742 } else {
4743 result = mean;
4744 }
4745
4746 UNLOCK_MUTEX6
4747
4748 /* Return the result. */
4749 return result;
4750 }
4751
Rand(Rcontext * context,int * status)4752 static double Rand( Rcontext *context, int *status ) {
4753 /*
4754 * Name:
4755 * Rand
4756
4757 * Purpose:
4758 * Produce a uniformly distributed pseudo-random number.
4759
4760 * Type:
4761 * Private function.
4762
4763 * Synopsis:
4764 * #include "mathmap.h"
4765 * double Rand( Rcontext *context, int *status )
4766
4767 * Class Membership:
4768 * MathMap member function.
4769
4770 * Description:
4771 * On each invocation, this function returns a pseudo-random number
4772 * uniformly distributed in the range 0.0 to 1.0 (inclusive). The
4773 * underlying algorithm is that used by the "ran2" function of Press et
4774 * al. (Numerical Recipes), which has a long period and good statistical
4775 * properties. This independent implementation returns double precision
4776 * values.
4777
4778 * Parameters:
4779 * context
4780 * Pointer to an Rcontext structure which holds the random number
4781 * generator's context between invocations.
4782 * status
4783 * Pointer to the inherited status variable.
4784
4785 * Notes:
4786 * - The sequence of numbers returned is determined by the "seed"
4787 * value in the Rcontext structure supplied.
4788 * - If the seed value is changed, the "active" flag must also be cleared
4789 * so that this function can re-initiallise the Rcontext structure before
4790 * generating the next pseudo-random number. The "active" flag should
4791 * also be clear to force initialisation the first time an Rcontext
4792 * structure is used.
4793 * - This function does not perform error checking and does not generate
4794 * errors. It will execute even if the global error status is set.
4795 */
4796
4797 /* Local Constants: */
4798 const long int a1 = 40014L; /* Random number generator constants... */
4799 const long int a2 = 40692L;
4800 const long int m1 = 2147483563L;
4801 const long int m2 = 2147483399L;
4802 const long int q1 = 53668L;
4803 const long int q2 = 52774L;
4804 const long int r1 = 12211L;
4805 const long int r2 = 3791L;
4806 const int ntab = /* Size of shuffle table */
4807 AST_MATHMAP_RAND_CONTEXT_NTAB_;
4808 const int nwarm = 8; /* Number of warm-up iterations */
4809
4810 /* Local Variables: */
4811 double result; /* Result value to return */
4812 double scale; /* Scale factor for random integers */
4813 double sum; /* Sum for forming normalisation constant */
4814 int dbits; /* Approximate bits in double mantissa */
4815 int irand; /* Loop counter for random integers */
4816 int itab; /* Loop counter for shuffle table */
4817 int lbits; /* Approximate bits used by generators */
4818 long int seed; /* Random number seed */
4819 long int tmp; /* Temporary variable */
4820 static double norm; /* Normalisation constant */
4821 static double scale0; /* Scale decrement for successive integers */
4822 static int init = 0; /* Local initialisation performed? */
4823 static int nrand; /* Number of random integers to use */
4824
4825 /* If the random number generator context is not active, then
4826 initialise it. */
4827 if ( !context->active ) {
4828
4829 /* First, perform local initialisation for this function, if not
4830 already done. */
4831 LOCK_MUTEX4
4832 if ( !init ) {
4833
4834 /* Obtain the approximate number of bits used by the random integer
4835 generator from the value "m1". */
4836 (void) frexp( (double) m1, &lbits );
4837
4838 /* Obtain the approximate number of bits used by the mantissa of the
4839 double value we want to produce, allowing for the (unlikely)
4840 possibility that the mantissa's radix isn't 2. */
4841 dbits = (int) ceil( (double) DBL_MANT_DIG *
4842 log( (double) FLT_RADIX ) / log( 2.0 ) );
4843
4844 /* Hence determine how many random integers we need to combine to
4845 produce each double value, so that all the mantissa's bits will be
4846 used. */
4847 nrand = ( dbits + lbits - 1 ) / lbits;
4848
4849 /* Calculate the scale factor by which each successive random
4850 integer's contribution to the result is reduced so as to generate
4851 progressively less significant bits. */
4852 scale0 = 1.0 / (double) ( m1 - 1L );
4853
4854 /* Loop to sum the maximum contributions from each random integer
4855 (assuming that each takes the largest possible value, of "m1-1",
4856 from which we will later subtract 1). This produces the normalisation
4857 factor by which the result must be scaled so as to lie between 0.0 and
4858 1.0 (inclusive). */
4859 sum = 0.0;
4860 scale = 1.0;
4861 for ( irand = 0; irand < nrand; irand++ ) {
4862 scale *= scale0;
4863 sum += scale;
4864 }
4865 norm = 1.0 / ( sum * (double) ( m1 - 2L ) );
4866
4867 /* Note that local initialisation has been done. */
4868 init = 1;
4869 }
4870 UNLOCK_MUTEX4
4871
4872 /* Obtain the seed value, enforcing positivity. */
4873 seed = (long int) context->seed;
4874 if ( seed < 1 ) seed = seed + LONG_MAX;
4875 if ( seed < 1 ) seed = LONG_MAX;
4876
4877 /* Initialise the random number generators with this seed. */
4878 context->rand1 = context->rand2 = seed;
4879
4880 /* Now loop to initialise the shuffle table with an initial set of
4881 random values. We generate more values than required in order to "warm
4882 up" the generator before recording values in the table. */
4883 for ( itab = ntab + nwarm - 1; itab >= 0; itab-- ) {
4884
4885 /* Repeatedly update "rand1" from the expression "(rand1*a1)%m1" while
4886 avoiding overflow. */
4887 tmp = context->rand1 / q1;
4888 context->rand1 = a1 * ( context->rand1 - tmp * q1 ) - tmp * r1;
4889 if ( context->rand1 < 0L ) context->rand1 += m1;
4890
4891 /* After warming up, start recording values in the table. */
4892 if ( itab < ntab ) context->table[ itab ] = context->rand1;
4893 }
4894
4895 /* Record the last entry in the table as the "previous" random
4896 integer. */
4897 context->random_int = context->table[ 0 ];
4898
4899 /* Note the random number generator context is active. */
4900 context->active = 1;
4901 }
4902
4903 /* Generate a random value. */
4904 /* ------------------------ */
4905 /* Initialise. */
4906 result = 0.0;
4907
4908 /* Loop to generate sufficient random integers to combine into a
4909 double value. */
4910 scale = norm;
4911 for ( irand = 0; irand < nrand; irand++ ) {
4912
4913 /* Update the first generator "rand1" from the expression
4914 "(a1*rand1)%m1" while avoiding overflow. */
4915 tmp = context->rand1 / q1;
4916 context->rand1 = a1 * ( context->rand1 - tmp * q1 ) - tmp * r1;
4917 if ( context->rand1 < 0L ) context->rand1 += m1;
4918
4919 /* Similarly, update the second generator "rand2" from the expression
4920 "(a2*rand2)%m2". */
4921 tmp = context->rand2 / q2;
4922 context->rand2 = a2 * ( context->rand2 - tmp * q2 ) - tmp * r2;
4923 if ( context->rand2 < 0L ) context->rand2 += m2;
4924
4925 /* Use the previous random integer to generate an index into the
4926 shuffle table. */
4927 itab = (int) ( context->random_int /
4928 ( 1L + ( m1 - 1L ) / (long int) ntab ) );
4929
4930 /* The algorithm left by RFWS seems to have a bug that "itab" can
4931 sometimes be outside the range of [0.,ntab-1] causing the context->table
4932 array to be addressed out of bounds. To avoid this, use the
4933 following sticking plaster, since I'm not sure what the correct fix is. */
4934 if( itab < 0 ) itab = -itab;
4935 itab = itab % ntab;
4936
4937 /* Extract the table entry and replace it with a new random value from
4938 the first generator "rand1". This is the Bays-Durham shuffle. */
4939 context->random_int = context->table[ itab ];
4940 context->table[ itab ] = context->rand1;
4941
4942 /* Combine the extracted value with the latest value from the second
4943 generator "rand2". */
4944 context->random_int -= context->rand2;
4945 if ( context->random_int < 1L ) context->random_int += m1 - 1L;
4946
4947 /* Update the scale factor to apply to the resulting random integer
4948 and accumulate its contribution to the result. */
4949 scale *= scale0;
4950 result += scale * (double) ( context->random_int - 1L );
4951 }
4952
4953 /* Return the result. */
4954 return result;
4955 }
4956
SetAttrib(AstObject * this_object,const char * setting,int * status)4957 static void SetAttrib( AstObject *this_object, const char *setting, int *status ) {
4958 /*
4959 * Name:
4960 * SetAttrib
4961
4962 * Purpose:
4963 * Set an attribute value for a MathMap.
4964
4965 * Type:
4966 * Private function.
4967
4968 * Synopsis:
4969 * #include "mathmap.h"
4970 * void SetAttrib( AstObject *this, const char *setting, int *status )
4971
4972 * Class Membership:
4973 * MathMap member function (extends the astSetAttrib method inherited from
4974 * the Mapping class).
4975
4976 * Description:
4977 * This function assigns an attribute value for a MathMap, the attribute
4978 * and its value being specified by means of a string of the form:
4979 *
4980 * "attribute= value "
4981 *
4982 * Here, "attribute" specifies the attribute name and should be in lower
4983 * case with no white space present. The value to the right of the "="
4984 * should be a suitable textual representation of the value to be assigned
4985 * and this will be interpreted according to the attribute's data type.
4986 * White space surrounding the value is only significant for string
4987 * attributes.
4988
4989 * Parameters:
4990 * this
4991 * Pointer to the MathMap.
4992 * setting
4993 * Pointer to a null terminated string specifying the new attribute
4994 * value.
4995 * status
4996 * Pointer to the inherited status variable.
4997
4998 * Returned Value:
4999 * void
5000 */
5001
5002 /* Local Vaiables: */
5003 AstMathMap *this; /* Pointer to the MathMap structure */
5004 int ival; /* Integer attribute value */
5005 int len; /* Length of setting string */
5006 int nc; /* Number of characters read by astSscanf */
5007
5008 /* Check the global error status. */
5009 if ( !astOK ) return;
5010
5011 /* Obtain a pointer to the MathMap structure. */
5012 this = (AstMathMap *) this_object;
5013
5014 /* Obtain the length of the setting string. */
5015 len = strlen( setting );
5016
5017 /* Test for each recognised attribute in turn, using "astSscanf" to parse the
5018 setting string and extract the attribute value (or an offset to it in the
5019 case of string values). In each case, use the value set in "nc" to check
5020 that the entire string was matched. Once a value has been obtained, use the
5021 appropriate method to set it. */
5022
5023 /* Seed. */
5024 /* ----- */
5025 if ( nc = 0,
5026 ( 1 == astSscanf( setting, "seed= %d %n", &ival, &nc ) )
5027 && ( nc >= len ) ) {
5028 astSetSeed( this, ival );
5029
5030 /* SimpFI. */
5031 /* ------- */
5032 } else if ( nc = 0,
5033 ( 1 == astSscanf( setting, "simpfi= %d %n", &ival, &nc ) )
5034 && ( nc >= len ) ) {
5035 astSetSimpFI( this, ival );
5036
5037 /* SimpIF. */
5038 /* ------- */
5039 } else if ( nc = 0,
5040 ( 1 == astSscanf( setting, "simpif= %d %n", &ival, &nc ) )
5041 && ( nc >= len ) ) {
5042 astSetSimpIF( this, ival );
5043
5044 /* Pass any unrecognised setting to the parent method for further
5045 interpretation. */
5046 } else {
5047 (*parent_setattrib)( this_object, setting, status );
5048 }
5049 }
5050
TestAttrib(AstObject * this_object,const char * attrib,int * status)5051 static int TestAttrib( AstObject *this_object, const char *attrib, int *status ) {
5052 /*
5053 * Name:
5054 * TestAttrib
5055
5056 * Purpose:
5057 * Test if a specified attribute value is set for a MathMap.
5058
5059 * Type:
5060 * Private function.
5061
5062 * Synopsis:
5063 * #include "mathmap.h"
5064 * int TestAttrib( AstObject *this, const char *attrib, int *status )
5065
5066 * Class Membership:
5067 * MathMap member function (over-rides the astTestAttrib protected
5068 * method inherited from the Mapping class).
5069
5070 * Description:
5071 * This function returns a boolean result (0 or 1) to indicate whether
5072 * a value has been set for one of a MathMap's attributes.
5073
5074 * Parameters:
5075 * this
5076 * Pointer to the MathMap.
5077 * attrib
5078 * Pointer to a null terminated string specifying the attribute
5079 * name. This should be in lower case with no surrounding white
5080 * space.
5081 * status
5082 * Pointer to the inherited status variable.
5083
5084 * Returned Value:
5085 * One if a value has been set, otherwise zero.
5086
5087 * Notes:
5088 * - A value of zero will be returned if this function is invoked
5089 * with the global status set, or if it should fail for any reason.
5090 */
5091
5092 /* Local Variables: */
5093 AstMathMap *this; /* Pointer to the MathMap structure */
5094 int result; /* Result value to return */
5095
5096 /* Initialise. */
5097 result = 0;
5098
5099 /* Check the global error status. */
5100 if ( !astOK ) return result;
5101
5102 /* Obtain a pointer to the MathMap structure. */
5103 this = (AstMathMap *) this_object;
5104
5105 /* Check the attribute name and test the appropriate attribute. */
5106
5107 /* Seed. */
5108 /* ----- */
5109 if ( !strcmp( attrib, "seed" ) ) {
5110 result = astTestSeed( this );
5111
5112 /* SimpFI. */
5113 /* ------- */
5114 } else if ( !strcmp( attrib, "simpfi" ) ) {
5115 result = astTestSimpFI( this );
5116
5117 /* SimpIF. */
5118 /* ------- */
5119 } else if ( !strcmp( attrib, "simpif" ) ) {
5120 result = astTestSimpIF( this );
5121
5122 /* If the attribute is not recognised, pass it on to the parent method
5123 for further interpretation. */
5124 } else {
5125 result = (*parent_testattrib)( this_object, attrib, status );
5126 }
5127
5128 /* Return the result, */
5129 return result;
5130 }
5131
Transform(AstMapping * map,AstPointSet * in,int forward,AstPointSet * out,int * status)5132 static AstPointSet *Transform( AstMapping *map, AstPointSet *in,
5133 int forward, AstPointSet *out, int *status ) {
5134 /*
5135 * Name:
5136 * Transform
5137
5138 * Purpose:
5139 * Apply a MathMap to transform a set of points.
5140
5141 * Type:
5142 * Private function.
5143
5144 * Synopsis:
5145 * #include "mathmap.h"
5146 * AstPointSet *Transform( AstMapping *map, AstPointSet *in,
5147 * int forward, AstPointSet *out, int *status )
5148
5149 * Class Membership:
5150 * MathMap member function (over-rides the astTransform method inherited
5151 * from the Mapping class).
5152
5153 * Description:
5154 * This function takes a MathMap and a set of points encapsulated in a
5155 * PointSet and transforms the points so as to apply the required coordinate
5156 * transformation.
5157
5158 * Parameters:
5159 * map
5160 * Pointer to the MathMap.
5161 * in
5162 * Pointer to the PointSet holding the input coordinate data.
5163 * forward
5164 * A non-zero value indicates that the forward coordinate transformation
5165 * should be applied, while a zero value requests the inverse
5166 * transformation.
5167 * out
5168 * Pointer to a PointSet which will hold the transformed (output)
5169 * coordinate values. A NULL value may also be given, in which case a
5170 * new PointSet will be created by this function.
5171 * status
5172 * Pointer to the inherited status variable.
5173
5174 * Returned Value:
5175 * Pointer to the output (possibly new) PointSet.
5176
5177 * Notes:
5178 * - A null pointer will be returned if this function is invoked with the
5179 * global error status set, or if it should fail for any reason.
5180 * - The number of coordinate values per point in the input PointSet must
5181 * match the number of coordinates for the MathMap being applied.
5182 * - If an output PointSet is supplied, it must have space for sufficient
5183 * number of points and coordinate values per point to accommodate the
5184 * result. Any excess space will be ignored.
5185 */
5186
5187 /* Local Variables: */
5188 AstMathMap *this; /* Pointer to MathMap to be applied */
5189 AstPointSet *result; /* Pointer to output PointSet */
5190 double **data_ptr; /* Array of pointers to coordinate data */
5191 double **ptr_in; /* Pointer to input coordinate data */
5192 double **ptr_out; /* Pointer to output coordinate data */
5193 double *work; /* Workspace for intermediate results */
5194 int idata; /* Loop counter for data pointer elements */
5195 int ifun; /* Loop counter for functions */
5196 int ncoord_in; /* Number of coordinates per input point */
5197 int ncoord_out; /* Number of coordinates per output point */
5198 int ndata; /* Number of data pointer elements filled */
5199 int nfun; /* Number of functions to evaluate */
5200 int npoint; /* Number of points */
5201
5202 /* Check the global error status. */
5203 if ( !astOK ) return NULL;
5204
5205 /* Initialise variables to avoid "used of uninitialised variable"
5206 messages from dumb compilers. */
5207 work = NULL;
5208
5209 /* Obtain a pointer to the MathMap. */
5210 this = (AstMathMap *) map;
5211
5212 /* Apply the parent mapping using the stored pointer to the Transform member
5213 function inherited from the parent Mapping class. This function validates
5214 all arguments and generates an output PointSet if necessary, but does not
5215 actually transform any coordinate values. */
5216 result = (*parent_transform)( map, in, forward, out, status );
5217
5218 /* We will now extend the parent astTransform method by performing the
5219 transformation needed to generate the output coordinate values. */
5220
5221 /* Determine the numbers of points and coordinates per point from the input
5222 and output PointSets and obtain pointers for accessing the input and output
5223 coordinate values. */
5224 ncoord_in = astGetNcoord( in );
5225 ncoord_out = astGetNcoord( result );
5226 npoint = astGetNpoint( in );
5227 ptr_in = astGetPoints( in );
5228 ptr_out = astGetPoints( result );
5229
5230 /* Determine whether to apply the forward or inverse transformation, according
5231 to the direction specified and whether the mapping has been inverted. */
5232 if ( astGetInvert( this ) ) forward = !forward;
5233
5234 /* Obtain the number of transformation functions that must be
5235 evaluated to perform the transformation. This will include any that
5236 produce intermediate results from which the final results are
5237 calculated. */
5238 nfun = forward ? this->nfwd : this->ninv;
5239
5240 /* If intermediate results are to be calculated, then allocate
5241 workspace to hold them (each intermediate result being a vector of
5242 "npoint" double values). */
5243 if ( nfun > ncoord_out ) {
5244 work = astMalloc( sizeof( double) *
5245 (size_t) ( npoint * ( nfun - ncoord_out ) ) );
5246 }
5247
5248 /* Also allocate space for an array to hold pointers to the input
5249 data, intermediate results and output data. */
5250 data_ptr = astMalloc( sizeof( double * ) * (size_t) ( ncoord_in + nfun ) );
5251
5252 /* We now set up the "data_ptr" array to locate the data to be
5253 processed. */
5254 if ( astOK ) {
5255
5256 /* The first elements of this array point at the input data
5257 vectors. */
5258 ndata = 0;
5259 for ( idata = 0; idata < ncoord_in; idata++ ) {
5260 data_ptr[ ndata++ ] = ptr_in[ idata ];
5261 }
5262
5263 /* The following elements point at successive vectors within the
5264 workspace array (if allocated). These vectors will act first as output
5265 arrays for intermediate results, and then as input arrays for
5266 subsequent calculations which use these results. */
5267 for ( idata = 0; idata < ( nfun - ncoord_out ); idata++ ) {
5268 data_ptr[ ndata++ ] = work + ( idata * npoint );
5269 }
5270
5271 /* The final elements point at the output coordinate data arrays into
5272 which the final results will be written. */
5273 for ( idata = 0; idata < ncoord_out; idata++ ) {
5274 data_ptr[ ndata++ ] = ptr_out[ idata ];
5275 }
5276
5277 /* Perform coordinate transformation. */
5278 /* ---------------------------------- */
5279 /* Loop to evaluate each transformation function in turn. */
5280 for ( ifun = 0; ifun < nfun; ifun++ ) {
5281
5282 /* Invoke the function that evaluates compiled expressions. Pass the
5283 appropriate code and constants arrays, depending on the direction of
5284 coordinate transformation, together with the required stack size. The
5285 output array is the vector located by successive elements of the
5286 "data_ptr" array (skipping the input data elements), while the
5287 function has access to all previous elements of the "data_ptr" array
5288 to locate the required input data. */
5289 EvaluateFunction( &this->rcontext, npoint, (const double **) data_ptr,
5290 forward ? this->fwdcode[ ifun ] :
5291 this->invcode[ ifun ],
5292 forward ? this->fwdcon[ ifun ] :
5293 this->invcon[ ifun ],
5294 forward ? this->fwdstack : this->invstack,
5295 data_ptr[ ifun + ncoord_in ], status );
5296 }
5297 }
5298
5299 /* Free the array of data pointers and any workspace allocated for
5300 intermediate results. */
5301 data_ptr = astFree( data_ptr );
5302 if ( nfun > ncoord_out ) work = astFree( work );
5303
5304 /* If an error occurred, then return a NULL pointer. If no output
5305 PointSet was supplied, also delete any new one that may have been
5306 created. */
5307 if ( !astOK ) {
5308 result = ( result == out ) ? NULL : astDelete( result );
5309 }
5310
5311 /* Return a pointer to the output PointSet. */
5312 return result;
5313 }
5314
ValidateSymbol(const char * method,const char * class,const char * exprs,int iend,int sym,int * lpar,int ** argcount,int ** opensym,int * ncon,double ** con,int * status)5315 static void ValidateSymbol( const char *method, const char *class,
5316 const char *exprs, int iend, int sym,
5317 int *lpar, int **argcount, int **opensym,
5318 int *ncon, double **con, int *status ) {
5319 /*
5320 * Name:
5321 * ValidateSymbol
5322
5323 * Purpose:
5324 * Validate a symbol in an expression.
5325
5326 * Type:
5327 * Private function.
5328
5329 * Synopsis:
5330 * #include "mathmap.h"
5331 * void ValidateSymbol( const char *method, const char *class,
5332 * const char *exprs, int iend, int sym, int *lpar,
5333 * int **argcount, int **opensym, int *ncon,
5334 * double **con, int *status )
5335
5336 * Class Membership:
5337 * MathMap member function.
5338
5339 * Description:
5340 * This function validates an identified standard symbol during
5341 * compilation of an expression. Its main task is to keep track of the
5342 * level of parenthesis in the expression and to count the number of
5343 * arguments supplied to functions at each level of parenthesis (for
5344 * nested function calls). On this basis it is able to interpret and
5345 * accept or reject symbols which represent function calls, parentheses
5346 * and delimiters. Other symbols are accepted automatically.
5347
5348 * Parameters:
5349 * method
5350 * Pointer to a constant null-terminated character string
5351 * containing the name of the method that invoked this function.
5352 * This method name is used solely for constructing error messages.
5353 * class
5354 * Pointer to a constant null-terminated character string containing the
5355 * class name of the Object being processed. This name is used solely
5356 * for constructing error messages.
5357 * exprs
5358 * Pointer to a null-terminated string containing the expression
5359 * being parsed. This is only used for constructing error messages.
5360 * iend
5361 * Index in "exprs" of the last character belonging to the most
5362 * recently identified symbol. This is only used for constructing error
5363 * messages.
5364 * sym
5365 * Index in the static "symbol" array of the most recently identified
5366 * symbol in the expression. This is the symbol to be verified.
5367 * lpar
5368 * Pointer to an int which holds the current level of parenthesis. On
5369 * the first invocation, this should be zero. The returned value should
5370 * be passed to subsequent invocations.
5371 * argcount
5372 * Address of a pointer to a dynamically allocated array of int in
5373 * which argument count information is maintained for each level of
5374 * parenthesis (e.g. for nested function calls). On the first invocation,
5375 * "*argcount" should be NULL. This function will allocate the required
5376 * space as needed and update this pointer. The returned pointer value
5377 * should be passed to subsequent invocations.
5378 *
5379 * The allocated space must be freed by the caller (using astFree) when
5380 * no longer required.
5381 * opensym
5382 * Address of a pointer to a dynamically allocated array of int, in which
5383 * information is maintained about the functions associated with each
5384 * level of parenthesis (e.g. for nested function calls). On the first
5385 * invocation, "*opensym" should be NULL. This function will allocate the
5386 * required space as needed and update this pointer. The returned pointer
5387 * value should be passed to subsequent invocations.
5388 *
5389 * The allocated space must be freed by the caller (using astFree) when
5390 * no longer required.
5391 * ncon
5392 * Pointer to an int which holds a count of the constants associated
5393 * with the expression (and determines the size of the "*con" array).
5394 * This function will update the count to reflect any new constants
5395 * appended to the "*con" array and the returned value should be passed
5396 * to subsequent invocations.
5397 * con
5398 * Address of a pointer to a dynamically allocated array of double, in
5399 * which the constants associated with the expression being parsed are
5400 * accumulated. On entry, "*con" should point at a dynamic array with
5401 * at least "*ncon" elements containing existing constants (or may be
5402 * NULL if no constants have yet been stored). This function will
5403 * allocate the required space as needed and update this pointer (and
5404 * "*ncon") appropriately. The returned pointer value should be passed
5405 * to subsequent invocations.
5406 *
5407 * The allocated space must be freed by the caller (using astFree) when
5408 * no longer required.
5409 * status
5410 * Pointer to the inherited status variable.
5411
5412 * Notes:
5413 * - The dynamically allocated arrays normally returned by this function
5414 * will be freed and NULL pointers will be returned if this function is
5415 * invoked with the global error status set, or if it should fail for any
5416 * reason.
5417 */
5418
5419 /* Check the global error status, but do not return at this point
5420 because dynamic arrays may require freeing. */
5421 if ( astOK ) {
5422
5423 /* Check if the symbol is a comma. */
5424 if ( ( symbol[ sym ].text[ 0 ] == ',' ) &&
5425 ( symbol[ sym ].text[ 1 ] == '\0' ) ) {
5426
5427 /* A comma is only used to delimit function arguments. If the current
5428 level of parenthesis is zero, or the symbol which opened the current
5429 level of parenthesis was not a function call (indicated by an argument
5430 count of zero at the current level of parenthesis), then report an
5431 error. */
5432 if ( ( *lpar <= 0 ) || ( ( *argcount )[ *lpar - 1 ] == 0 ) ) {
5433 astError( AST__COMIN,
5434 "%s(%s): Spurious comma encountered in the expression "
5435 "\"%.*s\".", status,
5436 method, class, iend + 1, exprs );
5437
5438 /* If a comma is valid, then increment the argument count at the
5439 current level of parenthesis. */
5440 } else {
5441 ( *argcount )[ *lpar - 1 ]++;
5442 }
5443
5444 /* If the symbol is not a comma, check if it increases the current
5445 level of parenthesis. */
5446 } else if ( symbol[ sym ].parincrement > 0 ) {
5447
5448 /* Increase the size of the arrays which hold parenthesis level
5449 information and check for errors. */
5450 *argcount = astGrow( *argcount, *lpar + 1, sizeof( int ) );
5451 *opensym = astGrow( *opensym, *lpar + 1, sizeof( int ) );
5452 if ( astOK ) {
5453
5454 /* Increment the level of parenthesis and initialise the argument
5455 count at the new level. This count is set to zero if the symbol which
5456 opens the parenthesis level is not a function call (indicated by a
5457 zero "nargs" entry in the symbol data), and it subsequently remains at
5458 zero. If the symbol is a function call, the argument count is
5459 initially set to 1 and increments whenever a comma is encountered at
5460 this parenthesis level. */
5461 ( *argcount )[ ++( *lpar ) - 1 ] = ( symbol[ sym ].nargs != 0 );
5462
5463 /* Remember the symbol which opened this parenthesis level. */
5464 ( *opensym )[ *lpar - 1 ] = sym;
5465 }
5466
5467 /* Check if the symbol decreases the current parenthesis level. */
5468 } else if ( symbol[ sym ].parincrement < 0 ) {
5469
5470 /* Ensure that the parenthesis level is not already at zero. If it is,
5471 then there is a missing left parenthesis in the expression being
5472 compiled, so report an error. */
5473 if ( *lpar == 0 ) {
5474 astError( AST__MLPAR,
5475 "%s(%s): Missing left parenthesis in the expression "
5476 "\"%.*s\".", status,
5477 method, class, iend + 1, exprs );
5478
5479 /* If the parenthesis level is valid and the symbol which opened this
5480 level of parenthesis was a function call with a fixed number of
5481 arguments (indicated by a positive "nargs" entry in the symbol data),
5482 then we must check the number of function arguments which have been
5483 encountered. */
5484 } else if ( symbol[ ( *opensym )[ *lpar - 1 ] ].nargs > 0 ) {
5485
5486 /* Report an error if the number of arguments is wrong. */
5487 if ( ( *argcount )[ *lpar - 1 ] !=
5488 symbol[ ( *opensym )[ *lpar - 1 ] ].nargs ) {
5489 astError( AST__WRNFA,
5490 "%s(%s): Wrong number of function arguments in the "
5491 "expression \"%.*s\".", status,
5492 method, class, iend + 1, exprs );
5493
5494 /* If the number of arguments is valid, decrement the parenthesis
5495 level. */
5496 } else {
5497 ( *lpar )--;
5498 }
5499
5500 /* If the symbol which opened this level of parenthesis was a function
5501 call with a variable number of arguments (indicated by a negative
5502 "nargs" entry in the symbol data), then we must check and process the
5503 number of function arguments. */
5504 } else if ( symbol[ ( *opensym )[ *lpar - 1 ] ].nargs < 0 ) {
5505
5506 /* Check that the minimum required number of arguments have been
5507 supplied. Report an error if they have not. */
5508 if ( ( *argcount )[ *lpar - 1 ] <
5509 ( -symbol[ ( *opensym )[ *lpar - 1 ] ].nargs ) ) {
5510 astError( AST__WRNFA,
5511 "%s(%s): Insufficient function arguments in the "
5512 "expression \"%.*s\".", status,
5513 method, class, iend + 1, exprs );
5514
5515 /* If the number of arguments is valid, increase the size of the
5516 constants array and check for errors. */
5517 } else {
5518 *con = astGrow( *con, *ncon + 1, sizeof( double ) );
5519 if ( astOK ) {
5520
5521 /* Append the argument count to the end of the array of constants and
5522 decrement the parenthesis level. */
5523 ( *con )[ ( *ncon )++ ] =
5524 (double) ( *argcount )[ --( *lpar ) ];
5525 }
5526 }
5527
5528 /* Finally, if the symbol which opened this level of parenthesis was
5529 not a function call ("nargs" entry in the symbol data is zero), then
5530 decrement the parenthesis level. In this case there is no need to
5531 check the argument count, because it will not have been
5532 incremented. */
5533 } else {
5534 ( *lpar )--;
5535 }
5536 }
5537 }
5538
5539 /* If an error occurred (or the global error status was set on entry),
5540 then reset the parenthesis level and free any memory which may have
5541 been allocated. */
5542 if ( !astOK ) {
5543 *lpar = 0;
5544 if ( *argcount ) *argcount = astFree( *argcount );
5545 if ( *opensym ) *opensym = astFree( *opensym );
5546 if ( *con ) *con = astFree( *con );
5547 }
5548 }
5549
5550 /* Functions which access class attributes. */
5551 /* ---------------------------------------- */
5552 /* Implement member functions to access the attributes associated with
5553 this class using the macros defined for this purpose in the
5554 "object.h" file. For a description of each attribute, see the class
5555 interface (in the associated .h file). */
5556
5557 /*
5558 *att++
5559 * Name:
5560 * Seed
5561
5562 * Purpose:
5563 * Random number seed for a MathMap.
5564
5565 * Type:
5566 * Public attribute.
5567
5568 * Synopsis:
5569 * Integer.
5570
5571 * Description:
5572 * This attribute, which may take any integer value, determines the
5573 * sequence of random numbers produced by the random number functions in
5574 * MathMap expressions. It is set to an unpredictable default value when
5575 * a MathMap is created, so that by default each MathMap uses a different
5576 * set of random numbers.
5577 *
5578 * If required, you may set this Seed attribute to a value of your
5579 * choosing in order to produce repeatable behaviour from the random
5580 * number functions. You may also enquire the Seed value (e.g. if an
5581 * initially unpredictable value has been used) and then use it to
5582 * reproduce the resulting sequence of random numbers, either from the
5583 * same MathMap or from another one.
5584 *
5585 * Clearing the Seed attribute gives it a new unpredictable default
5586 * value.
5587
5588 * Applicability:
5589 * MathMap
5590 * All MathMaps have this attribute.
5591 *att--
5592 */
5593 /* Clear the Seed value by setting it to a new unpredictable value
5594 produced by DefaultSeed and clearing the "seed_set" flag in the
5595 MathMap's random number generator context. Also clear the "active"
5596 flag, so that the generator will be re-initialised to use this seed
5597 when it is next invoked. */
5598 astMAKE_CLEAR(MathMap,Seed,rcontext.seed,( this->rcontext.seed_set = 0,
5599 this->rcontext.active = 0,
5600 DefaultSeed( &this->rcontext, status ) ))
5601
5602 /* Return the "seed" value from the random number generator
5603 context. */
5604 astMAKE_GET(MathMap,Seed,int,0,this->rcontext.seed)
5605
5606 /* Store the new seed value in the MathMap's random number generator
5607 context and set the context's "seed_set" flag. Also clear the "active"
5608 flag, so that the generator will be re-initialised to use this seed
5609 when it is next invoked. */
5610 astMAKE_SET(MathMap,Seed,int,rcontext.seed,( this->rcontext.seed_set = 1,
5611 this->rcontext.active = 0,
5612 value ))
5613
5614 /* Test the "seed_set" flag in the random number generator context. */
5615 astMAKE_TEST(MathMap,Seed,( this->rcontext.seed_set ))
5616
5617 /*
5618 *att++
5619 * Name:
5620 * SimpFI
5621
5622 * Purpose:
5623 * Forward-inverse MathMap pairs simplify?
5624
5625 * Type:
5626 * Public attribute.
5627
5628 * Synopsis:
5629 * Integer (boolean).
5630
5631 * Description:
5632 c This attribute should be set to a non-zero value if applying a
5633 c MathMap's forward transformation, followed immediately by the matching
5634 c inverse transformation will always restore the original set of
5635 c coordinates. It indicates that AST may replace such a sequence of
5636 c operations by an identity Mapping (a UnitMap) if it is encountered
5637 c while simplifying a compound Mapping (e.g. using astSimplify).
5638 f This attribute should be set to a non-zero value if applying a
5639 f MathMap's forward transformation, followed immediately by the matching
5640 f inverse transformation will always restore the original set of
5641 f coordinates. It indicates that AST may replace such a sequence of
5642 f operations by an identity Mapping (a UnitMap) if it is encountered
5643 f while simplifying a compound Mapping (e.g. using AST_SIMPLIFY).
5644 *
5645 * By default, the SimpFI attribute is zero, so that AST will not perform
5646 * this simplification unless you have set SimpFI to indicate that it is
5647 * safe to do so.
5648
5649 * Applicability:
5650 * MathMap
5651 * All MathMaps have this attribute.
5652
5653 * Notes:
5654 * - For simplification to occur, the two MathMaps must be in series and
5655 * be identical (with textually identical transformation
5656 * functions). Functional equivalence is not sufficient.
5657 * - The consent of both MathMaps is required before simplification can
5658 * take place. If either has a SimpFI value of zero, then simplification
5659 * will not occur.
5660 * - The SimpFI attribute controls simplification only in the case where
5661 * a MathMap's forward transformation is followed by the matching inverse
5662 * transformation. It does not apply if an inverse transformation is
5663 * followed by a forward transformation. This latter case is controlled
5664 * by the SimpIF attribute.
5665 c - The "forward" and "inverse" transformations referred to are those
5666 c defined when the MathMap is created (corresponding to the "fwd" and
5667 c "inv" parameters of its constructor function). If the MathMap is
5668 c inverted (i.e. its Invert attribute is non-zero), then the role of the
5669 c SimpFI and SimpIF attributes will be interchanged.
5670 f - The "forward" and "inverse" transformations referred to are those
5671 f defined when the MathMap is created (corresponding to the FWD and
5672 f INV arguments of its constructor function). If the MathMap is
5673 f inverted (i.e. its Invert attribute is non-zero), then the role of the
5674 f SimpFI and SimpIF attributes will be interchanged.
5675 *att--
5676 */
5677 /* Clear the SimpFI value by setting it to -INT_MAX. */
5678 astMAKE_CLEAR(MathMap,SimpFI,simp_fi,-INT_MAX)
5679
5680 /* Supply a default of 0 if no SimpFI value has been set. */
5681 astMAKE_GET(MathMap,SimpFI,int,0,( ( this->simp_fi != -INT_MAX ) ?
5682 this->simp_fi : 0 ))
5683
5684 /* Set a SimpFI value of 1 if any non-zero value is supplied. */
5685 astMAKE_SET(MathMap,SimpFI,int,simp_fi,( value != 0 ))
5686
5687 /* The SimpFI value is set if it is not -INT_MAX. */
5688 astMAKE_TEST(MathMap,SimpFI,( this->simp_fi != -INT_MAX ))
5689
5690 /*
5691 *att++
5692 * Name:
5693 * SimpIF
5694
5695 * Purpose:
5696 * Inverse-forward MathMap pairs simplify?
5697
5698 * Type:
5699 * Public attribute.
5700
5701 * Synopsis:
5702 * Integer (boolean).
5703
5704 * Description:
5705 c This attribute should be set to a non-zero value if applying a
5706 c MathMap's inverse transformation, followed immediately by the matching
5707 c forward transformation will always restore the original set of
5708 c coordinates. It indicates that AST may replace such a sequence of
5709 c operations by an identity Mapping (a UnitMap) if it is encountered
5710 c while simplifying a compound Mapping (e.g. using astSimplify).
5711 f This attribute should be set to a non-zero value if applying a
5712 f MathMap's inverse transformation, followed immediately by the matching
5713 f forward transformation will always restore the original set of
5714 f coordinates. It indicates that AST may replace such a sequence of
5715 f operations by an identity Mapping (a UnitMap) if it is encountered
5716 f while simplifying a compound Mapping (e.g. using AST_SIMPLIFY).
5717 *
5718 * By default, the SimpIF attribute is zero, so that AST will not perform
5719 * this simplification unless you have set SimpIF to indicate that it is
5720 * safe to do so.
5721
5722 * Applicability:
5723 * MathMap
5724 * All MathMaps have this attribute.
5725
5726 * Notes:
5727 * - For simplification to occur, the two MathMaps must be in series and
5728 * be identical (with textually identical transformation
5729 * functions). Functional equivalence is not sufficient.
5730 * - The consent of both MathMaps is required before simplification can
5731 * take place. If either has a SimpIF value of zero, then simplification
5732 * will not occur.
5733 * - The SimpIF attribute controls simplification only in the case where
5734 * a MathMap's inverse transformation is followed by the matching forward
5735 * transformation. It does not apply if a forward transformation is
5736 * followed by an inverse transformation. This latter case is controlled
5737 * by the SimpFI attribute.
5738 c - The "forward" and "inverse" transformations referred to are those
5739 c defined when the MathMap is created (corresponding to the "fwd" and
5740 c "inv" parameters of its constructor function). If the MathMap is
5741 c inverted (i.e. its Invert attribute is non-zero), then the role of the
5742 c SimpFI and SimpIF attributes will be interchanged.
5743 f - The "forward" and "inverse" transformations referred to are those
5744 f defined when the MathMap is created (corresponding to the FWD and
5745 f INV arguments of its constructor function). If the MathMap is
5746 f inverted (i.e. its Invert attribute is non-zero), then the role of the
5747 f SimpFI and SimpIF attributes will be interchanged.
5748 *att--
5749 */
5750 /* Clear the SimpIF value by setting it to -INT_MAX. */
5751 astMAKE_CLEAR(MathMap,SimpIF,simp_if,-INT_MAX)
5752
5753 /* Supply a default of 0 if no SimpIF value has been set. */
5754 astMAKE_GET(MathMap,SimpIF,int,0,( ( this->simp_if != -INT_MAX ) ?
5755 this->simp_if : 0 ))
5756
5757 /* Set a SimpIF value of 1 if any non-zero value is supplied. */
5758 astMAKE_SET(MathMap,SimpIF,int,simp_if,( value != 0 ))
5759
5760 /* The SimpIF value is set if it is not -INT_MAX. */
5761 astMAKE_TEST(MathMap,SimpIF,( this->simp_if != -INT_MAX ))
5762
5763 /* Copy constructor. */
5764 /* ----------------- */
Copy(const AstObject * objin,AstObject * objout,int * status)5765 static void Copy( const AstObject *objin, AstObject *objout, int *status ) {
5766 /*
5767 * Name:
5768 * Copy
5769
5770 * Purpose:
5771 * Copy constructor for MathMap objects.
5772
5773 * Type:
5774 * Private function.
5775
5776 * Synopsis:
5777 * void Copy( const AstObject *objin, AstObject *objout, int *status )
5778
5779 * Description:
5780 * This function implements the copy constructor for MathMap objects.
5781
5782 * Parameters:
5783 * objin
5784 * Pointer to the object to be copied.
5785 * objout
5786 * Pointer to the object being constructed.
5787 * status
5788 * Pointer to the inherited status variable.
5789
5790 * Returned Value:
5791 * void
5792
5793 * Notes:
5794 * - This constructor makes a deep copy.
5795 */
5796
5797 /* Local Variables: */
5798 AstMathMap *in; /* Pointer to input MathMap */
5799 AstMathMap *out; /* Pointer to output MathMap */
5800 int ifun; /* Loop counter for functions */
5801
5802 /* Check the global error status. */
5803 if ( !astOK ) return;
5804
5805 /* Obtain pointers to the input and output MathMaps. */
5806 in = (AstMathMap *) objin;
5807 out = (AstMathMap *) objout;
5808
5809 /* For safety, first clear any references to the input memory from
5810 the output MathMap. */
5811 out->fwdfun = NULL;
5812 out->invfun = NULL;
5813 out->fwdcode = NULL;
5814 out->invcode = NULL;
5815 out->fwdcon = NULL;
5816 out->invcon = NULL;
5817
5818 /* Now allocate and initialise each of the output pointer arrays
5819 required. */
5820 if ( in->fwdfun ) {
5821 MALLOC_POINTER_ARRAY( out->fwdfun, char *, out->nfwd )
5822 }
5823 if ( in->invfun ) {
5824 MALLOC_POINTER_ARRAY( out->invfun, char *, out->ninv )
5825 }
5826 if ( in->fwdcode ) {
5827 MALLOC_POINTER_ARRAY( out->fwdcode, int *, out->nfwd )
5828 }
5829 if ( in->invcode ) {
5830 MALLOC_POINTER_ARRAY( out->invcode, int *, out->ninv )
5831 }
5832 if ( in->fwdcon ) {
5833 MALLOC_POINTER_ARRAY( out->fwdcon, double *, out->nfwd )
5834 }
5835 if ( in->invcon ) {
5836 MALLOC_POINTER_ARRAY( out->invcon, double *, out->ninv )
5837 }
5838
5839 /* If OK, loop to make copies of the data (where available) associated
5840 with each forward transformation function, storing pointers to the
5841 copy in the output pointer arrays allocated above. */
5842 if ( astOK ) {
5843 for ( ifun = 0; ifun < out->nfwd; ifun++ ) {
5844 if ( in->fwdfun && in->fwdfun[ ifun ] ) {
5845 out->fwdfun[ ifun ] = astStore( NULL, in->fwdfun[ ifun ],
5846 astSizeOf( in->fwdfun[ ifun ] ) );
5847 }
5848 if ( in->fwdcode && in->fwdcode[ ifun ] ) {
5849 out->fwdcode[ ifun ] = astStore( NULL, in->fwdcode[ ifun ],
5850 astSizeOf( in->fwdcode[ ifun ] ) );
5851 }
5852 if ( in->fwdcon && in->fwdcon[ ifun ] ) {
5853 out->fwdcon[ ifun ] = astStore( NULL, in->fwdcon[ ifun ],
5854 astSizeOf( in->fwdcon[ ifun ] ) );
5855 }
5856 if ( !astOK ) break;
5857 }
5858 }
5859
5860 /* Repeat this process for the inverse transformation functions. */
5861 if ( astOK ) {
5862 for ( ifun = 0; ifun < out->ninv; ifun++ ) {
5863 if ( in->invfun && in->invfun[ ifun ] ) {
5864 out->invfun[ ifun ] = astStore( NULL, in->invfun[ ifun ],
5865 astSizeOf( in->invfun[ ifun ] ) );
5866 }
5867 if ( in->invcode && in->invcode[ ifun ] ) {
5868 out->invcode[ ifun ] = astStore( NULL, in->invcode[ ifun ],
5869 astSizeOf( in->invcode[ ifun ] ) );
5870 }
5871 if ( in->invcon && in->invcon[ ifun ] ) {
5872 out->invcon[ ifun ] = astStore( NULL, in->invcon[ ifun ],
5873 astSizeOf( in->invcon[ ifun ] ) );
5874 }
5875 if ( !astOK ) break;
5876 }
5877 }
5878
5879 /* If an error occurred, clean up by freeing all output memory
5880 allocated above. */
5881 if ( !astOK ) {
5882 FREE_POINTER_ARRAY( out->fwdfun, out->nfwd )
5883 FREE_POINTER_ARRAY( out->invfun, out->ninv )
5884 FREE_POINTER_ARRAY( out->fwdcode, out->nfwd )
5885 FREE_POINTER_ARRAY( out->invcode, out->ninv )
5886 FREE_POINTER_ARRAY( out->fwdcon, out->nfwd )
5887 FREE_POINTER_ARRAY( out->invcon, out->ninv )
5888 }
5889 }
5890
5891 /* Destructor. */
5892 /* ----------- */
Delete(AstObject * obj,int * status)5893 static void Delete( AstObject *obj, int *status ) {
5894 /*
5895 * Name:
5896 * Delete
5897
5898 * Purpose:
5899 * Destructor for MathMap objects.
5900
5901 * Type:
5902 * Private function.
5903
5904 * Synopsis:
5905 * void Delete( AstObject *obj, int *status )
5906
5907 * Description:
5908 * This function implements the destructor for MathMap objects.
5909
5910 * Parameters:
5911 * obj
5912 * Pointer to the object to be deleted.
5913 * status
5914 * Pointer to the inherited status variable.
5915
5916 * Returned Value:
5917 * void
5918
5919 * Notes:
5920 * This function attempts to execute even if the global error status is
5921 * set.
5922 */
5923
5924 /* Local Variables: */
5925 AstMathMap *this; /* Pointer to MathMap */
5926
5927 /* Obtain a pointer to the MathMap structure. */
5928 this = (AstMathMap *) obj;
5929
5930 /* Free all memory allocated by the MathMap. */
5931 FREE_POINTER_ARRAY( this->fwdfun, this->nfwd )
5932 FREE_POINTER_ARRAY( this->invfun, this->ninv )
5933 FREE_POINTER_ARRAY( this->fwdcode, this->nfwd )
5934 FREE_POINTER_ARRAY( this->invcode, this->ninv )
5935 FREE_POINTER_ARRAY( this->fwdcon, this->nfwd )
5936 FREE_POINTER_ARRAY( this->invcon, this->ninv )
5937 }
5938
5939 /* Dump function. */
5940 /* -------------- */
Dump(AstObject * this_object,AstChannel * channel,int * status)5941 static void Dump( AstObject *this_object, AstChannel *channel, int *status ) {
5942 /*
5943 * Name:
5944 * Dump
5945
5946 * Purpose:
5947 * Dump function for MathMap objects.
5948
5949 * Type:
5950 * Private function.
5951
5952 * Synopsis:
5953 * void Dump( AstObject *this, AstChannel *channel, int *status )
5954
5955 * Description:
5956 * This function implements the Dump function which writes out data
5957 * for the MathMap class to an output Channel.
5958
5959 * Parameters:
5960 * this
5961 * Pointer to the MathMap whose data are being written.
5962 * channel
5963 * Pointer to the Channel to which the data are being written.
5964 * status
5965 * Pointer to the inherited status variable.
5966 */
5967
5968 /* Local Constants: */
5969 #define COMMENT_LEN 150 /* Maximum length of a comment string */
5970 #define KEY_LEN 50 /* Maximum length of a keyword */
5971
5972 /* Local Variables: */
5973 AstMathMap *this; /* Pointer to the MathMap structure */
5974 char comment[ COMMENT_LEN + 1 ]; /* Buffer for comment strings */
5975 char key[ KEY_LEN + 1 ]; /* Buffer for keyword strings */
5976 int ifun; /* Loop counter for functions */
5977 int invert; /* MathMap inverted? */
5978 int ival; /* Integer attribute value */
5979 int nin; /* True number of input coordinates */
5980 int nout; /* True number of output coordinates */
5981 int set; /* Attribute value set? */
5982
5983 /* Check the global error status. */
5984 if ( !astOK ) return;
5985
5986 /* Obtain a pointer to the MathMap structure. */
5987 this = (AstMathMap *) this_object;
5988
5989 /* Determine if the MathMap is inverted and obtain the "true" number
5990 of input and output coordinates by un-doing the effects of any
5991 inversion. */
5992 invert = astGetInvert( this );
5993 nin = !invert ? astGetNin( this ) : astGetNout( this );
5994 nout = !invert ? astGetNout( this ) : astGetNin( this );
5995
5996 /* Write out values representing the instance variables for the
5997 MathMap class. Accompany these with appropriate comment strings,
5998 possibly depending on the values being written.*/
5999
6000 /* In the case of attributes, we first use the appropriate (private)
6001 Test... member function to see if they are set. If so, we then use
6002 the (private) Get... function to obtain the value to be written
6003 out.
6004
6005 For attributes which are not set, we use the astGet... method to
6006 obtain the value instead. This will supply a default value
6007 (possibly provided by a derived class which over-rides this method)
6008 which is more useful to a human reader as it corresponds to the
6009 actual default attribute value. Since "set" will be zero, these
6010 values are for information only and will not be read back. */
6011
6012 /* Number of forward transformation functions. */
6013 /* ------------------------------------------- */
6014 /* We regard this value as set if it differs from the number of output
6015 coordinates for the MathMap. */
6016 set = ( this->nfwd != nout );
6017 astWriteInt( channel, "Nfwd", set, 0, this->nfwd,
6018 "Number of forward transformation functions" );
6019
6020 /* Forward transformation functions. */
6021 /* --------------------------------- */
6022 /* Loop to write out each forward transformation function, generating
6023 a suitable keyword and comment for each one. */
6024 for ( ifun = 0; ifun < this->nfwd; ifun++ ) {
6025 (void) sprintf( key, "Fwd%d", ifun + 1 );
6026 (void) sprintf( comment, "Forward function %d", ifun + 1 );
6027 astWriteString( channel, key, 1, 1, this->fwdfun[ ifun ], comment );
6028 }
6029
6030 /* Number of inverse transformation functions. */
6031 /* ------------------------------------------- */
6032 /* We regard this value as set if it differs from the number of input
6033 coordinates for the MathMap. */
6034 set = ( this->ninv != nin );
6035 astWriteInt( channel, "Ninv", set, 0, this->ninv,
6036 "Number of inverse transformation functions" );
6037
6038 /* Inverse transformation functions. */
6039 /* --------------------------------- */
6040 /* Similarly, loop to write out each inverse transformation
6041 function. */
6042 for ( ifun = 0; ifun < this->ninv; ifun++ ) {
6043 (void) sprintf( key, "Inv%d", ifun + 1 );
6044 (void) sprintf( comment, "Inverse function %d", ifun + 1 );
6045 astWriteString( channel, key, 1, 1, this->invfun[ ifun ], comment );
6046 }
6047
6048 /* SimpFI. */
6049 /* ------- */
6050 /* Write out the forward-inverse simplification flag. */
6051 set = TestSimpFI( this, status );
6052 ival = set ? GetSimpFI( this, status ) : astGetSimpFI( this );
6053 astWriteInt( channel, "SimpFI", set, 0, ival,
6054 ival ? "Forward-inverse pairs may simplify" :
6055 "Forward-inverse pairs do not simplify" );
6056
6057 /* SimpIF. */
6058 /* ------- */
6059 /* Write out the inverse-forward simplification flag. */
6060 set = TestSimpIF( this, status );
6061 ival = set ? GetSimpIF( this, status ) : astGetSimpIF( this );
6062 astWriteInt( channel, "SimpIF", set, 0, ival,
6063 ival ? "Inverse-forward pairs may simplify" :
6064 "Inverse-forward pairs do not simplify" );
6065
6066 /* Seed. */
6067 /* ----- */
6068 /* Write out any random number seed value which is set. Prefix this with
6069 a separate flag which indicates if the seed has been set. */
6070 set = TestSeed( this, status );
6071 ival = set ? GetSeed( this, status ) : astGetSeed( this );
6072 astWriteInt( channel, "Seeded", set, 0, set,
6073 set? "Explicit random number seed set" :
6074 "No random number seed set" );
6075 astWriteInt( channel, "Seed", set, 0, ival,
6076 set ? "Random number seed value" :
6077 "Default random number seed used" );
6078
6079 /* Undefine macros local to this function. */
6080 #undef COMMENT_LEN
6081 #undef KEY_LEN
6082 }
6083
6084 /* Standard class functions. */
6085 /* ========================= */
6086 /* Implement the astIsAMathMap and astCheckMathMap functions using the macros
6087 defined for this purpose in the "object.h" header file. */
astMAKE_ISA(MathMap,Mapping)6088 astMAKE_ISA(MathMap,Mapping)
6089 astMAKE_CHECK(MathMap)
6090
6091 AstMathMap *astMathMap_( int nin, int nout,
6092 int nfwd, const char *fwd[],
6093 int ninv, const char *inv[],
6094 const char *options, int *status, ...) {
6095 /*
6096 *+
6097 * Name:
6098 * astMathMap
6099
6100 * Purpose:
6101 * Create a MathMap.
6102
6103 * Type:
6104 * Protected function.
6105
6106 * Synopsis:
6107 * #include "mathmap.h"
6108 * AstMathMap *astMathMap( int nin, int nout,
6109 * int nfwd, const char *fwd[],
6110 * int ninv, const char *inv[],
6111 * const char *options, ..., int *status )
6112
6113 * Class Membership:
6114 * MathMap constructor.
6115
6116 * Description:
6117 * This function creates a new MathMap and optionally initialises its
6118 * attributes.
6119
6120 * Parameters:
6121 * nin
6122 * Number of input variables for the MathMap.
6123 * nout
6124 * Number of output variables for the MathMap.
6125 * nfwd
6126 * The number of forward transformation functions being supplied.
6127 * This must be at least equal to "nout".
6128 * fwd
6129 * Pointer to an array, with "nfwd" elements, of pointers to null
6130 * terminated strings which contain each of the forward transformation
6131 * functions.
6132 * ninv
6133 * The number of inverse transformation functions being supplied.
6134 * This must be at least equal to "nin".
6135 * inv
6136 * Pointer to an array, with "ninv" elements, of pointers to null
6137 * terminated strings which contain each of the inverse transformation
6138 * functions.
6139 * options
6140 * Pointer to a null terminated string containing an optional
6141 * comma-separated list of attribute assignments to be used for
6142 * initialising the new MathMap. The syntax used is the same as
6143 * for the astSet method and may include "printf" format
6144 * specifiers identified by "%" symbols in the normal way.
6145 * status
6146 * Pointer to the inherited status variable.
6147 * ...
6148 * If the "options" string contains "%" format specifiers, then
6149 * an optional list of arguments may follow it in order to
6150 * supply values to be substituted for these specifiers. The
6151 * rules for supplying these are identical to those for the
6152 * astSet method (and for the C "printf" function).
6153
6154 * Returned Value:
6155 * A pointer to the new MathMap.
6156
6157 * Notes:
6158 * - A NULL pointer will be returned if this function is invoked
6159 * with the global error status set, or if it should fail for any
6160 * reason.
6161 *-
6162
6163 * Implementation Notes:
6164 * - This function implements the basic MathMap constructor which is
6165 * available via the protected interface to the MathMap class. A
6166 * public interface is provided by the astMathMapId_ function.
6167 */
6168
6169 /* Local Variables: */
6170 astDECLARE_GLOBALS /* Pointer to thread-specific global data */
6171 AstMathMap *new; /* Pointer to new MathMap */
6172 va_list args; /* Variable argument list */
6173
6174 /* Get a pointer to the thread specific global data structure. */
6175 astGET_GLOBALS(NULL);
6176
6177 /* Check the global status. */
6178 if ( !astOK ) return NULL;
6179
6180 /* Initialise the MathMap, allocating memory and initialising the
6181 virtual function table as well if necessary. */
6182 new = astInitMathMap( NULL, sizeof( AstMathMap ), !class_init, &class_vtab,
6183 "MathMap", nin, nout, nfwd, fwd, ninv, inv );
6184
6185 /* If successful, note that the virtual function table has been
6186 initialised. */
6187 if ( astOK ) {
6188 class_init = 1;
6189
6190 /* Obtain the variable argument list and pass it along with the options string
6191 to the astVSet method to initialise the new MathMap's attributes. */
6192 va_start( args, status );
6193 astVSet( new, options, NULL, args );
6194 va_end( args );
6195
6196 /* If an error occurred, clean up by deleting the new object. */
6197 if ( !astOK ) new = astDelete( new );
6198 }
6199
6200 /* Return a pointer to the new MathMap. */
6201 return new;
6202 }
6203
astMathMapId_(int nin,int nout,int nfwd,const char * fwd[],int ninv,const char * inv[],const char * options,...)6204 AstMathMap *astMathMapId_( int nin, int nout,
6205 int nfwd, const char *fwd[],
6206 int ninv, const char *inv[],
6207 const char *options, ... ) {
6208 /*
6209 *++
6210 * Name:
6211 c astMathMap
6212 f AST_MATHMAP
6213
6214 * Purpose:
6215 * Create a MathMap.
6216
6217 * Type:
6218 * Public function.
6219
6220 * Synopsis:
6221 c #include "mathmap.h"
6222 c AstMathMap *astMathMap( int nin, int nout,
6223 c int nfwd, const char *fwd[],
6224 c int ninv, const char *inv[],
6225 c const char *options, ... )
6226 f RESULT = AST_MATHMAP( NIN, NOUT, NFWD, FWD, NINV, INV, OPTIONS, STATUS )
6227
6228 * Class Membership:
6229 * MathMap constructor.
6230
6231 * Description:
6232 * This function creates a new MathMap and optionally initialises its
6233 * attributes.
6234 *
6235 c A MathMap is a Mapping which allows you to specify a set of forward
6236 c and/or inverse transformation functions using arithmetic operations
6237 c and mathematical functions similar to those available in C. The
6238 c MathMap interprets these functions at run-time, whenever its forward
6239 c or inverse transformation is required. Because the functions are not
6240 c compiled in the normal sense (unlike an IntraMap), they may be used to
6241 c describe coordinate transformations in a transportable manner. A
6242 c MathMap therefore provides a flexible way of defining new types of
6243 c Mapping whose descriptions may be stored as part of a dataset and
6244 c interpreted by other programs.
6245 f A MathMap is a Mapping which allows you to specify a set of forward
6246 f and/or inverse transformation functions using arithmetic operations
6247 f and mathematical functions similar to those available in Fortran. The
6248 f MathMap interprets these functions at run-time, whenever its forward
6249 f or inverse transformation is required. Because the functions are not
6250 f compiled in the normal sense (unlike an IntraMap), they may be used to
6251 f describe coordinate transformations in a transportable manner. A
6252 f MathMap therefore provides a flexible way of defining new types of
6253 f Mapping whose descriptions may be stored as part of a dataset and
6254 f interpreted by other programs.
6255
6256 * Parameters:
6257 c nin
6258 f NIN = INTEGER
6259 * Number of input variables for the MathMap. This determines the
6260 * value of its Nin attribute.
6261 c nout
6262 f NOUT = INTEGER
6263 * Number of output variables for the MathMap. This determines the
6264 * value of its Nout attribute.
6265 c nfwd
6266 f NFWD = INTEGER
6267 * The number of forward transformation functions being supplied.
6268 c This must be at least equal to "nout", but may be increased to
6269 f This must be at least equal to NOUT, but may be increased to
6270 * accommodate any additional expressions which define intermediate
6271 * variables for the forward transformation (see the "Calculating
6272 * Intermediate Values" section below).
6273 c fwd
6274 f FWD = CHARACTER * ( * )( NFWD )
6275 c An array (with "nfwd" elements) of pointers to null terminated strings
6276 c which contain the expressions defining the forward transformation.
6277 f An array which contains the expressions defining the forward
6278 f transformation.
6279 * The syntax of these expressions is described below.
6280 c ninv
6281 f NINV = INTEGER
6282 * The number of inverse transformation functions being supplied.
6283 c This must be at least equal to "nin", but may be increased to
6284 f This must be at least equal to NIN, but may be increased to
6285 * accommodate any additional expressions which define intermediate
6286 * variables for the inverse transformation (see the "Calculating
6287 * Intermediate Values" section below).
6288 c inv
6289 f INV = CHARACTER * ( * )( NINV )
6290 c An array (with "ninv" elements) of pointers to null terminated strings
6291 c which contain the expressions defining the inverse transformation.
6292 f An array which contains the expressions defining the inverse
6293 f transformation.
6294 * The syntax of these expressions is described below.
6295 c options
6296 f OPTIONS = CHARACTER * ( * ) (Given)
6297 c Pointer to a null-terminated string containing an optional
6298 c comma-separated list of attribute assignments to be used for
6299 c initialising the new MathMap. The syntax used is identical to
6300 c that for the astSet function and may include "printf" format
6301 c specifiers identified by "%" symbols in the normal way.
6302 c If no initialisation is required, a zero-length string may be
6303 c supplied.
6304 f A character string containing an optional comma-separated
6305 f list of attribute assignments to be used for initialising the
6306 f new MathMap. The syntax used is identical to that for the
6307 f AST_SET routine. If no initialisation is required, a blank
6308 f value may be supplied.
6309 c ...
6310 c If the "options" string contains "%" format specifiers, then
6311 c an optional list of additional arguments may follow it in
6312 c order to supply values to be substituted for these
6313 c specifiers. The rules for supplying these are identical to
6314 c those for the astSet function (and for the C "printf"
6315 c function).
6316 f STATUS = INTEGER (Given and Returned)
6317 f The global status.
6318
6319 * Returned Value:
6320 c astMathMap()
6321 f AST_MATHMAP = INTEGER
6322 * A pointer to the new MathMap.
6323
6324 * Defining Transformation Functions:
6325 c A MathMap's transformation functions are supplied as a set of
6326 c expressions in an array of character strings. Normally you would
6327 c supply the same number of expressions for the forward transformation,
6328 c via the "fwd" parameter, as there are output variables (given by the
6329 c MathMap's Nout attribute). For instance, if Nout is 2 you might use:
6330 c - "r = sqrt( x * x + y * y )"
6331 c - "theta = atan2( y, x )"
6332 c
6333 c which defines a transformation from Cartesian to polar
6334 c coordinates. Here, the variables that appear on the left of each
6335 c expression ("r" and "theta") provide names for the output variables
6336 c and those that appear on the right ("x" and "y") are references to
6337 c input variables.
6338 f A MathMap's transformation functions are supplied as a set of
6339 f expressions in an array of character strings. Normally you would
6340 f supply the same number of expressions for the forward transformation,
6341 f via the FWD argument, as there are output variables (given by the
6342 f MathMap's Nout attribute). For instance, if Nout is 2 you might use:
6343 f - 'R = SQRT( X * X + Y * Y )'
6344 f - 'THETA = ATAN2( Y, X )'
6345 f
6346 f which defines a transformation from Cartesian to polar
6347 f coordinates. Here, the variables that appear on the left of each
6348 f expression (R and THETA) provide names for the output variables and
6349 f those that appear on the right (X and Y) are references to input
6350 f variables.
6351 *
6352 c To complement this, you must also supply expressions for the inverse
6353 c transformation via the "inv" parameter. In this case, the number of
6354 c expressions given would normally match the number of MathMap input
6355 c coordinates (given by the Nin attribute). If Nin is 2, you might use:
6356 c - "x = r * cos( theta )"
6357 c - "y = r * sin( theta )"
6358 c
6359 c which expresses the transformation from polar to Cartesian
6360 c coordinates. Note that here the input variables ("x" and "y") are
6361 c named on the left of each expression, and the output variables ("r"
6362 c and "theta") are referenced on the right.
6363 f To complement this, you must also supply expressions for the inverse
6364 f transformation via the INV argument. In this case, the number of
6365 f expressions given would normally match the number of MathMap input
6366 f coordinates (given by the Nin attribute). If Nin is 2, you might use:
6367 f - 'X = R * COS( THETA )'
6368 f - 'Y = R * SIN( THETA )'
6369 f
6370 f which expresses the transformation from polar to Cartesian
6371 f coordinates. Note that here the input variables (X and Y) are named on
6372 f the left of each expression, and the output variables (R and THETA)
6373 f are referenced on the right.
6374 *
6375 * Normally, you cannot refer to a variable on the right of an expression
6376 * unless it is named on the left of an expression in the complementary
6377 * set of functions. Therefore both sets of functions (forward and
6378 * inverse) must be formulated using the same consistent set of variable
6379 * names. This means that if you wish to leave one of the transformations
6380 * undefined, you must supply dummy expressions which simply name each of
6381 * the output (or input) variables. For example, you might use:
6382 c - "x"
6383 c - "y"
6384 f - 'X'
6385 f - 'Y'
6386 *
6387 * for the inverse transformation above, which serves to name the input
6388 * variables but without defining an inverse transformation.
6389
6390 * Calculating Intermediate Values:
6391 c It is sometimes useful to calculate intermediate values and then to
6392 c use these in the final expressions for the output (or input)
6393 c variables. This may be done by supplying additional expressions for
6394 c the forward (or inverse) transformation functions. For instance, the
6395 c following array of five expressions describes 2-dimensional pin-cushion
6396 c distortion:
6397 c - "r = sqrt( xin * xin + yin * yin )"
6398 c - "rout = r * ( 1 + 0.1 * r * r )"
6399 c - "theta = atan2( yin, xin )"
6400 c - "xout = rout * cos( theta )"
6401 c - "yout = rout * sin( theta )"
6402 f It is sometimes useful to calculate intermediate values and then to
6403 f use these in the final expressions for the output (or input)
6404 f variables. This may be done by supplying additional expressions for
6405 f the forward (or inverse) transformation functions. For instance, the
6406 f following array of five expressions describes 2-dimensional pin-cushion
6407 f distortion:
6408 f - 'R = SQRT( XIN * XIN + YIN * YIN )'
6409 f - 'ROUT = R * ( 1 + 0.1 * R * R )'
6410 f - 'THETA = ATAN2( YIN, XIN )',
6411 f - 'XOUT = ROUT * COS( THETA )'
6412 f - 'YOUT = ROUT * SIN( THETA )'
6413 *
6414 c Here, we first calculate three intermediate results ("r", "rout"
6415 c and "theta") and then use these to calculate the final results ("xout"
6416 c and "yout"). The MathMap knows that only the final two results
6417 c constitute values for the output variables because its Nout attribute
6418 c is set to 2. You may define as many intermediate variables in this
6419 c way as you choose. Having defined a variable, you may then refer to it
6420 c on the right of any subsequent expressions.
6421 f Here, we first calculate three intermediate results (R, ROUT
6422 f and THETA) and then use these to calculate the final results (XOUT
6423 f and YOUT). The MathMap knows that only the final two results
6424 f constitute values for the output variables because its Nout attribute
6425 f is set to 2. You may define as many intermediate variables in this
6426 f way as you choose. Having defined a variable, you may then refer to it
6427 f on the right of any subsequent expressions.
6428 *
6429 c Note that when defining the inverse transformation you may only refer
6430 c to the output variables "xout" and "yout". The intermediate variables
6431 c "r", "rout" and "theta" (above) are private to the forward
6432 c transformation and may not be referenced by the inverse
6433 c transformation. The inverse transformation may, however, define its
6434 c own private intermediate variables.
6435 f Note that when defining the inverse transformation you may only refer
6436 f to the output variables XOUT and YOUT. The intermediate variables R,
6437 f ROUT and THETA (above) are private to the forward transformation and
6438 f may not be referenced by the inverse transformation. The inverse
6439 f transformation may, however, define its own private intermediate
6440 f variables.
6441
6442 * Expression Syntax:
6443 c The expressions given for the forward and inverse transformations
6444 c closely follow the syntax of the C programming language (with some
6445 c extensions for compatibility with Fortran). They may contain
6446 c references to variables and literal constants, together with
6447 c arithmetic, boolean, relational and bitwise operators, and function
6448 c invocations. A set of symbolic constants is also available. Each of
6449 c these is described in detail below. Parentheses may be used to
6450 c over-ride the normal order of evaluation. There is no built-in limit
6451 c to the length of expressions and they are insensitive to case or the
6452 c presence of additional white space.
6453 f The expressions given for the forward and inverse transformations
6454 f closely follow the syntax of Fortran (with some extensions for
6455 f compatibility with the C language). They may contain references to
6456 f variables and literal constants, together with arithmetic, logical,
6457 f relational and bitwise operators, and function invocations. A set of
6458 f symbolic constants is also available. Each of these is described in
6459 f detail below. Parentheses may be used to over-ride the normal order of
6460 f evaluation. There is no built-in limit to the length of expressions
6461 f and they are insensitive to case or the presence of additional white
6462 f space.
6463
6464 * Variables:
6465 * Variable names must begin with an alphabetic character and may contain
6466 * only alphabetic characters, digits, and the underscore character
6467 * "_". There is no built-in limit to the length of variable names.
6468
6469 * Literal Constants:
6470 c Literal constants, such as "0", "1", "0.007" or "2.505e-16" may appear
6471 c in expressions, with the decimal point and exponent being optional (a
6472 c "D" may also be used as an exponent character for compatibility with
6473 c Fortran). A unary minus "-" may be used as a prefix.
6474 f Literal constants, such as "0", "1", "0.007" or "2.505E-16" may appear
6475 f in expressions, with the decimal point and exponent being optional (a
6476 f "D" may also be used as an exponent character). A unary minus "-" may
6477 f be used as a prefix.
6478
6479 * Arithmetic Precision:
6480 * All arithmetic is floating point, performed in double precision.
6481
6482 * Propagation of Missing Data:
6483 * Unless indicated otherwise, if any argument of a function or operator
6484 * has the value AST__BAD (indicating missing data), then the result of
6485 * that function or operation is also AST__BAD, so that such values are
6486 * propagated automatically through all operations performed by MathMap
6487 * transformations. The special value AST__BAD can be represented in
6488 * expressions by the symbolic constant "<bad>".
6489 *
6490 * A <bad> result (i.e. equal to AST__BAD) is also produced in response
6491 * to any numerical error (such as division by zero or numerical
6492 * overflow), or if an invalid argument value is provided to a function
6493 * or operator.
6494
6495 * Arithmetic Operators:
6496 * The following arithmetic operators are available:
6497 c - x1 + x2: Sum of "x1" and "x2".
6498 f - X1 + X2: Sum of X1 and X2.
6499 c - x1 - x2: Difference of "x1" and "x2".
6500 f - X1 - X2: Difference of X1 and X2.
6501 c - x1 * x2: Product of "x1" and "x1".
6502 f - X1 * X2: Product of X1 and X2.
6503 c - x1 / x2: Ratio of "x1" and "x2".
6504 f - X1 / X2: Ratio of X1 and X2.
6505 c - x1 ** x2: "x1" raised to the power of "x2".
6506 f - X1 ** X2: X1 raised to the power of X2.
6507 c - + x: Unary plus, has no effect on its argument.
6508 f - + X: Unary plus, has no effect on its argument.
6509 c - - x: Unary minus, negates its argument.
6510 f - - X: Unary minus, negates its argument.
6511
6512 c Boolean Operators:
6513 f Logical Operators:
6514 c Boolean values are represented using zero to indicate false and
6515 c non-zero to indicate true. In addition, the value AST__BAD is taken to
6516 c mean "unknown". The values returned by boolean operators may therefore
6517 c be 0, 1 or AST__BAD. Where appropriate, "tri-state" logic is
6518 c implemented. For example, "a||b" may evaluate to 1 if "a" is non-zero,
6519 c even if "b" has the value AST__BAD. This is because the result of the
6520 c operation would not be affected by the value of "b", so long as "a" is
6521 c non-zero.
6522 f Logical values are represented using zero to indicate .FALSE. and
6523 f non-zero to indicate .TRUE.. In addition, the value AST__BAD is taken to
6524 f mean "unknown". The values returned by logical operators may therefore
6525 f be 0, 1 or AST__BAD. Where appropriate, "tri-state" logic is
6526 f implemented. For example, A.OR.B may evaluate to 1 if A is non-zero,
6527 f even if B has the value AST__BAD. This is because the result of the
6528 f operation would not be affected by the value of B, so long as A is
6529 f non-zero.
6530 *
6531 c The following boolean operators are available:
6532 f The following logical operators are available:
6533 c - x1 && x2: Boolean AND between "x1" and "x2", returning 1 if both "x1"
6534 c and "x2" are non-zero, and 0 otherwise. This operator implements
6535 c tri-state logic. (The synonym ".and." is also provided for compatibility
6536 c with Fortran.)
6537 f - X1 .AND. X2: Logical AND between X1 and X2, returning 1 if both X1
6538 f and X2 are non-zero, and 0 otherwise. This operator implements
6539 f tri-state logic. (The synonym "&&" is also provided for compatibility
6540 f with C.)
6541 c - x1 || x2: Boolean OR between "x1" and "x2", returning 1 if either "x1"
6542 c or "x2" are non-zero, and 0 otherwise. This operator implements
6543 c tri-state logic. (The synonym ".or." is also provided for compatibility
6544 c with Fortran.)
6545 f - X1 .OR. X2: Logical OR between X1 and X2, returning 1 if either X1
6546 f or X2 are non-zero, and 0 otherwise. This operator implements
6547 f tri-state logic. (The synonym "||" is also provided for compatibility
6548 f with C.)
6549 c - x1 ^^ x2: Boolean exclusive OR (XOR) between "x1" and "x2", returning
6550 c 1 if exactly one of "x1" and "x2" is non-zero, and 0 otherwise. Tri-state
6551 c logic is not used with this operator. (The synonyms ".neqv." and ".xor."
6552 c are also provided for compatibility with Fortran, although the second
6553 c of these is not standard.)
6554 f - X1 .NEQV. X2: Logical exclusive OR (XOR) between X1 and X2,
6555 f returning 1 if exactly one of X1 and X2 is non-zero, and 0
6556 f otherwise. Tri-state logic is not used with this operator. (The
6557 f synonym ".XOR." is also provided, although this is not standard
6558 f Fortran. In addition, the C-like synonym "^^" may be used, although
6559 f this is also not standard.)
6560 c - x1 .eqv. x2: This is provided only for compatibility with Fortran
6561 c and tests whether the boolean states of "x1" and "x2" (i.e. true/false)
6562 c are equal. It is the negative of the exclusive OR (XOR) function.
6563 c Tri-state logic is not used with this operator.
6564 f - X1 .EQV. X2: Tests whether the logical states of X1 and X2
6565 f (i.e. .TRUE./.FALSE.) are equal. It is the negative of the exclusive OR
6566 f (XOR) function. Tri-state logic is not used with this operator.
6567 c - ! x: Boolean unary NOT operation, returning 1 if "x" is zero, and
6568 c 0 otherwise. (The synonym ".not." is also provided for compatibility
6569 c with Fortran.)
6570 f - .NOT. X: Logical unary NOT operation, returning 1 if X is zero, and
6571 f 0 otherwise. (The synonym "!" is also provided for compatibility with
6572 f C.)
6573
6574 * Relational Operators:
6575 c Relational operators return the boolean result (0 or 1) of comparing
6576 c the values of two floating point values for equality or inequality. The
6577 c value AST__BAD may also be returned if either argument is <bad>.
6578 f Relational operators return the logical result (0 or 1) of comparing
6579 f the values of two floating point values for equality or inequality. The
6580 f value AST__BAD may also be returned if either argument is <bad>.
6581 *
6582 * The following relational operators are available:
6583 c - x1 == x2: Tests whether "x1" equals "x1". (The synonym ".eq." is
6584 c also provided for compatibility with Fortran.)
6585 f - X1 .EQ. X2: Tests whether X1 equals X2. (The synonym "==" is also
6586 f provided for compatibility with C.)
6587 c - x1 != x2: Tests whether "x1" is unequal to "x2". (The synonym ".ne."
6588 c is also provided for compatibility with Fortran.)
6589 f - X1 .NE. X2: Tests whether X1 is unequal to X2. (The synonym "!=" is
6590 f also provided for compatibility with C.)
6591 c - x1 > x2: Tests whether "x1" is greater than "x2". (The synonym
6592 c ".gt." is also provided for compatibility with Fortran.)
6593 f - X1 .GT. X2: Tests whether X1 is greater than X2. (The synonym ">" is
6594 f also provided for compatibility with C.)
6595 c - x1 >= x2: Tests whether "x1" is greater than or equal to "x2". (The
6596 c synonym ".ge." is also provided for compatibility with Fortran.)
6597 f - X1 .GE. X2: Tests whether X1 is greater than or equal to X2. (The
6598 f synonym ">=" is also provided for compatibility with C.)
6599 c - x1 < x2: Tests whether "x1" is less than "x2". (The synonym ".lt."
6600 c is also provided for compatibility with Fortran.)
6601 f - X1 .LT. X2: Tests whether X1 is less than X2. (The synonym "<" is also
6602 f provided for compatibility with C.)
6603 c - x1 <= x2: Tests whether "x1" is less than or equal to "x2". (The
6604 c synonym ".le." is also provided for compatibility with Fortran.)
6605 f - X1 .LE. X2: Tests whether X1 is less than or equal to X2. (The synonym
6606 f "<=" is also provided for compatibility with C.)
6607 *
6608 c Note that relational operators cannot usefully be used to compare
6609 c values with the <bad> value (representing missing data), because the
6610 c result is always <bad>. The isbad() function should be used instead.
6611 f Note that relational operators cannot usefully be used to compare
6612 f values with the <bad> value (representing missing data), because the
6613 f result is always <bad>. The ISBAD() function should be used instead.
6614 f
6615 f Note, also, that because logical operators can operate on floating
6616 f point values, care must be taken to use parentheses in some cases
6617 f where they would not normally be required in Fortran. For example,
6618 f the expresssion:
6619 f - .NOT. A .EQ. B
6620 f
6621 f must be written:
6622 f - .NOT. ( A .EQ. B )
6623 f
6624 f to prevent the .NOT. operator from associating with the variable A.
6625
6626 * Bitwise Operators:
6627 c The bitwise operators provided by C are often useful when operating on
6628 c raw data (e.g. from instruments), so they are also provided for use in
6629 c MathMap expressions. In this case, however, the values on which they
6630 c operate are floating point values rather than pure integers. In order
6631 c to produce results which match the pure integer case, the operands are
6632 c regarded as fixed point binary numbers (i.e. with the binary
6633 c equivalent of a decimal point) with negative numbers represented using
6634 c twos-complement notation. For integer values, the resulting bit
6635 c pattern corresponds to that of the equivalent signed integer (digits
6636 c to the right of the point being zero). Operations on the bits
6637 c representing the fractional part are also possible, however.
6638 f Bitwise operators are often useful when operating on raw data
6639 f (e.g. from instruments), so they are provided for use in MathMap
6640 f expressions. In this case, however, the values on which they operate
6641 f are floating point values rather than the more usual pure integers. In
6642 f order to produce results which match the pure integer case, the
6643 f operands are regarded as fixed point binary numbers (i.e. with the
6644 f binary equivalent of a decimal point) with negative numbers
6645 f represented using twos-complement notation. For integer values, the
6646 f resulting bit pattern corresponds to that of the equivalent signed
6647 f integer (digits to the right of the point being zero). Operations on
6648 f the bits representing the fractional part are also possible, however.
6649 *
6650 * The following bitwise operators are available:
6651 c - x1 >> x2: Rightward bit shift. The integer value of "x2" is taken
6652 c (rounding towards zero) and the bits representing "x1" are then
6653 c shifted this number of places to the right (or to the left if the
6654 c number of places is negative). This is equivalent to dividing "x1" by
6655 c the corresponding power of 2.
6656 f - X1 >> X2: Rightward bit shift. The integer value of X2 is taken
6657 f (rounding towards zero) and the bits representing X1 are then
6658 f shifted this number of places to the right (or to the left if the
6659 f number of places is negative). This is equivalent to dividing X1 by
6660 f the corresponding power of 2.
6661 c - x1 << x2: Leftward bit shift. The integer value of "x2" is taken
6662 c (rounding towards zero), and the bits representing "x1" are then
6663 c shifted this number of places to the left (or to the right if the
6664 c number of places is negative). This is equivalent to multiplying "x1"
6665 c by the corresponding power of 2.
6666 f - X1 << X2: Leftward bit shift. The integer value of X2 is taken
6667 f (rounding towards zero), and the bits representing X1 are then
6668 f shifted this number of places to the left (or to the right if the
6669 f number of places is negative). This is equivalent to multiplying X1
6670 f by the corresponding power of 2.
6671 c - x1 & x2: Bitwise AND between the bits of "x1" and those of "x2"
6672 c (equivalent to a boolean AND applied at each bit position in turn).
6673 f - X1 & X2: Bitwise AND between the bits of X1 and those of X2
6674 f (equivalent to a logical AND applied at each bit position in turn).
6675 c - x1 | x2: Bitwise OR between the bits of "x1" and those of "x2"
6676 c (equivalent to a boolean OR applied at each bit position in turn).
6677 f - X1 | X2: Bitwise OR between the bits of X1 and those of X2
6678 f (equivalent to a logical OR applied at each bit position in turn).
6679 c - x1 ^ x2: Bitwise exclusive OR (XOR) between the bits of "x1" and
6680 c those of "x2" (equivalent to a boolean XOR applied at each bit
6681 c position in turn).
6682 f - X1 ^ X2: Bitwise exclusive OR (XOR) between the bits of X1 and
6683 f those of X2 (equivalent to a logical XOR applied at each bit
6684 f position in turn).
6685 *
6686 c Note that no bit inversion operator ("~" in C) is provided. This is
6687 c because inverting the bits of a twos-complement fixed point binary
6688 c number is equivalent to simply negating it. This differs from the
6689 c pure integer case because bits to the right of the binary point are
6690 c also inverted. To invert only those bits to the left of the binary
6691 c point, use a bitwise exclusive OR with the value -1 (i.e. "x^-1").
6692 f Note that no bit inversion operator is provided. This is
6693 f because inverting the bits of a twos-complement fixed point binary
6694 f number is equivalent to simply negating it. This differs from the
6695 f pure integer case because bits to the right of the binary point are
6696 f also inverted. To invert only those bits to the left of the binary
6697 f point, use a bitwise exclusive OR with the value -1 (i.e. X^-1).
6698
6699 * Functions:
6700 * The following functions are available:
6701 c - abs(x): Absolute value of "x" (sign removal), same as fabs(x).
6702 f - ABS(X): Absolute value of X (sign removal), same as FABS(X).
6703 c - acos(x): Inverse cosine of "x", in radians.
6704 f - ACOS(X): Inverse cosine of X, in radians.
6705 c - acosd(x): Inverse cosine of "x", in degrees.
6706 f - ACOSD(X): Inverse cosine of X, in degrees.
6707 c - acosh(x): Inverse hyperbolic cosine of "x".
6708 f - ACOSH(X): Inverse hyperbolic cosine of X.
6709 c - acoth(x): Inverse hyperbolic cotangent of "x".
6710 f - ACOTH(X): Inverse hyperbolic cotangent of X.
6711 c - acsch(x): Inverse hyperbolic cosecant of "x".
6712 f - ACSCH(X): Inverse hyperbolic cosecant of X.
6713 c - aint(x): Integer part of "x" (round towards zero), same as int(x).
6714 f - AINT(X): Integer part of X (round towards zero), same as INT(X).
6715 c - asech(x): Inverse hyperbolic secant of "x".
6716 f - ASECH(X): Inverse hyperbolic secant of X.
6717 c - asin(x): Inverse sine of "x", in radians.
6718 f - ASIN(X): Inverse sine of X, in radians.
6719 c - asind(x): Inverse sine of "x", in degrees.
6720 f - ASIND(X): Inverse sine of X, in degrees.
6721 c - asinh(x): Inverse hyperbolic sine of "x".
6722 f - ASINH(X): Inverse hyperbolic sine of X.
6723 c - atan(x): Inverse tangent of "x", in radians.
6724 f - ATAN(X): Inverse tangent of X, in radians.
6725 c - atand(x): Inverse tangent of "x", in degrees.
6726 f - ATAND(X): Inverse tangent of X, in degrees.
6727 c - atanh(x): Inverse hyperbolic tangent of "x".
6728 f - ATANH(X): Inverse hyperbolic tangent of X.
6729 c - atan2(x1, x2): Inverse tangent of "x1/x2", in radians.
6730 f - ATAN2(X1, X2): Inverse tangent of X1/X2, in radians.
6731 c - atan2d(x1, x2): Inverse tangent of "x1/x2", in degrees.
6732 f - ATAN2D(X1, X2): Inverse tangent of X1/X2, in degrees.
6733 c - ceil(x): Smallest integer value not less then "x" (round towards
6734 c plus infinity).
6735 f - CEIL(X): Smallest integer value not less then X (round towards
6736 f plus infinity).
6737 c - cos(x): Cosine of "x" in radians.
6738 f - COS(X): Cosine of X in radians.
6739 c - cosd(x): Cosine of "x" in degrees.
6740 f - COSD(X): Cosine of X in degrees.
6741 c - cosh(x): Hyperbolic cosine of "x".
6742 f - COSH(X): Hyperbolic cosine of X.
6743 c - coth(x): Hyperbolic cotangent of "x".
6744 f - COTH(X): Hyperbolic cotangent of X.
6745 c - csch(x): Hyperbolic cosecant of "x".
6746 f - CSCH(X): Hyperbolic cosecant of X.
6747 c - dim(x1, x2): Returns "x1-x2" if "x1" is greater than "x2", otherwise 0.
6748 f - DIM(X1, X2): Returns X1-X2 if X1 is greater than X2, otherwise 0.
6749 c - exp(x): Exponential function of "x".
6750 f - EXP(X): Exponential function of X.
6751 c - fabs(x): Absolute value of "x" (sign removal), same as abs(x).
6752 f - FABS(X): Absolute value of X (sign removal), same as ABS(X).
6753 c - floor(x): Largest integer not greater than "x" (round towards
6754 c minus infinity).
6755 f - FLOOR(X): Largest integer not greater than X (round towards
6756 f minus infinity).
6757 c - fmod(x1, x2): Remainder when "x1" is divided by "x2", same as
6758 c mod(x1, x2).
6759 f - FMOD(X1, X2): Remainder when X1 is divided by X2, same as
6760 f MOD(X1, X2).
6761 c - gauss(x1, x2): Random sample from a Gaussian distribution with mean
6762 c "x1" and standard deviation "x2".
6763 f - GAUSS(X1, X2): Random sample from a Gaussian distribution with mean
6764 f X1 and standard deviation X2.
6765 c - int(x): Integer part of "x" (round towards zero), same as aint(x).
6766 f - INT(X): Integer part of X (round towards zero), same as AINT(X).
6767 c - isbad(x): Returns 1 if "x" has the <bad> value (AST__BAD), otherwise 0.
6768 f - ISBAD(X): Returns 1 if X has the <bad> value (AST__BAD), otherwise 0.
6769 c - log(x): Natural logarithm of "x".
6770 f - LOG(X): Natural logarithm of X.
6771 c - log10(x): Logarithm of "x" to base 10.
6772 f - LOG10(X): Logarithm of X to base 10.
6773 c - max(x1, x2, ...): Maximum of two or more values.
6774 f - MAX(X1, X2, ...): Maximum of two or more values.
6775 c - min(x1, x2, ...): Minimum of two or more values.
6776 f - MIN(X1, X2, ...): Minimum of two or more values.
6777 c - mod(x1, x2): Remainder when "x1" is divided by "x2", same as
6778 c fmod(x1, x2).
6779 f - MOD(X1, X2): Remainder when X1 is divided by X2, same as
6780 f FMOD(X1, X2).
6781 c - nint(x): Nearest integer to "x" (round to nearest).
6782 f - NINT(X): Nearest integer to X (round to nearest).
6783 c - poisson(x): Random integer-valued sample from a Poisson
6784 c distribution with mean "x".
6785 f - POISSON(X): Random integer-valued sample from a Poisson
6786 f distribution with mean X.
6787 c - pow(x1, x2): "x1" raised to the power of "x2".
6788 f - POW(X1, X2): X1 raised to the power of X2.
6789 c - qif(x1, x2, x3): Returns "x2" if "x1" is true, and "x3" otherwise.
6790 f - QIF(x1, x2, x3): Returns X2 if X1 is true, and X3 otherwise.
6791 c - rand(x1, x2): Random sample from a uniform distribution in the
6792 c range "x1" to "x2" inclusive.
6793 f - RAND(X1, X2): Random sample from a uniform distribution in the
6794 f range X1 to X2 inclusive.
6795 c - sech(x): Hyperbolic secant of "x".
6796 f - SECH(X): Hyperbolic secant of X.
6797 c - sign(x1, x2): Absolute value of "x1" with the sign of "x2"
6798 c (transfer of sign).
6799 f - SIGN(X1, X2): Absolute value of X1 with the sign of X2
6800 f (transfer of sign).
6801 c - sin(x): Sine of "x" in radians.
6802 f - SIN(X): Sine of X in radians.
6803 c - sinc(x): Sinc function of "x" [= "sin(x)/x"].
6804 f - SINC(X): Sinc function of X [= SIN(X)/X].
6805 c - sind(x): Sine of "x" in degrees.
6806 f - SIND(X): Sine of X in degrees.
6807 c - sinh(x): Hyperbolic sine of "x".
6808 f - SINH(X): Hyperbolic sine of X.
6809 c - sqr(x): Square of "x" (= "x*x").
6810 f - SQR(X): Square of X (= X*X).
6811 c - sqrt(x): Square root of "x".
6812 f - SQRT(X): Square root of X.
6813 c - tan(x): Tangent of "x" in radians.
6814 f - TAN(X): Tangent of X in radians.
6815 c - tand(x): Tangent of "x" in degrees.
6816 f - TAND(X): Tangent of X in degrees.
6817 c - tanh(x): Hyperbolic tangent of "x".
6818 f - TANH(X): Hyperbolic tangent of X.
6819
6820 * Symbolic Constants:
6821 * The following symbolic constants are available (the enclosing "<>"
6822 * brackets must be included):
6823 c - <bad>: The "bad" value (AST__BAD) used to flag missing data. Note
6824 c that you cannot usefully compare values with this constant because the
6825 c result is always <bad>. The isbad() function should be used instead.
6826 f - <bad>: The "bad" value (AST__BAD) used to flag missing data. Note
6827 f that you cannot usefully compare values with this constant because the
6828 f result is always <bad>. The ISBAD() function should be used instead.
6829 c - <dig>: Number of decimal digits of precision available in a
6830 c floating point (double) value.
6831 f - <dig>: Number of decimal digits of precision available in a
6832 f floating point (double precision) value.
6833 * - <e>: Base of natural logarithms.
6834 * - <epsilon>: Smallest positive number such that 1.0+<epsilon> is
6835 * distinguishable from unity.
6836 c - <mant_dig>: The number of base <radix> digits stored in the
6837 c mantissa of a floating point (double) value.
6838 f - <mant_dig>: The number of base <radix> digits stored in the
6839 f mantissa of a floating point (double precision) value.
6840 c - <max>: Maximum representable floating point (double) value.
6841 f - <max>: Maximum representable floating point (double precision) value.
6842 c - <max_10_exp>: Maximum integer such that 10 raised to that power
6843 c can be represented as a floating point (double) value.
6844 f - <max_10_exp>: Maximum integer such that 10 raised to that power
6845 f can be represented as a floating point (double precision) value.
6846 c - <max_exp>: Maximum integer such that <radix> raised to that
6847 c power minus 1 can be represented as a floating point (double) value.
6848 f - <max_exp>: Maximum integer such that <radix> raised to that
6849 f power minus 1 can be represented as a floating point (double precision)
6850 f value.
6851 c - <min>: Smallest positive number which can be represented as a
6852 c normalised floating point (double) value.
6853 f - <min>: Smallest positive number which can be represented as a
6854 f normalised floating point (double precision) value.
6855 c - <min_10_exp>: Minimum negative integer such that 10 raised to that
6856 c power can be represented as a normalised floating point (double) value.
6857 f - <min_10_exp>: Minimum negative integer such that 10 raised to that
6858 f power can be represented as a normalised floating point (double
6859 f precision) value.
6860 c - <min_exp>: Minimum negative integer such that <radix> raised to
6861 c that power minus 1 can be represented as a normalised floating point
6862 c (double) value.
6863 f - <min_exp>: Minimum negative integer such that <radix> raised to
6864 f that power minus 1 can be represented as a normalised floating point
6865 f (double precision) value.
6866 * - <pi>: Ratio of the circumference of a circle to its diameter.
6867 c - <radix>: The radix (number base) used to represent the mantissa of
6868 c floating point (double) values.
6869 f - <radix>: The radix (number base) used to represent the mantissa of
6870 f floating point (double precision) values.
6871 * - <rounds>: The mode used for rounding floating point results after
6872 * addition. Possible values include: -1 (indeterminate), 0 (toward
6873 * zero), 1 (to nearest), 2 (toward plus infinity) and 3 (toward minus
6874 * infinity). Other values indicate machine-dependent behaviour.
6875
6876 * Evaluation Precedence and Associativity:
6877 * Items appearing in expressions are evaluated in the following order
6878 * (highest precedence first):
6879 * - Constants and variables
6880 * - Function arguments and parenthesised expressions
6881 * - Function invocations
6882 * - Unary + - ! .not.
6883 * - **
6884 * - * /
6885 * - + -
6886 * - << >>
6887 * - < .lt. <= .le. > .gt. >= .ge.
6888 * - == .eq. != .ne.
6889 * - &
6890 * - ^
6891 * - |
6892 * - && .and.
6893 * - ^^
6894 * - || .or
6895 * - .eqv. .neqv. .xor.
6896 *
6897 * All operators associate from left-to-right, except for unary +,
6898 * unary -, !, .not. and ** which associate from right-to-left.
6899
6900 * Notes:
6901 * - The sequence of numbers produced by the random number functions
6902 * available within a MathMap is normally unpredictable and different for
6903 * each MathMap. However, this behaviour may be controlled by means of
6904 * the MathMap's Seed attribute.
6905 c - Normally, compound Mappings (CmpMaps) which involve MathMaps will
6906 c not be subject to simplification (e.g. using astSimplify) because AST
6907 c cannot know how different MathMaps will interact. However, in the
6908 c special case where a MathMap occurs in series with its own inverse,
6909 c then simplification may be possible. Whether simplification does, in
6910 c fact, occur under these circumstances is controlled by the MathMap's
6911 c SimpFI and SimpIF attributes.
6912 f - Normally, compound Mappings (CmpMaps) which involve MathMaps will
6913 f not be subject to simplification (e.g. using AST_SIMPLIFY) because AST
6914 f cannot know how different MathMaps will interact. However, in the
6915 f special case where a MathMap occurs in series with its own inverse,
6916 f then simplification may be possible. Whether simplification does, in
6917 f fact, occur under these circumstances is controlled by the MathMap's
6918 f SimpFI and SimpIF attributes.
6919 * - A null Object pointer (AST__NULL) will be returned if this
6920 c function is invoked with the AST error status set, or if it
6921 f function is invoked with STATUS set to an error value, or if it
6922 * should fail for any reason.
6923 *--
6924
6925 * Implementation Notes:
6926 * - This function implements the external (public) interface to
6927 * the astMathMap constructor function. It returns an ID value
6928 * (instead of a true C pointer) to external users, and must be
6929 * provided because astMathMap_ has a variable argument list which
6930 * cannot be encapsulated in a macro (where this conversion would
6931 * otherwise occur).
6932 * - The variable argument list also prevents this function from
6933 * invoking astMathMap_ directly, so it must be a re-implementation
6934 * of it in all respects, except for the final conversion of the
6935 * result to an ID value.
6936 */
6937
6938 /* Local Variables: */
6939 astDECLARE_GLOBALS /* Pointer to thread-specific global data */
6940 AstMathMap *new; /* Pointer to new MathMap */
6941 va_list args; /* Variable argument list */
6942
6943 int *status; /* Pointer to inherited status value */
6944
6945 /* Get a pointer to the inherited status value. */
6946 status = astGetStatusPtr;
6947
6948 /* Get a pointer to the thread specific global data structure. */
6949 astGET_GLOBALS(NULL);
6950
6951 /* Check the global error status. */
6952 if ( !astOK ) return NULL;
6953
6954 /* Initialise the MathMap, allocating memory and initialising the virtual
6955 function table as well if necessary. */
6956 new = astInitMathMap( NULL, sizeof( AstMathMap ), !class_init, &class_vtab,
6957 "MathMap", nin, nout, nfwd, fwd, ninv, inv );
6958
6959 /* If successful, note that the virtual function table has been initialised. */
6960 if ( astOK ) {
6961 class_init = 1;
6962
6963 /* Obtain the variable argument list and pass it along with the options string
6964 to the astVSet method to initialise the new MathMap's attributes. */
6965 va_start( args, options );
6966 astVSet( new, options, NULL, args );
6967 va_end( args );
6968
6969 /* If an error occurred, clean up by deleting the new object. */
6970 if ( !astOK ) new = astDelete( new );
6971 }
6972
6973 /* Return an ID value for the new MathMap. */
6974 return astMakeId( new );
6975 }
6976
astInitMathMap_(void * mem,size_t size,int init,AstMathMapVtab * vtab,const char * name,int nin,int nout,int nfwd,const char * fwd[],int ninv,const char * inv[],int * status)6977 AstMathMap *astInitMathMap_( void *mem, size_t size, int init,
6978 AstMathMapVtab *vtab, const char *name,
6979 int nin, int nout,
6980 int nfwd, const char *fwd[],
6981 int ninv, const char *inv[], int *status ) {
6982 /*
6983 *+
6984 * Name:
6985 * astInitMathMap
6986
6987 * Purpose:
6988 * Initialise a MathMap.
6989
6990 * Type:
6991 * Protected function.
6992
6993 * Synopsis:
6994 * #include "mathmap.h"
6995 * AstMathMap *astInitMathMap_( void *mem, size_t size, int init,
6996 * AstMathMapVtab *vtab, const char *name,
6997 * int nin, int nout,
6998 * int nfwd, const char *fwd[],
6999 * int ninv, const char *inv[] )
7000
7001 * Class Membership:
7002 * MathMap initialiser.
7003
7004 * Description:
7005 * This function is provided for use by class implementations to initialise
7006 * a new MathMap object. It allocates memory (if necessary) to accommodate
7007 * the MathMap plus any additional data associated with the derived class.
7008 * It then initialises a MathMap structure at the start of this memory. If
7009 * the "init" flag is set, it also initialises the contents of a virtual
7010 * function table for a MathMap at the start of the memory passed via the
7011 * "vtab" parameter.
7012
7013 * Parameters:
7014 * mem
7015 * A pointer to the memory in which the MathMap is to be initialised.
7016 * This must be of sufficient size to accommodate the MathMap data
7017 * (sizeof(MathMap)) plus any data used by the derived class. If a value
7018 * of NULL is given, this function will allocate the memory itself using
7019 * the "size" parameter to determine its size.
7020 * size
7021 * The amount of memory used by the MathMap (plus derived class data).
7022 * This will be used to allocate memory if a value of NULL is given for
7023 * the "mem" parameter. This value is also stored in the MathMap
7024 * structure, so a valid value must be supplied even if not required for
7025 * allocating memory.
7026 * init
7027 * A logical flag indicating if the MathMap's virtual function table is
7028 * to be initialised. If this value is non-zero, the virtual function
7029 * table will be initialised by this function.
7030 * vtab
7031 * Pointer to the start of the virtual function table to be associated
7032 * with the new MathMap.
7033 * name
7034 * Pointer to a constant null-terminated character string which contains
7035 * the name of the class to which the new object belongs (it is this
7036 * pointer value that will subsequently be returned by the Object
7037 * astClass function).
7038 * nin
7039 * Number of input variables for the MathMap.
7040 * nout
7041 * Number of output variables for the MathMap.
7042 * nfwd
7043 * The number of forward transformation functions being supplied.
7044 * This must be at least equal to "nout".
7045 * fwd
7046 * Pointer to an array, with "nfwd" elements, of pointers to null
7047 * terminated strings which contain each of the forward transformation
7048 * functions.
7049 * ninv
7050 * The number of inverse transformation functions being supplied.
7051 * This must be at least equal to "nin".
7052 * inv
7053 * Pointer to an array, with "ninv" elements, of pointers to null
7054 * terminated strings which contain each of the inverse transformation
7055 * functions.
7056
7057 * Returned Value:
7058 * A pointer to the new MathMap.
7059
7060 * Notes:
7061 * - This function does not attempt to ensure that the forward and inverse
7062 * transformations performed by the resulting MathMap are consistent in any
7063 * way.
7064 * - This function makes a copy of the contents of the strings supplied.
7065 * - A null pointer will be returned if this function is invoked with the
7066 * global error status set, or if it should fail for any reason.
7067 *-
7068 */
7069
7070 /* Local Variables: */
7071 AstMathMap *new; /* Pointer to new MathMap */
7072 char **fwdfun; /* Array of cleaned forward functions */
7073 char **invfun; /* Array of cleaned inverse functions */
7074 double **fwdcon; /* Constants for forward functions */
7075 double **invcon; /* Constants for inverse functions */
7076 int **fwdcode; /* Code for forward functions */
7077 int **invcode; /* Code for inverse functions */
7078 int fwdstack; /* Stack size for forward functions */
7079 int invstack; /* Stack size for inverse functions */
7080
7081 /* Initialise. */
7082 new = NULL;
7083
7084 /* Check the global status. */
7085 if ( !astOK ) return new;
7086
7087 /* If necessary, initialise the virtual function table. */
7088 if ( init ) astInitMathMapVtab( vtab, name );
7089
7090 /* Check the numbers of input and output variables for validity,
7091 reporting an error if necessary. */
7092 if ( nin < 1 ) {
7093 astError( AST__BADNI,
7094 "astInitMathMap(%s): Bad number of input coordinates (%d).", status,
7095 name, nin );
7096 astError( AST__BADNI,
7097 "This number should be one or more." , status);
7098 } else if ( nout < 1 ) {
7099 astError( AST__BADNO,
7100 "astInitMathMap(%s): Bad number of output coordinates (%d).", status,
7101 name, nout );
7102 astError( AST__BADNI,
7103 "This number should be one or more." , status);
7104
7105 /* Check that sufficient number of forward and inverse transformation
7106 functions have been supplied and report an error if necessary. */
7107 } else if ( nfwd < nout ) {
7108 astError( AST__INNTF,
7109 "astInitMathMap(%s): Too few forward transformation functions "
7110 "given (%d).", status,
7111 name, nfwd );
7112 astError( astStatus,
7113 "At least %d forward transformation functions must be "
7114 "supplied. ", status,
7115 nout );
7116 } else if ( ninv < nin ) {
7117 astError( AST__INNTF,
7118 "astInitMathMap(%s): Too few inverse transformation functions "
7119 "given (%d).", status,
7120 name, ninv );
7121 astError( astStatus,
7122 "At least %d inverse transformation functions must be "
7123 "supplied. ", status,
7124 nin );
7125
7126 /* Of OK, clean the forward and inverse functions provided. This makes
7127 a lower-case copy with white space removed. */
7128 } else {
7129 CleanFunctions( nfwd, fwd, &fwdfun, status );
7130 CleanFunctions( ninv, inv, &invfun, status );
7131
7132 /* Compile the cleaned functions. From the returned pointers (if
7133 successful), we can now tell which transformations (forward and/or
7134 inverse) are defined. */
7135 CompileMapping( "astInitMathMap", name, nin, nout,
7136 nfwd, (const char **) fwdfun,
7137 ninv, (const char **) invfun,
7138 &fwdcode, &invcode, &fwdcon, &invcon,
7139 &fwdstack, &invstack, status );
7140
7141 /* Initialise a Mapping structure (the parent class) as the first
7142 component within the MathMap structure, allocating memory if
7143 necessary. Specify that the Mapping should be defined in the required
7144 directions. */
7145 new = (AstMathMap *) astInitMapping( mem, size, 0,
7146 (AstMappingVtab *) vtab, name,
7147 nin, nout,
7148 ( fwdcode != NULL ),
7149 ( invcode != NULL ) );
7150
7151
7152 /* If an error has occurred, free all the memory which may have been
7153 allocated by the cleaning and compilation steps above. */
7154 if ( !astOK ) {
7155 FREE_POINTER_ARRAY( fwdfun, nfwd )
7156 FREE_POINTER_ARRAY( invfun, ninv )
7157 FREE_POINTER_ARRAY( fwdcode, nfwd )
7158 FREE_POINTER_ARRAY( invcode, ninv )
7159 FREE_POINTER_ARRAY( fwdcon, nfwd )
7160 FREE_POINTER_ARRAY( invcon, ninv )
7161 }
7162
7163 /* Initialise the MathMap data. */
7164 /* ---------------------------- */
7165 /* Store pointers to the compiled function information, together with
7166 other MathMap data. */
7167 if ( new ) {
7168 new->fwdfun = fwdfun;
7169 new->invfun = invfun;
7170 new->fwdcode = fwdcode;
7171 new->invcode = invcode;
7172 new->fwdcon = fwdcon;
7173 new->invcon = invcon;
7174 new->fwdstack = fwdstack;
7175 new->invstack = invstack;
7176 new->nfwd = nfwd;
7177 new->ninv = ninv;
7178 new->simp_fi = -INT_MAX;
7179 new->simp_if = -INT_MAX;
7180
7181 /* Initialise the random number generator context associated with the
7182 MathMap, using an unpredictable default seed value. */
7183 new->rcontext.active = 0;
7184 new->rcontext.random_int = 0;
7185 new->rcontext.seed_set = 0;
7186 new->rcontext.seed = DefaultSeed( &new->rcontext, status );
7187
7188 /* If an error occurred, clean up by deleting the new object. */
7189 if ( !astOK ) new = astDelete( new );
7190 }
7191 }
7192
7193 /* Return a pointer to the new object. */
7194 return new;
7195 }
7196
astLoadMathMap_(void * mem,size_t size,AstMathMapVtab * vtab,const char * name,AstChannel * channel,int * status)7197 AstMathMap *astLoadMathMap_( void *mem, size_t size,
7198 AstMathMapVtab *vtab, const char *name,
7199 AstChannel *channel, int *status ) {
7200 /*
7201 *+
7202 * Name:
7203 * astLoadMathMap
7204
7205 * Purpose:
7206 * Load a MathMap.
7207
7208 * Type:
7209 * Protected function.
7210
7211 * Synopsis:
7212 * #include "mathmap.h"
7213 * AstMathMap *astLoadMathMap( void *mem, size_t size,
7214 * AstMathMapVtab *vtab, const char *name,
7215 * AstChannel *channel )
7216
7217 * Class Membership:
7218 * MathMap loader.
7219
7220 * Description:
7221 * This function is provided to load a new MathMap using data read
7222 * from a Channel. It first loads the data used by the parent class
7223 * (which allocates memory if necessary) and then initialises a
7224 * MathMap structure in this memory, using data read from the input
7225 * Channel.
7226 *
7227 * If the "init" flag is set, it also initialises the contents of a
7228 * virtual function table for a MathMap at the start of the memory
7229 * passed via the "vtab" parameter.
7230
7231
7232 * Parameters:
7233 * mem
7234 * A pointer to the memory into which the MathMap is to be
7235 * loaded. This must be of sufficient size to accommodate the
7236 * MathMap data (sizeof(MathMap)) plus any data used by derived
7237 * classes. If a value of NULL is given, this function will
7238 * allocate the memory itself using the "size" parameter to
7239 * determine its size.
7240 * size
7241 * The amount of memory used by the MathMap (plus derived class
7242 * data). This will be used to allocate memory if a value of
7243 * NULL is given for the "mem" parameter. This value is also
7244 * stored in the MathMap structure, so a valid value must be
7245 * supplied even if not required for allocating memory.
7246 *
7247 * If the "vtab" parameter is NULL, the "size" value is ignored
7248 * and sizeof(AstMathMap) is used instead.
7249 * vtab
7250 * Pointer to the start of the virtual function table to be
7251 * associated with the new MathMap. If this is NULL, a pointer
7252 * to the (static) virtual function table for the MathMap class
7253 * is used instead.
7254 * name
7255 * Pointer to a constant null-terminated character string which
7256 * contains the name of the class to which the new object
7257 * belongs (it is this pointer value that will subsequently be
7258 * returned by the astGetClass method).
7259 *
7260 * If the "vtab" parameter is NULL, the "name" value is ignored
7261 * and a pointer to the string "MathMap" is used instead.
7262
7263 * Returned Value:
7264 * A pointer to the new MathMap.
7265
7266 * Notes:
7267 * - A null pointer will be returned if this function is invoked
7268 * with the global error status set, or if it should fail for any
7269 * reason.
7270 *-
7271 */
7272
7273 /* Local Constants: */
7274 astDECLARE_GLOBALS /* Pointer to thread-specific global data */
7275 #define KEY_LEN 50 /* Maximum length of a keyword */
7276
7277 /* Local Variables: */
7278 AstMathMap *new; /* Pointer to the new MathMap */
7279 char key[ KEY_LEN + 1 ]; /* Buffer for keyword strings */
7280 int ifun; /* Loop counter for functions */
7281 int invert; /* Invert attribute value */
7282 int nin; /* True number of input coordinates */
7283 int nout; /* True number of output coordinates */
7284
7285 /* Get a pointer to the thread specific global data structure. */
7286 astGET_GLOBALS(channel);
7287
7288 /* Initialise. */
7289 new = NULL;
7290
7291 /* Check the global error status. */
7292 if ( !astOK ) return new;
7293
7294 /* If a NULL virtual function table has been supplied, then this is
7295 the first loader to be invoked for this MathMap. In this case the
7296 MathMap belongs to this class, so supply appropriate values to be
7297 passed to the parent class loader (and its parent, etc.). */
7298 if ( !vtab ) {
7299 size = sizeof( AstMathMap );
7300 vtab = &class_vtab;
7301 name = "MathMap";
7302
7303 /* If required, initialise the virtual function table for this class. */
7304 if ( !class_init ) {
7305 astInitMathMapVtab( vtab, name );
7306 class_init = 1;
7307 }
7308 }
7309
7310 /* Invoke the parent class loader to load data for all the ancestral
7311 classes of the current one, returning a pointer to the resulting
7312 partly-built MathMap. */
7313 new = astLoadMapping( mem, size, (AstMappingVtab *) vtab, name,
7314 channel );
7315
7316 if ( astOK ) {
7317
7318 /* Read input data. */
7319 /* ================ */
7320 /* Request the input Channel to read all the input data appropriate to
7321 this class into the internal "values list". */
7322 astReadClassData( channel, "MathMap" );
7323
7324 /* Determine if the MathMap is inverted and obtain the "true" number
7325 of input and output coordinates by un-doing the effects of any
7326 inversion. */
7327 invert = astGetInvert( new );
7328 nin = invert ? astGetNout( new ) : astGetNin( new );
7329 nout = invert ? astGetNin( new ) : astGetNout( new );
7330
7331 /* Now read each individual data item from this list and use it to
7332 initialise the appropriate instance variable(s) for this class. */
7333
7334 /* In the case of attributes, we first read the "raw" input value,
7335 supplying the "unset" value as the default. If a "set" value is
7336 obtained, we then use the appropriate (private) Set... member
7337 function to validate and set the value properly. */
7338
7339 /* Numbers of transformation functions. */
7340 /* ------------------------------------ */
7341 /* Read the numbers of forward and inverse transformation functions,
7342 supplying appropriate defaults. */
7343 new->nfwd = astReadInt( channel, "nfwd", nout );
7344 new->ninv = astReadInt( channel, "ninv", nin );
7345 if ( astOK ) {
7346
7347 /* Allocate memory for the MathMap's transformation function arrays. */
7348 MALLOC_POINTER_ARRAY( new->fwdfun, char *, new->nfwd )
7349 MALLOC_POINTER_ARRAY( new->invfun, char *, new->ninv )
7350 if ( astOK ) {
7351
7352 /* Forward transformation functions. */
7353 /* --------------------------------- */
7354 /* Create a keyword for each forward transformation function and read
7355 the function's value as a string. */
7356 for ( ifun = 0; ifun < new->nfwd; ifun++ ) {
7357 (void) sprintf( key, "fwd%d", ifun + 1 );
7358 new->fwdfun[ ifun ] = astReadString( channel, key, "" );
7359 }
7360
7361 /* Inverse transformation functions. */
7362 /* --------------------------------- */
7363 /* Repeat this process for the inverse transformation functions. */
7364 for ( ifun = 0; ifun < new->ninv; ifun++ ) {
7365 (void) sprintf( key, "inv%d", ifun + 1 );
7366 new->invfun[ ifun ] = astReadString( channel, key, "" );
7367 }
7368
7369 /* Forward-inverse simplification flag. */
7370 /* ------------------------------------ */
7371 new->simp_fi = astReadInt( channel, "simpfi", -INT_MAX );
7372 if ( TestSimpFI( new, status ) ) SetSimpFI( new, new->simp_fi, status );
7373
7374 /* Inverse-forward simplification flag. */
7375 /* ------------------------------------ */
7376 new->simp_if = astReadInt( channel, "simpif", -INT_MAX );
7377 if ( TestSimpIF( new, status ) ) SetSimpIF( new, new->simp_if, status );
7378
7379 /* Random number context. */
7380 /* ---------------------- */
7381 /* Initialise the random number generator context. */
7382 new->rcontext.active = 0;
7383 new->rcontext.random_int = 0;
7384
7385 /* Read the flag that determines if the Seed value is set, and the
7386 Seed value itself. */
7387 new->rcontext.seed_set = astReadInt( channel, "seeded", 0 );
7388 if ( TestSeed( new, status ) ) {
7389 new->rcontext.seed = astReadInt( channel, "seed", 0 );
7390 SetSeed( new, new->rcontext.seed, status );
7391
7392 /* Supply an unpredictable default Seed value if necessary. */
7393 } else {
7394 new->rcontext.seed = DefaultSeed( &new->rcontext, status );
7395 }
7396
7397 /* Compile the MathMap's transformation functions. */
7398 CompileMapping( "astLoadMathMap", name, nin, nout,
7399 new->nfwd, (const char **) new->fwdfun,
7400 new->ninv, (const char **) new->invfun,
7401 &new->fwdcode, &new->invcode,
7402 &new->fwdcon, &new->invcon,
7403 &new->fwdstack, &new->invstack, status );
7404 }
7405
7406 /* If an error occurred, clean up by deleting the new MathMap. */
7407 if ( !astOK ) new = astDelete( new );
7408 }
7409 }
7410
7411 /* Return the new MathMap pointer. */
7412 return new;
7413
7414 /* Undefine macros local to this function. */
7415 #undef KEY_LEN
7416 }
7417
7418
7419
7420
7421
7422