FORM v5.0.0-35-g6318119
token.c
Go to the documentation of this file.
1
8/* #[ License : */
9/*
10 * Copyright (C) 1984-2026 J.A.M. Vermaseren
11 * When using this file you are requested to refer to the publication
12 * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
13 * This is considered a matter of courtesy as the development was paid
14 * for by FOM the Dutch physics granting agency and we would like to
15 * be able to track its scientific use to convince FOM of its value
16 * for the community.
17 *
18 * This file is part of FORM.
19 *
20 * FORM is free software: you can redistribute it and/or modify it under the
21 * terms of the GNU General Public License as published by the Free Software
22 * Foundation, either version 3 of the License, or (at your option) any later
23 * version.
24 *
25 * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
26 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
27 * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
28 * details.
29 *
30 * You should have received a copy of the GNU General Public License along
31 * with FORM. If not, see <http://www.gnu.org/licenses/>.
32 */
33/* #] License : */
34/*
35 #[ Includes :
36*/
37
38#include "form3.h"
39
40/*
41 #] Includes :
42 #[ Compiler :
43 #[ tokenize :
44
45 Takes the input in 'in' and translates it into tokens.
46 The tokens are put in the token buffer which starts at 'AC.tokens'
47 and runs till 'AC.toptokens'
48 We may assume that the various types of brackets match properly.
49 object = -1: after , or (
50 object = 0: name/variable/number etc is allowed
51 object = 1: variable.
52 object = 2: number
53 object = 3: ) after subexpression
54*/
55
56#define CHECKPOLY {if(polyflag)MesPrint("&Illegal use of polynomial function"); polyflag = 0; }
57
58int tokenize(UBYTE *in, WORD leftright)
59{
60 int error = 0, object, funlevel = 0, bracelevel = 0, explevel = 0, numexp;
61 int polyflag = 0;
62 WORD number, type;
63 UBYTE *s = in, c;
64 SBYTE *out, *outtop, num[MAXNUMSIZE], *t;
65 LONG i;
66 if ( AC.tokens == 0 ) {
67 SBYTE **ppp = &(AC.tokens); /* to avoid a compiler warning */
68 SBYTE **pppp = &(AC.toptokens);
69 DoubleBuffer((void **)ppp,(void **)pppp,sizeof(SBYTE),"start tokens");
70 }
71 out = AC.tokens;
72 outtop = AC.toptokens - MAXNUMSIZE;
73 AC.dumnumflag = 0;
74 object = 0;
75 while ( *in ) {
76 if ( out > outtop ) {
77 LONG oldsize = (LONG)(out - AC.tokens);
78 SBYTE **ppp = &(AC.tokens); /* to avoid a compiler warning */
79 SBYTE **pppp = &(AC.toptokens);
80 DoubleBuffer((void **)ppp,(void **)pppp,sizeof(SBYTE),"expand tokens");
81 out = AC.tokens + oldsize;
82 outtop = AC.toptokens - MAXNUMSIZE;
83 }
84 switch ( FG.cTable[*in] ) {
85 case 0: /* a-zA-Z */
86 CHECKPOLY
87 s = in++;
88 while ( FG.cTable[*in] == 0 || FG.cTable[*in] == 1
89 || *in == '_' ) in++;
90dovariable: c = *in; *in = 0;
91 if ( object > 0 ) {
92 MesPrint("&Illegal position for %s",s);
93 if ( !error ) error = 1;
94 }
95 if ( out > AC.tokens && ( out[-1] == TWILDCARD || out[-1] == TNOT ) ) {
96 type = GetName(AC.varnames,s,&number,NOAUTO);
97 }
98 else {
99 type = GetName(AC.varnames,s,&number,WITHAUTO);
100 }
101 if ( type < 0 )
102 type = GetName(AC.exprnames,s,&number,NOAUTO);
103 switch ( type ) {
104 case CSYMBOL: *out++ = TSYMBOL; break;
105 case CINDEX:
106 if ( number >= (AM.IndDum-AM.OffsetIndex) ) {
107 if ( c != '?' ) {
108 MesPrint("&Generated indices should be of the type Nnumber_?");
109 error = 1;
110 }
111 else {
112 *in++ = c; c = *in; *in = 0;
113 AC.dumnumflag = 1;
114 }
115 }
116 *out++ = TINDEX;
117 break;
118 case CVECTOR: *out++ = TVECTOR; break;
119 case CFUNCTION:
120#ifdef WITHMPI
121 /*
122 * In the preprocessor, random functions in #$var=... and #inside
123 * may cause troubles, because the program flow on a slave may be
124 * different from those on others. We set AC.RhsExprInModuleFlag in order
125 * to make the change of $-variable be done on the master and thus keep the
126 * consistency among the master and all slave processes. The previous value
127 * of AC.RhsExprInModuleFlag will be restored after #$var=... and #inside.
128 */
129 if ( AP.PreAssignFlag || AP.PreInsideLevel ) {
130 switch ( number + FUNCTION ) {
131 case RANDOMFUNCTION:
132 case RANPERM:
133 AC.RhsExprInModuleFlag = 1;
134 }
135 }
136#endif
137 *out++ = TFUNCTION;
138 break;
139 case CSET: *out++ = TSET; break;
140 case CEXPRESSION: *out++ = TEXPRESSION;
141 if ( leftright == LHSIDE ) {
142 if ( !error ) error = 1;
143 MesPrint("&Expression not allowed in LH-side of substitution: %s",s);
144 }
145/*[06nov2003 mt]:*/
146#ifdef WITHMPI
147 else { /*RHSide*/
148 /* NOTE: We always set AC.RhsExprInModuleFlag regardless of
149 * AP.PreAssignFlag or AP.PreInsideLevel because we have to detect
150 * RHS expressions even in those cases. */
151 AC.RhsExprInModuleFlag = 1;
152 }
153 if ( !AP.PreAssignFlag && !AP.PreInsideLevel )
154 Expressions[number].vflags |= ISINRHS;
155#endif
156/*:[06nov2003 mt]*/
157 if ( AC.exprfillwarning == 0 ) {
158 AC.exprfillwarning = 1;
159 }
160 break;
161 case CDELTA: *out++ = TDELTA; *in = c;
162 object = 1; continue;
163 case CDUBIOUS: *out++ = TDUBIOUS; break;
164 default: *out++ = TDUBIOUS;
165 if ( !error ) error = 1;
166 MesPrint("&Undeclared variable %s",s);
167 number = AddDubious(s);
168 break;
169 }
170 object = 1;
171donumber: i = 0;
172 do { num[i++] = (SBYTE)(number & 0x7F); number >>= 7; } while ( number );
173 while ( --i >= 0 ) *out++ = num[i];
174 *in = c;
175 break;
176 case 1: /* 0-9 */
177 {
178#ifdef WITHFLOAT
179 int spec;
180 UBYTE *in2;
181#endif
182 CHECKPOLY
183 s = in;
184 while ( *s == '0' && FG.cTable[s[1]] == 1 ) s++;
185 in = s+1; i = 1;
186 while ( FG.cTable[*in] == 1 ) { in++; i++; }
187 if ( object > 0 ) {
188 c = *in; *in = 0;
189 MesPrint("&Illegal position for %s",s);
190 *in = c;
191 if ( !error ) error = 1;
192 }
193 if ( i == 1 && *in == '_' && ( *s == '5' || *s == '6'
194 || *s == '7' ) ) {
195 in++; *out++ = TSGAMMA; *out++ = (SBYTE)(*s - '4');
196 object = 1;
197 break;
198 }
199#ifdef WITHFLOAT
200 in2 = CheckFloat(in,&spec);
201 if ( in2 > in ) {
202 if ( spec == -1 ) {
203 MesPrint("&The floating point system has not been started: %s",in);
204 if ( !error ) error = 1;
205 }
206 else {
207 in = in2;
208dofloat:
209 while ( out + (in-s) >= AC.toptokens ) {
210 LONG oldsize = (LONG)(out - AC.tokens);
211 SBYTE **ppp = &(AC.tokens); /* to avoid a compiler warning */
212 SBYTE **pppp = &(AC.toptokens);
213 DoubleBuffer((void **)ppp,(void **)pppp,sizeof(SBYTE),"more tokens");
214 out = AC.tokens + oldsize;
215 outtop = AC.toptokens - MAXNUMSIZE;
216 }
217 *out++ = TFLOAT;
218 while ( s < in ) *out++ = *s++;
219 }
220 }
221 else
222#endif
223 {
224 *out++ = TNUMBER;
225 if ( ( i & 1 ) != 0 ) *out++ = (SBYTE)(*s++ - '0');
226 while ( out + (in-s)/2 >= AC.toptokens ) {
227 LONG oldsize = (LONG)(out - AC.tokens);
228 SBYTE **ppp = &(AC.tokens); /* to avoid a compiler warning */
229 SBYTE **pppp = &(AC.toptokens);
230 DoubleBuffer((void **)ppp,(void **)pppp,sizeof(SBYTE),"more tokens");
231 out = AC.tokens + oldsize;
232 outtop = AC.toptokens - MAXNUMSIZE;
233 }
234 while ( s < in ) { /* We store in base 100 */
235 *out++ = (SBYTE)(( *s - '0' ) * 10 + ( s[1] - '0' ));
236 s += 2;
237 }
238 }
239 object = 2;
240 }
241 break;
242 case 2: /* . $ _ ? # ' */
243 CHECKPOLY
244 if ( *in == '?' ) {
245 if ( leftright == LHSIDE ) {
246 if ( object == 1 ) { /* follows a name */
247 in++; *out++ = TWILDCARD;
248 if ( FG.cTable[in[0]] == 0 || in[0] == '[' || in[0] == '{' ) object = 0;
249 }
250 else if ( object == -1 ) { /* follows comma or ( */
251 in++; s = in;
252 while ( FG.cTable[*in] == 0 || FG.cTable[*in] == 1 ) in++;
253 c = *in; *in = 0;
254 if ( FG.cTable[*s] != 0 ) {
255 MesPrint("&Illegal name for argument list variable %s",s);
256 error = 1;
257 }
258 else {
259 i = AddWildcardName((UBYTE *)s);
260 *in = c;
261 *out++ = TWILDARG;
262 *out++ = (SBYTE)i;
263 }
264 object = 1;
265 }
266 else {
267 MesPrint("&Illegal position for ?");
268 error = 1;
269 in++;
270 }
271 }
272 else {
273 if ( object != -1 ) goto IllPos;
274 in++;
275 if ( FG.cTable[*in] == 0 || FG.cTable[*in] == 1 ) {
276 s = in;
277 while ( FG.cTable[*in] == 0 || FG.cTable[*in] == 1 ) in++;
278 c = *in; *in = 0;
279 i = GetWildcardName((UBYTE *)s);
280 if ( i <= 0 ) {
281 MesPrint("&Undefined argument list variable %s",s);
282 error = 1;
283 }
284 *in = c;
285 *out++ = TWILDARG;
286 *out++ = (SBYTE)i;
287 }
288 else {
289 if ( AC.vectorlikeLHS == 0 ) {
290 MesPrint("&Generated index ? only allowed in vector substitution",s);
291 error = 1;
292 }
293 *out++ = TGENINDEX;
294 }
295 object = 1;
296 }
297 }
298 else if ( *in == '.' ) {
299 if ( object == 1 ) { /* follows a name */
300 *out++ = TDOT;
301 object = 0;
302 in++;
303 }
304#ifdef WITHFLOAT
305 else if ( object == 0 || object == -1 ) {
306/*
307 Test for floating point number
308*/
309 int spec;
310 s = CheckFloat(in,&spec);
311 if ( s > in ) {
312 if ( spec == -1 ) {
313 MesPrint("&The floating point system has not been started: %s",in);
314 if ( !error ) error = 1;
315 in++;
316 }
317 else {
318 UBYTE *a = s; s = in; in = a;
319 goto dofloat;
320 }
321 }
322 else goto IllPos;
323 }
324#endif
325 else goto IllPos;
326 }
327 else if ( *in == '$' ) { /* $ variable */
328 in++;
329 s = in;
330 if ( FG.cTable[*in] == 0 ) {
331 while ( FG.cTable[*in] == 0 || FG.cTable[*in] == 1 ) in++;
332 if ( *in == '_' && AP.PreAssignFlag == 2 ) in++;
333 c = *in; *in = 0;
334 if ( object > 0 ) {
335 if ( object != 1 || leftright == RHSIDE ) {
336 MesPrint("&Illegal position for $%s",s);
337 if ( !error ) error = 1;
338 } /* else can be assignment in wildcard */
339 else {
340 if ( ( number = GetDollar(s) ) < 0 ) {
341 number = AddDollar(s,0,0,0);
342 }
343 }
344 }
345 else if ( ( number = GetDollar(s) ) < 0 ) {
346 MesPrint("&Undefined variable $%s",s);
347 if ( !error ) error = 1;
348 number = AddDollar(s,0,0,0);
349 }
350 *out++ = TDOLLAR;
351 object = 1;
352 if ( ( AC.exprfillwarning == 0 ) &&
353 ( ( out > AC.tokens+1 ) && ( out[-2] != TWILDCARD ) ) ) {
354 AC.exprfillwarning = 1;
355 }
356 goto donumber;
357 }
358 else {
359 MesPrint("Illegal name for $ variable after %s",in);
360 if ( !error ) error = 1;
361 }
362 }
363 else if ( *in == '#' ) {
364 in++;
365 if ( object == 1 ) { /* follows a name */
366 *out++ = TCONJUGATE;
367 }
368 else {
369 MesPrint("&Illegal position for %#");
370 error = 1;
371 }
372 }
373 else goto IllPos;
374 break;
375 case 3: /* [ ] */
376 CHECKPOLY
377 if ( *in == '[' ) {
378 if ( object == 1 ) { /* after name */
379 t = out-1;
380 if ( *t == RPARENTHESIS ) {
381 *out++ = LBRACE; *out++ = LPARENTHESIS;
382 bracelevel++; explevel = bracelevel;
383 }
384 else {
385 while ( *t >= 0 && t > AC.tokens ) t--;
386 if ( *t == TEXPRESSION ) {
387 *out++ = LBRACE; *out++ = LPARENTHESIS;
388 bracelevel++; explevel = bracelevel;
389 }
390 else {*out++ = LBRACE; bracelevel++; }
391 }
392 object = 0;
393 }
394 else { /* name. find matching ] */
395 s = in;
396 in = SkipAName(in);
397 goto dovariable;
398 }
399 }
400 else {
401 if ( explevel > 0 && explevel == bracelevel ) {
402 *out++ = RPARENTHESIS; explevel = 0;
403 }
404 *out++ = RBRACE; object = 1; bracelevel--;
405 }
406 in++;
407 break;
408 case 4: /* ( ) = ; , */
409 if ( *in == '(' ) {
410 if ( funlevel >= AM.MaxParLevel ) {
411 MesPrint("&More than %d levels of parentheses",AM.MaxParLevel);
412 return(-1);
413 }
414 if ( object == 1 ) { /* After name -> function,vector */
415 AC.tokenarglevel[funlevel++] = TYPEISFUN;
416 *out++ = TFUNOPEN;
417 if ( polyflag ) {
418 if ( in[1] != ')' && in[1] != ',' ) {
419 *out++ = TNUMBER; *out++ = (SBYTE)(polyflag);
420 *out++ = TCOMMA;
421 *out++ = LPARENTHESIS;
422 }
423 else {
424 *out++ = LPARENTHESIS;
425 *out++ = TNUMBER; *out++ = (SBYTE)(polyflag);
426 }
427 polyflag = 0;
428 }
429 else if ( in[1] != ')' && in[1] != ',' ) {
430 *out++ = LPARENTHESIS;
431 }
432 }
433 else if ( object <= 0 ) {
434 CHECKPOLY
435 AC.tokenarglevel[funlevel++] = TYPEISSUB;
436 *out++ = LPARENTHESIS;
437 }
438 else {
439 polyflag = 0;
440 AC.tokenarglevel[funlevel++] = TYPEISMYSTERY;
441 MesPrint("&Illegal position for (: %s",in);
442 if ( error >= 0 ) error = -1;
443 }
444 object = -1;
445 }
446 else if ( *in == ')' ) {
447 funlevel--;
448 if ( funlevel < 0 ) {
449/* if ( funflag == 0 ) { */
450 MesPrint("&There is an unmatched parenthesis");
451 if ( error >= 0 ) error = -1;
452/* } */
453 }
454 else if ( object <= 0
455 && ( AC.tokenarglevel[funlevel] != TYPEISFUN
456 || out[-1] != TFUNOPEN ) ) {
457 MesPrint("&Illegal position for closing parenthesis.");
458 if ( error >= 0 ) error = -1;
459 if ( AC.tokenarglevel[funlevel] == TYPEISFUN ) object = 1;
460 else object = 3;
461 }
462 else {
463 if ( AC.tokenarglevel[funlevel] == TYPEISFUN ) {
464 if ( out[-1] == TFUNOPEN ) out--;
465 else {
466 if ( out[-1] != TCOMMA ) *out++ = RPARENTHESIS;
467 *out++ = TFUNCLOSE;
468 }
469 object = 1;
470 }
471 else if ( AC.tokenarglevel[funlevel] == TYPEISSUB ) {
472 *out++ = RPARENTHESIS;
473 object = 3;
474 }
475 }
476 }
477 else if ( *in == ',' ) {
478 if ( /* object > 0 && */ funlevel > 0 &&
479 AC.tokenarglevel[funlevel-1] == TYPEISFUN ) {
480 if ( out[-1] != TFUNOPEN && out[-1] != TCOMMA )
481 *out++ = RPARENTHESIS;
482 else { *out++ = TNUMBER; *out++ = 0; }
483 *out++ = TCOMMA;
484 if ( in[1] != ',' && in[1] != ')' )
485 *out++ = LPARENTHESIS;
486 else if ( in[1] == ')' ) {
487 *out++ = TNUMBER; *out++ = 0;
488 }
489 }
490/*
491 else if ( object > 0 ) {
492 }
493*/
494 else {
495 MesPrint("&Illegal position for comma: %s",in);
496 MesPrint("&Forgotten ; ?");
497 if ( error >= 0 ) error = -1;
498 }
499 object = -1;
500 }
501 else goto IllPos;
502 in++;
503 break;
504 case 5: /* + - * % / ^ : */
505 CHECKPOLY
506 if ( *in == ':' || *in == '%' ) goto IllPos;
507 if ( *in == '*' || *in == '/' || *in == '^' ) {
508 if ( object <= 0 ) {
509 MesPrint("&Illegal position for operator: %s",in);
510 if ( error >= 0 ) error = -1;
511 }
512 else if ( *in == '*' ) *out++ = TMULTIPLY;
513 else if ( *in == '/' ) *out++ = TDIVIDE;
514 else *out++ = TPOWER;
515 in++;
516 }
517 else {
518 i = 1;
519 while ( *in == '+' || *in == '-' ) {
520 if ( *in == '-' ) i = -i;
521 in++;
522 }
523 if ( i == 1 ) {
524 if ( out > AC.tokens && out[-1] != TFUNOPEN &&
525 out[-1] != LPARENTHESIS && out[-1] != TCOMMA
526 && out[-1] != LBRACE )
527 *out++ = TPLUS;
528 }
529 else *out++ = TMINUS;
530 }
531 object = 0;
532 break;
533 case 6: /* Whitespace */
534 in++; break;
535 case 7: /* { | } */
536 CHECKPOLY
537 if ( *in == '{' ) {
538 if ( object > 0 ) {
539 MesPrint("&Illegal position for %s",in);
540 if ( !error ) error = 1;
541 }
542 s = in+1;
543 SKIPBRA2(in)
544 number = DoTempSet(s,in);
545 in++;
546 if ( number >= 0 ) {
547 *out++ = TSET;
548 i = 0;
549 do { num[i++] = (SBYTE)(number & 0x7F); number >>= 7; } while ( number );
550 while ( --i >= 0 ) *out++ = num[i];
551 }
552 else if ( error == 0 ) error = 1;
553 object = 1;
554 }
555 else goto IllPos;
556 break;
557 case 8: /* ! & < > */
558 CHECKPOLY
559 if ( *in != '!' || leftright == RHSIDE
560 || object != 1 || out[-1] != TWILDCARD ) goto IllPos;
561 *out++ = TNOT;
562 if ( FG.cTable[in[1]] == 0 || in[1] == '[' || in[1] == '{' ) object = 0;
563 in++;
564 break;
565 default:
566IllPos: MesPrint("&Illegal character at this position: %s",in);
567 if ( error >= 0 ) error = -1;
568 in++;
569 polyflag = 0;
570 break;
571 }
572 }
573 *out++ = TENDOFIT;
574 AC.endoftokens = out;
575 if ( funlevel > 0 || bracelevel != 0 ) {
576 if ( funlevel > 0 ) MesPrint("&Unmatched parentheses");
577 if ( bracelevel != 0 ) MesPrint("&Unmatched braces");
578 return(-1);
579 }
580 if ( AC.TokensWriteFlag ) WriteTokens(AC.tokens);
581/*
582 Simplify fixed set elements
583*/
584 if ( error == 0 && simp1token(AC.tokens) ) error = 1;
585/*
586 Collect wildcards for the prototype. Simplify the leftover wildcards
587*/
588 if ( error == 0 && leftright == LHSIDE && simpwtoken(AC.tokens) )
589 error = 1;
590/*
591 Now prepare the set[n] objects in the RHS.
592*/
593 if ( error == 0 && leftright == RHSIDE && simp4token(AC.tokens) )
594 error = 1;
595/*
596 Simplify simple function arguments (and 1/fac_ and 1/invfac_)
597*/
598 if ( error == 0 && simp2token(AC.tokens) ) error = 1;
599/*
600 Next we try to remove composite denominators or exponents and
601 replace them by their internal functions. This may involve expanding
602 the buffer. The return code of 3a is negative if there is an error
603 and positive if indeed we need to do some work.
604 simp3btoken does the work
605*/
606 numexp = 0;
607 if ( error == 0 && ( numexp = simp3atoken(AC.tokens,leftright) ) < 0 )
608 error = 1;
609 if ( numexp > 0 ) {
610 // Make some space at the beginning of AC.tokens, filled with TEMPTY.
611 SBYTE *tt;
612 out = AC.tokens;
613 while ( *out != TENDOFIT ) out++;
614 while ( out+numexp*9 > outtop ) {
615 LONG oldsize = (LONG)(out - AC.tokens);
616 SBYTE **ppp = &(AC.tokens); /* to avoid a compiler warning */
617 SBYTE **pppp = &(AC.toptokens);
618 DoubleBuffer((void **)ppp,(void **)pppp,sizeof(SBYTE),"out tokens");
619 out = AC.tokens + oldsize;
620 outtop = AC.toptokens - MAXNUMSIZE;
621 }
622 tt = out + numexp*9;
623 while ( out >= AC.tokens ) { *tt-- = *out--; }
624 while ( tt >= AC.tokens ) { *tt-- = TEMPTY; }
625 if ( error == 0 && simp3btoken(AC.tokens,leftright) ) error = 1;
626 if ( error == 0 && simp2token(AC.tokens) ) error = 1;
627 }
628/*
629 In simp5token we test for special cases like sumvariables that are
630 already wildcards, etc.
631*/
632 if ( error == 0 && simp5token(AC.tokens,leftright) ) error = 1;
633/*
634 In simp6token we test for special cases like factorized expressions
635 that occur in the RHS in an improper way.
636*/
637 if ( error == 0 && simp6token(AC.tokens,leftright) ) error = 1;
638
639 return(error);
640}
641
642/*
643 #] tokenize :
644 #[ WriteTokens :
645*/
646
647char *ttypes[] = { "\n", "S", "I", "V", "F", "set", "E", "dotp", "#",
648 "sub", "d_", "$", "dub", "(", ")", "?", "??", ".", "[", "]",
649 ",", "((", "))", "*", "/", "^", "+", "-", "!", "end", "{{", "}}",
650 "N_?", "conj", "()", "#d", "^d", "_", "snum" };
651
652void WriteTokens(SBYTE *in)
653{
654 int numinline = 0, x, n = sizeof(ttypes)/sizeof(char *);
655 char outbuf[81], *s, *out, c;
656 out = outbuf;
657 while ( *in != TENDOFIT ) {
658 if ( *in < 0 ) {
659 if ( *in >= -n ) {
660 s = ttypes[-*in];
661 while ( *s ) { *out++ = *s++; numinline++; }
662 }
663 else {
664 *out++ = '-'; x = -*in; numinline++;
665 goto writenumber;
666 }
667 }
668 else {
669 x = *in;
670writenumber:
671 s = out;
672 do {
673 *out++ = (char)(( x % 10 ) + '0');
674 numinline++;
675 x = x / 10;
676 } while ( x );
677 c = out[-1]; out[-1] = *s; *s = c;
678 }
679 if ( numinline > 70 ) {
680 *out = 0;
681 MesPrint("%s",outbuf);
682 out = outbuf; numinline = 0;
683 }
684 else {
685 *out++ = ' '; numinline++;
686 }
687 in++;
688 }
689 if ( numinline > 0 ) { *out = 0; MesPrint("%s",outbuf); }
690}
691
692/*
693 #] WriteTokens :
694 #[ simp1token :
695
696 Routine substitutes set elements if possible.
697 This means sets with a fixed argument like setname[3].
698*/
699
700int simp1token(SBYTE *s)
701{
702 int error = 0, n, i, base;
703 WORD numsub;
704 SBYTE *fill = s, *start, *t, numtab[10];
705 SETS set;
706 while ( *s != TENDOFIT ) {
707 if ( *s == RBRACE ) {
708 start = fill-1;
709 while ( *start != LBRACE ) start--;
710 t = start - 1;
711 while ( *t >= 0 ) t--;
712 if ( *t == TSET && ( start[1] == TNUMBER || start[1] == TNUMBER1 ) ) {
713 base = start[1] == TNUMBER ? 100: 128;
714 start += 2;
715 numsub = *start++;
716 while ( *start >= 0 && start < fill )
717 { numsub = base*numsub + *start++; }
718 if ( start == fill ) {
719 start = t;
720 t++; n = *t++; while ( *t >= 0 ) { n = 128*n + *t++; }
721 set = Sets+n;
722 if ( ( set->type != CRANGE )
723 && ( numsub > 0 && numsub <= set->last-set->first ) ) {
724 fill = start;
725 n = SetElements[set->first+numsub-1];
726 switch (set->type) {
727 case CSYMBOL:
728 if ( n > MAXPOWER ) {
729 n -= 2*MAXPOWER;
730 if ( n < 0 ) { n = -n; *fill++ = TMINUS; }
731 *fill++ = TNUMBER1;
732 }
733 else *fill++ = TSYMBOL;
734 break;
735 case CINDEX:
736 if ( n < AM.OffsetIndex ) *fill++ = TNUMBER1;
737 else {
738 *fill++ = TINDEX;
739 n -= AM.OffsetIndex;
740 }
741 break;
742 case CVECTOR: *fill++ = TVECTOR;
743 n -= AM.OffsetVector; break;
744 case CFUNCTION: *fill++ = TFUNCTION;
745 n -= FUNCTION; break;
746 case CNUMBER: *fill++ = TNUMBER1; break;
747 case CDUBIOUS: *fill++ = TDUBIOUS; n = 1; break;
748 }
749 i = 0;
750if ( n < 0 ) {
751 MesPrint("Value of n = %d",n);
752}
753 do { numtab[i++] = (SBYTE)(n & 0x7F); n >>= 7; } while ( n );
754 while ( --i >= 0 ) *fill++ = numtab[i];
755 }
756 else {
757 MesPrint("&Illegal element %d in set",numsub);
758 error++;
759 }
760 s++; continue;
761 }
762 }
763 *fill++ = *s++;
764 }
765 else *fill++ = *s++;
766 }
767 *fill++ = TENDOFIT;
768 return(error);
769}
770
771/*
772 #] simp1token :
773 #[ simpwtoken :
774
775 Only to be called in the LHS.
776 Hunts down the wildcards and writes them to the wildcardbuffer.
777 Next it causes the ProtoType to be constructed.
778 All wildcards are simplified into the trailing TWILDCARD,
779 because the specifics are stored in the prototype.
780 These specifics also include the transfer of wildcard values
781 to $variables.
782
783 Types of wildcards:
784 a?, a?set, a?!set, a?set[i], A?set1?set2, ?a
785 After this we can strip the set information.
786 We still need the ? because of the wildcarding offset in code generation
787*/
788
789int simpwtoken(SBYTE *s)
790{
791 int error = 0, first = 1, notflag;
792 WORD num, numto, numdollar, *w = AC.WildC, *wstart, *wtop;
793 SBYTE *fill = s, *t, *v, *s0 = s;
794 while ( *s != TENDOFIT ) {
795 if ( *s == TWILDCARD ) {
796 notflag = 0; t = fill;
797 while ( t > s0 && t[-1] >= 0 ) t--;
798 v = t; num = 0; *fill++ = *s++;
799 while ( *v >= 0 ) num = 128*num + *v++;
800 if ( t > s0 ) t--;
801 AC.NwildC += 4;
802 if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
803 switch ( *t ) {
804 case TSYMBOL:
805 case TDUBIOUS:
806 *w++ = SYMTOSYM; *w++ = 4; *w++ = num; *w++ = num; break;
807 case TINDEX:
808 num += AM.OffsetIndex;
809 *w++ = INDTOIND; *w++ = 4; *w++ = num; *w++ = num; break;
810 case TVECTOR:
811 num += AM.OffsetVector;
812 *w++ = VECTOVEC; *w++ = 4; *w++ = num; *w++ = num; break;
813 case TFUNCTION:
814 num += FUNCTION;
815 *w++ = FUNTOFUN; *w++ = 4; *w++ = num; *w++ = num; break;
816 default:
817 MesPrint("&Illegal type of wildcard in LHS");
818 error = -1;
819 *w++ = SYMTOSYM; *w++ = 4; *w++ = num; *w++ = num; break;
820 break;
821 }
822/*
823 Now the sets. The s pointer sits after the ?
824*/
825 wstart = w;
826 if ( *s == TNOT && s[1] == TSET ) { notflag = 1; s++; }
827 if ( *s == TSET ) {
828 s++; num = 0; while ( *s >= 0 ) num = 128*num + *s++;
829 if ( notflag == 0 && *s == TWILDCARD && s[1] == TSET ) {
830 s += 2; numto = 0; while ( *s >= 0 ) numto = 128*numto + *s++;
831 if ( num < AM.NumFixedSets || numto < AM.NumFixedSets
832 || Sets[num].type == CRANGE || Sets[numto].type == CRANGE ) {
833 MesPrint("&This type of set not allowed in this wildcard construction");
834 error = 1;
835 }
836 else {
837 AC.NwildC += 4;
838 if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
839 *w++ = FROMSET; *w++ = 4; *w++ = num; *w++ = numto;
840 wstart = w;
841 }
842 }
843 else if ( notflag == 0 && *s == LBRACE && s[1] == TSYMBOL ) {
844 if ( num < AM.NumFixedSets || Sets[num].type == CRANGE ) {
845 MesPrint("&This type of set not allowed in this wildcard construction");
846 error = 1;
847 }
848 v = s; s += 2;
849 numto = 0; while ( *s >= 0 ) numto = 128*numto + *s++;
850 if ( *s == TWILDCARD ) s++; /* most common mistake */
851 if ( *s == RBRACE ) {
852 s++;
853 AC.NwildC += 8;
854 if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
855 *w++ = SETTONUM; *w++ = 4; *w++ = num; *w++ = numto;
856 wstart = w;
857 *w++ = SYMTOSYM; *w++ = 4; *w++ = numto; *w++ = 0;
858 }
859 else if ( *s == TDOLLAR ) {
860 s++; numdollar = 0;
861 while ( *s >= 0 ) numdollar = 128*numdollar + *s++;
862 if ( *s == RBRACE ) {
863 s++;
864 AC.NwildC += 12;
865 if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
866 *w++ = SETTONUM; *w++ = 4; *w++ = num; *w++ = numto;
867 wstart = w;
868 *w++ = SYMTOSYM; *w++ = 4; *w++ = numto; *w++ = 0;
869 *w++ = LOADDOLLAR; *w++ = 4; *w++ = numdollar;
870 *w++ = numdollar;
871 }
872 else { s = v; goto singlewild; }
873 }
874 else { s = v; goto singlewild; }
875 }
876 else {
877singlewild: num += notflag * 2*WILDOFFSET;
878 AC.NwildC += 4;
879 if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
880 *w++ = FROMSET; *w++ = 4; *w++ = num; *w++ = -WILDOFFSET;
881 wstart = w;
882 }
883 }
884 else if ( *s != TDOLLAR && *s != TENDOFIT && *s != RPARENTHESIS
885 && *s != RBRACE && *s != TCOMMA && *s != TFUNCLOSE && *s != TMULTIPLY
886 && *s != TPOWER && *s != TDIVIDE && *s != TPLUS && *s != TMINUS
887 && *s != TPOWER1 && *s != TEMPTY && *s != TFUNOPEN && *s != TDOT ) {
888 MesPrint("&Illegal type of wildcard in LHS");
889 error = -1;
890 }
891 if ( *s == TDOLLAR ) {
892 s++; numdollar = 0;
893 while ( *s >= 0 ) numdollar = 128*numdollar + *s++;
894 AC.NwildC += 4;
895 if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
896 wtop = w + 4;
897 if ( wstart < w ) {
898 while ( w > wstart ) { w[4] = w[0]; w--; }
899 }
900 *w++ = LOADDOLLAR; *w++ = 4; *w++ = numdollar; *w++ = numdollar;
901 w = wtop;
902 }
903 }
904 else if ( *s == TWILDARG ) {
905 *fill++ = *s++;
906 num = 0;
907 while ( *s >= 0 ) { num = 128*num + *s; *fill++ = *s++; }
908 AC.NwildC += 4;
909 if ( AC.NwildC > 4*AM.MaxWildcards ) {
910firsterr: if ( first ) {
911 MesPrint("&More than %d wildcards",AM.MaxWildcards);
912 error = -1;
913 first = 0;
914 }
915 }
916 else { *w++ = ARGTOARG; *w++ = 4; *w++ = num; *w++ = -1; }
917 if ( *s == TDOLLAR ) {
918 s++; num = 0; while ( *s >= 0 ) num = 128*num + *s++;
919 AC.NwildC += 4;
920 if ( AC.NwildC > 4*AM.MaxWildcards ) goto firsterr;
921 *w++ = LOADDOLLAR; *w++ = 4; *w++ = num; *w++ = num;
922 }
923 }
924 else *fill++ = *s++;
925 }
926 *fill++ = TENDOFIT;
927 AC.WildC = w;
928 return(error);
929}
930
931/*
932 #] simpwtoken :
933 #[ simp2token :
934
935 Deals with function arguments.
936 The tokenizer has given function arguments extra parentheses.
937 We remove the double parentheses.
938 Next we remove the parentheses around the simple arguments.
939
940 It also replaces /fac_() by *invfac_() and /invfac_() by *fac_()
941*/
942
943int simp2token(SBYTE *s)
944{
945 SBYTE *to, *fill, *t, *v, *w, *s0 = s, *vv;
946 int error = 0, n;
947/*
948 Set substitutions
949*/
950 fill = to = s;
951 while ( *s != TENDOFIT ) {
952 if ( *s == LPARENTHESIS && s[1] == LPARENTHESIS ) {
953 t = s+1; n = 0;
954 while ( n >= 0 ) {
955 t++;
956 if ( *t == LPARENTHESIS ) n++;
957 else if ( *t == RPARENTHESIS ) n--;
958 }
959 if ( t[1] == RPARENTHESIS ) {
960 *t = TEMPTY; s++;
961 }
962 *fill++ = *s++;
963 }
964 else if ( *s == TEMPTY ) s++;
965 else if ( *s == AM.facnum && ( fill > (s0+1) ) && fill[-2] == TDIVIDE
966 && fill[-1] == TFUNCTION ) {
967 fill[-2] = TMULTIPLY; *fill++ = (SBYTE)(AM.invfacnum); s++;
968 }
969 else if ( *s == AM.invfacnum && ( fill > (s0+1) ) && fill[-2] == TDIVIDE
970 && fill[-1] == TFUNCTION ) {
971 fill[-2] = TMULTIPLY; *fill++ = (SBYTE)(AM.facnum); s++;
972 }
973 else *fill++ = *s++;
974 }
975 *fill++ = TENDOFIT;
976/*
977 Second round: try to locate 'simple' arguments and strip their brackets
978
979 We add (9-feb-2010) to the simple arguments integers of any size
980*/
981 fill = s = to;
982 while ( *s != TENDOFIT ) {
983 if ( *s == LPARENTHESIS ) {
984 t = s; n = 0;
985 while ( n >= 0 ) {
986 t++;
987 if ( *t == LPARENTHESIS ) n++;
988 else if ( *t == RPARENTHESIS ) n--;
989 }
990 if ( t[1] == TFUNCLOSE && s[1] != TWILDARG ) { /* Check for last argument in sum */
991 v = fill - 1; n = 0;
992 while ( n >= 0 && v >= to ) {
993 if ( *v == TFUNOPEN ) n--;
994 else if ( *v == TFUNCLOSE ) n++;
995 v--;
996 }
997 if ( v > to ) {
998 while ( *v >= 0 ) v--;
999 if ( *v == TFUNCTION ) { v++;
1000 n = 0; while ( *v >= 0 && v < fill ) n = 128*n + *v++;
1001 if ( n == AM.sumnum || n == AM.sumpnum ) {
1002 *fill++ = *s++; continue;
1003 }
1004 else if ( ( n == (FIRSTBRACKET-FUNCTION)
1005 || n == (TERMSINEXPR-FUNCTION)
1006 || n == (SIZEOFFUNCTION-FUNCTION)
1007 || n == (NUMFACTORS-FUNCTION)
1008 || n == (GCDFUNCTION-FUNCTION)
1009 || n == (DIVFUNCTION-FUNCTION)
1010 || n == (REMFUNCTION-FUNCTION)
1011 || n == (INVERSEFUNCTION-FUNCTION)
1012 || n == (MULFUNCTION-FUNCTION)
1013 || n == (FACTORIN-FUNCTION)
1014 || n == (FIRSTTERM-FUNCTION)
1015 || n == (CONTENTTERM-FUNCTION) )
1016 && fill[-1] == TFUNOPEN ) {
1017 v = s+1;
1018 if ( *v == TEXPRESSION ) {
1019 v++;
1020 n = 0; while ( *v >= 0 ) n = 128*n + *v++;
1021 if ( v == t ) {
1022 *t = TEMPTY; s++;
1023 }
1024 }
1025 }
1026 }
1027 }
1028 }
1029 if ( ( fill > to )
1030 && ( ( fill[-1] == TFUNOPEN || fill[-1] == TCOMMA )
1031 && ( t[1] == TFUNCLOSE || t[1] == TCOMMA ) ) ) {
1032 v = s + 1;
1033 switch ( *v ) {
1034 case TMINUS:
1035 v++;
1036 if ( *v == TVECTOR ) {
1037 w = v+1; while ( *w >= 0 ) w++;
1038 if ( w == t ) {
1039 *t = TEMPTY; s++;
1040 }
1041 }
1042 else {
1043 if ( *v == TNUMBER || *v == TNUMBER1 ) {
1044 if ( BITSINWORD == 16 ) { ULONG x; WORD base;
1045 base = ( *v == TNUMBER ) ? 100: 128;
1046 vv = v+1; x = 0; while ( *vv >= 0 ) { x = x*base + *vv++; }
1047 if ( ( vv != t ) || ( ( vv - v ) > 4 ) || ( x > (MAXPOSITIVE+1) ) )
1048 *fill++ = *s++;
1049 else { *t = TEMPTY; s++; break; }
1050 }
1051 else if ( BITSINWORD == 32 ) { ULONG x; WORD base;
1052 base = ( *v == TNUMBER ) ? 100: 128;
1053 vv = v+1; x = 0; while ( *vv >= 0 ) { x = x*base + *vv++; }
1054 if ( ( vv != t ) || ( ( vv - v ) > 6 ) || ( x > (MAXPOSITIVE+1) ) )
1055 *fill++ = *s++;
1056 else { *t = TEMPTY; s++; break; }
1057 }
1058 else {
1059 if ( ( v+2 == t ) || ( v+3 == t && v[2] >= 0 ) )
1060 { *t = TEMPTY; s++; break; }
1061 else *fill++ = *s++;
1062 }
1063 }
1064 else if ( *v == LPARENTHESIS && t[-1] == RPARENTHESIS ) {
1065 w = v; n = 0;
1066 while ( n >= 0 ) {
1067 w++;
1068 if ( *w == LPARENTHESIS ) n++;
1069 else if ( *w == RPARENTHESIS ) n--;
1070 }
1071 if ( w == ( t-1 ) ) { *t = TEMPTY; s++; }
1072 else *fill++ = *s++;
1073 }
1074 else *fill++ = *s++;
1075 break;
1076 }
1077 /* fall through */
1078 case TSETNUM:
1079 v++; while ( *v >= 0 ) v++;
1080 goto tcommon;
1081 case TSYMBOL:
1082 if ( ( v[1] == COEFFSYMBOL || v[1] == NUMERATORSYMBOL
1083 || v[1] == DENOMINATORSYMBOL ) && v[2] < 0 ) {
1084 *fill++ = *s++; break;
1085 }
1086 /* fall through */
1087 case TSET:
1088 case TVECTOR:
1089 case TINDEX:
1090 case TFUNCTION:
1091 case TDOLLAR:
1092 case TDUBIOUS:
1093 case TSGAMMA:
1094tcommon: v++; while ( *v >= 0 ) v++;
1095 if ( v == t || ( v[0] == TWILDCARD && v+1 == t ) )
1096 { *t = TEMPTY; s++; }
1097 else *fill++ = *s++;
1098 break;
1099 case TGENINDEX:
1100 v++;
1101 if ( v == t ) { *t = TEMPTY; s++; }
1102 else *fill++ = *s++;
1103 break;
1104 case TNUMBER:
1105 case TNUMBER1:
1106 if ( BITSINWORD == 16 ) { ULONG x; WORD base;
1107 base = ( *v == TNUMBER ) ? 100: 128;
1108 vv = v+1; x = 0; while ( *vv >= 0 ) { x = x*base + *vv++; }
1109 if ( ( vv != t ) || ( ( vv - v ) > 4 ) || ( x > MAXPOSITIVE ) )
1110 *fill++ = *s++;
1111 else { *t = TEMPTY; s++; break; }
1112 }
1113 else if ( BITSINWORD == 32 ) { ULONG x; WORD base;
1114 base = ( *v == TNUMBER ) ? 100: 128;
1115 vv = v+1; x = 0; while ( *vv >= 0 ) { x = x*base + *vv++; }
1116 if ( ( vv != t ) || ( ( vv - v ) > 6 ) || ( x > MAXPOSITIVE ) )
1117 *fill++ = *s++;
1118 else { *t = TEMPTY; s++; break; }
1119 }
1120 else {
1121 if ( ( v+2 == t ) || ( v+3 == t && v[2] >= 0 ) )
1122 { *t = TEMPTY; s++; break; }
1123 else *fill++ = *s++;
1124 }
1125 break;
1126 case TWILDARG:
1127 v++; while ( *v >= 0 ) v++;
1128 if ( v == t ) { *t = TEMPTY; s++; }
1129 else *fill++ = *s++;
1130 break;
1131 case TEXPRESSION:
1132/*
1133 First establish that there is only the expression
1134 in this argument.
1135*/
1136 vv = s+1;
1137 while ( vv < t ) {
1138 if ( *vv != TEXPRESSION ) break;
1139 vv++; while ( *vv >= 0 ) vv++;
1140 }
1141 if ( vv < t ) { *fill++ = *s++; break; }
1142/*
1143 Find the function
1144*/
1145 w = fill-1; n = 0;
1146 while ( n >= 0 && w >= to ) {
1147 if ( *w == TFUNOPEN ) n--;
1148 else if ( *w == TFUNCLOSE ) n++;
1149 w--;
1150 }
1151 w--; while ( w > to && *w >= 0 ) w--;
1152 if ( *w != TFUNCTION ) { *fill++ = *s++; break; }
1153 w++; n = 0;
1154 while ( *w >= 0 ) { n = 128*n + *w++; }
1155 if ( n == GCDFUNCTION-FUNCTION
1156 || n == DIVFUNCTION-FUNCTION
1157 || n == REMFUNCTION-FUNCTION
1158 || n == INVERSEFUNCTION-FUNCTION
1159 || n == MULFUNCTION-FUNCTION ) {
1160 *t = TEMPTY; s++;
1161 }
1162 else *fill++ = *s++;
1163 break;
1164 default: *fill++ = *s++; break;
1165 }
1166 }
1167 else *fill++ = *s++;
1168 }
1169 else if ( *s == TEMPTY ) s++;
1170 else *fill++ = *s++;
1171 }
1172 *fill++ = TENDOFIT;
1173 return(error);
1174}
1175
1176/*
1177 #] simp2token :
1178 #[ simp3atoken :
1179
1180 We hunt for denominators and exponents that seem hidden.
1181 For the denominators we have to recognize:
1182 /fun /fun() /fun^power /fun()^power
1183 /set[n] /set[n]() /set[n]^power /set[n]()^power
1184 /symbol^power (power no number or symbol wildcard)
1185 /dotpr^power (id)
1186 /#^power (id)
1187 /() /()^power
1188 /vect /index /vect(anything) /vect(anything)^power
1189*/
1190
1191int simp3atoken(SBYTE *s, int mode)
1192{
1193 int error = 0, n, numexp = 0, denom, base, numprot, i;
1194 SBYTE *t, c;
1195 LONG num;
1196 WORD *prot;
1197 if ( mode == RHSIDE ) {
1198 prot = AC.ProtoType;
1199 numprot = prot[1] - SUBEXPSIZE;
1200 prot += SUBEXPSIZE;
1201 }
1202 else { prot = 0; numprot = 0; }
1203 while ( *s != TENDOFIT ) {
1204 denom = 1;
1205 if ( *s == TDIVIDE ) { denom = -1; s++; }
1206 c = *s;
1207 switch(c) {
1208 case TSYMBOL:
1209 case TNUMBER:
1210 case TNUMBER1:
1211 s++; while ( *s >= 0 ) s++; /* skip the object */
1212 if ( *s == TWILDCARD ) s++; /* and the possible wildcard */
1213dosymbol:
1214 if ( *s != TPOWER ) continue; /* No power -> done */
1215 s++; /* Skip the power */
1216 if ( *s == TMINUS ) s++; /* negative: no difference here */
1217 if ( *s == TNUMBER || *s == TNUMBER1 ) {
1218 base = *s == TNUMBER ? 100: 128; /* NUMBER = base 100 */
1219 s++; /* Now we compose the power */
1220 num = *s++; /* If the number is way too large */
1221 while ( *s >= 0 ) { /* it may look like not too big */
1222 if ( num > MAXPOWER ) break; /* Hence... */
1223 num = base*num + *s++;
1224 }
1225 while ( *s >= 0 ) s++; /* Finish the number if needed */
1226 if ( *s == TPOWER ) goto doublepower;
1227 if ( num <= MAXPOWER ) continue; /* Simple case */
1228 }
1229 else if ( *s == TSYMBOL && c != TNUMBER && c != TNUMBER1 ) {
1230 s++; n = 0; while ( *s >= 0 ) { n = 128*n + *s++; }
1231 if ( *s == TWILDCARD ) { s++;
1232 if ( *s == TPOWER ) goto doublepower;
1233 continue; }
1234/*
1235 Now we have to test whether n happens to be a wildcard
1236*/
1237 if ( mode == RHSIDE ) {
1238 n += 2*MAXPOWER;
1239 for ( i = 0; i < numprot; i += 4 ) {
1240 if ( prot[i+2] == n && prot[i] == SYMTOSYM ) break;
1241 }
1242 if ( i < numprot ) break;
1243 }
1244 if ( *s == TPOWER ) goto doublepower;
1245 }
1246 numexp++;
1247 break;
1248 case TINDEX:
1249 s++; while ( *s >= 0 ) s++;
1250 if ( *s == TWILDCARD ) s++;
1251doindex:
1252 if ( denom < 0 || *s == TPOWER ) {
1253 MesPrint("&Index to a power or in denominator is illegal");
1254 error = 1;
1255 }
1256 break;
1257 case TVECTOR:
1258 s++; while ( *s >= 0 ) s++;
1259 if ( *s == TWILDCARD ) s++;
1260dovector:
1261 if ( *s == TFUNOPEN ) {
1262 s++; n = 1;
1263 for(;;) {
1264 if ( *s == TFUNOPEN ) {
1265 n++;
1266 MesPrint("&Illegal vector index");
1267 error = 1;
1268 }
1269 else if ( *s == TFUNCLOSE ) {
1270 n--;
1271 if ( n <= 0 ) break;
1272 }
1273 s++;
1274 }
1275 s++;
1276 }
1277 else if ( *s == TDOT ) goto dodot;
1278 if ( denom < 0 || *s == TPOWER || *s == TPOWER1 ) numexp++;
1279 break;
1280 case TFUNCTION:
1281 s++; while ( *s >= 0 ) s++;
1282 if ( *s == TWILDCARD ) s++;
1283dofunction:
1284 t = s;
1285 if ( *t == TFUNOPEN ) {
1286 t++; n = 1;
1287 for(;;) {
1288 if ( *t == TFUNOPEN ) n++;
1289 else if ( *t == TFUNCLOSE ) { if ( --n <= 0 ) break; }
1290 t++;
1291 }
1292 t++; s++;
1293 }
1294 if ( denom < 0 || *t == TPOWER || *t == TPOWER1 ) numexp++;
1295 break;
1296#ifdef WITHFLOAT
1297 case TFLOAT:
1298 s++; while ( *s >= 0 ) s++;
1299 if ( denom < 0 || *s == TPOWER || *s == TPOWER1 ) numexp++;
1300 break;
1301#endif
1302 case TEXPRESSION:
1303 s++; while ( *s >= 0 ) s++;
1304 t = s;
1305 if ( *t == TFUNOPEN ) {
1306 t++; n = 1;
1307 for(;;) {
1308 if ( *t == TFUNOPEN ) n++;
1309 else if ( *t == TFUNCLOSE ) { if ( --n <= 0 ) break; }
1310 t++;
1311 }
1312 t++;
1313 }
1314 if ( *t == LBRACE ) {
1315 t++; n = 1;
1316 for(;;) {
1317 if ( *t == LBRACE ) n++;
1318 else if ( *t == RBRACE ) { if ( --n <= 0 ) break; }
1319 t++;
1320 }
1321 t++;
1322 }
1323 if ( denom < 0 || ( ( *t == TPOWER || *t == TPOWER1 )
1324 && t[1] == TMINUS ) ) numexp++;
1325 break;
1326 case TDOLLAR:
1327 s++; while ( *s >= 0 ) s++;
1328 if ( denom < 0 || ( ( *s == TPOWER || *s == TPOWER1 )
1329 && s[1] == TMINUS ) ) numexp++;
1330 break;
1331 case LPARENTHESIS:
1332 s++; n = 1; t = s;
1333 for(;;) {
1334 if ( *t == LPARENTHESIS ) n++;
1335 else if ( *t == RPARENTHESIS ) { if ( --n <= 0 ) break; }
1336 t++;
1337 }
1338 t++;
1339 if ( denom > 0 && ( *t == TPOWER || *t == TPOWER1 ) ) {
1340 if ( ( t[1] == TNUMBER || t[1] == TNUMBER1 ) && t[2] >= 0
1341 && t[3] < 0 ) break;
1342 numexp++;
1343 }
1344 else if ( denom < 0 && ( *t == TPOWER || *t == TPOWER1 ) ) {
1345 if ( t[1] == TMINUS && ( t[2] == TNUMBER
1346 || t[2] == TNUMBER1 ) && t[3] >= 0
1347 && t[4] < 0 ) break;
1348 numexp++;
1349 }
1350 else if ( denom < 0 || ( ( *t == TPOWER || *t == TPOWER1 )
1351 && ( t[1] == TMINUS || t[1] == LPARENTHESIS ) ) ) numexp++;
1352 break;
1353 case TSET:
1354 s++; n = *s++; while ( *s >= 0 ) { n = 128*n + *s++; }
1355 n = Sets[n].type;
1356 switch ( n ) {
1357 case CSYMBOL: goto dosymbol;
1358 case CINDEX: goto doindex;
1359 case CVECTOR: goto dovector;
1360 case CFUNCTION: goto dofunction;
1361 case CNUMBER: goto dosymbol;
1362 case CMODEL:
1363 if ( denom < 0 || *s == TPOWER ) {
1364 MesPrint("&A model to a power or in denominator is illegal");
1365 error = 1;
1366 }
1367 break;
1368 case ANYTYPE:
1369 if ( denom < 0 || *s == TPOWER ) {
1370 MesPrint("&A set without type to a power or in denominator is illegal");
1371 error = 1;
1372 }
1373 break;
1374 default: error = 1; break;
1375 }
1376 break;
1377 case TDOT:
1378dodot: s++;
1379 if ( *s == TVECTOR ) { s++; while ( *s >= 0 ) s++; }
1380 else if ( *s == TSET ) {
1381 s++; n = *s++; while ( *s >= 0 ) { n = 128*n + *s++; }
1382 if ( Sets[n].type != CVECTOR ) {
1383 MesPrint("&Set in dotproduct is not a set of vectors");
1384 error = 1;
1385 }
1386 if ( *s == LBRACE ) {
1387 s++; n = 1;
1388 for(;;) {
1389 if ( *s == LBRACE ) n++;
1390 else if ( *s == RBRACE ) { if ( --n <= 0 ) break; }
1391 s++;
1392 }
1393 s++;
1394 }
1395 else {
1396 MesPrint("&Set without argument in dotproduct");
1397 error = 1;
1398 }
1399 }
1400 else if ( *s == TSETNUM ) {
1401 s++; n = *s++; while ( *s >= 0 ) { n = 128*n + *s++; }
1402 if ( *s != TVECTOR ) goto nodot;
1403 s++; n = *s++; while ( *s >= 0 ) { n = 128*n + *s++; }
1404 if ( Sets[n].type != CVECTOR ) {
1405 MesPrint("&Set in dotproduct is not a set of vectors");
1406 error = 1;
1407 }
1408 }
1409 else {
1410nodot: MesPrint("&Illegal second element in dotproduct");
1411 error = 1;
1412 s++; while ( *s >= 0 ) s++;
1413 }
1414 goto dosymbol;
1415 default:
1416 s++; while ( *s >= 0 ) s++;
1417 break;
1418 }
1419 }
1420 if ( error ) return(-1);
1421 return(numexp);
1422doublepower:
1423 MesPrint("&Dubious notation with object^power1^power2");
1424 return(-1);
1425}
1426
1427/*
1428 #] simp3atoken :
1429 #[ simp3btoken :
1430*/
1431
1432int simp3btoken(SBYTE *s, int mode)
1433{
1434 int error = 0, i, numprot, n, denom, base, inset = 0, dotp, sube = 0;
1435 SBYTE *t, c, *fill, *ff, *ss;
1436 LONG num;
1437 WORD *prot;
1438
1439 // Work in a temporary buffer, to avoid clashes between input and output
1440 SBYTE *tmptokens = (SBYTE*)Malloc1((AC.toptokens-AC.tokens)*sizeof(SBYTE), "simp3btoken scratch");
1441 SBYTE* tmptoptokens = tmptokens + (AC.toptokens-AC.tokens);
1442 fill = tmptokens;
1443
1444 if ( mode == RHSIDE ) {
1445 prot = AC.ProtoType;
1446 numprot = prot[1] - SUBEXPSIZE;
1447 prot += SUBEXPSIZE;
1448 }
1449 else { prot = 0; numprot = 0; }
1450 while ( *s == TEMPTY ) s++;
1451 while ( *s != TENDOFIT ) {
1452 // If we are near the end of the output buffer, we'd better reallocate
1453 // both tmptokens and AC.tokens (which must fit the final result).
1454 // Experimentally, fill can move by at most 5 per loop iteration, but
1455 // this buffer of 20 of might not be enough for all cases!
1456 while ( tmptoptokens - fill < 20 ) {
1457 LONG tmppos;
1458 tmppos = s - AC.tokens;
1459 DoubleBuffer((void**)&(AC.tokens), (void**)&(AC.toptokens), sizeof(SBYTE), "simp3btoken double");
1460 s = AC.tokens + tmppos;
1461 tmppos = fill - tmptokens;
1462 DoubleBuffer((void**)&tmptokens, (void**)&tmptoptokens, sizeof(SBYTE), "simp3btoken scratch double");
1463 fill = tmptokens + tmppos;
1464 }
1465 if ( *s == TEMPTY ) { s++; continue; }
1466 denom = 1;
1467 if ( *s == TDIVIDE ) { denom = -1; *fill++ = *s++; }
1468 ff = fill; ss = s; c = *s;
1469 if ( c == TSETNUM ) {
1470 *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1471 c = *s;
1472 }
1473 dotp = 0;
1474 switch(c) {
1475 case TSYMBOL:
1476 case TNUMBER:
1477 case TNUMBER1:
1478 *fill++ = *s++;
1479 while ( *s >= 0 ) *fill++ = *s++;
1480 if ( *s == TWILDCARD ) *fill++ = *s++;
1481dosymbol:
1482 t = s;
1483 if ( *s != TPOWER ) continue;
1484 *fill++ = *s++;
1485 if ( *s == TMINUS ) *fill++ = *s++;
1486 if ( *s == TPLUS ) s++;
1487 if ( *s == TSETNUM ) {
1488 *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1489 inset = 1;
1490 }
1491 else inset = 0;
1492 if ( *s == TNUMBER || *s == TNUMBER1 ) {
1493 base = *s == TNUMBER ? 100: 128;
1494 *fill++ = *s++;
1495 num = *s++; *fill++ = num;
1496 while ( *s >= 0 ) {
1497 if ( num > MAXPOWER ) break;
1498 *fill++ = *s;
1499 num = base*num + *s++;
1500 }
1501 while ( *s >= 0 ) *fill++ = *s++;
1502 if ( num <= MAXPOWER ) continue;
1503 goto putexp1;
1504 }
1505 else if ( *s == TSYMBOL && c != TNUMBER && c != TNUMBER1 ) {
1506 *fill++ = *s++;
1507 n = 0; while ( *s >= 0 ) { n = 128*n + *s; *fill++ = *s++; }
1508 if ( *s == TWILDCARD ) { *fill++ = *s++;
1509 if ( *s == TPOWER ) goto doublepower;
1510 break; }
1511/*
1512 Now we have to test whether n happens to be a wildcard
1513*/
1514 if ( mode == RHSIDE && inset == 0 ) {
1515/* n += WILDOFFSET;*/
1516 for ( i = 0; i < numprot; i += 4 ) {
1517 if ( prot[i+2] == n && prot[i] == SYMTOSYM ) break;
1518 }
1519 if ( i < numprot ) break;
1520 }
1521
1522putexp1: fill = ff;
1523 if ( denom < 0 ) fill[-1] = TMULTIPLY;
1524 *fill++ = TFUNCTION; *fill++ = (SBYTE)(AM.expnum); *fill++ = TFUNOPEN;
1525 if ( dotp ) *fill++ = LPARENTHESIS;
1526 while ( ss < t ) *fill++ = *ss++;
1527 if ( dotp ) *fill++ = RPARENTHESIS;
1528 *fill++ = TCOMMA;
1529 ss++; /* Skip TPOWER */
1530 if ( *ss == TMINUS ) { denom = -denom; ss++; }
1531 if ( denom < 0 ) {
1532 *fill++ = LPARENTHESIS;
1533 *fill++ = TMINUS;
1534 while ( ss < s ) *fill++ = *ss++;
1535 *fill++ = RPARENTHESIS;
1536 }
1537 else {
1538 while ( ss < s ) *fill++ = *ss++;
1539 }
1540 *fill++ = TFUNCLOSE;
1541 if ( *ss == TPOWER ) goto doublepower;
1542 }
1543 else { /* other objects can be composite */
1544 goto dofunpower;
1545 }
1546 break;
1547 case TINDEX:
1548 *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1549 if ( *s == TWILDCARD ) *fill++ = *s++;
1550 break;
1551 case TVECTOR:
1552 *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1553 if ( *s == TWILDCARD ) *fill++ = *s++;
1554dovector:
1555 if ( *s == TFUNOPEN ) {
1556 while ( *s != TFUNCLOSE ) *fill++ = *s++;
1557 *fill++ = *s++;
1558 }
1559 else if ( *s == TDOT ) goto dodot;
1560 t = s;
1561 goto dofunpower;
1562#ifdef WITHFLOAT
1563 case TFLOAT:
1564 *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1565 t = s;
1566 sube = 0;
1567 goto dofunpower;
1568#endif
1569 case TFUNCTION:
1570 *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1571 if ( *s == TWILDCARD ) *fill++ = *s++;
1572dofunction:
1573 t = s;
1574 if ( *t == TFUNOPEN ) {
1575 t++; n = 1;
1576 for(;;) {
1577 if ( *t == TFUNOPEN ) n++;
1578 else if ( *t == TFUNCLOSE ) { if ( --n <= 0 ) break; }
1579 t++;
1580 }
1581 t++; *fill++ = *s++;
1582 }
1583 sube = 0;
1584dofunpower:
1585 if ( *t == TPOWER || *t == TPOWER1 ) {
1586 if ( sube ) {
1587 if ( ( t[1] == TNUMBER || t[1] == TNUMBER1 )
1588 && denom > 0 ) {
1589 if ( t[2] >= 0 && t[3] < 0 ) { sube = 0; break; }
1590 }
1591 else if ( t[1] == TMINUS && denom < 0 &&
1592 ( t[2] == TNUMBER || t[2] == TNUMBER1 ) ) {
1593 if ( t[2] >= 0 && t[3] < 0 ) { sube = 0; break; }
1594 }
1595 sube = 0;
1596 }
1597 fill = ff;
1598 *fill++ = TFUNCTION; *fill++ = (SBYTE)(AM.expnum); *fill++ = TFUNOPEN;
1599 *fill++ = LPARENTHESIS;
1600 while ( ss < t ) *fill++ = *ss++;
1601 t++;
1602 *fill++ = RPARENTHESIS; *fill++ = TCOMMA;
1603 if ( *t == TMINUS ) { t++; denom = -denom; }
1604 *fill++ = LPARENTHESIS;
1605 if ( denom < 0 ) *fill++ = TMINUS;
1606 if ( *t == LPARENTHESIS ) {
1607 *fill++ = *t++; n = 0;
1608 while ( n >= 0 ) {
1609 if ( *t == LPARENTHESIS ) n++;
1610 else if ( *t == RPARENTHESIS ) n--;
1611 *fill++ = *t++;
1612 }
1613 }
1614 else if ( *t == TFUNCTION || *t == TDUBIOUS ) {
1615 *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1616 if ( *t == TWILDCARD ) *fill++ = *t++;
1617 if ( *t == TFUNOPEN ) {
1618 *fill++ = *t++; n = 0;
1619 while ( n >= 0 ) {
1620 if ( *t == TFUNOPEN ) n++;
1621 else if ( *t == TFUNCLOSE ) n--;
1622 *fill++ = *t++;
1623 }
1624 }
1625 }
1626 else if ( *t == TSET ) {
1627 *fill++ = *t++; n = 0;
1628 while ( *t >= 0 ) { n = 128*n + *t; *fill++ = *t++; }
1629 if ( *t == LBRACE ) {
1630 if ( n < AM.NumFixedSets || Sets[n].type == CRANGE ) {
1631 MesPrint("&This type of usage of sets is not allowed");
1632 error = 1;
1633 }
1634 *fill++ = *t++; n = 0;
1635 while ( n >= 0 ) {
1636 if ( *t == LBRACE ) n++;
1637 else if ( *t == RBRACE ) n--;
1638 *fill++ = *t++;
1639 }
1640 }
1641 }
1642 else if ( *t == TEXPRESSION ) {
1643 *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1644 if ( *t == TFUNOPEN ) {
1645 *fill++ = *t++; n = 0;
1646 while ( n >= 0 ) {
1647 if ( *t == TFUNOPEN ) n++;
1648 else if ( *t == TFUNCLOSE ) n--;
1649 *fill++ = *t++;
1650 }
1651 }
1652 if ( *t == LBRACE ) {
1653 *fill++ = *t++; n = 0;
1654 while ( n >= 0 ) {
1655 if ( *t == LBRACE ) n++;
1656 else if ( *t == RBRACE ) n--;
1657 *fill++ = *t++;
1658 }
1659 }
1660 }
1661 else if ( *t == TVECTOR ) {
1662 *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1663 if ( *t == TFUNOPEN ) {
1664 *fill++ = *t++; n = 0;
1665 while ( n >= 0 ) {
1666 if ( *t == TFUNOPEN ) n++;
1667 else if ( *t == TFUNCLOSE ) n--;
1668 *fill++ = *t++;
1669 }
1670 }
1671 else if ( *t == TDOT ) {
1672 *fill++ = *t++;
1673 if ( *t == TVECTOR || *t == TDUBIOUS ) {
1674 *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1675 }
1676 else if ( *t == TSET ) {
1677 *fill++ = *t++; num = 0;
1678 while ( *t >= 0 ) { num = 128*num + *t; *fill++ = *t++; }
1679 if ( Sets[num].type != CVECTOR ) {
1680 MesPrint("&Illegal set type in dotproduct");
1681 error = 1;
1682 }
1683 if ( *t == LBRACE ) {
1684 *fill++ = *t++; n = 0;
1685 while ( n >= 0 ) {
1686 if ( *t == LBRACE ) n++;
1687 else if ( *t == RBRACE ) n--;
1688 *fill++ = *t++;
1689 }
1690 }
1691 }
1692 else if ( *t == TSETNUM ) {
1693 *fill++ = *t++;
1694 while ( *t >= 0 ) { *fill++ = *t++; }
1695 *fill++ = *t++;
1696 while ( *t >= 0 ) { *fill++ = *t++; }
1697 }
1698 }
1699 else {
1700 MesPrint("&Illegal second element in dotproduct");
1701 error = 1;
1702 }
1703 }
1704 else {
1705 *fill++ = *t++; while ( *t >= 0 ) *fill++ = *t++;
1706 if ( *t == TWILDCARD ) *fill++ = *t++;
1707 }
1708 *fill++ = RPARENTHESIS; *fill++ = TFUNCLOSE;
1709 if ( *t == TPOWER ) goto doublepower;
1710 while ( fill > ff ) *--t = *--fill;
1711 s = t;
1712 }
1713 else if ( denom < 0 ) {
1714 fill = ff; ff[-1] = TMULTIPLY;
1715 *fill++ = TFUNCTION; *fill++ = (SBYTE)(AM.denomnum);
1716 *fill++ = TFUNOPEN; *fill++ = LPARENTHESIS;
1717 while ( ss < t ) *fill++ = *ss++;
1718 *fill++ = RPARENTHESIS; *fill++ = TFUNCLOSE;
1719 while ( fill > ff ) *--t = *--fill;
1720 s = t; denom = 1; sube = 0;
1721 break;
1722 }
1723 sube = 0;
1724 break;
1725 case TEXPRESSION:
1726 *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1727 t = s;
1728 if ( *t == TFUNOPEN ) {
1729 t++; n = 1;
1730 for(;;) {
1731 if ( *t == TFUNOPEN ) n++;
1732 else if ( *t == TFUNCLOSE ) { if ( --n <= 0 ) break; }
1733 t++;
1734 }
1735 t++;
1736 }
1737 if ( *t == LBRACE ) {
1738 t++; n = 1;
1739 for(;;) {
1740 if ( *t == LBRACE ) n++;
1741 else if ( *t == RBRACE ) { if ( --n <= 0 ) break; }
1742 t++;
1743 }
1744 t++;
1745 }
1746 if ( t > s || denom < 0 || ( ( *t == TPOWER || *t == TPOWER1 )
1747 && t[1] == TMINUS ) ) goto dofunpower;
1748 else goto dosymbol;
1749 case TDOLLAR:
1750 *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1751 goto dosymbol;
1752 case LPARENTHESIS:
1753 *fill++ = *s++; n = 1; t = s;
1754 for(;;) {
1755 if ( *t == LPARENTHESIS ) n++;
1756 else if ( *t == RPARENTHESIS ) { if ( --n <= 0 ) break; }
1757 t++;
1758 }
1759 t++; sube = 1;
1760 goto dofunpower;
1761 case TSET:
1762 *fill++ = *s++; n = *s++; *fill++ = (SBYTE)n;
1763 while ( *s >= 0 ) { *fill++ = *s; n = 128*n + *s++; }
1764 n = Sets[n].type;
1765 switch ( n ) {
1766 case CSYMBOL: goto dosymbol;
1767 case CINDEX: break;
1768 case CVECTOR: goto dovector;
1769 case CFUNCTION: goto dofunction;
1770 case CNUMBER: goto dosymbol;
1771 case CMODEL: break;
1772 case ANYTYPE: break;
1773 default: error = 1; break;
1774 }
1775 break;
1776 case TDOT:
1777dodot: *fill++ = *s++;
1778 if ( *s == TVECTOR ) {
1779 *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1780 }
1781 else if ( *s == TSET ) {
1782 *fill++ = *s++; n = *s++; *fill++ = (SBYTE)n;
1783 while ( *s >= 0 ) { *fill++ = *s; n = 128*n + *s++; }
1784 if ( *s == LBRACE ) {
1785 if ( n < AM.NumFixedSets || Sets[n].type == CRANGE ) {
1786 MesPrint("&This type of usage of sets is not allowed");
1787 error = 1;
1788 }
1789 *fill++ = *s++; n = 1;
1790 for(;;) {
1791 if ( *s == LBRACE ) n++;
1792 else if ( *s == RBRACE ) { if ( --n <= 0 ) break; }
1793 *fill++ = *s++;
1794 }
1795 *fill++ = *s++;
1796 }
1797 else {
1798 MesPrint("&Set without argument in dotproduct");
1799 error = 1;
1800 }
1801 }
1802 else if ( *s == TSETNUM ) {
1803 *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1804 if ( *s != TVECTOR ) goto nodot;
1805 *fill++ = *s++; while ( *s >= 0 ) *fill++ = *s++;
1806 }
1807 else {
1808nodot: MesPrint("&Illegal second element in dotproduct");
1809 error = 1;
1810 *fill++ = *s++;
1811 while ( *s >= 0 ) *fill++ = *s++;
1812 }
1813 dotp = 1;
1814 goto dosymbol;
1815 default:
1816 *fill++ = *s++;
1817 while ( *s >= 0 ) *fill++ = *s++;
1818 break;
1819 }
1820 }
1821 *fill = TENDOFIT;
1822 // Now copy the modified tokens back to the original buffer
1823 fill = tmptokens;
1824 s = AC.tokens;
1825 do {
1826 *s++ = *fill;
1827 } while ( *fill++ != TENDOFIT );
1828 M_free(tmptokens, "simp3btoken scratch");
1829 return(error);
1830doublepower:;
1831 MesPrint("&Dubious notation with power of power");
1832 M_free(tmptokens, "simp3btoken scratch");
1833 return(-1);
1834}
1835
1836/*
1837 #] simp3btoken :
1838 #[ simp4token :
1839
1840 Deal with the set[n] objects in the RHS.
1841*/
1842
1843int simp4token(SBYTE *s)
1844{
1845 int error = 0, n, nsym, settype;
1846 WORD i, *w, *wstop, level;
1847 SBYTE *const s0 = s;
1848 SBYTE *fill = s, *s1, *s2, *s3, type, s1buf[10];
1849 SBYTE *tbuf = s, *t, *t1;
1850
1851 while ( *s != TENDOFIT ) {
1852 if ( *s != TSET ) {
1853 if ( *s == TEMPTY ) s++;
1854 else *fill++ = *s++;
1855 continue;
1856 }
1857 if ( fill >= (s0+1) && fill[-1] == TWILDCARD ) { *fill++ = *s++; continue; }
1858 if ( fill >= (s0+2) && fill[-1] == TNOT && fill[-2] == TWILDCARD ) { *fill++ = *s++; continue; }
1859 s1 = s++; n = 0; while ( *s >= 0 ) { n = 128*n + *s++; }
1860 i = Sets[n].type;
1861 if ( *s != LBRACE ) { while ( s1 < s ) *fill++ = *s1++; continue; }
1862 if ( n < AM.NumFixedSets || i == CRANGE ) {
1863 MesPrint("&It is not allowed to refer to individual elements of built in or ranged sets");
1864 error = 1;
1865 }
1866 s++;
1867 if ( *s != TSYMBOL && *s != TDOLLAR ) {
1868 MesPrint("&Set index in RHS is not a wildcard symbol or $-variable");
1869 error = 1;
1870 while ( s1 < s ) *fill++ = *s1++;
1871 continue;
1872 }
1873 settype = ( *s == TDOLLAR );
1874 s++; nsym = 0; s2 = s;
1875 while ( *s >= 0 ) nsym = 128*nsym + *s++;
1876 if ( *s != RBRACE ) {
1877 MesPrint("&Improper set argument in RHS");
1878 error = 1;
1879 while ( s1 < s ) *fill++ = *s1++;
1880 continue;
1881 }
1882 s++;
1883/*
1884 Verify that nsym is a wildcard
1885*/
1886 if ( !settype ) {
1887 w = AC.ProtoType; wstop = w + w[1]; w += SUBEXPSIZE;
1888 while ( w < wstop ) {
1889 if ( *w == SYMTOSYM && w[2] == nsym ) break;
1890 w += w[1];
1891 }
1892 if ( w >= wstop ) {
1893/*
1894 It could still be a summation parameter!
1895*/
1896 t = fill - 1;
1897 while ( t >= tbuf ) {
1898 if ( *t == TFUNCLOSE ) {
1899 level = 1; t--;
1900 while ( t >= tbuf ) {
1901 if ( *t == TFUNCLOSE ) level++;
1902 else if ( *t == TFUNOPEN ) {
1903 level--;
1904 if ( level == 0 ) break;
1905 }
1906 t--;
1907 }
1908 }
1909 else if ( *t == RBRACE ) {
1910 level = 1; t--;
1911 while ( t >= tbuf ) {
1912 if ( *t == RBRACE ) level++;
1913 else if ( *t == LBRACE ) {
1914 level--;
1915 if ( level == 0 ) break;
1916 }
1917 t--;
1918 }
1919 }
1920 else if ( *t == RPARENTHESIS ) {
1921 level = 1; t--;
1922 while ( t >= tbuf ) {
1923 if ( *t == RPARENTHESIS ) level++;
1924 else if ( *t == LPARENTHESIS ) {
1925 level--;
1926 if ( level == 0 ) break;
1927 }
1928 t--;
1929 }
1930 }
1931 else if ( *t == TFUNOPEN ) {
1932 t1 = t-1;
1933 while ( *t1 > 0 && t1 > tbuf ) t1--;
1934 if ( *t1 == TFUNCTION ) {
1935 t1++; level = 0;
1936 while ( *t1 > 0 ) level = level*128+*t1++;
1937 if ( level == (SUMF1-FUNCTION)
1938 || level == (SUMF2-FUNCTION) ) {
1939 t1 = t + 1;
1940 if ( *t1 == LPARENTHESIS ) t1++;
1941 if ( *t1 == TSYMBOL ) {
1942 if ( ( t1[1] == COEFFSYMBOL
1943 || t1[1] == NUMERATORSYMBOL
1944 || t1[1] == DENOMINATORSYMBOL )
1945 && t1[2] < 0 ) {}
1946 else {
1947 t1++; level = 0;
1948 while ( *t1 >= 0 && t1 < fill ) level = 128*level + *t1++;
1949 if ( level == nsym && t1 < fill ) {
1950 if ( t[1] == LPARENTHESIS
1951 && *t1 == RPARENTHESIS && t1[1] == TCOMMA ) break;
1952 if ( t[1] != LPARENTHESIS && *t1 == TCOMMA ) break;
1953 }
1954 }
1955 }
1956 }
1957 }
1958 }
1959 t--;
1960 }
1961 if ( t < tbuf ) {
1962 fill--;
1963 MesPrint("&Set index in RHS is not a wildcard symbol");
1964 error = 1;
1965 while ( s1 < s ) *fill++ = *s1++;
1966 continue;
1967 }
1968 }
1969 }
1970/*
1971 Now replace by a set marker: TSETNUM,nsym,TYPE,setnumber
1972*/
1973 switch ( i ) {
1974 case CSYMBOL: type = TSYMBOL; break;
1975 case CINDEX: type = TINDEX; break;
1976 case CVECTOR: type = TVECTOR; break;
1977 case CFUNCTION: type = TFUNCTION; break;
1978 case CNUMBER: type = TNUMBER1; break;
1979 case CDUBIOUS: type = TDUBIOUS; break;
1980 default:
1981 MesPrint("&Unknown set type in simp4token");
1982 error = 1; type = CDUBIOUS; break;
1983 }
1984 s3 = s1buf; s1++;
1985 while ( *s1 >= 0 ) *s3++ = *s1++;
1986 *s3 = -1; s1 = s1buf;
1987 if ( settype ) *fill++ = TSETDOL;
1988 else *fill++ = TSETNUM;
1989 while ( *s2 >= 0 ) *fill++ = *s2++;
1990 *fill++ = type; while ( *s1 >= 0 ) *fill++ = *s1++;
1991 }
1992 *fill++ = TENDOFIT;
1993 return(error);
1994}
1995
1996/*
1997 #] simp4token :
1998 #[ simp5token :
1999
2000 Making sure that first argument of sumfunction is not a wildcard already
2001*/
2002
2003int simp5token(SBYTE *s, int mode)
2004{
2005 int error = 0, n, type;
2006 WORD *w, *wstop;
2007 if ( mode == RHSIDE ) {
2008 while ( *s != TENDOFIT ) {
2009 if ( *s == TFUNCTION ) {
2010 s++; n = 0; while ( *s >= 0 ) n = 128*n + *s++;
2011 if ( n == AM.sumnum || n == AM.sumpnum ) {
2012 if ( *s != TFUNOPEN ) continue;
2013 s++;
2014 if ( *s != TSYMBOL && *s != TINDEX ) continue;
2015 type = *s++;
2016 n = 0; while ( *s >= 0 ) n = 128*n + *s++;
2017 if ( type == TINDEX ) n += AM.OffsetIndex;
2018 if ( *s != TCOMMA ) continue;
2019 w = AC.ProtoType;
2020 wstop = w + w[1];
2021 w += SUBEXPSIZE;
2022 while ( w < wstop ) {
2023 if ( w[2] == n ) {
2024 if ( ( type == TSYMBOL && ( w[0] == SYMTOSYM
2025 || w[0] == SYMTONUM || w[0] == SYMTOSUB ) ) || (
2026 type == TINDEX && ( w[0] == INDTOIND
2027 || w[0] == INDTOSUB ) ) ) {
2028 error = 1;
2029 MesPrint("&Parameter of sum function is already a wildcard");
2030 }
2031 }
2032 w += w[1];
2033 }
2034 }
2035 }
2036 else s++;
2037 }
2038 }
2039 return(error);
2040}
2041
2042/*
2043 #] simp5token :
2044 #[ simp6token :
2045
2046 Making sure that factorized expressions are used properly
2047*/
2048
2049int simp6token(SBYTE *tokens, int mode)
2050{
2051/* EXPRESSIONS e = Expressions; */
2052 int error = 0, n;
2053 int level = 0, haveone = 0;
2054 SBYTE *s = tokens, *ss;
2055 LONG numterms;
2056 WORD funnum = 0;
2057 GETIDENTITY
2058 if ( mode == RHSIDE ) {
2059 while ( *s == TPLUS || *s == TMINUS ) s++;
2060 numterms = 1;
2061 while ( *s != TENDOFIT ) {
2062 if ( *s == LPARENTHESIS ) level++;
2063 else if ( *s == RPARENTHESIS ) level--;
2064 else if ( *s == TFUNOPEN ) level++;
2065 else if ( *s == TFUNCLOSE ) level--;
2066 else if ( ( *s == TPLUS || *s == TMINUS ) && level == 0 ) {
2067/*
2068 Special exception: x^-1 etc.
2069*/
2070 if ( s[-1] != TPOWER && s[-1] != TPLUS && s[-1] != TMINUS ) {
2071 numterms++;
2072 }
2073 }
2074 else if ( *s == TEXPRESSION ) {
2075 ss = s;
2076 s++; n = 0; while ( *s >= 0 ) n = 128*n + *s++;
2077
2078 if ( Expressions[n].status == STOREDEXPRESSION ) {
2079 POSITION position;
2080/*
2081#ifdef WITHPTHREADS
2082 RENUMBER renumber;
2083#endif
2084*/
2085 RENUMBER renumber;
2086
2087 WORD TMproto[SUBEXPSIZE];
2088 TMproto[0] = EXPRESSION;
2089 TMproto[1] = SUBEXPSIZE;
2090 TMproto[2] = n;
2091 TMproto[3] = 1;
2092 { int ie; for ( ie = 4; ie < SUBEXPSIZE; ie++ ) TMproto[ie] = 0; }
2093 AT.TMaddr = TMproto;
2094 PUTZERO(position);
2095/*
2096 if ( (
2097#ifdef WITHPTHREADS
2098 renumber =
2099#endif
2100 GetTable(n,&position,0) ) == 0 )
2101*/
2102 if ( ( renumber = GetTable(n,&position,0) ) == 0 )
2103 {
2104 error = 1;
2105 MesPrint("&Problems getting information about stored expression %s(4)"
2106 ,EXPRNAME(n));
2107 }
2108/*
2109#ifdef WITHPTHREADS
2110*/
2111 if ( renumber->symb.lo != AN.dummyrenumlist )
2112 M_free(renumber->symb.lo,"VarSpace");
2113 M_free(renumber,"Renumber");
2114/*
2115#endif
2116*/
2117 }
2118
2119 if ( ( ( AS.Oldvflags[n] & ISFACTORIZED ) != 0 ) && *s != LBRACE ) {
2120 if ( level == 0 ) {
2121 haveone = 1;
2122 }
2123 else if ( error == 0 ) {
2124 if ( ss[-1] != TFUNOPEN || funnum != NUMFACTORS-FUNCTION ) {
2125 MesPrint("&Illegal use of factorized expression(s) in RHS");
2126 error = 1;
2127 }
2128 }
2129 }
2130 continue;
2131 }
2132 else if ( *s == TFUNCTION ) {
2133 s++; funnum = 0; while ( *s >= 0 ) funnum = 128*funnum + *s++;
2134 continue;
2135 }
2136 s++;
2137 }
2138 if ( haveone ) {
2139 if ( numterms > 1 ) {
2140 MesPrint("&Factorized expression in RHS in an expression of more than one term.");
2141 error = 1;
2142 }
2143 else if ( AC.ToBeInFactors == 0 ) {
2144 MesPrint("&Attempt to put a factorized expression inside an unfactorized expression.");
2145 error = 1;
2146 }
2147 }
2148 }
2149 return(error);
2150}
2151
2152/*
2153 #] simp6token :
2154 #] Compiler :
2155*/
SkipAName
UBYTE * SkipAName(UBYTE *s)
Definition compiler.c:443
ReNuMbEr::symb
VARRENUM symb
Definition structs.h:179
VaRrEnUm::lo
WORD * lo
Definition structs.h:166
Generated by doxygen 1.9.8