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 }
77 {
"stats", &(AC.StatsFlag), 1, 0}
78 ,{
"statistics", &(AC.StatsFlag), 1, 0}
79 ,{
"shortstats", &(AC.ShortStats), 1, 0}
80 ,{
"shortstatistics",&(AC.ShortStats), 1, 0}
81 ,{
"warnings", &(AC.WarnFlag), 1, 0}
82 ,{
"allwarnings", &(AC.WarnFlag), 2, 0}
83 ,{
"setup", &(AC.SetupFlag), 1, 0}
84 ,{
"names", &(AC.NamesFlag), 1, 0}
85 ,{
"allnames", &(AC.NamesFlag), 2, 0}
86 ,{
"codes", &(AC.CodesFlag), 1, 0}
87 ,{
"highfirst", &(AC.SortType), SORTHIGHFIRST, SORTLOWFIRST}
88 ,{
"lowfirst", &(AC.SortType), SORTLOWFIRST, SORTHIGHFIRST}
89 ,{
"powerfirst", &(AC.SortType), SORTPOWERFIRST, SORTHIGHFIRST}
90 ,{
"tokens", &(AC.TokensWriteFlag),1, 0}
94 {
"compress", &(AC.NoCompress), 0, 1}
95 ,{
"checkpoint", &(AC.CheckpointFlag), 1, 0}
96 ,{
"insidefirst", &(AC.insidefirst), 1, 0}
97 ,{
"propercount", &(AC.BottomLevel), 1, 0}
98 ,{
"stats", &(AC.StatsFlag), 1, 0}
99 ,{
"statistics", &(AC.StatsFlag), 1, 0}
100 ,{
"shortstats", &(AC.ShortStats), 1, 0}
101 ,{
"shortstatistics",&(AC.ShortStats), 1, 0}
102 ,{
"names", &(AC.NamesFlag), 1, 0}
103 ,{
"allnames", &(AC.NamesFlag), 2, 0}
104 ,{
"warnings", &(AC.WarnFlag), 1, 0}
105 ,{
"allwarnings", &(AC.WarnFlag), 2, 0}
106 ,{
"highfirst", &(AC.SortType), SORTHIGHFIRST, SORTLOWFIRST}
107 ,{
"lowfirst", &(AC.SortType), SORTLOWFIRST, SORTHIGHFIRST}
108 ,{
"powerfirst", &(AC.SortType), SORTPOWERFIRST, SORTHIGHFIRST}
109 ,{
"setup", &(AC.SetupFlag), 1, 0}
110 ,{
"codes", &(AC.CodesFlag), 1, 0}
111 ,{
"tokens", &(AC.TokensWriteFlag),1,0}
112 ,{
"properorder", &(AC.properorderflag),1,0}
113 ,{
"threadloadbalancing",&(AC.ThreadBalancing),1, 0}
114 ,{
"threads", &(AC.ThreadsFlag),1, 0}
115 ,{
"threadsortfilesynch",&(AC.ThreadSortFileSynch),1, 0}
116 ,{
"threadstats", &(AC.ThreadStats),1, 0}
117 ,{
"finalstats", &(AC.FinalStats),1, 0}
118 ,{
"fewerstats", &(AC.ShortStatsMax), 10, 0}
119 ,{
"fewerstatistics",&(AC.ShortStatsMax), 10, 0}
120 ,{
"processstats", &(AC.ProcessStats),1, 0}
121 ,{
"oldparallelstats",&(AC.OldParallelStats),1,0}
122 ,{
"parallel", &(AC.parallelflag),PARALLELFLAG,NOPARALLEL_USER}
123 ,{
"nospacesinnumbers",&(AO.NoSpacesInNumbers),1,0}
124 ,{
"indentspace", &(AO.IndentSpace),INDENTSPACE,0}
125 ,{
"totalsize", &(AM.PrintTotalSize), 1, 0}
126 ,{
"flag", (
int *)&(AC.debugFlags), 1, 0}
127 ,{
"oldfactarg", &(AC.OldFactArgFlag), 1, 0}
128 ,{
"memdebugflag", &(AC.MemDebugFlag), 1, 0}
129 ,{
"oldgcd", &(AC.OldGCDflag), 1, 0}
130 ,{
"innertest", &(AC.InnerTest), 1, 0}
131 ,{
"wtimestats", &(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 *onoffoptions[i].var = 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 *onoffoptions[i].var = 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;
960 WORD numexpr, tofile = 0, *w, par2 = 0;
961 CBUF *C = cbuf + AC.cbufnum;
962 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; handle = AC.LogHandle; }
970 else if ( *s ==
'<' ) {
973 while ( *s && *s !=
'>' ) s++;
975 MesPrint(
"&Improper filename in print statement");
980 if ( ( handle = GetChannel((
char *)filename,1) ) < 0 )
return(1);
981 SKIPBLANKS(s) if ( *s == ',' ) s++; SKIPBLANKS(s)
982 if ( *s == '+' && ( s[1] == 's' || s[1] == 'S' ) ) {
984 par2 |= PRINTONETERM;
985 if ( *s ==
's' || *s ==
'S' ) {
987 par2 |= PRINTONEFUNCTION;
988 if ( *s ==
's' || *s ==
'S' ) {
993 SKIPBLANKS(s) if ( *s == ',' ) s++; SKIPBLANKS(s)
996 if ( par == PRINTON && *s == '"' ) {
998 if ( tofile == 1 ) code[0] = TYPEFPRINT;
999 else code[0] = TYPEPRINT;
1003 while ( *s && *s !=
'"' ) {
1004 if ( *s ==
'\\' ) s++;
1005 if ( *s ==
'%' && s[1] ==
'$' ) numdol++;
1009 MesPrint(
"&String in print statement should be enclosed in \"");
1013 AddComString(3,code,name,1);
1015 while ( *s ==
',' ) {
1018 s++; name = s;
while ( FG.cTable[*s] <= 1 ) s++;
1020 type = GetName(AC.dollarnames,name,&numexpr,NOAUTO);
1021 if ( type == NAMENOTFOUND ) {
1022 MesPrint(
"&$ variable %s not (yet) defined",name);
1026 C->
lhs[C->numlhs][1] += 2;
1027 *(C->
Pointer)++ = DOLLAREXPRESSION;
1033 MesPrint(
"&Illegal object in print statement");
1041 s = GetDoParam(s,&(C->
Pointer),-1);
1042 if ( s == 0 )
return(1);
1044 MesPrint(
"&unmatched [] in $ factor");
1052 MesPrint(
"&Illegal object in print statement");
1056 MesPrint(
"&More $ variables asked for than provided");
1064 for ( e = Expressions, i = NumExpressions; i > 0; i--, e++ ) {
1065 if ( e->status == LOCALEXPRESSION || e->status ==
1066 GLOBALEXPRESSION || e->status == UNHIDELEXPRESSION
1067 || e->status == UNHIDEGEXPRESSION ) e->printflag = par;
1074 if ( tolower(*s) ==
'f' ) par |= PRINTLFILE;
1075 else if ( tolower(*s) ==
's' ) {
1076 if ( tolower(s[1]) ==
's' ) {
1077 if ( tolower(s[2]) ==
's' ) {
1078 par |= PRINTONEFUNCTION | PRINTONETERM | PRINTALL;
1081 else if ( ( par & 3 ) < 2 ) par |= PRINTONEFUNCTION | PRINTONETERM;
1085 if ( ( par & 3 ) < 2 ) par |= PRINTONETERM;
1089 illeg: MesPrint(
"&Illegal option in (n)print statement");
1093 if ( *s == 0 )
goto AllExpr;
1095 else if ( *s ==
'-' ) {
1097 if ( tolower(*s) ==
'f' ) par &= ~PRINTLFILE;
1098 else if ( tolower(*s) ==
's' ) {
1099 if ( tolower(s[1]) ==
's' ) {
1100 if ( tolower(s[2]) ==
's' ) {
1104 else if ( ( par & 3 ) < 2 ) {
1105 par &= ~PRINTONEFUNCTION;
1111 if ( ( par & 3 ) < 2 ) {
1112 par &= ~PRINTONETERM;
1113 par &= ~PRINTONEFUNCTION;
1120 if ( *s == 0 )
goto AllExpr;
1122 else if ( FG.cTable[*s] == 0 || *s ==
'[' ) {
1124 if ( ( s = SkipAName(s) ) == 0 ) {
1125 MesPrint(
"&Improper name in (n)print statement");
1129 if ( ( GetName(AC.exprnames,name,&numexpr,NOAUTO) == CEXPRESSION )
1130 && ( Expressions[numexpr].status == LOCALEXPRESSION
1131 || Expressions[numexpr].status == GLOBALEXPRESSION ) ) {
1133 if ( c ==
'[' && s[1] ==
']' ) {
1134 Expressions[numexpr].printflag = par | PRINTCONTENTS;
1138 Expressions[numexpr].printflag = par;
1140 else if ( GetLastExprName(name,&numexpr)
1141 && ( Expressions[numexpr].status == LOCALEXPRESSION
1142 || Expressions[numexpr].status == GLOBALEXPRESSION
1143 || Expressions[numexpr].status == UNHIDELEXPRESSION
1144 || Expressions[numexpr].status == UNHIDEGEXPRESSION
1149 MesPrint(
"&%s is not the name of an active expression",name);
1153 if ( c == 0 )
return(0);
1154 if ( c ==
'-' || c ==
'+' ) s--;
1156 else if ( *s ==
',' ) s++;
1158 MesPrint(
"&Illegal object in (n)print statement");
1170 int CoPrint(UBYTE *s) {
return(DoPrint(s,PRINTON)); }
1177 int CoPrintB(UBYTE *s) {
return(DoPrint(s,PRINTCONTENT)); }
1184 int CoNPrint(UBYTE *s) {
return(DoPrint(s,PRINTOFF)); }
1191 int CoPushHide(UBYTE *s)
1196 if ( AR.Fscr[2].PObuffer == 0 ) {
1197 ScratchBuf = (WORD *)Malloc1(AM.HideSize*
sizeof(WORD),
"hidesize");
1198 AR.Fscr[2].POsize = AM.HideSize *
sizeof(WORD);
1199 AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1200 AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1201 PUTZERO(AR.Fscr[2].POposition);
1203 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
1206 MesPrint(
"&PushHide statement should have no arguments");
1209 for ( i = 0; i < NumExpressions; i++ ) {
1210 switch ( Expressions[i].status ) {
1211 case DROPLEXPRESSION:
1212 case SKIPLEXPRESSION:
1213 case LOCALEXPRESSION:
1214 Expressions[i].status = HIDELEXPRESSION;
1215 Expressions[i].hidelevel = AC.HideLevel-1;
1217 case DROPGEXPRESSION:
1218 case SKIPGEXPRESSION:
1219 case GLOBALEXPRESSION:
1220 Expressions[i].status = HIDEGEXPRESSION;
1221 Expressions[i].hidelevel = AC.HideLevel-1;
1235 int CoPopHide(UBYTE *s)
1238 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
1239 if ( AC.HideLevel <= 0 ) {
1240 MesPrint(
"&PopHide statement without corresponding PushHide statement");
1245 MesPrint(
"&PopHide statement should have no arguments");
1248 for ( i = 0; i < NumExpressions; i++ ) {
1249 switch ( Expressions[i].status ) {
1250 case HIDDENLEXPRESSION:
1251 if ( Expressions[i].hidelevel > AC.HideLevel )
1252 Expressions[i].status = UNHIDELEXPRESSION;
1254 case HIDDENGEXPRESSION:
1255 if ( Expressions[i].hidelevel > AC.HideLevel )
1256 Expressions[i].status = UNHIDEGEXPRESSION;
1270 int SetExprCases(
int par,
int setunset,
int val)
1275 case SKIPLEXPRESSION:
1276 if ( !setunset ) val = LOCALEXPRESSION;
1278 case SKIPGEXPRESSION:
1279 if ( !setunset ) val = GLOBALEXPRESSION;
1281 case LOCALEXPRESSION:
1282 if ( setunset ) val = SKIPLEXPRESSION;
1284 case GLOBALEXPRESSION:
1285 if ( setunset ) val = SKIPGEXPRESSION;
1287 case INTOHIDEGEXPRESSION:
1288 case INTOHIDELEXPRESSION:
1295 case SKIPLEXPRESSION:
1296 case LOCALEXPRESSION:
1297 case HIDELEXPRESSION:
1298 if ( setunset ) val = DROPLEXPRESSION;
1300 case DROPLEXPRESSION:
1301 if ( !setunset ) val = LOCALEXPRESSION;
1303 case SKIPGEXPRESSION:
1304 case GLOBALEXPRESSION:
1305 case HIDEGEXPRESSION:
1306 if ( setunset ) val = DROPGEXPRESSION;
1308 case DROPGEXPRESSION:
1309 if ( !setunset ) val = GLOBALEXPRESSION;
1311 case HIDDENLEXPRESSION:
1312 case UNHIDELEXPRESSION:
1313 if ( setunset ) val = DROPHLEXPRESSION;
1315 case HIDDENGEXPRESSION:
1316 case UNHIDEGEXPRESSION:
1317 if ( setunset ) val = DROPHGEXPRESSION;
1319 case DROPHLEXPRESSION:
1320 if ( !setunset ) val = HIDDENLEXPRESSION;
1322 case DROPHGEXPRESSION:
1323 if ( !setunset ) val = HIDDENGEXPRESSION;
1325 case INTOHIDEGEXPRESSION:
1326 case INTOHIDELEXPRESSION:
1333 case DROPLEXPRESSION:
1334 case SKIPLEXPRESSION:
1335 case LOCALEXPRESSION:
1336 if ( setunset ) val = HIDELEXPRESSION;
1338 case HIDELEXPRESSION:
1339 if ( !setunset ) val = LOCALEXPRESSION;
1341 case DROPGEXPRESSION:
1342 case SKIPGEXPRESSION:
1343 case GLOBALEXPRESSION:
1344 if ( setunset ) val = HIDEGEXPRESSION;
1346 case HIDEGEXPRESSION:
1347 if ( !setunset ) val = GLOBALEXPRESSION;
1349 case INTOHIDEGEXPRESSION:
1350 case INTOHIDELEXPRESSION:
1357 case HIDDENLEXPRESSION:
1358 case DROPHLEXPRESSION:
1359 if ( setunset ) val = UNHIDELEXPRESSION;
1361 case UNHIDELEXPRESSION:
1362 if ( !setunset ) val = HIDDENLEXPRESSION;
1364 case HIDDENGEXPRESSION:
1365 case DROPHGEXPRESSION:
1366 if ( setunset ) val = UNHIDEGEXPRESSION;
1368 case UNHIDEGEXPRESSION:
1369 if ( !setunset ) val = HIDDENGEXPRESSION;
1371 case INTOHIDEGEXPRESSION:
1372 case INTOHIDELEXPRESSION:
1379 case HIDDENLEXPRESSION:
1380 case HIDDENGEXPRESSION:
1381 MesPrint(
"&Expression is already hidden");
1383 case DROPHLEXPRESSION:
1384 case DROPHGEXPRESSION:
1385 case UNHIDELEXPRESSION:
1386 case UNHIDEGEXPRESSION:
1387 MesPrint(
"&Cannot unhide and put intohide expression in the same module");
1389 case LOCALEXPRESSION:
1390 case DROPLEXPRESSION:
1391 case SKIPLEXPRESSION:
1392 case HIDELEXPRESSION:
1393 if ( setunset ) val = INTOHIDELEXPRESSION;
1395 case GLOBALEXPRESSION:
1396 case DROPGEXPRESSION:
1397 case SKIPGEXPRESSION:
1398 case HIDEGEXPRESSION:
1399 if ( setunset ) val = INTOHIDEGEXPRESSION;
1416 int SetExpr(UBYTE *s,
int setunset,
int par)
1421 if ( *s == 0 && ( par != INTOHIDE ) ) {
1422 for ( i = 0; i < NumExpressions; i++ ) {
1423 w = &(Expressions[i].status);
1424 *w = SetExprCases(par,setunset,*w);
1425 if ( *w < 0 ) error = 1;
1426 if ( par == HIDE && setunset == 1 )
1427 Expressions[i].hidelevel = AC.HideLevel;
1432 if ( *s ==
',' ) { s++;
continue; }
1433 if ( *s ==
'0' ) { s++;
continue; }
1435 if ( ( s = SkipAName(s) ) == 0 ) {
1436 MesPrint(
"&Improper name for an expression: '%s'",name);
1440 if ( GetName(AC.exprnames,name,&numexpr,NOAUTO) == CEXPRESSION ) {
1441 w = &(Expressions[numexpr].status);
1442 *w = SetExprCases(par,setunset,*w);
1443 if ( *w < 0 ) error = 1;
1444 if ( ( par == HIDE || par == INTOHIDE ) && setunset == 1 )
1445 Expressions[numexpr].hidelevel = AC.HideLevel;
1447 else if ( GetName(AC.varnames,name,&numexpr,NOAUTO) != NAMENOTFOUND ) {
1448 MesPrint(
"&%s is not an expression",name);
1461 int CoDrop(UBYTE *s) {
return(SetExpr(s,1,DROP)); }
1468 int CoNoDrop(UBYTE *s) {
return(SetExpr(s,0,DROP)); }
1475 int CoSkip(UBYTE *s) {
return(SetExpr(s,1,SKIP)); }
1482 int CoNoSkip(UBYTE *s) {
return(SetExpr(s,0,SKIP)); }
1489 int CoHide(UBYTE *inp) {
1492 if ( AR.Fscr[2].PObuffer == 0 ) {
1493 ScratchBuf = (WORD *)Malloc1(AM.HideSize*
sizeof(WORD),
"hidesize");
1494 AR.Fscr[2].POsize = AM.HideSize *
sizeof(WORD);
1495 AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1496 AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1497 PUTZERO(AR.Fscr[2].POposition);
1499 return(SetExpr(inp,1,HIDE));
1507 int CoIntoHide(UBYTE *inp) {
1510 if ( AR.Fscr[2].PObuffer == 0 ) {
1511 ScratchBuf = (WORD *)Malloc1(AM.HideSize*
sizeof(WORD),
"hidesize");
1512 AR.Fscr[2].POsize = AM.HideSize *
sizeof(WORD);
1513 AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1514 AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1515 PUTZERO(AR.Fscr[2].POposition);
1517 return(SetExpr(inp,1,INTOHIDE));
1525 int CoNoHide(UBYTE *inp) {
return(SetExpr(inp,0,HIDE)); }
1532 int CoUnHide(UBYTE *inp) {
return(SetExpr(inp,1,UNHIDE)); }
1539 int CoNoUnHide(UBYTE *inp) {
return(SetExpr(inp,0,UNHIDE)); }
1546 void AddToCom(
int n, WORD *array)
1548 CBUF *C = cbuf+AC.cbufnum;
1550 MesPrint(
" %a",n,array);
1553 while ( --n >= 0 ) *(C->
Pointer)++ = *array++;
1561 int AddComString(
int n, WORD *array, UBYTE *thestring,
int par)
1563 CBUF *C = cbuf+AC.cbufnum;
1564 UBYTE *s = thestring, *w;
1569 int i, numchars = 0, size, zeroes;
1571 if ( *s ==
'\\' ) s++;
1572 else if ( par == 1 &&
1573 ( ( *s ==
'%' && s[1] !=
't' && s[1] !=
'T' && s[1] !=
'$' &&
1574 s[1] !=
'w' && s[1] !=
'W' && s[1] !=
'r' && s[1] != 0 ) || *s ==
'#'
1575 || *s ==
'@' || *s ==
'&' ) ) {
1581 size = numchars/
sizeof(WORD)+1;
1588 for ( i = 1; i < n; i++ ) *(C->
Pointer)++ = array[i];
1594 zeroes = size*
sizeof(WORD)-numchars;
1597 if ( *s ==
'\\' ) s++;
1598 else if ( par == 1 && ( ( *s ==
'%' &&
1599 s[1] !=
't' && s[1] !=
'T' && s[1] !=
'$' &&
1600 s[1] !=
'w' && s[1] !=
'W' && s[1] !=
'r' && s[1] != 0 ) || *s ==
'#'
1601 || *s ==
'@' || *s ==
'&' ) ) {
1606 while ( --zeroes >= 0 ) *w++ = 0;
1609 MesPrint(
"LH: %a",size+1+n,cc);
1610 MesPrint(
" %s",thestring);
1620 int Add2ComStrings(
int n, WORD *array, UBYTE *string1, UBYTE *string2)
1622 CBUF *C = cbuf+AC.cbufnum;
1623 UBYTE *s1 = string1, *s2 = string2, *w;
1624 int i, num1chars = 0, num2chars = 0, size1, size2, zeroes1, zeroes2;
1626 while ( *s1 ) { s1++; num1chars++; }
1627 size1 = num1chars/
sizeof(WORD)+1;
1629 while ( *s2 ) { s2++; num2chars++; }
1630 size2 = num2chars/
sizeof(WORD)+1;
1635 *(C->
Pointer)++ = size1+size2+n+3;
1636 for ( i = 1; i < n; i++ ) *(C->
Pointer)++ = array[i];
1639 zeroes1 = size1*
sizeof(WORD)-num1chars;
1641 while ( *s1 ) { *w++ = *s1++; }
1642 while ( --zeroes1 >= 0 ) *w++ = 0;
1647 zeroes2 = size2*
sizeof(WORD)-num2chars;
1649 while ( *s2 ) { *w++ = *s2++; }
1650 while ( --zeroes2 >= 0 ) *w++ = 0;
1661 int CoDiscard(UBYTE *s)
1664 Add2Com(TYPEDISCARD)
1667 MesPrint("&Illegal argument in discard statement: '%s'",s);
1682 static WORD ccarray[5] = { TYPEOPERATION,5,CONTRACT,0,0 };
1684 int CoContract(UBYTE *s)
1690 if ( *s != ',' && *s ) {
1691 proper: MesPrint(
"&Illegal number in contract statement");
1697 else ccarray[4] = 0;
1698 if ( FG.cTable[*s] == 1 ) {
1700 if ( *s ) goto proper;
1703 else if ( *s ) goto proper;
1704 else ccarray[3] = -1;
1713 int CoGoTo(UBYTE *inp)
1717 while ( FG.cTable[*s] <= 1 ) s++;
1719 MesPrint(
"&Label should be an alpha-numeric string");
1723 Add3Com(TYPEGOTO,x);
1732 int CoLabel(UBYTE *inp)
1736 while ( FG.cTable[*s] <= 1 ) s++;
1738 MesPrint(
"&Label should be an alpha-numeric string");
1742 if ( AC.Labels[x] >= 0 ) {
1743 MesPrint(
"&Label %s defined more than once",AC.LabelNames[x]);
1746 AC.Labels[x] = cbuf[AC.cbufnum].numlhs;
1759 int DoArgument(UBYTE *s,
int par)
1762 UBYTE *name, *t, *v, c;
1763 WORD *oldworkpointer = AT.WorkPointer, *w, *ww, number, *scale;
1764 int error = 0, zeroflag, type, x;
1765 AC.lhdollarflag = 0;
1766 while ( *s ==
',' ) s++;
1772 if ( AC.arglevel >= MAXNEST ) {
1773 MesPrint(
"@Nesting of argument statements more than %d levels"
1777 AC.argsumcheck[AC.arglevel] = NestingChecksum();
1778 AC.argstack[AC.arglevel] = cbuf[AC.cbufnum].Pointer
1779 - cbuf[AC.cbufnum].Buffer + 2;
1781 *w++ = cbuf[AC.cbufnum].numlhs;
1786 case TYPESPLITFIRSTARG:
1787 case TYPESPLITLASTARG:
1789 case TYPEARGTOEXTRASYMBOL:
1790 *w++ = cbuf[AC.cbufnum].numlhs+1;
1798 s++; ParseSignedNumber(x,s)
1799 while ( *s == ',' ) s++;
1803 t = s+1; SKIPBRA3(s)
1804 if ( par == TYPEARG ) {
1805 MesPrint(
"&Illegal () entry in argument statement");
1806 error = 1; s++;
goto skipbracks;
1808 else if ( par == TYPESPLITFIRSTARG ) {
1809 MesPrint(
"&Illegal () entry in splitfirstarg statement");
1810 error = 1; s++;
goto skipbracks;
1812 else if ( par == TYPESPLITLASTARG ) {
1813 MesPrint(
"&Illegal () entry in splitlastarg statement");
1814 error = 1; s++;
goto skipbracks;
1819 MesPrint(
"&Wildcarding not allowed in this type of statement");
1825 if ( *t ==
'(' && v[-1] ==
')' ) {
1827 if ( par == TYPESPLITARG ) oldworkpointer[0] = TYPESPLITARG2;
1828 else if ( par == TYPEFACTARG ) oldworkpointer[0] = TYPEFACTARG2;
1829 else if ( par == TYPENORM4 ) oldworkpointer[0] = TYPENORM4;
1830 else if ( par == TYPENORM ) {
1831 if ( *t ==
'-' ) { oldworkpointer[0] = TYPENORM3; t++; }
1832 else { oldworkpointer[0] = TYPENORM2; *scale = 0; }
1836 CBUF *C = cbuf+AC.cbufnum;
1837 WORD oldnumrhs = C->numrhs, oldnumlhs = C->numlhs;
1838 WORD prototype[SUBEXPSIZE+40];
1843 prototype[0] = SUBEXPRESSION;
1844 prototype[1] = SUBEXPSIZE;
1845 prototype[2] = C->numrhs+1;
1847 prototype[4] = AC.cbufnum;
1848 AT.WorkPointer += TYPEARGHEADSIZE+1;
1850 if ( ( retcode = CompileAlgebra(t,LHSIDE,prototype) ) < 0 )
1853 prototype[2] = retcode;
1854 ww = C->
lhs[retcode];
1855 AC.lhdollarflag = 0;
1857 *w++ = -2; *w++ = 0;
1859 else if ( ww[ww[0]] != 0 ) {
1860 MesPrint(
"&There should be only one term between ()");
1863 else if (
NewSort(BHEAD0) ) {
if ( !error ) error = 1; }
1866 if ( !error ) error = 1;
1869 AN.RepPoint = AT.RepCount + 1;
1872 while ( --i >= 0 ) *m++ = *mm++;
1873 mm = AT.WorkPointer; AT.WorkPointer = m;
1874 AR.Cnumlhs = C->numlhs;
1878 else if (
EndSort(BHEAD mm,0) < 0 ) {
1880 AT.WorkPointer = mm;
1882 else if ( *mm == 0 ) {
1883 *w++ = -2; *w++ = 0;
1884 AT.WorkPointer = mm;
1886 else if ( mm[mm[0]] != 0 ) {
1888 AT.WorkPointer = mm;
1891 AT.WorkPointer = mm;
1893 if ( par == TYPEFACTARG ) {
1894 if ( *mm != ABS(m[-1])+1 ) {
1897 mm[-1] = -*mm-1; w += *mm+1;
1905 { mm[-1] = -*mm-1; w += *mm+1; }
1907 oldworkpointer[1] = w - oldworkpointer;
1911 oldworkpointer[5] = AC.lhdollarflag;
1914 C->numrhs = oldnumrhs;
1915 C->numlhs = oldnumlhs;
1920 if ( *s == 0 ) { *w++ = 0; *w++ = 2; *w++ = 1; }
1923 if ( *s ==
',' ) { s++;
continue; }
1924 ww = w; *w++ = 0; w++;
1925 if ( FG.cTable[*s] > 1 && *s !=
'[' && *s !=
'{' ) {
1926 MesPrint(
"&Illegal parameters in statement");
1930 while ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'{' ) {
1935 number = DoTempSet(name,s);
1936 name--; *s++ = c; c = *s; *s = 0;
1941 if ( ( s = SkipAName(s) ) == 0 ) {
1942 MesPrint(
"&Illegal name '%s'",name);
1946 if ( ( type = GetName(AC.varnames,name,&number,WITHAUTO) ) == CSET ) {
1947 doset:
if ( Sets[number].type != CFUNCTION )
goto nofun;
1948 *w++ = CSET; *w++ = number;
1950 else if ( type == CFUNCTION ) {
1951 *w++ = CFUNCTION; *w++ = number + FUNCTION;
1954 nofun: MesPrint(
"&%s is not a function or a set of functions"
1960 while ( *s ==
',' ) s++;
1963 ww = w; w++; zeroflag = 0;
1964 while ( FG.cTable[*s] == 1 ) {
1966 if ( *s && *s != ',' ) {
1967 MesPrint(
"&Illegal separator after number");
1969 while ( *s && *s !=
',' ) s++;
1971 while ( *s ==
',' ) s++;
1972 if ( x == 0 ) zeroflag = 1;
1973 if ( !zeroflag ) *w++ = (WORD)x;
1978 oldworkpointer[1] = w - oldworkpointer;
1979 if ( par == TYPEARG ) {
1980 AC.argstack[AC.arglevel-1] = cbuf[AC.cbufnum].Pointer
1981 - cbuf[AC.cbufnum].Buffer + 2;
1983 AddNtoL(oldworkpointer[1],oldworkpointer);
1984 AT.WorkPointer = oldworkpointer;
1993 int CoArgument(UBYTE *s) {
return(DoArgument(s,TYPEARG)); }
2000 int CoEndArgument(UBYTE *s)
2002 CBUF *C = cbuf+AC.cbufnum;
2003 while ( *s ==
',' ) s++;
2005 MesPrint(
"&Illegal syntax for EndArgument statement");
2008 if ( AC.arglevel <= 0 ) {
2009 MesPrint(
"&EndArgument without corresponding Argument statement");
2013 cbuf[AC.cbufnum].Buffer[AC.argstack[AC.arglevel]] = C->numlhs;
2014 if ( AC.argsumcheck[AC.arglevel] != NestingChecksum() ) {
2026 int CoInside(UBYTE *s) {
return(ExecInside(s)); }
2033 int CoEndInside(UBYTE *s)
2035 CBUF *C = cbuf+AC.cbufnum;
2036 while ( *s ==
',' ) s++;
2038 MesPrint(
"&Illegal syntax for EndInside statement");
2041 if ( AC.insidelevel <= 0 ) {
2042 MesPrint(
"&EndInside without corresponding Inside statement");
2046 cbuf[AC.cbufnum].Buffer[AC.insidestack[AC.insidelevel]] = C->numlhs;
2047 if ( AC.insidesumcheck[AC.insidelevel] != NestingChecksum() ) {
2059 int CoNormalize(UBYTE *s) {
return(DoArgument(s,TYPENORM)); }
2066 int CoMakeInteger(UBYTE *s) {
return(DoArgument(s,TYPENORM4)); }
2073 int CoSplitArg(UBYTE *s) {
return(DoArgument(s,TYPESPLITARG)); }
2080 int CoSplitFirstArg(UBYTE *s) {
return(DoArgument(s,TYPESPLITFIRSTARG)); }
2087 int CoSplitLastArg(UBYTE *s) {
return(DoArgument(s,TYPESPLITLASTARG)); }
2094 int CoFactArg(UBYTE *s) {
2095 if ( ( AC.topolynomialflag & TOPOLYNOMIALFLAG ) != 0 ) {
2096 MesPrint(
"&ToPolynomial statement and FactArg statement are not allowed in the same module");
2099 AC.topolynomialflag |= FACTARGFLAG;
2100 return(DoArgument(s,TYPEFACTARG));
2114 int DoSymmetrize(UBYTE *s,
int par)
2117 int extra = 0, error = 0, err, fix, x, groupsize, num, i;
2119 WORD funnum, *w, *ww, type;
2122 if ( ( s = SkipAName(s) ) == 0 ) {
2123 MesPrint(
"&Improper function name");
2127 if ( c !=
',' || ( FG.cTable[s[1]] != 0 && s[1] !=
'[' ) )
break;
2128 if ( par <= 0 && StrICmp(name,(UBYTE *)
"cyclic") == 0 ) extra = 2;
2129 else if ( par <= 0 && StrICmp(name,(UBYTE *)
"rcyclic") == 0 ) extra = 6;
2131 MesPrint(
"&Illegal option: '%s'",name);
2136 if ( ( err = GetVar(name,&type,&funnum,CFUNCTION,WITHAUTO) ) == NAMENOTFOUND ) {
2137 MesPrint(
"&Undefined function: %s",name);
2138 AddFunction(name,0,0,0,0,0,-1,-1);
2143 if ( err == -1 ) error = 1;
2147 if ( *s ==
',' || *s ==
'(' || *s == 0 ) fix = -1;
2148 else if ( FG.cTable[*s] == 1 ) {
2151 Warning("Restriction to zero arguments removed");
2154 MesPrint(
"&Illegal character after :");
2160 *w++ = TYPEOPERATION;
2169 w += 2; ww = w; groupsize = -1;
2170 while ( *s ==
',' ) s++;
2174 while ( *s && *s !=
')' ) {
2175 if ( *s ==
',' ) { s++;
continue; }
2176 if ( FG.cTable[*s] != 1 )
goto illarg;
2178 if ( x <= 0 || ( fix > 0 && x > fix ) ) goto illnum;
2183 MesPrint(
"&Improper termination of statement");
2186 if ( groupsize < 0 ) groupsize = num;
2187 else if ( groupsize != num )
goto group;
2190 else if ( FG.cTable[*s] == 1 ) {
2191 if ( groupsize < 0 ) groupsize = 1;
2192 else if ( groupsize != 1 ) {
2193 group: MesPrint(
"&All groups should have the same number of arguments");
2197 if ( x <= 0 || ( fix > 0 && x > fix ) ) {
2198 illnum: MesPrint(
"&Illegal argument number: %d",x);
2204 illarg: MesPrint(
"&Illegal argument");
2207 while ( *s ==
',' ) s++;
2216 for ( i = 0; i < fix; i++ ) *w++ = i;
2222 ww[-2] = (w-ww)/groupsize;
2224 AT.WorkPointer[1] = w - AT.WorkPointer;
2225 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
2234 int CoSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,SYMMETRIC)); }
2241 int CoAntiSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,ANTISYMMETRIC)); }
2248 int CoCycleSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,CYCLESYMMETRIC)); }
2255 int CoRCycleSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,RCYCLESYMMETRIC)); }
2262 int CoWrite(UBYTE *s)
2268 if ( ( ( s = SkipAName(s) ) == 0 ) || *s != 0 ) {
2269 MesPrint(
"&Proper use of write statement is: write option");
2274 MesPrint(
"&Unrecognized option in write statement");
2277 *key->var = key->type;
2278 AR.SortType = AC.SortType;
2287 int CoNWrite(UBYTE *s)
2293 if ( ( ( s = SkipAName(s) ) == 0 ) || *s != 0 ) {
2294 MesPrint(
"&Proper use of nwrite statement is: nwrite option");
2299 MesPrint(
"&Unrecognized option in nwrite statement");
2302 *key->var = key->flags;
2303 AR.SortType = AC.SortType;
2312 static WORD ratstring[6] = { TYPEOPERATION, 6, RATIO, 0, 0, 0 };
2314 int CoRatio(UBYTE *s)
2317 int i, type, error = 0;
2320 for ( i = 0; i < 3; i++ ) {
2325 if ( ( ( type = GetName(AC.varnames,t,&numsym,WITHAUTO) ) != CSYMBOL )
2326 && type != CDUBIOUS ) {
2327 MesPrint(
"&%s is not a symbol",t);
2329 if ( type < 0 ) numsym = AddSymbol(t,-MAXPOWER,MAXPOWER,0,0);
2332 if ( *s ==
',' ) s++;
2336 MesPrint(
"&The ratio statement needs three symbols for its arguments");
2354 int CoRedefine(UBYTE *s)
2356 UBYTE *name, c, *args = 0;
2360 if ( FG.cTable[*s] || ( s = SkipAName(s) ) == 0 || s[-1] ==
'_' ) {
2361 MesPrint(
"&Illegal name for preprocessor variable in redefine statement");
2365 for ( numprevar = NumPre-1; numprevar >= 0; numprevar-- ) {
2366 if ( StrCmp(name,PreVar[numprevar].name) == 0 )
break;
2368 if ( numprevar < 0 ) {
2369 MesPrint(
"&There is no preprocessor variable with the name `%s'",name);
2381 if ( chartype[*s] != 0 )
goto illarg;
2383 while ( chartype[*s] <= 1 ) s++;
2384 while ( *s ==
' ' || *s ==
'\t' ) s++;
2385 if ( *s ==
')' )
break;
2386 if ( *s !=
',' )
goto illargs;
2388 while ( *s ==
' ' || *s ==
'\t' ) s++;
2391 while ( *s ==
' ' || *s ==
'\t' ) s++;
2393 while ( *s ==
',' ) s++;
2395 encl: MesPrint(
"&Value for %s should be enclosed in double quotes"
2396 ,PreVar[numprevar].name);
2400 while ( *s && *s !=
'"' ) {
if ( *s ==
'\\' ) s++; s++; }
2401 if ( *s !=
'"' )
goto encl;
2403 code[0] = TYPEREDEFPRE; code[1] = numprevar;
2407 Add2ComStrings(2,code,name,args);
2419 for ( j = 0; j < AC.numpfirstnum; j++ ) {
2420 if ( numprevar == AC.pfirstnum[j] )
break;
2422 if ( j >= AC.numpfirstnum ) {
2423 if ( j >= AC.sizepfirstnum ) {
2424 if ( AC.sizepfirstnum <= 0 ) { AC.sizepfirstnum = 10; }
2425 else { AC.sizepfirstnum = 2 * AC.sizepfirstnum; }
2426 newin = (LONG *)Malloc1(AC.sizepfirstnum*(
sizeof(WORD)+
sizeof(LONG)),
"AC.pfirstnum");
2427 newpf = (WORD *)(newin+AC.sizepfirstnum);
2428 for ( j = 0; j < AC.numpfirstnum; j++ ) {
2429 newpf[j] = AC.pfirstnum[j];
2430 newin[j] = AC.inputnumbers[j];
2432 if ( AC.inputnumbers ) M_free(AC.inputnumbers,
"AC.pfirstnum");
2433 AC.inputnumbers = newin;
2434 AC.pfirstnum = newpf;
2436 AC.pfirstnum[AC.numpfirstnum] = numprevar;
2437 AC.inputnumbers[AC.numpfirstnum] = -1;
2444 MesPrint(
"&Illegally formed name in argument of redefine statement");
2447 MesPrint(
"&Illegally formed arguments in redefine statement");
2459 int CoRenumber(UBYTE *s)
2463 while ( *s ==
',' ) s++;
2465 if ( *s == 0 ) { x = 0; }
2466 else ParseNumber(x,s)
2467 if ( *s == 0 && x >= 0 && x <= 1 ) {
2468 Add3Com(TYPERENUMBER,x);
2471 MesPrint(
"&Illegal argument in Renumber statement: '%s'",inp);
2482 CBUF *C = cbuf+AC.cbufnum;
2483 UBYTE *ss = 0, c, *t;
2484 int error = 0, i = 0, type, x;
2485 WORD numindex,number;
2489 t++; s++;
while ( FG.cTable[*s] < 2 ) s++;
2491 if ( ( number = GetDollar(t) ) < 0 ) {
2492 MesPrint(
"&Undefined variable $%s",t);
2493 if ( !error ) error = 1;
2494 number = AddDollar(t,0,0,0);
2499 if ( ( s = SkipAName(s) ) == 0 )
return(1);
2501 if ( ( ( type = GetOName(AC.exprnames,t,&numindex,NOAUTO) ) != NAMENOTFOUND )
2502 || ( ( type = GetOName(AC.varnames,t,&numindex,WITHAUTO) ) != CINDEX ) ) {
2503 if ( type != NAMENOTFOUND ) error = NameConflict(type,t);
2505 MesPrint(
"&%s should have been declared as an index",t);
2507 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2511 Add3Com(TYPESUM,numindex);
2513 if ( *s == 0 )
break;
2515 MesPrint(
"&Illegal separator between objects in sum statement.");
2519 if ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'$' ) {
2520 while ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'$' ) {
2524 while ( FG.cTable[*s] < 2 ) s++;
2526 if ( ( number = GetDollar(t) ) < 0 ) {
2527 MesPrint(
"&Undefined variable $%s",t);
2528 if ( !error ) error = 1;
2529 number = AddDollar(t,0,0,0);
2535 if ( ( s = SkipAName(s) ) == 0 )
return(1);
2537 if ( ( ( type = GetOName(AC.exprnames,t,&numindex,NOAUTO) ) != NAMENOTFOUND )
2538 || ( ( type = GetOName(AC.varnames,t,&numindex,WITHAUTO) ) != CINDEX ) ) {
2539 if ( type != NAMENOTFOUND ) error = NameConflict(type,t);
2541 MesPrint(
"&%s should have been declared as an index",t);
2543 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2549 C->Pointer[-i+1] = i;
2551 if ( *s == 0 ) return(error);
2553 MesPrint(
"&Illegal separator between objects in sum statement.");
2558 if ( FG.cTable[*s] == 1 ) {
2562 else if ( FG.cTable[*s] == 1 ) {
2563 while ( FG.cTable[*s] == 1 ) {
2566 while( FG.cTable[*s] == 1 ) x = 10*x + *s++ -
'0';
2567 if ( *s && *s !=
',' ) {
2568 MesPrint(
"&%s is not a legal fixed index",t);
2571 else if ( x >= AM.OffsetIndex ) {
2572 MesPrint(
"&%d is too large to be a fixed index",x);
2578 C->Pointer[-i] = TYPESUMFIX;
2579 C->Pointer[-i+1] = i;
2581 if ( *s == 0 ) break;
2586 MesPrint(
"&Illegal object in sum statement");
2598 static WORD cttarray[7] = { TYPEOPERATION,7,TENVEC,0,0,1,0 };
2600 int CoToTensor(UBYTE *s)
2603 int type, j, nargs, error = 0;
2604 WORD number, dol[2] = { 0, 0 };
2616 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
2617 if ( *s == 0 )
break;
2624 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2627 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2631 if ( nargs < 2 )
goto not_enough_arguments;
2636 for ( j = 2; j < nargs; j++ ) {
2637 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
2646 if ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'_' ) {
2648 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2650 type = GetName(AC.varnames,t,&number,WITHAUTO);
2651 if ( type == CVECTOR ) {
2655 cttarray[6] = DoTempSet(t,s);
2659 else if ( type != CSET ) {
2660 MesPrint(
"&%s is not the name of a set or a vector",t);
2664 cttarray[6] = number;
2666 else if ( *s ==
'{' ) {
2667 t = ++s; SKIPBRA2(s) *s = 0;
2668 cttarray[6] = DoTempSet(t,s);
2671 if ( cttarray[6] < 0 ) {
2674 if ( AC.wildflag ) {
2675 MesPrint(
"&Improper use of wildcard(s) in set specification");
2684 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2686 if ( StrICmp(t,(UBYTE *)
"nosquare") == 0 ) cttarray[5] |= 2;
2687 else if ( StrICmp(t,(UBYTE *)
"functions") == 0 ) cttarray[5] |= 4;
2689 MesPrint(
"&Unrecognized option in ToTensor statement: '%s'",t);
2699 for ( j = 0; j < 2; j++ ) {
2700 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
2702 if ( ( s = SkipAName(s) ) == 0 )
goto syntax_error;
2704 if ( t[0] ==
'$' ) {
2705 dol[j] = GetDollar(t+1);
2706 if ( dol[j] < 0 ) dol[j] = AddDollar(t+1,DOLUNDEFINED,0,0);
2708 type = GetName(AC.varnames,t,&number,WITHAUTO);
2709 if ( type == CVECTOR ) {
2710 cttarray[4] = number + AM.OffsetVector;
2712 else if ( type == CFUNCTION && ( functions[number].spec > 0 ) ) {
2713 cttarray[3] = number + FUNCTION;
2716 MesPrint(
"&%s is not a vector or a tensor",t);
2722 if ( cttarray[3] == 0 || cttarray[4] == 0 ) {
2723 if ( dol[0] == 0 && dol[1] == 0 ) {
2724 goto not_enough_arguments;
2726 else if ( cttarray[3] ) {
2727 if ( dol[1] ) cttarray[4] = dol[1];
2728 else if ( dol[0] ) { cttarray[4] = dol[0]; }
2730 goto not_enough_arguments;
2733 else if ( cttarray[4] ) {
2734 if ( dol[1] ) { cttarray[3] = -dol[1]; }
2735 else if ( dol[0] ) cttarray[3] = -dol[0];
2737 goto not_enough_arguments;
2741 if ( dol[0] == 0 || dol[1] == 0 ) {
2742 goto not_enough_arguments;
2745 cttarray[3] = -dol[0]; cttarray[4] = dol[1];
2749 AddNtoL(cttarray[1],cttarray);
2753 MesPrint(
"&Syntax error in ToTensor statement");
2756 not_enough_arguments:
2757 MesPrint(
"&ToTensor statement needs a vector and a tensor");
2766 static WORD ctvarray[6] = { TYPEOPERATION,6,TENVEC,0,0,0 };
2768 int CoToVector(UBYTE *s)
2771 int j, type, error = 0;
2772 WORD number, dol[2];
2773 dol[0] = dol[1] = 0;
2774 ctvarray[3] = ctvarray[4] = ctvarray[5] = 0;
2775 for ( j = 0; j < 2; j++ ) {
2777 if ( ( s = SkipAName(s) ) == 0 ) {
2778 proper: MesPrint(
"&Arguments of ToVector statement should be a vector and a tensor");
2783 dol[j] = GetDollar(t+1);
2784 if ( dol[j] < 0 ) dol[j] = AddDollar(t+1,DOLUNDEFINED,0,0);
2786 else if ( ( type = GetName(AC.varnames,t,&number,WITHAUTO) ) == CVECTOR )
2787 ctvarray[4] = number + AM.OffsetVector;
2788 else if ( type == CFUNCTION && ( functions[number].spec > 0 ) )
2789 ctvarray[3] = number+FUNCTION;
2791 MesPrint(
"&%s is not a vector or a tensor",t);
2794 *s = c;
if ( *s && *s !=
',' )
goto proper;
2797 if ( *s != 0 )
goto proper;
2798 if ( ctvarray[3] == 0 || ctvarray[4] == 0 ) {
2799 if ( dol[0] == 0 && dol[1] == 0 ) {
2800 MesPrint(
"&ToVector statement needs a vector and a tensor");
2803 else if ( ctvarray[3] ) {
2804 if ( dol[1] ) ctvarray[4] = dol[1];
2805 else if ( dol[0] ) ctvarray[4] = dol[0];
2807 MesPrint(
"&ToVector statement needs a vector and a tensor");
2811 else if ( ctvarray[4] ) {
2812 if ( dol[1] ) ctvarray[3] = -dol[1];
2813 else if ( dol[0] ) ctvarray[3] = -dol[0];
2815 MesPrint(
"&ToVector statement needs a vector and a tensor");
2820 if ( dol[0] == 0 || dol[1] == 0 ) {
2821 MesPrint(
"&ToVector statement needs a vector and a tensor");
2825 ctvarray[3] = -dol[0]; ctvarray[4] = dol[1];
2838 int CoTrace4(UBYTE *s)
2840 int error = 0, type, option = CHISHOLM;
2842 WORD numindex, one = 1;
2846 if ( FG.cTable[*s] == 1 )
break;
2847 if ( ( s = SkipAName(s) ) == 0 ) {
2848 proper: MesPrint(
"&Proper syntax for Trace4 is 'Trace4[,options],index;'");
2851 if ( *s == 0 )
break;
2853 if ( ( key = FindKeyWord(t,trace4options,
2854 sizeof(trace4options)/
sizeof(
KEYWORD)) ) == 0 )
break;
2856 option |= key->type;
2857 option &= ~key->flags;
2859 if ( ( *s++ = c ) !=
',' ) {
2860 MesPrint(
"&Illegal separator in Trace4 statement");
2863 if ( *s == 0 )
goto proper;
2866 if ( FG.cTable[*s] == 1 ) {
2868 ParseNumber(numindex,s)
2870 MesPrint(
"&Last argument of Trace4 should be an index");
2873 if ( numindex >= AM.OffsetIndex ) {
2874 MesPrint(
"&fixed index >= %d. Change value of OffsetIndex in setup file"
2879 else if ( *s ==
'$' ) {
2880 if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
2881 numindex = -numindex;
2883 MesPrint(
"&%s is undefined",s);
2884 numindex = AddDollar(s+1,DOLINDEX,&one,1);
2887 tests: s = SkipAName(s);
2889 MesPrint(
"&Trace4 should have a single index or $variable for its argument");
2893 else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
2894 numindex += AM.OffsetIndex;
2897 else if ( type != -1 ) {
2898 if ( type != CDUBIOUS ) {
2899 if ( ( FG.cTable[*s] != 0 ) && ( *s !=
'[' ) ) {
2900 if ( *s ==
'+' && FG.cTable[s[1]] == 1 ) { s++;
goto retry; }
2903 NameConflict(type,s);
2904 type = MakeDubious(AC.varnames,s,&numindex);
2909 MesPrint(
"&%s is not an index",s);
2910 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2913 if ( error )
return(error);
2914 if ( ( option & CHISHOLM ) != 0 )
2915 Add4Com(TYPECHISHOLM,numindex,(option & ALSOREVERSE));
2916 Add5Com(TYPEOPERATION,TAKETRACE,4 + (option & NOTRICK),numindex);
2925 int CoTraceN(UBYTE *s)
2927 WORD numindex, one = 1;
2929 if ( FG.cTable[*s] == 1 ) {
2931 ParseNumber(numindex,s)
2933 proper: MesPrint(
"&TraceN should have a single index for its argument");
2936 if ( numindex >= AM.OffsetIndex ) {
2937 MesPrint(
"&fixed index >= %d. Change value of OffsetIndex in setup file"
2942 else if ( *s ==
'$' ) {
2943 if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
2944 numindex = -numindex;
2946 MesPrint(
"&%s is undefined",s);
2947 numindex = AddDollar(s+1,DOLINDEX,&one,1);
2950 tests: s = SkipAName(s);
2952 MesPrint(
"&TraceN should have a single index or $variable for its argument");
2956 else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
2957 numindex += AM.OffsetIndex;
2960 else if ( type != -1 ) {
2961 if ( type != CDUBIOUS ) {
2962 if ( ( FG.cTable[*s] != 0 ) && ( *s !=
'[' ) ) {
2963 if ( *s ==
'+' && FG.cTable[s[1]] == 1 ) { s++;
goto retry; }
2966 NameConflict(type,s);
2967 type = MakeDubious(AC.varnames,s,&numindex);
2972 MesPrint(
"&%s is not an index",s);
2973 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2976 Add5Com(TYPEOPERATION,TAKETRACE,0,numindex);
2985 int CoChisholm(UBYTE *s)
2987 int error = 0, type, option = CHISHOLM;
2989 WORD numindex, one = 1;
2993 if ( FG.cTable[*s] == 1 )
break;
2994 if ( ( s = SkipAName(s) ) == 0 ) {
2995 proper: MesPrint(
"&Proper syntax for Chisholm is 'Chisholm[,options],index;'");
2998 if ( *s == 0 )
break;
3000 if ( ( key = FindKeyWord(t,chisoptions,
3001 sizeof(chisoptions)/
sizeof(
KEYWORD)) ) == 0 )
break;
3003 option |= key->type;
3004 option &= ~key->flags;
3006 if ( ( *s++ = c ) !=
',' ) {
3007 MesPrint(
"&Illegal separator in Chisholm statement");
3010 if ( *s == 0 )
goto proper;
3013 if ( FG.cTable[*s] == 1 ) {
3014 ParseNumber(numindex,s)
3016 MesPrint(
"&Last argument of Chisholm should be an index");
3019 if ( numindex >= AM.OffsetIndex ) {
3020 MesPrint(
"&fixed index >= %d. Change value of OffsetIndex in setup file"
3025 else if ( *s ==
'$' ) {
3026 if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
3027 numindex = -numindex;
3029 MesPrint(
"&%s is undefined",s);
3030 numindex = AddDollar(s+1,DOLINDEX,&one,1);
3033 tests: s = SkipAName(s);
3035 MesPrint(
"&Chisholm should have a single index or $variable for its argument");
3039 else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
3040 numindex += AM.OffsetIndex;
3043 else if ( type != -1 ) {
3044 if ( type != CDUBIOUS ) {
3045 NameConflict(type,s);
3046 type = MakeDubious(AC.varnames,s,&numindex);
3051 MesPrint(
"&%s is not an index",s);
3052 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
3055 if ( error )
return(error);
3056 Add4Com(TYPECHISHOLM,numindex,(option & ALSOREVERSE));
3067 int DoChain(UBYTE *s,
int option)
3071 if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
3074 MesPrint(
"&%s is undefined",s);
3075 numfunc = AddDollar(s+1,DOLINDEX,&one,1);
3078 tests: s = SkipAName(s);
3080 MesPrint(
"&ChainIn/ChainOut should have a single function or $variable for its argument");
3084 else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
3085 numfunc += FUNCTION;
3088 else if ( type != -1 ) {
3089 if ( type != CDUBIOUS ) {
3090 NameConflict(type,s);
3091 type = MakeDubious(AC.varnames,s,&numfunc);
3096 MesPrint(
"&%s is not a function",s);
3097 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
3100 Add3Com(option,numfunc);
3111 int CoChainin(UBYTE *s)
3113 return(DoChain(s,TYPECHAININ));
3123 int CoChainout(UBYTE *s)
3125 return(DoChain(s,TYPECHAINOUT));
3133 int CoExit(UBYTE *s)
3136 WORD code = TYPEEXIT;
3137 while ( *s ==
',' ) s++;
3139 Add3Com(TYPEEXIT,0);
3144 while ( *s ) {
if ( *s ==
'\\' ) s++; s++; }
3145 if ( name[-1] !=
'"' || s[-1] !=
'"' ) {
3146 MesPrint(
"&Illegal syntax for exit statement");
3150 AddComString(1,&code,name,0);
3160 int CoInParallel(UBYTE *s)
3162 return(DoInParallel(s,1));
3170 int CoNotInParallel(UBYTE *s)
3172 return(DoInParallel(s,0));
3185 int DoInParallel(UBYTE *s,
int par)
3194 #ifndef WITHPTHREADS
3198 AC.inparallelflag = par;
3200 for ( i = NumExpressions-1; i >= 0; i-- ) {
3202 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
3203 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
3212 while ( *s ==
',' ) s++;
3213 if ( *s == 0 )
break;
3214 if ( *s ==
'[' || FG.cTable[*s] == 0 ) {
3216 if ( ( s = SkipAName(s) ) == 0 ) {
3217 MesPrint(
"&Improper name for an expression: '%s'",t);
3221 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
3223 e = Expressions+number;
3224 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
3225 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
3231 else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
3232 MesPrint(
"&%s is not an expression",t);
3238 MesPrint(
"&Illegal object in InExpression statement");
3240 while ( *s && *s !=
',' ) s++;
3241 if ( *s == 0 )
break;
3254 int CoInExpression(UBYTE *s)
3261 if ( AC.inexprlevel >= MAXNEST ) {
3262 MesPrint(
"@Nesting of inexpression statements more than %d levels",(WORD)MAXNEST);
3265 AC.inexprsumcheck[AC.inexprlevel] = NestingChecksum();
3266 AC.inexprstack[AC.inexprlevel] = cbuf[AC.cbufnum].Pointer
3267 - cbuf[AC.cbufnum].Buffer + 2;
3269 *w++ = TYPEINEXPRESSION;
3272 while ( *s ==
',' ) s++;
3273 if ( *s == 0 )
break;
3274 if ( *s ==
'[' || FG.cTable[*s] == 0 ) {
3276 if ( ( s = SkipAName(s) ) == 0 ) {
3277 MesPrint(
"&Improper name for an expression: '%s'",t);
3281 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
3284 else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
3285 MesPrint(
"&%s is not an expression",t);
3291 MesPrint(
"&Illegal object in InExpression statement");
3293 while ( *s && *s !=
',' ) s++;
3294 if ( *s == 0 )
break;
3297 AT.WorkPointer[1] = w - AT.WorkPointer;
3298 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
3307 int CoEndInExpression(UBYTE *s)
3309 CBUF *C = cbuf+AC.cbufnum;
3310 while ( *s ==
',' ) s++;
3312 MesPrint(
"&Illegal syntax for EndInExpression statement");
3315 if ( AC.inexprlevel <= 0 ) {
3316 MesPrint(
"&EndInExpression without corresponding InExpression statement");
3320 cbuf[AC.cbufnum].Buffer[AC.inexprstack[AC.inexprlevel]] = C->numlhs;
3321 if ( AC.inexprsumcheck[AC.inexprlevel] != NestingChecksum() ) {
3333 int CoSetExitFlag(UBYTE *s)
3336 MesPrint(
"&Illegal syntax for the SetExitFlag statement");
3339 Add2Com(TYPESETEXIT);
3347 int CoTryReplace(UBYTE *p)
3351 WORD *w, error = 0, i, which = -1, c1, minvec = 0;
3368 if ( *p ==
'-' && minvec == 0 && which == (CVECTOR+1) ) {
3371 if ( *p ==
'[' || FG.cTable[*p] == 0 ) {
3373 if ( ( p = SkipAName(p) ) == 0 )
return(1);
3375 i = GetName(AC.varnames,name,&c1,WITHAUTO);
3376 if ( which >= 0 && i >= 0 && i != CDUBIOUS && which != (i+1) ) {
3377 MesPrint(
"&Illegal combination of objects in TryReplace");
3380 else if ( minvec && i != CVECTOR && i != CDUBIOUS ) {
3381 MesPrint(
"&Currently a - sign can be used only with a vector in TryReplace");
3385 case CSYMBOL: *w++ = -SYMBOL; *w++ = c1;
break;
3387 if ( minvec ) *w++ = -MINVECTOR;
3388 else *w++ = -VECTOR;
3389 *w++ = c1 + AM.OffsetVector;
3392 case CINDEX: *w++ = -INDEX; *w++ = c1 + AM.OffsetIndex;
3393 if ( c1 >= AM.WilInd && c ==
'?' ) { *p++ = c; c = *p; }
3395 case CFUNCTION: *w++ = -c1-FUNCTION;
break;
3396 case CDUBIOUS: minvec = 0; error = 1;
break;
3398 MesPrint(
"&Illegal object type in TryReplace: %s",name);
3403 if ( which < 0 ) which = i+1;
3406 if ( *p ==
',' ) p++;
3410 MesPrint(
"&Illegal object in TryReplace");
3412 while ( *p && *p !=
',' ) {
3413 if ( *p ==
'(' ) SKIPBRA3(p)
3414 else if ( *p == '{
' ) SKIPBRA2(p)
3415 else if ( *p == '[
' ) SKIPBRA1(p)
3419 if ( *p == ',
' ) p++;
3420 if ( which < 0 ) which = 0;
3424 MesPrint("&Odd number of arguments in TryReplace");
3427 i = w - AT.WorkPointer;
3428 AT.WorkPointer[1] = i;
3429 AT.WorkPointer[2] = i - 3;
3430 AT.WorkPointer[4] = i - 3;
3431 AddNtoL((int)i,AT.WorkPointer);
3439 Old syntax: Modulus [-] number [:number]
3440 New syntax: Modulus [option(s)] number
3441 Options are: NoFunctions/CoefficientsOnly/AlsoFunctions
3444 PrintPowersOf(number)
3446 AlsoDollars/NoDollars
3447 Notice: We change the defaults. This may cause problems to some.
3450 int CoModulus(UBYTE *inp)
3453 /* #[ Old Syntax : */
3455 WORD sign = 1, Retval;
3456 while ( *inp == '-
' || *inp == '+
' ) {
3457 if ( *inp == '-
' ) sign = -sign;
3461 if ( FG.cTable[*inp] != 1 ) {
3462 MesPrint("&Invalid value for modulus:%s",inp);
3463 if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers");
3467 do { inp++; } while ( FG.cTable[*inp] == 1 );
3469 Retval = GetLong(p,(UWORD *)AC.cmod,&AC.ncmod);
3470 if ( sign < 0 ) AC.ncmod = -AC.ncmod;
3472 if ( c == 0 ) goto regular;
3473 else if ( c != ':
' ) {
3474 MesPrint("&Illegal option for modulus %s",inp);
3475 if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers");
3481 while ( FG.cTable[*inp] == 1 ) inp++;
3483 MesPrint("&Illegal character in option for modulus %s",inp);
3484 if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers");
3488 if ( GetLong(p,(UWORD *)AC.powmod,&AC.npowmod) ) Retval = -1;
3489 if ( TakeModulus((UWORD *)AC.powmod,&AC.npowmod,AC.cmod,AC.ncmod,NOUNPACK) ) Retval = -1;
3490 if ( AC.npowmod == 0 ) {
3491 MesPrint("&Improper value for generator");
3494 if ( MakeModTable() ) Retval = -1;
3497 AN.ncmod = AC.ncmod;
3499 M_free(AC.halfmod,"halfmod");
3500 AC.halfmod = 0; AC.nhalfmod = 0;
3502 if ( AC.modinverses ) {
3503 M_free(AC.halfmod,"modinverses");
3507 /* #] Old Syntax : */
3510 int Retval = 0, sign = 1;
3512 while ( *inp == ',
' || *inp == ' ' || *inp == '\t
' ) inp++;
3515 if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers");
3517 AN.ncmod = AC.ncmod = 0;
3518 if ( AC.halfmod ) M_free(AC.halfmod,"halfmod");
3519 AC.halfmod = 0; AC.nhalfmod = 0;
3520 if ( AC.modinverses ) M_free(AC.modinverses,"modinverses");
3526 if ( *inp == '-
' ) {
3531 while ( FG.cTable[*inp] == 0 ) {
3533 while ( FG.cTable[*inp] == 0 ) inp++;
3535 if ( StrICmp(p,(UBYTE *)"nofunctions") == 0 ) {
3536 AC.modmode &= ~ALSOFUNARGS;
3538 else if ( StrICmp(p,(UBYTE *)"alsofunctions") == 0 ) {
3539 AC.modmode |= ALSOFUNARGS;
3541 else if ( StrICmp(p,(UBYTE *)"coefficientsonly") == 0 ) {
3542 AC.modmode &= ~ALSOFUNARGS;
3543 AC.modmode &= ~ALSOPOWERS;
3546 else if ( StrICmp(p,(UBYTE *)"plusmin") == 0 ) {
3547 AC.modmode |= POSNEG;
3549 else if ( StrICmp(p,(UBYTE *)"positive") == 0 ) {
3550 AC.modmode &= ~POSNEG;
3552 else if ( StrICmp(p,(UBYTE *)"inversetable") == 0 ) {
3553 AC.modmode |= INVERSETABLE;
3555 else if ( StrICmp(p,(UBYTE *)"noinversetable") == 0 ) {
3556 AC.modmode &= ~INVERSETABLE;
3558 else if ( StrICmp(p,(UBYTE *)"nodollars") == 0 ) {
3559 AC.modmode &= ~ALSODOLLARS;
3561 else if ( StrICmp(p,(UBYTE *)"alsodollars") == 0 ) {
3562 AC.modmode |= ALSODOLLARS;
3564 else if ( StrICmp(p,(UBYTE *)"printpowersof") == 0 ) {
3566 if ( *inp != '(
' ) {
3568 MesPrint("&Bad syntax in argument of PrintPowersOf(number) in Modulus statement");
3571 while ( *inp == ',
' || *inp == ' ' || *inp == '\t
' ) inp++;
3573 if ( FG.cTable[*inp] != 1 ) goto badsyntax;
3574 do { inp++; } while ( FG.cTable[*inp] == 1 );
3576 if ( GetLong(p,(UWORD *)AC.powmod,&AC.npowmod) ) Retval = -1;
3577 if ( TakeModulus((UWORD *)AC.powmod,&AC.npowmod,AC.cmod,AC.ncmod,NOUNPACK) ) Retval = -1;
3578 if ( AC.npowmod == 0 ) {
3579 MesPrint("&Improper value for generator");
3582 if ( MakeModTable() ) Retval = -1;
3585 while ( *inp == ',
' || *inp == ' ' || *inp == '\t
' ) inp++;
3586 if ( *inp != ')
' ) goto badsyntax;
3590 else if ( StrICmp(p,(UBYTE *)"alsopowers") == 0 ) {
3591 AC.modmode |= ALSOPOWERS;
3594 else if ( StrICmp(p,(UBYTE *)"nopowers") == 0 ) {
3595 AC.modmode &= ~ALSOPOWERS;
3599 MesPrint("&Unrecognized option %s in Modulus statement",inp);
3603 while ( *inp == ',
' || *inp == ' ' || *inp == '\t
' ) inp++;
3605 MesPrint("&Modulus statement with no value!!!");
3611 if ( FG.cTable[*inp] != 1 ) {
3612 MesPrint("&Invalid value for modulus:%s",inp);
3613 if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers");
3615 AN.ncmod = AC.ncmod = 0;
3616 if ( AC.halfmod ) M_free(AC.halfmod,"halfmod");
3617 AC.halfmod = 0; AC.nhalfmod = 0;
3618 if ( AC.modinverses ) M_free(AC.modinverses,"modinverses");
3622 do { inp++; } while ( FG.cTable[*inp] == 1 );
3624 Retval = GetLong(p,(UWORD *)AC.cmod,&AC.ncmod);
3625 if ( Retval == 0 && AC.ncmod == 0 ) goto SwitchOff;
3626 if ( sign < 0 ) AC.ncmod = -AC.ncmod;
3627 AN.ncmod = AC.ncmod;
3628 if ( ( AC.modmode & INVERSETABLE ) != 0 ) MakeInverses();
3629 if ( AC.halfmod ) M_free(AC.halfmod,"halfmod");
3630 AC.halfmod = 0; AC.nhalfmod = 0;
3640 int CoRepeat(UBYTE *inp)
3643 AC.RepSumCheck[AC.RepLevel] = NestingChecksum();
3645 if ( AC.RepLevel > AM.RepMax ) {
3646 MesPrint("&Too many repeat levels. Maximum is %d",AM.RepMax);
3649 Add3Com(TYPEREPEAT,-1) /* Means indefinite */
3650 while ( *inp == ' ' || *inp == ',
' || *inp == '\t
' ) inp++;
3652 error = CompileStatement(inp);
3653 if ( CoEndRepeat(inp) ) error = 1;
3663 int CoEndRepeat(UBYTE *inp)
3665 CBUF *C = cbuf+AC.cbufnum;
3666 int level, error = 0, repeatlevel = 0;
3669 if ( AC.RepLevel < 0 ) {
3670 MesPrint("&EndRepeat without Repeat");
3674 else if ( AC.RepSumCheck[AC.RepLevel] != NestingChecksum() ) {
3678 level = C->numlhs+1;
3679 while ( level > 0 ) {
3680 if ( C->lhs[--level][0] == TYPEREPEAT ) {
3681 if ( repeatlevel == 0 ) {
3682 Add3Com(TYPEENDREPEAT,level)
3687 else if ( C->lhs[level][0] == TYPEENDREPEAT ) repeatlevel++;
3696 Reads in the bracket information.
3697 Storage is in the form of a regular term.
3698 No subterms and arguments are allowed.
3701 int DoBrackets(UBYTE *inp, int par)
3705 WORD *to, i, type, *w, error = 0;
3706 WORD c1,c2, *WorkSave;
3709 WorkSave = to = AT.WorkPointer;
3711 if ( AT.BrackBuf == 0 ) {
3712 AR.MaxBracket = 100;
3713 AT.BrackBuf = (WORD *)Malloc1(sizeof(WORD)*(AR.MaxBracket+1),"bracket buffer");
3717 AC.bracketindexflag = 0;
3718 AT.bracketindexflag = 0;
3719 if ( *p == '+
' || *p == '-
' ) p++;
3720 if ( p[-1] == ',
' && *p ) p--;
3721 if ( p[-1] == '+
' && *p ) { biflag = 1; if ( *p != ',
' ) { *--p = ',
'; } }
3722 else if ( p[-1] == '-
' && *p ) { biflag = -1; if ( *p != ',
' ) { *--p = ',
'; } }
3724 while ( *p == ',
' ) {
3725 redo: AR.BracketOn++;
3726 while ( *p == ',
' ) p++;
3727 if ( *p == 0 ) break;
3729 p++; while ( *p == '0
' ) p++;
3734 if ( p == 0 ) return(1);
3737 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
3739 if ( type == CVECTOR || type == CDUBIOUS ) {
3743 if ( p == 0 ) return(1);
3746 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
3747 if ( type != CVECTOR && type != CDUBIOUS ) {
3748 MesPrint("&Not a vector in dotproduct in bracket statement: %s",inp);
3751 else type = CDOTPRODUCT;
3754 MesPrint("&Illegal use of . after %s in bracket statement",inp);
3762 *to++ = SYMBOL; *to++ = 4; *to++ = c1; *to++ = 1; break;
3764 *to++ = INDEX; *to++ = 3; *to++ = AM.OffsetVector + c1; break;
3766 *to++ = c1+FUNCTION; *to++ = FUNHEAD; *to++ = 0;
3770 *to++ = DOTPRODUCT; *to++ = 5; *to++ = c1 + AM.OffsetVector;
3771 *to++ = c2 + AM.OffsetVector; *to++ = 1; break;
3773 *to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX; break;
3775 *to++ = SETSET; *to++ = 4; *to++ = c1; *to++ = Sets[c1].type; break;
3777 MesPrint("&Illegal bracket request for %s",pp);
3783 MesCerr("separator",p);
3784 AC.BracketNormalize = 0;
3785 AT.WorkPointer = WorkSave;
3789 *to++ = 1; *to++ = 1; *to++ = 3;
3790 *AT.WorkPointer = to - AT.WorkPointer;
3791 AT.WorkPointer = to;
3792 AC.BracketNormalize = 1;
3793 if ( BracketNormalize(BHEAD WorkSave) ) { error = 1; AR.BracketOn = 0; }
3796 if ( *w == 4 || !*w ) { AR.BracketOn = 0; }
3799 if ( i < 0 ) i = -i;
3802 if ( i > AR.MaxBracket ) {
3804 newbuf = (WORD *)Malloc1(sizeof(WORD)*(i+1),"bracket buffer");
3806 if ( AT.BrackBuf != 0 ) M_free(AT.BrackBuf,"bracket buffer");
3807 AT.BrackBuf = newbuf;
3813 AC.BracketNormalize = 0;
3814 if ( par == 1 ) AR.BracketOn = -AR.BracketOn;
3816 AC.bracketindexflag = biflag;
3817 AT.bracketindexflag = biflag;
3819 AT.WorkPointer = WorkSave;
3828 int CoBracket(UBYTE *inp)
3829 { return(DoBrackets(inp,0)); }
3836 int CoAntiBracket(UBYTE *inp)
3837 { return(DoBrackets(inp,1)); }
3844 MultiBracket:{A|B} bracketinfo:...:{A|B} bracketinfo;
3847 int CoMultiBracket(UBYTE *inp)
3850 int i, error = 0, error1, type, num;
3854 if ( *inp != ':
' ) {
3855 MesPrint("&Illegal Multiple Bracket separator: %s",inp);
3859 if ( AC.MultiBracketBuf == 0 ) {
3860 AC.MultiBracketBuf = (WORD **)Malloc1(sizeof(WORD *)*MAXMULTIBRACKETLEVELS,"multi bracket buffer");
3861 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
3862 AC.MultiBracketBuf[i] = 0;
3866 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
3867 if ( AC.MultiBracketBuf[i] ) {
3868 M_free(AC.MultiBracketBuf[i],"bracket buffer i");
3869 AC.MultiBracketBuf[i] = 0;
3872 AC.MultiBracketLevels = 0;
3874 AC.MultiBracketLevels = 0;
3876 Start with disabling the regular brackets.
3878 if ( AT.BrackBuf == 0 ) {
3879 AR.MaxBracket = 100;
3880 AT.BrackBuf = (WORD *)Malloc1(sizeof(WORD)*(AR.MaxBracket+1),"bracket buffer");
3884 AC.bracketindexflag = 0;
3885 AT.bracketindexflag = 0;
3887 Now loop through the various levels, separated by the colons.
3889 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
3890 if ( *inp == 0 ) goto RegEnd;
3892 1: skip to ':
', determine bracket or antibracket
3895 while ( *s && *s != ':
' ) {
3896 if ( *s == '[
' ) { SKIPBRA1(s) s++; }
3897 else if ( *s == '{
' ) { SKIPBRA2(s) s++; }
3901 if ( StrICont(inp,(UBYTE *)"antibrackets") == 0 ) { type = 1; }
3902 else if ( StrICont(inp,(UBYTE *)"brackets") == 0 ) { type = 0; }
3904 MesPrint("&Illegal (anti)bracket specification in MultiBracket statement");
3905 if ( error == 0 ) error = 1;
3908 while ( FG.cTable[*inp] == 0 ) inp++;
3909 if ( *inp != ',
' ) {
3910 MesPrint("&Illegal separator after (anti)bracket specification in MultiBracket statement");
3911 if ( error == 0 ) error = 1;
3918 error1 = DoBrackets(inp, type);
3919 if ( error < 0 ) return(error1);
3920 if ( error1 > error ) error = error1;
3922 3: copy bracket information to the multi bracket arrays
3924 if ( AR.BracketOn ) {
3925 num = AT.BrackBuf[0];
3926 to = AC.MultiBracketBuf[i] = (WORD *)Malloc1((num+2)*sizeof(WORD),"bracket buffer i");
3928 *to++ = AR.BracketOn;
3933 4: set ready for the next level
3936 *s = c; if ( c == ':
' ) s++;
3942 MesPrint("&More than %d levels in MultiBracket statement",(WORD)MAXMULTIBRACKETLEVELS);
3943 if ( error == 0 ) error = 1;
3946 AC.MultiBracketLevels = i;
3949 AC.bracketindexflag = 0;
3950 AT.bracketindexflag = 0;
3958 This routine reads the count statement. The syntax is:
3959 count minimum,object,size[,object,size]
3965 Vectors can have the auxiliary flags:
3968 Output for the compiler:
3969 TYPECOUNT,size,minimum,objects
3971 SYMBOL,4,number,size
3972 DOTPRODUCT,5,v1,v2,size
3973 FUNCTION,4,number,size
3974 VECTOR,5,number,bits,size or VECTOR,6,number,bits,setnumber,size
3976 Currently only used in the if statement
3979 WORD *CountComp(UBYTE *inp, WORD *to)
3983 WORD *w, mini = 0, type, c1, c2;
3991 while ( *p == ',
' ) {
3993 if ( *p == '[
' || FG.cTable[*p] == 0 ) {
3994 if ( ( p = SkipAName(inp) ) == 0 ) return(0);
3996 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
3998 if ( type == CVECTOR || type == CDUBIOUS ) {
4002 if ( p == 0 ) return(0);
4005 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
4006 if ( type != CVECTOR && type != CDUBIOUS ) {
4007 MesPrint("&Not a vector in dotproduct in if statement: %s",inp);
4010 else type = CDOTPRODUCT;
4013 MesPrint("&Illegal use of . after %s in if statement",inp);
4014 if ( type == NAMENOTFOUND )
4015 MesPrint("&%s is not a properly declared variable",inp);
4018 while ( *p && *p != ')
' && *p != ',
' ) p++;
4019 if ( *p == ',
' && FG.cTable[p[1]] == 1 ) {
4021 while ( *p && *p != ')
' && *p != ',
' ) p++;
4029 *w++ = SYMBOL; *w++ = 4; *w++ = c1;
4030 Sgetnum: if ( *p != ',
' ) {
4031 MesCerr("sequence",p);
4032 while ( *p && *p != ')
' && *p != ',
' ) p++;
4036 ParseSignedNumber(mini,p)
4037 if ( FG.cTable[p[-1]] != 1 || ( *p && *p != ')
' && *p != ',
' ) ) {
4038 while ( *p && *p != ')
' && *p != ',
' ) p++;
4041 MesPrint("&Improper value in count: %s",inp);
4043 while ( *p && *p != ')
' && *p != ',
' ) p++;
4048 *w++ = FUNCTION; *w++ = 4; *w++ = c1+FUNCTION; goto Sgetnum;
4050 *w++ = DOTPRODUCT; *w++ = 5;
4051 *w++ = c2 + AM.OffsetVector;
4052 *w++ = c1 + AM.OffsetVector;
4055 *w++ = VECTOR; *w++ = 5;
4056 *w++ = c1 + AM.OffsetVector;
4058 *w++ = VECTBIT | DOTPBIT | FUNBIT;
4061 else if ( *p == '+
' ) {
4064 while ( *p && *p != ',
' ) {
4065 if ( *p == 'v
' || *p == 'V
' ) {
4068 else if ( *p == 'd
' || *p == 'D
' ) {
4071 else if ( *p == 'f
' || *p == 'F
'
4072 || *p == 't
' || *p == 'T
' ) {
4075 else if ( *p == '?
' ) {
4077 if ( *p == '{
' ) { /* } */
4079 if ( p == 0 ) return(0);
4080 if ( ( c1 = DoTempSet(inp+1,p) ) < 0 ) return(0);
4081 if ( Sets[c1].type != CFUNCTION ) {
4082 MesPrint("&set type conflict: Function expected");
4090 if ( p == 0 ) return(0);
4092 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
4094 if ( type != CSET && type != CDUBIOUS ) {
4095 MesPrint("&%s is not a set",inp);
4105 MesCerr("specifier for vector",p);
4113 MesCerr("specifier for vector",p);
4114 while ( *p && *p != ')
' && *p != ',
' ) p++;
4116 *w++ = VECTBIT | DOTPBIT | FUNBIT;
4123 MesPrint("&%s is not a symbol, function, vector or dotproduct",inp);
4125 skipfield: while ( *p && *p != ')
' && *p != ',
' ) p++;
4126 if ( *p && FG.cTable[p[1]] == 1 ) {
4128 while ( *p && *p != ')
' && *p != ',
' ) p++;
4135 while ( *p && *p != ',
' ) p++;
4140 if ( *p == ')
' ) p++;
4141 if ( *p ) { MesCerr("end of statement",p); return(0); }
4142 if ( error ) return(0);
4150 Reads the if statement: There must be a pair of parentheses.
4151 Much work is delegated to the routines in compi2 and CountComp.
4152 The goto is kept hanging as it is forward.
4153 The address in which the label must be written is pushed on
4156 Here we allow statements of the type
4157 if ( condition ) single statement;
4158 compile the if statement.
4159 test character at end
4161 copy the statement after the proper parenthesis to the
4162 beginning of the AC.iBuffer.
4164 generate an endif statement.
4167 static UWORD *CIscratC = 0;
4169 int CoIf(UBYTE *inp)
4172 int error = 0, level;
4173 WORD *w, *ww, *u, *s, *OldWork, *OldSpace = AT.WorkSpace;
4174 WORD gotexp = 0; /* Indicates whether there can be a condition */
4175 WORD lenpp, lenlev, ncoef, i, number;
4176 UBYTE *p, *pp, *ppp, c;
4177 CBUF *C = cbuf+AC.cbufnum;
4179 if ( *inp == '(
' && inp[1] == ',
' ) inp += 2;
4180 else if ( *inp == '(
' ) inp++; /* Usually we enter at the bracket */
4182 if ( CIscratC == 0 )
4183 CIscratC = (UWORD *)Malloc1((AM.MaxTal+2)*sizeof(UWORD),"CoIf");
4186 if ( AC.IfLevel >= AC.MaxIf ) DoubleIfBuffers();
4187 AC.IfCount[lenpp++] = 0;
4189 IfStack is used for organizing the 'go to
' for the various if levels
4191 *AC.IfStack++ = C->Pointer-C->Buffer+2;
4193 IfSumCheck is used to test for illegal nesting of if, argument or repeat.
4195 AC.IfSumCheck[AC.IfLevel] = NestingChecksum();
4197 w = OldWork = AT.WorkPointer;
4205 if ( FG.cTable[*p] == 1 ) { /* Number */
4206 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4210 if ( GetLong(p,(UWORD *)w,&ncoef) ) { ncoef = 1; error = 1; }
4212 while ( FG.cTable[*++p] == 1 );
4215 if ( FG.cTable[*p] != 1 ) {
4216 MesCerr("sequence",p); error = 1; goto OnlyNum;
4218 if ( GetLong(p,CIscratC,&ncoef) ) {
4219 ncoef = 1; error = 1;
4221 while ( FG.cTable[*++p] == 1 );
4223 MesPrint("&Division by zero!");
4228 if ( Simplify(BHEAD (UWORD *)w,(WORD *)(w-1),
4229 CIscratC,&ncoef) ) error = 1;
4236 s = (WORD *)CIscratC;
4238 while ( --i >= 0 ) *w++ = 0;
4243 while ( --i >= 0 ) *w++ = 0;
4244 s = (WORD *)CIscratC;
4256 while ( --ncoef >= 0 ) *w++ = 0;
4259 u[1] = WORDDIF(w,u);
4260 u[2] = (u[1] - 3)/2;
4261 if ( level ) u[2] = -u[2];
4264 else if ( *p == '+
' ) { p++; goto ReDo; }
4265 else if ( *p == '-
' ) { level ^= 1; p++; goto ReDo; }
4266 else if ( *p == 'c
' || *p == 'C
' ) { /* Count or Coefficient */
4267 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4268 while ( FG.cTable[*++p] == 0 );
4270 if ( !StrICmp(inp,(UBYTE *)"count") ) {
4273 MesPrint("&no ( after count");
4279 c = *++p; *p = 0; *inp = ',
';
4280 w = CountComp(inp,w);
4282 if ( w == 0 ) { error = 1; goto endofif; }
4285 else if ( ConWord(inp,(UBYTE *)"coefficient") && ( p - inp ) > 3 ) {
4294 else if ( *p == 'm
' || *p == 'M
' ) { /* match */
4295 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4296 while ( !FG.cTable[*++p] );
4298 if ( !StrICmp(inp,(UBYTE *)"match") ) {
4301 MesPrint("&no ( after match");
4309 Now we can call the reading of the lhs of an id statement.
4310 This has to be modified in the future.
4312 AT.WorkSpace = AT.WorkPointer = w;
4314 while ( FG.cTable[*ppp] == 0 && ppp < p ) ppp++;
4315 if ( *ppp == ',
' ) AC.idoption = 0;
4316 else AC.idoption = SUBMULTI;
4317 level = CoIdExpression(inp,TYPEIF);
4318 AT.WorkSpace = OldSpace;
4319 AT.WorkPointer = OldWork;
4321 if ( level < 0 ) { error = -1; goto endofif; }
4325 If we pop numlhs we are in good shape
4327 s = u = C->lhs[C->numlhs];
4328 while ( u < C->Pointer ) *w++ = *u++;
4329 C->numlhs--; C->Pointer = s;
4334 else if ( !StrICmp(inp,(UBYTE *)"multipleof") ) {
4335 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4338 MesPrint("&no ( after multipleof");
4339 error = 1; goto endofif;
4342 if ( FG.cTable[*p] != 1 ) {
4343 Nomulof: MesPrint("&multipleof needs a short positive integer argument");
4344 error = 1; goto endofif;
4347 if ( *p != ')
' || x <= 0 || x > MAXPOSITIVE ) goto Nomulof;
4349 *w++ = MULTIPLEOF; *w++ = 3; *w++ = (WORD)x;
4354 NoGood: MesPrint("&Unrecognized word: %s",inp);
4358 if ( c == '(
' ) SKIPBRA4(p)
4363 else if ( *p == 'f
' || *p == 'F
' ) { /* FindLoop */
4364 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4365 while ( FG.cTable[*++p] == 0 );
4367 if ( !StrICmp(inp,(UBYTE *)"findloop") ) {
4370 MesPrint("&no ( after findloop");
4376 c = *++p; *p = 0; *inp = ',
';
4377 if ( CoFindLoop(inp) ) goto endofif;
4378 s = u = C->lhs[C->numlhs];
4379 while ( u < C->Pointer ) *w++ = *u++;
4380 C->numlhs--; C->Pointer = s;
4382 if ( w == 0 ) { error = 1; goto endofif; }
4388 else if ( *p == 'e
' || *p == 'E
' ) { /* Expression */
4389 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4390 while ( FG.cTable[*++p] == 0 );
4392 if ( !StrICmp(inp,(UBYTE *)"expression") ) {
4395 MesPrint("&no ( after expression");
4399 p++; ww = w; *w++ = IFEXPRESSION; w++;
4400 while ( *p != ')
' ) {
4401 if ( *p == ',
' ) { p++; continue; }
4402 if ( *p == '[
' || FG.cTable[*p] == 0 ) {
4404 if ( ( p = SkipAName(p) ) == 0 ) {
4405 MesPrint("&Improper name for an expression: '%s
'",pp);
4410 if ( GetName(AC.exprnames,pp,&number,NOAUTO) == CEXPRESSION ) {
4413 else if ( GetName(AC.varnames,pp,&number,NOAUTO) != NAMENOTFOUND ) {
4414 MesPrint("&%s is not an expression",pp);
4421 MesPrint("&Illegal object in Expression in if-statement");
4423 while ( *p && *p != ',
' && *p != ')
' ) p++;
4424 if ( *p == 0 || *p == ')
' ) break;
4434 else if ( *p == 'i
' || *p == 'I
' ) { /* IsFactorized */
4435 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4436 while ( FG.cTable[*++p] == 0 );
4438 if ( !StrICmp(inp,(UBYTE *)"isfactorized") ) {
4440 if ( c != '(
' ) { /* No expression means current expression */
4441 ww = w; *w++ = IFISFACTORIZED; w++;
4444 p++; ww = w; *w++ = IFISFACTORIZED; w++;
4445 while ( *p != ')
' ) {
4446 if ( *p == ',
' ) { p++; continue; }
4447 if ( *p == '[
' || FG.cTable[*p] == 0 ) {
4449 if ( ( p = SkipAName(p) ) == 0 ) {
4450 MesPrint("&Improper name for an expression: '%s
'",pp);
4455 if ( GetName(AC.exprnames,pp,&number,NOAUTO) == CEXPRESSION ) {
4458 else if ( GetName(AC.varnames,pp,&number,NOAUTO) != NAMENOTFOUND ) {
4459 MesPrint("&%s is not an expression",pp);
4466 MesPrint("&Illegal object in IsFactorized in if-statement");
4468 while ( *p && *p != ',
' && *p != ')
' ) p++;
4469 if ( *p == 0 || *p == ')
' ) break;
4480 else if ( *p == 'o
' || *p == 'O
' ) { /* Occurs */
4482 Tests whether variables occur inside a term.
4483 At the moment this is done one by one.
4484 If we want to do them in groups we should do the reading
4485 a bit different: each as a variable in a term, and then
4486 use Normalize to get the variables grouped and in order.
4487 That way FindVar (in if.c) can work more efficiently.
4489 TASK: Nice little task for someone to learn.
4492 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4493 while ( FG.cTable[*++p] == 0 );
4494 c = cc = *p; *p = 0;
4495 if ( !StrICmp(inp,(UBYTE *)"occurs") ) {
4499 MesPrint("&no ( after occurs");
4505 cc = *++p; *p = 0; *inp = ',
'; pp = p;
4507 *w++ = IFOCCURS; *w++ = 0;
4509 while ( *inp == ',
' ) inp++;
4510 if ( *inp == 0 || *inp == ')
' ) break;
4512 Now read a list of names
4513 We can have symbols, vectors, dotproducts, indices, functions.
4514 There could also be dummy indices and/or extra symbols.
4516 if ( *inp == '[
' || FG.cTable[*inp] == 0 ) {
4517 if ( ( p = SkipAName(inp) ) == 0 ) return(0);
4519 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
4521 if ( type == CVECTOR || type == CDUBIOUS ) {
4525 if ( p == 0 ) return(0);
4528 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
4529 if ( type != CVECTOR && type != CDUBIOUS ) {
4530 MesPrint("&Not a vector in dotproduct in if statement: %s",inp);
4533 else type = CDOTPRODUCT;
4536 MesPrint("&Illegal use of . after %s in if statement",inp);
4537 if ( type == NAMENOTFOUND )
4538 MesPrint("&%s is not a properly declared variable",inp);
4541 while ( *p && *p != ')
' && *p != ',
' ) p++;
4542 if ( *p == ',
' && FG.cTable[p[1]] == 1 ) {
4544 while ( *p && *p != ')
' && *p != ',
' ) p++;
4551 case CSYMBOL: /* To worry about extra symbols */
4557 *w++ = c1 + AM.OffsetIndex;
4561 *w++ = c1 + AM.OffsetVector;
4565 *w++ = c1 + AM.OffsetVector;
4566 *w++ = c2 + AM.OffsetVector;
4573 MesPrint("&Illegal variable %s in occurs condition in if statement",inp);
4580 MesPrint("&Illegal object %s in occurs condition in if statement",inp);
4586 p = pp; *p = cc; *inp = '(
';
4589 MesPrint("&The occurs condition in the if statement needs arguments.");
4596 else if ( *p == '$
' ) {
4597 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4599 while ( FG.cTable[*p] == 0 || FG.cTable[*p] == 1 ) p++;
4601 if ( ( i = GetDollar(inp) ) < 0 ) {
4602 MesPrint("&undefined dollar expression %s",inp);
4604 i = AddDollar(inp,DOLUNDEFINED,0,0);
4607 *w++ = IFDOLLAR; *w++ = 3; *w++ = i;
4609 And then the IFDOLLAREXTRA pieces for [1] [$y] etc
4613 if ( ( w = GetIfDollarFactor(&p,w) ) == 0 ) {
4617 else if ( *p != ']
' ) {
4626 else if ( *p == '(
' ) {
4628 MesCerr("parenthesis",p);
4633 if ( ++lenlev >= AC.MaxIf ) DoubleIfBuffers();
4634 AC.IfCount[lenpp++] = w-OldWork;
4639 else if ( *p == ')
' ) {
4640 if ( gotexp == 0 ) { MesCerr("position for )",p); error = 1; }
4642 u = AC.IfCount[--lenpp]+OldWork;
4645 if ( lenlev <= 0 ) { /* End if condition */
4646 AT.WorkSpace = OldSpace;
4647 AT.WorkPointer = OldWork;
4648 AddNtoL(OldWork[1],OldWork);
4651 MesPrint("&unmatched parenthesis in if/while ()");
4653 while ( *++p == ')
' );
4656 level = CompileStatement(p);
4657 if ( level ) error = level;
4659 if ( CoEndIf(p) && error == 0 ) error = 1;
4665 else if ( *p == '>
' ) {
4666 if ( gotexp == 0 ) goto NoExp;
4667 if ( p[1] == '=
' ) { *w++ = GREATEREQUAL; *w++ = 2; p += 2; }
4668 else { *w++ = GREATER; *w++ = 2; p++; }
4671 else if ( *p == '<
' ) {
4672 if ( gotexp == 0 ) goto NoExp;
4673 if ( p[1] == '=
' ) { *w++ = LESSEQUAL; *w++ = 2; p += 2; }
4674 else { *w++ = LESS; *w++ = 2; p++; }
4677 else if ( *p == '=
' ) {
4678 if ( gotexp == 0 ) goto NoExp;
4679 if ( p[1] == '=
' ) p++;
4680 *w++ = EQUAL; *w++ = 2; p++;
4683 else if ( *p == '!
' && p[1] == '=
' ) {
4684 if ( gotexp == 0 ) { p++; goto NoExp; }
4685 *w++ = NOTEQUAL; *w++ = 2; p += 2;
4688 else if ( *p == '|
' && p[1] == '|
' ) {
4689 if ( gotexp == 0 ) { p++; goto NoExp; }
4690 *w++ = ORCOND; *w++ = 2; p += 2;
4693 else if ( *p == '&
' && p[1] == '&
' ) {
4694 if ( gotexp == 0 ) {
4697 MesCerr("sequence",p);
4701 *w++ = ANDCOND; *w++ = 2; p += 2;
4705 else if ( *p == 0 ) {
4706 MesPrint("&Unmatched parentheses");
4711 if ( FG.cTable[*p] == 0 ) {
4714 while ( ( ij = FG.cTable[*++p] ) == 0 || ij == 1 );
4718 MesCerr("sequence",p);
4732 int CoElse(UBYTE *p)
4735 CBUF *C = cbuf+AC.cbufnum;
4737 while ( *p == ',
' ) p++;
4738 if ( tolower(*p) == 'i
' && tolower(p[1]) == 'f
' && p[2] == '(
' )
4739 return(CoElseIf(p+2));
4740 MesPrint("&No extra text allowed as part of an else statement");
4743 if ( AC.IfLevel <= 0 ) { MesPrint("&else statement without if"); return(1); }
4744 if ( AC.IfSumCheck[AC.IfLevel-1] != NestingChecksum() - 1 ) {
4748 Add3Com(TYPEELSE,AC.IfLevel)
4749 C->Buffer[AC.IfStack[-1]] = C->numlhs;
4750 AC.IfStack[-1] = C->Pointer - C->Buffer - 1;
4759 int CoElseIf(UBYTE *inp)
4761 CBUF *C = cbuf+AC.cbufnum;
4762 if ( AC.IfLevel <= 0 ) { MesPrint("&elseif statement without if"); return(1); }
4763 Add3Com(TYPEELSE,-AC.IfLevel)
4765 C->Buffer[*--AC.IfStack] = C->numlhs;
4773 It puts a RHS-level at the position indicated in the AC.IfStack.
4774 This corresponds to the label belonging to a forward goto.
4775 It is the goto that belongs either to the failing condition
4776 of the if (no else statement), or the completion of the
4777 success path (with else statement)
4778 The code is a jump to the next statement. It is there to prevent
4786 int CoEndIf(UBYTE *inp)
4788 CBUF *C = cbuf+AC.cbufnum;
4789 WORD i = C->numlhs, to, k = -AC.IfLevel;
4791 while ( *inp == ',
' ) inp++;
4794 MesPrint("&No extra text allowed as part of an endif/elseif statement");
4796 if ( AC.IfLevel <= 0 ) {
4797 MesPrint("&Endif statement without corresponding if"); return(1);
4800 C->Buffer[*--AC.IfStack] = i+1;
4801 if ( AC.IfSumCheck[AC.IfLevel] != NestingChecksum() ) {
4805 Add3Com(TYPEENDIF,i+1)
4807 Now the search for the TYPEELSE in front of the elseif statements
4811 if ( C->lhs[i][0] == TYPEELSE && C->lhs[i][2] == to ) to = i;
4812 if ( C->lhs[i][0] == TYPEIF ) {
4813 if ( C->lhs[i][2] == to ) {
4815 if ( i <= 0 || C->lhs[i][0] != TYPEELSE
4816 || C->lhs[i][2] != k ) break;
4817 C->lhs[i][2] = C->numlhs;
4831 int CoWhile(UBYTE *inp)
4833 CBUF *C = cbuf+AC.cbufnum;
4834 WORD startnum = C->numlhs + 1;
4838 if ( C->numlhs > startnum && C->lhs[startnum][2] == C->numlhs
4839 && C->lhs[C->numlhs][0] == TYPEENDIF ) {
4840 C->lhs[C->numlhs][2] = startnum-1;
4843 else C->lhs[startnum][2] = startnum;
4852 int CoEndWhile(UBYTE *inp)
4856 CBUF *C = cbuf+AC.cbufnum;
4857 if ( AC.WhileLevel <= 0 ) {
4858 MesPrint("&EndWhile statement without corresponding While"); return(1);
4861 i = C->Buffer[AC.IfStack[-1]];
4862 error = CoEndIf(inp);
4863 C->lhs[C->numlhs][2] = i - 1;
4871 Function,arguments=number,loopsize=number,outfun=function,include=index;
4874 static char *messfind[] = {
4875 "Findloop(function,arguments=#,loopsize(=#|<#)[,include=index])"
4876 ,"Replaceloop,function,arguments=#,loopsize(=#|<#),outfun=function[,include=index]"
4878 static WORD comfindloop[7] = { TYPEFINDLOOP,7,0,0,0,0,0 };
4880 int DoFindLoop(UBYTE *inp, int mode)
4883 WORD funnum, nargs = 0, nloop = 0, indexnum = 0, outfun = 0;
4884 int type, aflag, lflag, indflag, outflag, error = 0, sym;
4885 while ( *inp == ',
' ) inp++;
4886 if ( ( s = SkipAName(inp) ) == 0 ) {
4887 syntax: MesPrint("&Proper syntax is:");
4888 MesPrint("%s",messfind[mode]);
4892 if ( ( ( type = GetName(AC.varnames,inp,&funnum,WITHAUTO) ) == NAMENOTFOUND )
4893 || type != CFUNCTION || ( ( sym = (functions[funnum].symmetric) & ~REVERSEORDER )
4894 != SYMMETRIC && sym != ANTISYMMETRIC ) ) {
4895 MesPrint("&%s should be a (anti)symmetric function or tensor",inp);
4899 aflag = lflag = indflag = outflag = 0;
4900 while ( *inp == ',
' ) {
4901 while ( *inp == ',
' ) inp++;
4903 if ( ( s = SkipAName(inp) ) == 0 ) goto syntax;
4905 if ( StrICont(inp,(UBYTE *)"arguments") == 0 ) {
4906 if ( c != '=
' ) goto syntax;
4908 NeedNumber(nargs,s,syntax)
4912 else if ( StrICont(inp,(UBYTE *)"loopsize") == 0 ) {
4913 if ( c != '=
' && c != '<
' ) goto syntax;
4915 if ( FG.cTable[*s] == 1 ) {
4916 NeedNumber(nloop,s,syntax)
4918 MesPrint("&loopsize should be at least 2");
4921 if ( c == '<
' ) nloop = -nloop;
4923 else if ( tolower(*s) == 'a
' && tolower(s[1]) == 'l
'
4924 && tolower(s[2]) == 'l
' && FG.cTable[s[3]] > 1 ) {
4926 if ( c != '=
' ) goto syntax;
4931 else if ( StrICont(inp,(UBYTE *)"include") == 0 ) {
4932 if ( c != '=
' ) goto syntax;
4934 if ( ( inp = SkipAName(s) ) == 0 ) goto syntax;
4936 if ( ( type = GetName(AC.varnames,s,&indexnum,WITHAUTO) ) != CINDEX ) {
4937 MesPrint("&%s is not a proper index",s);
4940 else if ( indexnum < WILDOFFSET
4941 && indices[indexnum].dimension == 0 ) {
4942 MesPrint("&%s should be a summable index",s);
4945 indexnum += AM.OffsetIndex;
4949 else if ( StrICont(inp,(UBYTE *)"outfun") == 0 ) {
4950 if ( c != '=
' ) goto syntax;
4952 if ( ( inp = SkipAName(s) ) == 0 ) goto syntax;
4954 if ( ( type = GetName(AC.varnames,s,&outfun,WITHAUTO) ) != CFUNCTION ) {
4955 MesPrint("&%s is not a proper function or tensor",s);
4963 MesPrint("&Unrecognized option in FindLoop or ReplaceLoop: %s",inp);
4965 while ( *inp && *inp != ',
' ) inp++;
4968 if ( *inp != 0 && mode == REPLACELOOP ) goto syntax;
4969 if ( mode == FINDLOOP && outflag > 0 ) {
4970 MesPrint("&outflag option is illegal in FindLoop");
4973 if ( mode == REPLACELOOP && outflag == 0 ) goto syntax;
4974 if ( aflag == 0 || lflag == 0 ) goto syntax;
4975 comfindloop[3] = funnum;
4976 comfindloop[4] = nloop;
4977 comfindloop[5] = nargs;
4978 comfindloop[6] = outfun;
4981 if ( mode == 0 ) comfindloop[2] = indexnum + 5;
4982 else comfindloop[2] = -indexnum - 5;
4984 else comfindloop[2] = mode;
4985 AddNtoL(comfindloop[1],comfindloop);
4994 int CoFindLoop(UBYTE *inp)
4995 { return(DoFindLoop(inp,FINDLOOP)); }
5002 int CoReplaceLoop(UBYTE *inp)
5003 { return(DoFindLoop(inp,REPLACELOOP)); }
5010 static UBYTE *FunPowOptions[] = {
5011 (UBYTE *)"nofunpowers"
5012 ,(UBYTE *)"commutingonly"
5013 ,(UBYTE *)"allfunpowers"
5016 int CoFunPowers(UBYTE *inp)
5019 int i, maxoptions = sizeof(FunPowOptions)/sizeof(UBYTE *);
5020 while ( *inp == ',
' ) inp++;
5022 inp = SkipAName(inp); c = *inp; *inp = 0;
5023 for ( i = 0; i < maxoptions; i++ ) {
5024 if ( StrICont(option,FunPowOptions[i]) == 0 ) {
5027 MesPrint("&Illegal FunPowers statement");
5034 MesPrint("&Illegal option in FunPowers statement: %s",option);
5043 int CoUnitTrace(UBYTE *s)
5046 if ( FG.cTable[*s] == 1 ) {
5049 nogood: MesPrint("&Value of UnitTrace should be a (positive) number or a symbol");
5052 AC.lUniTrace[0] = SNUMBER;
5053 AC.lUniTrace[2] = num;
5056 if ( GetName(AC.varnames,s,&num,WITHAUTO) == CSYMBOL ) {
5057 AC.lUniTrace[0] = SYMBOL;
5058 AC.lUniTrace[2] = num;
5063 if ( *s ) goto nogood;
5065 AC.lUnitTrace = num;
5073 Note: termstack holds the offset of the term statement in the compiler
5074 buffer. termsortstack holds the offset of the last sort statement
5075 (or the corresponding term statement)
5078 int CoTerm(UBYTE *s)
5081 WORD *w = AT.WorkPointer;
5083 while ( *s == ',
' ) s++;
5085 MesPrint("&Illegal syntax for Term statement");
5088 if ( AC.termlevel+1 >= AC.maxtermlevel ) {
5089 if ( AC.maxtermlevel <= 0 ) {
5090 AC.maxtermlevel = 20;
5091 AC.termstack = (LONG *)Malloc1(AC.maxtermlevel*sizeof(LONG),"termstack");
5092 AC.termsortstack = (LONG *)Malloc1(AC.maxtermlevel*sizeof(LONG),"termsortstack");
5093 AC.termsumcheck = (WORD *)Malloc1(AC.maxtermlevel*sizeof(WORD),"termsumcheck");
5096 DoubleBuffer((void **)AC.termstack,(void **)AC.termstack+AC.maxtermlevel,
5097 sizeof(LONG),"doubling termstack");
5098 DoubleBuffer((void **)AC.termsortstack,
5099 (void **)AC.termsortstack+AC.maxtermlevel,
5100 sizeof(LONG),"doubling termsortstack");
5101 DoubleBuffer((void **)AC.termsumcheck,
5102 (void **)AC.termsumcheck+AC.maxtermlevel,
5103 sizeof(LONG),"doubling termsumcheck");
5104 AC.maxtermlevel *= 2;
5107 AC.termsumcheck[AC.termlevel] = NestingChecksum();
5108 AC.termstack[AC.termlevel] = cbuf[AC.cbufnum].Pointer
5109 - cbuf[AC.cbufnum].Buffer + 2;
5110 AC.termsortstack[AC.termlevel] = AC.termstack[AC.termlevel] + 1;
5114 *w++ = cbuf[AC.cbufnum].numlhs;
5115 *w++ = cbuf[AC.cbufnum].numlhs;
5116 AT.WorkPointer[1] = w - AT.WorkPointer;
5117 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
5126 int CoEndTerm(UBYTE *s)
5128 CBUF *C = cbuf+AC.cbufnum;
5129 while ( *s == ',
' ) s++;
5131 MesPrint("&Illegal syntax for EndTerm statement");
5134 if ( AC.termlevel <= 0 ) {
5135 MesPrint("&EndTerm without corresponding Argument statement");
5139 cbuf[AC.cbufnum].Buffer[AC.termstack[AC.termlevel]] = C->numlhs;
5140 cbuf[AC.cbufnum].Buffer[AC.termsortstack[AC.termlevel]] = C->numlhs;
5141 if ( AC.termsumcheck[AC.termlevel] != NestingChecksum() ) {
5153 int CoSort(UBYTE *s)
5156 WORD *w = AT.WorkPointer;
5158 while ( *s == ',
' ) s++;
5160 MesPrint("&Illegal syntax for Sort statement");
5163 if ( AC.termlevel <= 0 ) {
5164 MesPrint("&The Sort statement can only be used inside a term environment");
5167 if ( error ) return(error);
5171 cbuf[AC.cbufnum].Buffer[AC.termsortstack[AC.termlevel-1]] =
5172 *w = cbuf[AC.cbufnum].numlhs+1;
5174 AC.termsortstack[AC.termlevel-1] = cbuf[AC.cbufnum].Pointer
5175 - cbuf[AC.cbufnum].Buffer + 3;
5176 if ( AC.termsumcheck[AC.termlevel-1] != NestingChecksum() - 1 ) {
5180 AT.WorkPointer[1] = w - AT.WorkPointer;
5181 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
5189 Collect,functionname
5192 int CoPolyFun(UBYTE *s)
5198 AR.PolyFun = AC.lPolyFun = 0;
5199 AR.PolyFunInv = AC.lPolyFunInv = 0;
5200 AR.PolyFunType = AC.lPolyFunType = 0;
5201 AR.PolyFunExp = AC.lPolyFunExp = 0;
5202 AR.PolyFunVar = AC.lPolyFunVar = 0;
5203 AR.PolyFunPow = AC.lPolyFunPow = 0;
5204 if ( *s == 0 ) { return(0); }
5206 if ( t == 0 || *t != 0 ) {
5207 MesPrint("&PolyFun statement needs a single commuting function for its argument");
5210 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5211 || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
5212 MesPrint("&%s should be a regular commuting function",s);
5214 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5215 AddFunction(s,0,0,0,0,0,-1,-1);
5219 AR.PolyFun = AC.lPolyFun = numfun+FUNCTION;
5220 AR.PolyFunType = AC.lPolyFunType = 1;
5228 PolyRatFun [,functionname[,functionname](option)]
5231 int CoPolyRatFun(UBYTE *s)
5237 AR.PolyFun = AC.lPolyFun = 0;
5238 AR.PolyFunInv = AC.lPolyFunInv = 0;
5239 AR.PolyFunType = AC.lPolyFunType = 0;
5240 AR.PolyFunExp = AC.lPolyFunExp = 0;
5241 AR.PolyFunVar = AC.lPolyFunVar = 0;
5242 AR.PolyFunPow = AC.lPolyFunPow = 0;
5243 if ( *s == 0 ) return(0);
5245 if ( t == 0 ) goto NumErr;
5247 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5248 || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
5249 MesPrint("&%s should be a regular commuting function",s);
5251 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5252 AddFunction(s,0,0,0,0,0,-1,-1);
5256 AR.PolyFun = AC.lPolyFun = numfun+FUNCTION;
5257 AR.PolyFunInv = AC.lPolyFunInv = 0;
5258 AR.PolyFunType = AC.lPolyFunType = 2;
5259 AC.PolyRatFunChanged = 1;
5260 if ( c == 0 ) return(0);
5262 if ( *t == '-
' ) { AC.PolyRatFunChanged = 0; t++; }
5263 while ( *t == ',
' || *t == ' ' || *t == '\t
' ) t++;
5264 if ( *t == 0 ) return(0);
5268 if ( t == 0 ) goto NumErr;
5270 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5271 || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
5272 MesPrint("&%s should be a regular commuting function",s);
5274 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5275 AddFunction(s,0,0,0,0,0,-1,-1);
5279 AR.PolyFunInv = AC.lPolyFunInv = numfun+FUNCTION;
5280 if ( c == 0 ) return(0);
5282 if ( *t == '-
' ) { AC.PolyRatFunChanged = 0; t++; }
5283 while ( *t == ',
' || *t == ' ' || *t == '\t
' ) t++;
5284 if ( *t == 0 ) return(0);
5288 while ( *t == ',
' || *t == ' ' || *t == '\t
' ) t++;
5290 Next we need a keyword like
5296 if ( t == 0 ) goto NumErr;
5298 if ( ( StrICmp(s,(UBYTE *)"divergence") == 0 )
5299 || ( StrICmp(s,(UBYTE *)"finddivergence") == 0 ) ) {
5301 MesPrint("&Illegal option field in PolyRatFun statement.");
5305 while ( *t == ',
' || *t == ' ' || *t == '\t
' ) t++;
5308 if ( t == 0 ) goto NumErr;
5310 if ( ( type = GetName(AC.varnames,s,&AC.lPolyFunVar,WITHAUTO) ) != CSYMBOL ) {
5311 MesPrint("&Illegal symbol %s in option field in PolyRatFun statement.",s);
5315 while ( *t == ',
' || *t == ' ' || *t == '\t
' ) t++;
5317 MesPrint("&Illegal termination of option in PolyRatFun statement.");
5320 AR.PolyFunExp = AC.lPolyFunExp = 1;
5321 AR.PolyFunVar = AC.lPolyFunVar;
5322 symbols[AC.lPolyFunVar].minpower = -MAXPOWER;
5323 symbols[AC.lPolyFunVar].maxpower = MAXPOWER;
5325 else if ( StrICmp(s,(UBYTE *)"expand") == 0 ) {
5326 WORD x = 0, etype = 2;
5328 MesPrint("&Illegal option field in PolyRatFun statement.");
5332 while ( *t == ',
' || *t == ' ' || *t == '\t
' ) t++;
5335 if ( t == 0 ) goto NumErr;
5337 if ( ( type = GetName(AC.varnames,s,&AC.lPolyFunVar,WITHAUTO) ) != CSYMBOL ) {
5338 MesPrint("&Illegal symbol %s in option field in PolyRatFun statement.",s);
5342 while ( *t == ',
' || *t == ' ' || *t == '\t
' ) t++;
5343 if ( *t > '9
' || *t < '0
' ) {
5344 MesPrint("&Illegal option field in PolyRatFun statement.");
5347 while ( *t <= '9
' && *t >= '0
' ) x = 10*x + *t++ - '0
';
5348 while ( *t == ',
' || *t == ' ' || *t == '\t
' ) t++;
5352 if ( t == 0 ) goto ParErr;
5354 if ( StrICmp(s,(UBYTE *)"fixed") == 0 ) {
5357 else if ( StrICmp(s,(UBYTE *)"relative") == 0 ) {
5361 MesPrint("&Illegal termination of option in PolyRatFun statement.");
5365 while ( *t == ',
' || *t == ' ' || *t == '\t
' ) t++;
5367 MesPrint("&Illegal termination of option in PolyRatFun statement.");
5371 AR.PolyFunExp = AC.lPolyFunExp = etype;
5372 AR.PolyFunVar = AC.lPolyFunVar;
5373 AR.PolyFunPow = AC.lPolyFunPow = x;
5374 symbols[AC.lPolyFunVar].minpower = -MAXPOWER;
5375 symbols[AC.lPolyFunVar].maxpower = MAXPOWER;
5378 ParErr: MesPrint("&Illegal option %s in PolyRatFun statement.",s);
5382 while ( *t == ',
' || *t == ' ' || *t == '\t
' ) t++;
5383 if ( *t == 0 ) return(0);
5386 MesPrint("&PolyRatFun statement needs one or two commuting function(s) for its argument(s)");
5395 int CoMerge(UBYTE *inp)
5399 WORD numfunc, option = 0;
5400 if ( tolower(s[0]) == 'o
' && tolower(s[1]) == 'n
' && tolower(s[2]) == 'c
' &&
5401 tolower(s[3]) == 'e
' && tolower(s[4]) == ',
' ) {
5404 else if ( tolower(s[0]) == 'a
' && tolower(s[1]) == 'l
' && tolower(s[2]) == 'l
' &&
5405 tolower(s[3]) == ',
' ) {
5409 if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
5412 MesPrint("&%s is undefined",s);
5413 numfunc = AddDollar(s+1,DOLINDEX,&one,1);
5416 tests: s = SkipAName(s);
5418 MesPrint("&Merge/shuffle should have a single function or $variable for its argument");
5422 else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
5423 numfunc += FUNCTION;
5426 else if ( type != -1 ) {
5427 if ( type != CDUBIOUS ) {
5428 NameConflict(type,s);
5429 type = MakeDubious(AC.varnames,s,&numfunc);
5434 MesPrint("&%s is not a function",s);
5435 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
5438 Add4Com(TYPEMERGE,numfunc,option);
5446 Important for future options: The bit, given by 256 (bit 8) is reserved
5447 internally for keeping track of the sign in the number of Stuffle
5451 int CoStuffle(UBYTE *inp)
5453 UBYTE *s = inp, *ss, c;
5455 WORD numfunc, option = 0;
5456 if ( tolower(s[0]) == 'o
' && tolower(s[1]) == 'n
' && tolower(s[2]) == 'c
' &&
5457 tolower(s[3]) == 'e
' && tolower(s[4]) == ',
' ) {
5460 else if ( tolower(s[0]) == 'a
' && tolower(s[1]) == 'l
' && tolower(s[2]) == 'l
' &&
5461 tolower(s[3]) == ',
' ) {
5467 if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
5470 MesPrint("&%s is undefined",s);
5471 numfunc = AddDollar(s+1,DOLINDEX,&one,1);
5475 if ( *ss != '+
' && *ss != '-
' && ss[1] != 0 ) {
5476 MesPrint("&Stuffle should have a single function or $variable for its argument, followed by either + or -");
5479 if ( *ss == '-
' ) option += 2;
5481 else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
5482 numfunc += FUNCTION;
5485 else if ( type != -1 ) {
5486 if ( type != CDUBIOUS ) {
5487 NameConflict(type,s);
5488 type = MakeDubious(AC.varnames,s,&numfunc);
5493 MesPrint("&%s is not a function",s);
5494 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
5497 Add4Com(TYPESTUFFLE,numfunc,option);
5503 #[ CoProcessBucket :
5506 int CoProcessBucket(UBYTE *s)
5509 while ( *s == ',
' || *s == '=
' ) s++;
5511 if ( *s && *s != ' ' && *s != '\t
' ) {
5512 MesPrint("&Numerical value expected for ProcessBucketSize");
5515 AC.ProcessBucketSize = x;
5520 #] CoProcessBucket :
5524 int CoThreadBucket(UBYTE *s)
5527 while ( *s == ',
' || *s == '=
' ) s++;
5529 if ( *s && *s != ' ' && *s != '\t
' ) {
5530 MesPrint("&Numerical value expected for ThreadBucketSize");
5534 Warning("Negative of zero value not allowed for ThreadBucketSize. Adjusted to 1.");
5537 AC.ThreadBucketSize = x;
5539 if ( AS.MultiThreaded ) MakeThreadBuckets(-1,1);
5548 Syntax: a list of functions.
5549 If the functions have an argument it must be a function.
5550 In the case f(g) we treat f(g(...)) with g any argument.
5551 (not yet implemented)
5554 int DoArgPlode(UBYTE *s, int par)
5557 WORD numfunc, type, error = 0, *w, n;
5563 while ( *s == ',
' ) s++;
5566 MesPrint("&We don't
do dollar variables yet in ArgImplode/ArgExplode
");
5570 if ( ( s = SkipAName(s) ) == 0 ) return(1);
5572 if ( ( type = GetName(AC.varnames,t,&numfunc,WITHAUTO) ) == CFUNCTION ) {
5573 numfunc += FUNCTION;
5575 else if ( type != -1 ) {
5576 if ( type != CDUBIOUS ) {
5577 NameConflict(type,t);
5578 type = MakeDubious(AC.varnames,t,&numfunc);
5583 MesPrint("&%s is not a
function",t);
5584 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
5591 for ( i = 2; i < FUNHEAD; i++ ) *w++ = 0;
5593 if ( *s && *s != ',' ) {
5594 MesPrint("&Illegal character in ArgImplode/ArgExplode statement: %s
",s);
5597 while ( *s == ',' ) s++;
5599 n = w - AT.WorkPointer;
5600 AT.WorkPointer[1] = n;
5601 AddNtoL(n,AT.WorkPointer);
5610 int CoArgExplode(UBYTE *s) { return(DoArgPlode(s,TYPEARGEXPLODE)); }
5617 int CoArgImplode(UBYTE *s) { return(DoArgPlode(s,TYPEARGIMPLODE)); }
5624 int CoClearTable(UBYTE *s)
5627 int j, type, error = 0;
5631 MesPrint("&The ClearTable statement needs at least one (table) argument.");
5638 if ( ( ( type = GetName(AC.varnames,t,&numfun,WITHAUTO) ) != CFUNCTION )
5639 && type != CDUBIOUS ) {
5640 nofunc: MesPrint(
"&%s is not a table",t);
5642 if ( type < 0 ) numfun = AddFunction(t,0,0,0,0,0,-1,-1);
5644 if ( *s ==
',' ) s++;
5651 else if ( ( T = functions[numfun].tabl ) == 0 )
goto nofunc;
5654 if ( *s ==
',' ) s++;
5659 if ( T->boomlijst ) M_free(T->boomlijst,
"TableTree");
5660 for (j = 0; j < T->buffersfill; j++ ) {
5663 if ( T->buffers ) M_free(T->buffers,
"Table buffers");
5667 T->numtree = 0; T->rootnum = 0; T->MaxTreeSize = 0;
5671 T->buffers = (WORD *)Malloc1(
sizeof(WORD)*T->bufferssize,
"Table buffers");
5673 T->buffers[T->buffersfill++] = T->bufnum;
5681 if ( T->tablepointers ) M_free(T->tablepointers,
"tablepointers");
5682 T->tablepointers = 0;
5684 if ( TT->tablepointers ) M_free(TT->tablepointers,
"tablepointers");
5685 for (j = 0; j < TT->buffersfill; j++ ) {
5688 if ( TT->boomlijst ) M_free(TT->boomlijst,
"TableTree");
5689 if ( TT->buffers )M_free(TT->buffers,
"Table buffers");
5690 if ( TT->mm ) M_free(TT->mm,
"tableminmax");
5691 if ( TT->flags ) M_free(TT->flags,
"tableflags");
5706 int CoDenominators(UBYTE *s)
5710 UBYTE *t = SkipAName(s), *t1;
5711 if ( t == 0 )
goto syntaxerror;
5712 t1 = t;
while ( *t1 ==
',' || *t1 ==
' ' || *t1 ==
'\t' ) t1++;
5713 if ( *t1 )
goto syntaxerror;
5715 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5716 || ( functions[numfun].spec != 0 ) ) {
5718 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5719 AddFunction(s,0,0,0,0,0,-1,-1);
5723 Add3Com(TYPEDENOMINATORS,numfun+FUNCTION);
5726 MesPrint(
"&Denominators statement needs one regular function for its argument");
5735 int CoDropCoefficient(UBYTE *s)
5738 Add2Com(TYPEDROPCOEFFICIENT)
5741 MesPrint("&Illegal argument in DropCoefficient statement: '%s'",s);
5749 int CoDropSymbols(UBYTE *s)
5752 Add2Com(TYPEDROPSYMBOLS)
5755 MesPrint("&Illegal argument in DropSymbols statement: '%s'",s);
5772 int CoToPolynomial(UBYTE *inp)
5775 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5776 if ( ( AC.topolynomialflag & ~TOPOLYNOMIALFLAG ) != 0 ) {
5777 MesPrint(
"&ToPolynomial statement and FactArg statement are not allowed in the same module");
5780 if ( AO.OptimizeResult.code != NULL ) {
5781 MesPrint(
"&Using ToPolynomial statement when there are still optimization results active.");
5782 MesPrint(
"&Please use #ClearOptimize instruction first.");
5783 MesPrint(
"&This will loose the optimized expression.");
5787 Add3Com(TYPETOPOLYNOMIAL,DOALL)
5791 WORD *funnums = 0, type, num;
5794 if ( s == 0 )
return(1);
5796 if ( StrICmp(inp,(UBYTE *)
"onlyfunctions") ) {
5797 MesPrint(
"&Illegal option %s in ToPolynomial statement",inp);
5803 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5809 funnums = (WORD *)Malloc1(((LONG)(s-inp)+3)*
sizeof(WORD),
"ToPlynomial");
5812 if ( s == 0 )
return(1);
5814 type = GetName(AC.varnames,inp,&num,WITHAUTO);
5815 if ( type != CFUNCTION ) {
5816 MesPrint(
"&%s is not a function in ToPolynomial statement",inp);
5819 funnums[3+numargs++] = num+FUNCTION;
5822 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5824 funnums[0] = TYPETOPOLYNOMIAL;
5825 funnums[1] = numargs+3;
5826 funnums[2] = ONLYFUNCTIONS;
5829 if ( funnums ) M_free(funnums,
"ToPolynomial");
5831 AC.topolynomialflag |= TOPOLYNOMIALFLAG;
5834 AC.mparallelflag |= NOPARALLEL_CONVPOLY;
5847 int CoFromPolynomial(UBYTE *inp)
5849 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5851 if ( AO.OptimizeResult.code != NULL ) {
5852 MesPrint(
"&Using FromPolynomial statement when there are still optimization results active.");
5853 MesPrint(
"&Please use #ClearOptimize instruction first.");
5854 MesPrint(
"&This will loose the optimized expression.");
5857 Add2Com(TYPEFROMPOLYNOMIAL)
5860 MesPrint("&Illegal argument in FromPolynomial statement: '%s'",inp);
5873 int CoArgToExtraSymbol(UBYTE *s)
5875 CBUF *C = cbuf + AC.cbufnum;
5879 if ( ( AC.topolynomialflag & ~TOPOLYNOMIALFLAG ) != 0 ) {
5880 MesPrint(
"&ArgToExtraSymbol statement and FactArg statement are not allowed in the same module");
5883 if ( AO.OptimizeResult.code != NULL ) {
5884 MesPrint(
"&Using ArgToExtraSymbol statement when there are still optimization results active.");
5885 MesPrint(
"&Please use #ClearOptimize instruction first.");
5886 MesPrint(
"&This will loose the optimized expression.");
5891 int tonumber = ConsumeOption(&s,
"tonumber");
5893 int ret = DoArgument(s,TYPEARGTOEXTRASYMBOL);
5894 if ( ret )
return(ret);
5900 lhs = C->
lhs[C->numlhs];
5901 if ( lhs[4] != 1 ) {
5902 Warning(
"scale parameter (^n) is ignored in ArgToExtraSymbol");
5906 AC.topolynomialflag |= TOPOLYNOMIALFLAG;
5912 AC.mparallelflag |= NOPARALLEL_CONVPOLY;
5923 int CoExtraSymbols(UBYTE *inp)
5925 UBYTE *arg1, *arg2, c, *s;
5926 WORD i, j, type, number;
5927 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5928 if ( FG.cTable[*inp] != 0 ) {
5929 MesPrint(
"&Illegal argument in ExtraSymbols statement: '%s'",inp);
5933 while ( FG.cTable[*inp] == 0 ) inp++;
5935 if ( ( StrICmp(arg1,(UBYTE *)
"array") == 0 )
5936 || ( StrICmp(arg1,(UBYTE *)
"vector") == 0 ) ) {
5937 AC.extrasymbols = 1;
5939 else if ( StrICmp(arg1,(UBYTE *)
"underscore") == 0 ) {
5940 AC.extrasymbols = 0;
5948 MesPrint(
"&Illegal keyword in ExtraSymbols statement: '%s'",arg1);
5952 while ( *inp ==
' ' || *inp ==
',' || *inp ==
'\t' ) inp++;
5953 if ( FG.cTable[*inp] != 0 ) {
5954 MesPrint(
"&Illegal argument in ExtraSymbols statement: '%s'",inp);
5958 while ( FG.cTable[*inp] <= 1 ) inp++;
5960 MesPrint(
"&Illegal end of ExtraSymbols statement: '%s'",inp);
5967 if ( AC.extrasymbols == 1 ) {
5968 type = GetName(AC.varnames,arg2,&number,NOAUTO);
5969 if ( type != NAMENOTFOUND ) {
5970 MesPrint(
"&ExtraSymbols statement: '%s' has already been declared before",arg2);
5974 else if ( AC.extrasymbols == 0 ) {
5975 if ( *arg2 ==
'N' ) {
5977 while ( FG.cTable[*s] == 1 ) s++;
5979 MesPrint(
"&ExtraSymbols statement: '%s' creates conflicts with summed indices",arg2);
5984 if ( AC.extrasym ) { M_free(AC.extrasym,
"extrasym"); AC.extrasym = 0; }
5986 AC.extrasym = (UBYTE *)Malloc1(i*
sizeof(UBYTE),
"extrasym");
5987 for ( j = 0; j < i; j++ ) AC.extrasym[j] = arg2[j];
5996 WORD *GetIfDollarFactor(UBYTE **inp, WORD *w)
6002 if ( FG.cTable[*s] == 1 ) {
6004 while ( FG.cTable[*s] == 1 ) {
6005 x = 10*x + *s++ -
'0';
6006 if ( x >= MAXPOSITIVE ) {
6007 MesPrint(
"&Value in dollar factor too large");
6008 while ( FG.cTable[*s] == 1 ) s++;
6013 *w++ = IFDOLLAREXTRA;
6020 MesPrint(
"&Factor indicator for $-variable should be a number or a $-variable.");
6024 while ( FG.cTable[*s] < 2 ) s++;
6026 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
6027 MesPrint(
"&dollar in if statement should have been defined previously");
6031 *w++ = IFDOLLAREXTRA;
6037 if ( ( w = GetIfDollarFactor(inp,w) ) == 0 )
return(0);
6040 MesPrint(
"&unmatched [] in $ in if statement");
6054 UBYTE *GetDoParam(UBYTE *inp, WORD **wp,
int par)
6059 if ( FG.cTable[*inp] == 1 ) {
6061 while ( *inp >=
'0' && *inp <=
'9' ) {
6062 x = 10*x + *inp++ -
'0';
6063 if ( x > MAXPOSITIVE ) {
6065 MesPrint(
"&Value in dollar factor too large");
6068 MesPrint(
"&Value in do loop boundaries too large");
6070 while ( FG.cTable[*inp] == 1 ) inp++;
6079 *(*wp)++ = DOLLAREXPR2;
6080 *(*wp)++ = -((WORD)x)-1;
6084 if ( *inp !=
'$' ) {
6088 while ( FG.cTable[*inp] < 2 ) inp++;
6090 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
6092 MesPrint(
"&dollar in print statement should have been defined previously");
6095 MesPrint(
"&dollar in do loop boundaries should have been defined previously");
6101 *(*wp)++ = DOLLAREXPRESSION;
6105 *(*wp)++ = DOLLAREXPR2;
6110 inp = GetDoParam(inp,wp,0);
6111 if ( inp == 0 )
return(0);
6112 if ( *inp !=
']' ) {
6114 MesPrint(
"&unmatched [] in $ in print statement");
6117 MesPrint(
"&unmatched [] in do loop boundaries");
6131 int CoDo(UBYTE *inp)
6134 CBUF *C = cbuf+AC.cbufnum;
6138 if ( AC.doloopstack == 0 ) {
6139 AC.doloopstacksize = 20;
6140 AC.doloopstack = (WORD *)Malloc1(AC.doloopstacksize*2*
sizeof(WORD),
"doloop stack");
6141 AC.doloopnest = AC.doloopstack + AC.doloopstacksize;
6143 if ( AC.dolooplevel >= AC.doloopstacksize ) {
6144 WORD *newstack, *newnest, newsize;
6145 newsize = AC.doloopstacksize * 2;
6146 newstack = (WORD *)Malloc1(newsize*2*
sizeof(WORD),
"doloop stack");
6147 newnest = newstack + newsize;
6148 for ( i = 0; i < newsize; i++ ) {
6149 newstack[i] = AC.doloopstack[i];
6150 newnest[i] = AC.doloopnest[i];
6152 M_free(AC.doloopstack,
"doloop stack");
6153 AC.doloopstack = newstack;
6154 AC.doloopnest = newnest;
6155 AC.doloopstacksize = newsize;
6157 AC.doloopnest[AC.dolooplevel] = NestingChecksum();
6165 while ( *inp ==
',' ) inp++;
6166 if ( *inp !=
'$' ) {
6168 MesPrint(
"&do loop parameter should be a dollar variable");
6173 if ( FG.cTable[*inp] != 0 ) {
6175 MesPrint(
"&illegal name for do loop parameter");
6177 while ( FG.cTable[*inp] < 2 ) inp++;
6179 if ( GetName(AC.dollarnames,name,&numparam,NOAUTO) == NAMENOTFOUND ) {
6180 numparam = AddDollar(name,DOLUNDEFINED,0,0);
6187 while ( *inp ==
',' ) inp++;
6188 if ( *inp !=
'=' )
goto IllSyntax;
6190 while ( *inp ==
',' ) inp++;
6194 inp = GetDoParam(inp,&w,1);
6195 if ( inp == 0 || *inp !=
',' )
goto IllSyntax;
6196 while ( *inp ==
',' ) inp++;
6200 inp = GetDoParam(inp,&w,1);
6201 if ( inp == 0 || ( *inp != 0 && *inp !=
',' ) )
goto IllSyntax;
6205 if ( *inp !=
',' ) {
6206 if ( *inp == 0 ) { *w++ = SNUMBER; *w++ = 1; }
6207 else goto IllSyntax;
6210 while ( *inp ==
',' ) inp++;
6211 inp = GetDoParam(inp,&w,1);
6213 if ( inp == 0 || *inp != 0 )
goto IllSyntax;
6215 AT.WorkPointer[1] = w - AT.WorkPointer;
6219 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
6220 AC.doloopstack[AC.dolooplevel++] = C->numlhs;
6225 MesPrint(
"&Illegal syntax for do statement");
6234 int CoEndDo(UBYTE *inp)
6236 CBUF *C = cbuf+AC.cbufnum;
6238 while ( *inp ==
',' ) inp++;
6240 MesPrint(
"&Illegal syntax for EndDo statement");
6243 if ( AC.dolooplevel <= 0 ) {
6244 MesPrint(
"&EndDo without corresponding Do statement");
6248 scratch[0] = TYPEENDDOLOOP;
6250 scratch[2] = AC.doloopstack[AC.dolooplevel];
6252 cbuf[AC.cbufnum].lhs[AC.doloopstack[AC.dolooplevel]][3] = C->numlhs;
6253 if ( AC.doloopnest[AC.dolooplevel] != NestingChecksum() ) {
6265 int CoFactDollar(UBYTE *inp)
6268 if ( *inp ==
'$' ) {
6269 if ( GetName(AC.dollarnames,inp+1,&numdollar,NOAUTO) != CDOLLAR ) {
6270 MesPrint(
"&%s is undefined",inp);
6271 numdollar = AddDollar(inp+1,DOLINDEX,&one,1);
6274 inp = SkipAName(inp+1);
6276 MesPrint(
"&FactDollar should have a single $variable for its argument");
6282 MesPrint(
"&%s is not a $-variable",inp);
6285 Add3Com(TYPEFACTOR,numdollar);
6294 int CoFactorize(UBYTE *s) {
return(DoFactorize(s,1)); }
6301 int CoNFactorize(UBYTE *s) {
return(DoFactorize(s,0)); }
6308 int CoUnFactorize(UBYTE *s) {
return(DoFactorize(s,3)); }
6315 int CoNUnFactorize(UBYTE *s) {
return(DoFactorize(s,2)); }
6322 int DoFactorize(UBYTE *s,
int par)
6328 int error = 0, keepzeroflag = 0;
6331 while ( *s !=
')' && *s ) {
6332 if ( FG.cTable[*s] == 0 ) {
6333 t = s;
while ( FG.cTable[*s] == 0 ) s++;
6335 if ( StrICmp((UBYTE *)
"keepzero",t) == 0 ) {
6339 MesPrint(
"&Illegal option in [N][Un]Factorize statement: %s",t);
6344 while ( *s ==
',' ) s++;
6345 if ( *s && *s !=
')' && FG.cTable[*s] != 0 ) {
6346 MesPrint(
"&Illegal character in option field of [N][Un]Factorize statement");
6352 while ( *s ==
',' || *s ==
' ' ) s++;
6355 for ( i = NumExpressions-1; i >= 0; i-- ) {
6357 if ( e->replace >= 0 ) {
6358 e = Expressions + e->replace;
6360 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
6361 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
6362 || e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION
6366 e->vflags &= ~TOBEFACTORED;
6369 e->vflags |= TOBEFACTORED;
6370 e->vflags &= ~TOBEUNFACTORED;
6373 e->vflags &= ~TOBEUNFACTORED;
6376 e->vflags |= TOBEUNFACTORED;
6377 e->vflags &= ~TOBEFACTORED;
6381 if ( ( e->vflags & TOBEFACTORED ) != 0 ) {
6382 if ( keepzeroflag ) e->vflags |= KEEPZERO;
6383 else e->vflags &= ~KEEPZERO;
6385 else e->vflags &= ~KEEPZERO;
6390 while ( *s ==
',' ) s++;
6391 if ( *s == 0 )
break;
6392 if ( *s ==
'[' || FG.cTable[*s] == 0 ) {
6394 if ( ( s = SkipAName(s) ) == 0 ) {
6395 MesPrint(
"&Improper name for an expression: '%s'",t);
6399 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
6400 e = Expressions+number;
6401 if ( e->replace >= 0 ) {
6402 e = Expressions + e->replace;
6404 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
6405 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
6406 || e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION
6410 e->vflags &= ~TOBEFACTORED;
6413 e->vflags |= TOBEFACTORED;
6414 e->vflags &= ~TOBEUNFACTORED;
6417 e->vflags &= ~TOBEUNFACTORED;
6420 e->vflags |= TOBEUNFACTORED;
6421 e->vflags &= ~TOBEFACTORED;
6425 if ( ( e->vflags & TOBEFACTORED ) != 0 ) {
6426 if ( keepzeroflag ) e->vflags |= KEEPZERO;
6427 else e->vflags &= ~KEEPZERO;
6429 else e->vflags &= ~KEEPZERO;
6431 else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
6432 MesPrint(
"&%s is not an expression",t);
6438 MesPrint(
"&Illegal object in (N)Factorize statement");
6440 while ( *s && *s !=
',' ) s++;
6441 if ( *s == 0 )
break;
6455 int CoOptimizeOption(UBYTE *s)
6457 UBYTE *name, *t1, *t2, c1, c2, *value, *u;
6460 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
6462 name = s;
while ( FG.cTable[*s] == 0 ) s++;
6464 while ( *s ==
' ' || *s ==
'\t' ) s++;
6467 MesPrint(
"&Correct use in Format,Optimize statement is Optionname=value");
6469 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' || *s ==
'=' ) s++;
6475 while ( *s ==
' ' || *s ==
'\t' ) s++;
6476 if ( *s == 0 )
goto correctuse;
6478 while ( FG.cTable[*s] <= 1 || *s==
'.' || *s==
'*' || *s ==
'(' || *s ==
')' ) {
6479 if ( *s ==
'(' ) { SKIPBRA4(s) }
6483 while ( *s ==
' ' || *s ==
'\t' ) s++;
6484 if ( *s && *s !=
',' )
goto correctuse;
6487 while ( *s ==
' ' || *s ==
'\t' ) s++;
6493 if ( StrICmp(name,(UBYTE *)
"horner") == 0 ) {
6494 if ( StrICmp(value,(UBYTE *)
"occurrence") == 0 ) {
6495 AO.Optimize.horner = O_OCCURRENCE;
6497 else if ( StrICmp(value,(UBYTE *)
"mcts") == 0 ) {
6498 AO.Optimize.horner = O_MCTS;
6500 else if ( StrICmp(value,(UBYTE *)
"sa") == 0 ) {
6501 AO.Optimize.horner = O_SIMULATED_ANNEALING;
6504 AO.Optimize.horner = -1;
6505 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6509 else if ( StrICmp(name,(UBYTE *)
"hornerdirection") == 0 ) {
6510 if ( StrICmp(value,(UBYTE *)
"forward") == 0 ) {
6511 AO.Optimize.hornerdirection = O_FORWARD;
6513 else if ( StrICmp(value,(UBYTE *)
"backward") == 0 ) {
6514 AO.Optimize.hornerdirection = O_BACKWARD;
6516 else if ( StrICmp(value,(UBYTE *)
"forwardorbackward") == 0 ) {
6517 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
6519 else if ( StrICmp(value,(UBYTE *)
"forwardandbackward") == 0 ) {
6520 AO.Optimize.hornerdirection = O_FORWARDANDBACKWARD;
6523 AO.Optimize.method = -1;
6524 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6528 else if ( StrICmp(name,(UBYTE *)
"method") == 0 ) {
6529 if ( StrICmp(value,(UBYTE *)
"none") == 0 ) {
6530 AO.Optimize.method = O_NONE;
6532 else if ( StrICmp(value,(UBYTE *)
"cse") == 0 ) {
6533 AO.Optimize.method = O_CSE;
6535 else if ( StrICmp(value,(UBYTE *)
"csegreedy") == 0 ) {
6536 AO.Optimize.method = O_CSEGREEDY;
6538 else if ( StrICmp(value,(UBYTE *)
"greedy") == 0 ) {
6539 AO.Optimize.method = O_GREEDY;
6542 AO.Optimize.method = -1;
6543 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6547 else if ( StrICmp(name,(UBYTE *)
"timelimit") == 0 ) {
6549 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6551 MesPrint(
"&Option TimeLimit in Format,Optimize statement should be a positive number: %s",value);
6552 AO.Optimize.mctstimelimit = 0;
6553 AO.Optimize.greedytimelimit = 0;
6557 AO.Optimize.mctstimelimit = x/2;
6558 AO.Optimize.greedytimelimit = x/2;
6561 else if ( StrICmp(name,(UBYTE *)
"mctstimelimit") == 0 ) {
6563 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6565 MesPrint(
"&Option MCTSTimeLimit in Format,Optimize statement should be a positive number: %s",value);
6566 AO.Optimize.mctstimelimit = 0;
6570 AO.Optimize.mctstimelimit = x;
6573 else if ( StrICmp(name,(UBYTE *)
"mctsnumexpand") == 0 ) {
6576 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6577 if ( *u ==
'*' || *u ==
'x' || *u ==
'X' ) {
6580 while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6584 MesPrint(
"&Option MCTSNumExpand in Format,Optimize statement should be a positive number: %s",value);
6585 AO.Optimize.mctsnumexpand= 0;
6586 AO.Optimize.mctsnumrepeat= 1;
6590 AO.Optimize.mctsnumexpand= x;
6591 AO.Optimize.mctsnumrepeat= y;
6594 else if ( StrICmp(name,(UBYTE *)
"mctsnumrepeat") == 0 ) {
6596 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6598 MesPrint(
"&Option MCTSNumExpand in Format,Optimize statement should be a positive number: %s",value);
6599 AO.Optimize.mctsnumrepeat= 1;
6603 AO.Optimize.mctsnumrepeat= x;
6606 else if ( StrICmp(name,(UBYTE *)
"mctsnumkeep") == 0 ) {
6608 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6610 MesPrint(
"&Option MCTSNumKeep in Format,Optimize statement should be a positive number: %s",value);
6611 AO.Optimize.mctsnumkeep= 0;
6615 AO.Optimize.mctsnumkeep= x;
6618 else if ( StrICmp(name,(UBYTE *)
"mctsconstant") == 0 ) {
6620 if ( sscanf ((
char*)value,
"%lf", &d) != 1 ) {
6621 MesPrint(
"&Option MCTSConstant in Format,Optimize statement should be a positive number: %s",value);
6622 AO.Optimize.mctsconstant.fval = 0;
6626 AO.Optimize.mctsconstant.fval = d;
6629 else if ( StrICmp(name,(UBYTE *)
"greedytimelimit") == 0 ) {
6631 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6633 MesPrint(
"&Option GreedyTimeLimit in Format,Optimize statement should be a positive number: %s",value);
6634 AO.Optimize.greedytimelimit = 0;
6638 AO.Optimize.greedytimelimit = x;
6641 else if ( StrICmp(name,(UBYTE *)
"greedyminnum") == 0 ) {
6643 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6645 MesPrint(
"&Option GreedyMinNum in Format,Optimize statement should be a positive number: %s",value);
6646 AO.Optimize.greedyminnum= 0;
6650 AO.Optimize.greedyminnum= x;
6653 else if ( StrICmp(name,(UBYTE *)
"greedymaxperc") == 0 ) {
6655 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6657 MesPrint(
"&Option GreedyMaxPerc in Format,Optimize statement should be a positive number: %s",value);
6658 AO.Optimize.greedymaxperc= 0;
6662 AO.Optimize.greedymaxperc= x;
6665 else if ( StrICmp(name,(UBYTE *)
"stats") == 0 ) {
6666 if ( StrICmp(value,(UBYTE *)
"on") == 0 ) {
6667 AO.Optimize.printstats = 1;
6669 else if ( StrICmp(value,(UBYTE *)
"off") == 0 ) {
6670 AO.Optimize.printstats = 0;
6673 AO.Optimize.printstats = 0;
6674 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6678 else if ( StrICmp(name,(UBYTE *)
"printscheme") == 0 ) {
6679 if ( StrICmp(value,(UBYTE *)
"on") == 0 ) {
6680 AO.Optimize.schemeflags |= 1;
6682 else if ( StrICmp(value,(UBYTE *)
"off") == 0 ) {
6683 AO.Optimize.schemeflags &= ~1;
6686 AO.Optimize.schemeflags &= ~1;
6687 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6691 else if ( StrICmp(name,(UBYTE *)
"debugflag") == 0 ) {
6699 if ( FG.cTable[*u] == 1 ) {
6700 while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6702 MesPrint(
"&Numerical value for DebugFlag in Format,Optimize statement should be a nonnegative number: %s",value);
6703 AO.Optimize.debugflags = 0;
6707 AO.Optimize.debugflags = x;
6710 else if ( StrICmp(value,(UBYTE *)
"on") == 0 ) {
6711 AO.Optimize.debugflags = 1;
6713 else if ( StrICmp(value,(UBYTE *)
"off") == 0 ) {
6714 AO.Optimize.debugflags = 0;
6717 AO.Optimize.debugflags = 0;
6718 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6722 else if ( StrICmp(name,(UBYTE *)
"scheme") == 0 ) {
6729 MesPrint(
"&Option Scheme in Format,Optimize statement should be an array of names or integers between (): %s",value);
6734 while ( *ss ==
' ' || *ss ==
'\t' || *ss ==
',' ) ss++;
6735 if ( FG.cTable[*ss] == 0 || *ss ==
'$' || *ss ==
'[' ) {
6736 s1 = u; SKIPBRA3(s1)
6737 if ( *s1 != ')' ) goto noscheme;
6738 while ( ss < s1 ) {
if ( *ss++ ==
',' ) AO.schemenum++; }
6739 *ss++ = 0;
while ( *ss ==
' ' ) ss++;
6740 if ( *ss != 0 )
goto noscheme;
6742 if ( AO.schemenum < 1 ) {
6743 MesPrint(
"&Option Scheme in Format,Optimize statement should have at least one name or number between ()");
6747 if ( AO.inscheme ) M_free(AO.inscheme,
"Horner input scheme");
6748 AO.inscheme = (WORD *)Malloc1((AO.schemenum+1)*
sizeof(WORD),
"Horner input scheme");
6749 while ( *ss ==
' ' || *ss ==
'\t' || *ss ==
',' ) ss++;
6752 if ( *ss == 0 )
break;
6753 s1 = ss; ss = SkipAName(s1); c = *ss; *ss = 0;
6755 if ( ss[-1] ==
'_' ) {
6760 u1 = s1; u2 = AC.extrasym;
6761 while ( *u1 == *u2 ) { u1++; u2++; }
6764 while ( *u1 >=
'0' && *u1 <=
'9' ) numsym = 10*numsym + *u1++ -
'0';
6765 if ( u1 != ss-1 || numsym == 0 || AC.extrasymbols != 0 ) {
6766 MesPrint(
"&Improper use of extra symbol in scheme format option");
6769 numsym = MAXVARIABLES-numsym;
6774 else if ( *s1 ==
'$' ) {
6777 if ( ( numdollar = GetDollar(s1+1) ) < 0 ) {
6778 MesPrint(
"&Undefined variable %s",s1);
6781 else if ( ( numsym = DolToSymbol(BHEAD numdollar) ) < 0 ) {
6782 MesPrint(
"&$%s does not evaluate to a symbol",s1);
6788 else if ( c ==
'(' ) {
6789 if ( StrCmp(s1,AC.extrasym) == 0 ) {
6790 if ( (AC.extrasymbols&1) != 1 ) {
6791 MesPrint(
"&Improper use of extra symbol in scheme format option");
6796 while ( *ss >=
'0' && *ss <=
'9' ) numsym = 10*numsym + *ss++ -
'0';
6798 MesPrint(
"&Extra symbol should have a number for its argument.");
6801 numsym = MAXVARIABLES-numsym;
6806 type = GetName(AC.varnames,s1,&numsym,WITHAUTO);
6807 if ( ( type != CSYMBOL ) && type != CDUBIOUS ) {
6808 MesPrint(
"&%s is not a symbol",s1);
6810 if ( type < 0 ) numsym = AddSymbol(s1,-MAXPOWER,MAXPOWER,0,0);
6814 AO.inscheme[AO.schemenum++] = numsym;
6815 while ( *ss ==
' ' || *ss ==
'\t' || *ss ==
',' ) ss++;
6819 else if ( StrICmp(name,(UBYTE *)
"mctsdecaymode") == 0 ) {
6822 if ( FG.cTable[*u] == 1 ) {
6823 while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6825 MesPrint(
"&Option MCTSDecayMode in Format,Optimize statement should be a nonnegative integer: %s",value);
6826 AO.Optimize.mctsdecaymode = 0;
6830 AO.Optimize.mctsdecaymode = x;
6834 AO.Optimize.mctsdecaymode = 0;
6835 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6839 else if ( StrICmp(name,(UBYTE *)
"saiter") == 0 ) {
6841 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6843 MesPrint(
"&Option SAIter in Format,Optimize statement should be a positive integer: %s",value);
6844 AO.Optimize.saIter = 0;
6848 AO.Optimize.saIter= x;
6851 else if ( StrICmp(name,(UBYTE *)
"samaxt") == 0 ) {
6853 if ( sscanf ((
char*)value,
"%lf", &d) != 1 ) {
6854 MesPrint(
"&Option SAMaxT in Format,Optimize statement should be a positive number: %s",value);
6855 AO.Optimize.saMaxT.fval = 0;
6859 AO.Optimize.saMaxT.fval = d;
6862 else if ( StrICmp(name,(UBYTE *)
"samint") == 0 ) {
6864 if ( sscanf ((
char*)value,
"%lf", &d) != 1 ) {
6865 MesPrint(
"&Option SAMinT in Format,Optimize statement should be a positive number: %s",value);
6866 AO.Optimize.saMinT.fval = 0;
6870 AO.Optimize.saMinT.fval = d;
6874 MesPrint(
"&Unrecognized option name in Format,Optimize statement: %s",name);
6891 int CoPutInside(UBYTE *inp) {
return(DoPutInside(inp,1)); }
6892 int CoAntiPutInside(UBYTE *inp) {
return(DoPutInside(inp,-1)); }
6894 int DoPutInside(UBYTE *inp,
int par)
6898 WORD *to, type, c1,c2,funnum, *WorkSave;
6900 while ( *inp ==
' ' || *inp ==
'\t' || *inp ==
',' ) inp++;
6905 if ( p == 0 )
return(1);
6907 type = GetName(AC.varnames,inp,&funnum,WITHAUTO);
6908 if ( type != CFUNCTION || functions[funnum].tabl != 0 || functions[funnum].spec ) {
6909 MesPrint(
"&PutInside/AntiPutInside expects a regular function for its first argument");
6910 MesPrint(
"&Argument is %s",inp);
6916 while ( *inp ==
' ' || *inp ==
'\t' || *inp ==
',' ) inp++;
6920 tocompiler[0] = TYPEPUTINSIDE;
6923 tocompiler[3] = funnum;
6927 MesPrint(
"&AntiPutInside needs inside information.");
6932 WorkSave = to = AT.WorkPointer;
6933 *to++ = TYPEPUTINSIDE;
6939 while ( *inp ==
' ' || *inp ==
'\t' || *inp ==
',' ) inp++;
6940 if ( *inp == 0 )
break;
6942 if ( p == 0 ) { error = 1;
break; }
6944 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
6946 if ( type == CVECTOR || type == CDUBIOUS ) {
6950 if ( p == 0 )
return(1);
6952 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
6953 if ( type != CVECTOR && type != CDUBIOUS ) {
6954 MesPrint(
"&Not a vector in dotproduct in PutInside/AntiPutInside statement: %s",inp);
6957 else type = CDOTPRODUCT;
6960 MesPrint(
"&Illegal use of . after %s in PutInside/AntiPutInside statement",inp);
6968 *to++ = SYMBOL; *to++ = 4; *to++ = c1; *to++ = 1;
break;
6970 *to++ = INDEX; *to++ = 3; *to++ = AM.OffsetVector + c1;
break;
6972 *to++ = c1+FUNCTION; *to++ = FUNHEAD; *to++ = 0;
6976 *to++ = DOTPRODUCT; *to++ = 5; *to++ = c1 + AM.OffsetVector;
6977 *to++ = c2 + AM.OffsetVector; *to++ = 1; break;
6979 *to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX; break;
6981 MesPrint("&Illegal variable request for %s in PutInside/AntiPutInside statement",inp);
6987 *to++ = 1; *to++ = 1; *to++ = 3;
6988 AT.WorkPointer[1] = to - AT.WorkPointer;
6989 AT.WorkPointer[4] = AT.WorkPointer[1]-4;
6990 AT.WorkPointer = to;
6991 AC.BracketNormalize = 1;
6992 if ( Normalize(BHEAD WorkSave+4) ) { error = 1; }
6994 WorkSave[1] = WorkSave[4]+4;
6995 to = WorkSave + WorkSave[1] - 1;
6999 AddNtoL(WorkSave[1],WorkSave);
7001 AC.BracketNormalize = 0;
7002 AT.WorkPointer = WorkSave;
7014 int CoSwitch(UBYTE *s)
7019 if ( GetName(AC.dollarnames,s+1,&numdollar,NOAUTO) != CDOLLAR ) {
7020 MesPrint(
"&%s is undefined in switch statement",s);
7021 numdollar = AddDollar(s+1,DOLINDEX,&one,1);
7026 MesPrint(
"&Switch should have a single $variable for its argument");
7032 MesPrint(
"&%s is not a $-variable in switch statement",s);
7041 if ( AC.SwitchInArray >= AC.MaxSwitch ) DoubleSwitchBuffers();
7042 AC.SwitchHeap[AC.SwitchLevel] = AC.SwitchInArray;
7043 sw = AC.SwitchArray + AC.SwitchInArray;
7045 sw->iflevel = AC.IfLevel;
7046 sw->whilelevel = AC.WhileLevel;
7047 sw->nestingsum = NestingChecksum();
7049 Add4Com(TYPESWITCH,numdollar,AC.SwitchInArray);
7060 int CoCase(UBYTE *s)
7062 SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
7063 WORD x = 0, sign = 1;
7064 while ( *s ==
',' ) s++;
7066 while ( *s ==
'-' || *s ==
'+' ) {
7067 if ( *s ==
'-' ) sign = -sign;
7070 while ( FG.cTable[*s] == 1 ) { x = 10*x + *s++ -
'0'; }
7073 if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
7074 || sw->nestingsum != NestingChecksum() ) {
7075 MesPrint(
"&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
7081 if ( sw->numcases >= sw->tablesize ) {
7085 if ( sw->tablesize == 0 ) newsize = 10;
7086 else newsize = 2*sw->tablesize;
7089 for ( i = 0; i < sw->tablesize; i++ ) newtable[i] = sw->table[i];
7090 M_free(sw->table,
"Switch table");
7092 sw->table = newtable;
7093 sw->tablesize = newsize;
7095 if ( sw->numcases == 0 ) { sw->mincase = sw->maxcase = x; }
7096 else if ( x > sw->maxcase ) sw->maxcase = x;
7097 else if ( x < sw->mincase ) sw->mincase = x;
7098 sw->table[sw->numcases].ncase = x;
7099 sw->table[sw->numcases].value = cbuf[AC.cbufnum].numlhs;
7100 sw->table[sw->numcases].compbuffer = AC.cbufnum;
7110 int CoBreak(UBYTE *s)
7117 SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
7118 if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
7119 || sw->nestingsum != NestingChecksum() ) {
7120 MesPrint(
"&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
7124 MesPrint(
"&No parameters allowed in Break statement");
7127 Add3Com(TYPEENDSWITCH,AC.SwitchHeap[AC.SwitchLevel]);
7136 int CoDefault(UBYTE *s)
7142 SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
7143 if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
7144 || sw->nestingsum != NestingChecksum() ) {
7145 MesPrint(
"&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
7149 MesPrint(
"&No parameters allowed in Default statement");
7152 sw->defaultcase.ncase = 0;
7153 sw->defaultcase.value = cbuf[AC.cbufnum].numlhs;
7154 sw->defaultcase.compbuffer = AC.cbufnum;
7163 int CoEndSwitch(UBYTE *s)
7172 SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
7174 WORD totcases = sw->maxcase-sw->mincase+1;
7175 while ( *s ==
',' ) s++;
7178 MesPrint(
"&No parameters allowed in EndSwitch statement");
7181 if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
7182 || sw->nestingsum != NestingChecksum() ) {
7183 MesPrint(
"&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
7186 if ( sw->defaultcase.value == 0 ) CoDefault(s);
7187 if ( totcases > sw->numcases*AM.jumpratio ) {
7189 sw->typetable = SPARSETABLE;
7193 SwitchSplitMerge(sw->table,sw->numcases);
7197 sw->caseoffset = sw->mincase;
7198 sw->typetable = DENSETABLE;
7200 for ( i = 0; i < totcases; i++ ) {
7201 ntable[i].ncase = i+sw->caseoffset;
7202 ntable[i].value = sw->defaultcase.value;
7203 ntable[i].compbuffer = sw->defaultcase.compbuffer;
7205 for ( i = 0; i < sw->numcases; i++ ) {
7206 ntable[sw->table[i].ncase-sw->caseoffset] = sw->table[i];
7208 M_free(sw->table,
"Switch table");
7210 sw->numcases = totcases;
7212 sw->endswitch.ncase = 0;
7213 sw->endswitch.value = cbuf[AC.cbufnum].numlhs;
7214 sw->endswitch.compbuffer = AC.cbufnum;
7215 if ( sw->defaultcase.value == 0 ) {
7216 sw->defaultcase = sw->endswitch;
7218 Add3Com(TYPEENDSWITCH,AC.SwitchHeap[AC.SwitchLevel]);
void AddPotModdollar(WORD)
WORD Generator(PHEAD WORD *, WORD)
LONG EndSort(PHEAD WORD *, int)