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