43 static KEYWORD formatoptions[] = {
44 {
"c", (TFUN)0, CMODE, 0}
45 ,{
"doublefortran", (TFUN)0, DOUBLEFORTRANMODE, 0}
46 ,{
"float", (TFUN)0, 0, 2}
47 ,{
"fortran", (TFUN)0, FORTRANMODE, 0}
48 ,{
"fortran90", (TFUN)0, FORTRANMODE, 4}
49 ,{
"maple", (TFUN)0, MAPLEMODE, 0}
50 ,{
"mathematica", (TFUN)0, MATHEMATICAMODE, 0}
51 ,{
"normal", (TFUN)0, NORMALFORMAT, 1}
52 ,{
"nospaces", (TFUN)0, NOSPACEFORMAT, 3}
53 ,{
"pfortran", (TFUN)0, PFORTRANMODE, 0}
54 ,{
"quadfortran", (TFUN)0, QUADRUPLEFORTRANMODE, 0}
55 ,{
"quadruplefortran", (TFUN)0, QUADRUPLEFORTRANMODE, 0}
56 ,{
"rational", (TFUN)0, RATIONALMODE, 1}
57 ,{
"reduce", (TFUN)0, REDUCEMODE, 0}
58 ,{
"spaces", (TFUN)0, NORMALFORMAT, 3}
59 ,{
"vortran", (TFUN)0, VORTRANMODE, 0}
62 static KEYWORD trace4options[] = {
63 {
"contract", (TFUN)0, CHISHOLM, 0 }
64 ,{
"nocontract", (TFUN)0, 0, CHISHOLM }
65 ,{
"nosymmetrize",(TFUN)0, 0, ALSOREVERSE}
66 ,{
"notrick", (TFUN)0, NOTRICK, 0 }
67 ,{
"symmetrize", (TFUN)0, ALSOREVERSE, 0 }
68 ,{
"trick", (TFUN)0, 0, NOTRICK }
71 static KEYWORD chisoptions[] = {
72 {
"nosymmetrize",(TFUN)0, 0, ALSOREVERSE}
73 ,{
"symmetrize", (TFUN)0, ALSOREVERSE, 0 }
76 static KEYWORD writeoptions[] = {
77 {
"stats", (TFUN)&(AC.StatsFlag), 1, 0}
78 ,{
"statistics", (TFUN)&(AC.StatsFlag), 1, 0}
79 ,{
"shortstats", (TFUN)&(AC.ShortStats), 1, 0}
80 ,{
"shortstatistics",(TFUN)&(AC.ShortStats), 1, 0}
81 ,{
"warnings", (TFUN)&(AC.WarnFlag), 1, 0}
82 ,{
"allwarnings", (TFUN)&(AC.WarnFlag), 2, 0}
83 ,{
"setup", (TFUN)&(AC.SetupFlag), 1, 0}
84 ,{
"names", (TFUN)&(AC.NamesFlag), 1, 0}
85 ,{
"allnames", (TFUN)&(AC.NamesFlag), 2, 0}
86 ,{
"codes", (TFUN)&(AC.CodesFlag), 1, 0}
87 ,{
"highfirst", (TFUN)&(AC.SortType), SORTHIGHFIRST, SORTLOWFIRST}
88 ,{
"lowfirst", (TFUN)&(AC.SortType), SORTLOWFIRST, SORTHIGHFIRST}
89 ,{
"powerfirst", (TFUN)&(AC.SortType), SORTPOWERFIRST, SORTHIGHFIRST}
90 ,{
"tokens", (TFUN)&(AC.TokensWriteFlag),1, 0}
93 static KEYWORD onoffoptions[] = {
94 {
"compress", (TFUN)&(AC.NoCompress), 0, 1}
95 ,{
"checkpoint", (TFUN)&(AC.CheckpointFlag), 1, 0}
96 ,{
"insidefirst", (TFUN)&(AC.insidefirst), 1, 0}
97 ,{
"propercount", (TFUN)&(AC.BottomLevel), 1, 0}
98 ,{
"stats", (TFUN)&(AC.StatsFlag), 1, 0}
99 ,{
"statistics", (TFUN)&(AC.StatsFlag), 1, 0}
100 ,{
"shortstats", (TFUN)&(AC.ShortStats), 1, 0}
101 ,{
"shortstatistics",(TFUN)&(AC.ShortStats), 1, 0}
102 ,{
"names", (TFUN)&(AC.NamesFlag), 1, 0}
103 ,{
"allnames", (TFUN)&(AC.NamesFlag), 2, 0}
104 ,{
"warnings", (TFUN)&(AC.WarnFlag), 1, 0}
105 ,{
"allwarnings", (TFUN)&(AC.WarnFlag), 2, 0}
106 ,{
"highfirst", (TFUN)&(AC.SortType), SORTHIGHFIRST, SORTLOWFIRST}
107 ,{
"lowfirst", (TFUN)&(AC.SortType), SORTLOWFIRST, SORTHIGHFIRST}
108 ,{
"powerfirst", (TFUN)&(AC.SortType), SORTPOWERFIRST, SORTHIGHFIRST}
109 ,{
"setup", (TFUN)&(AC.SetupFlag), 1, 0}
110 ,{
"codes", (TFUN)&(AC.CodesFlag), 1, 0}
111 ,{
"tokens", (TFUN)&(AC.TokensWriteFlag),1,0}
112 ,{
"properorder", (TFUN)&(AC.properorderflag),1,0}
113 ,{
"threadloadbalancing",(TFUN)&(AC.ThreadBalancing),1, 0}
114 ,{
"threads", (TFUN)&(AC.ThreadsFlag),1, 0}
115 ,{
"threadsortfilesynch",(TFUN)&(AC.ThreadSortFileSynch),1, 0}
116 ,{
"threadstats", (TFUN)&(AC.ThreadStats),1, 0}
117 ,{
"finalstats", (TFUN)&(AC.FinalStats),1, 0}
118 ,{
"fewerstats", (TFUN)&(AC.ShortStatsMax), 10, 0}
119 ,{
"fewerstatistics",(TFUN)&(AC.ShortStatsMax), 10, 0}
120 ,{
"processstats", (TFUN)&(AC.ProcessStats),1, 0}
121 ,{
"oldparallelstats",(TFUN)&(AC.OldParallelStats),1,0}
122 ,{
"parallel", (TFUN)&(AC.parallelflag),PARALLELFLAG,NOPARALLEL_USER}
123 ,{
"nospacesinnumbers",(TFUN)&(AO.NoSpacesInNumbers),1,0}
124 ,{
"indentspace", (TFUN)&(AO.IndentSpace),INDENTSPACE,0}
125 ,{
"totalsize", (TFUN)&(AM.PrintTotalSize), 1, 0}
126 ,{
"flag", (TFUN)&(AC.debugFlags), 1, 0}
127 ,{
"oldfactarg", (TFUN)&(AC.OldFactArgFlag), 1, 0}
128 ,{
"memdebugflag", (TFUN)&(AC.MemDebugFlag), 1, 0}
129 ,{
"oldgcd", (TFUN)&(AC.OldGCDflag), 1, 0}
130 ,{
"innertest", (TFUN)&(AC.InnerTest), 1, 0}
131 ,{
"wtimestats", (TFUN)&(AC.WTimeStatsFlag), 1, 0}
143 int CoCollect(UBYTE *s)
148 UBYTE *t = SkipAName(s), *t1, *t2;
149 AC.AltCollectFun = 0;
150 if ( t == 0 )
goto syntaxerror;
151 t1 = t;
while ( *t1 ==
',' || *t1 ==
' ' || *t1 ==
'\t' ) t1++;
153 if ( *t1 && ( FG.cTable[*t1] == 0 || *t1 ==
'[' ) ) {
155 if ( t2 == 0 )
goto syntaxerror;
157 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
161 if ( *t && FG.cTable[*t] == 1 ) {
162 while ( *t >=
'0' && *t <=
'9' ) x = 10*x + *t++ -
'0';
163 if ( x > 100 ) x = 100;
164 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
165 if ( *t )
goto syntaxerror;
168 if ( *t )
goto syntaxerror;
171 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
172 || ( functions[numfun].spec != 0 ) ) {
173 MesPrint(
"&%s should be a regular function",s);
175 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
176 AddFunction(s,0,0,0,0,0,-1,-1);
180 AC.CollectFun = numfun+FUNCTION;
181 AC.CollectPercentage = (WORD)x;
183 if ( ( ( type = GetName(AC.varnames,t1,&numfun,WITHAUTO) ) != CFUNCTION )
184 || ( functions[numfun].spec != 0 ) ) {
185 MesPrint(
"&%s should be a regular function",t1);
187 if ( GetName(AC.exprnames,t1,&numfun,NOAUTO) == NAMENOTFOUND )
188 AddFunction(t1,0,0,0,0,0,-1,-1);
192 AC.AltCollectFun = numfun+FUNCTION;
196 MesPrint(
"&Collect statement needs one or two functions (and a percentage) for its argument(s)");
205 int setonoff(UBYTE *s,
int *flag,
int onvalue,
int offvalue)
207 if ( StrICmp(s,(UBYTE *)
"on") == 0 ) *flag = onvalue;
208 else if ( StrICmp(s,(UBYTE *)
"off") == 0 ) *flag = offvalue;
210 MesPrint(
"&Unknown option: %s, on or off expected",s);
221 int CoCompress(UBYTE *s)
225 if ( StrICmp(s,(UBYTE *)
"on") == 0 ) {
229 else if ( StrICmp(s,(UBYTE *)
"off") == 0 ) {
234 t = s;
while ( FG.cTable[*t] <= 1 ) t++;
236 if ( StrICmp(s,(UBYTE *)
"gzip") == 0 ) {
238 Warning(
"gzip compression not supported on this platform");
242 AR.gzipCompress = GZIPDEFAULT;
245 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
247 if ( FG.cTable[*s] == 1 ) {
248 AR.gzipCompress = *s -
'0';
250 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
251 if ( *s == 0 )
return(0);
253 MesPrint(
"&Unknown gzip option: %s, a digit was expected",t);
258 MesPrint(
"&Unknown option: %s, on, off or gzip expected",s);
270 int CoFlags(UBYTE *s,
int value)
274 MesPrint(
"&Proper syntax is: On/Off Flag,number[s];");
277 while ( *s ==
',' ) {
278 do { s++; }
while ( *s ==
',' );
280 if ( FG.cTable[*s] != 1 ) {
281 MesPrint(
"&Proper syntax is: On/Off Flag,number[s];");
285 while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ -
'0'; }
286 if ( i <= 0 || i > MAXFLAGS ) {
287 MesPrint(
"&The number of a flag in On/Off Flag should be in the range 0-%d",(
int)MAXFLAGS);
291 AC.debugFlags[i] = value;
294 MesPrint(
"&Proper syntax is: On/Off Flag,number[s];");
309 int i, num =
sizeof(onoffoptions)/
sizeof(
KEYWORD);
311 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
312 if ( *s == 0 )
return(0);
313 if ( chartype[*s] != 0 ) {
314 MesPrint(
"&Illegal character or option encountered in OFF statement");
317 t = s;
while ( chartype[*s] == 0 ) s++;
319 for ( i = 0; i < num; i++ ) {
320 if ( StrICont(t,(UBYTE *)(onoffoptions[i].name)) == 0 )
break;
323 MesPrint(
"&Unrecognized option in OFF statement: %s",t);
326 else if ( StrICont(t,(UBYTE *)
"compress") == 0 ) {
329 else if ( StrICont(t,(UBYTE *)
"checkpoint") == 0 ) {
330 AC.CheckpointInterval = 0;
331 if ( AC.CheckpointRunBefore ) { free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL; }
332 if ( AC.CheckpointRunAfter ) { free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL; }
333 if ( AC.NoShowInput == 0 ) MesPrint(
"Checkpoints deactivated.");
335 else if ( StrICont(t,(UBYTE *)
"threads") == 0 ) {
336 AS.MultiThreaded = 0;
338 else if ( StrICont(t,(UBYTE *)
"flag") == 0 ) {
340 return(CoFlags(s,0));
342 else if ( StrICont(t,(UBYTE *)
"innertest") == 0 ) {
345 if ( AC.TestValue ) {
346 M_free(AC.TestValue,
"InnerTest");
351 *((
int *)(onoffoptions[i].func)) = onoffoptions[i].flags;
352 AR.SortType = AC.SortType;
353 AC.mparallelflag = AC.parallelflag | AM.hparallelflag;
366 int i, num =
sizeof(onoffoptions)/
sizeof(
KEYWORD);
369 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
370 if ( *s == 0 )
return(0);
371 if ( chartype[*s] != 0 ) {
372 MesPrint(
"&Illegal character or option encountered in ON statement");
375 t = s;
while ( chartype[*s] == 0 ) s++;
377 for ( i = 0; i < num; i++ ) {
378 if ( StrICont(t,(UBYTE *)(onoffoptions[i].name)) == 0 )
break;
381 MesPrint(
"&Unrecognized option in ON statement: %s",t);
384 if ( StrICont(t,(UBYTE *)
"compress") == 0 ) {
387 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
390 while ( FG.cTable[*s] <= 1 ) s++;
392 if ( StrICmp(t,(UBYTE *)
"gzip") == 0 ) {}
394 MesPrint(
"&Unrecognized option in ON compress statement: %s",t);
398 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
400 Warning(
"gzip compression not supported on this platform");
402 if ( FG.cTable[*s] == 1 ) {
403 AR.gzipCompress = *s++ -
'0';
404 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
406 MesPrint(
"&Unrecognized option in ON compress gzip statement: %s",t);
410 else if ( *s == 0 ) {
411 AR.gzipCompress = GZIPDEFAULT;
414 MesPrint(
"&Unrecognized option in ON compress gzip statement: %s, single digit expected",t);
419 else if ( StrICont(t,(UBYTE *)
"checkpoint") == 0 ) {
420 AC.CheckpointInterval = 0;
421 if ( AC.CheckpointRunBefore ) { free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL; }
422 if ( AC.CheckpointRunAfter ) { free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL; }
425 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
426 if ( FG.cTable[*s] == 1 ) {
429 do { interval = 10*interval + *s++ -
'0'; }
while ( FG.cTable[*s] == 1 );
430 if ( *s ==
's' || *s ==
'S' ) {
433 else if ( *s ==
'm' || *s ==
'M' ) {
436 else if ( *s ==
'h' || *s ==
'H' ) {
437 interval *= 3600; s++;
439 else if ( *s ==
'd' || *s ==
'D' ) {
440 interval *= 86400; s++;
442 if ( *s !=
',' && FG.cTable[*s] != 6 && FG.cTable[*s] != 10 ) {
443 MesPrint(
"&Unrecognized time interval in ON Checkpoint statement: %s", t);
446 AC.CheckpointInterval = interval * 100;
448 else if ( FG.cTable[*s] == 0 ) {
451 while ( FG.cTable[*s] == 0 ) s++;
453 if ( StrICmp(t,(UBYTE *)
"run") == 0 ) {
456 else if ( StrICmp(t,(UBYTE *)
"runafter") == 0 ) {
459 else if ( StrICmp(t,(UBYTE *)
"runbefore") == 0 ) {
463 MesPrint(
"&Unrecognized option in ON Checkpoint statement: %s", t);
467 if ( *s !=
'=' && FG.cTable[*(s+1)] != 9 ) {
468 MesPrint(
"&Unrecognized option in ON Checkpoint statement: %s", t);
474 if ( FG.cTable[*s] == 9 ) {
477 if ( AC.CheckpointRunBefore ) {
478 free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL;
481 AC.CheckpointRunBefore = Malloc1(s-t+1,
"AC.CheckpointRunBefore");
482 StrCopy(t, (UBYTE*)AC.CheckpointRunBefore);
486 if ( AC.CheckpointRunAfter ) {
487 free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL;
490 AC.CheckpointRunAfter = Malloc1(s-t+1,
"AC.CheckpointRunAfter");
491 StrCopy(t, (UBYTE*)AC.CheckpointRunAfter);
499 if ( FG.cTable[*s] != 9 ) {
500 MesPrint(
"&Unrecognized option in ON Checkpoint statement: %s", t);
524 else if ( StrICont(t,(UBYTE *)
"indentspace") == 0 ) {
526 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
529 while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ -
'0'; }
531 MesPrint(
"&Unrecognized option in ON IndentSpace statement: %s",t);
535 Warning(
"IndentSpace parameter adjusted to 40");
541 AO.IndentSpace = AM.ggIndentSpace;
545 else if ( ( StrICont(t,(UBYTE *)
"fewerstats") == 0 ) ||
546 ( StrICont(t,(UBYTE *)
"fewerstatistics") == 0 ) ) {
548 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
551 while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ -
'0'; }
553 MesPrint(
"&Unrecognized option in ON FewerStatistics statement: %s",t);
556 if ( i > AM.S0->MaxPatches ) {
558 MesPrint(
"&Warning: FewerStatistics parameter greater than MaxPatches(=%d). Adjusted to %d" 559 ,AM.S0->MaxPatches,(AM.S0->MaxPatches+1)/2);
560 i = (AM.S0->MaxPatches+1)/2;
562 AC.ShortStatsMax = i;
565 AC.ShortStatsMax = 10;
569 else if ( StrICont(t,(UBYTE *)
"threads") == 0 ) {
570 if ( AM.totalnumberofthreads > 1 ) AS.MultiThreaded = 1;
572 else if ( StrICont(t,(UBYTE *)
"flag") == 0 ) {
574 return(CoFlags(s,1));
576 else if ( StrICont(t,(UBYTE *)
"innertest") == 0 ) {
579 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
581 t = s;
while ( *t ) t++;
582 while ( t[-1] ==
' ' || t[-1] ==
'\t' ) t--;
584 if ( AC.TestValue ) M_free(AC.TestValue,
"InnerTest");
585 AC.TestValue = strDup1(s,
"InnerTest");
588 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
591 if ( AC.TestValue ) {
592 M_free(AC.TestValue,
"InnerTest");
598 *((
int *)(onoffoptions[i].func)) = onoffoptions[i].type;
599 AR.SortType = AC.SortType;
600 AC.mparallelflag = AC.parallelflag | AM.hparallelflag;
609 int CoInsideFirst(UBYTE *s) {
return(setonoff(s,&AC.insidefirst,1,0)); }
616 int CoProperCount(UBYTE *s) {
return(setonoff(s,&AC.BottomLevel,1,0)); }
623 int CoDelete(UBYTE *s)
626 if ( StrICmp(s,(UBYTE *)
"storage") == 0 ) {
627 if ( DeleteStore(1) < 0 ) {
628 MesPrint(
"&Cannot restart storage file");
634 while ( *t && *t !=
',' && *t !=
'>' ) t++;
636 if ( ( StrICmp(s,(UBYTE *)
"extrasymbols") == 0 )
637 || ( StrICmp(s,(UBYTE *)
"extrasymbol") == 0 ) ) {
645 if ( FG.cTable[*s] != 1 )
goto unknown;
646 while ( *s <= '9' && *s >=
'0' ) x = 10*x + *s++ -
'0';
647 if ( *s )
goto unknown;
649 else if ( *s )
goto unknown;
650 if ( x < AM.gnumextrasym ) x = AM.gnumextrasym;
651 PruneExtraSymbols(x);
656 MesPrint(
"&Unknown option: %s",s);
668 int CoFormat(UBYTE *s)
673 while ( *s ==
' ' || *s ==
',' ) s++;
676 AC.OutputSpaces = NORMALFORMAT;
682 if ( *s ==
'O' || *s ==
'o' ) {
683 if ( ( FG.cTable[s[1]] == 1 ) ||
684 ( s[1] ==
'=' && FG.cTable[s[2]] == 1 ) ) {
685 s++;
if ( *s ==
'=' ) s++;
687 while ( *s >=
'0' && *s <=
'9' ) x = 10*x + *s++ -
'0';
688 while ( *s ==
',' ) s++;
689 AO.OptimizationLevel = x;
690 AO.Optimize.greedytimelimit = 0;
691 AO.Optimize.mctstimelimit = 0;
692 AO.Optimize.printstats = 0;
693 AO.Optimize.debugflags = 0;
694 AO.Optimize.schemeflags = 0;
695 AO.Optimize.mctsdecaymode = 1;
697 M_free(AO.inscheme,
"Horner input scheme");
698 AO.inscheme = 0; AO.schemenum = 0;
704 AO.Optimize.mctsconstant.fval = -1.0;
705 AO.Optimize.horner = O_OCCURRENCE;
706 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
707 AO.Optimize.method = O_CSE;
710 AO.Optimize.horner = O_OCCURRENCE;
711 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
712 AO.Optimize.method = O_GREEDY;
713 AO.Optimize.greedyminnum = 10;
714 AO.Optimize.greedymaxperc = 5;
717 AO.Optimize.mctsconstant.fval = 1.0;
718 AO.Optimize.horner = O_MCTS;
719 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
720 AO.Optimize.method = O_GREEDY;
721 AO.Optimize.mctsnumexpand = 1000;
722 AO.Optimize.mctsnumkeep = 10;
723 AO.Optimize.mctsnumrepeat = 1;
724 AO.Optimize.greedyminnum = 10;
725 AO.Optimize.greedymaxperc = 5;
728 AO.Optimize.horner = O_SIMULATED_ANNEALING;
729 AO.Optimize.saIter = 1000;
730 AO.Optimize.saMaxT.fval = 2000;
731 AO.Optimize.saMinT.fval = 1;
735 MesPrint(
"&Illegal optimization specification in format statement");
738 if ( error == 0 && *s != 0 && x > 0 )
return(CoOptimizeOption(s));
744 while ( FG.cTable[*s] == 0 ) s++;
746 if ( StrICont(ss,(UBYTE *)
"optimize") == 0 ) {
748 while ( *s ==
',' ) s++;
749 if ( *s ==
'=' ) s++;
750 AO.OptimizationLevel = 3;
751 AO.Optimize.mctsconstant.fval = 1.0;
752 AO.Optimize.horner = O_MCTS;
753 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
754 AO.Optimize.method = O_GREEDY;
755 AO.Optimize.mctstimelimit = 0;
756 AO.Optimize.mctsnumexpand = 1000;
757 AO.Optimize.mctsnumkeep = 10;
758 AO.Optimize.mctsnumrepeat = 1;
759 AO.Optimize.greedytimelimit = 0;
760 AO.Optimize.greedyminnum = 10;
761 AO.Optimize.greedymaxperc = 5;
762 AO.Optimize.printstats = 0;
763 AO.Optimize.debugflags = 0;
764 AO.Optimize.schemeflags = 0;
765 AO.Optimize.mctsdecaymode = 1;
767 M_free(AO.inscheme,
"Horner input scheme");
768 AO.inscheme = 0; AO.schemenum = 0;
770 return(CoOptimizeOption(s));
774 MesPrint(
"&Illegal optimization specification in format statement");
780 else if ( FG.cTable[*s] == 1 ) {
782 while ( FG.cTable[*s] == 1 ) x = 10*x + *s++ -
'0';
783 if ( x <= 0 || x >= MAXLINELENGTH ) {
786 MesPrint(
"&Illegal value for linesize: %d",x);
789 MesPrint(
" ... Too small value for linesize corrected to 39");
802 MesPrint(
"&Illegal linesize field in format statement");
806 key = FindKeyWord(s,formatoptions,
807 sizeof(formatoptions)/
sizeof(
KEYWORD));
809 if ( key->flags == 0 ) {
810 if ( key->type == FORTRANMODE || key->type == PFORTRANMODE
811 || key->type == DOUBLEFORTRANMODE
812 || key->type == QUADRUPLEFORTRANMODE || key->type == VORTRANMODE ) {
813 AC.IsFortran90 = ISNOTFORTRAN90;
814 if ( AC.Fortran90Kind ) {
815 M_free(AC.Fortran90Kind,
"Fortran90 Kind");
816 AC.Fortran90Kind = 0;
820 AC.OutputMode = key->type & NODOUBLEMASK;
821 if ( ( key->type & DOUBLEPRECISIONFLAG ) != 0 ) {
824 else if ( ( key->type & QUADRUPLEPRECISIONFLAG ) != 0 ) {
828 else if ( key->flags == 1 ) {
829 AC.OutputMode = AC.OutNumberType = key->type;
831 else if ( key->flags == 2 ) {
832 while ( FG.cTable[*s] == 0 ) s++;
833 if ( *s == 0 ) AC.OutNumberType = 10;
834 else if ( *s ==
',' ) {
837 while ( FG.cTable[*s] == 1 ) x = 10*x + *s++ -
'0';
840 MesPrint(
"&Illegal float format specifier");
845 MesPrint(
"& ... float format value corrected to 3");
849 MesPrint(
"& ... float format value corrected to 100");
851 AC.OutNumberType = x;
855 else if ( key->flags == 3 ) {
856 AC.OutputSpaces = key->type;
858 else if ( key->flags == 4 ) {
859 AC.IsFortran90 = ISFORTRAN90;
860 if ( AC.Fortran90Kind ) {
861 M_free(AC.Fortran90Kind,
"Fortran90 Kind");
862 AC.Fortran90Kind = 0;
864 while ( FG.cTable[*s] <= 1 ) s++;
867 while ( *ss && *ss !=
',' ) ss++;
869 MesPrint(
"&No white space or comma's allowed in Fortran90 option: %s",s); error = 1;
872 AC.Fortran90Kind = strDup1(s,
"Fortran90 Kind");
876 AC.OutputMode = key->type & NODOUBLEMASK;
879 else if ( ( *s ==
'c' || *s ==
'C' ) && ( FG.cTable[s[1]] == 1 ) ) {
882 while ( *ss >=
'0' && *ss <=
'9' ) x = 10*x + *ss++ -
'0';
883 if ( *ss != 0 )
goto Unknown;
884 AC.OutputMode = CMODE;
888 Unknown: MesPrint(
"&Unknown option: %s",s); error = 1;
902 if ( StrICmp(s,(UBYTE *)
"brackets") == 0 ) AC.ComDefer = 1;
903 else { MesPrint(
"&Unknown option: '%s'",s);
return(1); }
912 int CoFixIndex(UBYTE *s)
916 if ( FG.cTable[*s] != 1 ) {
917 proper: MesPrint(
"&Proper syntax is: FixIndex,number:value[,number,value];");
921 if ( *s !=
':' )
goto proper;
923 if ( *s !=
'-' && *s !=
'+' && FG.cTable[*s] != 1 )
goto proper;
924 ParseSignedNumber(y,s)
925 if ( *s && *s !=
',' )
goto proper;
926 while ( *s ==
',' ) s++;
927 if ( x >= AM.OffsetIndex ) {
928 MesPrint(
"&Fixed index out of allowed range. Change ConstIndex in setup file?");
929 MesPrint(
"&Current value of ConstIndex = %d",AM.OffsetIndex-1);
932 if ( y != (
int)((WORD)y) ) {
933 MesPrint(
"&Value of d_(%d,%d) outside range for this computer",x,x);
936 if ( error == 0 ) AC.FixIndices[x] = y;
946 int CoMetric(UBYTE *s)
947 { DUMMYUSE(s); MesPrint(
"&The metric statement does not do anything yet");
return(1); }
954 int DoPrint(UBYTE *s,
int par)
956 int i, error = 0, numdol = 0, type;
959 WORD numexpr, tofile = 0, *w;
960 CBUF *C = cbuf + AC.cbufnum;
961 while ( *s ==
',' ) s++;
963 if ( ( *s ==
'+' || *s ==
'-' ) && ( s[1] ==
'f' || s[1] ==
'F' ) ) {
964 t = s + 2;
while ( *t ==
' ' || *t ==
',' ) t++;
966 if ( *s ==
'+' ) tofile = 1;
970 if ( par == PRINTON && *s ==
'"' ) {
972 if ( tofile == 1 ) code = TYPEFPRINT;
973 else code = TYPEPRINT;
975 while ( *s && *s !=
'"' ) {
976 if ( *s ==
'\\' ) s++;
977 if ( *s ==
'%' && s[1] ==
'$' ) numdol++;
981 MesPrint(
"&String in print statement should be enclosed in \"");
985 AddComString(1,&code,name,1);
987 while ( *s ==
',' ) {
990 s++; name = s;
while ( FG.cTable[*s] <= 1 ) s++;
992 type = GetName(AC.dollarnames,name,&numexpr,NOAUTO);
993 if ( type == NAMENOTFOUND ) {
994 MesPrint(
"&$ variable %s not (yet) defined",name);
998 C->
lhs[C->numlhs][1] += 2;
999 *(C->
Pointer)++ = DOLLAREXPRESSION;
1005 MesPrint(
"&Illegal object in print statement");
1013 s = GetDoParam(s,&(C->
Pointer),-1);
1014 if ( s == 0 )
return(1);
1016 MesPrint(
"&unmatched [] in $ factor");
1024 MesPrint(
"&Illegal object in print statement");
1028 MesPrint(
"&More $ variables asked for than provided");
1036 for ( e = Expressions, i = NumExpressions; i > 0; i--, e++ ) {
1037 if ( e->status == LOCALEXPRESSION || e->status ==
1038 GLOBALEXPRESSION || e->status == UNHIDELEXPRESSION
1039 || e->status == UNHIDEGEXPRESSION ) e->printflag = par;
1046 if ( tolower(*s) ==
'f' ) par |= PRINTLFILE;
1047 else if ( tolower(*s) ==
's' ) {
1048 if ( tolower(s[1]) ==
's' ) {
1049 if ( tolower(s[2]) ==
's' ) {
1050 par |= PRINTONEFUNCTION | PRINTONETERM | PRINTALL;
1053 else if ( ( par & 3 ) < 2 ) par |= PRINTONEFUNCTION | PRINTONETERM;
1057 if ( ( par & 3 ) < 2 ) par |= PRINTONETERM;
1061 illeg: MesPrint(
"&Illegal option in (n)print statement");
1065 if ( *s == 0 )
goto AllExpr;
1067 else if ( *s ==
'-' ) {
1069 if ( tolower(*s) ==
'f' ) par &= ~PRINTLFILE;
1070 else if ( tolower(*s) ==
's' ) {
1071 if ( tolower(s[1]) ==
's' ) {
1072 if ( tolower(s[2]) ==
's' ) {
1076 else if ( ( par & 3 ) < 2 ) {
1077 par &= ~PRINTONEFUNCTION;
1083 if ( ( par & 3 ) < 2 ) {
1084 par &= ~PRINTONETERM;
1085 par &= ~PRINTONEFUNCTION;
1092 if ( *s == 0 )
goto AllExpr;
1094 else if ( FG.cTable[*s] == 0 || *s ==
'[' ) {
1096 if ( ( s = SkipAName(s) ) == 0 ) {
1097 MesPrint(
"&Improper name in (n)print statement");
1101 if ( ( GetName(AC.exprnames,name,&numexpr,NOAUTO) == CEXPRESSION )
1102 && ( Expressions[numexpr].status == LOCALEXPRESSION
1103 || Expressions[numexpr].status == GLOBALEXPRESSION ) ) {
1105 if ( c ==
'[' && s[1] ==
']' ) {
1106 Expressions[numexpr].printflag = par | PRINTCONTENTS;
1110 Expressions[numexpr].printflag = par;
1112 else if ( GetLastExprName(name,&numexpr)
1113 && ( Expressions[numexpr].status == LOCALEXPRESSION
1114 || Expressions[numexpr].status == GLOBALEXPRESSION
1115 || Expressions[numexpr].status == UNHIDELEXPRESSION
1116 || Expressions[numexpr].status == UNHIDEGEXPRESSION
1121 MesPrint(
"&%s is not the name of an active expression",name);
1125 if ( c == 0 )
return(0);
1126 if ( c ==
'-' || c ==
'+' ) s--;
1128 else if ( *s ==
',' ) s++;
1130 MesPrint(
"&Illegal object in (n)print statement");
1142 int CoPrint(UBYTE *s) {
return(DoPrint(s,PRINTON)); }
1149 int CoPrintB(UBYTE *s) {
return(DoPrint(s,PRINTCONTENT)); }
1156 int CoNPrint(UBYTE *s) {
return(DoPrint(s,PRINTOFF)); }
1163 int CoPushHide(UBYTE *s)
1168 if ( AR.Fscr[2].PObuffer == 0 ) {
1169 ScratchBuf = (WORD *)Malloc1(AM.HideSize*
sizeof(WORD),
"hidesize");
1170 AR.Fscr[2].POsize = AM.HideSize *
sizeof(WORD);
1171 AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1172 AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1173 PUTZERO(AR.Fscr[2].POposition);
1175 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
1178 MesPrint(
"&PushHide statement should have no arguments");
1181 for ( i = 0; i < NumExpressions; i++ ) {
1182 switch ( Expressions[i].status ) {
1183 case DROPLEXPRESSION:
1184 case SKIPLEXPRESSION:
1185 case LOCALEXPRESSION:
1186 Expressions[i].status = HIDELEXPRESSION;
1187 Expressions[i].hidelevel = AC.HideLevel-1;
1189 case DROPGEXPRESSION:
1190 case SKIPGEXPRESSION:
1191 case GLOBALEXPRESSION:
1192 Expressions[i].status = HIDEGEXPRESSION;
1193 Expressions[i].hidelevel = AC.HideLevel-1;
1207 int CoPopHide(UBYTE *s)
1210 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
1211 if ( AC.HideLevel <= 0 ) {
1212 MesPrint(
"&PopHide statement without corresponding PushHide statement");
1217 MesPrint(
"&PopHide statement should have no arguments");
1220 for ( i = 0; i < NumExpressions; i++ ) {
1221 switch ( Expressions[i].status ) {
1222 case HIDDENLEXPRESSION:
1223 if ( Expressions[i].hidelevel > AC.HideLevel )
1224 Expressions[i].status = UNHIDELEXPRESSION;
1226 case HIDDENGEXPRESSION:
1227 if ( Expressions[i].hidelevel > AC.HideLevel )
1228 Expressions[i].status = UNHIDEGEXPRESSION;
1242 int SetExprCases(
int par,
int setunset,
int val)
1247 case SKIPLEXPRESSION:
1248 if ( !setunset ) val = LOCALEXPRESSION;
1250 case SKIPGEXPRESSION:
1251 if ( !setunset ) val = GLOBALEXPRESSION;
1253 case LOCALEXPRESSION:
1254 if ( setunset ) val = SKIPLEXPRESSION;
1256 case GLOBALEXPRESSION:
1257 if ( setunset ) val = SKIPGEXPRESSION;
1259 case INTOHIDEGEXPRESSION:
1260 case INTOHIDELEXPRESSION:
1267 case SKIPLEXPRESSION:
1268 case LOCALEXPRESSION:
1269 case HIDELEXPRESSION:
1270 if ( setunset ) val = DROPLEXPRESSION;
1272 case DROPLEXPRESSION:
1273 if ( !setunset ) val = LOCALEXPRESSION;
1275 case SKIPGEXPRESSION:
1276 case GLOBALEXPRESSION:
1277 case HIDEGEXPRESSION:
1278 if ( setunset ) val = DROPGEXPRESSION;
1280 case DROPGEXPRESSION:
1281 if ( !setunset ) val = GLOBALEXPRESSION;
1283 case HIDDENLEXPRESSION:
1284 case UNHIDELEXPRESSION:
1285 if ( setunset ) val = DROPHLEXPRESSION;
1287 case HIDDENGEXPRESSION:
1288 case UNHIDEGEXPRESSION:
1289 if ( setunset ) val = DROPHGEXPRESSION;
1291 case DROPHLEXPRESSION:
1292 if ( !setunset ) val = HIDDENLEXPRESSION;
1294 case DROPHGEXPRESSION:
1295 if ( !setunset ) val = HIDDENGEXPRESSION;
1297 case INTOHIDEGEXPRESSION:
1298 case INTOHIDELEXPRESSION:
1305 case DROPLEXPRESSION:
1306 case SKIPLEXPRESSION:
1307 case LOCALEXPRESSION:
1308 if ( setunset ) val = HIDELEXPRESSION;
1310 case HIDELEXPRESSION:
1311 if ( !setunset ) val = LOCALEXPRESSION;
1313 case DROPGEXPRESSION:
1314 case SKIPGEXPRESSION:
1315 case GLOBALEXPRESSION:
1316 if ( setunset ) val = HIDEGEXPRESSION;
1318 case HIDEGEXPRESSION:
1319 if ( !setunset ) val = GLOBALEXPRESSION;
1321 case INTOHIDEGEXPRESSION:
1322 case INTOHIDELEXPRESSION:
1329 case HIDDENLEXPRESSION:
1330 case DROPHLEXPRESSION:
1331 if ( setunset ) val = UNHIDELEXPRESSION;
1333 case UNHIDELEXPRESSION:
1334 if ( !setunset ) val = HIDDENLEXPRESSION;
1336 case HIDDENGEXPRESSION:
1337 case DROPHGEXPRESSION:
1338 if ( setunset ) val = UNHIDEGEXPRESSION;
1340 case UNHIDEGEXPRESSION:
1341 if ( !setunset ) val = HIDDENGEXPRESSION;
1343 case INTOHIDEGEXPRESSION:
1344 case INTOHIDELEXPRESSION:
1351 case HIDDENLEXPRESSION:
1352 case HIDDENGEXPRESSION:
1353 MesPrint(
"&Expression is already hidden");
1355 case DROPHLEXPRESSION:
1356 case DROPHGEXPRESSION:
1357 case UNHIDELEXPRESSION:
1358 case UNHIDEGEXPRESSION:
1359 MesPrint(
"&Cannot unhide and put intohide expression in the same module");
1361 case LOCALEXPRESSION:
1362 case DROPLEXPRESSION:
1363 case SKIPLEXPRESSION:
1364 case HIDELEXPRESSION:
1365 if ( setunset ) val = INTOHIDELEXPRESSION;
1367 case GLOBALEXPRESSION:
1368 case DROPGEXPRESSION:
1369 case SKIPGEXPRESSION:
1370 case HIDEGEXPRESSION:
1371 if ( setunset ) val = INTOHIDEGEXPRESSION;
1388 int SetExpr(UBYTE *s,
int setunset,
int par)
1393 if ( *s == 0 && ( par != INTOHIDE ) ) {
1394 for ( i = 0; i < NumExpressions; i++ ) {
1395 w = &(Expressions[i].status);
1396 *w = SetExprCases(par,setunset,*w);
1397 if ( *w < 0 ) error = 1;
1398 if ( par == HIDE && setunset == 1 )
1399 Expressions[i].hidelevel = AC.HideLevel;
1404 if ( *s ==
',' ) { s++;
continue; }
1405 if ( *s ==
'0' ) { s++;
continue; }
1407 if ( ( s = SkipAName(s) ) == 0 ) {
1408 MesPrint(
"&Improper name for an expression: '%s'",name);
1412 if ( GetName(AC.exprnames,name,&numexpr,NOAUTO) == CEXPRESSION ) {
1413 w = &(Expressions[numexpr].status);
1414 *w = SetExprCases(par,setunset,*w);
1415 if ( *w < 0 ) error = 1;
1416 if ( ( par == HIDE || par == INTOHIDE ) && setunset == 1 )
1417 Expressions[numexpr].hidelevel = AC.HideLevel;
1419 else if ( GetName(AC.varnames,name,&numexpr,NOAUTO) != NAMENOTFOUND ) {
1420 MesPrint(
"&%s is not an expression",name);
1433 int CoDrop(UBYTE *s) {
return(SetExpr(s,1,DROP)); }
1440 int CoNoDrop(UBYTE *s) {
return(SetExpr(s,0,DROP)); }
1447 int CoSkip(UBYTE *s) {
return(SetExpr(s,1,SKIP)); }
1454 int CoNoSkip(UBYTE *s) {
return(SetExpr(s,0,SKIP)); }
1461 int CoHide(UBYTE *inp) {
1464 if ( AR.Fscr[2].PObuffer == 0 ) {
1465 ScratchBuf = (WORD *)Malloc1(AM.HideSize*
sizeof(WORD),
"hidesize");
1466 AR.Fscr[2].POsize = AM.HideSize *
sizeof(WORD);
1467 AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1468 AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1469 PUTZERO(AR.Fscr[2].POposition);
1471 return(SetExpr(inp,1,HIDE));
1479 int CoIntoHide(UBYTE *inp) {
1482 if ( AR.Fscr[2].PObuffer == 0 ) {
1483 ScratchBuf = (WORD *)Malloc1(AM.HideSize*
sizeof(WORD),
"hidesize");
1484 AR.Fscr[2].POsize = AM.HideSize *
sizeof(WORD);
1485 AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1486 AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1487 PUTZERO(AR.Fscr[2].POposition);
1489 return(SetExpr(inp,1,INTOHIDE));
1497 int CoNoHide(UBYTE *inp) {
return(SetExpr(inp,0,HIDE)); }
1504 int CoUnHide(UBYTE *inp) {
return(SetExpr(inp,1,UNHIDE)); }
1511 int CoNoUnHide(UBYTE *inp) {
return(SetExpr(inp,0,UNHIDE)); }
1518 void AddToCom(
int n, WORD *array)
1520 CBUF *C = cbuf+AC.cbufnum;
1522 MesPrint(
" %a",n,array);
1525 while ( --n >= 0 ) *(C->
Pointer)++ = *array++;
1533 int AddComString(
int n, WORD *array, UBYTE *thestring,
int par)
1535 CBUF *C = cbuf+AC.cbufnum;
1536 UBYTE *s = thestring, *w;
1541 int i, numchars = 0, size, zeroes;
1543 if ( *s ==
'\\' ) s++;
1544 else if ( par == 1 &&
1545 ( ( *s ==
'%' && s[1] !=
't' && s[1] !=
'T' && s[1] !=
'$' &&
1546 s[1] !=
'w' && s[1] !=
'W' && s[1] !=
'r' && s[1] != 0 ) || *s ==
'#' 1547 || *s ==
'@' || *s ==
'&' ) ) {
1553 size = numchars/
sizeof(WORD)+1;
1560 for ( i = 1; i < n; i++ ) *(C->
Pointer)++ = array[i];
1566 zeroes = size*
sizeof(WORD)-numchars;
1569 if ( *s ==
'\\' ) s++;
1570 else if ( par == 1 && ( ( *s ==
'%' &&
1571 s[1] !=
't' && s[1] !=
'T' && s[1] !=
'$' &&
1572 s[1] !=
'w' && s[1] !=
'W' && s[1] !=
'r' && s[1] != 0 ) || *s ==
'#' 1573 || *s ==
'@' || *s ==
'&' ) ) {
1578 while ( --zeroes >= 0 ) *w++ = 0;
1581 MesPrint(
"LH: %a",size+1+n,cc);
1582 MesPrint(
" %s",thestring);
1592 int Add2ComStrings(
int n, WORD *array, UBYTE *string1, UBYTE *string2)
1594 CBUF *C = cbuf+AC.cbufnum;
1595 UBYTE *s1 = string1, *s2 = string2, *w;
1596 int i, num1chars = 0, num2chars = 0, size1, size2, zeroes1, zeroes2;
1598 while ( *s1 ) { s1++; num1chars++; }
1599 size1 = num1chars/
sizeof(WORD)+1;
1601 while ( *s2 ) { s2++; num2chars++; }
1602 size2 = num2chars/
sizeof(WORD)+1;
1607 *(C->
Pointer)++ = size1+size2+n+3;
1608 for ( i = 1; i < n; i++ ) *(C->
Pointer)++ = array[i];
1611 zeroes1 = size1*
sizeof(WORD)-num1chars;
1613 while ( *s1 ) { *w++ = *s1++; }
1614 while ( --zeroes1 >= 0 ) *w++ = 0;
1619 zeroes2 = size2*
sizeof(WORD)-num2chars;
1621 while ( *s2 ) { *w++ = *s2++; }
1622 while ( --zeroes2 >= 0 ) *w++ = 0;
1633 int CoDiscard(UBYTE *s)
1636 Add2Com(TYPEDISCARD)
1639 MesPrint(
"&Illegal argument in discard statement: '%s'",s);
1654 static WORD ccarray[5] = { TYPEOPERATION,5,CONTRACT,0,0 };
1656 int CoContract(UBYTE *s)
1662 if ( *s !=
',' && *s ) {
1663 proper: MesPrint(
"&Illegal number in contract statement");
1669 else ccarray[4] = 0;
1670 if ( FG.cTable[*s] == 1 ) {
1672 if ( *s )
goto proper;
1675 else if ( *s )
goto proper;
1676 else ccarray[3] = -1;
1685 int CoGoTo(UBYTE *inp)
1689 while ( FG.cTable[*s] <= 1 ) s++;
1691 MesPrint(
"&Label should be an alpha-numeric string");
1695 Add3Com(TYPEGOTO,x);
1704 int CoLabel(UBYTE *inp)
1708 while ( FG.cTable[*s] <= 1 ) s++;
1710 MesPrint(
"&Label should be an alpha-numeric string");
1714 if ( AC.Labels[x] >= 0 ) {
1715 MesPrint(
"&Label %s defined more than once",AC.LabelNames[x]);
1718 AC.Labels[x] = cbuf[AC.cbufnum].numlhs;
1731 int DoArgument(UBYTE *s,
int par)
1734 UBYTE *name, *t, *v, c;
1735 WORD *oldworkpointer = AT.WorkPointer, *w, *ww, number, *scale;
1736 int error = 0, zeroflag, type, x;
1737 AC.lhdollarflag = 0;
1738 while ( *s ==
',' ) s++;
1744 if ( AC.arglevel >= MAXNEST ) {
1745 MesPrint(
"@Nesting of argument statements more than %d levels" 1749 AC.argsumcheck[AC.arglevel] = NestingChecksum();
1750 AC.argstack[AC.arglevel] = cbuf[AC.cbufnum].Pointer
1751 - cbuf[AC.cbufnum].Buffer + 2;
1753 *w++ = cbuf[AC.cbufnum].numlhs;
1758 case TYPESPLITFIRSTARG:
1759 case TYPESPLITLASTARG:
1761 case TYPEARGTOEXTRASYMBOL:
1762 *w++ = cbuf[AC.cbufnum].numlhs+1;
1770 s++; ParseSignedNumber(x,s)
1771 while ( *s ==
',' ) s++;
1775 t = s+1; SKIPBRA3(s)
1776 if ( par == TYPEARG ) {
1777 MesPrint(
"&Illegal () entry in argument statement");
1778 error = 1; s++;
goto skipbracks;
1780 else if ( par == TYPESPLITFIRSTARG ) {
1781 MesPrint(
"&Illegal () entry in splitfirstarg statement");
1782 error = 1; s++;
goto skipbracks;
1784 else if ( par == TYPESPLITLASTARG ) {
1785 MesPrint(
"&Illegal () entry in splitlastarg statement");
1786 error = 1; s++;
goto skipbracks;
1791 MesPrint(
"&Wildcarding not allowed in this type of statement");
1797 if ( *t ==
'(' && v[-1] ==
')' ) {
1799 if ( par == TYPESPLITARG ) oldworkpointer[0] = TYPESPLITARG2;
1800 else if ( par == TYPEFACTARG ) oldworkpointer[0] = TYPEFACTARG2;
1801 else if ( par == TYPENORM4 ) oldworkpointer[0] = TYPENORM4;
1802 else if ( par == TYPENORM ) {
1803 if ( *t ==
'-' ) { oldworkpointer[0] = TYPENORM3; t++; }
1804 else { oldworkpointer[0] = TYPENORM2; *scale = 0; }
1808 CBUF *C = cbuf+AC.cbufnum;
1809 WORD oldnumrhs = C->numrhs, oldnumlhs = C->numlhs;
1810 WORD prototype[SUBEXPSIZE+40];
1815 prototype[0] = SUBEXPRESSION;
1816 prototype[1] = SUBEXPSIZE;
1817 prototype[2] = C->numrhs+1;
1819 prototype[4] = AC.cbufnum;
1820 AT.WorkPointer += TYPEARGHEADSIZE+1;
1822 if ( ( retcode = CompileAlgebra(t,LHSIDE,prototype) ) < 0 )
1825 prototype[2] = retcode;
1826 ww = C->
lhs[retcode];
1827 AC.lhdollarflag = 0;
1829 *w++ = -2; *w++ = 0;
1831 else if ( ww[ww[0]] != 0 ) {
1832 MesPrint(
"&There should be only one term between ()");
1835 else if (
NewSort(BHEAD0) ) {
if ( !error ) error = 1; }
1838 if ( !error ) error = 1;
1841 AN.RepPoint = AT.RepCount + 1;
1844 while ( --i >= 0 ) *m++ = *mm++;
1845 mm = AT.WorkPointer; AT.WorkPointer = m;
1846 AR.Cnumlhs = C->numlhs;
1850 else if (
EndSort(BHEAD mm,0) < 0 ) {
1852 AT.WorkPointer = mm;
1854 else if ( *mm == 0 ) {
1855 *w++ = -2; *w++ = 0;
1856 AT.WorkPointer = mm;
1858 else if ( mm[mm[0]] != 0 ) {
1860 AT.WorkPointer = mm;
1863 AT.WorkPointer = mm;
1865 if ( par == TYPEFACTARG ) {
1866 if ( *mm != ABS(m[-1])+1 ) {
1869 mm[-1] = -*mm-1; w += *mm+1;
1877 { mm[-1] = -*mm-1; w += *mm+1; }
1879 oldworkpointer[1] = w - oldworkpointer;
1883 oldworkpointer[5] = AC.lhdollarflag;
1886 C->numrhs = oldnumrhs;
1887 C->numlhs = oldnumlhs;
1892 if ( *s == 0 ) { *w++ = 0; *w++ = 2; *w++ = 1; }
1895 if ( *s ==
',' ) { s++;
continue; }
1896 ww = w; *w++ = 0; w++;
1897 if ( FG.cTable[*s] > 1 && *s !=
'[' && *s !=
'{' ) {
1898 MesPrint(
"&Illegal parameters in statement");
1902 while ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'{' ) {
1907 number = DoTempSet(name,s);
1908 name--; *s++ = c; c = *s; *s = 0;
1913 if ( ( s = SkipAName(s) ) == 0 ) {
1914 MesPrint(
"&Illegal name '%s'",name);
1918 if ( ( type = GetName(AC.varnames,name,&number,WITHAUTO) ) == CSET ) {
1919 doset:
if ( Sets[number].type != CFUNCTION )
goto nofun;
1920 *w++ = CSET; *w++ = number;
1922 else if ( type == CFUNCTION ) {
1923 *w++ = CFUNCTION; *w++ = number + FUNCTION;
1926 nofun: MesPrint(
"&%s is not a function or a set of functions" 1932 while ( *s ==
',' ) s++;
1935 ww = w; w++; zeroflag = 0;
1936 while ( FG.cTable[*s] == 1 ) {
1938 if ( *s && *s !=
',' ) {
1939 MesPrint(
"&Illegal separator after number");
1941 while ( *s && *s !=
',' ) s++;
1943 while ( *s ==
',' ) s++;
1944 if ( x == 0 ) zeroflag = 1;
1945 if ( !zeroflag ) *w++ = (WORD)x;
1950 oldworkpointer[1] = w - oldworkpointer;
1951 if ( par == TYPEARG ) {
1952 AC.argstack[AC.arglevel-1] = cbuf[AC.cbufnum].Pointer
1953 - cbuf[AC.cbufnum].Buffer + 2;
1955 AddNtoL(oldworkpointer[1],oldworkpointer);
1956 AT.WorkPointer = oldworkpointer;
1965 int CoArgument(UBYTE *s) {
return(DoArgument(s,TYPEARG)); }
1972 int CoEndArgument(UBYTE *s)
1974 CBUF *C = cbuf+AC.cbufnum;
1975 while ( *s ==
',' ) s++;
1977 MesPrint(
"&Illegal syntax for EndArgument statement");
1980 if ( AC.arglevel <= 0 ) {
1981 MesPrint(
"&EndArgument without corresponding Argument statement");
1985 cbuf[AC.cbufnum].Buffer[AC.argstack[AC.arglevel]] = C->numlhs;
1986 if ( AC.argsumcheck[AC.arglevel] != NestingChecksum() ) {
1998 int CoInside(UBYTE *s) {
return(ExecInside(s)); }
2005 int CoEndInside(UBYTE *s)
2007 CBUF *C = cbuf+AC.cbufnum;
2008 while ( *s ==
',' ) s++;
2010 MesPrint(
"&Illegal syntax for EndInside statement");
2013 if ( AC.insidelevel <= 0 ) {
2014 MesPrint(
"&EndInside without corresponding Inside statement");
2018 cbuf[AC.cbufnum].Buffer[AC.insidestack[AC.insidelevel]] = C->numlhs;
2019 if ( AC.insidesumcheck[AC.insidelevel] != NestingChecksum() ) {
2031 int CoNormalize(UBYTE *s) {
return(DoArgument(s,TYPENORM)); }
2038 int CoMakeInteger(UBYTE *s) {
return(DoArgument(s,TYPENORM4)); }
2045 int CoSplitArg(UBYTE *s) {
return(DoArgument(s,TYPESPLITARG)); }
2052 int CoSplitFirstArg(UBYTE *s) {
return(DoArgument(s,TYPESPLITFIRSTARG)); }
2059 int CoSplitLastArg(UBYTE *s) {
return(DoArgument(s,TYPESPLITLASTARG)); }
2066 int CoFactArg(UBYTE *s) {
2067 if ( ( AC.topolynomialflag & TOPOLYNOMIALFLAG ) != 0 ) {
2068 MesPrint(
"&ToPolynomial statement and FactArg statement are not allowed in the same module");
2071 AC.topolynomialflag |= FACTARGFLAG;
2072 return(DoArgument(s,TYPEFACTARG));
2086 int DoSymmetrize(UBYTE *s,
int par)
2089 int extra = 0, error = 0, err, fix, x, groupsize, num, i;
2091 WORD funnum, *w, *ww, type;
2094 if ( ( s = SkipAName(s) ) == 0 ) {
2095 MesPrint(
"&Improper function name");
2099 if ( c !=
',' || ( FG.cTable[s[1]] != 0 && s[1] !=
'[' ) )
break;
2100 if ( par <= 0 && StrICmp(name,(UBYTE *)
"cyclic") == 0 ) extra = 2;
2101 else if ( par <= 0 && StrICmp(name,(UBYTE *)
"rcyclic") == 0 ) extra = 6;
2103 MesPrint(
"&Illegal option: '%s'",name);
2108 if ( ( err = GetVar(name,&type,&funnum,CFUNCTION,WITHAUTO) ) == NAMENOTFOUND ) {
2109 MesPrint(
"&Undefined function: %s",name);
2110 AddFunction(name,0,0,0,0,0,-1,-1);
2115 if ( err == -1 ) error = 1;
2119 if ( *s ==
',' || *s ==
'(' || *s == 0 ) fix = -1;
2120 else if ( FG.cTable[*s] == 1 ) {
2123 Warning(
"Restriction to zero arguments removed");
2126 MesPrint(
"&Illegal character after :");
2132 *w++ = TYPEOPERATION;
2141 w += 2; ww = w; groupsize = -1;
2142 while ( *s ==
',' ) s++;
2146 while ( *s && *s !=
')' ) {
2147 if ( *s ==
',' ) { s++;
continue; }
2148 if ( FG.cTable[*s] != 1 )
goto illarg;
2150 if ( x <= 0 || ( fix > 0 && x > fix ) )
goto illnum;
2155 MesPrint(
"&Improper termination of statement");
2158 if ( groupsize < 0 ) groupsize = num;
2159 else if ( groupsize != num )
goto group;
2162 else if ( FG.cTable[*s] == 1 ) {
2163 if ( groupsize < 0 ) groupsize = 1;
2164 else if ( groupsize != 1 ) {
2165 group: MesPrint(
"&All groups should have the same number of arguments");
2169 if ( x <= 0 || ( fix > 0 && x > fix ) ) {
2170 illnum: MesPrint(
"&Illegal argument number: %d",x);
2176 illarg: MesPrint(
"&Illegal argument");
2179 while ( *s ==
',' ) s++;
2188 for ( i = 0; i < fix; i++ ) *w++ = i;
2194 ww[-2] = (w-ww)/groupsize;
2196 AT.WorkPointer[1] = w - AT.WorkPointer;
2197 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
2206 int CoSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,SYMMETRIC)); }
2213 int CoAntiSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,ANTISYMMETRIC)); }
2220 int CoCycleSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,CYCLESYMMETRIC)); }
2227 int CoRCycleSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,RCYCLESYMMETRIC)); }
2234 int CoWrite(UBYTE *s)
2240 if ( ( ( s = SkipAName(s) ) == 0 ) || *s != 0 ) {
2241 MesPrint(
"&Proper use of write statement is: write option");
2244 key = FindInKeyWord(option,writeoptions,
sizeof(writeoptions)/
sizeof(
KEYWORD));
2246 MesPrint(
"&Unrecognized option in write statement");
2249 *((
int *)(key->func)) = key->type;
2250 AR.SortType = AC.SortType;
2259 int CoNWrite(UBYTE *s)
2265 if ( ( ( s = SkipAName(s) ) == 0 ) || *s != 0 ) {
2266 MesPrint(
"&Proper use of nwrite statement is: nwrite option");
2269 key = FindInKeyWord(option,writeoptions,
sizeof(writeoptions)/
sizeof(
KEYWORD));
2271 MesPrint(
"&Unrecognized option in nwrite statement");
2274 *((
int *)(key->func)) = key->flags;
2275 AR.SortType = AC.SortType;
2284 static WORD ratstring[6] = { TYPEOPERATION, 6, RATIO, 0, 0, 0 };
2286 int CoRatio(UBYTE *s)
2289 int i, type, error = 0;
2292 for ( i = 0; i < 3; i++ ) {
2297 if ( ( ( type = GetName(AC.varnames,t,&numsym,WITHAUTO) ) != CSYMBOL )
2298 && type != CDUBIOUS ) {
2299 MesPrint(
"&%s is not a symbol",t);
2301 if ( type < 0 ) numsym = AddSymbol(t,-MAXPOWER,MAXPOWER,0,0);
2304 if ( *s ==
',' ) s++;
2308 MesPrint(
"&The ratio statement needs three symbols for its arguments");
2326 int CoRedefine(UBYTE *s)
2328 UBYTE *name, c, *args = 0;
2332 if ( FG.cTable[*s] || ( s = SkipAName(s) ) == 0 || s[-1] ==
'_' ) {
2333 MesPrint(
"&Illegal name for preprocessor variable in redefine statement");
2337 for ( numprevar = NumPre-1; numprevar >= 0; numprevar-- ) {
2338 if ( StrCmp(name,PreVar[numprevar].name) == 0 )
break;
2340 if ( numprevar < 0 ) {
2341 MesPrint(
"&There is no preprocessor variable with the name `%s'",name);
2353 if ( chartype[*s] != 0 )
goto illarg;
2355 while ( chartype[*s] <= 1 ) s++;
2356 while ( *s ==
' ' || *s ==
'\t' ) s++;
2357 if ( *s ==
')' )
break;
2358 if ( *s !=
',' )
goto illargs;
2360 while ( *s ==
' ' || *s ==
'\t' ) s++;
2363 while ( *s ==
' ' || *s ==
'\t' ) s++;
2365 while ( *s ==
',' ) s++;
2367 encl: MesPrint(
"&Value for %s should be enclosed in double quotes" 2368 ,PreVar[numprevar].name);
2372 while ( *s && *s !=
'"' ) {
if ( *s ==
'\\' ) s++; s++; }
2373 if ( *s !=
'"' )
goto encl;
2375 code[0] = TYPEREDEFPRE; code[1] = numprevar;
2379 Add2ComStrings(2,code,name,args);
2391 for ( j = 0; j < AC.numpfirstnum; j++ ) {
2392 if ( numprevar == AC.pfirstnum[j] )
break;
2394 if ( j >= AC.numpfirstnum ) {
2395 if ( j >= AC.sizepfirstnum ) {
2396 if ( AC.sizepfirstnum <= 0 ) { AC.sizepfirstnum = 10; }
2397 else { AC.sizepfirstnum = 2 * AC.sizepfirstnum; }
2398 newin = (LONG *)Malloc1(AC.sizepfirstnum*(
sizeof(WORD)+
sizeof(LONG)),
"AC.pfirstnum");
2399 newpf = (WORD *)(newin+AC.sizepfirstnum);
2400 for ( j = 0; j < AC.numpfirstnum; j++ ) {
2401 newpf[j] = AC.pfirstnum[j];
2402 newin[j] = AC.inputnumbers[j];
2404 if ( AC.inputnumbers ) M_free(AC.inputnumbers,
"AC.pfirstnum");
2405 AC.inputnumbers = newin;
2406 AC.pfirstnum = newpf;
2408 AC.pfirstnum[AC.numpfirstnum] = numprevar;
2409 AC.inputnumbers[AC.numpfirstnum] = -1;
2416 MesPrint(
"&Illegally formed name in argument of redefine statement");
2419 MesPrint(
"&Illegally formed arguments in redefine statement");
2431 int CoRenumber(UBYTE *s)
2435 while ( *s ==
',' ) s++;
2437 if ( *s == 0 ) { x = 0; }
2438 else ParseNumber(x,s)
2439 if ( *s == 0 && x >= 0 && x <= 1 ) {
2440 Add3Com(TYPERENUMBER,x);
2443 MesPrint(
"&Illegal argument in Renumber statement: '%s'",inp);
2454 CBUF *C = cbuf+AC.cbufnum;
2455 UBYTE *ss = 0, c, *t;
2456 int error = 0, i = 0, type, x;
2457 WORD numindex,number;
2461 t++; s++;
while ( FG.cTable[*s] < 2 ) s++;
2463 if ( ( number = GetDollar(t) ) < 0 ) {
2464 MesPrint(
"&Undefined variable $%s",t);
2465 if ( !error ) error = 1;
2466 number = AddDollar(t,0,0,0);
2471 if ( ( s = SkipAName(s) ) == 0 )
return(1);
2473 if ( ( ( type = GetOName(AC.exprnames,t,&numindex,NOAUTO) ) != NAMENOTFOUND )
2474 || ( ( type = GetOName(AC.varnames,t,&numindex,WITHAUTO) ) != CINDEX ) ) {
2475 if ( type != NAMENOTFOUND ) error = NameConflict(type,t);
2477 MesPrint(
"&%s should have been declared as an index",t);
2479 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2483 Add3Com(TYPESUM,numindex);
2485 if ( *s == 0 )
break;
2487 MesPrint(
"&Illegal separator between objects in sum statement.");
2491 if ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'$' ) {
2492 while ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'$' ) {
2496 while ( FG.cTable[*s] < 2 ) s++;
2498 if ( ( number = GetDollar(t) ) < 0 ) {
2499 MesPrint(
"&Undefined variable $%s",t);
2500 if ( !error ) error = 1;
2501 number = AddDollar(t,0,0,0);
2507 if ( ( s = SkipAName(s) ) == 0 )
return(1);
2509 if ( ( ( type = GetOName(AC.exprnames,t,&numindex,NOAUTO) ) != NAMENOTFOUND )
2510 || ( ( type = GetOName(AC.varnames,t,&numindex,WITHAUTO) ) != CINDEX ) ) {
2511 if ( type != NAMENOTFOUND ) error = NameConflict(type,t);
2513 MesPrint(
"&%s should have been declared as an index",t);
2515 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2523 if ( *s == 0 )
return(error);
2525 MesPrint(
"&Illegal separator between objects in sum statement.");
2530 if ( FG.cTable[*s] == 1 ) {
2534 else if ( FG.cTable[*s] == 1 ) {
2535 while ( FG.cTable[*s] == 1 ) {
2538 while( FG.cTable[*s] == 1 ) x = 10*x + *s++ -
'0';
2539 if ( *s && *s !=
',' ) {
2540 MesPrint(
"&%s is not a legal fixed index",t);
2543 else if ( x >= AM.OffsetIndex ) {
2544 MesPrint(
"&%d is too large to be a fixed index",x);
2553 if ( *s == 0 )
break;
2558 MesPrint(
"&Illegal object in sum statement");
2570 static WORD cttarray[7] = { TYPEOPERATION,7,TENVEC,0,0,1,0 };
2572 int CoToTensor(UBYTE *s)
2575 int type, j, nargs, error = 0;
2576 WORD number, dol[2] = { 0, 0 };
2588 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
2589 if ( *s == 0 )
break;
2596 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2599 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2603 if ( nargs < 2 )
goto not_enough_arguments;
2608 for ( j = 2; j < nargs; j++ ) {
2609 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
2618 if ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'_' ) {
2620 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2622 type = GetName(AC.varnames,t,&number,WITHAUTO);
2623 if ( type == CVECTOR ) {
2627 cttarray[6] = DoTempSet(t,s);
2631 else if ( type != CSET ) {
2632 MesPrint(
"&%s is not the name of a set or a vector",t);
2636 cttarray[6] = number;
2638 else if ( *s ==
'{' ) {
2639 t = ++s; SKIPBRA2(s) *s = 0;
2640 cttarray[6] = DoTempSet(t,s);
2643 if ( cttarray[6] < 0 ) {
2646 if ( AC.wildflag ) {
2647 MesPrint(
"&Improper use of wildcard(s) in set specification");
2656 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2658 if ( StrICmp(t,(UBYTE *)
"nosquare") == 0 ) cttarray[5] |= 2;
2659 else if ( StrICmp(t,(UBYTE *)
"functions") == 0 ) cttarray[5] |= 4;
2661 MesPrint(
"&Unrecognized option in ToTensor statement: '%s'",t);
2671 for ( j = 0; j < 2; j++ ) {
2672 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
2674 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2676 if ( t[0] ==
'$' ) {
2677 dol[j] = GetDollar(t+1);
2678 if ( dol[j] < 0 ) dol[j] = AddDollar(t+1,DOLUNDEFINED,0,0);
2680 type = GetName(AC.varnames,t,&number,WITHAUTO);
2681 if ( type == CVECTOR ) {
2682 cttarray[4] = number + AM.OffsetVector;
2684 else if ( type == CFUNCTION && ( functions[number].spec > 0 ) ) {
2685 cttarray[3] = number + FUNCTION;
2688 MesPrint(
"&%s is not a vector or a tensor",t);
2694 if ( cttarray[3] == 0 || cttarray[4] == 0 ) {
2695 if ( dol[0] == 0 && dol[1] == 0 ) {
2696 goto not_enough_arguments;
2698 else if ( cttarray[3] ) {
2699 if ( dol[1] ) cttarray[4] = dol[1];
2700 else if ( dol[0] ) { cttarray[4] = dol[0]; }
2702 goto not_enough_arguments;
2705 else if ( cttarray[4] ) {
2706 if ( dol[1] ) { cttarray[3] = -dol[1]; }
2707 else if ( dol[0] ) cttarray[3] = -dol[0];
2709 goto not_enough_arguments;
2713 if ( dol[0] == 0 || dol[1] == 0 ) {
2714 goto not_enough_arguments;
2717 cttarray[3] = -dol[0]; cttarray[4] = dol[1];
2721 AddNtoL(cttarray[1],cttarray);
2725 MesPrint(
"&Syntax error in ToTensor statement");
2728 not_enough_arguments:
2729 MesPrint(
"&ToTensor statement needs a vector and a tensor");
2738 static WORD ctvarray[6] = { TYPEOPERATION,6,TENVEC,0,0,0 };
2740 int CoToVector(UBYTE *s)
2743 int j, type, error = 0;
2744 WORD number, dol[2];
2745 dol[0] = dol[1] = 0;
2746 ctvarray[3] = ctvarray[4] = ctvarray[5] = 0;
2747 for ( j = 0; j < 2; j++ ) {
2749 if ( ( s = SkipAName(s) ) == 0 ) {
2750 proper: MesPrint(
"&Arguments of ToVector statement should be a vector and a tensor");
2755 dol[j] = GetDollar(t+1);
2756 if ( dol[j] < 0 ) dol[j] = AddDollar(t+1,DOLUNDEFINED,0,0);
2758 else if ( ( type = GetName(AC.varnames,t,&number,WITHAUTO) ) == CVECTOR )
2759 ctvarray[4] = number + AM.OffsetVector;
2760 else if ( type == CFUNCTION && ( functions[number].spec > 0 ) )
2761 ctvarray[3] = number+FUNCTION;
2763 MesPrint(
"&%s is not a vector or a tensor",t);
2766 *s = c;
if ( *s && *s !=
',' )
goto proper;
2769 if ( *s != 0 )
goto proper;
2770 if ( ctvarray[3] == 0 || ctvarray[4] == 0 ) {
2771 if ( dol[0] == 0 && dol[1] == 0 ) {
2772 MesPrint(
"&ToVector statement needs a vector and a tensor");
2775 else if ( ctvarray[3] ) {
2776 if ( dol[1] ) ctvarray[4] = dol[1];
2777 else if ( dol[0] ) ctvarray[4] = dol[0];
2779 MesPrint(
"&ToVector statement needs a vector and a tensor");
2783 else if ( ctvarray[4] ) {
2784 if ( dol[1] ) ctvarray[3] = -dol[1];
2785 else if ( dol[0] ) ctvarray[3] = -dol[0];
2787 MesPrint(
"&ToVector statement needs a vector and a tensor");
2792 if ( dol[0] == 0 || dol[1] == 0 ) {
2793 MesPrint(
"&ToVector statement needs a vector and a tensor");
2797 ctvarray[3] = -dol[0]; ctvarray[4] = dol[1];
2810 int CoTrace4(UBYTE *s)
2812 int error = 0, type, option = CHISHOLM;
2814 WORD numindex, one = 1;
2818 if ( FG.cTable[*s] == 1 )
break;
2819 if ( ( s = SkipAName(s) ) == 0 ) {
2820 proper: MesPrint(
"&Proper syntax for Trace4 is 'Trace4[,options],index;'");
2823 if ( *s == 0 )
break;
2825 if ( ( key = FindKeyWord(t,trace4options,
2826 sizeof(trace4options)/
sizeof(
KEYWORD)) ) == 0 )
break;
2828 option |= key->type;
2829 option &= ~key->flags;
2831 if ( ( *s++ = c ) !=
',' ) {
2832 MesPrint(
"&Illegal separator in Trace4 statement");
2835 if ( *s == 0 )
goto proper;
2838 if ( FG.cTable[*s] == 1 ) {
2840 ParseNumber(numindex,s)
2842 MesPrint(
"&Last argument of Trace4 should be an index");
2845 if ( numindex >= AM.OffsetIndex ) {
2846 MesPrint(
"&fixed index >= %d. Change value of OffsetIndex in setup file" 2851 else if ( *s ==
'$' ) {
2852 if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
2853 numindex = -numindex;
2855 MesPrint(
"&%s is undefined",s);
2856 numindex = AddDollar(s+1,DOLINDEX,&one,1);
2859 tests: s = SkipAName(s);
2861 MesPrint(
"&Trace4 should have a single index or $variable for its argument");
2865 else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
2866 numindex += AM.OffsetIndex;
2869 else if ( type != -1 ) {
2870 if ( type != CDUBIOUS ) {
2871 if ( ( FG.cTable[*s] != 0 ) && ( *s !=
'[' ) ) {
2872 if ( *s ==
'+' && FG.cTable[s[1]] == 1 ) { s++;
goto retry; }
2875 NameConflict(type,s);
2876 type = MakeDubious(AC.varnames,s,&numindex);
2881 MesPrint(
"&%s is not an index",s);
2882 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2885 if ( error )
return(error);
2886 if ( ( option & CHISHOLM ) != 0 )
2887 Add4Com(TYPECHISHOLM,numindex,(option & ALSOREVERSE));
2888 Add5Com(TYPEOPERATION,TAKETRACE,4 + (option & NOTRICK),numindex);
2897 int CoTraceN(UBYTE *s)
2899 WORD numindex, one = 1;
2901 if ( FG.cTable[*s] == 1 ) {
2903 ParseNumber(numindex,s)
2905 proper: MesPrint(
"&TraceN should have a single index for its argument");
2908 if ( numindex >= AM.OffsetIndex ) {
2909 MesPrint(
"&fixed index >= %d. Change value of OffsetIndex in setup file" 2914 else if ( *s ==
'$' ) {
2915 if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
2916 numindex = -numindex;
2918 MesPrint(
"&%s is undefined",s);
2919 numindex = AddDollar(s+1,DOLINDEX,&one,1);
2922 tests: s = SkipAName(s);
2924 MesPrint(
"&TraceN should have a single index or $variable for its argument");
2928 else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
2929 numindex += AM.OffsetIndex;
2932 else if ( type != -1 ) {
2933 if ( type != CDUBIOUS ) {
2934 if ( ( FG.cTable[*s] != 0 ) && ( *s !=
'[' ) ) {
2935 if ( *s ==
'+' && FG.cTable[s[1]] == 1 ) { s++;
goto retry; }
2938 NameConflict(type,s);
2939 type = MakeDubious(AC.varnames,s,&numindex);
2944 MesPrint(
"&%s is not an index",s);
2945 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2948 Add5Com(TYPEOPERATION,TAKETRACE,0,numindex);
2957 int CoChisholm(UBYTE *s)
2959 int error = 0, type, option = CHISHOLM;
2961 WORD numindex, one = 1;
2965 if ( FG.cTable[*s] == 1 )
break;
2966 if ( ( s = SkipAName(s) ) == 0 ) {
2967 proper: MesPrint(
"&Proper syntax for Chisholm is 'Chisholm[,options],index;'");
2970 if ( *s == 0 )
break;
2972 if ( ( key = FindKeyWord(t,chisoptions,
2973 sizeof(chisoptions)/
sizeof(
KEYWORD)) ) == 0 )
break;
2975 option |= key->type;
2976 option &= ~key->flags;
2978 if ( ( *s++ = c ) !=
',' ) {
2979 MesPrint(
"&Illegal separator in Chisholm statement");
2982 if ( *s == 0 )
goto proper;
2985 if ( FG.cTable[*s] == 1 ) {
2986 ParseNumber(numindex,s)
2988 MesPrint(
"&Last argument of Chisholm should be an index");
2991 if ( numindex >= AM.OffsetIndex ) {
2992 MesPrint(
"&fixed index >= %d. Change value of OffsetIndex in setup file" 2997 else if ( *s ==
'$' ) {
2998 if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
2999 numindex = -numindex;
3001 MesPrint(
"&%s is undefined",s);
3002 numindex = AddDollar(s+1,DOLINDEX,&one,1);
3005 tests: s = SkipAName(s);
3007 MesPrint(
"&Chisholm should have a single index or $variable for its argument");
3011 else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
3012 numindex += AM.OffsetIndex;
3015 else if ( type != -1 ) {
3016 if ( type != CDUBIOUS ) {
3017 NameConflict(type,s);
3018 type = MakeDubious(AC.varnames,s,&numindex);
3023 MesPrint(
"&%s is not an index",s);
3024 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
3027 if ( error )
return(error);
3028 Add4Com(TYPECHISHOLM,numindex,(option & ALSOREVERSE));
3039 int DoChain(UBYTE *s,
int option)
3043 if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
3046 MesPrint(
"&%s is undefined",s);
3047 numfunc = AddDollar(s+1,DOLINDEX,&one,1);
3050 tests: s = SkipAName(s);
3052 MesPrint(
"&ChainIn/ChainOut should have a single function or $variable for its argument");
3056 else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
3057 numfunc += FUNCTION;
3060 else if ( type != -1 ) {
3061 if ( type != CDUBIOUS ) {
3062 NameConflict(type,s);
3063 type = MakeDubious(AC.varnames,s,&numfunc);
3068 MesPrint(
"&%s is not a function",s);
3069 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
3072 Add3Com(option,numfunc);
3083 int CoChainin(UBYTE *s)
3085 return(DoChain(s,TYPECHAININ));
3095 int CoChainout(UBYTE *s)
3097 return(DoChain(s,TYPECHAINOUT));
3105 int CoExit(UBYTE *s)
3108 WORD code = TYPEEXIT;
3109 while ( *s ==
',' ) s++;
3111 Add3Com(TYPEEXIT,0);
3116 while ( *s ) {
if ( *s ==
'\\' ) s++; s++; }
3117 if ( name[-1] !=
'"' || s[-1] !=
'"' ) {
3118 MesPrint(
"&Illegal syntax for exit statement");
3122 AddComString(1,&code,name,0);
3132 int CoInParallel(UBYTE *s)
3134 return(DoInParallel(s,1));
3142 int CoNotInParallel(UBYTE *s)
3144 return(DoInParallel(s,0));
3157 int DoInParallel(UBYTE *s,
int par)
3166 #ifndef WITHPTHREADS 3170 AC.inparallelflag = par;
3172 for ( i = NumExpressions-1; i >= 0; i-- ) {
3174 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
3175 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
3184 while ( *s ==
',' ) s++;
3185 if ( *s == 0 )
break;
3186 if ( *s ==
'[' || FG.cTable[*s] == 0 ) {
3188 if ( ( s = SkipAName(s) ) == 0 ) {
3189 MesPrint(
"&Improper name for an expression: '%s'",t);
3193 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
3195 e = Expressions+number;
3196 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
3197 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
3203 else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
3204 MesPrint(
"&%s is not an expression",t);
3210 MesPrint(
"&Illegal object in InExpression statement");
3212 while ( *s && *s !=
',' ) s++;
3213 if ( *s == 0 )
break;
3226 int CoInExpression(UBYTE *s)
3233 if ( AC.inexprlevel >= MAXNEST ) {
3234 MesPrint(
"@Nesting of inexpression statements more than %d levels",(WORD)MAXNEST);
3237 AC.inexprsumcheck[AC.inexprlevel] = NestingChecksum();
3238 AC.inexprstack[AC.inexprlevel] = cbuf[AC.cbufnum].Pointer
3239 - cbuf[AC.cbufnum].Buffer + 2;
3241 *w++ = TYPEINEXPRESSION;
3244 while ( *s ==
',' ) s++;
3245 if ( *s == 0 )
break;
3246 if ( *s ==
'[' || FG.cTable[*s] == 0 ) {
3248 if ( ( s = SkipAName(s) ) == 0 ) {
3249 MesPrint(
"&Improper name for an expression: '%s'",t);
3253 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
3256 else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
3257 MesPrint(
"&%s is not an expression",t);
3263 MesPrint(
"&Illegal object in InExpression statement");
3265 while ( *s && *s !=
',' ) s++;
3266 if ( *s == 0 )
break;
3269 AT.WorkPointer[1] = w - AT.WorkPointer;
3270 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
3279 int CoEndInExpression(UBYTE *s)
3281 CBUF *C = cbuf+AC.cbufnum;
3282 while ( *s ==
',' ) s++;
3284 MesPrint(
"&Illegal syntax for EndInExpression statement");
3287 if ( AC.inexprlevel <= 0 ) {
3288 MesPrint(
"&EndInExpression without corresponding InExpression statement");
3292 cbuf[AC.cbufnum].Buffer[AC.inexprstack[AC.inexprlevel]] = C->numlhs;
3293 if ( AC.inexprsumcheck[AC.inexprlevel] != NestingChecksum() ) {
3305 int CoSetExitFlag(UBYTE *s)
3308 MesPrint(
"&Illegal syntax for the SetExitFlag statement");
3311 Add2Com(TYPESETEXIT);
3319 int CoTryReplace(UBYTE *p)
3323 WORD *w, error = 0, i, which = -1, c1, minvec = 0;
3340 if ( *p ==
'-' && minvec == 0 && which == (CVECTOR+1) ) {
3343 if ( *p ==
'[' || FG.cTable[*p] == 0 ) {
3345 if ( ( p = SkipAName(p) ) == 0 )
return(1);
3347 i = GetName(AC.varnames,name,&c1,WITHAUTO);
3348 if ( which >= 0 && i >= 0 && i != CDUBIOUS && which != (i+1) ) {
3349 MesPrint(
"&Illegal combination of objects in TryReplace");
3352 else if ( minvec && i != CVECTOR && i != CDUBIOUS ) {
3353 MesPrint(
"&Currently a - sign can be used only with a vector in TryReplace");
3357 case CSYMBOL: *w++ = -SYMBOL; *w++ = c1;
break;
3359 if ( minvec ) *w++ = -MINVECTOR;
3360 else *w++ = -VECTOR;
3361 *w++ = c1 + AM.OffsetVector;
3364 case CINDEX: *w++ = -INDEX; *w++ = c1 + AM.OffsetIndex;
3365 if ( c1 >= AM.WilInd && c ==
'?' ) { *p++ = c; c = *p; }
3367 case CFUNCTION: *w++ = -c1-FUNCTION;
break;
3368 case CDUBIOUS: minvec = 0; error = 1;
break;
3370 MesPrint(
"&Illegal object type in TryReplace: %s",name);
3375 if ( which < 0 ) which = i+1;
3378 if ( *p ==
',' ) p++;
3382 MesPrint(
"&Illegal object in TryReplace");
3384 while ( *p && *p !=
',' ) {
3385 if ( *p ==
'(' ) SKIPBRA3(p)
3386 else if ( *p ==
'{' ) SKIPBRA2(p)
3387 else if ( *p ==
'[' ) SKIPBRA1(p)
3391 if ( *p ==
',' ) p++;
3392 if ( which < 0 ) which = 0;
3396 MesPrint(
"&Odd number of arguments in TryReplace");
3399 i = w - AT.WorkPointer;
3400 AT.WorkPointer[1] = i;
3401 AT.WorkPointer[2] = i - 3;
3402 AT.WorkPointer[4] = i - 3;
3403 AddNtoL((
int)i,AT.WorkPointer);
3422 int CoModulus(UBYTE *inp)
3427 WORD sign = 1, Retval;
3428 while ( *inp ==
'-' || *inp ==
'+' ) {
3429 if ( *inp ==
'-' ) sign = -sign;
3433 if ( FG.cTable[*inp] != 1 ) {
3434 MesPrint(
"&Invalid value for modulus:%s",inp);
3435 if ( AC.modpowers ) M_free(AC.modpowers,
"AC.modpowers");
3439 do { inp++; }
while ( FG.cTable[*inp] == 1 );
3441 Retval = GetLong(p,(UWORD *)AC.cmod,&AC.ncmod);
3442 if ( sign < 0 ) AC.ncmod = -AC.ncmod;
3444 if ( c == 0 )
goto regular;
3445 else if ( c !=
':' ) {
3446 MesPrint(
"&Illegal option for modulus %s",inp);
3447 if ( AC.modpowers ) M_free(AC.modpowers,
"AC.modpowers");
3453 while ( FG.cTable[*inp] == 1 ) inp++;
3455 MesPrint(
"&Illegal character in option for modulus %s",inp);
3456 if ( AC.modpowers ) M_free(AC.modpowers,
"AC.modpowers");
3460 if ( GetLong(p,(UWORD *)AC.powmod,&AC.npowmod) ) Retval = -1;
3461 if ( TakeModulus((UWORD *)AC.powmod,&AC.npowmod,AC.cmod,AC.ncmod,NOUNPACK) ) Retval = -1;
3462 if ( AC.npowmod == 0 ) {
3463 MesPrint(
"&Improper value for generator");
3466 if ( MakeModTable() ) Retval = -1;
3469 AN.ncmod = AC.ncmod;
3471 M_free(AC.halfmod,
"halfmod");
3472 AC.halfmod = 0; AC.nhalfmod = 0;
3474 if ( AC.modinverses ) {
3475 M_free(AC.halfmod,
"modinverses");
3482 int Retval = 0, sign = 1;
3484 while ( *inp ==
',' || *inp ==
' ' || *inp ==
'\t' ) inp++;
3487 if ( AC.modpowers ) M_free(AC.modpowers,
"AC.modpowers");
3489 AN.ncmod = AC.ncmod = 0;
3490 if ( AC.halfmod ) M_free(AC.halfmod,
"halfmod");
3491 AC.halfmod = 0; AC.nhalfmod = 0;
3492 if ( AC.modinverses ) M_free(AC.modinverses,
"modinverses");
3498 if ( *inp ==
'-' ) {
3503 while ( FG.cTable[*inp] == 0 ) {
3505 while ( FG.cTable[*inp] == 0 ) inp++;
3507 if ( StrICmp(p,(UBYTE *)
"nofunctions") == 0 ) {
3508 AC.modmode &= ~ALSOFUNARGS;
3510 else if ( StrICmp(p,(UBYTE *)
"alsofunctions") == 0 ) {
3511 AC.modmode |= ALSOFUNARGS;
3513 else if ( StrICmp(p,(UBYTE *)
"coefficientsonly") == 0 ) {
3514 AC.modmode &= ~ALSOFUNARGS;
3515 AC.modmode &= ~ALSOPOWERS;
3518 else if ( StrICmp(p,(UBYTE *)
"plusmin") == 0 ) {
3519 AC.modmode |= POSNEG;
3521 else if ( StrICmp(p,(UBYTE *)
"positive") == 0 ) {
3522 AC.modmode &= ~POSNEG;
3524 else if ( StrICmp(p,(UBYTE *)
"inversetable") == 0 ) {
3525 AC.modmode |= INVERSETABLE;
3527 else if ( StrICmp(p,(UBYTE *)
"noinversetable") == 0 ) {
3528 AC.modmode &= ~INVERSETABLE;
3530 else if ( StrICmp(p,(UBYTE *)
"nodollars") == 0 ) {
3531 AC.modmode &= ~ALSODOLLARS;
3533 else if ( StrICmp(p,(UBYTE *)
"alsodollars") == 0 ) {
3534 AC.modmode |= ALSODOLLARS;
3536 else if ( StrICmp(p,(UBYTE *)
"printpowersof") == 0 ) {
3538 if ( *inp !=
'(' ) {
3540 MesPrint(
"&Bad syntax in argument of PrintPowersOf(number) in Modulus statement");
3543 while ( *inp ==
',' || *inp ==
' ' || *inp ==
'\t' ) inp++;
3545 if ( FG.cTable[*inp] != 1 )
goto badsyntax;
3546 do { inp++; }
while ( FG.cTable[*inp] == 1 );
3548 if ( GetLong(p,(UWORD *)AC.powmod,&AC.npowmod) ) Retval = -1;
3549 if ( TakeModulus((UWORD *)AC.powmod,&AC.npowmod,AC.cmod,AC.ncmod,NOUNPACK) ) Retval = -1;
3550 if ( AC.npowmod == 0 ) {
3551 MesPrint(
"&Improper value for generator");
3554 if ( MakeModTable() ) Retval = -1;
3557 while ( *inp ==
',' || *inp ==
' ' || *inp ==
'\t' ) inp++;
3558 if ( *inp !=
')' )
goto badsyntax;
3562 else if ( StrICmp(p,(UBYTE *)
"alsopowers") == 0 ) {
3563 AC.modmode |= ALSOPOWERS;
3566 else if ( StrICmp(p,(UBYTE *)
"nopowers") == 0 ) {
3567 AC.modmode &= ~ALSOPOWERS;
3571 MesPrint(
"&Unrecognized option %s in Modulus statement",inp);
3575 while ( *inp ==
',' || *inp ==
' ' || *inp ==
'\t' ) inp++;
3577 MesPrint(
"&Modulus statement with no value!!!");
3583 if ( FG.cTable[*inp] != 1 ) {
3584 MesPrint(
"&Invalid value for modulus:%s",inp);
3585 if ( AC.modpowers ) M_free(AC.modpowers,
"AC.modpowers");
3587 AN.ncmod = AC.ncmod = 0;
3588 if ( AC.halfmod ) M_free(AC.halfmod,
"halfmod");
3589 AC.halfmod = 0; AC.nhalfmod = 0;
3590 if ( AC.modinverses ) M_free(AC.modinverses,
"modinverses");
3594 do { inp++; }
while ( FG.cTable[*inp] == 1 );
3596 Retval = GetLong(p,(UWORD *)AC.cmod,&AC.ncmod);
3597 if ( Retval == 0 && AC.ncmod == 0 )
goto SwitchOff;
3598 if ( sign < 0 ) AC.ncmod = -AC.ncmod;
3599 AN.ncmod = AC.ncmod;
3600 if ( ( AC.modmode & INVERSETABLE ) != 0 )
MakeInverses();
3601 if ( AC.halfmod ) M_free(AC.halfmod,
"halfmod");
3602 AC.halfmod = 0; AC.nhalfmod = 0;
3612 int CoRepeat(UBYTE *inp)
3615 AC.RepSumCheck[AC.RepLevel] = NestingChecksum();
3617 if ( AC.RepLevel > AM.RepMax ) {
3618 MesPrint(
"&Too many repeat levels. Maximum is %d",AM.RepMax);
3621 Add3Com(TYPEREPEAT,-1)
3622 while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
3624 error = CompileStatement(inp);
3625 if ( CoEndRepeat(inp) ) error = 1;
3635 int CoEndRepeat(UBYTE *inp)
3637 CBUF *C = cbuf+AC.cbufnum;
3638 int level, error = 0, repeatlevel = 0;
3641 if ( AC.RepLevel < 0 ) {
3642 MesPrint(
"&EndRepeat without Repeat");
3646 else if ( AC.RepSumCheck[AC.RepLevel] != NestingChecksum() ) {
3650 level = C->numlhs+1;
3651 while ( level > 0 ) {
3652 if ( C->
lhs[--level][0] == TYPEREPEAT ) {
3653 if ( repeatlevel == 0 ) {
3654 Add3Com(TYPEENDREPEAT,level)
3659 else if ( C->
lhs[level][0] == TYPEENDREPEAT ) repeatlevel++;
3673 int DoBrackets(UBYTE *inp,
int par)
3677 WORD *to, i, type, *w, error = 0;
3678 WORD c1,c2, *WorkSave;
3681 WorkSave = to = AT.WorkPointer;
3683 if ( AT.BrackBuf == 0 ) {
3684 AR.MaxBracket = 100;
3685 AT.BrackBuf = (WORD *)Malloc1(
sizeof(WORD)*(AR.MaxBracket+1),
"bracket buffer");
3689 AC.bracketindexflag = 0;
3690 AT.bracketindexflag = 0;
3691 if ( *p ==
'+' || *p ==
'-' ) p++;
3692 if ( p[-1] ==
',' && *p ) p--;
3693 if ( p[-1] ==
'+' && *p ) { biflag = 1;
if ( *p !=
',' ) { *--p =
','; } }
3694 else if ( p[-1] ==
'-' && *p ) { biflag = -1;
if ( *p !=
',' ) { *--p =
','; } }
3696 while ( *p ==
',' ) {
3697 redo: AR.BracketOn++;
3698 while ( *p ==
',' ) p++;
3699 if ( *p == 0 )
break;
3701 p++;
while ( *p ==
'0' ) p++;
3706 if ( p == 0 )
return(1);
3709 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
3711 if ( type == CVECTOR || type == CDUBIOUS ) {
3715 if ( p == 0 )
return(1);
3718 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
3719 if ( type != CVECTOR && type != CDUBIOUS ) {
3720 MesPrint(
"&Not a vector in dotproduct in bracket statement: %s",inp);
3723 else type = CDOTPRODUCT;
3726 MesPrint(
"&Illegal use of . after %s in bracket statement",inp);
3734 *to++ = SYMBOL; *to++ = 4; *to++ = c1; *to++ = 1;
break;
3736 *to++ = INDEX; *to++ = 3; *to++ = AM.OffsetVector + c1;
break;
3738 *to++ = c1+FUNCTION; *to++ = FUNHEAD; *to++ = 0;
3742 *to++ = DOTPRODUCT; *to++ = 5; *to++ = c1 + AM.OffsetVector;
3743 *to++ = c2 + AM.OffsetVector; *to++ = 1;
break;
3745 *to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX;
break;
3747 *to++ = SETSET; *to++ = 4; *to++ = c1; *to++ = Sets[c1].type;
break;
3749 MesPrint(
"&Illegal bracket request for %s",pp);
3755 MesCerr(
"separator",p);
3756 AC.BracketNormalize = 0;
3757 AT.WorkPointer = WorkSave;
3761 *to++ = 1; *to++ = 1; *to++ = 3;
3762 *AT.WorkPointer = to - AT.WorkPointer;
3763 AT.WorkPointer = to;
3764 AC.BracketNormalize = 1;
3765 if ( BracketNormalize(BHEAD WorkSave) ) { error = 1; AR.BracketOn = 0; }
3768 if ( *w == 4 || !*w ) { AR.BracketOn = 0; }
3771 if ( i < 0 ) i = -i;
3774 if ( i > AR.MaxBracket ) {
3776 newbuf = (WORD *)Malloc1(
sizeof(WORD)*(i+1),
"bracket buffer");
3778 if ( AT.BrackBuf != 0 ) M_free(AT.BrackBuf,
"bracket buffer");
3779 AT.BrackBuf = newbuf;
3785 AC.BracketNormalize = 0;
3786 if ( par == 1 ) AR.BracketOn = -AR.BracketOn;
3788 AC.bracketindexflag = biflag;
3789 AT.bracketindexflag = biflag;
3791 AT.WorkPointer = WorkSave;
3800 int CoBracket(UBYTE *inp)
3801 {
return(DoBrackets(inp,0)); }
3808 int CoAntiBracket(UBYTE *inp)
3809 {
return(DoBrackets(inp,1)); }
3819 int CoMultiBracket(UBYTE *inp)
3822 int i, error = 0, error1, type, num;
3826 if ( *inp !=
':' ) {
3827 MesPrint(
"&Illegal Multiple Bracket separator: %s",inp);
3831 if ( AC.MultiBracketBuf == 0 ) {
3832 AC.MultiBracketBuf = (WORD **)Malloc1(
sizeof(WORD *)*MAXMULTIBRACKETLEVELS,
"multi bracket buffer");
3833 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
3834 AC.MultiBracketBuf[i] = 0;
3838 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
3839 if ( AC.MultiBracketBuf[i] ) {
3840 M_free(AC.MultiBracketBuf[i],
"bracket buffer i");
3841 AC.MultiBracketBuf[i] = 0;
3844 AC.MultiBracketLevels = 0;
3846 AC.MultiBracketLevels = 0;
3850 if ( AT.BrackBuf == 0 ) {
3851 AR.MaxBracket = 100;
3852 AT.BrackBuf = (WORD *)Malloc1(
sizeof(WORD)*(AR.MaxBracket+1),
"bracket buffer");
3856 AC.bracketindexflag = 0;
3857 AT.bracketindexflag = 0;
3861 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
3862 if ( *inp == 0 )
goto RegEnd;
3867 while ( *s && *s !=
':' ) {
3868 if ( *s ==
'[' ) { SKIPBRA1(s) s++; }
3869 else if ( *s ==
'{' ) { SKIPBRA2(s) s++; }
3873 if ( StrICont(inp,(UBYTE *)
"antibrackets") == 0 ) { type = 1; }
3874 else if ( StrICont(inp,(UBYTE *)
"brackets") == 0 ) { type = 0; }
3876 MesPrint(
"&Illegal (anti)bracket specification in MultiBracket statement");
3877 if ( error == 0 ) error = 1;
3880 while ( FG.cTable[*inp] == 0 ) inp++;
3881 if ( *inp !=
',' ) {
3882 MesPrint(
"&Illegal separator after (anti)bracket specification in MultiBracket statement");
3883 if ( error == 0 ) error = 1;
3890 error1 = DoBrackets(inp, type);
3891 if ( error < 0 )
return(error1);
3892 if ( error1 > error ) error = error1;
3896 if ( AR.BracketOn ) {
3897 num = AT.BrackBuf[0];
3898 to = AC.MultiBracketBuf[i] = (WORD *)Malloc1((num+2)*
sizeof(WORD),
"bracket buffer i");
3900 *to++ = AR.BracketOn;
3908 *s = c;
if ( c ==
':' ) s++;
3914 MesPrint(
"&More than %d levels in MultiBracket statement",(WORD)MAXMULTIBRACKETLEVELS);
3915 if ( error == 0 ) error = 1;
3918 AC.MultiBracketLevels = i;
3921 AC.bracketindexflag = 0;
3922 AT.bracketindexflag = 0;
3951 WORD *CountComp(UBYTE *inp, WORD *to)
3955 WORD *w, mini = 0, type, c1, c2;
3963 while ( *p ==
',' ) {
3965 if ( *p ==
'[' || FG.cTable[*p] == 0 ) {
3966 if ( ( p = SkipAName(inp) ) == 0 )
return(0);
3968 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
3970 if ( type == CVECTOR || type == CDUBIOUS ) {
3974 if ( p == 0 )
return(0);
3977 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
3978 if ( type != CVECTOR && type != CDUBIOUS ) {
3979 MesPrint(
"&Not a vector in dotproduct in if statement: %s",inp);
3982 else type = CDOTPRODUCT;
3985 MesPrint(
"&Illegal use of . after %s in if statement",inp);
3986 if ( type == NAMENOTFOUND )
3987 MesPrint(
"&%s is not a properly declared variable",inp);
3990 while ( *p && *p !=
')' && *p !=
',' ) p++;
3991 if ( *p ==
',' && FG.cTable[p[1]] == 1 ) {
3993 while ( *p && *p !=
')' && *p !=
',' ) p++;
4001 *w++ = SYMBOL; *w++ = 4; *w++ = c1;
4002 Sgetnum:
if ( *p !=
',' ) {
4003 MesCerr(
"sequence",p);
4004 while ( *p && *p !=
')' && *p !=
',' ) p++;
4008 ParseSignedNumber(mini,p)
4009 if ( FG.cTable[p[-1]] != 1 || ( *p && *p !=
')' && *p !=
',' ) ) {
4010 while ( *p && *p !=
')' && *p !=
',' ) p++;
4013 MesPrint(
"&Improper value in count: %s",inp);
4015 while ( *p && *p !=
')' && *p !=
',' ) p++;
4020 *w++ = FUNCTION; *w++ = 4; *w++ = c1+FUNCTION;
goto Sgetnum;
4022 *w++ = DOTPRODUCT; *w++ = 5;
4023 *w++ = c2 + AM.OffsetVector;
4024 *w++ = c1 + AM.OffsetVector;
4027 *w++ = VECTOR; *w++ = 5;
4028 *w++ = c1 + AM.OffsetVector;
4030 *w++ = VECTBIT | DOTPBIT | FUNBIT;
4033 else if ( *p ==
'+' ) {
4036 while ( *p && *p !=
',' ) {
4037 if ( *p ==
'v' || *p ==
'V' ) {
4040 else if ( *p ==
'd' || *p ==
'D' ) {
4043 else if ( *p ==
'f' || *p ==
'F' 4044 || *p ==
't' || *p ==
'T' ) {
4047 else if ( *p ==
'?' ) {
4051 if ( p == 0 )
return(0);
4052 if ( ( c1 = DoTempSet(inp+1,p) ) < 0 )
return(0);
4053 if ( Sets[c1].type != CFUNCTION ) {
4054 MesPrint(
"&set type conflict: Function expected");
4062 if ( p == 0 )
return(0);
4064 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
4066 if ( type != CSET && type != CDUBIOUS ) {
4067 MesPrint(
"&%s is not a set",inp);
4077 MesCerr(
"specifier for vector",p);
4085 MesCerr(
"specifier for vector",p);
4086 while ( *p && *p !=
')' && *p !=
',' ) p++;
4088 *w++ = VECTBIT | DOTPBIT | FUNBIT;
4095 MesPrint(
"&%s is not a symbol, function, vector or dotproduct",inp);
4097 skipfield:
while ( *p && *p !=
')' && *p !=
',' ) p++;
4098 if ( *p && FG.cTable[p[1]] == 1 ) {
4100 while ( *p && *p !=
')' && *p !=
',' ) p++;
4107 while ( *p && *p !=
',' ) p++;
4112 if ( *p ==
')' ) p++;
4113 if ( *p ) { MesCerr(
"end of statement",p);
return(0); }
4114 if ( error )
return(0);
4139 static UWORD *CIscratC = 0;
4141 int CoIf(UBYTE *inp)
4144 int error = 0, level;
4145 WORD *w, *ww, *u, *s, *OldWork, *OldSpace = AT.WorkSpace;
4147 WORD lenpp, lenlev, ncoef, i, number;
4148 UBYTE *p, *pp, *ppp, c;
4149 CBUF *C = cbuf+AC.cbufnum;
4151 if ( *inp ==
'(' && inp[1] ==
',' ) inp += 2;
4152 else if ( *inp ==
'(' ) inp++;
4154 if ( CIscratC == 0 )
4155 CIscratC = (UWORD *)Malloc1((AM.MaxTal+2)*
sizeof(UWORD),
"CoIf");
4158 if ( AC.IfLevel >= AC.MaxIf ) DoubleIfBuffers();
4159 AC.IfCount[lenpp++] = 0;
4167 AC.IfSumCheck[AC.IfLevel] = NestingChecksum();
4169 w = OldWork = AT.WorkPointer;
4177 if ( FG.cTable[*p] == 1 ) {
4178 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4182 if ( GetLong(p,(UWORD *)w,&ncoef) ) { ncoef = 1; error = 1; }
4184 while ( FG.cTable[*++p] == 1 );
4187 if ( FG.cTable[*p] != 1 ) {
4188 MesCerr(
"sequence",p); error = 1;
goto OnlyNum;
4190 if ( GetLong(p,CIscratC,&ncoef) ) {
4191 ncoef = 1; error = 1;
4193 while ( FG.cTable[*++p] == 1 );
4195 MesPrint(
"&Division by zero!");
4200 if ( Simplify(BHEAD (UWORD *)w,(WORD *)(w-1),
4201 CIscratC,&ncoef) ) error = 1;
4208 s = (WORD *)CIscratC;
4210 while ( --i >= 0 ) *w++ = 0;
4215 while ( --i >= 0 ) *w++ = 0;
4216 s = (WORD *)CIscratC;
4228 while ( --ncoef >= 0 ) *w++ = 0;
4231 u[1] = WORDDIF(w,u);
4232 u[2] = (u[1] - 3)>>1;
4233 if ( level ) u[2] = -u[2];
4236 else if ( *p ==
'+' ) { p++;
goto ReDo; }
4237 else if ( *p ==
'-' ) { level ^= 1; p++;
goto ReDo; }
4238 else if ( *p ==
'c' || *p ==
'C' ) {
4239 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4240 while ( FG.cTable[*++p] == 0 );
4242 if ( !StrICmp(inp,(UBYTE *)
"count") ) {
4245 MesPrint(
"&no ( after count");
4251 c = *++p; *p = 0; *inp =
',';
4252 w = CountComp(inp,w);
4254 if ( w == 0 ) { error = 1;
goto endofif; }
4257 else if ( ConWord(inp,(UBYTE *)
"coefficient") && ( p - inp ) > 3 ) {
4266 else if ( *p ==
'm' || *p ==
'M' ) {
4267 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4268 while ( !FG.cTable[*++p] );
4270 if ( !StrICmp(inp,(UBYTE *)
"match") ) {
4273 MesPrint(
"&no ( after match");
4284 AT.WorkSpace = AT.WorkPointer = w;
4286 while ( FG.cTable[*ppp] == 0 && ppp < p ) ppp++;
4287 if ( *ppp ==
',' ) AC.idoption = 0;
4288 else AC.idoption = SUBMULTI;
4289 level = CoIdExpression(inp,TYPEIF);
4290 AT.WorkSpace = OldSpace;
4291 AT.WorkPointer = OldWork;
4293 if ( level < 0 ) { error = -1;
goto endofif; }
4299 s = u = C->
lhs[C->numlhs];
4300 while ( u < C->Pointer ) *w++ = *u++;
4306 else if ( !StrICmp(inp,(UBYTE *)
"multipleof") ) {
4307 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4310 MesPrint(
"&no ( after multipleof");
4311 error = 1;
goto endofif;
4314 if ( FG.cTable[*p] != 1 ) {
4315 Nomulof: MesPrint(
"&multipleof needs a short positive integer argument");
4316 error = 1;
goto endofif;
4319 if ( *p !=
')' || x <= 0 || x > MAXPOSITIVE )
goto Nomulof;
4321 *w++ = MULTIPLEOF; *w++ = 3; *w++ = (WORD)x;
4326 NoGood: MesPrint(
"&Unrecognized word: %s",inp);
4330 if ( c ==
'(' ) SKIPBRA4(p)
4335 else if ( *p ==
'f' || *p ==
'F' ) {
4336 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4337 while ( FG.cTable[*++p] == 0 );
4339 if ( !StrICmp(inp,(UBYTE *)
"findloop") ) {
4342 MesPrint(
"&no ( after findloop");
4348 c = *++p; *p = 0; *inp =
',';
4349 if ( CoFindLoop(inp) )
goto endofif;
4350 s = u = C->
lhs[C->numlhs];
4351 while ( u < C->Pointer ) *w++ = *u++;
4354 if ( w == 0 ) { error = 1;
goto endofif; }
4360 else if ( *p ==
'e' || *p ==
'E' ) {
4361 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4362 while ( FG.cTable[*++p] == 0 );
4364 if ( !StrICmp(inp,(UBYTE *)
"expression") ) {
4367 MesPrint(
"&no ( after expression");
4371 p++; ww = w; *w++ = IFEXPRESSION; w++;
4372 while ( *p !=
')' ) {
4373 if ( *p ==
',' ) { p++;
continue; }
4374 if ( *p ==
'[' || FG.cTable[*p] == 0 ) {
4376 if ( ( p = SkipAName(p) ) == 0 ) {
4377 MesPrint(
"&Improper name for an expression: '%s'",pp);
4382 if ( GetName(AC.exprnames,pp,&number,NOAUTO) == CEXPRESSION ) {
4385 else if ( GetName(AC.varnames,pp,&number,NOAUTO) != NAMENOTFOUND ) {
4386 MesPrint(
"&%s is not an expression",pp);
4393 MesPrint(
"&Illegal object in Expression in if-statement");
4395 while ( *p && *p !=
',' && *p !=
')' ) p++;
4396 if ( *p == 0 || *p ==
')' )
break;
4406 else if ( *p ==
'i' || *p ==
'I' ) {
4407 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4408 while ( FG.cTable[*++p] == 0 );
4410 if ( !StrICmp(inp,(UBYTE *)
"isfactorized") ) {
4413 ww = w; *w++ = IFISFACTORIZED; w++;
4416 p++; ww = w; *w++ = IFISFACTORIZED; w++;
4417 while ( *p !=
')' ) {
4418 if ( *p ==
',' ) { p++;
continue; }
4419 if ( *p ==
'[' || FG.cTable[*p] == 0 ) {
4421 if ( ( p = SkipAName(p) ) == 0 ) {
4422 MesPrint(
"&Improper name for an expression: '%s'",pp);
4427 if ( GetName(AC.exprnames,pp,&number,NOAUTO) == CEXPRESSION ) {
4430 else if ( GetName(AC.varnames,pp,&number,NOAUTO) != NAMENOTFOUND ) {
4431 MesPrint(
"&%s is not an expression",pp);
4438 MesPrint(
"&Illegal object in IsFactorized in if-statement");
4440 while ( *p && *p !=
',' && *p !=
')' ) p++;
4441 if ( *p == 0 || *p ==
')' )
break;
4452 else if ( *p ==
'o' || *p ==
'O' ) {
4464 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4465 while ( FG.cTable[*++p] == 0 );
4466 c = cc = *p; *p = 0;
4467 if ( !StrICmp(inp,(UBYTE *)
"occurs") ) {
4471 MesPrint(
"&no ( after occurs");
4477 cc = *++p; *p = 0; *inp =
','; pp = p;
4479 *w++ = IFOCCURS; *w++ = 0;
4481 while ( *inp ==
',' ) inp++;
4482 if ( *inp == 0 || *inp ==
')' )
break;
4488 if ( *inp ==
'[' || FG.cTable[*inp] == 0 ) {
4489 if ( ( p = SkipAName(inp) ) == 0 )
return(0);
4491 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
4493 if ( type == CVECTOR || type == CDUBIOUS ) {
4497 if ( p == 0 )
return(0);
4500 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
4501 if ( type != CVECTOR && type != CDUBIOUS ) {
4502 MesPrint(
"&Not a vector in dotproduct in if statement: %s",inp);
4505 else type = CDOTPRODUCT;
4508 MesPrint(
"&Illegal use of . after %s in if statement",inp);
4509 if ( type == NAMENOTFOUND )
4510 MesPrint(
"&%s is not a properly declared variable",inp);
4513 while ( *p && *p !=
')' && *p !=
',' ) p++;
4514 if ( *p ==
',' && FG.cTable[p[1]] == 1 ) {
4516 while ( *p && *p !=
')' && *p !=
',' ) p++;
4529 *w++ = c1 + AM.OffsetIndex;
4533 *w++ = c1 + AM.OffsetVector;
4537 *w++ = c1 + AM.OffsetVector;
4538 *w++ = c2 + AM.OffsetVector;
4545 MesPrint(
"&Illegal variable %s in occurs condition in if statement",inp);
4552 MesPrint(
"&Illegal object %s in occurs condition in if statement",inp);
4558 p = pp; *p = cc; *inp =
'(';
4561 MesPrint(
"&The occurs condition in the if statement needs arguments.");
4568 else if ( *p ==
'$' ) {
4569 if ( gotexp == 1 ) { MesCerr(
"position for )",p); error = 1; }
4571 while ( FG.cTable[*p] == 0 || FG.cTable[*p] == 1 ) p++;
4573 if ( ( i = GetDollar(inp) ) < 0 ) {
4574 MesPrint(
"&undefined dollar expression %s",inp);
4576 i = AddDollar(inp,DOLUNDEFINED,0,0);
4579 *w++ = IFDOLLAR; *w++ = 3; *w++ = i;
4585 if ( ( w = GetIfDollarFactor(&p,w) ) == 0 ) {
4589 else if ( *p !=
']' ) {
4598 else if ( *p ==
'(' ) {
4600 MesCerr(
"parenthesis",p);
4605 if ( ++lenlev >= AC.MaxIf ) DoubleIfBuffers();
4606 AC.IfCount[lenpp++] = w-OldWork;
4611 else if ( *p ==
')' ) {
4612 if ( gotexp == 0 ) { MesCerr(
"position for )",p); error = 1; }
4614 u = AC.IfCount[--lenpp]+OldWork;
4617 if ( lenlev <= 0 ) {
4618 AT.WorkSpace = OldSpace;
4619 AT.WorkPointer = OldWork;
4623 MesPrint(
"&unmatched parenthesis in if/while ()");
4625 while ( *++p ==
')' );
4628 level = CompileStatement(p);
4629 if ( level ) error = level;
4631 if ( CoEndIf(p) && error == 0 ) error = 1;
4637 else if ( *p ==
'>' ) {
4638 if ( gotexp == 0 )
goto NoExp;
4639 if ( p[1] ==
'=' ) { *w++ = GREATEREQUAL; *w++ = 2; p += 2; }
4640 else { *w++ = GREATER; *w++ = 2; p++; }
4643 else if ( *p ==
'<' ) {
4644 if ( gotexp == 0 )
goto NoExp;
4645 if ( p[1] ==
'=' ) { *w++ = LESSEQUAL; *w++ = 2; p += 2; }
4646 else { *w++ = LESS; *w++ = 2; p++; }
4649 else if ( *p ==
'=' ) {
4650 if ( gotexp == 0 )
goto NoExp;
4651 if ( p[1] ==
'=' ) p++;
4652 *w++ = EQUAL; *w++ = 2; p++;
4655 else if ( *p ==
'!' && p[1] ==
'=' ) {
4656 if ( gotexp == 0 ) { p++;
goto NoExp; }
4657 *w++ = NOTEQUAL; *w++ = 2; p += 2;
4660 else if ( *p ==
'|' && p[1] ==
'|' ) {
4661 if ( gotexp == 0 ) { p++;
goto NoExp; }
4662 *w++ = ORCOND; *w++ = 2; p += 2;
4665 else if ( *p ==
'&' && p[1] ==
'&' ) {
4666 if ( gotexp == 0 ) {
4669 MesCerr(
"sequence",p);
4673 *w++ = ANDCOND; *w++ = 2; p += 2;
4677 else if ( *p == 0 ) {
4678 MesPrint(
"&Unmatched parentheses");
4683 if ( FG.cTable[*p] == 0 ) {
4686 while ( ( ij = FG.cTable[*++p] ) == 0 || ij == 1 );
4690 MesCerr(
"sequence",p);
4704 int CoElse(UBYTE *p)
4707 CBUF *C = cbuf+AC.cbufnum;
4709 while ( *p ==
',' ) p++;
4710 if ( tolower(*p) ==
'i' && tolower(p[1]) ==
'f' && p[2] ==
'(' )
4711 return(CoElseIf(p+2));
4712 MesPrint(
"&No extra text allowed as part of an else statement");
4715 if ( AC.IfLevel <= 0 ) { MesPrint(
"&else statement without if");
return(1); }
4716 if ( AC.IfSumCheck[AC.IfLevel-1] != NestingChecksum() - 1 ) {
4720 Add3Com(TYPEELSE,AC.IfLevel)
4721 C->Buffer[AC.IfStack[-1]] = C->numlhs;
4722 AC.IfStack[-1] = C->Pointer - C->Buffer - 1;
4731 int CoElseIf(UBYTE *inp)
4733 CBUF *C = cbuf+AC.cbufnum;
4734 if ( AC.IfLevel <= 0 ) { MesPrint(
"&elseif statement without if");
return(1); }
4735 Add3Com(TYPEELSE,-AC.IfLevel)
4737 C->Buffer[*--AC.IfStack] = C->numlhs;
4758 int CoEndIf(UBYTE *inp)
4760 CBUF *C = cbuf+AC.cbufnum;
4761 WORD i = C->numlhs, to, k = -AC.IfLevel;
4763 while ( *inp ==
',' ) inp++;
4766 MesPrint(
"&No extra text allowed as part of an endif/elseif statement");
4768 if ( AC.IfLevel <= 0 ) {
4769 MesPrint(
"&Endif statement without corresponding if");
return(1);
4772 C->
Buffer[*--AC.IfStack] = i+1;
4773 if ( AC.IfSumCheck[AC.IfLevel] != NestingChecksum() ) {
4777 Add3Com(TYPEENDIF,i+1)
4783 if ( C->
lhs[i][0] == TYPEELSE && C->
lhs[i][2] == to ) to = i;
4784 if ( C->
lhs[i][0] == TYPEIF ) {
4785 if ( C->
lhs[i][2] == to ) {
4787 if ( i <= 0 || C->lhs[i][0] != TYPEELSE
4788 || C->
lhs[i][2] != k )
break;
4789 C->
lhs[i][2] = C->numlhs;
4803 int CoWhile(UBYTE *inp)
4805 CBUF *C = cbuf+AC.cbufnum;
4806 WORD startnum = C->numlhs + 1;
4810 if ( C->numlhs > startnum && C->
lhs[startnum][2] == C->numlhs
4811 && C->
lhs[C->numlhs][0] == TYPEENDIF ) {
4812 C->
lhs[C->numlhs][2] = startnum-1;
4815 else C->
lhs[startnum][2] = startnum;
4824 int CoEndWhile(UBYTE *inp)
4828 CBUF *C = cbuf+AC.cbufnum;
4829 if ( AC.WhileLevel <= 0 ) {
4830 MesPrint(
"&EndWhile statement without corresponding While");
return(1);
4833 i = C->
Buffer[AC.IfStack[-1]];
4834 error = CoEndIf(inp);
4835 C->
lhs[C->numlhs][2] = i - 1;
4846 static char *messfind[] = {
4847 "Findloop(function,arguments=#,loopsize(=#|<#)[,include=index])" 4848 ,
"Replaceloop,function,arguments=#,loopsize(=#|<#),outfun=function[,include=index]" 4850 static WORD comfindloop[7] = { TYPEFINDLOOP,7,0,0,0,0,0 };
4852 int DoFindLoop(UBYTE *inp,
int mode)
4855 WORD funnum, nargs = 0, nloop = 0, indexnum = 0, outfun = 0;
4856 int type, aflag, lflag, indflag, outflag, error = 0, sym;
4857 while ( *inp ==
',' ) inp++;
4858 if ( ( s = SkipAName(inp) ) == 0 ) {
4859 syntax: MesPrint(
"&Proper syntax is:");
4860 MesPrint(
"%s",messfind[mode]);
4864 if ( ( ( type = GetName(AC.varnames,inp,&funnum,WITHAUTO) ) == NAMENOTFOUND )
4865 || type != CFUNCTION || ( ( sym = (functions[funnum].symmetric) & ~REVERSEORDER )
4866 != SYMMETRIC && sym != ANTISYMMETRIC ) ) {
4867 MesPrint(
"&%s should be a (anti)symmetric function or tensor",inp);
4871 aflag = lflag = indflag = outflag = 0;
4872 while ( *inp ==
',' ) {
4873 while ( *inp ==
',' ) inp++;
4875 if ( ( s = SkipAName(inp) ) == 0 )
goto syntax;
4877 if ( StrICont(inp,(UBYTE *)
"arguments") == 0 ) {
4878 if ( c !=
'=' )
goto syntax;
4880 NeedNumber(nargs,s,syntax)
4884 else if ( StrICont(inp,(UBYTE *)
"loopsize") == 0 ) {
4885 if ( c !=
'=' && c !=
'<' )
goto syntax;
4887 if ( FG.cTable[*s] == 1 ) {
4888 NeedNumber(nloop,s,syntax)
4890 MesPrint(
"&loopsize should be at least 2");
4893 if ( c ==
'<' ) nloop = -nloop;
4895 else if ( tolower(*s) ==
'a' && tolower(s[1]) ==
'l' 4896 && tolower(s[2]) ==
'l' && FG.cTable[s[3]] > 1 ) {
4898 if ( c !=
'=' )
goto syntax;
4903 else if ( StrICont(inp,(UBYTE *)
"include") == 0 ) {
4904 if ( c !=
'=' )
goto syntax;
4906 if ( ( inp = SkipAName(s) ) == 0 )
goto syntax;
4908 if ( ( type = GetName(AC.varnames,s,&indexnum,WITHAUTO) ) != CINDEX ) {
4909 MesPrint(
"&%s is not a proper index",s);
4912 else if ( indexnum < WILDOFFSET
4913 && indices[indexnum].dimension == 0 ) {
4914 MesPrint(
"&%s should be a summable index",s);
4917 indexnum += AM.OffsetIndex;
4921 else if ( StrICont(inp,(UBYTE *)
"outfun") == 0 ) {
4922 if ( c !=
'=' )
goto syntax;
4924 if ( ( inp = SkipAName(s) ) == 0 )
goto syntax;
4926 if ( ( type = GetName(AC.varnames,s,&outfun,WITHAUTO) ) != CFUNCTION ) {
4927 MesPrint(
"&%s is not a proper function or tensor",s);
4935 MesPrint(
"&Unrecognized option in FindLoop or ReplaceLoop: %s",inp);
4937 while ( *inp && *inp !=
',' ) inp++;
4940 if ( *inp != 0 && mode == REPLACELOOP )
goto syntax;
4941 if ( mode == FINDLOOP && outflag > 0 ) {
4942 MesPrint(
"&outflag option is illegal in FindLoop");
4945 if ( mode == REPLACELOOP && outflag == 0 )
goto syntax;
4946 if ( aflag == 0 || lflag == 0 )
goto syntax;
4947 comfindloop[3] = funnum;
4948 comfindloop[4] = nloop;
4949 comfindloop[5] = nargs;
4950 comfindloop[6] = outfun;
4953 if ( mode == 0 ) comfindloop[2] = indexnum + 5;
4954 else comfindloop[2] = -indexnum - 5;
4956 else comfindloop[2] = mode;
4957 AddNtoL(comfindloop[1],comfindloop);
4966 int CoFindLoop(UBYTE *inp)
4967 {
return(DoFindLoop(inp,FINDLOOP)); }
4974 int CoReplaceLoop(UBYTE *inp)
4975 {
return(DoFindLoop(inp,REPLACELOOP)); }
4982 static UBYTE *FunPowOptions[] = {
4983 (UBYTE *)
"nofunpowers" 4984 ,(UBYTE *)
"commutingonly" 4985 ,(UBYTE *)
"allfunpowers" 4988 int CoFunPowers(UBYTE *inp)
4991 int i, maxoptions =
sizeof(FunPowOptions)/
sizeof(UBYTE *);
4992 while ( *inp ==
',' ) inp++;
4994 inp = SkipAName(inp); c = *inp; *inp = 0;
4995 for ( i = 0; i < maxoptions; i++ ) {
4996 if ( StrICont(option,FunPowOptions[i]) == 0 ) {
4999 MesPrint(
"&Illegal FunPowers statement");
5006 MesPrint(
"&Illegal option in FunPowers statement: %s",option);
5015 int CoUnitTrace(UBYTE *s)
5018 if ( FG.cTable[*s] == 1 ) {
5021 nogood: MesPrint(
"&Value of UnitTrace should be a (positive) number or a symbol");
5024 AC.lUniTrace[0] = SNUMBER;
5025 AC.lUniTrace[2] = num;
5028 if ( GetName(AC.varnames,s,&num,WITHAUTO) == CSYMBOL ) {
5029 AC.lUniTrace[0] = SYMBOL;
5030 AC.lUniTrace[2] = num;
5035 if ( *s )
goto nogood;
5037 AC.lUnitTrace = num;
5050 int CoTerm(UBYTE *s)
5053 WORD *w = AT.WorkPointer;
5055 while ( *s ==
',' ) s++;
5057 MesPrint(
"&Illegal syntax for Term statement");
5060 if ( AC.termlevel+1 >= AC.maxtermlevel ) {
5061 if ( AC.maxtermlevel <= 0 ) {
5062 AC.maxtermlevel = 20;
5063 AC.termstack = (LONG *)Malloc1(AC.maxtermlevel*
sizeof(LONG),
"termstack");
5064 AC.termsortstack = (LONG *)Malloc1(AC.maxtermlevel*
sizeof(LONG),
"termsortstack");
5065 AC.termsumcheck = (WORD *)Malloc1(AC.maxtermlevel*
sizeof(WORD),
"termsumcheck");
5068 DoubleBuffer((
void **)AC.termstack,(
void **)AC.termstack+AC.maxtermlevel,
5069 sizeof(LONG),
"doubling termstack");
5070 DoubleBuffer((
void **)AC.termsortstack,
5071 (
void **)AC.termsortstack+AC.maxtermlevel,
5072 sizeof(LONG),
"doubling termsortstack");
5073 DoubleBuffer((
void **)AC.termsumcheck,
5074 (
void **)AC.termsumcheck+AC.maxtermlevel,
5075 sizeof(LONG),
"doubling termsumcheck");
5076 AC.maxtermlevel *= 2;
5079 AC.termsumcheck[AC.termlevel] = NestingChecksum();
5080 AC.termstack[AC.termlevel] = cbuf[AC.cbufnum].Pointer
5081 - cbuf[AC.cbufnum].Buffer + 2;
5082 AC.termsortstack[AC.termlevel] = AC.termstack[AC.termlevel] + 1;
5086 *w++ = cbuf[AC.cbufnum].numlhs;
5087 *w++ = cbuf[AC.cbufnum].numlhs;
5088 AT.WorkPointer[1] = w - AT.WorkPointer;
5089 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
5098 int CoEndTerm(UBYTE *s)
5100 CBUF *C = cbuf+AC.cbufnum;
5101 while ( *s ==
',' ) s++;
5103 MesPrint(
"&Illegal syntax for EndTerm statement");
5106 if ( AC.termlevel <= 0 ) {
5107 MesPrint(
"&EndTerm without corresponding Argument statement");
5111 cbuf[AC.cbufnum].Buffer[AC.termstack[AC.termlevel]] = C->numlhs;
5112 cbuf[AC.cbufnum].Buffer[AC.termsortstack[AC.termlevel]] = C->numlhs;
5113 if ( AC.termsumcheck[AC.termlevel] != NestingChecksum() ) {
5125 int CoSort(UBYTE *s)
5128 WORD *w = AT.WorkPointer;
5130 while ( *s ==
',' ) s++;
5132 MesPrint(
"&Illegal syntax for Sort statement");
5135 if ( AC.termlevel <= 0 ) {
5136 MesPrint(
"&The Sort statement can only be used inside a term environment");
5139 if ( error )
return(error);
5143 cbuf[AC.cbufnum].Buffer[AC.termsortstack[AC.termlevel-1]] =
5144 *w = cbuf[AC.cbufnum].numlhs+1;
5146 AC.termsortstack[AC.termlevel-1] = cbuf[AC.cbufnum].Pointer
5147 - cbuf[AC.cbufnum].Buffer + 3;
5148 if ( AC.termsumcheck[AC.termlevel-1] != NestingChecksum() - 1 ) {
5152 AT.WorkPointer[1] = w - AT.WorkPointer;
5153 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
5164 int CoPolyFun(UBYTE *s)
5170 AR.PolyFun = AC.lPolyFun = 0;
5171 AR.PolyFunInv = AC.lPolyFunInv = 0;
5172 AR.PolyFunType = AC.lPolyFunType = 0;
5173 AR.PolyFunExp = AC.lPolyFunExp = 0;
5174 AR.PolyFunVar = AC.lPolyFunVar = 0;
5175 AR.PolyFunPow = AC.lPolyFunPow = 0;
5176 if ( *s == 0 ) {
return(0); }
5178 if ( t == 0 || *t != 0 ) {
5179 MesPrint(
"&PolyFun statement needs a single commuting function for its argument");
5182 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5183 || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
5184 MesPrint(
"&%s should be a regular commuting function",s);
5186 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5187 AddFunction(s,0,0,0,0,0,-1,-1);
5191 AR.PolyFun = AC.lPolyFun = numfun+FUNCTION;
5192 AR.PolyFunType = AC.lPolyFunType = 1;
5203 int CoPolyRatFun(UBYTE *s)
5209 AR.PolyFun = AC.lPolyFun = 0;
5210 AR.PolyFunInv = AC.lPolyFunInv = 0;
5211 AR.PolyFunType = AC.lPolyFunType = 0;
5212 AR.PolyFunExp = AC.lPolyFunExp = 0;
5213 AR.PolyFunVar = AC.lPolyFunVar = 0;
5214 AR.PolyFunPow = AC.lPolyFunPow = 0;
5215 if ( *s == 0 )
return(0);
5217 if ( t == 0 )
goto NumErr;
5219 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5220 || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
5221 MesPrint(
"&%s should be a regular commuting function",s);
5223 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5224 AddFunction(s,0,0,0,0,0,-1,-1);
5228 AR.PolyFun = AC.lPolyFun = numfun+FUNCTION;
5229 AR.PolyFunInv = AC.lPolyFunInv = 0;
5230 AR.PolyFunType = AC.lPolyFunType = 2;
5231 AC.PolyRatFunChanged = 1;
5232 if ( c == 0 )
return(0);
5234 if ( *t ==
'-' ) { AC.PolyRatFunChanged = 0; t++; }
5235 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5236 if ( *t == 0 )
return(0);
5240 if ( t == 0 )
goto NumErr;
5242 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5243 || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
5244 MesPrint(
"&%s should be a regular commuting function",s);
5246 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5247 AddFunction(s,0,0,0,0,0,-1,-1);
5251 AR.PolyFunInv = AC.lPolyFunInv = numfun+FUNCTION;
5252 if ( c == 0 )
return(0);
5254 if ( *t ==
'-' ) { AC.PolyRatFunChanged = 0; t++; }
5255 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5256 if ( *t == 0 )
return(0);
5260 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5268 if ( t == 0 )
goto NumErr;
5270 if ( ( StrICmp(s,(UBYTE *)
"divergence") == 0 )
5271 || ( StrICmp(s,(UBYTE *)
"finddivergence") == 0 ) ) {
5273 MesPrint(
"&Illegal option field in PolyRatFun statement.");
5277 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5280 if ( t == 0 )
goto NumErr;
5282 if ( ( type = GetName(AC.varnames,s,&AC.lPolyFunVar,WITHAUTO) ) != CSYMBOL ) {
5283 MesPrint(
"&Illegal symbol %s in option field in PolyRatFun statement.",s);
5287 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5289 MesPrint(
"&Illegal termination of option in PolyRatFun statement.");
5292 AR.PolyFunExp = AC.lPolyFunExp = 1;
5293 AR.PolyFunVar = AC.lPolyFunVar;
5294 symbols[AC.lPolyFunVar].minpower = -MAXPOWER;
5295 symbols[AC.lPolyFunVar].maxpower = MAXPOWER;
5297 else if ( StrICmp(s,(UBYTE *)
"expand") == 0 ) {
5298 WORD x = 0, etype = 2;
5300 MesPrint(
"&Illegal option field in PolyRatFun statement.");
5304 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5307 if ( t == 0 )
goto NumErr;
5309 if ( ( type = GetName(AC.varnames,s,&AC.lPolyFunVar,WITHAUTO) ) != CSYMBOL ) {
5310 MesPrint(
"&Illegal symbol %s in option field in PolyRatFun statement.",s);
5314 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5315 if ( *t >
'9' || *t <
'0' ) {
5316 MesPrint(
"&Illegal option field in PolyRatFun statement.");
5319 while ( *t <= '9' && *t >=
'0' ) x = 10*x + *t++ -
'0';
5320 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5324 if ( t == 0 )
goto ParErr;
5326 if ( StrICmp(s,(UBYTE *)
"fixed") == 0 ) {
5329 else if ( StrICmp(s,(UBYTE *)
"relative") == 0 ) {
5333 MesPrint(
"&Illegal termination of option in PolyRatFun statement.");
5337 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5339 MesPrint(
"&Illegal termination of option in PolyRatFun statement.");
5343 AR.PolyFunExp = AC.lPolyFunExp = etype;
5344 AR.PolyFunVar = AC.lPolyFunVar;
5345 AR.PolyFunPow = AC.lPolyFunPow = x;
5346 symbols[AC.lPolyFunVar].minpower = -MAXPOWER;
5347 symbols[AC.lPolyFunVar].maxpower = MAXPOWER;
5350 ParErr: MesPrint(
"&Illegal option %s in PolyRatFun statement.",s);
5354 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
5355 if ( *t == 0 )
return(0);
5358 MesPrint(
"&PolyRatFun statement needs one or two commuting function(s) for its argument(s)");
5367 int CoMerge(UBYTE *inp)
5371 WORD numfunc, option = 0;
5372 if ( tolower(s[0]) ==
'o' && tolower(s[1]) ==
'n' && tolower(s[2]) ==
'c' &&
5373 tolower(s[3]) ==
'e' && tolower(s[4]) ==
',' ) {
5376 else if ( tolower(s[0]) ==
'a' && tolower(s[1]) ==
'l' && tolower(s[2]) ==
'l' &&
5377 tolower(s[3]) ==
',' ) {
5381 if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
5384 MesPrint(
"&%s is undefined",s);
5385 numfunc = AddDollar(s+1,DOLINDEX,&one,1);
5388 tests: s = SkipAName(s);
5390 MesPrint(
"&Merge/shuffle should have a single function or $variable for its argument");
5394 else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
5395 numfunc += FUNCTION;
5398 else if ( type != -1 ) {
5399 if ( type != CDUBIOUS ) {
5400 NameConflict(type,s);
5401 type = MakeDubious(AC.varnames,s,&numfunc);
5406 MesPrint(
"&%s is not a function",s);
5407 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
5410 Add4Com(TYPEMERGE,numfunc,option);
5423 int CoStuffle(UBYTE *inp)
5425 UBYTE *s = inp, *ss, c;
5427 WORD numfunc, option = 0;
5428 if ( tolower(s[0]) ==
'o' && tolower(s[1]) ==
'n' && tolower(s[2]) ==
'c' &&
5429 tolower(s[3]) ==
'e' && tolower(s[4]) ==
',' ) {
5432 else if ( tolower(s[0]) ==
'a' && tolower(s[1]) ==
'l' && tolower(s[2]) ==
'l' &&
5433 tolower(s[3]) ==
',' ) {
5439 if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
5442 MesPrint(
"&%s is undefined",s);
5443 numfunc = AddDollar(s+1,DOLINDEX,&one,1);
5447 if ( *ss !=
'+' && *ss !=
'-' && ss[1] != 0 ) {
5448 MesPrint(
"&Stuffle should have a single function or $variable for its argument, followed by either + or -");
5451 if ( *ss ==
'-' ) option += 2;
5453 else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
5454 numfunc += FUNCTION;
5457 else if ( type != -1 ) {
5458 if ( type != CDUBIOUS ) {
5459 NameConflict(type,s);
5460 type = MakeDubious(AC.varnames,s,&numfunc);
5465 MesPrint(
"&%s is not a function",s);
5466 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
5469 Add4Com(TYPESTUFFLE,numfunc,option);
5478 int CoProcessBucket(UBYTE *s)
5481 while ( *s ==
',' || *s ==
'=' ) s++;
5483 if ( *s && *s !=
' ' && *s !=
'\t' ) {
5484 MesPrint(
"&Numerical value expected for ProcessBucketSize");
5487 AC.ProcessBucketSize = x;
5496 int CoThreadBucket(UBYTE *s)
5499 while ( *s ==
',' || *s ==
'=' ) s++;
5501 if ( *s && *s !=
' ' && *s !=
'\t' ) {
5502 MesPrint(
"&Numerical value expected for ThreadBucketSize");
5506 Warning(
"Negative of zero value not allowed for ThreadBucketSize. Adjusted to 1.");
5509 AC.ThreadBucketSize = x;
5511 if ( AS.MultiThreaded ) MakeThreadBuckets(-1,1);
5526 int DoArgPlode(UBYTE *s,
int par)
5529 WORD numfunc, type, error = 0, *w, n;
5535 while ( *s ==
',' ) s++;
5538 MesPrint(
"&We don't do dollar variables yet in ArgImplode/ArgExplode");
5542 if ( ( s = SkipAName(s) ) == 0 )
return(1);
5544 if ( ( type = GetName(AC.varnames,t,&numfunc,WITHAUTO) ) == CFUNCTION ) {
5545 numfunc += FUNCTION;
5547 else if ( type != -1 ) {
5548 if ( type != CDUBIOUS ) {
5549 NameConflict(type,t);
5550 type = MakeDubious(AC.varnames,t,&numfunc);
5555 MesPrint(
"&%s is not a function",t);
5556 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
5563 for ( i = 2; i < FUNHEAD; i++ ) *w++ = 0;
5565 if ( *s && *s !=
',' ) {
5566 MesPrint(
"&Illegal character in ArgImplode/ArgExplode statement: %s",s);
5569 while ( *s ==
',' ) s++;
5571 n = w - AT.WorkPointer;
5572 AT.WorkPointer[1] = n;
5582 int CoArgExplode(UBYTE *s) {
return(DoArgPlode(s,TYPEARGEXPLODE)); }
5589 int CoArgImplode(UBYTE *s) {
return(DoArgPlode(s,TYPEARGIMPLODE)); }
5596 int CoClearTable(UBYTE *s)
5599 int j, type, error = 0;
5603 MesPrint(
"&The ClearTable statement needs at least one (table) argument.");
5610 if ( ( ( type = GetName(AC.varnames,t,&numfun,WITHAUTO) ) != CFUNCTION )
5611 && type != CDUBIOUS ) {
5612 nofunc: MesPrint(
"&%s is not a table",t);
5614 if ( type < 0 ) numfun = AddFunction(t,0,0,0,0,0,-1,-1);
5616 if ( *s ==
',' ) s++;
5623 else if ( ( T = functions[numfun].tabl ) == 0 )
goto nofunc;
5626 if ( *s ==
',' ) s++;
5662 if ( TT->
mm ) M_free(TT->
mm,
"tableminmax");
5663 if ( TT->
flags ) M_free(TT->
flags,
"tableflags");
5678 int CoDenominators(UBYTE *s)
5682 UBYTE *t = SkipAName(s), *t1;
5683 if ( t == 0 )
goto syntaxerror;
5684 t1 = t;
while ( *t1 ==
',' || *t1 ==
' ' || *t1 ==
'\t' ) t1++;
5685 if ( *t1 )
goto syntaxerror;
5687 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5688 || ( functions[numfun].spec != 0 ) ) {
5690 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5691 AddFunction(s,0,0,0,0,0,-1,-1);
5695 Add3Com(TYPEDENOMINATORS,numfun+FUNCTION);
5698 MesPrint(
"&Denominators statement needs one regular function for its argument");
5707 int CoDropCoefficient(UBYTE *s)
5710 Add2Com(TYPEDROPCOEFFICIENT)
5713 MesPrint(
"&Illegal argument in DropCoefficient statement: '%s'",s);
5721 int CoDropSymbols(UBYTE *s)
5724 Add2Com(TYPEDROPSYMBOLS)
5727 MesPrint(
"&Illegal argument in DropSymbols statement: '%s'",s);
5744 int CoToPolynomial(UBYTE *inp)
5747 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5748 if ( ( AC.topolynomialflag & ~TOPOLYNOMIALFLAG ) != 0 ) {
5749 MesPrint(
"&ToPolynomial statement and FactArg statement are not allowed in the same module");
5752 if ( AO.OptimizeResult.code != NULL ) {
5753 MesPrint(
"&Using ToPolynomial statement when there are still optimization results active.");
5754 MesPrint(
"&Please use #ClearOptimize instruction first.");
5755 MesPrint(
"&This will loose the optimized expression.");
5759 Add3Com(TYPETOPOLYNOMIAL,DOALL)
5763 WORD *funnums = 0, type, num;
5766 if ( s == 0 )
return(1);
5768 if ( StrICmp(inp,(UBYTE *)
"onlyfunctions") ) {
5769 MesPrint(
"&Illegal option %s in ToPolynomial statement",inp);
5775 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5781 funnums = (WORD *)Malloc1(((LONG)(s-inp)+3)*
sizeof(WORD),
"ToPlynomial");
5784 if ( s == 0 )
return(1);
5786 type = GetName(AC.varnames,inp,&num,WITHAUTO);
5787 if ( type != CFUNCTION ) {
5788 MesPrint(
"&%s is not a function in ToPolynomial statement",inp);
5791 funnums[3+numargs++] = num+FUNCTION;
5794 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5796 funnums[0] = TYPETOPOLYNOMIAL;
5797 funnums[1] = numargs+3;
5798 funnums[2] = ONLYFUNCTIONS;
5801 if ( funnums ) M_free(funnums,
"ToPolynomial");
5803 AC.topolynomialflag |= TOPOLYNOMIALFLAG;
5806 AC.mparallelflag |= NOPARALLEL_CONVPOLY;
5819 int CoFromPolynomial(UBYTE *inp)
5821 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5823 if ( AO.OptimizeResult.code != NULL ) {
5824 MesPrint(
"&Using FromPolynomial statement when there are still optimization results active.");
5825 MesPrint(
"&Please use #ClearOptimize instruction first.");
5826 MesPrint(
"&This will loose the optimized expression.");
5829 Add2Com(TYPEFROMPOLYNOMIAL)
5832 MesPrint(
"&Illegal argument in FromPolynomial statement: '%s'",inp);
5845 int CoArgToExtraSymbol(UBYTE *s)
5847 CBUF *C = cbuf + AC.cbufnum;
5851 if ( ( AC.topolynomialflag & ~TOPOLYNOMIALFLAG ) != 0 ) {
5852 MesPrint(
"&ArgToExtraSymbol statement and FactArg statement are not allowed in the same module");
5855 if ( AO.OptimizeResult.code != NULL ) {
5856 MesPrint(
"&Using ArgToExtraSymbol statement when there are still optimization results active.");
5857 MesPrint(
"&Please use #ClearOptimize instruction first.");
5858 MesPrint(
"&This will loose the optimized expression.");
5863 int tonumber = ConsumeOption(&s,
"tonumber");
5865 int ret = DoArgument(s,TYPEARGTOEXTRASYMBOL);
5866 if ( ret )
return(ret);
5872 lhs = C->
lhs[C->numlhs];
5873 if ( lhs[4] != 1 ) {
5874 Warning(
"scale parameter (^n) is ignored in ArgToExtraSymbol");
5878 AC.topolynomialflag |= TOPOLYNOMIALFLAG;
5884 AC.mparallelflag |= NOPARALLEL_CONVPOLY;
5895 int CoExtraSymbols(UBYTE *inp)
5897 UBYTE *arg1, *arg2, c, *s;
5898 WORD i, j, type, number;
5899 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5900 if ( FG.cTable[*inp] != 0 ) {
5901 MesPrint(
"&Illegal argument in ExtraSymbols statement: '%s'",inp);
5905 while ( FG.cTable[*inp] == 0 ) inp++;
5907 if ( ( StrICmp(arg1,(UBYTE *)
"array") == 0 )
5908 || ( StrICmp(arg1,(UBYTE *)
"vector") == 0 ) ) {
5909 AC.extrasymbols = 1;
5911 else if ( StrICmp(arg1,(UBYTE *)
"underscore") == 0 ) {
5912 AC.extrasymbols = 0;
5920 MesPrint(
"&Illegal keyword in ExtraSymbols statement: '%s'",arg1);
5924 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5925 if ( FG.cTable[*inp] != 0 ) {
5926 MesPrint(
"&Illegal argument in ExtraSymbols statement: '%s'",inp);
5930 while ( FG.cTable[*inp] <= 1 ) inp++;
5932 MesPrint(
"&Illegal end of ExtraSymbols statement: '%s'",inp);
5939 if ( AC.extrasymbols == 1 ) {
5940 type = GetName(AC.varnames,arg2,&number,NOAUTO);
5941 if ( type != NAMENOTFOUND ) {
5942 MesPrint(
"&ExtraSymbols statement: '%s' has already been declared before",arg2);
5946 else if ( AC.extrasymbols == 0 ) {
5947 if ( *arg2 ==
'N' ) {
5949 while ( FG.cTable[*s] == 1 ) s++;
5951 MesPrint(
"&ExtraSymbols statement: '%s' creates conflicts with summed indices",arg2);
5956 if ( AC.extrasym ) { M_free(AC.extrasym,
"extrasym"); AC.extrasym = 0; }
5958 AC.extrasym = (UBYTE *)Malloc1(i*
sizeof(UBYTE),
"extrasym");
5959 for ( j = 0; j < i; j++ ) AC.extrasym[j] = arg2[j];
5968 WORD *GetIfDollarFactor(UBYTE **inp, WORD *w)
5974 if ( FG.cTable[*s] == 1 ) {
5976 while ( FG.cTable[*s] == 1 ) {
5977 x = 10*x + *s++ -
'0';
5978 if ( x >= MAXPOSITIVE ) {
5979 MesPrint(
"&Value in dollar factor too large");
5980 while ( FG.cTable[*s] == 1 ) s++;
5985 *w++ = IFDOLLAREXTRA;
5992 MesPrint(
"&Factor indicator for $-variable should be a number or a $-variable.");
5996 while ( FG.cTable[*s] < 2 ) s++;
5998 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
5999 MesPrint(
"&dollar in if statement should have been defined previously");
6003 *w++ = IFDOLLAREXTRA;
6009 if ( ( w = GetIfDollarFactor(inp,w) ) == 0 )
return(0);
6012 MesPrint(
"&unmatched [] in $ in if statement");
6026 UBYTE *GetDoParam(UBYTE *inp, WORD **wp,
int par)
6031 if ( FG.cTable[*inp] == 1 ) {
6033 while ( *inp >=
'0' && *inp <=
'9' ) {
6034 x = 10*x + *inp++ -
'0';
6035 if ( x > MAXPOSITIVE ) {
6037 MesPrint(
"&Value in dollar factor too large");
6040 MesPrint(
"&Value in do loop boundaries too large");
6042 while ( FG.cTable[*inp] == 1 ) inp++;
6051 *(*wp)++ = DOLLAREXPR2;
6052 *(*wp)++ = -((WORD)x)-1;
6056 if ( *inp !=
'$' ) {
6060 while ( FG.cTable[*inp] < 2 ) inp++;
6062 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
6064 MesPrint(
"&dollar in print statement should have been defined previously");
6067 MesPrint(
"&dollar in do loop boundaries should have been defined previously");
6073 *(*wp)++ = DOLLAREXPRESSION;
6077 *(*wp)++ = DOLLAREXPR2;
6082 inp = GetDoParam(inp,wp,0);
6083 if ( inp == 0 )
return(0);
6084 if ( *inp !=
']' ) {
6086 MesPrint(
"&unmatched [] in $ in print statement");
6089 MesPrint(
"&unmatched [] in do loop boundaries");
6103 int CoDo(UBYTE *inp)
6106 CBUF *C = cbuf+AC.cbufnum;
6110 if ( AC.doloopstack == 0 ) {
6111 AC.doloopstacksize = 20;
6112 AC.doloopstack = (WORD *)Malloc1(AC.doloopstacksize*2*
sizeof(WORD),
"doloop stack");
6113 AC.doloopnest = AC.doloopstack + AC.doloopstacksize;
6115 if ( AC.dolooplevel >= AC.doloopstacksize ) {
6116 WORD *newstack, *newnest, newsize;
6117 newsize = AC.doloopstacksize * 2;
6118 newstack = (WORD *)Malloc1(newsize*2*
sizeof(WORD),
"doloop stack");
6119 newnest = newstack + newsize;
6120 for ( i = 0; i < newsize; i++ ) {
6121 newstack[i] = AC.doloopstack[i];
6122 newnest[i] = AC.doloopnest[i];
6124 M_free(AC.doloopstack,
"doloop stack");
6125 AC.doloopstack = newstack;
6126 AC.doloopnest = newnest;
6127 AC.doloopstacksize = newsize;
6129 AC.doloopnest[AC.dolooplevel] = NestingChecksum();
6137 while ( *inp ==
',' ) inp++;
6138 if ( *inp !=
'$' ) {
6140 MesPrint(
"&do loop parameter should be a dollar variable");
6145 if ( FG.cTable[*inp] != 0 ) {
6147 MesPrint(
"&illegal name for do loop parameter");
6149 while ( FG.cTable[*inp] < 2 ) inp++;
6151 if ( GetName(AC.dollarnames,name,&numparam,NOAUTO) == NAMENOTFOUND ) {
6152 numparam = AddDollar(name,DOLUNDEFINED,0,0);
6159 while ( *inp ==
',' ) inp++;
6160 if ( *inp !=
'=' )
goto IllSyntax;
6162 while ( *inp ==
',' ) inp++;
6166 inp = GetDoParam(inp,&w,1);
6167 if ( inp == 0 || *inp !=
',' )
goto IllSyntax;
6168 while ( *inp ==
',' ) inp++;
6172 inp = GetDoParam(inp,&w,1);
6173 if ( inp == 0 || ( *inp != 0 && *inp !=
',' ) )
goto IllSyntax;
6177 if ( *inp !=
',' ) {
6178 if ( *inp == 0 ) { *w++ = SNUMBER; *w++ = 1; }
6179 else goto IllSyntax;
6182 while ( *inp ==
',' ) inp++;
6183 inp = GetDoParam(inp,&w,1);
6185 if ( inp == 0 || *inp != 0 )
goto IllSyntax;
6187 AT.WorkPointer[1] = w - AT.WorkPointer;
6191 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
6192 AC.doloopstack[AC.dolooplevel++] = C->numlhs;
6197 MesPrint(
"&Illegal syntax for do statement");
6206 int CoEndDo(UBYTE *inp)
6208 CBUF *C = cbuf+AC.cbufnum;
6210 while ( *inp ==
',' ) inp++;
6212 MesPrint(
"&Illegal syntax for EndDo statement");
6215 if ( AC.dolooplevel <= 0 ) {
6216 MesPrint(
"&EndDo without corresponding Do statement");
6220 scratch[0] = TYPEENDDOLOOP;
6222 scratch[2] = AC.doloopstack[AC.dolooplevel];
6224 cbuf[AC.cbufnum].lhs[AC.doloopstack[AC.dolooplevel]][3] = C->numlhs;
6225 if ( AC.doloopnest[AC.dolooplevel] != NestingChecksum() ) {
6237 int CoFactDollar(UBYTE *inp)
6240 if ( *inp ==
'$' ) {
6241 if ( GetName(AC.dollarnames,inp+1,&numdollar,NOAUTO) != CDOLLAR ) {
6242 MesPrint(
"&%s is undefined",inp);
6243 numdollar = AddDollar(inp+1,DOLINDEX,&one,1);
6246 inp = SkipAName(inp+1);
6248 MesPrint(
"&FactDollar should have a single $variable for its argument");
6254 MesPrint(
"&%s is not a $-variable",inp);
6257 Add3Com(TYPEFACTOR,numdollar);
6266 int CoFactorize(UBYTE *s) {
return(DoFactorize(s,1)); }
6273 int CoNFactorize(UBYTE *s) {
return(DoFactorize(s,0)); }
6280 int CoUnFactorize(UBYTE *s) {
return(DoFactorize(s,3)); }
6287 int CoNUnFactorize(UBYTE *s) {
return(DoFactorize(s,2)); }
6294 int DoFactorize(UBYTE *s,
int par)
6300 int error = 0, keepzeroflag = 0;
6303 while ( *s !=
')' && *s ) {
6304 if ( FG.cTable[*s] == 0 ) {
6305 t = s;
while ( FG.cTable[*s] == 0 ) s++;
6307 if ( StrICmp((UBYTE *)
"keepzero",t) == 0 ) {
6311 MesPrint(
"&Illegal option in [N][Un]Factorize statement: %s",t);
6316 while ( *s ==
',' ) s++;
6317 if ( *s && *s !=
')' && FG.cTable[*s] != 0 ) {
6318 MesPrint(
"&Illegal character in option field of [N][Un]Factorize statement");
6324 while ( *s ==
',' || *s ==
' ' ) s++;
6327 for ( i = NumExpressions-1; i >= 0; i-- ) {
6329 if ( e->replace >= 0 ) {
6330 e = Expressions + e->replace;
6332 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
6333 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
6334 || e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION
6338 e->vflags &= ~TOBEFACTORED;
6341 e->vflags |= TOBEFACTORED;
6342 e->vflags &= ~TOBEUNFACTORED;
6345 e->vflags &= ~TOBEUNFACTORED;
6348 e->vflags |= TOBEUNFACTORED;
6349 e->vflags &= ~TOBEFACTORED;
6353 if ( ( e->vflags & TOBEFACTORED ) != 0 ) {
6354 if ( keepzeroflag ) e->vflags |= KEEPZERO;
6355 else e->vflags &= ~KEEPZERO;
6357 else e->vflags &= ~KEEPZERO;
6362 while ( *s ==
',' ) s++;
6363 if ( *s == 0 )
break;
6364 if ( *s ==
'[' || FG.cTable[*s] == 0 ) {
6366 if ( ( s = SkipAName(s) ) == 0 ) {
6367 MesPrint(
"&Improper name for an expression: '%s'",t);
6371 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
6372 e = Expressions+number;
6373 if ( e->replace >= 0 ) {
6374 e = Expressions + e->replace;
6376 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
6377 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
6378 || e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION
6382 e->vflags &= ~TOBEFACTORED;
6385 e->vflags |= TOBEFACTORED;
6386 e->vflags &= ~TOBEUNFACTORED;
6389 e->vflags &= ~TOBEUNFACTORED;
6392 e->vflags |= TOBEUNFACTORED;
6393 e->vflags &= ~TOBEFACTORED;
6397 if ( ( e->vflags & TOBEFACTORED ) != 0 ) {
6398 if ( keepzeroflag ) e->vflags |= KEEPZERO;
6399 else e->vflags &= ~KEEPZERO;
6401 else e->vflags &= ~KEEPZERO;
6403 else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
6404 MesPrint(
"&%s is not an expression",t);
6410 MesPrint(
"&Illegal object in (N)Factorize statement");
6412 while ( *s && *s !=
',' ) s++;
6413 if ( *s == 0 )
break;
6427 int CoOptimizeOption(UBYTE *s)
6429 UBYTE *name, *t1, *t2, c1, c2, *value, *u;
6432 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
6434 name = s;
while ( FG.cTable[*s] == 0 ) s++;
6436 while ( *s ==
' ' || *s ==
'\t' ) s++;
6439 MesPrint(
"&Correct use in Format,Optimize statement is Optionname=value");
6441 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' || *s ==
'=' ) s++;
6447 while ( *s ==
' ' || *s ==
'\t' ) s++;
6448 if ( *s == 0 )
goto correctuse;
6450 while ( FG.cTable[*s] <= 1 || *s==
'.' || *s==
'*' || *s ==
'(' || *s ==
')' ) {
6451 if ( *s ==
'(' ) { SKIPBRA4(s) }
6455 while ( *s ==
' ' || *s ==
'\t' ) s++;
6456 if ( *s && *s !=
',' )
goto correctuse;
6459 while ( *s ==
' ' || *s ==
'\t' ) s++;
6465 if ( StrICmp(name,(UBYTE *)
"horner") == 0 ) {
6466 if ( StrICmp(value,(UBYTE *)
"occurrence") == 0 ) {
6467 AO.Optimize.horner = O_OCCURRENCE;
6469 else if ( StrICmp(value,(UBYTE *)
"mcts") == 0 ) {
6470 AO.Optimize.horner = O_MCTS;
6472 else if ( StrICmp(value,(UBYTE *)
"sa") == 0 ) {
6473 AO.Optimize.horner = O_SIMULATED_ANNEALING;
6476 AO.Optimize.horner = -1;
6477 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6481 else if ( StrICmp(name,(UBYTE *)
"hornerdirection") == 0 ) {
6482 if ( StrICmp(value,(UBYTE *)
"forward") == 0 ) {
6483 AO.Optimize.hornerdirection = O_FORWARD;
6485 else if ( StrICmp(value,(UBYTE *)
"backward") == 0 ) {
6486 AO.Optimize.hornerdirection = O_BACKWARD;
6488 else if ( StrICmp(value,(UBYTE *)
"forwardorbackward") == 0 ) {
6489 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
6491 else if ( StrICmp(value,(UBYTE *)
"forwardandbackward") == 0 ) {
6492 AO.Optimize.hornerdirection = O_FORWARDANDBACKWARD;
6495 AO.Optimize.method = -1;
6496 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6500 else if ( StrICmp(name,(UBYTE *)
"method") == 0 ) {
6501 if ( StrICmp(value,(UBYTE *)
"none") == 0 ) {
6502 AO.Optimize.method = O_NONE;
6504 else if ( StrICmp(value,(UBYTE *)
"cse") == 0 ) {
6505 AO.Optimize.method = O_CSE;
6507 else if ( StrICmp(value,(UBYTE *)
"csegreedy") == 0 ) {
6508 AO.Optimize.method = O_CSEGREEDY;
6510 else if ( StrICmp(value,(UBYTE *)
"greedy") == 0 ) {
6511 AO.Optimize.method = O_GREEDY;
6514 AO.Optimize.method = -1;
6515 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6519 else if ( StrICmp(name,(UBYTE *)
"timelimit") == 0 ) {
6521 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6523 MesPrint(
"&Option TimeLimit in Format,Optimize statement should be a positive number: %s",value);
6524 AO.Optimize.mctstimelimit = 0;
6525 AO.Optimize.greedytimelimit = 0;
6529 AO.Optimize.mctstimelimit = x/2;
6530 AO.Optimize.greedytimelimit = x/2;
6533 else if ( StrICmp(name,(UBYTE *)
"mctstimelimit") == 0 ) {
6535 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6537 MesPrint(
"&Option MCTSTimeLimit in Format,Optimize statement should be a positive number: %s",value);
6538 AO.Optimize.mctstimelimit = 0;
6542 AO.Optimize.mctstimelimit = x;
6545 else if ( StrICmp(name,(UBYTE *)
"mctsnumexpand") == 0 ) {
6548 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6549 if ( *u ==
'*' || *u ==
'x' || *u ==
'X' ) {
6552 while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6556 MesPrint(
"&Option MCTSNumExpand in Format,Optimize statement should be a positive number: %s",value);
6557 AO.Optimize.mctsnumexpand= 0;
6558 AO.Optimize.mctsnumrepeat= 1;
6562 AO.Optimize.mctsnumexpand= x;
6563 AO.Optimize.mctsnumrepeat= y;
6566 else if ( StrICmp(name,(UBYTE *)
"mctsnumrepeat") == 0 ) {
6568 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6570 MesPrint(
"&Option MCTSNumExpand in Format,Optimize statement should be a positive number: %s",value);
6571 AO.Optimize.mctsnumrepeat= 1;
6575 AO.Optimize.mctsnumrepeat= x;
6578 else if ( StrICmp(name,(UBYTE *)
"mctsnumkeep") == 0 ) {
6580 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6582 MesPrint(
"&Option MCTSNumKeep in Format,Optimize statement should be a positive number: %s",value);
6583 AO.Optimize.mctsnumkeep= 0;
6587 AO.Optimize.mctsnumkeep= x;
6590 else if ( StrICmp(name,(UBYTE *)
"mctsconstant") == 0 ) {
6592 if ( sscanf ((
char*)value,
"%lf", &d) != 1 ) {
6593 MesPrint(
"&Option MCTSConstant in Format,Optimize statement should be a positive number: %s",value);
6594 AO.Optimize.mctsconstant.fval = 0;
6598 AO.Optimize.mctsconstant.fval = d;
6601 else if ( StrICmp(name,(UBYTE *)
"greedytimelimit") == 0 ) {
6603 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6605 MesPrint(
"&Option GreedyTimeLimit in Format,Optimize statement should be a positive number: %s",value);
6606 AO.Optimize.greedytimelimit = 0;
6610 AO.Optimize.greedytimelimit = x;
6613 else if ( StrICmp(name,(UBYTE *)
"greedyminnum") == 0 ) {
6615 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6617 MesPrint(
"&Option GreedyMinNum in Format,Optimize statement should be a positive number: %s",value);
6618 AO.Optimize.greedyminnum= 0;
6622 AO.Optimize.greedyminnum= x;
6625 else if ( StrICmp(name,(UBYTE *)
"greedymaxperc") == 0 ) {
6627 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6629 MesPrint(
"&Option GreedyMaxPerc in Format,Optimize statement should be a positive number: %s",value);
6630 AO.Optimize.greedymaxperc= 0;
6634 AO.Optimize.greedymaxperc= x;
6637 else if ( StrICmp(name,(UBYTE *)
"stats") == 0 ) {
6638 if ( StrICmp(value,(UBYTE *)
"on") == 0 ) {
6639 AO.Optimize.printstats = 1;
6641 else if ( StrICmp(value,(UBYTE *)
"off") == 0 ) {
6642 AO.Optimize.printstats = 0;
6645 AO.Optimize.printstats = 0;
6646 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6650 else if ( StrICmp(name,(UBYTE *)
"printscheme") == 0 ) {
6651 if ( StrICmp(value,(UBYTE *)
"on") == 0 ) {
6652 AO.Optimize.schemeflags |= 1;
6654 else if ( StrICmp(value,(UBYTE *)
"off") == 0 ) {
6655 AO.Optimize.schemeflags &= ~1;
6658 AO.Optimize.schemeflags &= ~1;
6659 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6663 else if ( StrICmp(name,(UBYTE *)
"debugflag") == 0 ) {
6671 if ( FG.cTable[*u] == 1 ) {
6672 while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6674 MesPrint(
"&Numerical value for DebugFlag in Format,Optimize statement should be a nonnegative number: %s",value);
6675 AO.Optimize.debugflags = 0;
6679 AO.Optimize.debugflags = x;
6682 else if ( StrICmp(value,(UBYTE *)
"on") == 0 ) {
6683 AO.Optimize.debugflags = 1;
6685 else if ( StrICmp(value,(UBYTE *)
"off") == 0 ) {
6686 AO.Optimize.debugflags = 0;
6689 AO.Optimize.debugflags = 0;
6690 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6694 else if ( StrICmp(name,(UBYTE *)
"scheme") == 0 ) {
6701 MesPrint(
"&Option Scheme in Format,Optimize statement should be an array of names or integers between (): %s",value);
6706 while ( *ss ==
' ' || *ss ==
'\t' || *ss ==
',' ) ss++;
6707 if ( FG.cTable[*ss] == 0 || *ss ==
'$' || *ss ==
'[' ) {
6708 s1 = u; SKIPBRA3(s1)
6709 if ( *s1 !=
')' )
goto noscheme;
6710 while ( ss < s1 ) {
if ( *ss++ ==
',' ) AO.schemenum++; }
6711 *ss++ = 0;
while ( *ss ==
' ' ) ss++;
6712 if ( *ss != 0 )
goto noscheme;
6714 if ( AO.schemenum < 1 ) {
6715 MesPrint(
"&Option Scheme in Format,Optimize statement should have at least one name or number between ()");
6719 if ( AO.inscheme ) M_free(AO.inscheme,
"Horner input scheme");
6720 AO.inscheme = (WORD *)Malloc1((AO.schemenum+1)*
sizeof(WORD),
"Horner input scheme");
6721 while ( *ss ==
' ' || *ss ==
'\t' || *ss ==
',' ) ss++;
6724 if ( *ss == 0 )
break;
6725 s1 = ss; ss = SkipAName(s1); c = *ss; *ss = 0;
6727 if ( ss[-1] ==
'_' ) {
6732 u1 = s1; u2 = AC.extrasym;
6733 while ( *u1 == *u2 ) { u1++; u2++; }
6736 while ( *u1 >=
'0' && *u1 <=
'9' ) numsym = 10*numsym + *u1++ -
'0';
6737 if ( u1 != ss-1 || numsym == 0 || AC.extrasymbols != 0 ) {
6738 MesPrint(
"&Improper use of extra symbol in scheme format option");
6741 numsym = MAXVARIABLES-numsym;
6746 else if ( *s1 ==
'$' ) {
6749 if ( ( numdollar = GetDollar(s1+1) ) < 0 ) {
6750 MesPrint(
"&Undefined variable %s",s1);
6753 else if ( ( numsym = DolToSymbol(BHEAD numdollar) ) < 0 ) {
6754 MesPrint(
"&$%s does not evaluate to a symbol",s1);
6760 else if ( c ==
'(' ) {
6761 if ( StrCmp(s1,AC.extrasym) == 0 ) {
6762 if ( (AC.extrasymbols&1) != 1 ) {
6763 MesPrint(
"&Improper use of extra symbol in scheme format option");
6768 while ( *ss >=
'0' && *ss <=
'9' ) numsym = 10*numsym + *ss++ -
'0';
6770 MesPrint(
"&Extra symbol should have a number for its argument.");
6773 numsym = MAXVARIABLES-numsym;
6778 type = GetName(AC.varnames,s1,&numsym,WITHAUTO);
6779 if ( ( type != CSYMBOL ) && type != CDUBIOUS ) {
6780 MesPrint(
"&%s is not a symbol",s1);
6782 if ( type < 0 ) numsym = AddSymbol(s1,-MAXPOWER,MAXPOWER,0,0);
6786 AO.inscheme[AO.schemenum++] = numsym;
6787 while ( *ss ==
' ' || *ss ==
'\t' || *ss ==
',' ) ss++;
6791 else if ( StrICmp(name,(UBYTE *)
"mctsdecaymode") == 0 ) {
6794 if ( FG.cTable[*u] == 1 ) {
6795 while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6797 MesPrint(
"&Option MCTSDecayMode in Format,Optimize statement should be a nonnegative integer: %s",value);
6798 AO.Optimize.mctsdecaymode = 0;
6802 AO.Optimize.mctsdecaymode = x;
6806 AO.Optimize.mctsdecaymode = 0;
6807 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6811 else if ( StrICmp(name,(UBYTE *)
"saiter") == 0 ) {
6813 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6815 MesPrint(
"&Option SAIter in Format,Optimize statement should be a positive integer: %s",value);
6816 AO.Optimize.saIter = 0;
6820 AO.Optimize.saIter= x;
6823 else if ( StrICmp(name,(UBYTE *)
"samaxt") == 0 ) {
6825 if ( sscanf ((
char*)value,
"%lf", &d) != 1 ) {
6826 MesPrint(
"&Option SAMaxT in Format,Optimize statement should be a positive number: %s",value);
6827 AO.Optimize.saMaxT.fval = 0;
6831 AO.Optimize.saMaxT.fval = d;
6834 else if ( StrICmp(name,(UBYTE *)
"samint") == 0 ) {
6836 if ( sscanf ((
char*)value,
"%lf", &d) != 1 ) {
6837 MesPrint(
"&Option SAMinT in Format,Optimize statement should be a positive number: %s",value);
6838 AO.Optimize.saMinT.fval = 0;
6842 AO.Optimize.saMinT.fval = d;
6846 MesPrint(
"&Unrecognized option name in Format,Optimize statement: %s",name);
6863 int CoPutInside(UBYTE *inp) {
return(DoPutInside(inp,1)); }
6864 int CoAntiPutInside(UBYTE *inp) {
return(DoPutInside(inp,-1)); }
6866 int DoPutInside(UBYTE *inp,
int par)
6870 WORD *to, type, c1,c2,funnum, *WorkSave;
6872 while ( *inp ==
' ' || *inp ==
'\t' || *inp ==
',' ) inp++;
6877 if ( p == 0 )
return(1);
6879 type = GetName(AC.varnames,inp,&funnum,WITHAUTO);
6880 if ( type != CFUNCTION || functions[funnum].tabl != 0 || functions[funnum].spec ) {
6881 MesPrint(
"&PutInside/AntiPutInside expects a regular function for its first argument");
6882 MesPrint(
"&Argument is %s",inp);
6888 while ( *inp ==
' ' || *inp ==
'\t' || *inp ==
',' ) inp++;
6892 tocompiler[0] = TYPEPUTINSIDE;
6895 tocompiler[3] = funnum;
6899 MesPrint(
"&AntiPutInside needs inside information.");
6904 WorkSave = to = AT.WorkPointer;
6905 *to++ = TYPEPUTINSIDE;
6911 while ( *inp ==
' ' || *inp ==
'\t' || *inp ==
',' ) inp++;
6912 if ( *inp == 0 )
break;
6914 if ( p == 0 ) { error = 1;
break; }
6916 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
6918 if ( type == CVECTOR || type == CDUBIOUS ) {
6922 if ( p == 0 )
return(1);
6924 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
6925 if ( type != CVECTOR && type != CDUBIOUS ) {
6926 MesPrint(
"&Not a vector in dotproduct in PutInside/AntiPutInside statement: %s",inp);
6929 else type = CDOTPRODUCT;
6932 MesPrint(
"&Illegal use of . after %s in PutInside/AntiPutInside statement",inp);
6940 *to++ = SYMBOL; *to++ = 4; *to++ = c1; *to++ = 1;
break;
6942 *to++ = INDEX; *to++ = 3; *to++ = AM.OffsetVector + c1;
break;
6944 *to++ = c1+FUNCTION; *to++ = FUNHEAD; *to++ = 0;
6948 *to++ = DOTPRODUCT; *to++ = 5; *to++ = c1 + AM.OffsetVector;
6949 *to++ = c2 + AM.OffsetVector; *to++ = 1;
break;
6951 *to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX;
break;
6953 MesPrint(
"&Illegal variable request for %s in PutInside/AntiPutInside statement",inp);
6959 *to++ = 1; *to++ = 1; *to++ = 3;
6960 AT.WorkPointer[1] = to - AT.WorkPointer;
6961 AT.WorkPointer[4] = AT.WorkPointer[1]-4;
6962 AT.WorkPointer = to;
6963 AC.BracketNormalize = 1;
6964 if ( Normalize(BHEAD WorkSave+4) ) { error = 1; }
6966 WorkSave[1] = WorkSave[4]+4;
6967 to = WorkSave + WorkSave[1] - 1;
6971 AddNtoL(WorkSave[1],WorkSave);
6973 AC.BracketNormalize = 0;
6974 AT.WorkPointer = WorkSave;
void AddPotModdollar(WORD)
WORD Generator(PHEAD WORD *, WORD)
LONG EndSort(PHEAD WORD *, int)