File: common\parser.c
1 /* Parser.c (C) 1990, Mark C. Peterson, CompuServe [70441,3353]
2 All rights reserved.
3
4 Code may be used in any program provided the author is credited
5 either during program execution or in the documentation. Source
6 code may be distributed only in combination with public domain or
7 shareware source code. Source code may be modified provided the
8 copyright notice and this message is left unchanged and all
9 modifications are clearly documented.
10
11 I would appreciate a copy of any work which incorporates this code,
12 however this is optional.
13
14 Mark C. Peterson
15 405-C Queen St. Suite #181
16 Southington, CT 06489
17 (203) 276-9721
18 */
19
20 /* Chuck Ebbert (CompuServe [76306,1226] ) changed code marked 'CAE fp' */
21 /* for fast 387 floating-point math. See PARSERA.ASM and PARSERFP.C */
22 /* (13 Dec 1992.) */
23 /* */
24 /* Modified 12 July 1993 by CAE to fix crash when formula not found. */
25
26 #include <string.h>
27 #include <ctype.h>
28 #include <time.h>
29
30 /* see Fractint.c for a description of the "include" hierarchy */
31 #include "port.h"
32 #include "prototyp.h"
33
34
35 #ifdef WATCH_MP
36 double x1, y1, x2, y2; 37 #endif
38
39 enum MATH_TYPE MathType = D_MATH;
40 /* moved _LCMPLX and union ARg to mpmath.h -6-20-90 TIW */
41
42 #define MAX_OPS 250
43 #define MAX_ARGS 100
44 #define MAX_BOXX 8192 /* max size of boxx array */
45
46 unsigned Max_Ops = MAX_OPS;
47 unsigned Max_Args = MAX_ARGS;
48
49 unsigned long number_of_ops, number_of_loads, number_of_stores, number_of_jumps;
50
51 struct PEND_OP {
52 void (far *f)(void);
53 int p;
54 };
55
56 #ifndef XFRACT
57 /* reuse an array in the decoder */
58 JUMP_CONTROL_ST far *jump_control = (JUMP_CONTROL_ST far *) sizeofstring;
61 #endif
62
63 int jump_index, InitJumpIndex;
64
65 static int frm_prescan (FILE * open_file);
66
67 #define CASE_TERMINATOR case',':\
68 case '\n':\
69 case '(':\
70 case ')':\
71 case '!':\
72 case '=':\
73 case '<':\
74 case '>':\
75 case '|':\
76 case '&':\
77 case '}':\
78 case ':':\
79 case '+':\
80 case '-':\
81 case '*':\
82 case '/':\
83 case '^'
84
85 #define CASE_ALPHA case 'a':\
86 case 'b':\
87 case 'c':\
88 case 'd':\
89 case 'e':\
90 case 'f':\
91 case 'g':\
92 case 'h':\
93 case 'i':\
94 case 'j':\
95 case 'k':\
96 case 'l':\
97 case 'm':\
98 case 'n':\
99 case 'o':\
100 case 'p':\
101 case 'q':\
102 case 'r':\
103 case 's':\
104 case 't':\
105 case 'u':\
106 case 'v':\
107 case 'w':\
108 case 'x':\
109 case 'y':\
110 case 'z'
111
112 #define CASE_NUM case '0':\
113 case '1':\
114 case '2':\
115 case '3':\
116 case '4':\
117 case '5':\
118 case '6':\
119 case '7':\
120 case '8':\
121 case '9'
122
123 /* token_type definitions */
124 #define NOT_A_TOKEN 0
125 #define PARENS 1
126 #define PARAM_VARIABLE 2
127 #define USER_NAMED_VARIABLE 3
128 #define PREDEFINED_VARIABLE 4
129 #define REAL_CONSTANT 5
130 #define COMPLEX_CONSTANT 6
131 #define FUNCTION 7
132 #define PARAM_FUNCTION 8
133 #define FLOW_CONTROL 9
134 #define OPERATOR 10
135 #define END_OF_FORMULA 11
136
137 /* token IDs */
138 #define END_OF_FILE 1
139 #define ILLEGAL_CHARACTER 2
140 #define ILLEGAL_VARIABLE_NAME 3
141 #define TOKEN_TOO_LONG 4
142 #define FUNC_USED_AS_VAR 5
143 #define JUMP_MISSING_BOOLEAN 6
144 #define JUMP_WITH_ILLEGAL_CHAR 7
145 #define UNDEFINED_FUNCTION 8
146 #define ILLEGAL_OPERATOR 9
147 #define ILL_FORMED_CONSTANT 10
148 #define OPEN_PARENS 1
149 #define CLOSE_PARENS -1
150
151 struct token_st {
152 char token_str[80];
153 int token_type;
154 int token_id;
155 _CMPLX token_const;
156 };
157
158
159 /* CAE fp added MAX_STORES and LOADS */
160 /* MAX_STORES must be even to make Unix alignment work */
161 /* TW made dependent on Max_Ops */
162
163 #define MAX_STORES ((Max_Ops/4)*2) /* at most only half the ops can be stores */
164 #define MAX_LOADS ((unsigned)(Max_Ops*.8)) /* and 80% can be loads */
165 /* PB 901103 made some of the following static for safety */
166
167 static struct PEND_OP far *o;
168
169 #if 0
170 static void ops_allocate(void);
171 static void vars_allocate(void); 172 #endif
173
174 struct var_list_st {
175 char name[34];
176 struct var_list_st far * next_item;
177 } far * var_list;
178
179 struct const_list_st {
180 _CMPLX complex_const;
181 struct const_list_st far * next_item;
182 } far * complx_list, far * real_list;
183
184 static void parser_allocate(void);
185
186 union Arg *Arg1, *Arg2;
187 /* PB 910417 removed unused "a" array */
188
189 /* CAE fp made some of the following non-static for PARSERA.ASM */
190 /* Some of these variables should be renamed for safety */
191 union Arg s[20], far * far *Store, far * far *Load; /* static CAE fp */
192 int StoPtr, LodPtr, OpPtr; /* static CAE fp */
193 int var_count;
194 int complx_count;
195 int real_count;
196
197
198 void (far * far *f)(void) = (void(far * far *)(void))0; /* static CAE fp */
199
200 short int ismand = 1;
201
202 unsigned int posp, vsp, LastOp; /* CAE fp made non-static */
203 static unsigned int n, NextOp, InitN;
204 static int paren, ExpectingArg;
205 struct ConstArg far *v = (struct ConstArg far *)0; /* was static CAE fp */
206 int InitLodPtr, InitStoPtr, InitOpPtr, LastInitOp; /* was static CAE fp */
207 static int Delta16;
208 double fgLimit; /* TIW 05-04-91 */
209 static double fg;
210 static int ShiftBack; /* TIW 06-18-90 */
211 static int SetRandom; /* MCP 11-21-91 */
212 static int Randomized;
213 static unsigned long RandNum;
214 short uses_p1, uses_p2, uses_p3, uses_p4, uses_p5, uses_jump;
215 short uses_ismand;
216 unsigned int chars_in_formula;
217
218 #ifndef XFRACT
219 #define ChkLongDenom(denom)\
220 if ((denom == 0 || overflow) && save_release > 1920) {\
221 overflow = 1;\
222 return;\
223 }\
224 else if (denom == 0)\
225 return
226 #endif
227
228 #define ChkFloatDenom(denom)\
229 if (fabs(denom) <= DBL_MIN) {\
230 if (save_release > 1920) overflow = 1;\
231 return;\
232 }
233
234 #define LastSqr v[4].a
235
236 #if (_MSC_VER >= 700)
237 #pragma code_seg ("parser1_text") /* place following in an overlay */
238 #endif
239
240 /* ParseErrs() defines; all calls to ParseErrs(), or any variable which will
241 be used as the argument in a call to ParseErrs(), should use one of these
242 defines.
243 */
244
245 #define PE_NO_ERRORS_FOUND -1
246 #define PE_SHOULD_BE_ARGUMENT 0
247 #define PE_SHOULD_BE_OPERATOR 1
248 #define PE_NEED_A_MATCHING_OPEN_PARENS 2
249 #define PE_NEED_MORE_CLOSE_PARENS 3
250 #define PE_UNDEFINED_OPERATOR 4
251 #define PE_UNDEFINED_FUNCTION 5
252 #define PE_TABLE_OVERFLOW 6
253 #define PE_NO_MATCH_RIGHT_PAREN 7
254 #define PE_NO_LEFT_BRACKET_FIRST_LINE 8
255 #define PE_UNEXPECTED_EOF 9
256 #define PE_INVALID_SYM_USING_NOSYM 10
257 #define PE_FORMULA_TOO_LARGE 11
258 #define PE_INSUFFICIENT_MEM_FOR_TYPE_FORMULA 12
259 #define PE_COULD_NOT_OPEN_FILE_WHERE_FORMULA_LOCATED 13
260 #define PE_JUMP_NOT_FIRST 14
261 #define PE_NO_CHAR_AFTER_THIS_JUMP 15
262 #define PE_JUMP_NEEDS_BOOLEAN 16
263 #define PE_ENDIF_REQUIRED_AFTER_ELSE 17
264 #define PE_ENDIF_WITH_NO_IF 18
265 #define PE_MISPLACED_ELSE_OR_ELSEIF 19
266 #define PE_UNMATCHED_IF_IN_INIT_SECTION 20
267 #define PE_IF_WITH_NO_ENDIF 21
268 #define PE_ERROR_IN_PARSING_JUMP_STATEMENTS 22
269 #define PE_TOO_MANY_JUMPS 23
270 #define PE_FORMULA_NAME_TOO_LARGE 24
271 #define PE_ILLEGAL_ASSIGNMENT 25
272 #define PE_ILLEGAL_VAR_NAME 26
273 #define PE_INVALID_CONST 27
274 #define PE_ILLEGAL_CHAR 28
275 #define PE_NESTING_TO_DEEP 29
276 #define PE_UNMATCHED_MODULUS 30
277 #define PE_FUNC_USED_AS_VAR 31
278 #define PE_NO_NEG_AFTER_EXPONENT 32
279 #define PE_TOKEN_TOO_LONG 33
280 #define PE_SECOND_COLON 34
281 #define PE_INVALID_CALL_TO_PARSEERRS 35
282
283 static char far *ParseErrs(int which)
284 {
285 int lasterr;
286 static FCODE e0[] = {"Should be an Argument"};
287 static FCODE e1[] = {"Should be an Operator"};
288 static FCODE e2[] = {"')' needs a matching '('"};
289 static FCODE e3[] = {"Need more ')'"};
290 static FCODE e4[] = {"Undefined Operator"};
291 static FCODE e5[] = {"Undefined Function"};
292 static FCODE e6[] = {"Table overflow"};
293 static FCODE e7[] = {"Didn't find matching ')' in symmetry declaration"};
294 static FCODE e8[] = {"No '{' found on first line"};
295 static FCODE e9[] = {"Unexpected EOF!"};
296 static FCODE e10[] = {"Symmetry below is invalid, will use NOSYM"};
297 static FCODE e11[] = {"Formula is too large"};
298 static FCODE e12[] = {"Insufficient memory to run fractal type 'formula'"};
299 static FCODE e13[] = {"Could not open file where formula located"};
300 static FCODE e14[] = {"No characters may precede jump instruction"};
301 static FCODE e15[] = {"No characters may follow this jump instruction"};
302 static FCODE e16[] = {"Jump instruction missing required (boolean argument)"};
303 static FCODE e17[] = {"Next jump after \"else\" must be \"endif\""};
304 static FCODE e18[] = {"\"endif\" has no matching \"if\""};
305 static FCODE e19[] = {"Misplaced \"else\" or \"elseif()\""};
306 static FCODE e20[] = {"\"if()\" in initialization has no matching \"endif\""};
307 static FCODE e21[] = {"\"if()\" has no matching \"endif\""};
308 static FCODE e22[] = {"Error in parsing jump statements"};
309 static FCODE e23[] = {"Formula has too many jump commands"};
310 static FCODE e24[] = {"Formula name has too many characters"};
311 static FCODE e25[] = {"Only variables are allowed to left of assignment"};
312 static FCODE e26[] = {"Illegal variable name"};
313 static FCODE e27[] = {"Invalid constant expression"};
314 static FCODE e28[] = {"This character not supported by parser"};
315 static FCODE e29[] = {"Nesting of parentheses exceeds maximum depth"};
316 static FCODE e30[] = {"Unmatched modulus operator \"|\" in this expression"}; /*last one */
317 static FCODE e31[] = {"Can't use function name as variable"};
318 static FCODE e32[] = {"Negative exponent must be enclosed in parens"};
319 static FCODE e33[] = {"Variable or constant exceeds 32 character limit"};
320 static FCODE e34[] = {"Only one \":\" permitted in a formula"};
321 static FCODE e35[] = {"Invalid ParseErrs code"};
322 static PFCODE ErrStrings[] = { e0,e1,e2,e3,e4,e5,
323 e6,e7,e8,e9,e10,
324 e11,e12,e13,e14,e15,
325 e16,e17,e18,e19,e20,
326 e21,e22,e23,e24,e25,
327 e26, e27, e28, e29, e30,
328 e31, e32, e33, e34, e35
329 };
330 lasterr = sizeof(ErrStrings)/sizeof(ErrStrings[0]) - 1;
331 if(which > lasterr)
332 which = lasterr;
333 return((char far *)ErrStrings[which]);
334 }
335
336 #if (_MSC_VER >= 700)
337 #pragma code_seg () /* back to normal segment */
338 #endif
339
340 /* use the following when only float functions are implemented to
341 get MP math and Integer math */
342
343 #ifndef XFRACT
344 #define FUNCT
345 #ifdef FUNCT /* use function form save space - isn't really slower */
346
347 #if (_MSC_VER >= 700)
348 #pragma code_seg ("mpmath1_text") /* place following in an overlay */
349 #endif
350 static void mStkFunct(void (*fct)(void)) /* call lStk via dStk */
351 {
352 Arg1->d = MPC2cmplx(Arg1->m);
353 (*fct)();
354 Arg1->m = cmplx2MPC(Arg1->d);
355 }
356 #if (_MSC_VER >= 700)
357 #pragma code_seg () /* back to normal segment */
358 #endif
359
360 static void lStkFunct(void (*fct)(void)) /* call lStk via dStk */
361 {
362 double y;
363 /*
364 intermediate variable needed for safety because of
365 different size of double and long in Arg union
366 */
367 y = (double)Arg1->l.y / fg;
368 Arg1->d.x = (double)Arg1->l.x / fg;
369 Arg1->d.y = y;
370 (*fct)();
371 if(fabs(Arg1->d.x) < fgLimit && fabs(Arg1->d.y) < fgLimit) {
372 Arg1->l.x = (long)(Arg1->d.x * fg);
373 Arg1->l.y = (long)(Arg1->d.y * fg);
374 }
375 else
376 overflow = 1;
377 }
402 #endif
403
404 #endif
405
406 /* Random number code, MCP 11-21-91 */
407
408 unsigned long NewRandNum(void)
409 {
410 return(RandNum = ((RandNum << 15) + rand15()) ^ RandNum);
411 }
412
413 void lRandom(void)
414 {
415 v[7].a.l.x = NewRandNum() >> (32 - bitshift);
416 v[7].a.l.y = NewRandNum() >> (32 - bitshift);
417 }
418
419 void dRandom(void)
420 {
421 long x, y;
422
423 /* Use the same algorithm as for fixed math so that they will generate
424 the same fractals when the srand() function is used. */
425 x = NewRandNum() >> (32 - bitshift);
426 y = NewRandNum() >> (32 - bitshift);
427 v[7].a.d.x = ((double)x / (1L << bitshift));
428 v[7].a.d.y = ((double)y / (1L << bitshift));
429
430 }
431
432 #ifndef XFRACT
433 void mRandom(void)
434 {
435 long x, y;
436
437 /* Use the same algorithm as for fixed math so that they will generate
438 the same fractals when the srand() function is used. */
439 x = NewRandNum() >> (32 - bitshift);
440 y = NewRandNum() >> (32 - bitshift);
441 v[7].a.m.x = *fg2MP(x, bitshift);
442 v[7].a.m.y = *fg2MP(y, bitshift);
443 }
444 #endif
445
446 void SetRandFnct(void)
447 {
448 unsigned Seed;
449
450 if(!SetRandom)
451 RandNum = Arg1->l.x ^ Arg1->l.y;
452
453 Seed = (unsigned)RandNum ^ (unsigned)(RandNum >> 16);
454 srand(Seed);
455 SetRandom = 1;
456
457 /* Clear out the seed */
458 NewRandNum();
459 NewRandNum();
460 NewRandNum();
461 }
462
463 void RandomSeed(void)
464 {
465 time_t ltime;
466
467 /* Use the current time to randomize the random number sequence. */
468 time(<ime);
469 srand((unsigned int)ltime);
470
471 NewRandNum();
472 NewRandNum();
473 NewRandNum();
474 Randomized = 1;
475 }
476
477 #ifndef XFRACT
478 void lStkSRand(void)
479 {
480 SetRandFnct();
481 lRandom();
482 Arg1->l = v[7].a.l;
483 }
484 #endif
485
486 #ifndef XFRACT
487 void mStkSRand(void)
488 {
489 Arg1->l.x = Arg1->m.x.Mant ^ (long)Arg1->m.x.Exp;
490 Arg1->l.y = Arg1->m.y.Mant ^ (long)Arg1->m.y.Exp;
491 SetRandFnct();
492 mRandom();
493 Arg1->m = v[7].a.m;
494 }
495 #endif
496
497 void dStkSRand(void)
498 {
499 Arg1->l.x = (long)(Arg1->d.x * (1L << bitshift));
500 Arg1->l.y = (long)(Arg1->d.y * (1L << bitshift));
501 SetRandFnct();
502 dRandom();
503 Arg1->d = v[7].a.d;
504 }
505
506 void (*StkSRand)(void) = dStkSRand;
507
508
509 void dStkLodDup()
510 {
511 Arg1+=2;
512 Arg2+=2;
513 *Arg2 = *Arg1 = *Load[LodPtr];
514 LodPtr+=2;
515 }
516
517 void dStkLodSqr()
518 {
519 Arg1++;
520 Arg2++;
521 Arg1->d.y = Load[LodPtr]->d.x * Load[LodPtr]->d.y * 2.0;
522 Arg1->d.x = (Load[LodPtr]->d.x * Load[LodPtr]->d.x) - (Load[LodPtr]->d.y * Load[LodPtr]->d.y);
523 LodPtr++;
524 }
525
526 void dStkLodSqr2()
527 {
528 Arg1++;
529 Arg2++;
530 LastSqr.d.x = Load[LodPtr]->d.x * Load[LodPtr]->d.x;
531 LastSqr.d.y = Load[LodPtr]->d.y * Load[LodPtr]->d.y;
532 Arg1->d.y = Load[LodPtr]->d.x * Load[LodPtr]->d.y * 2.0;
533 Arg1->d.x = LastSqr.d.x - LastSqr.d.y;
534 LastSqr.d.x += LastSqr.d.y;
535 LastSqr.d.y = 0;
536 LodPtr++;
537 }
538
539 void dStkStoDup(){}
540 void dStkStoSqr(){}
541 void dStkStoSqr0(){}
542
543 void dStkLodDbl()
544 {
545 Arg1++;
546 Arg2++;
547 Arg1->d.x = Load[LodPtr]->d.x * 2.0;
548 Arg1->d.y = Load[LodPtr]->d.y * 2.0;
549 LodPtr++;
550 }
551
552 void dStkStoDbl(){}
553 void dStkReal2(){}
554
555 void dStkSqr0()
556 {
557 LastSqr.d.y = Arg1->d.y * Arg1->d.y; /* use LastSqr as temp storage */
558 Arg1->d.y = Arg1->d.x * Arg1->d.y * 2.0;
559 Arg1->d.x = Arg1->d.x * Arg1->d.x - LastSqr.d.y;
560 }
561
562
563 void dStkSqr3()
564 {
565 Arg1->d.x = Arg1->d.x * Arg1->d.x;
566 }
567
568
569
570 void dStkAbs(void) {
571 Arg1->d.x = fabs(Arg1->d.x);
572 Arg1->d.y = fabs(Arg1->d.y);
573 }
574
575 #ifndef XFRACT
576 void mStkAbs(void) {
577 if(Arg1->m.x.Exp < 0)
578 Arg1->m.x.Exp = -Arg1->m.x.Exp;
579 if(Arg1->m.y.Exp < 0)
580 Arg1->m.y.Exp = -Arg1->m.y.Exp;
581 }
582
583 void lStkAbs(void) {
584 Arg1->l.x = labs(Arg1->l.x);
585 Arg1->l.y = labs(Arg1->l.y);
586 }
587 #endif
588
589 void (*StkAbs)(void) = dStkAbs;
590
591 void dStkSqr(void) {
592 LastSqr.d.x = Arg1->d.x * Arg1->d.x;
593 LastSqr.d.y = Arg1->d.y * Arg1->d.y;
594 Arg1->d.y = Arg1->d.x * Arg1->d.y * 2.0;
595 Arg1->d.x = LastSqr.d.x - LastSqr.d.y;
596 LastSqr.d.x += LastSqr.d.y;
597 LastSqr.d.y = 0;
598 }
599
600 #ifndef XFRACT
601 void mStkSqr(void) {
602 LastSqr.m.x = *MPmul(Arg1->m.x, Arg1->m.x);
603 LastSqr.m.y = *MPmul(Arg1->m.y, Arg1->m.y);
604 Arg1->m.y = *MPmul(Arg1->m.x, Arg1->m.y);
605 Arg1->m.y.Exp++;
606 Arg1->m.x = *MPsub(LastSqr.m.x, LastSqr.m.y);
607 LastSqr.m.x = *MPadd(LastSqr.m.x, LastSqr.m.y);
608 LastSqr.m.y.Mant = (long)(LastSqr.m.y.Exp = 0);
609 }
610
611 void lStkSqr(void) {
612 LastSqr.l.x = multiply(Arg1->l.x, Arg1->l.x, bitshift);
613 LastSqr.l.y = multiply(Arg1->l.y, Arg1->l.y, bitshift);
614 Arg1->l.y = multiply(Arg1->l.x, Arg1->l.y, bitshift) << 1;
615 Arg1->l.x = LastSqr.l.x - LastSqr.l.y;
616 LastSqr.l.x += LastSqr.l.y;
617 LastSqr.l.y = 0L;
618 }
619 #endif
620
621 void (*StkSqr)(void) = dStkSqr;
622
623 void dStkAdd(void) {
624 Arg2->d.x += Arg1->d.x;
625 Arg2->d.y += Arg1->d.y;
626 Arg1--;
627 Arg2--;
628 }
629
630 #ifndef XFRACT
631
632 #if (_MSC_VER >= 700)
633 #pragma code_seg ("mpmath1_text") /* place following in an overlay */
634 #endif
635 void mStkAdd(void) {
636 Arg2->m = MPCadd(Arg2->m, Arg1->m);
637 Arg1--;
638 Arg2--;
639 }
640 #if (_MSC_VER >= 700)
641 #pragma code_seg () /* back to normal segment */
642 #endif
643
644 void lStkAdd(void) {
645 Arg2->l.x += Arg1->l.x;
646 Arg2->l.y += Arg1->l.y;
647 Arg1--;
648 Arg2--;
649 }
650 #endif
651
652 void (*StkAdd)(void) = dStkAdd;
653
654 void dStkSub(void) {
655 Arg2->d.x -= Arg1->d.x;
656 Arg2->d.y -= Arg1->d.y;
657 Arg1--;
658 Arg2--;
659 }
660
661 #ifndef XFRACT
662 #if (_MSC_VER >= 700)
663 #pragma code_seg ("mpmath1_text") /* place following in an overlay */
664 #endif
665 void mStkSub(void) {
666 Arg2->m = MPCsub(Arg2->m, Arg1->m);
667 Arg1--;
668 Arg2--;
669 }
670 #if (_MSC_VER >= 700)
671 #pragma code_seg () /* back to normal segment */
672 #endif
673
674 void lStkSub(void) {
675 Arg2->l.x -= Arg1->l.x;
676 Arg2->l.y -= Arg1->l.y;
677 Arg1--;
678 Arg2--;
679 }
680 #endif
681
682 void (*StkSub)(void) = dStkSub;
683
684 void dStkConj(void) {
685 Arg1->d.y = -Arg1->d.y;
686 }
687
688 #ifndef XFRACT
689 void mStkConj(void) {
690 Arg1->m.y.Exp ^= 0x8000;
691 }
692
693 void lStkConj(void) {
694 Arg1->l.y = -Arg1->l.y;
695 }
696 #endif
697
698 void (*StkConj)(void) = dStkConj;
699
700 void dStkFloor(void) {
701 Arg1->d.x = floor(Arg1->d.x);
702 Arg1->d.y = floor(Arg1->d.y);
703 }
704
705 #ifndef XFRACT
706 void mStkFloor(void) {
707 mStkFunct(dStkFloor); /* call lStk via dStk */
708 }
709
710 void lStkFloor(void) {
711 /*
712 * Kill fractional part. This operation truncates negative numbers
713 * toward negative infinity as desired.
714 */
715 Arg1->l.x = (Arg1->l.x) >> bitshift;
716 Arg1->l.y = (Arg1->l.y) >> bitshift;
717 Arg1->l.x = (Arg1->l.x) << bitshift;
718 Arg1->l.y = (Arg1->l.y) << bitshift;
719 }
720 #endif
721
722 void (*StkFloor)(void) = dStkFloor;
723
724 void dStkCeil(void) {
725 Arg1->d.x = ceil(Arg1->d.x);
726 Arg1->d.y = ceil(Arg1->d.y);
727 }
728
729 #ifndef XFRACT
730 void mStkCeil(void) {
731 mStkFunct(dStkCeil); /* call lStk via dStk */
732 }
733
734 void lStkCeil(void) {
735 /* the shift operation does the "floor" operation, so we
736 negate everything before the operation */
737 Arg1->l.x = (-Arg1->l.x) >> bitshift;
738 Arg1->l.y = (-Arg1->l.y) >> bitshift;
739 Arg1->l.x = -((Arg1->l.x) << bitshift);
740 Arg1->l.y = -((Arg1->l.y) << bitshift);
741 }
742 #endif
743
744 void (*StkCeil)(void) = dStkCeil;
745
746 void dStkTrunc(void) {
747 Arg1->d.x = (int)(Arg1->d.x);
748 Arg1->d.y = (int)(Arg1->d.y);
749 }
750
751 #ifndef XFRACT
752 void mStkTrunc(void) {
753 mStkFunct(dStkTrunc); /* call lStk via dStk */
754 }
755
756 void lStkTrunc(void) {
757 /* shifting and shifting back truncates positive numbers,
758 so we make the numbers positive */
759 int signx, signy;
760 signx = sign(Arg1->l.x);
761 signy = sign(Arg1->l.y);
762 Arg1->l.x = labs(Arg1->l.x);
763 Arg1->l.y = labs(Arg1->l.y);
764 Arg1->l.x = (Arg1->l.x) >> bitshift;
765 Arg1->l.y = (Arg1->l.y) >> bitshift;
766 Arg1->l.x = (Arg1->l.x) << bitshift;
767 Arg1->l.y = (Arg1->l.y) << bitshift;
768 Arg1->l.x = signx*Arg1->l.x;
769 Arg1->l.y = signy*Arg1->l.y;
770 }
771 #endif
772
773 void (*StkTrunc)(void) = dStkTrunc;
774
775 void dStkRound(void) {
776 Arg1->d.x = floor(Arg1->d.x+.5);
777 Arg1->d.y = floor(Arg1->d.y+.5);
778 }
779
780 #ifndef XFRACT
781 void mStkRound(void) {
782 mStkFunct(dStkRound); /* call lStk via dStk */
783 }
784
785 void lStkRound(void) {
786 /* Add .5 then truncate */
787 Arg1->l.x += (1L<<bitshiftless1);
788 Arg1->l.y += (1L<<bitshiftless1);
789 lStkFloor();
790 }
791 #endif
792
793 void (*StkRound)(void) = dStkRound;
794
795 void dStkZero(void) {
796 Arg1->d.y = Arg1->d.x = 0.0;
797 }
798
799 #ifndef XFRACT
800 void mStkZero(void) {
801 Arg1->m.x.Mant = Arg1->m.x.Exp = 0;
802 Arg1->m.y.Mant = Arg1->m.y.Exp = 0;
803 }
804
805 void lStkZero(void) {
806 Arg1->l.y = Arg1->l.x = 0;
807 }
808 #endif
809
810 void (*StkZero)(void) = dStkZero;
811
812 void dStkOne(void) {
813 Arg1->d.x = 1.0;
814 Arg1->d.y = 0.0;
815 }
816
817 #ifndef XFRACT
818 void mStkOne(void) {
819 Arg1->m = MPCone;
820 }
821
822 void lStkOne(void) {
823 Arg1->l.x = (long) fg;
824 Arg1->l.y = 0L;
825 }
826 #endif
827
828 void (*StkOne)(void) = dStkOne;
829
830
831 void dStkReal(void) {
832 Arg1->d.y = 0.0;
833 }
834
835 #ifndef XFRACT
836 void mStkReal(void) {
837 Arg1->m.y.Mant = (long)(Arg1->m.y.Exp = 0);
838 }
839
840 void lStkReal(void) {
841 Arg1->l.y = 0l;
842 }
843 #endif
844
845 void (*StkReal)(void) = dStkReal;
846
847 void dStkImag(void) {
848 Arg1->d.x = Arg1->d.y;
849 Arg1->d.y = 0.0;
850 }
851
852 #ifndef XFRACT
853 void mStkImag(void) {
854 Arg1->m.x = Arg1->m.y;
855 Arg1->m.y.Mant = (long)(Arg1->m.y.Exp = 0);
856 }
857
858 void lStkImag(void) {
859 Arg1->l.x = Arg1->l.y;
860 Arg1->l.y = 0l;
861 }
862 #endif
863
864 void (*StkImag)(void) = dStkImag;
865
866 void dStkNeg(void) {
867 Arg1->d.x = -Arg1->d.x;
868 Arg1->d.y = -Arg1->d.y;
869 }
870
871 #ifndef XFRACT
872 void mStkNeg(void) {
873 Arg1->m.x.Exp ^= 0x8000;
874 Arg1->m.y.Exp ^= 0x8000;
875 }
876
877 void lStkNeg(void) {
878 Arg1->l.x = -Arg1->l.x;
879 Arg1->l.y = -Arg1->l.y;
880 }
881 #endif
882
883 void (*StkNeg)(void) = dStkNeg;
884
885 void dStkMul(void) {
886 FPUcplxmul(&Arg2->d, &Arg1->d, &Arg2->d);
887 Arg1--;
888 Arg2--;
889 }
890
891 #ifndef XFRACT
892 #if (_MSC_VER >= 700)
893 #pragma code_seg ("mpmath1_text") /* place following in an overlay */
894 #endif
895 void mStkMul(void) {
896 Arg2->m = MPCmul(Arg2->m, Arg1->m);
897 Arg1--;
898 Arg2--;
899 }
900 #if (_MSC_VER >= 700)
901 #pragma code_seg () /* back to normal segment */
902 #endif
903
904 void lStkMul(void) {
905 long x, y;
906
907 x = multiply(Arg2->l.x, Arg1->l.x, bitshift) -
908 multiply(Arg2->l.y, Arg1->l.y, bitshift);
909 y = multiply(Arg2->l.y, Arg1->l.x, bitshift) +
910 multiply(Arg2->l.x, Arg1->l.y, bitshift);
911 Arg2->l.x = x;
912 Arg2->l.y = y;
913 Arg1--;
914 Arg2--;
915 }
916 #endif
917
918 void (*StkMul)(void) = dStkMul;
919
920 void dStkDiv(void) {
921 FPUcplxdiv(&Arg2->d, &Arg1->d, &Arg2->d);
922 Arg1--;
923 Arg2--;
924 }
925
926 #ifndef XFRACT
927 #if (_MSC_VER >= 700)
928 #pragma code_seg ("mpmath1_text") /* place following in an overlay */
929 #endif
930 void mStkDiv(void) {
931 Arg2->m = MPCdiv(Arg2->m, Arg1->m);
932 Arg1--;
933 Arg2--;
934 }
935 #if (_MSC_VER >= 700)
936 #pragma code_seg () /* back to normal segment */
937 #endif
938
939 void lStkDiv(void) {
940 long x, y, mod, x2, y2;
941
942 mod = multiply(Arg1->l.x, Arg1->l.x, bitshift) +
943 multiply(Arg1->l.y, Arg1->l.y, bitshift);
944 x = divide(Arg1->l.x, mod, bitshift);
945 y = -divide(Arg1->l.y, mod, bitshift);
946 /* pb 900617 changed next 4 lines to use x2,y2 instead of x,y */
947 x2 = multiply(Arg2->l.x, x, bitshift) - multiply(Arg2->l.y, y, bitshift);
948 y2 = multiply(Arg2->l.y, x, bitshift) + multiply(Arg2->l.x, y, bitshift);
949 Arg2->l.x = x2;
950 Arg2->l.y = y2;
951 Arg1--;
952 Arg2--;
953 }
954 #endif
955
956 void (*StkDiv)(void) = dStkDiv;
957
958 void dStkMod(void) {
959 Arg1->d.x = (Arg1->d.x * Arg1->d.x) + (Arg1->d.y * Arg1->d.y);
960 Arg1->d.y = 0.0;
961 }
962
963 #ifndef XFRACT
964 #if (_MSC_VER >= 700)
965 #pragma code_seg ("mpmath1_text") /* place following in an overlay */
966 #endif
967 void mStkMod(void) {
968 Arg1->m.x = MPCmod(Arg1->m);
969 Arg1->m.y.Mant = (long)(Arg1->m.y.Exp = 0);
970 }
971 #if (_MSC_VER >= 700)
972 #pragma code_seg () /* back to normal segment */
973 #endif
974
975 void lStkMod(void) {
976 /* Arg1->l.x = multiply(Arg2->l.x, Arg1->l.x, bitshift) + */
977 /* multiply(Arg2->l.y, Arg1->l.y, bitshift); */
978 /*** I don't understand how this ever worked correctly! JCO 12/31/94 ***/
979 Arg1->l.x = multiply(Arg1->l.x, Arg1->l.x, bitshift) +
980 multiply(Arg1->l.y, Arg1->l.y, bitshift);
981 if(Arg1->l.x < 0)
982 overflow = 1;
983 Arg1->l.y = 0L;
984 }
985
986 void lStkModOld(void) {
987 Arg1->l.x = multiply(Arg2->l.x, Arg1->l.x, bitshift) +
988 multiply(Arg2->l.y, Arg1->l.y, bitshift);
989 if(Arg1->l.x < 0)
990 overflow = 1;
991 Arg1->l.y = 0L;
992 }
993 #endif
994
995 void (*StkMod)(void) = dStkMod;
996
997 void StkSto(void) {
998 *Store[StoPtr++] = *Arg1;
999 }
1000
1001 void (*PtrStkSto)(void) = StkSto;
1002
1003 void StkLod(void) {
1004 Arg1++;
1005 Arg2++;
1006 *Arg1 = *Load[LodPtr++];
1007 }
1008
1009 void (*PtrStkLod)(void) = StkLod;
1010
1011 void StkClr(void) {
1012 s[0] = *Arg1;
1013 Arg1 = &s[0];
1014 Arg2 = Arg1;
1015 Arg2--;
1016 }
1017
1018 void (*PtrStkClr)(void) = StkClr;
1019
1020 /* MCP 4-9-91, Added Flip() */
1021
1022 void dStkFlip(void) {
1023 double t;
1024
1025 t = Arg1->d.x;
1026 Arg1->d.x = Arg1->d.y;
1027 Arg1->d.y = t;
1028 }
1029
1030 #ifndef XFRACT
1031 void mStkFlip(void) {
1032 struct MP t;
1033
1034 t = Arg1->m.x;
1035 Arg1->m.x = Arg1->m.y;
1036 Arg1->m.y = t;
1037 }
1038
1039 void lStkFlip(void) {
1040 long t;
1041
1042 t = Arg1->l.x;
1043 Arg1->l.x = Arg1->l.y;
1044 Arg1->l.y = t;
1045 }
1046 #endif
1047
1048 void (*StkFlip)(void) = dStkFlip;
1049
1050 void dStkSin(void) {
1051 double sinx, cosx, sinhy, coshy;
1052
1053 FPUsincos(&Arg1->d.x, &sinx, &cosx);
1054 FPUsinhcosh(&Arg1->d.y, &sinhy, &coshy);
1055 Arg1->d.x = sinx*coshy;
1056 Arg1->d.y = cosx*sinhy;
1057 }
1058
1059 #ifndef XFRACT
1060 void mStkSin(void) {
1061 mStkFunct(dStkSin); /* call lStk via dStk */
1062 }
1063
1064 void lStkSin(void) {
1065 long x, y, sinx, cosx, sinhy, coshy;
1066 x = Arg1->l.x >> Delta16;
1067 y = Arg1->l.y >> Delta16;
1068 SinCos086(x, &sinx, &cosx);
1069 SinhCosh086(y, &sinhy, &coshy);
1070 Arg1->l.x = multiply(sinx, coshy, ShiftBack); /* TIW 06-18-90 */
1071 Arg1->l.y = multiply(cosx, sinhy, ShiftBack); /* TIW 06-18-90 */
1072 }
1073 #endif
1074
1075 void (*StkSin)(void) = dStkSin;
1076
1077 /* The following functions are supported by both the parser and for fn
1078 variable replacement. TIW 04-22-91 */
1079
1080 void dStkTan(void) {
1081 double sinx, cosx, sinhy, coshy, denom;
1082 Arg1->d.x *= 2;
1083 Arg1->d.y *= 2;
1084 FPUsincos(&Arg1->d.x, &sinx, &cosx);
1085 FPUsinhcosh(&Arg1->d.y, &sinhy, &coshy);
1086 denom = cosx + coshy;
1087 ChkFloatDenom(denom);
1088 Arg1->d.x = sinx/denom;
1089 Arg1->d.y = sinhy/denom;
1090 }
1091
1092 #ifndef XFRACT
1093 void mStkTan(void) {
1094 mStkFunct(dStkTan); /* call lStk via dStk */
1095 }
1096
1097 void lStkTan(void) {
1098 long x, y, sinx, cosx, sinhy, coshy, denom;
1099 x = Arg1->l.x >> Delta16;
1100 x = x << 1;
1101 y = Arg1->l.y >> Delta16;
1102 y = y << 1;
1103 SinCos086(x, &sinx, &cosx);
1104 SinhCosh086(y, &sinhy, &coshy);
1105 denom = cosx + coshy;
1106 ChkLongDenom(denom);
1107 Arg1->l.x = divide(sinx,denom,bitshift);
1108 Arg1->l.y = divide(sinhy,denom,bitshift);
1109 }
1110 #endif
1111
1112 void (*StkTan)(void) = dStkTan;
1113
1114 void dStkTanh(void) {
1115 double siny, cosy, sinhx, coshx, denom;
1116 Arg1->d.x *= 2;
1117 Arg1->d.y *= 2;
1118 FPUsincos(&Arg1->d.y, &siny, &cosy);
1119 FPUsinhcosh(&Arg1->d.x, &sinhx, &coshx);
1120 denom = coshx + cosy;
1121 ChkFloatDenom(denom);
1122 Arg1->d.x = sinhx/denom;
1123 Arg1->d.y = siny/denom;
1124 }
1125
1126 #ifndef XFRACT
1127 void mStkTanh(void) {
1128 mStkFunct(dStkTanh); /* call lStk via dStk */
1129 }
1130
1131 void lStkTanh(void) {
1132 long x, y, siny, cosy, sinhx, coshx, denom;
1133 x = Arg1->l.x >> Delta16;
1134 x = x << 1;
1135 y = Arg1->l.y >> Delta16;
1136 y = y << 1;
1137 SinCos086(y, &siny, &cosy);
1138 SinhCosh086(x, &sinhx, &coshx);
1139 denom = coshx + cosy;
1140 ChkLongDenom(denom);
1141 Arg1->l.x = divide(sinhx,denom,bitshift);
1142 Arg1->l.y = divide(siny,denom,bitshift);
1143 }
1144 #endif
1145
1146 void (*StkTanh)(void) = dStkTanh;
1147
1148 void dStkCoTan(void) {
1149 double sinx, cosx, sinhy, coshy, denom;
1150 Arg1->d.x *= 2;
1151 Arg1->d.y *= 2;
1152 FPUsincos(&Arg1->d.x, &sinx, &cosx);
1153 FPUsinhcosh(&Arg1->d.y, &sinhy, &coshy);
1154 denom = coshy - cosx;
1155 ChkFloatDenom(denom);
1156 Arg1->d.x = sinx/denom;
1157 Arg1->d.y = -sinhy/denom;
1158 }
1159
1160 #ifndef XFRACT
1161 void mStkCoTan(void) {
1162 mStkFunct(dStkCoTan); /* call lStk via dStk */
1163 }
1164
1165 void lStkCoTan(void) {
1166 long x, y, sinx, cosx, sinhy, coshy, denom;
1167 x = Arg1->l.x >> Delta16;
1168 x = x << 1;
1169 y = Arg1->l.y >> Delta16;
1170 y = y << 1;
1171 SinCos086(x, &sinx, &cosx);
1172 SinhCosh086(y, &sinhy, &coshy);
1173 denom = coshy - cosx;
1174 ChkLongDenom(denom);
1175 Arg1->l.x = divide(sinx,denom,bitshift);
1176 Arg1->l.y = -divide(sinhy,denom,bitshift);
1177 }
1178 #endif
1179
1180 void (*StkCoTan)(void) = dStkCoTan;
1181
1182 void dStkCoTanh(void) {
1183 double siny, cosy, sinhx, coshx, denom;
1184 Arg1->d.x *= 2;
1185 Arg1->d.y *= 2;
1186 FPUsincos(&Arg1->d.y, &siny, &cosy);
1187 FPUsinhcosh(&Arg1->d.x, &sinhx, &coshx);
1188 denom = coshx - cosy;
1189 ChkFloatDenom(denom);
1190 Arg1->d.x = sinhx/denom;
1191 Arg1->d.y = -siny/denom;
1192 }
1193
1194 #ifndef XFRACT
1195 void mStkCoTanh(void) {
1196 mStkFunct(dStkCoTanh); /* call lStk via dStk */
1197 }
1198
1199 void lStkCoTanh(void) {
1200 long x, y, siny, cosy, sinhx, coshx, denom;
1201 x = Arg1->l.x >> Delta16;
1202 x = x << 1;
1203 y = Arg1->l.y >> Delta16;
1204 y = y << 1;
1205 SinCos086(y, &siny, &cosy);
1206 SinhCosh086(x, &sinhx, &coshx);
1207 denom = coshx - cosy;
1208 ChkLongDenom(denom);
1209 Arg1->l.x = divide(sinhx,denom,bitshift);
1210 Arg1->l.y = -divide(siny,denom,bitshift);
1211 }
1212 #endif
1213
1214 void (*StkCoTanh)(void) = dStkCoTanh;
1215
1216 /* The following functions are not directly used by the parser - support
1217 for the parser was not provided because the existing parser language
1218 represents these quite easily. They are used for fn variable support
1219 in miscres.c but are placed here because they follow the pattern of
1220 the other parser functions. TIW 04-22-91 */
1221
1222 void dStkRecip(void) {
1223 double mod;
1224 mod =Arg1->d.x * Arg1->d.x + Arg1->d.y * Arg1->d.y;
1225 ChkFloatDenom(mod);
1226 Arg1->d.x = Arg1->d.x/mod;
1227 Arg1->d.y = -Arg1->d.y/mod;
1228 }
1229
1230 #ifndef XFRACT
1231 void mStkRecip(void) {
1232 struct MP mod;
1233 mod = *MPadd(*MPmul(Arg1->m.x, Arg1->m.x),*MPmul(Arg1->m.y, Arg1->m.y));
1234 if(mod.Mant == 0L) {
1235 overflow = 1;
1236 return;
1237 }
1238 Arg1->m.x = *MPdiv(Arg1->m.x,mod);
1239 Arg1->m.y = *MPdiv(Arg1->m.y,mod);
1240 Arg1->m.y.Exp ^= 0x8000;
1241 }
1242
1243 void lStkRecip(void) {
1244 long mod;
1245 mod = multiply(Arg1->l.x,Arg1->l.x,bitshift)
1246 + multiply(Arg1->l.y,Arg1->l.y,bitshift);
1247 if(save_release > 1920) {
1248 ChkLongDenom(mod);
1249 } else if(mod<=0L) return;
1250 Arg1->l.x = divide(Arg1->l.x,mod,bitshift);
1251 Arg1->l.y = -divide(Arg1->l.y,mod,bitshift);
1252 }
1253 #endif
1254
1255 void StkIdent(void) { /* do nothing - the function Z */
1256 }
1257 /* End TIW 04-22-91 */
1258
1259 void dStkSinh(void) {
1260 double siny, cosy, sinhx, coshx;
1261
1262 FPUsincos(&Arg1->d.y, &siny, &cosy);
1263 FPUsinhcosh(&Arg1->d.x, &sinhx, &coshx);
1264 Arg1->d.x = sinhx*cosy;
1265 Arg1->d.y = coshx*siny;
1266 }
1267
1268 #ifndef XFRACT
1269 void mStkSinh(void) {
1270 mStkFunct(dStkSinh); /* call lStk via dStk */
1271 }
1272
1273 void lStkSinh(void) {
1274 long x, y, sinhx, coshx, siny, cosy;
1275
1276 x = Arg1->l.x >> Delta16;
1277 y = Arg1->l.y >> Delta16;
1278 SinCos086(y, &siny, &cosy);
1279 SinhCosh086(x, &sinhx, &coshx);
1280 Arg1->l.x = multiply(cosy, sinhx, ShiftBack); /* TIW 06-18-90 */
1281 Arg1->l.y = multiply(siny, coshx, ShiftBack); /* TIW 06-18-90 */
1282 }
1283 #endif
1284
1285 void (*StkSinh)(void) = dStkSinh;
1286
1287 void dStkCos(void) {
1288 double sinx, cosx, sinhy, coshy;
1289
1290 FPUsincos(&Arg1->d.x, &sinx, &cosx);
1291 FPUsinhcosh(&Arg1->d.y, &sinhy, &coshy);
1292 Arg1->d.x = cosx*coshy;
1293 Arg1->d.y = -sinx*sinhy; /* TIW 04-25-91 sign */
1294 }
1295
1296 #ifndef XFRACT
1297 void mStkCos(void) {
1298 mStkFunct(dStkCos); /* call lStk via dStk */
1299 }
1300
1301 void lStkCos(void) {
1302 long x, y, sinx, cosx, sinhy, coshy;
1303
1304 x = Arg1->l.x >> Delta16;
1305 y = Arg1->l.y >> Delta16;
1306 SinCos086(x, &sinx, &cosx);
1307 SinhCosh086(y, &sinhy, &coshy);
1308 Arg1->l.x = multiply(cosx, coshy, ShiftBack); /* TIW 06-18-90 */
1309 Arg1->l.y = -multiply(sinx, sinhy, ShiftBack); /* TIW 04-25-91 sign */
1310 }
1311 #endif
1312
1313 void (*StkCos)(void) = dStkCos;
1314
1315 /* Bogus version of cos, to replicate bug which was in regular cos till v16: */
1316
1317 void dStkCosXX(void) {
1318 dStkCos();
1319 Arg1->d.y = -Arg1->d.y;
1320 }
1321
1322 #ifndef XFRACT
1323 void mStkCosXX(void) {
1324 mStkFunct(dStkCosXX); /* call lStk via dStk */
1325 }
1326
1327 void lStkCosXX(void) {
1328 lStkCos();
1329 Arg1->l.y = -Arg1->l.y;
1330 }
1331 #endif
1332
1333 void (*StkCosXX)(void) = dStkCosXX;
1334
1335 void dStkCosh(void) {
1336 double siny, cosy, sinhx, coshx;
1337
1338 FPUsincos(&Arg1->d.y, &siny, &cosy);
1339 FPUsinhcosh(&Arg1->d.x, &sinhx, &coshx);
1340 Arg1->d.x = coshx*cosy;
1341 Arg1->d.y = sinhx*siny;
1342 }
1343
1344 #ifndef XFRACT
1345 void mStkCosh(void) {
1346 mStkFunct(dStkCosh); /* call lStk via dStk */
1347 }
1348
1349 void lStkCosh(void) {
1350 long x, y, sinhx, coshx, siny, cosy;
1351
1352 x = Arg1->l.x >> Delta16;
1353 y = Arg1->l.y >> Delta16;
1354 SinCos086(y, &siny, &cosy);
1355 SinhCosh086(x, &sinhx, &coshx);
1356 Arg1->l.x = multiply(cosy, coshx, ShiftBack); /* TIW 06-18-90 */
1357 Arg1->l.y = multiply(siny, sinhx, ShiftBack); /* TIW 06-18-90 */
1358 }
1359 #endif
1360
1361 void (*StkCosh)(void) = dStkCosh;
1362
1363 /* TIW added arc functions here 11-25-94 */
1364
1365 void dStkASin(void) {
1366 Arcsinz(Arg1->d, &(Arg1->d));
1367 }
1368
1369 #ifndef XFRACT
1370 void mStkASin(void) {
1371 mStkFunct(dStkASin);
1372 }
1373
1374 void lStkASin(void) {
1375 lStkFunct(dStkASin);
1376 }
1377 #endif
1378
1379 void (*StkASin)(void) = dStkASin;
1380
1381 void dStkASinh(void) {
1382 Arcsinhz(Arg1->d, &(Arg1->d));
1383 }
1384
1385 #ifndef XFRACT
1386 void mStkASinh(void) {
1387 mStkFunct(dStkASinh);
1388 }
1389
1390 void lStkASinh(void) {
1391 lStkFunct(dStkASinh);
1392 }
1393 #endif
1394
1395 void (*StkASinh)(void) = dStkASinh;
1396
1397 void dStkACos(void) {
1398 Arccosz(Arg1->d, &(Arg1->d));
1399 }
1400
1401 #ifndef XFRACT
1402 void mStkACos(void) {
1403 mStkFunct(dStkACos);
1404 }
1405
1406 void lStkACos(void) {
1407 lStkFunct(dStkACos);
1408 }
1409 #endif
1410
1411 void (*StkACos)(void) = dStkACos;
1412
1413 void dStkACosh(void) {
1414 Arccoshz(Arg1->d, &(Arg1->d));
1415 }
1416
1417 #ifndef XFRACT
1418 void mStkACosh(void) {
1419 mStkFunct(dStkACosh);
1420 }
1421
1422 void lStkACosh(void) {
1423 lStkFunct(dStkACosh);
1424 }
1425 #endif
1426
1427 void (*StkACosh)(void) = dStkACosh;
1428
1429 void dStkATan(void) {
1430 Arctanz(Arg1->d, &(Arg1->d));
1431 }
1432
1433 #ifndef XFRACT
1434 void mStkATan(void) {
1435 mStkFunct(dStkATan);
1436 }
1437
1438 void lStkATan(void) {
1439 lStkFunct(dStkATan);
1440 }
1441 #endif
1442
1443 void (*StkATan)(void) = dStkATan;
1444
1445 void dStkATanh(void) {
1446 Arctanhz(Arg1->d, &(Arg1->d));
1447 }
1448
1449 #ifndef XFRACT
1450 void mStkATanh(void) {
1451 mStkFunct(dStkATanh);
1452 }
1453
1454 void lStkATanh(void) {
1455 lStkFunct(dStkATanh);
1456 }
1457 #endif
1458
1459 void (*StkATanh)(void) = dStkATanh;
1460
1461 void dStkSqrt(void) {
1462 Arg1->d = ComplexSqrtFloat(Arg1->d.x, Arg1->d.y);
1463 }
1464
1465 #ifndef XFRACT
1466 void mStkSqrt(void) {
1467 mStkFunct(dStkSqrt);
1468 }
1469
1470 void lStkSqrt(void) {
1471 /* lStkFunct(dStkSqrt); */
1472 Arg1->l = ComplexSqrtLong(Arg1->l.x, Arg1->l.y);
1473 }
1474 #endif
1475
1476 void (*StkSqrt)(void) = dStkSqrt;
1477
1478 void dStkCAbs(void) {
1479 Arg1->d.x = sqrt(sqr(Arg1->d.x)+sqr(Arg1->d.y));
1480 Arg1->d.y = 0.0;
1481 }
1482
1483 #ifndef XFRACT
1484 void mStkCAbs(void) {
1485 mStkFunct(dStkCAbs);
1486 }
1487
1488 void lStkCAbs(void) {
1489 lStkFunct(dStkCAbs);
1490 }
1491 #endif
1492
1493 void (*StkCAbs)(void) = dStkCAbs;
1494
1495 /* TIW end arc functions 11-25-94 */
1496
1497 void dStkLT(void) {
1498 Arg2->d.x = (double)(Arg2->d.x < Arg1->d.x);
1499 Arg2->d.y = 0.0;
1500 Arg1--;
1501 Arg2--;
1502 }
1503
1504 #ifndef XFRACT
1505 void mStkLT(void) {
1506 Arg2->m.x = *fg2MP((long)(MPcmp(Arg2->m.x, Arg1->m.x) == -1), 0);
1507 Arg2->m.y.Mant = (long)(Arg2->m.y.Exp = 0);
1508 Arg1--;
1509 Arg2--;
1510 }
1511
1512 void lStkLT(void) {
1513 Arg2->l.x = (long)(Arg2->l.x < Arg1->l.x) << bitshift; /* JCO 12/26/94 */
1514 Arg2->l.y = 0l;
1515 Arg1--;
1516 Arg2--;
1517 }
1518 #endif
1519
1520 void (*StkLT)(void) = dStkLT;
1521
1522 void dStkGT(void) {
1523 Arg2->d.x = (double)(Arg2->d.x > Arg1->d.x);
1524 Arg2->d.y = 0.0;
1525 Arg1--;
1526 Arg2--;
1527 }
1528
1529 #ifndef XFRACT
1530 void mStkGT(void) {
1531 Arg2->m.x = *fg2MP((long)(MPcmp(Arg2->m.x, Arg1->m.x) == 1), 0);
1532 Arg2->m.y.Mant = (long)(Arg2->m.y.Exp = 0);
1533 Arg1--;
1534 Arg2--;
1535 }
1536
1537 void lStkGT(void) {
1538 Arg2->l.x = (long)(Arg2->l.x > Arg1->l.x) << bitshift; /* JCO 12/26/94 */
1539 Arg2->l.y = 0l;
1540 Arg1--;
1541 Arg2--;
1542 }
1543 #endif
1544
1545 void (*StkGT)(void) = dStkGT;
1546
1547 void dStkLTE(void) {
1548 Arg2->d.x = (double)(Arg2->d.x <= Arg1->d.x);
1549 Arg2->d.y = 0.0;
1550 Arg1--;
1551 Arg2--;
1552 }
1553
1554 #ifndef XFRACT
1555 void mStkLTE(void) {
1556 int comp;
1557
1558 comp = MPcmp(Arg2->m.x, Arg1->m.x);
1559 Arg2->m.x = *fg2MP((long)(comp == -1 || comp == 0), 0);
1560 Arg2->m.y.Mant = (long)(Arg2->m.y.Exp = 0);
1561 Arg1--;
1562 Arg2--;
1563 }
1564
1565 void lStkLTE(void) {
1566 Arg2->l.x = (long)(Arg2->l.x <= Arg1->l.x) << bitshift; /* JCO 12/26/94 */
1567 Arg2->l.y = 0l;
1568 Arg1--;
1569 Arg2--;
1570 }
1571 #endif
1572
1573 void (*StkLTE)(void) = dStkLTE;
1574
1575 void dStkGTE(void) {
1576 Arg2->d.x = (double)(Arg2->d.x >= Arg1->d.x);
1577 Arg2->d.y = 0.0;
1578 Arg1--;
1579 Arg2--;
1580 }
1581
1582 #ifndef XFRACT
1583 void mStkGTE(void) {
1584 int comp;
1585
1586 comp = MPcmp(Arg2->m.x, Arg1->m.x);
1587 Arg2->m.x = *fg2MP((long)(comp == 1 || comp == 0), 0);
1588 Arg2->m.y.Mant = (long)(Arg2->m.y.Exp = 0);
1589 Arg1--;
1590 Arg2--;
1591 }
1592
1593 void lStkGTE(void) {
1594 Arg2->l.x = (long)(Arg2->l.x >= Arg1->l.x) << bitshift; /* JCO 12/26/94 */
1595 Arg2->l.y = 0l;
1596 Arg1--;
1597 Arg2--;
1598 }
1599 #endif
1600
1601 void (*StkGTE)(void) = dStkGTE;
1602
1603 void dStkEQ(void) {
1604 Arg2->d.x = (double)(Arg2->d.x == Arg1->d.x);
1605 Arg2->d.y = 0.0;
1606 Arg1--;
1607 Arg2--;
1608 }
1609
1610 #ifndef XFRACT
1611 void mStkEQ(void) {
1612 int comp;
1613
1614 comp = MPcmp(Arg2->m.x, Arg1->m.x);
1615 Arg2->m.x = *fg2MP((long)(comp == 0), 0);
1616 Arg2->m.y.Mant = (long)(Arg2->m.y.Exp = 0);
1617 Arg1--;
1618 Arg2--;
1619 }
1620
1621 void lStkEQ(void) {
1622 Arg2->l.x = (long)(Arg2->l.x == Arg1->l.x) << bitshift; /* JCO 12/26/94 */
1623 Arg2->l.y = 0l;
1624 Arg1--;
1625 Arg2--;
1626 }
1627 #endif
1628
1629 void (*StkEQ)(void) = dStkEQ;
1630
1631 void dStkNE(void) {
1632 Arg2->d.x = (double)(Arg2->d.x != Arg1->d.x);
1633 Arg2->d.y = 0.0;
1634 Arg1--;
1635 Arg2--;
1636 }
1637
1638 #ifndef XFRACT
1639 void mStkNE(void) {
1640 int comp;
1641
1642 comp = MPcmp(Arg2->m.x, Arg1->m.x);
1643 Arg2->m.x = *fg2MP((long)(comp != 0), 0);
1644 Arg2->m.y.Mant = (long)(Arg2->m.y.Exp = 0);
1645 Arg1--;
1646 Arg2--;
1647 }
1648
1649 void lStkNE(void) {
1650 Arg2->l.x = (long)(Arg2->l.x != Arg1->l.x) << bitshift; /* JCO 12/26/94 */
1651 Arg2->l.y = 0l;
1652 Arg1--;
1653 Arg2--;
1654 }
1655 #endif
1656
1657 void (*StkNE)(void) = dStkNE;
1658
1659 void dStkOR(void) {
1660 Arg2->d.x = (double)(Arg2->d.x || Arg1->d.x);
1661 Arg2->d.y = 0.0;
1662 Arg1--;
1663 Arg2--;
1664 }
1665
1666 #ifndef XFRACT
1667 void mStkOR(void) {
1668 Arg2->m.x = *fg2MP((long)(Arg2->m.x.Mant || Arg1->m.x.Mant), 0);
1669 Arg2->m.y.Mant = (long)(Arg2->m.y.Exp = 0);
1670 Arg1--;
1671 Arg2--;
1672 }
1673
1674 void lStkOR(void) {
1675 Arg2->l.x = (long)(Arg2->l.x || Arg1->l.x) << bitshift; /* JCO 12/26/94 */
1676 Arg2->l.y = 0l;
1677 Arg1--;
1678 Arg2--;
1679 }
1680 #endif
1681
1682 void (*StkOR)(void) = dStkOR;
1683
1684 void dStkAND(void) {
1685 Arg2->d.x = (double)(Arg2->d.x && Arg1->d.x);
1686 Arg2->d.y = 0.0;
1687 Arg1--;
1688 Arg2--;
1689 }
1690
1691 #ifndef XFRACT
1692 void mStkAND(void) {
1693 Arg2->m.x = *fg2MP((long)(Arg2->m.x.Mant && Arg1->m.x.Mant), 0);
1694 Arg2->m.y.Mant = (long)(Arg2->m.y.Exp = 0);
1695 Arg1--;
1696 Arg2--;
1697 }
1698
1699 void lStkAND(void) {
1700 Arg2->l.x = (long)(Arg2->l.x && Arg1->l.x) << bitshift; /* JCO 12/26/94 */
1701 Arg2->l.y = 0l;
1702 Arg1--;
1703 Arg2--;
1704 }
1705 #endif
1706
1707 void (*StkAND)(void) = dStkAND;
1708 void dStkLog(void) {
1709 FPUcplxlog(&Arg1->d, &Arg1->d);
1710 }
1711
1712 #ifndef XFRACT
1713 void mStkLog(void) {
1714 mStkFunct(dStkLog); /* call lStk via dStk */
1715 }
1716
1717 void lStkLog(void) {
1718 lStkFunct(dStkLog);
1719 }
1720 #endif
1721
1722 void (*StkLog)(void) = dStkLog;
1723
1724 void FPUcplxexp(_CMPLX *x, _CMPLX *z) {
1725 double e2x, siny, cosy;
1726
1727 if(fpu >= 387)
1728 FPUcplxexp387(x, z);
1729 else {
1730 e2x = exp(x->x);
1731 FPUsincos(&x->y, &siny, &cosy);
1732 z->x = e2x * cosy;
1733 z->y = e2x * siny;
1734 }
1735 }
1736
1737 void dStkExp(void) {
1738 FPUcplxexp(&Arg1->d, &Arg1->d);
1739 }
1740
1741 #ifndef XFRACT
1742 void mStkExp(void) {
1743 mStkFunct(dStkExp); /* call lStk via dStk */
1744 }
1745
1746 void lStkExp(void) {
1747 lStkFunct(dStkExp);
1748 }
1749 #endif
1750
1751 void (*StkExp)(void) = dStkExp;
1752
1753 void dStkPwr(void) {
1754 Arg2->d = ComplexPower(Arg2->d, Arg1->d);
1755 Arg1--;
1756 Arg2--;
1757 }
1758
1759 #ifndef XFRACT
1760 #if (_MSC_VER >= 700)
1761 #pragma code_seg ("mpmath1_text") /* place following in an overlay */
1762 #endif
1763 void mStkPwr(void) {
1764 _CMPLX x, y;
1765
1766 x = MPC2cmplx(Arg2->m);
1767 y = MPC2cmplx(Arg1->m);
1768 x = ComplexPower(x, y);
1769 Arg2->m = cmplx2MPC(x);
1770 Arg1--;
1771 Arg2--;
1772 }
1773 #if (_MSC_VER >= 700)
1774 #pragma code_seg () /* back to normal segment */
1775 #endif
1776
1777 void lStkPwr(void) {
1778 _CMPLX x, y;
1779
1780 x.x = (double)Arg2->l.x / fg;
1781 x.y = (double)Arg2->l.y / fg;
1782 y.x = (double)Arg1->l.x / fg;
1783 y.y = (double)Arg1->l.y / fg;
1784 x = ComplexPower(x, y);
1785 if(fabs(x.x) < fgLimit && fabs(x.y) < fgLimit) {
1786 Arg2->l.x = (long)(x.x * fg);
1787 Arg2->l.y = (long)(x.y * fg);
1788 }
1789 else
1790 overflow = 1;
1791 Arg1--;
1792 Arg2--;
1793 }
1794 #endif
1795
1796 void (*StkPwr)(void) = dStkPwr;
1797
1798 void EndInit(void) {
1799 LastInitOp = OpPtr;
1800 InitJumpIndex = jump_index;
1801 }
1802
1803 void (*PtrEndInit)(void) = EndInit;
1804
1805 void StkJump (void)
1806 {
1807 OpPtr = jump_control[jump_index].ptrs.JumpOpPtr;
1808 LodPtr = jump_control[jump_index].ptrs.JumpLodPtr;
1809 StoPtr = jump_control[jump_index].ptrs.JumpStoPtr;
1810 jump_index = jump_control[jump_index].DestJumpIndex;
1811 }
1812
1813 void dStkJumpOnFalse (void)
1814 {
1815 if(Arg1->d.x == 0)
1816 StkJump();
1817 else
1818 jump_index++;
1819 }
1820
1821 void mStkJumpOnFalse (void)
1822 {
1823 #ifndef XFRACT
1824 if(Arg1->m.x.Mant == 0)
1825 StkJump();
1826 else
1827 jump_index++;
1828 #endif
1829 }
1830
1831 void lStkJumpOnFalse (void)
1832 {
1833 if(Arg1->l.x == 0)
1834 StkJump();
1835 else
1836 jump_index++;
1837 }
1838
1839 void (*StkJumpOnFalse)(void) = dStkJumpOnFalse;
1840
1841 void dStkJumpOnTrue (void)
1842 {
1843 if(Arg1->d.x)
1844 StkJump();
1845 else
1846 jump_index++;
1847 }
1848
1849 void mStkJumpOnTrue (void)
1850 {
1851 #ifndef XFRACT
1852 if(Arg1->m.x.Mant)
1853 StkJump();
1854 else
1855 jump_index++;
1856 #endif
1857 }
1858
1859 void lStkJumpOnTrue (void)
1860 {
1861 if(Arg1->l.x)
1862 StkJump();
1863 else
1864 jump_index++;
1865 }
1866
1867 void (*StkJumpOnTrue)(void) = dStkJumpOnTrue;
1868
1869 void StkJumpLabel (void)
1870 {
1871 jump_index++;
1872 }
1873
1874
1875 #if (_MSC_VER >= 700)
1876 #pragma code_seg ("parser1_text") /* place following in an overlay */
1877 #endif
1878
1879 unsigned SkipWhiteSpace(char *Str) {
1880 unsigned n, Done;
1881
1882 for(Done = n = 0; !Done; n++) {
1883 switch(Str[n]) {
1884 case ' ':
1885 case '\t':
1886 case '\n':
1887 case '\r':
1888 break;
1889 default:
1890 Done = 1;
1891 }
1892 }
1893 return(n - 1);
1894 }
1895
1896 /* detect if constant is part of a (a,b) construct */
1897 static int isconst_pair(char *Str) {
1898 int n,j;
1899 int answer = 0;
1900 /* skip past first number */
1901 for(n = 0; isdigit(Str[n]) || Str[n] == '.'; n++);
1902 if(Str[n] == ',') {
1903 j = n + SkipWhiteSpace(&Str[n+1]) + 1;
1904 if(isdigit(Str[j])
1905 || (Str[j] == '-' && (isdigit(Str[j+1]) || Str[j+1] == '.'))
1906 || Str[j] == '.') {
1907 answer = 1;
1908 }
1909 }
1910 return(answer);
1911 }
1912
1913 struct ConstArg far *isconst(char *Str, int Len) {
1914 _CMPLX z;
1915 unsigned n, j;
1916 /* next line enforces variable vs constant naming convention */
1917 for(n = 0; n < vsp; n++) {
1918 if(v[n].len == Len) {
1919 if(!strnicmp(v[n].s, Str, Len))
1920 {
1921 if(n == 1) /* The formula uses 'p1'. */
1922 uses_p1 = 1;
1923 if(n == 2) /* The formula uses 'p2'. */
1924 uses_p2 = 1;
1925 if(n == 7) /* The formula uses 'rand'. */
1926 RandomSeed();
1927 if(n == 8) /* The formula uses 'p3'. */
1928 uses_p3 = 1;
1929 if(n == 13) /* The formula uses 'ismand'. */
1930 uses_ismand = 1;
1931 if(n == 17) /* The formula uses 'p4'. */
1932 uses_p4 = 1;
1933 if(n == 18) /* The formula uses 'p5'. */
1934 uses_p5 = 1;
1935 #ifndef XFRACT
1936 if(n == 10 || n == 11 || n == 12)
1937 if(MathType == L_MATH)
1938 keybuffer = 'f';
1939 #endif
1940 if(!isconst_pair(Str))
1941 return(&v[n]);
1942 }
1943 }
1944 }
1945 v[vsp].s = Str;
1946 v[vsp].len = Len;
1947 v[vsp].a.d.x = v[vsp].a.d.y = 0.0;
1948
1949 #ifndef XFRACT
1950 /* v[vsp].a should already be zeroed out */
1951 switch(MathType) {
1952 case M_MATH:
1953 v[vsp].a.m.x.Mant = v[vsp].a.m.x.Exp = 0;
1954 v[vsp].a.m.y.Mant = v[vsp].a.m.y.Exp = 0;
1955 break;
1956 case L_MATH:
1957 v[vsp].a.l.x = v[vsp].a.l.y = 0;
1958 break;
1959 }
1960 #endif
1961
1962 if(isdigit(Str[0])
1963 || (Str[0] == '-' && (isdigit(Str[1]) || Str[1] == '.'))
1964 || Str[0] == '.') {
1965 if(o[posp-1].f == StkNeg) {
1966 posp--;
1967 Str = Str - 1;
1968 InitN--;
1969 v[vsp].len++;
1970 }
1971 for(n = 1; isdigit(Str[n]) || Str[n] == '.'; n++);
1972 if(Str[n] == ',') {
1973 j = n + SkipWhiteSpace(&Str[n+1]) + 1;
1974 if(isdigit(Str[j])
1975 || (Str[j] == '-' && (isdigit(Str[j+1]) || Str[j+1] == '.'))
1976 || Str[j] == '.') {
1977 z.y = atof(&Str[j]);
1978 for(; isdigit(Str[j]) || Str[j] == '.' || Str[j] == '-'; j++);
1979 v[vsp].len = j;
1980 }
1981 else
1982 z.y = 0.0;
1983 }
1984 else
1985 z.y = 0.0;
1986 z.x = atof(Str);
1987 switch(MathType) {
1988 case D_MATH:
1989 v[vsp].a.d = z;
1990 break;
1991 #ifndef XFRACT
1992 case M_MATH:
1993 v[vsp].a.m = cmplx2MPC(z);
1994 break;
1995 case L_MATH:
1996 v[vsp].a.l.x = (long)(z.x * fg);
1997 v[vsp].a.l.y = (long)(z.y * fg);
1998 break;
1999 #endif
2000 }
2001 v[vsp].s = Str;
2002 }
2003 return(&v[vsp++]);
2004 }
2005
2006
2007 struct FNCT_LIST {
2008 char far *s; /* TIW 03-31-91 added far */
2009 void (**ptr)(void);
2010 };
2011
2012 /* TIW 03-30-91 START */
2013 void (*StkTrig0)(void) = dStkSin;
2014 void (*StkTrig1)(void) = dStkSqr;
2015 void (*StkTrig2)(void) = dStkSinh;
2016 void (*StkTrig3)(void) = dStkCosh;
2017
2018 char far * JumpList[] = {
2019 "if",
2020 "elseif",
2021 "else",
2022 "endif",
2023 ""
2024 };
2025
2026
2027
2028 int isjump(char *Str, int Len)
2029 {
2030 /* return values
2031 0 - Not a jump
2032 1 - if
2033 2 - elseif
2034 3 - else
2035 4 - endif
2036 */
2037
2038 int i;
2039
2040 for(i = 0; *JumpList[i]; i++)
2041 if(far_strlen(JumpList[i]) == Len)
2042 if(!far_strnicmp(JumpList[i], Str, Len))
2043 return i + 1;
2044 return 0;
2045 }
2046
2047
2048 char maxfn = 0;
2049 /* TIW 03-30-91 STOP */
2050
2051 struct FNCT_LIST far FnctList[] = { /* TIW 03-31-91 added far */
2052 {s_sin, &StkSin},
2053 {s_sinh, &StkSinh},
2054 {s_cos, &StkCos},
2055 {s_cosh, &StkCosh},
2056 {s_sqr, &StkSqr},
2057 {s_log, &StkLog},
2058 {s_exp, &StkExp},
2059 {s_abs, &StkAbs},
2060 {s_conj, &StkConj},
2061 {s_real, &StkReal},
2062 {s_imag, &StkImag},
2063 {s_fn1, &StkTrig0}, /* TIW 03-30-91 */
2064 {s_fn2, &StkTrig1}, /* TIW 03-30-91 */
2065 {s_fn3, &StkTrig2}, /* TIW 03-30-91 */
2066 {s_fn4, &StkTrig3}, /* TIW 03-30-91 */
2067 {s_flip, &StkFlip}, /* MCP 4-9-91 */
2068 {s_tan, &StkTan}, /* TIW 04-22-91 */
2069 {s_tanh, &StkTanh}, /* TIW 04-22-91 */
2070 {s_cotan, &StkCoTan}, /* TIW 04-24-91 */
2071 {s_cotanh,&StkCoTanh}, /* TIW 04-24-91 */
2072 {s_cosxx, &StkCosXX}, /* PB 04-28-91 */
2073 {s_srand, &StkSRand}, /* MCP 11-21-91 */
2074 {s_asin, &StkASin}, /* TIW 11-26-94 */
2075 {s_asinh, &StkASinh}, /* TIW 11-26-94 */
2076 {s_acos, &StkACos}, /* TIW 11-26-94 */
2077 {s_acosh, &StkACosh}, /* TIW 11-26-94 */
2078 {s_atan, &StkATan}, /* TIW 11-26-94 */
2079 {s_atanh, &StkATanh}, /* TIW 11-26-94 */
2080 {s_sqrt, &StkSqrt}, /* TIW 11-26-94 */
2081 {s_cabs, &StkCAbs}, /* TIW 11-26-94 */
2082 {s_floor, &StkFloor}, /* TIW 06-30-96 */
2083 {s_ceil, &StkCeil}, /* TIW 06-30-96 */
2084 {s_trunc, &StkTrunc}, /* TIW 06-30-96 */
2085 {s_round, &StkRound}, /* TIW 06-30-96 */
2086 };
2087
2088 struct OP_LIST {
2089 char *s;
2090 void (**ptr)(void);
2091 };
2092
2093 struct OP_LIST far OPList[] = {
2094 {"," , &PtrStkClr }, /* 0 */
2095 {"!=" , &StkNE }, /* 1 */
2096 {"=" , &PtrStkSto }, /* 2 */
2097 {"==" , &StkEQ }, /* 3 */
2098 {"<" , &StkLT }, /* 4 */
2099 {"<=" , &StkLTE }, /* 5 */
2100 {">" , &StkGT }, /* 6 */
2101 {">=" , &StkGTE }, /* 7 */
2102 {"|" , &StkMod }, /* 8 */
2103 {"||" , &StkOR }, /* 9 */
2104 {"&&" , &StkAND }, /* 10 */
2105 {":" , &PtrEndInit }, /* 11 */
2106 {"+" , &StkAdd }, /* 12 */
2107 {"-" , &StkSub }, /* 13 */
2108 {"*" , &StkMul }, /* 14 */
2109 {"/" , &StkDiv }, /* 15 */
2110 {"^" , &StkPwr }, /* 16 */
2111 };
2112
2113
2114 void NotAFnct(void) { }
2115 void FnctNotFound(void) { }
2116
2117 /* determine if s names a function and if so which one */
2118 /* TIW 04-22-91 */
2119 int whichfn(char *s, int len)
2120 {
2121 int out;
2122 if(len != 3)
2123 out = 0;
2124 else if(strnicmp(s,"fn",2))
2125 out = 0;
2126 else
2127 out = atoi(s+2);
2128 if(out < 1 || out > 4)
2129 out = 0;
2130 return(out);
2131 }
2132
2133 #ifndef XFRACT
2134 void (far *isfunct(char *Str, int Len))(void)
2139 #endif
2140 {
2141 unsigned n;
2142 int functnum; /* TIW 04-22-91 */
2143
2144 n = SkipWhiteSpace(&Str[Len]);
2145 if(Str[Len+n] == '(') {
2146 for(n = 0; n < sizeof(FnctList) / sizeof(struct FNCT_LIST); n++) {
2147 if(far_strlen(FnctList[n].s) == Len) { /* TIW 03-31-91 added far */
2148 if(!far_strnicmp(FnctList[n].s, Str, Len)) { /* TIW 03-31-91 added far */
2149 /* count function variables */
2150 if((functnum = whichfn(Str, Len)) != 0) /* TIW 04-22-91 */
2151 if(functnum > maxfn) /* TIW 04-22-91 */
2152 maxfn = (char)functnum; /* TIW 04-22-91 */
2153 return(*FnctList[n].ptr);
2154 }
2155 }
2156 }
2157 return(FnctNotFound);
2158 }
2159 return(NotAFnct);
2160 }
2161
2162 void RecSortPrec(void) {
2163 int ThisOp = NextOp++;
2164 while(o[ThisOp].p > o[NextOp].p && NextOp < posp)
2165 RecSortPrec();
2166 f[OpPtr++] = o[ThisOp].f;
2167 }
2168
2169 static char *Constants[] = {
2170 "pixel", /* v[0] */
2171 "p1", /* v[1] */
2172 "p2", /* v[2] */
2173 "z", /* v[3] */
2174 "LastSqr", /* v[4] */
2175 "pi", /* v[5] */
2176 "e", /* v[6] */
2177 "rand", /* v[7] */
2178 "p3", /* v[8] */
2179 "whitesq", /* v[9] */
2180 "scrnpix", /* v[10] */
2181 "scrnmax", /* v[11] */
2182 "maxit", /* v[12] */
2183 s_ismand, /* v[13] */
2184 "center", /* v[14] */
2185 "magxmag", /* v[15] */
2186 "rotskew", /* v[16] */
2187 "p4", /* v[17] */
2188 "p5" /* v[18] */
2189 };
2190
2191 struct SYMETRY {
2192 char *s;
2193 int n;
2194 } SymStr[] = {
2195 {"NOSYM", 0},
2196 {"XAXIS_NOPARM", -1},
2197 {"XAXIS", 1},
2198 {"YAXIS_NOPARM", -2},
2199 {"YAXIS", 2},
2200 {"XYAXIS_NOPARM",-3},
2201 {"XYAXIS", 3},
2202 {"ORIGIN_NOPARM",-4},
2203 {"ORIGIN", 4},
2204 {"PI_SYM_NOPARM",-5},
2205 {"PI_SYM", 5},
2206 {"XAXIS_NOIMAG", -6},
2207 {"XAXIS_NOREAL", 6},
2208 {"NOPLOT", 99},
2209 {"", 0}
2210 };
2211
2212 static int ParseStr(char *Str, int pass) {
2213 struct ConstArg far *c;
2214 int ModFlag = 999, Len, Equals = 0, Mod[20], mdstk = 0;
2215 int jumptype;
2216 double const_pi, const_e;
2217 double Xctr, Yctr, Xmagfactor, Rotation, Skew;
2218 LDBL Magnification;
2219 SetRandom = Randomized = 0;
2220 uses_jump = 0;
2221 jump_index = 0;
2222 if(pass == 0)
2223 o = (struct PEND_OP far *)
2224 ((char far *)typespecific_workarea + total_formula_mem-sizeof(struct PEND_OP) * Max_Ops);
2225 else if(used_extra == 1)
2226 o = (struct PEND_OP far *)
2227 ((char far *)typespecific_workarea + total_formula_mem-sizeof(struct PEND_OP) * Max_Ops);
2228 else
2229 o = (struct PEND_OP far *)farmemalloc(sizeof(struct PEND_OP) * (long)Max_Ops);
2230 if( !o || !typespecific_workarea) {
2231 stopmsg(0,ParseErrs(PE_INSUFFICIENT_MEM_FOR_TYPE_FORMULA));
2232 return(1);
2233 }
2234 switch(MathType) {
2235 case D_MATH:
2236 StkAdd = dStkAdd;
2237 StkSub = dStkSub;
2238 StkNeg = dStkNeg;
2239 StkMul = dStkMul;
2240 StkSin = dStkSin;
2241 StkSinh = dStkSinh;
2242 StkLT = dStkLT;
2243 StkLTE = dStkLTE;
2244 StkMod = dStkMod;
2245 StkSqr = dStkSqr;
2246 StkCos = dStkCos;
2247 StkCosh = dStkCosh;
2248 StkLog = dStkLog;
2249 StkExp = dStkExp;
2250 StkPwr = dStkPwr;
2251 StkDiv = dStkDiv;
2252 StkAbs = dStkAbs;
2253 StkReal = dStkReal;
2254 StkImag = dStkImag;
2255 StkConj = dStkConj;
2256 StkTrig0 = dtrig0; /* TIW 03-30-91 */
2257 StkTrig1 = dtrig1; /* TIW 03-30-91 */
2258 StkTrig2 = dtrig2; /* TIW 03-30-91 */
2259 StkTrig3 = dtrig3; /* TIW 03-30-91 */
2260 StkFlip = dStkFlip;
2261 StkTan = dStkTan; /* TIW 04-22-91 */
2262 StkTanh = dStkTanh; /* TIW 04-22-91 */
2263 StkCoTan = dStkCoTan; /* TIW 04-24-91 */
2264 StkCoTanh = dStkCoTanh; /* TIW 04-24-91 */
2265 StkCosXX = dStkCosXX; /* PB 04-28-91 */
2266 StkGT = dStkGT; /* MCP 11-3-91 */
2267 StkGTE = dStkGTE; /* MCP 11-3-91 */
2268 StkEQ = dStkEQ; /* MCP 11-3-91 */
2269 StkNE = dStkNE; /* MCP 11-3-91 */
2270 StkAND = dStkAND; /* MCP 11-3-91 */
2271 StkOR = dStkOR ; /* MCP 11-3-91 */
2272 StkSRand = dStkSRand; /* MCP 11-21-91 */
2273 StkASin = dStkASin; /* TIW 11-25-94 */
2274 StkASinh = dStkASinh; /* TIW 11-25-94 */
2275 StkACos = dStkACos; /* TIW 11-25-94 */
2276 StkACosh = dStkACosh; /* TIW 11-25-94 */
2277 StkATan = dStkATan; /* TIW 11-25-94 */
2278 StkATanh = dStkATanh; /* TIW 11-25-94 */
2279 StkCAbs = dStkCAbs; /* TIW 11-25-94 */
2280 StkSqrt = dStkSqrt; /* TIW 11-25-94 */
2281 StkZero = dStkZero; /* JCO 12-31-94 */
2282 StkFloor = dStkFloor; /* TIW 06-30-96 */
2283 StkCeil = dStkCeil; /* TIW 06-30-96 */
2284 StkTrunc = dStkTrunc; /* TIW 06-30-96 */
2285 StkRound = dStkRound; /* TIW 06-30-96 */
2286 StkJumpOnTrue = dStkJumpOnTrue; /* GGM 02-10-97 */
2287 StkJumpOnFalse = dStkJumpOnFalse; /* GGM 02-10-97 */
2288 StkOne = dStkOne; /* GGM 10-08-97 */
2289 break;
2290 #ifndef XFRACT
2291 case M_MATH:
2292 StkAdd = mStkAdd;
2293 StkSub = mStkSub;
2294 StkNeg = mStkNeg;
2295 StkMul = mStkMul;
2296 StkSin = mStkSin;
2297 StkSinh = mStkSinh;
2298 StkLT = mStkLT;
2299 StkLTE = mStkLTE;
2300 StkMod = mStkMod;
2301 StkSqr = mStkSqr;
2302 StkCos = mStkCos;
2303 StkCosh = mStkCosh;
2304 StkLog = mStkLog;
2305 StkExp = mStkExp;
2306 StkPwr = mStkPwr;
2307 StkDiv = mStkDiv;
2308 StkAbs = mStkAbs;
2309 StkReal = mStkReal;
2310 StkImag = mStkImag;
2311 StkConj = mStkConj;
2312 StkTrig0 = mtrig0; /* TIW 03-30-91 */
2313 StkTrig1 = mtrig1; /* TIW 03-30-91 */
2314 StkTrig2 = mtrig2; /* TIW 03-30-91 */
2315 StkTrig3 = mtrig3; /* TIW 03-30-91 */
2316 StkFlip = mStkFlip;
2317 StkTan = mStkTan; /* TIW 04-22-91 */
2318 StkTanh = mStkTanh;/* TIW 04-22-91 */
2319 StkCoTan = mStkCoTan; /* TIW 04-24-91 */
2320 StkCoTanh = mStkCoTanh;/* TIW 04-24-91 */
2321 StkCosXX = mStkCosXX; /* PB 04-28-91 */
2322 StkGT = mStkGT; /* MCP 11-3-91 */
2323 StkGTE = mStkGTE; /* MCP 11-3-91 */
2324 StkEQ = mStkEQ; /* MCP 11-3-91 */
2325 StkNE = mStkNE; /* MCP 11-3-91 */
2326 StkAND = mStkAND; /* MCP 11-3-91 */
2327 StkOR = mStkOR ; /* MCP 11-3-91 */
2328 StkSRand = mStkSRand; /* MCP 11-21-91 */
2329 StkASin = mStkASin; /* TIW 11-25-94 */
2330 StkACos = mStkACos; /* TIW 11-25-94 */
2331 StkACosh = mStkACosh; /* TIW 11-25-94 */
2332 StkATan = mStkATan; /* TIW 11-25-94 */
2333 StkATanh = mStkATanh; /* TIW 11-25-94 */
2334 StkCAbs = mStkCAbs; /* TIW 11-25-94 */
2335 StkSqrt = mStkSqrt; /* TIW 11-25-94 */
2336 StkZero = mStkZero; /* JCO 12-31-94 */
2337 StkFloor = mStkFloor; /* TIW 06-30-96 */
2338 StkCeil = mStkCeil; /* TIW 06-30-96 */
2339 StkTrunc = mStkTrunc; /* TIW 06-30-96 */
2340 StkRound = mStkRound; /* TIW 06-30-96 */
2341 StkJumpOnTrue = mStkJumpOnTrue; /* GGM 02-10-97 */
2342 StkJumpOnFalse = mStkJumpOnFalse; /* GGM 02-10-97 */
2343 StkOne = mStkOne; /* GGM 10-08-97 */
2344 break;
2345 case L_MATH:
2346 Delta16 = bitshift - 16;
2347 ShiftBack = 32 - bitshift; /* TW 06-18-90 */
2348 StkAdd = lStkAdd;
2349 StkSub = lStkSub;
2350 StkNeg = lStkNeg;
2351 StkMul = lStkMul;
2352 StkSin = lStkSin;
2353 StkSinh = lStkSinh;
2354 StkLT = lStkLT;
2355 StkLTE = lStkLTE;
2356 if (save_release > 1826)
2357 StkMod = lStkMod;
2358 else
2359 StkMod = lStkModOld;
2360 StkSqr = lStkSqr;
2361 StkCos = lStkCos;
2362 StkCosh = lStkCosh;
2363 StkLog = lStkLog;
2364 StkExp = lStkExp;
2365 StkPwr = lStkPwr;
2366 StkDiv = lStkDiv;
2367 StkAbs = lStkAbs;
2368 StkReal = lStkReal;
2369 StkImag = lStkImag;
2370 StkConj = lStkConj;
2371 StkTrig0 = ltrig0; /* TIW 03-30-91 */
2372 StkTrig1 = ltrig1; /* TIW 03-30-91 */
2373 StkTrig2 = ltrig2; /* TIW 03-30-91 */
2374 StkTrig3 = ltrig3; /* TIW 03-30-91 */
2375 StkFlip = lStkFlip;
2376 StkTan = lStkTan; /* TIW 04-22-91 */
2377 StkTanh = lStkTanh; /* TIW 04-22-91 */
2378 StkCoTan = lStkCoTan; /* TIW 04-24-91 */
2379 StkCoTanh = lStkCoTanh; /* TIW 04-24-91 */
2380 StkCosXX = lStkCosXX; /* PB 04-28-91 */
2381 StkGT = lStkGT; /* MCP 11-3-91 */
2382 StkGTE = lStkGTE; /* MCP 11-3-91 */
2383 StkEQ = lStkEQ; /* MCP 11-3-91 */
2384 StkNE = lStkNE; /* MCP 11-3-91 */
2385 StkAND = lStkAND; /* MCP 11-3-91 */
2386 StkOR = lStkOR ; /* MCP 11-3-91 */
2387 StkSRand = lStkSRand; /* MCP 11-21-91 */
2388 StkASin = lStkASin; /* TIW 11-25-94 */
2389 StkACos = lStkACos; /* TIW 11-25-94 */
2390 StkACosh = lStkACosh; /* TIW 11-25-94 */
2391 StkATan = lStkATan; /* TIW 11-25-94 */
2392 StkATanh = lStkATanh; /* TIW 11-25-94 */
2393 StkCAbs = lStkCAbs; /* TIW 11-25-94 */
2394 StkSqrt = lStkSqrt; /* TIW 11-25-94 */
2395 StkZero = lStkZero; /* JCO 12-31-94 */
2396 StkFloor = lStkFloor; /* TIW 06-30-96 */
2397 StkCeil = lStkCeil; /* TIW 06-30-96 */
2398 StkTrunc = lStkTrunc; /* TIW 06-30-96 */
2399 StkRound = lStkRound; /* TIW 06-30-96 */
2400 StkJumpOnTrue = lStkJumpOnTrue; /* GGM 02-10-97 */
2401 StkJumpOnFalse = lStkJumpOnFalse; /* GGM 02-10-97 */
2402 StkOne = lStkOne; /* GGM 10-08-97 */
2403 break;
2404 #endif
2405 }
2406 maxfn = 0; /* TIW 03-30-91 */
2407 for(vsp = 0; vsp < sizeof(Constants) / sizeof(char*); vsp++) {
2408 v[vsp].s = Constants[vsp];
2409 v[vsp].len = strlen(Constants[vsp]);
2410 }
2411 cvtcentermag(&Xctr, &Yctr, &Magnification, &Xmagfactor, &Rotation, &Skew);
2412 const_pi = atan(1.0) * 4;
2413 const_e = exp(1.0);
2414 v[7].a.d.x = v[7].a.d.y = 0.0;
2415 v[11].a.d.x = (double)xdots;
2416 v[11].a.d.y = (double)ydots;
2417 v[12].a.d.x = (double)maxit;
2418 v[12].a.d.y = 0;
2419 v[13].a.d.x = (double)ismand;
2420 v[13].a.d.y = 0;
2421 v[14].a.d.x = Xctr;
2422 v[14].a.d.y = Yctr;
2423 v[15].a.d.x = (double)Magnification;
2424 v[15].a.d.y = Xmagfactor;
2425 v[16].a.d.x = Rotation;
2426 v[16].a.d.y = Skew;
2427
2428 switch(MathType) {
2429 case D_MATH:
2430 v[1].a.d.x = param[0];
2431 v[1].a.d.y = param[1];
2432 v[2].a.d.x = param[2];
2433 v[2].a.d.y = param[3];
2434 v[5].a.d.x = const_pi;
2435 v[5].a.d.y = 0.0;
2436 v[6].a.d.x = const_e;
2437 v[6].a.d.y = 0.0;
2438 v[8].a.d.x = param[4];
2439 v[8].a.d.y = param[5];
2440 v[17].a.d.x = param[6];
2441 v[17].a.d.y = param[7];
2442 v[18].a.d.x = param[8];
2443 v[18].a.d.y = param[9];
2444 break;
2445 #ifndef XFRACT
2446 case M_MATH:
2447 v[1].a.m.x = *d2MP(param[0]);
2448 v[1].a.m.y = *d2MP(param[1]);
2449 v[2].a.m.x = *d2MP(param[2]);
2450 v[2].a.m.y = *d2MP(param[3]);
2451 v[5].a.m.x = *d2MP(const_pi);
2452 v[5].a.m.y = *d2MP(0.0);
2453 v[6].a.m.x = *d2MP(const_e);
2454 v[6].a.m.y = *d2MP(0.0);
2455 v[8].a.m.x = *d2MP(param[4]);
2456 v[8].a.m.y = *d2MP(param[5]);
2457 v[11].a.m = cmplx2MPC(v[11].a.d);
2458 v[12].a.m = cmplx2MPC(v[12].a.d);
2459 v[13].a.m = cmplx2MPC(v[13].a.d);
2460 v[14].a.m = cmplx2MPC(v[14].a.d);
2461 v[15].a.m = cmplx2MPC(v[15].a.d);
2462 v[16].a.m = cmplx2MPC(v[16].a.d);
2463 v[17].a.m.x = *d2MP(param[6]);
2464 v[17].a.m.y = *d2MP(param[7]);
2465 v[18].a.m.x = *d2MP(param[8]);
2466 v[18].a.m.y = *d2MP(param[9]);
2467 break;
2468 case L_MATH:
2469 v[1].a.l.x = (long)(param[0] * fg);
2470 v[1].a.l.y = (long)(param[1] * fg);
2471 v[2].a.l.x = (long)(param[2] * fg);
2472 v[2].a.l.y = (long)(param[3] * fg);
2473 v[5].a.l.x = (long)(const_pi * fg);
2474 v[5].a.l.y = 0L;
2475 v[6].a.l.x = (long)(const_e * fg);
2476 v[6].a.l.y = 0L;
2477 v[8].a.l.x = (long)(param[4] * fg);
2478 v[8].a.l.y = (long)(param[5] * fg);
2479 v[11].a.l.x = xdots; v[11].a.l.x <<= bitshift;
2480 v[11].a.l.y = ydots; v[11].a.l.y <<= bitshift;
2481 v[12].a.l.x = maxit; v[12].a.l.x <<= bitshift;
2482 v[12].a.l.y = 0L;
2483 v[13].a.l.x = ismand; v[13].a.l.x <<= bitshift;
2484 v[13].a.l.y = 0L;
2485 v[14].a.l.x = (long)(v[14].a.d.x * fg);
2486 v[14].a.l.y = (long)(v[14].a.d.y * fg);
2487 v[15].a.l.x = (long)(v[15].a.d.x * fg);
2488 v[15].a.l.y = (long)(v[15].a.d.y * fg);
2489 v[16].a.l.x = (long)(v[16].a.d.x * fg);
2490 v[16].a.l.y = (long)(v[16].a.d.y * fg);
2491 v[17].a.l.x = (long)(param[6] * fg);
2492 v[17].a.l.y = (long)(param[7] * fg);
2493 v[18].a.l.x = (long)(param[8] * fg);
2494 v[18].a.l.y = (long)(param[9] * fg);
2495 break;
2496 #endif
2497 }
2498
2499 LastInitOp = paren = OpPtr = LodPtr = StoPtr = posp = 0;
2500 ExpectingArg = 1;
2501 for(n = 0; Str[n]; n++) {
2502 if(!Str[n])
2503 break;
2504 InitN = n;
2505 switch(Str[n]) {
2506 case ' ':
2507 case '\t':
2508 case '\r':
2509 case '\n':
2510 break;
2511 case '(':
2512 paren++;
2513 break;
2514 case ')':
2515 paren--;
2516 break;
2517 case '|':
2518 if(Str[n+1] == '|') {
2519 ExpectingArg = 1;
2520 n++;
2521 o[posp].f = StkOR;
2522 o[posp++].p = 7 - (paren + Equals)*15;
2523 }
2524 else if(ModFlag == paren-1) {
2525 paren--;
2526 ModFlag = Mod[--mdstk];
2527 }
2528 else {
2529 Mod[mdstk++] = ModFlag;
2530 o[posp].f = StkMod;
2531 o[posp++].p = 2 - (paren + Equals)*15;
2532 ModFlag = paren++;
2533 }
2534 break;
2535 case ',':
2536 case ';':
2537 if(!ExpectingArg) {
2538 ExpectingArg = 1;
2539 o[posp].f = (void(far*)(void))0;
2540 o[posp++].p = 15;
2541 o[posp].f = StkClr;
2542 o[posp++].p = -30000;
2543 Equals = paren = 0;
2544 }
2545 break;
2546 case ':':
2547 ExpectingArg = 1;
2548 o[posp].f = (void(far*)(void))0;
2549 o[posp++].p = 15;
2550 o[posp].f = EndInit;
2551 o[posp++].p = -30000;
2552 Equals = paren = 0;
2553 LastInitOp = 10000;
2554 break;
2555 case '+':
2556 ExpectingArg = 1;
2557 o[posp].f = StkAdd;
2558 o[posp++].p = 4 - (paren + Equals)*15;
2559 break;
2560 case '-':
2561 if(ExpectingArg) {
2562 o[posp].f = StkNeg;
2563 o[posp++].p = 2 - (paren + Equals)*15;
2564 }
2565 else {
2566 o[posp].f = StkSub;
2567 o[posp++].p = 4 - (paren + Equals)*15;
2568 ExpectingArg = 1;
2569 }
2570 break;
2571 case '&':
2572 ExpectingArg = 1;
2573 n++;
2574 o[posp].f = StkAND;
2575 o[posp++].p = 7 - (paren + Equals)*15;
2576 break;
2577 case '!':
2578 ExpectingArg = 1;
2579 n++;
2580 o[posp].f = StkNE;
2581 o[posp++].p = 6 - (paren + Equals)*15;
2582 break;
2583 case '<':
2584 ExpectingArg = 1;
2585 if(Str[n+1] == '=') {
2586 n++;
2587 o[posp].f = StkLTE;
2588 }
2589 else
2590 o[posp].f = StkLT;
2591 o[posp++].p = 6 - (paren + Equals)*15;
2592 break;
2593 case '>':
2594 ExpectingArg = 1;
2595 if(Str[n+1] == '=') {
2596 n++;
2597 o[posp].f = StkGTE;
2598 }
2599 else
2600 o[posp].f = StkGT;
2601 o[posp++].p = 6 - (paren + Equals)*15;
2602 break;
2603 case '*':
2604 ExpectingArg = 1;
2605 o[posp].f = StkMul;
2606 o[posp++].p = 3 - (paren + Equals)*15;
2607 break;
2608 case '/':
2609 ExpectingArg = 1;
2610 o[posp].f = StkDiv;
2611 o[posp++].p = 3 - (paren + Equals)*15;
2612 break;
2613 case '^':
2614 ExpectingArg = 1;
2615 o[posp].f = StkPwr;
2616 o[posp++].p = 2 - (paren + Equals)*15;
2617 break;
2618 case '=':
2619 ExpectingArg = 1;
2620 if(Str[n+1] == '=') {
2621 n++;
2622 o[posp].f = StkEQ;
2623 o[posp++].p = 6 - (paren + Equals)*15;
2624 }
2625 else {
2626 o[posp-1].f = StkSto;
2627 o[posp-1].p = 5 - (paren + Equals)*15;
2628 Store[StoPtr++] = Load[--LodPtr];
2629 Equals++;
2630 }
2631 break;
2632 default:
2633 while(isalnum(Str[n+1]) || Str[n+1] == '.' || Str[n+1] == '_')
2634 n++;
2635 Len = (n+1)-InitN;
2636 ExpectingArg = 0;
2637 if((jumptype = isjump(&Str[InitN], Len)) != 0) {
2638 uses_jump = 1;
2639 switch (jumptype) {
2640 case 1: /* if */
2641 ExpectingArg = 1;
2642 jump_control[jump_index++].type = 1;
2643 o[posp].f = StkJumpOnFalse;
2644 o[posp++].p = 1;
2645 break;
2646 case 2: /* elseif */
2647 ExpectingArg = 1;
2648 jump_control[jump_index++].type = 2;
2649 jump_control[jump_index++].type = 2;
2650 o[posp].f = StkJump;
2651 o[posp++].p = 1;
2652 o[posp].f = (void(far*)(void))0;
2653 o[posp++].p = 15;
2654 o[posp].f = StkClr;
2655 o[posp++].p = -30000;
2656 o[posp].f = StkJumpOnFalse;
2657 o[posp++].p = 1;
2658 break;
2659 case 3: /* else */
2660 jump_control[jump_index++].type = 3;
2661 o[posp].f = StkJump;
2662 o[posp++].p = 1;
2663 break;
2664 case 4: /* endif */
2665 jump_control[jump_index++].type = 4;
2666 o[posp].f = StkJumpLabel;
2667 o[posp++].p = 1;
2668 break;
2669 default:
2670 break;
2671 }
2672 }
2673 else {
2674 o[posp].f = isfunct(&Str[InitN], Len);
2675 if(o[posp].f != NotAFnct) {
2676 o[posp++].p = 1 - (paren + Equals)*15;
2677 ExpectingArg = 1;
2678 }
2679 else {
2680 c = isconst(&Str[InitN], Len);
2681 Load[LodPtr++] = &(c->a);
2682 o[posp].f = StkLod;
2683 o[posp++].p = 1 - (paren + Equals)*15;
2684 n = InitN + c->len - 1;
2685 }
2686 }
2687 break;
2688 }
2689 }
2690 o[posp].f = (void(far*)(void))0;
2691 o[posp++].p = 16;
2692 NextOp = 0;
2693 LastOp = posp;
2694 while(NextOp < posp) {
2695 if(o[NextOp].f)
2696 RecSortPrec();
2697 else {
2698 NextOp++;
2699 LastOp--;
2700 }
2701 }
2702 if(pass > 0 && used_extra == 0)
2703 farmemfree(o);
2704 return(0);
2705 }
2706
2707
2708 #if (_MSC_VER >= 700)
2709 #pragma code_seg () /* back to normal segment */
2710 #endif
2711
2712 int Formula(void) {
2713 if(FormName[0] == 0 || overflow) return(1);
2714
2715 LodPtr = InitLodPtr;
2716 StoPtr = InitStoPtr;
2717 OpPtr = InitOpPtr;
2718 jump_index=InitJumpIndex;
2719 /* Set the random number, MCP 11-21-91 */
2720 if(SetRandom || Randomized)
2721 {
2722 switch(MathType)
2723 {
2724 case D_MATH:
2725 dRandom();
2726 break;
2727 #ifndef XFRACT
2728 case L_MATH:
2729 lRandom();
2730 break;
2731 case M_MATH:
2732 mRandom();
2733 #endif
2734 }
2735 }
2736
2737 Arg1 = &s[0];
2738 Arg2 = Arg1-1;
2739 while(OpPtr < (int)LastOp) {
2740 f[OpPtr]();
2741 OpPtr++;
2742 #ifdef WATCH_MP
2747 #endif
2748 }
2749
2750 switch(MathType) {
2751 case D_MATH:
2752 old = new = v[3].a.d;
2753 return(Arg1->d.x == 0.0);
2754 #ifndef XFRACT
2755 case M_MATH:
2756 old = new = MPC2cmplx(v[3].a.m);
2757 return(Arg1->m.x.Exp == 0 && Arg1->m.x.Mant == 0);
2758 case L_MATH:
2759 lold = lnew = v[3].a.l;
2760 if(overflow)
2761 return(1);
2762 return(Arg1->l.x == 0L);
2763 #endif
2764 }
2765 return(1);
2766 }
2767
2768 int form_per_pixel(void) {
2769 if (FormName[0] == 0) return(1);
2770 overflow = LodPtr = StoPtr = OpPtr = jump_index = 0;
2771 Arg1 = &s[0];
2772 Arg2 = Arg1;
2773 Arg2--;
2774
2775
2776 v[10].a.d.x = (double)col;
2777 v[10].a.d.y = (double)row;
2778
2779 switch(MathType) {
2780 case D_MATH:
2781 if((row+col)&1)
2782 v[9].a.d.x = 1.0;
2783 else
2784 v[9].a.d.x = 0.0;
2785 v[9].a.d.y = 0.0;
2786 break;
2787
2788
2789 #ifndef XFRACT
2790 case M_MATH:
2791 if((row+col)&1)
2792 v[9].a.m = MPCone;
2793 else {
2794 v[9].a.m.x.Mant = v[9].a.m.x.Exp = 0;
2795 v[9].a.m.y.Mant = v[9].a.m.y.Exp = 0;
2796 }
2797 v[10].a.m = cmplx2MPC(v[10].a.d);
2798 break;
2799 case L_MATH:
2800 v[9].a.l.x = (long) (((row+col)&1) * fg);
2801 v[9].a.l.y = 0L;
2802 v[10].a.l.x = col; v[10].a.l.x <<= bitshift;
2803 v[10].a.l.y = row; v[10].a.l.y <<= bitshift;
2804 break;
2805 #endif
2806 }
2807
2808 /* TW started additions for inversion support here 4/17/94 */
2809 {
2810 if(invert)
2811 {
2812 invertz2(&old);
2813 switch(MathType)
2814 {
2815 case D_MATH:
2816 v[0].a.d.x = old.x;
2817 v[0].a.d.y = old.y;
2818 break;
2819 #ifndef XFRACT
2820 case M_MATH:
2821 v[0].a.m.x = *d2MP(old.x);
2822 v[0].a.m.y = *d2MP(old.y);
2823 break;
2824 case L_MATH:
2825 /* watch out for overflow */
2826 if(sqr(old.x)+sqr(old.y) >= 127)
2827 {
2828 old.x = 8; /* value to bail out in one iteration */
2829 old.y = 8;
2830 }
2831 /* convert to fudged longs */
2832 v[0].a.l.x = (long)(old.x*fg);
2833 v[0].a.l.y = (long)(old.y*fg);
2834 break;
2835 #endif
2836 }
2837 }
2838 else
2839 /* TW end of inversion support changes here 4/17/94 */
2840 switch(MathType)
2841 {
2842 case D_MATH:
2843 v[0].a.d.x = dxpixel();
2844 v[0].a.d.y = dypixel();
2845 break;
2846 #ifndef XFRACT
2847 case M_MATH:
2848 v[0].a.m.x = *d2MP(dxpixel());
2849 v[0].a.m.y = *d2MP(dypixel());
2850 break;
2851 case L_MATH:
2852 v[0].a.l.x = lxpixel();
2853 v[0].a.l.y = lypixel();
2854 break;
2855 #endif
2856 }
2857 }
2858
2859 if(LastInitOp)
2860 LastInitOp = LastOp;
2861 while(OpPtr < LastInitOp) {
2862 f[OpPtr]();
2863 OpPtr++;
2864 }
2865 InitLodPtr = LodPtr;
2866 InitStoPtr = StoPtr;
2867 InitOpPtr = OpPtr;
2868 /* Set old variable for orbits TIW 12-18-93 */
2869 switch(MathType) {
2870 case D_MATH:
2871 old = v[3].a.d;
2872 break;
2873 #ifndef XFRACT
2874 case M_MATH:
2875 old = MPC2cmplx(v[3].a.m);
2876 break;
2877 case L_MATH:
2878 lold = v[3].a.l;
2879 break;
2880 #endif
2881 }
2882
2883 if(overflow)
2884 return(0);
2885 else
2886 return(1);
2887 }
2888
2889 int fill_if_group(int endif_index, JUMP_PTRS_ST* jump_data)
2890 {
2891 int i = endif_index;
2892 int ljp = endif_index; /* ljp means "last jump processed" */
2893 while(i > 0) {
2894 i--;
2895 switch (jump_control[i].type) {
2896 case 1: /*if(); this concludes processing of this group*/
2897 jump_control[i].ptrs = jump_data[ljp];
2898 jump_control[i].DestJumpIndex = ljp + 1;
2899 return i;
2900 case 2: /*elseif* ( 2 jumps, the else and the if*/
2901 /* first, the "if" part */
2902 jump_control[i].ptrs = jump_data[ljp];
2903 jump_control[i].DestJumpIndex = ljp + 1;
2904
2905 /* then, the else part */
2906 i--; /*fall through to "else" is intentional*/
2907 case 3:
2908 jump_control[i].ptrs = jump_data[endif_index];
2909 jump_control[i].DestJumpIndex = endif_index + 1;
2910 ljp = i;
2911 break;
2912 case 4: /*endif*/
2913 i = fill_if_group(i, jump_data);
2914 break;
2915 default:
2916 break;
2917 }
2918 }
2919 return -1; /* should never get here */
2920 }
2921
2922 int fill_jump_struct(void)
2923 { /* Completes all entries in jump structure. Returns 1 on error) */
2924 /* On entry, jump_index is the number of jump functions in the formula*/
2925 int i = 0;
2926 int loadcount = 0;
2927 int storecount = 0;
2928 int checkforelse = 0;
2929 void (*JumpFunc)(void) = NULL;
2930 int find_new_func = 1;
2931
2932 JUMP_PTRS_ST jump_data[MAX_JUMPS];
2933
2934 for (OpPtr = 0; OpPtr < (int) LastOp; OpPtr++) {
2935 if(find_new_func) {
2936 switch (jump_control[i].type) {
2937 case 1:
2938 JumpFunc = StkJumpOnFalse;
2939 break;
2940 case 2:
2941 checkforelse = !checkforelse;
2942 if(checkforelse)
2943 JumpFunc = StkJump;
2944 else
2945 JumpFunc = StkJumpOnFalse;
2946 break;
2947 case 3:
2948 JumpFunc = StkJump;
2949 break;
2950 case 4:
2951 JumpFunc = StkJumpLabel;
2952 break;
2953 default:
2954 break;
2955 }
2956 find_new_func = 0;
2957 }
2958 if(*(f[OpPtr]) == StkLod)
2959 loadcount++;
2960 else if(*(f[OpPtr]) == StkSto)
2961 storecount++;
2962 else if(*(f[OpPtr]) == JumpFunc) {
2963 jump_data[i].JumpOpPtr = OpPtr;
2964 jump_data[i].JumpLodPtr = loadcount;
2965 jump_data[i].JumpStoPtr = storecount;
2966 i++;
2967 find_new_func = 1;
2968 }
2969 }
2970
2971 /* Following for safety only; all should always be false */
2972 if(i != jump_index || jump_control[i - 1].type != 4
2973 || jump_control[0].type != 1) {
2974 return 1;
2975 }
2976
2977 while(i > 0) {
2978 i--;
2979 i = fill_if_group(i, jump_data);
2980 }
2981 return i < 0 ? 1 : 0;
2982 }
2983
2984 static char *FormStr;
2985
2986 #if (_MSC_VER >= 700)
2987 #pragma code_seg ("parser1_text") /* place following in an overlay */
2988 #endif
2989
2990 int frmgetchar (FILE * openfile)
2991 {
2992 int c;
2993 int done = 0;
2994 int linewrap = 0;
2995 while (!done) {
2996 c = getc(openfile);
2997 switch (c) {
2998 case '\r': case ' ' : case '\t' :
2999 break;
3000 case '\\':
3001 linewrap = 1;
3002 break;
3003 case ';' :
3004 while ((c = getc(openfile)) != '\n' && c != EOF && c != '\032')
3005 {}
3006 if(c == EOF || c == '\032')
3007 done = 1;
3008 case '\n' :
3009 if(!linewrap)
3010 done = 1;
3011 linewrap = 0;
3012 break;
3013 default:
3014 done = 1;
3015 break;
3016 }
3017 }
3018 return tolower(c);
3019 }
3020
3021 /* This function also gets flow control info */
3022
3023 void getfuncinfo(struct token_st * tok)
3024 {
3025 int i;
3026 for(i=0; i < sizeof(FnctList)/ sizeof(struct FNCT_LIST); i++) {
3027 if(!far_strcmp(FnctList[i].s, tok->token_str)) {
3028 tok->token_id = i;
3029 if(i >= 11 && i <= 14)
3030 tok->token_type = PARAM_FUNCTION;
3031 else
3032 tok->token_type = FUNCTION;
3033 return;
3034 }
3035 }
3036
3037 for (i=0; i < 4; i++) { /*pick up flow control*/
3038 if(!far_strcmp(JumpList[i], tok->token_str)) {
3039 tok->token_type = FLOW_CONTROL;
3040 tok->token_id = i + 1;
3041 return;
3042 }
3043 }
3044 tok->token_type = NOT_A_TOKEN;
3045 tok->token_id = UNDEFINED_FUNCTION;
3046 return;
3047 }
3048
3049 void getvarinfo(struct token_st * tok)
3050 {
3051 int i;
3052
3053 for(i=0; i < sizeof(Constants) / sizeof(char*); i++) {
3054 if(!far_strcmp(Constants[i], tok->token_str)) {
3055 tok->token_id = i;
3056 switch(i) {
3057 case 1: case 2: case 8: case 13: case 17: case 18:
3058 tok->token_type = PARAM_VARIABLE;
3059 break;
3060 default:
3061 tok->token_type = PREDEFINED_VARIABLE;
3062 break;
3063 }
3064 return;
3065 }
3066 }
3067 tok->token_type = USER_NAMED_VARIABLE;
3068 tok->token_id = 0;
3069 }
3070
3071 /* fills in token structure where numeric constant is indicated */
3072 /* Note - this function will be called twice to fill in the components
3073 of a complex constant. See is_complex_constant() below. */
3074
3075 /* returns 1 on success, 0 on NOT_A_TOKEN */
3076
3077 int frmgetconstant(FILE * openfile, struct token_st * tok)
3078 {
3079 int c;
3080 int i = 1;
3081 int getting_base = 1;
3082 long filepos = ftell(openfile);
3083 int got_decimal_already = 0;
3084 int done = 0;
3085 tok->token_const.x = 0.0; /*initialize values to 0*/
3086 tok->token_const.y = 0.0;
3087 if(tok->token_str[0] == '.')
3088 got_decimal_already = 1;
3089 while (!done) {
3090 switch (c=frmgetchar(openfile)) {
3091 case EOF: case '\032':
3092 tok->token_str[i] = (char) 0;
3093 tok->token_type = NOT_A_TOKEN;
3094 tok->token_id = END_OF_FILE;
3095 return 0;
3096 CASE_NUM:
3097 tok->token_str[i++] = (char) c;
3098 filepos=ftell(openfile);
3099 break;
3100 case '.':
3101 if (got_decimal_already || !getting_base) {
3102 tok->token_str[i++] = (char) c;
3103 tok->token_str[i++] = (char) 0;
3104 tok->token_type = NOT_A_TOKEN;
3105 tok->token_id = ILL_FORMED_CONSTANT;
3106 return 0;
3107 }
3108 else {
3109 tok->token_str[i++] = (char) c;
3110 got_decimal_already = 1;
3111 filepos=ftell(openfile);
3112 }
3113 break;
3114 default :
3115 if(c == 'e' && getting_base && (isdigit(tok->token_str[i-1]) || (tok->token_str[i-1] == '.' && i > 1))) {
3116 tok->token_str[i++] = (char) c;
3117 getting_base = 0;
3118 got_decimal_already = 0;
3119 filepos=ftell(openfile);
3120 if((c = frmgetchar(openfile)) == '-' || c == '+') {
3121 tok->token_str[i++] = (char) c;
3122 filepos = ftell(openfile);
3123 }
3124 else {
3125 fseek(openfile, filepos, SEEK_SET);
3126 }
3127 }
3128 else if(isalpha(c) || c == '_') {
3129 tok->token_str[i++] = (char) c;
3130 tok->token_str[i++] = (char) 0;
3131 tok->token_type = NOT_A_TOKEN;
3132 tok->token_id = ILL_FORMED_CONSTANT;
3133 return 0;
3134 }
3135 else if (tok->token_str[i-1] == 'e' || (tok->token_str[i-1] == '.' && i == 1)) {
3136 tok->token_str[i++] = (char) c;
3137 tok->token_str[i++] = (char) 0;
3138 tok->token_type = NOT_A_TOKEN;
3139 tok->token_id = ILL_FORMED_CONSTANT;
3140 return 0;
3141 }
3142 else {
3143 fseek(openfile, filepos, SEEK_SET);
3144 tok->token_str[i++] = (char) 0;
3145 done = 1;
3146 }
3147 break;
3148 }
3149 if (i == 33 && tok->token_str[32]) {
3150 tok->token_str[33] = (char) 0;
3151 tok->token_type = NOT_A_TOKEN;
3152 tok->token_id = TOKEN_TOO_LONG;
3153 return 0;
3154 }
3155 } /* end of while loop. Now fill in the value */
3156 tok->token_const.x = atof(tok->token_str);
3157 tok->token_type = REAL_CONSTANT;
3158 tok->token_id = 0;
3159 return 1;
3160 }
3161
3162 void is_complex_constant(FILE * openfile, struct token_st * tok)
3163 {
3164 /* should test to make sure tok->token_str[0] == '(' */
3165 struct token_st temp_tok;
3166 long filepos;
3167 int c;
3168 int sign_value = 1;
3169 int done = 0;
3170 int getting_real = 1;
3171 FILE * debug_token = NULL;
3172 tok->token_str[1] = (char) 0; /* so we can concatenate later */
3173
3174 filepos = ftell(openfile);
3175 if (debugflag == 96) {
3176 debug_token = fopen("frmconst.txt","at");
3177 }
3178
3179 while (!done) {
3180 switch (c = frmgetchar(openfile)) {
3181 CASE_NUM : case '.':
3182 if (debug_token != NULL) {
3183 fprintf(debug_token, "Set temp_tok.token_str[0] to %c\n", c);
3184 }
3185 temp_tok.token_str[0] = (char) c;
3186 break;
3187 case '-' :
3188 if (debug_token != NULL) {
3189 fprintf(debug_token, "First char is a minus\n");
3190 }
3191 sign_value = -1;
3192 if ((c = frmgetchar(openfile)) == '.' || isdigit(c)) {
3193 if (debug_token != NULL) {
3194 fprintf(debug_token, "Set temp_tok.token_str[0] to %c\n", c);
3195 }
3196 temp_tok.token_str[0] = (char) c;
3197 }
3198 else {
3199 if (debug_token != NULL) {
3200 fprintf(debug_token, "First char not a . or NUM\n");
3201 }
3202 done = 1;
3203 }
3204 break;
3205 default:
3206 if (debug_token != NULL) {
3207 fprintf(debug_token, "First char not a . or NUM\n");
3208 }
3209 done = 1;
3210 break;
3211 }
3212 if (debug_token != NULL) {
3213 fprintf(debug_token, "Calling frmgetconstant unless done is 1; done is %d\n", done);
3214 }
3215 if (!done && frmgetconstant (openfile, &temp_tok)) {
3216 c = frmgetchar(openfile);
3217 if (debug_token != NULL) {
3218 fprintf(debug_token, "frmgetconstant returned 1; next token is %c\n", c);
3219 }
3220 if (getting_real && c == ',') { /*we have the real part now*/
3221 if (sign_value == -1) {
3222 strcat(tok->token_str, "-");
3223 }
3224 strcat(tok->token_str, temp_tok.token_str);
3225 strcat(tok->token_str, ",");
3226 tok->token_const.x = temp_tok.token_const.x * sign_value;
3227 getting_real = 0;
3228 sign_value = 1;
3229 }
3230 else if (!getting_real && c == ')') { /* we have the complex part */
3231 if (sign_value == -1) {
3232 strcat(tok->token_str, "-");
3233 }
3234 strcat(tok->token_str, temp_tok.token_str);
3235 strcat(tok->token_str, ")");
3236 tok->token_const.y = temp_tok.token_const.x * sign_value;
3237 tok->token_type = tok->token_const.y ? COMPLEX_CONSTANT : REAL_CONSTANT;
3238 tok->token_id = 0;
3239 if (debug_token != NULL) {
3240 fprintf(debug_token, "Exiting with type set to %d\n", tok->token_const.y ? COMPLEX_CONSTANT : REAL_CONSTANT);
3241 fclose (debug_token);
3242 }
3243 return;
3244 }
3245 else
3246 done = 1;
3247 }
3248 else
3249 done = 1;
3250 }
3251 fseek (openfile, filepos, SEEK_SET);
3252 tok->token_str[1] = (char) 0;
3253 tok->token_const.y = tok->token_const.x = 0.0;
3254 tok->token_type = PARENS;
3255 tok->token_id = OPEN_PARENS;
3256 if (debug_token != NULL) {
3257 fprintf(debug_token, "Exiting with ID set to OPEN_PARENS\n");
3258 fclose (debug_token);
3259 }
3260 return;
3261 }
3262
3263 int frmgetalpha(FILE * openfile, struct token_st * tok)
3264 {
3265 int c;
3266 int i = 1;
3267 int var_name_too_long = 0;
3268 long filepos;
3269 long last_filepos = ftell(openfile);
3270 while ((c=frmgetchar(openfile)) != EOF && c != '\032') {
3271 filepos = ftell(openfile);
3272 switch (c) {
3273 CASE_ALPHA: CASE_NUM: case '_':
3274 if (i<79)
3275 tok->token_str[i++] = (char) c;
3276 else {
3277 tok->token_str[i] = (char) 0;
3278 }
3279 if(i == 33) {
3280 var_name_too_long=1;
3281 }
3282 last_filepos = filepos;
3283 break;
3284 default:
3285 if (c == '.') { /*illegal character in variable or func name*/
3286 tok->token_type = NOT_A_TOKEN;
3287 tok->token_id = ILLEGAL_VARIABLE_NAME;
3288 tok->token_str[i++] = '.';
3289 tok->token_str[i] = (char) 0;
3290 return 0;
3291 }
3292 else if (var_name_too_long) {
3293 tok->token_type = NOT_A_TOKEN;
3294 tok->token_id = TOKEN_TOO_LONG;
3295 tok->token_str[i] = (char) 0;
3296 fseek(openfile, last_filepos, SEEK_SET);
3297 return 0;
3298 }
3299 tok->token_str[i] = (char) 0;
3300 fseek(openfile, last_filepos, SEEK_SET);
3301 getfuncinfo(tok);
3302 if(c=='(') { /*getfuncinfo() correctly filled structure*/
3303 if (tok->token_type == NOT_A_TOKEN)
3304 return 0;
3305 else if (tok->token_type == FLOW_CONTROL && (tok->token_id == 3 || tok->token_id == 4)) {
3306 tok->token_type = NOT_A_TOKEN;
3307 tok->token_id = JUMP_WITH_ILLEGAL_CHAR;
3308 return 0;
3309 }
3310 else
3311 return 1;
3312 }
3313 /*can't use function names as variables*/
3314 else if(tok->token_type == FUNCTION || tok->token_type == PARAM_FUNCTION) {
3315 tok->token_type = NOT_A_TOKEN;
3316 tok->token_id = FUNC_USED_AS_VAR;
3317 return 0;
3318 }
3319 else if(tok->token_type == FLOW_CONTROL && (tok->token_id == 1 || tok->token_id == 2)) {
3320 tok->token_type = NOT_A_TOKEN;
3321 tok->token_id = JUMP_MISSING_BOOLEAN;
3322 return 0;
3323 }
3324 else if (tok->token_type == FLOW_CONTROL && (tok->token_id == 3 || tok->token_id == 4)) {
3325 if (c == ',' || c == '\n' || c == ':')
3326 return 1;
3327 else {
3328 tok->token_type = NOT_A_TOKEN;
3329 tok->token_id = JUMP_WITH_ILLEGAL_CHAR;
3330 return 0;
3331 }
3332 }
3333 else {
3334 getvarinfo(tok);
3335 return 1;
3336 }
3337 }
3338 }
3339 tok->token_str[0] = (char) 0;
3340 tok->token_type = NOT_A_TOKEN;
3341 tok->token_id = END_OF_FILE;
3342 return 0;
3343 }
3344
3345 void frm_get_eos (FILE * openfile, struct token_st * this_token)
3346 {
3347 long last_filepos = ftell(openfile);
3348 int c;
3349 while ((c = frmgetchar(openfile)) == '\n' || c == ',' || c == ':') {
3350 if (c == ':') {
3351 this_token->token_str[0] = ':';
3352 }
3353 last_filepos = ftell(openfile);
3354 }
3355 if (c == '}') {
3356 this_token->token_str[0] = '}';
3357 this_token->token_type = END_OF_FORMULA;
3358 this_token->token_id = 0;
3359 }
3360 else {
3361 fseek (openfile, last_filepos, SEEK_SET);
3362 if (this_token->token_str[0] == '\n') {
3363 this_token->token_str[0] = ',';
3364 }
3365 }
3366 }
3367
3368 /*frmgettoken fills token structure; returns 1 on success and 0 on
3369 NOT_A_TOKEN and END_OF_FORMULA
3370 */
3371
3372 int frmgettoken(FILE * openfile, struct token_st * this_token)
3373 {
3374 int c;
3375 int i=1;
3376 long filepos;
3377
3378 switch (c = frmgetchar(openfile)) {
3379 CASE_NUM: case '.':
3380 this_token->token_str[0] = (char) c;
3381 return frmgetconstant(openfile, this_token);
3382 CASE_ALPHA: case '_':
3383 this_token->token_str[0] = (char) c;
3384 return frmgetalpha(openfile, this_token);
3385 CASE_TERMINATOR:
3386 this_token->token_type = OPERATOR; /* this may be changed below */
3387 this_token->token_str[0] = (char) c;
3388 filepos = ftell(openfile);
3389 if(c=='<' || c=='>' || c=='=') {
3390 if((c=frmgetchar(openfile)) == '=')
3391 this_token->token_str[i++] = (char) c;
3392 else {
3393 fseek(openfile, filepos, SEEK_SET);
3394 }
3395 }
3396 else if(c=='!') {
3397 if((c=frmgetchar(openfile)) == '=')
3398 this_token->token_str[i++] = (char) c;
3399 else {
3400 fseek(openfile, filepos, SEEK_SET);
3401 this_token->token_str[1] = (char) 0;
3402 this_token->token_type = NOT_A_TOKEN;
3403 this_token->token_id = ILLEGAL_OPERATOR;
3404 return 0;
3405 }
3406 }
3407 else if(c=='|') {
3408 if((c=frmgetchar(openfile)) == '|')
3409 this_token->token_str[i++] = (char) c;
3410 else
3411 fseek(openfile, filepos, SEEK_SET);
3412 }
3413 else if (c=='&') {
3414 if((c=frmgetchar(openfile)) == '&')
3415 this_token->token_str[i++] = (char) c;
3416 else {
3417 fseek(openfile, filepos, SEEK_SET);
3418 this_token->token_str[1] = (char) 0;
3419 this_token->token_type = NOT_A_TOKEN;
3420 this_token->token_id = ILLEGAL_OPERATOR;
3421 return 0;
3422 }
3423 }
3424 else if(this_token->token_str[0] == '}') {
3425 this_token->token_type = END_OF_FORMULA;
3426 this_token->token_id = 0;
3427 }
3428 else if (this_token->token_str[0] == '\n'
3429 || this_token->token_str[0] == ','
3430 || this_token->token_str[0] == ':' ) {
3431 frm_get_eos(openfile, this_token);
3432 }
3433 else if (this_token->token_str[0] == ')') {
3434 this_token->token_type = PARENS;
3435 this_token->token_id = CLOSE_PARENS;
3436 }
3437 else if (this_token->token_str[0] == '(') {
3438 /* the following function will set token_type to PARENS and
3439 token_id to OPEN_PARENS if this is not the start of a
3440 complex constant */
3441 is_complex_constant(openfile, this_token);
3442 return 1;
3443 }
3444 this_token->token_str[i] = (char) 0;
3445 if(this_token->token_type == OPERATOR) {
3446 for(i=0; i < sizeof(OPList)/sizeof(struct OP_LIST); i++) {
3447 if(!far_strcmp(OPList[i].s, this_token->token_str)) {
3448 this_token->token_id = i;
3449 }
3450 }
3451 }
3452 return this_token->token_str[0] == '}' ? 0 : 1;
3453 case EOF: case '\032':
3454 this_token->token_str[0] = (char) 0;
3455 this_token->token_type = NOT_A_TOKEN;
3456 this_token->token_id = END_OF_FILE;
3457 return 0;
3458 default:
3459 this_token->token_str[0] = (char) c;
3460 this_token->token_str[1] = (char) 0;
3461 this_token->token_type = NOT_A_TOKEN;
3462 this_token->token_id = ILLEGAL_CHARACTER;
3463 return 0;
3464 }
3465 }
3466
3467 int frm_get_param_stuff (char * Name)
3468 {
3469 FILE *debug_token = NULL;
3470 int c;
3471 struct token_st current_token;
3472 FILE * entry_file = NULL;
3473 uses_p1 = uses_p2 = uses_p3 = uses_ismand = maxfn = 0;
3474 uses_p4 = uses_p5 = 0;
3475
3476 if (FormName[0] == 0 ) {
3477 return 0; /* and don't reset the pointers */
3478 }
3479 if (find_file_item(FormFileName,Name,&entry_file, 1)) {
3480 stopmsg(0, ParseErrs(PE_COULD_NOT_OPEN_FILE_WHERE_FORMULA_LOCATED));
3481 return 0;
3482 }
3483 while((c=frmgetchar(entry_file)) != '{' && c != EOF && c != '\032')
3484 {}
3485 if (c != '{') {
3486 stopmsg(0,ParseErrs(PE_UNEXPECTED_EOF));
3487 fclose(entry_file);
3488 return 0;
3489 }
3490
3491 if(debugflag == 96) {
3492 if((debug_token = fopen("frmtokens.txt","at")) != NULL)
3493 fprintf(debug_token,"%s\n", Name);
3494 }
3495 while(frmgettoken(entry_file, ¤t_token)) {
3496 if (debug_token != NULL) {
3497 fprintf(debug_token,"%s\n", current_token.token_str);
3498 fprintf(debug_token,"token_type is %d\n", current_token.token_type);
3499 fprintf(debug_token,"token_id is %d\n", current_token.token_id);
3500 if (current_token.token_type == REAL_CONSTANT || current_token.token_type == COMPLEX_CONSTANT) {
3501 fprintf(debug_token,"Real value is %f\n", current_token.token_const.x);
3502 fprintf(debug_token,"Imag value is %f\n", current_token.token_const.y);
3503 }
3504 fprintf(debug_token,"\n");
3505 }
3506 switch (current_token.token_type) {
3507 case PARAM_VARIABLE:
3508 if(current_token.token_id == 1)
3509 uses_p1 = 1;
3510 else if(current_token.token_id == 2)
3511 uses_p2 = 1;
3512 else if(current_token.token_id == 8)
3513 uses_p3 = 1;
3514 else if(current_token.token_id == 13)
3515 uses_ismand = 1;
3516 else if(current_token.token_id == 17)
3517 uses_p4 = 1;
3518 else if(current_token.token_id == 18)
3519 uses_p5 = 1;
3520 break;
3521 case PARAM_FUNCTION:
3522 if((current_token.token_id - 10) > maxfn)
3523 maxfn = (char) (current_token.token_id - 10);
3524 break;
3525 }
3526 }
3527 fclose(entry_file);
3528 if(debug_token)
3529 fclose(debug_token);
3530 if (current_token.token_type != END_OF_FORMULA) {
3531 uses_p1 = uses_p2 = uses_p3 = uses_ismand = maxfn = 0;
3532 uses_p4 = uses_p5 = 0;
3533 return 0;
3534 }
3535 return 1;
3536 }
3537
3538 /* frm_check_name_and_sym():
3539 error checking to the open brace on the first line; return 1
3540 on success, 2 if an invalid symmetry is found, and 0 if errors
3541 are found which should cause the formula not to be executed
3542 */
3543
3544 int frm_check_name_and_sym (FILE * open_file, int report_bad_sym)
3545 {
3546 long filepos = ftell(open_file);
3547 int c, i, done, at_end_of_name;
3548
3549 /* first, test name */
3550 done = at_end_of_name = i = 0;
3551 while(!done) {
3552 switch (c = getc(open_file)) {
3553 case EOF: case '\032':
3554 stopmsg(0,ParseErrs(PE_UNEXPECTED_EOF));
3555 return 0;
3556 case '\r': case '\n':
3557 stopmsg(0,ParseErrs(PE_NO_LEFT_BRACKET_FIRST_LINE));
3558 return 0;
3559 case ' ': case '\t':
3560 at_end_of_name = 1;
3561 break;
3562 case '(': case '{':
3563 done = 1;
3564 break;
3565 default :
3566 if (!at_end_of_name)
3567 i++;
3568 break;
3569 }
3570 }
3571
3572 if(i > ITEMNAMELEN) {
3573 int j;
3574 int k = far_strlen(ParseErrs(PE_FORMULA_NAME_TOO_LARGE));
3575 char msgbuf[100];
3576 far_strcpy(msgbuf, ParseErrs(PE_FORMULA_NAME_TOO_LARGE));
3577 strcat(msgbuf, ":\n ");
3578 fseek(open_file, filepos, SEEK_SET);
3579 for(j = 0; j < i && j < 25; j++)
3580 msgbuf[j+k+2] = (char) getc(open_file);
3581 msgbuf[j+k+2] = (char) 0;
3582 stopmsg(8, msgbuf);
3583 return 0;
3584 }
3585 /* get symmetry */
3586 symmetry = 0;
3587 if (c == '(') {
3588 char sym_buf[20];
3589 done = i = 0;
3590 while(!done) {
3591 switch (c = getc(open_file)) {
3592 case EOF: case '\032':
3593 stopmsg(0,ParseErrs(PE_UNEXPECTED_EOF));
3594 return 0;
3595 case '\r': case '\n':
3596 stopmsg(8,ParseErrs(PE_NO_LEFT_BRACKET_FIRST_LINE));
3597 return 0;
3598 case '{':
3599 stopmsg(8,ParseErrs(PE_NO_MATCH_RIGHT_PAREN));
3600 return 0;
3601 case ' ': case '\t':
3602 break;
3603 case ')':
3604 done = 1;
3605 break;
3606 default :
3607 if(i < 19)
3608 sym_buf[i++] = (char) toupper(c);
3609 break;
3610 }
3611 }
3612 sym_buf[i] = (char) 0;
3613 for(i = 0; SymStr[i].s[0]; i++) {
3614 if(!stricmp(SymStr[i].s, sym_buf)) {
3615 symmetry = SymStr[i].n;
3616 break;
3617 }
3618 }
3619 if(SymStr[i].s[0] == (char) 0 && report_bad_sym) {
3620 char far * msgbuf = (char far*) farmemalloc(far_strlen(ParseErrs(PE_INVALID_SYM_USING_NOSYM))
3621 + strlen(sym_buf) + 6);
3622 far_strcpy(msgbuf, ParseErrs(PE_INVALID_SYM_USING_NOSYM));
3623 far_strcat(msgbuf, ":\n ");
3624 far_strcat(msgbuf, sym_buf);
3625 stopmsg(8, msgbuf);
3626 farmemfree(msgbuf);
3627 }
3628 }
3629 if (c != '{') {
3630 done = 0;
3631 while(!done) {
3632 switch (c = getc(open_file)) {
3633 case EOF: case '\032':
3634 stopmsg(8,ParseErrs(PE_UNEXPECTED_EOF));
3635 return 0;
3636 case '\r': case '\n':
3637 stopmsg(8,ParseErrs(PE_NO_LEFT_BRACKET_FIRST_LINE));
3638 return 0;
3639 case '{':
3640 done = 1;
3641 break;
3642 default :
3643 break;
3644 }
3645 }
3646 }
3647 return 1;
3648 }
3649
3650
3651 static char *PrepareFormula(FILE * File, int from_prompts1c) {
3652
3653 /* GGM 5-23-96: replaces FindFormula(). This function sets the
3654 symmetry and converts a formula into a string with no spaces,
3655 and one comma after each expression except where the ':' is placed
3656 and except the final expression in the formula. The open file passed
3657 as an argument is open in "rb" mode and is positioned at the first
3658 letter of the name of the formula to be prepared. This function
3659 is called from RunForm() below.
3660 */
3661
3662 FILE *debug_fp = NULL;
3663 char *FormulaStr;
3664 struct token_st temp_tok;
3665 int Done;
3666 long filepos = ftell(File);
3667
3668 /* char debugmsg[500];
3669 */
3670
3671 /*Test for a repeat*/
3672
3673 if (frm_check_name_and_sym(File, from_prompts1c) == 0) {
3674 fseek(File, filepos, SEEK_SET);
3675 return NULL;
3676 }
3677 if(!frm_prescan(File)) {
3678 fseek(File, filepos, SEEK_SET);
3679 return NULL;
3680 }
3681
3682 if(chars_in_formula > 8190) {
3683 fseek(File, filepos, SEEK_SET);
3684 return NULL;
3685 }
3686
3687 if(debugflag == 96)
3688 {
3689 if((debug_fp = fopen("debugfrm.txt","at")) != NULL) {
3690 fprintf(debug_fp,"%s\n",FormName);
3691 if(symmetry != 0)
3692 fprintf(debug_fp,"%s\n", SymStr[symmetry].s);
3693 }
3694 }
3695
3696 FormulaStr = (char *)boxx;
3697 FormulaStr[0] = (char) 0; /* To permit concantenation later */
3698
3699 Done = 0;
3700
3701 /*skip opening end-of-lines */
3702 while(!Done) {
3703 frmgettoken(File, &temp_tok);
3704 if (temp_tok.token_type == NOT_A_TOKEN) {
3705 stopmsg(8, "Unexpected token error in PrepareFormula\n");
3706 fseek(File, filepos, SEEK_SET);
3707 return NULL;
3708 }
3709 else if (temp_tok.token_type == END_OF_FORMULA) {
3710 stopmsg(8, "Formula has no executable instructions\n");
3711 fseek(File, filepos, SEEK_SET);
3712 return NULL;
3713 }
3714 if (temp_tok.token_str[0] == ',')
3715 ;
3716 else {
3717 strcat(FormulaStr, temp_tok.token_str);
3718 Done = 1;
3719 }
3720 }
3721
3722 Done = 0;
3723 while(!Done) {
3724 frmgettoken(File, &temp_tok);
3725 switch (temp_tok.token_type) {
3726 case NOT_A_TOKEN:
3727 stopmsg(8, "Unexpected token error in PrepareFormula\n");
3728 fseek(File, filepos, SEEK_SET);
3729 return NULL;
3730 case END_OF_FORMULA:
3731 Done = 1;
3732 fseek(File, filepos, SEEK_SET);
3733 break;
3734 default:
3735 strcat(FormulaStr, temp_tok.token_str);
3736 break;
3737 }
3738 }
3739
3740 if(debug_fp != NULL && FormulaStr != NULL)
3741 fprintf(debug_fp," %s\n",FormulaStr);
3742 if(debug_fp != NULL)
3743 fclose(debug_fp);
3744
3745
3746 /* sprintf(debugmsg, "Chars in formula per boxx is %u.\n", strlen(FormulaStr));
3747 stopmsg(0, debugmsg);
3748 */
3749 return FormulaStr;
3750 }
3751
3752 int BadFormula(void) {
3753 /* moved from Parsera.Asm by CAE 12 July 1993 */
3754
3755 /* this is called when a formula is bad, instead of calling */
3756 /* the normal functions which will produce undefined results */
3757 return 1;
3758 }
3759
3760 int RunForm(char *Name, int from_prompts1c) { /* returns 1 if an error occurred */
3761
3762 FILE * entry_file = NULL;
3763
3764 /* CAE changed fn 12 July 1993 to fix problem when formula not found */
3765
3766 /* first set the pointers so they point to a fn which always returns 1 */
3767 curfractalspecific->per_pixel = BadFormula;
3768 curfractalspecific->orbitcalc = BadFormula;
3769
3770 if (FormName[0] == 0 ){
3771 return 1; /* and don't reset the pointers */
3772 }
3773
3774 /* TW 5-31-94 add search for FRM files in directory */
3775 if (find_file_item(FormFileName,Name,&entry_file, 1)) {
3776 stopmsg(0, ParseErrs(PE_COULD_NOT_OPEN_FILE_WHERE_FORMULA_LOCATED));
3777 return 1;
3778 }
3779
3780 FormStr = PrepareFormula(entry_file, from_prompts1c );
3781 fclose(entry_file);
3782
3783 if(FormStr) /* No errors while making string */
3784 {
3785 parser_allocate(); /* ParseStr() will test if this alloc worked */
3786 if (ParseStr(FormStr,1))
3787 return 1; /* parse failed, don't change fn pointers */
3788 else
3789 {
3790 if(uses_jump == 1 && fill_jump_struct() == 1) {
3791 stopmsg(0, ParseErrs(PE_ERROR_IN_PARSING_JUMP_STATEMENTS));
3792 return 1;
3793 }
3794
3795 /* all parses succeeded so set the pointers back to good functions*/
3796 curfractalspecific->per_pixel = form_per_pixel;
3797 curfractalspecific->orbitcalc = Formula;
3798 return 0;
3799 }
3800 }
3801 else
3802 return 1; /* error in making string*/
3803 }
3804
3805
3806 int fpFormulaSetup(void) {
3807
3808 int RunFormRes; /* CAE fp */
3809 #ifndef XFRACT
3810 if (fpu > 0) {
3811 MathType = D_MATH;
3812 /* CAE changed below for fp */
3813 RunFormRes = !RunForm(FormName, 0); /* RunForm() returns 1 for failure */
3814 if (RunFormRes && fpu >=387 && debugflag != 90 && (orbitsave&2) == 0
3815 && !Randomized)
3816 return CvtStk(); /* run fast assembler code in parsera.asm */
3817 return RunFormRes;
3818 }
3819 else {
3820 MathType = M_MATH;
3821 return !RunForm(FormName, 0);
3822 }
3832 #endif
3833 }
3834
3835 int intFormulaSetup(void) {
3836 #ifdef XFRACT
3839 #else
3840 MathType = L_MATH;
3841 fg = (double)(1L << bitshift);
3842 fgLimit = (double)0x7fffffffL / fg;
3843 ShiftBack = 32 - bitshift;
3844 #endif
3845 return(!RunForm(FormName, 0));
3846 }
3847
3848
3849 /* TIW added 06-20-90 so functions can be called from fractals.c */
3850 void init_misc()
3851 {
3852 static struct ConstArg far vv[5];
3853 static union Arg argfirst,argsecond;
3854 if(!v)
3855 v = vv;
3856 Arg1 = &argfirst; Arg2 = &argsecond; /* needed by all the ?Stk* functions */
3857 fg = (double)(1L << bitshift);
3858 fgLimit = (double)0x7fffffffL / fg;
3859 ShiftBack = 32 - bitshift;
3860 Delta16 = bitshift - 16;
3861 bitshiftless1 = bitshift-1;
3862 uses_p1 = uses_p2 = uses_p3 = uses_jump = uses_ismand = 0;
3863 uses_p4 = uses_p5 = 0;
3864 }
3865
3866
3867 /* PB 910417 here to end changed.
3868 Allocate sub-arrays from one main farmemalloc, using global variable
3869 typespecific_workarea; calcfrac.c releases this area when calculation
3870 ends or is terminated.
3871 Moved the "f" array to be allocated as part of this.
3872 */
3873
3874 long total_formula_mem;
3875 BYTE used_extra = 0;
3876 static void parser_allocate(void)
3877 {
3878 /* CAE fp changed below for v18 */
3879 /* Note that XFRACT will waste about 6k here for pfls */
3880 /* Somewhat more memory is now allocated than in v17 here */
3881 /* however Store and Load were reduced in size to help make up for it */
3882
3883 long f_size,Store_size,Load_size,v_size, p_size;
3884 int pass, is_bad_form=0;
3885 long end_dx_array;
3886 /* TW Jan 1 1996 Made two passes to determine actual values of
3887 Max_Ops and Max_Args. Now use the end of extraseg if possible, so
3888 if less than 2048x2048 resolution is used, usually no farmemalloc
3889 calls are needed */
3890 for(pass = 0; pass < 2; pass++)
3891 {
3892 free_workarea();
3893 if(pass == 0) {
3894 Max_Ops = 2300; /* this value uses up about 64K memory */
3895 Max_Args = (unsigned)(Max_Ops/2.5);
3896 }
3897 f_size = sizeof(void(far * far *)(void)) * Max_Ops;
3898 Store_size = sizeof(union Arg far *) * MAX_STORES;
3899 Load_size = sizeof(union Arg far *) * MAX_LOADS;
3900 v_size = sizeof(struct ConstArg) * Max_Args;
3901 p_size = sizeof(struct fls far *) * Max_Ops;
3902 total_formula_mem = f_size+Load_size+Store_size+v_size+p_size /*+ jump_size*/
3903 + sizeof(struct PEND_OP) * Max_Ops;
3904 used_extra = 0;
3905
3906 if(use_grid)
3907 end_dx_array = 2L*(long)(xdots+ydots)*sizeof(double);
3908 else
3909 end_dx_array = 0;
3910
3911 if(pass == 0 || is_bad_form)
3912 {
3913 typespecific_workarea = (char far *)MK_FP(extraseg,0);
3914 used_extra = 1;
3915 }
3916 else if(1L<<16 > end_dx_array + total_formula_mem)
3917 {
3918 typespecific_workarea = (char far *)MK_FP(extraseg,0) + end_dx_array;
3919 used_extra = 1;
3920 }
3921 else if(is_bad_form == 0)
3922 {
3923 typespecific_workarea =
3924 (char far *)farmemalloc((long)(f_size+Load_size+Store_size+v_size+p_size));
3925 used_extra = 0;
3926 }
3927 f = (void(far * far *)(void))typespecific_workarea;
3928 Store = (union Arg far * far *)(f + Max_Ops);
3929 Load = (union Arg far * far *)(Store + MAX_STORES);
3930 v = (struct ConstArg far *)(Load + MAX_LOADS);
3931 pfls = (struct fls far *)(v + Max_Args);
3932
3933 if(pass == 0)
3934 {
3935 if((is_bad_form = ParseStr(FormStr,pass)) == 0)
3936 {
3937 /* per Chuck Ebbert, fudge these up a little */
3938 Max_Ops = posp+4;
3939 Max_Args = vsp+4;
3940 }
3941 typespecific_workarea = NULL;
3942 }
3943 }
3944 uses_p1 = uses_p2 = uses_p3 = uses_p4 = uses_p5 = 0;
3945 }
3946
3947 void free_workarea()
3948 {
3949 if(typespecific_workarea && used_extra == 0) {
3950 farmemfree(typespecific_workarea);
3951 }
3952 typespecific_workarea = NULL;
3953 Store = (union Arg far * far *)0;
3954 Load = (union Arg far * far *)0;
3955 v = (struct ConstArg far *)0;
3956 f = (void(far * far *)(void))0; /* CAE fp */
3957 pfls = (struct fls far * )0; /* CAE fp */
3958 total_formula_mem = 0;
3959
3960 /* restore extraseg */
3961 if(integerfractal && !invert)
3962 fill_lx_array();
3963 else
3964 fill_dx_array();
3965 }
3966
3967
3968 struct error_data_st {
3969 long start_pos;
3970 long error_pos;
3971 int error_number;
3972 } errors[3];
3973
3974
3975 void frm_error(FILE * open_file, long begin_frm)
3976 {
3977 struct token_st tok;
3978 /* char debugmsg[500];
3979 */ int i, chars_to_error=0, chars_in_error=0, token_count;
3980 int statement_len, line_number;
3981 int done;
3982 char msgbuf[900];
3983 long filepos;
3984 int j;
3985 int initialization_error;
3986 strcpy (msgbuf, "\n");
3987
3988 for(j=0; j < 3 && errors[j].start_pos; j++) {
3989 initialization_error = errors[j].error_number == PE_SECOND_COLON ? 1 : 0;
3990 fseek(open_file, begin_frm, SEEK_SET);
3991 line_number = 1;
3992 while (ftell(open_file) != errors[j].error_pos) {
3993 if((i = fgetc(open_file)) == '\n') {
3994 line_number++;
3995 }
3996 else if (i == EOF || i == '}') {
3997 stopmsg(0, "Unexpected EOF or end-of-formula in error function.\n");
3998 fseek (open_file, errors[j].error_pos, SEEK_SET);
3999 frmgettoken(open_file, &tok); /*reset file to end of error token */
4000 return;
4001 }
4002 }
4003 #ifndef XFRACT
4004 sprintf(&msgbuf[strlen(msgbuf)], "Error(%d) at line %d: %Fs\n ", errors[j].error_number, line_number, ParseErrs(errors[j].error_number));
4007 #endif
4008 i = strlen(msgbuf);
4009 /* sprintf(debugmsg, "msgbuf is: %s\n and i is %d\n", msgbuf, i);
4010 stopmsg (0, debugmsg);
4011 */ fseek(open_file, errors[j].start_pos, SEEK_SET);
4012 statement_len = token_count = 0;
4013 done = 0;
4014 while(!done) {
4015 filepos = ftell (open_file);
4016 if(filepos == errors[j].error_pos) {
4017 /* stopmsg(0, "About to get error token\n");
4018 */ chars_to_error = statement_len;
4019 frmgettoken(open_file, &tok);
4020 chars_in_error = strlen(tok.token_str);
4021 statement_len += chars_in_error;
4022 token_count++;
4023 /* sprintf(debugmsg, "Error is %s\nChars in error is %d\nChars to error is %d\n", tok.token_str, chars_in_error, chars_to_error);
4024 stopmsg (0, debugmsg);
4025 */ }
4026 else {
4027 frmgettoken(open_file, &tok);
4028 /* sprintf(debugmsg, "Just got %s\n", tok.token_str);
4029 stopmsg (0, debugmsg);
4030 */ statement_len += strlen(tok.token_str);
4031 token_count++;
4032 }
4033 if ((tok.token_type == END_OF_FORMULA)
4034 || (tok.token_type == OPERATOR
4035 && (tok.token_id == 0 || tok.token_id == 11))
4036 || (tok.token_type == NOT_A_TOKEN && tok.token_id == END_OF_FILE)){
4037 done = 1;
4038 if (token_count > 1 && !initialization_error) {
4039 token_count--;
4040 }
4041 }
4042 }
4043 fseek(open_file, errors[j].start_pos, SEEK_SET);
4044 if(chars_in_error < 74) {
4045 while (chars_to_error + chars_in_error > 74) {
4046 /* stopmsg(0, "chars in error less than 74, but late in line");
4047 */ frmgettoken(open_file, &tok);
4048 chars_to_error -= strlen(tok.token_str);
4049 token_count--;
4050 }
4051 }
4052 else {
4053 fseek(open_file, errors[j].error_pos, SEEK_SET);
4054 chars_to_error = 0;
4055 token_count = 1;
4056 }
4057 /* stopmsg(0, "Back to beginning of statement to build msgbuf");
4058 */ while (strlen(&msgbuf[i]) <=74 && token_count--) {
4059 frmgettoken (open_file, &tok);
4060 strcat (msgbuf, tok.token_str);
4061 /* stopmsg(0, &msgbuf[i]);
4062 */ }
4063 fseek (open_file, errors[j].error_pos, SEEK_SET);
4064 frmgettoken (open_file, &tok);
4065 if (strlen(&msgbuf[i]) > 74)
4066 msgbuf[i + 74] = (char) 0;
4067 strcat(msgbuf, "\n");
4068 i = strlen(msgbuf);
4069 while (chars_to_error-- > -2)
4070 strcat (msgbuf, " ");
4071 /* sprintf(debugmsg, "Going into final line, chars in error is %d", chars_in_error);
4072 stopmsg(0, debugmsg);
4073 */
4074 if(errors[j].error_number == PE_TOKEN_TOO_LONG) {
4075 chars_in_error = 33;
4076 }
4077 while (chars_in_error-- && strlen(&msgbuf[i]) <=74)
4078 strcat (msgbuf, "^");
4079 strcat (msgbuf, "\n");
4080 }
4081 stopmsg (8, msgbuf);
4082 return;
4083 }
4084
4085 void display_var_list()
4086 {
4087 struct var_list_st far * p;
4088 stopmsg(0, "List of user defined variables:\n");
4089 for (p = var_list; p; p=p->next_item) {
4090 stopmsg(0, p->name);
4091 }
4092
4093 }
4094
4095 void display_const_lists()
4096 {
4097 struct const_list_st far * p;
4098 char msgbuf[800];
4099 stopmsg (0, "Complex constants are:");
4100 for (p = complx_list; p; p=p->next_item) {
4101 sprintf(msgbuf, "%f, %f\n", p->complex_const.x, p->complex_const.y);
4102 stopmsg(0, msgbuf);
4103 }
4104 stopmsg (0, "Real constants are:");
4105 for (p = real_list; p; p=p->next_item) {
4106 sprintf(msgbuf, "%f, %f\n", p->complex_const.x, p->complex_const.y);
4107 stopmsg(0, msgbuf);
4108 }
4109 }
4110
4111
4112 struct var_list_st far *var_list_alloc() {
4113 return (struct var_list_st far*) farmemalloc(sizeof(struct var_list_st));
4114 }
4115
4116
4117 struct const_list_st far *const_list_alloc() {
4118 return (struct const_list_st far *) farmemalloc(sizeof(struct const_list_st));
4119 }
4120
4121 void init_var_list()
4122 {
4123 struct var_list_st far * temp, far * p;
4124 for (p = var_list; p; p=temp) {
4125 temp = p->next_item;
4126 farmemfree(p);
4127 }
4128 var_list = NULL;
4129 }
4130
4131
4132 void init_const_lists()
4133 {
4134 struct const_list_st far * temp, far * p;
4135 for (p = complx_list; p; p=temp) {
4136 temp = p->next_item;
4137 farmemfree(p);
4138 }
4139 complx_list = NULL;
4140 for (p = real_list; p; p=temp) {
4141 temp = p->next_item;
4142 farmemfree(p);
4143 }
4144 real_list = NULL;
4145 }
4146
4147 struct var_list_st far * add_var_to_list (struct var_list_st far * p, struct token_st tok) {
4148 if (p == NULL) {
4149 if ((p = var_list_alloc()) == NULL)
4150 return NULL;
4151 far_strcpy(p->name, tok.token_str);
4152 p->next_item = NULL;
4153 }
4154 else if (far_strcmp(p->name, tok.token_str) == 0) {
4155 }
4156 else {
4157 if ((p->next_item = add_var_to_list(p->next_item, tok)) == NULL)
4158 return NULL;
4159 }
4160 return p;
4161 }
4162
4163 struct const_list_st far * add_const_to_list (struct const_list_st far * p, struct token_st tok) {
4164 if (p == NULL) {
4165 if ((p = const_list_alloc()) == NULL)
4166 return NULL;
4167 p->complex_const.x = tok.token_const.x;
4168 p->complex_const.y = tok.token_const.y;
4169 p->next_item = NULL;
4170 }
4171 else if (p->complex_const.x == tok.token_const.x && p->complex_const.y == tok.token_const.y) {
4172 }
4173 else
4174 if ((p->next_item = add_const_to_list(p->next_item, tok)) == NULL)
4175 return NULL;
4176 return p;
4177 }
4178
4179 void count_lists()
4180 {
4181 /* char msgbuf[800];
4182 */ struct var_list_st far * p;
4183 struct const_list_st far * q;
4184
4185 var_count = 0;
4186 complx_count = 0;
4187 real_count = 0;
4188
4189 for (p = var_list; p; p=p->next_item) {
4190 var_count++;
4191 }
4192 for (q = complx_list; q; q=q->next_item) {
4193 complx_count++;
4194 }
4195 for (q = real_list; q; q=q->next_item) {
4196 real_count++;
4197 }
4198 /* sprintf(msgbuf, "Number of vars is %d\nNumber of complx is %d\nNumber of real is %d\n", var_count, complx_count, real_count);
4199 stopmsg(0, msgbuf);
4200 */
4201 }
4202
4203
4204
4205 /*frm_prescan() takes an open file with the file pointer positioned at
4206 the beginning of the relevant formula, and parses the formula, token
4207 by token, for syntax errors. The function also accumulates data for
4208 memory allocation to be done later.
4209
4210 The function returns 1 if success, and 0 if errors are found.
4211 */
4212
4213 int disable_fastparser;
4214 int must_use_float;
4215
4216
4217 int frm_prescan (FILE * open_file)
4218 {
4219 long filepos;
4220 int i;
4221 long statement_pos, orig_pos;
4222 int done = 0;
4223 struct token_st this_token;
4224 int errors_found = 0;
4225 int ExpectingArg = 1;
4226 int NewStatement = 1;
4227 int assignment_ok = 1;
4228 int already_got_colon = 0;
4229 unsigned long else_has_been_used = 0;
4230 unsigned long waiting_for_mod = 0;
4231 int waiting_for_endif = 0;
4232 int max_parens = sizeof(long) * 8;
4233 /* char debugmsg[800];
4234 stopmsg (0, "Entering prescan");
4235 */
4236
4237 disable_fastparser = 0;
4238 must_use_float = 0;
4239
4240 number_of_ops = number_of_loads = number_of_stores = number_of_jumps = (unsigned) 0L;
4241 chars_in_formula = (unsigned) 0;
4242 uses_jump = (short) 0;
4243 paren = 0;
4244
4245 init_var_list();
4246 init_const_lists();
4247
4248 orig_pos = statement_pos = ftell(open_file);
4249 for (i = 0; i < 3; i++) {
4250 errors[i].start_pos = 0L;
4251 errors[i].error_pos = 0L;
4252 errors[i].error_number = 0;
4253 }
4254
4255 while (!done) {
4256 /* char msgbuf[80] = "Just got ";
4257 */ filepos = ftell (open_file);
4258 frmgettoken (open_file, &this_token);
4259 /* strcat(msgbuf, this_token.token_str);
4260 stopmsg (0, msgbuf);
4261 sprintf (debugmsg, "Errors structure\n0: %ld, %ld, %d\n1: %ld, %ld, %d\n2: %ld, %ld, %d\n\n",
4262 errors[0].start_pos, errors[0].error_pos, errors[0].error_number,
4263 errors[1].start_pos, errors[1].error_pos, errors[1].error_number,
4264 errors[2].start_pos, errors[2].error_pos, errors[2].error_number);
4265 stopmsg (0, debugmsg);
4266 */
4267 chars_in_formula += strlen(this_token.token_str);
4268 switch (this_token.token_type) {
4269 case NOT_A_TOKEN:
4270 assignment_ok = 0;
4271 switch (this_token.token_id) {
4272 case END_OF_FILE:
4273 stopmsg(0,ParseErrs(PE_UNEXPECTED_EOF));
4274 fseek(open_file, orig_pos, SEEK_SET);
4275 return 0;
4276 case ILLEGAL_CHARACTER:
4277 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4278 errors[errors_found].start_pos = statement_pos;
4279 errors[errors_found].error_pos = filepos;
4280 errors[errors_found++].error_number = PE_ILLEGAL_CHAR;
4281 }
4282 break;
4283 case ILLEGAL_VARIABLE_NAME:
4284 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4285 errors[errors_found].start_pos = statement_pos;
4286 errors[errors_found].error_pos = filepos;
4287 errors[errors_found++].error_number = PE_ILLEGAL_VAR_NAME;
4288 }
4289 break;
4290 case TOKEN_TOO_LONG:
4291 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4292 errors[errors_found].start_pos = statement_pos;
4293 errors[errors_found].error_pos = filepos;
4294 errors[errors_found++].error_number = PE_TOKEN_TOO_LONG;
4295 }
4296 break;
4297 case FUNC_USED_AS_VAR:
4298 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4299 errors[errors_found].start_pos = statement_pos;
4300 errors[errors_found].error_pos = filepos;
4301 errors[errors_found++].error_number = PE_FUNC_USED_AS_VAR;
4302 }
4303 break;
4304 case JUMP_MISSING_BOOLEAN:
4305 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4306 errors[errors_found].start_pos = statement_pos;
4307 errors[errors_found].error_pos = filepos;
4308 errors[errors_found++].error_number = PE_JUMP_NEEDS_BOOLEAN;
4309 }
4310 break;
4311 case JUMP_WITH_ILLEGAL_CHAR:
4312 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4313 errors[errors_found].start_pos = statement_pos;
4314 errors[errors_found].error_pos = filepos;
4315 errors[errors_found++].error_number = PE_NO_CHAR_AFTER_THIS_JUMP;
4316 }
4317 break;
4318 case UNDEFINED_FUNCTION:
4319 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4320 errors[errors_found].start_pos = statement_pos;
4321 errors[errors_found].error_pos = filepos;
4322 errors[errors_found++].error_number = PE_UNDEFINED_FUNCTION;
4323 }
4324 break;
4325 case ILLEGAL_OPERATOR:
4326 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4327 errors[errors_found].start_pos = statement_pos;
4328 errors[errors_found].error_pos = filepos;
4329 errors[errors_found++].error_number = PE_UNDEFINED_OPERATOR;
4330 }
4331 break;
4332 case ILL_FORMED_CONSTANT:
4333 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4334 errors[errors_found].start_pos = statement_pos;
4335 errors[errors_found].error_pos = filepos;
4336 errors[errors_found++].error_number = PE_INVALID_CONST;
4337 }
4338 break;
4339 default:
4340 stopmsg(0, "Unexpected arrival at default case in prescan()");
4341 fseek(open_file, orig_pos, SEEK_SET);
4342 return 0;
4343 }
4344 break;
4345 case PARENS:
4346 assignment_ok = 0;
4347 NewStatement = 0;
4348 switch (this_token.token_id) {
4349 case OPEN_PARENS:
4350 if(++paren > max_parens) {
4351 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4352 errors[errors_found].start_pos = statement_pos;
4353 errors[errors_found].error_pos = filepos;
4354 errors[errors_found++].error_number = PE_NESTING_TO_DEEP;
4355 }
4356 }
4357 else if(!ExpectingArg) {
4358 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4359 errors[errors_found].start_pos = statement_pos;
4360 errors[errors_found].error_pos = filepos;
4361 errors[errors_found++].error_number = PE_SHOULD_BE_OPERATOR;
4362 }
4363 }
4364 waiting_for_mod = waiting_for_mod << 1;
4365 break;
4366 case CLOSE_PARENS:
4367 if(paren) {
4368 paren--;
4369 }
4370 else {
4371 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4372 errors[errors_found].start_pos = statement_pos;
4373 errors[errors_found].error_pos = filepos;
4374 errors[errors_found++].error_number = PE_NEED_A_MATCHING_OPEN_PARENS;
4375 }
4376 paren = 0;
4377 }
4378 if (waiting_for_mod & 1L) {
4379 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4380 errors[errors_found].start_pos = statement_pos;
4381 errors[errors_found].error_pos = filepos;
4382 errors[errors_found++].error_number = PE_UNMATCHED_MODULUS;
4383 }
4384 }
4385 else {
4386 waiting_for_mod = waiting_for_mod >> 1;
4387 }
4388 if (ExpectingArg) {
4389 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4390 errors[errors_found].start_pos = statement_pos;
4391 errors[errors_found].error_pos = filepos;
4392 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4393 }
4394 }
4395 break;
4396 default:
4397 break;
4398 }
4399 break;
4400 case PARAM_VARIABLE: /*i.e. p1, p2, p3, p4 or p5*/
4401 number_of_ops++;
4402 number_of_loads++;
4403 NewStatement = 0;
4404 if(!ExpectingArg) {
4405 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4406 errors[errors_found].start_pos = statement_pos;
4407 errors[errors_found].error_pos = filepos;
4408 errors[errors_found++].error_number = PE_SHOULD_BE_OPERATOR;
4409 }
4410 }
4411 switch (this_token.token_id) {
4412 case 1:
4413 break;
4414 case 2:
4415 break;
4416 case 8:
4417 break;
4418 case 17:
4419 break;
4420 case 18:
4421 break;
4422 default:
4423 break;
4424 }
4425 ExpectingArg = 0;
4426 break;
4427 case USER_NAMED_VARIABLE: /* i.e. c, iter, etc. */
4428 number_of_ops++;
4429 number_of_loads++;
4430 NewStatement = 0;
4431 if(!ExpectingArg) {
4432 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4433 errors[errors_found].start_pos = statement_pos;
4434 errors[errors_found].error_pos = filepos;
4435 errors[errors_found++].error_number = PE_SHOULD_BE_OPERATOR;
4436 }
4437 }
4438 ExpectingArg = 0;
4439 /* if ((var_list = add_var_to_list (var_list, this_token)) == NULL) {
4440 stopmsg(0, ParseErrs(PE_INSUFFICIENT_MEM_FOR_TYPE_FORMULA));
4441 fseek(open_file, orig_pos, SEEK_SET);
4442 init_var_list();
4443 init_const_lists();
4444 return 0;
4445 }
4446 */ break;
4447 case PREDEFINED_VARIABLE: /* i.e. z, pixel, whitesq, etc. */
4448 number_of_ops++;
4449 number_of_loads++;
4450 NewStatement = 0;
4451 if(!ExpectingArg) {
4452 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4453 errors[errors_found].start_pos = statement_pos;
4454 errors[errors_found].error_pos = filepos;
4455 errors[errors_found++].error_number = PE_SHOULD_BE_OPERATOR;
4456 }
4457 }
4458 switch (this_token.token_id) {
4459 case 0: /* pixel */
4460 break;
4461 case 3: /* z */
4462 break;
4463 case 4: /* LastSqr */
4464 break;
4465 case 5: /* pi */
4466 break;
4467 case 6: /* e */
4468 break;
4469 case 7: /* rand */
4470 break;
4471 case 9: /* whitesq */
4472 break;
4473 case 10: /* scrnpix */
4474 break;
4475 case 11: /* scrnmax */
4476 break;
4477 case 12: /* maxit */
4478 break;
4479 case 13: /* ismand */
4480 break;
4481 default:
4482 break;
4483 }
4484 ExpectingArg = 0;
4485 break;
4486 case REAL_CONSTANT: /* i.e. 4, (4,0), etc.) */
4487 assignment_ok = 0;
4488 number_of_ops++;
4489 number_of_loads++;
4490 NewStatement = 0;
4491 if(!ExpectingArg) {
4492 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4493 errors[errors_found].start_pos = statement_pos;
4494 errors[errors_found].error_pos = filepos;
4495 errors[errors_found++].error_number = PE_SHOULD_BE_OPERATOR;
4496 }
4497 }
4498 ExpectingArg = 0;
4499 /* if ((real_list = add_const_to_list (real_list, this_token)) == NULL) {
4500 stopmsg(0, ParseErrs(PE_INSUFFICIENT_MEM_FOR_TYPE_FORMULA));
4501 fseek(open_file, orig_pos, SEEK_SET);
4502 init_var_list();
4503 init_const_lists();
4504 return 0;
4505 }
4506 */ break;
4507 case COMPLEX_CONSTANT: /* i.e. (1,2) etc. */
4508 assignment_ok = 0;
4509 number_of_ops++;
4510 number_of_loads++;
4511 NewStatement = 0;
4512 if(!ExpectingArg) {
4513 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4514 errors[errors_found].start_pos = statement_pos;
4515 errors[errors_found].error_pos = filepos;
4516 errors[errors_found++].error_number = PE_SHOULD_BE_OPERATOR;
4517 }
4518 }
4519 ExpectingArg = 0;
4520 /* if ((complx_list = add_const_to_list (complx_list, this_token)) == NULL) {
4521 stopmsg(0, ParseErrs(PE_INSUFFICIENT_MEM_FOR_TYPE_FORMULA));
4522 fseek(open_file, orig_pos, SEEK_SET);
4523 init_var_list();
4524 init_const_lists();
4525 return 0;
4526 }
4527 */ break;
4528 case FUNCTION:
4529 assignment_ok = 0;
4530 NewStatement = 0;
4531 number_of_ops++;
4532 if(!ExpectingArg) {
4533 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4534 errors[errors_found].start_pos = statement_pos;
4535 errors[errors_found].error_pos = filepos;
4536 errors[errors_found++].error_number = PE_SHOULD_BE_OPERATOR;
4537 }
4538 }
4539 switch (this_token.token_id) {
4540 case 0:
4541 break;
4542 case 1:
4543 break;
4544 case 2:
4545 break;
4546 case 3:
4547 break;
4548 case 4:
4549 break;
4550 case 5:
4551 break;
4552 case 6:
4553 break;
4554 case 7:
4555 break;
4556 case 8:
4557 break;
4558 case 9:
4559 break;
4560 case 10:
4561 break;
4562 case 15:
4563 break;
4564 case 16:
4565 break;
4566 case 17:
4567 break;
4568 case 18:
4569 break;
4570 case 19:
4571 break;
4572 case 20:
4573 break;
4574 case 21:
4575 break;
4576 case 22:
4577 break;
4578 case 23:
4579 break;
4580 case 24:
4581 break;
4582 case 25:
4583 break;
4584 case 26:
4585 break;
4586 case 27:
4587 break;
4588 case 28:
4589 break;
4590 case 29:
4591 break;
4592 case 30:
4593 break;
4594 case 31:
4595 break;
4596 case 32:
4597 break;
4598 case 33:
4599 break;
4600 case 34:
4601 break;
4602 default:
4603 break;
4604 }
4605 break;
4606 case PARAM_FUNCTION:
4607 assignment_ok = 0;
4608 NewStatement = 0;
4609 number_of_ops++;
4610 if(!ExpectingArg) {
4611 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4612 errors[errors_found].start_pos = statement_pos;
4613 errors[errors_found].error_pos = filepos;
4614 errors[errors_found++].error_number = PE_SHOULD_BE_OPERATOR;
4615 }
4616 }
4617 switch (this_token.token_id) {
4618 case 11:
4619 break;
4620 case 12:
4621 break;
4622 case 13:
4623 break;
4624 case 14:
4625 break;
4626 default:
4627 break;
4628 }
4629 NewStatement = 0;
4630 break;
4631 case FLOW_CONTROL:
4632 assignment_ok = 0;
4633 number_of_ops++;
4634 number_of_jumps++;
4635 if(!NewStatement) {
4636 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4637 errors[errors_found].start_pos = statement_pos;
4638 errors[errors_found].error_pos = filepos;
4639 errors[errors_found++].error_number = PE_JUMP_NOT_FIRST;
4640 }
4641 }
4642 else {
4643 uses_jump = 1;
4644 switch (this_token.token_id) {
4645 case 1: /* if */
4646 else_has_been_used = else_has_been_used << 1;
4647 waiting_for_endif++;
4648 break;
4649 case 2: /*ELSEIF*/
4650 number_of_ops += 3; /*else + two clear statements*/
4651 number_of_jumps++; /* this involves two jumps */
4652 if (else_has_been_used % 2) {
4653 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4654 errors[errors_found].start_pos = statement_pos;
4655 errors[errors_found].error_pos = filepos;
4656 errors[errors_found++].error_number = PE_ENDIF_REQUIRED_AFTER_ELSE;
4657 }
4658 }
4659 else if (!waiting_for_endif) {
4660 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4661 errors[errors_found].start_pos = statement_pos;
4662 errors[errors_found].error_pos = filepos;
4663 errors[errors_found++].error_number = PE_MISPLACED_ELSE_OR_ELSEIF;
4664 }
4665 }
4666 break;
4667 case 3: /*ELSE*/
4668 if (else_has_been_used % 2) {
4669 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4670 errors[errors_found].start_pos = statement_pos;
4671 errors[errors_found].error_pos = filepos;
4672 errors[errors_found++].error_number = PE_ENDIF_REQUIRED_AFTER_ELSE;
4673 }
4674 }
4675 else if (!waiting_for_endif) {
4676 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4677 errors[errors_found].start_pos = statement_pos;
4678 errors[errors_found].error_pos = filepos;
4679 errors[errors_found++].error_number = PE_MISPLACED_ELSE_OR_ELSEIF;
4680 }
4681 }
4682 else_has_been_used = else_has_been_used | 1;
4683 break;
4684 case 4: /*ENDIF*/
4685 else_has_been_used = else_has_been_used >> 1;
4686 waiting_for_endif--;
4687 if(waiting_for_endif < 0) {
4688 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4689 errors[errors_found].start_pos = statement_pos;
4690 errors[errors_found].error_pos = filepos;
4691 errors[errors_found++].error_number = PE_ENDIF_WITH_NO_IF;
4692 }
4693 waiting_for_endif = 0;
4694 }
4695 break;
4696 default:
4697 break;
4698 }
4699 }
4700 break;
4701 case OPERATOR:
4702 number_of_ops++; /*This will be corrected below in certain cases*/
4703 switch (this_token.token_id) {
4704 case 0: case 11: /* end of statement and : */
4705 number_of_ops++; /* ParseStr inserts a dummy op*/
4706 if (paren) {
4707 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4708 errors[errors_found].start_pos = statement_pos;
4709 errors[errors_found].error_pos = filepos;
4710 errors[errors_found++].error_number = PE_NEED_MORE_CLOSE_PARENS;
4711 }
4712 paren = 0;
4713 }
4714 if (waiting_for_mod) {
4715 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4716 errors[errors_found].start_pos = statement_pos;
4717 errors[errors_found].error_pos = filepos;
4718 errors[errors_found++].error_number = PE_UNMATCHED_MODULUS;
4719 }
4720 waiting_for_mod = 0;
4721 }
4722 if (!ExpectingArg) {
4723 if (this_token.token_id == 11)
4724 number_of_ops += 2;
4725 else
4726 number_of_ops++;
4727 }
4728 else if (!NewStatement) {
4729 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4730 errors[errors_found].start_pos = statement_pos;
4731 errors[errors_found].error_pos = filepos;
4732 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4733 }
4734 }
4735 if (this_token.token_id == 11 && waiting_for_endif) {
4736 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4737 errors[errors_found].start_pos = statement_pos;
4738 errors[errors_found].error_pos = filepos;
4739 errors[errors_found++].error_number = PE_UNMATCHED_IF_IN_INIT_SECTION;
4740 }
4741 waiting_for_endif = 0;
4742 }
4743 if (this_token.token_id == 11 && already_got_colon) {
4744 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4745 errors[errors_found].start_pos = statement_pos;
4746 errors[errors_found].error_pos = filepos;
4747 errors[errors_found++].error_number = PE_SECOND_COLON;
4748 }
4749 }
4750 if (this_token.token_id == 11)
4751 already_got_colon = 1;
4752 NewStatement = ExpectingArg = assignment_ok = 1;
4753 statement_pos = ftell(open_file);
4754 break;
4755 case 1: /* != */
4756 assignment_ok = 0;
4757 if(ExpectingArg) {
4758 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4759 errors[errors_found].start_pos = statement_pos;
4760 errors[errors_found].error_pos = filepos;
4761 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4762 }
4763 }
4764 ExpectingArg = 1;
4765 break;
4766 case 2: /* = */
4767 number_of_ops--; /*this just converts a load to a store*/
4768 number_of_loads--;
4769 number_of_stores++;
4770 if(!assignment_ok) {
4771 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4772 errors[errors_found].start_pos = statement_pos;
4773 errors[errors_found].error_pos = filepos;
4774 errors[errors_found++].error_number = PE_ILLEGAL_ASSIGNMENT;
4775 }
4776 }
4777 ExpectingArg = 1;
4778 break;
4779 case 3: /* == */
4780 assignment_ok = 0;
4781 if(ExpectingArg) {
4782 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4783 errors[errors_found].start_pos = statement_pos;
4784 errors[errors_found].error_pos = filepos;
4785 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4786 }
4787 }
4788 ExpectingArg = 1;
4789 break;
4790 case 4: /* < */
4791 assignment_ok = 0;
4792 if(ExpectingArg) {
4793 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4794 errors[errors_found].start_pos = statement_pos;
4795 errors[errors_found].error_pos = filepos;
4796 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4797 }
4798 }
4799 ExpectingArg = 1;
4800 break;
4801 case 5: /* <= */
4802 assignment_ok = 0;
4803 if(ExpectingArg) {
4804 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4805 errors[errors_found].start_pos = statement_pos;
4806 errors[errors_found].error_pos = filepos;
4807 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4808 }
4809 }
4810 ExpectingArg = 1;
4811 break;
4812 case 6: /* > */
4813 assignment_ok = 0;
4814 if(ExpectingArg) {
4815 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4816 errors[errors_found].start_pos = statement_pos;
4817 errors[errors_found].error_pos = filepos;
4818 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4819 }
4820 }
4821 ExpectingArg = 1;
4822 break;
4823 case 7: /* >= */
4824 assignment_ok = 0;
4825 if(ExpectingArg) {
4826 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4827 errors[errors_found].start_pos = statement_pos;
4828 errors[errors_found].error_pos = filepos;
4829 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4830 }
4831 }
4832 ExpectingArg = 1;
4833 break;
4834 case 8: /* | */ /* (half of the modulus operator */
4835 assignment_ok = 0;
4836 if(!waiting_for_mod & 1L) {
4837 number_of_ops--;
4838 }
4839 if(!(waiting_for_mod & 1L) && !ExpectingArg) {
4840 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4841 errors[errors_found].start_pos = statement_pos;
4842 errors[errors_found].error_pos = filepos;
4843 errors[errors_found++].error_number = PE_SHOULD_BE_OPERATOR;
4844 }
4845 }
4846 else if ((waiting_for_mod & 1L) && ExpectingArg) {
4847 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4848 errors[errors_found].start_pos = statement_pos;
4849 errors[errors_found].error_pos = filepos;
4850 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4851 }
4852 }
4853 waiting_for_mod = waiting_for_mod ^ 1L; /*switch right bit*/
4854 break;
4855 case 9: /* || */
4856 assignment_ok = 0;
4857 if(ExpectingArg) {
4858 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4859 errors[errors_found].start_pos = statement_pos;
4860 errors[errors_found].error_pos = filepos;
4861 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4862 }
4863 }
4864 ExpectingArg = 1;
4865 break;
4866 case 10: /* && */
4867 assignment_ok = 0;
4868 if(ExpectingArg) {
4869 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4870 errors[errors_found].start_pos = statement_pos;
4871 errors[errors_found].error_pos = filepos;
4872 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4873 }
4874 }
4875 ExpectingArg = 1;
4876 break;
4877 case 12: /* + */ /* case 11 (":") is up with case 0 */
4878 assignment_ok = 0;
4879 if(ExpectingArg) {
4880 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4881 errors[errors_found].start_pos = statement_pos;
4882 errors[errors_found].error_pos = filepos;
4883 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4884 }
4885 }
4886 ExpectingArg = 1;
4887 break;
4888 case 13: /* - */
4889 assignment_ok = 0;
4890 ExpectingArg = 1;
4891 break;
4892 case 14: /* * */
4893 assignment_ok = 0;
4894 if(ExpectingArg) {
4895 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4896 errors[errors_found].start_pos = statement_pos;
4897 errors[errors_found].error_pos = filepos;
4898 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4899 }
4900 }
4901 ExpectingArg = 1;
4902 break;
4903 case 15: /* / */
4904 assignment_ok = 0;
4905 if(ExpectingArg) {
4906 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4907 errors[errors_found].start_pos = statement_pos;
4908 errors[errors_found].error_pos = filepos;
4909 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4910 }
4911 }
4912 ExpectingArg = 1;
4913 break;
4914 case 16: /* ^ */
4915 assignment_ok = 0;
4916 if(ExpectingArg) {
4917 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4918 errors[errors_found].start_pos = statement_pos;
4919 errors[errors_found].error_pos = filepos;
4920 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4921 }
4922 }
4923 filepos = ftell(open_file);
4924 frmgettoken (open_file, &this_token);
4925 if (this_token.token_str[0] == '-') {
4926 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4927 errors[errors_found].start_pos = statement_pos;
4928 errors[errors_found].error_pos = filepos;
4929 errors[errors_found++].error_number = PE_NO_NEG_AFTER_EXPONENT;
4930 }
4931 }
4932 else
4933 fseek(open_file, filepos, SEEK_SET);
4934 ExpectingArg = 1;
4935 break;
4936 default:
4937 break;
4938 }
4939 break;
4940 case END_OF_FORMULA:
4941 number_of_ops+= 3; /* Just need one, but a couple of extra just for the heck of it */
4942 if (paren) {
4943 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4944 errors[errors_found].start_pos = statement_pos;
4945 errors[errors_found].error_pos = filepos;
4946 errors[errors_found++].error_number = PE_NEED_MORE_CLOSE_PARENS;
4947 }
4948 paren = 0;
4949 }
4950 if (waiting_for_mod) {
4951 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4952 errors[errors_found].start_pos = statement_pos;
4953 errors[errors_found].error_pos = filepos;
4954 errors[errors_found++].error_number = PE_UNMATCHED_MODULUS;
4955 }
4956 waiting_for_mod = 0;
4957 }
4958 if (waiting_for_endif) {
4959 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4960 errors[errors_found].start_pos = statement_pos;
4961 errors[errors_found].error_pos = filepos;
4962 errors[errors_found++].error_number = PE_IF_WITH_NO_ENDIF;
4963 }
4964 waiting_for_endif = 0;
4965 }
4966 if (ExpectingArg && !NewStatement) {
4967 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4968 errors[errors_found].start_pos = statement_pos;
4969 errors[errors_found].error_pos = filepos;
4970 errors[errors_found++].error_number = PE_SHOULD_BE_ARGUMENT;
4971 }
4972 statement_pos = ftell(open_file);
4973 }
4974
4975 if (number_of_jumps >= MAX_JUMPS) {
4976 if(!errors_found || errors[errors_found-1].start_pos != statement_pos) {
4977 errors[errors_found].start_pos = statement_pos;
4978 errors[errors_found].error_pos = filepos;
4979 errors[errors_found++].error_number = PE_TOO_MANY_JUMPS;
4980 }
4981 }
4982
4983
4984
4985 done = 1;
4986 break;
4987 default:
4988 break;
4989 }
4990 if (errors_found == 3)
4991 done = 1;
4992 }
4993 if(errors[0].start_pos) {
4994 /* sprintf (debugmsg, "Errors structure on entering frm_error\n 0: %ld, %ld, %d\n1: %ld, %ld, %d\n2: %ld, %ld, %d\n\n",
4995 errors[0].start_pos, errors[0].error_pos, errors[0].error_number,
4996 errors[1].start_pos, errors[1].error_pos, errors[1].error_number,
4997 errors[2].start_pos, errors[2].error_pos, errors[2].error_number);
4998 stopmsg (0, debugmsg);
4999 */ frm_error(open_file, orig_pos);
5000 fseek(open_file, orig_pos, SEEK_SET);
5001 return 0;
5002 }
5003 fseek(open_file, orig_pos, SEEK_SET);
5004
5005 /* display_var_list();
5006 display_const_lists();
5007 */ count_lists();
5008
5009 /* sprintf(debugmsg, "Chars in formula per prescan() is %u.\n", chars_in_formula);
5010 stopmsg(0, debugmsg);
5011 */ return 1;
5012 }
5013
5014