42 static KEYWORD formatoptions[] = {
43 {
"c", (TFUN)0, CMODE, 0}
44 ,{
"doublefortran", (TFUN)0, DOUBLEFORTRANMODE, 0}
45 ,{
"float", (TFUN)0, 0, 2}
46 ,{
"fortran", (TFUN)0, FORTRANMODE, 0}
47 ,{
"fortran90", (TFUN)0, FORTRANMODE, 4}
48 ,{
"maple", (TFUN)0, MAPLEMODE, 0}
49 ,{
"mathematica", (TFUN)0, MATHEMATICAMODE, 0}
50 ,{
"normal", (TFUN)0, NORMALFORMAT, 1}
51 ,{
"nospaces", (TFUN)0, NOSPACEFORMAT, 3}
52 ,{
"pfortran", (TFUN)0, PFORTRANMODE, 0}
53 ,{
"rational", (TFUN)0, RATIONALMODE, 1}
54 ,{
"reduce", (TFUN)0, REDUCEMODE, 0}
55 ,{
"spaces", (TFUN)0, NORMALFORMAT, 3}
56 ,{
"vortran", (TFUN)0, VORTRANMODE, 0}
59 static KEYWORD trace4options[] = {
60 {
"contract", (TFUN)0, CHISHOLM, 0 }
61 ,{
"nocontract", (TFUN)0, 0, CHISHOLM }
62 ,{
"nosymmetrize",(TFUN)0, 0, ALSOREVERSE}
63 ,{
"notrick", (TFUN)0, NOTRICK, 0 }
64 ,{
"symmetrize", (TFUN)0, ALSOREVERSE, 0 }
65 ,{
"trick", (TFUN)0, 0, NOTRICK }
68 static KEYWORD chisoptions[] = {
69 {
"nosymmetrize",(TFUN)0, 0, ALSOREVERSE}
70 ,{
"symmetrize", (TFUN)0, ALSOREVERSE, 0 }
73 static KEYWORD writeoptions[] = {
74 {
"stats", (TFUN)&(AC.StatsFlag), 1, 0}
75 ,{
"statistics", (TFUN)&(AC.StatsFlag), 1, 0}
76 ,{
"shortstats", (TFUN)&(AC.ShortStats), 1, 0}
77 ,{
"shortstatistics",(TFUN)&(AC.ShortStats), 1, 0}
78 ,{
"warnings", (TFUN)&(AC.WarnFlag), 1, 0}
79 ,{
"allwarnings", (TFUN)&(AC.WarnFlag), 2, 0}
80 ,{
"setup", (TFUN)&(AC.SetupFlag), 1, 0}
81 ,{
"names", (TFUN)&(AC.NamesFlag), 1, 0}
82 ,{
"allnames", (TFUN)&(AC.NamesFlag), 2, 0}
83 ,{
"codes", (TFUN)&(AC.CodesFlag), 1, 0}
84 ,{
"highfirst", (TFUN)&(AC.SortType), SORTHIGHFIRST, SORTLOWFIRST}
85 ,{
"lowfirst", (TFUN)&(AC.SortType), SORTLOWFIRST, SORTHIGHFIRST}
86 ,{
"powerfirst", (TFUN)&(AC.SortType), SORTPOWERFIRST, SORTHIGHFIRST}
87 ,{
"tokens", (TFUN)&(AC.TokensWriteFlag),1, 0}
90 static KEYWORD onoffoptions[] = {
91 {
"compress", (TFUN)&(AC.NoCompress), 0, 1}
92 ,{
"checkpoint", (TFUN)&(AC.CheckpointFlag), 1, 0}
93 ,{
"insidefirst", (TFUN)&(AC.insidefirst), 1, 0}
94 ,{
"propercount", (TFUN)&(AC.BottomLevel), 1, 0}
95 ,{
"stats", (TFUN)&(AC.StatsFlag), 1, 0}
96 ,{
"statistics", (TFUN)&(AC.StatsFlag), 1, 0}
97 ,{
"shortstats", (TFUN)&(AC.ShortStats), 1, 0}
98 ,{
"shortstatistics",(TFUN)&(AC.ShortStats), 1, 0}
99 ,{
"names", (TFUN)&(AC.NamesFlag), 1, 0}
100 ,{
"allnames", (TFUN)&(AC.NamesFlag), 2, 0}
101 ,{
"warnings", (TFUN)&(AC.WarnFlag), 1, 0}
102 ,{
"allwarnings", (TFUN)&(AC.WarnFlag), 2, 0}
103 ,{
"highfirst", (TFUN)&(AC.SortType), SORTHIGHFIRST, SORTLOWFIRST}
104 ,{
"lowfirst", (TFUN)&(AC.SortType), SORTLOWFIRST, SORTHIGHFIRST}
105 ,{
"powerfirst", (TFUN)&(AC.SortType), SORTPOWERFIRST, SORTHIGHFIRST}
106 ,{
"setup", (TFUN)&(AC.SetupFlag), 1, 0}
107 ,{
"codes", (TFUN)&(AC.CodesFlag), 1, 0}
108 ,{
"tokens", (TFUN)&(AC.TokensWriteFlag),1,0}
109 ,{
"properorder", (TFUN)&(AC.properorderflag),1,0}
110 ,{
"threadloadbalancing",(TFUN)&(AC.ThreadBalancing),1, 0}
111 ,{
"threads", (TFUN)&(AC.ThreadsFlag),1, 0}
112 ,{
"threadsortfilesynch",(TFUN)&(AC.ThreadSortFileSynch),1, 0}
113 ,{
"threadstats", (TFUN)&(AC.ThreadStats),1, 0}
114 ,{
"finalstats", (TFUN)&(AC.FinalStats),1, 0}
115 ,{
"fewerstats", (TFUN)&(AC.ShortStatsMax), 10, 0}
116 ,{
"fewerstatistics",(TFUN)&(AC.ShortStatsMax), 10, 0}
117 ,{
"processstats", (TFUN)&(AC.ProcessStats),1, 0}
118 ,{
"oldparallelstats",(TFUN)&(AC.OldParallelStats),1,0}
119 ,{
"parallel", (TFUN)&(AC.parallelflag),PARALLELFLAG,NOPARALLEL_USER}
120 ,{
"nospacesinnumbers",(TFUN)&(AO.NoSpacesInNumbers),1,0}
121 ,{
"indentspace", (TFUN)&(AO.IndentSpace),INDENTSPACE,0}
122 ,{
"totalsize", (TFUN)&(AM.PrintTotalSize), 1, 0}
123 ,{
"flag", (TFUN)&(AC.debugFlags), 1, 0}
124 ,{
"oldfactarg", (TFUN)&(AC.OldFactArgFlag), 1, 0}
125 ,{
"memdebugflag", (TFUN)&(AC.MemDebugFlag), 1, 0}
137 int CoCollect(UBYTE *s)
142 UBYTE *t = SkipAName(s), *t1, *t2;
143 AC.AltCollectFun = 0;
144 if ( t == 0 )
goto syntaxerror;
145 t1 = t;
while ( *t1 ==
',' || *t1 ==
' ' || *t1 ==
'\t' ) t1++;
147 if ( *t1 && ( FG.cTable[*t1] == 0 || *t1 ==
'[' ) ) {
149 if ( t2 == 0 )
goto syntaxerror;
151 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
155 if ( *t && FG.cTable[*t] == 1 ) {
156 while ( *t >=
'0' && *t <=
'9' ) x = 10*x + *t++ -
'0';
157 if ( x > 100 ) x = 100;
158 while ( *t ==
',' || *t ==
' ' || *t ==
'\t' ) t++;
159 if ( *t )
goto syntaxerror;
162 if ( *t )
goto syntaxerror;
165 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
166 || ( functions[numfun].spec != 0 ) ) {
167 MesPrint(
"&%s should be a regular function",s);
169 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
170 AddFunction(s,0,0,0,0,0,-1,-1);
174 AC.CollectFun = numfun+FUNCTION;
175 AC.CollectPercentage = (WORD)x;
177 if ( ( ( type = GetName(AC.varnames,t1,&numfun,WITHAUTO) ) != CFUNCTION )
178 || ( functions[numfun].spec != 0 ) ) {
179 MesPrint(
"&%s should be a regular function",t1);
181 if ( GetName(AC.exprnames,t1,&numfun,NOAUTO) == NAMENOTFOUND )
182 AddFunction(t1,0,0,0,0,0,-1,-1);
186 AC.AltCollectFun = numfun+FUNCTION;
190 MesPrint(
"&Collect statement needs one or two functions (and a percentage) for its argument(s)");
199 int setonoff(UBYTE *s,
int *flag,
int onvalue,
int offvalue)
201 if ( StrICmp(s,(UBYTE *)
"on") == 0 ) *flag = onvalue;
202 else if ( StrICmp(s,(UBYTE *)
"off") == 0 ) *flag = offvalue;
204 MesPrint(
"&Unknown option: %s, on or off expected",s);
215 int CoCompress(UBYTE *s)
219 if ( StrICmp(s,(UBYTE *)
"on") == 0 ) {
223 else if ( StrICmp(s,(UBYTE *)
"off") == 0 ) {
228 t = s;
while ( FG.cTable[*t] <= 1 ) t++;
230 if ( StrICmp(s,(UBYTE *)
"gzip") == 0 ) {
232 Warning(
"gzip compression not supported on this platform");
236 AR.gzipCompress = GZIPDEFAULT;
239 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
241 if ( FG.cTable[*s] == 1 ) {
242 AR.gzipCompress = *s -
'0';
244 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
245 if ( *s == 0 )
return(0);
247 MesPrint(
"&Unknown gzip option: %s, a digit was expected",t);
252 MesPrint(
"&Unknown option: %s, on, off or gzip expected",s);
264 int CoFlags(UBYTE *s,
int value)
268 MesPrint(
"&Proper syntax is: On/Off Flag,number[s];");
271 while ( *s ==
',' ) {
272 do { s++; }
while ( *s ==
',' );
274 if ( FG.cTable[*s] != 1 ) {
275 MesPrint(
"&Proper syntax is: On/Off Flag,number[s];");
279 while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ -
'0'; }
280 if ( i <= 0 || i > MAXFLAGS ) {
281 MesPrint(
"&The number of a flag in On/Off Flag should be in the range 0-%d",(
int)MAXFLAGS);
285 AC.debugFlags[i] = value;
288 MesPrint(
"&Proper syntax is: On/Off Flag,number[s];");
303 int i, num =
sizeof(onoffoptions)/
sizeof(
KEYWORD);
305 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
306 if ( *s == 0 )
return(0);
307 if ( chartype[*s] != 0 ) {
308 MesPrint(
"&Illegal character or option encountered in OFF statement");
311 t = s;
while ( chartype[*s] == 0 ) s++;
313 for ( i = 0; i < num; i++ ) {
314 if ( StrICont(t,(UBYTE *)(onoffoptions[i].name)) == 0 )
break;
317 MesPrint(
"&Unrecognized option in OFF statement: %s",t);
320 else if ( StrICont(t,(UBYTE *)
"compress") == 0 ) {
323 else if ( StrICont(t,(UBYTE *)
"checkpoint") == 0 ) {
324 AC.CheckpointInterval = 0;
325 if ( AC.CheckpointRunBefore ) { free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL; }
326 if ( AC.CheckpointRunAfter ) { free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL; }
327 if ( AC.NoShowInput == 0 ) MesPrint(
"Checkpoints deactivated.");
329 else if ( StrICont(t,(UBYTE *)
"threads") == 0 ) {
330 AS.MultiThreaded = 0;
332 else if ( StrICont(t,(UBYTE *)
"flag") == 0 ) {
334 return(CoFlags(s,0));
337 *((
int *)(onoffoptions[i].func)) = onoffoptions[i].flags;
338 AR.SortType = AC.SortType;
351 int i, num =
sizeof(onoffoptions)/
sizeof(
KEYWORD);
354 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
355 if ( *s == 0 )
return(0);
356 if ( chartype[*s] != 0 ) {
357 MesPrint(
"&Illegal character or option encountered in ON statement");
360 t = s;
while ( chartype[*s] == 0 ) s++;
362 for ( i = 0; i < num; i++ ) {
363 if ( StrICont(t,(UBYTE *)(onoffoptions[i].name)) == 0 )
break;
366 MesPrint(
"&Unrecognized option in ON statement: %s",t);
369 if ( StrICont(t,(UBYTE *)
"compress") == 0 ) {
372 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
375 while ( FG.cTable[*s] <= 1 ) s++;
377 if ( StrICmp(t,(UBYTE *)
"gzip") == 0 ) {}
379 MesPrint(
"&Unrecognized option in ON compress statement: %s",t);
383 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
385 Warning(
"gzip compression not supported on this platform");
387 if ( FG.cTable[*s] == 1 ) {
388 AR.gzipCompress = *s++ -
'0';
389 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
391 MesPrint(
"&Unrecognized option in ON compress gzip statement: %s",t);
395 else if ( *s == 0 ) {
396 AR.gzipCompress = GZIPDEFAULT;
399 MesPrint(
"&Unrecognized option in ON compress gzip statement: %s, single digit expected",t);
404 else if ( StrICont(t,(UBYTE *)
"checkpoint") == 0 ) {
405 AC.CheckpointInterval = 0;
406 if ( AC.CheckpointRunBefore ) { free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL; }
407 if ( AC.CheckpointRunAfter ) { free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL; }
410 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
411 if ( FG.cTable[*s] == 1 ) {
414 do { interval = 10*interval + *s++ -
'0'; }
while ( FG.cTable[*s] == 1 );
415 if ( *s ==
's' || *s ==
'S' ) {
418 else if ( *s ==
'm' || *s ==
'M' ) {
421 else if ( *s ==
'h' || *s ==
'H' ) {
422 interval *= 3600; s++;
424 else if ( *s ==
'd' || *s ==
'D' ) {
425 interval *= 86400; s++;
427 if ( *s !=
',' && FG.cTable[*s] != 6 && FG.cTable[*s] != 10 ) {
428 MesPrint(
"&Unrecognized time interval in ON Checkpoint statement: %s", t);
431 AC.CheckpointInterval = interval * 100;
433 else if ( FG.cTable[*s] == 0 ) {
436 while ( FG.cTable[*s] == 0 ) s++;
438 if ( StrICmp(t,(UBYTE *)
"run") == 0 ) {
441 else if ( StrICmp(t,(UBYTE *)
"runafter") == 0 ) {
444 else if ( StrICmp(t,(UBYTE *)
"runbefore") == 0 ) {
448 MesPrint(
"&Unrecognized option in ON Checkpoint statement: %s", t);
452 if ( *s !=
'=' && FG.cTable[*(s+1)] != 9 ) {
453 MesPrint(
"&Unrecognized option in ON Checkpoint statement: %s", t);
459 if ( FG.cTable[*s] == 9 ) {
462 if ( AC.CheckpointRunBefore ) {
463 free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL;
466 AC.CheckpointRunBefore = Malloc1(s-t+1,
"AC.CheckpointRunBefore");
467 StrCopy(t, (UBYTE*)AC.CheckpointRunBefore);
471 if ( AC.CheckpointRunAfter ) {
472 free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL;
475 AC.CheckpointRunAfter = Malloc1(s-t+1,
"AC.CheckpointRunAfter");
476 StrCopy(t, (UBYTE*)AC.CheckpointRunAfter);
484 if ( FG.cTable[*s] != 9 ) {
485 MesPrint(
"&Unrecognized option in ON Checkpoint statement: %s", t);
509 else if ( StrICont(t,(UBYTE *)
"indentspace") == 0 ) {
511 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
514 while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ -
'0'; }
516 MesPrint(
"&Unrecognized option in ON IndentSpace statement: %s",t);
520 Warning(
"IndentSpace parameter adjusted to 40");
526 AO.IndentSpace = AM.ggIndentSpace;
530 else if ( ( StrICont(t,(UBYTE *)
"fewerstats") == 0 ) ||
531 ( StrICont(t,(UBYTE *)
"fewerstatistics") == 0 ) ) {
533 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
536 while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ -
'0'; }
538 MesPrint(
"&Unrecognized option in ON FewerStatistics statement: %s",t);
541 if ( i > AM.S0->MaxPatches ) {
543 MesPrint(
"&Warning: FewerStatistics parameter greater than MaxPatches(=%d). Adjusted to %d" 544 ,AM.S0->MaxPatches,(AM.S0->MaxPatches+1)/2);
545 i = (AM.S0->MaxPatches+1)/2;
547 AC.ShortStatsMax = i;
550 AC.ShortStatsMax = 10;
554 else if ( StrICont(t,(UBYTE *)
"threads") == 0 ) {
555 if ( AM.totalnumberofthreads > 1 ) AS.MultiThreaded = 1;
557 else if ( StrICont(t,(UBYTE *)
"flag") == 0 ) {
559 return(CoFlags(s,1));
562 *((
int *)(onoffoptions[i].func)) = onoffoptions[i].type;
563 AR.SortType = AC.SortType;
572 int CoInsideFirst(UBYTE *s) {
return(setonoff(s,&AC.insidefirst,1,0)); }
579 int CoProperCount(UBYTE *s) {
return(setonoff(s,&AC.BottomLevel,1,0)); }
586 int CoDelete(UBYTE *s)
588 if ( StrICmp(s,(UBYTE *)
"storage") == 0 ) {
589 if ( DeleteStore(1) < 0 ) {
590 MesPrint(
"&Cannot restart storage file");
596 MesPrint(
"&Unknown option: %s",s);
606 int CoFormat(UBYTE *s)
611 while ( *s ==
' ' || *s ==
',' ) s++;
614 AC.OutputSpaces = NORMALFORMAT;
620 if ( *s ==
'O' || *s ==
'o' ) {
621 if ( ( FG.cTable[s[1]] == 1 ) ||
622 ( s[1] ==
'=' && FG.cTable[s[2]] == 1 ) ) {
623 s++;
if ( *s ==
'=' ) s++;
625 while ( *s >=
'0' && *s <=
'9' ) x = 10*x + *s++ -
'0';
626 while ( *s ==
',' ) s++;
627 AO.OptimizationLevel = x;
628 AO.Optimize.greedytimelimit = 0;
629 AO.Optimize.mctstimelimit = 0;
630 AO.Optimize.printstats = 0;
631 AO.Optimize.debugflags = 0;
632 AO.Optimize.schemeflags = 0;
634 M_free(AO.inscheme,
"Horner input scheme");
635 AO.inscheme = 0; AO.schemenum = 0;
641 AO.Optimize.mctsconstant.fval = -1.0;
642 AO.Optimize.horner = O_OCCURRENCE;
643 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
644 AO.Optimize.method = O_CSE;
647 AO.Optimize.horner = O_OCCURRENCE;
648 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
649 AO.Optimize.method = O_GREEDY;
650 AO.Optimize.greedyminnum = 10;
651 AO.Optimize.greedymaxperc = 5;
654 AO.Optimize.mctsconstant.fval = 1.0;
655 AO.Optimize.horner = O_MCTS;
656 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
657 AO.Optimize.method = O_GREEDY;
658 AO.Optimize.mctsnumexpand = 1000;
659 AO.Optimize.mctsnumkeep = 10;
660 AO.Optimize.mctsnumrepeat = 1;
661 AO.Optimize.greedyminnum = 10;
662 AO.Optimize.greedymaxperc = 5;
666 MesPrint(
"&Illegal optimization specification in format statement");
669 if ( error == 0 && *s != 0 && x > 0 )
return(CoOptimizeOption(s));
675 while ( FG.cTable[*s] == 0 ) s++;
677 if ( StrICont(ss,(UBYTE *)
"optimize") == 0 ) {
679 while ( *s ==
',' ) s++;
680 if ( *s ==
'=' ) s++;
681 AO.OptimizationLevel = 9;
682 AO.Optimize.mctsconstant.fval = 1.0;
683 AO.Optimize.horner = O_MCTS;
684 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
685 AO.Optimize.method = O_GREEDY;
686 AO.Optimize.mctstimelimit = 0;
687 AO.Optimize.mctsnumexpand = 1000;
688 AO.Optimize.mctsnumkeep = 10;
689 AO.Optimize.mctsnumrepeat = 1;
690 AO.Optimize.greedytimelimit = 0;
691 AO.Optimize.greedyminnum = 10;
692 AO.Optimize.greedymaxperc = 5;
693 AO.Optimize.printstats = 0;
694 AO.Optimize.debugflags = 0;
695 AO.Optimize.schemeflags = 0;
697 M_free(AO.inscheme,
"Horner input scheme");
698 AO.inscheme = 0; AO.schemenum = 0;
700 return(CoOptimizeOption(s));
704 MesPrint(
"&Illegal optimization specification in format statement");
710 else if ( FG.cTable[*s] == 1 ) {
712 while ( FG.cTable[*s] == 1 ) x = 10*x + *s++ -
'0';
713 if ( x <= 0 || x >= MAXLINELENGTH ) {
716 MesPrint(
"&Illegal value for linesize: %d",x);
719 MesPrint(
" ... Too small value for linesize corrected to 39");
727 MesPrint(
"&Illegal linesize field in format statement");
731 key = FindKeyWord(s,formatoptions,
732 sizeof(formatoptions)/
sizeof(
KEYWORD));
734 if ( key->flags == 0 ) {
735 if ( key->type == FORTRANMODE || key->type == PFORTRANMODE
736 || key->type == DOUBLEFORTRANMODE || key->type == VORTRANMODE ) {
737 AC.IsFortran90 = ISNOTFORTRAN90;
738 if ( AC.Fortran90Kind ) {
739 M_free(AC.Fortran90Kind,
"Fortran90 Kind");
740 AC.Fortran90Kind = 0;
744 AC.OutputMode = key->type & NODOUBLEMASK;
745 if ( ( key->type & DOUBLEPRECISIONFLAG ) != 0 ) {
749 else if ( key->flags == 1 ) {
750 AC.OutputMode = AC.OutNumberType = key->type;
752 else if ( key->flags == 2 ) {
753 while ( FG.cTable[*s] == 0 ) s++;
754 if ( *s == 0 ) AC.OutNumberType = 10;
755 else if ( *s ==
',' ) {
758 while ( FG.cTable[*s] == 1 ) x = 10*x + *s++ -
'0';
761 MesPrint(
"&Illegal float format specifier");
766 MesPrint(
"& ... float format value corrected to 3");
770 MesPrint(
"& ... float format value corrected to 100");
772 AC.OutNumberType = x;
776 else if ( key->flags == 3 ) {
777 AC.OutputSpaces = key->type;
779 else if ( key->flags == 4 ) {
780 AC.IsFortran90 = ISFORTRAN90;
781 if ( AC.Fortran90Kind ) {
782 M_free(AC.Fortran90Kind,
"Fortran90 Kind");
783 AC.Fortran90Kind = 0;
785 while ( FG.cTable[*s] <= 1 ) s++;
788 while ( *ss && *ss !=
',' ) ss++;
790 MesPrint(
"&No white space or comma's allowed in Fortran90 option: %s",s); error = 1;
793 AC.Fortran90Kind = strDup1(s,
"Fortran90 Kind");
797 AC.OutputMode = key->type & NODOUBLEMASK;
800 else if ( ( *s ==
'c' || *s ==
'C' ) && ( FG.cTable[s[1]] == 1 ) ) {
803 while ( *ss >=
'0' && *ss <=
'9' ) x = 10*x + *ss++ -
'0';
804 if ( *ss != 0 )
goto Unknown;
805 AC.OutputMode = CMODE;
809 Unknown: MesPrint(
"&Unknown option: %s",s); error = 1;
823 if ( StrICmp(s,(UBYTE *)
"brackets") == 0 ) AC.ComDefer = 1;
824 else { MesPrint(
"&Unknown option: '%s'",s);
return(1); }
833 int CoFixIndex(UBYTE *s)
837 if ( FG.cTable[*s] != 1 ) {
838 proper: MesPrint(
"&Proper syntax is: FixIndex,number:value[,number,value];");
842 if ( *s != ':' ) goto proper;
844 if ( *s != '-' && *s != '+' && FG.cTable[*s] != 1 ) goto proper;
845 ParseSignedNumber(y,s)
846 if ( *s && *s != ',' ) goto proper;
847 while ( *s == ',' ) s++;
848 if ( x >= AM.OffsetIndex ) {
849 MesPrint(
"&Fixed index out of allowed range. Change ConstIndex in setup file?");
850 MesPrint(
"&Current value of ConstIndex = %d",AM.OffsetIndex-1);
853 if ( y != (
int)((WORD)y) ) {
854 MesPrint(
"&Value of d_(%d,%d) outside range for this computer",x,x);
857 if ( error == 0 ) AC.FixIndices[x] = y;
867 int CoMetric(UBYTE *s)
868 { DUMMYUSE(s); MesPrint(
"&The metric statement does not do anything yet");
return(1); }
875 int DoPrint(UBYTE *s,
int par)
877 int i, error = 0, numdol = 0, type;
880 WORD numexpr, tofile = 0, *w;
881 CBUF *C = cbuf + AC.cbufnum;
882 while ( *s ==
',' ) s++;
884 if ( ( *s ==
'+' || *s ==
'-' ) && ( s[1] ==
'f' || s[1] ==
'F' ) ) {
885 t = s + 2;
while ( *t ==
' ' || *t ==
',' ) t++;
887 if ( *s ==
'+' ) tofile = 1;
891 if ( par == PRINTON && *s ==
'"' ) {
893 if ( tofile == 1 ) code = TYPEFPRINT;
894 else code = TYPEPRINT;
896 while ( *s && *s !=
'"' ) {
897 if ( *s ==
'\\' ) s++;
898 if ( *s ==
'%' && s[1] ==
'$' ) numdol++;
902 MesPrint(
"&String in print statement should be enclosed in \"");
906 AddComString(1,&code,name,1);
908 while ( *s ==
',' ) {
911 s++; name = s;
while ( FG.cTable[*s] <= 1 ) s++;
913 type = GetName(AC.dollarnames,name,&numexpr,NOAUTO);
914 if ( type == NAMENOTFOUND ) {
915 MesPrint(
"&$ variable %s not (yet) defined",name);
919 C->
lhs[C->numlhs][1] += 2;
920 *(C->
Pointer)++ = DOLLAREXPRESSION;
926 MesPrint(
"&Illegal object in print statement");
934 s = GetDoParam(s,&(C->
Pointer),-1);
935 if ( s == 0 )
return(1);
937 MesPrint(
"&unmatched [] in $ factor");
945 MesPrint(
"&Illegal object in print statement");
949 MesPrint(
"&More $ variables asked for than provided");
957 for ( e = Expressions, i = NumExpressions; i > 0; i--, e++ ) {
958 if ( e->status == LOCALEXPRESSION || e->status ==
959 GLOBALEXPRESSION || e->status == UNHIDELEXPRESSION
960 || e->status == UNHIDEGEXPRESSION ) e->printflag = par;
967 if ( tolower(*s) ==
'f' ) par |= PRINTLFILE;
968 else if ( tolower(*s) ==
's' ) {
969 if ( tolower(s[1]) ==
's' ) {
970 if ( tolower(s[2]) ==
's' ) {
971 par |= PRINTONEFUNCTION | PRINTONETERM | PRINTALL;
974 else if ( ( par & 3 ) < 2 ) par |= PRINTONEFUNCTION | PRINTONETERM;
978 if ( ( par & 3 ) < 2 ) par |= PRINTONETERM;
982 illeg: MesPrint(
"&Illegal option in (n)print statement");
986 if ( *s == 0 )
goto AllExpr;
988 else if ( *s ==
'-' ) {
990 if ( tolower(*s) ==
'f' ) par &= ~PRINTLFILE;
991 else if ( tolower(*s) ==
's' ) {
992 if ( tolower(s[1]) ==
's' ) {
993 if ( tolower(s[2]) ==
's' ) {
997 else if ( ( par & 3 ) < 2 ) {
998 par &= ~PRINTONEFUNCTION;
1004 if ( ( par & 3 ) < 2 ) {
1005 par &= ~PRINTONETERM;
1006 par &= ~PRINTONEFUNCTION;
1013 if ( *s == 0 )
goto AllExpr;
1015 else if ( FG.cTable[*s] == 0 || *s ==
'[' ) {
1017 if ( ( s = SkipAName(s) ) == 0 ) {
1018 MesPrint(
"&Improper name in (n)print statement");
1022 if ( ( GetName(AC.exprnames,name,&numexpr,NOAUTO) == CEXPRESSION )
1023 && ( Expressions[numexpr].status == LOCALEXPRESSION
1024 || Expressions[numexpr].status == GLOBALEXPRESSION ) ) {
1026 if ( c ==
'[' && s[1] ==
']' ) {
1027 Expressions[numexpr].printflag = par | PRINTCONTENTS;
1031 Expressions[numexpr].printflag = par;
1033 else if ( GetLastExprName(name,&numexpr)
1034 && ( Expressions[numexpr].status == LOCALEXPRESSION
1035 || Expressions[numexpr].status == GLOBALEXPRESSION ) ) {
1039 MesPrint(
"&%s is not the name of an active expression",name);
1043 if ( c == 0 )
return(0);
1044 if ( c ==
'-' || c ==
'+' ) s--;
1046 else if ( *s ==
',' ) s++;
1048 MesPrint(
"&Illegal object in (n)print statement");
1060 int CoPrint(UBYTE *s) {
return(DoPrint(s,PRINTON)); }
1067 int CoPrintB(UBYTE *s) {
return(DoPrint(s,PRINTCONTENT)); }
1074 int CoNPrint(UBYTE *s) {
return(DoPrint(s,PRINTOFF)); }
1081 int CoPushHide(UBYTE *s)
1086 if ( AR.Fscr[2].PObuffer == 0 ) {
1087 ScratchBuf = (WORD *)Malloc1(AM.HideSize*
sizeof(WORD),
"hidesize");
1088 AR.Fscr[2].POsize = AM.HideSize *
sizeof(WORD);
1089 AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1090 AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1091 PUTZERO(AR.Fscr[2].POposition);
1093 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
1096 MesPrint(
"&PushHide statement should have no arguments");
1099 for ( i = 0; i < NumExpressions; i++ ) {
1100 switch ( Expressions[i].status ) {
1101 case DROPLEXPRESSION:
1102 case SKIPLEXPRESSION:
1103 case LOCALEXPRESSION:
1104 Expressions[i].status = HIDELEXPRESSION;
1105 Expressions[i].hidelevel = AC.HideLevel-1;
1107 case DROPGEXPRESSION:
1108 case SKIPGEXPRESSION:
1109 case GLOBALEXPRESSION:
1110 Expressions[i].status = HIDEGEXPRESSION;
1111 Expressions[i].hidelevel = AC.HideLevel-1;
1125 int CoPopHide(UBYTE *s)
1128 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
1129 if ( AC.HideLevel <= 0 ) {
1130 MesPrint(
"&PopHide statement without corresponding PushHide statement");
1135 MesPrint(
"&PopHide statement should have no arguments");
1138 for ( i = 0; i < NumExpressions; i++ ) {
1139 switch ( Expressions[i].status ) {
1140 case HIDDENLEXPRESSION:
1141 if ( Expressions[i].hidelevel > AC.HideLevel )
1142 Expressions[i].status = UNHIDELEXPRESSION;
1144 case HIDDENGEXPRESSION:
1145 if ( Expressions[i].hidelevel > AC.HideLevel )
1146 Expressions[i].status = UNHIDEGEXPRESSION;
1160 int SetExprCases(
int par,
int setunset,
int val)
1165 case SKIPLEXPRESSION:
1166 if ( !setunset ) val = LOCALEXPRESSION;
1168 case SKIPGEXPRESSION:
1169 if ( !setunset ) val = GLOBALEXPRESSION;
1171 case LOCALEXPRESSION:
1172 if ( setunset ) val = SKIPLEXPRESSION;
1174 case GLOBALEXPRESSION:
1175 if ( setunset ) val = SKIPGEXPRESSION;
1177 case INTOHIDEGEXPRESSION:
1178 case INTOHIDELEXPRESSION:
1185 case SKIPLEXPRESSION:
1186 case LOCALEXPRESSION:
1187 case HIDELEXPRESSION:
1188 if ( setunset ) val = DROPLEXPRESSION;
1190 case DROPLEXPRESSION:
1191 if ( !setunset ) val = LOCALEXPRESSION;
1193 case SKIPGEXPRESSION:
1194 case GLOBALEXPRESSION:
1195 case HIDEGEXPRESSION:
1196 if ( setunset ) val = DROPGEXPRESSION;
1198 case DROPGEXPRESSION:
1199 if ( !setunset ) val = GLOBALEXPRESSION;
1201 case HIDDENLEXPRESSION:
1202 case UNHIDELEXPRESSION:
1203 if ( setunset ) val = DROPHLEXPRESSION;
1205 case HIDDENGEXPRESSION:
1206 case UNHIDEGEXPRESSION:
1207 if ( setunset ) val = DROPHGEXPRESSION;
1209 case DROPHLEXPRESSION:
1210 if ( !setunset ) val = HIDDENLEXPRESSION;
1212 case DROPHGEXPRESSION:
1213 if ( !setunset ) val = HIDDENGEXPRESSION;
1215 case INTOHIDEGEXPRESSION:
1216 case INTOHIDELEXPRESSION:
1223 case DROPLEXPRESSION:
1224 case SKIPLEXPRESSION:
1225 case LOCALEXPRESSION:
1226 if ( setunset ) val = HIDELEXPRESSION;
1228 case HIDELEXPRESSION:
1229 if ( !setunset ) val = LOCALEXPRESSION;
1231 case DROPGEXPRESSION:
1232 case SKIPGEXPRESSION:
1233 case GLOBALEXPRESSION:
1234 if ( setunset ) val = HIDEGEXPRESSION;
1236 case HIDEGEXPRESSION:
1237 if ( !setunset ) val = GLOBALEXPRESSION;
1239 case INTOHIDEGEXPRESSION:
1240 case INTOHIDELEXPRESSION:
1247 case HIDDENLEXPRESSION:
1248 case DROPHLEXPRESSION:
1249 if ( setunset ) val = UNHIDELEXPRESSION;
1251 case UNHIDELEXPRESSION:
1252 if ( !setunset ) val = HIDDENLEXPRESSION;
1254 case HIDDENGEXPRESSION:
1255 case DROPHGEXPRESSION:
1256 if ( setunset ) val = UNHIDEGEXPRESSION;
1258 case UNHIDEGEXPRESSION:
1259 if ( !setunset ) val = HIDDENGEXPRESSION;
1261 case INTOHIDEGEXPRESSION:
1262 case INTOHIDELEXPRESSION:
1269 case HIDDENLEXPRESSION:
1270 case HIDDENGEXPRESSION:
1271 MesPrint(
"&Expression is already hidden");
1273 case DROPHLEXPRESSION:
1274 case DROPHGEXPRESSION:
1275 case UNHIDELEXPRESSION:
1276 case UNHIDEGEXPRESSION:
1277 MesPrint(
"&Cannot unhide and put intohide expression in the same module");
1279 case LOCALEXPRESSION:
1280 case DROPLEXPRESSION:
1281 case SKIPLEXPRESSION:
1282 case HIDELEXPRESSION:
1283 if ( setunset ) val = INTOHIDELEXPRESSION;
1285 case GLOBALEXPRESSION:
1286 case DROPGEXPRESSION:
1287 case SKIPGEXPRESSION:
1288 case HIDEGEXPRESSION:
1289 if ( setunset ) val = INTOHIDEGEXPRESSION;
1306 int SetExpr(UBYTE *s,
int setunset,
int par)
1311 if ( *s == 0 && ( par != INTOHIDE ) ) {
1312 for ( i = 0; i < NumExpressions; i++ ) {
1313 w = &(Expressions[i].status);
1314 *w = SetExprCases(par,setunset,*w);
1315 if ( *w < 0 ) error = 1;
1316 if ( par == HIDE && setunset == 1 )
1317 Expressions[i].hidelevel = AC.HideLevel;
1322 if ( *s ==
',' ) { s++;
continue; }
1323 if ( *s ==
'0' ) { s++;
continue; }
1325 if ( ( s = SkipAName(s) ) == 0 ) {
1326 MesPrint(
"&Improper name for an expression: '%s'",name);
1330 if ( GetName(AC.exprnames,name,&numexpr,NOAUTO) == CEXPRESSION ) {
1331 w = &(Expressions[numexpr].status);
1332 *w = SetExprCases(par,setunset,*w);
1333 if ( *w < 0 ) error = 1;
1334 if ( ( par == HIDE || par == INTOHIDE ) && setunset == 1 )
1335 Expressions[numexpr].hidelevel = AC.HideLevel;
1337 else if ( GetName(AC.varnames,name,&numexpr,NOAUTO) != NAMENOTFOUND ) {
1338 MesPrint(
"&%s is not an expression",name);
1351 int CoDrop(UBYTE *s) {
return(SetExpr(s,1,DROP)); }
1358 int CoNoDrop(UBYTE *s) {
return(SetExpr(s,0,DROP)); }
1365 int CoSkip(UBYTE *s) {
return(SetExpr(s,1,SKIP)); }
1372 int CoNoSkip(UBYTE *s) {
return(SetExpr(s,0,SKIP)); }
1379 int CoHide(UBYTE *inp) {
1382 if ( AR.Fscr[2].PObuffer == 0 ) {
1383 ScratchBuf = (WORD *)Malloc1(AM.HideSize*
sizeof(WORD),
"hidesize");
1384 AR.Fscr[2].POsize = AM.HideSize *
sizeof(WORD);
1385 AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1386 AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1387 PUTZERO(AR.Fscr[2].POposition);
1389 return(SetExpr(inp,1,HIDE));
1397 int CoIntoHide(UBYTE *inp) {
1400 if ( AR.Fscr[2].PObuffer == 0 ) {
1401 ScratchBuf = (WORD *)Malloc1(AM.HideSize*
sizeof(WORD),
"hidesize");
1402 AR.Fscr[2].POsize = AM.HideSize *
sizeof(WORD);
1403 AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1404 AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1405 PUTZERO(AR.Fscr[2].POposition);
1407 return(SetExpr(inp,1,INTOHIDE));
1415 int CoNoHide(UBYTE *inp) {
return(SetExpr(inp,0,HIDE)); }
1422 int CoUnHide(UBYTE *inp) {
return(SetExpr(inp,1,UNHIDE)); }
1429 int CoNoUnHide(UBYTE *inp) {
return(SetExpr(inp,0,UNHIDE)); }
1436 void AddToCom(
int n, WORD *array)
1438 CBUF *C = cbuf+AC.cbufnum;
1440 MesPrint(
" %a",n,array);
1443 while ( --n >= 0 ) *(C->
Pointer)++ = *array++;
1451 int AddComString(
int n, WORD *array, UBYTE *thestring,
int par)
1453 CBUF *C = cbuf+AC.cbufnum;
1454 UBYTE *s = thestring, *w;
1459 int i, numchars = 0, size, zeroes;
1461 if ( *s ==
'\\' ) s++;
1462 else if ( par == 1 &&
1463 ( ( *s ==
'%' && s[1] !=
't' && s[1] !=
'T' && s[1] !=
'$' &&
1464 s[1] !=
'w' && s[1] !=
'W' && s[1] !=
'r' && s[1] != 0 ) || *s ==
'#' 1465 || *s ==
'@' || *s ==
'&' ) ) {
1471 size = numchars/
sizeof(WORD)+1;
1478 for ( i = 1; i < n; i++ ) *(C->
Pointer)++ = array[i];
1484 zeroes = size*
sizeof(WORD)-numchars;
1487 if ( *s ==
'\\' ) s++;
1488 else if ( par == 1 && ( ( *s ==
'%' &&
1489 s[1] !=
't' && s[1] !=
'T' && s[1] !=
'$' &&
1490 s[1] !=
'w' && s[1] !=
'W' && s[1] !=
'r' && s[1] != 0 ) || *s ==
'#' 1491 || *s ==
'@' || *s ==
'&' ) ) {
1496 while ( --zeroes >= 0 ) *w++ = 0;
1499 MesPrint(
"LH: %a",size+1+n,cc);
1500 MesPrint(
" %s",thestring);
1510 int Add2ComStrings(
int n, WORD *array, UBYTE *string1, UBYTE *string2)
1512 CBUF *C = cbuf+AC.cbufnum;
1513 UBYTE *s1 = string1, *s2 = string2, *w;
1514 int i, num1chars = 0, num2chars = 0, size1, size2, zeroes1, zeroes2;
1516 while ( *s1 ) { s1++; num1chars++; }
1517 size1 = num1chars/
sizeof(WORD)+1;
1519 while ( *s2 ) { s2++; num2chars++; }
1520 size2 = num2chars/
sizeof(WORD)+1;
1523 while ( C->
Pointer+size1+size2+n+3 >= C->
Top ) DoubleCbuffer(AC.cbufnum,C->
Pointer);
1525 *(C->
Pointer)++ = size1+size2+n+3;
1526 for ( i = 1; i < n; i++ ) *(C->
Pointer)++ = array[i];
1529 zeroes1 = size1*
sizeof(WORD)-num1chars;
1531 while ( *s1 ) { *w++ = *s1++; }
1532 while ( --zeroes1 >= 0 ) *w++ = 0;
1537 zeroes2 = size2*
sizeof(WORD)-num2chars;
1539 while ( *s2 ) { *w++ = *s2++; }
1540 while ( --zeroes2 >= 0 ) *w++ = 0;
1551 int CoDiscard(UBYTE *s)
1554 Add2Com(TYPEDISCARD)
1557 MesPrint("&Illegal argument in discard statement: '%s'",s);
1572 static WORD ccarray[5] = { TYPEOPERATION,5,CONTRACT,0,0 };
1574 int CoContract(UBYTE *s)
1580 if ( *s != ',' && *s ) {
1581 proper: MesPrint(
"&Illegal number in contract statement");
1587 else ccarray[4] = 0;
1588 if ( FG.cTable[*s] == 1 ) {
1590 if ( *s ) goto proper;
1593 else if ( *s ) goto proper;
1594 else ccarray[3] = -1;
1595 return(AddNtoL(5,ccarray));
1603 int CoGoTo(UBYTE *inp)
1607 while ( FG.cTable[*s] <= 1 ) s++;
1609 MesPrint(
"&Label should be an alpha-numeric string");
1613 Add3Com(TYPEGOTO,x);
1622 int CoLabel(UBYTE *inp)
1626 while ( FG.cTable[*s] <= 1 ) s++;
1628 MesPrint(
"&Label should be an alpha-numeric string");
1632 AC.Labels[x] = cbuf[AC.cbufnum].numlhs;
1645 int DoArgument(UBYTE *s,
int par)
1648 UBYTE *name, *t, *v, c;
1649 WORD *oldworkpointer = AT.WorkPointer, *w, *ww, number, *scale;
1650 int error = 0, zeroflag, type, x;
1651 AC.lhdollarflag = 0;
1652 while ( *s ==
',' ) s++;
1658 if ( AC.arglevel >= MAXNEST ) {
1659 MesPrint(
"@Nesting of argument statements more than %d levels" 1663 AC.argsumcheck[AC.arglevel] = NestingChecksum();
1664 AC.argstack[AC.arglevel] = cbuf[AC.cbufnum].Pointer
1665 - cbuf[AC.cbufnum].Buffer + 2;
1667 *w++ = cbuf[AC.cbufnum].numlhs;
1672 case TYPESPLITFIRSTARG:
1673 case TYPESPLITLASTARG:
1675 *w++ = cbuf[AC.cbufnum].numlhs+1;
1683 s++; ParseSignedNumber(x,s)
1684 while ( *s == ',' ) s++;
1688 t = s+1; SKIPBRA3(s)
1689 if ( par == TYPEARG ) {
1690 MesPrint(
"&Illegal () entry in argument statement");
1691 error = 1; s++;
goto skipbracks;
1693 else if ( par == TYPESPLITFIRSTARG ) {
1694 MesPrint(
"&Illegal () entry in splitfirstarg statement");
1695 error = 1; s++;
goto skipbracks;
1697 else if ( par == TYPESPLITLASTARG ) {
1698 MesPrint(
"&Illegal () entry in splitlastarg statement");
1699 error = 1; s++;
goto skipbracks;
1704 MesPrint(
"&Wildcarding not allowed in this type of statement");
1710 if ( *t ==
'(' && v[-1] ==
')' ) {
1712 if ( par == TYPESPLITARG ) oldworkpointer[0] = TYPESPLITARG2;
1713 else if ( par == TYPEFACTARG ) oldworkpointer[0] = TYPEFACTARG2;
1714 else if ( par == TYPENORM4 ) oldworkpointer[0] = TYPENORM4;
1715 else if ( par == TYPENORM ) {
1716 if ( *t ==
'-' ) { oldworkpointer[0] = TYPENORM3; t++; }
1717 else { oldworkpointer[0] = TYPENORM2; *scale = 0; }
1721 CBUF *C = cbuf+AC.cbufnum;
1722 WORD oldnumrhs = C->numrhs, oldnumlhs = C->numlhs;
1723 WORD prototype[SUBEXPSIZE+40];
1728 prototype[0] = SUBEXPRESSION;
1729 prototype[1] = SUBEXPSIZE;
1730 prototype[2] = C->numrhs+1;
1732 prototype[4] = AC.cbufnum;
1733 AT.WorkPointer += TYPEARGHEADSIZE+1;
1735 if ( ( retcode = CompileAlgebra(t,LHSIDE,prototype) ) < 0 )
1738 prototype[2] = retcode;
1739 ww = C->
lhs[retcode];
1740 AC.lhdollarflag = 0;
1742 *w++ = -2; *w++ = 0;
1744 else if ( ww[ww[0]] != 0 ) {
1745 MesPrint(
"&There should be only one term between ()");
1748 else if (
NewSort(BHEAD0) ) {
if ( !error ) error = 1; }
1751 if ( !error ) error = 1;
1754 AN.RepPoint = AT.RepCount + 1;
1757 while ( --i >= 0 ) *m++ = *mm++;
1758 mm = AT.WorkPointer; AT.WorkPointer = m;
1759 AR.Cnumlhs = C->numlhs;
1763 else if (
EndSort(BHEAD mm,0) < 0 ) {
1765 AT.WorkPointer = mm;
1767 else if ( *mm == 0 ) {
1768 *w++ = -2; *w++ = 0;
1769 AT.WorkPointer = mm;
1771 else if ( mm[mm[0]] != 0 ) {
1773 AT.WorkPointer = mm;
1776 AT.WorkPointer = mm;
1778 if ( par == TYPEFACTARG ) {
1779 if ( *mm != ABS(m[-1])+1 ) {
1782 mm[-1] = -*mm-1; w += *mm+1;
1790 { mm[-1] = -*mm-1; w += *mm+1; }
1792 oldworkpointer[1] = w - oldworkpointer;
1796 oldworkpointer[5] = AC.lhdollarflag;
1799 C->numrhs = oldnumrhs;
1800 C->numlhs = oldnumlhs;
1805 if ( *s == 0 ) { *w++ = 0; *w++ = 2; *w++ = 1; }
1808 if ( *s ==
',' ) { s++;
continue; }
1809 ww = w; *w++ = 0; w++;
1810 if ( FG.cTable[*s] > 1 && *s !=
'[' && *s !=
'{' ) {
1811 MesPrint(
"&Illegal parameters in statement");
1815 while ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'{' ) {
1820 number = DoTempSet(name,s);
1821 name--; *s++ = c; c = *s; *s = 0;
1826 if ( ( s = SkipAName(s) ) == 0 ) {
1827 MesPrint(
"&Illegal name '%s'",name);
1831 if ( ( type = GetName(AC.varnames,name,&number,WITHAUTO) ) == CSET ) {
1832 doset:
if ( Sets[number].type != CFUNCTION )
goto nofun;
1833 *w++ = CSET; *w++ = number;
1835 else if ( type == CFUNCTION ) {
1836 *w++ = CFUNCTION; *w++ = number + FUNCTION;
1839 nofun: MesPrint(
"&%s is not a function or a set of functions" 1845 while ( *s ==
',' ) s++;
1848 ww = w; w++; zeroflag = 0;
1849 while ( FG.cTable[*s] == 1 ) {
1851 if ( *s && *s != ',' ) {
1852 MesPrint(
"&Illegal separator after number");
1854 while ( *s && *s !=
',' ) s++;
1856 while ( *s ==
',' ) s++;
1857 if ( x == 0 ) zeroflag = 1;
1858 if ( !zeroflag ) *w++ = (WORD)x;
1863 oldworkpointer[1] = w - oldworkpointer;
1864 if ( par == TYPEARG ) {
1865 AC.argstack[AC.arglevel-1] = cbuf[AC.cbufnum].Pointer
1866 - cbuf[AC.cbufnum].Buffer + 2;
1868 AddNtoL(oldworkpointer[1],oldworkpointer);
1869 AT.WorkPointer = oldworkpointer;
1878 int CoArgument(UBYTE *s) {
return(DoArgument(s,TYPEARG)); }
1885 int CoEndArgument(UBYTE *s)
1887 CBUF *C = cbuf+AC.cbufnum;
1888 while ( *s ==
',' ) s++;
1890 MesPrint(
"&Illegal syntax for EndArgument statement");
1893 if ( AC.arglevel <= 0 ) {
1894 MesPrint(
"&EndArgument without corresponding Argument statement");
1898 cbuf[AC.cbufnum].Buffer[AC.argstack[AC.arglevel]] = C->numlhs;
1899 if ( AC.argsumcheck[AC.arglevel] != NestingChecksum() ) {
1911 int CoInside(UBYTE *s) {
return(ExecInside(s)); }
1918 int CoEndInside(UBYTE *s)
1920 CBUF *C = cbuf+AC.cbufnum;
1921 while ( *s ==
',' ) s++;
1923 MesPrint(
"&Illegal syntax for EndInside statement");
1926 if ( AC.insidelevel <= 0 ) {
1927 MesPrint(
"&EndInside without corresponding Inside statement");
1931 cbuf[AC.cbufnum].Buffer[AC.insidestack[AC.insidelevel]] = C->numlhs;
1932 if ( AC.insidesumcheck[AC.insidelevel] != NestingChecksum() ) {
1944 int CoNormalize(UBYTE *s) {
return(DoArgument(s,TYPENORM)); }
1951 int CoMakeInteger(UBYTE *s) {
return(DoArgument(s,TYPENORM4)); }
1958 int CoSplitArg(UBYTE *s) {
return(DoArgument(s,TYPESPLITARG)); }
1965 int CoSplitFirstArg(UBYTE *s) {
return(DoArgument(s,TYPESPLITFIRSTARG)); }
1972 int CoSplitLastArg(UBYTE *s) {
return(DoArgument(s,TYPESPLITLASTARG)); }
1979 int CoFactArg(UBYTE *s) {
1980 if ( ( AC.topolynomialflag & TOPOLYNOMIALFLAG ) != 0 ) {
1981 MesPrint(
"&ToPolynomial statement and FactArg statement are not allowed in the same module");
1984 AC.topolynomialflag |= FACTARGFLAG;
1985 return(DoArgument(s,TYPEFACTARG));
1999 int DoSymmetrize(UBYTE *s,
int par)
2002 int extra = 0, error = 0, err, fix, x, groupsize, num, i;
2004 WORD funnum, *w, *ww, type;
2007 if ( ( s = SkipAName(s) ) == 0 ) {
2008 MesPrint(
"&Improper function name");
2012 if ( c !=
',' || ( FG.cTable[s[1]] != 0 && s[1] !=
'[' ) )
break;
2013 if ( par <= 0 && StrICmp(name,(UBYTE *)
"cyclic") == 0 ) extra = 2;
2014 else if ( par <= 0 && StrICmp(name,(UBYTE *)
"rcyclic") == 0 ) extra = 6;
2016 MesPrint(
"&Illegal option: '%s'",name);
2021 if ( ( err = GetVar(name,&type,&funnum,CFUNCTION,WITHAUTO) ) == NAMENOTFOUND ) {
2022 MesPrint(
"&Undefined function: %s",name);
2023 AddFunction(name,0,0,0,0,0,-1,-1);
2028 if ( err == -1 ) error = 1;
2032 if ( *s ==
',' || *s ==
'(' || *s == 0 ) fix = -1;
2033 else if ( FG.cTable[*s] == 1 ) {
2036 Warning("Restriction to zero arguments removed");
2039 MesPrint(
"&Illegal character after :");
2045 *w++ = TYPEOPERATION;
2054 w += 2; ww = w; groupsize = -1;
2055 while ( *s ==
',' ) s++;
2059 while ( *s && *s !=
')' ) {
2060 if ( *s ==
',' ) { s++;
continue; }
2061 if ( FG.cTable[*s] != 1 )
goto illarg;
2063 if ( x <= 0 || ( fix > 0 && x > fix ) ) goto illnum;
2068 MesPrint(
"&Improper termination of statement");
2071 if ( groupsize < 0 ) groupsize = num;
2072 else if ( groupsize != num )
goto group;
2075 else if ( FG.cTable[*s] == 1 ) {
2076 if ( groupsize < 0 ) groupsize = 1;
2077 else if ( groupsize != 1 ) {
2078 group: MesPrint(
"&All groups should have the same number of arguments");
2082 if ( x <= 0 || ( fix > 0 && x > fix ) ) {
2083 illnum: MesPrint(
"&Illegal argument number: %d",x);
2089 illarg: MesPrint(
"&Illegal argument");
2092 while ( *s ==
',' ) s++;
2101 for ( i = 0; i < fix; i++ ) *w++ = i;
2107 ww[-2] = (w-ww)/groupsize;
2109 AT.WorkPointer[1] = w - AT.WorkPointer;
2110 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
2119 int CoSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,SYMMETRIC)); }
2126 int CoAntiSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,ANTISYMMETRIC)); }
2133 int CoCycleSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,CYCLESYMMETRIC)); }
2140 int CoRCycleSymmetrize(UBYTE *s) {
return(DoSymmetrize(s,RCYCLESYMMETRIC)); }
2147 int CoWrite(UBYTE *s)
2153 if ( ( ( s = SkipAName(s) ) == 0 ) || *s != 0 ) {
2154 MesPrint(
"&Proper use of write statement is: write option");
2157 key = FindInKeyWord(option,writeoptions,
sizeof(writeoptions)/
sizeof(
KEYWORD));
2159 MesPrint(
"&Unrecognized option in write statement");
2162 *((
int *)(key->func)) = key->type;
2163 AR.SortType = AC.SortType;
2172 int CoNWrite(UBYTE *s)
2178 if ( ( ( s = SkipAName(s) ) == 0 ) || *s != 0 ) {
2179 MesPrint(
"&Proper use of nwrite statement is: nwrite option");
2182 key = FindInKeyWord(option,writeoptions,
sizeof(writeoptions)/
sizeof(
KEYWORD));
2184 MesPrint(
"&Unrecognized option in nwrite statement");
2187 *((
int *)(key->func)) = key->flags;
2188 AR.SortType = AC.SortType;
2197 static WORD ratstring[6] = { TYPEOPERATION, 6, RATIO, 0, 0, 0 };
2199 int CoRatio(UBYTE *s)
2202 int i, type, error = 0;
2205 for ( i = 0; i < 3; i++ ) {
2210 if ( ( ( type = GetName(AC.varnames,t,&numsym,WITHAUTO) ) != CSYMBOL )
2211 && type != CDUBIOUS ) {
2212 MesPrint(
"&%s is not a symbol",t);
2214 if ( type < 0 ) numsym = AddSymbol(t,-MAXPOWER,MAXPOWER,0,0);
2217 if ( *s ==
',' ) s++;
2221 MesPrint(
"&The ratio statement needs three symbols for its arguments");
2227 AddNtoL(6,ratstring);
2239 int CoRedefine(UBYTE *s)
2241 UBYTE *name, c, *args = 0;
2245 if ( FG.cTable[*s] || ( s = SkipAName(s) ) == 0 || s[-1] ==
'_' ) {
2246 MesPrint(
"&Illegal name for preprocessor variable in redefine statement");
2250 for ( numprevar = NumPre-1; numprevar >= 0; numprevar-- ) {
2251 if ( StrCmp(name,PreVar[numprevar].name) == 0 )
break;
2253 if ( numprevar < 0 ) {
2254 MesPrint(
"&There is no preprocessor variable with the name `%s'",name);
2266 if ( chartype[*s] != 0 )
goto illarg;
2268 while ( chartype[*s] <= 1 ) s++;
2269 while ( *s ==
' ' || *s ==
'\t' ) s++;
2270 if ( *s ==
')' )
break;
2271 if ( *s !=
',' )
goto illargs;
2273 while ( *s ==
' ' || *s ==
'\t' ) s++;
2276 while ( *s ==
' ' || *s ==
'\t' ) s++;
2278 while ( *s ==
',' ) s++;
2280 encl: MesPrint(
"&Value for %s should be enclosed in double quotes" 2281 ,PreVar[numprevar].name);
2285 while ( *s && *s !=
'"' ) {
if ( *s ==
'\\' ) s++; s++; }
2286 if ( *s !=
'"' )
goto encl;
2288 code[0] = TYPEREDEFPRE; code[1] = numprevar;
2292 Add2ComStrings(2,code,name,args);
2304 for ( j = 0; j < AC.numpfirstnum; j++ ) {
2305 if ( numprevar == AC.pfirstnum[j] )
break;
2307 if ( j >= AC.numpfirstnum ) {
2308 if ( j >= AC.sizepfirstnum ) {
2309 if ( AC.sizepfirstnum <= 0 ) { AC.sizepfirstnum = 10; }
2310 else { AC.sizepfirstnum = 2 * AC.sizepfirstnum; }
2311 newin = (LONG *)Malloc1(AC.sizepfirstnum*(
sizeof(WORD)+
sizeof(LONG)),
"AC.pfirstnum");
2312 newpf = (WORD *)(newin+AC.sizepfirstnum);
2313 for ( j = 0; j < AC.numpfirstnum; j++ ) {
2314 newpf[j] = AC.pfirstnum[j];
2315 newin[j] = AC.inputnumbers[j];
2317 if ( AC.inputnumbers ) M_free(AC.inputnumbers,
"AC.pfirstnum");
2318 AC.inputnumbers = newin;
2319 AC.pfirstnum = newpf;
2321 AC.pfirstnum[AC.numpfirstnum] = numprevar;
2322 AC.inputnumbers[AC.numpfirstnum] = -1;
2329 MesPrint(
"&Illegally formed name in argument of redefine statement");
2332 MesPrint(
"&Illegally formed arguments in redefine statement");
2344 int CoRenumber(UBYTE *s)
2348 while ( *s ==
',' ) s++;
2350 if ( *s == 0 ) { x = 0; }
2351 else ParseNumber(x,s)
2352 if ( *s == 0 && x >= 0 && x <= 1 ) {
2353 Add3Com(TYPERENUMBER,x);
2356 MesPrint(
"&Illegal argument in Renumber statement: '%s'",inp);
2367 CBUF *C = cbuf+AC.cbufnum;
2368 UBYTE *ss = 0, c, *t;
2369 int error = 0, i = 0, type, x;
2370 WORD numindex,number;
2374 t++; s++;
while ( FG.cTable[*s] < 2 ) s++;
2376 if ( ( number = GetDollar(t) ) < 0 ) {
2377 MesPrint(
"&Undefined variable $%s",t);
2378 if ( !error ) error = 1;
2379 number = AddDollar(t,0,0,0);
2384 if ( ( s = SkipAName(s) ) == 0 )
return(1);
2386 if ( ( ( type = GetOName(AC.exprnames,t,&numindex,NOAUTO) ) != NAMENOTFOUND )
2387 || ( ( type = GetOName(AC.varnames,t,&numindex,WITHAUTO) ) != CINDEX ) ) {
2388 if ( type != NAMENOTFOUND ) error = NameConflict(type,t);
2390 MesPrint(
"&%s should have been declared as an index",t);
2392 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2396 Add3Com(TYPESUM,numindex);
2398 if ( *s == 0 )
break;
2400 MesPrint(
"&Illegal separator between objects in sum statement.");
2404 if ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'$' ) {
2405 while ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'$' ) {
2409 while ( FG.cTable[*s] < 2 ) s++;
2411 if ( ( number = GetDollar(t) ) < 0 ) {
2412 MesPrint(
"&Undefined variable $%s",t);
2413 if ( !error ) error = 1;
2414 number = AddDollar(t,0,0,0);
2420 if ( ( s = SkipAName(s) ) == 0 )
return(1);
2422 if ( ( ( type = GetOName(AC.exprnames,t,&numindex,NOAUTO) ) != NAMENOTFOUND )
2423 || ( ( type = GetOName(AC.varnames,t,&numindex,WITHAUTO) ) != CINDEX ) ) {
2424 if ( type != NAMENOTFOUND ) error = NameConflict(type,t);
2426 MesPrint(
"&%s should have been declared as an index",t);
2428 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2434 C->Pointer[-i+1] = i;
2436 if ( *s == 0 ) return(error);
2438 MesPrint(
"&Illegal separator between objects in sum statement.");
2443 if ( FG.cTable[*s] == 1 ) {
2447 else if ( FG.cTable[*s] == 1 ) {
2448 while ( FG.cTable[*s] == 1 ) {
2451 while( FG.cTable[*s] == 1 ) x = 10*x + *s++ -
'0';
2452 if ( *s && *s !=
',' ) {
2453 MesPrint(
"&%s is not a legal fixed index",t);
2456 else if ( x >= AM.OffsetIndex ) {
2457 MesPrint(
"&%d is too large to be a fixed index",x);
2463 C->Pointer[-i] = TYPESUMFIX;
2464 C->Pointer[-i+1] = i;
2466 if ( *s == 0 ) break;
2471 MesPrint(
"&Illegal object in sum statement");
2483 static WORD cttarray[7] = { TYPEOPERATION,7,TENVEC,0,0,1,0 };
2485 int CoToTensor(UBYTE *s)
2487 UBYTE *t, c, *args[2], cc[2];
2488 int j, type, error = 0, ex = 0;
2489 WORD number, dol[2];
2490 cttarray[3] = cttarray[4] = 0; cttarray[5] = 1;
2491 dol[0] = dol[1] = 0;
2492 for ( j = 0; j < 2; j++ ) {
2493 inloop: args[j] = s;
2494 if ( ( s = SkipAName(s) ) == 0 ) {
2495 proper: MesPrint(
"&Syntax error in ToTensor statement");
2501 if ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'_' || *s ==
'$' ) {
2502 if ( ( s = SkipAName(s) ) == 0 )
goto proper;
2504 else if ( *s ==
'{' ) {
2509 if ( *s == 0 ) break;
2510 if ( *s != ',' ) goto proper;
2515 if ( cc[j] == 0 )
break;
2516 if ( cc[j] !=
',' )
goto proper;
2520 if ( cc[1] ==
',' ) {
2521 if ( StrICmp(args[0],(UBYTE *)
"nosquare") == 0 ) cttarray[5] |= 2;
2522 else if ( StrICmp(args[0],(UBYTE *)
"functions") == 0 ) cttarray[5] |= 4;
2524 MesPrint(
"&Unrecognized option in ToTensor statement: '%s'",args[0]);
2527 args[0] = args[1]; args[1][-1] = cc[0]; cc[0] = cc[1];
2530 if ( cc[1] !=
'!' && cc[1] != 0 )
goto proper;
2531 for ( j = 0; j < 2; j++ ) {
2532 if ( args[j][0] ==
'$' ) {
2533 dol[j] = GetDollar(args[j]+1);
2534 if ( dol[j] < 0 ) dol[j] = AddDollar(args[j]+1,DOLUNDEFINED,0,0);
2536 else if ( ( type = GetName(AC.varnames,args[j],&number,WITHAUTO) ) == CVECTOR ) {
2537 cttarray[4] = number + AM.OffsetVector;
2538 if ( j == 0 ) ex = 1;
2540 else if ( type == CFUNCTION && ( functions[number].spec > 0 ) ) {
2541 cttarray[3] = number + FUNCTION;
2542 if ( j == 1 ) ex = 1;
2545 MesPrint(
"&%s is not a vector or a tensor",args[j]);
2549 if ( cttarray[3] == 0 || cttarray[4] == 0 ) {
2550 if ( dol[0] == 0 && dol[1] == 0 ) {
2551 MesPrint(
"&ToTensor statement needs a vector and a tensor");
2554 else if ( cttarray[3] ) {
2555 if ( dol[1] ) cttarray[4] = dol[1];
2556 else if ( dol[0] ) { cttarray[4] = dol[0]; ex = 1; }
2558 MesPrint(
"&ToTensor statement needs a vector and a tensor");
2562 else if ( cttarray[4] ) {
2563 if ( dol[1] ) { cttarray[3] = -dol[1]; ex = 1; }
2564 else if ( dol[0] ) cttarray[3] = -dol[0];
2566 MesPrint(
"&ToTensor statement needs a vector and a tensor");
2571 if ( dol[0] == 0 || dol[1] == 0 ) {
2572 MesPrint(
"&ToTensor statement needs a vector and a tensor");
2576 cttarray[3] = -dol[0]; cttarray[4] = dol[1];
2582 if ( cc[j] ==
'!' ) {
2583 s = args[1-j];
while ( *s ) s++; *s = cc[1-j];
2584 s = args[j];
while ( *s ) s++; *s++ = cc[j];
2586 if ( FG.cTable[*s] == 0 || *s ==
'[' || *s ==
'_' ) {
2588 if ( ( s = SkipAName(s) ) == 0 )
goto proper;
2590 if ( ( type = GetName(AC.varnames,t,&number,WITHAUTO) ) != CSET ) {
2591 MesPrint(
"&%s is not the name of a set",t);
2595 cttarray[6] = number;
2597 else if ( *s ==
'{' ) {
2598 s++; t = s; SKIPBRA2(s) *s = 0;
2599 cttarray[6] = DoTempSet(t,s);
2600 if ( cttarray[6] < 0 ) error = 1;
2602 if ( AC.wildflag ) {
2603 MesPrint(
"&Improper use of wildcard(s) in set specification");
2607 if ( *s != 0 )
goto proper;
2609 AddNtoL(7,cttarray);
2612 args[1][-1] = cc[0]; s[-1] = cc[1];
2614 AddNtoL(6,cttarray);
2624 static WORD ctvarray[6] = { TYPEOPERATION,6,TENVEC,0,0,0 };
2626 int CoToVector(UBYTE *s)
2629 int j, type, error = 0;
2630 WORD number, dol[2];
2631 dol[0] = dol[1] = 0;
2632 ctvarray[3] = ctvarray[4] = ctvarray[5] = 0;
2633 for ( j = 0; j < 2; j++ ) {
2635 if ( ( s = SkipAName(s) ) == 0 ) {
2636 proper: MesPrint(
"&Arguments of ToVector statement should be a vector and a tensor");
2641 dol[j] = GetDollar(t+1);
2642 if ( dol[j] < 0 ) dol[j] = AddDollar(t+1,DOLUNDEFINED,0,0);
2644 else if ( ( type = GetName(AC.varnames,t,&number,WITHAUTO) ) == CVECTOR )
2645 ctvarray[4] = number + AM.OffsetVector;
2646 else if ( type == CFUNCTION && ( functions[number].spec > 0 ) )
2647 ctvarray[3] = number+FUNCTION;
2649 MesPrint(
"&%s is not a vector or a tensor",t);
2652 *s = c;
if ( *s && *s !=
',' )
goto proper;
2655 if ( *s != 0 )
goto proper;
2656 if ( ctvarray[3] == 0 || ctvarray[4] == 0 ) {
2657 if ( dol[0] == 0 && dol[1] == 0 ) {
2658 MesPrint(
"&ToVector statement needs a vector and a tensor");
2661 else if ( ctvarray[3] ) {
2662 if ( dol[1] ) ctvarray[4] = dol[1];
2663 else if ( dol[0] ) ctvarray[4] = dol[0];
2665 MesPrint(
"&ToVector statement needs a vector and a tensor");
2669 else if ( ctvarray[4] ) {
2670 if ( dol[1] ) ctvarray[3] = -dol[1];
2671 else if ( dol[0] ) ctvarray[3] = -dol[0];
2673 MesPrint(
"&ToVector statement needs a vector and a tensor");
2678 if ( dol[0] == 0 || dol[1] == 0 ) {
2679 MesPrint(
"&ToVector statement needs a vector and a tensor");
2683 ctvarray[3] = -dol[0]; ctvarray[4] = dol[1];
2687 AddNtoL(6,ctvarray);
2696 int CoTrace4(UBYTE *s)
2698 int error = 0, type, option = CHISHOLM;
2700 WORD numindex, one = 1;
2704 if ( FG.cTable[*s] == 1 )
break;
2705 if ( ( s = SkipAName(s) ) == 0 ) {
2706 proper: MesPrint(
"&Proper syntax for Trace4 is 'Trace4[,options],index;'");
2709 if ( *s == 0 )
break;
2711 if ( ( key = FindKeyWord(t,trace4options,
2712 sizeof(trace4options)/
sizeof(
KEYWORD)) ) == 0 )
break;
2714 option |= key->type;
2715 option &= ~key->flags;
2717 if ( ( *s++ = c ) !=
',' ) {
2718 MesPrint(
"&Illegal separator in Trace4 statement");
2721 if ( *s == 0 )
goto proper;
2724 if ( FG.cTable[*s] == 1 ) {
2726 ParseNumber(numindex,s)
2728 MesPrint(
"&Last argument of Trace4 should be an index");
2731 if ( numindex >= AM.OffsetIndex ) {
2732 MesPrint(
"&fixed index >= %d. Change value of OffsetIndex in setup file" 2737 else if ( *s ==
'$' ) {
2738 if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
2739 numindex = -numindex;
2741 MesPrint(
"&%s is undefined",s);
2742 numindex = AddDollar(s+1,DOLINDEX,&one,1);
2745 tests: s = SkipAName(s);
2747 MesPrint(
"&Trace4 should have a single index or $variable for its argument");
2751 else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
2752 numindex += AM.OffsetIndex;
2755 else if ( type != -1 ) {
2756 if ( type != CDUBIOUS ) {
2757 if ( ( FG.cTable[*s] != 0 ) && ( *s !=
'[' ) ) {
2758 if ( *s ==
'+' && FG.cTable[s[1]] == 1 ) { s++;
goto retry; }
2761 NameConflict(type,s);
2762 type = MakeDubious(AC.varnames,s,&numindex);
2767 MesPrint(
"&%s is not an index",s);
2768 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2771 if ( error )
return(error);
2772 if ( ( option & CHISHOLM ) != 0 )
2773 Add4Com(TYPECHISHOLM,numindex,(option & ALSOREVERSE));
2774 Add5Com(TYPEOPERATION,TAKETRACE,4 + (option & NOTRICK),numindex);
2783 int CoTraceN(UBYTE *s)
2785 WORD numindex, one = 1;
2787 if ( FG.cTable[*s] == 1 ) {
2789 ParseNumber(numindex,s)
2791 proper: MesPrint(
"&TraceN should have a single index for its argument");
2794 if ( numindex >= AM.OffsetIndex ) {
2795 MesPrint(
"&fixed index >= %d. Change value of OffsetIndex in setup file" 2800 else if ( *s ==
'$' ) {
2801 if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
2802 numindex = -numindex;
2804 MesPrint(
"&%s is undefined",s);
2805 numindex = AddDollar(s+1,DOLINDEX,&one,1);
2808 tests: s = SkipAName(s);
2810 MesPrint(
"&TraceN should have a single index or $variable for its argument");
2814 else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
2815 numindex += AM.OffsetIndex;
2818 else if ( type != -1 ) {
2819 if ( type != CDUBIOUS ) {
2820 if ( ( FG.cTable[*s] != 0 ) && ( *s !=
'[' ) ) {
2821 if ( *s ==
'+' && FG.cTable[s[1]] == 1 ) { s++;
goto retry; }
2824 NameConflict(type,s);
2825 type = MakeDubious(AC.varnames,s,&numindex);
2830 MesPrint(
"&%s is not an index",s);
2831 numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2834 Add5Com(TYPEOPERATION,TAKETRACE,0,numindex);
2843 int CoChisholm(UBYTE *s)
2845 int error = 0, type, option = CHISHOLM;
2847 WORD numindex, one = 1;
2851 if ( FG.cTable[*s] == 1 )
break;
2852 if ( ( s = SkipAName(s) ) == 0 ) {
2853 proper: MesPrint(
"&Proper syntax for Chisholm is 'Chisholm[,options],index;'");
2856 if ( *s == 0 )
break;
2858 if ( ( key = FindKeyWord(t,chisoptions,
2859 sizeof(chisoptions)/
sizeof(
KEYWORD)) ) == 0 )
break;
2861 option |= key->type;
2862 option &= ~key->flags;
2864 if ( ( *s++ = c ) !=
',' ) {
2865 MesPrint(
"&Illegal separator in Chisholm statement");
2868 if ( *s == 0 )
goto proper;
2871 if ( FG.cTable[*s] == 1 ) {
2872 ParseNumber(numindex,s)
2874 MesPrint(
"&Last argument of Chisholm should be an index");
2877 if ( numindex >= AM.OffsetIndex ) {
2878 MesPrint(
"&fixed index >= %d. Change value of OffsetIndex in setup file" 2883 else if ( *s ==
'$' ) {
2884 if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
2885 numindex = -numindex;
2887 MesPrint(
"&%s is undefined",s);
2888 numindex = AddDollar(s+1,DOLINDEX,&one,1);
2891 tests: s = SkipAName(s);
2893 MesPrint(
"&Chisholm should have a single index or $variable for its argument");
2897 else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
2898 numindex += AM.OffsetIndex;
2901 else if ( type != -1 ) {
2902 if ( type != CDUBIOUS ) {
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 Add4Com(TYPECHISHOLM,numindex,(option & ALSOREVERSE));
2925 int DoChain(UBYTE *s,
int option)
2929 if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
2932 MesPrint(
"&%s is undefined",s);
2933 numfunc = AddDollar(s+1,DOLINDEX,&one,1);
2936 tests: s = SkipAName(s);
2938 MesPrint(
"&ChainIn/ChainOut should have a single function or $variable for its argument");
2942 else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
2943 numfunc += FUNCTION;
2946 else if ( type != -1 ) {
2947 if ( type != CDUBIOUS ) {
2948 NameConflict(type,s);
2949 type = MakeDubious(AC.varnames,s,&numfunc);
2954 MesPrint(
"&%s is not a function",s);
2955 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
2958 Add3Com(option,numfunc);
2969 int CoChainin(UBYTE *s)
2971 return(DoChain(s,TYPECHAININ));
2981 int CoChainout(UBYTE *s)
2983 return(DoChain(s,TYPECHAINOUT));
2991 int CoExit(UBYTE *s)
2994 WORD code = TYPEEXIT;
2995 while ( *s ==
',' ) s++;
2997 Add3Com(TYPEEXIT,0);
3002 while ( *s ) {
if ( *s ==
'\\' ) s++; s++; }
3003 if ( name[-1] !=
'"' || s[-1] !=
'"' ) {
3004 MesPrint(
"&Illegal syntax for exit statement");
3008 AddComString(1,&code,name,0);
3018 int CoInParallel(UBYTE *s)
3020 return(DoInParallel(s,1));
3028 int CoNotInParallel(UBYTE *s)
3030 return(DoInParallel(s,0));
3043 int DoInParallel(UBYTE *s,
int par)
3052 #ifndef WITHPTHREADS 3056 AC.inparallelflag = par;
3058 for ( i = NumExpressions-1; i >= 0; i-- ) {
3060 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
3061 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
3070 while ( *s ==
',' ) s++;
3071 if ( *s == 0 )
break;
3072 if ( *s ==
'[' || FG.cTable[*s] == 0 ) {
3074 if ( ( s = SkipAName(s) ) == 0 ) {
3075 MesPrint(
"&Improper name for an expression: '%s'",t);
3079 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
3081 e = Expressions+number;
3082 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
3083 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
3089 else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
3090 MesPrint(
"&%s is not an expression",t);
3096 MesPrint(
"&Illegal object in InExpression statement");
3098 while ( *s && *s !=
',' ) s++;
3099 if ( *s == 0 )
break;
3112 int CoInExpression(UBYTE *s)
3119 if ( AC.inexprlevel >= MAXNEST ) {
3120 MesPrint(
"@Nesting of inexpression statements more than %d levels",(WORD)MAXNEST);
3123 AC.inexprsumcheck[AC.inexprlevel] = NestingChecksum();
3124 AC.inexprstack[AC.inexprlevel] = cbuf[AC.cbufnum].Pointer
3125 - cbuf[AC.cbufnum].Buffer + 2;
3127 *w++ = TYPEINEXPRESSION;
3130 while ( *s ==
',' ) s++;
3131 if ( *s == 0 )
break;
3132 if ( *s ==
'[' || FG.cTable[*s] == 0 ) {
3134 if ( ( s = SkipAName(s) ) == 0 ) {
3135 MesPrint(
"&Improper name for an expression: '%s'",t);
3139 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
3142 else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
3143 MesPrint(
"&%s is not an expression",t);
3149 MesPrint(
"&Illegal object in InExpression statement");
3151 while ( *s && *s !=
',' ) s++;
3152 if ( *s == 0 )
break;
3155 AT.WorkPointer[1] = w - AT.WorkPointer;
3156 AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
3165 int CoEndInExpression(UBYTE *s)
3167 CBUF *C = cbuf+AC.cbufnum;
3168 while ( *s ==
',' ) s++;
3170 MesPrint(
"&Illegal syntax for EndInExpression statement");
3173 if ( AC.inexprlevel <= 0 ) {
3174 MesPrint(
"&EndInExpression without corresponding InExpression statement");
3178 cbuf[AC.cbufnum].Buffer[AC.inexprstack[AC.inexprlevel]] = C->numlhs;
3179 if ( AC.inexprsumcheck[AC.inexprlevel] != NestingChecksum() ) {
3191 int CoSetExitFlag(UBYTE *s)
3194 MesPrint(
"&Illegal syntax for the SetExitFlag statement");
3197 Add2Com(TYPESETEXIT);
3205 int CoTryReplace(UBYTE *p)
3209 WORD *w, error = 0, i, which = -1, c1, minvec = 0;
3226 if ( *p ==
'-' && minvec == 0 && which == (CVECTOR+1) ) {
3229 if ( *p ==
'[' || FG.cTable[*p] == 0 ) {
3231 if ( ( p = SkipAName(p) ) == 0 )
return(1);
3233 i = GetName(AC.varnames,name,&c1,WITHAUTO);
3234 if ( which >= 0 && i >= 0 && i != CDUBIOUS && which != (i+1) ) {
3235 MesPrint(
"&Illegal combination of objects in TryReplace");
3238 else if ( minvec && i != CVECTOR && i != CDUBIOUS ) {
3239 MesPrint(
"&Currently a - sign can be used only with a vector in TryReplace");
3243 case CSYMBOL: *w++ = -SYMBOL; *w++ = c1;
break;
3245 if ( minvec ) *w++ = -MINVECTOR;
3246 else *w++ = -VECTOR;
3247 *w++ = c1 + AM.OffsetVector;
3250 case CINDEX: *w++ = -INDEX; *w++ = c1 + AM.OffsetIndex;
3251 if ( c1 >= AM.WilInd && c ==
'?' ) { *p++ = c; c = *p; }
3253 case CFUNCTION: *w++ = -c1-FUNCTION;
break;
3254 case CDUBIOUS: minvec = 0; error = 1;
break;
3256 MesPrint(
"&Illegal object type in TryReplace: %s",name);
3261 if ( which < 0 ) which = i+1;
3264 if ( *p ==
',' ) p++;
3268 MesPrint(
"&Illegal object in TryReplace");
3270 while ( *p && *p !=
',' ) {
3271 if ( *p ==
'(' ) SKIPBRA3(p)
3272 else if ( *p == '{
' ) SKIPBRA2(p) 3273 else if ( *p == '[
' ) SKIPBRA1(p) 3277 if ( *p == ',
' ) p++; 3278 if ( which < 0 ) which = 0; 3282 MesPrint("&Odd number of arguments in TryReplace"); 3285 i = w - AT.WorkPointer; 3286 AT.WorkPointer[1] = i; 3287 AT.WorkPointer[2] = i - 3; 3288 AT.WorkPointer[4] = i - 3; 3289 AddNtoL((int)i,AT.WorkPointer); 3297 Old syntax: Modulus [-] number [:number] 3298 New syntax: Modulus [option(s)] number 3299 Options are: NoFunctions/CoefficientsOnly/AlsoFunctions 3302 PrintPowersOf(number) 3304 AlsoDollars/NoDollars 3305 Notice: We change the defaults. This may cause problems to some. 3308 int CoModulus(UBYTE *inp) 3311 /* #[ Old Syntax : */ 3313 WORD sign = 1, Retval; 3314 while ( *inp == '-
' || *inp == '+
' ) { 3315 if ( *inp == '-
' ) sign = -sign; 3319 if ( FG.cTable[*inp] != 1 ) { 3320 MesPrint("&Invalid value for modulus:%s",inp); 3321 if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers"); 3325 do { inp++; } while ( FG.cTable[*inp] == 1 ); 3327 Retval = GetLong(p,(UWORD *)AC.cmod,&AC.ncmod); 3328 if ( sign < 0 ) AC.ncmod = -AC.ncmod; 3330 if ( c == 0 ) goto regular; 3331 else if ( c != ':
' ) { 3332 MesPrint("&Illegal option for modulus %s",inp); 3333 if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers"); 3339 while ( FG.cTable[*inp] == 1 ) inp++; 3341 MesPrint("&Illegal character in option for modulus %s",inp); 3342 if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers"); 3346 if ( GetLong(p,(UWORD *)AC.powmod,&AC.npowmod) ) Retval = -1; 3347 if ( TakeModulus((UWORD *)AC.powmod,&AC.npowmod,AC.cmod,AC.ncmod,NOUNPACK) ) Retval = -1; 3348 if ( AC.npowmod == 0 ) { 3349 MesPrint("&Improper value for generator"); 3352 if ( MakeModTable() ) Retval = -1; 3355 AN.ncmod = AC.ncmod; 3357 M_free(AC.halfmod,"halfmod"); 3358 AC.halfmod = 0; AC.nhalfmod = 0; 3360 if ( AC.modinverses ) { 3361 M_free(AC.halfmod,"modinverses"); 3365 /* #] Old Syntax : */ 3368 int Retval = 0, sign = 1; 3370 while ( *inp == ',
' || *inp == ' ' || *inp == '\t
' ) inp++; 3373 if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers"); 3375 AN.ncmod = AC.ncmod = 0; 3376 if ( AC.halfmod ) M_free(AC.halfmod,"halfmod"); 3377 AC.halfmod = 0; AC.nhalfmod = 0; 3378 if ( AC.modinverses ) M_free(AC.modinverses,"modinverses"); 3384 if ( *inp == '-
' ) { 3389 while ( FG.cTable[*inp] == 0 ) { 3391 while ( FG.cTable[*inp] == 0 ) inp++; 3393 if ( StrICmp(p,(UBYTE *)"nofunctions") == 0 ) { 3394 AC.modmode &= ~ALSOFUNARGS; 3396 else if ( StrICmp(p,(UBYTE *)"alsofunctions") == 0 ) { 3397 AC.modmode |= ALSOFUNARGS; 3399 else if ( StrICmp(p,(UBYTE *)"coefficientsonly") == 0 ) { 3400 AC.modmode &= ~ALSOFUNARGS; 3401 AC.modmode &= ~ALSOPOWERS; 3404 else if ( StrICmp(p,(UBYTE *)"plusmin") == 0 ) { 3405 AC.modmode |= POSNEG; 3407 else if ( StrICmp(p,(UBYTE *)"positive") == 0 ) { 3408 AC.modmode &= ~POSNEG; 3410 else if ( StrICmp(p,(UBYTE *)"inversetable") == 0 ) { 3411 AC.modmode |= INVERSETABLE; 3413 else if ( StrICmp(p,(UBYTE *)"noinversetable") == 0 ) { 3414 AC.modmode &= ~INVERSETABLE; 3416 else if ( StrICmp(p,(UBYTE *)"nodollars") == 0 ) { 3417 AC.modmode &= ~ALSODOLLARS; 3419 else if ( StrICmp(p,(UBYTE *)"alsodollars") == 0 ) { 3420 AC.modmode |= ALSODOLLARS; 3422 else if ( StrICmp(p,(UBYTE *)"printpowersof") == 0 ) { 3424 if ( *inp != '(
' ) { 3426 MesPrint("&Bad syntax in argument of PrintPowersOf(number) in Modulus statement"); 3429 while ( *inp == ',
' || *inp == ' ' || *inp == '\t
' ) inp++; 3431 if ( FG.cTable[*inp] != 1 ) goto badsyntax; 3432 do { inp++; } while ( FG.cTable[*inp] == 1 ); 3434 if ( GetLong(p,(UWORD *)AC.powmod,&AC.npowmod) ) Retval = -1; 3435 if ( TakeModulus((UWORD *)AC.powmod,&AC.npowmod,AC.cmod,AC.ncmod,NOUNPACK) ) Retval = -1; 3436 if ( AC.npowmod == 0 ) { 3437 MesPrint("&Improper value for generator"); 3440 if ( MakeModTable() ) Retval = -1; 3443 while ( *inp == ',
' || *inp == ' ' || *inp == '\t
' ) inp++; 3444 if ( *inp != ')
' ) goto badsyntax; 3448 else if ( StrICmp(p,(UBYTE *)"alsopowers") == 0 ) { 3449 AC.modmode |= ALSOPOWERS; 3452 else if ( StrICmp(p,(UBYTE *)"nopowers") == 0 ) { 3453 AC.modmode &= ~ALSOPOWERS; 3457 MesPrint("&Unrecognized option %s in Modulus statement",inp); 3461 while ( *inp == ',
' || *inp == ' ' || *inp == '\t
' ) inp++; 3463 MesPrint("&Modulus statement with no value!!!"); 3469 if ( FG.cTable[*inp] != 1 ) { 3470 MesPrint("&Invalid value for modulus:%s",inp); 3471 if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers"); 3473 AN.ncmod = AC.ncmod = 0; 3474 if ( AC.halfmod ) M_free(AC.halfmod,"halfmod"); 3475 AC.halfmod = 0; AC.nhalfmod = 0; 3476 if ( AC.modinverses ) M_free(AC.modinverses,"modinverses"); 3480 do { inp++; } while ( FG.cTable[*inp] == 1 ); 3482 Retval = GetLong(p,(UWORD *)AC.cmod,&AC.ncmod); 3483 if ( Retval == 0 && AC.ncmod == 0 ) goto SwitchOff; 3484 if ( sign < 0 ) AC.ncmod = -AC.ncmod; 3485 AN.ncmod = AC.ncmod; 3486 if ( ( AC.modmode & INVERSETABLE ) != 0 ) MakeInverses(); 3487 if ( AC.halfmod ) M_free(AC.halfmod,"halfmod"); 3488 AC.halfmod = 0; AC.nhalfmod = 0; 3498 int CoRepeat(UBYTE *inp) 3501 AC.RepSumCheck[AC.RepLevel] = NestingChecksum(); 3503 if ( AC.RepLevel > AM.RepMax ) { 3504 MesPrint("&Too many repeat levels. Maximum is %d",AM.RepMax); 3507 Add3Com(TYPEREPEAT,-1) /* Means indefinite */ 3508 while ( *inp == ' ' || *inp == ',
' || *inp == '\t
' ) inp++; 3510 error = CompileStatement(inp); 3511 if ( CoEndRepeat(inp) ) error = 1; 3521 int CoEndRepeat(UBYTE *inp) 3523 CBUF *C = cbuf+AC.cbufnum; 3524 int level, error = 0, repeatlevel = 0; 3527 if ( AC.RepLevel < 0 ) { 3528 MesPrint("&EndRepeat without Repeat"); 3532 else if ( AC.RepSumCheck[AC.RepLevel] != NestingChecksum() ) { 3536 level = C->numlhs+1; 3537 while ( level > 0 ) { 3538 if ( C->lhs[--level][0] == TYPEREPEAT ) { 3539 if ( repeatlevel == 0 ) { 3540 Add3Com(TYPEENDREPEAT,level) 3545 else if ( C->lhs[level][0] == TYPEENDREPEAT ) repeatlevel++; 3554 Reads in the bracket information. 3555 Storage is in the form of a regular term. 3556 No subterms and arguments are allowed. 3559 int DoBrackets(UBYTE *inp, int par) 3563 WORD *to, i, type, *w, error = 0; 3564 WORD c1,c2, *WorkSave; 3567 WorkSave = to = AT.WorkPointer; 3569 if ( AT.BrackBuf == 0 ) { 3570 AR.MaxBracket = 100; 3571 AT.BrackBuf = (WORD *)Malloc1(sizeof(WORD)*(AR.MaxBracket+1),"bracket buffer"); 3575 AC.bracketindexflag = 0; 3576 AT.bracketindexflag = 0; 3577 if ( *p == '+
' || *p == '-
' ) p++; 3578 if ( p[-1] == ',
' && *p ) p--; 3579 if ( p[-1] == '+
' && *p ) { biflag = 1; if ( *p != ',
' ) { *--p = ',
'; } } 3580 else if ( p[-1] == '-
' && *p ) { biflag = -1; if ( *p != ',
' ) { *--p = ',
'; } } 3582 while ( *p == ',
' ) { 3583 redo: AR.BracketOn++; 3584 while ( *p == ',
' ) p++; 3585 if ( *p == 0 ) break; 3587 p++; while ( *p == '0
' ) p++; 3592 if ( p == 0 ) return(1); 3595 type = GetName(AC.varnames,inp,&c1,WITHAUTO); 3597 if ( type == CVECTOR || type == CDUBIOUS ) { 3601 if ( p == 0 ) return(1); 3604 type = GetName(AC.varnames,inp,&c2,WITHAUTO); 3605 if ( type != CVECTOR && type != CDUBIOUS ) { 3606 MesPrint("&Not a vector in dotproduct in bracket statement: %s",inp); 3609 else type = CDOTPRODUCT; 3612 MesPrint("&Illegal use of . after %s in bracket statement",inp); 3620 *to++ = SYMBOL; *to++ = 4; *to++ = c1; *to++ = 1; break; 3622 *to++ = INDEX; *to++ = 3; *to++ = AM.OffsetVector + c1; break; 3624 *to++ = c1+FUNCTION; *to++ = FUNHEAD; *to++ = 0; 3628 *to++ = DOTPRODUCT; *to++ = 5; *to++ = c1 + AM.OffsetVector; 3629 *to++ = c2 + AM.OffsetVector; *to++ = 1; break; 3631 *to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX; break; 3633 MesPrint("&Illegal bracket request for %s",pp); 3638 if ( *p ) MesCerr("separator",p); 3639 *to++ = 1; *to++ = 1; *to++ = 3; 3640 *AT.WorkPointer = to - AT.WorkPointer; 3641 AT.WorkPointer = to; 3642 AC.BracketNormalize = 1; 3643 if ( Normalize(BHEAD WorkSave) ) { error = 1; AR.BracketOn = 0; } 3646 if ( *w == 4 || !*w ) { AR.BracketOn = 0; } 3649 if ( i < 0 ) i = -i; 3652 if ( i > AR.MaxBracket ) { 3654 newbuf = (WORD *)Malloc1(sizeof(WORD)*(i+1),"bracket buffer"); 3656 if ( AT.BrackBuf != 0 ) M_free(AT.BrackBuf,"bracket buffer"); 3657 AT.BrackBuf = newbuf; 3663 AC.BracketNormalize = 0; 3664 if ( par == 1 ) AR.BracketOn = -AR.BracketOn; 3666 AC.bracketindexflag = biflag; 3667 AT.bracketindexflag = biflag; 3669 AT.WorkPointer = WorkSave; 3678 int CoBracket(UBYTE *inp) 3679 { return(DoBrackets(inp,0)); } 3686 int CoAntiBracket(UBYTE *inp) 3687 { return(DoBrackets(inp,1)); } 3694 MultiBracket:{A|B} bracketinfo:...:{A|B} bracketinfo; 3697 int CoMultiBracket(UBYTE *inp) 3700 int i, error = 0, error1, type, num; 3704 if ( *inp != ':
' ) { 3705 MesPrint("&Illegal Multiple Bracket separator: %s",inp); 3709 if ( AC.MultiBracketBuf == 0 ) { 3710 AC.MultiBracketBuf = (WORD **)Malloc1(sizeof(WORD *)*MAXMULTIBRACKETLEVELS,"multi bracket buffer"); 3711 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) { 3712 AC.MultiBracketBuf[i] = 0; 3716 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) { 3717 if ( AC.MultiBracketBuf[i] ) { 3718 M_free(AC.MultiBracketBuf[i],"bracket buffer i"); 3719 AC.MultiBracketBuf[i] = 0; 3722 AC.MultiBracketLevels = 0; 3724 AC.MultiBracketLevels = 0; 3726 Start with disabling the regular brackets. 3728 if ( AT.BrackBuf == 0 ) { 3729 AR.MaxBracket = 100; 3730 AT.BrackBuf = (WORD *)Malloc1(sizeof(WORD)*(AR.MaxBracket+1),"bracket buffer"); 3734 AC.bracketindexflag = 0; 3735 AT.bracketindexflag = 0; 3737 Now loop through the various levels, separated by the colons. 3739 for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) { 3740 if ( *inp == 0 ) goto RegEnd; 3742 1: skip to ':
', determine bracket or antibracket 3745 while ( *s && *s != ':
' ) { 3746 if ( *s == '[
' ) { SKIPBRA1(s) s++; } 3747 else if ( *s == '{
' ) { SKIPBRA2(s) s++; } 3751 if ( StrICont(inp,(UBYTE *)"antibrackets") == 0 ) { type = 1; } 3752 else if ( StrICont(inp,(UBYTE *)"brackets") == 0 ) { type = 0; } 3754 MesPrint("&Illegal (anti)bracket specification in MultiBracket statement"); 3755 if ( error == 0 ) error = 1; 3758 while ( FG.cTable[*inp] == 0 ) inp++; 3759 if ( *inp != ',
' ) { 3760 MesPrint("&Illegal separator after (anti)bracket specification in MultiBracket statement"); 3761 if ( error == 0 ) error = 1; 3768 error1 = DoBrackets(inp, type); 3769 if ( error < 0 ) return(error1); 3770 if ( error1 > error ) error = error1; 3772 3: copy bracket information to the multi bracket arrays 3774 if ( AR.BracketOn ) { 3775 num = AT.BrackBuf[0]; 3776 to = AC.MultiBracketBuf[i] = (WORD *)Malloc1((num+2)*sizeof(WORD),"bracket buffer i"); 3778 *to++ = AR.BracketOn; 3783 4: set ready for the next level 3786 *s = c; if ( c == ':
' ) s++; 3792 MesPrint("&More than %d levels in MultiBracket statement",(WORD)MAXMULTIBRACKETLEVELS); 3793 if ( error == 0 ) error = 1; 3796 AC.MultiBracketLevels = i; 3799 AC.bracketindexflag = 0; 3800 AT.bracketindexflag = 0; 3808 This routine reads the count statement. The syntax is: 3809 count minimum,object,size[,object,size] 3815 Vectors can have the auxiliary flags: 3818 Output for the compiler: 3819 TYPECOUNT,size,minimum,objects 3821 SYMBOL,4,number,size 3822 DOTPRODUCT,5,v1,v2,size 3823 FUNCTION,4,number,size 3824 VECTOR,5,number,bits,size or VECTOR,6,number,bits,setnumber,size 3826 Currently only used in the if statement 3829 WORD *CountComp(UBYTE *inp, WORD *to) 3833 WORD *w, mini = 0, type, c1, c2; 3841 while ( *p == ',
' ) { 3843 if ( *p == '[
' || FG.cTable[*p] == 0 ) { 3844 if ( ( p = SkipAName(inp) ) == 0 ) return(0); 3846 type = GetName(AC.varnames,inp,&c1,WITHAUTO); 3848 if ( type == CVECTOR || type == CDUBIOUS ) { 3852 if ( p == 0 ) return(0); 3855 type = GetName(AC.varnames,inp,&c2,WITHAUTO); 3856 if ( type != CVECTOR && type != CDUBIOUS ) { 3857 MesPrint("&Not a vector in dotproduct in bracket statement: %s",inp); 3860 else type = CDOTPRODUCT; 3863 MesPrint("&Illegal use of . after %s in bracket statement",inp); 3864 if ( type == NAMENOTFOUND ) 3865 MesPrint("&%s is not a properly declared variable",inp); 3868 while ( *p && *p != ')
' && *p != ',
' ) p++; 3869 if ( *p == ',
' && FG.cTable[p[1]] == 1 ) { 3871 while ( *p && *p != ')
' && *p != ',
' ) p++; 3879 *w++ = SYMBOL; *w++ = 4; *w++ = c1; 3880 Sgetnum: if ( *p != ',
' ) { 3881 MesCerr("sequence",p); 3882 while ( *p && *p != ')
' && *p != ',
' ) p++; 3886 ParseSignedNumber(mini,p) 3887 if ( FG.cTable[p[-1]] != 1 || ( *p && *p != ')
' && *p != ',
' ) ) { 3888 while ( *p && *p != ')
' && *p != ',
' ) p++; 3891 MesPrint("&Improper value in count: %s",inp); 3893 while ( *p && *p != ')
' && *p != ',
' ) p++; 3898 *w++ = FUNCTION; *w++ = 4; *w++ = c1+FUNCTION; goto Sgetnum; 3900 *w++ = DOTPRODUCT; *w++ = 5; 3901 *w++ = c2 + AM.OffsetVector; 3902 *w++ = c1 + AM.OffsetVector; 3905 *w++ = VECTOR; *w++ = 5; 3906 *w++ = c1 + AM.OffsetVector; 3908 *w++ = VECTBIT | DOTPBIT | FUNBIT; 3911 else if ( *p == '+
' ) { 3914 while ( *p && *p != ',
' ) { 3915 if ( *p == 'v
' || *p == 'V
' ) { 3918 else if ( *p == 'd
' || *p == 'D
' ) { 3921 else if ( *p == 'f
' || *p == 'F
' 3922 || *p == 't
' || *p == 'T
' ) { 3925 else if ( *p == '?
' ) { 3927 if ( *p == '{
' ) { /* } */ 3929 if ( p == 0 ) return(0); 3930 if ( ( c1 = DoTempSet(inp+1,p) ) < 0 ) return(0); 3931 if ( Sets[c1].type != CFUNCTION ) { 3932 MesPrint("&set type conflict: Function expected"); 3940 if ( p == 0 ) return(0); 3942 type = GetName(AC.varnames,inp,&c1,WITHAUTO); 3944 if ( type != CSET && type != CDUBIOUS ) { 3945 MesPrint("&%s is not a set",inp); 3955 MesCerr("specifier for vector",p); 3963 MesCerr("specifier for vector",p); 3964 while ( *p && *p != ')
' && *p != ',
' ) p++; 3966 *w++ = VECTBIT | DOTPBIT | FUNBIT; 3973 MesPrint("&%s is not a symbol, function, vector or dotproduct",inp); 3975 skipfield: while ( *p && *p != ')
' && *p != ',
' ) p++; 3976 if ( *p && FG.cTable[p[1]] == 1 ) { 3978 while ( *p && *p != ')
' && *p != ',
' ) p++; 3985 while ( *p && *p != ',
' ) p++; 3990 if ( *p == ')
' ) p++; 3991 if ( *p ) { MesCerr("end of statement",p); return(0); } 3992 if ( error ) return(0); 4000 Reads the if statement: There must be a pair of parentheses. 4001 Much work is delegated to the routines in compi2 and CountComp. 4002 The goto is kept hanging as it is forward. 4003 The address in which the label must be written is pushed on 4006 Here we allow statements of the type 4007 if ( condition ) single statement; 4008 compile the if statement. 4009 test character at end 4011 copy the statement after the proper parenthesis to the 4012 beginning of the AC.iBuffer. 4014 generate an endif statement. 4017 static UWORD *CIscratC = 0; 4019 int CoIf(UBYTE *inp) 4022 int error = 0, level; 4023 WORD *w, *ww, *u, *s, *OldWork, *OldSpace = AT.WorkSpace; 4024 WORD gotexp = 0; /* Indicates whether there can be a condition */ 4025 WORD lenpp, lenlev, ncoef, i, number; 4026 UBYTE *p, *pp, *ppp, c; 4027 CBUF *C = cbuf+AC.cbufnum; 4029 if ( *inp == '(
' && inp[1] == ',
' ) inp += 2; 4030 else if ( *inp == '(
' ) inp++; /* Usually we enter at the bracket */ 4032 if ( CIscratC == 0 ) 4033 CIscratC = (UWORD *)Malloc1((AM.MaxTal+2)*sizeof(UWORD),"CoIf"); 4036 if ( AC.IfLevel >= AC.MaxIf ) DoubleIfBuffers(); 4037 AC.IfCount[lenpp++] = 0; 4039 IfStack is used for organizing the 'go to
' for the various if levels 4041 *AC.IfStack++ = C->Pointer-C->Buffer+2; 4043 IfSumCheck is used to test for illegal nesting of if, argument or repeat. 4045 AC.IfSumCheck[AC.IfLevel] = NestingChecksum(); 4047 w = OldWork = AT.WorkPointer; 4055 if ( FG.cTable[*p] == 1 ) { /* Number */ 4056 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; } 4060 if ( GetLong(p,(UWORD *)w,&ncoef) ) { ncoef = 1; error = 1; } 4062 while ( FG.cTable[*++p] == 1 ); 4065 if ( FG.cTable[*p] != 1 ) { 4066 MesCerr("sequence",p); error = 1; goto OnlyNum; 4068 if ( GetLong(p,CIscratC,&ncoef) ) { 4069 ncoef = 1; error = 1; 4071 while ( FG.cTable[*++p] == 1 ); 4073 MesPrint("&Division by zero!"); 4078 if ( Simplify(BHEAD (UWORD *)w,(WORD *)(w-1), 4079 CIscratC,&ncoef) ) error = 1; 4086 s = (WORD *)CIscratC; 4088 while ( --i >= 0 ) *w++ = 0; 4093 while ( --i >= 0 ) *w++ = 0; 4094 s = (WORD *)CIscratC; 4106 while ( --ncoef >= 0 ) *w++ = 0; 4109 u[1] = WORDDIF(w,u); 4110 u[2] = (u[1] - 3)>>1; 4111 if ( level ) u[2] = -u[2]; 4114 else if ( *p == '+
' ) { p++; goto ReDo; } 4115 else if ( *p == '-
' ) { level ^= 1; p++; goto ReDo; } 4116 else if ( *p == 'c
' || *p == 'C
' ) { /* Count or Coefficient */ 4117 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; } 4118 while ( FG.cTable[*++p] == 0 ); 4120 if ( !StrICmp(inp,(UBYTE *)"count") ) { 4123 MesPrint("&no ( after count"); 4129 c = *++p; *p = 0; *inp = ',
'; 4130 w = CountComp(inp,w); 4132 if ( w == 0 ) { error = 1; goto endofif; } 4135 else if ( ConWord(inp,(UBYTE *)"coefficient") && ( p - inp ) > 3 ) { 4144 else if ( *p == 'm
' || *p == 'M
' ) { /* match */ 4145 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; } 4146 while ( !FG.cTable[*++p] ); 4148 if ( !StrICmp(inp,(UBYTE *)"match") ) { 4151 MesPrint("&no ( after match"); 4159 Now we can call the reading of the lhs of an id statement. 4160 This has to be modified in the future. 4162 AT.WorkSpace = AT.WorkPointer = w; 4164 while ( FG.cTable[*ppp] == 0 && ppp < p ) ppp++; 4165 if ( *ppp == ',
' ) AC.idoption = 0; 4166 else AC.idoption = SUBMULTI; 4167 level = CoIdExpression(inp,TYPEIF); 4168 AT.WorkSpace = OldSpace; 4169 AT.WorkPointer = OldWork; 4171 if ( level < 0 ) { error = -1; goto endofif; } 4175 If we pop numlhs we are in good shape 4177 s = u = C->lhs[C->numlhs]; 4178 while ( u < C->Pointer ) *w++ = *u++; 4179 C->numlhs--; C->Pointer = s; 4184 else if ( !StrICmp(inp,(UBYTE *)"multipleof") ) { 4185 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; } 4188 MesPrint("&no ( after multipleof"); 4189 error = 1; goto endofif; 4192 if ( FG.cTable[*p] != 1 ) { 4193 Nomulof: MesPrint("&multipleof needs a short positive integer argument"); 4194 error = 1; goto endofif; 4197 if ( *p != ')
' || x <= 0 || x > MAXPOSITIVE ) goto Nomulof; 4199 *w++ = MULTIPLEOF; *w++ = 3; *w++ = (WORD)x; 4204 NoGood: MesPrint("&Unrecognized word: %s",inp); 4208 if ( c == '(
' ) SKIPBRA4(p) 4213 else if ( *p == 'f
' || *p == 'F
' ) { /* FindLoop */ 4214 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; } 4215 while ( FG.cTable[*++p] == 0 ); 4217 if ( !StrICmp(inp,(UBYTE *)"findloop") ) { 4220 MesPrint("&no ( after findloop"); 4226 c = *++p; *p = 0; *inp = ',
'; 4227 if ( CoFindLoop(inp) ) goto endofif; 4228 s = u = C->lhs[C->numlhs]; 4229 while ( u < C->Pointer ) *w++ = *u++; 4230 C->numlhs--; C->Pointer = s; 4232 if ( w == 0 ) { error = 1; goto endofif; } 4238 else if ( *p == 'e
' || *p == 'E
' ) { /* Expression */ 4239 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; } 4240 while ( FG.cTable[*++p] == 0 ); 4242 if ( !StrICmp(inp,(UBYTE *)"expression") ) { 4245 MesPrint("&no ( after expression"); 4249 p++; ww = w; *w++ = IFEXPRESSION; w++; 4250 while ( *p != ')
' ) { 4251 if ( *p == ',
' ) { p++; continue; } 4252 if ( *p == '[
' || FG.cTable[*p] == 0 ) { 4254 if ( ( p = SkipAName(p) ) == 0 ) { 4255 MesPrint("&Improper name for an expression: '%s
'",pp); 4260 if ( GetName(AC.exprnames,pp,&number,NOAUTO) == CEXPRESSION ) { 4263 else if ( GetName(AC.varnames,pp,&number,NOAUTO) != NAMENOTFOUND ) { 4264 MesPrint("&%s is not an expression",pp); 4271 MesPrint("&Illegal object in Expression in if-statement"); 4273 while ( *p && *p != ',
' && *p != ')
' ) p++; 4274 if ( *p == 0 || *p == ')
' ) break; 4284 else if ( *p == 'i
' || *p == 'I
' ) { /* IsFactorized */ 4285 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; } 4286 while ( FG.cTable[*++p] == 0 ); 4288 if ( !StrICmp(inp,(UBYTE *)"isfactorized") ) { 4290 if ( c != '(
' ) { /* No expression means current expression */ 4291 ww = w; *w++ = IFISFACTORIZED; w++; 4294 p++; ww = w; *w++ = IFISFACTORIZED; w++; 4295 while ( *p != ')
' ) { 4296 if ( *p == ',
' ) { p++; continue; } 4297 if ( *p == '[
' || FG.cTable[*p] == 0 ) { 4299 if ( ( p = SkipAName(p) ) == 0 ) { 4300 MesPrint("&Improper name for an expression: '%s
'",pp); 4305 if ( GetName(AC.exprnames,pp,&number,NOAUTO) == CEXPRESSION ) { 4308 else if ( GetName(AC.varnames,pp,&number,NOAUTO) != NAMENOTFOUND ) { 4309 MesPrint("&%s is not an expression",pp); 4316 MesPrint("&Illegal object in IsFactorized in if-statement"); 4318 while ( *p && *p != ',
' && *p != ')
' ) p++; 4319 if ( *p == 0 || *p == ')
' ) break; 4330 else if ( *p == '$
' ) { 4331 if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; } 4333 while ( FG.cTable[*p] == 0 || FG.cTable[*p] == 1 ) p++; 4335 if ( ( i = GetDollar(inp) ) < 0 ) { 4336 MesPrint("&undefined dollar expression %s",inp); 4338 i = AddDollar(inp,DOLUNDEFINED,0,0); 4341 *w++ = IFDOLLAR; *w++ = 3; *w++ = i; 4343 And then the IFDOLLAREXTRA pieces for [1] [$y] etc 4347 if ( ( w = GetIfDollarFactor(&p,w) ) == 0 ) { 4351 else if ( *p != ']
' ) { 4360 else if ( *p == '(
' ) { 4362 MesCerr("parenthesis",p); 4367 if ( ++lenlev >= AC.MaxIf ) DoubleIfBuffers(); 4368 AC.IfCount[lenpp++] = w-OldWork; 4373 else if ( *p == ')
' ) { 4374 if ( gotexp == 0 ) { MesCerr("position for )",p); error = 1; } 4376 u = AC.IfCount[--lenpp]+OldWork; 4379 if ( lenlev <= 0 ) { /* End if condition */ 4380 AT.WorkSpace = OldSpace; 4381 AT.WorkPointer = OldWork; 4382 AddNtoL(OldWork[1],OldWork); 4385 MesPrint("&unmatched parenthesis in if/while ()"); 4387 while ( *++p == ')
' ); 4390 level = CompileStatement(p); 4391 if ( level ) error = level; 4393 if ( CoEndIf(p) && error == 0 ) error = 1; 4399 else if ( *p == '>
' ) { 4400 if ( gotexp == 0 ) goto NoExp; 4401 if ( p[1] == '=
' ) { *w++ = GREATEREQUAL; *w++ = 2; p += 2; } 4402 else { *w++ = GREATER; *w++ = 2; p++; } 4405 else if ( *p == '<
' ) { 4406 if ( gotexp == 0 ) goto NoExp; 4407 if ( p[1] == '=
' ) { *w++ = LESSEQUAL; *w++ = 2; p += 2; } 4408 else { *w++ = LESS; *w++ = 2; p++; } 4411 else if ( *p == '=
' ) { 4412 if ( gotexp == 0 ) goto NoExp; 4413 if ( p[1] == '=
' ) p++; 4414 *w++ = EQUAL; *w++ = 2; p++; 4417 else if ( *p == '!
' && p[1] == '=
' ) { 4418 if ( gotexp == 0 ) { p++; goto NoExp; } 4419 *w++ = NOTEQUAL; *w++ = 2; p += 2; 4422 else if ( *p == '|
' && p[1] == '|
' ) { 4423 if ( gotexp == 0 ) { p++; goto NoExp; } 4424 *w++ = ORCOND; *w++ = 2; p += 2; 4427 else if ( *p == '&
' && p[1] == '&
' ) { 4428 if ( gotexp == 0 ) { 4431 MesCerr("sequence",p); 4435 *w++ = ANDCOND; *w++ = 2; p += 2; 4439 else if ( *p == 0 ) { 4440 MesPrint("&Unmatched parentheses"); 4445 if ( FG.cTable[*p] == 0 ) { 4448 while ( ( ij = FG.cTable[*++p] ) == 0 || ij == 1 ); 4452 MesCerr("sequence",p); 4466 int CoElse(UBYTE *p) 4469 CBUF *C = cbuf+AC.cbufnum; 4471 while ( *p == ',
' ) p++; 4472 if ( tolower(*p) == 'i
' && tolower(p[1]) == 'f
' && p[2] == '(
' ) 4473 return(CoElseIf(p+2)); 4474 MesPrint("&No extra text allowed as part of an else statement"); 4477 if ( AC.IfLevel <= 0 ) { MesPrint("&else statement without if"); return(1); } 4478 if ( AC.IfSumCheck[AC.IfLevel-1] != NestingChecksum() - 1 ) { 4482 Add3Com(TYPEELSE,AC.IfLevel) 4483 C->Buffer[AC.IfStack[-1]] = C->numlhs; 4484 AC.IfStack[-1] = C->Pointer - C->Buffer - 1; 4493 int CoElseIf(UBYTE *inp) 4495 CBUF *C = cbuf+AC.cbufnum; 4496 if ( AC.IfLevel <= 0 ) { MesPrint("&elseif statement without if"); return(1); } 4497 Add3Com(TYPEELSE,-AC.IfLevel) 4499 C->Buffer[*--AC.IfStack] = C->numlhs; 4507 It puts a RHS-level at the position indicated in the AC.IfStack. 4508 This corresponds to the label belonging to a forward goto. 4509 It is the goto that belongs either to the failing condition 4510 of the if (no else statement), or the completion of the 4511 success path (with else statement) 4512 The code is a jump to the next statement. It is there to prevent 4520 int CoEndIf(UBYTE *inp) 4522 CBUF *C = cbuf+AC.cbufnum; 4523 WORD i = C->numlhs, to, k = -AC.IfLevel; 4525 while ( *inp == ',
' ) inp++; 4528 MesPrint("&No extra text allowed as part of an endif/elseif statement"); 4530 if ( AC.IfLevel <= 0 ) { 4531 MesPrint("&Endif statement without corresponding if"); return(1); 4534 C->Buffer[*--AC.IfStack] = i+1; 4535 if ( AC.IfSumCheck[AC.IfLevel] != NestingChecksum() ) { 4539 Add3Com(TYPEENDIF,i+1) 4541 Now the search for the TYPEELSE in front of the elseif statements 4545 if ( C->lhs[i][0] == TYPEELSE && C->lhs[i][2] == to ) to = i; 4546 if ( C->lhs[i][0] == TYPEIF ) { 4547 if ( C->lhs[i][2] == to ) { 4549 if ( i <= 0 || C->lhs[i][0] != TYPEELSE 4550 || C->lhs[i][2] != k ) break; 4551 C->lhs[i][2] = C->numlhs; 4565 int CoWhile(UBYTE *inp) 4567 CBUF *C = cbuf+AC.cbufnum; 4568 WORD startnum = C->numlhs + 1; 4572 if ( C->numlhs > startnum && C->lhs[startnum][2] == C->numlhs 4573 && C->lhs[C->numlhs][0] == TYPEENDIF ) { 4574 C->lhs[C->numlhs][2] = startnum-1; 4577 else C->lhs[startnum][2] = startnum; 4586 int CoEndWhile(UBYTE *inp) 4590 CBUF *C = cbuf+AC.cbufnum; 4591 if ( AC.WhileLevel <= 0 ) { 4592 MesPrint("&EndWhile statement without corresponding While"); return(1); 4595 i = C->Buffer[AC.IfStack[-1]]; 4596 error = CoEndIf(inp); 4597 C->lhs[C->numlhs][2] = i - 1; 4605 Function,arguments=number,loopsize=number,outfun=function,include=index; 4608 static char *messfind[] = { 4609 "Findloop(function,arguments=#,loopsize(=#|<#)[,include=index])" 4610 ,"Replaceloop,function,arguments=#,loopsize(=#|<#),outfun=function[,include=index]" 4612 static WORD comfindloop[7] = { TYPEFINDLOOP,7,0,0,0,0,0 }; 4614 int DoFindLoop(UBYTE *inp, int mode) 4617 WORD funnum, nargs = 0, nloop = 0, indexnum = 0, outfun = 0; 4618 int type, aflag, lflag, indflag, outflag, error = 0, sym; 4619 while ( *inp == ',
' ) inp++; 4620 if ( ( s = SkipAName(inp) ) == 0 ) { 4621 syntax: MesPrint("&Proper syntax is:"); 4622 MesPrint("%s",messfind[mode]); 4626 if ( ( ( type = GetName(AC.varnames,inp,&funnum,WITHAUTO) ) == NAMENOTFOUND ) 4627 || type != CFUNCTION || ( ( sym = (functions[funnum].symmetric) & ~REVERSEORDER ) 4628 != SYMMETRIC && sym != ANTISYMMETRIC ) ) { 4629 MesPrint("&%s should be a (anti)symmetric function or tensor",inp); 4633 aflag = lflag = indflag = outflag = 0; 4634 while ( *inp == ',
' ) { 4635 while ( *inp == ',
' ) inp++; 4637 if ( ( s = SkipAName(inp) ) == 0 ) goto syntax; 4639 if ( StrICont(inp,(UBYTE *)"arguments") == 0 ) { 4640 if ( c != '=
' ) goto syntax; 4642 NeedNumber(nargs,s,syntax) 4646 else if ( StrICont(inp,(UBYTE *)"loopsize") == 0 ) { 4647 if ( c != '=
' && c != '<
' ) goto syntax; 4649 if ( FG.cTable[*s] == 1 ) { 4650 NeedNumber(nloop,s,syntax) 4652 MesPrint("&loopsize should be at least 2"); 4655 if ( c == '<
' ) nloop = -nloop; 4657 else if ( tolower(*s) == 'a
' && tolower(s[1]) == 'l
' 4658 && tolower(s[2]) == 'l
' && FG.cTable[s[3]] > 1 ) { 4660 if ( c != '=
' ) goto syntax; 4665 else if ( StrICont(inp,(UBYTE *)"include") == 0 ) { 4666 if ( c != '=
' ) goto syntax; 4668 if ( ( inp = SkipAName(s) ) == 0 ) goto syntax; 4670 if ( ( type = GetName(AC.varnames,s,&indexnum,WITHAUTO) ) != CINDEX ) { 4671 MesPrint("&%s is not a proper index",s); 4674 else if ( indexnum < WILDOFFSET 4675 && indices[indexnum].dimension == 0 ) { 4676 MesPrint("&%s should be a summable index",s); 4679 indexnum += AM.OffsetIndex; 4683 else if ( StrICont(inp,(UBYTE *)"outfun") == 0 ) { 4684 if ( c != '=
' ) goto syntax; 4686 if ( ( inp = SkipAName(s) ) == 0 ) goto syntax; 4688 if ( ( type = GetName(AC.varnames,s,&outfun,WITHAUTO) ) != CFUNCTION ) { 4689 MesPrint("&%s is not a proper function or tensor",s); 4697 MesPrint("&Unrecognized option in FindLoop or ReplaceLoop: %s",inp); 4699 while ( *inp && *inp != ',
' ) inp++; 4702 if ( *inp != 0 && mode == REPLACELOOP ) goto syntax; 4703 if ( mode == FINDLOOP && outflag > 0 ) { 4704 MesPrint("&outflag option is illegal in FindLoop"); 4707 if ( mode == REPLACELOOP && outflag == 0 ) goto syntax; 4708 if ( aflag == 0 || lflag == 0 ) goto syntax; 4709 comfindloop[3] = funnum; 4710 comfindloop[4] = nloop; 4711 comfindloop[5] = nargs; 4712 comfindloop[6] = outfun; 4715 if ( mode == 0 ) comfindloop[2] = indexnum + 5; 4716 else comfindloop[2] = -indexnum - 5; 4718 else comfindloop[2] = mode; 4719 AddNtoL(comfindloop[1],comfindloop); 4728 int CoFindLoop(UBYTE *inp) 4729 { return(DoFindLoop(inp,FINDLOOP)); } 4736 int CoReplaceLoop(UBYTE *inp) 4737 { return(DoFindLoop(inp,REPLACELOOP)); } 4744 static UBYTE *FunPowOptions[] = { 4745 (UBYTE *)"nofunpowers" 4746 ,(UBYTE *)"commutingonly" 4747 ,(UBYTE *)"allfunpowers" 4750 int CoFunPowers(UBYTE *inp) 4753 int i, maxoptions = sizeof(FunPowOptions)/sizeof(UBYTE *); 4754 while ( *inp == ',
' ) inp++; 4756 inp = SkipAName(inp); c = *inp; *inp = 0; 4757 for ( i = 0; i < maxoptions; i++ ) { 4758 if ( StrICont(option,FunPowOptions[i]) == 0 ) { 4761 MesPrint("&Illegal FunPowers statement"); 4768 MesPrint("&Illegal option in FunPowers statement: %s",option); 4777 int CoUnitTrace(UBYTE *s) 4780 if ( FG.cTable[*s] == 1 ) { 4783 nogood: MesPrint("&Value of UnitTrace should be a (positive) number or a symbol"); 4786 AC.lUniTrace[0] = SNUMBER; 4787 AC.lUniTrace[2] = num; 4790 if ( GetName(AC.varnames,s,&num,WITHAUTO) == CSYMBOL ) { 4791 AC.lUniTrace[0] = SYMBOL; 4792 AC.lUniTrace[2] = num; 4797 if ( *s ) goto nogood; 4799 AC.lUnitTrace = num; 4807 Note: termstack holds the offset of the term statement in the compiler 4808 buffer. termsortstack holds the offset of the last sort statement 4809 (or the corresponding term statement) 4812 int CoTerm(UBYTE *s) 4815 WORD *w = AT.WorkPointer; 4817 while ( *s == ',
' ) s++; 4819 MesPrint("&Illegal syntax for Term statement"); 4822 if ( AC.termlevel+1 >= AC.maxtermlevel ) { 4823 if ( AC.maxtermlevel <= 0 ) { 4824 AC.maxtermlevel = 20; 4825 AC.termstack = (LONG *)Malloc1(AC.maxtermlevel*sizeof(LONG),"termstack"); 4826 AC.termsortstack = (LONG *)Malloc1(AC.maxtermlevel*sizeof(LONG),"termsortstack"); 4827 AC.termsumcheck = (WORD *)Malloc1(AC.maxtermlevel*sizeof(WORD),"termsumcheck"); 4830 DoubleBuffer((void **)AC.termstack,(void **)AC.termstack+AC.maxtermlevel, 4831 sizeof(LONG),"doubling termstack"); 4832 DoubleBuffer((void **)AC.termsortstack, 4833 (void **)AC.termsortstack+AC.maxtermlevel, 4834 sizeof(LONG),"doubling termsortstack"); 4835 DoubleBuffer((void **)AC.termsumcheck, 4836 (void **)AC.termsumcheck+AC.maxtermlevel, 4837 sizeof(LONG),"doubling termsumcheck"); 4838 AC.maxtermlevel *= 2; 4841 AC.termsumcheck[AC.termlevel] = NestingChecksum(); 4842 AC.termstack[AC.termlevel] = cbuf[AC.cbufnum].Pointer 4843 - cbuf[AC.cbufnum].Buffer + 2; 4844 AC.termsortstack[AC.termlevel] = AC.termstack[AC.termlevel] + 1; 4848 *w++ = cbuf[AC.cbufnum].numlhs; 4849 *w++ = cbuf[AC.cbufnum].numlhs; 4850 AT.WorkPointer[1] = w - AT.WorkPointer; 4851 AddNtoL(AT.WorkPointer[1],AT.WorkPointer); 4860 int CoEndTerm(UBYTE *s) 4862 CBUF *C = cbuf+AC.cbufnum; 4863 while ( *s == ',
' ) s++; 4865 MesPrint("&Illegal syntax for EndTerm statement"); 4868 if ( AC.termlevel <= 0 ) { 4869 MesPrint("&EndTerm without corresponding Argument statement"); 4873 cbuf[AC.cbufnum].Buffer[AC.termstack[AC.termlevel]] = C->numlhs; 4874 cbuf[AC.cbufnum].Buffer[AC.termsortstack[AC.termlevel]] = C->numlhs; 4875 if ( AC.termsumcheck[AC.termlevel] != NestingChecksum() ) { 4887 int CoSort(UBYTE *s) 4890 WORD *w = AT.WorkPointer; 4892 while ( *s == ',
' ) s++; 4894 MesPrint("&Illegal syntax for Sort statement"); 4897 if ( AC.termlevel <= 0 ) { 4898 MesPrint("&The Sort statement can only be used inside a term environment"); 4901 if ( error ) return(error); 4905 cbuf[AC.cbufnum].Buffer[AC.termsortstack[AC.termlevel-1]] = 4906 *w = cbuf[AC.cbufnum].numlhs+1; 4908 AC.termsortstack[AC.termlevel-1] = cbuf[AC.cbufnum].Pointer 4909 - cbuf[AC.cbufnum].Buffer + 3; 4910 if ( AC.termsumcheck[AC.termlevel-1] != NestingChecksum() - 1 ) { 4914 AT.WorkPointer[1] = w - AT.WorkPointer; 4915 AddNtoL(AT.WorkPointer[1],AT.WorkPointer); 4923 Collect,functionname 4926 int CoPolyFun(UBYTE *s) 4933 AR.PolyFun = AC.lPolyFun = 0; 4934 AR.PolyFunType = AC.lPolyFunType = 0; 4938 if ( t == 0 || *t != 0 ) { 4939 MesPrint("&PolyFun statement needs a single commuting function for its argument"); 4942 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION ) 4943 || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) { 4944 MesPrint("&%s should be a regular commuting function",s); 4946 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND ) 4947 AddFunction(s,0,0,0,0,0,-1,-1); 4951 AR.PolyFun = AC.lPolyFun = numfun+FUNCTION; 4952 AR.PolyFunType = AC.lPolyFunType = 1; 4960 Collect,functionname 4963 int CoPolyRatFun(UBYTE *s) 4970 AR.PolyFun = AC.lPolyFun = 0; 4971 AR.PolyFunType = AC.lPolyFunType = 0; 4975 if ( t == 0 || *t != 0 ) { 4976 MesPrint("&PolyRatFun statement needs a single commuting function for its argument"); 4979 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION ) 4980 || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) { 4981 MesPrint("&%s should be a regular commuting function",s); 4983 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND ) 4984 AddFunction(s,0,0,0,0,0,-1,-1); 4988 AR.PolyFun = AC.lPolyFun = numfun+FUNCTION; 4989 AR.PolyFunType = AC.lPolyFunType = 2; 4990 AC.PolyRatFunChanged = 1; 4999 int CoMerge(UBYTE *inp) 5003 WORD numfunc, option = 0; 5004 if ( tolower(s[0]) == 'o
' && tolower(s[1]) == 'n
' && tolower(s[2]) == 'c
' && 5005 tolower(s[3]) == 'e
' && tolower(s[4]) == ',
' ) { 5008 else if ( tolower(s[0]) == 'a
' && tolower(s[1]) == 'l
' && tolower(s[2]) == 'l
' && 5009 tolower(s[3]) == ',
' ) { 5013 if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR ) 5016 MesPrint("&%s is undefined",s); 5017 numfunc = AddDollar(s+1,DOLINDEX,&one,1); 5020 tests: s = SkipAName(s); 5022 MesPrint("&Merge/shuffle should have a single function or $variable for its argument"); 5026 else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) { 5027 numfunc += FUNCTION; 5030 else if ( type != -1 ) { 5031 if ( type != CDUBIOUS ) { 5032 NameConflict(type,s); 5033 type = MakeDubious(AC.varnames,s,&numfunc); 5038 MesPrint("&%s is not a function",s); 5039 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION; 5042 Add4Com(TYPEMERGE,numfunc,option); 5050 Important for future options: The bit, given by 256 (bit 8) is reserved 5051 internally for keeping track of the sign in the number of Stuffle 5055 int CoStuffle(UBYTE *inp) 5057 UBYTE *s = inp, *ss, c; 5059 WORD numfunc, option = 0; 5060 if ( tolower(s[0]) == 'o
' && tolower(s[1]) == 'n
' && tolower(s[2]) == 'c
' && 5061 tolower(s[3]) == 'e
' && tolower(s[4]) == ',
' ) { 5064 else if ( tolower(s[0]) == 'a
' && tolower(s[1]) == 'l
' && tolower(s[2]) == 'l
' && 5065 tolower(s[3]) == ',
' ) { 5071 if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR ) 5074 MesPrint("&%s is undefined",s); 5075 numfunc = AddDollar(s+1,DOLINDEX,&one,1); 5079 if ( *ss != '+
' && *ss != '-
' && ss[1] != 0 ) { 5080 MesPrint("&Stuffle should have a single function or $variable for its argument, followed by either + or -"); 5083 if ( *ss == '-
' ) option += 2; 5085 else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) { 5086 numfunc += FUNCTION; 5089 else if ( type != -1 ) { 5090 if ( type != CDUBIOUS ) { 5091 NameConflict(type,s); 5092 type = MakeDubious(AC.varnames,s,&numfunc); 5097 MesPrint("&%s is not a function",s); 5098 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION; 5101 Add4Com(TYPESTUFFLE,numfunc,option); 5107 #[ CoProcessBucket : 5110 int CoProcessBucket(UBYTE *s) 5113 while ( *s == ',
' || *s == '=
' ) s++; 5115 if ( *s && *s != ' ' && *s != '\t
' ) { 5116 MesPrint("&Numerical value expected for ProcessBucketSize"); 5119 AC.ProcessBucketSize = x; 5124 #] CoProcessBucket : 5128 int CoThreadBucket(UBYTE *s) 5131 while ( *s == ',
' || *s == '=
' ) s++; 5133 if ( *s && *s != ' ' && *s != '\t
' ) { 5134 MesPrint("&Numerical value expected for ThreadBucketSize"); 5138 Warning("Negative of zero value not allowed for ThreadBucketSize. Adjusted to 1."); 5141 AC.ThreadBucketSize = x; 5143 if ( AS.MultiThreaded ) MakeThreadBuckets(-1,1); 5152 Syntax: a list of functions. 5153 If the functions have an argument it must be a function. 5154 In the case f(g) we treat f(g(...)) with g any argument. 5155 (not yet implemented) 5158 int DoArgPlode(UBYTE *s, int par) 5161 WORD numfunc, type, error = 0, *w, n; 5166 while ( *s == ',
' ) s++; 5169 MesPrint("&We don't
do dollar variables yet in ArgImplode/ArgExplode
"); 5172 if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) { 5173 numfunc += FUNCTION; 5175 else if ( type != -1 ) { 5176 if ( type != CDUBIOUS ) { 5177 NameConflict(type,s); 5178 type = MakeDubious(AC.varnames,s,&numfunc); 5183 MesPrint("&%s is not a
function",s); 5184 numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION; 5191 for ( i = 2; i < FUNHEAD; i++ ) *w++ = 0; 5193 if ( *s && *s != ',' ) { 5194 MesPrint("&Illegal character in ArgImplode/ArgExplode statement: %s
",s); 5197 while ( *s == ',' ) s++; 5199 n = w - AT.WorkPointer; 5200 AT.WorkPointer[1] = n; 5201 AddNtoL(n,AT.WorkPointer); 5210 int CoArgExplode(UBYTE *s) { return(DoArgPlode(s,TYPEARGEXPLODE)); } 5217 int CoArgImplode(UBYTE *s) { return(DoArgPlode(s,TYPEARGIMPLODE)); } 5224 int CoClearTable(UBYTE *s) 5227 int j, type, error = 0; 5231 MesPrint("&The ClearTable statement needs at least one (table) argument.
"); 5238 if ( ( ( type = GetName(AC.varnames,t,&numfun,WITHAUTO) ) != CFUNCTION ) 5239 && type != CDUBIOUS ) { 5240 nofunc: MesPrint("&%s is not a sparse table
",t); 5242 if ( type < 0 ) numfun = AddFunction(t,0,0,0,0,0,-1,-1); 5244 if ( *s == ',' ) s++; 5247 else if ( ( ( T = functions[numfun].tabl ) == 0 ) 5248 || ( T->sparse == 0 ) ) goto nofunc; 5251 if ( *s == ',' ) s++; 5253 Now we clear the table. 5255 if ( T->boomlijst ) M_free(T->boomlijst,"TableTree
"); 5256 for (j = 0; j < T->buffersfill; j++ ) { /* was <= */ 5257 finishcbuf(T->buffers[j]); 5259 if ( T->buffers ) M_free(T->buffers,"Table buffers
"); 5260 finishcbuf(T->bufnum); 5261 if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers
"); 5264 T->numtree = 0; T->rootnum = 0; T->MaxTreeSize = 0; 5266 T->bufnum = inicbufs(); 5268 T->buffers = (WORD *)Malloc1(sizeof(WORD)*T->bufferssize,"Table buffers
"); 5270 T->buffers[T->buffersfill++] = T->bufnum; 5272 T->totind = 0; /* At the moment there are this many */ 5273 T->tablepointers = 0; 5280 if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers
"); 5281 for (j = 0; j < TT->buffersfill; j++ ) { 5282 finishcbuf(TT->buffers[j]); 5284 if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree
"); 5285 if ( TT->buffers )M_free(TT->buffers,"Table buffers
"); 5286 if ( TT->mm ) M_free(TT->mm,"tableminmax
"); 5287 if ( TT->flags ) M_free(TT->flags,"tableflags
"); 5300 int CoDenominators(UBYTE *s) 5304 UBYTE *t = SkipAName(s), *t1; 5305 if ( t == 0 ) goto syntaxerror; 5306 t1 = t; while ( *t1 == ',' || *t1 == ' ' || *t1 == '\t' ) t1++; 5307 if ( *t1 ) goto syntaxerror; 5309 if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION ) 5310 || ( functions[numfun].spec != 0 ) ) { 5312 if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND ) 5313 AddFunction(s,0,0,0,0,0,-1,-1); 5317 Add3Com(TYPEDENOMINATORS,numfun+FUNCTION); 5320 MesPrint("&Denominators statement needs one regular
function for its argument
"); 5326 #[ CoDropCoefficient : 5329 int CoDropCoefficient(UBYTE *s) 5332 Add2Com(TYPEDROPCOEFFICIENT) 5335 MesPrint("&Illegal argument in DropCoefficient statement:
'%s'",s); 5339 #] CoDropCoefficient : 5343 int CoDropSymbols(UBYTE *s) 5346 Add2Com(TYPEDROPSYMBOLS) 5349 MesPrint("&Illegal argument in DropSymbols statement:
'%s'",s); 5356 Converts the current term as much as possible to symbols. 5357 Keeps a list of all objects converted to symbols in AM.sbufnum. 5358 Note that this cannot be executed in parallel because we have only 5359 a single compiler buffer for this. Hence we switch on the noparallel 5363 OnlyFunctions [,name1][,name2][,...,namem]; 5366 int CoToPolynomial(UBYTE *inp) 5369 while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++; 5370 if ( ( AC.topolynomialflag & ~TOPOLYNOMIALFLAG ) != 0 ) { 5371 MesPrint("&ToPolynomial statement and FactArg statement are not allowed in the same module
"); 5374 if ( AO.OptimizeResult.code != NULL ) { 5375 MesPrint("&Using ToPolynomial statement when there are still optimization results active.
"); 5376 MesPrint("&Please use #ClearOptimize instruction first.
"); 5377 MesPrint("&This will loose the optimized expression.
"); 5381 Add3Com(TYPETOPOLYNOMIAL,DOALL) 5385 WORD *funnums = 0, type, num; 5388 if ( s == 0 ) return(1); 5390 if ( StrICmp(inp,(UBYTE *)"onlyfunctions
") ) { 5391 MesPrint("&Illegal option %s in ToPolynomial statement
",inp); 5397 while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++; 5401 Get definitely enough space for the numbers of the functions 5403 funnums = (WORD *)Malloc1(((LONG)(s-inp)+3)*sizeof(WORD),"ToPlynomial
"); 5406 if ( s == 0 ) return(1); 5408 type = GetName(AC.varnames,inp,&num,WITHAUTO); 5409 if ( type != CFUNCTION ) { 5410 MesPrint("&%s is not a
function in ToPolynomial statement
",inp); 5413 funnums[3+numargs++] = num+FUNCTION; 5416 while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++; 5418 funnums[0] = TYPETOPOLYNOMIAL; 5419 funnums[1] = numargs+3; 5420 funnums[2] = ONLYFUNCTIONS; 5422 AddNtoL(numargs+3,funnums); 5423 if ( funnums ) M_free(funnums,"ToPolynomial
"); 5425 AC.topolynomialflag |= TOPOLYNOMIALFLAG; 5427 /* In ParFORM, ToPolynomial has to be executed on the master. */ 5428 AC.mparallelflag |= NOPARALLEL_CONVPOLY; 5435 #[ CoFromPolynomial : 5437 Converts the current term as much as possible back from extra symbols 5438 to their original values. Does not look inside functions. 5441 int CoFromPolynomial(UBYTE *inp) 5443 while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++; 5445 if ( AO.OptimizeResult.code != NULL ) { 5446 MesPrint("&Using FromPolynomial statement when there are still optimization results active.
"); 5447 MesPrint("&Please use #ClearOptimize instruction first.
"); 5448 MesPrint("&This will loose the optimized expression.
"); 5451 Add2Com(TYPEFROMPOLYNOMIAL) 5454 MesPrint("&Illegal argument in FromPolynomial statement:
'%s'",inp); 5459 #] CoFromPolynomial : 5463 int CoExtraSymbols(UBYTE *inp) 5465 UBYTE *arg1, *arg2, c, *s; 5466 WORD i, j, type, number; 5467 while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++; 5468 if ( FG.cTable[*inp] != 0 ) { 5469 MesPrint("&Illegal argument in ExtraSymbols statement:
'%s'",inp); 5473 while ( FG.cTable[*inp] == 0 ) inp++; 5475 if ( ( StrICmp(arg1,(UBYTE *)"array
") == 0 ) 5476 || ( StrICmp(arg1,(UBYTE *)"vector
") == 0 ) ) { 5477 AC.extrasymbols = 1; 5479 else if ( StrICmp(arg1,(UBYTE *)"underscore
") == 0 ) { 5480 AC.extrasymbols = 0; 5483 else if ( StrICmp(arg1,(UBYTE *)"nothing
") == 0 ) { 5484 AC.extrasymbols = 2; 5488 MesPrint("&Illegal keyword in ExtraSymbols statement:
'%s'",arg1); 5492 while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++; 5493 if ( FG.cTable[*inp] != 0 ) { 5494 MesPrint("&Illegal argument in ExtraSymbols statement:
'%s'",inp); 5498 while ( FG.cTable[*inp] <= 1 ) inp++; 5500 MesPrint("&Illegal end of ExtraSymbols statement:
'%s'",inp); 5504 Now check whether this object has been declared already. 5505 That would not be allowed. 5507 if ( AC.extrasymbols == 1 ) { 5508 type = GetName(AC.varnames,arg2,&number,NOAUTO); 5509 if ( type != NAMENOTFOUND ) { 5510 MesPrint("&ExtraSymbols statement:
'%s' has already been declared before
",arg2); 5514 else if ( AC.extrasymbols == 0 ) { 5515 if ( *arg2 == 'N' ) { 5517 while ( FG.cTable[*s] == 1 ) s++; 5519 MesPrint("&ExtraSymbols statement:
'%s' creates conflicts with summed indices
",arg2); 5524 if ( AC.extrasym ) { M_free(AC.extrasym,"extrasym
"); AC.extrasym = 0; } 5526 AC.extrasym = (UBYTE *)Malloc1(i*sizeof(UBYTE),"extrasym
"); 5527 for ( j = 0; j < i; j++ ) AC.extrasym[j] = arg2[j]; 5533 #[ GetIfDollarFactor : 5536 WORD *GetIfDollarFactor(UBYTE **inp, WORD *w) 5542 if ( FG.cTable[*s] == 1 ) { 5544 while ( FG.cTable[*s] == 1 ) { 5545 x = 10*x + *s++ - '0'; 5546 if ( x >= MAXPOSITIVE ) { 5547 MesPrint("&Value in dollar factor too large
"); 5548 while ( FG.cTable[*s] == 1 ) s++; 5553 *w++ = IFDOLLAREXTRA; 5560 MesPrint("&Factor indicator
for $-variable should be a number or a $-variable.
"); 5564 while ( FG.cTable[*s] < 2 ) s++; 5566 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) { 5567 MesPrint("&dollar in
if statement should have been defined previously
"); 5571 *w++ = IFDOLLAREXTRA; 5577 if ( ( w = GetIfDollarFactor(inp,w) ) == 0 ) return(0); 5580 MesPrint("&unmatched [] in $ in
if statement
"); 5590 #] GetIfDollarFactor : 5594 UBYTE *GetDoParam(UBYTE *inp, WORD **wp, int par) 5599 if ( FG.cTable[*inp] == 1 ) { 5601 while ( *inp >= '0' && *inp <= '9' ) { 5602 x = 10*x + *inp++ - '0'; 5603 if ( x > MAXPOSITIVE ) { 5605 MesPrint("&Value in dollar factor too large
"); 5608 MesPrint("&Value in
do loop boundaries too large
"); 5610 while ( FG.cTable[*inp] == 1 ) inp++; 5619 *(*wp)++ = DOLLAREXPR2; 5620 *(*wp)++ = -((WORD)x)-1; 5624 if ( *inp != '$' ) { 5628 while ( FG.cTable[*inp] < 2 ) inp++; 5630 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) { 5632 MesPrint("&dollar in print statement should have been defined previously
"); 5635 MesPrint("&dollar in
do loop boundaries should have been defined previously
"); 5641 *(*wp)++ = DOLLAREXPRESSION; 5645 *(*wp)++ = DOLLAREXPR2; 5650 inp = GetDoParam(inp,wp,0); 5651 if ( inp == 0 ) return(0); 5652 if ( *inp != ']' ) { 5654 MesPrint("&unmatched [] in $ in print statement
"); 5657 MesPrint("&unmatched [] in
do loop boundaries
"); 5671 int CoDo(UBYTE *inp) 5674 CBUF *C = cbuf+AC.cbufnum; 5678 if ( AC.doloopstack == 0 ) { 5679 AC.doloopstacksize = 20; 5680 AC.doloopstack = (WORD *)Malloc1(AC.doloopstacksize*2*sizeof(WORD),"doloop stack
"); 5681 AC.doloopnest = AC.doloopstack + AC.doloopstacksize; 5683 if ( AC.dolooplevel >= AC.doloopstacksize ) { 5684 WORD *newstack, *newnest, newsize; 5685 newsize = AC.doloopstacksize * 2; 5686 newstack = (WORD *)Malloc1(newsize*2*sizeof(WORD),"doloop stack
"); 5687 newnest = newstack + newsize; 5688 for ( i = 0; i < newsize; i++ ) { 5689 newstack[i] = AC.doloopstack[i]; 5690 newnest[i] = AC.doloopnest[i]; 5692 M_free(AC.doloopstack,"doloop stack
"); 5693 AC.doloopstack = newstack; 5694 AC.doloopnest = newnest; 5695 AC.doloopstacksize = newsize; 5697 AC.doloopnest[AC.dolooplevel] = NestingChecksum(); 5701 w++; /* Space for the length of the statement */ 5703 Now the $loopvariable 5705 while ( *inp == ',' ) inp++; 5706 if ( *inp != '$' ) { 5708 MesPrint("&
do loop parameter should be a dollar variable
"); 5713 if ( FG.cTable[*inp] != 0 ) { 5715 MesPrint("&illegal name
for do loop parameter
"); 5717 while ( FG.cTable[*inp] < 2 ) inp++; 5719 if ( GetName(AC.dollarnames,name,&numparam,NOAUTO) == NAMENOTFOUND ) { 5720 numparam = AddDollar(name,DOLUNDEFINED,0,0); 5724 AddPotModdollar(numparam); 5726 w++; /* space for the level of the enddo statement */ 5727 while ( *inp == ',' ) inp++; 5728 if ( *inp != '=' ) goto IllSyntax; 5730 while ( *inp == ',' ) inp++; 5734 inp = GetDoParam(inp,&w,1); 5735 if ( inp == 0 || *inp != ',' ) goto IllSyntax; 5736 while ( *inp == ',' ) inp++; 5740 inp = GetDoParam(inp,&w,1); 5741 if ( inp == 0 || ( *inp != 0 && *inp != ',' ) ) goto IllSyntax; 5745 if ( *inp != ',' ) { 5746 if ( *inp == 0 ) { *w++ = SNUMBER; *w++ = 1; } 5747 else goto IllSyntax; 5750 while ( *inp == ',' ) inp++; 5751 inp = GetDoParam(inp,&w,1); 5753 if ( inp == 0 || *inp != 0 ) goto IllSyntax; 5755 AT.WorkPointer[1] = w - AT.WorkPointer; 5757 Put away and set information for placing enddo information. 5759 AddNtoL(AT.WorkPointer[1],AT.WorkPointer); 5760 AC.doloopstack[AC.dolooplevel++] = C->numlhs; 5765 MesPrint("&Illegal syntax
for do statement
"); 5774 int CoEndDo(UBYTE *inp) 5776 CBUF *C = cbuf+AC.cbufnum; 5778 while ( *inp == ',' ) inp++; 5780 MesPrint("&Illegal syntax
for EndDo statement
"); 5783 if ( AC.dolooplevel <= 0 ) { 5784 MesPrint("&EndDo without corresponding Do statement
"); 5788 scratch[0] = TYPEENDDOLOOP; 5790 scratch[2] = AC.doloopstack[AC.dolooplevel]; 5792 cbuf[AC.cbufnum].lhs[AC.doloopstack[AC.dolooplevel]][3] = C->numlhs; 5793 if ( AC.doloopnest[AC.dolooplevel] != NestingChecksum() ) { 5805 int CoFactDollar(UBYTE *inp) 5808 if ( *inp == '$' ) { 5809 if ( GetName(AC.dollarnames,inp+1,&numdollar,NOAUTO) != CDOLLAR ) { 5810 MesPrint("&%s is undefined
",inp); 5811 numdollar = AddDollar(inp+1,DOLINDEX,&one,1); 5814 inp = SkipAName(inp+1); 5816 MesPrint("&FactDollar should have a single $variable
for its argument
"); 5819 AddPotModdollar(numdollar); 5822 MesPrint("&%s is not a $-variable
",inp); 5825 Add3Com(TYPEFACTOR,numdollar); 5834 int CoFactorize(UBYTE *s) { return(DoFactorize(s,1)); } 5841 int CoNFactorize(UBYTE *s) { return(DoFactorize(s,0)); } 5848 int CoUnFactorize(UBYTE *s) { return(DoFactorize(s,3)); } 5855 int CoNUnFactorize(UBYTE *s) { return(DoFactorize(s,2)); } 5862 int DoFactorize(UBYTE *s,int par) 5868 int error = 0, keepzeroflag = 0; 5871 while ( *s != ')' && *s ) { 5872 if ( FG.cTable[*s] == 0 ) { 5873 t = s; while ( FG.cTable[*s] == 0 ) s++; 5875 if ( StrICmp((UBYTE *)"keepzero
",t) == 0 ) { 5879 MesPrint("&Illegal option in [N][Un]Factorize statement: %s
",t); 5884 while ( *s == ',' ) s++; 5885 if ( *s && *s != ')' && FG.cTable[*s] != 0 ) { 5886 MesPrint("&Illegal character in option field of [N][Un]Factorize statement
"); 5892 while ( *s == ',' || *s == ' ' ) s++; 5895 for ( i = NumExpressions-1; i >= 0; i-- ) { 5897 if ( e->replace >= 0 ) { 5898 e = Expressions + e->replace; 5900 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION 5901 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION 5902 || e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION 5906 e->vflags &= ~TOBEFACTORED; 5909 e->vflags |= TOBEFACTORED; 5910 e->vflags &= ~TOBEUNFACTORED; 5913 e->vflags &= ~TOBEUNFACTORED; 5916 e->vflags |= TOBEUNFACTORED; 5917 e->vflags &= ~TOBEFACTORED; 5921 if ( ( e->vflags & TOBEFACTORED ) != 0 ) { 5922 if ( keepzeroflag ) e->vflags |= KEEPZERO; 5923 else e->vflags &= ~KEEPZERO; 5925 else e->vflags &= ~KEEPZERO; 5929 for(;;) { /* Look for a (comma separated) list of variables */ 5930 while ( *s == ',' ) s++; 5931 if ( *s == 0 ) break; 5932 if ( *s == '[' || FG.cTable[*s] == 0 ) { 5934 if ( ( s = SkipAName(s) ) == 0 ) { 5935 MesPrint("&Improper name
for an expression:
'%s'",t); 5939 if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) { 5940 e = Expressions+number; 5941 if ( e->replace >= 0 ) { 5942 e = Expressions + e->replace; 5944 if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION 5945 || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION 5946 || e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION 5950 e->vflags &= ~TOBEFACTORED; 5953 e->vflags |= TOBEFACTORED; 5954 e->vflags &= ~TOBEUNFACTORED; 5957 e->vflags &= ~TOBEUNFACTORED; 5960 e->vflags |= TOBEUNFACTORED; 5961 e->vflags &= ~TOBEFACTORED; 5965 if ( ( e->vflags & TOBEFACTORED ) != 0 ) { 5966 if ( keepzeroflag ) e->vflags |= KEEPZERO; 5967 else e->vflags &= ~KEEPZERO; 5969 else e->vflags &= ~KEEPZERO; 5971 else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) { 5972 MesPrint("&%s is not an expression
",t); 5978 MesPrint("&Illegal
object in (N)Factorize statement");
5980 while ( *s && *s != ',' ) s++;
5981 if ( *s == 0 ) break;
5995 int CoOptimizeOption(UBYTE *s)
5997 UBYTE *name, *t1, *t2, c1, c2, *value, *u;
6000 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' ) s++;
6002 name = s;
while ( FG.cTable[*s] == 0 ) s++;
6004 while ( *s ==
' ' || *s ==
'\t' ) s++;
6007 MesPrint(
"&Correct use in Format,Optimize statement is Optionname=value");
6009 while ( *s ==
' ' || *s ==
',' || *s ==
'\t' || *s ==
'=' ) s++;
6015 while ( *s ==
' ' || *s ==
'\t' ) s++;
6016 if ( *s == 0 )
goto correctuse;
6018 while ( FG.cTable[*s] <= 1 || *s==
'.' || *s==
'*' || *s ==
'(' || *s ==
')' ) {
6019 if ( *s ==
'(' ) { SKIPBRA4(s) }
6023 while ( *s ==
' ' || *s ==
'\t' ) s++;
6024 if ( *s && *s !=
',' )
goto correctuse;
6027 while ( *s ==
' ' || *s ==
'\t' ) s++;
6033 if ( StrICmp(name,(UBYTE *)
"horner") == 0 ) {
6034 if ( StrICmp(value,(UBYTE *)
"occurrence") == 0 ) {
6035 AO.Optimize.horner = O_OCCURRENCE;
6037 else if ( StrICmp(value,(UBYTE *)
"mcts") == 0 ) {
6038 AO.Optimize.horner = O_MCTS;
6041 AO.Optimize.horner = -1;
6042 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6046 else if ( StrICmp(name,(UBYTE *)
"hornerdirection") == 0 ) {
6047 if ( StrICmp(value,(UBYTE *)
"forward") == 0 ) {
6048 AO.Optimize.hornerdirection = O_FORWARD;
6050 else if ( StrICmp(value,(UBYTE *)
"backward") == 0 ) {
6051 AO.Optimize.hornerdirection = O_BACKWARD;
6053 else if ( StrICmp(value,(UBYTE *)
"forwardorbackward") == 0 ) {
6054 AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
6056 else if ( StrICmp(value,(UBYTE *)
"forwardandbackward") == 0 ) {
6057 AO.Optimize.hornerdirection = O_FORWARDANDBACKWARD;
6060 AO.Optimize.method = -1;
6061 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6065 else if ( StrICmp(name,(UBYTE *)
"method") == 0 ) {
6066 if ( StrICmp(value,(UBYTE *)
"none") == 0 ) {
6067 AO.Optimize.method = O_NONE;
6069 else if ( StrICmp(value,(UBYTE *)
"cse") == 0 ) {
6070 AO.Optimize.method = O_CSE;
6072 else if ( StrICmp(value,(UBYTE *)
"csegreedy") == 0 ) {
6073 AO.Optimize.method = O_CSEGREEDY;
6075 else if ( StrICmp(value,(UBYTE *)
"greedy") == 0 ) {
6076 AO.Optimize.method = O_GREEDY;
6079 AO.Optimize.method = -1;
6080 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6084 else if ( StrICmp(name,(UBYTE *)
"timelimit") == 0 ) {
6086 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6088 MesPrint(
"&Option TimeLimit in Format,Optimize statement should be a positive number: %s",value);
6089 AO.Optimize.mctstimelimit = 0;
6090 AO.Optimize.greedytimelimit = 0;
6094 AO.Optimize.mctstimelimit = x/2;
6095 AO.Optimize.greedytimelimit = x/2;
6098 else if ( StrICmp(name,(UBYTE *)
"mctstimelimit") == 0 ) {
6100 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6102 MesPrint(
"&Option MCTSTimeLimit in Format,Optimize statement should be a positive number: %s",value);
6103 AO.Optimize.mctstimelimit = 0;
6107 AO.Optimize.mctstimelimit = x;
6110 else if ( StrICmp(name,(UBYTE *)
"mctsnumexpand") == 0 ) {
6113 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6114 if ( *u ==
'*' || *u ==
'x' || *u ==
'X' ) {
6117 while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6121 MesPrint(
"&Option MCTSNumExpand in Format,Optimize statement should be a positive number: %s",value);
6122 AO.Optimize.mctsnumexpand= 0;
6123 AO.Optimize.mctsnumrepeat= 1;
6127 AO.Optimize.mctsnumexpand= x;
6128 AO.Optimize.mctsnumrepeat= y;
6131 else if ( StrICmp(name,(UBYTE *)
"mctsnumrepeat") == 0 ) {
6133 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6135 MesPrint(
"&Option MCTSNumExpand in Format,Optimize statement should be a positive number: %s",value);
6136 AO.Optimize.mctsnumrepeat= 1;
6140 AO.Optimize.mctsnumrepeat= x;
6143 else if ( StrICmp(name,(UBYTE *)
"mctsnumkeep") == 0 ) {
6145 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6147 MesPrint(
"&Option MCTSNumKeep in Format,Optimize statement should be a positive number: %s",value);
6148 AO.Optimize.mctsnumkeep= 0;
6152 AO.Optimize.mctsnumkeep= x;
6155 else if ( StrICmp(name,(UBYTE *)
"mctsconstant") == 0 ) {
6157 if ( sscanf ((
char*)value,
"%lf", &d) != 1 ) {
6158 MesPrint(
"&Option MCTSConstant in Format,Optimize statement should be a positive number: %s",value);
6159 AO.Optimize.mctsconstant.fval = 0;
6163 AO.Optimize.mctsconstant.fval = d;
6166 else if ( StrICmp(name,(UBYTE *)
"greedytimelimit") == 0 ) {
6168 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6170 MesPrint(
"&Option GreedyTimeLimit in Format,Optimize statement should be a positive number: %s",value);
6171 AO.Optimize.greedytimelimit = 0;
6175 AO.Optimize.greedytimelimit = x;
6178 else if ( StrICmp(name,(UBYTE *)
"greedyminnum") == 0 ) {
6180 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6182 MesPrint(
"&Option GreedyMinNum in Format,Optimize statement should be a positive number: %s",value);
6183 AO.Optimize.greedyminnum= 0;
6187 AO.Optimize.greedyminnum= x;
6190 else if ( StrICmp(name,(UBYTE *)
"greedymaxperc") == 0 ) {
6192 u = value;
while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6194 MesPrint(
"&Option GreedyMaxPerc in Format,Optimize statement should be a positive number: %s",value);
6195 AO.Optimize.greedymaxperc= 0;
6199 AO.Optimize.greedymaxperc= x;
6202 else if ( StrICmp(name,(UBYTE *)
"stats") == 0 ) {
6203 if ( StrICmp(value,(UBYTE *)
"on") == 0 ) {
6204 AO.Optimize.printstats = 1;
6206 else if ( StrICmp(value,(UBYTE *)
"off") == 0 ) {
6207 AO.Optimize.printstats = 0;
6210 AO.Optimize.printstats = 0;
6211 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6215 else if ( StrICmp(name,(UBYTE *)
"printscheme") == 0 ) {
6216 if ( StrICmp(value,(UBYTE *)
"on") == 0 ) {
6217 AO.Optimize.schemeflags |= 1;
6219 else if ( StrICmp(value,(UBYTE *)
"off") == 0 ) {
6220 AO.Optimize.schemeflags &= ~1;
6223 AO.Optimize.schemeflags &= ~1;
6224 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6228 else if ( StrICmp(name,(UBYTE *)
"debugflag") == 0 ) {
6236 if ( FG.cTable[*u] == 1 ) {
6237 while ( *u >=
'0' && *u <=
'9' ) x = 10*x + *u++ -
'0';
6239 MesPrint(
"&Numerical value for DebugFlag in Format,Optimize statement should be a nonnegative number: %s",value);
6240 AO.Optimize.debugflags = 0;
6244 AO.Optimize.debugflags = x;
6247 else if ( StrICmp(value,(UBYTE *)
"on") == 0 ) {
6248 AO.Optimize.debugflags = 1;
6250 else if ( StrICmp(value,(UBYTE *)
"off") == 0 ) {
6251 AO.Optimize.debugflags = 0;
6254 AO.Optimize.debugflags = 0;
6255 MesPrint(
"&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6259 else if ( StrICmp(name,(UBYTE *)
"scheme") == 0 ) {
6266 MesPrint(
"&Option Scheme in Format,Optimize statement should be an array of names or integers between (): %s",value);
6271 while ( *ss ==
' ' || *ss ==
'\t' || *ss ==
',' ) ss++;
6272 if ( FG.cTable[*ss] == 0 || *ss ==
'[' ) {
6273 s1 = u; SKIPBRA3(s1)
6274 if ( *s1 != ')' ) goto noscheme;
6275 while ( ss < s1 ) {
if ( *ss++ ==
',' ) AO.schemenum++; }
6276 *ss++ = 0;
while ( *ss ==
' ' ) ss++;
6277 if ( *ss != 0 )
goto noscheme;
6279 if ( AO.schemenum < 1 ) {
6280 MesPrint(
"&Option Scheme in Format,Optimize statement should have at least one name or number between ()");
6284 if ( AO.inscheme ) M_free(AO.inscheme,
"Horner input scheme");
6285 AO.inscheme = (WORD *)Malloc1((AO.schemenum+1)*
sizeof(WORD),
"Horner input scheme");
6286 while ( *ss ==
' ' || *ss ==
'\t' || *ss ==
',' ) ss++;
6289 if ( *ss == 0 )
break;
6290 s1 = ss; ss = SkipAName(s1); c = *ss; *ss = 0;
6292 if ( ss[-1] ==
'_' ) {
6297 u1 = s1; u2 = AC.extrasym;
6298 while ( *u1 == *u2 ) { u1++; u2++; }
6301 while ( *u1 >=
'0' && *u1 <=
'9' ) numsym = 10*numsym + *u1++ -
'0';
6302 if ( u1 != ss-1 || numsym == 0 || AC.extrasymbols != 0 ) {
6303 MesPrint(
"&Improper use of extra symbol in scheme format option");
6306 numsym = MAXVARIABLES-numsym;
6311 else if ( c ==
'(' ) {
6312 if ( StrCmp(s1,AC.extrasym) == 0 ) {
6313 if ( (AC.extrasymbols&1) != 1 ) {
6314 MesPrint(
"&Improper use of extra symbol in scheme format option");
6319 while ( *ss >=
'0' && *ss <=
'9' ) numsym = 10*numsym + *ss++ -
'0';
6321 MesPrint(
"&Extra symbol should have a number for its argument.");
6324 numsym = MAXVARIABLES-numsym;
6329 type = GetName(AC.varnames,s1,&numsym,WITHAUTO);
6330 if ( ( type != CSYMBOL ) && type != CDUBIOUS ) {
6331 MesPrint(
"&%s is not a symbol",s1);
6333 if ( type < 0 ) numsym = AddSymbol(s1,-MAXPOWER,MAXPOWER,0,0);
6337 AO.inscheme[AO.schemenum++] = numsym;
6338 while ( *ss ==
' ' || *ss ==
'\t' || *ss ==
',' ) ss++;
6343 MesPrint(
"&Unrecognized option name in Format,Optimize statement: %s",name);
6360 int CoPutInside(UBYTE *inp) {
return(DoPutInside(inp,1)); }
6361 int CoAntiPutInside(UBYTE *inp) {
return(DoPutInside(inp,-1)); }
6363 int DoPutInside(UBYTE *inp,
int par)
6367 WORD *to, type, c1,c2,funnum, *WorkSave;
6369 while ( *inp ==
' ' || *inp ==
'\t' || *inp ==
',' ) inp++;
6374 if ( p == 0 )
return(1);
6376 type = GetName(AC.varnames,inp,&funnum,WITHAUTO);
6377 if ( type != CFUNCTION || functions[funnum].tabl != 0 || functions[funnum].spec ) {
6378 MesPrint(
"&PutInside/AntiPutInside expects a regular function for its first argument");
6379 MesPrint(
"&Argument is %s",inp);
6385 while ( *inp ==
' ' || *inp ==
'\t' || *inp ==
',' ) inp++;
6389 tocompiler[0] = TYPEPUTINSIDE;
6392 tocompiler[3] = funnum;
6393 AddNtoL(4,tocompiler);
6396 MesPrint(
"&AntiPutInside needs inside information.");
6401 WorkSave = to = AT.WorkPointer;
6402 *to++ = TYPEPUTINSIDE;
6408 while ( *inp ==
' ' || *inp ==
'\t' || *inp ==
',' ) inp++;
6409 if ( *inp == 0 )
break;
6411 if ( p == 0 ) { error = 1;
break; }
6413 type = GetName(AC.varnames,inp,&c1,WITHAUTO);
6415 if ( type == CVECTOR || type == CDUBIOUS ) {
6419 if ( p == 0 )
return(1);
6421 type = GetName(AC.varnames,inp,&c2,WITHAUTO);
6422 if ( type != CVECTOR && type != CDUBIOUS ) {
6423 MesPrint(
"&Not a vector in dotproduct in PutInside/AntiPutInside statement: %s",inp);
6426 else type = CDOTPRODUCT;
6429 MesPrint(
"&Illegal use of . after %s in PutInside/AntiPutInside statement",inp);
6437 *to++ = SYMBOL; *to++ = 4; *to++ = c1; *to++ = 1;
break;
6439 *to++ = INDEX; *to++ = 3; *to++ = AM.OffsetVector + c1;
break;
6441 *to++ = c1+FUNCTION; *to++ = FUNHEAD; *to++ = 0;
6445 *to++ = DOTPRODUCT; *to++ = 5; *to++ = c1 + AM.OffsetVector;
6446 *to++ = c2 + AM.OffsetVector; *to++ = 1; break;
6448 *to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX; break;
6450 MesPrint("&Illegal variable request for %s in PutInside/AntiPutInside statement",inp);
6456 *to++ = 1; *to++ = 1; *to++ = 3;
6457 AT.WorkPointer[1] = to - AT.WorkPointer;
6458 AT.WorkPointer[4] = AT.WorkPointer[1]-4;
6459 AT.WorkPointer = to;
6460 AC.BracketNormalize = 1;
6461 if ( Normalize(BHEAD WorkSave+4) ) { error = 1; }
6463 WorkSave[1] = WorkSave[4]+4;
6464 to = WorkSave + WorkSave[1] - 1;
6468 AddNtoL(WorkSave[1],WorkSave);
6470 AC.BracketNormalize = 0;
6471 AT.WorkPointer = WorkSave;
WORD Generator(PHEAD WORD *, WORD)
LONG EndSort(PHEAD WORD *, int)