1 /*
2 Gri - A language for scientific graphics programming
3 Copyright (C) 2008 Daniel Kelley
4
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; version 3 of the License, or
8 (at your option) any later version.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
14
15 You should have received a copy of the GNU General Public License along
16 with this program; if not, write to the Free Software Foundation, Inc.,
17 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
18 */
19
20 // Do rpn math
21 static bool permit_missing_value_in_comparisons = 0;
22 #define STRING_END(S) ((S) + strlen((S)) - 1)
23 #include <string>
24 #include <ctype.h>
25 #include <stdio.h>
26 #include <math.h>
27 #include <time.h>
28 #if defined(HAVE_ACCESS)
29 #include <unistd.h>
30 #endif
31 #ifdef HAVE_STAT
32 #include <errno.h>
33 #include <sys/stat.h>
34 #endif
35
36 #include "gr.hh"
37 #include "extern.hh"
38 #include "private.hh"
39
40 #ifdef __DECXX
41 extern "C" double acosh(double x); // DEC-cxx needs this
42 extern "C" double asinh(double x); // DEC-cxx needs this
43 extern "C" double atanh(double x); // DEC-cxx needs this
44 #endif
45
46 static std::vector<RpnItem> rS;
47 void
erase_rpn_stack()48 erase_rpn_stack()
49 {
50 rS.erase(rS.begin(), rS.end());
51 }
52
53
54
55 // *******************************************
56 // *** Macros to simplify stack operations ***
57 // *******************************************
58 // Require index i to be type t.
59 #define NEED_IS_TYPE(i,t) \
60 { \
61 if (rS[rS.size() - (i)].getType() != (t)) { \
62 RpnError = ILLEGAL_TYPE; \
63 return false; \
64 } \
65 }
66 // Retrieve name (i-1) from top of stack (i=1 means top)
67 #define NAME(i) (rS[rS.size() - (i)].getName())
68 // Retrieve value (i-1) from top of stack (i=1 means top)
69 #define VALUE(i) (rS[rS.size() - (i)].getValue())
70 // Retrieve validity (i-1) from top of stack (i=1 means top)
71 #define VALID(i) (rS[rS.size() - (i)].getValid())
72 // Retrieve type (i-1) from top of stack (i=1 means top)
73 #define TYPE(i) (rS[rS.size() - (i)].getType())
74 // Set (i-1) from top of stack (i=1 means top)
75 #define SET(i, n, value, t, valid) (rS[rS.size() - (i)].set((n), (value), (t), (valid)))
76
77 #define Ee 2.7182818284590452354
78 // rpn - reverse polish notation calculator
79 //
80 // RETURN VALUE: see defines below
81 //
82
83 // Return codes:
84 #define NO_ERROR 0 // everything is OK
85 #define BAD_WORD 1 // not operator, operand, column, function
86 #define STACK_UNDERFLOW 2 // missing operators
87 #define STACK_OVERFLOW 3 // extra stuff
88 #define DIV_BY_ZERO 4 // cannot divide by zero
89 #define OUT_OF_STORAGE 5 // computer limitation
90 #define ILLEGAL_TYPE 6 // cannot do with given operand(s)
91 #define NEED_GE_0 7 // need operand >= 0
92 #define NEED_GT_0 8 // need operand > 0
93 #define RANGE_1 9 // need operand in range -1 to 1
94 #define NEED_GT_1 10 // need operand > 1
95 #define COMPUTER_LIMITATION 11 // can't do on this machine
96 #define GENERAL_ERROR 12 // some other error
97
98 // Operator types.
99 typedef enum {
100 ADD = 1, SUBTRACT, MULTIPLY, DIVIDE,
101 POWER,
102 AGE, // of a file
103 ASINE, ACOSINE, ATANGENT,
104 SINE, COSINE, TANGENT,
105 ACOSH, ASINH, ATANH,
106 COSH, SINH, TANH,
107 SQRT,
108 LOG, LN, EXP, EXP10,
109 CEIL, FLOOR, REMAINDER,
110 ABS,
111 LESS_THAN, LESS_THAN_EQUAL,
112 GREATER_THAN, GREATER_THAN_EQUAL,
113 EQUAL, NOT_EQUAL,
114 AND, OR, NOT,
115 CMTOPT, PTTOCM,
116 DUP, POP, EXCH, ROLL_LEFT, ROLL_RIGHT, PSTACK, CLEAR,
117 STRCAT, STRLEN, SUBSTR,
118 ATOF,
119 SYSTEM,
120 SUP,
121 INF,
122 ASSIGN,
123 XYCMTOUSER,
124 XYUSERTOCM,
125 XCMTOUSER,
126 XPTTOUSER,
127 XUSERTOCM,
128 XUSERTOPT,
129 YCMTOUSER,
130 YPTTOUSER,
131 YUSERTOCM,
132 YUSERTOPT,
133 AREA, VAL, MIN, MAX, MEDIAN, MEAN, STDDEV, SKEWNESS, KURTOSIS, SIZE,
134 STRINGWIDTH, STRINGASCENT, STRINGDESCENT,
135 SED,
136 DEFINED,
137 ISMISSING,
138 INTERPOLATE,
139 RAND,
140 NOT_OPERATOR,
141 DIRECTORY_EXISTS,
142 FILE_EXISTS,
143 HEX2DEC,
144 DEC2HEX,
145 ARGC,
146 ARGV,
147 WORDC,
148 WORDV
149 } operator_name;
150
151 // Rpn functions.
152 typedef struct {
153 char *op_name;
154 unsigned int chars; // for speeding lookup
155 operator_name op_id;
156 } RPN_DICT;
157 #define RPN_FCN_CAPACITY 100
158 #define RPN_W_CAPACITY 100
159 unsigned int rpn_fcn_filled = 0;
160 typedef struct {
161 char * name;
162 char * w[RPN_W_CAPACITY];
163 unsigned int nw;
164 } RPN_FCN;
165 RPN_FCN rpn_fcn[RPN_FCN_CAPACITY];
166
167 // Operators, with common (algebraic) ones first to speed lookup.
168 RPN_DICT rpn_dict[] =
169 {
170 {(char *)"+", 1, ADD},
171 {(char *)"-", 1, SUBTRACT},
172 {(char *)".", 1, MULTIPLY},
173 {(char *)"*", 1, MULTIPLY},
174 {(char *)"/", 1, DIVIDE},
175 {(char *)"power", 5, POWER},
176 {(char *)"age", 3, AGE},
177 {(char *)"asin", 4, ASINE},
178 {(char *)"acos", 4, ACOSINE},
179 {(char *)"atan", 4, ATANGENT},
180 {(char *)"sin", 3, SINE},
181 {(char *)"cos", 3, COSINE},
182 {(char *)"tan", 3, TANGENT},
183 {(char *)"asinh", 5, ASINH},
184 {(char *)"acosh", 5, ACOSH},
185 {(char *)"atanh", 5, ATANH},
186 {(char *)"cosh", 4, COSH},
187 {(char *)"sinh", 4, SINH},
188 {(char *)"tanh", 4, TANH},
189 {(char *)"sqrt", 4, SQRT},
190 {(char *)"log", 3, LOG},
191 {(char *)"ln", 2, LN},
192 {(char *)"exp", 3, EXP},
193 {(char *)"exp10", 5, EXP10},
194 {(char *)"ceil", 4, CEIL},
195 {(char *)"dec2hex", 7, DEC2HEX}, // cf hex2dec
196 {(char *)"floor", 5, FLOOR},
197 {(char *)"hex2dec", 7, HEX2DEC}, // cf dec2hex
198 {(char *)"remainder", 9, REMAINDER},
199 {(char *)"abs", 3, ABS},
200 {(char *)"<", 1, LESS_THAN},
201 {(char *)"<=", 2, LESS_THAN_EQUAL},
202 {(char *)">", 1, GREATER_THAN},
203 {(char *)">=", 2, GREATER_THAN_EQUAL},
204 {(char *)"==", 2, EQUAL},
205 {(char *)"!=", 2, NOT_EQUAL},
206 {(char *)"&", 1, AND},
207 {(char *)"and", 3, AND},
208 {(char *)"|", 1, OR},
209 {(char *)"or", 2, OR},
210 {(char *)"!", 1, NOT},
211 {(char *)"not", 3, NOT},
212 {(char *)"cmtopt", 6, CMTOPT},
213 {(char *)"pttocm", 6, PTTOCM},
214 {(char *)"dup", 3, DUP},
215 {(char *)"pop", 3, POP},
216 {(char *)"exch", 4, EXCH},
217 {(char *)"roll_left", 9, ROLL_LEFT},
218 {(char *)"roll_right", 10, ROLL_RIGHT},
219 {(char *)"pstack", 6, PSTACK},
220 {(char *)"strcat", 6, STRCAT},
221 {(char *)"strlen", 6, STRLEN},
222 {(char *)"substr", 6, SUBSTR},
223 {(char *)"atof", 4, ATOF},
224 {(char *)"system", 6, SYSTEM},
225 {(char *)"sup", 3, SUP},
226 {(char *)"inf", 3, INF},
227 {(char *)"=", 1, ASSIGN},
228 {(char *)"xcmtouser", 9, XCMTOUSER},
229 {(char *)"xpttouser", 9, XPTTOUSER},
230 {(char *)"xycmtouser", 10, XYCMTOUSER},
231 {(char *)"xyusertocm", 10, XYUSERTOCM},
232 {(char *)"xusertocm", 9, XUSERTOCM},
233 {(char *)"xusertopt", 9, XUSERTOPT},
234 {(char *)"ycmtouser", 9, YCMTOUSER},
235 {(char *)"ypttouser", 9, YPTTOUSER},
236 {(char *)"yusertocm", 9, YUSERTOCM},
237 {(char *)"yusertopt", 9, YUSERTOPT},
238 {(char *)"area", 4, AREA},
239 {(char *)"@", 1, VAL},
240 {(char *)"min", 3, MIN},
241 {(char *)"max", 3, MAX},
242 {(char *)"median", 6, MEDIAN},
243 {(char *)"mean", 4, MEAN},
244 {(char *)"stddev", 6, STDDEV},
245 {(char *)"skewness", 8, SKEWNESS},
246 {(char *)"kurtosis", 8, KURTOSIS},
247 {(char *)"size", 4, SIZE},
248 {(char *)"directory_exists", 16, DIRECTORY_EXISTS},
249 {(char *)"file_exists", 11, FILE_EXISTS},
250 {(char *)"argc", 4, ARGC},
251 {(char *)"argv", 4, ARGV},
252 {(char *)"sed", 3, SED},
253 {(char *)"width", 5, STRINGWIDTH},
254 {(char *)"ascent", 6, STRINGASCENT},
255 {(char *)"descent", 7, STRINGDESCENT},
256 {(char *)"defined", 7, DEFINED},
257 {(char *)"ismissing", 9, ISMISSING},
258 {(char *)"interpolate", 11, INTERPOLATE},
259 {(char *)"rand", 4, RAND},
260 {(char *)"wordc", 5, WORDC},
261 {(char *)"wordv", 5, WORDV},
262 {(char *)NULL, 0, NOT_OPERATOR}
263 };
264
265
266
267 int RpnError;
268
269 #define PT_PER_IN 72.27 // points per inch
270 #define PT_PER_CM 28.45 // points per centimetre
271 #define deg_per_rad (57.29577951)
272
273 void gr_usertocm(double x, double y, double *x_cm, double *y_cm);
274 void gr_cmtouser(double x_cm, double y_cm, double *x, double *y);
275 static operator_name is_oper(const char *w);
276 static operand_type is_operand(const char *w, double *operand);
277 bool rpn_create_function(char *name, char ** w, unsigned int nw);
278 static unsigned int rpn_which_function(const char *w);
279 int rpn(unsigned int nw, char **w, char ** result);
280 static bool do_operation(operator_name oper);
281
282 int
rpn(unsigned int nw,char ** w,char ** result)283 rpn(unsigned int nw, char **w, char ** result)
284 {
285 if (((unsigned) superuser()) & FLAG_RPN) {
286 printf("%s:%d called rpn(", __FILE__,__LINE__);
287 for (unsigned int i=0; i < nw - 1; i++)
288 printf(" '%s',",w[i]);
289 printf(" '%s')\n", w[nw-1]);
290 }
291 unsigned int NW;
292 char *W[MAX_nword];
293 operator_name oper;
294 double operand_value = 0.0; // should be set below, actually (remove warning)
295 *result = new char[1];
296 strcpy(*result, "");
297 if (nw < 1) {
298 if (((unsigned) superuser()) & FLAG_RPN) printf("rpn() go stack underflow\n");
299 return STACK_UNDERFLOW;
300 }
301 RpnError = 0;
302 // Dump into new array (so can manipulate for funtions)
303 NW = nw;
304 if (NW < MAX_nword)
305 for (unsigned int i = 0; i < NW; i++)
306 W[i] = w[i];
307 else
308 return OUT_OF_STORAGE;
309 // Now, scan through list, pushing operands onto stack and obeying
310 // operators immediately.
311 for (unsigned int i = 0; i < NW; i++) {
312 if (((unsigned) superuser()) & FLAG_RPN) printf(" rpn scanning item '%s'\n",W[i]);
313 if (NOT_OPERATOR != (oper = is_oper((const char*)W[i]))) {
314 // Do indicated operation.
315 do_operation(oper);
316 } else {
317 // Must be an operand
318 unsigned int which;
319 char *Wnew[MAX_nword]; // for function case
320 operand_type type = is_operand((const char*)W[i], &operand_value);
321 if (((unsigned) superuser()) & FLAG_RPN) printf(" rpn operand type %d (variable with missing value code = %d)\n", type, VARIABLE_WITH_MISSING_VALUE);
322 RpnItem item;
323 switch (type) {
324 case VARIABLE_WITH_MISSING_VALUE:
325 if (_debugFlag & 0x01) printf("rpn trying to use variable '%s' but its value equals the current \"missing value\"", W[i]);
326 item.set("", gr_currentmissingvalue(), NUMBER, false);
327 rS.push_back(item);
328 break;
329 case NUMBER:
330 item.set("", operand_value, type, true);
331 rS.push_back(item);
332 break;
333 case COLUMN_NAME:
334 item.set(W[i], operand_value, type, true);
335 rS.push_back(item);
336 break;
337 case FUNCTION:
338 which = rpn_which_function((const char*)W[i]) - 1;
339 if ((NW + rpn_fcn[which].nw) >= MAX_nword) {
340 fatal_err("Ran out of space in RPN expression");
341 }
342 // Shuffle words up.
343 // Copy words up to function name
344 for (unsigned int ii = 0; ii < i; ii++) {
345 Wnew[ii] = W[ii];
346 }
347 // Copy the function contents
348 for (unsigned int ii = 0; ii < rpn_fcn[which].nw; ii++) {
349 Wnew[i + ii] = rpn_fcn[which].w[ii];
350 }
351 // Copy rest (skip the function name itself)
352 for (unsigned int ii = 0; ii < NW - i - 1; ii++) {
353 Wnew[i + ii + rpn_fcn[which].nw] = W[i + ii + 1];
354 }
355 // Now dump back into W[]
356 NW += rpn_fcn[which].nw - 1;
357 for (unsigned int ii = 0; ii < NW; ii++) {
358 W[ii] = Wnew[ii];
359 }
360 i--; // Must reexamine i-th word
361 break;
362 case STRING:
363 item.set(W[i], 0.0 , type, true);
364 rS.push_back(item);
365 break;
366 case NOT_OPERAND:
367 default:
368 RpnError = BAD_WORD;
369 break;
370 }
371 }
372 if (RpnError)
373 return RpnError;
374 }
375 if (rS.size() > 1)
376 return STACK_OVERFLOW;
377 // If stack is empty, return nothing
378 if (rS.size() == 0) {
379 return NO_ERROR;
380 }
381 // Otherwise, save final result into the string
382 //printf("missing code %d\n",rS[0].getValid());
383 switch (TYPE(1)) {
384 case NUMBER:
385 if (_debugFlag & 0x01 && !rS[0].getValid()) {
386 warning("Rpn result is 'missing' since it contained a variable equal to 'missing' value");
387 }
388 *result = new char[50];
389 sprintf(*result, "%.20g", VALUE(1));
390 rS.pop_back();
391 break;
392 case STRING:
393 *result = new char[1 + strlen(NAME(1))];
394 strcpy(*result, NAME(1));
395 rS.pop_back();
396 break;
397 case FUNCTION:
398 // I think cannot arrive here anyway
399 err("Not allowed to end up with function on stack");
400 return GENERAL_ERROR;
401 case COLUMN_NAME:
402 case NOT_OPERAND:
403 case VARIABLE_WITH_MISSING_VALUE:
404 case UNKNOWN:
405 break;
406 }
407 return NO_ERROR;
408 }
409
410 static operator_name
is_oper(const char * w)411 is_oper(const char *w)
412 {
413 int i;
414 #if 0
415 i = 0;
416 while (rpn_dict[i].op_name) {
417 if (strlen(rpn_dict[i].op_name) != rpn_dict[i].chars) {
418 printf("ERROR in rpn_dict on '%s' ... %d vs %d\n",rpn_dict[i].op_name, strlen(rpn_dict[i].op_name), rpn_dict[i].chars);
419 }
420 i++;
421 }
422 #endif
423 i = 0;
424 unsigned int chars_in_w = strlen(w); // checking first speeds a bit
425 while (rpn_dict[i].op_name) {
426 if (chars_in_w == rpn_dict[i].chars && !strcmp(rpn_dict[i].op_name, w))
427 return (operator_name) (rpn_dict[i].op_id);
428 i++;
429 }
430 return NOT_OPERATOR;
431 }
432
433 static operand_type
is_operand(const char * w,double * operand_value)434 is_operand(const char *w, double *operand_value)
435 {
436 double value;
437 if (w[0] == '"' && w[strlen(w) - 1] == '"') {
438 return STRING;
439 } else if (rpn_which_function(w)) {
440 return FUNCTION;
441 } else if (!strcmp(w, "x")
442 || !strcmp(w, "y")
443 || !strcmp(w, "z")
444 || !strcmp(w, "u")
445 || !strcmp(w, "v")
446 || !strcmp(w, "grid")) {
447 return COLUMN_NAME;
448 } else if (is_var(w)) {
449 if (getdnum(w, &value))
450 *operand_value = value;
451 else
452 return VARIABLE_WITH_MISSING_VALUE;
453 if (gr_missing(value))
454 return VARIABLE_WITH_MISSING_VALUE;
455 else
456 return NUMBER;
457 } else if (getdnum(w, &value)) { // BUG - if can't scan, will die
458 *operand_value = value;
459 return NUMBER;
460 } else {
461 return NOT_OPERAND;
462 }
463 }
464
465 bool
rpn_create_function(char * name,char * w[],unsigned int nw)466 rpn_create_function(char *name, char *w[], unsigned int nw)
467 {
468 unsigned int i;
469 rpn_fcn[rpn_fcn_filled].name = new char[1 + strlen(name)];
470 if (!rpn_fcn[rpn_fcn_filled].name) OUT_OF_MEMORY;
471 strcpy(rpn_fcn[rpn_fcn_filled].name, name);
472 if (nw > 0) {
473 if (nw >= RPN_W_CAPACITY) {
474 fatal_err("internal error: too many words in rpn def");
475 }
476 for (i = 0; i < nw; i++) {
477 rpn_fcn[rpn_fcn_filled].w[i] = new char[1 + strlen(w[i])];
478 if (!rpn_fcn[rpn_fcn_filled].w[i]) OUT_OF_MEMORY;
479 strcpy(rpn_fcn[rpn_fcn_filled].w[i], w[i]);
480 }
481 }
482 rpn_fcn[rpn_fcn_filled].nw = nw;
483 rpn_fcn_filled++;
484 return true;
485 }
486
487 // Return 1 + index of function, or 0 if unknown
488 static unsigned int
rpn_which_function(const char * name)489 rpn_which_function(const char *name)
490 {
491 if (isdigit(name[0]))
492 return 0;
493 for (unsigned int i = 0; i < rpn_fcn_filled; i++)
494 if (!strcmp(rpn_fcn[i].name, name))
495 return (i + 1);
496 return 0;
497 }
498
499 #define NEED_ON_STACK(num) \
500 { \
501 if (rS.size() < (num)) { \
502 RpnError = STACK_UNDERFLOW; \
503 return false; \
504 } \
505 }
506
507 #define GET_COL_VAL(COL_NAME, I) \
508 { \
509 if ((COL_NAME).size() <= 0 || (I) > ((COL_NAME).size() - 1)) { \
510 SET(2, "", gr_currentmissingvalue(),NUMBER,false); \
511 } else { \
512 SET(2, "", (COL_NAME)(I), NUMBER, true); \
513 }
514
515 // Area under y-x curve
curve_area()516 double curve_area()
517 {
518 double sum = 0;
519 int n = _colX.size();
520 for (int i = 1; i < n; i++) {
521 if (!gr_missingx(_colX[i])
522 && !gr_missingx(_colX[i - 1])
523 && !gr_missingy(_colY[i])
524 && !gr_missingy(_colY[i - 1])) {
525 sum += 0.5 * (_colY[i] + _colY[i - 1]) * (_colX[i] - _colX[i - 1]);
526 }
527 }
528 return sum;
529 }
530
531 #define GET_GRID_MIN() \
532 { \
533 unsigned int i, j; \
534 bool first = true; \
535 double min_val = gr_currentmissingvalue(); \
536 if (!_grid_exists) { \
537 err("No data in grid yet."); \
538 RpnError = GENERAL_ERROR; \
539 return false; \
540 } \
541 for (j = 0; j < _num_ymatrix_data; j++) { \
542 for (i = 0; i < _num_xmatrix_data; i++) { \
543 if (inside_box(_xmatrix[i], _ymatrix[j]) && !gr_missing((double)_f_xy(i, j))) { \
544 if (first) { \
545 min_val = _f_xy(i, j); \
546 first = false; \
547 } else { \
548 if (_f_xy(i, j) < min_val) { \
549 min_val = _f_xy(i, j); \
550 } \
551 } \
552 } \
553 } \
554 } \
555 SET(1, "", min_val, NUMBER, true); \
556 }
557
558 #define GET_GRID_MAX() \
559 { \
560 unsigned int i, j; \
561 bool first = true; \
562 double max_val = gr_currentmissingvalue(); \
563 if (!_grid_exists) { \
564 err("No data in grid yet."); \
565 RpnError = GENERAL_ERROR; \
566 return false; \
567 } \
568 for (j = 0; j < _num_ymatrix_data; j++) { \
569 for (i = 0; i < _num_xmatrix_data; i++) { \
570 if (inside_box(_xmatrix[i], _ymatrix[j]) && !gr_missing((double)_f_xy(i, j))) { \
571 if (first) { \
572 max_val = _f_xy(i, j); \
573 first = false; \
574 } else { \
575 if (_f_xy(i, j) > max_val) { \
576 max_val = _f_xy(i, j); \
577 } \
578 } \
579 } \
580 } \
581 } \
582 SET(1, "", max_val, NUMBER, true); \
583 }
584
585 #define GET_GRID_MEAN() \
586 { \
587 unsigned int i, j; \
588 double mean_val = 0.0; \
589 int num = 0; \
590 if (!_grid_exists) { \
591 err("No data in grid yet."); \
592 RpnError = GENERAL_ERROR; \
593 return false; \
594 } \
595 for (j = 0; j < _num_ymatrix_data; j++) { \
596 for (i = 0; i < _num_xmatrix_data; i++) { \
597 if (inside_box(_xmatrix[i], _ymatrix[j]) && _legit_xy(i, j)) { \
598 mean_val += _f_xy(i, j); \
599 num++; \
600 } \
601 } \
602 } \
603 if (num > 0) { \
604 mean_val = mean_val / num; \
605 } else { \
606 mean_val = gr_currentmissingvalue(); \
607 } \
608 SET(1, "", mean_val, NUMBER, true); \
609 }
610
611 #define GET_GRID_STDDEV() \
612 { \
613 unsigned int i, j; \
614 double stddev_val = 0.0; \
615 double mean_val = 0.0; \
616 int num = 0; \
617 if (!_grid_exists) { \
618 err("No data in grid yet."); \
619 RpnError = GENERAL_ERROR; \
620 return false; \
621 } \
622 for (j = 0; j < _num_ymatrix_data; j++) { \
623 for (i = 0; i < _num_xmatrix_data; i++) { \
624 if (_legit_xy(i, j)) { \
625 mean_val += _f_xy(i, j); \
626 num++; \
627 } \
628 } \
629 } \
630 if (num > 0) { \
631 mean_val = mean_val / num; \
632 for (j = 0; j < _num_ymatrix_data; j++) { \
633 for (i = 0; i < _num_xmatrix_data; i++) { \
634 if (_legit_xy(i, j)) { \
635 stddev_val += (_f_xy(i, j)-mean_val)*(_f_xy(i, j)-mean_val);\
636 } \
637 } \
638 } \
639 if (num > 1) { \
640 stddev_val = sqrt(stddev_val / (num - 1)); \
641 } else { \
642 stddev_val = gr_currentmissingvalue(); \
643 } \
644 } else { \
645 stddev_val = gr_currentmissingvalue(); \
646 } \
647 SET(1, "", stddev_val, NUMBER, true); \
648 }
649
650 #define GET_GRID_SIZE() \
651 { \
652 unsigned int i, j; \
653 unsigned int num = 0; \
654 if (!_grid_exists) { \
655 err("No data in grid yet."); \
656 RpnError = GENERAL_ERROR; \
657 return false; \
658 } \
659 for (j = 0; j < _num_ymatrix_data; j++) { \
660 for (i = 0; i < _num_xmatrix_data; i++) { \
661 if (_legit_xy(i, j)) { \
662 num++; \
663 } \
664 } \
665 } \
666 SET(1, "", num, NUMBER, true); \
667 }
668
669 static bool
do_operation(operator_name oper)670 do_operation(operator_name oper)
671 {
672 //printf("do_operation(%d) vs %d\n",int(oper),int(ARGV));
673 if (oper == NOT_OPERATOR) {
674 RpnError = BAD_WORD;
675 return false;
676 }
677 double missing = gr_currentmissingvalue();
678 double res; // holds result
679 if (oper == ADD) {
680 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
681 if (VALID(1) && VALID(2))
682 SET(2, "", (VALUE(1)+VALUE(2)), NUMBER, true);
683 else
684 SET(2, "", missing, NUMBER, false);
685 rS.pop_back();
686 return true;
687 }
688 if (oper == SUBTRACT) {
689 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
690 if (VALID(1) && VALID(2))
691 SET(2, "", ((VALUE(2))-(VALUE(1))), NUMBER, true);
692 else
693 SET(2, "", missing, NUMBER, false);
694 rS.pop_back();
695 return true;
696 }
697 if (oper == GREATER_THAN) {
698 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
699 if (permit_missing_value_in_comparisons) { // fix SF bug 641406
700 if (VALID(1) && VALID(2))
701 SET(2, "", (VALUE(1)>VALUE(2)?1.0:0.0), NUMBER, true);
702 else
703 SET(2, "", missing, NUMBER, false);
704 } else {
705 SET(2, "", (VALUE(1)>VALUE(2)?1.0:0.0), NUMBER, true);
706 }
707 rS.pop_back();
708 return true;
709 }
710 if (oper == GREATER_THAN_EQUAL) {
711 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
712 if (permit_missing_value_in_comparisons) { // fix SF bug 641406
713 if (VALID(1) && VALID(2))
714 SET(2, "", (VALUE(1)>=VALUE(2)?1:0), NUMBER, true);
715 else
716 SET(2, "", missing, NUMBER, false);
717 } else {
718 SET(2, "", (VALUE(1)>=VALUE(2)?1:0), NUMBER, true);
719 }
720 rS.pop_back();
721 return true;
722 }
723 if (oper == EQUAL) {
724 NEED_ON_STACK(2);
725 if (TYPE(1) == STRING && TYPE(2) == STRING) {
726 SET(2, "", !strcmp(NAME(2), NAME(1)) ? 1.0 : 0.0, NUMBER, true);
727 rS.pop_back();
728 } else if (TYPE(1) == NUMBER && TYPE(2) == NUMBER) {
729 if (permit_missing_value_in_comparisons) { // fix SF bug 641406
730 if (VALID(1) && VALID(2))
731 SET(2, "", (VALUE(1)==VALUE(2)?1.0:0.0), NUMBER, true);
732 else
733 SET(2, "", missing, NUMBER, false);
734 } else {
735 SET(2, "", (VALUE(1)==VALUE(2)?1.0:0.0), NUMBER, true);
736 }
737 rS.pop_back();
738 } else {
739 err("RPN operator `==' cannot handle the items currently on stack.");
740 RpnError = ILLEGAL_TYPE;
741 return false;
742 }
743 return true;
744 }
745 if (oper == NOT_EQUAL) {
746 NEED_ON_STACK(2);
747 if (TYPE(1) == STRING && TYPE(2) == STRING) {
748 SET(2, "", !strcmp(NAME(2), NAME(1)) ? 0.0 : 1.0, NUMBER, true);
749 rS.pop_back();
750 } else if (TYPE(1) == NUMBER && TYPE(2) == NUMBER) {
751 if (permit_missing_value_in_comparisons) { // fix SF bug 641406
752 if (VALID(1) && VALID(2))
753 SET(2, "", (VALUE(1)!=VALUE(2)?1.0:0.0), NUMBER, true);
754 else
755 SET(2, "", missing, NUMBER, false);
756 } else {
757 SET(2, "", (VALUE(1)!=VALUE(2)?1.0:0.0), NUMBER, true);
758 }
759 rS.pop_back();
760 } else {
761 err("Rpn operator `!=' cannot handle items on stack.");
762 RpnError = ILLEGAL_TYPE;
763 return false;
764 }
765 return true;
766 }
767 if (oper == AND) {
768 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
769 // if EITHER on stack is 0, result is 0
770 if (VALID(1) && !VALUE(1)) {
771 SET(2, "", 0.0, NUMBER, true);
772 rS.pop_back();
773 return true;
774 }
775 if (VALID(2) && !VALUE(2)) {
776 SET(2, "", 0.0, NUMBER, true);
777 rS.pop_back();
778 return true;
779 }
780 if (VALID(1) && VALID(2)) {
781 SET(2, "", (VALUE(1)&&VALUE(2)?1.0:0.0), NUMBER, true);
782 } else {
783 SET(2, "", missing, NUMBER, false);
784 }
785 rS.pop_back();
786 return true;
787 }
788 if (oper == OR) {
789 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
790 // if EITHER on stack is 1, result is 1
791 if (VALID(1) && VALUE(1)) {
792 SET(2, "", 1.0, NUMBER, true);
793 rS.pop_back();
794 return true;
795 }
796 if (VALID(2) && VALUE(2)) {
797 SET(2, "", 1.0, NUMBER, true);
798 rS.pop_back();
799 return true;
800 }
801 if (VALID(1) && VALID(2))
802 SET(2, "", (VALUE(1)||VALUE(2)?1.0:0.0), NUMBER, true);
803 else
804 SET(2, "", missing, NUMBER, false);
805 rS.pop_back();
806 return true;
807 }
808 if (oper == NOT) {
809 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
810 if (VALID(1))
811 SET(1, "", (VALUE(1) ? 0.0 : 1.0), NUMBER, true);
812 else
813 SET(1, "", missing, NUMBER, false);
814 return true;
815 }
816 if (oper == LESS_THAN) {
817 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
818 if (permit_missing_value_in_comparisons) { // fix SF bug 641406
819 if (VALID(1) && VALID(2))
820 SET(2, "", (VALUE(1)<VALUE(2)?1.0:0.0), NUMBER, true);
821 else
822 SET(2, "", missing, NUMBER, false);
823 } else {
824 SET(2, "", (VALUE(1)<VALUE(2)?1.0:0.0), NUMBER, true);
825 }
826 rS.pop_back();
827 return true;
828 }
829 if (oper == LESS_THAN_EQUAL) {
830 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
831 if (permit_missing_value_in_comparisons) { // fix SF bug 641406
832 if (VALID(1) && VALID(2))
833 SET(2, "", (VALUE(1)<=VALUE(2)?1.0:0.0), NUMBER, true);
834 else
835 SET(2, "", missing, NUMBER, false);
836 } else {
837 SET(2, "", (VALUE(1)<=VALUE(2)?1.0:0.0), NUMBER, true);
838 }
839 rS.pop_back();
840 return true;
841 }
842 if (oper == MULTIPLY) {
843 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
844 if (VALID(1) && VALID(2))
845 SET(2, "", (VALUE(1)*VALUE(2)), NUMBER, true);
846 else
847 SET(2, "", missing, NUMBER, false);
848 rS.pop_back();
849 return true;
850 }
851 if (oper == DIVIDE) {
852 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
853 if (VALID(1) && VALID(2)) {
854 if (VALUE(1) == 0.0) {
855 RpnError = DIV_BY_ZERO;
856 rS.pop_back(); // no need, since will die
857 return false;
858 }
859 SET(2, "", (VALUE(2)/VALUE(1)), NUMBER, true);
860 } else
861 SET(2, "", missing, NUMBER, false);
862 rS.pop_back();
863 return true;
864 }
865 if (oper == POWER) { // x^p
866 // Solve SourceForge bug #113816 for a few legal cases with x<0
867 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
868 if (!VALID(1) || !VALID(2)) {
869 SET(2, "", missing, NUMBER, false);
870 rS.pop_back();
871 return true;
872 }
873 double x = VALUE(2), p = VALUE(1);
874 if (x == 0.0) { // I bet pow() is ok on zero, but let's be safe
875 SET(2, "", 0.0, NUMBER, true);
876 rS.pop_back();
877 return true;
878 }
879 if (x > 0.0) {
880 SET(2, "", pow(x, p), NUMBER, true);
881 rS.pop_back();
882 return true;
883 }
884 // If x<0 and p is even integer, ok;
885 // If x<0 and p is odd integer, ok;
886 // Otherwise, we're out of luck.
887 if (x < 0.0) {
888 if (is_even_integer(p)) {
889 SET(2, "", pow(-x, p), NUMBER, true);
890 rS.pop_back();
891 return true;
892 } else if (is_odd_integer(p)) {
893 SET(2, "", -pow(-x, p), NUMBER, true);
894 rS.pop_back();
895 return true;
896 } else {
897 RpnError = NEED_GE_0;
898 rS.pop_back(); // no need, since will die
899 return false;
900 }
901 }
902 // Cannot get here.
903 return true;
904 }
905 if (oper == ACOSINE) {
906 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
907 if (VALID(1)) {
908 if (VALUE(1) > 1.0 || VALUE(1) < -1.0) {
909 RpnError = RANGE_1;
910 return false;
911 }
912 SET(1, "", (acos(VALUE(1)) * deg_per_rad), NUMBER, true);
913 } else
914 SET(1, "", missing, NUMBER, false);
915 return true;
916 }
917 if (oper == AGE) {
918 NEED_ON_STACK(1); NEED_IS_TYPE(1, STRING);
919 static time_t present_time;
920 time(&present_time);
921 //printf("DEBUG: B. present_time %d\n", (unsigned int)(present_time));
922 string filename(NAME(1));
923 #ifdef HAVE_STAT
924 struct stat buf;
925 un_double_quote(filename);
926 //printf("BEFORE... [%s]\n",filename.c_str());
927 extern bool full_path_name(std::string& f);
928 full_path_name(filename);
929 //printf("AFTER... [%s]\n",filename.c_str());
930 if (0 == stat(filename.c_str(), &buf)) {
931 double seconds = buf.st_ctime;
932 SET(1, "", present_time - seconds, NUMBER, true);
933 } else {
934 SET(1, "", present_time, NUMBER, true);
935 //warning("warning: cannot find age of file named `\\", filename.c_str(), "' so using an 'infinite' age", "\\");
936 }
937 #else
938 SET(1, "", present_time, NUMBER, true);
939 warning("This computer cannot do stat() on file named `\\", filename.c_str(), "' so using an 'infinite' age'", "\\");
940 #endif
941 return true;
942 }
943 if (oper == ASINE) {
944 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
945 if (VALID(1)) {
946 if (VALUE(1) > 1.0 || VALUE(1) < -1.0) {
947 RpnError = RANGE_1;
948 return false;
949 }
950 SET(1, "", (asin(VALUE(1)) * deg_per_rad), NUMBER, true);
951 } else
952 SET(1, "", missing, NUMBER, false);
953 return true;
954 }
955 if (oper == ATANGENT) {
956 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
957 if (VALID(1)) {
958 if (VALUE(1) > 1.0 || VALUE(1) < -1.0) {
959 RpnError = RANGE_1;
960 return false;
961 }
962 SET(1, "", (atan(VALUE(1)) * deg_per_rad), NUMBER, true);
963 } else
964 SET(1, "", missing, NUMBER, false);
965 return true;
966 }
967 if (oper == SINE) {
968 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
969 if (VALID(1)) {
970 SET(1, "", (sin(VALUE(1)/deg_per_rad)), NUMBER, true);
971 } else
972 SET(1, "", missing, NUMBER, false);
973 return true;
974 }
975 if (oper == COSINE) {
976 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
977 if (VALID(1)) {
978 SET(1, "", (cos(VALUE(1)/deg_per_rad)), NUMBER, true);
979 } else
980 SET(1, "", missing, NUMBER, false);
981 return true;
982 }
983 if (oper == TANGENT) {
984 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
985 if (VALID(1)) {
986 SET(1, "", (tan(VALUE(1)/deg_per_rad)), NUMBER, true);
987 } else
988 SET(1, "", missing, NUMBER, false);
989 return true;
990 }
991 if (oper == SINH) {
992 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
993 if (VALID(1)) {
994 SET(1, "", (sinh(VALUE(1))), NUMBER, true);
995 } else
996 SET(1, "", missing, NUMBER, false);
997 return true;
998 }
999 if (oper == ACOSH) {
1000 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1001 if (!VALID(1)) {
1002 SET(1, "", missing, NUMBER, false);
1003 return true;
1004 }
1005 if (VALUE(1) < 1.0) {
1006 RpnError = NEED_GT_1;
1007 return false;
1008 }
1009 #if defined(HAVE_ACOSH)
1010 SET(1, "", (acosh(VALUE(1))), NUMBER, true);
1011 return true;
1012 #else
1013 RpnError = COMPUTER_LIMITATION;
1014 return false;
1015 #endif
1016 }
1017 if (oper == ATANH) {
1018 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1019 if (!VALID(1)) {
1020 SET(1, "", missing, NUMBER, false);
1021 return true;
1022 }
1023 if (VALUE(1) > 1.0 || VALUE(1) < -1.0) {
1024 RpnError = RANGE_1;
1025 return false;
1026 }
1027 #if defined(HAVE_ACOSH)
1028 SET(1, "", (atanh(VALUE(1))), NUMBER, true);
1029 return true;
1030 #else
1031 RpnError = COMPUTER_LIMITATION;
1032 return false;
1033 #endif
1034 }
1035 if (oper == ASINH) {
1036 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1037 if (!VALID(1)) {
1038 SET(1, "", missing, NUMBER, false);
1039 return true;
1040 }
1041 #if defined(HAVE_ACOSH)
1042 SET(1, "", (asinh(VALUE(1))), NUMBER, true);
1043 return true;
1044 #else
1045 RpnError = COMPUTER_LIMITATION;
1046 return false;
1047 #endif
1048 }
1049 if (oper == COSH) {
1050 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1051 if (!VALID(1)) {
1052 SET(1, "", missing, NUMBER, false);
1053 return true;
1054 }
1055 SET(1, "", (cosh(VALUE(1))), NUMBER, true);
1056 return true;
1057 }
1058 if (oper == TANH) {
1059 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1060 if (!VALID(1)) {
1061 SET(1, "", missing, NUMBER, false);
1062 return true;
1063 }
1064 SET(1, "", (tanh(VALUE(1))), NUMBER, true);
1065 return true;
1066 }
1067 if (oper == SQRT) {
1068 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1069 if (!VALID(1)) {
1070 SET(1, "", missing, NUMBER, false);
1071 return true;
1072 }
1073 if (VALUE(1) < 0.0) {
1074 RpnError = NEED_GE_0;
1075 return false;
1076 }
1077 SET(1, "", (sqrt(VALUE(1))), NUMBER, true);
1078 return true;
1079 }
1080 if (oper == LOG) {
1081 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1082 if (!VALID(1)) {
1083 SET(1, "", missing, NUMBER, false);
1084 return true;
1085 }
1086 if (VALUE(1) <= 0.0) {
1087 RpnError = NEED_GT_0;
1088 return false;
1089 }
1090 SET(1, "", (log10(VALUE(1))), NUMBER, true);
1091 return true;
1092 }
1093 if (oper == LN) {
1094 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1095 if (!VALID(1)) {
1096 SET(1, "", missing, NUMBER, false);
1097 return true;
1098 }
1099 if (VALUE(1) <= 0) {
1100 RpnError = NEED_GT_0;
1101 return false;
1102 }
1103 SET(1, "", (log(VALUE(1))), NUMBER, true);
1104 return true;
1105 }
1106 if (oper == EXP) {
1107 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1108 if (!VALID(1)) {
1109 SET(1, "", missing, NUMBER, false);
1110 return true;
1111 }
1112 SET(1, "", (pow(Ee, VALUE(1))), NUMBER, true);
1113 return true;
1114 }
1115 if (oper == EXP10) {
1116 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1117 if (!VALID(1)) {
1118 SET(1, "", missing, NUMBER, false);
1119 return true;
1120 }
1121 SET(1, "", (pow(10.0, VALUE(1))), NUMBER, true);
1122 return true;
1123 }
1124 if (oper == HEX2DEC) {
1125 NEED_ON_STACK(1); NEED_IS_TYPE(1, STRING);
1126 if (!VALID(1)) {
1127 SET(1, "", missing, NUMBER, false);
1128 return true;
1129 }
1130 std::string hex = NAME(1);
1131 un_double_quote(hex);
1132 unsigned int r;
1133 if (1 == sscanf(hex.c_str(), "%x", &r)) {
1134 res = floor(0.5 + r);
1135 } else {
1136 res = gr_currentmissingvalue();
1137 err("hex2dec cannot decode \\", hex.c_str(), "\\");
1138 RpnError = GENERAL_ERROR;
1139 return false;
1140 }
1141 SET(1, "", res, NUMBER, true);
1142 return true;
1143 }
1144 if (oper == DEC2HEX) {
1145 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1146 if (!VALID(1)) {
1147 SET(1, "", missing, NUMBER, false);
1148 return true;
1149 }
1150 if (VALUE(1) < -0.5) {
1151 SET(1, "", 0.0, STRING, true);
1152 RpnError = NEED_GE_0;
1153 return false;
1154 }
1155 char hex[20]; // BUG: may not be long enough
1156 unsigned int chars = snprintf(hex, -1 + sizeof(hex), "%X", (unsigned int)floor(0.5 + VALUE(1)));
1157 if (chars > -1 + sizeof(hex)) {
1158 err("dec2hex buffer overflow [internal error in rpncalc.cc, please contact developer]");
1159 return false;
1160 }
1161 if (chars < 1) {
1162 SET(1, "", 0.0, STRING, true);
1163 err("dec2hex cannot convert number");
1164 RpnError = GENERAL_ERROR;
1165 return false;
1166 }
1167 std::string qhex = "\"";
1168 qhex.append(hex);
1169 qhex.append("\"");
1170 SET(1, qhex.c_str(), 0.0, STRING, true);
1171 return true;
1172 }
1173 if (oper == FLOOR) {
1174 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1175 if (!VALID(1)) {
1176 SET(1, "", missing, NUMBER, false);
1177 return true;
1178 }
1179 SET(1, "", (floor(VALUE(1))), NUMBER, true);
1180 return true;
1181 }
1182 if (oper == REMAINDER) {
1183 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
1184 if (!VALID(1)) {
1185 SET(1, "", missing, NUMBER, false);
1186 return true;
1187 }
1188 SET(2, "", (fmod(VALUE(2), VALUE(1))), NUMBER, true);
1189 rS.pop_back();
1190 return true;
1191 }
1192 if (oper == CEIL) {
1193 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1194 if (!VALID(1)) {
1195 SET(1, "", missing, NUMBER, false);
1196 return true;
1197 }
1198 SET(1, "", (ceil(VALUE(1))), NUMBER, true);
1199 return true;
1200 }
1201 if (oper == ABS) {
1202 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1203 if (!VALID(1)) {
1204 SET(1, "", missing, NUMBER, false);
1205 return true;
1206 }
1207 SET(1, "", (fabs(VALUE(1))), NUMBER, true);
1208 return true;
1209 }
1210 if (oper == CMTOPT) {
1211 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1212 if (!VALID(1)) {
1213 SET(1, "", missing, NUMBER, false);
1214 return true;
1215 }
1216 SET(1, "", (VALUE(1) * PT_PER_CM), NUMBER, true);
1217 return true;
1218 }
1219 if (oper == PTTOCM) {
1220 NEED_ON_STACK(1); NEED_IS_TYPE(1, NUMBER);
1221 if (!VALID(1)) {
1222 SET(1, "", missing, NUMBER, false);
1223 return true;
1224 }
1225 SET(1, "", (VALUE(1) / PT_PER_CM), NUMBER, true);
1226 return true;
1227 }
1228 if (oper == DUP) {
1229 NEED_ON_STACK(1);
1230 RpnItem item;
1231 item.set(NAME(1), VALUE(1), TYPE(1), true);
1232 rS.push_back(item);
1233 return true;
1234 }
1235 if (oper == POP) {
1236 if (rS.size() < 2) {
1237 warning("An 'RPN' pop is leaving a blank stack. Do you want this?");
1238 }
1239 rS.pop_back();
1240 return true;
1241 }
1242 if (oper == EXCH) {
1243 NEED_ON_STACK(2);
1244 RpnItem old; // cannot do old=... here
1245 old = rS[rS.size() - 1];
1246 rS[rS.size() - 1] = rS[rS.size() - 2];
1247 rS[rS.size() - 2] = old;
1248 return true;
1249 }
1250 if (oper == ROLL_LEFT) {
1251 NEED_ON_STACK(2);
1252 RpnItem old; // cannot do old=... here
1253 old = rS[0];
1254 for (unsigned int i = 0; i < rS.size() - 1; i++)
1255 rS[i] = rS[i + 1];
1256 rS[rS.size() - 1] = old;
1257 return true;
1258 }
1259 if (oper == ROLL_RIGHT) {
1260 NEED_ON_STACK(2);
1261 RpnItem old; // cannot do old=... here
1262 old = rS[rS.size() - 1];
1263 for (unsigned int i = rS.size() - 1; i > 0; i--)
1264 rS[i] = rS[i - 1];
1265 rS[0] = old;
1266 return true;
1267 }
1268 if (oper == PSTACK) {
1269 return print_rpn_stack();
1270 }
1271 if (oper == STRLEN) {
1272 NEED_ON_STACK(1); NEED_IS_TYPE(1, STRING);
1273 SET(1, "", double(strlen(NAME(1))), NUMBER, true);
1274 return true;
1275 }
1276 if (oper == SUBSTR) {
1277 NEED_ON_STACK(3);
1278 NEED_IS_TYPE(1, STRING);
1279 NEED_IS_TYPE(2, NUMBER);
1280 NEED_IS_TYPE(3, NUMBER);
1281 std::string s(NAME(1)), ss;
1282 un_double_quote(s);
1283 int stop = int(VALUE(2));
1284 int start = int(VALUE(3));
1285 if (stop < 0 || start < 0) {
1286 RpnError = NEED_GE_0;
1287 return false;
1288 }
1289 rS.pop_back();
1290 rS.pop_back();
1291 rS.pop_back();
1292 RpnItem item;
1293 ss = "\"";
1294 ss.append(s.substr(start, stop));
1295 ss.append("\"");
1296 item.set(ss.c_str(), 0.0, STRING, true);
1297 rS.push_back(item);
1298 return true;
1299 }
1300 if (oper == STRCAT) {
1301 // Need to remove the last quote (") of first and first quote of second.
1302 NEED_ON_STACK(2); NEED_IS_TYPE(1, STRING); NEED_IS_TYPE(2, STRING);
1303 std::string res(NAME(2));
1304 res.STRINGERASE(res.size()-1, 1);
1305 res.append(NAME(1) + 1);
1306 SET(2, res.c_str(), 0.0, STRING, true);
1307 rS.pop_back();
1308 return true;
1309 }
1310 if (oper == ATOF) {
1311 NEED_ON_STACK(1);
1312 NEED_IS_TYPE(1, STRING);
1313 double tmp;
1314 sscanf(NAME(1), "\"%lf\"", &tmp);
1315 SET(1, "", tmp, NUMBER, true);
1316 return true;
1317 }
1318 if (oper == SYSTEM) {
1319 NEED_ON_STACK(1);
1320 NEED_IS_TYPE(1, STRING);
1321 #if !defined(HAVE_POPEN)
1322 err("This computer can't do `system' in RPN, since no popen() subroutine.");
1323 return false;
1324 #else
1325 {
1326 char *output_lines = new char[LineLength];
1327 if (!output_lines) OUT_OF_MEMORY;
1328 char *thisline = new char[LineLength];
1329 if (!thisline) OUT_OF_MEMORY;
1330 FILE *pipefile;
1331 // double duty for this
1332 strcpy(output_lines, 1 + NAME(1));
1333 if (*STRING_END(output_lines) == '"')
1334 *STRING_END(output_lines) = '\0';
1335 pipefile = (FILE *) popen(output_lines, "r");
1336 if (!pipefile) {
1337 err("Sorry, cannot do `system' in RPN; failed popen() call");
1338 delete [] thisline;
1339 delete [] output_lines;
1340 return false;
1341 }
1342 strcpy(output_lines, "");
1343 // BUG -- should check for overwrite!
1344 while (NULL != fgets(thisline, LineLength_1, pipefile))
1345 strcat(output_lines, thisline);
1346 pclose(pipefile);
1347 if (*STRING_END(output_lines) == '\n') {
1348 *STRING_END(output_lines) = '\0';
1349 }
1350 std::string tmp("\"");
1351 tmp.append(output_lines);
1352 tmp.append("\"");
1353 SET(1, tmp.c_str(), 0.0, STRING, true);
1354 delete [] thisline;
1355 delete [] output_lines;
1356 }
1357 return true;
1358 #endif
1359 }
1360 if (oper == SUP) {
1361 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
1362 if (VALID(1) && VALID(2))
1363 SET(2, "", (VALUE(1)>VALUE(2)?VALUE(1):VALUE(2)), NUMBER, true);
1364 else
1365 SET(2, "", missing, NUMBER, false);
1366 rS.pop_back();
1367 return true;
1368 }
1369 if (oper == INF) {
1370 NEED_ON_STACK(2); NEED_IS_TYPE(1, NUMBER); NEED_IS_TYPE(2, NUMBER);
1371 if (VALID(1) && VALID(2))
1372 SET(2, "", (VALUE(1)<VALUE(2)?VALUE(1):VALUE(2)), NUMBER, true);
1373 else
1374 SET(2, "", missing, NUMBER, false);
1375 rS.pop_back();
1376 return true;
1377 }
1378
1379 if (oper == ASSIGN) {
1380 // {rpn 10 ".a." =} # assign 10 to the variable named ".a."
1381 // {rpn 3.14159 1 x =} # assign Pi to x[1]
1382 NEED_ON_STACK(2);
1383 NEED_IS_TYPE(1, STRING);
1384 std::string unadorned(NAME(1));
1385 un_double_quote(unadorned);
1386 if (is_column_name(unadorned.c_str())) {
1387 //print_rpn_stack("assign to a column ...\n");
1388 NEED_ON_STACK(3);
1389 //printf("assign to column [%s]\n", unadorned.c_str());
1390 int index = int(0.5 + VALUE(2));
1391 //printf("assigning %lf to %s[%d]\n", VALUE(3), unadorned.c_str(), index);
1392 assign_to_column(index, VALUE(3), unadorned.c_str());
1393 NEED_IS_TYPE(3, NUMBER);
1394 NEED_IS_TYPE(2, NUMBER);
1395 rS.pop_back();
1396 rS.pop_back();
1397 rS.pop_back();
1398 return true;
1399 }
1400 switch (TYPE(2)) {
1401 case NUMBER:
1402 printf("case NUMBER\n");
1403 if (is_var(unadorned.c_str())) {
1404 PUT_VAR(unadorned.c_str(), VALUE(2));
1405 //printf("%s:%d debug\n",__FILE__,__LINE__);
1406 } else {
1407 //printf("%s:%d [%s]\n",__FILE__,__LINE__,unadorned.c_str());
1408 //printf("%s:%d [%s]\n",__FILE__,__LINE__,NAME(1));
1409 err("Invalid variable name `\\", unadorned.c_str(), "' in assignment", "\\");
1410 RpnError = ILLEGAL_TYPE;
1411 return false;
1412 }
1413 break;
1414 case STRING:
1415 //printf("case STRING\n");
1416 if (unadorned[1] == '\\') {
1417 char *s = new char[1 + strlen(NAME(2))];
1418 if (!s) OUT_OF_MEMORY;
1419 strcpy(s, 1 + NAME(2));
1420 if (s[strlen(s) - 1] == '"')
1421 s[strlen(s) - 1] = '\0';
1422 if (!put_syn(1 + unadorned.c_str(), s, true)) OUT_OF_MEMORY;
1423 delete [] s;
1424 } else {
1425 err("Invalid synonym name in assignment");
1426 RpnError = ILLEGAL_TYPE;
1427 return false;
1428 }
1429 break;
1430 default:
1431 //printf("case DEFAULT\n");
1432 err("RPN operator `=' cannot handle the items currently on stack.");
1433 RpnError = ILLEGAL_TYPE;
1434 return false;
1435 }
1436 rS.pop_back();
1437 rS.pop_back();
1438 return true;
1439 }
1440
1441 if (oper == XYCMTOUSER) { // should check for missingvalue?
1442 NEED_IS_TYPE(2, NUMBER);
1443 set_x_scale();
1444 set_y_scale();
1445 double tmpy, tmpx;
1446 gr_cmtouser(VALUE(2), VALUE(1), &tmpx, &tmpy);
1447 SET(2, "", tmpx, NUMBER, true);
1448 SET(1, "", tmpy, NUMBER, true);
1449 return true;
1450 }
1451 if (oper == XYUSERTOCM) { // should check for missingvalue?
1452 NEED_IS_TYPE(2, NUMBER);
1453 set_x_scale();
1454 set_y_scale();
1455 double tmpy, tmpx;
1456 gr_usertocm(VALUE(2), VALUE(1), &tmpx, &tmpy);
1457 SET(2, "", tmpx, NUMBER, true);
1458 SET(1, "", tmpy, NUMBER, true);
1459 return true;
1460 }
1461 if (oper == XCMTOUSER) { // should check for missingvalue?
1462 NEED_IS_TYPE(1, NUMBER);
1463 set_x_scale();
1464 double tmpy, tmpx;
1465 gr_cmtouser(VALUE(1), 1.0, &tmpx, &tmpy);
1466 SET(1, "", tmpx, NUMBER, true);
1467 return true;
1468 }
1469 if (oper == XPTTOUSER) { // should check for missingvalue?
1470 NEED_IS_TYPE(1, NUMBER);
1471 set_x_scale();
1472 double tmpy, tmpx;
1473 gr_cmtouser(VALUE(1) / PT_PER_CM, 1.0, &tmpx, &tmpy);
1474 SET(1, "", tmpx, NUMBER, true);
1475 return true;
1476 }
1477 if (oper == XUSERTOCM) { // should check for missingvalue?
1478 NEED_IS_TYPE(1, NUMBER);
1479 set_x_scale();
1480 double tmpy, tmpx;
1481 gr_usertocm(VALUE(1), 1.0, &tmpx, &tmpy);
1482 SET(1, "", tmpx, NUMBER, true);
1483 return true;
1484 }
1485 if (oper == XUSERTOPT) { // should check for missingvalue?
1486 NEED_IS_TYPE(1, NUMBER);
1487 set_x_scale();
1488 double tmpy, tmpx;
1489 gr_usertopt(VALUE(1), 1.0, &tmpx, &tmpy);
1490 SET(1, "", tmpx, NUMBER, true);
1491 return true;
1492 }
1493 if (oper == YUSERTOCM) { // should check for missingvalue?
1494 NEED_IS_TYPE(1, NUMBER);
1495 set_y_scale();
1496 double tmpy, tmpx;
1497 gr_usertocm(1.0, VALUE(1), &tmpx, &tmpy);
1498 SET(1, "", tmpy, NUMBER, true);
1499 return true;
1500 }
1501 if (oper == YUSERTOPT) { // should check for missingvalue?
1502 NEED_IS_TYPE(1, NUMBER);
1503 set_y_scale();
1504 double tmpy, tmpx;
1505 gr_usertopt(1.0, VALUE(1), &tmpx, &tmpy);
1506 SET(1, "", tmpy, NUMBER, true);
1507 return true;
1508 }
1509 if (oper == YCMTOUSER) { // should check for missingvalue?
1510 NEED_IS_TYPE(1, NUMBER);
1511 set_y_scale();
1512 double tmpy, tmpx;
1513 gr_cmtouser(1.0, VALUE(1), &tmpx, &tmpy);
1514 SET(1, "", tmpy, NUMBER, true);
1515 return true;
1516 }
1517 if (oper == YPTTOUSER) { // should check for missingvalue?
1518 NEED_IS_TYPE(1, NUMBER);
1519 set_y_scale();
1520 double tmpy, tmpx;
1521 gr_cmtouser(1.0, VALUE(1) / PT_PER_CM, &tmpx, &tmpy);
1522 SET(1, "", tmpy, NUMBER, true);
1523 return true;
1524 }
1525 if (oper == SED) {
1526 NEED_IS_TYPE(1, STRING);
1527 NEED_IS_TYPE(2, STRING);
1528 string cmd;
1529 cmd.assign("echo \"");
1530 cmd.append(NAME(2));
1531 cmd.append("\" | sed -e \"");
1532 cmd.append(NAME(1));
1533 cmd.append("\"");
1534 FILE *pipefile = (FILE *) popen(cmd.c_str(), "r");
1535 if (!pipefile) {
1536 err("cannot do `sed' in RPN; failed popen() call");
1537 return false;
1538 }
1539 GriString res;
1540 res.line_from_FILE(pipefile);
1541 pclose(pipefile);
1542 if (0 == strlen(res.getValue())) {
1543 err("cannot read output from 'sed' system command");
1544 return false;
1545 }
1546 std::string quoted_res("\"");
1547 quoted_res.append(res.getValue());
1548 if (quoted_res[-1 + quoted_res.size()] == '\n')
1549 quoted_res.STRINGERASE(-1 + quoted_res.size());
1550 quoted_res.append("\"");
1551 SET(2, quoted_res.c_str(), 0.0, STRING, true);
1552 rS.pop_back();
1553 return true;
1554 }
1555 if (oper == STRINGWIDTH) {
1556 NEED_ON_STACK(1);
1557 if (TYPE(1) != STRING) {
1558 err("RPN string operator `width' needs a string to be top item on stack.");
1559 RpnError = ILLEGAL_TYPE;
1560 return false;
1561 } else {
1562 double width, ascent, descent; // in cm
1563 double fontsize;
1564 gr_fontID old_font;
1565 old_font = gr_currentfont();
1566 if (!get_var("..fontsize..", &fontsize))
1567 warning("(rpn width), ..fontsize.. undefined so using 12");
1568 gr_setfontsize_pt(fontsize);
1569 gr_setfont(old_font);
1570 std::string no_quotes(NAME(1));
1571 un_double_quote(no_quotes);
1572 gr_stringwidth(no_quotes.c_str(), &width, &ascent, &descent);
1573 SET(1, "", width, NUMBER, true);
1574 }
1575 return true;
1576 }
1577 if (oper == STRINGASCENT) {
1578 NEED_ON_STACK(1);
1579 if (TYPE(1) != STRING) {
1580 err("RPN string operator `ascent' needs a string to be top item on stack.");
1581 RpnError = ILLEGAL_TYPE;
1582 return false;
1583 } else {
1584 double fontsize;
1585 double width, ascent, descent; // in cm
1586 gr_fontID old_font;
1587 old_font = gr_currentfont();
1588 if (!get_var("..fontsize..", &fontsize))
1589 warning("(rpn width), ..fontsize.. undefined so using 12");
1590 gr_setfontsize_pt(fontsize);
1591 gr_setfont(old_font);
1592 std::string no_quotes(NAME(1));
1593 un_double_quote(no_quotes);
1594 gr_stringwidth(no_quotes.c_str(), &width, &ascent, &descent);
1595 SET(1, "", ascent, NUMBER, true);
1596 }
1597 return true;
1598 }
1599 if (oper == STRINGDESCENT) {
1600 NEED_ON_STACK(1);
1601 if (TYPE(1) != STRING) {
1602 err("RPN string operator `descent' needs a string to be top item on stack.");
1603 RpnError = ILLEGAL_TYPE;
1604 return false;
1605 } else {
1606 double width, ascent, descent; // in cm
1607 double fontsize;
1608 gr_fontID old_font;
1609 old_font = gr_currentfont();
1610 if (!get_var("..fontsize..", &fontsize))
1611 warning("(rpn width), ..fontsize.. undefined so using 12");
1612 gr_setfontsize_pt(fontsize);
1613 gr_setfont(old_font);
1614 std::string no_quotes(NAME(1));
1615 un_double_quote(no_quotes);
1616 gr_stringwidth(no_quotes.c_str(), &width, &ascent, &descent);
1617 SET(1, "", descent, NUMBER, true);
1618 }
1619 return true;
1620 }
1621 if (oper == DIRECTORY_EXISTS) {
1622 NEED_ON_STACK(1);
1623 if (TYPE(1) != STRING) {
1624 err("RPN string operator `directory_exists' needs a string to be top item on stack.");
1625 RpnError = ILLEGAL_TYPE;
1626 return false;
1627 } else {
1628 #if defined(HAVE_ACCESS)
1629 std::string fname(NAME(1));
1630 un_double_quote(fname);
1631 if (fname[0] == '~') {
1632 fname.STRINGERASE(0, 1);
1633 std::string home(egetenv("HOME"));
1634 home.append(fname);
1635 fname = home;
1636 }
1637 //printf("DEBUG: should check if file named '%s' or '%s' exists\n",NAME(1),fname.c_str());
1638 if (0 == access(fname.c_str(), R_OK | X_OK))
1639 SET(1, "", 1.0, NUMBER, true);
1640 else
1641 SET(1, "", 0.0, NUMBER, true);
1642 #else
1643 warning("Can't determine whether directory exists (no 'access' subroutine on this system) so guessing answer is yes.");
1644 SET(1, "", 1.0, NUMBER, true);
1645 #endif
1646 }
1647 return true;
1648 }
1649 if (oper == WORDC) {
1650 extern int _num_command_word;
1651 extern char *_command_word[MAX_cmd_word];
1652 extern char *_command_word_separator;
1653 int cmd;
1654 for (cmd = _num_command_word - 1; cmd > -1; cmd--)
1655 if (!strcmp(_command_word[cmd], _command_word_separator))
1656 break;
1657 //printf("DEBUG cmd %d num %d stacksize %d\n",cmd,_num_command_word,rS.size());
1658 RpnItem item;
1659 if (cmd > -1)
1660 item.set("", double(_num_command_word - cmd - 1), NUMBER, true);
1661 else
1662 item.set("", 0.0, NUMBER, true);
1663 rS.push_back(item);
1664 return true;
1665 }
1666 if (oper == WORDV) {
1667 if (rS.size() < 1) {
1668 err("`wordv' needs an argument, e.g. {rpn 0 wordv} gives first word of command\n.");
1669 return false;
1670 }
1671 NEED_IS_TYPE(1, NUMBER);
1672 int index = int(VALUE(1));
1673 if (index < 0) {
1674 printf("`wordv' needs index >= 0\n");
1675 RpnError = NEED_GT_1;
1676 return false;
1677 }
1678 extern int _num_command_word;
1679 extern char *_command_word[MAX_cmd_word];
1680 extern char *_command_word_separator;
1681 int cmd;
1682 // Trace back through the stack until at next level deep, then
1683 // move forward to indicated word.
1684 for (cmd = _num_command_word - 1; cmd > -1; cmd--) {
1685 //printf("\t%d of %d <%s>\n",cmd,_num_command_word,_command_word[cmd]);
1686 if (!strcmp(_command_word[cmd], _command_word_separator))
1687 break;
1688 }
1689 //printf("cmd is %d max is %d ... value '%s'\n",cmd,_num_command_word,_command_word[cmd+index+1]);
1690 std::string rv;
1691 if (*_command_word[cmd + index + 1] == '\"') {
1692 rv.append(_command_word[cmd + index + 1]);
1693 } else {
1694 rv.append("\"");
1695 rv.append(_command_word[cmd + index + 1]);
1696 rv.append("\"");
1697 }
1698 SET(1, rv.c_str(), 0.0, STRING, true);
1699 //printf("\t\trv is '%s'\n",rv.c_str());
1700 return true;
1701 }
1702 if (oper == ARGC) {
1703 extern std::vector<const char*>_gri_argv;
1704 RpnItem item;
1705 item.set("", double(_gri_argv.size()), NUMBER, true);
1706 rS.push_back(item);
1707 return true;
1708 }
1709 if (oper == ARGV) {
1710 NEED_ON_STACK(1);
1711 NEED_IS_TYPE(1, NUMBER);
1712 int index = int(VALUE(1));
1713 if (index < 0) {
1714 printf("'argv' needs index >= 0\n");
1715 RpnError = NEED_GT_1;
1716 return false;
1717 }
1718 extern std::vector<const char*>_gri_argv;
1719 if (index >= int(_gri_argv.size())) {
1720 SET(1, "\" \"", 0.0, STRING, true);
1721 return true;
1722 }
1723 std::string rv("\"");
1724 rv.append(_gri_argv[index]);
1725 rv.append("\"");
1726 SET(1, rv.c_str(), 0.0, STRING, true);
1727 return true;
1728 }
1729 if (oper == FILE_EXISTS) {
1730 NEED_ON_STACK(1);
1731 if (TYPE(1) != STRING) {
1732 err("RPN string operator `file_exists' needs a string to be top item on stack.");
1733 RpnError = ILLEGAL_TYPE;
1734 return false;
1735 } else {
1736 #if defined(HAVE_ACCESS)
1737 std::string fname(NAME(1));
1738 un_double_quote(fname);
1739 if (fname[0] == '~') {
1740 fname.STRINGERASE(0, 1);
1741 std::string home(egetenv("HOME"));
1742 home.append(fname);
1743 fname = home;
1744 }
1745 //printf("DEBUG: should check if file named '%s' or '%s' exists\n",NAME(1),fname.c_str());
1746 if (0 == access(fname.c_str(), R_OK))
1747 SET(1, "", 1.0, NUMBER, true);
1748 else
1749 SET(1, "", 0.0, NUMBER, true);
1750 #else
1751 warning("Can't determine whether file exists (no 'access' subroutine on this system) so guessing answer is yes.");
1752 SET(1, "", 1.0, NUMBER, true);
1753 #endif
1754 }
1755 return true;
1756 }
1757 if (oper == DEFINED) {
1758 NEED_ON_STACK(1);
1759 NEED_IS_TYPE(1, STRING);
1760 std::string n1(NAME(1));
1761 un_double_quote(n1);
1762 // It's either a synonym or a variable, or not defined
1763 if (is_syn(n1)) {
1764 //printf("\n");
1765 //printf("DEBUG %s:%d defined on <%s>\n",__FILE__,__LINE__,n1.c_str());
1766 int w_index = -1;
1767 if (1 == sscanf(n1.c_str(), "\\.word%d.", &w_index)) {
1768 std::string w("");
1769 if (get_cmdword(w_index, w)) {
1770 // If such a \.word?. exists, look up pointed-to item
1771 //printf("DEBUG %s:%d w= <%s>\n",__FILE__,__LINE__,w.c_str());
1772 std::string coded_name;
1773 int coded_level;
1774 if (is_coded_string(w, coded_name, &coded_level)) {
1775 //printf("DEBUG %s:%d encoded `%s' at level %d\n",__FILE__,__LINE__, coded_name.c_str(), coded_level);
1776 std::string value;
1777 if (get_coded_value(coded_name, coded_level, value)) {
1778 //printf(" ** YES [%s] is defined\n", coded_name.c_str());
1779 SET(1, "", 1.0, NUMBER, true);
1780 } else {
1781 //printf(" ** NO [%s] is NOT defined\n", coded_name.c_str());
1782 SET(1, "", 0.0, NUMBER, true);
1783 }
1784 } else {
1785 // Nothing pointed-to, so \.word?. existence enough
1786 SET(1, "", 1.0, NUMBER, true);
1787 }
1788 } else {
1789 // If no such \.word?., certainly nothing pointed-to.
1790 SET(1, "", 0.0, NUMBER, true);
1791 }
1792 } else {
1793 //printf("CASE 2. n1 is [%s]\n",n1.c_str());
1794 bool exists;
1795 std::string syn_value; // not used, actually
1796 if (n1[1] == '@') {
1797 std::string d("\\");
1798 d.append(n1.substr(2, n1.size()));
1799 exists = get_syn(d.c_str(), syn_value);
1800 //printf("CASE 2B d is [%s] returning %d\n",d.c_str(),exists);
1801 } else {
1802 exists = get_syn(n1.c_str(), syn_value);
1803 //printf("CASE 2B. n1 is [%s] returning %d\n",n1.c_str(),exists);
1804 }
1805 if (exists)
1806 SET(1, "", 1.0, NUMBER, true);
1807 else
1808 SET(1, "", 0.0, NUMBER, true);
1809 }
1810 } else if (is_var(n1)) {
1811 double tmp;
1812 bool exists = get_var(n1.c_str(), &tmp);
1813 if (exists)
1814 SET(1, "", 1.0, NUMBER, true);
1815 else
1816 SET(1, "", 0.0, NUMBER, true);
1817 } else {
1818 err("Can only use `defined' on a variable or synonym (e.g., `.var.' or `\\syn'), not on `\\", NAME(1), "' as found", "\\");
1819 RpnError = ILLEGAL_TYPE;
1820 return false;
1821 }
1822 return true;
1823 }
1824 if (oper == ISMISSING) {
1825 //printf("\noperator ISMISSING.\n");
1826 //printf("value on stack: %f\n",VALUE(1));
1827 NEED_IS_TYPE(1, NUMBER);
1828 SET(1, "", gr_missing(VALUE(1)) == true ? 1.0 : 0.0, NUMBER, true);
1829 //printf("ste value to %f\n",VALUE(1));
1830 return true;
1831 }
1832 if (oper == INTERPOLATE) {
1833 // Next 2 functions in convert.cc
1834 NEED_ON_STACK(3);
1835 NEED_IS_TYPE(3, COLUMN_NAME); // must be `grid', actually
1836 NEED_IS_TYPE(2, NUMBER); // x
1837 NEED_IS_TYPE(1, NUMBER); // y
1838 int i, j;
1839 double x = VALUE(2), y = VALUE(1), grid_value;
1840 if (!locate_i_j(x, y, &i, &j)) {
1841 SET(3, "", gr_currentmissingvalue(), NUMBER, true);
1842 } else {
1843 #if defined(OLD_IMAGE_INTERPOLATION)
1844 value_i_j(i, j, x, y, &grid_value);
1845 #else
1846 value_i_j(i, j, x, y, &grid_value);
1847 #endif
1848 SET(3, "", grid_value, NUMBER, true);
1849 }
1850 rS.pop_back();
1851 rS.pop_back();
1852 return true;
1853 }
1854 if (oper == RAND) {
1855 RpnItem item;
1856 #if defined(HAVE_DRAND48)
1857 item.set("", drand48(), NUMBER, true);
1858 #else
1859 item.set("", rand(), NUMBER, true);
1860 #endif
1861 rS.push_back(item);
1862 return true;
1863 }
1864
1865 if (oper == VAL) {
1866 extern char _grTempString[];
1867 NEED_ON_STACK(2);
1868 NEED_IS_TYPE(2, COLUMN_NAME);
1869 int index = (int) (floor(0.5 + VALUE(1)));
1870 if (index < 0) {
1871 err("Can't take negative index of the `\\",
1872 NAME(1),
1873 "' column.",
1874 "\\");
1875 RpnError = GENERAL_ERROR;
1876 return false;
1877 }
1878 if (!strcmp(NAME(2), "x")) {
1879 if (index > int(_colX.size() - 1)) {
1880 sprintf(_grTempString, "Cannot index %d-th value of x column; valid range is 0 to %d", index, int(_colX.size() - 1));
1881 err(_grTempString);
1882 RpnError = GENERAL_ERROR;
1883 return false;
1884 }
1885 SET(2, "", _colX[index], NUMBER, true);
1886 rS.pop_back();
1887 } else if (!strcmp(NAME(2), "y")) {
1888 if (index > int(_colY.size() - 1)) {
1889 sprintf(_grTempString, "Cannot index %d-th value of y column; valid range is 0 to %d", index, int(_colY.size() - 1));
1890 err(_grTempString);
1891 RpnError = GENERAL_ERROR;
1892 return false;
1893 }
1894 SET(2, "", _colY[index], NUMBER, true);
1895 rS.pop_back();
1896 } else if (!strcmp(NAME(2), "z")) {
1897 if (index > int(_colZ.size() - 1)) {
1898 sprintf(_grTempString, "Cannot index %d-th value of z column; valid range is 0 to %d", index, int(_colZ.size() - 1));
1899 err(_grTempString);
1900 RpnError = GENERAL_ERROR;
1901 return false;
1902 }
1903 SET(2, "", _colZ[index], NUMBER, true);
1904 rS.pop_back();
1905 } else if (!strcmp(NAME(2), "u")) {
1906 if (index > int(_colU.size() - 1)) {
1907 sprintf(_grTempString, "Cannot index %d-th value of u column; valid range is 0 to %d", index, int(_colU.size() - 1));
1908 err(_grTempString);
1909 RpnError = GENERAL_ERROR;
1910 return false;
1911 }
1912 SET(2, "", _colU[index], NUMBER, true);
1913 rS.pop_back();
1914 } else if (!strcmp(NAME(2), "v")) {
1915 if (index > int(_colV.size() - 1)) {
1916 sprintf(_grTempString, "Cannot index %d-th value of v column; valid range is 0 to %d", index, int(_colV.size() - 1));
1917 err(_grTempString);
1918 RpnError = GENERAL_ERROR;
1919 return false;
1920 }
1921 SET(2, "", _colV[index], NUMBER, true);
1922 rS.pop_back();
1923 } else if (!strcmp(NAME(2), "weight")) {
1924 if (index > int(_colWEIGHT.size() - 1)) {
1925 sprintf(_grTempString, "Cannot index %d-th value of weight column; valid range is 0 to %d", index, int(_colWEIGHT.size() - 1));
1926 err(_grTempString);
1927 RpnError = GENERAL_ERROR;
1928 return false;
1929 }
1930 SET(2, "", _colWEIGHT[index], NUMBER, true);
1931 rS.pop_back();
1932
1933 } else {
1934 err("Column `\\", NAME(2), "' is invalid", "\\");
1935 RpnError = GENERAL_ERROR;
1936 return false;
1937 }
1938 return true;
1939 }
1940 if (oper == AREA) {
1941 NEED_ON_STACK(2);
1942 NEED_IS_TYPE(1, COLUMN_NAME);
1943 NEED_IS_TYPE(2, COLUMN_NAME);
1944 if (!(!strcmp(NAME(2), "y") && !strcmp(NAME(1), "x"))) {
1945 err("To get area under curve, must use syntax `y x area'");
1946 RpnError = GENERAL_ERROR;
1947 return false;
1948 }
1949 SET(2, "", curve_area(), NUMBER, true);
1950 rS.pop_back();
1951 return true;
1952 }
1953 if (oper == MIN) {
1954 NEED_ON_STACK(1);
1955 NEED_IS_TYPE(1, COLUMN_NAME);
1956 if (!strcmp(NAME(1), "x")) {
1957 SET(1, "", _colX.min(), NUMBER, true);
1958 } else if (!strcmp(NAME(1), "y")) {
1959 SET(1, "", _colY.min(), NUMBER, true);
1960 } else if (!strcmp(NAME(1), "z")) {
1961 SET(1, "", _colZ.min(), NUMBER, true);
1962 } else if (!strcmp(NAME(1), "u")) {
1963 SET(1, "", _colU.min(), NUMBER, true);
1964 } else if (!strcmp(NAME(1), "v")) {
1965 SET(1, "", _colV.min(), NUMBER, true);
1966 } else if (!strcmp(NAME(1), "grid")) {
1967 GET_GRID_MIN();
1968 } else {
1969 err("Can't find min of item `\\", NAME(1), "'", "\\");
1970 RpnError = GENERAL_ERROR;
1971 return false;
1972 }
1973 return true;
1974 }
1975 if (oper == MAX) {
1976 NEED_ON_STACK(1);
1977 NEED_IS_TYPE(1, COLUMN_NAME);
1978 if (!strcmp(NAME(1), "x")) {
1979 SET(1, "", _colX.max(), NUMBER, true);
1980 } else if (!strcmp(NAME(1), "y")) {
1981 SET(1, "", _colY.max(), NUMBER, true);
1982 } else if (!strcmp(NAME(1), "z")) {
1983 SET(1, "", _colZ.max(), NUMBER, true);
1984 } else if (!strcmp(NAME(1), "u")) {
1985 SET(1, "", _colU.max(), NUMBER, true);
1986 } else if (!strcmp(NAME(1), "v")) {
1987 SET(1, "", _colV.max(), NUMBER, true);
1988 } else if (!strcmp(NAME(1), "grid")) {
1989 GET_GRID_MAX();
1990 } else {
1991 err("Can't find max of item `\\", NAME(1), "'", "\\");
1992 RpnError = GENERAL_ERROR;
1993 return false;
1994 }
1995 return true;
1996 }
1997 if (oper == MEDIAN) {
1998 NEED_ON_STACK(1);
1999 NEED_IS_TYPE(1, COLUMN_NAME);
2000 if (!strcmp(NAME(1), "x")) {
2001 SET(1, "", _colX.median(), NUMBER, true);
2002 } else if (!strcmp(NAME(1), "y")) {
2003 SET(1, "", _colY.median(), NUMBER, true);
2004 } else if (!strcmp(NAME(1), "z")) {
2005 SET(1, "", _colZ.median(), NUMBER, true);
2006 } else if (!strcmp(NAME(1), "u")) {
2007 SET(1, "", _colU.median(), NUMBER, true);
2008 } else if (!strcmp(NAME(1), "v")) {
2009 SET(1, "", _colV.median(), NUMBER, true);
2010 } else if (!strcmp(NAME(1), "grid")) {
2011 err("This version of Gri cannot do 'median' of grid yet.");
2012 RpnError = GENERAL_ERROR;
2013 return false;
2014 } else {
2015 err("Column `\\", NAME(1), "' is invalid", "\\");
2016 RpnError = GENERAL_ERROR;
2017 return false;
2018 }
2019 return true;
2020 }
2021 if (oper == MEAN) {
2022 NEED_ON_STACK(1);
2023 NEED_IS_TYPE(1, COLUMN_NAME);
2024 if (!strcmp(NAME(1), "x")) {
2025 SET(1, "", _colX.mean(), NUMBER, true);
2026 } else if (!strcmp(NAME(1), "y")) {
2027 SET(1, "", _colY.mean(), NUMBER, true);
2028 } else if (!strcmp(NAME(1), "z")) {
2029 SET(1, "", _colZ.mean(), NUMBER, true);
2030 } else if (!strcmp(NAME(1), "u")) {
2031 SET(1, "", _colU.mean(), NUMBER, true);
2032 } else if (!strcmp(NAME(1), "v")) {
2033 SET(1, "", _colV.mean(), NUMBER, true);
2034 } else if (!strcmp(NAME(1), "grid")) {
2035 GET_GRID_MEAN();
2036 } else {
2037 err("Column `\\", NAME(1), "' is invalid", "\\");
2038 RpnError = GENERAL_ERROR;
2039 return false;
2040 }
2041 return true;
2042 }
2043 if (oper == SKEWNESS) {
2044 NEED_ON_STACK(1);
2045 NEED_IS_TYPE(1, COLUMN_NAME);
2046 if (!strcmp(NAME(1), "x")) {
2047 SET(1, "", _colX.skewness(), NUMBER, true);
2048 } else if (!strcmp(NAME(1), "y")) {
2049 SET(1, "", _colY.skewness(), NUMBER, true);
2050 } else if (!strcmp(NAME(1), "z")) {
2051 SET(1, "", _colZ.skewness(), NUMBER, true);
2052 } else if (!strcmp(NAME(1), "u")) {
2053 SET(1, "", _colU.skewness(), NUMBER, true);
2054 } else if (!strcmp(NAME(1), "v")) {
2055 SET(1, "", _colV.skewness(), NUMBER, true);
2056 } else if (!strcmp(NAME(1), "grid")) {
2057 err("Cannot do skewness of a grid. Ask author if you need this to be added to Gri");
2058 } else {
2059 err("Column `\\", NAME(1), "' is invalid", "\\");
2060 RpnError = GENERAL_ERROR;
2061 return false;
2062 }
2063 return true;
2064 }
2065 if (oper == KURTOSIS) {
2066 NEED_ON_STACK(1);
2067 NEED_IS_TYPE(1, COLUMN_NAME);
2068 if (!strcmp(NAME(1), "x")) {
2069 SET(1, "", _colX.kurtosis(), NUMBER, true);
2070 } else if (!strcmp(NAME(1), "y")) {
2071 SET(1, "", _colY.kurtosis(), NUMBER, true);
2072 } else if (!strcmp(NAME(1), "z")) {
2073 SET(1, "", _colZ.kurtosis(), NUMBER, true);
2074 } else if (!strcmp(NAME(1), "u")) {
2075 SET(1, "", _colU.kurtosis(), NUMBER, true);
2076 } else if (!strcmp(NAME(1), "v")) {
2077 SET(1, "", _colV.kurtosis(), NUMBER, true);
2078 } else if (!strcmp(NAME(1), "grid")) {
2079 err("Cannot do kurtosis of a grid. Ask author if you need this to be added to Gri");
2080 } else {
2081 err("Column `\\", NAME(1), "' is invalid", "\\");
2082 RpnError = GENERAL_ERROR;
2083 return false;
2084 }
2085 return true;
2086 }
2087 if (oper == STDDEV) {
2088 NEED_ON_STACK(1);
2089 NEED_IS_TYPE(1, COLUMN_NAME);
2090 if (!strcmp(NAME(1), "x")) {
2091 SET(1, "", _colX.stddev(), NUMBER, true);
2092 } else if (!strcmp(NAME(1), "y")) {
2093 SET(1, "", _colY.stddev(), NUMBER, true);
2094 } else if (!strcmp(NAME(1), "z")) {
2095 SET(1, "", _colZ.stddev(), NUMBER, true);
2096 } else if (!strcmp(NAME(1), "u")) {
2097 SET(1, "", _colU.stddev(), NUMBER, true);
2098 } else if (!strcmp(NAME(1), "v")) {
2099 SET(1, "", _colV.stddev(), NUMBER, true);
2100 } else if (!strcmp(NAME(1), "grid")) {
2101 GET_GRID_STDDEV();
2102 } else {
2103 err("Column `\\", NAME(1), "' is invalid", "\\");
2104 RpnError = GENERAL_ERROR;
2105 return false;
2106 }
2107 return true;
2108 }
2109 if (oper == SIZE) {
2110 NEED_ON_STACK(1);
2111 NEED_IS_TYPE(1, COLUMN_NAME);
2112 if (!strcmp(NAME(1), "x")) {
2113 SET(1, "", _colX.size_legit(), NUMBER, true);
2114 } else if (!strcmp(NAME(1), "y")) {
2115 SET(1, "", _colY.size_legit(), NUMBER, true);
2116 } else if (!strcmp(NAME(1), "z")) {
2117 SET(1, "", _colZ.size_legit(), NUMBER, true);
2118 } else if (!strcmp(NAME(1), "u")) {
2119 SET(1, "", _colU.size_legit(), NUMBER, true);
2120 } else if (!strcmp(NAME(1), "v")) {
2121 SET(1, "", _colV.size_legit(), NUMBER, true);
2122 } else if (!strcmp(NAME(1), "grid")) {
2123 GET_GRID_SIZE();
2124 } else {
2125 err("Column `\\", NAME(1), "' is invalid", "\\");
2126 RpnError = GENERAL_ERROR;
2127 return false;
2128 }
2129 return true;
2130 }
2131 gr_Error("Internal error: should not be able to get to\n this line. Please email bug report to author");
2132 return true;
2133 }
2134
2135 // Used by rpn.cc also, in case of stack overflow
2136 bool
print_rpn_stack(const char * msg)2137 print_rpn_stack(const char *msg)
2138 {
2139 int i;
2140 int stack_len = rS.size();
2141 if (strlen(msg) > 0)
2142 ShowStr(msg);
2143 // printf("stack types UNKNOWN, VARIABLE_WITH_MISSING_VALUE, NOT_OPERAND, NUMBER, STRING, COLUMN_NAME, FUNCTION\n");
2144 ShowStr("Operands on rpn stack: (");
2145 for (i = 0; i < stack_len; i++) {
2146 char str[100];
2147 //printf("type[%d] = %d\n", i, TYPE(stack_len - i));
2148 if (TYPE(stack_len - i) == NUMBER) {
2149 sprintf(str, "%.20g", VALUE(stack_len - i));
2150 ShowStr(str);
2151 } else if (TYPE(stack_len - i) == COLUMN_NAME) {
2152 //ShowStr("colname:");
2153 ShowStr(NAME(stack_len - i));
2154 //printf("[%s]\n",NAME(stack_len - i));
2155 } else {
2156 ShowStr(NAME(stack_len - i));
2157 }
2158 if (i != (stack_len - 1))
2159 ShowStr(", ");
2160 }
2161 ShowStr(")\n");
2162 return true;
2163 }
2164 #undef NEED_IS_TYPE
2165 #undef NEED_ON_STACK
2166 #undef GET_COL_VAL
2167 #undef GET_COL_MIN
2168 #undef GET_COL_MAX
2169 #undef GET_COL_MEAN
2170 #undef GET_COL_STDDEV
2171 #undef VALUE
2172 #undef NAME
2173 #undef VALUE
2174 #undef TYPE
2175