43static KEYWORD formatoptions[] = {
44 {
"allfloat", (TFUN)0, ALLINTEGERDOUBLE, 0}
45 ,{
"c", (TFUN)0, CMODE, 0}
46 ,{
"doublefortran", (TFUN)0, DOUBLEFORTRANMODE, 0}
47 ,{
"float", (TFUN)0, 0, 2}
48 ,{
"fortran", (TFUN)0, FORTRANMODE, 0}
49 ,{
"fortran90", (TFUN)0, FORTRANMODE, 4}
50 ,{
"maple", (TFUN)0, MAPLEMODE, 0}
51 ,{
"mathematica", (TFUN)0, MATHEMATICAMODE, 0}
52 ,{
"normal", (TFUN)0, NORMALFORMAT, 1}
53 ,{
"nospaces", (TFUN)0, NOSPACEFORMAT, 3}
54 ,{
"pfortran", (TFUN)0, PFORTRANMODE, 0}
55 ,{
"quadfortran", (TFUN)0, QUADRUPLEFORTRANMODE, 0}
56 ,{
"quadruplefortran", (TFUN)0, QUADRUPLEFORTRANMODE, 0}
57 ,{
"rational", (TFUN)0, RATIONALMODE, 1}
58 ,{
"reduce", (TFUN)0, REDUCEMODE, 0}
59 ,{
"spaces", (TFUN)0, NORMALFORMAT, 3}
60 ,{
"vortran", (TFUN)0, VORTRANMODE, 0}
63static KEYWORD trace4options[] = {
64 {
"contract", (TFUN)0, CHISHOLM, 0 }
65 ,{
"nocontract", (TFUN)0, 0, CHISHOLM }
66 ,{
"nosymmetrize",(TFUN)0, 0, ALSOREVERSE}
67 ,{
"notrick", (TFUN)0, NOTRICK, 0 }
68 ,{
"symmetrize", (TFUN)0, ALSOREVERSE, 0 }
69 ,{
"trick", (TFUN)0, 0, NOTRICK }
73 {
"nosymmetrize",(TFUN)0, 0, ALSOREVERSE}
74 ,{
"symmetrize", (TFUN)0, ALSOREVERSE, 0 }
78 {
"stats", &(AC.StatsFlag), 1, 0}
79 ,{
"statistics", &(AC.StatsFlag), 1, 0}
80 ,{
"shortstats", &(AC.ShortStats), 1, 0}
81 ,{
"shortstatistics",&(AC.ShortStats), 1, 0}
82 ,{
"warnings", &(AC.WarnFlag), 1, 0}
83 ,{
"allwarnings", &(AC.WarnFlag), 2, 0}
84 ,{
"setup", &(AC.SetupFlag), 1, 0}
85 ,{
"names", &(AC.NamesFlag), 1, 0}
86 ,{
"allnames", &(AC.NamesFlag), 2, 0}
87 ,{
"codes", &(AC.CodesFlag), 1, 0}
88 ,{
"highfirst", &(AC.SortType), SORTHIGHFIRST, SORTLOWFIRST}
89 ,{
"lowfirst", &(AC.SortType), SORTLOWFIRST, SORTHIGHFIRST}
90 ,{
"powerfirst", &(AC.SortType), SORTPOWERFIRST, SORTHIGHFIRST}
91 ,{
"tokens", &(AC.TokensWriteFlag),1, 0}
95 {
"compress", &(AC.NoCompress), 0, 1}
96 ,{
"checkpoint", &(AC.CheckpointFlag), 1, 0}
97 ,{
"insidefirst", &(AC.insidefirst), 1, 0}
98 ,{
"propercount", &(AC.BottomLevel), 1, 0}
99 ,{
"stats", &(AC.StatsFlag), 1, 0}
100 ,{
"statistics", &(AC.StatsFlag), 1, 0}
101 ,{
"shortstats", &(AC.ShortStats), 1, 0}
102 ,{
"shortstatistics",&(AC.ShortStats), 1, 0}
103 ,{
"names", &(AC.NamesFlag), 1, 0}
104 ,{
"allnames", &(AC.NamesFlag), 2, 0}
105 ,{
"warnings", &(AC.WarnFlag), 1, 0}
106 ,{
"allwarnings", &(AC.WarnFlag), 2, 0}
107 ,{
"highfirst", &(AC.SortType), SORTHIGHFIRST, SORTLOWFIRST}
108 ,{
"lowfirst", &(AC.SortType), SORTLOWFIRST, SORTHIGHFIRST}
109 ,{
"powerfirst", &(AC.SortType), SORTPOWERFIRST, SORTHIGHFIRST}
110 ,{
"setup", &(AC.SetupFlag), 1, 0}
111 ,{
"codes", &(AC.CodesFlag), 1, 0}
112 ,{
"tokens", &(AC.TokensWriteFlag),1,0}
113 ,{
"properorder", &(AC.properorderflag),1,0}
114 ,{
"threadloadbalancing",&(AC.ThreadBalancing),1, 0}
115 ,{
"threads", &(AC.ThreadsFlag),1, 0}
116 ,{
"threadsortfilesynch",&(AC.ThreadSortFileSynch),1, 0}
117 ,{
"threadstats", &(AC.ThreadStats),1, 0}
118 ,{
"finalstats", &(AC.FinalStats),1, 0}
119 ,{
"fewerstats", &(AC.ShortStatsMax), 10, 0}
120 ,{
"fewerstatistics",&(AC.ShortStatsMax), 10, 0}
121 ,{
"processstats", &(AC.ProcessStats),1, 0}
122 ,{
"oldparallelstats",&(AC.OldParallelStats),1,0}
123 ,{
"parallel", &(AC.parallelflag),PARALLELFLAG,NOPARALLEL_USER}
124 ,{
"nospacesinnumbers",&(AO.NoSpacesInNumbers),1,0}
125 ,{
"indentspace", &(AO.IndentSpace),INDENTSPACE,0}
126 ,{
"totalsize", &(AM.PrintTotalSize), 1, 0}
127 ,{
"flag", (
int *)&(AC.debugFlags), 1, 0}
128 ,{
"oldfactarg", &(AC.OldFactArgFlag), 1, 0}
129 ,{
"memdebugflag", &(AC.MemDebugFlag), 1, 0}
130 ,{
"oldgcd", &(AC.OldGCDflag), 1, 0}
131 ,{
"innertest", &(AC.InnerTest), 1, 0}
132 ,{
"wtimestats", &(AC.WTimeStatsFlag), 1, 0}
144int CoCollect(UBYTE *s)
149 UBYTE *t = SkipAName(s), *t1, *t2;
150 AC.AltCollectFun = 0;
151 if ( t == 0 )
goto syntaxerror;
152 t1 = t;
while ( *t1 ==
',' || *t1 ==
' ' || *t1 ==
'\t' ) t1++;
154 if ( *t1 && ( FG.cTable[*t1] == 0 || *t1 ==
'[' ) ) {
156 if ( t2 == 0 )
goto syntaxerror;
158 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
162 if ( *t && FG.cTable[*t] == 1 ) {
163 while ( *t >=
'0' && *t <=
'9' ) x = 10*x + *t++ -
'0';
164 if ( x > 100 ) x = 100;
165 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
166 if ( *t )
goto syntaxerror;
169 if ( *t )
goto syntaxerror;
172 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
173 || ( functions[numfun].spec != 0 ) ) {
174 MesPrint(
"&%s should be a regular function",s);
176 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
177 AddFunction(s,0,0,0,0,0,-1,-1);
181 AC.CollectFun = numfun+FUNCTION;
182 AC.CollectPercentage = (WORD)x;
184 if ( ( ( type = GetName(AC.varnames,t1,&numfun,WITHAUTO) ) != CFUNCTION )
185 || ( functions[numfun].spec != 0 ) ) {
186 MesPrint(
"&%s should be a regular function",t1);
188 if ( GetName(AC.exprnames,t1,&numfun,NOAUTO) == NAMENOTFOUND )
189 AddFunction(t1,0,0,0,0,0,-1,-1);
193 AC.AltCollectFun = numfun+FUNCTION;
197 MesPrint(
"&Collect statement needs one or two functions (and a percentage) for its argument(s)");
206int setonoff(UBYTE *s,
int *flag,
int onvalue,
int offvalue)
208 if ( StrICmp(s,(UBYTE *)
"on") == 0 ) *flag = onvalue;
209 else if ( StrICmp(s,(UBYTE *)
"off") == 0 ) *flag = offvalue;
211 MesPrint(
"&Unknown option: %s, on or off expected",s);
222int CoCompress(UBYTE *s)
226 if ( StrICmp(s,(UBYTE *)
"on") == 0 ) {
230 else if ( StrICmp(s,(UBYTE *)
"off") == 0 ) {
235 t = s;
while ( FG.cTable[*t] <= 1 ) t++;
237 if ( StrICmp(s,(UBYTE *)
"gzip") == 0 ) {
239 Warning(
"gzip compression not supported on this platform");
243 AR.gzipCompress = GZIPDEFAULT;
246 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
248 if ( FG.cTable[*s] == 1 ) {
249 AR.gzipCompress = *s -
'0';
251 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
252 if ( *s == 0 )
return(0);
254 MesPrint(
"&Unknown gzip option: %s, a digit was expected",t);
259 MesPrint(
"&Unknown option: %s, on, off or gzip expected",s);
271int CoFlags(UBYTE *s,
int value)
275 MesPrint(
"&Proper syntax is: On/Off Flag,number[s];");
278 while ( *s ==
',' ) {
279 do { s++; }
while ( *s ==
',' );
281 if ( FG.cTable[*s] != 1 ) {
282 MesPrint(
"&Proper syntax is: On/Off Flag,number[s];");
286 while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ -
'0'; }
287 if ( i <= 0 || i > MAXFLAGS ) {
288 MesPrint(
"&The number of a flag in On/Off Flag should be in the range 0-%d",(
int)MAXFLAGS);
292 AC.debugFlags[i] = value;
295 MesPrint(
"&Proper syntax is: On/Off Flag,number[s];");
310 int i, num =
sizeof(onoffoptions)/
sizeof(
KEYWORD);
312 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
313 if ( *s == 0 )
return(0);
314 if ( chartype[*s] != 0 ) {
315 MesPrint(
"&Illegal character or option encountered in OFF statement");
318 t = s;
while ( chartype[*s] == 0 ) s++;
320 for ( i = 0; i < num; i++ ) {
321 if ( StrICont(t,(UBYTE *)(onoffoptions[i].name)) == 0 )
break;
324 MesPrint(
"&Unrecognized option in OFF statement: %s",t);
327 else if ( StrICont(t,(UBYTE *)
"compress") == 0 ) {
330 else if ( StrICont(t,(UBYTE *)
"checkpoint") == 0 ) {
331 AC.CheckpointInterval = 0;
332 if ( AC.CheckpointRunBefore ) { free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL; }
333 if ( AC.CheckpointRunAfter ) { free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL; }
334 if ( AC.NoShowInput == 0 ) MesPrint(
"Checkpoints deactivated.");
336 else if ( StrICont(t,(UBYTE *)
"threads") == 0 ) {
337 AS.MultiThreaded = 0;
339 else if ( StrICont(t,(UBYTE *)
"flag") == 0 ) {
341 return(CoFlags(s,0));
343 else if ( StrICont(t,(UBYTE *)
"innertest") == 0 ) {
346 if ( AC.TestValue ) {
347 M_free(AC.TestValue,
"InnerTest");
352 *onoffoptions[i].var = onoffoptions[i].flags;
353 AR.SortType = AC.SortType;
354 AC.mparallelflag = AC.parallelflag | AM.hparallelflag;
367 int i, num =
sizeof(onoffoptions)/
sizeof(
KEYWORD);
370 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
371 if ( *s == 0 )
return(0);
372 if ( chartype[*s] != 0 ) {
373 MesPrint(
"&Illegal character or option encountered in ON statement");
376 t = s;
while ( chartype[*s] == 0 ) s++;
378 for ( i = 0; i < num; i++ ) {
379 if ( StrICont(t,(UBYTE *)(onoffoptions[i].name)) == 0 )
break;
382 MesPrint(
"&Unrecognized option in ON statement: %s",t);
385 if ( StrICont(t,(UBYTE *)
"compress") == 0 ) {
388 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
391 while ( FG.cTable[*s] <= 1 ) s++;
393 if ( StrICmp(t,(UBYTE *)
"gzip") == 0 ) {}
395 MesPrint(
"&Unrecognized option in ON compress statement: %s",t);
399 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
401 Warning(
"gzip compression not supported on this platform");
403 if ( FG.cTable[*s] == 1 ) {
404 AR.gzipCompress = *s++ -
'0';
405 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
407 MesPrint(
"&Unrecognized option in ON compress gzip statement: %s",t);
411 else if ( *s == 0 ) {
412 AR.gzipCompress = GZIPDEFAULT;
415 MesPrint(
"&Unrecognized option in ON compress gzip statement: %s, single digit expected",t);
420 else if ( StrICont(t,(UBYTE *)
"checkpoint") == 0 ) {
421 AC.CheckpointInterval = 0;
422 if ( AC.CheckpointRunBefore ) { free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL; }
423 if ( AC.CheckpointRunAfter ) { free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL; }
426 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
427 if ( FG.cTable[*s] == 1 ) {
430 do { interval = 10*interval + *s++ -
'0'; }
while ( FG.cTable[*s] == 1 );
431 if ( *s ==
's' || *s ==
'S' ) {
434 else if ( *s ==
'm' || *s ==
'M' ) {
437 else if ( *s ==
'h' || *s ==
'H' ) {
438 interval *= 3600; s++;
440 else if ( *s ==
'd' || *s ==
'D' ) {
441 interval *= 86400; s++;
443 if ( *s !=
',' && FG.cTable[*s] != 6 && FG.cTable[*s] != 10 ) {
444 MesPrint(
"&Unrecognized time interval in ON Checkpoint statement: %s", t);
447 AC.CheckpointInterval = interval * 100;
449 else if ( FG.cTable[*s] == 0 ) {
452 while ( FG.cTable[*s] == 0 ) s++;
454 if ( StrICmp(t,(UBYTE *)
"run") == 0 ) {
457 else if ( StrICmp(t,(UBYTE *)
"runafter") == 0 ) {
460 else if ( StrICmp(t,(UBYTE *)
"runbefore") == 0 ) {
464 MesPrint(
"&Unrecognized option in ON Checkpoint statement: %s", t);
468 if ( *s !=
'=' && FG.cTable[*(s+1)] != 9 ) {
469 MesPrint(
"&Unrecognized option in ON Checkpoint statement: %s", t);
475 if ( FG.cTable[*s] == 9 ) {
478 if ( AC.CheckpointRunBefore ) {
479 free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL;
482 AC.CheckpointRunBefore = Malloc1(s-t+1,
"AC.CheckpointRunBefore");
483 StrCopy(t, (UBYTE*)AC.CheckpointRunBefore);
487 if ( AC.CheckpointRunAfter ) {
488 free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL;
491 AC.CheckpointRunAfter = Malloc1(s-t+1,
"AC.CheckpointRunAfter");
492 StrCopy(t, (UBYTE*)AC.CheckpointRunAfter);
500 if ( FG.cTable[*s] != 9 ) {
501 MesPrint(
"&Unrecognized option in ON Checkpoint statement: %s", t);
525 else if ( StrICont(t,(UBYTE *)
"indentspace") == 0 ) {
527 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
530 while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ -
'0'; }
532 MesPrint(
"&Unrecognized option in ON IndentSpace statement: %s",t);
536 Warning(
"IndentSpace parameter adjusted to 40");
542 AO.IndentSpace = AM.ggIndentSpace;
546 else if ( ( StrICont(t,(UBYTE *)
"fewerstats") == 0 ) ||
547 ( StrICont(t,(UBYTE *)
"fewerstatistics") == 0 ) ) {
549 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
552 while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ -
'0'; }
554 MesPrint(
"&Unrecognized option in ON FewerStatistics statement: %s",t);
557 if ( i > AM.S0->MaxPatches ) {
559 MesPrint(
"&Warning: FewerStatistics parameter greater than MaxPatches(=%d). Adjusted to %d"
560 ,AM.S0->MaxPatches,(AM.S0->MaxPatches+1)/2);
561 i = (AM.S0->MaxPatches+1)/2;
563 AC.ShortStatsMax = i;
566 AC.ShortStatsMax = 10;
570 else if ( StrICont(t,(UBYTE *)
"threads") == 0 ) {
571 if ( AM.totalnumberofthreads > 1 ) AS.MultiThreaded = 1;
573 else if ( StrICont(t,(UBYTE *)
"flag") == 0 ) {
575 return(CoFlags(s,1));
577 else if ( StrICont(t,(UBYTE *)
"innertest") == 0 ) {
580 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
582 t = s;
while ( *t ) t++;
583 while ( t[-1] ==
' ' || t[-1] ==
'\t' ) t--;
585 if ( AC.TestValue ) M_free(AC.TestValue,
"InnerTest");
586 AC.TestValue = strDup1(s,
"InnerTest");
589 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
592 if ( AC.TestValue ) {
593 M_free(AC.TestValue,
"InnerTest");
599 *onoffoptions[i].var = onoffoptions[i].type;
600 AR.SortType = AC.SortType;
601 AC.mparallelflag = AC.parallelflag | AM.hparallelflag;
610int CoInsideFirst(UBYTE *s) {
return(setonoff(s,&AC.insidefirst,1,0)); }
617int CoProperCount(UBYTE *s) {
return(setonoff(s,&AC.BottomLevel,1,0)); }
624int CoDelete(UBYTE *s)
627 if ( StrICmp(s,(UBYTE *)
"storage") == 0 ) {
628 if ( DeleteStore(1) < 0 ) {
629 MesPrint(
"&Cannot restart storage file");
635 while ( *t && *t !=
',' && *t !=
'>' ) t++;
637 if ( ( StrICmp(s,(UBYTE *)
"extrasymbols") == 0 )
638 || ( StrICmp(s,(UBYTE *)
"extrasymbol") == 0 ) ) {
646 if ( FG.cTable[*s] != 1 )
goto unknown;
647 while ( *s <=
'9' && *s >=
'0' ) x = 10*x + *s++ -
'0';
648 if ( *s )
goto unknown;
650 else if ( *s )
goto unknown;
651 if ( x < AM.gnumextrasym ) x = AM.gnumextrasym;
652 PruneExtraSymbols(x);
657 MesPrint(
"&Unknown option: %s",s);
669int CoFormat(UBYTE *s)
674 while ( *s ==
' ' || *s ==
',' ) s++;
677 AC.OutputSpaces = NORMALFORMAT;
683 if ( *s ==
'O' || *s ==
'o' ) {
684 if ( ( FG.cTable[s[1]] == 1 ) ||
685 ( s[1] ==
'=' && FG.cTable[s[2]] == 1 ) ) {
686 s++;
if ( *s ==
'=' ) s++;
688 while ( *s >=
'0' && *s <=
'9' ) x = 10*x + *s++ -
'0';
689 while ( *s ==
',' ) s++;
690 AO.OptimizationLevel = x;
691 AO.Optimize.greedytimelimit = 0;
692 AO.Optimize.mctstimelimit = 0;
693 AO.Optimize.printstats = 0;
694 AO.Optimize.debugflags = 0;
695 AO.Optimize.schemeflags = 0;
696 AO.Optimize.mctsdecaymode = 1;
698 M_free(AO.inscheme,
"Horner input scheme");
699 AO.inscheme = 0; AO.schemenum = 0;
705 AO.Optimize.mctsconstant.fval = -1.0;
706 AO.Optimize.horner = O_OCCURRENCE;
707 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
708 AO.Optimize.method = O_CSE;
711 AO.Optimize.horner = O_OCCURRENCE;
712 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
713 AO.Optimize.method = O_GREEDY;
714 AO.Optimize.greedyminnum = 10;
715 AO.Optimize.greedymaxperc = 5;
718 AO.Optimize.mctsconstant.fval = 1.0;
719 AO.Optimize.horner = O_MCTS;
720 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
721 AO.Optimize.method = O_GREEDY;
722 AO.Optimize.mctsnumexpand = 1000;
723 AO.Optimize.mctsnumkeep = 10;
724 AO.Optimize.mctsnumrepeat = 1;
725 AO.Optimize.greedyminnum = 10;
726 AO.Optimize.greedymaxperc = 5;
729 AO.Optimize.horner = O_SIMULATED_ANNEALING;
730 AO.Optimize.saIter = 1000;
731 AO.Optimize.saMaxT.fval = 2000;
732 AO.Optimize.saMinT.fval = 1;
736 MesPrint(
"&Illegal optimization specification in format statement");
739 if ( error == 0 && *s != 0 && x > 0 )
return(CoOptimizeOption(s));
745 while ( FG.cTable[*s] == 0 ) s++;
747 if ( StrICont(ss,(UBYTE *)
"optimize") == 0 ) {
749 while ( *s ==
',' ) s++;
750 if ( *s ==
'=' ) s++;
751 AO.OptimizationLevel = 3;
752 AO.Optimize.mctsconstant.fval = 1.0;
753 AO.Optimize.horner = O_MCTS;
754 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
755 AO.Optimize.method = O_GREEDY;
756 AO.Optimize.mctstimelimit = 0;
757 AO.Optimize.mctsnumexpand = 1000;
758 AO.Optimize.mctsnumkeep = 10;
759 AO.Optimize.mctsnumrepeat = 1;
760 AO.Optimize.greedytimelimit = 0;
761 AO.Optimize.greedyminnum = 10;
762 AO.Optimize.greedymaxperc = 5;
763 AO.Optimize.printstats = 0;
764 AO.Optimize.debugflags = 0;
765 AO.Optimize.schemeflags = 0;
766 AO.Optimize.mctsdecaymode = 1;
768 M_free(AO.inscheme,
"Horner input scheme");
769 AO.inscheme = 0; AO.schemenum = 0;
771 return(CoOptimizeOption(s));
775 MesPrint(
"&Illegal optimization specification in format statement");
781 else if ( FG.cTable[*s] == 1 ) {
783 while ( FG.cTable[*s] == 1 ) x = 10*x + *s++ -
'0';
784 if ( x <= 0 || x >= MAXLINELENGTH ) {
786 MesPrint(
"&Illegal value for linesize: %d",x);
790 MesPrint(
" ... Too small value for linesize corrected to 39");
803 MesPrint(
"&Illegal linesize field in format statement");
807 key = FindKeyWord(s,formatoptions,
808 sizeof(formatoptions)/
sizeof(
KEYWORD));
810 if ( key->type == FORTRANMODE || key->type == PFORTRANMODE || key->type == DOUBLEFORTRANMODE
811 || key->type == QUADRUPLEFORTRANMODE || key->type == VORTRANMODE ) {
812 if (AC.LineLength > 72) AC.LineLength = 72;
815 if ( key->flags == 0 ) {
816 if ( key->type == FORTRANMODE || key->type == PFORTRANMODE
817 || key->type == DOUBLEFORTRANMODE || key->type == ALLINTEGERDOUBLE
818 || key->type == QUADRUPLEFORTRANMODE || key->type == VORTRANMODE ) {
819 AC.IsFortran90 = ISNOTFORTRAN90;
820 if ( AC.Fortran90Kind ) {
821 M_free(AC.Fortran90Kind,
"Fortran90 Kind");
822 AC.Fortran90Kind = 0;
825 if ( ( key->type == ALLINTEGERDOUBLE ) && AO.DoubleFlag != 0 ) {
830 AC.OutputMode = key->type & NODOUBLEMASK;
831 if ( ( key->type & DOUBLEPRECISIONFLAG ) != 0 ) {
834 else if ( ( key->type & QUADRUPLEPRECISIONFLAG ) != 0 ) {
839 else if ( key->flags == 1 ) {
840 AC.OutputMode = AC.OutNumberType = key->type;
842 else if ( key->flags == 2 ) {
843 while ( FG.cTable[*s] == 0 ) s++;
844 if ( *s == 0 ) AC.OutNumberType = 10;
845 else if ( *s ==
',' ) {
848 while ( FG.cTable[*s] == 1 ) x = 10*x + *s++ -
'0';
851 MesPrint(
"&Illegal float format specifier");
856 MesPrint(
"& ... float format value corrected to 3");
860 MesPrint(
"& ... float format value corrected to 100");
862 AC.OutNumberType = x;
866 else if ( key->flags == 3 ) {
867 AC.OutputSpaces = key->type;
869 else if ( key->flags == 4 ) {
870 AC.IsFortran90 = ISFORTRAN90;
871 if ( AC.Fortran90Kind ) {
872 M_free(AC.Fortran90Kind,
"Fortran90 Kind");
873 AC.Fortran90Kind = 0;
875 while ( FG.cTable[*s] <= 1 ) s++;
878 while ( *ss && *ss !=
',' ) ss++;
880 MesPrint(
"&No white space or comma's allowed in Fortran90 option: %s",s); error = 1;
883 AC.Fortran90Kind = strDup1(s,
"Fortran90 Kind");
887 AC.OutputMode = key->type & NODOUBLEMASK;
890 else if ( ( *s ==
'c' || *s ==
'C' ) && ( FG.cTable[s[1]] == 1 ) ) {
893 while ( *ss >=
'0' && *ss <=
'9' ) x = 10*x + *ss++ -
'0';
894 if ( *ss != 0 )
goto Unknown;
895 AC.OutputMode = CMODE;
899Unknown: MesPrint(
"&Unknown option: %s",s); error = 1;
912 if ( StrICmp(s,(UBYTE *)
"brackets") == 0 ) AC.ComDefer = 1;
913 else { MesPrint(
"&Unknown option: '%s'",s);
return(1); }
922int CoFixIndex(UBYTE *s)
926 if ( FG.cTable[*s] != 1 ) {
927proper: MesPrint(
"&Proper syntax is: FixIndex,number:value[,number,value];");
931 if ( *s !=
':' )
goto proper;
933 if ( *s !=
'-' && *s !=
'+' && FG.cTable[*s] != 1 )
goto proper;
934 ParseSignedNumber(y,s)
935 if ( *s && *s !=
',' )
goto proper;
936 while ( *s ==
',' ) s++;
937 if ( x >= AM.OffsetIndex ) {
938 MesPrint(
"&Fixed index out of allowed range. Change ConstIndex in setup file?");
939 MesPrint(
"&Current value of ConstIndex = %d",AM.OffsetIndex-1);
942 if ( y != (
int)((WORD)y) ) {
943 MesPrint(
"&Value of d_(%d,%d) outside range for this computer",x,x);
946 if ( error == 0 ) AC.FixIndices[x] = y;
956int CoMetric(UBYTE *s)
957{ DUMMYUSE(s); MesPrint(
"&The metric statement does not do anything yet");
return(1); }
964int DoPrint(UBYTE *s,
int par)
966 int i, error = 0, numdol = 0, type;
970 WORD numexpr, tofile = 0, *w, par2 = 0;
971 CBUF *C = cbuf + AC.cbufnum;
972 while ( *s ==
',' ) s++;
973 if ( ( *s ==
'+' || *s ==
'-' ) && ( s[1] ==
'f' || s[1] ==
'F' ) ) {
974 t = s + 2;
while ( *t ==
' ' || *t ==
',' ) t++;
976 if ( *s ==
'+' ) { tofile = 1; handle = AC.LogHandle; }
980 else if ( *s ==
'<' ) {
983 while ( *s && *s !=
'>' ) s++;
985 MesPrint(
"&Improper filename in print statement");
990 if ( ( handle = GetChannel((
char *)filename,1) ) < 0 )
return(1);
991 SKIPBLANKS(s)
if ( *s ==
',' ) s++; SKIPBLANKS(s)
992 if ( *s ==
'+' && ( s[1] ==
's' || s[1] ==
'S' ) ) {
994 par2 |= PRINTONETERM;
995 if ( *s ==
's' || *s ==
'S' ) {
997 par2 |= PRINTONEFUNCTION;
998 if ( *s ==
's' || *s ==
'S' ) {
1003 SKIPBLANKS(s)
if ( *s ==
',' ) s++; SKIPBLANKS(s)
1006 if ( par == PRINTON && *s ==
'"' ) {
1008 if ( tofile == 1 ) code[0] = TYPEFPRINT;
1009 else code[0] = TYPEPRINT;
1013 while ( *s && *s !=
'"' ) {
1014 if ( *s ==
'\\' ) s++;
1015 if ( *s ==
'%' && s[1] ==
'$' ) numdol++;
1019 MesPrint(
"&String in print statement should be enclosed in \"");
1023 AddComString(3,code,name,1);
1025 while ( *s ==
',' ) {
1028 s++; name = s;
while ( FG.cTable[*s] <= 1 ) s++;
1030 type = GetName(AC.dollarnames,name,&numexpr,NOAUTO);
1031 if ( type == NAMENOTFOUND ) {
1032 MesPrint(
"&$ variable %s not (yet) defined",name);
1036 C->
lhs[C->numlhs][1] += 2;
1037 *(C->
Pointer)++ = DOLLAREXPRESSION;
1043 MesPrint(
"&Illegal object in print statement");
1051 s = GetDoParam(s,&(C->
Pointer),-1);
1052 if ( s == 0 )
return(1);
1054 MesPrint(
"&unmatched [] in $ factor");
1062 MesPrint(
"&Illegal object in print statement");
1066 MesPrint(
"&More $ variables asked for than provided");
1074 for ( e = Expressions, i = NumExpressions; i > 0; i--, e++ ) {
1075 if ( e->status == LOCALEXPRESSION || e->status ==
1076 GLOBALEXPRESSION || e->status == UNHIDELEXPRESSION
1077 || e->status == UNHIDEGEXPRESSION ) e->printflag = par;
1084 if ( tolower(*s) ==
'f' ) par |= PRINTLFILE;
1085 else if ( tolower(*s) ==
's' ) {
1086 if ( tolower(s[1]) ==
's' ) {
1087 if ( tolower(s[2]) ==
's' ) {
1088 par |= PRINTONEFUNCTION | PRINTONETERM | PRINTALL;
1091 else if ( ( par & 3 ) < 2 ) par |= PRINTONEFUNCTION | PRINTONETERM;
1095 if ( ( par & 3 ) < 2 ) par |= PRINTONETERM;
1099illeg: MesPrint(
"&Illegal option in (n)print statement");
1103 if ( *s == 0 )
goto AllExpr;
1105 else if ( *s ==
'-' ) {
1107 if ( tolower(*s) ==
'f' ) par &= ~PRINTLFILE;
1108 else if ( tolower(*s) ==
's' ) {
1109 if ( tolower(s[1]) ==
's' ) {
1110 if ( tolower(s[2]) ==
's' ) {
1114 else if ( ( par & 3 ) < 2 ) {
1115 par &= ~PRINTONEFUNCTION;
1121 if ( ( par & 3 ) < 2 ) {
1122 par &= ~PRINTONETERM;
1123 par &= ~PRINTONEFUNCTION;
1130 if ( *s == 0 )
goto AllExpr;
1132 else if ( FG.cTable[*s] == 0 || *s ==
'[' ) {
1134 if ( ( s = SkipAName(s) ) == 0 ) {
1135 MesPrint(
"&Improper name in (n)print statement");
1139 if ( ( GetName(AC.exprnames,name,&numexpr,NOAUTO) == CEXPRESSION )
1140 && ( Expressions[numexpr].status == LOCALEXPRESSION
1141 || Expressions[numexpr].status == GLOBALEXPRESSION ) ) {
1143 if ( c ==
'[' && s[1] ==
']' ) {
1144 Expressions[numexpr].printflag = par | PRINTCONTENTS;
1148 Expressions[numexpr].printflag = par;
1150 else if ( GetLastExprName(name,&numexpr)
1151 && ( Expressions[numexpr].status == LOCALEXPRESSION
1152 || Expressions[numexpr].status == GLOBALEXPRESSION
1153 || Expressions[numexpr].status == UNHIDELEXPRESSION
1154 || Expressions[numexpr].status == UNHIDEGEXPRESSION
1159 MesPrint(
"&%s is not the name of an active expression",name);
1163 if ( c == 0 )
return(0);
1164 if ( c ==
'-' || c ==
'+' ) s--;
1166 else if ( *s ==
',' ) s++;
1168 MesPrint(
"&Illegal object in (n)print statement");
1180int CoPrint(UBYTE *s) {
return(DoPrint(s,PRINTON)); }
1187int CoPrintB(UBYTE *s) {
return(DoPrint(s,PRINTCONTENT)); }
1194int CoNPrint(UBYTE *s) {
return(DoPrint(s,PRINTOFF)); }
1201int CoPushHide(UBYTE *s)
1206 if ( AR.Fscr[2].PObuffer == 0 ) {
1207 ScratchBuf = (WORD *)Malloc1(AM.HideSize*
sizeof(WORD),
"hidesize");
1208 AR.Fscr[2].POsize = AM.HideSize *
sizeof(WORD);
1209 AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1210 AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1211 PUTZERO(AR.Fscr[2].POposition);
1213 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
1216 MesPrint(
"&PushHide statement should have no arguments");
1219 for ( i = 0; i < NumExpressions; i++ ) {
1220 switch ( Expressions[i].status ) {
1221 case DROPLEXPRESSION:
1222 case SKIPLEXPRESSION:
1223 case LOCALEXPRESSION:
1224 Expressions[i].status = HIDELEXPRESSION;
1225 Expressions[i].hidelevel = AC.HideLevel-1;
1227 case DROPGEXPRESSION:
1228 case SKIPGEXPRESSION:
1229 case GLOBALEXPRESSION:
1230 Expressions[i].status = HIDEGEXPRESSION;
1231 Expressions[i].hidelevel = AC.HideLevel-1;
1245int CoPopHide(UBYTE *s)
1248 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
1249 if ( AC.HideLevel <= 0 ) {
1250 MesPrint(
"&PopHide statement without corresponding PushHide statement");
1255 MesPrint(
"&PopHide statement should have no arguments");
1258 for ( i = 0; i < NumExpressions; i++ ) {
1259 switch ( Expressions[i].status ) {
1260 case HIDDENLEXPRESSION:
1261 if ( Expressions[i].hidelevel > AC.HideLevel )
1262 Expressions[i].status = UNHIDELEXPRESSION;
1264 case HIDDENGEXPRESSION:
1265 if ( Expressions[i].hidelevel > AC.HideLevel )
1266 Expressions[i].status = UNHIDEGEXPRESSION;
1280int SetExprCases(
int par,
int setunset,
int val)
1285 case SKIPLEXPRESSION:
1286 if ( !setunset ) val = LOCALEXPRESSION;
1288 case SKIPGEXPRESSION:
1289 if ( !setunset ) val = GLOBALEXPRESSION;
1291 case LOCALEXPRESSION:
1292 if ( setunset ) val = SKIPLEXPRESSION;
1294 case GLOBALEXPRESSION:
1295 if ( setunset ) val = SKIPGEXPRESSION;
1297 case INTOHIDEGEXPRESSION:
1298 case INTOHIDELEXPRESSION:
1305 case SKIPLEXPRESSION:
1306 case LOCALEXPRESSION:
1307 case HIDELEXPRESSION:
1308 if ( setunset ) val = DROPLEXPRESSION;
1310 case DROPLEXPRESSION:
1311 if ( !setunset ) val = LOCALEXPRESSION;
1313 case SKIPGEXPRESSION:
1314 case GLOBALEXPRESSION:
1315 case HIDEGEXPRESSION:
1316 if ( setunset ) val = DROPGEXPRESSION;
1318 case DROPGEXPRESSION:
1319 if ( !setunset ) val = GLOBALEXPRESSION;
1321 case HIDDENLEXPRESSION:
1322 case UNHIDELEXPRESSION:
1323 if ( setunset ) val = DROPHLEXPRESSION;
1325 case HIDDENGEXPRESSION:
1326 case UNHIDEGEXPRESSION:
1327 if ( setunset ) val = DROPHGEXPRESSION;
1329 case DROPHLEXPRESSION:
1330 if ( !setunset ) val = HIDDENLEXPRESSION;
1332 case DROPHGEXPRESSION:
1333 if ( !setunset ) val = HIDDENGEXPRESSION;
1335 case INTOHIDEGEXPRESSION:
1336 case INTOHIDELEXPRESSION:
1343 case DROPLEXPRESSION:
1344 case SKIPLEXPRESSION:
1345 case LOCALEXPRESSION:
1346 if ( setunset ) val = HIDELEXPRESSION;
1348 case HIDELEXPRESSION:
1349 if ( !setunset ) val = LOCALEXPRESSION;
1351 case DROPGEXPRESSION:
1352 case SKIPGEXPRESSION:
1353 case GLOBALEXPRESSION:
1354 if ( setunset ) val = HIDEGEXPRESSION;
1356 case HIDEGEXPRESSION:
1357 if ( !setunset ) val = GLOBALEXPRESSION;
1359 case INTOHIDEGEXPRESSION:
1360 case INTOHIDELEXPRESSION:
1367 case HIDDENLEXPRESSION:
1368 case DROPHLEXPRESSION:
1369 if ( setunset ) val = UNHIDELEXPRESSION;
1371 case UNHIDELEXPRESSION:
1372 if ( !setunset ) val = HIDDENLEXPRESSION;
1374 case HIDDENGEXPRESSION:
1375 case DROPHGEXPRESSION:
1376 if ( setunset ) val = UNHIDEGEXPRESSION;
1378 case UNHIDEGEXPRESSION:
1379 if ( !setunset ) val = HIDDENGEXPRESSION;
1381 case INTOHIDEGEXPRESSION:
1382 case INTOHIDELEXPRESSION:
1389 case HIDDENLEXPRESSION:
1390 case HIDDENGEXPRESSION:
1391 MesPrint(
"&Expression is already hidden");
1393 case DROPHLEXPRESSION:
1394 case DROPHGEXPRESSION:
1395 case UNHIDELEXPRESSION:
1396 case UNHIDEGEXPRESSION:
1397 MesPrint(
"&Cannot unhide and put intohide expression in the same module");
1399 case LOCALEXPRESSION:
1400 case DROPLEXPRESSION:
1401 case SKIPLEXPRESSION:
1402 case HIDELEXPRESSION:
1403 if ( setunset ) val = INTOHIDELEXPRESSION;
1405 case GLOBALEXPRESSION:
1406 case DROPGEXPRESSION:
1407 case SKIPGEXPRESSION:
1408 case HIDEGEXPRESSION:
1409 if ( setunset ) val = INTOHIDEGEXPRESSION;
1426int SetExpr(UBYTE *s,
int setunset,
int par)
1431 if ( *s == 0 && ( par != INTOHIDE ) ) {
1432 for ( i = 0; i < NumExpressions; i++ ) {
1433 w = &(Expressions[i].status);
1434 *w = SetExprCases(par,setunset,*w);
1435 if ( *w < 0 ) error = 1;
1436 if ( par == HIDE && setunset == 1 )
1437 Expressions[i].hidelevel = AC.HideLevel;
1442 if ( *s ==
',' ) { s++;
continue; }
1443 if ( *s ==
'0' ) { s++;
continue; }
1445 if ( ( s = SkipAName(s) ) == 0 ) {
1446 MesPrint(
"&Improper name for an expression: '%s'",name);
1450 if ( GetName(AC.exprnames,name,&numexpr,NOAUTO) == CEXPRESSION ) {
1451 w = &(Expressions[numexpr].status);
1452 *w = SetExprCases(par,setunset,*w);
1453 if ( *w < 0 ) error = 1;
1454 if ( ( par == HIDE || par == INTOHIDE ) && setunset == 1 )
1455 Expressions[numexpr].hidelevel = AC.HideLevel;
1457 else if ( GetName(AC.varnames,name,&numexpr,NOAUTO) != NAMENOTFOUND ) {
1458 MesPrint(
"&%s is not an expression",name);
1471int CoDrop(UBYTE *s) {
return(SetExpr(s,1,DROP)); }
1478int CoNoDrop(UBYTE *s) {
return(SetExpr(s,0,DROP)); }
1485int CoSkip(UBYTE *s) {
return(SetExpr(s,1,SKIP)); }
1492int CoNoSkip(UBYTE *s) {
return(SetExpr(s,0,SKIP)); }
1499int CoHide(UBYTE *inp) {
1502 if ( AR.Fscr[2].PObuffer == 0 ) {
1503 ScratchBuf = (WORD *)Malloc1(AM.HideSize*
sizeof(WORD),
"hidesize");
1504 AR.Fscr[2].POsize = AM.HideSize *
sizeof(WORD);
1505 AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1506 AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1507 PUTZERO(AR.Fscr[2].POposition);
1509 return(SetExpr(inp,1,HIDE));
1517int CoIntoHide(UBYTE *inp) {
1520 if ( AR.Fscr[2].PObuffer == 0 ) {
1521 ScratchBuf = (WORD *)Malloc1(AM.HideSize*
sizeof(WORD),
"hidesize");
1522 AR.Fscr[2].POsize = AM.HideSize *
sizeof(WORD);
1523 AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1524 AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1525 PUTZERO(AR.Fscr[2].POposition);
1527 return(SetExpr(inp,1,INTOHIDE));
1535int CoNoHide(UBYTE *inp) {
return(SetExpr(inp,0,HIDE)); }
1542int CoUnHide(UBYTE *inp) {
return(SetExpr(inp,1,UNHIDE)); }
1549int CoNoUnHide(UBYTE *inp) {
return(SetExpr(inp,0,UNHIDE)); }
1556void AddToCom(
int n, WORD *array)
1558 CBUF *C = cbuf+AC.cbufnum;
1560 MesPrint(
" %a",n,array);
1563 while ( --n >= 0 ) *(C->
Pointer)++ = *array++;
1571int AddComString(
int n, WORD *array, UBYTE *thestring,
int par)
1573 CBUF *C = cbuf+AC.cbufnum;
1574 UBYTE *s = thestring, *w;
1579 int i, numchars = 0, size, zeroes;
1581 if ( *s ==
'\\' ) s++;
1582 else if ( par == 1 &&
1583 ( ( *s ==
'%' && s[1] !=
't' && s[1] !=
'T' && s[1] !=
'$' &&
1584 s[1] !=
'w' && s[1] !=
'W' && s[1] !=
'r' && s[1] != 0 ) || *s ==
'#'
1585 || *s ==
'@' || *s ==
'&' ) ) {
1591 size = numchars/
sizeof(WORD)+1;
1598 for ( i = 1; i < n; i++ ) *(C->
Pointer)++ = array[i];
1604 zeroes = size*
sizeof(WORD)-numchars;
1607 if ( *s ==
'\\' ) s++;
1608 else if ( par == 1 && ( ( *s ==
'%' &&
1609 s[1] !=
't' && s[1] !=
'T' && s[1] !=
'$' &&
1610 s[1] !=
'w' && s[1] !=
'W' && s[1] !=
'r' && s[1] != 0 ) || *s ==
'#'
1611 || *s ==
'@' || *s ==
'&' ) ) {
1616 while ( --zeroes >= 0 ) *w++ = 0;
1619 MesPrint(
"LH: %a",size+1+n,cc);
1620 MesPrint(
" %s",thestring);
1630int Add2ComStrings(
int n, WORD *array, UBYTE *string1, UBYTE *string2)
1632 CBUF *C = cbuf+AC.cbufnum;
1633 UBYTE *s1 = string1, *s2 = string2, *w;
1634 int i, num1chars = 0, num2chars = 0, size1, size2, zeroes1, zeroes2;
1636 while ( *s1 ) { s1++; num1chars++; }
1637 size1 = num1chars/
sizeof(WORD)+1;
1639 while ( *s2 ) { s2++; num2chars++; }
1640 size2 = num2chars/
sizeof(WORD)+1;
1645 *(C->
Pointer)++ = size1+size2+n+3;
1646 for ( i = 1; i < n; i++ ) *(C->
Pointer)++ = array[i];
1649 zeroes1 = size1*
sizeof(WORD)-num1chars;
1651 while ( *s1 ) { *w++ = *s1++; }
1652 while ( --zeroes1 >= 0 ) *w++ = 0;
1657 zeroes2 = size2*
sizeof(WORD)-num2chars;
1659 while ( *s2 ) { *w++ = *s2++; }
1660 while ( --zeroes2 >= 0 ) *w++ = 0;
1671int CoDiscard(UBYTE *s)
1674 Add2Com(TYPEDISCARD)
1677 MesPrint(
"&Illegal argument in discard statement: '%s'",s);
1692static WORD ccarray[5] = { TYPEOPERATION,5,CONTRACT,0,0 };
1694int CoContract(UBYTE *s)
1700 if ( *s !=
',' && *s ) {
1701proper: MesPrint(
"&Illegal number in contract statement");
1707 else ccarray[4] = 0;
1708 if ( FG.cTable[*s] == 1 ) {
1710 if ( *s )
goto proper;
1713 else if ( *s )
goto proper;
1714 else ccarray[3] = -1;
1723int CoGoTo(UBYTE *inp)
1727 while ( FG.cTable[*s] <= 1 ) s++;
1729 MesPrint(
"&Label should be an alpha-numeric string");
1733 Add3Com(TYPEGOTO,x);
1742int CoLabel(UBYTE *inp)
1746 while ( FG.cTable[*s] <= 1 ) s++;
1748 MesPrint(
"&Label should be an alpha-numeric string");
1752 if ( AC.Labels[x] >= 0 ) {
1753 MesPrint(
"&Label %s defined more than once",AC.LabelNames[x]);
1756 AC.Labels[x] = cbuf[AC.cbufnum].numlhs;
1769int DoArgument(UBYTE *s,
int par)
1772 UBYTE *name, *t, *v, c;
1773 WORD *oldworkpointer = AT.WorkPointer, *w, *ww, number, *scale;
1774 int error = 0, zeroflag, type, x;
1775 AC.lhdollarflag = 0;
1776 while ( *s ==
',' ) s++;
1782 if ( AC.arglevel >= MAXNEST ) {
1783 MesPrint(
"@Nesting of argument statements more than %d levels"
1787 AC.argsumcheck[AC.arglevel] = NestingChecksum();
1788 AC.argstack[AC.arglevel] = cbuf[AC.cbufnum].Pointer
1789 - cbuf[AC.cbufnum].Buffer + 2;
1791 *w++ = cbuf[AC.cbufnum].numlhs;
1796 case TYPESPLITFIRSTARG:
1797 case TYPESPLITLASTARG:
1799 case TYPEARGTOEXTRASYMBOL:
1800 *w++ = cbuf[AC.cbufnum].numlhs+1;
1808 s++; ParseSignedNumber(x,s)
1809 while ( *s ==
',' ) s++;
1813 t = s+1; SKIPBRA3(s)
1814 if ( par == TYPEARG ) {
1815 MesPrint(
"&Illegal () entry in argument statement");
1816 error = 1; s++;
goto skipbracks;
1818 else if ( par == TYPESPLITFIRSTARG ) {
1819 MesPrint(
"&Illegal () entry in splitfirstarg statement");
1820 error = 1; s++;
goto skipbracks;
1822 else if ( par == TYPESPLITLASTARG ) {
1823 MesPrint(
"&Illegal () entry in splitlastarg statement");
1824 error = 1; s++;
goto skipbracks;
1829 MesPrint(
"&Wildcarding not allowed in this type of statement");
1835 if ( *t ==
'(' && v[-1] ==
')' ) {
1837 if ( par == TYPESPLITARG ) oldworkpointer[0] = TYPESPLITARG2;
1838 else if ( par == TYPEFACTARG ) oldworkpointer[0] = TYPEFACTARG2;
1839 else if ( par == TYPENORM4 ) oldworkpointer[0] = TYPENORM4;
1840 else if ( par == TYPENORM ) {
1841 if ( *t ==
'-' ) { oldworkpointer[0] = TYPENORM3; t++; }
1842 else { oldworkpointer[0] = TYPENORM2; *scale = 0; }
1846 CBUF *C = cbuf+AC.cbufnum;
1847 WORD oldnumrhs = C->numrhs, oldnumlhs = C->numlhs;
1848 WORD prototype[SUBEXPSIZE+40];
1853 prototype[0] = SUBEXPRESSION;
1854 prototype[1] = SUBEXPSIZE;
1855 prototype[2] = C->numrhs+1;
1857 prototype[4] = AC.cbufnum;
1858 AT.WorkPointer += TYPEARGHEADSIZE+1;
1860 if ( ( retcode = CompileAlgebra(t,LHSIDE,prototype) ) < 0 )
1863 prototype[2] = retcode;
1864 ww = C->
lhs[retcode];
1865 AC.lhdollarflag = 0;
1867 *w++ = -2; *w++ = 0;
1869 else if ( ww[ww[0]] != 0 ) {
1870 MesPrint(
"&There should be only one term between ()");
1873 else if (
NewSort(BHEAD0) ) {
if ( !error ) error = 1; }
1876 if ( !error ) error = 1;
1879 AN.RepPoint = AT.RepCount + 1;
1882 while ( --i >= 0 ) *m++ = *mm++;
1883 mm = AT.WorkPointer; AT.WorkPointer = m;
1884 AR.Cnumlhs = C->numlhs;
1888 else if (
EndSort(BHEAD mm,0) < 0 ) {
1890 AT.WorkPointer = mm;
1892 else if ( *mm == 0 ) {
1893 *w++ = -2; *w++ = 0;
1894 AT.WorkPointer = mm;
1896 else if ( mm[mm[0]] != 0 ) {
1898 AT.WorkPointer = mm;
1901 AT.WorkPointer = mm;
1903 if ( par == TYPEFACTARG ) {
1904 if ( *mm != ABS(m[-1])+1 ) {
1907 mm[-1] = -*mm-1; w += *mm+1;
1915 { mm[-1] = -*mm-1; w += *mm+1; }
1917 oldworkpointer[1] = w - oldworkpointer;
1921 oldworkpointer[5] = AC.lhdollarflag;
1924 C->numrhs = oldnumrhs;
1925 C->numlhs = oldnumlhs;
1930 if ( *s == 0 ) { *w++ = 0; *w++ = 2; *w++ = 1; }
1933 if ( *s ==
',' ) { s++;
continue; }
1934 ww = w; *w++ = 0; w++;
1935 if ( FG.cTable[*s] > 1 && *s !=
'[' && *s !=
'{' ) {
1936 MesPrint(
"&Illegal parameters in statement");
1940 while ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'{' ) {
1945 number = DoTempSet(name,s);
1946 name--; *s++ = c; c = *s; *s = 0;
1951 if ( ( s = SkipAName(s) ) == 0 ) {
1952 MesPrint(
"&Illegal name '%s'",name);
1956 if ( ( type = GetName(AC.varnames,name,&number,WITHAUTO) ) == CSET ) {
1957doset:
if ( Sets[number].type != CFUNCTION )
goto nofun;
1958 *w++ = CSET; *w++ = number;
1960 else if ( type == CFUNCTION ) {
1961 *w++ = CFUNCTION; *w++ = number + FUNCTION;
1964nofun: MesPrint(
"&%s is not a function or a set of functions"
1970 while ( *s ==
',' ) s++;
1973 ww = w; w++; zeroflag = 0;
1974 while ( FG.cTable[*s] == 1 ) {
1976 if ( *s && *s !=
',' ) {
1977 MesPrint(
"&Illegal separator after number");
1979 while ( *s && *s !=
',' ) s++;
1981 while ( *s ==
',' ) s++;
1982 if ( x == 0 ) zeroflag = 1;
1983 if ( !zeroflag ) *w++ = (WORD)x;
1988 oldworkpointer[1] = w - oldworkpointer;
1989 if ( par == TYPEARG ) {
1990 AC.argstack[AC.arglevel-1] = cbuf[AC.cbufnum].Pointer
1991 - cbuf[AC.cbufnum].Buffer + 2;
1993 AddNtoL(oldworkpointer[1],oldworkpointer);
1994 AT.WorkPointer = oldworkpointer;
2003int CoArgument(UBYTE *s) {
return(DoArgument(s,TYPEARG)); }
2010int CoEndArgument(UBYTE *s)
2012 CBUF *C = cbuf+AC.cbufnum;
2013 while ( *s ==
',' ) s++;
2015 MesPrint(
"&Illegal syntax for EndArgument statement");
2018 if ( AC.arglevel <= 0 ) {
2019 MesPrint(
"&EndArgument without corresponding Argument statement");
2023 cbuf[AC.cbufnum].Buffer[AC.argstack[AC.arglevel]] = C->numlhs;
2024 if ( AC.argsumcheck[AC.arglevel] != NestingChecksum() ) {
2036int CoInside(UBYTE *s) {
return(ExecInside(s)); }
2043int CoEndInside(UBYTE *s)
2045 CBUF *C = cbuf+AC.cbufnum;
2046 while ( *s ==
',' ) s++;
2048 MesPrint(
"&Illegal syntax for EndInside statement");
2051 if ( AC.insidelevel <= 0 ) {
2052 MesPrint(
"&EndInside without corresponding Inside statement");
2056 cbuf[AC.cbufnum].Buffer[AC.insidestack[AC.insidelevel]] = C->numlhs;
2057 if ( AC.insidesumcheck[AC.insidelevel] != NestingChecksum() ) {
2069int CoNormalize(UBYTE *s) {
return(DoArgument(s,TYPENORM)); }
2076int CoMakeInteger(UBYTE *s) {
return(DoArgument(s,TYPENORM4)); }
2083int CoSplitArg(UBYTE *s) {
return(DoArgument(s,TYPESPLITARG)); }
2090int CoSplitFirstArg(UBYTE *s) {
return(DoArgument(s,TYPESPLITFIRSTARG)); }
2097int CoSplitLastArg(UBYTE *s) {
return(DoArgument(s,TYPESPLITLASTARG)); }
2104int CoFactArg(UBYTE *s) {
2105 if ( ( AC.topolynomialflag & TOPOLYNOMIALFLAG ) != 0 ) {
2106 MesPrint(
"&ToPolynomial statement and FactArg statement are not allowed in the same module");
2109 AC.topolynomialflag |= FACTARGFLAG;
2110 return(DoArgument(s,TYPEFACTARG));
2124int DoSymmetrize(UBYTE *s,
int par)
2127 int extra = 0, error = 0, err, fix, x, groupsize, num, i;
2129 WORD funnum, *w, *ww, type;
2132 if ( ( s = SkipAName(s) ) == 0 ) {
2133 MesPrint(
"&Improper function name");
2137 if ( c !=
',' || ( FG.cTable[s[1]] != 0 && s[1] !=
'[' ) )
break;
2138 if ( par <= 0 && StrICmp(name,(UBYTE *)
"cyclic") == 0 ) extra = 2;
2139 else if ( par <= 0 && StrICmp(name,(UBYTE *)
"rcyclic") == 0 ) extra = 6;
2141 MesPrint(
"&Illegal option: '%s'",name);
2146 if ( ( err = GetVar(name,&type,&funnum,CFUNCTION,WITHAUTO) ) == NAMENOTFOUND ) {
2147 MesPrint(
"&Undefined function: %s",name);
2148 AddFunction(name,0,0,0,0,0,-1,-1);
2153 if ( err == -1 ) error = 1;
2157 if ( *s ==
',' || *s ==
'(' || *s == 0 ) fix = -1;
2158 else if ( FG.cTable[*s] == 1 ) {
2161 Warning(
"Restriction to zero arguments removed");
2164 MesPrint(
"&Illegal character after :");
2170 *w++ = TYPEOPERATION;
2179 w += 2; ww = w; groupsize = -1;
2180 while ( *s ==
',' ) s++;
2184 while ( *s && *s !=
')' ) {
2185 if ( *s ==
',' ) { s++;
continue; }
2186 if ( FG.cTable[*s] != 1 )
goto illarg;
2188 if ( x <= 0 || ( fix > 0 && x > fix ) )
goto illnum;
2193 MesPrint(
"&Improper termination of statement");
2196 if ( groupsize < 0 ) groupsize = num;
2197 else if ( groupsize != num )
goto group;
2200 else if ( FG.cTable[*s] == 1 ) {
2201 if ( groupsize < 0 ) groupsize = 1;
2202 else if ( groupsize != 1 ) {
2203group: MesPrint(
"&All groups should have the same number of arguments");
2207 if ( x <= 0 || ( fix > 0 && x > fix ) ) {
2208illnum: MesPrint(
"&Illegal argument number: %d",x);
2214illarg: MesPrint(
"&Illegal argument");
2217 while ( *s ==
',' ) s++;
2226 for ( i = 0; i < fix; i++ ) *w++ = i;
2232 ww[-2] = (w-ww)/groupsize;
2234 AT.WorkPointer[1] = w - AT.WorkPointer;
2235 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
2244int CoSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,SYMMETRIC)); }
2251int CoAntiSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,ANTISYMMETRIC)); }
2258int CoCycleSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,CYCLESYMMETRIC)); }
2265int CoRCycleSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,RCYCLESYMMETRIC)); }
2272int CoWrite(UBYTE *s)
2278 if ( ( ( s = SkipAName(s) ) == 0 ) || *s != 0 ) {
2279 MesPrint(
"&Proper use of write statement is: write option");
2284 MesPrint(
"&Unrecognized option in write statement");
2287 *key->var = key->type;
2288 AR.SortType = AC.SortType;
2297int CoNWrite(UBYTE *s)
2303 if ( ( ( s = SkipAName(s) ) == 0 ) || *s != 0 ) {
2304 MesPrint(
"&Proper use of nwrite statement is: nwrite option");
2309 MesPrint(
"&Unrecognized option in nwrite statement");
2312 *key->var = key->flags;
2313 AR.SortType = AC.SortType;
2322static WORD ratstring[6] = { TYPEOPERATION, 6, RATIO, 0, 0, 0 };
2324int CoRatio(UBYTE *s)
2327 int i, type, error = 0;
2330 for ( i = 0; i < 3; i++ ) {
2335 if ( ( ( type = GetName(AC.varnames,t,&numsym,WITHAUTO) ) != CSYMBOL )
2336 && type != CDUBIOUS ) {
2337 MesPrint(
"&%s is not a symbol",t);
2339 if ( type < 0 ) numsym = AddSymbol(t,-MAXPOWER,MAXPOWER,0,0);
2342 if ( *s ==
',' ) s++;
2346 MesPrint(
"&The ratio statement needs three symbols for its arguments");
2364int CoRedefine(UBYTE *s)
2366 UBYTE *name, c, *args = 0;
2370 if ( FG.cTable[*s] || ( s = SkipAName(s) ) == 0 || s[-1] ==
'_' ) {
2371 MesPrint(
"&Illegal name for preprocessor variable in redefine statement");
2375 for ( numprevar = NumPre-1; numprevar >= 0; numprevar-- ) {
2376 if ( StrCmp(name,PreVar[numprevar].name) == 0 )
break;
2378 if ( numprevar < 0 ) {
2379 MesPrint(
"&There is no preprocessor variable with the name `%s'",name);
2391 if ( chartype[*s] != 0 )
goto illarg;
2393 while ( chartype[*s] <= 1 ) s++;
2394 while ( *s ==
' ' || *s ==
'\t' ) s++;
2395 if ( *s ==
')' )
break;
2396 if ( *s !=
',' )
goto illargs;
2398 while ( *s ==
' ' || *s ==
'\t' ) s++;
2401 while ( *s ==
' ' || *s ==
'\t' ) s++;
2403 while ( *s ==
',' ) s++;
2405encl: MesPrint(
"&Value for %s should be enclosed in double quotes"
2406 ,PreVar[numprevar].name);
2410 while ( *s && *s !=
'"' ) {
if ( *s ==
'\\' ) s++; s++; }
2411 if ( *s !=
'"' )
goto encl;
2413 code[0] = TYPEREDEFPRE; code[1] = numprevar;
2417 Add2ComStrings(2,code,name,args);
2429 for ( j = 0; j < AC.numpfirstnum; j++ ) {
2430 if ( numprevar == AC.pfirstnum[j] )
break;
2432 if ( j >= AC.numpfirstnum ) {
2433 if ( j >= AC.sizepfirstnum ) {
2434 if ( AC.sizepfirstnum <= 0 ) { AC.sizepfirstnum = 10; }
2435 else { AC.sizepfirstnum = 2 * AC.sizepfirstnum; }
2436 newin = (LONG *)Malloc1(AC.sizepfirstnum*(
sizeof(WORD)+
sizeof(LONG)),
"AC.pfirstnum");
2437 newpf = (WORD *)(newin+AC.sizepfirstnum);
2438 for ( j = 0; j < AC.numpfirstnum; j++ ) {
2439 newpf[j] = AC.pfirstnum[j];
2440 newin[j] = AC.inputnumbers[j];
2442 if ( AC.inputnumbers ) M_free(AC.inputnumbers,
"AC.pfirstnum");
2443 AC.inputnumbers = newin;
2444 AC.pfirstnum = newpf;
2446 AC.pfirstnum[AC.numpfirstnum] = numprevar;
2447 AC.inputnumbers[AC.numpfirstnum] = -1;
2454 MesPrint(
"&Illegally formed name in argument of redefine statement");
2457 MesPrint(
"&Illegally formed arguments in redefine statement");
2469int CoRenumber(UBYTE *s)
2473 while ( *s ==
',' ) s++;
2475 if ( *s == 0 ) { x = 0; }
2476 else ParseNumber(x,s)
2477 if ( *s == 0 && x >= 0 && x <= 1 ) {
2478 Add3Com(TYPERENUMBER,x);
2481 MesPrint(
"&Illegal argument in Renumber statement: '%s'",inp);
2492 CBUF *C = cbuf+AC.cbufnum;
2493 UBYTE *ss = 0, c, *t;
2494 int error = 0, i = 0, type, x;
2495 WORD numindex,number;
2499 t++; s++;
while ( FG.cTable[*s] < 2 ) s++;
2501 if ( ( number = GetDollar(t) ) < 0 ) {
2502 MesPrint(
"&Undefined variable $%s",t);
2503 if ( !error ) error = 1;
2504 number = AddDollar(t,0,0,0);
2509 if ( ( s = SkipAName(s) ) == 0 )
return(1);
2511 if ( ( ( type = GetOName(AC.exprnames,t,&numindex,NOAUTO) ) != NAMENOTFOUND )
2512 || ( ( type = GetOName(AC.varnames,t,&numindex,WITHAUTO) ) != CINDEX ) ) {
2513 if ( type != NAMENOTFOUND ) error = NameConflict(type,t);
2515 MesPrint(
"&%s should have been declared as an index",t);
2517 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2521 Add3Com(TYPESUM,numindex);
2523 if ( *s == 0 )
break;
2525 MesPrint(
"&Illegal separator between objects in sum statement.");
2529 if ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'$' ) {
2530 while ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'$' ) {
2534 while ( FG.cTable[*s] < 2 ) s++;
2536 if ( ( number = GetDollar(t) ) < 0 ) {
2537 MesPrint(
"&Undefined variable $%s",t);
2538 if ( !error ) error = 1;
2539 number = AddDollar(t,0,0,0);
2545 if ( ( s = SkipAName(s) ) == 0 )
return(1);
2547 if ( ( ( type = GetOName(AC.exprnames,t,&numindex,NOAUTO) ) != NAMENOTFOUND )
2548 || ( ( type = GetOName(AC.varnames,t,&numindex,WITHAUTO) ) != CINDEX ) ) {
2549 if ( type != NAMENOTFOUND ) error = NameConflict(type,t);
2551 MesPrint(
"&%s should have been declared as an index",t);
2553 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2561 if ( *s == 0 )
return(error);
2563 MesPrint(
"&Illegal separator between objects in sum statement.");
2568 if ( FG.cTable[*s] == 1 ) {
2572 else if ( FG.cTable[*s] == 1 ) {
2573 while ( FG.cTable[*s] == 1 ) {
2576 while( FG.cTable[*s] == 1 ) x = 10*x + *s++ -
'0';
2577 if ( *s && *s !=
',' ) {
2578 MesPrint(
"&%s is not a legal fixed index",t);
2581 else if ( x >= AM.OffsetIndex ) {
2582 MesPrint(
"&%d is too large to be a fixed index",x);
2591 if ( *s == 0 )
break;
2596 MesPrint(
"&Illegal object in sum statement");
2608static WORD cttarray[7] = { TYPEOPERATION,7,TENVEC,0,0,1,0 };
2610int CoToTensor(UBYTE *s)
2613 int type, j, nargs, error = 0;
2614 WORD number, dol[2] = { 0, 0 };
2626 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
2627 if ( *s == 0 )
break;
2634 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2637 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2641 if ( nargs < 2 )
goto not_enough_arguments;
2646 for ( j = 2; j < nargs; j++ ) {
2647 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
2656 if ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'_' ) {
2658 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2660 type = GetName(AC.varnames,t,&number,WITHAUTO);
2661 if ( type == CVECTOR ) {
2665 cttarray[6] = DoTempSet(t,s);
2669 else if ( type != CSET ) {
2670 MesPrint(
"&%s is not the name of a set or a vector",t);
2674 cttarray[6] = number;
2676 else if ( *s ==
'{' ) {
2677 t = ++s; SKIPBRA2(s) *s = 0;
2678 cttarray[6] = DoTempSet(t,s);
2681 if ( cttarray[6] < 0 ) {
2684 if ( AC.wildflag ) {
2685 MesPrint(
"&Improper use of wildcard(s) in set specification");
2694 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2696 if ( StrICmp(t,(UBYTE *)
"nosquare") == 0 ) cttarray[5] |= 2;
2697 else if ( StrICmp(t,(UBYTE *)
"functions") == 0 ) cttarray[5] |= 4;
2699 MesPrint(
"&Unrecognized option in ToTensor statement: '%s'",t);
2709 for ( j = 0; j < 2; j++ ) {
2710 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
2712 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2714 if ( t[0] ==
'$' ) {
2715 dol[j] = GetDollar(t+1);
2716 if ( dol[j] < 0 ) dol[j] = AddDollar(t+1,DOLUNDEFINED,0,0);
2718 type = GetName(AC.varnames,t,&number,WITHAUTO);
2719 if ( type == CVECTOR ) {
2720 cttarray[4] = number + AM.OffsetVector;
2722 else if ( type == CFUNCTION && ( functions[number].spec > 0 ) ) {
2723 cttarray[3] = number + FUNCTION;
2726 MesPrint(
"&%s is not a vector or a tensor",t);
2732 if ( cttarray[3] == 0 || cttarray[4] == 0 ) {
2733 if ( dol[0] == 0 && dol[1] == 0 ) {
2734 goto not_enough_arguments;
2736 else if ( cttarray[3] ) {
2737 if ( dol[1] ) cttarray[4] = dol[1];
2738 else if ( dol[0] ) { cttarray[4] = dol[0]; }
2740 goto not_enough_arguments;
2743 else if ( cttarray[4] ) {
2744 if ( dol[1] ) { cttarray[3] = -dol[1]; }
2745 else if ( dol[0] ) cttarray[3] = -dol[0];
2747 goto not_enough_arguments;
2751 if ( dol[0] == 0 || dol[1] == 0 ) {
2752 goto not_enough_arguments;
2755 cttarray[3] = -dol[0]; cttarray[4] = dol[1];
2759 AddNtoL(cttarray[1],cttarray);
2763 MesPrint(
"&Syntax error in ToTensor statement");
2766not_enough_arguments:
2767 MesPrint(
"&ToTensor statement needs a vector and a tensor");
2776static WORD ctvarray[6] = { TYPEOPERATION,6,TENVEC,0,0,0 };
2778int CoToVector(UBYTE *s)
2781 int j, type, error = 0;
2782 WORD number, dol[2];
2783 dol[0] = dol[1] = 0;
2784 ctvarray[3] = ctvarray[4] = ctvarray[5] = 0;
2785 for ( j = 0; j < 2; j++ ) {
2787 if ( ( s = SkipAName(s) ) == 0 ) {
2788proper: MesPrint(
"&Arguments of ToVector statement should be a vector and a tensor");
2793 dol[j] = GetDollar(t+1);
2794 if ( dol[j] < 0 ) dol[j] = AddDollar(t+1,DOLUNDEFINED,0,0);
2796 else if ( ( type = GetName(AC.varnames,t,&number,WITHAUTO) ) == CVECTOR )
2797 ctvarray[4] = number + AM.OffsetVector;
2798 else if ( type == CFUNCTION && ( functions[number].spec > 0 ) )
2799 ctvarray[3] = number+FUNCTION;
2801 MesPrint(
"&%s is not a vector or a tensor",t);
2804 *s = c;
if ( *s && *s !=
',' )
goto proper;
2807 if ( *s != 0 )
goto proper;
2808 if ( ctvarray[3] == 0 || ctvarray[4] == 0 ) {
2809 if ( dol[0] == 0 && dol[1] == 0 ) {
2810 MesPrint(
"&ToVector statement needs a vector and a tensor");
2813 else if ( ctvarray[3] ) {
2814 if ( dol[1] ) ctvarray[4] = dol[1];
2815 else if ( dol[0] ) ctvarray[4] = dol[0];
2817 MesPrint(
"&ToVector statement needs a vector and a tensor");
2821 else if ( ctvarray[4] ) {
2822 if ( dol[1] ) ctvarray[3] = -dol[1];
2823 else if ( dol[0] ) ctvarray[3] = -dol[0];
2825 MesPrint(
"&ToVector statement needs a vector and a tensor");
2830 if ( dol[0] == 0 || dol[1] == 0 ) {
2831 MesPrint(
"&ToVector statement needs a vector and a tensor");
2835 ctvarray[3] = -dol[0]; ctvarray[4] = dol[1];
2848int CoTrace4(UBYTE *s)
2850 int error = 0, type, option = CHISHOLM;
2852 WORD numindex, one = 1;
2856 if ( FG.cTable[*s] == 1 )
break;
2857 if ( ( s = SkipAName(s) ) == 0 ) {
2858proper: MesPrint(
"&Proper syntax for Trace4 is 'Trace4[,options],index;'");
2861 if ( *s == 0 )
break;
2863 if ( ( key = FindKeyWord(t,trace4options,
2864 sizeof(trace4options)/
sizeof(
KEYWORD)) ) == 0 )
break;
2866 option |= key->type;
2867 option &= ~key->flags;
2869 if ( ( *s++ = c ) !=
',' ) {
2870 MesPrint(
"&Illegal separator in Trace4 statement");
2873 if ( *s == 0 )
goto proper;
2876 if ( FG.cTable[*s] == 1 ) {
2878 ParseNumber(numindex,s)
2880 MesPrint(
"&Last argument of Trace4 should be an index");
2883 if ( numindex >= AM.OffsetIndex ) {
2884 MesPrint(
"&fixed index >= %d. Change value of OffsetIndex in setup file"
2889 else if ( *s ==
'$' ) {
2890 if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
2891 numindex = -numindex;
2893 MesPrint(
"&%s is undefined",s);
2894 numindex = AddDollar(s+1,DOLINDEX,&one,1);
2897tests: s = SkipAName(s);
2899 MesPrint(
"&Trace4 should have a single index or $variable for its argument");
2903 else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
2904 numindex += AM.OffsetIndex;
2907 else if ( type != -1 ) {
2908 if ( type != CDUBIOUS ) {
2909 if ( ( FG.cTable[*s] != 0 ) && ( *s !=
'[' ) ) {
2910 if ( *s ==
'+' && FG.cTable[s[1]] == 1 ) { s++;
goto retry; }
2913 NameConflict(type,s);
2914 type = MakeDubious(AC.varnames,s,&numindex);
2919 MesPrint(
"&%s is not an index",s);
2920 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2923 if ( error )
return(error);
2924 if ( ( option & CHISHOLM ) != 0 )
2925 Add4Com(TYPECHISHOLM,numindex,(option & ALSOREVERSE));
2926 Add5Com(TYPEOPERATION,TAKETRACE,4 + (option & NOTRICK),numindex);
2935int CoTraceN(UBYTE *s)
2937 WORD numindex, one = 1;
2939 if ( FG.cTable[*s] == 1 ) {
2941 ParseNumber(numindex,s)
2943proper: MesPrint(
"&TraceN should have a single index for its argument");
2946 if ( numindex >= AM.OffsetIndex ) {
2947 MesPrint(
"&fixed index >= %d. Change value of OffsetIndex in setup file"
2952 else if ( *s ==
'$' ) {
2953 if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
2954 numindex = -numindex;
2956 MesPrint(
"&%s is undefined",s);
2957 numindex = AddDollar(s+1,DOLINDEX,&one,1);
2960tests: s = SkipAName(s);
2962 MesPrint(
"&TraceN should have a single index or $variable for its argument");
2966 else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
2967 numindex += AM.OffsetIndex;
2970 else if ( type != -1 ) {
2971 if ( type != CDUBIOUS ) {
2972 if ( ( FG.cTable[*s] != 0 ) && ( *s !=
'[' ) ) {
2973 if ( *s ==
'+' && FG.cTable[s[1]] == 1 ) { s++;
goto retry; }
2976 NameConflict(type,s);
2977 type = MakeDubious(AC.varnames,s,&numindex);
2982 MesPrint(
"&%s is not an index",s);
2983 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2986 Add5Com(TYPEOPERATION,TAKETRACE,0,numindex);
2995int CoChisholm(UBYTE *s)
2997 int error = 0, type, option = CHISHOLM;
2999 WORD numindex, one = 1;
3003 if ( FG.cTable[*s] == 1 )
break;
3004 if ( ( s = SkipAName(s) ) == 0 ) {
3005proper: MesPrint(
"&Proper syntax for Chisholm is 'Chisholm[,options],index;'");
3008 if ( *s == 0 )
break;
3010 if ( ( key = FindKeyWord(t,chisoptions,
3011 sizeof(chisoptions)/
sizeof(
KEYWORD)) ) == 0 )
break;
3013 option |= key->type;
3014 option &= ~key->flags;
3016 if ( ( *s++ = c ) !=
',' ) {
3017 MesPrint(
"&Illegal separator in Chisholm statement");
3020 if ( *s == 0 )
goto proper;
3023 if ( FG.cTable[*s] == 1 ) {
3024 ParseNumber(numindex,s)
3026 MesPrint(
"&Last argument of Chisholm should be an index");
3029 if ( numindex >= AM.OffsetIndex ) {
3030 MesPrint(
"&fixed index >= %d. Change value of OffsetIndex in setup file"
3035 else if ( *s ==
'$' ) {
3036 if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
3037 numindex = -numindex;
3039 MesPrint(
"&%s is undefined",s);
3040 numindex = AddDollar(s+1,DOLINDEX,&one,1);
3043tests: s = SkipAName(s);
3045 MesPrint(
"&Chisholm should have a single index or $variable for its argument");
3049 else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
3050 numindex += AM.OffsetIndex;
3053 else if ( type != -1 ) {
3054 if ( type != CDUBIOUS ) {
3055 NameConflict(type,s);
3056 type = MakeDubious(AC.varnames,s,&numindex);
3061 MesPrint(
"&%s is not an index",s);
3062 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
3065 if ( error )
return(error);
3066 Add4Com(TYPECHISHOLM,numindex,(option & ALSOREVERSE));
3077int DoChain(UBYTE *s,
int option)
3081 if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
3084 MesPrint(
"&%s is undefined",s);
3085 numfunc = AddDollar(s+1,DOLINDEX,&one,1);
3088tests: s = SkipAName(s);
3090 MesPrint(
"&ChainIn/ChainOut should have a single function or $variable for its argument");
3094 else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
3095 numfunc += FUNCTION;
3098 else if ( type != -1 ) {
3099 if ( type != CDUBIOUS ) {
3100 NameConflict(type,s);
3101 type = MakeDubious(AC.varnames,s,&numfunc);
3106 MesPrint(
"&%s is not a function",s);
3107 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
3110 Add3Com(option,numfunc);
3121int CoChainin(UBYTE *s)
3123 return(DoChain(s,TYPECHAININ));
3133int CoChainout(UBYTE *s)
3135 return(DoChain(s,TYPECHAINOUT));
3146 WORD code = TYPEEXIT;
3147 while ( *s ==
',' ) s++;
3149 Add3Com(TYPEEXIT,0);
3154 while ( *s ) {
if ( *s ==
'\\' ) s++; s++; }
3155 if ( name[-1] !=
'"' || s[-1] !=
'"' ) {
3156 MesPrint(
"&Illegal syntax for exit statement");
3160 AddComString(1,&code,name,0);
3170int CoInParallel(UBYTE *s)
3172 return(DoInParallel(s,1));
3180int CoNotInParallel(UBYTE *s)
3182 return(DoInParallel(s,0));
3195int DoInParallel(UBYTE *s,
int par)
3208 AC.inparallelflag = par;
3210 for ( i = NumExpressions-1; i >= 0; i-- ) {
3212 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
3213 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
3222 while ( *s ==
',' ) s++;
3223 if ( *s == 0 )
break;
3224 if ( *s ==
'[' || FG.cTable[*s] == 0 ) {
3226 if ( ( s = SkipAName(s) ) == 0 ) {
3227 MesPrint(
"&Improper name for an expression: '%s'",t);
3231 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
3233 e = Expressions+number;
3234 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
3235 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
3241 else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
3242 MesPrint(
"&%s is not an expression",t);
3248 MesPrint(
"&Illegal object in InExpression statement");
3250 while ( *s && *s !=
',' ) s++;
3251 if ( *s == 0 )
break;
3264int CoInExpression(UBYTE *s)
3271 if ( AC.inexprlevel >= MAXNEST ) {
3272 MesPrint(
"@Nesting of inexpression statements more than %d levels",(WORD)MAXNEST);
3275 AC.inexprsumcheck[AC.inexprlevel] = NestingChecksum();
3276 AC.inexprstack[AC.inexprlevel] = cbuf[AC.cbufnum].Pointer
3277 - cbuf[AC.cbufnum].Buffer + 2;
3279 *w++ = TYPEINEXPRESSION;
3282 while ( *s ==
',' ) s++;
3283 if ( *s == 0 )
break;
3284 if ( *s ==
'[' || FG.cTable[*s] == 0 ) {
3286 if ( ( s = SkipAName(s) ) == 0 ) {
3287 MesPrint(
"&Improper name for an expression: '%s'",t);
3291 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
3294 else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
3295 MesPrint(
"&%s is not an expression",t);
3301 MesPrint(
"&Illegal object in InExpression statement");
3303 while ( *s && *s !=
',' ) s++;
3304 if ( *s == 0 )
break;
3307 AT.WorkPointer[1] = w - AT.WorkPointer;
3308 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
3317int CoEndInExpression(UBYTE *s)
3319 CBUF *C = cbuf+AC.cbufnum;
3320 while ( *s ==
',' ) s++;
3322 MesPrint(
"&Illegal syntax for EndInExpression statement");
3325 if ( AC.inexprlevel <= 0 ) {
3326 MesPrint(
"&EndInExpression without corresponding InExpression statement");
3330 cbuf[AC.cbufnum].Buffer[AC.inexprstack[AC.inexprlevel]] = C->numlhs;
3331 if ( AC.inexprsumcheck[AC.inexprlevel] != NestingChecksum() ) {
3343int CoSetExitFlag(UBYTE *s)
3346 MesPrint(
"&Illegal syntax for the SetExitFlag statement");
3349 Add2Com(TYPESETEXIT);
3357int CoTryReplace(UBYTE *p)
3361 WORD *w, error = 0, i, which = -1, c1, minvec = 0;
3378 if ( *p ==
'-' && minvec == 0 && which == (CVECTOR+1) ) {
3381 if ( *p ==
'[' || FG.cTable[*p] == 0 ) {
3383 if ( ( p = SkipAName(p) ) == 0 )
return(1);
3385 i = GetName(AC.varnames,name,&c1,WITHAUTO);
3386 if ( which >= 0 && i >= 0 && i != CDUBIOUS && which != (i+1) ) {
3387 MesPrint(
"&Illegal combination of objects in TryReplace");
3390 else if ( minvec && i != CVECTOR && i != CDUBIOUS ) {
3391 MesPrint(
"&Currently a - sign can be used only with a vector in TryReplace");
3395 case CSYMBOL: *w++ = -SYMBOL; *w++ = c1;
break;
3397 if ( minvec ) *w++ = -MINVECTOR;
3398 else *w++ = -VECTOR;
3399 *w++ = c1 + AM.OffsetVector;
3402 case CINDEX: *w++ = -INDEX; *w++ = c1 + AM.OffsetIndex;
3403 if ( c1 >= AM.WilInd && c ==
'?' ) { *p++ = c; c = *p; }
3405 case CFUNCTION: *w++ = -c1-FUNCTION;
break;
3406 case CDUBIOUS: minvec = 0; error = 1;
break;
3408 MesPrint(
"&Illegal object type in TryReplace: %s",name);
3413 if ( which < 0 ) which = i+1;
3416 if ( *p ==
',' ) p++;
3420 MesPrint(
"&Illegal object in TryReplace");
3422 while ( *p && *p !=
',' ) {
3423 if ( *p ==
'(' ) SKIPBRA3(p)
3424 else if ( *p ==
'{' ) SKIPBRA2(p)
3425 else if ( *p ==
'[' ) SKIPBRA1(p)
3429 if ( *p ==
',' ) p++;
3430 if ( which < 0 ) which = 0;
3434 MesPrint(
"&Odd number of arguments in TryReplace");
3437 i = w - AT.WorkPointer;
3438 AT.WorkPointer[1] = i;
3439 AT.WorkPointer[2] = i - 3;
3440 AT.WorkPointer[4] = i - 3;
3441 AddNtoL((
int)i,AT.WorkPointer);
3460int CoModulus(UBYTE *inp)
3465 WORD sign = 1, Retval;
3466 while ( *inp ==
'-' || *inp ==
'+' ) {
3467 if ( *inp ==
'-' ) sign = -sign;
3471 if ( FG.cTable[*inp] != 1 ) {
3472 MesPrint(
"&Invalid value for modulus:%s",inp);
3473 if ( AC.modpowers ) M_free(AC.modpowers,
"AC.modpowers");
3477 do { inp++; }
while ( FG.cTable[*inp] == 1 );
3479 Retval = GetLong(p,(UWORD *)AC.cmod,&AC.ncmod);
3480 if ( sign < 0 ) AC.ncmod = -AC.ncmod;
3482 if ( c == 0 )
goto regular;
3483 else if ( c !=
':' ) {
3484 MesPrint(
"&Illegal option for modulus %s",inp);
3485 if ( AC.modpowers ) M_free(AC.modpowers,
"AC.modpowers");
3491 while ( FG.cTable[*inp] == 1 ) inp++;
3493 MesPrint(
"&Illegal character in option for modulus %s",inp);
3494 if ( AC.modpowers ) M_free(AC.modpowers,
"AC.modpowers");
3498 if ( GetLong(p,(UWORD *)AC.powmod,&AC.npowmod) ) Retval = -1;
3499 if ( TakeModulus((UWORD *)AC.powmod,&AC.npowmod,AC.cmod,AC.ncmod,NOUNPACK) ) Retval = -1;
3500 if ( AC.npowmod == 0 ) {
3501 MesPrint(
"&Improper value for generator");
3504 if ( MakeModTable() ) Retval = -1;
3507 AN.ncmod = AC.ncmod;
3509 M_free(AC.halfmod,
"halfmod");
3510 AC.halfmod = 0; AC.nhalfmod = 0;
3512 if ( AC.modinverses ) {
3513 M_free(AC.halfmod,
"modinverses");
3520 int Retval = 0, sign = 1;
3522 while ( *inp ==
',' || *inp ==
' ' || *inp ==
'\t' ) inp++;
3525 if ( AC.modpowers ) M_free(AC.modpowers,
"AC.modpowers");
3527 AN.ncmod = AC.ncmod = 0;
3528 if ( AC.halfmod ) M_free(AC.halfmod,
"halfmod");
3529 AC.halfmod = 0; AC.nhalfmod = 0;
3530 if ( AC.modinverses ) M_free(AC.modinverses,
"modinverses");
3536 if ( *inp ==
'-' ) {
3541 while ( FG.cTable[*inp] == 0 ) {
3543 while ( FG.cTable[*inp] == 0 ) inp++;
3545 if ( StrICmp(p,(UBYTE *)
"nofunctions") == 0 ) {
3546 AC.modmode &= ~ALSOFUNARGS;
3548 else if ( StrICmp(p,(UBYTE *)
"alsofunctions") == 0 ) {
3549 AC.modmode |= ALSOFUNARGS;
3551 else if ( StrICmp(p,(UBYTE *)
"coefficientsonly") == 0 ) {
3552 AC.modmode &= ~ALSOFUNARGS;
3553 AC.modmode &= ~ALSOPOWERS;
3556 else if ( StrICmp(p,(UBYTE *)
"plusmin") == 0 ) {
3557 AC.modmode |= POSNEG;
3559 else if ( StrICmp(p,(UBYTE *)
"positive") == 0 ) {
3560 AC.modmode &= ~POSNEG;
3562 else if ( StrICmp(p,(UBYTE *)
"inversetable") == 0 ) {
3563 AC.modmode |= INVERSETABLE;
3565 else if ( StrICmp(p,(UBYTE *)
"noinversetable") == 0 ) {
3566 AC.modmode &= ~INVERSETABLE;
3568 else if ( StrICmp(p,(UBYTE *)
"nodollars") == 0 ) {
3569 AC.modmode &= ~ALSODOLLARS;
3571 else if ( StrICmp(p,(UBYTE *)
"alsodollars") == 0 ) {
3572 AC.modmode |= ALSODOLLARS;
3574 else if ( StrICmp(p,(UBYTE *)
"printpowersof") == 0 ) {
3576 if ( *inp !=
'(' ) {
3578 MesPrint(
"&Bad syntax in argument of PrintPowersOf(number) in Modulus statement");
3581 while ( *inp ==
',' || *inp ==
' ' || *inp ==
'\t' ) inp++;
3583 if ( FG.cTable[*inp] != 1 )
goto badsyntax;
3584 do { inp++; }
while ( FG.cTable[*inp] == 1 );
3586 if ( GetLong(p,(UWORD *)AC.powmod,&AC.npowmod) ) Retval = -1;
3587 if ( TakeModulus((UWORD *)AC.powmod,&AC.npowmod,AC.cmod,AC.ncmod,NOUNPACK) ) Retval = -1;
3588 if ( AC.npowmod == 0 ) {
3589 MesPrint(
"&Improper value for generator");
3592 if ( MakeModTable() ) Retval = -1;
3595 while ( *inp ==
',' || *inp ==
' ' || *inp ==
'\t' ) inp++;
3596 if ( *inp !=
')' )
goto badsyntax;
3600 else if ( StrICmp(p,(UBYTE *)
"alsopowers") == 0 ) {
3601 AC.modmode |= ALSOPOWERS;
3604 else if ( StrICmp(p,(UBYTE *)
"nopowers") == 0 ) {
3605 AC.modmode &= ~ALSOPOWERS;
3609 MesPrint(
"&Unrecognized option %s in Modulus statement",inp);
3613 while ( *inp ==
',' || *inp ==
' ' || *inp ==
'\t' ) inp++;
3615 MesPrint(
"&Modulus statement with no value!!!");
3621 if ( FG.cTable[*inp] != 1 ) {
3622 MesPrint(
"&Invalid value for modulus:%s",inp);
3623 if ( AC.modpowers ) M_free(AC.modpowers,
"AC.modpowers");
3625 AN.ncmod = AC.ncmod = 0;
3626 if ( AC.halfmod ) M_free(AC.halfmod,
"halfmod");
3627 AC.halfmod = 0; AC.nhalfmod = 0;
3628 if ( AC.modinverses ) M_free(AC.modinverses,
"modinverses");
3632 do { inp++; }
while ( FG.cTable[*inp] == 1 );
3634 Retval = GetLong(p,(UWORD *)AC.cmod,&AC.ncmod);
3635 if ( Retval == 0 && AC.ncmod == 0 )
goto SwitchOff;
3636 if ( sign < 0 ) AC.ncmod = -AC.ncmod;
3637 AN.ncmod = AC.ncmod;
3638 if ( ( AC.modmode & INVERSETABLE ) != 0 )
MakeInverses();
3639 if ( AC.halfmod ) M_free(AC.halfmod,
"halfmod");
3640 AC.halfmod = 0; AC.nhalfmod = 0;
3650int CoRepeat(UBYTE *inp)
3653 AC.RepSumCheck[AC.RepLevel] = NestingChecksum();
3655 if ( AC.RepLevel > AM.RepMax ) {
3656 MesPrint(
"&Too many repeat levels. Maximum is %d",AM.RepMax);
3659 Add3Com(TYPEREPEAT,-1)
3660 while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
3662 error = CompileStatement(inp);
3663 if ( CoEndRepeat(inp) ) error = 1;
3673int CoEndRepeat(UBYTE *inp)
3675 CBUF *C = cbuf+AC.cbufnum;
3676 int level, error = 0, repeatlevel = 0;
3679 if ( AC.RepLevel < 0 ) {
3680 MesPrint(
"&EndRepeat without Repeat");
3684 else if ( AC.RepSumCheck[AC.RepLevel] != NestingChecksum() ) {
3688 level = C->numlhs+1;
3689 while ( level > 0 ) {
3690 if ( C->
lhs[--level][0] == TYPEREPEAT ) {
3691 if ( repeatlevel == 0 ) {
3692 Add3Com(TYPEENDREPEAT,level)
3697 else if ( C->
lhs[level][0] == TYPEENDREPEAT ) repeatlevel++;
3711int DoBrackets(UBYTE *inp,
int par)
3715 WORD *to, i, type, *w, error = 0;
3716 WORD c1,c2, *WorkSave;
3719 WorkSave = to = AT.WorkPointer;
3721 if ( AT.BrackBuf == 0 ) {
3722 AR.MaxBracket = 100;
3723 AT.BrackBuf = (WORD *)Malloc1(
sizeof(WORD)*(AR.MaxBracket+1),
"bracket buffer");
3727 AC.bracketindexflag = 0;
3728 AT.bracketindexflag = 0;
3729 if ( *p ==
'+' || *p ==
'-' ) p++;
3730 if ( p[-1] ==
',' && *p ) p--;
3731 if ( p[-1] ==
'+' && *p ) { biflag = 1;
if ( *p !=
',' ) { *--p =
','; } }
3732 else if ( p[-1] ==
'-' && *p ) { biflag = -1;
if ( *p !=
',' ) { *--p =
','; } }
3734 while ( *p ==
',' ) {
3735redo: AR.BracketOn++;
3736 while ( *p ==
',' ) p++;
3737 if ( *p == 0 )
break;
3739 p++;
while ( *p ==
'0' ) p++;
3744 if ( p == 0 )
return(1);
3747 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
3749 if ( type == CVECTOR || type == CDUBIOUS ) {
3753 if ( p == 0 )
return(1);
3756 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
3757 if ( type != CVECTOR && type != CDUBIOUS ) {
3758 MesPrint(
"&Not a vector in dotproduct in bracket statement: %s",inp);
3761 else type = CDOTPRODUCT;
3764 MesPrint(
"&Illegal use of . after %s in bracket statement",inp);
3772 *to++ = SYMBOL; *to++ = 4; *to++ = c1; *to++ = 1;
break;
3774 *to++ = INDEX; *to++ = 3; *to++ = AM.OffsetVector + c1;
break;
3776 *to++ = c1+FUNCTION; *to++ = FUNHEAD; *to++ = 0;
3780 *to++ = DOTPRODUCT; *to++ = 5; *to++ = c1 + AM.OffsetVector;
3781 *to++ = c2 + AM.OffsetVector; *to++ = 1;
break;
3783 *to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX;
break;
3785 *to++ = SETSET; *to++ = 4; *to++ = c1; *to++ = Sets[c1].type;
break;
3787 MesPrint(
"&Illegal bracket request for %s",pp);
3793 MesCerr(
"separator",p);
3794 AC.BracketNormalize = 0;
3795 AT.WorkPointer = WorkSave;
3799 *to++ = 1; *to++ = 1; *to++ = 3;
3800 *AT.WorkPointer = to - AT.WorkPointer;
3801 AT.WorkPointer = to;
3802 AC.BracketNormalize = 1;
3803 if ( BracketNormalize(BHEAD WorkSave) ) { error = 1; AR.BracketOn = 0; }
3806 if ( *w == 4 || !*w ) { AR.BracketOn = 0; }
3809 if ( i < 0 ) i = -i;
3812 if ( i > AR.MaxBracket ) {
3814 newbuf = (WORD *)Malloc1(
sizeof(WORD)*(i+1),
"bracket buffer");
3816 if ( AT.BrackBuf != 0 ) M_free(AT.BrackBuf,
"bracket buffer");
3817 AT.BrackBuf = newbuf;
3823 AC.BracketNormalize = 0;
3824 if ( par == 1 ) AR.BracketOn = -AR.BracketOn;
3826 AC.bracketindexflag = biflag;
3827 AT.bracketindexflag = biflag;
3829 AT.WorkPointer = WorkSave;
3838int CoBracket(UBYTE *inp)
3839{
return(DoBrackets(inp,0)); }
3846int CoAntiBracket(UBYTE *inp)
3847{
return(DoBrackets(inp,1)); }
3857int CoMultiBracket(UBYTE *inp)
3860 int i, error = 0, error1, type, num;
3864 if ( *inp !=
':' ) {
3865 MesPrint(
"&Illegal Multiple Bracket separator: %s",inp);
3869 if ( AC.MultiBracketBuf == 0 ) {
3870 AC.MultiBracketBuf = (WORD **)Malloc1(
sizeof(WORD *)*MAXMULTIBRACKETLEVELS,
"multi bracket buffer");
3871 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
3872 AC.MultiBracketBuf[i] = 0;
3876 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
3877 if ( AC.MultiBracketBuf[i] ) {
3878 M_free(AC.MultiBracketBuf[i],
"bracket buffer i");
3879 AC.MultiBracketBuf[i] = 0;
3882 AC.MultiBracketLevels = 0;
3884 AC.MultiBracketLevels = 0;
3888 if ( AT.BrackBuf == 0 ) {
3889 AR.MaxBracket = 100;
3890 AT.BrackBuf = (WORD *)Malloc1(
sizeof(WORD)*(AR.MaxBracket+1),
"bracket buffer");
3894 AC.bracketindexflag = 0;
3895 AT.bracketindexflag = 0;
3899 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
3900 if ( *inp == 0 )
goto RegEnd;
3905 while ( *s && *s !=
':' ) {
3906 if ( *s ==
'[' ) { SKIPBRA1(s) s++; }
3907 else if ( *s ==
'{' ) { SKIPBRA2(s) s++; }
3911 if ( StrICont(inp,(UBYTE *)
"antibrackets") == 0 ) { type = 1; }
3912 else if ( StrICont(inp,(UBYTE *)
"brackets") == 0 ) { type = 0; }
3914 MesPrint(
"&Illegal (anti)bracket specification in MultiBracket statement");
3915 if ( error == 0 ) error = 1;
3918 while ( FG.cTable[*inp] == 0 ) inp++;
3919 if ( *inp !=
',' ) {
3920 MesPrint(
"&Illegal separator after (anti)bracket specification in MultiBracket statement");
3921 if ( error == 0 ) error = 1;
3928 error1 = DoBrackets(inp, type);
3929 if ( error < 0 )
return(error1);
3930 if ( error1 > error ) error = error1;
3934 if ( AR.BracketOn ) {
3935 num = AT.BrackBuf[0];
3936 to = AC.MultiBracketBuf[i] = (WORD *)Malloc1((num+2)*
sizeof(WORD),
"bracket buffer i");
3938 *to++ = AR.BracketOn;
3946 *s = c;
if ( c ==
':' ) s++;
3952 MesPrint(
"&More than %d levels in MultiBracket statement",(WORD)MAXMULTIBRACKETLEVELS);
3953 if ( error == 0 ) error = 1;
3956 AC.MultiBracketLevels = i;
3959 AC.bracketindexflag = 0;
3960 AT.bracketindexflag = 0;
3989WORD *CountComp(UBYTE *inp, WORD *to)
3993 WORD *w, mini = 0, type, c1, c2;
4001 while ( *p ==
',' ) {
4003 if ( *p ==
'[' || FG.cTable[*p] == 0 ) {
4004 if ( ( p = SkipAName(inp) ) == 0 )
return(0);
4006 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
4008 if ( type == CVECTOR || type == CDUBIOUS ) {
4012 if ( p == 0 )
return(0);
4015 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
4016 if ( type != CVECTOR && type != CDUBIOUS ) {
4017 MesPrint(
"&Not a vector in dotproduct in if statement: %s",inp);
4020 else type = CDOTPRODUCT;
4023 MesPrint(
"&Illegal use of . after %s in if statement",inp);
4024 if ( type == NAMENOTFOUND )
4025 MesPrint(
"&%s is not a properly declared variable",inp);
4028 while ( *p && *p !=
')' && *p !=
',' ) p++;
4029 if ( *p ==
',' && FG.cTable[p[1]] == 1 ) {
4031 while ( *p && *p !=
')' && *p !=
',' ) p++;
4039 *w++ = SYMBOL; *w++ = 4; *w++ = c1;
4040Sgetnum:
if ( *p !=
',' ) {
4041 MesCerr(
"sequence",p);
4042 while ( *p && *p !=
')' && *p !=
',' ) p++;
4046 ParseSignedNumber(mini,p)
4047 if ( FG.cTable[p[-1]] != 1 || ( *p && *p !=
')' && *p !=
',' ) ) {
4048 while ( *p && *p !=
')' && *p !=
',' ) p++;
4051 MesPrint(
"&Improper value in count: %s",inp);
4053 while ( *p && *p !=
')' && *p !=
',' ) p++;
4058 *w++ = FUNCTION; *w++ = 4; *w++ = c1+FUNCTION;
goto Sgetnum;
4060 *w++ = DOTPRODUCT; *w++ = 5;
4061 *w++ = c2 + AM.OffsetVector;
4062 *w++ = c1 + AM.OffsetVector;
4065 *w++ = VECTOR; *w++ = 5;
4066 *w++ = c1 + AM.OffsetVector;
4068 *w++ = VECTBIT | DOTPBIT | FUNBIT;
4071 else if ( *p ==
'+' ) {
4074 while ( *p && *p !=
',' ) {
4075 if ( *p ==
'v' || *p ==
'V' ) {
4078 else if ( *p ==
'd' || *p ==
'D' ) {
4081 else if ( *p ==
'f' || *p ==
'F'
4082 || *p ==
't' || *p ==
'T' ) {
4085 else if ( *p ==
'?' ) {
4089 if ( p == 0 )
return(0);
4090 if ( ( c1 = DoTempSet(inp+1,p) ) < 0 )
return(0);
4091 if ( Sets[c1].type != CFUNCTION ) {
4092 MesPrint(
"&set type conflict: Function expected");
4100 if ( p == 0 )
return(0);
4102 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
4104 if ( type != CSET && type != CDUBIOUS ) {
4105 MesPrint(
"&%s is not a set",inp);
4115 MesCerr(
"specifier for vector",p);
4123 MesCerr(
"specifier for vector",p);
4124 while ( *p && *p !=
')' && *p !=
',' ) p++;
4126 *w++ = VECTBIT | DOTPBIT | FUNBIT;
4133 MesPrint(
"&%s is not a symbol, function, vector or dotproduct",inp);
4135skipfield:
while ( *p && *p !=
')' && *p !=
',' ) p++;
4136 if ( *p && FG.cTable[p[1]] == 1 ) {
4138 while ( *p && *p !=
')' && *p !=
',' ) p++;
4145 while ( *p && *p !=
',' ) p++;
4150 if ( *p ==
')' ) p++;
4151 if ( *p ) { MesCerr(
"end of statement",p);
return(0); }
4152 if ( error )
return(0);
4177static UWORD *CIscratC = 0;
4182 int error = 0, level;
4183 WORD *w, *ww, *u, *s, *OldWork, *OldSpace = AT.WorkSpace;
4185 WORD lenpp, lenlev, ncoef, i, number;
4186 UBYTE *p, *pp, *ppp, c;
4187 CBUF *C = cbuf+AC.cbufnum;
4189 if ( *inp ==
'(' && inp[1] ==
',' ) inp += 2;
4190 else if ( *inp ==
'(' ) inp++;
4192 if ( CIscratC == 0 )
4193 CIscratC = (UWORD *)Malloc1((AM.MaxTal+2)*
sizeof(UWORD),
"CoIf");
4196 if ( AC.IfLevel >= AC.MaxIf ) DoubleIfBuffers();
4197 AC.IfCount[lenpp++] = 0;
4205 AC.IfSumCheck[AC.IfLevel] = NestingChecksum();
4207 w = OldWork = AT.WorkPointer;
4215 if ( FG.cTable[*p] == 1 ) {
4216 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4220 if ( GetLong(p,(UWORD *)w,&ncoef) ) { ncoef = 1; error = 1; }
4222 while ( FG.cTable[*++p] == 1 );
4225 if ( FG.cTable[*p] != 1 ) {
4226 MesCerr(
"sequence",p); error = 1;
goto OnlyNum;
4228 if ( GetLong(p,CIscratC,&ncoef) ) {
4229 ncoef = 1; error = 1;
4231 while ( FG.cTable[*++p] == 1 );
4233 MesPrint(
"&Division by zero!");
4238 if ( Simplify(BHEAD (UWORD *)w,(WORD *)(w-1),
4239 CIscratC,&ncoef) ) error = 1;
4246 s = (WORD *)CIscratC;
4248 while ( --i >= 0 ) *w++ = 0;
4253 while ( --i >= 0 ) *w++ = 0;
4254 s = (WORD *)CIscratC;
4266 while ( --ncoef >= 0 ) *w++ = 0;
4269 u[1] = WORDDIF(w,u);
4270 u[2] = (u[1] - 3)/2;
4271 if ( level ) u[2] = -u[2];
4274 else if ( *p ==
'+' ) { p++;
goto ReDo; }
4275 else if ( *p ==
'-' ) { level ^= 1; p++;
goto ReDo; }
4276 else if ( *p ==
'c' || *p ==
'C' ) {
4277 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4278 while ( FG.cTable[*++p] == 0 );
4280 if ( !StrICmp(inp,(UBYTE *)
"count") ) {
4283 MesPrint(
"&no ( after count");
4289 c = *++p; *p = 0; *inp =
',';
4290 w = CountComp(inp,w);
4292 if ( w == 0 ) { error = 1;
goto endofif; }
4295 else if ( ConWord(inp,(UBYTE *)
"coefficient") && ( p - inp ) > 3 ) {
4304 else if ( *p ==
'm' || *p ==
'M' ) {
4305 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4306 while ( !FG.cTable[*++p] );
4308 if ( !StrICmp(inp,(UBYTE *)
"match") ) {
4311 MesPrint(
"&no ( after match");
4322 AT.WorkSpace = AT.WorkPointer = w;
4324 while ( FG.cTable[*ppp] == 0 && ppp < p ) ppp++;
4325 if ( *ppp ==
',' ) AC.idoption = 0;
4326 else AC.idoption = SUBMULTI;
4327 level = CoIdExpression(inp,TYPEIF);
4328 AT.WorkSpace = OldSpace;
4329 AT.WorkPointer = OldWork;
4331 if ( level < 0 ) { error = -1;
goto endofif; }
4337 s = u = C->
lhs[C->numlhs];
4338 while ( u < C->Pointer ) *w++ = *u++;
4344 else if ( !StrICmp(inp,(UBYTE *)
"multipleof") ) {
4345 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4348 MesPrint(
"&no ( after multipleof");
4349 error = 1;
goto endofif;
4352 if ( FG.cTable[*p] != 1 ) {
4353Nomulof: MesPrint(
"&multipleof needs a short positive integer argument");
4354 error = 1;
goto endofif;
4357 if ( *p !=
')' || x <= 0 || x > MAXPOSITIVE )
goto Nomulof;
4359 *w++ = MULTIPLEOF; *w++ = 3; *w++ = (WORD)x;
4364NoGood: MesPrint(
"&Unrecognized word: %s",inp);
4368 if ( c ==
'(' ) SKIPBRA4(p)
4373 else if ( *p ==
'f' || *p ==
'F' ) {
4374 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4375 while ( FG.cTable[*++p] == 0 );
4377 if ( !StrICmp(inp,(UBYTE *)
"findloop") ) {
4380 MesPrint(
"&no ( after findloop");
4386 c = *++p; *p = 0; *inp =
',';
4387 if ( CoFindLoop(inp) )
goto endofif;
4388 s = u = C->
lhs[C->numlhs];
4389 while ( u < C->Pointer ) *w++ = *u++;
4392 if ( w == 0 ) { error = 1;
goto endofif; }
4398 else if ( *p ==
'e' || *p ==
'E' ) {
4399 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4400 while ( FG.cTable[*++p] == 0 );
4402 if ( !StrICmp(inp,(UBYTE *)
"expression") ) {
4405 MesPrint(
"&no ( after expression");
4409 p++; ww = w; *w++ = IFEXPRESSION; w++;
4410 while ( *p !=
')' ) {
4411 if ( *p ==
',' ) { p++;
continue; }
4412 if ( *p ==
'[' || FG.cTable[*p] == 0 ) {
4414 if ( ( p = SkipAName(p) ) == 0 ) {
4415 MesPrint(
"&Improper name for an expression: '%s'",pp);
4420 if ( GetName(AC.exprnames,pp,&number,NOAUTO) == CEXPRESSION ) {
4423 else if ( GetName(AC.varnames,pp,&number,NOAUTO) != NAMENOTFOUND ) {
4424 MesPrint(
"&%s is not an expression",pp);
4431 MesPrint(
"&Illegal object in Expression in if-statement");
4433 while ( *p && *p !=
',' && *p !=
')' ) p++;
4434 if ( *p == 0 || *p ==
')' )
break;
4444 else if ( *p ==
'i' || *p ==
'I' ) {
4445 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4446 while ( FG.cTable[*++p] == 0 );
4448 if ( !StrICmp(inp,(UBYTE *)
"isfactorized") ) {
4451 ww = w; *w++ = IFISFACTORIZED; w++;
4454 p++; ww = w; *w++ = IFISFACTORIZED; w++;
4455 while ( *p !=
')' ) {
4456 if ( *p ==
',' ) { p++;
continue; }
4457 if ( *p ==
'[' || FG.cTable[*p] == 0 ) {
4459 if ( ( p = SkipAName(p) ) == 0 ) {
4460 MesPrint(
"&Improper name for an expression: '%s'",pp);
4465 if ( GetName(AC.exprnames,pp,&number,NOAUTO) == CEXPRESSION ) {
4468 else if ( GetName(AC.varnames,pp,&number,NOAUTO) != NAMENOTFOUND ) {
4469 MesPrint(
"&%s is not an expression",pp);
4476 MesPrint(
"&Illegal object in IsFactorized in if-statement");
4478 while ( *p && *p !=
',' && *p !=
')' ) p++;
4479 if ( *p == 0 || *p ==
')' )
break;
4490 else if ( *p ==
'o' || *p ==
'O' ) {
4502 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4503 while ( FG.cTable[*++p] == 0 );
4504 c = cc = *p; *p = 0;
4505 if ( !StrICmp(inp,(UBYTE *)
"occurs") ) {
4509 MesPrint(
"&no ( after occurs");
4515 cc = *++p; *p = 0; *inp =
','; pp = p;
4517 *w++ = IFOCCURS; *w++ = 0;
4519 while ( *inp ==
',' ) inp++;
4520 if ( *inp == 0 || *inp ==
')' )
break;
4526 if ( *inp ==
'[' || FG.cTable[*inp] == 0 ) {
4527 if ( ( p = SkipAName(inp) ) == 0 )
return(0);
4529 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
4531 if ( type == CVECTOR || type == CDUBIOUS ) {
4535 if ( p == 0 )
return(0);
4538 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
4539 if ( type != CVECTOR && type != CDUBIOUS ) {
4540 MesPrint(
"&Not a vector in dotproduct in if statement: %s",inp);
4543 else type = CDOTPRODUCT;
4546 MesPrint(
"&Illegal use of . after %s in if statement",inp);
4547 if ( type == NAMENOTFOUND )
4548 MesPrint(
"&%s is not a properly declared variable",inp);
4551 while ( *p && *p !=
')' && *p !=
',' ) p++;
4552 if ( *p ==
',' && FG.cTable[p[1]] == 1 ) {
4554 while ( *p && *p !=
')' && *p !=
',' ) p++;
4567 *w++ = c1 + AM.OffsetIndex;
4571 *w++ = c1 + AM.OffsetVector;
4575 *w++ = c1 + AM.OffsetVector;
4576 *w++ = c2 + AM.OffsetVector;
4583 MesPrint(
"&Illegal variable %s in occurs condition in if statement",inp);
4590 MesPrint(
"&Illegal object %s in occurs condition in if statement",inp);
4596 p = pp; *p = cc; *inp =
'(';
4599 MesPrint(
"&The occurs condition in the if statement needs arguments.");
4606 else if ( *p ==
'$' ) {
4607 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4609 while ( FG.cTable[*p] == 0 || FG.cTable[*p] == 1 ) p++;
4611 if ( ( i = GetDollar(inp) ) < 0 ) {
4612 MesPrint(
"&undefined dollar expression %s",inp);
4614 i = AddDollar(inp,DOLUNDEFINED,0,0);
4617 *w++ = IFDOLLAR; *w++ = 3; *w++ = i;
4623 if ( ( w = GetIfDollarFactor(&p,w) ) == 0 ) {
4627 else if ( *p !=
']' ) {
4636 else if ( *p ==
'(' ) {
4638 MesCerr(
"parenthesis",p);
4643 if ( ++lenlev >= AC.MaxIf ) DoubleIfBuffers();
4644 AC.IfCount[lenpp++] = w-OldWork;
4649 else if ( *p ==
')' ) {
4650 if ( gotexp == 0 ) { MesCerr(
"position for )",p); error = 1; }
4652 u = AC.IfCount[--lenpp]+OldWork;
4655 if ( lenlev <= 0 ) {
4656 AT.WorkSpace = OldSpace;
4657 AT.WorkPointer = OldWork;
4661 MesPrint(
"&unmatched parenthesis in if/while ()");
4663 while ( *++p ==
')' );
4666 level = CompileStatement(p);
4667 if ( level ) error = level;
4669 if ( CoEndIf(p) && error == 0 ) error = 1;
4675 else if ( *p ==
'>' ) {
4676 if ( gotexp == 0 )
goto NoExp;
4677 if ( p[1] ==
'=' ) { *w++ = GREATEREQUAL; *w++ = 2; p += 2; }
4678 else { *w++ = GREATER; *w++ = 2; p++; }
4681 else if ( *p ==
'<' ) {
4682 if ( gotexp == 0 )
goto NoExp;
4683 if ( p[1] ==
'=' ) { *w++ = LESSEQUAL; *w++ = 2; p += 2; }
4684 else { *w++ = LESS; *w++ = 2; p++; }
4687 else if ( *p ==
'=' ) {
4688 if ( gotexp == 0 )
goto NoExp;
4689 if ( p[1] ==
'=' ) p++;
4690 *w++ = EQUAL; *w++ = 2; p++;
4693 else if ( *p ==
'!' && p[1] ==
'=' ) {
4694 if ( gotexp == 0 ) { p++;
goto NoExp; }
4695 *w++ = NOTEQUAL; *w++ = 2; p += 2;
4698 else if ( *p ==
'|' && p[1] ==
'|' ) {
4699 if ( gotexp == 0 ) { p++;
goto NoExp; }
4700 *w++ = ORCOND; *w++ = 2; p += 2;
4703 else if ( *p ==
'&' && p[1] ==
'&' ) {
4704 if ( gotexp == 0 ) {
4707 MesCerr(
"sequence",p);
4711 *w++ = ANDCOND; *w++ = 2; p += 2;
4715 else if ( *p == 0 ) {
4716 MesPrint(
"&Unmatched parentheses");
4721 if ( FG.cTable[*p] == 0 ) {
4724 while ( ( ij = FG.cTable[*++p] ) == 0 || ij == 1 );
4728 MesCerr(
"sequence",p);
4745 CBUF *C = cbuf+AC.cbufnum;
4747 while ( *p ==
',' ) p++;
4748 if ( tolower(*p) ==
'i' && tolower(p[1]) ==
'f' && p[2] ==
'(' )
4749 return(CoElseIf(p+2));
4750 MesPrint(
"&No extra text allowed as part of an else statement");
4753 if ( AC.IfLevel <= 0 ) { MesPrint(
"&else statement without if");
return(1); }
4754 if ( AC.IfSumCheck[AC.IfLevel-1] != NestingChecksum() - 1 ) {
4758 Add3Com(TYPEELSE,AC.IfLevel)
4759 C->Buffer[AC.IfStack[-1]] = C->numlhs;
4760 AC.IfStack[-1] = C->Pointer - C->Buffer - 1;
4769int CoElseIf(UBYTE *inp)
4771 CBUF *C = cbuf+AC.cbufnum;
4772 if ( AC.IfLevel <= 0 ) { MesPrint(
"&elseif statement without if"); return(1); }
4773 Add3Com(TYPEELSE,-AC.IfLevel)
4775 C->
Buffer[*--AC.IfStack] = C->numlhs;
4796int CoEndIf(UBYTE *inp)
4798 CBUF *C = cbuf+AC.cbufnum;
4799 WORD i = C->numlhs, to, k = -AC.IfLevel;
4801 while ( *inp ==
',' ) inp++;
4804 MesPrint(
"&No extra text allowed as part of an endif/elseif statement");
4806 if ( AC.IfLevel <= 0 ) {
4807 MesPrint(
"&Endif statement without corresponding if");
return(1);
4810 C->
Buffer[*--AC.IfStack] = i+1;
4811 if ( AC.IfSumCheck[AC.IfLevel] != NestingChecksum() ) {
4815 Add3Com(TYPEENDIF,i+1)
4821 if ( C->
lhs[i][0] == TYPEELSE && C->
lhs[i][2] == to ) to = i;
4822 if ( C->
lhs[i][0] == TYPEIF ) {
4823 if ( C->lhs[i][2] == to ) {
4825 if ( i <= 0 || C->lhs[i][0] != TYPEELSE
4826 || C->lhs[i][2] != k ) break;
4827 C->lhs[i][2] = C->numlhs;
4841int CoWhile(UBYTE *inp)
4843 CBUF *C = cbuf+AC.cbufnum;
4844 WORD startnum = C->numlhs + 1;
4848 if ( C->numlhs > startnum && C->
lhs[startnum][2] == C->numlhs
4849 && C->
lhs[C->numlhs][0] == TYPEENDIF ) {
4850 C->
lhs[C->numlhs][2] = startnum-1;
4853 else C->
lhs[startnum][2] = startnum;
4862int CoEndWhile(UBYTE *inp)
4866 CBUF *C = cbuf+AC.cbufnum;
4867 if ( AC.WhileLevel <= 0 ) {
4868 MesPrint(
"&EndWhile statement without corresponding While");
return(1);
4871 i = C->
Buffer[AC.IfStack[-1]];
4872 error = CoEndIf(inp);
4873 C->
lhs[C->numlhs][2] = i - 1;
4884static char *messfind[] = {
4885 "Findloop(function,arguments=#,loopsize(=#|<#)[,include=index])"
4886 ,
"Replaceloop,function,arguments=#,loopsize(=#|<#),outfun=function[,include=index]"
4888static WORD comfindloop[7] = { TYPEFINDLOOP,7,0,0,0,0,0 };
4890int DoFindLoop(UBYTE *inp,
int mode)
4893 WORD funnum, nargs = 0, nloop = 0, indexnum = 0, outfun = 0;
4894 int type, aflag, lflag, indflag, outflag, error = 0, sym;
4895 while ( *inp ==
',' ) inp++;
4896 if ( ( s = SkipAName(inp) ) == 0 ) {
4897syntax: MesPrint(
"&Proper syntax is:");
4898 MesPrint(
"%s",messfind[mode]);
4902 if ( ( ( type = GetName(AC.varnames,inp,&funnum,WITHAUTO) ) == NAMENOTFOUND )
4903 || type != CFUNCTION || ( ( sym = (functions[funnum].symmetric) & ~REVERSEORDER )
4904 != SYMMETRIC && sym != ANTISYMMETRIC ) ) {
4905 MesPrint(
"&%s should be a (anti)symmetric function or tensor",inp);
4909 aflag = lflag = indflag = outflag = 0;
4910 while ( *inp ==
',' ) {
4911 while ( *inp ==
',' ) inp++;
4913 if ( ( s = SkipAName(inp) ) == 0 )
goto syntax;
4915 if ( StrICont(inp,(UBYTE *)
"arguments") == 0 ) {
4916 if ( c !=
'=' )
goto syntax;
4918 NeedNumber(nargs,s,syntax)
4922 else if ( StrICont(inp,(UBYTE *)
"loopsize") == 0 ) {
4923 if ( c !=
'=' && c !=
'<' )
goto syntax;
4925 if ( FG.cTable[*s] == 1 ) {
4926 NeedNumber(nloop,s,syntax)
4928 MesPrint(
"&loopsize should be at least 2");
4931 if ( c ==
'<' ) nloop = -nloop;
4933 else if ( tolower(*s) ==
'a' && tolower(s[1]) ==
'l'
4934 && tolower(s[2]) ==
'l' && FG.cTable[s[3]] > 1 ) {
4936 if ( c !=
'=' )
goto syntax;
4941 else if ( StrICont(inp,(UBYTE *)
"include") == 0 ) {
4942 if ( c !=
'=' )
goto syntax;
4944 if ( ( inp = SkipAName(s) ) == 0 )
goto syntax;
4946 if ( ( type = GetName(AC.varnames,s,&indexnum,WITHAUTO) ) != CINDEX ) {
4947 MesPrint(
"&%s is not a proper index",s);
4950 else if ( indexnum < WILDOFFSET
4951 && indices[indexnum].dimension == 0 ) {
4952 MesPrint(
"&%s should be a summable index",s);
4955 indexnum += AM.OffsetIndex;
4959 else if ( StrICont(inp,(UBYTE *)
"outfun") == 0 ) {
4960 if ( c !=
'=' )
goto syntax;
4962 if ( ( inp = SkipAName(s) ) == 0 )
goto syntax;
4964 if ( ( type = GetName(AC.varnames,s,&outfun,WITHAUTO) ) != CFUNCTION ) {
4965 MesPrint(
"&%s is not a proper function or tensor",s);
4973 MesPrint(
"&Unrecognized option in FindLoop or ReplaceLoop: %s",inp);
4975 while ( *inp && *inp !=
',' ) inp++;
4978 if ( *inp != 0 && mode == REPLACELOOP )
goto syntax;
4979 if ( mode == FINDLOOP && outflag > 0 ) {
4980 MesPrint(
"&outflag option is illegal in FindLoop");
4983 if ( mode == REPLACELOOP && outflag == 0 )
goto syntax;
4984 if ( aflag == 0 || lflag == 0 )
goto syntax;
4985 comfindloop[3] = funnum;
4986 comfindloop[4] = nloop;
4987 comfindloop[5] = nargs;
4988 comfindloop[6] = outfun;
4991 if ( mode == 0 ) comfindloop[2] = indexnum + 5;
4992 else comfindloop[2] = -indexnum - 5;
4994 else comfindloop[2] = mode;
4995 AddNtoL(comfindloop[1],comfindloop);
5004int CoFindLoop(UBYTE *inp)
5005{
return(DoFindLoop(inp,FINDLOOP)); }
5012int CoReplaceLoop(UBYTE *inp)
5013{
return(DoFindLoop(inp,REPLACELOOP)); }
5020static UBYTE *FunPowOptions[] = {
5021 (UBYTE *)
"nofunpowers"
5022 ,(UBYTE *)
"commutingonly"
5023 ,(UBYTE *)
"allfunpowers"
5026int CoFunPowers(UBYTE *inp)
5029 int i, maxoptions =
sizeof(FunPowOptions)/
sizeof(UBYTE *);
5030 while ( *inp ==
',' ) inp++;
5032 inp = SkipAName(inp); c = *inp; *inp = 0;
5033 for ( i = 0; i < maxoptions; i++ ) {
5034 if ( StrICont(option,FunPowOptions[i]) == 0 ) {
5037 MesPrint(
"&Illegal FunPowers statement");
5044 MesPrint(
"&Illegal option in FunPowers statement: %s",option);
5053int CoUnitTrace(UBYTE *s)
5056 if ( FG.cTable[*s] == 1 ) {
5059nogood: MesPrint(
"&Value of UnitTrace should be a (positive) number or a symbol");
5062 AC.lUniTrace[0] = SNUMBER;
5063 AC.lUniTrace[2] = num;
5066 if ( GetName(AC.varnames,s,&num,WITHAUTO) == CSYMBOL ) {
5067 AC.lUniTrace[0] = SYMBOL;
5068 AC.lUniTrace[2] = num;
5073 if ( *s )
goto nogood;
5075 AC.lUnitTrace = num;
5091 WORD *w = AT.WorkPointer;
5093 while ( *s ==
',' ) s++;
5095 MesPrint(
"&Illegal syntax for Term statement");
5098 if ( AC.termlevel+1 >= AC.maxtermlevel ) {
5099 if ( AC.maxtermlevel <= 0 ) {
5100 AC.maxtermlevel = 20;
5101 AC.termstack = (LONG *)Malloc1(AC.maxtermlevel*
sizeof(LONG),
"termstack");
5102 AC.termsortstack = (LONG *)Malloc1(AC.maxtermlevel*
sizeof(LONG),
"termsortstack");
5103 AC.termsumcheck = (WORD *)Malloc1(AC.maxtermlevel*
sizeof(WORD),
"termsumcheck");
5106 DoubleBuffer((
void **)AC.termstack,(
void **)AC.termstack+AC.maxtermlevel,
5107 sizeof(LONG),
"doubling termstack");
5108 DoubleBuffer((
void **)AC.termsortstack,
5109 (
void **)AC.termsortstack+AC.maxtermlevel,
5110 sizeof(LONG),
"doubling termsortstack");
5111 DoubleBuffer((
void **)AC.termsumcheck,
5112 (
void **)AC.termsumcheck+AC.maxtermlevel,
5113 sizeof(LONG),
"doubling termsumcheck");
5114 AC.maxtermlevel *= 2;
5117 AC.termsumcheck[AC.termlevel] = NestingChecksum();
5118 AC.termstack[AC.termlevel] = cbuf[AC.cbufnum].Pointer
5119 - cbuf[AC.cbufnum].Buffer + 2;
5120 AC.termsortstack[AC.termlevel] = AC.termstack[AC.termlevel] + 1;
5124 *w++ = cbuf[AC.cbufnum].numlhs;
5125 *w++ = cbuf[AC.cbufnum].numlhs;
5126 AT.WorkPointer[1] = w - AT.WorkPointer;
5127 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
5136int CoEndTerm(UBYTE *s)
5138 CBUF *C = cbuf+AC.cbufnum;
5139 while ( *s ==
',' ) s++;
5141 MesPrint(
"&Illegal syntax for EndTerm statement");
5144 if ( AC.termlevel <= 0 ) {
5145 MesPrint(
"&EndTerm without corresponding Argument statement");
5149 cbuf[AC.cbufnum].Buffer[AC.termstack[AC.termlevel]] = C->numlhs;
5150 cbuf[AC.cbufnum].Buffer[AC.termsortstack[AC.termlevel]] = C->numlhs;
5151 if ( AC.termsumcheck[AC.termlevel] != NestingChecksum() ) {
5166 WORD *w = AT.WorkPointer;
5168 while ( *s ==
',' ) s++;
5170 MesPrint(
"&Illegal syntax for Sort statement");
5173 if ( AC.termlevel <= 0 ) {
5174 MesPrint(
"&The Sort statement can only be used inside a term environment");
5177 if ( error )
return(error);
5181 cbuf[AC.cbufnum].Buffer[AC.termsortstack[AC.termlevel-1]] =
5182 *w = cbuf[AC.cbufnum].numlhs+1;
5184 AC.termsortstack[AC.termlevel-1] = cbuf[AC.cbufnum].Pointer
5185 - cbuf[AC.cbufnum].Buffer + 3;
5186 if ( AC.termsumcheck[AC.termlevel-1] != NestingChecksum() - 1 ) {
5190 AT.WorkPointer[1] = w - AT.WorkPointer;
5191 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
5202int CoPolyFun(UBYTE *s)
5208 AR.PolyFun = AC.lPolyFun = 0;
5209 AR.PolyFunInv = AC.lPolyFunInv = 0;
5210 AR.PolyFunType = AC.lPolyFunType = 0;
5211 AR.PolyFunExp = AC.lPolyFunExp = 0;
5212 AR.PolyFunVar = AC.lPolyFunVar = 0;
5213 AR.PolyFunPow = AC.lPolyFunPow = 0;
5214 if ( *s == 0 ) {
return(0); }
5216 if ( t == 0 || *t != 0 ) {
5217 MesPrint(
"&PolyFun statement needs a single commuting function for its argument");
5220 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5221 || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
5222 MesPrint(
"&%s should be a regular commuting function",s);
5224 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5225 AddFunction(s,0,0,0,0,0,-1,-1);
5229 AR.PolyFun = AC.lPolyFun = numfun+FUNCTION;
5230 AR.PolyFunType = AC.lPolyFunType = 1;
5241int CoPolyRatFun(UBYTE *s)
5247 AR.PolyFun = AC.lPolyFun = 0;
5248 AR.PolyFunInv = AC.lPolyFunInv = 0;
5249 AR.PolyFunType = AC.lPolyFunType = 0;
5250 AR.PolyFunExp = AC.lPolyFunExp = 0;
5251 AR.PolyFunVar = AC.lPolyFunVar = 0;
5252 AR.PolyFunPow = AC.lPolyFunPow = 0;
5253 if ( *s == 0 )
return(0);
5255 if ( t == 0 )
goto NumErr;
5257 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5258 || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
5259 MesPrint(
"&%s should be a regular commuting function",s);
5261 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5262 AddFunction(s,0,0,0,0,0,-1,-1);
5266 AR.PolyFun = AC.lPolyFun = numfun+FUNCTION;
5267 AR.PolyFunInv = AC.lPolyFunInv = 0;
5268 AR.PolyFunType = AC.lPolyFunType = 2;
5269 AC.PolyRatFunChanged = 1;
5270 if ( c == 0 )
return(0);
5272 if ( *t ==
'-' ) { AC.PolyRatFunChanged = 0; t++; }
5273 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5274 if ( *t == 0 )
return(0);
5278 if ( t == 0 )
goto NumErr;
5280 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5281 || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
5282 MesPrint(
"&%s should be a regular commuting function",s);
5284 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5285 AddFunction(s,0,0,0,0,0,-1,-1);
5289 AR.PolyFunInv = AC.lPolyFunInv = numfun+FUNCTION;
5290 if ( c == 0 )
return(0);
5292 if ( *t ==
'-' ) { AC.PolyRatFunChanged = 0; t++; }
5293 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5294 if ( *t == 0 )
return(0);
5298 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5306 if ( t == 0 )
goto NumErr;
5308 if ( ( StrICmp(s,(UBYTE *)
"divergence") == 0 )
5309 || ( StrICmp(s,(UBYTE *)
"finddivergence") == 0 ) ) {
5311 MesPrint(
"&Illegal option field in PolyRatFun statement.");
5315 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5318 if ( t == 0 )
goto NumErr;
5320 if ( ( type = GetName(AC.varnames,s,&AC.lPolyFunVar,WITHAUTO) ) != CSYMBOL ) {
5321 MesPrint(
"&Illegal symbol %s in option field in PolyRatFun statement.",s);
5325 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5327 MesPrint(
"&Illegal termination of option in PolyRatFun statement.");
5330 AR.PolyFunExp = AC.lPolyFunExp = 1;
5331 AR.PolyFunVar = AC.lPolyFunVar;
5332 symbols[AC.lPolyFunVar].minpower = -MAXPOWER;
5333 symbols[AC.lPolyFunVar].maxpower = MAXPOWER;
5335 else if ( StrICmp(s,(UBYTE *)
"expand") == 0 ) {
5336 WORD x = 0, etype = 2;
5338 MesPrint(
"&Illegal option field in PolyRatFun statement.");
5342 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5345 if ( t == 0 )
goto NumErr;
5347 if ( ( type = GetName(AC.varnames,s,&AC.lPolyFunVar,WITHAUTO) ) != CSYMBOL ) {
5348 MesPrint(
"&Illegal symbol %s in option field in PolyRatFun statement.",s);
5352 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5353 if ( *t >
'9' || *t <
'0' ) {
5354 MesPrint(
"&Illegal option field in PolyRatFun statement.");
5357 while ( *t <=
'9' && *t >=
'0' ) x = 10*x + *t++ -
'0';
5358 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5362 if ( t == 0 )
goto ParErr;
5364 if ( StrICmp(s,(UBYTE *)
"fixed") == 0 ) {
5367 else if ( StrICmp(s,(UBYTE *)
"relative") == 0 ) {
5371 MesPrint(
"&Illegal termination of option in PolyRatFun statement.");
5375 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5377 MesPrint(
"&Illegal termination of option in PolyRatFun statement.");
5381 AR.PolyFunExp = AC.lPolyFunExp = etype;
5382 AR.PolyFunVar = AC.lPolyFunVar;
5383 AR.PolyFunPow = AC.lPolyFunPow = x;
5384 symbols[AC.lPolyFunVar].minpower = -MAXPOWER;
5385 symbols[AC.lPolyFunVar].maxpower = MAXPOWER;
5388ParErr: MesPrint(
"&Illegal option %s in PolyRatFun statement.",s);
5392 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5393 if ( *t == 0 )
return(0);
5396 MesPrint(
"&PolyRatFun statement needs one or two commuting function(s) for its argument(s)");
5405int CoMerge(UBYTE *inp)
5409 WORD numfunc, option = 0;
5410 if ( tolower(s[0]) ==
'o' && tolower(s[1]) ==
'n' && tolower(s[2]) ==
'c' &&
5411 tolower(s[3]) ==
'e' && tolower(s[4]) ==
',' ) {
5414 else if ( tolower(s[0]) ==
'a' && tolower(s[1]) ==
'l' && tolower(s[2]) ==
'l' &&
5415 tolower(s[3]) ==
',' ) {
5419 if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
5422 MesPrint(
"&%s is undefined",s);
5423 numfunc = AddDollar(s+1,DOLINDEX,&one,1);
5426tests: s = SkipAName(s);
5428 MesPrint(
"&Merge/shuffle should have a single function or $variable for its argument");
5432 else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
5433 numfunc += FUNCTION;
5436 else if ( type != -1 ) {
5437 if ( type != CDUBIOUS ) {
5438 NameConflict(type,s);
5439 type = MakeDubious(AC.varnames,s,&numfunc);
5444 MesPrint(
"&%s is not a function",s);
5445 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
5448 Add4Com(TYPEMERGE,numfunc,option);
5461int CoStuffle(UBYTE *inp)
5463 UBYTE *s = inp, *ss, c;
5465 WORD numfunc, option = 0;
5466 if ( tolower(s[0]) ==
'o' && tolower(s[1]) ==
'n' && tolower(s[2]) ==
'c' &&
5467 tolower(s[3]) ==
'e' && tolower(s[4]) ==
',' ) {
5470 else if ( tolower(s[0]) ==
'a' && tolower(s[1]) ==
'l' && tolower(s[2]) ==
'l' &&
5471 tolower(s[3]) ==
',' ) {
5477 if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
5480 MesPrint(
"&%s is undefined",s);
5481 numfunc = AddDollar(s+1,DOLINDEX,&one,1);
5485 if ( *ss !=
'+' && *ss !=
'-' && ss[1] != 0 ) {
5486 MesPrint(
"&Stuffle should have a single function or $variable for its argument, followed by either + or -");
5489 if ( *ss ==
'-' ) option += 2;
5491 else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
5492 numfunc += FUNCTION;
5495 else if ( type != -1 ) {
5496 if ( type != CDUBIOUS ) {
5497 NameConflict(type,s);
5498 type = MakeDubious(AC.varnames,s,&numfunc);
5503 MesPrint(
"&%s is not a function",s);
5504 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
5507 Add4Com(TYPESTUFFLE,numfunc,option);
5516int CoProcessBucket(UBYTE *s)
5519 while ( *s ==
',' || *s ==
'=' ) s++;
5521 if ( *s && *s !=
' ' && *s !=
'\t' ) {
5522 MesPrint(
"&Numerical value expected for ProcessBucketSize");
5525 AC.ProcessBucketSize = x;
5534int CoThreadBucket(UBYTE *s)
5537 while ( *s ==
',' || *s ==
'=' ) s++;
5539 if ( *s && *s !=
' ' && *s !=
'\t' ) {
5540 MesPrint(
"&Numerical value expected for ThreadBucketSize");
5544 Warning(
"Negative of zero value not allowed for ThreadBucketSize. Adjusted to 1.");
5547 AC.ThreadBucketSize = x;
5549 if ( AS.MultiThreaded ) MakeThreadBuckets(-1,1);
5564int DoArgPlode(UBYTE *s,
int par)
5567 WORD numfunc, type, error = 0, *w, n;
5573 while ( *s ==
',' ) s++;
5576 MesPrint(
"&We don't do dollar variables yet in ArgImplode/ArgExplode");
5580 if ( ( s = SkipAName(s) ) == 0 )
return(1);
5582 if ( ( type = GetName(AC.varnames,t,&numfunc,WITHAUTO) ) == CFUNCTION ) {
5583 numfunc += FUNCTION;
5585 else if ( type != -1 ) {
5586 if ( type != CDUBIOUS ) {
5587 NameConflict(type,t);
5588 type = MakeDubious(AC.varnames,t,&numfunc);
5593 MesPrint(
"&%s is not a function",t);
5594 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
5601 for ( i = 2; i < FUNHEAD; i++ ) *w++ = 0;
5603 if ( *s && *s !=
',' ) {
5604 MesPrint(
"&Illegal character in ArgImplode/ArgExplode statement: %s",s);
5607 while ( *s ==
',' ) s++;
5609 n = w - AT.WorkPointer;
5610 AT.WorkPointer[1] = n;
5620int CoArgExplode(UBYTE *s) {
return(DoArgPlode(s,TYPEARGEXPLODE)); }
5627int CoArgImplode(UBYTE *s) {
return(DoArgPlode(s,TYPEARGIMPLODE)); }
5634int CoClearTable(UBYTE *s)
5637 int j, type, error = 0;
5641 MesPrint(
"&The ClearTable statement needs at least one (table) argument.");
5648 if ( ( ( type = GetName(AC.varnames,t,&numfun,WITHAUTO) ) != CFUNCTION )
5649 && type != CDUBIOUS ) {
5650nofunc: MesPrint(
"&%s is not a table",t);
5652 if ( type < 0 ) numfun = AddFunction(t,0,0,0,0,0,-1,-1);
5654 if ( *s ==
',' ) s++;
5661 else if ( ( T = functions[numfun].tabl ) == 0 )
goto nofunc;
5664 if ( *s ==
',' ) s++;
5700 if ( TT->
mm ) M_free(TT->
mm,
"tableminmax");
5701 if ( TT->
flags ) M_free(TT->
flags,
"tableflags");
5716int CoDenominators(UBYTE *s)
5720 UBYTE *t = SkipAName(s), *t1;
5721 if ( t == 0 )
goto syntaxerror;
5722 t1 = t;
while ( *t1 ==
',' || *t1 ==
' ' || *t1 ==
'\t' ) t1++;
5723 if ( *t1 )
goto syntaxerror;
5725 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5726 || ( functions[numfun].spec != 0 ) ) {
5728 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5729 AddFunction(s,0,0,0,0,0,-1,-1);
5733 Add3Com(TYPEDENOMINATORS,numfun+FUNCTION);
5736 MesPrint(
"&Denominators statement needs one regular function for its argument");
5745int CoDropCoefficient(UBYTE *s)
5748 Add2Com(TYPEDROPCOEFFICIENT)
5751 MesPrint(
"&Illegal argument in DropCoefficient statement: '%s'",s);
5759int CoDropSymbols(UBYTE *s)
5762 Add2Com(TYPEDROPSYMBOLS)
5765 MesPrint(
"&Illegal argument in DropSymbols statement: '%s'",s);
5782int CoToPolynomial(UBYTE *inp)
5785 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5786 if ( ( AC.topolynomialflag & ~TOPOLYNOMIALFLAG ) != 0 ) {
5787 MesPrint(
"&ToPolynomial statement and FactArg statement are not allowed in the same module");
5790 if ( AO.OptimizeResult.code != NULL ) {
5791 MesPrint(
"&Using ToPolynomial statement when there are still optimization results active.");
5792 MesPrint(
"&Please use #ClearOptimize instruction first.");
5793 MesPrint(
"&This will loose the optimized expression.");
5797 Add3Com(TYPETOPOLYNOMIAL,DOALL)
5801 WORD *funnums = 0, type, num;
5804 if ( s == 0 )
return(1);
5806 if ( StrICmp(inp,(UBYTE *)
"onlyfunctions") ) {
5807 MesPrint(
"&Illegal option %s in ToPolynomial statement",inp);
5813 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5819 funnums = (WORD *)Malloc1(((LONG)(s-inp)+3)*
sizeof(WORD),
"ToPlynomial");
5822 if ( s == 0 )
return(1);
5824 type = GetName(AC.varnames,inp,&num,WITHAUTO);
5825 if ( type != CFUNCTION ) {
5826 MesPrint(
"&%s is not a function in ToPolynomial statement",inp);
5829 funnums[3+numargs++] = num+FUNCTION;
5832 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5834 funnums[0] = TYPETOPOLYNOMIAL;
5835 funnums[1] = numargs+3;
5836 funnums[2] = ONLYFUNCTIONS;
5839 if ( funnums ) M_free(funnums,
"ToPolynomial");
5841 AC.topolynomialflag |= TOPOLYNOMIALFLAG;
5844 AC.mparallelflag |= NOPARALLEL_CONVPOLY;
5857int CoFromPolynomial(UBYTE *inp)
5859 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5861 if ( AO.OptimizeResult.code != NULL ) {
5862 MesPrint(
"&Using FromPolynomial statement when there are still optimization results active.");
5863 MesPrint(
"&Please use #ClearOptimize instruction first.");
5864 MesPrint(
"&This will loose the optimized expression.");
5867 Add2Com(TYPEFROMPOLYNOMIAL)
5870 MesPrint(
"&Illegal argument in FromPolynomial statement: '%s'",inp);
5883int CoArgToExtraSymbol(UBYTE *s)
5885 CBUF *C = cbuf + AC.cbufnum;
5889 if ( ( AC.topolynomialflag & ~TOPOLYNOMIALFLAG ) != 0 ) {
5890 MesPrint(
"&ArgToExtraSymbol statement and FactArg statement are not allowed in the same module");
5893 if ( AO.OptimizeResult.code != NULL ) {
5894 MesPrint(
"&Using ArgToExtraSymbol statement when there are still optimization results active.");
5895 MesPrint(
"&Please use #ClearOptimize instruction first.");
5896 MesPrint(
"&This will loose the optimized expression.");
5901 int tonumber = ConsumeOption(&s,
"tonumber");
5903 int ret = DoArgument(s,TYPEARGTOEXTRASYMBOL);
5904 if ( ret )
return(ret);
5910 lhs = C->
lhs[C->numlhs];
5911 if ( lhs[4] != 1 ) {
5912 Warning(
"scale parameter (^n) is ignored in ArgToExtraSymbol");
5916 AC.topolynomialflag |= TOPOLYNOMIALFLAG;
5922 AC.mparallelflag |= NOPARALLEL_CONVPOLY;
5933int CoExtraSymbols(UBYTE *inp)
5935 UBYTE *arg1, *arg2, c, *s;
5936 WORD i, j, type, number;
5937 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5938 if ( FG.cTable[*inp] != 0 ) {
5939 MesPrint(
"&Illegal argument in ExtraSymbols statement: '%s'",inp);
5943 while ( FG.cTable[*inp] == 0 ) inp++;
5945 if ( ( StrICmp(arg1,(UBYTE *)
"array") == 0 )
5946 || ( StrICmp(arg1,(UBYTE *)
"vector") == 0 ) ) {
5947 AC.extrasymbols = 1;
5949 else if ( StrICmp(arg1,(UBYTE *)
"underscore") == 0 ) {
5950 AC.extrasymbols = 0;
5958 MesPrint(
"&Illegal keyword in ExtraSymbols statement: '%s'",arg1);
5962 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5963 if ( FG.cTable[*inp] != 0 ) {
5964 MesPrint(
"&Illegal argument in ExtraSymbols statement: '%s'",inp);
5968 while ( FG.cTable[*inp] <= 1 ) inp++;
5970 MesPrint(
"&Illegal end of ExtraSymbols statement: '%s'",inp);
5977 if ( AC.extrasymbols == 1 ) {
5978 type = GetName(AC.varnames,arg2,&number,NOAUTO);
5979 if ( type != NAMENOTFOUND ) {
5980 MesPrint(
"&ExtraSymbols statement: '%s' has already been declared before",arg2);
5984 else if ( AC.extrasymbols == 0 ) {
5985 if ( *arg2 ==
'N' ) {
5987 while ( FG.cTable[*s] == 1 ) s++;
5989 MesPrint(
"&ExtraSymbols statement: '%s' creates conflicts with summed indices",arg2);
5994 if ( AC.extrasym ) { M_free(AC.extrasym,
"extrasym"); AC.extrasym = 0; }
5996 AC.extrasym = (UBYTE *)Malloc1(i*
sizeof(UBYTE),
"extrasym");
5997 for ( j = 0; j < i; j++ ) AC.extrasym[j] = arg2[j];
6006WORD *GetIfDollarFactor(UBYTE **inp, WORD *w)
6012 if ( FG.cTable[*s] == 1 ) {
6014 while ( FG.cTable[*s] == 1 ) {
6015 x = 10*x + *s++ -
'0';
6016 if ( x >= MAXPOSITIVE ) {
6017 MesPrint(
"&Value in dollar factor too large");
6018 while ( FG.cTable[*s] == 1 ) s++;
6023 *w++ = IFDOLLAREXTRA;
6030 MesPrint(
"&Factor indicator for $-variable should be a number or a $-variable.");
6034 while ( FG.cTable[*s] < 2 ) s++;
6036 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
6037 MesPrint(
"&dollar in if statement should have been defined previously");
6041 *w++ = IFDOLLAREXTRA;
6047 if ( ( w = GetIfDollarFactor(inp,w) ) == 0 )
return(0);
6050 MesPrint(
"&unmatched [] in $ in if statement");
6064UBYTE *GetDoParam(UBYTE *inp, WORD **wp,
int par)
6069 if ( FG.cTable[*inp] == 1 ) {
6071 while ( *inp >=
'0' && *inp <=
'9' ) {
6072 x = 10*x + *inp++ -
'0';
6073 if ( x > MAXPOSITIVE ) {
6075 MesPrint(
"&Value in dollar factor too large");
6078 MesPrint(
"&Value in do loop boundaries too large");
6080 while ( FG.cTable[*inp] == 1 ) inp++;
6089 *(*wp)++ = DOLLAREXPR2;
6090 *(*wp)++ = -((WORD)x)-1;
6094 if ( *inp !=
'$' ) {
6098 while ( FG.cTable[*inp] < 2 ) inp++;
6100 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
6102 MesPrint(
"&dollar in print statement should have been defined previously");
6105 MesPrint(
"&dollar in do loop boundaries should have been defined previously");
6111 *(*wp)++ = DOLLAREXPRESSION;
6115 *(*wp)++ = DOLLAREXPR2;
6120 inp = GetDoParam(inp,wp,0);
6121 if ( inp == 0 )
return(0);
6122 if ( *inp !=
']' ) {
6124 MesPrint(
"&unmatched [] in $ in print statement");
6127 MesPrint(
"&unmatched [] in do loop boundaries");
6144 CBUF *C = cbuf+AC.cbufnum;
6148 if ( AC.doloopstack == 0 ) {
6149 AC.doloopstacksize = 20;
6150 AC.doloopstack = (WORD *)Malloc1(AC.doloopstacksize*2*
sizeof(WORD),
"doloop stack");
6151 AC.doloopnest = AC.doloopstack + AC.doloopstacksize;
6153 if ( AC.dolooplevel >= AC.doloopstacksize ) {
6154 WORD *newstack, *newnest, newsize;
6155 newsize = AC.doloopstacksize * 2;
6156 newstack = (WORD *)Malloc1(newsize*2*
sizeof(WORD),
"doloop stack");
6157 newnest = newstack + newsize;
6158 for ( i = 0; i < newsize; i++ ) {
6159 newstack[i] = AC.doloopstack[i];
6160 newnest[i] = AC.doloopnest[i];
6162 M_free(AC.doloopstack,
"doloop stack");
6163 AC.doloopstack = newstack;
6164 AC.doloopnest = newnest;
6165 AC.doloopstacksize = newsize;
6167 AC.doloopnest[AC.dolooplevel] = NestingChecksum();
6175 while ( *inp ==
',' ) inp++;
6176 if ( *inp !=
'$' ) {
6178 MesPrint(
"&do loop parameter should be a dollar variable");
6183 if ( FG.cTable[*inp] != 0 ) {
6185 MesPrint(
"&illegal name for do loop parameter");
6187 while ( FG.cTable[*inp] < 2 ) inp++;
6189 if ( GetName(AC.dollarnames,name,&numparam,NOAUTO) == NAMENOTFOUND ) {
6190 numparam = AddDollar(name,DOLUNDEFINED,0,0);
6197 while ( *inp ==
',' ) inp++;
6198 if ( *inp !=
'=' )
goto IllSyntax;
6200 while ( *inp ==
',' ) inp++;
6204 inp = GetDoParam(inp,&w,1);
6205 if ( inp == 0 || *inp !=
',' )
goto IllSyntax;
6206 while ( *inp ==
',' ) inp++;
6210 inp = GetDoParam(inp,&w,1);
6211 if ( inp == 0 || ( *inp != 0 && *inp !=
',' ) )
goto IllSyntax;
6215 if ( *inp !=
',' ) {
6216 if ( *inp == 0 ) { *w++ = SNUMBER; *w++ = 1; }
6217 else goto IllSyntax;
6220 while ( *inp ==
',' ) inp++;
6221 inp = GetDoParam(inp,&w,1);
6223 if ( inp == 0 || *inp != 0 )
goto IllSyntax;
6225 AT.WorkPointer[1] = w - AT.WorkPointer;
6229 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
6230 AC.doloopstack[AC.dolooplevel++] = C->numlhs;
6235 MesPrint(
"&Illegal syntax for do statement");
6244int CoEndDo(UBYTE *inp)
6246 CBUF *C = cbuf+AC.cbufnum;
6248 while ( *inp ==
',' ) inp++;
6250 MesPrint(
"&Illegal syntax for EndDo statement");
6253 if ( AC.dolooplevel <= 0 ) {
6254 MesPrint(
"&EndDo without corresponding Do statement");
6258 scratch[0] = TYPEENDDOLOOP;
6260 scratch[2] = AC.doloopstack[AC.dolooplevel];
6262 cbuf[AC.cbufnum].lhs[AC.doloopstack[AC.dolooplevel]][3] = C->numlhs;
6263 if ( AC.doloopnest[AC.dolooplevel] != NestingChecksum() ) {
6275int CoFactDollar(UBYTE *inp)
6278 if ( *inp ==
'$' ) {
6279 if ( GetName(AC.dollarnames,inp+1,&numdollar,NOAUTO) != CDOLLAR ) {
6280 MesPrint(
"&%s is undefined",inp);
6281 numdollar = AddDollar(inp+1,DOLINDEX,&one,1);
6284 inp = SkipAName(inp+1);
6286 MesPrint(
"&FactDollar should have a single $variable for its argument");
6292 MesPrint(
"&%s is not a $-variable",inp);
6295 Add3Com(TYPEFACTOR,numdollar);
6304int CoFactorize(UBYTE *s) {
return(DoFactorize(s,1)); }
6311int CoNFactorize(UBYTE *s) {
return(DoFactorize(s,0)); }
6318int CoUnFactorize(UBYTE *s) {
return(DoFactorize(s,3)); }
6325int CoNUnFactorize(UBYTE *s) {
return(DoFactorize(s,2)); }
6332int DoFactorize(UBYTE *s,
int par)
6338 int error = 0, keepzeroflag = 0;
6341 while ( *s !=
')' && *s ) {
6342 if ( FG.cTable[*s] == 0 ) {
6343 t = s;
while ( FG.cTable[*s] == 0 ) s++;
6345 if ( StrICmp((UBYTE *)
"keepzero",t) == 0 ) {
6349 MesPrint(
"&Illegal option in [N][Un]Factorize statement: %s",t);
6354 while ( *s ==
',' ) s++;
6355 if ( *s && *s !=
')' && FG.cTable[*s] != 0 ) {
6356 MesPrint(
"&Illegal character in option field of [N][Un]Factorize statement");
6362 while ( *s ==
',' || *s ==
' ' ) s++;
6365 for ( i = NumExpressions-1; i >= 0; i-- ) {
6367 if ( e->replace >= 0 ) {
6368 e = Expressions + e->replace;
6370 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
6371 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
6372 || e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION
6376 e->vflags &= ~TOBEFACTORED;
6379 e->vflags |= TOBEFACTORED;
6380 e->vflags &= ~TOBEUNFACTORED;
6383 e->vflags &= ~TOBEUNFACTORED;
6386 e->vflags |= TOBEUNFACTORED;
6387 e->vflags &= ~TOBEFACTORED;
6391 if ( ( e->vflags & TOBEFACTORED ) != 0 ) {
6392 if ( keepzeroflag ) e->vflags |= KEEPZERO;
6393 else e->vflags &= ~KEEPZERO;
6395 else e->vflags &= ~KEEPZERO;
6400 while ( *s ==
',' ) s++;
6401 if ( *s == 0 )
break;
6402 if ( *s ==
'[' || FG.cTable[*s] == 0 ) {
6404 if ( ( s = SkipAName(s) ) == 0 ) {
6405 MesPrint(
"&Improper name for an expression: '%s'",t);
6409 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
6410 e = Expressions+number;
6411 if ( e->replace >= 0 ) {
6412 e = Expressions + e->replace;
6414 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
6415 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
6416 || e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION
6420 e->vflags &= ~TOBEFACTORED;
6423 e->vflags |= TOBEFACTORED;
6424 e->vflags &= ~TOBEUNFACTORED;
6427 e->vflags &= ~TOBEUNFACTORED;
6430 e->vflags |= TOBEUNFACTORED;
6431 e->vflags &= ~TOBEFACTORED;
6435 if ( ( e->vflags & TOBEFACTORED ) != 0 ) {
6436 if ( keepzeroflag ) e->vflags |= KEEPZERO;
6437 else e->vflags &= ~KEEPZERO;
6439 else e->vflags &= ~KEEPZERO;
6441 else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
6442 MesPrint(
"&%s is not an expression",t);
6448 MesPrint(
"&Illegal object in (N)Factorize statement");
6450 while ( *s && *s !=
',' ) s++;
6451 if ( *s == 0 )
break;
6465int CoOptimizeOption(UBYTE *s)
6467 UBYTE *name, *t1, *t2, c1, c2, *value, *u;
6470 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
6472 name = s;
while ( FG.cTable[*s] == 0 ) s++;
6474 while ( *s ==
' ' || *s ==
'\t' ) s++;
6477 MesPrint(
"&Correct use in Format,Optimize statement is Optionname=value");
6479 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' || *s ==
'=' ) s++;
6485 while ( *s ==
' ' || *s ==
'\t' ) s++;
6486 if ( *s == 0 )
goto correctuse;
6488 while ( FG.cTable[*s] <= 1 || *s==
'.' || *s==
'*' || *s ==
'(' || *s ==
')' ) {
6489 if ( *s ==
'(' ) { SKIPBRA4(s) }
6493 while ( *s ==
' ' || *s ==
'\t' ) s++;
6494 if ( *s && *s !=
',' )
goto correctuse;
6497 while ( *s ==
' ' || *s ==
'\t' ) s++;
6503 if ( StrICmp(name,(UBYTE *)
"horner") == 0 ) {
6504 if ( StrICmp(value,(UBYTE *)
"occurrence") == 0 ) {
6505 AO.Optimize.horner = O_OCCURRENCE;
6507 else if ( StrICmp(value,(UBYTE *)
"mcts") == 0 ) {
6508 AO.Optimize.horner = O_MCTS;
6510 else if ( StrICmp(value,(UBYTE *)
"sa") == 0 ) {
6511 AO.Optimize.horner = O_SIMULATED_ANNEALING;
6514 AO.Optimize.horner = -1;
6515 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6519 else if ( StrICmp(name,(UBYTE *)
"hornerdirection") == 0 ) {
6520 if ( StrICmp(value,(UBYTE *)
"forward") == 0 ) {
6521 AO.Optimize.hornerdirection = O_FORWARD;
6523 else if ( StrICmp(value,(UBYTE *)
"backward") == 0 ) {
6524 AO.Optimize.hornerdirection = O_BACKWARD;
6526 else if ( StrICmp(value,(UBYTE *)
"forwardorbackward") == 0 ) {
6527 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
6529 else if ( StrICmp(value,(UBYTE *)
"forwardandbackward") == 0 ) {
6530 AO.Optimize.hornerdirection = O_FORWARDANDBACKWARD;
6533 AO.Optimize.method = -1;
6534 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6538 else if ( StrICmp(name,(UBYTE *)
"method") == 0 ) {
6539 if ( StrICmp(value,(UBYTE *)
"none") == 0 ) {
6540 AO.Optimize.method = O_NONE;
6542 else if ( StrICmp(value,(UBYTE *)
"cse") == 0 ) {
6543 AO.Optimize.method = O_CSE;
6545 else if ( StrICmp(value,(UBYTE *)
"csegreedy") == 0 ) {
6546 AO.Optimize.method = O_CSEGREEDY;
6548 else if ( StrICmp(value,(UBYTE *)
"greedy") == 0 ) {
6549 AO.Optimize.method = O_GREEDY;
6552 AO.Optimize.method = -1;
6553 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6557 else if ( StrICmp(name,(UBYTE *)
"timelimit") == 0 ) {
6559 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6561 MesPrint(
"&Option TimeLimit in Format,Optimize statement should be a positive number: %s",value);
6562 AO.Optimize.mctstimelimit = 0;
6563 AO.Optimize.greedytimelimit = 0;
6567 AO.Optimize.mctstimelimit = x/2;
6568 AO.Optimize.greedytimelimit = x/2;
6571 else if ( StrICmp(name,(UBYTE *)
"mctstimelimit") == 0 ) {
6573 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6575 MesPrint(
"&Option MCTSTimeLimit in Format,Optimize statement should be a positive number: %s",value);
6576 AO.Optimize.mctstimelimit = 0;
6580 AO.Optimize.mctstimelimit = x;
6583 else if ( StrICmp(name,(UBYTE *)
"mctsnumexpand") == 0 ) {
6586 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6587 if ( *u ==
'*' || *u ==
'x' || *u ==
'X' ) {
6590 while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6594 MesPrint(
"&Option MCTSNumExpand in Format,Optimize statement should be a positive number: %s",value);
6595 AO.Optimize.mctsnumexpand= 0;
6596 AO.Optimize.mctsnumrepeat= 1;
6600 AO.Optimize.mctsnumexpand= x;
6601 AO.Optimize.mctsnumrepeat= y;
6604 else if ( StrICmp(name,(UBYTE *)
"mctsnumrepeat") == 0 ) {
6606 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6608 MesPrint(
"&Option MCTSNumExpand in Format,Optimize statement should be a positive number: %s",value);
6609 AO.Optimize.mctsnumrepeat= 1;
6613 AO.Optimize.mctsnumrepeat= x;
6616 else if ( StrICmp(name,(UBYTE *)
"mctsnumkeep") == 0 ) {
6618 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6620 MesPrint(
"&Option MCTSNumKeep in Format,Optimize statement should be a positive number: %s",value);
6621 AO.Optimize.mctsnumkeep= 0;
6625 AO.Optimize.mctsnumkeep= x;
6628 else if ( StrICmp(name,(UBYTE *)
"mctsconstant") == 0 ) {
6630 if ( sscanf ((
char*)value,
"%lf", &d) != 1 ) {
6631 MesPrint(
"&Option MCTSConstant in Format,Optimize statement should be a positive number: %s",value);
6632 AO.Optimize.mctsconstant.fval = 0;
6636 AO.Optimize.mctsconstant.fval = d;
6639 else if ( StrICmp(name,(UBYTE *)
"greedytimelimit") == 0 ) {
6641 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6643 MesPrint(
"&Option GreedyTimeLimit in Format,Optimize statement should be a positive number: %s",value);
6644 AO.Optimize.greedytimelimit = 0;
6648 AO.Optimize.greedytimelimit = x;
6651 else if ( StrICmp(name,(UBYTE *)
"greedyminnum") == 0 ) {
6653 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6655 MesPrint(
"&Option GreedyMinNum in Format,Optimize statement should be a positive number: %s",value);
6656 AO.Optimize.greedyminnum= 0;
6660 AO.Optimize.greedyminnum= x;
6663 else if ( StrICmp(name,(UBYTE *)
"greedymaxperc") == 0 ) {
6665 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6667 MesPrint(
"&Option GreedyMaxPerc in Format,Optimize statement should be a positive number: %s",value);
6668 AO.Optimize.greedymaxperc= 0;
6672 AO.Optimize.greedymaxperc= x;
6675 else if ( StrICmp(name,(UBYTE *)
"stats") == 0 ) {
6676 if ( StrICmp(value,(UBYTE *)
"on") == 0 ) {
6677 AO.Optimize.printstats = 1;
6679 else if ( StrICmp(value,(UBYTE *)
"off") == 0 ) {
6680 AO.Optimize.printstats = 0;
6683 AO.Optimize.printstats = 0;
6684 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6688 else if ( StrICmp(name,(UBYTE *)
"printscheme") == 0 ) {
6689 if ( StrICmp(value,(UBYTE *)
"on") == 0 ) {
6690 AO.Optimize.schemeflags |= 1;
6692 else if ( StrICmp(value,(UBYTE *)
"off") == 0 ) {
6693 AO.Optimize.schemeflags &= ~1;
6696 AO.Optimize.schemeflags &= ~1;
6697 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6701 else if ( StrICmp(name,(UBYTE *)
"debugflag") == 0 ) {
6709 if ( FG.cTable[*u] == 1 ) {
6710 while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6712 MesPrint(
"&Numerical value for DebugFlag in Format,Optimize statement should be a nonnegative number: %s",value);
6713 AO.Optimize.debugflags = 0;
6717 AO.Optimize.debugflags = x;
6720 else if ( StrICmp(value,(UBYTE *)
"on") == 0 ) {
6721 AO.Optimize.debugflags = 1;
6723 else if ( StrICmp(value,(UBYTE *)
"off") == 0 ) {
6724 AO.Optimize.debugflags = 0;
6727 AO.Optimize.debugflags = 0;
6728 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6732 else if ( StrICmp(name,(UBYTE *)
"scheme") == 0 ) {
6739 MesPrint(
"&Option Scheme in Format,Optimize statement should be an array of names or integers between (): %s",value);
6744 while ( *ss ==
' ' || *ss ==
'\t' || *ss ==
',' ) ss++;
6745 if ( FG.cTable[*ss] == 0 || *ss ==
'$' || *ss ==
'[' ) {
6746 s1 = u; SKIPBRA3(s1)
6747 if ( *s1 !=
')' )
goto noscheme;
6748 while ( ss < s1 ) {
if ( *ss++ ==
',' ) AO.schemenum++; }
6749 *ss++ = 0;
while ( *ss ==
' ' ) ss++;
6750 if ( *ss != 0 )
goto noscheme;
6752 if ( AO.schemenum < 1 ) {
6753 MesPrint(
"&Option Scheme in Format,Optimize statement should have at least one name or number between ()");
6757 if ( AO.inscheme ) M_free(AO.inscheme,
"Horner input scheme");
6758 AO.inscheme = (WORD *)Malloc1((AO.schemenum+1)*
sizeof(WORD),
"Horner input scheme");
6759 while ( *ss ==
' ' || *ss ==
'\t' || *ss ==
',' ) ss++;
6762 if ( *ss == 0 )
break;
6763 s1 = ss; ss = SkipAName(s1); c = *ss; *ss = 0;
6765 if ( ss[-1] ==
'_' ) {
6770 u1 = s1; u2 = AC.extrasym;
6771 while ( *u1 == *u2 ) { u1++; u2++; }
6774 while ( *u1 >=
'0' && *u1 <=
'9' ) numsym = 10*numsym + *u1++ -
'0';
6775 if ( u1 != ss-1 || numsym == 0 || AC.extrasymbols != 0 ) {
6776 MesPrint(
"&Improper use of extra symbol in scheme format option");
6779 numsym = MAXVARIABLES-numsym;
6784 else if ( *s1 ==
'$' ) {
6787 if ( ( numdollar = GetDollar(s1+1) ) < 0 ) {
6788 MesPrint(
"&Undefined variable %s",s1);
6791 else if ( ( numsym = DolToSymbol(BHEAD numdollar) ) < 0 ) {
6792 MesPrint(
"&$%s does not evaluate to a symbol",s1);
6798 else if ( c ==
'(' ) {
6799 if ( StrCmp(s1,AC.extrasym) == 0 ) {
6800 if ( (AC.extrasymbols&1) != 1 ) {
6801 MesPrint(
"&Improper use of extra symbol in scheme format option");
6806 while ( *ss >=
'0' && *ss <=
'9' ) numsym = 10*numsym + *ss++ -
'0';
6808 MesPrint(
"&Extra symbol should have a number for its argument.");
6811 numsym = MAXVARIABLES-numsym;
6816 type = GetName(AC.varnames,s1,&numsym,WITHAUTO);
6817 if ( ( type != CSYMBOL ) && type != CDUBIOUS ) {
6818 MesPrint(
"&%s is not a symbol",s1);
6820 if ( type < 0 ) numsym = AddSymbol(s1,-MAXPOWER,MAXPOWER,0,0);
6824 AO.inscheme[AO.schemenum++] = numsym;
6825 while ( *ss ==
' ' || *ss ==
'\t' || *ss ==
',' ) ss++;
6829 else if ( StrICmp(name,(UBYTE *)
"mctsdecaymode") == 0 ) {
6832 if ( FG.cTable[*u] == 1 ) {
6833 while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6835 MesPrint(
"&Option MCTSDecayMode in Format,Optimize statement should be a nonnegative integer: %s",value);
6836 AO.Optimize.mctsdecaymode = 0;
6840 AO.Optimize.mctsdecaymode = x;
6844 AO.Optimize.mctsdecaymode = 0;
6845 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6849 else if ( StrICmp(name,(UBYTE *)
"saiter") == 0 ) {
6851 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6853 MesPrint(
"&Option SAIter in Format,Optimize statement should be a positive integer: %s",value);
6854 AO.Optimize.saIter = 0;
6858 AO.Optimize.saIter= x;
6861 else if ( StrICmp(name,(UBYTE *)
"samaxt") == 0 ) {
6863 if ( sscanf ((
char*)value,
"%lf", &d) != 1 ) {
6864 MesPrint(
"&Option SAMaxT in Format,Optimize statement should be a positive number: %s",value);
6865 AO.Optimize.saMaxT.fval = 0;
6869 AO.Optimize.saMaxT.fval = d;
6872 else if ( StrICmp(name,(UBYTE *)
"samint") == 0 ) {
6874 if ( sscanf ((
char*)value,
"%lf", &d) != 1 ) {
6875 MesPrint(
"&Option SAMinT in Format,Optimize statement should be a positive number: %s",value);
6876 AO.Optimize.saMinT.fval = 0;
6880 AO.Optimize.saMinT.fval = d;
6884 MesPrint(
"&Unrecognized option name in Format,Optimize statement: %s",name);
6901int CoPutInside(UBYTE *inp) {
return(DoPutInside(inp,1)); }
6902int CoAntiPutInside(UBYTE *inp) {
return(DoPutInside(inp,-1)); }
6904int DoPutInside(UBYTE *inp,
int par)
6908 WORD *to, type, c1,c2,funnum, *WorkSave;
6910 while ( *inp ==
' ' || *inp ==
'\t' || *inp ==
',' ) inp++;
6915 if ( p == 0 )
return(1);
6917 type = GetName(AC.varnames,inp,&funnum,WITHAUTO);
6918 if ( type != CFUNCTION || functions[funnum].tabl != 0 || functions[funnum].spec ) {
6919 MesPrint(
"&PutInside/AntiPutInside expects a regular function for its first argument");
6920 MesPrint(
"&Argument is %s",inp);
6926 while ( *inp ==
' ' || *inp ==
'\t' || *inp ==
',' ) inp++;
6930 tocompiler[0] = TYPEPUTINSIDE;
6933 tocompiler[3] = funnum;
6937 MesPrint(
"&AntiPutInside needs inside information.");
6942 WorkSave = to = AT.WorkPointer;
6943 *to++ = TYPEPUTINSIDE;
6949 while ( *inp ==
' ' || *inp ==
'\t' || *inp ==
',' ) inp++;
6950 if ( *inp == 0 )
break;
6952 if ( p == 0 ) { error = 1;
break; }
6954 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
6956 if ( type == CVECTOR || type == CDUBIOUS ) {
6960 if ( p == 0 )
return(1);
6962 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
6963 if ( type != CVECTOR && type != CDUBIOUS ) {
6964 MesPrint(
"&Not a vector in dotproduct in PutInside/AntiPutInside statement: %s",inp);
6967 else type = CDOTPRODUCT;
6970 MesPrint(
"&Illegal use of . after %s in PutInside/AntiPutInside statement",inp);
6978 *to++ = SYMBOL; *to++ = 4; *to++ = c1; *to++ = 1;
break;
6980 *to++ = INDEX; *to++ = 3; *to++ = AM.OffsetVector + c1;
break;
6982 *to++ = c1+FUNCTION; *to++ = FUNHEAD; *to++ = 0;
6986 *to++ = DOTPRODUCT; *to++ = 5; *to++ = c1 + AM.OffsetVector;
6987 *to++ = c2 + AM.OffsetVector; *to++ = 1;
break;
6989 *to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX;
break;
6991 MesPrint(
"&Illegal variable request for %s in PutInside/AntiPutInside statement",inp);
6997 *to++ = 1; *to++ = 1; *to++ = 3;
6998 AT.WorkPointer[1] = to - AT.WorkPointer;
6999 AT.WorkPointer[4] = AT.WorkPointer[1]-4;
7000 AT.WorkPointer = to;
7001 AC.BracketNormalize = 1;
7002 if ( Normalize(BHEAD WorkSave+4) ) { error = 1; }
7004 WorkSave[1] = WorkSave[4]+4;
7005 to = WorkSave + WorkSave[1] - 1;
7009 AddNtoL(WorkSave[1],WorkSave);
7011 AC.BracketNormalize = 0;
7012 AT.WorkPointer = WorkSave;
7024int CoSwitch(UBYTE *s)
7029 if ( GetName(AC.dollarnames,s+1,&numdollar,NOAUTO) != CDOLLAR ) {
7030 MesPrint(
"&%s is undefined in switch statement",s);
7031 numdollar = AddDollar(s+1,DOLINDEX,&one,1);
7036 MesPrint(
"&Switch should have a single $variable for its argument");
7042 MesPrint(
"&%s is not a $-variable in switch statement",s);
7051 if ( AC.SwitchInArray >= AC.MaxSwitch ) DoubleSwitchBuffers();
7052 AC.SwitchHeap[AC.SwitchLevel] = AC.SwitchInArray;
7053 sw = AC.SwitchArray + AC.SwitchInArray;
7055 sw->iflevel = AC.IfLevel;
7056 sw->whilelevel = AC.WhileLevel;
7057 sw->nestingsum = NestingChecksum();
7059 Add4Com(TYPESWITCH,numdollar,AC.SwitchInArray);
7072 SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
7073 WORD x = 0, sign = 1;
7074 while ( *s ==
',' ) s++;
7076 while ( *s ==
'-' || *s ==
'+' ) {
7077 if ( *s ==
'-' ) sign = -sign;
7080 while ( FG.cTable[*s] == 1 ) { x = 10*x + *s++ -
'0'; }
7083 if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
7084 || sw->nestingsum != NestingChecksum() ) {
7085 MesPrint(
"&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
7091 if ( sw->numcases >= sw->tablesize ) {
7095 if ( sw->tablesize == 0 ) newsize = 10;
7096 else newsize = 2*sw->tablesize;
7099 for ( i = 0; i < sw->tablesize; i++ ) newtable[i] = sw->table[i];
7100 M_free(sw->table,
"Switch table");
7102 sw->table = newtable;
7103 sw->tablesize = newsize;
7105 if ( sw->numcases == 0 ) { sw->mincase = sw->maxcase = x; }
7106 else if ( x > sw->maxcase ) sw->maxcase = x;
7107 else if ( x < sw->mincase ) sw->mincase = x;
7108 sw->table[sw->numcases].ncase = x;
7109 sw->table[sw->numcases].value = cbuf[AC.cbufnum].numlhs;
7110 sw->table[sw->numcases].compbuffer = AC.cbufnum;
7120int CoBreak(UBYTE *s)
7127 SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
7128 if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
7129 || sw->nestingsum != NestingChecksum() ) {
7130 MesPrint(
"&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
7134 MesPrint(
"&No parameters allowed in Break statement");
7137 Add3Com(TYPEENDSWITCH,AC.SwitchHeap[AC.SwitchLevel]);
7146int CoDefault(UBYTE *s)
7152 SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
7153 if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
7154 || sw->nestingsum != NestingChecksum() ) {
7155 MesPrint(
"&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
7159 MesPrint(
"&No parameters allowed in Default statement");
7162 sw->defaultcase.ncase = 0;
7163 sw->defaultcase.value = cbuf[AC.cbufnum].numlhs;
7164 sw->defaultcase.compbuffer = AC.cbufnum;
7173int CoEndSwitch(UBYTE *s)
7182 SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
7184 WORD totcases = sw->maxcase-sw->mincase+1;
7185 while ( *s ==
',' ) s++;
7188 MesPrint(
"&No parameters allowed in EndSwitch statement");
7191 if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
7192 || sw->nestingsum != NestingChecksum() ) {
7193 MesPrint(
"&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
7196 if ( sw->defaultcase.value == 0 ) CoDefault(s);
7197 if ( totcases > sw->numcases*AM.jumpratio ) {
7199 sw->typetable = SPARSETABLE;
7203 SwitchSplitMerge(sw->table,sw->numcases);
7207 sw->caseoffset = sw->mincase;
7208 sw->typetable = DENSETABLE;
7210 for ( i = 0; i < totcases; i++ ) {
7211 ntable[i].ncase = i+sw->caseoffset;
7212 ntable[i].value = sw->defaultcase.value;
7213 ntable[i].compbuffer = sw->defaultcase.compbuffer;
7215 for ( i = 0; i < sw->numcases; i++ ) {
7216 ntable[sw->table[i].ncase-sw->caseoffset] = sw->table[i];
7218 M_free(sw->table,
"Switch table");
7220 sw->numcases = totcases;
7222 sw->endswitch.ncase = 0;
7223 sw->endswitch.value = cbuf[AC.cbufnum].numlhs;
7224 sw->endswitch.compbuffer = AC.cbufnum;
7225 if ( sw->defaultcase.value == 0 ) {
7226 sw->defaultcase = sw->endswitch;
7228 Add3Com(TYPEENDSWITCH,AC.SwitchHeap[AC.SwitchLevel]);
void AddPotModdollar(WORD)
LONG EndSort(PHEAD WORD *, int)
WORD Generator(PHEAD WORD *, WORD)