1 /** @file compcomm.c
2  *
3  *  Compiler routines for most statements that don't involve algebraic
4  *	expressions. Exceptions: all routines involving declarations are in
5  *	the file names.c
6  *	When making new statements one can add the compiler routines here and
7  *	have a look whether there is already a routine that is similar. In that
8  *	case one can make a copy and modify it.
9  */
10 /* #[ License : */
11 /*
12  *   Copyright (C) 1984-2017 J.A.M. Vermaseren
13  *   When using this file you are requested to refer to the publication
14  *   J.A.M.Vermaseren "New features of FORM" math-ph/0010025
15  *   This is considered a matter of courtesy as the development was paid
16  *   for by FOM the Dutch physics granting agency and we would like to
17  *   be able to track its scientific use to convince FOM of its value
18  *   for the community.
19  *
20  *   This file is part of FORM.
21  *
22  *   FORM is free software: you can redistribute it and/or modify it under the
23  *   terms of the GNU General Public License as published by the Free Software
24  *   Foundation, either version 3 of the License, or (at your option) any later
25  *   version.
26  *
27  *   FORM is distributed in the hope that it will be useful, but WITHOUT ANY
28  *   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
29  *   FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
30  *   details.
31  *
32  *   You should have received a copy of the GNU General Public License along
33  *   with FORM.  If not, see <http://www.gnu.org/licenses/>.
34  */
35 /* #] License : */
36 /*
37   	#[ includes :
38 */
39 
40 #include "form3.h"
41 #include "comtool.h"
42 
43 static KEYWORD formatoptions[] = {
44 	 {"c",				(TFUN)0,	CMODE,				0}
45 	,{"doublefortran",	(TFUN)0,	DOUBLEFORTRANMODE,	0}
46 	,{"float",			(TFUN)0,	0,					2}
47 	,{"fortran",		(TFUN)0,	FORTRANMODE,		0}
48 	,{"fortran90",		(TFUN)0,	FORTRANMODE,		4}
49 	,{"maple",			(TFUN)0,	MAPLEMODE,			0}
50 	,{"mathematica",	(TFUN)0,	MATHEMATICAMODE,	0}
51 	,{"normal",			(TFUN)0,	NORMALFORMAT,		1}
52 	,{"nospaces",		(TFUN)0,	NOSPACEFORMAT,		3}
53 	,{"pfortran",		(TFUN)0,	PFORTRANMODE,		0}
54 	,{"quadfortran",	(TFUN)0,	QUADRUPLEFORTRANMODE,	0}
55 	,{"quadruplefortran",	(TFUN)0,	QUADRUPLEFORTRANMODE,	0}
56 	,{"rational",		(TFUN)0,	RATIONALMODE,		1}
57 	,{"reduce",			(TFUN)0,	REDUCEMODE,			0}
58 	,{"spaces",			(TFUN)0,	NORMALFORMAT,		3}
59 	,{"vortran",		(TFUN)0,	VORTRANMODE,		0}
60 };
61 
62 static KEYWORD trace4options[] = {
63 	 {"contract",    (TFUN)0,	CHISHOLM,		0          }
64 	,{"nocontract",  (TFUN)0,	0,				CHISHOLM   }
65 	,{"nosymmetrize",(TFUN)0,	0,				ALSOREVERSE}
66 	,{"notrick",     (TFUN)0,	NOTRICK,		0          }
67 	,{"symmetrize",  (TFUN)0,	ALSOREVERSE,	0          }
68 	,{"trick",       (TFUN)0,	0,				NOTRICK    }
69 };
70 
71 static KEYWORD chisoptions[] = {
72 	 {"nosymmetrize",(TFUN)0,	0,				ALSOREVERSE}
73 	,{"symmetrize",  (TFUN)0,	ALSOREVERSE,	0          }
74 };
75 
76 static KEYWORDV writeoptions[] = {
77 	 {"stats",			&(AC.StatsFlag),	1,		0}
78 	,{"statistics",		&(AC.StatsFlag),	1,		0}
79 	,{"shortstats",		&(AC.ShortStats),	1,		0}
80 	,{"shortstatistics",&(AC.ShortStats),	1,		0}
81 	,{"warnings",		&(AC.WarnFlag),	1,		0}
82 	,{"allwarnings",	&(AC.WarnFlag),	2,		0}
83 	,{"setup",			&(AC.SetupFlag),	1,		0}
84 	,{"names",			&(AC.NamesFlag),	1,		0}
85 	,{"allnames",		&(AC.NamesFlag),	2,		0}
86 	,{"codes",			&(AC.CodesFlag),	1,		0}
87 	,{"highfirst",		&(AC.SortType),	SORTHIGHFIRST,		SORTLOWFIRST}
88 	,{"lowfirst",		&(AC.SortType),	SORTLOWFIRST,		SORTHIGHFIRST}
89 	,{"powerfirst",		&(AC.SortType),	SORTPOWERFIRST,		SORTHIGHFIRST}
90 	,{"tokens",			&(AC.TokensWriteFlag),1,	0}
91 };
92 
93 static KEYWORDV onoffoptions[] = {
94 	 {"compress",       &(AC.NoCompress),  0,  1}
95 	,{"checkpoint",     &(AC.CheckpointFlag),  1,  0}
96 	,{"insidefirst",	&(AC.insidefirst), 1,  0}
97 	,{"propercount",    &(AC.BottomLevel), 1,  0}
98 	,{"stats",			&(AC.StatsFlag),	1,	0}
99 	,{"statistics",		&(AC.StatsFlag),	1,	0}
100 	,{"shortstats",		&(AC.ShortStats),	1,	0}
101 	,{"shortstatistics",&(AC.ShortStats),	1,	0}
102 	,{"names",			&(AC.NamesFlag),	1,	0}
103 	,{"allnames",		&(AC.NamesFlag),	2,	0}
104 	,{"warnings",		&(AC.WarnFlag),	1,	0}
105 	,{"allwarnings",	&(AC.WarnFlag),	2,	0}
106 	,{"highfirst",		&(AC.SortType),	SORTHIGHFIRST,	SORTLOWFIRST}
107 	,{"lowfirst",		&(AC.SortType),	SORTLOWFIRST,	SORTHIGHFIRST}
108 	,{"powerfirst",		&(AC.SortType),	SORTPOWERFIRST,	SORTHIGHFIRST}
109 	,{"setup",			&(AC.SetupFlag),	1,	0}
110 	,{"codes",			&(AC.CodesFlag),	1,	0}
111 	,{"tokens",		    &(AC.TokensWriteFlag),1,0}
112 	,{"properorder",    &(AC.properorderflag),1,0}
113 	,{"threadloadbalancing",&(AC.ThreadBalancing),1,	0}
114 	,{"threads",		&(AC.ThreadsFlag),1,	0}
115 	,{"threadsortfilesynch",&(AC.ThreadSortFileSynch),1,  0}
116 	,{"threadstats",	&(AC.ThreadStats),1,	0}
117 	,{"finalstats",	    &(AC.FinalStats),1,	0}
118 	,{"fewerstats",		&(AC.ShortStatsMax),	10,		0}
119 	,{"fewerstatistics",&(AC.ShortStatsMax),	10,		0}
120 	,{"processstats",	&(AC.ProcessStats),1,	0}
121 	,{"oldparallelstats",&(AC.OldParallelStats),1,0}
122 	,{"parallel",	    &(AC.parallelflag),PARALLELFLAG,NOPARALLEL_USER}
123 	,{"nospacesinnumbers",&(AO.NoSpacesInNumbers),1,0}
124 	,{"indentspace",    &(AO.IndentSpace),INDENTSPACE,0}
125 	,{"totalsize",		&(AM.PrintTotalSize),	1,	0}
126 	,{"flag",			(int *)&(AC.debugFlags),	1,	0}
127 	,{"oldfactarg",		&(AC.OldFactArgFlag),	1,	0}
128 	,{"memdebugflag",	&(AC.MemDebugFlag),	1,	0}
129 	,{"oldgcd", 		&(AC.OldGCDflag),	1,	0}
130 	,{"innertest",      &(AC.InnerTest),  1,  0}
131 	,{"wtimestats",     &(AC.WTimeStatsFlag),  1,  0}
132 };
133 
134 static WORD one = 1;
135 
136 /*
137   	#] includes :
138   	#[ CoCollect :
139 
140 	Collect,functionname
141 */
142 
CoCollect(UBYTE * s)143 int CoCollect(UBYTE *s)
144 {
145 /*	--------------change 17-feb-2003 Added percentage */
146 	WORD numfun;
147 	int type,x = 0;
148 	UBYTE *t = SkipAName(s), *t1, *t2;
149 	AC.AltCollectFun = 0;
150 	if ( t == 0 ) goto syntaxerror;
151 	t1 = t; while ( *t1 == ',' || *t1 == ' ' || *t1 == '\t' ) t1++;
152 	*t = 0; t = t1;
153 	if ( *t1 && ( FG.cTable[*t1] == 0 || *t1 == '[' ) ) {
154 		t2 = SkipAName(t1);
155 		if ( t2 == 0 ) goto syntaxerror;
156 		t = t2;
157 		while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
158 		*t2 = 0;
159 	}
160 	else t1 = 0;
161 	if ( *t && FG.cTable[*t] == 1 ) {
162 		while ( *t >= '0' && *t <= '9' ) x = 10*x + *t++ - '0';
163 		if ( x > 100 ) x = 100;
164 		while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
165 		if ( *t ) goto syntaxerror;
166 	}
167 	else {
168 		if ( *t ) goto syntaxerror;
169 		x = 100;
170 	}
171 	if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
172 	|| ( functions[numfun].spec != 0 ) ) {
173 		MesPrint("&%s should be a regular function",s);
174 		if ( type < 0 ) {
175 			if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
176 				AddFunction(s,0,0,0,0,0,-1,-1);
177 		}
178 		return(1);
179 	}
180 	AC.CollectFun = numfun+FUNCTION;
181 	AC.CollectPercentage = (WORD)x;
182 	if ( t1 ) {
183 		if ( ( ( type = GetName(AC.varnames,t1,&numfun,WITHAUTO) ) != CFUNCTION )
184 		|| ( functions[numfun].spec != 0 ) ) {
185 			MesPrint("&%s should be a regular function",t1);
186 			if ( type < 0 ) {
187 				if ( GetName(AC.exprnames,t1,&numfun,NOAUTO) == NAMENOTFOUND )
188 					AddFunction(t1,0,0,0,0,0,-1,-1);
189 			}
190 			return(1);
191 		}
192 		AC.AltCollectFun = numfun+FUNCTION;
193 	}
194 	return(0);
195 syntaxerror:
196 	MesPrint("&Collect statement needs one or two functions (and a percentage) for its argument(s)");
197 	return(1);
198 }
199 
200 /*
201   	#] CoCollect :
202   	#[ setonoff :
203 */
204 
setonoff(UBYTE * s,int * flag,int onvalue,int offvalue)205 int setonoff(UBYTE *s, int *flag, int onvalue, int offvalue)
206 {
207 	if ( StrICmp(s,(UBYTE *)"on") == 0 ) *flag = onvalue;
208 	else if ( StrICmp(s,(UBYTE *)"off") == 0 ) *flag = offvalue;
209 	else {
210 		MesPrint("&Unknown option: %s, on or off expected",s);
211 		return(1);
212 	}
213 	return(0);
214 }
215 
216 /*
217   	#] setonoff :
218   	#[ CoCompress :
219 */
220 
CoCompress(UBYTE * s)221 int CoCompress(UBYTE *s)
222 {
223 	GETIDENTITY
224 	UBYTE *t, c;
225 	if ( StrICmp(s,(UBYTE *)"on") == 0 ) {
226 		AC.NoCompress = 0;
227 		AR.gzipCompress = 0;
228 	}
229 	else if ( StrICmp(s,(UBYTE *)"off") == 0 ) {
230 		AC.NoCompress = 1;
231 		AR.gzipCompress = 0;
232 	}
233 	else {
234 		t = s; while ( FG.cTable[*t] <= 1 ) t++;
235 		c = *t; *t = 0;
236 		if ( StrICmp(s,(UBYTE *)"gzip") == 0 ) {
237 #ifndef WITHZLIB
238 			Warning("gzip compression not supported on this platform");
239 #endif
240 			s = t; *s = c;
241 			if ( *s == 0 ) {
242 				AR.gzipCompress = GZIPDEFAULT;  /* Normally should be 6 */
243 				return(0);
244 			}
245 			while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
246 			t = s;
247 			if ( FG.cTable[*s] == 1 ) {
248 				AR.gzipCompress = *s - '0';
249 				s++;
250 				while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
251 				if ( *s == 0 ) return(0);
252 			}
253 			MesPrint("&Unknown gzip option: %s, a digit was expected",t);
254 			return(1);
255 
256 		}
257 		else {
258 			MesPrint("&Unknown option: %s, on, off or gzip expected",s);
259 			return(1);
260 		}
261 	}
262 	return(0);
263 }
264 
265 /*
266   	#] CoCompress :
267   	#[ CoFlags :
268 */
269 
CoFlags(UBYTE * s,int value)270 int CoFlags(UBYTE *s,int value)
271 {
272 	int i, error = 0;
273 	if ( *s != ',' ) {
274 		MesPrint("&Proper syntax is: On/Off Flag,number[s];");
275 		error = 1;
276 	}
277 	while ( *s == ',' ) {
278 		do { s++; } while ( *s == ',' );
279 		i = 0;
280 		if ( FG.cTable[*s] != 1 ) {
281 			MesPrint("&Proper syntax is: On/Off Flag,number[s];");
282 			error = 1;
283 			break;
284 		}
285 		while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ - '0'; }
286 		if ( i <= 0 || i > MAXFLAGS ) {
287 			MesPrint("&The number of a flag in On/Off Flag should be in the range 0-%d",(int)MAXFLAGS);
288 			error = 1;
289 			break;
290 		}
291 		AC.debugFlags[i] = value;
292 	}
293 	if ( *s ) {
294 		MesPrint("&Proper syntax is: On/Off Flag,number[s];");
295 		error = 1;
296 	}
297 	return(error);
298 }
299 
300 /*
301   	#] CoFlags :
302   	#[ CoOff :
303 */
304 
CoOff(UBYTE * s)305 int CoOff(UBYTE *s)
306 {
307 	GETIDENTITY
308 	UBYTE *t, c;
309 	int i, num = sizeof(onoffoptions)/sizeof(KEYWORD);
310 	for (;;) {
311 		while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
312 		if ( *s == 0 ) return(0);
313 		if ( chartype[*s] != 0 ) {
314 			MesPrint("&Illegal character or option encountered in OFF statement");
315 			return(-1);
316 		}
317 		t = s;	while ( chartype[*s] == 0 ) s++;
318 		c = *s; *s = 0;
319 		for ( i = 0; i < num; i++ ) {
320 			if ( StrICont(t,(UBYTE *)(onoffoptions[i].name)) == 0 ) break;
321 		}
322 		if ( i >= num ) {
323 			MesPrint("&Unrecognized option in OFF statement: %s",t);
324 			*s = c; return(-1);
325 		}
326 		else if ( StrICont(t,(UBYTE *)"compress") == 0 ) {
327 			AR.gzipCompress = 0;
328 		}
329 		else if ( StrICont(t,(UBYTE *)"checkpoint") == 0 ) {
330 			AC.CheckpointInterval = 0;
331 			if ( AC.CheckpointRunBefore ) { free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL; }
332 			if ( AC.CheckpointRunAfter ) { free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL; }
333 			if ( AC.NoShowInput == 0 ) MesPrint("Checkpoints deactivated.");
334 		}
335 		else if ( StrICont(t,(UBYTE *)"threads") == 0 ) {
336 			AS.MultiThreaded = 0;
337 		}
338 		else if ( StrICont(t,(UBYTE *)"flag") == 0 ) {
339 			*s = c;
340 			return(CoFlags(s,0));
341 		}
342 		else if ( StrICont(t,(UBYTE *)"innertest") == 0 ) {
343 			*s = c;
344 			AC.InnerTest = 0;
345 			if ( AC.TestValue ) {
346 				M_free(AC.TestValue,"InnerTest");
347 				AC.TestValue = 0;
348 			}
349 		}
350 		*s = c;
351 	 	*onoffoptions[i].var = onoffoptions[i].flags;
352 		AR.SortType = AC.SortType;
353 		AC.mparallelflag = AC.parallelflag | AM.hparallelflag;
354 	}
355 }
356 
357 /*
358   	#] CoOff :
359   	#[ CoOn :
360 */
361 
CoOn(UBYTE * s)362 int CoOn(UBYTE *s)
363 {
364 	GETIDENTITY
365 	UBYTE *t, c;
366 	int i, num = sizeof(onoffoptions)/sizeof(KEYWORD);
367 	LONG interval;
368 	for (;;) {
369 		while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
370 		if ( *s == 0 ) return(0);
371 		if ( chartype[*s] != 0 ) {
372 			MesPrint("&Illegal character or option encountered in ON statement");
373 			return(-1);
374 		}
375 		t = s;	while ( chartype[*s] == 0 ) s++;
376 		c = *s; *s = 0;
377 		for ( i = 0; i < num; i++ ) {
378 			if ( StrICont(t,(UBYTE *)(onoffoptions[i].name)) == 0 ) break;
379 		}
380 		if ( i >= num ) {
381 			MesPrint("&Unrecognized option in ON statement: %s",t);
382 			*s = c; return(-1);
383 		}
384 		if ( StrICont(t,(UBYTE *)"compress") == 0 ) {
385 			AR.gzipCompress = 0;
386 			*s = c;
387 			while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
388 			if ( *s ) {
389 			  t = s;
390 			  while ( FG.cTable[*s] <= 1 ) s++;
391 			  c = *s; *s = 0;
392 			  if ( StrICmp(t,(UBYTE *)"gzip") == 0 ) {}
393 			  else {
394 				MesPrint("&Unrecognized option in ON compress statement: %s",t);
395 				return(-1);
396 			  }
397 			  *s = c;
398 			  while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
399 #ifndef WITHZLIB
400 			  Warning("gzip compression not supported on this platform");
401 #endif
402 			  if ( FG.cTable[*s] == 1 ) {
403 				AR.gzipCompress = *s++ - '0';
404 				while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
405 				if ( *s ) {
406 					MesPrint("&Unrecognized option in ON compress gzip statement: %s",t);
407 					return(-1);
408 				}
409 			  }
410 			  else if ( *s == 0 ) {
411 				AR.gzipCompress = GZIPDEFAULT;
412 			  }
413 			  else {
414 				MesPrint("&Unrecognized option in ON compress gzip statement: %s, single digit expected",t);
415 				return(-1);
416 			  }
417 			}
418 		}
419 		else if ( StrICont(t,(UBYTE *)"checkpoint") == 0 ) {
420 			AC.CheckpointInterval = 0;
421 			if ( AC.CheckpointRunBefore ) { free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL; }
422 			if ( AC.CheckpointRunAfter ) { free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL; }
423 			*s = c;
424 			while ( *s ) {
425 				while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
426 				if ( FG.cTable[*s] == 1 ) {
427 					interval = 0;
428 					t = s;
429 					do { interval = 10*interval + *s++ - '0'; } while ( FG.cTable[*s] == 1 );
430 					if ( *s == 's' || *s == 'S' ) {
431 						s++;
432 					}
433 					else if ( *s == 'm' || *s == 'M' ) {
434 						interval *= 60; s++;
435 					}
436 					else if ( *s == 'h' || *s == 'H' ) {
437 						interval *= 3600; s++;
438 					}
439 					else if ( *s == 'd' || *s == 'D' ) {
440 						interval *= 86400; s++;
441 					}
442 					if ( *s != ',' && FG.cTable[*s] != 6 && FG.cTable[*s] != 10 ) {
443 						MesPrint("&Unrecognized time interval in ON Checkpoint statement: %s", t);
444 						return(-1);
445 					}
446 					AC.CheckpointInterval = interval * 100; /* in 1/100 of seconds */
447 				}
448 				else if ( FG.cTable[*s] == 0 ) {
449 					int type;
450 					t = s;
451 					while ( FG.cTable[*s] == 0 ) s++;
452 					c = *s; *s = 0;
453 					if ( StrICmp(t,(UBYTE *)"run") == 0 ) {
454 						type = 3;
455 					}
456 					else if ( StrICmp(t,(UBYTE *)"runafter") == 0 ) {
457 						type = 2;
458 					}
459 					else if ( StrICmp(t,(UBYTE *)"runbefore") == 0 ) {
460 						type = 1;
461 					}
462 					else {
463 						MesPrint("&Unrecognized option in ON Checkpoint statement: %s", t);
464 						*s = c; return(-1);
465 					}
466 					*s = c;
467 					if ( *s != '=' && FG.cTable[*(s+1)] != 9 ) {
468 						MesPrint("&Unrecognized option in ON Checkpoint statement: %s", t);
469 						return(-1);
470 					}
471 					++s;
472 					t = ++s;
473 					while ( *s ) {
474 						if ( FG.cTable[*s] == 9 ) {
475 							c = *s; *s = 0;
476 							if ( type & 1 ) {
477 								if ( AC.CheckpointRunBefore ) {
478 									free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL;
479 								}
480 								if ( s-t > 0 ) {
481 									AC.CheckpointRunBefore = Malloc1(s-t+1, "AC.CheckpointRunBefore");
482 									StrCopy(t, (UBYTE*)AC.CheckpointRunBefore);
483 								}
484 							}
485 							if ( type & 2 ) {
486 								if ( AC.CheckpointRunAfter ) {
487 									free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL;
488 								}
489 								if ( s-t > 0 ) {
490 									AC.CheckpointRunAfter = Malloc1(s-t+1, "AC.CheckpointRunAfter");
491 									StrCopy(t, (UBYTE*)AC.CheckpointRunAfter);
492 								}
493 							}
494 							*s = c;
495 							break;
496 						}
497 						++s;
498 					}
499 					if ( FG.cTable[*s] != 9 ) {
500 						MesPrint("&Unrecognized option in ON Checkpoint statement: %s", t);
501 						return(-1);
502 					}
503 					++s;
504 				}
505 			}
506 /*
507 			if ( AC.NoShowInput == 0 ) {
508 				MesPrint("Checkpoints activated.");
509 				if ( AC.CheckpointInterval ) {
510 					MesPrint("-> Minimum saving interval: %l seconds.", AC.CheckpointInterval/100);
511 				}
512 				else {
513 					MesPrint("-> No minimum saving interval given. Saving after EVERY module.");
514 				}
515 				if ( AC.CheckpointRunBefore ) {
516 					MesPrint("-> Calling script \"%s\" before saving.", AC.CheckpointRunBefore);
517 				}
518 				if ( AC.CheckpointRunAfter ) {
519 					MesPrint("-> Calling script \"%s\" after saving.", AC.CheckpointRunAfter);
520 				}
521 			}
522 */
523 		}
524 		else if ( StrICont(t,(UBYTE *)"indentspace") == 0 ) {
525 			*s = c;
526 			while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
527 			if ( *s ) {
528 				i = 0;
529 				while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ - '0'; }
530 				if ( *s ) {
531 					MesPrint("&Unrecognized option in ON IndentSpace statement: %s",t);
532 					return(-1);
533 				}
534 				if ( i > 40 ) {
535 					Warning("IndentSpace parameter adjusted to 40");
536 					i = 40;
537 				}
538 				AO.IndentSpace = i;
539 			}
540 			else {
541 				AO.IndentSpace = AM.ggIndentSpace;
542 			}
543 			return(0);
544 		}
545 		else if ( ( StrICont(t,(UBYTE *)"fewerstats") == 0 ) ||
546 		          ( StrICont(t,(UBYTE *)"fewerstatistics") == 0 ) ) {
547 			*s = c;
548 			while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
549 			if ( *s ) {
550 				i = 0;
551 				while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ - '0'; }
552 				if ( *s ) {
553 					MesPrint("&Unrecognized option in ON FewerStatistics statement: %s",t);
554 					return(-1);
555 				}
556 				if ( i > AM.S0->MaxPatches ) {
557 					if ( AC.WarnFlag )
558 					MesPrint("&Warning: FewerStatistics parameter greater than MaxPatches(=%d). Adjusted to %d"
559 					,AM.S0->MaxPatches,(AM.S0->MaxPatches+1)/2);
560 					i = (AM.S0->MaxPatches+1)/2;
561 				}
562 				AC.ShortStatsMax = i;
563 			}
564 			else {
565 				AC.ShortStatsMax = 10; /* default value */
566 			}
567 			return(0);
568 		}
569 		else if ( StrICont(t,(UBYTE *)"threads") == 0 ) {
570 			if ( AM.totalnumberofthreads > 1 ) AS.MultiThreaded = 1;
571 		}
572 		else if ( StrICont(t,(UBYTE *)"flag") == 0 ) {
573 			*s = c;
574 			return(CoFlags(s,1));
575 		}
576 		else if ( StrICont(t,(UBYTE *)"innertest") == 0 ) {
577 			UBYTE *t;
578 			*s = c;
579 			while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
580 			if ( *s ) {
581 				t = s; while ( *t ) t++;
582 				while ( t[-1] == ' ' || t[-1] == '\t' ) t--;
583 				c = *t; *t = 0;
584 				if ( AC.TestValue ) M_free(AC.TestValue,"InnerTest");
585 				AC.TestValue = strDup1(s,"InnerTest");
586 				*t = c;
587 				s = t;
588 				while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
589 			}
590 			else {
591 				if ( AC.TestValue ) {
592 					M_free(AC.TestValue,"InnerTest");
593 					AC.TestValue = 0;
594 				}
595 			}
596 		}
597 		else { *s = c; }
598 	 	*onoffoptions[i].var = onoffoptions[i].type;
599 		AR.SortType = AC.SortType;
600 		AC.mparallelflag = AC.parallelflag | AM.hparallelflag;
601 	}
602 }
603 
604 /*
605   	#] CoOn :
606   	#[ CoInsideFirst :
607 */
608 
CoInsideFirst(UBYTE * s)609 int CoInsideFirst(UBYTE *s) { return(setonoff(s,&AC.insidefirst,1,0)); }
610 
611 /*
612   	#] CoInsideFirst :
613   	#[ CoProperCount :
614 */
615 
CoProperCount(UBYTE * s)616 int CoProperCount(UBYTE *s) { return(setonoff(s,&AC.BottomLevel,1,0)); }
617 
618 /*
619   	#] CoProperCount :
620   	#[ CoDelete :
621 */
622 
CoDelete(UBYTE * s)623 int CoDelete(UBYTE *s)
624 {
625 	int error = 0;
626 	if ( StrICmp(s,(UBYTE *)"storage") == 0 ) {
627 		if ( DeleteStore(1) < 0 ) {
628 			MesPrint("&Cannot restart storage file");
629 			error = 1;
630 		}
631 	}
632 	else {
633 		UBYTE *t = s, c;
634 		while ( *t && *t != ',' && *t != '>' ) t++;
635 		c = *t; *t = 0;
636 		if ( ( StrICmp(s,(UBYTE *)"extrasymbols") == 0 )
637 		|| ( StrICmp(s,(UBYTE *)"extrasymbol") == 0 ) ) {
638 			WORD x = 0;
639 /*
640 			Either deletes all extra symbols or deletes above a given number
641 */
642 			*t = c; s = t;
643 			if ( *s == '>' ) {
644 				s++;
645 				if ( FG.cTable[*s] != 1 ) goto unknown;
646 				while ( *s <= '9' && *s >= '0' ) x = 10*x + *s++ - '0';
647 				if ( *s ) goto unknown;
648 			}
649 			else if ( *s ) goto unknown;
650 			if ( x < AM.gnumextrasym ) x = AM.gnumextrasym;
651 			PruneExtraSymbols(x);
652 		}
653 		else {
654 			*t = c;
655 unknown:
656 			MesPrint("&Unknown option: %s",s);
657 			error = 1;
658 		}
659 	}
660 	return(error);
661 }
662 
663 /*
664   	#] CoDelete :
665   	#[ CoFormat :
666 */
667 
CoFormat(UBYTE * s)668 int CoFormat(UBYTE *s)
669 {
670 	int error = 0, x;
671 	KEYWORD *key;
672 	UBYTE *ss;
673 	while ( *s == ' ' || *s == ',' ) s++;
674 	if ( *s == 0 ) {
675 		AC.OutputMode = 72;
676 		AC.OutputSpaces = NORMALFORMAT;
677 		return(error);
678 	}
679 /*
680 	First the optimization level
681 */
682 	if ( *s == 'O' || *s == 'o' ) {
683 		if ( ( FG.cTable[s[1]] == 1 ) ||
684 			 ( s[1] == '=' && FG.cTable[s[2]] == 1 ) ) {
685 			s++; if ( *s == '=' ) s++;
686 			x = 0;
687 			while ( *s >= '0' && *s <= '9' ) x = 10*x + *s++ - '0';
688 			while ( *s == ',' ) s++;
689 			AO.OptimizationLevel = x;
690 			AO.Optimize.greedytimelimit = 0;
691 			AO.Optimize.mctstimelimit = 0;
692 			AO.Optimize.printstats = 0;
693 			AO.Optimize.debugflags = 0;
694 			AO.Optimize.schemeflags = 0;
695 			AO.Optimize.mctsdecaymode = 1; // default is decreasing C_p with iteration number
696 			if ( AO.inscheme ) {
697 				M_free(AO.inscheme,"Horner input scheme");
698 				AO.inscheme = 0; AO.schemenum = 0;
699 			}
700 			switch ( x ) {
701 				case 0:
702 					break;
703 				case 1:
704 					AO.Optimize.mctsconstant.fval = -1.0;
705 					AO.Optimize.horner = O_OCCURRENCE;
706 					AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
707 					AO.Optimize.method = O_CSE;
708 					break;
709 				case 2:
710 					AO.Optimize.horner = O_OCCURRENCE;
711 					AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
712 					AO.Optimize.method = O_GREEDY;
713 					AO.Optimize.greedyminnum = 10;
714 					AO.Optimize.greedymaxperc = 5;
715 					break;
716 				case 3:
717 					AO.Optimize.mctsconstant.fval = 1.0;
718 					AO.Optimize.horner = O_MCTS;
719 					AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
720 					AO.Optimize.method = O_GREEDY;
721 					AO.Optimize.mctsnumexpand = 1000;
722 					AO.Optimize.mctsnumkeep = 10;
723 					AO.Optimize.mctsnumrepeat = 1;
724 					AO.Optimize.greedyminnum = 10;
725 					AO.Optimize.greedymaxperc = 5;
726 					break;
727 				case 4:
728 					AO.Optimize.horner = O_SIMULATED_ANNEALING;
729 					AO.Optimize.saIter = 1000;
730 					AO.Optimize.saMaxT.fval = 2000;
731 					AO.Optimize.saMinT.fval = 1;
732 					break;
733 				default:
734 					error = 1;
735 					MesPrint("&Illegal optimization specification in format statement");
736 					break;
737 			}
738 			if ( error == 0 && *s != 0 && x > 0 ) return(CoOptimizeOption(s));
739 			return(error);
740 		}
741 #ifdef EXPOPT
742 		{ UBYTE c;
743 		ss = s;
744 		while ( FG.cTable[*s] == 0 ) s++;
745 		c = *s; *s = 0;
746 		if ( StrICont(ss,(UBYTE *)"optimize") == 0 ) {
747 			*s = c;
748 			while ( *s == ',' ) s++;
749 			if ( *s == '=' ) s++;
750 			AO.OptimizationLevel = 3;
751 			AO.Optimize.mctsconstant.fval = 1.0;
752 			AO.Optimize.horner = O_MCTS;
753 			AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
754 			AO.Optimize.method = O_GREEDY;
755 			AO.Optimize.mctstimelimit = 0;
756 			AO.Optimize.mctsnumexpand = 1000;
757 			AO.Optimize.mctsnumkeep = 10;
758 			AO.Optimize.mctsnumrepeat = 1;
759 			AO.Optimize.greedytimelimit = 0;
760 			AO.Optimize.greedyminnum = 10;
761 			AO.Optimize.greedymaxperc = 5;
762 			AO.Optimize.printstats = 0;
763 			AO.Optimize.debugflags = 0;
764 			AO.Optimize.schemeflags = 0;
765 			AO.Optimize.mctsdecaymode = 1;
766 			if ( AO.inscheme ) {
767 				M_free(AO.inscheme,"Horner input scheme");
768 				AO.inscheme = 0; AO.schemenum = 0;
769 			}
770 			return(CoOptimizeOption(s));
771 		}
772 		else {
773 			error = 1;
774 			MesPrint("&Illegal optimization specification in format statement");
775 			return(error);
776 		}
777 		}
778 #endif
779 	}
780 	else if ( FG.cTable[*s] == 1 ) {
781 		x = 0;
782 		while ( FG.cTable[*s] == 1 ) x = 10*x + *s++ - '0';
783 		if ( x <= 0 || x >= MAXLINELENGTH ) {
784 			x = 72;
785 			error = 1;
786 			MesPrint("&Illegal value for linesize: %d",x);
787 		}
788 		if ( x < 39 ) {
789 			MesPrint(" ... Too small value for linesize corrected to 39");
790 			x = 39;
791 		}
792 		AO.DoubleFlag = 0;
793 /*
794 		The next line resets the mode to normal. Because the special modes
795 		reset the line length we have a little problem with the special modes
796 		and customized line length. We try to improve by removing the next line
797 */
798 /*		AC.OutputMode = 0;  */
799 		AC.LineLength = x;
800 		if ( *s != 0 ) {
801 			error = 1;
802 			MesPrint("&Illegal linesize field in format statement");
803 		}
804 	}
805 	else {
806 		key = FindKeyWord(s,formatoptions,
807 			sizeof(formatoptions)/sizeof(KEYWORD));
808 		if ( key ) {
809 			if ( key->flags == 0 ) {
810 				if ( key->type == FORTRANMODE || key->type == PFORTRANMODE
811 				|| key->type == DOUBLEFORTRANMODE
812 				|| key->type == QUADRUPLEFORTRANMODE || key->type == VORTRANMODE ) {
813 					AC.IsFortran90 = ISNOTFORTRAN90;
814 					if ( AC.Fortran90Kind ) {
815 						M_free(AC.Fortran90Kind,"Fortran90 Kind");
816 						AC.Fortran90Kind = 0;
817 					}
818 				}
819 				AO.DoubleFlag = 0;
820 				AC.OutputMode = key->type & NODOUBLEMASK;
821 				if ( ( key->type & DOUBLEPRECISIONFLAG ) != 0 ) {
822 					AO.DoubleFlag = 1;
823 				}
824 				else if ( ( key->type & QUADRUPLEPRECISIONFLAG ) != 0 ) {
825 					AO.DoubleFlag = 2;
826 				}
827 			}
828 			else if ( key->flags == 1 ) {
829 				AC.OutputMode = AC.OutNumberType = key->type;
830 			}
831 			else if ( key->flags == 2 ) {
832 				while ( FG.cTable[*s] == 0 ) s++;
833 				if ( *s == 0 ) AC.OutNumberType = 10;
834 				else if ( *s == ',' ) {
835 					s++;
836 					x = 0;
837 					while ( FG.cTable[*s] == 1 ) x = 10*x + *s++ - '0';
838 					if ( *s != 0 ) {
839 						error = 1;
840 						MesPrint("&Illegal float format specifier");
841 					}
842 					else {
843 						if ( x < 3 ) {
844 							x = 3;
845 							MesPrint("& ... float format value corrected to 3");
846 						}
847 						if ( x > 100 ) {
848 							x = 100;
849 							MesPrint("& ... float format value corrected to 100");
850 						}
851 						AC.OutNumberType = x;
852 					}
853 				}
854 			}
855 			else if ( key->flags == 3 ) {
856 				AC.OutputSpaces = key->type;
857 			}
858 			else if ( key->flags == 4 ) {
859 				AC.IsFortran90 = ISFORTRAN90;
860 				if ( AC.Fortran90Kind ) {
861 					M_free(AC.Fortran90Kind,"Fortran90 Kind");
862 					AC.Fortran90Kind = 0;
863 				}
864 				while ( FG.cTable[*s] <= 1 ) s++;
865 				if ( *s == ',' ) {
866 					s++; ss = s;
867 					while ( *ss && *ss != ',' ) ss++;
868 					if ( *ss == ',' ) {
869 						MesPrint("&No white space or comma's allowed in Fortran90 option: %s",s); error = 1;
870 					}
871 					else {
872 						AC.Fortran90Kind = strDup1(s,"Fortran90 Kind");
873 					}
874 				}
875 				AO.DoubleFlag = 0;
876 				AC.OutputMode = key->type & NODOUBLEMASK;
877 			}
878 		}
879 		else if ( ( *s == 'c' || *s == 'C' ) && ( FG.cTable[s[1]] == 1 ) ) {
880 			UBYTE *ss = s+1;
881 			WORD x = 0;
882 			while ( *ss >= '0' && *ss <= '9' ) x = 10*x + *ss++ - '0';
883 			if ( *ss != 0 ) goto Unknown;
884 			AC.OutputMode = CMODE;
885 			AC.Cnumpows = x;
886 		}
887 		else {
888 Unknown:	MesPrint("&Unknown option: %s",s); error = 1;
889 		}
890 		AC.LineLength = 72;
891 	}
892 	return(error);
893 }
894 
895 /*
896   	#] CoFormat :
897   	#[ CoKeep :
898 */
899 
CoKeep(UBYTE * s)900 int CoKeep(UBYTE *s)
901 {
902 	if ( StrICmp(s,(UBYTE *)"brackets") == 0 ) AC.ComDefer = 1;
903 	else { MesPrint("&Unknown option: '%s'",s); return(1); }
904 	return(0);
905 }
906 
907 /*
908   	#] CoKeep :
909   	#[ CoFixIndex :
910 */
911 
CoFixIndex(UBYTE * s)912 int CoFixIndex(UBYTE *s)
913 {
914 	int x, y, error = 0;
915 	while ( *s ) {
916 		if ( FG.cTable[*s] != 1 ) {
917 proper:		MesPrint("&Proper syntax is: FixIndex,number:value[,number,value];");
918 			return(1);
919 		}
920 		ParseNumber(x,s)
921 		if ( *s != ':' ) goto proper;
922 		s++;
923 		if ( *s != '-' && *s != '+' && FG.cTable[*s] != 1 ) goto proper;
924 		ParseSignedNumber(y,s)
925 		if ( *s && *s != ',' ) goto proper;
926 		while ( *s == ',' ) s++;
927 		if ( x >= AM.OffsetIndex ) {
928 			MesPrint("&Fixed index out of allowed range. Change ConstIndex in setup file?");
929 			MesPrint("&Current value of ConstIndex = %d",AM.OffsetIndex-1);
930 			error = 1;
931 		}
932 		if ( y != (int)((WORD)y) ) {
933 			MesPrint("&Value of d_(%d,%d) outside range for this computer",x,x);
934 			error = 1;
935 		}
936 		if ( error == 0 ) AC.FixIndices[x] = y;
937 	}
938 	return(error);
939 }
940 
941 /*
942   	#] CoFixIndex :
943   	#[ CoMetric :
944 */
945 
CoMetric(UBYTE * s)946 int CoMetric(UBYTE *s)
947 { DUMMYUSE(s); MesPrint("&The metric statement does not do anything yet"); return(1); }
948 
949 /*
950   	#] CoMetric :
951   	#[ DoPrint :
952 */
953 
DoPrint(UBYTE * s,int par)954 int DoPrint(UBYTE *s, int par)
955 {
956 	int i, error = 0, numdol = 0, type;
957 	WORD handle = -1;
958 	UBYTE *name, c, *t;
959 	EXPRESSIONS e;
960 	WORD numexpr, tofile = 0, *w, par2 = 0;
961 	CBUF *C = cbuf + AC.cbufnum;
962 	while ( *s == ',' ) s++;
963 	if ( ( *s == '+' || *s == '-' ) && ( s[1] == 'f' || s[1] == 'F' ) ) {
964 		t = s + 2; while ( *t == ' ' || *t == ',' ) t++;
965 		if ( *t == '"' ) {
966 			if ( *s == '+' ) { tofile = 1; handle = AC.LogHandle; }
967 			s = t;
968 		}
969 	}
970 	else if ( *s == '<' ) {
971 		UBYTE *filename;
972 		s++; filename = s;
973 		while ( *s && *s != '>' ) s++;
974 		if ( *s == 0 ) {
975 			MesPrint("&Improper filename in print statement");
976 			return(1);
977 		}
978 		*s++ = 0;
979 		tofile = 1;
980 		if ( ( handle = GetChannel((char *)filename,1) ) < 0 ) return(1);
981 		SKIPBLANKS(s) if ( *s == ',' ) s++; SKIPBLANKS(s)
982 		if ( *s == '+' && ( s[1] == 's' || s[1] == 'S' ) ) {
983 			s += 2;
984 			par2 |= PRINTONETERM;
985 			if ( *s == 's' || *s == 'S' ) {
986 				s++;
987 				par2 |= PRINTONEFUNCTION;
988 				if ( *s == 's' || *s == 'S' ) {
989 					s++;
990 					par2 |= PRINTALL;
991 				}
992 			}
993 			SKIPBLANKS(s) if ( *s == ',' ) s++; SKIPBLANKS(s)
994 		}
995 	}
996 	if ( par == PRINTON && *s == '"' ) {
997 		WORD code[3];
998 		if ( tofile == 1 ) code[0] = TYPEFPRINT;
999 		else code[0] = TYPEPRINT;
1000 		code[1] = handle;
1001 		code[2] = par2;
1002 		s++; name = s;
1003 		while ( *s && *s != '"' ) {
1004 			if ( *s == '\\' ) s++;
1005 			if ( *s == '%' && s[1] == '$' ) numdol++;
1006 			s++;
1007 		}
1008 		if ( *s != '"' ) {
1009 			MesPrint("&String in print statement should be enclosed in \"");
1010 			return(1);
1011 		}
1012 		*s = 0;
1013 		AddComString(3,code,name,1);
1014 		*s++ = '"';
1015 		while ( *s == ',' ) {
1016 			s++;
1017 			if ( *s == '$' ) {
1018 				s++; name = s; while ( FG.cTable[*s] <= 1 ) s++;
1019 				c = *s; *s = 0;
1020 				type = GetName(AC.dollarnames,name,&numexpr,NOAUTO);
1021 				if ( type == NAMENOTFOUND ) {
1022 					MesPrint("&$ variable %s not (yet) defined",name);
1023 					error = 1;
1024 				}
1025 				else {
1026 					C->lhs[C->numlhs][1] += 2;
1027 					*(C->Pointer)++ = DOLLAREXPRESSION;
1028 					*(C->Pointer)++ = numexpr;
1029 					numdol--;
1030 				}
1031 			}
1032 			else {
1033 				MesPrint("&Illegal object in print statement");
1034 				error = 1;
1035 				return(error);
1036 			}
1037 			*s = c;
1038 			if ( c == '[' ) {
1039 				w = C->Pointer;
1040 				s++;
1041 				s = GetDoParam(s,&(C->Pointer),-1);
1042 				if ( s == 0 ) return(1);
1043 				if ( *s != ']' ) {
1044 					MesPrint("&unmatched [] in $ factor");
1045 					return(1);
1046 				}
1047 				C->lhs[C->numlhs][1] += C->Pointer - w;
1048 				s++;
1049 			}
1050 		}
1051 		if ( *s != 0 ) {
1052 			MesPrint("&Illegal object in print statement");
1053 			error = 1;
1054 		}
1055 		if ( numdol > 0 ) {
1056 			MesPrint("&More $ variables asked for than provided");
1057 			error = 1;
1058 		}
1059 		*(C->Pointer)++ = 0;
1060 		return(error);
1061 	}
1062 	if ( *s == 0 ) {	/* All active expressions */
1063 AllExpr:
1064 		for ( e = Expressions, i = NumExpressions; i > 0; i--, e++ ) {
1065             if ( e->status == LOCALEXPRESSION || e->status ==
1066             GLOBALEXPRESSION || e->status == UNHIDELEXPRESSION
1067 			|| e->status == UNHIDEGEXPRESSION ) e->printflag = par;
1068         }
1069 		return(error);
1070 	}
1071 	while ( *s ) {
1072 		if ( *s == '+' ) {
1073 			s++;
1074 			if ( tolower(*s) == 'f' ) par |= PRINTLFILE;
1075 			else if ( tolower(*s) == 's' ) {
1076 				if ( tolower(s[1]) == 's' ) {
1077 					if ( tolower(s[2]) == 's' ) {
1078 						par |= PRINTONEFUNCTION | PRINTONETERM | PRINTALL;
1079 						s++;
1080 					}
1081 					else if ( ( par & 3 ) < 2 ) par |= PRINTONEFUNCTION | PRINTONETERM;
1082 					s++;
1083 				}
1084 				else {
1085 					if ( ( par & 3 ) < 2 ) par |= PRINTONETERM;
1086 				}
1087 			}
1088 			else {
1089 illeg:				MesPrint("&Illegal option in (n)print statement");
1090 				error = 1;
1091 			}
1092 			s++;
1093 			if ( *s == 0 ) goto AllExpr;
1094 		}
1095 		else if ( *s == '-' ) {
1096 			s++;
1097 			if ( tolower(*s) == 'f' ) par &= ~PRINTLFILE;
1098 			else if ( tolower(*s) == 's' ) {
1099 				if ( tolower(s[1]) == 's' ) {
1100 					if ( tolower(s[2]) == 's' ) {
1101 						par &= ~PRINTALL;
1102 						s++;
1103 					}
1104 					else if ( ( par & 3 ) < 2 ) {
1105 						par &= ~PRINTONEFUNCTION;
1106 						par &= ~PRINTALL;
1107 					}
1108 					s++;
1109 				}
1110 				else {
1111 					if ( ( par & 3 ) < 2 ) {
1112 						par &= ~PRINTONETERM;
1113 						par &= ~PRINTONEFUNCTION;
1114 						par &= ~PRINTALL;
1115 					}
1116 				}
1117 			}
1118 			else goto illeg;
1119 			s++;
1120 			if ( *s == 0 ) goto AllExpr;
1121 		}
1122 		else if ( FG.cTable[*s] == 0 || *s == '[' ) {
1123 			name = s;
1124 			if ( ( s = SkipAName(s) ) == 0 ) {
1125 				MesPrint("&Improper name in (n)print statement");
1126 				return(1);
1127 			}
1128 			c = *s; *s = 0;
1129 			if ( ( GetName(AC.exprnames,name,&numexpr,NOAUTO) == CEXPRESSION )
1130 			&& ( Expressions[numexpr].status == LOCALEXPRESSION
1131 			|| Expressions[numexpr].status == GLOBALEXPRESSION ) ) {
1132 FoundExpr:;
1133 				if ( c == '[' && s[1] == ']' ) {
1134 					Expressions[numexpr].printflag = par | PRINTCONTENTS;
1135 					*s++ = c; c = *++s;
1136 				}
1137 				else
1138 					Expressions[numexpr].printflag = par;
1139 			}
1140 			else if ( GetLastExprName(name,&numexpr)
1141 			&& ( Expressions[numexpr].status == LOCALEXPRESSION
1142 			|| Expressions[numexpr].status == GLOBALEXPRESSION
1143 			|| Expressions[numexpr].status == UNHIDELEXPRESSION
1144 			|| Expressions[numexpr].status == UNHIDEGEXPRESSION
1145 			) ) {
1146 				goto FoundExpr;
1147 			}
1148 			else {
1149 				MesPrint("&%s is not the name of an active expression",name);
1150 				error = 1;
1151 			}
1152 			*s++ = c;
1153 			if ( c == 0 ) return(0);
1154 			if ( c == '-' || c == '+' ) s--;
1155 		}
1156 		else if ( *s == ',' ) s++;
1157 		else {
1158 			MesPrint("&Illegal object in (n)print statement");
1159 			return(1);
1160 		}
1161 	}
1162 	return(0);
1163 }
1164 
1165 /*
1166   	#] DoPrint :
1167   	#[ CoPrint :
1168 */
1169 
CoPrint(UBYTE * s)1170 int CoPrint(UBYTE *s) { return(DoPrint(s,PRINTON)); }
1171 
1172 /*
1173   	#] CoPrint :
1174   	#[ CoPrintB :
1175 */
1176 
CoPrintB(UBYTE * s)1177 int CoPrintB(UBYTE *s) { return(DoPrint(s,PRINTCONTENT)); }
1178 
1179 /*
1180   	#] CoPrintB :
1181   	#[ CoNPrint :
1182 */
1183 
CoNPrint(UBYTE * s)1184 int CoNPrint(UBYTE *s) { return(DoPrint(s,PRINTOFF)); }
1185 
1186 /*
1187   	#] CoNPrint :
1188   	#[ CoPushHide :
1189 */
1190 
CoPushHide(UBYTE * s)1191 int CoPushHide(UBYTE *s)
1192 {
1193 	GETIDENTITY
1194 	WORD *ScratchBuf;
1195 	int i;
1196 	if ( AR.Fscr[2].PObuffer == 0 ) {
1197 		ScratchBuf = (WORD *)Malloc1(AM.HideSize*sizeof(WORD),"hidesize");
1198 		AR.Fscr[2].POsize = AM.HideSize * sizeof(WORD);
1199 		AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1200 		AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1201 		PUTZERO(AR.Fscr[2].POposition);
1202 	}
1203 	while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
1204 	AC.HideLevel += 2;
1205 	if ( *s ) {
1206 		MesPrint("&PushHide statement should have no arguments");
1207 		return(-1);
1208 	}
1209 	for ( i = 0; i < NumExpressions; i++ ) {
1210 		switch ( Expressions[i].status ) {
1211 			case DROPLEXPRESSION:
1212 	        case SKIPLEXPRESSION:
1213 	        case LOCALEXPRESSION:
1214 				Expressions[i].status = HIDELEXPRESSION;
1215 				Expressions[i].hidelevel = AC.HideLevel-1;
1216 	            break;
1217 			case DROPGEXPRESSION:
1218 	        case SKIPGEXPRESSION:
1219 	        case GLOBALEXPRESSION:
1220 				Expressions[i].status = HIDEGEXPRESSION;
1221 				Expressions[i].hidelevel = AC.HideLevel-1;
1222 	            break;
1223 	        default:
1224 	            break;
1225 		}
1226 	}
1227 	return(0);
1228 }
1229 
1230 /*
1231   	#] CoPushHide :
1232   	#[ CoPopHide :
1233 */
1234 
CoPopHide(UBYTE * s)1235 int CoPopHide(UBYTE *s)
1236 {
1237 	int i;
1238 	while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
1239 	if ( AC.HideLevel <= 0 ) {
1240 		MesPrint("&PopHide statement without corresponding PushHide statement");
1241 		return(-1);
1242 	}
1243 	AC.HideLevel -= 2;
1244 	if ( *s ) {
1245 		MesPrint("&PopHide statement should have no arguments");
1246 		return(-1);
1247 	}
1248 	for ( i = 0; i < NumExpressions; i++ ) {
1249 		switch ( Expressions[i].status ) {
1250 	        case HIDDENLEXPRESSION:
1251 				if ( Expressions[i].hidelevel > AC.HideLevel )
1252 					Expressions[i].status = UNHIDELEXPRESSION;
1253 	            break;
1254 	        case HIDDENGEXPRESSION:
1255 				if ( Expressions[i].hidelevel > AC.HideLevel )
1256 					Expressions[i].status = UNHIDEGEXPRESSION;
1257 	            break;
1258 	        default:
1259 	            break;
1260 		}
1261 	}
1262 	return(0);
1263 }
1264 
1265 /*
1266   	#] CoPopHide :
1267   	#[ SetExprCases :
1268 */
1269 
SetExprCases(int par,int setunset,int val)1270 int SetExprCases(int par, int setunset, int val)
1271 {
1272 	switch ( par ) {
1273 		case SKIP:
1274 			switch ( val ) {
1275 		        case SKIPLEXPRESSION:
1276 					if ( !setunset ) val = LOCALEXPRESSION;
1277 		            break;
1278 		        case SKIPGEXPRESSION:
1279 					if ( !setunset ) val = GLOBALEXPRESSION;
1280 		            break;
1281 		        case LOCALEXPRESSION:
1282 					if ( setunset ) val = SKIPLEXPRESSION;
1283 		            break;
1284 		        case GLOBALEXPRESSION:
1285 					if ( setunset ) val = SKIPGEXPRESSION;
1286 		            break;
1287 		        case INTOHIDEGEXPRESSION:
1288 		        case INTOHIDELEXPRESSION:
1289 		        default:
1290 		            break;
1291 			}
1292 			break;
1293 		case DROP:
1294 			switch ( val ) {
1295 		        case SKIPLEXPRESSION:
1296 		        case LOCALEXPRESSION:
1297 		        case HIDELEXPRESSION:
1298 					if ( setunset ) val = DROPLEXPRESSION;
1299 		            break;
1300 		        case DROPLEXPRESSION:
1301 					if ( !setunset ) val = LOCALEXPRESSION;
1302 		            break;
1303 		        case SKIPGEXPRESSION:
1304 		        case GLOBALEXPRESSION:
1305 		        case HIDEGEXPRESSION:
1306 					if ( setunset ) val = DROPGEXPRESSION;
1307 		            break;
1308 		        case DROPGEXPRESSION:
1309 					if ( !setunset ) val = GLOBALEXPRESSION;
1310 		            break;
1311 		        case HIDDENLEXPRESSION:
1312 				case UNHIDELEXPRESSION:
1313 					if ( setunset ) val = DROPHLEXPRESSION;
1314 		            break;
1315 		        case HIDDENGEXPRESSION:
1316 				case UNHIDEGEXPRESSION:
1317 					if ( setunset ) val = DROPHGEXPRESSION;
1318 		            break;
1319 		        case DROPHLEXPRESSION:
1320 					if ( !setunset ) val = HIDDENLEXPRESSION;
1321 		            break;
1322 		        case DROPHGEXPRESSION:
1323 					if ( !setunset ) val = HIDDENGEXPRESSION;
1324 		            break;
1325 		        case INTOHIDEGEXPRESSION:
1326 		        case INTOHIDELEXPRESSION:
1327 		        default:
1328 		            break;
1329 			}
1330 			break;
1331 		case HIDE:
1332 			switch ( val ) {
1333 				case DROPLEXPRESSION:
1334 		        case SKIPLEXPRESSION:
1335 		        case LOCALEXPRESSION:
1336 					if ( setunset ) val = HIDELEXPRESSION;
1337 		            break;
1338 		        case HIDELEXPRESSION:
1339 					if ( !setunset ) val = LOCALEXPRESSION;
1340 		            break;
1341 				case DROPGEXPRESSION:
1342 		        case SKIPGEXPRESSION:
1343 		        case GLOBALEXPRESSION:
1344 					if ( setunset ) val = HIDEGEXPRESSION;
1345 		            break;
1346 		        case HIDEGEXPRESSION:
1347 					if ( !setunset ) val = GLOBALEXPRESSION;
1348 		            break;
1349 		        case INTOHIDEGEXPRESSION:
1350 		        case INTOHIDELEXPRESSION:
1351 		        default:
1352 		            break;
1353 			}
1354 			break;
1355 		case UNHIDE:
1356 			switch ( val ) {
1357 		        case HIDDENLEXPRESSION:
1358 		        case DROPHLEXPRESSION:
1359 					if ( setunset ) val = UNHIDELEXPRESSION;
1360 		            break;
1361 				case UNHIDELEXPRESSION:
1362 					if ( !setunset ) val = HIDDENLEXPRESSION;
1363 		            break;
1364 		        case HIDDENGEXPRESSION:
1365 		        case DROPHGEXPRESSION:
1366 					if ( setunset ) val = UNHIDEGEXPRESSION;
1367 		            break;
1368 				case UNHIDEGEXPRESSION:
1369 					if ( !setunset ) val = HIDDENGEXPRESSION;
1370 		            break;
1371 		        case INTOHIDEGEXPRESSION:
1372 		        case INTOHIDELEXPRESSION:
1373 		        default:
1374 		            break;
1375 			}
1376 			break;
1377 		case INTOHIDE:
1378 			switch ( val ) {
1379 		        case HIDDENLEXPRESSION:
1380 		        case HIDDENGEXPRESSION:
1381 					MesPrint("&Expression is already hidden");
1382 					return(-1);
1383 		        case DROPHLEXPRESSION:
1384 		        case DROPHGEXPRESSION:
1385 				case UNHIDELEXPRESSION:
1386 				case UNHIDEGEXPRESSION:
1387 					MesPrint("&Cannot unhide and put intohide expression in the same module");
1388 					return(-1);
1389 				case LOCALEXPRESSION:
1390 				case DROPLEXPRESSION:
1391 		        case SKIPLEXPRESSION:
1392 				case HIDELEXPRESSION:
1393 					if ( setunset ) val = INTOHIDELEXPRESSION;
1394 					break;
1395 				case GLOBALEXPRESSION:
1396 				case DROPGEXPRESSION:
1397 		        case SKIPGEXPRESSION:
1398 				case HIDEGEXPRESSION:
1399 					if ( setunset ) val = INTOHIDEGEXPRESSION;
1400 					break;
1401 		        default:
1402 		            break;
1403 			}
1404 			break;
1405 		default:
1406 			break;
1407 	}
1408 	return(val);
1409 }
1410 
1411 /*
1412   	#] SetExprCases :
1413   	#[ SetExpr :
1414 */
1415 
SetExpr(UBYTE * s,int setunset,int par)1416 int SetExpr(UBYTE *s, int setunset, int par)
1417 {
1418 	WORD *w, numexpr;
1419 	int error = 0, i;
1420 	UBYTE *name, c;
1421 	if ( *s == 0 && ( par != INTOHIDE ) ) {
1422 		for ( i = 0; i < NumExpressions; i++ ) {
1423 			w = &(Expressions[i].status);
1424 			*w = SetExprCases(par,setunset,*w);
1425 			if ( *w < 0 ) error = 1;
1426 			if ( par == HIDE && setunset == 1 )
1427 				Expressions[i].hidelevel = AC.HideLevel;
1428 		}
1429 		return(0);
1430 	}
1431 	while ( *s ) {
1432 		if ( *s == ',' ) { s++; continue; }
1433 		if ( *s == '0' ) { s++; continue; }
1434 		name = s;
1435 		if ( ( s = SkipAName(s) ) == 0 ) {
1436 			MesPrint("&Improper name for an expression: '%s'",name);
1437 			return(1);
1438 		}
1439 		c = *s; *s = 0;
1440 		if ( GetName(AC.exprnames,name,&numexpr,NOAUTO) == CEXPRESSION ) {
1441 			w = &(Expressions[numexpr].status);
1442 			*w = SetExprCases(par,setunset,*w);
1443 			if ( *w < 0 ) error = 1;
1444 			if ( ( par == HIDE || par == INTOHIDE ) && setunset == 1 )
1445 				Expressions[numexpr].hidelevel = AC.HideLevel;
1446 		}
1447 		else if ( GetName(AC.varnames,name,&numexpr,NOAUTO) != NAMENOTFOUND ) {
1448 			MesPrint("&%s is not an expression",name);
1449 			error = 1;
1450 		}
1451 		*s = c;
1452 	}
1453 	return(error);
1454 }
1455 
1456 /*
1457   	#] SetExpr :
1458   	#[ CoDrop :
1459 */
1460 
CoDrop(UBYTE * s)1461 int CoDrop(UBYTE *s) { return(SetExpr(s,1,DROP)); }
1462 
1463 /*
1464   	#] CoDrop :
1465   	#[ CoNoDrop :
1466 */
1467 
CoNoDrop(UBYTE * s)1468 int CoNoDrop(UBYTE *s) { return(SetExpr(s,0,DROP)); }
1469 
1470 /*
1471   	#] CoNoDrop :
1472   	#[ CoSkip :
1473 */
1474 
CoSkip(UBYTE * s)1475 int CoSkip(UBYTE *s) { return(SetExpr(s,1,SKIP)); }
1476 
1477 /*
1478   	#] CoSkip :
1479   	#[ CoNoSkip :
1480 */
1481 
CoNoSkip(UBYTE * s)1482 int CoNoSkip(UBYTE *s) { return(SetExpr(s,0,SKIP)); }
1483 
1484 /*
1485   	#] CoNoSkip :
1486   	#[ CoHide :
1487 */
1488 
CoHide(UBYTE * inp)1489 int CoHide(UBYTE *inp) {
1490 	GETIDENTITY
1491 	WORD *ScratchBuf;
1492 	if ( AR.Fscr[2].PObuffer == 0 ) {
1493 		ScratchBuf = (WORD *)Malloc1(AM.HideSize*sizeof(WORD),"hidesize");
1494 		AR.Fscr[2].POsize = AM.HideSize * sizeof(WORD);
1495 		AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1496 		AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1497 		PUTZERO(AR.Fscr[2].POposition);
1498 	}
1499 	return(SetExpr(inp,1,HIDE));
1500 }
1501 
1502 /*
1503   	#] CoHide :
1504   	#[ CoIntoHide :
1505 */
1506 
CoIntoHide(UBYTE * inp)1507 int CoIntoHide(UBYTE *inp) {
1508 	GETIDENTITY
1509 	WORD *ScratchBuf;
1510 	if ( AR.Fscr[2].PObuffer == 0 ) {
1511 		ScratchBuf = (WORD *)Malloc1(AM.HideSize*sizeof(WORD),"hidesize");
1512 		AR.Fscr[2].POsize = AM.HideSize * sizeof(WORD);
1513 		AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1514 		AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1515 		PUTZERO(AR.Fscr[2].POposition);
1516 	}
1517 	return(SetExpr(inp,1,INTOHIDE));
1518 }
1519 
1520 /*
1521   	#] CoIntoHide :
1522   	#[ CoNoHide :
1523 */
1524 
CoNoHide(UBYTE * inp)1525 int CoNoHide(UBYTE *inp) { return(SetExpr(inp,0,HIDE)); }
1526 
1527 /*
1528   	#] CoNoHide :
1529   	#[ CoUnHide :
1530 */
1531 
CoUnHide(UBYTE * inp)1532 int CoUnHide(UBYTE *inp) { return(SetExpr(inp,1,UNHIDE)); }
1533 
1534 /*
1535   	#] CoUnHide :
1536   	#[ CoNoUnHide :
1537 */
1538 
CoNoUnHide(UBYTE * inp)1539 int CoNoUnHide(UBYTE *inp) { return(SetExpr(inp,0,UNHIDE)); }
1540 
1541 /*
1542   	#] CoNoUnHide :
1543   	#[ AddToCom :
1544 */
1545 
AddToCom(int n,WORD * array)1546 void AddToCom(int n, WORD *array)
1547 {
1548 	CBUF *C = cbuf+AC.cbufnum;
1549 #ifdef COMPBUFDEBUG
1550 	MesPrint("  %a",n,array);
1551 #endif
1552 	while ( C->Pointer+n >= C->Top ) DoubleCbuffer(AC.cbufnum,C->Pointer,18);
1553 	while ( --n >= 0 ) *(C->Pointer)++ = *array++;
1554 }
1555 
1556 /*
1557   	#] AddToCom :
1558   	#[ AddComString :
1559 */
1560 
AddComString(int n,WORD * array,UBYTE * thestring,int par)1561 int AddComString(int n, WORD *array, UBYTE *thestring, int par)
1562 {
1563 	CBUF *C = cbuf+AC.cbufnum;
1564 	UBYTE *s = thestring, *w;
1565 #ifdef COMPBUFDEBUG
1566 	WORD *cc;
1567 	UBYTE *ww;
1568 #endif
1569 	int i, numchars = 0, size, zeroes;
1570 	while ( *s ) {
1571 		if ( *s == '\\' ) s++;
1572 		else if ( par == 1 &&
1573 		( ( *s == '%' && s[1] != 't' && s[1] != 'T' && s[1] != '$' &&
1574 		 s[1] != 'w' && s[1] != 'W' && s[1] != 'r' && s[1] != 0 ) || *s == '#'
1575 		|| *s == '@' || *s == '&' ) ) {
1576 			numchars++;
1577 		}
1578 		s++; numchars++;
1579 	}
1580 	AddLHS(AC.cbufnum);
1581 	size = numchars/sizeof(WORD)+1;
1582 	while ( C->Pointer+size+n+2 >= C->Top ) DoubleCbuffer(AC.cbufnum,C->Pointer,19);
1583 #ifdef COMPBUFDEBUG
1584 	cc = C->Pointer;
1585 #endif
1586 	*(C->Pointer)++ = array[0];
1587 	*(C->Pointer)++ = size+n+2;
1588 	for ( i = 1; i < n; i++ ) *(C->Pointer)++ = array[i];
1589 	*(C->Pointer)++ = size;
1590 #ifdef COMPBUFDEBUG
1591 	ww =
1592 #endif
1593 	w = (UBYTE *)(C->Pointer);
1594 	zeroes = size*sizeof(WORD)-numchars;
1595 	s = thestring;
1596 	while ( *s ) {
1597 		if ( *s == '\\' ) s++;
1598 		else if ( par == 1 && ( ( *s == '%' &&
1599 		s[1] != 't' && s[1] != 'T' && s[1] != '$' &&
1600 		s[1] != 'w' && s[1] != 'W' && s[1] != 'r' && s[1] != 0 ) || *s == '#'
1601 		|| *s == '@' || *s == '&' ) ) {
1602 			*w++ = '%';
1603 		}
1604 		*w++ = *s++;
1605 	}
1606 	while ( --zeroes >= 0 ) *w++ = 0;
1607 	C->Pointer += size;
1608 #ifdef COMPBUFDEBUG
1609 	MesPrint("LH: %a",size+1+n,cc);
1610 	MesPrint("        %s",thestring);
1611 #endif
1612 	return(0);
1613 }
1614 
1615 /*
1616   	#] AddComString :
1617   	#[ Add2ComStrings :
1618 */
1619 
Add2ComStrings(int n,WORD * array,UBYTE * string1,UBYTE * string2)1620 int Add2ComStrings(int n, WORD *array, UBYTE *string1, UBYTE *string2)
1621 {
1622 	CBUF *C = cbuf+AC.cbufnum;
1623 	UBYTE *s1 = string1, *s2 = string2, *w;
1624 	int i, num1chars = 0, num2chars = 0, size1, size2, zeroes1, zeroes2;
1625 	AddLHS(AC.cbufnum);
1626 	while ( *s1 ) { s1++; num1chars++; }
1627 	size1 = num1chars/sizeof(WORD)+1;
1628 	if ( s2 ) {
1629 		while ( *s2 ) { s2++; num2chars++; }
1630 		size2 = num2chars/sizeof(WORD)+1;
1631 	}
1632 	else size2 = 0;
1633 	while ( C->Pointer+size1+size2+n+3 >= C->Top ) DoubleCbuffer(AC.cbufnum,C->Pointer,20);
1634 	*(C->Pointer)++ = array[0];
1635 	*(C->Pointer)++ = size1+size2+n+3;
1636 	for ( i = 1; i < n; i++ ) *(C->Pointer)++ = array[i];
1637 	*(C->Pointer)++ = size1;
1638 	w = (UBYTE *)(C->Pointer);
1639 	zeroes1 = size1*sizeof(WORD)-num1chars;
1640 	s1 = string1;
1641 	while ( *s1 ) { *w++ = *s1++; }
1642 	while ( --zeroes1 >= 0 ) *w++ = 0;
1643 	C->Pointer += size1;
1644 	*(C->Pointer)++ = size2;
1645 	if ( size2 ) {
1646 		w = (UBYTE *)(C->Pointer);
1647 		zeroes2 = size2*sizeof(WORD)-num2chars;
1648 		s2 = string2;
1649 		while ( *s2 ) { *w++ = *s2++; }
1650 		while ( --zeroes2 >= 0 ) *w++ = 0;
1651 		C->Pointer += size2;
1652 	}
1653 	return(0);
1654 }
1655 
1656 /*
1657   	#] Add2ComStrings :
1658   	#[ CoDiscard :
1659 */
1660 
CoDiscard(UBYTE * s)1661 int CoDiscard(UBYTE *s)
1662 {
1663 	if ( *s == 0 ) {
1664 		Add2Com(TYPEDISCARD)
1665 		return(0);
1666 	}
1667 	MesPrint("&Illegal argument in discard statement: '%s'",s);
1668 	return(1);
1669 }
1670 
1671 /*
1672   	#] CoDiscard :
1673   	#[ CoContract :
1674 
1675 	Syntax:
1676 		Contract
1677 		Contract:#
1678 		Contract #
1679 		Contract:#,#
1680 */
1681 
1682 static WORD ccarray[5] = { TYPEOPERATION,5,CONTRACT,0,0 };
1683 
CoContract(UBYTE * s)1684 int CoContract(UBYTE *s)
1685 {
1686 	int x;
1687 	if ( *s == ':' ) {
1688 		s++;
1689 		ParseNumber(x,s)
1690 		if ( *s != ',' && *s ) {
1691 proper:		MesPrint("&Illegal number in contract statement");
1692 			return(1);
1693 		}
1694 		if ( *s ) s++;
1695 		ccarray[4] = x;
1696 	}
1697 	else ccarray[4] = 0;
1698 	if ( FG.cTable[*s] == 1 ) {
1699 		ParseNumber(x,s)
1700 		if ( *s ) goto proper;
1701 		ccarray[3] = x;
1702 	}
1703 	else if ( *s ) goto proper;
1704 	else ccarray[3] = -1;
1705 	return(AddNtoL(5,ccarray));
1706 }
1707 
1708 /*
1709   	#] CoContract :
1710   	#[ CoGoTo :
1711 */
1712 
CoGoTo(UBYTE * inp)1713 int CoGoTo(UBYTE *inp)
1714 {
1715 	UBYTE *s = inp;
1716 	int x;
1717 	while ( FG.cTable[*s] <= 1 ) s++;
1718 	if ( *s ) {
1719 		MesPrint("&Label should be an alpha-numeric string");
1720 		return(1);
1721 	}
1722 	x = GetLabel(inp);
1723 	Add3Com(TYPEGOTO,x);
1724 	return(0);
1725 }
1726 
1727 /*
1728   	#] CoGoTo :
1729   	#[ CoLabel :
1730 */
1731 
CoLabel(UBYTE * inp)1732 int CoLabel(UBYTE *inp)
1733 {
1734 	UBYTE *s = inp;
1735 	int x;
1736 	while ( FG.cTable[*s] <= 1 ) s++;
1737 	if ( *s ) {
1738 		MesPrint("&Label should be an alpha-numeric string");
1739 		return(1);
1740 	}
1741 	x = GetLabel(inp);
1742 	if ( AC.Labels[x] >= 0 ) {
1743 		MesPrint("&Label %s defined more than once",AC.LabelNames[x]);
1744 		return(1);
1745 	}
1746 	AC.Labels[x] = cbuf[AC.cbufnum].numlhs;
1747 	return(0);
1748 }
1749 
1750 /*
1751   	#] CoLabel :
1752   	#[ DoArgument :
1753 
1754 	Layout:
1755 		par,full size,numlhs(+1),par,scale
1756 		scale is for normalize
1757 */
1758 
DoArgument(UBYTE * s,int par)1759 int DoArgument(UBYTE *s, int par)
1760 {
1761 	GETIDENTITY
1762 	UBYTE *name, *t, *v, c;
1763 	WORD *oldworkpointer = AT.WorkPointer, *w, *ww, number, *scale;
1764 	int error = 0, zeroflag, type, x;
1765 	AC.lhdollarflag = 0;
1766 	while ( *s == ',' ) s++;
1767 	w = AT.WorkPointer;
1768 	*w++ = par;
1769 	w++;
1770 	switch ( par ) {
1771 		case TYPEARG:
1772 	        if ( AC.arglevel >= MAXNEST ) {
1773     	        MesPrint("@Nesting of argument statements more than %d levels"
1774         	    ,(WORD)MAXNEST);
1775             	return(-1);
1776 	        }
1777 			AC.argsumcheck[AC.arglevel] = NestingChecksum();
1778         	AC.argstack[AC.arglevel] = cbuf[AC.cbufnum].Pointer
1779 			                       - cbuf[AC.cbufnum].Buffer + 2;
1780 			AC.arglevel++;
1781 	        *w++ = cbuf[AC.cbufnum].numlhs;
1782 			break;
1783 		case TYPENORM:
1784 		case TYPENORM4:
1785 		case TYPESPLITARG:
1786 		case TYPESPLITFIRSTARG:
1787 		case TYPESPLITLASTARG:
1788 		case TYPEFACTARG:
1789 		case TYPEARGTOEXTRASYMBOL:
1790 	        *w++ = cbuf[AC.cbufnum].numlhs+1;
1791 			break;
1792     }
1793 	*w++ = par;
1794 	scale = w;
1795 	*w++ = 1;
1796 	*w++ = 0;
1797 	if ( *s == '^' ) {
1798 		s++; ParseSignedNumber(x,s)
1799 		while ( *s == ',' ) s++;
1800 		*scale = x;
1801 	}
1802 	if ( *s == '(' ) {
1803 		t = s+1; SKIPBRA3(s)	/* We did check the brackets already */
1804 		if ( par == TYPEARG ) {
1805 			MesPrint("&Illegal () entry in argument statement");
1806 			error = 1; s++; goto skipbracks;
1807 		}
1808 		else if ( par == TYPESPLITFIRSTARG ) {
1809 			MesPrint("&Illegal () entry in splitfirstarg statement");
1810 			error = 1; s++; goto skipbracks;
1811 		}
1812 		else if ( par == TYPESPLITLASTARG ) {
1813 			MesPrint("&Illegal () entry in splitlastarg statement");
1814 			error = 1; s++; goto skipbracks;
1815 		}
1816 		v = t;
1817 		while ( v < s ) {
1818 			if ( *v == '?' ) {
1819 				MesPrint("&Wildcarding not allowed in this type of statement");
1820 				error = 1; break;
1821 			}
1822 			v++;
1823 		}
1824 		v = s++;
1825 		if ( *t == '(' && v[-1] == ')' ) {
1826 			t++; v--;
1827 			if ( par == TYPESPLITARG ) oldworkpointer[0] = TYPESPLITARG2;
1828 			else if ( par == TYPEFACTARG ) oldworkpointer[0] = TYPEFACTARG2;
1829 			else if ( par == TYPENORM4 ) oldworkpointer[0] = TYPENORM4;
1830 			else if ( par == TYPENORM ) {
1831 				if ( *t == '-' ) { oldworkpointer[0] = TYPENORM3; t++; }
1832 				else             { oldworkpointer[0] = TYPENORM2; *scale = 0; }
1833 			}
1834 		}
1835 		if ( error == 0 ) {
1836 			CBUF *C = cbuf+AC.cbufnum;
1837 			WORD oldnumrhs = C->numrhs, oldnumlhs = C->numlhs;
1838 			WORD prototype[SUBEXPSIZE+40]; /* Up to 10 nested sums! */
1839 			WORD *m, *mm;
1840 			int i, retcode;
1841 			LONG oldpointer = C->Pointer - C->Buffer;
1842 			*v = 0;
1843 			prototype[0] = SUBEXPRESSION;
1844 			prototype[1] = SUBEXPSIZE;
1845 			prototype[2] = C->numrhs+1;
1846 			prototype[3] = 1;
1847 			prototype[4] = AC.cbufnum;
1848 			AT.WorkPointer += TYPEARGHEADSIZE+1;
1849 			AddLHS(AC.cbufnum);
1850 			if ( ( retcode = CompileAlgebra(t,LHSIDE,prototype) ) < 0 )
1851 				error = 1;
1852 			else {
1853 				prototype[2] = retcode;
1854 				ww = C->lhs[retcode];
1855 				AC.lhdollarflag = 0;
1856 				if ( *ww == 0 ) {
1857 					*w++ = -2; *w++ = 0;
1858 				}
1859 				else if ( ww[ww[0]] != 0 ) {
1860 					MesPrint("&There should be only one term between ()");
1861 					error = 1;
1862 				}
1863 				else if ( NewSort(BHEAD0) ) { if ( !error ) error = 1; }
1864 				else if ( NewSort(BHEAD0) ) {
1865 					LowerSortLevel();
1866 					if ( !error ) error = 1;
1867 				}
1868 				else {
1869 					AN.RepPoint = AT.RepCount + 1;
1870 			        m = AT.WorkPointer;
1871 					mm = ww; i = *mm;
1872 					while ( --i >= 0 ) *m++ = *mm++;
1873 					mm = AT.WorkPointer; AT.WorkPointer = m;
1874 					AR.Cnumlhs = C->numlhs;
1875 					if ( Generator(BHEAD mm,C->numlhs) ) {
1876 						LowerSortLevel(); error = 1;
1877 					}
1878 					else if ( EndSort(BHEAD mm,0) < 0 ) {
1879 						error = 1;
1880 						AT.WorkPointer = mm;
1881 					}
1882 					else if ( *mm == 0 ) {
1883 						*w++ = -2; *w++ = 0;
1884 						AT.WorkPointer = mm;
1885 					}
1886 					else if ( mm[mm[0]] != 0 ) {
1887 						error = 1;
1888 						AT.WorkPointer = mm;
1889 					}
1890 					else {
1891 						AT.WorkPointer = mm;
1892 						m = mm+*mm;
1893 						if ( par == TYPEFACTARG ) {
1894 							if ( *mm != ABS(m[-1])+1 ) {
1895 								*mm -= ABS(m[-1]);	/* Strip coefficient */
1896 							}
1897 							mm[-1] = -*mm-1; w += *mm+1;
1898 						}
1899 						else {
1900 							*mm -= ABS(m[-1]);	/* Strip coefficient */
1901 /*
1902 							if ( *mm == 1 ) { *w++ = -2; *w++ = 0; }
1903 							else
1904 */
1905 							{ mm[-1] = -*mm-1; w += *mm+1; }
1906 						}
1907 						oldworkpointer[1] = w - oldworkpointer;
1908 					}
1909 					LowerSortLevel();
1910 				}
1911 				oldworkpointer[5] = AC.lhdollarflag;
1912 			}
1913 			*v = ')';
1914 			C->numrhs = oldnumrhs;
1915 			C->numlhs = oldnumlhs;
1916 			C->Pointer = C->Buffer + oldpointer;
1917 		}
1918 	}
1919 skipbracks:
1920 	if ( *s == 0 ) { *w++ = 0; *w++ = 2; *w++ = 1; }
1921 	else {
1922 		do {
1923 			if ( *s == ',' ) { s++; continue; }
1924 			ww = w; *w++ = 0; w++;
1925 			if ( FG.cTable[*s] > 1 && *s != '[' && *s != '{' ) {
1926 				MesPrint("&Illegal parameters in statement");
1927 				error = 1;
1928 				break;
1929 			}
1930 			while ( FG.cTable[*s] == 0 || *s == '[' || *s == '{' ) {
1931 				if ( *s == '{' ) {
1932 					name = s+1;
1933 					SKIPBRA2(s)
1934 					c = *s; *s = 0;
1935 					number = DoTempSet(name,s);
1936 					name--; *s++ = c; c = *s; *s = 0;
1937 					goto doset;
1938 				}
1939 				else {
1940 					name = s;
1941 					if ( ( s = SkipAName(s) ) == 0 ) {
1942 						MesPrint("&Illegal name '%s'",name);
1943 						return(1);
1944 					}
1945 					c = *s; *s = 0;
1946 					if ( ( type = GetName(AC.varnames,name,&number,WITHAUTO) ) == CSET ) {
1947 doset:					if ( Sets[number].type != CFUNCTION ) goto nofun;
1948 						*w++ = CSET; *w++ = number;
1949 					}
1950 					else if ( type == CFUNCTION ) {
1951 						*w++ = CFUNCTION; *w++ = number + FUNCTION;
1952 					}
1953 					else {
1954 nofun:					MesPrint("&%s is not a function or a set of functions"
1955 						,name);
1956 						error = 1;
1957 					}
1958 				}
1959 				*s = c;
1960 				while ( *s == ',' ) s++;
1961 			}
1962 			ww[1] = w - ww;
1963 			ww = w; w++; zeroflag = 0;
1964 			while ( FG.cTable[*s] == 1 ) {
1965 				ParseNumber(x,s)
1966 				if ( *s && *s != ',' ) {
1967 					MesPrint("&Illegal separator after number");
1968 					error = 1;
1969 					while ( *s && *s != ',' ) s++;
1970 				}
1971 				while ( *s == ',' ) s++;
1972 				if ( x == 0 ) zeroflag = 1;
1973 				if ( !zeroflag ) *w++ = (WORD)x;
1974 			}
1975 			*ww = w - ww;
1976 		} while ( *s );
1977 	}
1978 	oldworkpointer[1] = w - oldworkpointer;
1979 	if ( par == TYPEARG ) {  /* To make sure. The Pointer might move in the future */
1980        	AC.argstack[AC.arglevel-1] = cbuf[AC.cbufnum].Pointer
1981 			                       - cbuf[AC.cbufnum].Buffer + 2;
1982 	}
1983 	AddNtoL(oldworkpointer[1],oldworkpointer);
1984 	AT.WorkPointer = oldworkpointer;
1985 	return(error);
1986 }
1987 
1988 /*
1989   	#] DoArgument :
1990   	#[ CoArgument :
1991 */
1992 
CoArgument(UBYTE * s)1993 int CoArgument(UBYTE *s) { return(DoArgument(s,TYPEARG)); }
1994 
1995 /*
1996   	#] CoArgument :
1997   	#[ CoEndArgument :
1998 */
1999 
CoEndArgument(UBYTE * s)2000 int CoEndArgument(UBYTE *s)
2001 {
2002 	CBUF *C = cbuf+AC.cbufnum;
2003 	while ( *s == ',' ) s++;
2004 	if ( *s ) {
2005 		MesPrint("&Illegal syntax for EndArgument statement");
2006 		return(1);
2007 	}
2008 	if ( AC.arglevel <= 0 ) {
2009 		MesPrint("&EndArgument without corresponding Argument statement");
2010 		return(1);
2011 	}
2012 	AC.arglevel--;
2013 	cbuf[AC.cbufnum].Buffer[AC.argstack[AC.arglevel]] = C->numlhs;
2014 	if ( AC.argsumcheck[AC.arglevel] != NestingChecksum() ) {
2015 		MesNesting();
2016 		return(1);
2017 	}
2018 	return(0);
2019 }
2020 
2021 /*
2022   	#] CoEndArgument :
2023   	#[ CoInside :
2024 */
2025 
CoInside(UBYTE * s)2026 int CoInside(UBYTE *s) { return(ExecInside(s)); }
2027 
2028 /*
2029   	#] CoInside :
2030   	#[ CoEndInside :
2031 */
2032 
CoEndInside(UBYTE * s)2033 int CoEndInside(UBYTE *s)
2034 {
2035 	CBUF *C = cbuf+AC.cbufnum;
2036 	while ( *s == ',' ) s++;
2037 	if ( *s ) {
2038 		MesPrint("&Illegal syntax for EndInside statement");
2039 		return(1);
2040 	}
2041 	if ( AC.insidelevel <= 0 ) {
2042 		MesPrint("&EndInside without corresponding Inside statement");
2043 		return(1);
2044 	}
2045 	AC.insidelevel--;
2046 	cbuf[AC.cbufnum].Buffer[AC.insidestack[AC.insidelevel]] = C->numlhs;
2047 	if ( AC.insidesumcheck[AC.insidelevel] != NestingChecksum() ) {
2048 		MesNesting();
2049 		return(1);
2050 	}
2051 	return(0);
2052 }
2053 
2054 /*
2055   	#] CoEndInside :
2056   	#[ CoNormalize :
2057 */
2058 
CoNormalize(UBYTE * s)2059 int CoNormalize(UBYTE *s) { return(DoArgument(s,TYPENORM)); }
2060 
2061 /*
2062   	#] CoNormalize :
2063   	#[ CoMakeInteger :
2064 */
2065 
CoMakeInteger(UBYTE * s)2066 int CoMakeInteger(UBYTE *s) { return(DoArgument(s,TYPENORM4)); }
2067 
2068 /*
2069   	#] CoMakeInteger :
2070   	#[ CoSplitArg :
2071 */
2072 
CoSplitArg(UBYTE * s)2073 int CoSplitArg(UBYTE *s) { return(DoArgument(s,TYPESPLITARG)); }
2074 
2075 /*
2076   	#] CoSplitArg :
2077   	#[ CoSplitFirstArg :
2078 */
2079 
CoSplitFirstArg(UBYTE * s)2080 int CoSplitFirstArg(UBYTE *s) { return(DoArgument(s,TYPESPLITFIRSTARG)); }
2081 
2082 /*
2083   	#] CoSplitFirstArg :
2084   	#[ CoSplitLastArg :
2085 */
2086 
CoSplitLastArg(UBYTE * s)2087 int CoSplitLastArg(UBYTE *s) { return(DoArgument(s,TYPESPLITLASTARG)); }
2088 
2089 /*
2090   	#] CoSplitLastArg :
2091   	#[ CoFactArg :
2092 */
2093 
CoFactArg(UBYTE * s)2094 int CoFactArg(UBYTE *s) {
2095 	if ( ( AC.topolynomialflag & TOPOLYNOMIALFLAG ) != 0 ) {
2096 		MesPrint("&ToPolynomial statement and FactArg statement are not allowed in the same module");
2097 		return(1);
2098 	}
2099 	AC.topolynomialflag |= FACTARGFLAG;
2100 	return(DoArgument(s,TYPEFACTARG));
2101 }
2102 
2103 /*
2104   	#] CoFactArg :
2105   	#[ DoSymmetrize :
2106 
2107         Syntax:
2108         Symmetrize Fun[:[number]] [Fields]      -> par = 0;
2109         AntiSymmetrize Fun[:[number]] [Fields]  -> par = 1;
2110         CycleSymmetrize Fun[:[number]] [Fields] -> par = 2;
2111         RCycleSymmetrize Fun[:[number]] [Fields]-> par = 3;
2112 */
2113 
DoSymmetrize(UBYTE * s,int par)2114 int DoSymmetrize(UBYTE *s, int par)
2115 {
2116 	GETIDENTITY
2117 	int extra = 0, error = 0, err, fix, x, groupsize, num, i;
2118 	UBYTE *name, c;
2119 	WORD funnum, *w, *ww, type;
2120 	for(;;) {
2121 		name = s;
2122 		if ( ( s = SkipAName(s) ) == 0 ) {
2123 			MesPrint("&Improper function name");
2124 			return(1);
2125 		}
2126 		c = *s; *s = 0;
2127 		if ( c != ',' || ( FG.cTable[s[1]] != 0 && s[1] != '[' ) ) break;
2128 		if ( par <= 0 && StrICmp(name,(UBYTE *)"cyclic") == 0 ) extra = 2;
2129 		else if ( par <= 0 && StrICmp(name,(UBYTE *)"rcyclic") == 0 ) extra = 6;
2130 		else {
2131 			MesPrint("&Illegal option: '%s'",name);
2132 			error = 1;
2133 		}
2134 		*s++ = c;
2135 	}
2136 	if ( ( err = GetVar(name,&type,&funnum,CFUNCTION,WITHAUTO) ) == NAMENOTFOUND ) {
2137 		MesPrint("&Undefined function: %s",name);
2138 		AddFunction(name,0,0,0,0,0,-1,-1);
2139 		*s++ = c;
2140 		return(1);
2141 	}
2142 	funnum += FUNCTION;
2143 	if ( err == -1 ) error = 1;
2144 	*s = c;
2145 	if ( *s == ':' ) {
2146 		s++;
2147 		if ( *s == ',' || *s == '(' || *s == 0 ) fix = -1;
2148 		else if ( FG.cTable[*s] == 1 ) {
2149 			ParseNumber(fix,s)
2150 			if ( fix == 0 )
2151 				Warning("Restriction to zero arguments removed");
2152 		}
2153 		else {
2154 			MesPrint("&Illegal character after :");
2155 			return(1);
2156 		}
2157 	}
2158 	else fix = 0;
2159 	w = AT.WorkPointer;
2160 	*w++ = TYPEOPERATION;
2161 	w++;
2162 	*w++ = SYMMETRIZE;
2163 	*w++ = par | extra;
2164 	*w++ = funnum;
2165 	*w++ = fix;
2166 /*
2167 	And now the argument lists. We have either ,#,#,... or (#,#,..,#),(#,...
2168 */
2169 	w += 2; ww = w; groupsize = -1;
2170 	while ( *s == ',' ) s++;
2171 	while ( *s ) {
2172 		if ( *s == '(' ) {
2173 			s++; num = 0;
2174 			while ( *s && *s != ')' ) {
2175 				if ( *s == ',' ) { s++; continue; }
2176 				if ( FG.cTable[*s] != 1 ) goto illarg;
2177 				ParseNumber(x,s)
2178 				if ( x <= 0 || ( fix > 0 && x > fix ) ) goto illnum;
2179 				num++;
2180 				*w++ = x-1;
2181 			}
2182 			if ( *s == 0 ) {
2183 				MesPrint("&Improper termination of statement");
2184 				return(1);
2185 			}
2186 			if ( groupsize < 0 ) groupsize = num;
2187 			else if ( groupsize != num ) goto group;
2188 			s++;
2189 		}
2190 		else if ( FG.cTable[*s] == 1 ) {
2191 			if ( groupsize < 0 ) groupsize = 1;
2192 			else if ( groupsize != 1 ) {
2193 group:			MesPrint("&All groups should have the same number of arguments");
2194 				return(1);
2195 			}
2196 			ParseNumber(x,s)
2197 			if ( x <= 0 || ( fix > 0 && x > fix ) ) {
2198 illnum:			MesPrint("&Illegal argument number: %d",x);
2199 				return(1);
2200 			}
2201 			*w++ = x-1;
2202 		}
2203 		else {
2204 illarg:		MesPrint("&Illegal argument");
2205 			return(1);
2206 		}
2207 		while ( *s == ',' ) s++;
2208 	}
2209 /*
2210 	Now the completion
2211 */
2212 	if ( w == ww ) {
2213 		ww[-1] = 1;
2214 		ww[-2] = 0;
2215 		if ( fix > 0 ) {
2216 			for ( i = 0; i < fix; i++ ) *w++ = i;
2217 			ww[-2] = fix; /* Bugfix 31-oct-2001. Reported by York Schroeder */
2218 		}
2219 	}
2220 	else {
2221 		ww[-1] = groupsize;
2222 		ww[-2] = (w-ww)/groupsize;
2223 	}
2224 	AT.WorkPointer[1] = w - AT.WorkPointer;
2225 	AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
2226 	return(error);
2227 }
2228 
2229 /*
2230   	#] DoSymmetrize :
2231   	#[ CoSymmetrize :
2232 */
2233 
CoSymmetrize(UBYTE * s)2234 int CoSymmetrize(UBYTE *s) { return(DoSymmetrize(s,SYMMETRIC)); }
2235 
2236 /*
2237   	#] CoSymmetrize :
2238   	#[ CoAntiSymmetrize :
2239 */
2240 
CoAntiSymmetrize(UBYTE * s)2241 int CoAntiSymmetrize(UBYTE *s) { return(DoSymmetrize(s,ANTISYMMETRIC)); }
2242 
2243 /*
2244   	#] CoAntiSymmetrize :
2245   	#[ CoCycleSymmetrize :
2246 */
2247 
CoCycleSymmetrize(UBYTE * s)2248 int CoCycleSymmetrize(UBYTE *s) { return(DoSymmetrize(s,CYCLESYMMETRIC)); }
2249 
2250 /*
2251   	#] CoCycleSymmetrize :
2252   	#[ CoRCycleSymmetrize :
2253 */
2254 
CoRCycleSymmetrize(UBYTE * s)2255 int CoRCycleSymmetrize(UBYTE *s) { return(DoSymmetrize(s,RCYCLESYMMETRIC)); }
2256 
2257 /*
2258   	#] CoRCycleSymmetrize :
2259   	#[ CoWrite :
2260 */
2261 
CoWrite(UBYTE * s)2262 int CoWrite(UBYTE *s)
2263 {
2264 	GETIDENTITY
2265 	UBYTE *option;
2266 	KEYWORDV *key;
2267 	option = s;
2268 	if ( ( ( s = SkipAName(s) ) == 0 ) || *s != 0 ) {
2269 		MesPrint("&Proper use of write statement is: write option");
2270 		return(1);
2271 	}
2272 	key = (KEYWORDV *)FindInKeyWord(option,(KEYWORD *)writeoptions,sizeof(writeoptions)/sizeof(KEYWORD));
2273 	if ( key == 0 ) {
2274 		MesPrint("&Unrecognized option in write statement");
2275 		return(1);
2276 	}
2277 	*key->var = key->type;
2278 	AR.SortType = AC.SortType;
2279 	return(0);
2280 }
2281 
2282 /*
2283   	#] CoWrite :
2284   	#[ CoNWrite :
2285 */
2286 
CoNWrite(UBYTE * s)2287 int CoNWrite(UBYTE *s)
2288 {
2289 	GETIDENTITY
2290 	UBYTE *option;
2291 	KEYWORDV *key;
2292 	option = s;
2293 	if ( ( ( s = SkipAName(s) ) == 0 ) || *s != 0 ) {
2294 		MesPrint("&Proper use of nwrite statement is: nwrite option");
2295 		return(1);
2296 	}
2297 	key = (KEYWORDV *)FindInKeyWord(option,(KEYWORD *)writeoptions,sizeof(writeoptions)/sizeof(KEYWORD));
2298 	if ( key == 0 ) {
2299 		MesPrint("&Unrecognized option in nwrite statement");
2300 		return(1);
2301 	}
2302 	*key->var = key->flags;
2303 	AR.SortType = AC.SortType;
2304 	return(0);
2305 }
2306 
2307 /*
2308   	#] CoNWrite :
2309   	#[ CoRatio :
2310 */
2311 
2312 static WORD ratstring[6] = { TYPEOPERATION, 6, RATIO, 0, 0, 0 };
2313 
CoRatio(UBYTE * s)2314 int CoRatio(UBYTE *s)
2315 {
2316 	UBYTE c, *t;
2317 	int i, type, error = 0;
2318 	WORD numsym, *rs;
2319 	rs = ratstring+3;
2320 	for ( i = 0; i < 3; i++ ) {
2321 		if ( *s ) {
2322 			t = s;
2323 			s = SkipAName(s);
2324 			c = *s; *s = 0;
2325 			if ( ( ( type = GetName(AC.varnames,t,&numsym,WITHAUTO) ) != CSYMBOL )
2326 			&& type != CDUBIOUS ) {
2327 				MesPrint("&%s is not a symbol",t);
2328 				error = 4;
2329 				if ( type < 0 ) numsym = AddSymbol(t,-MAXPOWER,MAXPOWER,0,0);
2330 			}
2331 			*s = c;
2332 			if ( *s == ',' ) s++;
2333 		}
2334 		else {
2335 			if ( error == 0 )
2336 				MesPrint("&The ratio statement needs three symbols for its arguments");
2337 			error++;
2338 			numsym = 0;
2339 		}
2340 		*rs++ = numsym;
2341 	}
2342 	AddNtoL(6,ratstring);
2343 	return(error);
2344 }
2345 
2346 /*
2347   	#] CoRatio :
2348   	#[ CoRedefine :
2349 
2350 	We have a preprocessor variable and a (new) value for it.
2351 	This value is inside a string that must be stored.
2352 */
2353 
CoRedefine(UBYTE * s)2354 int CoRedefine(UBYTE *s)
2355 {
2356 	UBYTE *name, c, *args = 0;
2357 	int numprevar;
2358 	WORD code[2];
2359 	name = s;
2360 	if ( FG.cTable[*s] || ( s = SkipAName(s) ) == 0 || s[-1] == '_' ) {
2361 		MesPrint("&Illegal name for preprocessor variable in redefine statement");
2362 		return(1);
2363 	}
2364 	c = *s; *s = 0;
2365 	for ( numprevar = NumPre-1; numprevar >= 0; numprevar-- ) {
2366 		if ( StrCmp(name,PreVar[numprevar].name) == 0 ) break;
2367 	}
2368 	if ( numprevar < 0 ) {
2369 		MesPrint("&There is no preprocessor variable with the name `%s'",name);
2370 		*s = c;
2371 		return(1);
2372 	}
2373 	*s = c;
2374 /*
2375 	The next code worries about arguments.
2376 	It is a direct copy of the code in TheDefine in the preprocessor.
2377 */
2378 	if ( *s == '(' ) {	/* arguments. scan for correctness */
2379 		s++; args = s;
2380 		for (;;) {
2381 			if ( chartype[*s] != 0 ) goto illarg;
2382 			s++;
2383 			while ( chartype[*s] <= 1 ) s++;
2384 			while ( *s == ' ' || *s == '\t' ) s++;
2385 			if ( *s == ')' ) break;
2386 			if ( *s != ',' ) goto illargs;
2387 			s++;
2388 			while ( *s == ' ' || *s == '\t' ) s++;
2389 		}
2390 		*s++ = 0;
2391 		while ( *s == ' ' || *s == '\t' ) s++;
2392 	}
2393 	while ( *s == ',' ) s++;
2394 	if ( *s != '"' ) {
2395 encl:	MesPrint("&Value for %s should be enclosed in double quotes"
2396 		,PreVar[numprevar].name);
2397 		return(1);
2398 	}
2399 	s++; name = s; /* actually name points to the new string */
2400 	while ( *s && *s != '"' ) { if ( *s == '\\' ) s++; s++; }
2401 	if ( *s != '"' ) goto encl;
2402 	*s = 0;
2403 	code[0] = TYPEREDEFPRE; code[1] = numprevar;
2404 /*
2405 	AddComString(2,code,name,0);
2406 */
2407 	Add2ComStrings(2,code,name,args);
2408 	*s = '"';
2409 #ifdef PARALLELCODE
2410 /*
2411 	Now we prepare the input numbering system for pthreads.
2412 	We need a list of preprocessor variables that are redefined in this
2413 	module.
2414 */
2415 	{
2416 	  int j;
2417 	  WORD *newpf;
2418 	  LONG *newin;
2419 	  for ( j = 0; j < AC.numpfirstnum; j++ ) {
2420 		if ( numprevar == AC.pfirstnum[j] ) break;
2421 	  }
2422 	  if ( j >= AC.numpfirstnum ) {  /* add to list */
2423 		if ( j >= AC.sizepfirstnum ) {
2424 			if ( AC.sizepfirstnum <= 0 ) { AC.sizepfirstnum = 10; }
2425 			else { AC.sizepfirstnum = 2 * AC.sizepfirstnum; }
2426 			newin = (LONG *)Malloc1(AC.sizepfirstnum*(sizeof(WORD)+sizeof(LONG)),"AC.pfirstnum");
2427 			newpf = (WORD *)(newin+AC.sizepfirstnum);
2428 			for ( j = 0; j < AC.numpfirstnum; j++ ) {
2429 				newpf[j] = AC.pfirstnum[j];
2430 				newin[j] = AC.inputnumbers[j];
2431 			}
2432 			if ( AC.inputnumbers ) M_free(AC.inputnumbers,"AC.pfirstnum");
2433 			AC.inputnumbers = newin;
2434 			AC.pfirstnum = newpf;
2435 		}
2436 		AC.pfirstnum[AC.numpfirstnum] = numprevar;
2437 		AC.inputnumbers[AC.numpfirstnum] = -1;
2438 		AC.numpfirstnum++;
2439 	  }
2440 	}
2441 #endif
2442 	return(0);
2443 illarg:;
2444 	MesPrint("&Illegally formed name in argument of redefine statement");
2445 	return(1);
2446 illargs:;
2447 	MesPrint("&Illegally formed arguments in redefine statement");
2448 	return(1);
2449 }
2450 
2451 /*
2452   	#] CoRedefine :
2453   	#[ CoRenumber :
2454 
2455 	renumber    or renumber,0     Only exchanges (n^2 until no improvement)
2456 	renumber,1                    All permutations (could be slow)
2457 */
2458 
CoRenumber(UBYTE * s)2459 int CoRenumber(UBYTE *s)
2460 {
2461 	int x;
2462 	UBYTE *inp;
2463 	while ( *s == ',' ) s++;
2464 	inp = s;
2465 	if ( *s == 0 ) { x = 0; }
2466 	else ParseNumber(x,s)
2467 	if ( *s == 0 && x >= 0 && x <= 1 ) {
2468 		Add3Com(TYPERENUMBER,x);
2469 		return(0);
2470 	}
2471 	MesPrint("&Illegal argument in Renumber statement: '%s'",inp);
2472 	return(1);
2473 }
2474 
2475 /*
2476   	#] CoRenumber :
2477   	#[ CoSum :
2478 */
2479 
CoSum(UBYTE * s)2480 int CoSum(UBYTE *s)
2481 {
2482 	CBUF *C = cbuf+AC.cbufnum;
2483 	UBYTE *ss = 0, c, *t;
2484 	int error = 0, i = 0, type, x;
2485 	WORD numindex,number;
2486 	while ( *s ) {
2487 		t = s;
2488 		if ( *s == '$' ) {
2489 			t++; s++; while ( FG.cTable[*s] < 2 ) s++;
2490 			c = *s; *s = 0;
2491 			if ( ( number = GetDollar(t) ) < 0 ) {
2492 				MesPrint("&Undefined variable $%s",t);
2493 				if ( !error ) error = 1;
2494 				number = AddDollar(t,0,0,0);
2495 			}
2496 			numindex = -number;
2497 		}
2498 		else {
2499 			if ( ( s = SkipAName(s) ) == 0 ) return(1);
2500 			c = *s; *s = 0;
2501 			if ( ( ( type = GetOName(AC.exprnames,t,&numindex,NOAUTO) ) != NAMENOTFOUND )
2502 			|| ( ( type = GetOName(AC.varnames,t,&numindex,WITHAUTO) ) != CINDEX ) ) {
2503 				if ( type != NAMENOTFOUND ) error = NameConflict(type,t);
2504 				else {
2505 					MesPrint("&%s should have been declared as an index",t);
2506 					error = 1;
2507 					numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2508 				}
2509 			}
2510 		}
2511 		Add3Com(TYPESUM,numindex);
2512 		i = 3; *s = c;
2513 		if ( *s == 0 ) break;
2514 		if ( *s != ',' ) {
2515 			MesPrint("&Illegal separator between objects in sum statement.");
2516 			return(1);
2517 		}
2518 		s++;
2519 		if ( FG.cTable[*s] == 0 || *s == '[' || *s == '$' ) {
2520 			while ( FG.cTable[*s] == 0 || *s == '[' || *s == '$' ) {
2521 				if ( *s == '$' ) {
2522 					s++;
2523 					ss = t = s;
2524 					while ( FG.cTable[*s] < 2 ) s++;
2525 					c = *s; *s = 0;
2526 					if ( ( number = GetDollar(t) ) < 0 ) {
2527 						MesPrint("&Undefined variable $%s",t);
2528 						if ( !error ) error = 1;
2529 						number = AddDollar(t,0,0,0);
2530 					}
2531 					numindex = -number;
2532 				}
2533 				else {
2534 					ss = t = s;
2535 					if ( ( s = SkipAName(s) ) == 0 ) return(1);
2536 					c = *s; *s = 0;
2537 					if ( ( ( type = GetOName(AC.exprnames,t,&numindex,NOAUTO) ) != NAMENOTFOUND )
2538 					|| ( ( type = GetOName(AC.varnames,t,&numindex,WITHAUTO) ) != CINDEX ) ) {
2539 						if ( type != NAMENOTFOUND ) error = NameConflict(type,t);
2540 						else {
2541 							MesPrint("&%s should have been declared as an index",t);
2542 							error = 1;
2543 							numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2544 						}
2545 					}
2546 				}
2547 				AddToCB(C,numindex)
2548 				i++;
2549 				C->Pointer[-i+1] = i;
2550 				*s = c;
2551 				if ( *s == 0 ) return(error);
2552 				if ( *s != ',' ) {
2553 					MesPrint("&Illegal separator between objects in sum statement.");
2554 					return(1);
2555 				}
2556 				s++;
2557 			}
2558 			if ( FG.cTable[*s] == 1 ) {
2559 				C->Pointer[-i+1]--; C->Pointer--; s = ss;
2560 			}
2561 		}
2562 		else if ( FG.cTable[*s] == 1 ) {
2563 			while ( FG.cTable[*s] == 1 ) {
2564 				t = s;
2565 				x = *s++ - '0';
2566 				while( FG.cTable[*s] == 1 ) x = 10*x + *s++ - '0';
2567 				if ( *s && *s != ',' ) {
2568 					MesPrint("&%s is not a legal fixed index",t);
2569 					return(1);
2570 				}
2571 				else if ( x >= AM.OffsetIndex ) {
2572 					MesPrint("&%d is too large to be a fixed index",x);
2573 					error = 1;
2574 				}
2575 				else {
2576 					AddToCB(C,x)
2577 					i++;
2578 					C->Pointer[-i] = TYPESUMFIX;
2579 					C->Pointer[-i+1] = i;
2580 				}
2581 				if ( *s == 0 ) break;
2582 				s++;
2583 			}
2584 		}
2585 		else {
2586 			MesPrint("&Illegal object in sum statement");
2587 			error = 1;
2588 		}
2589 	}
2590 	return(error);
2591 }
2592 
2593 /*
2594   	#] CoSum :
2595   	#[ CoToTensor :
2596 */
2597 
2598 static WORD cttarray[7] = { TYPEOPERATION,7,TENVEC,0,0,1,0 };
2599 
CoToTensor(UBYTE * s)2600 int CoToTensor(UBYTE *s)
2601 {
2602 	UBYTE c, *t;
2603 	int type, j, nargs, error = 0;
2604 	WORD number, dol[2] = { 0, 0 };
2605 	cttarray[1] = 6;  /* length */
2606 	cttarray[3] = 0;  /* tensor */
2607 	cttarray[4] = 0;  /* vector */
2608 	cttarray[5] = 1;  /* option flags */
2609 /*	cttarray[6] = 0;     set veto */
2610 /*
2611 	Count the number of the arguments. The validity of them is not checked here.
2612 */
2613 	nargs = 0;
2614 	t = s;
2615 	for (;;) {
2616 		while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
2617 		if ( *s == 0 ) break;
2618 		if ( *s == '!' ) {
2619 			s++;
2620 			if ( *s == '{' ) {
2621 				SKIPBRA2(s)
2622 				s++;
2623 			} else {
2624 				if ( ( s = SkipAName(s) ) == 0 ) goto syntax_error;
2625 			}
2626 		} else {
2627 			if ( ( s = SkipAName(s) ) == 0 ) goto syntax_error;
2628 		}
2629 		nargs++;
2630 	}
2631 	if ( nargs < 2 ) goto not_enough_arguments;
2632 	s = t;
2633 /*
2634 	Parse options, which are given as the arguments except the last two.
2635 */
2636 	for ( j = 2; j < nargs; j++ ) {
2637 		while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
2638 		if ( *s == '!' ) {
2639 /*
2640 			Handle !set or !{vector,...}. Note: If two or more sets are
2641 			specified, then only the last one is used.
2642 */
2643 			s++;
2644 			cttarray[1] = 7;
2645 			cttarray[5] |= 8;
2646 			if ( FG.cTable[*s] == 0 || *s == '[' || *s == '_' ) {
2647 				t = s;
2648 				if ( ( s = SkipAName(s) ) == 0 ) goto syntax_error;
2649 				c = *s; *s = 0;
2650 				type = GetName(AC.varnames,t,&number,WITHAUTO);
2651 				if ( type == CVECTOR ) {
2652 /*
2653 					As written in the manual, "!p" (without "{}") should work.
2654 */
2655 					cttarray[6] = DoTempSet(t,s);
2656 					*s = c;
2657 					goto check_tempset;
2658 				}
2659 				else if ( type != CSET ) {
2660 					MesPrint("&%s is not the name of a set or a vector",t);
2661 					error = 1;
2662 				}
2663 				*s = c;
2664 				cttarray[6] = number;
2665 			}
2666 			else if ( *s == '{' ) {
2667 				t = ++s; SKIPBRA2(s) *s = 0;
2668 				cttarray[6] = DoTempSet(t,s);
2669 				*s++ = '}';
2670 check_tempset:
2671 				if ( cttarray[6] < 0 ) {
2672 					error = 1;
2673 				}
2674 				if ( AC.wildflag ) {
2675 					MesPrint("&Improper use of wildcard(s) in set specification");
2676 					error = 1;
2677 				}
2678 			}
2679 		} else {
2680 /*
2681 			Other options.
2682 */
2683 			t = s;
2684 			if ( ( s = SkipAName(s) ) == 0 ) goto syntax_error;
2685 			c = *s; *s = 0;
2686 			if ( StrICmp(t,(UBYTE *)"nosquare") == 0 ) cttarray[5] |= 2;
2687 			else if ( StrICmp(t,(UBYTE *)"functions") == 0 ) cttarray[5] |= 4;
2688 			else {
2689 				MesPrint("&Unrecognized option in ToTensor statement: '%s'",t);
2690 				*s = c;
2691 				return(1);
2692 			}
2693 			*s = c;
2694 		}
2695 	}
2696 /*
2697 	Now parse a vector and a tensor. The ordering doesn't matter.
2698 */
2699 	for ( j = 0; j < 2; j++ ) {
2700 		while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
2701 		t = s;
2702 		if ( ( s = SkipAName(s) ) == 0 ) goto syntax_error;
2703 		c = *s; *s = 0;
2704 		if ( t[0] == '$' ) {
2705 			dol[j] = GetDollar(t+1);
2706 			if ( dol[j] < 0 ) dol[j] = AddDollar(t+1,DOLUNDEFINED,0,0);
2707 		} else {
2708 			type = GetName(AC.varnames,t,&number,WITHAUTO);
2709 			if ( type == CVECTOR ) {
2710 				cttarray[4] = number + AM.OffsetVector;
2711 			}
2712 			else if ( type == CFUNCTION && ( functions[number].spec > 0 ) ) {
2713 				cttarray[3] = number + FUNCTION;
2714 			}
2715 			else {
2716 				MesPrint("&%s is not a vector or a tensor",t);
2717 				error = 1;
2718 			}
2719 		}
2720 		*s = c;
2721 	}
2722 	if ( cttarray[3] == 0 || cttarray[4] == 0 ) {
2723 		if ( dol[0] == 0 && dol[1] == 0 ) {
2724 			goto not_enough_arguments;
2725 		}
2726 		else if ( cttarray[3] ) {
2727 			if ( dol[1] )        cttarray[4] = dol[1];
2728 			else if ( dol[0] ) { cttarray[4] = dol[0]; }
2729 			else {
2730 				goto not_enough_arguments;
2731 			}
2732 		}
2733 		else if ( cttarray[4] ) {
2734 			if ( dol[1] )    { cttarray[3] = -dol[1]; }
2735 			else if ( dol[0] ) cttarray[3] = -dol[0];
2736 			else {
2737 				goto not_enough_arguments;
2738 			}
2739 		}
2740 		else {
2741 			if ( dol[0] == 0 || dol[1] == 0 ) {
2742 				goto not_enough_arguments;
2743 			}
2744 			else {
2745 				cttarray[3] = -dol[0]; cttarray[4] = dol[1];
2746 			}
2747 		}
2748 	}
2749 	AddNtoL(cttarray[1],cttarray);
2750 	return(error);
2751 
2752 syntax_error:
2753 	MesPrint("&Syntax error in ToTensor statement");
2754 	return(1);
2755 
2756 not_enough_arguments:
2757 	MesPrint("&ToTensor statement needs a vector and a tensor");
2758 	return(1);
2759 }
2760 
2761 /*
2762   	#] CoToTensor :
2763   	#[ CoToVector :
2764 */
2765 
2766 static WORD ctvarray[6] = { TYPEOPERATION,6,TENVEC,0,0,0 };
2767 
CoToVector(UBYTE * s)2768 int CoToVector(UBYTE *s)
2769 {
2770 	UBYTE *t, c;
2771 	int j, type, error = 0;
2772 	WORD number, dol[2];
2773 	dol[0] = dol[1] = 0;
2774 	ctvarray[3] = ctvarray[4] = ctvarray[5] = 0;
2775 	for ( j = 0; j < 2; j++ ) {
2776 		t = s;
2777 		if ( ( s = SkipAName(s) ) == 0 ) {
2778 proper:		MesPrint("&Arguments of ToVector statement should be a vector and a tensor");
2779 			return(1);
2780 		}
2781 		c = *s; *s = 0;
2782 		if ( *t == '$' ) {
2783 			dol[j] = GetDollar(t+1);
2784 			if ( dol[j] < 0 ) dol[j] = AddDollar(t+1,DOLUNDEFINED,0,0);
2785 		}
2786 		else if ( ( type = GetName(AC.varnames,t,&number,WITHAUTO) ) == CVECTOR )
2787 			ctvarray[4] = number + AM.OffsetVector;
2788 		else if ( type == CFUNCTION && ( functions[number].spec > 0 ) )
2789 			ctvarray[3] = number+FUNCTION;
2790 		else {
2791 			MesPrint("&%s is not a vector or a tensor",t);
2792 			error = 1;
2793 		}
2794 		*s = c; if ( *s && *s != ',' ) goto proper;
2795 		if ( *s ) s++;
2796 	}
2797 	if ( *s != 0 ) goto proper;
2798 	if ( ctvarray[3] == 0 || ctvarray[4] == 0 ) {
2799 	 	if ( dol[0] == 0 && dol[1] == 0 ) {
2800 			MesPrint("&ToVector statement needs a vector and a tensor");
2801 			error = 1;
2802 		}
2803 		else if ( ctvarray[3] ) {
2804 			if ( dol[1] )      ctvarray[4] = dol[1];
2805 			else if ( dol[0] ) ctvarray[4] = dol[0];
2806 			else {
2807 				MesPrint("&ToVector statement needs a vector and a tensor");
2808 				error = 1;
2809 			}
2810 		}
2811 		else if ( ctvarray[4] ) {
2812 			if ( dol[1] )      ctvarray[3] = -dol[1];
2813 			else if ( dol[0] ) ctvarray[3] = -dol[0];
2814 			else {
2815 				MesPrint("&ToVector statement needs a vector and a tensor");
2816 				error = 1;
2817 			}
2818 		}
2819 		else {
2820 			if ( dol[0] == 0 || dol[1] == 0 ) {
2821 				MesPrint("&ToVector statement needs a vector and a tensor");
2822 				error = 1;
2823 			}
2824 			else {
2825 				ctvarray[3] = -dol[0]; ctvarray[4] = dol[1];
2826 			}
2827 		}
2828 	}
2829 	AddNtoL(6,ctvarray);
2830 	return(error);
2831 }
2832 
2833 /*
2834   	#] CoToVector :
2835   	#[ CoTrace4 :
2836 */
2837 
CoTrace4(UBYTE * s)2838 int CoTrace4(UBYTE *s)
2839 {
2840 	int error = 0, type, option = CHISHOLM;
2841 	UBYTE *t, c;
2842 	WORD numindex, one = 1;
2843 	KEYWORD *key;
2844 	for (;;) {
2845 		t = s;
2846 		if ( FG.cTable[*s] == 1 ) break;
2847 		if ( ( s = SkipAName(s) ) == 0 ) {
2848 proper:		MesPrint("&Proper syntax for Trace4 is 'Trace4[,options],index;'");
2849 			return(1);
2850 		}
2851 		if ( *s == 0 ) break;
2852 		c = *s; *s = 0;
2853 		if ( ( key = FindKeyWord(t,trace4options,
2854 			sizeof(trace4options)/sizeof(KEYWORD)) ) == 0 ) break;
2855 		else {
2856 			option |=  key->type;
2857 			option &= ~key->flags;
2858 		}
2859 		if ( ( *s++ = c ) != ',' ) {
2860 			MesPrint("&Illegal separator in Trace4 statement");
2861 			return(1);
2862 		}
2863 		if ( *s == 0 ) goto proper;
2864 	}
2865 	s = t;
2866 	if ( FG.cTable[*s] == 1 ) {
2867 retry:
2868 		ParseNumber(numindex,s)
2869 		if ( *s != 0 ) {
2870 			MesPrint("&Last argument of Trace4 should be an index");
2871 			return(1);
2872 		}
2873 		if ( numindex >= AM.OffsetIndex ) {
2874 			MesPrint("&fixed index >= %d. Change value of OffsetIndex in setup file"
2875 			,AM.OffsetIndex);
2876 			return(1);
2877 		}
2878 	}
2879 	else if ( *s == '$' ) {
2880 		if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
2881 			numindex = -numindex;
2882 		else {
2883 			MesPrint("&%s is undefined",s);
2884 			numindex = AddDollar(s+1,DOLINDEX,&one,1);
2885 			return(1);
2886 		}
2887 tests:	s = SkipAName(s);
2888 		if ( *s != 0 ) {
2889 			MesPrint("&Trace4 should have a single index or $variable for its argument");
2890 			return(1);
2891 		}
2892 	}
2893 	else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
2894 		numindex += AM.OffsetIndex;
2895 		goto tests;
2896 	}
2897 	else if ( type != -1 ) {
2898 		if ( type != CDUBIOUS ) {
2899 			if ( ( FG.cTable[*s] != 0 ) && ( *s != '[' ) ) {
2900 				if ( *s == '+' && FG.cTable[s[1]] == 1 ) { s++; goto retry; }
2901 				goto proper;
2902 			}
2903 			NameConflict(type,s);
2904 			type = MakeDubious(AC.varnames,s,&numindex);
2905 		}
2906 		return(1);
2907 	}
2908 	else {
2909 		MesPrint("&%s is not an index",s);
2910 		numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2911 		return(1);
2912 	}
2913 	if ( error ) return(error);
2914 	if ( ( option & CHISHOLM ) != 0 )
2915 		Add4Com(TYPECHISHOLM,numindex,(option & ALSOREVERSE));
2916 	Add5Com(TYPEOPERATION,TAKETRACE,4 + (option & NOTRICK),numindex);
2917 	return(0);
2918 }
2919 
2920 /*
2921   	#] CoTrace4 :
2922   	#[ CoTraceN :
2923 */
2924 
CoTraceN(UBYTE * s)2925 int CoTraceN(UBYTE *s)
2926 {
2927 	WORD numindex, one = 1;
2928 	int type;
2929 	if ( FG.cTable[*s] == 1 ) {
2930 retry:
2931 		ParseNumber(numindex,s)
2932 		if ( *s != 0 ) {
2933 proper:		MesPrint("&TraceN should have a single index for its argument");
2934 			return(1);
2935 		}
2936 		if ( numindex >= AM.OffsetIndex ) {
2937 			MesPrint("&fixed index >= %d. Change value of OffsetIndex in setup file"
2938 			,AM.OffsetIndex);
2939 			return(1);
2940 		}
2941 	}
2942 	else if ( *s == '$' ) {
2943 		if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
2944 			numindex = -numindex;
2945 		else {
2946 			MesPrint("&%s is undefined",s);
2947 			numindex = AddDollar(s+1,DOLINDEX,&one,1);
2948 			return(1);
2949 		}
2950 tests:	s = SkipAName(s);
2951 		if ( *s != 0 ) {
2952 			MesPrint("&TraceN should have a single index or $variable for its argument");
2953 			return(1);
2954 		}
2955 	}
2956 	else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
2957 		numindex += AM.OffsetIndex;
2958 		goto tests;
2959 	}
2960 	else if ( type != -1 ) {
2961 		if ( type != CDUBIOUS ) {
2962 			if ( ( FG.cTable[*s] != 0 ) && ( *s != '[' ) ) {
2963 				if ( *s == '+' && FG.cTable[s[1]] == 1 ) { s++; goto retry; }
2964 				goto proper;
2965 			}
2966 			NameConflict(type,s);
2967 			type = MakeDubious(AC.varnames,s,&numindex);
2968 		}
2969 		return(1);
2970 	}
2971 	else {
2972 		MesPrint("&%s is not an index",s);
2973 		numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
2974 		return(1);
2975 	}
2976 	Add5Com(TYPEOPERATION,TAKETRACE,0,numindex);
2977 	return(0);
2978 }
2979 
2980 /*
2981   	#] CoTraceN :
2982   	#[ CoChisholm :
2983 */
2984 
CoChisholm(UBYTE * s)2985 int CoChisholm(UBYTE *s)
2986 {
2987 	int error = 0, type, option = CHISHOLM;
2988 	UBYTE *t, c;
2989 	WORD numindex, one = 1;
2990 	KEYWORD *key;
2991 	for (;;) {
2992 		t = s;
2993 		if ( FG.cTable[*s] == 1 ) break;
2994 		if ( ( s = SkipAName(s) ) == 0 ) {
2995 proper:		MesPrint("&Proper syntax for Chisholm is 'Chisholm[,options],index;'");
2996 			return(1);
2997 		}
2998 		if ( *s == 0 ) break;
2999 		c = *s; *s = 0;
3000 		if ( ( key = FindKeyWord(t,chisoptions,
3001 			sizeof(chisoptions)/sizeof(KEYWORD)) ) == 0 ) break;
3002 		else {
3003 			option |=  key->type;
3004 			option &= ~key->flags;
3005 		}
3006 		if ( ( *s++ = c ) != ',' ) {
3007 			MesPrint("&Illegal separator in Chisholm statement");
3008 			return(1);
3009 		}
3010 		if ( *s == 0 ) goto proper;
3011 	}
3012 	s = t;
3013 	if ( FG.cTable[*s] == 1 ) {
3014 		ParseNumber(numindex,s)
3015 		if ( *s != 0 ) {
3016 			MesPrint("&Last argument of Chisholm should be an index");
3017 			return(1);
3018 		}
3019 		if ( numindex >= AM.OffsetIndex ) {
3020 			MesPrint("&fixed index >= %d. Change value of OffsetIndex in setup file"
3021 			,AM.OffsetIndex);
3022 			return(1);
3023 		}
3024 	}
3025 	else if ( *s == '$' ) {
3026 		if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
3027 			numindex = -numindex;
3028 		else {
3029 			MesPrint("&%s is undefined",s);
3030 			numindex = AddDollar(s+1,DOLINDEX,&one,1);
3031 			return(1);
3032 		}
3033 tests:	s = SkipAName(s);
3034 		if ( *s != 0 ) {
3035 			MesPrint("&Chisholm should have a single index or $variable for its argument");
3036 			return(1);
3037 		}
3038 	}
3039 	else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
3040 		numindex += AM.OffsetIndex;
3041 		goto tests;
3042 	}
3043 	else if ( type != -1 ) {
3044 		if ( type != CDUBIOUS ) {
3045 			NameConflict(type,s);
3046 			type = MakeDubious(AC.varnames,s,&numindex);
3047 		}
3048 		return(1);
3049 	}
3050 	else {
3051 		MesPrint("&%s is not an index",s);
3052 		numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
3053 		return(1);
3054 	}
3055 	if ( error ) return(error);
3056 	Add4Com(TYPECHISHOLM,numindex,(option & ALSOREVERSE));
3057 	return(0);
3058 }
3059 
3060 /*
3061   	#] CoChisholm :
3062   	#[ DoChain :
3063 
3064 	Syntax: Chainxx functionname;
3065 */
3066 
DoChain(UBYTE * s,int option)3067 int DoChain(UBYTE *s, int option)
3068 {
3069 	WORD numfunc,type;
3070 	if ( *s == '$' ) {
3071 		if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
3072 			numfunc = -numfunc;
3073 		else {
3074 			MesPrint("&%s is undefined",s);
3075 			numfunc = AddDollar(s+1,DOLINDEX,&one,1);
3076 			return(1);
3077 		}
3078 tests:	s = SkipAName(s);
3079 		if ( *s != 0 ) {
3080 			MesPrint("&ChainIn/ChainOut should have a single function or $variable for its argument");
3081 			return(1);
3082 		}
3083 	}
3084 	else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
3085 		numfunc += FUNCTION;
3086 		goto tests;
3087 	}
3088 	else if ( type != -1 ) {
3089 		if ( type != CDUBIOUS ) {
3090 			NameConflict(type,s);
3091 			type = MakeDubious(AC.varnames,s,&numfunc);
3092 		}
3093 		return(1);
3094 	}
3095 	else {
3096 		MesPrint("&%s is not a function",s);
3097 		numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
3098 		return(1);
3099 	}
3100 	Add3Com(option,numfunc);
3101 	return(0);
3102 }
3103 
3104 /*
3105   	#] DoChain :
3106   	#[ CoChainin :
3107 
3108 	Syntax: Chainin functionname;
3109 */
3110 
CoChainin(UBYTE * s)3111 int CoChainin(UBYTE *s)
3112 {
3113 	return(DoChain(s,TYPECHAININ));
3114 }
3115 
3116 /*
3117   	#] CoChainin :
3118   	#[ CoChainout :
3119 
3120 	Syntax: Chainout functionname;
3121 */
3122 
CoChainout(UBYTE * s)3123 int CoChainout(UBYTE *s)
3124 {
3125 	return(DoChain(s,TYPECHAINOUT));
3126 }
3127 
3128 /*
3129   	#] CoChainout :
3130   	#[ CoExit :
3131 */
3132 
CoExit(UBYTE * s)3133 int CoExit(UBYTE *s)
3134 {
3135 	UBYTE *name;
3136 	WORD code = TYPEEXIT;
3137 	while ( *s == ',' ) s++;
3138 	if ( *s == 0 ) {
3139 		Add3Com(TYPEEXIT,0);
3140 		return(0);
3141 	}
3142 	name = s+1;
3143 	s++;
3144 	while ( *s ) { if ( *s == '\\' ) s++; s++; }
3145 	if ( name[-1] != '"' || s[-1] != '"' ) {
3146 		MesPrint("&Illegal syntax for exit statement");
3147 		return(1);
3148 	}
3149 	s[-1] = 0;
3150 	AddComString(1,&code,name,0);
3151 	s[-1] = '"';
3152 	return(0);
3153 }
3154 
3155 /*
3156   	#] CoExit :
3157   	#[ CoInParallel :
3158 */
3159 
CoInParallel(UBYTE * s)3160 int CoInParallel(UBYTE *s)
3161 {
3162 	return(DoInParallel(s,1));
3163 }
3164 
3165 /*
3166   	#] CoInParallel :
3167   	#[ CoNotInParallel :
3168 */
3169 
CoNotInParallel(UBYTE * s)3170 int CoNotInParallel(UBYTE *s)
3171 {
3172 	return(DoInParallel(s,0));
3173 }
3174 
3175 /*
3176   	#] CoNotInParallel :
3177   	#[ DoInParallel :
3178 
3179 	InParallel;
3180 	InParallel,names;
3181 	NotInParallel;
3182 	NotInParallel,names;
3183 */
3184 
DoInParallel(UBYTE * s,int par)3185 int DoInParallel(UBYTE *s, int par)
3186 {
3187 #ifdef PARALLELCODE
3188 	EXPRESSIONS e;
3189 	WORD i;
3190 #endif
3191 	WORD number;
3192 	UBYTE *t, c;
3193 	int error = 0;
3194 #ifndef WITHPTHREADS
3195 	DUMMYUSE(par);
3196 #endif
3197 	if ( *s == 0 ) {
3198 		AC.inparallelflag = par;
3199 #ifdef PARALLELCODE
3200 		for ( i = NumExpressions-1; i >= 0; i-- ) {
3201 			e = Expressions+i;
3202 			if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
3203 			|| e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
3204 			) {
3205 				e->partodo = par;
3206 			}
3207 		}
3208 #endif
3209 	}
3210 	else {
3211 		for(;;) {	/* Look for a (comma separated) list of variables */
3212 			while ( *s == ',' ) s++;
3213 			if ( *s == 0 ) break;
3214 			if ( *s == '[' || FG.cTable[*s] == 0 ) {
3215 				t = s;
3216 				if ( ( s = SkipAName(s) ) == 0 ) {
3217 					MesPrint("&Improper name for an expression: '%s'",t);
3218 					return(1);
3219 				}
3220 				c = *s; *s = 0;
3221 				if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
3222 #ifdef PARALLELCODE
3223 					e = Expressions+number;
3224 					if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
3225 					|| e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
3226 					) {
3227 						e->partodo = par;
3228 					}
3229 #endif
3230 				}
3231 				else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
3232 					MesPrint("&%s is not an expression",t);
3233 					error = 1;
3234 				}
3235 				*s = c;
3236 			}
3237 			else {
3238 				MesPrint("&Illegal object in InExpression statement");
3239 				error = 1;
3240 				while ( *s && *s != ',' ) s++;
3241 				if ( *s == 0 ) break;
3242 			}
3243 		}
3244 
3245 	}
3246 	return(error);
3247 }
3248 
3249 /*
3250   	#] DoInParallel :
3251   	#[ CoInExpression :
3252 */
3253 
CoInExpression(UBYTE * s)3254 int CoInExpression(UBYTE *s)
3255 {
3256 	GETIDENTITY
3257 	UBYTE *t, c;
3258 	WORD *w, number;
3259 	int error = 0;
3260 	w = AT.WorkPointer;
3261 	if ( AC.inexprlevel >= MAXNEST ) {
3262 		MesPrint("@Nesting of inexpression statements more than %d levels",(WORD)MAXNEST);
3263 		return(-1);
3264 	}
3265 	AC.inexprsumcheck[AC.inexprlevel] = NestingChecksum();
3266 	AC.inexprstack[AC.inexprlevel] = cbuf[AC.cbufnum].Pointer
3267 								 - cbuf[AC.cbufnum].Buffer + 2;
3268 	AC.inexprlevel++;
3269 	*w++ = TYPEINEXPRESSION;
3270 	w++; w++;
3271 	for(;;) {	/* Look for a (comma separated) list of variables */
3272 		while ( *s == ',' ) s++;
3273 		if ( *s == 0 ) break;
3274 		if ( *s == '[' || FG.cTable[*s] == 0 ) {
3275 			t = s;
3276 			if ( ( s = SkipAName(s) ) == 0 ) {
3277 				MesPrint("&Improper name for an expression: '%s'",t);
3278 				return(1);
3279 			}
3280 			c = *s; *s = 0;
3281 			if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
3282 				*w++ = number;
3283 			}
3284 			else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
3285 				MesPrint("&%s is not an expression",t);
3286 				error = 1;
3287 			}
3288 			*s = c;
3289 		}
3290 		else {
3291 			MesPrint("&Illegal object in InExpression statement");
3292 			error = 1;
3293 			while ( *s && *s != ',' ) s++;
3294 			if ( *s == 0 ) break;
3295 		}
3296 	}
3297 	AT.WorkPointer[1] = w - AT.WorkPointer;
3298 	AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
3299 	return(error);
3300 }
3301 
3302 /*
3303   	#] CoInExpression :
3304   	#[ CoEndInExpression :
3305 */
3306 
CoEndInExpression(UBYTE * s)3307 int CoEndInExpression(UBYTE *s)
3308 {
3309 	CBUF *C = cbuf+AC.cbufnum;
3310 	while ( *s == ',' ) s++;
3311 	if ( *s ) {
3312 		MesPrint("&Illegal syntax for EndInExpression statement");
3313 		return(1);
3314 	}
3315 	if ( AC.inexprlevel <= 0 ) {
3316 		MesPrint("&EndInExpression without corresponding InExpression statement");
3317 		return(1);
3318 	}
3319 	AC.inexprlevel--;
3320 	cbuf[AC.cbufnum].Buffer[AC.inexprstack[AC.inexprlevel]] = C->numlhs;
3321 	if ( AC.inexprsumcheck[AC.inexprlevel] != NestingChecksum() ) {
3322 		MesNesting();
3323 		return(1);
3324 	}
3325 	return(0);
3326 }
3327 
3328 /*
3329   	#] CoEndInExpression :
3330   	#[ CoSetExitFlag :
3331 */
3332 
CoSetExitFlag(UBYTE * s)3333 int CoSetExitFlag(UBYTE *s)
3334 {
3335 	if ( *s ) {
3336 		MesPrint("&Illegal syntax for the SetExitFlag statement");
3337 		return(1);
3338 	}
3339 	Add2Com(TYPESETEXIT);
3340 	return(0);
3341 }
3342 
3343 /*
3344   	#] CoSetExitFlag :
3345   	#[ CoTryReplace :
3346 */
CoTryReplace(UBYTE * p)3347 int CoTryReplace(UBYTE *p)
3348 {
3349 	GETIDENTITY
3350 	UBYTE *name, c;
3351 	WORD *w, error = 0, i, which = -1, c1, minvec = 0;
3352 	w = AT.WorkPointer;
3353 	*w++ = TYPETRY;
3354 	*w++ = 3;
3355 	*w++ = 0;
3356 	*w++ = REPLACEMENT;
3357 	*w++ = FUNHEAD;
3358 	FILLFUN(w)
3359 /*
3360 	Now we have to read a function argument for the replace_ function.
3361 	Current arguments that we allow involve only single arguments
3362 	that do not expand further. No brackets!
3363 */
3364 	while ( *p ) {
3365 /*
3366 		No numbers yet
3367 */
3368 		if ( *p == '-' && minvec == 0 && which == (CVECTOR+1) ) {
3369 			minvec = 1; p++;
3370 		}
3371 		if ( *p == '[' || FG.cTable[*p] == 0 ) {
3372 			name = p;
3373 			if ( ( p = SkipAName(p) )  == 0 ) return(1);
3374 			c = *p; *p = 0;
3375 			i = GetName(AC.varnames,name,&c1,WITHAUTO);
3376 			if ( which >= 0 && i >= 0 && i != CDUBIOUS && which != (i+1) ) {
3377 				MesPrint("&Illegal combination of objects in TryReplace");
3378 				error = 1;
3379 			}
3380 			else if ( minvec && i != CVECTOR && i != CDUBIOUS ) {
3381 				MesPrint("&Currently a - sign can be used only with a vector in TryReplace");
3382 				error = 1;
3383 			}
3384 			else switch ( i ) {
3385 				case CSYMBOL: *w++ = -SYMBOL; *w++ = c1; break;
3386 				case CVECTOR:
3387 					if ( minvec ) *w++ = -MINVECTOR;
3388 					else          *w++ = -VECTOR;
3389 					*w++ = c1 + AM.OffsetVector;
3390 					minvec = 0;
3391 					break;
3392 				case CINDEX: *w++ = -INDEX; *w++ = c1 + AM.OffsetIndex;
3393 					if ( c1 >= AM.WilInd && c == '?' ) { *p++ = c; c = *p; }
3394 					break;
3395 				case CFUNCTION: *w++ = -c1-FUNCTION; break;
3396 				case CDUBIOUS: minvec = 0; error = 1; break;
3397 				default:
3398 					MesPrint("&Illegal object type in TryReplace: %s",name);
3399 					error = 1;
3400 					i = 0;
3401 					break;
3402 			}
3403 			if ( which < 0 ) which = i+1;
3404 			else which = -1;
3405 			*p = c;
3406 			if ( *p == ',' ) p++;
3407 			continue;
3408 		}
3409 		else {
3410 			MesPrint("&Illegal object in TryReplace");
3411 			error = 1;
3412 			while ( *p && *p != ',' ) {
3413 				if ( *p == '(' ) SKIPBRA3(p)
3414 				else if ( *p == '{' ) SKIPBRA2(p)
3415 				else if ( *p == '[' ) SKIPBRA1(p)
3416 				else p++;
3417 			}
3418 		}
3419 		if ( *p == ',' ) p++;
3420 		if ( which < 0 ) which = 0;
3421 		else which = -1;
3422 	}
3423 	if ( which >= 0 ) {
3424 		MesPrint("&Odd number of arguments in TryReplace");
3425 		error = 1;
3426 	}
3427 	i = w - AT.WorkPointer;
3428 	AT.WorkPointer[1] = i;
3429 	AT.WorkPointer[2] = i - 3;
3430 	AT.WorkPointer[4] = i - 3;
3431 	AddNtoL((int)i,AT.WorkPointer);
3432 	return(error);
3433 }
3434 
3435 /*
3436   	#] CoTryReplace :
3437   	#[ CoModulus :
3438 
3439 	Old syntax:  Modulus [-] number [:number]
3440 	New syntax:  Modulus [option(s)] number
3441 	    Options are: NoFunctions/CoefficientsOnly/AlsoFunctions
3442 	                 PlusMin/Positive
3443 	                 InverseTable
3444 	                 PrintPowersOf(number)
3445 	                 AlsoPowers/NoPowers
3446 	                 AlsoDollars/NoDollars
3447 	Notice: We change the defaults. This may cause problems to some.
3448 */
3449 
CoModulus(UBYTE * inp)3450 int CoModulus(UBYTE *inp)
3451 {
3452 #ifdef OLDMODULUS
3453 /*	#[ Old Syntax : */
3454 	UBYTE *p, c;
3455 	WORD sign = 1, Retval;
3456 	while ( *inp == '-' || *inp == '+' ) {
3457 		if ( *inp == '-' ) sign = -sign;
3458 		inp++;
3459 	}
3460 	p = inp;
3461 	if ( FG.cTable[*inp] != 1 ) {
3462 		MesPrint("&Invalid value for modulus:%s",inp);
3463 		if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers");
3464 		AC.modpowers = 0;
3465 		return(1);
3466 	}
3467 	do { inp++; } while ( FG.cTable[*inp] == 1 );
3468 	c = *inp; *inp = 0;
3469 	Retval = GetLong(p,(UWORD *)AC.cmod,&AC.ncmod);
3470 	if ( sign < 0 ) AC.ncmod = -AC.ncmod;
3471 	*p = c;
3472 	if ( c == 0 ) goto regular;
3473 	else if ( c != ':' ) {
3474 		MesPrint("&Illegal option for modulus %s",inp);
3475 		if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers");
3476 		AC.modpowers = 0;
3477 		return(1);
3478 	}
3479 	inp++;
3480 	p = inp;
3481 	while ( FG.cTable[*inp] == 1 ) inp++;
3482 	if ( *inp ) {
3483 		MesPrint("&Illegal character in option for modulus %s",inp);
3484 		if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers");
3485 		AC.modpowers = 0;
3486 		return(1);
3487 	}
3488 	if ( GetLong(p,(UWORD *)AC.powmod,&AC.npowmod) ) Retval = -1;
3489 	if ( TakeModulus((UWORD *)AC.powmod,&AC.npowmod,AC.cmod,AC.ncmod,NOUNPACK) ) Retval = -1;
3490 	if ( AC.npowmod == 0 ) {
3491 		MesPrint("&Improper value for generator");
3492 		Retval = -1;
3493 	}
3494 	if ( MakeModTable() ) Retval = -1;
3495 	AC.DirtPow = 1;
3496 regular:
3497 	AN.ncmod = AC.ncmod;
3498 	if ( AC.halfmod ) {
3499 		M_free(AC.halfmod,"halfmod");
3500 		AC.halfmod = 0; AC.nhalfmod = 0;
3501 	}
3502 	if ( AC.modinverses ) {
3503 		M_free(AC.halfmod,"modinverses");
3504 		AC.modinverses = 0;
3505 	}
3506 	return(Retval);
3507 /*	#] Old Syntax : */
3508 #else
3509 	GETIDENTITY
3510 	int Retval = 0, sign = 1;
3511 	UBYTE *p, c;
3512 	while ( *inp == ',' || *inp == ' ' || *inp == '\t' ) inp++;
3513 	if ( *inp == 0 ) {
3514 SwitchOff:
3515 		if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers");
3516 		AC.modpowers = 0;
3517 		AN.ncmod = AC.ncmod = 0;
3518 		if ( AC.halfmod ) M_free(AC.halfmod,"halfmod");
3519 		AC.halfmod = 0; AC.nhalfmod = 0;
3520 		if ( AC.modinverses ) M_free(AC.modinverses,"modinverses");
3521 		AC.modinverses = 0;
3522 		AC.modmode = 0;
3523 		return(0);
3524 	}
3525 	AC.modmode = 0;
3526 	if ( *inp == '-' ) {
3527 		sign = -1;
3528 		inp++;
3529 	}
3530 	else {
3531 	  while ( FG.cTable[*inp] == 0 ) {
3532 		p = inp;
3533 		while ( FG.cTable[*inp] == 0 ) inp++;
3534 		c = *inp; *inp = 0;
3535 		if ( StrICmp(p,(UBYTE *)"nofunctions") == 0 ) {
3536 			AC.modmode &= ~ALSOFUNARGS;
3537 		}
3538 		else if ( StrICmp(p,(UBYTE *)"alsofunctions") == 0 ) {
3539 			AC.modmode |= ALSOFUNARGS;
3540 		}
3541 		else if ( StrICmp(p,(UBYTE *)"coefficientsonly") == 0 ) {
3542 			AC.modmode &= ~ALSOFUNARGS;
3543 			AC.modmode &= ~ALSOPOWERS;
3544 			sign = -1;
3545 		}
3546 		else if ( StrICmp(p,(UBYTE *)"plusmin") == 0 ) {
3547 			AC.modmode |= POSNEG;
3548 		}
3549 		else if ( StrICmp(p,(UBYTE *)"positive") == 0 ) {
3550 			AC.modmode &= ~POSNEG;
3551 		}
3552 		else if ( StrICmp(p,(UBYTE *)"inversetable") == 0 ) {
3553 			AC.modmode |= INVERSETABLE;
3554 		}
3555 		else if ( StrICmp(p,(UBYTE *)"noinversetable") == 0 ) {
3556 			AC.modmode &= ~INVERSETABLE;
3557 		}
3558 		else if ( StrICmp(p,(UBYTE *)"nodollars") == 0 ) {
3559 			AC.modmode &= ~ALSODOLLARS;
3560 		}
3561 		else if ( StrICmp(p,(UBYTE *)"alsodollars") == 0 ) {
3562 			AC.modmode |= ALSODOLLARS;
3563 		}
3564 		else if ( StrICmp(p,(UBYTE *)"printpowersof") == 0 ) {
3565 			*inp = c;
3566 			if ( *inp != '(' ) {
3567 badsyntax:
3568 				MesPrint("&Bad syntax in argument of PrintPowersOf(number) in Modulus statement");
3569 				return(1);
3570 			}
3571 			while ( *inp == ',' || *inp == ' ' || *inp == '\t' ) inp++;
3572 			inp++; p = inp;
3573 			if ( FG.cTable[*inp] != 1 ) goto badsyntax;
3574 			do { inp++; } while ( FG.cTable[*inp] == 1 );
3575 			c = *inp; *inp = 0;
3576 			if ( GetLong(p,(UWORD *)AC.powmod,&AC.npowmod) ) Retval = -1;
3577 			if ( TakeModulus((UWORD *)AC.powmod,&AC.npowmod,AC.cmod,AC.ncmod,NOUNPACK) ) Retval = -1;
3578 			if ( AC.npowmod == 0 ) {
3579 				MesPrint("&Improper value for generator");
3580 				Retval = -1;
3581 			}
3582 			if ( MakeModTable() ) Retval = -1;
3583 			AC.DirtPow = 1;
3584 			*inp = c;
3585 			while ( *inp == ',' || *inp == ' ' || *inp == '\t' ) inp++;
3586 			if ( *inp != ')' ) goto badsyntax;
3587 			inp++;
3588 			c = *inp;
3589 		}
3590 		else if ( StrICmp(p,(UBYTE *)"alsopowers") == 0 ) {
3591 			AC.modmode |= ALSOPOWERS;
3592 			sign =  1;
3593 		}
3594 		else if ( StrICmp(p,(UBYTE *)"nopowers") == 0 ) {
3595 			AC.modmode &= ~ALSOPOWERS;
3596 			sign = -1;
3597 		}
3598 		else {
3599 			MesPrint("&Unrecognized option %s in Modulus statement",inp);
3600 			return(1);
3601 		}
3602 		*inp = c;
3603 		while ( *inp == ',' || *inp == ' ' || *inp == '\t' ) inp++;
3604 		if ( *inp == 0 ) {
3605 			MesPrint("&Modulus statement with no value!!!");
3606 			return(1);
3607 		}
3608 	  }
3609 	}
3610 	p = inp;
3611 	if ( FG.cTable[*inp] != 1 ) {
3612 		MesPrint("&Invalid value for modulus:%s",inp);
3613 		if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers");
3614 		AC.modpowers = 0;
3615 		AN.ncmod = AC.ncmod = 0;
3616 		if ( AC.halfmod ) M_free(AC.halfmod,"halfmod");
3617 		AC.halfmod = 0; AC.nhalfmod = 0;
3618 		if ( AC.modinverses ) M_free(AC.modinverses,"modinverses");
3619 		AC.modinverses = 0;
3620 		return(1);
3621 	}
3622 	do { inp++; } while ( FG.cTable[*inp] == 1 );
3623 	c = *inp; *inp = 0;
3624 	Retval = GetLong(p,(UWORD *)AC.cmod,&AC.ncmod);
3625 	if ( Retval == 0 && AC.ncmod == 0 ) goto SwitchOff;
3626 	if ( sign < 0 ) AC.ncmod = -AC.ncmod;
3627 	AN.ncmod = AC.ncmod;
3628 	if ( ( AC.modmode & INVERSETABLE ) != 0 ) MakeInverses();
3629 	if ( AC.halfmod ) M_free(AC.halfmod,"halfmod");
3630 	AC.halfmod = 0; AC.nhalfmod = 0;
3631 	return(Retval);
3632 #endif
3633 }
3634 
3635 /*
3636   	#] CoModulus :
3637   	#[ CoRepeat :
3638 */
3639 
CoRepeat(UBYTE * inp)3640 int CoRepeat(UBYTE *inp)
3641 {
3642 	int error = 0;
3643 	AC.RepSumCheck[AC.RepLevel] = NestingChecksum();
3644 	AC.RepLevel++;
3645 	if ( AC.RepLevel > AM.RepMax ) {
3646 		MesPrint("&Too many repeat levels. Maximum is %d",AM.RepMax);
3647 		return(1);
3648 	}
3649 	Add3Com(TYPEREPEAT,-1)   /* Means indefinite */
3650 	while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
3651 	if ( *inp ) {
3652 		error = CompileStatement(inp);
3653 		if ( CoEndRepeat(inp) ) error = 1;
3654 	}
3655 	return(error);
3656 }
3657 
3658 /*
3659   	#] CoRepeat :
3660   	#[ CoEndRepeat :
3661 */
3662 
CoEndRepeat(UBYTE * inp)3663 int CoEndRepeat(UBYTE *inp)
3664 {
3665 	CBUF *C = cbuf+AC.cbufnum;
3666 	int level, error = 0, repeatlevel = 0;
3667 	DUMMYUSE(inp);
3668 	AC.RepLevel--;
3669 	if ( AC.RepLevel < 0 ) {
3670 		MesPrint("&EndRepeat without Repeat");
3671 		AC.RepLevel = 0;
3672 		return(1);
3673 	}
3674 	else if ( AC.RepSumCheck[AC.RepLevel] != NestingChecksum() ) {
3675 		MesNesting();
3676 		error = 1;
3677 	}
3678 	level = C->numlhs+1;
3679 	while ( level > 0 ) {
3680 		if ( C->lhs[--level][0] == TYPEREPEAT ) {
3681 			if ( repeatlevel == 0 ) {
3682 				Add3Com(TYPEENDREPEAT,level)
3683 				return(error);
3684 			}
3685 			repeatlevel--;
3686 		}
3687 		else if ( C->lhs[level][0] == TYPEENDREPEAT ) repeatlevel++;
3688 	}
3689 	return(1);
3690 }
3691 
3692 /*
3693   	#] CoEndRepeat :
3694   	#[ DoBrackets :
3695 
3696 		Reads in the bracket information.
3697 		Storage is in the form of a regular term.
3698 		No subterms and arguments are allowed.
3699 */
3700 
DoBrackets(UBYTE * inp,int par)3701 int DoBrackets(UBYTE *inp, int par)
3702 {
3703 	GETIDENTITY
3704 	UBYTE *p, *pp, c;
3705 	WORD *to, i, type, *w, error = 0;
3706 	WORD c1,c2, *WorkSave;
3707 	int biflag;
3708 	p = inp;
3709 	WorkSave = to = AT.WorkPointer;
3710 	to++;
3711 	if ( AT.BrackBuf == 0 ) {
3712 		AR.MaxBracket = 100;
3713 		AT.BrackBuf = (WORD *)Malloc1(sizeof(WORD)*(AR.MaxBracket+1),"bracket buffer");
3714 	}
3715 	*AT.BrackBuf = 0;
3716 	AR.BracketOn = 0;
3717 	AC.bracketindexflag = 0;
3718 	AT.bracketindexflag = 0;
3719 	if ( *p == '+' || *p == '-' ) p++;
3720 	if ( p[-1] == ',' && *p ) p--;
3721 	if ( p[-1] == '+' && *p ) { biflag = 1;  if ( *p != ',' ) { *--p = ','; } }
3722 	else if ( p[-1] == '-' && *p ) { biflag = -1; if ( *p != ',' ) { *--p = ','; } }
3723 	else biflag = 0;
3724 	while ( *p == ',' ) {
3725 redo:	AR.BracketOn++;
3726 		while ( *p == ',' ) p++;
3727 		if ( *p == 0 ) break;
3728 		if ( *p == '0' ) {
3729 			p++; while ( *p == '0' ) p++;
3730 			continue;
3731 		}
3732 		inp = pp = p;
3733 		p = SkipAName(p);
3734 		if ( p == 0 ) return(1);
3735 		c = *p;
3736 		*p = 0;
3737 		type = GetName(AC.varnames,inp,&c1,WITHAUTO);
3738 		if ( c == '.' ) {
3739 			if ( type == CVECTOR || type == CDUBIOUS ) {
3740 				*p++ = c;
3741 				inp = p;
3742 				p = SkipAName(p);
3743 				if ( p == 0 ) return(1);
3744 				c = *p;
3745 				*p = 0;
3746 				type = GetName(AC.varnames,inp,&c2,WITHAUTO);
3747 				if ( type != CVECTOR && type != CDUBIOUS ) {
3748 					MesPrint("&Not a vector in dotproduct in bracket statement: %s",inp);
3749 					error = 1;
3750 				}
3751 				else type = CDOTPRODUCT;
3752 			}
3753 			else {
3754 				MesPrint("&Illegal use of . after %s in bracket statement",inp);
3755 				error = 1;
3756 				*p++ = c;
3757 				goto redo;
3758 			}
3759 		}
3760 		switch ( type ) {
3761 			case CSYMBOL :
3762 				*to++ = SYMBOL; *to++ = 4; *to++ = c1; *to++ = 1; break;
3763 			case CVECTOR :
3764 				*to++ = INDEX; *to++ = 3; *to++ = AM.OffsetVector + c1; break;
3765 			case CFUNCTION :
3766 				*to++ = c1+FUNCTION; *to++ = FUNHEAD; *to++ = 0;
3767 				FILLFUN3(to)
3768 				break;
3769 			case CDOTPRODUCT :
3770 				*to++ = DOTPRODUCT; *to++ = 5; *to++ = c1 + AM.OffsetVector;
3771 				*to++ = c2 + AM.OffsetVector; *to++ = 1; break;
3772 			case CDELTA :
3773 				*to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX; break;
3774 			case CSET :
3775 				*to++ = SETSET; *to++ = 4; *to++ = c1; *to++ = Sets[c1].type; break;
3776 			default :
3777 				MesPrint("&Illegal bracket request for %s",pp);
3778 				error = 1; break;
3779 		}
3780 		*p = c;
3781 	}
3782 	if ( *p ) {
3783 		MesCerr("separator",p);
3784 		AC.BracketNormalize = 0;
3785 		AT.WorkPointer = WorkSave;
3786 		error = 1;
3787 		return(error);
3788 	}
3789 	*to++ = 1; *to++ = 1; *to++ = 3;
3790 	*AT.WorkPointer = to - AT.WorkPointer;
3791 	AT.WorkPointer = to;
3792 	AC.BracketNormalize = 1;
3793 	if ( BracketNormalize(BHEAD WorkSave) ) { error = 1; AR.BracketOn = 0; }
3794 	else {
3795 		w = WorkSave;
3796 		if ( *w == 4 || !*w ) { AR.BracketOn = 0; }
3797 		else {
3798 			i = *(w+*w-1);
3799 			if ( i < 0 ) i = -i;
3800 			*w -= i;
3801 			i = *w;
3802 			if ( i > AR.MaxBracket ) {
3803 				WORD *newbuf;
3804 				newbuf = (WORD *)Malloc1(sizeof(WORD)*(i+1),"bracket buffer");
3805 				AR.MaxBracket = i;
3806 				if ( AT.BrackBuf != 0 ) M_free(AT.BrackBuf,"bracket buffer");
3807 				AT.BrackBuf = newbuf;
3808 			}
3809 			to = AT.BrackBuf;
3810 			NCOPY(to,w,i);
3811 		}
3812 	}
3813 	AC.BracketNormalize = 0;
3814 	if ( par == 1 ) AR.BracketOn = -AR.BracketOn;
3815 	if ( error == 0 ) {
3816 		AC.bracketindexflag = biflag;
3817 		AT.bracketindexflag = biflag;
3818 	}
3819 	AT.WorkPointer = WorkSave;
3820 	return(error);
3821 }
3822 
3823 /*
3824   	#] DoBrackets :
3825   	#[ CoBracket :
3826 */
3827 
CoBracket(UBYTE * inp)3828 int CoBracket(UBYTE *inp)
3829 { return(DoBrackets(inp,0)); }
3830 
3831 /*
3832   	#] CoBracket :
3833   	#[ CoAntiBracket :
3834 */
3835 
CoAntiBracket(UBYTE * inp)3836 int CoAntiBracket(UBYTE *inp)
3837 { return(DoBrackets(inp,1)); }
3838 
3839 /*
3840   	#] CoAntiBracket :
3841   	#[ CoMultiBracket :
3842 
3843 	Syntax:
3844 		MultiBracket:{A|B} bracketinfo:...:{A|B} bracketinfo;
3845 */
3846 
CoMultiBracket(UBYTE * inp)3847 int CoMultiBracket(UBYTE *inp)
3848 {
3849 	GETIDENTITY
3850 	int i, error = 0, error1, type, num;
3851 	UBYTE *s, c;
3852 	WORD *to, *from;
3853 
3854 	if ( *inp != ':' ) {
3855 		MesPrint("&Illegal Multiple Bracket separator: %s",inp);
3856 		return(1);
3857 	}
3858 	inp++;
3859 	if ( AC.MultiBracketBuf == 0 ) {
3860 		AC.MultiBracketBuf = (WORD **)Malloc1(sizeof(WORD *)*MAXMULTIBRACKETLEVELS,"multi bracket buffer");
3861 		for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
3862 			AC.MultiBracketBuf[i] = 0;
3863 		}
3864 	}
3865 	else {
3866 	  for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
3867 		if ( AC.MultiBracketBuf[i] ) {
3868 			M_free(AC.MultiBracketBuf[i],"bracket buffer i");
3869 			AC.MultiBracketBuf[i] = 0;
3870 		}
3871 	  }
3872 	  AC.MultiBracketLevels = 0;
3873 	}
3874 	AC.MultiBracketLevels = 0;
3875 /*
3876 		Start with disabling the regular brackets.
3877 */
3878 	if ( AT.BrackBuf == 0 ) {
3879 		AR.MaxBracket = 100;
3880 		AT.BrackBuf = (WORD *)Malloc1(sizeof(WORD)*(AR.MaxBracket+1),"bracket buffer");
3881 	}
3882 	*AT.BrackBuf = 0;
3883 	AR.BracketOn = 0;
3884 	AC.bracketindexflag = 0;
3885 	AT.bracketindexflag = 0;
3886 /*
3887 	Now loop through the various levels, separated by the colons.
3888 */
3889 	for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
3890 		if ( *inp == 0 ) goto RegEnd;
3891 /*
3892 		1: skip to ':', determine bracket or antibracket
3893 */
3894 		s = inp;
3895 		while ( *s && *s != ':' ) {
3896 			if ( *s == '[' ) { SKIPBRA1(s) s++; }
3897 			else if ( *s == '{' ) { SKIPBRA2(s) s++; }
3898 			else s++;
3899 		}
3900 		c = *s; *s = 0;
3901 		if ( StrICont(inp,(UBYTE *)"antibrackets") == 0 ) { type = 1; }
3902 		else if ( StrICont(inp,(UBYTE *)"brackets") == 0 ) { type = 0; }
3903 		else {
3904 			MesPrint("&Illegal (anti)bracket specification in MultiBracket statement");
3905 			if ( error == 0 ) error = 1;
3906 			goto NextLevel;
3907 		}
3908 		while ( FG.cTable[*inp] == 0 ) inp++;
3909 		if ( *inp != ',' ) {
3910 			MesPrint("&Illegal separator after (anti)bracket specification in MultiBracket statement");
3911 			if ( error == 0 ) error = 1;
3912 			goto NextLevel;
3913 		}
3914 		inp++;
3915 /*
3916 		2: call DoBrackets.
3917 */
3918 		error1 = DoBrackets(inp, type);
3919 		if ( error < 0 ) return(error1);
3920 		if ( error1 > error ) error = error1;
3921 /*
3922 		3: copy bracket information to the multi bracket arrays
3923 */
3924 		if ( AR.BracketOn ) {
3925 			num = AT.BrackBuf[0];
3926 			to = AC.MultiBracketBuf[i] = (WORD *)Malloc1((num+2)*sizeof(WORD),"bracket buffer i");
3927 			from = AT.BrackBuf;
3928 			*to++ = AR.BracketOn;
3929 			NCOPY(to,from,num);
3930 			*to = 0;
3931 		}
3932 /*
3933 		4: set ready for the next level
3934 */
3935 NextLevel:
3936 		*s = c; if ( c == ':' ) s++;
3937 		inp = s;
3938 		*AT.BrackBuf = 0;
3939 		AR.BracketOn = 0;
3940 	}
3941 	if ( *inp != 0 ) {
3942 		MesPrint("&More than %d levels in MultiBracket statement",(WORD)MAXMULTIBRACKETLEVELS);
3943 		if ( error == 0 ) error = 1;
3944 	}
3945 RegEnd:
3946 	AC.MultiBracketLevels = i;
3947 	*AT.BrackBuf = 0;
3948 	AR.BracketOn = 0;
3949 	AC.bracketindexflag = 0;
3950 	AT.bracketindexflag = 0;
3951 	return(error);
3952 }
3953 
3954 /*
3955   	#] CoMultiBracket :
3956   	#[ CountComp :
3957 
3958 		This routine reads the count statement. The syntax is:
3959 		count minimum,object,size[,object,size]
3960 		Objects can be:
3961 			symbol
3962 			dotproduct
3963 			vector
3964 			function
3965 		Vectors can have the auxiliary flags:
3966 			+v +f +d +?setname
3967 
3968 		Output for the compiler:
3969 		TYPECOUNT,size,minimum,objects
3970 		with the objects:
3971 		SYMBOL,4,number,size
3972 		DOTPRODUCT,5,v1,v2,size
3973 		FUNCTION,4,number,size
3974 		VECTOR,5,number,bits,size or VECTOR,6,number,bits,setnumber,size
3975 
3976 		Currently only used in the if statement
3977 */
3978 
CountComp(UBYTE * inp,WORD * to)3979 WORD *CountComp(UBYTE *inp, WORD *to)
3980 {
3981 	GETIDENTITY
3982 	UBYTE *p, c;
3983 	WORD *w, mini = 0, type, c1, c2;
3984 	int error = 0;
3985 	p = inp;
3986 	w = to;
3987 	AR.Eside = 2;
3988 	*w++ = TYPECOUNT;
3989 	*w++ = 0;
3990 	*w++ = 0;
3991 	while ( *p == ',' ) {
3992 		p++; inp = p;
3993 		if ( *p == '[' || FG.cTable[*p] == 0 ) {
3994 			if ( ( p = SkipAName(inp) ) == 0 ) return(0);
3995 			c = *p; *p = 0;
3996 			type = GetName(AC.varnames,inp,&c1,WITHAUTO);
3997 			if ( c == '.' ) {
3998 				if ( type == CVECTOR || type == CDUBIOUS ) {
3999 					*p++ = c;
4000 					inp = p;
4001 					p = SkipAName(p);
4002 					if ( p == 0 ) return(0);
4003 					c = *p;
4004 					*p = 0;
4005 					type = GetName(AC.varnames,inp,&c2,WITHAUTO);
4006 					if ( type != CVECTOR && type != CDUBIOUS ) {
4007 						MesPrint("&Not a vector in dotproduct in if statement: %s",inp);
4008 						error = 1;
4009 					}
4010 					else type = CDOTPRODUCT;
4011 				}
4012 				else {
4013 					MesPrint("&Illegal use of . after %s in if statement",inp);
4014 					if ( type == NAMENOTFOUND )
4015 						MesPrint("&%s is not a properly declared variable",inp);
4016 					error = 1;
4017 					*p++ = c;
4018 					while ( *p && *p != ')' && *p != ',' ) p++;
4019 					if ( *p == ',' && FG.cTable[p[1]] == 1 ) {
4020 						p++;
4021 						while ( *p && *p != ')' && *p != ',' ) p++;
4022 					}
4023 					continue;
4024 				}
4025 			}
4026 			*p = c;
4027 			switch ( type ) {
4028 				case CSYMBOL:
4029 					*w++ = SYMBOL; *w++ = 4; *w++ = c1;
4030 Sgetnum:			if ( *p != ',' ) {
4031 						MesCerr("sequence",p);
4032 						while ( *p && *p != ')' && *p != ',' ) p++;
4033 						error = 1;
4034 					}
4035 					p++; inp = p;
4036 					ParseSignedNumber(mini,p)
4037 					if ( FG.cTable[p[-1]] != 1 || ( *p && *p != ')' && *p != ',' ) ) {
4038 						while ( *p && *p != ')' && *p != ',' ) p++;
4039 						error = 1;
4040 						c = *p; *p = 0;
4041 						MesPrint("&Improper value in count: %s",inp);
4042 						*p = c;
4043 						while ( *p && *p != ')' && *p != ',' ) p++;
4044 					}
4045 					*w++ = mini;
4046 					break;
4047 				case CFUNCTION:
4048 					*w++ = FUNCTION; *w++ = 4; *w++ = c1+FUNCTION; goto Sgetnum;
4049 				case CDOTPRODUCT:
4050 					*w++ = DOTPRODUCT; *w++ = 5;
4051 					*w++ = c2 + AM.OffsetVector;
4052 					*w++ = c1 + AM.OffsetVector;
4053 					goto Sgetnum;
4054 				case CVECTOR:
4055 					*w++ = VECTOR; *w++ = 5;
4056 					*w++ = c1 + AM.OffsetVector;
4057 					if ( *p == ',' ) {
4058 						*w++ = VECTBIT | DOTPBIT | FUNBIT;
4059 						goto Sgetnum;
4060 					}
4061 					else if ( *p == '+' ) {
4062 						p++;
4063 						*w = 0;
4064 						while ( *p && *p != ',' ) {
4065 							if ( *p == 'v' || *p == 'V' ) {
4066 								*w |= VECTBIT; p++;
4067 							}
4068 							else if ( *p == 'd' || *p == 'D' ) {
4069 								*w |= DOTPBIT; p++;
4070 							}
4071 							else if ( *p == 'f' || *p == 'F'
4072 							|| *p == 't' || *p == 'T' ) {
4073 								*w |= FUNBIT; p++;
4074 							}
4075 							else if ( *p == '?' ) {
4076 								p++; inp = p;
4077 								if ( *p == '{' ) { /* } */
4078 									SKIPBRA2(p)
4079 									if ( p == 0 ) return(0);
4080 									if ( ( c1 = DoTempSet(inp+1,p) ) < 0 ) return(0);
4081 									if ( Sets[c1].type != CFUNCTION ) {
4082 										MesPrint("&set type conflict: Function expected");
4083 										return(0);
4084 									}
4085 									type = CSET;
4086 									c = *++p;
4087 								}
4088 								else {
4089 									p = SkipAName(p);
4090 									if ( p == 0 ) return(0);
4091 									c = *p; *p = 0;
4092 									type = GetName(AC.varnames,inp,&c1,WITHAUTO);
4093 								}
4094 								if ( type != CSET && type != CDUBIOUS ) {
4095 									MesPrint("&%s is not a set",inp);
4096 									error = 1;
4097 								}
4098 								w[-2] = 6;
4099 								*w++ |= SETBIT;
4100 								*w++ = c1;
4101 								*p = c;
4102 								goto Sgetnum;
4103 							}
4104 							else {
4105 								MesCerr("specifier for vector",p);
4106 								error = 1;
4107 							}
4108 						}
4109 						w++;
4110 						goto Sgetnum;
4111 					}
4112 					else {
4113 						MesCerr("specifier for vector",p);
4114 						while ( *p && *p != ')' && *p != ',' ) p++;
4115 						error = 1;
4116 						*w++ = VECTBIT | DOTPBIT | FUNBIT;
4117 						goto Sgetnum;
4118 					}
4119 				case CDUBIOUS:
4120 					goto skipfield;
4121 				default:
4122 					*p = 0;
4123 					MesPrint("&%s is not a symbol, function, vector or dotproduct",inp);
4124 					error = 1;
4125 skipfield:			while ( *p && *p != ')' && *p != ',' ) p++;
4126 					if ( *p && FG.cTable[p[1]] == 1 ) {
4127 						p++;
4128 						while ( *p && *p != ')' && *p != ',' ) p++;
4129 					}
4130 					break;
4131 			}
4132 		}
4133 		else {
4134 			MesCerr("name",p);
4135 			while ( *p && *p != ',' ) p++;
4136 			error = 1;
4137 		}
4138 	}
4139 	to[1] = w-to;
4140 	if ( *p == ')' ) p++;
4141 	if ( *p ) { MesCerr("end of statement",p); return(0); }
4142 	if ( error ) return(0);
4143 	return(w);
4144 }
4145 
4146 /*
4147   	#] CountComp :
4148   	#[ CoIf :
4149 
4150 		Reads the if statement: There must be a pair of parentheses.
4151 		Much work is delegated to the routines in compi2 and CountComp.
4152 		The goto is kept hanging as it is forward.
4153 		The address in which the label must be written is pushed on
4154 		the AC.IfStack.
4155 
4156 		Here we allow statements of the type
4157 		if ( condition ) single statement;
4158 		compile the if statement.
4159 		test character at end
4160 		if not ; or )
4161 		copy the statement after the proper parenthesis to the
4162 		beginning of the AC.iBuffer.
4163 		Have it compiled.
4164 		generate an endif statement.
4165 */
4166 
4167 static UWORD *CIscratC = 0;
4168 
CoIf(UBYTE * inp)4169 int CoIf(UBYTE *inp)
4170 {
4171 	GETIDENTITY
4172 	int error = 0, level;
4173 	WORD *w, *ww, *u, *s, *OldWork, *OldSpace = AT.WorkSpace;
4174 	WORD gotexp = 0;		/* Indicates whether there can be a condition */
4175 	WORD lenpp, lenlev, ncoef, i, number;
4176 	UBYTE *p, *pp, *ppp, c;
4177 	CBUF *C = cbuf+AC.cbufnum;
4178 	LONG x;
4179 	if ( *inp == '(' && inp[1] == ',' ) inp += 2;
4180 	else if ( *inp == '(' ) inp++;	/* Usually we enter at the bracket */
4181 
4182 	if ( CIscratC == 0 )
4183 		CIscratC = (UWORD *)Malloc1((AM.MaxTal+2)*sizeof(UWORD),"CoIf");
4184 	lenpp = 0;
4185 	lenlev = 1;
4186 	if ( AC.IfLevel >= AC.MaxIf ) DoubleIfBuffers();
4187 	AC.IfCount[lenpp++] = 0;
4188 /*
4189 	IfStack is used for organizing the 'go to' for the various if levels
4190 */
4191 	*AC.IfStack++ = C->Pointer-C->Buffer+2;
4192 /*
4193 	IfSumCheck is used to test for illegal nesting of if, argument or repeat.
4194 */
4195 	AC.IfSumCheck[AC.IfLevel] = NestingChecksum();
4196 	AC.IfLevel++;
4197 	w = OldWork = AT.WorkPointer;
4198 	*w++ = TYPEIF;
4199 	w += 2;
4200 	p = inp;
4201 	for(;;) {
4202 		inp = p;
4203 		level = 0;
4204 ReDo:
4205 		if ( FG.cTable[*p] == 1 ) {		/* Number */
4206 			if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4207 			u = w;
4208 			*w++ = LONGNUMBER;
4209 			w += 2;
4210 			if ( GetLong(p,(UWORD *)w,&ncoef) ) { ncoef = 1; error = 1; }
4211 			w[-1] = ncoef;
4212 			while ( FG.cTable[*++p] == 1 );
4213 			if ( *p == '/' ) {
4214 				p++;
4215 				if ( FG.cTable[*p] != 1 ) {
4216 					MesCerr("sequence",p); error = 1; goto OnlyNum;
4217 				}
4218 				if ( GetLong(p,CIscratC,&ncoef) ) {
4219 					ncoef = 1; error = 1;
4220 				}
4221 				while ( FG.cTable[*++p] == 1 );
4222 				if ( ncoef == 0 ) {
4223 					MesPrint("&Division by zero!");
4224 					error = 1;
4225 				}
4226 				else {
4227 					if ( w[-1] != 0 ) {
4228 						if ( Simplify(BHEAD (UWORD *)w,(WORD *)(w-1),
4229 						CIscratC,&ncoef) ) error = 1;
4230 						else {
4231 							i = w[-1];
4232 							if ( i >= ncoef ) {
4233 								i = w[-1];
4234 								w += i;
4235 								i -= ncoef;
4236 								s = (WORD *)CIscratC;
4237 								NCOPY(w,s,ncoef);
4238 								while ( --i >= 0 ) *w++ = 0;
4239 							}
4240 							else {
4241 								w += i;
4242 								i = ncoef - i;
4243 								while ( --i >= 0 ) *w++ = 0;
4244 								s = (WORD *)CIscratC;
4245 								NCOPY(w,s,ncoef);
4246 							}
4247 						}
4248 					}
4249 				}
4250 			}
4251 			else {
4252 OnlyNum:
4253 				w += ncoef;
4254 				if ( ncoef > 0 ) {
4255 					ncoef--; *w++ = 1;
4256 					while ( --ncoef >= 0 ) *w++ = 0;
4257 				}
4258 			}
4259 			u[1] = WORDDIF(w,u);
4260 			u[2] = (u[1] - 3)/2;
4261 			if ( level ) u[2] = -u[2];
4262 			gotexp = 1;
4263 		}
4264 		else if ( *p == '+' ) { p++; goto ReDo; }
4265 		else if ( *p == '-' ) { level ^= 1; p++; goto ReDo; }
4266 		else if ( *p == 'c' || *p == 'C' ) {	/* Count or Coefficient */
4267 			if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4268 			while ( FG.cTable[*++p] == 0 );
4269 			c = *p; *p = 0;
4270 			if ( !StrICmp(inp,(UBYTE *)"count") ) {
4271 				*p = c;
4272 				if ( c != '(' ) {
4273 					MesPrint("&no ( after count");
4274 					error = 1;
4275 					goto endofif;
4276 				}
4277 				inp = p;
4278 				SKIPBRA4(p);
4279 				c = *++p; *p = 0; *inp = ',';
4280 				w = CountComp(inp,w);
4281 				*p = c; *inp = '(';
4282 				if ( w == 0 ) { error = 1; goto endofif; }
4283 				gotexp = 1;
4284 			}
4285 			else if ( ConWord(inp,(UBYTE *)"coefficient") && ( p - inp ) > 3 ) {
4286 				*w++ = COEFFI;
4287 				*w++ = 2;
4288 				*p = c;
4289 				gotexp = 1;
4290 			}
4291 			else goto NoGood;
4292 			inp = p;
4293 		}
4294 		else if ( *p == 'm' || *p == 'M' ) {	/* match */
4295 			if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4296 			while ( !FG.cTable[*++p] );
4297 			c = *p; *p = 0;
4298 			if ( !StrICmp(inp,(UBYTE *)"match") ) {
4299 				*p = c;
4300 				if ( c != '(' ) {
4301 					MesPrint("&no ( after match");
4302 					error = 1;
4303 					goto endofif;
4304 				}
4305 				p++; inp = p;
4306 				SKIPBRA4(p);
4307 				*p = '=';
4308 /*
4309 				Now we can call the reading of the lhs of an id statement.
4310 				This has to be modified in the future.
4311 */
4312 				AT.WorkSpace = AT.WorkPointer = w;
4313 				ppp = inp;
4314 				while ( FG.cTable[*ppp] == 0 && ppp < p ) ppp++;
4315 				if ( *ppp == ',' ) AC.idoption = 0;
4316 				else AC.idoption = SUBMULTI;
4317 				level = CoIdExpression(inp,TYPEIF);
4318 				AT.WorkSpace = OldSpace;
4319 				AT.WorkPointer = OldWork;
4320 				if ( level != 0 ) {
4321 					if ( level < 0 ) { error = -1; goto endofif; }
4322 					error = 1;
4323 				}
4324 /*
4325 				If we pop numlhs we are in good shape
4326 */
4327 				s = u = C->lhs[C->numlhs];
4328 				while ( u < C->Pointer ) *w++ = *u++;
4329 				C->numlhs--; C->Pointer = s;
4330 				*p++ = ')';
4331 				inp = p;
4332 				gotexp = 1;
4333 			}
4334 			else if ( !StrICmp(inp,(UBYTE *)"multipleof") ) {
4335 			if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4336 				*p = c;
4337 				if ( c != '(' ) {
4338 					MesPrint("&no ( after multipleof");
4339 					error = 1; goto endofif;
4340 				}
4341 				p++;
4342 				if ( FG.cTable[*p] != 1 ) {
4343 Nomulof:			MesPrint("&multipleof needs a short positive integer argument");
4344 					error = 1; goto endofif;
4345 				}
4346 				ParseNumber(x,p)
4347 				if ( *p != ')' || x <= 0 || x > MAXPOSITIVE ) goto Nomulof;
4348 				p++;
4349 				*w++ = MULTIPLEOF; *w++ = 3; *w++ = (WORD)x;
4350 				inp = p;
4351 				gotexp = 1;
4352 			}
4353 			else {
4354 NoGood:			MesPrint("&Unrecognized word: %s",inp);
4355 				*p = c;
4356 				error = 1;
4357 				level = 0;
4358 				if ( c == '(' ) SKIPBRA4(p)
4359 				inp = ++p;
4360 				gotexp = 1;
4361 			}
4362 		}
4363 		else if ( *p == 'f' || *p == 'F' ) {	/* FindLoop */
4364 			if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4365 			while ( FG.cTable[*++p] == 0 );
4366 			c = *p; *p = 0;
4367 			if ( !StrICmp(inp,(UBYTE *)"findloop") ) {
4368 				*p = c;
4369 				if ( c != '(' ) {
4370 					MesPrint("&no ( after findloop");
4371 					error = 1;
4372 					goto endofif;
4373 				}
4374 				inp = p;
4375 				SKIPBRA4(p);
4376 				c = *++p; *p = 0; *inp = ',';
4377 				if ( CoFindLoop(inp) ) goto endofif;
4378 				s = u = C->lhs[C->numlhs];
4379 				while ( u < C->Pointer ) *w++ = *u++;
4380 				C->numlhs--; C->Pointer = s;
4381 				*p = c; *inp = '(';
4382 				if ( w == 0 ) { error = 1; goto endofif; }
4383 				gotexp = 1;
4384 			}
4385 			else goto NoGood;
4386 			inp = p;
4387 		}
4388 		else if ( *p == 'e' || *p == 'E' ) { /* Expression */
4389 			if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4390 			while ( FG.cTable[*++p] == 0 );
4391 			c = *p; *p = 0;
4392 			if ( !StrICmp(inp,(UBYTE *)"expression") ) {
4393 				*p = c;
4394 				if ( c != '(' ) {
4395 					MesPrint("&no ( after expression");
4396 					error = 1;
4397 					goto endofif;
4398 				}
4399 				p++; ww = w; *w++ = IFEXPRESSION; w++;
4400 				while ( *p != ')' ) {
4401 					if ( *p == ',' ) { p++; continue; }
4402 					if ( *p == '[' || FG.cTable[*p] == 0 ) {
4403 						pp = p;
4404 						if ( ( p = SkipAName(p) ) == 0 ) {
4405 							MesPrint("&Improper name for an expression: '%s'",pp);
4406 							error = 1;
4407 							goto endofif;
4408 						}
4409 						c = *p; *p = 0;
4410 						if ( GetName(AC.exprnames,pp,&number,NOAUTO) == CEXPRESSION ) {
4411 							*w++ = number;
4412 						}
4413 						else if ( GetName(AC.varnames,pp,&number,NOAUTO) != NAMENOTFOUND ) {
4414 							MesPrint("&%s is not an expression",pp);
4415 							error = 1;
4416 							*w++ = number;
4417 						}
4418 						*p = c;
4419 					}
4420 					else {
4421 						MesPrint("&Illegal object in Expression in if-statement");
4422 						error = 1;
4423 						while ( *p && *p != ',' && *p != ')' ) p++;
4424 						if ( *p == 0 || *p == ')' ) break;
4425 					}
4426 				}
4427 				ww[1] = w - ww;
4428 				p++;
4429 				gotexp = 1;
4430 			}
4431 			else goto NoGood;
4432 			inp = p;
4433 		}
4434 		else if ( *p == 'i' || *p == 'I' ) { /* IsFactorized */
4435 			if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4436 			while ( FG.cTable[*++p] == 0 );
4437 			c = *p; *p = 0;
4438 			if ( !StrICmp(inp,(UBYTE *)"isfactorized") ) {
4439 				*p = c;
4440 				if ( c != '(' ) { /* No expression means current expression */
4441 				  ww = w; *w++ = IFISFACTORIZED; w++;
4442 				}
4443 				else {
4444 				  p++; ww = w; *w++ = IFISFACTORIZED; w++;
4445 				  while ( *p != ')' ) {
4446 					if ( *p == ',' ) { p++; continue; }
4447 					if ( *p == '[' || FG.cTable[*p] == 0 ) {
4448 						pp = p;
4449 						if ( ( p = SkipAName(p) ) == 0 ) {
4450 							MesPrint("&Improper name for an expression: '%s'",pp);
4451 							error = 1;
4452 							goto endofif;
4453 						}
4454 						c = *p; *p = 0;
4455 						if ( GetName(AC.exprnames,pp,&number,NOAUTO) == CEXPRESSION ) {
4456 							*w++ = number;
4457 						}
4458 						else if ( GetName(AC.varnames,pp,&number,NOAUTO) != NAMENOTFOUND ) {
4459 							MesPrint("&%s is not an expression",pp);
4460 							error = 1;
4461 							*w++ = number;
4462 						}
4463 						*p = c;
4464 					}
4465 					else {
4466 						MesPrint("&Illegal object in IsFactorized in if-statement");
4467 						error = 1;
4468 						while ( *p && *p != ',' && *p != ')' ) p++;
4469 						if ( *p == 0 || *p == ')' ) break;
4470 					}
4471 				  }
4472 				  p++;
4473 				}
4474 				ww[1] = w - ww;
4475 				gotexp = 1;
4476 			}
4477 			else goto NoGood;
4478 			inp = p;
4479 		}
4480 		else if ( *p == 'o' || *p == 'O' ) { /* Occurs */
4481 /*
4482 			Tests whether variables occur inside a term.
4483 			At the moment this is done one by one.
4484 			If we want to do them in groups we should do the reading
4485 			a bit different: each as a variable in a term, and then
4486 			use Normalize to get the variables grouped and in order.
4487 			That way FindVar (in if.c) can work more efficiently.
4488 			Still to be done!!!
4489 			TASK: Nice little task for someone to learn.
4490 */
4491 			UBYTE cc;
4492 			if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4493 			while ( FG.cTable[*++p] == 0 );
4494 			c = cc = *p; *p = 0;
4495 			if ( !StrICmp(inp,(UBYTE *)"occurs") ) {
4496 				WORD c1, c2, type;
4497 				*p = cc;
4498 				if ( cc != '(' ) {
4499 					MesPrint("&no ( after occurs");
4500 					error = 1;
4501 					goto endofif;
4502 				}
4503 				inp = p;
4504 				SKIPBRA4(p);
4505 				cc = *++p; *p = 0; *inp = ','; pp = p;
4506 				ww = w;
4507 				*w++ = IFOCCURS; *w++ = 0;
4508 				while ( *inp ) {
4509 					while ( *inp == ',' ) inp++;
4510 					if ( *inp == 0 || *inp == ')' ) break;
4511 /*
4512 					Now read a list of names
4513 					We can have symbols, vectors, dotproducts, indices, functions.
4514 					There could also be dummy indices and/or extra symbols.
4515 */
4516 					if ( *inp == '[' || FG.cTable[*inp] == 0 ) {
4517 						if ( ( p = SkipAName(inp) ) == 0 ) return(0);
4518 						c = *p; *p = 0;
4519 						type = GetName(AC.varnames,inp,&c1,WITHAUTO);
4520 						if ( c == '.' ) {
4521 							if ( type == CVECTOR || type == CDUBIOUS ) {
4522 								*p++ = c;
4523 								inp = p;
4524 								p = SkipAName(p);
4525 								if ( p == 0 ) return(0);
4526 								c = *p;
4527 								*p = 0;
4528 								type = GetName(AC.varnames,inp,&c2,WITHAUTO);
4529 								if ( type != CVECTOR && type != CDUBIOUS ) {
4530 									MesPrint("&Not a vector in dotproduct in if statement: %s",inp);
4531 									error = 1;
4532 								}
4533 								else type = CDOTPRODUCT;
4534 							}
4535 							else {
4536 								MesPrint("&Illegal use of . after %s in if statement",inp);
4537 								if ( type == NAMENOTFOUND )
4538 									MesPrint("&%s is not a properly declared variable",inp);
4539 								error = 1;
4540 								*p++ = c;
4541 								while ( *p && *p != ')' && *p != ',' ) p++;
4542 								if ( *p == ',' && FG.cTable[p[1]] == 1 ) {
4543 									p++;
4544 									while ( *p && *p != ')' && *p != ',' ) p++;
4545 								}
4546 								continue;
4547 							}
4548 						}
4549 						*p = c;
4550 						switch ( type ) {
4551 							case CSYMBOL: /* To worry about extra symbols */
4552 								*w++ = SYMBOL;
4553 								*w++ = c1;
4554 							break;
4555 							case CINDEX:
4556 								*w++ = INDEX;
4557 								*w++ = c1 + AM.OffsetIndex;
4558 							break;
4559 							case CVECTOR:
4560 								*w++ = VECTOR;
4561 								*w++ = c1 + AM.OffsetVector;
4562 							break;
4563 							case CDOTPRODUCT:
4564 								*w++ = DOTPRODUCT;
4565 								*w++ = c1 + AM.OffsetVector;
4566 								*w++ = c2 + AM.OffsetVector;
4567 							break;
4568 							case CFUNCTION:
4569 								*w++ = FUNCTION;
4570 								*w++ = c1+FUNCTION;
4571 							break;
4572 							default:
4573 								MesPrint("&Illegal variable %s in occurs condition in if statement",inp);
4574 								error = 1;
4575 							break;
4576 						}
4577 						inp = p;
4578 					}
4579 					else {
4580 						MesPrint("&Illegal object %s in occurs condition in if statement",inp);
4581 						error = 1;
4582 						break;
4583 					}
4584 				}
4585 				ww[1] = w-ww;
4586 				p = pp; *p = cc; *inp = '(';
4587 				gotexp = 1;
4588 				if ( ww[1] <= 2 ) {
4589 					MesPrint("&The occurs condition in the if statement needs arguments.");
4590 					error = 1;
4591 				}
4592 			}
4593 			else goto NoGood;
4594 			inp = p;
4595 		}
4596 		else if ( *p == '$' ) {
4597 			if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
4598 			p++; inp = p;
4599 			while ( FG.cTable[*p] == 0 || FG.cTable[*p] == 1 ) p++;
4600 			c = *p; *p = 0;
4601 			if ( ( i = GetDollar(inp) ) < 0 ) {
4602 				MesPrint("&undefined dollar expression %s",inp);
4603 				error = 1;
4604 				i = AddDollar(inp,DOLUNDEFINED,0,0);
4605 			}
4606 			*p = c;
4607 			*w++ = IFDOLLAR; *w++ = 3; *w++ = i;
4608 /*
4609 			And then the IFDOLLAREXTRA pieces for [1] [$y] etc
4610 */
4611 			if ( *p == '[' ) {
4612 				p++;
4613 				if ( ( w = GetIfDollarFactor(&p,w) ) == 0 ) {
4614 					error = 1;
4615 					goto endofif;
4616 				}
4617 				else if ( *p != ']' ) {
4618 					error = 1;
4619 					goto endofif;
4620 				}
4621 				p++;
4622 			}
4623 			inp = p;
4624 			gotexp = 1;
4625 		}
4626 		else if ( *p == '(' ) {
4627 			if ( gotexp ) {
4628 				MesCerr("parenthesis",p);
4629 				error = 1;
4630 				goto endofif;
4631 			}
4632 			gotexp = 0;
4633 			if ( ++lenlev >= AC.MaxIf ) DoubleIfBuffers();
4634 			AC.IfCount[lenpp++] = w-OldWork;
4635 			*w++ = SUBEXPR;
4636 			w += 2;
4637 			p++;
4638 		}
4639 		else if ( *p == ')' ) {
4640 			if ( gotexp == 0 ) { MesCerr("position for )",p); error = 1; }
4641 			gotexp = 1;
4642 			u = AC.IfCount[--lenpp]+OldWork;
4643 			lenlev--;
4644 			u[1] = w - u;
4645 			if ( lenlev <= 0 ) {	/* End if condition */
4646 				AT.WorkSpace = OldSpace;
4647 				AT.WorkPointer = OldWork;
4648 				AddNtoL(OldWork[1],OldWork);
4649 				p++;
4650 				if ( *p == ')' ) {
4651 					MesPrint("&unmatched parenthesis in if/while ()");
4652 					error = 1;
4653 					while ( *++p == ')' );
4654 				}
4655 				if ( *p ) {
4656 					level = CompileStatement(p);
4657 					if ( level ) error = level;
4658 					while ( *p ) p++;
4659 					if ( CoEndIf(p) && error == 0 ) error = 1;
4660 				}
4661 				return(error);
4662 			}
4663 			p++;
4664 		}
4665 		else if ( *p == '>' ) {
4666 			if ( gotexp == 0 ) goto NoExp;
4667 			if ( p[1] == '=' ) { *w++ = GREATEREQUAL; *w++ = 2; p += 2; }
4668 			else               { *w++ = GREATER;      *w++ = 2; p++; }
4669 			gotexp = 0;
4670 		}
4671 		else if ( *p == '<' ) {
4672 			if ( gotexp == 0 ) goto NoExp;
4673 			if ( p[1] == '=' ) { *w++ = LESSEQUAL; *w++ = 2; p += 2; }
4674 			else               { *w++ = LESS;      *w++ = 2; p++; }
4675 			gotexp = 0;
4676 		}
4677 		else if ( *p == '=' ) {
4678 			if ( gotexp == 0 ) goto NoExp;
4679 			if ( p[1] == '=' ) p++;
4680 			*w++ = EQUAL; *w++ = 2; p++;
4681 			gotexp = 0;
4682 		}
4683 		else if ( *p == '!' && p[1] == '=' ) {
4684 			if ( gotexp == 0 ) { p++; goto NoExp; }
4685 			*w++ = NOTEQUAL; *w++ = 2; p += 2;
4686 			gotexp = 0;
4687 		}
4688 		else if ( *p == '|' && p[1] == '|' ) {
4689 			if ( gotexp == 0 ) { p++; goto NoExp; }
4690 			*w++ = ORCOND; *w++ = 2; p += 2;
4691 			gotexp = 0;
4692 		}
4693 		else if ( *p == '&' && p[1] == '&' ) {
4694 			if ( gotexp == 0 ) {
4695 				p++;
4696 NoExp:			p++;
4697 				MesCerr("sequence",p);
4698 				error = 1;
4699 			}
4700 			else {
4701 				*w++ = ANDCOND; *w++ = 2; p += 2;
4702 				gotexp = 0;
4703 			}
4704 		}
4705 		else if ( *p == 0 ) {
4706 			MesPrint("&Unmatched parentheses");
4707 			error = 1;
4708 			goto endofif;
4709 		}
4710 		else {
4711 			if ( FG.cTable[*p] == 0 ) {
4712 				WORD ij;
4713 				inp = p;
4714 				while ( ( ij = FG.cTable[*++p] ) == 0 || ij == 1 );
4715 				c = *p; *p = 0;
4716 				goto NoGood;
4717 			}
4718 			MesCerr("sequence",p);
4719 			error = 1;
4720 			p++;
4721 		}
4722 	}
4723 endofif:;
4724 	return(error);
4725 }
4726 
4727 /*
4728   	#] CoIf :
4729   	#[ CoElse :
4730 */
4731 
CoElse(UBYTE * p)4732 int CoElse(UBYTE *p)
4733 {
4734 	int error = 0;
4735 	CBUF *C = cbuf+AC.cbufnum;
4736 	if ( *p != 0 ) {
4737 		while ( *p == ',' ) p++;
4738 		if ( tolower(*p) == 'i' && tolower(p[1]) == 'f' && p[2] == '(' )
4739 													return(CoElseIf(p+2));
4740 		MesPrint("&No extra text allowed as part of an else statement");
4741 		error = 1;
4742 	}
4743 	if ( AC.IfLevel <= 0 ) { MesPrint("&else statement without if"); return(1); }
4744 	if ( AC.IfSumCheck[AC.IfLevel-1] != NestingChecksum() - 1 ) {
4745 		MesNesting();
4746 		error = 1;
4747 	}
4748 	Add3Com(TYPEELSE,AC.IfLevel)
4749 	C->Buffer[AC.IfStack[-1]] = C->numlhs;
4750 	AC.IfStack[-1] = C->Pointer - C->Buffer - 1;
4751 	return(error);
4752 }
4753 
4754 /*
4755   	#] CoElse :
4756   	#[ CoElseIf :
4757 */
4758 
CoElseIf(UBYTE * inp)4759 int CoElseIf(UBYTE *inp)
4760 {
4761 	CBUF *C = cbuf+AC.cbufnum;
4762 	if ( AC.IfLevel <= 0 ) { MesPrint("&elseif statement without if"); return(1); }
4763 	Add3Com(TYPEELSE,-AC.IfLevel)
4764 	AC.IfLevel--;
4765 	C->Buffer[*--AC.IfStack] = C->numlhs;
4766 	return(CoIf(inp));
4767 }
4768 
4769 /*
4770   	#] CoElseIf :
4771   	#[ CoEndIf :
4772 
4773 		It puts a RHS-level at the position indicated in the AC.IfStack.
4774 		This corresponds to the label belonging to a forward goto.
4775 		It is the goto that belongs either to the failing condition
4776 		of the if (no else statement), or the completion of the
4777 		success path (with else statement)
4778 		The code is a jump to the next statement. It is there to prevent
4779 		problems with
4780 		if ( .. )
4781 			if ( .. )
4782 			endif;
4783 		elseif ( .. )
4784 */
4785 
CoEndIf(UBYTE * inp)4786 int CoEndIf(UBYTE *inp)
4787 {
4788 	CBUF *C = cbuf+AC.cbufnum;
4789 	WORD i = C->numlhs, to, k = -AC.IfLevel;
4790 	int error = 0;
4791 	while ( *inp == ',' ) inp++;
4792 	if ( *inp != 0 ) {
4793 		error = 1;
4794 		MesPrint("&No extra text allowed as part of an endif/elseif statement");
4795 	}
4796 	if ( AC.IfLevel <= 0 ) {
4797 		MesPrint("&Endif statement without corresponding if"); return(1);
4798 	}
4799 	AC.IfLevel--;
4800 	C->Buffer[*--AC.IfStack] = i+1;
4801 	if ( AC.IfSumCheck[AC.IfLevel] != NestingChecksum() ) {
4802 		MesNesting();
4803 		error = 1;
4804 	}
4805 	Add3Com(TYPEENDIF,i+1)
4806 /*
4807 	Now the search for the TYPEELSE in front of the elseif statements
4808 */
4809 	to = C->numlhs;
4810     while ( i > 0 ) {
4811 		if ( C->lhs[i][0] == TYPEELSE && C->lhs[i][2] == to ) to = i;
4812 		if ( C->lhs[i][0] == TYPEIF ) {
4813 			if ( C->lhs[i][2] == to ) {
4814 				i--;
4815 				if ( i <= 0 || C->lhs[i][0] != TYPEELSE
4816 				|| C->lhs[i][2] != k ) break;
4817 				C->lhs[i][2] = C->numlhs;
4818 				to = i;
4819 			}
4820 		}
4821 		i--;
4822 	}
4823 	return(error);
4824 }
4825 
4826 /*
4827   	#] CoEndIf :
4828   	#[ CoWhile :
4829 */
4830 
CoWhile(UBYTE * inp)4831 int CoWhile(UBYTE *inp)
4832 {
4833 	CBUF *C = cbuf+AC.cbufnum;
4834 	WORD startnum = C->numlhs + 1;
4835 	int error;
4836 	AC.WhileLevel++;
4837 	error = CoIf(inp);
4838 	if ( C->numlhs > startnum && C->lhs[startnum][2] == C->numlhs
4839 							&& C->lhs[C->numlhs][0] == TYPEENDIF ) {
4840 		C->lhs[C->numlhs][2] = startnum-1;
4841 		AC.WhileLevel--;
4842 	}
4843 	else C->lhs[startnum][2] = startnum;
4844 	return(error);
4845 }
4846 
4847 /*
4848   	#] CoWhile :
4849   	#[ CoEndWhile :
4850 */
4851 
CoEndWhile(UBYTE * inp)4852 int CoEndWhile(UBYTE *inp)
4853 {
4854 	int error = 0;
4855 	WORD i;
4856 	CBUF *C = cbuf+AC.cbufnum;
4857 	if ( AC.WhileLevel <= 0 ) {
4858 		MesPrint("&EndWhile statement without corresponding While"); return(1);
4859 	}
4860 	AC.WhileLevel--;
4861 	i = C->Buffer[AC.IfStack[-1]];
4862 	error = CoEndIf(inp);
4863 	C->lhs[C->numlhs][2] = i - 1;
4864 	return(error);
4865 }
4866 
4867 /*
4868   	#] CoEndWhile :
4869   	#[ DoFindLoop :
4870 
4871 	Function,arguments=number,loopsize=number,outfun=function,include=index;
4872 */
4873 
4874 static char *messfind[] = {
4875 	"Findloop(function,arguments=#,loopsize(=#|<#)[,include=index])"
4876    ,"Replaceloop,function,arguments=#,loopsize(=#|<#),outfun=function[,include=index]"
4877 	};
4878 static WORD comfindloop[7] = { TYPEFINDLOOP,7,0,0,0,0,0 };
4879 
DoFindLoop(UBYTE * inp,int mode)4880 int DoFindLoop(UBYTE *inp, int mode)
4881 {
4882 	UBYTE *s, c;
4883 	WORD funnum, nargs = 0, nloop = 0, indexnum = 0, outfun = 0;
4884 	int type, aflag, lflag, indflag, outflag, error = 0, sym;
4885 	while ( *inp == ',' ) inp++;
4886 	if ( ( s = SkipAName(inp) ) == 0 ) {
4887 syntax:	MesPrint("&Proper syntax is:");
4888 		MesPrint("%s",messfind[mode]);
4889 		return(1);
4890 	}
4891 	c = *s; *s = 0;
4892 	if ( ( ( type = GetName(AC.varnames,inp,&funnum,WITHAUTO) ) == NAMENOTFOUND )
4893 		|| type != CFUNCTION || ( ( sym = (functions[funnum].symmetric) & ~REVERSEORDER )
4894 		!= SYMMETRIC && sym != ANTISYMMETRIC ) ) {
4895 		MesPrint("&%s should be a (anti)symmetric function or tensor",inp);
4896 	}
4897 	funnum += FUNCTION;
4898 	*s = c; inp = s;
4899 	aflag = lflag = indflag = outflag = 0;
4900 	while ( *inp == ',' ) {
4901 		while ( *inp == ',' ) inp++;
4902 		s = inp;
4903 		if ( ( s = SkipAName(inp) ) == 0 ) goto syntax;
4904 		c = *s; *s = 0;
4905 		if ( StrICont(inp,(UBYTE *)"arguments") == 0 ) {
4906 			if ( c != '=' ) goto syntax;
4907 			*s++ = c;
4908 			NeedNumber(nargs,s,syntax)
4909 			aflag++;
4910 			inp = s;
4911 		}
4912 		else if ( StrICont(inp,(UBYTE *)"loopsize") == 0 ) {
4913 			if ( c != '=' && c != '<' ) goto syntax;
4914 			*s++ = c;
4915 			if ( FG.cTable[*s] == 1 ) {
4916 				NeedNumber(nloop,s,syntax)
4917 				if ( nloop < 2 ) {
4918 					MesPrint("&loopsize should be at least 2");
4919 					error = 1;
4920 				}
4921 				if ( c == '<' ) nloop = -nloop;
4922 			}
4923 			else if ( tolower(*s) == 'a' && tolower(s[1]) == 'l'
4924 			&& tolower(s[2]) == 'l' && FG.cTable[s[3]] > 1 ) {
4925 				nloop = -1; s += 3;
4926 				if ( c != '=' ) goto syntax;
4927 			}
4928 			inp = s;
4929 			lflag++;
4930 		}
4931 		else if ( StrICont(inp,(UBYTE *)"include") == 0 ) {
4932 			if ( c != '=' ) goto syntax;
4933 			*s++ = c;
4934 			if ( ( inp = SkipAName(s) ) == 0 ) goto syntax;
4935 			c = *inp; *inp = 0;
4936 			if ( ( type = GetName(AC.varnames,s,&indexnum,WITHAUTO) ) != CINDEX ) {
4937 				MesPrint("&%s is not a proper index",s);
4938 				error = 1;
4939 			}
4940 			else if ( indexnum < WILDOFFSET
4941 			&& indices[indexnum].dimension == 0 ) {
4942 				MesPrint("&%s should be a summable index",s);
4943 				error = 1;
4944 			}
4945 			indexnum += AM.OffsetIndex;
4946 			*inp = c;
4947 			indflag++;
4948 		}
4949 		else if ( StrICont(inp,(UBYTE *)"outfun") == 0 ) {
4950 			if ( c != '=' ) goto syntax;
4951 			*s++ = c;
4952 			if ( ( inp = SkipAName(s) ) == 0 ) goto syntax;
4953 			c = *inp; *inp = 0;
4954 			if ( ( type = GetName(AC.varnames,s,&outfun,WITHAUTO) ) != CFUNCTION ) {
4955 				MesPrint("&%s is not a proper function or tensor",s);
4956 				error = 1;
4957 			}
4958 			outfun += FUNCTION;
4959 			outflag++;
4960 			*inp = c;
4961 		}
4962 		else {
4963 			MesPrint("&Unrecognized option in FindLoop or ReplaceLoop: %s",inp);
4964 			*s = c; inp = s;
4965 			while ( *inp && *inp != ',' ) inp++;
4966 		}
4967 	}
4968 	if ( *inp != 0 && mode == REPLACELOOP ) goto syntax;
4969 	if ( mode == FINDLOOP && outflag > 0 ) {
4970 		MesPrint("&outflag option is illegal in FindLoop");
4971 		error = 1;
4972 	}
4973 	if ( mode == REPLACELOOP && outflag == 0 ) goto syntax;
4974 	if ( aflag == 0 || lflag == 0 ) goto syntax;
4975 	comfindloop[3] = funnum;
4976 	comfindloop[4] = nloop;
4977 	comfindloop[5] = nargs;
4978 	comfindloop[6] = outfun;
4979 	comfindloop[1] = 7;
4980 	if ( indflag ) {
4981 		if ( mode == 0 ) comfindloop[2] =  indexnum + 5;
4982 		else             comfindloop[2] = -indexnum - 5;
4983 	}
4984 	else comfindloop[2] = mode;
4985 	AddNtoL(comfindloop[1],comfindloop);
4986 	return(error);
4987 }
4988 
4989 /*
4990   	#] DoFindLoop :
4991   	#[ CoFindLoop :
4992 */
4993 
CoFindLoop(UBYTE * inp)4994 int CoFindLoop(UBYTE *inp)
4995 { return(DoFindLoop(inp,FINDLOOP)); }
4996 
4997 /*
4998   	#] CoFindLoop :
4999   	#[ CoReplaceLoop :
5000 */
5001 
CoReplaceLoop(UBYTE * inp)5002 int CoReplaceLoop(UBYTE *inp)
5003 { return(DoFindLoop(inp,REPLACELOOP)); }
5004 
5005 /*
5006   	#] CoReplaceLoop :
5007   	#[ CoFunPowers :
5008 */
5009 
5010 static UBYTE *FunPowOptions[] = {
5011 	 (UBYTE *)"nofunpowers"
5012 	,(UBYTE *)"commutingonly"
5013 	,(UBYTE *)"allfunpowers"
5014 	};
5015 
CoFunPowers(UBYTE * inp)5016 int CoFunPowers(UBYTE *inp)
5017 {
5018 	UBYTE *option, c;
5019 	int i, maxoptions = sizeof(FunPowOptions)/sizeof(UBYTE *);
5020 	while ( *inp == ',' ) inp++;
5021 	option = inp;
5022 	inp = SkipAName(inp); c = *inp; *inp = 0;
5023 	for ( i = 0; i < maxoptions; i++ ) {
5024 		if ( StrICont(option,FunPowOptions[i]) == 0 ) {
5025 			if ( c ) {
5026 				*inp = c;
5027 				MesPrint("&Illegal FunPowers statement");
5028 				return(1);
5029 			}
5030 			AC.funpowers = i;
5031 			return(0);
5032 		}
5033 	}
5034 	MesPrint("&Illegal option in FunPowers statement: %s",option);
5035 	return(1);
5036 }
5037 
5038 /*
5039   	#] CoFunPowers :
5040   	#[ CoUnitTrace :
5041 */
5042 
CoUnitTrace(UBYTE * s)5043 int CoUnitTrace(UBYTE *s)
5044 {
5045 	WORD num;
5046 	if ( FG.cTable[*s] == 1 ) {
5047 		ParseNumber(num,s)
5048 		if ( *s != 0 ) {
5049 nogood:		MesPrint("&Value of UnitTrace should be a (positive) number or a symbol");
5050 			return(1);
5051 		}
5052 		AC.lUniTrace[0] = SNUMBER;
5053 		AC.lUniTrace[2] = num;
5054 	}
5055 	else {
5056 		if ( GetName(AC.varnames,s,&num,WITHAUTO) == CSYMBOL ) {
5057 			AC.lUniTrace[0] = SYMBOL;
5058 			AC.lUniTrace[2] = num;
5059 			num = -num;
5060 		}
5061 		else goto nogood;
5062 		s = SkipAName(s);
5063 		if ( *s ) goto nogood;
5064 	}
5065 	AC.lUnitTrace = num;
5066 	return(0);
5067 }
5068 
5069 /*
5070   	#] CoUnitTrace :
5071   	#[ CoTerm :
5072 
5073 	Note: termstack holds the offset of the term statement in the compiler
5074 	buffer. termsortstack holds the offset of the last sort statement
5075 		(or the corresponding term statement)
5076 */
5077 
CoTerm(UBYTE * s)5078 int CoTerm(UBYTE *s)
5079 {
5080 	GETIDENTITY
5081 	WORD *w = AT.WorkPointer;
5082 	int error = 0;
5083 	while ( *s == ',' ) s++;
5084 	if ( *s ) {
5085 		MesPrint("&Illegal syntax for Term statement");
5086 		return(1);
5087 	}
5088 	if ( AC.termlevel+1 >= AC.maxtermlevel ) {
5089 		if ( AC.maxtermlevel <= 0 ) {
5090 			AC.maxtermlevel = 20;
5091 			AC.termstack = (LONG *)Malloc1(AC.maxtermlevel*sizeof(LONG),"termstack");
5092 			AC.termsortstack = (LONG *)Malloc1(AC.maxtermlevel*sizeof(LONG),"termsortstack");
5093 			AC.termsumcheck = (WORD *)Malloc1(AC.maxtermlevel*sizeof(WORD),"termsumcheck");
5094 		}
5095 		else {
5096 			DoubleBuffer((void **)AC.termstack,(void **)AC.termstack+AC.maxtermlevel,
5097 				sizeof(LONG),"doubling termstack");
5098 			DoubleBuffer((void **)AC.termsortstack,
5099 				(void **)AC.termsortstack+AC.maxtermlevel,
5100 				sizeof(LONG),"doubling termsortstack");
5101 			DoubleBuffer((void **)AC.termsumcheck,
5102 				(void **)AC.termsumcheck+AC.maxtermlevel,
5103 				sizeof(LONG),"doubling termsumcheck");
5104 			AC.maxtermlevel *= 2;
5105 		}
5106 	}
5107 	AC.termsumcheck[AC.termlevel] = NestingChecksum();
5108 	AC.termstack[AC.termlevel] = cbuf[AC.cbufnum].Pointer
5109 			                 - cbuf[AC.cbufnum].Buffer + 2;
5110 	AC.termsortstack[AC.termlevel] = AC.termstack[AC.termlevel] + 1;
5111 	AC.termlevel++;
5112 	*w++ = TYPETERM;
5113 	w++;
5114 	*w++ = cbuf[AC.cbufnum].numlhs;
5115 	*w++ = cbuf[AC.cbufnum].numlhs;
5116 	AT.WorkPointer[1] = w - AT.WorkPointer;
5117 	AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
5118 	return(error);
5119 }
5120 
5121 /*
5122   	#] CoTerm :
5123   	#[ CoEndTerm :
5124 */
5125 
CoEndTerm(UBYTE * s)5126 int CoEndTerm(UBYTE *s)
5127 {
5128 	CBUF *C = cbuf+AC.cbufnum;
5129 	while ( *s == ',' ) s++;
5130 	if ( *s ) {
5131 		MesPrint("&Illegal syntax for EndTerm statement");
5132 		return(1);
5133 	}
5134 	if ( AC.termlevel <= 0 ) {
5135 		MesPrint("&EndTerm without corresponding Argument statement");
5136 		return(1);
5137 	}
5138 	AC.termlevel--;
5139 	cbuf[AC.cbufnum].Buffer[AC.termstack[AC.termlevel]] = C->numlhs;
5140 	cbuf[AC.cbufnum].Buffer[AC.termsortstack[AC.termlevel]] = C->numlhs;
5141 	if ( AC.termsumcheck[AC.termlevel] != NestingChecksum() ) {
5142 		MesNesting();
5143 		return(1);
5144 	}
5145 	return(0);
5146 }
5147 
5148 /*
5149   	#] CoEndTerm :
5150   	#[ CoSort :
5151 */
5152 
CoSort(UBYTE * s)5153 int CoSort(UBYTE *s)
5154 {
5155 	GETIDENTITY
5156 	WORD *w = AT.WorkPointer;
5157 	int error = 0;
5158 	while ( *s == ',' ) s++;
5159 	if ( *s ) {
5160 		MesPrint("&Illegal syntax for Sort statement");
5161 		error = 1;
5162 	}
5163 	if ( AC.termlevel <= 0 ) {
5164 		MesPrint("&The Sort statement can only be used inside a term environment");
5165 		error = 1;
5166 	}
5167 	if ( error ) return(error);
5168 	*w++ = TYPESORT;
5169 	w++;
5170 	w++;
5171 	cbuf[AC.cbufnum].Buffer[AC.termsortstack[AC.termlevel-1]] =
5172 										*w = cbuf[AC.cbufnum].numlhs+1;
5173 	w++;
5174 	AC.termsortstack[AC.termlevel-1] = cbuf[AC.cbufnum].Pointer
5175 			                 - cbuf[AC.cbufnum].Buffer + 3;
5176 	if ( AC.termsumcheck[AC.termlevel-1] != NestingChecksum() - 1 ) {
5177 		MesNesting();
5178 		return(1);
5179 	}
5180 	AT.WorkPointer[1] = w - AT.WorkPointer;
5181 	AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
5182 	return(error);
5183 }
5184 
5185 /*
5186   	#] CoSort :
5187   	#[ CoPolyFun :
5188 
5189 	Collect,functionname
5190 */
5191 
CoPolyFun(UBYTE * s)5192 int CoPolyFun(UBYTE *s)
5193 {
5194 	GETIDENTITY
5195 	WORD numfun;
5196 	int type;
5197 	UBYTE *t;
5198 	AR.PolyFun = AC.lPolyFun = 0;
5199 	AR.PolyFunInv = AC.lPolyFunInv = 0;
5200 	AR.PolyFunType = AC.lPolyFunType = 0;
5201 	AR.PolyFunExp = AC.lPolyFunExp = 0;
5202 	AR.PolyFunVar = AC.lPolyFunVar = 0;
5203 	AR.PolyFunPow = AC.lPolyFunPow = 0;
5204 	if ( *s == 0 ) { return(0); }
5205 	t = SkipAName(s);
5206 	if ( t == 0 || *t != 0 ) {
5207 		MesPrint("&PolyFun statement needs a single commuting function for its argument");
5208 		return(1);
5209 	}
5210 	if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5211 	|| ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
5212 		MesPrint("&%s should be a regular commuting function",s);
5213 		if ( type < 0 ) {
5214 			if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5215 				AddFunction(s,0,0,0,0,0,-1,-1);
5216 		}
5217 		return(1);
5218 	}
5219 	AR.PolyFun = AC.lPolyFun = numfun+FUNCTION;
5220 	AR.PolyFunType = AC.lPolyFunType = 1;
5221 	return(0);
5222 }
5223 
5224 /*
5225   	#] CoPolyFun :
5226   	#[ CoPolyRatFun :
5227 
5228 	PolyRatFun [,functionname[,functionname](option)]
5229 */
5230 
CoPolyRatFun(UBYTE * s)5231 int CoPolyRatFun(UBYTE *s)
5232 {
5233 	GETIDENTITY
5234 	WORD numfun;
5235 	int type;
5236 	UBYTE *t, c;
5237 	AR.PolyFun = AC.lPolyFun = 0;
5238 	AR.PolyFunInv = AC.lPolyFunInv = 0;
5239 	AR.PolyFunType = AC.lPolyFunType = 0;
5240 	AR.PolyFunExp = AC.lPolyFunExp = 0;
5241 	AR.PolyFunVar = AC.lPolyFunVar = 0;
5242 	AR.PolyFunPow = AC.lPolyFunPow = 0;
5243 	if ( *s == 0 ) return(0);
5244 	t = SkipAName(s);
5245 	if ( t == 0 ) goto NumErr;
5246 	c = *t; *t = 0;
5247 	if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5248 	|| ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
5249 		MesPrint("&%s should be a regular commuting function",s);
5250 		if ( type < 0 ) {
5251 			if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5252 				AddFunction(s,0,0,0,0,0,-1,-1);
5253 		}
5254 		return(1);
5255 	}
5256 	AR.PolyFun = AC.lPolyFun = numfun+FUNCTION;
5257 	AR.PolyFunInv = AC.lPolyFunInv = 0;
5258 	AR.PolyFunType = AC.lPolyFunType = 2;
5259 	AC.PolyRatFunChanged = 1;
5260 	if ( c == 0 ) return(0);
5261 	*t = c;
5262 	if ( *t == '-' ) { AC.PolyRatFunChanged = 0; t++; }
5263 	while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
5264 	if ( *t == 0 ) return(0);
5265 	if ( *t != '(' ) {
5266 		s = t;
5267 		t = SkipAName(s);
5268 		if ( t == 0 ) goto NumErr;
5269 		c = *t; *t = 0;
5270 		if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5271 		|| ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
5272 			MesPrint("&%s should be a regular commuting function",s);
5273 			if ( type < 0 ) {
5274 				if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5275 					AddFunction(s,0,0,0,0,0,-1,-1);
5276 			}
5277 			return(1);
5278 		}
5279 		AR.PolyFunInv = AC.lPolyFunInv = numfun+FUNCTION;
5280 		if ( c == 0 ) return(0);
5281 		*t = c;
5282 		if ( *t == '-' ) { AC.PolyRatFunChanged = 0; t++; }
5283 		while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
5284 		if ( *t == 0 ) return(0);
5285 	}
5286 	if ( *t == '(' ) {
5287 		t++;
5288 		while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
5289 /*
5290 		Next we need a keyword like
5291 			(divergence,ep)
5292 			(expand,ep,maxpow)
5293 */
5294 		s = t;
5295 		t = SkipAName(s);
5296 		if ( t == 0 ) goto NumErr;
5297 		c = *t; *t = 0;
5298 		if ( ( StrICmp(s,(UBYTE *)"divergence") == 0 )
5299 		|| ( StrICmp(s,(UBYTE *)"finddivergence") == 0 ) ) {
5300 			if ( c != ',' ) {
5301 				MesPrint("&Illegal option field in PolyRatFun statement.");
5302 				return(1);
5303 			}
5304 			*t = c;
5305 			while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
5306 			s = t;
5307 			t = SkipAName(s);
5308 			if ( t == 0 ) goto NumErr;
5309 			c = *t; *t = 0;
5310 			if ( ( type = GetName(AC.varnames,s,&AC.lPolyFunVar,WITHAUTO) ) != CSYMBOL ) {
5311 				MesPrint("&Illegal symbol %s in option field in PolyRatFun statement.",s);
5312 				return(1);
5313 			}
5314 			*t = c;
5315 			while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
5316 			if ( *t != ')' ) {
5317 				MesPrint("&Illegal termination of option in PolyRatFun statement.");
5318 				return(1);
5319 			}
5320 			AR.PolyFunExp = AC.lPolyFunExp = 1;
5321 			AR.PolyFunVar = AC.lPolyFunVar;
5322 			symbols[AC.lPolyFunVar].minpower = -MAXPOWER;
5323 			symbols[AC.lPolyFunVar].maxpower =  MAXPOWER;
5324 		}
5325 		else if ( StrICmp(s,(UBYTE *)"expand") == 0 ) {
5326 			WORD x = 0, etype = 2;
5327 			if ( c != ',' ) {
5328 				MesPrint("&Illegal option field in PolyRatFun statement.");
5329 				return(1);
5330 			}
5331 			*t = c;
5332 			while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
5333 			s = t;
5334 			t = SkipAName(s);
5335 			if ( t == 0 ) goto NumErr;
5336 			c = *t; *t = 0;
5337 			if ( ( type = GetName(AC.varnames,s,&AC.lPolyFunVar,WITHAUTO) ) != CSYMBOL ) {
5338 				MesPrint("&Illegal symbol %s in option field in PolyRatFun statement.",s);
5339 				return(1);
5340 			}
5341 			*t = c;
5342 			while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
5343 			if ( *t > '9' || *t < '0' ) {
5344 				MesPrint("&Illegal option field in PolyRatFun statement.");
5345 				return(1);
5346 			}
5347 			while ( *t <= '9' && *t >= '0' ) x = 10*x + *t++ - '0';
5348 			while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
5349 			if ( *t != ')' ) {
5350 				s = t;
5351 				t = SkipAName(s);
5352 				if ( t == 0 ) goto ParErr;
5353 				c = *t; *t = 0;
5354 				if ( StrICmp(s,(UBYTE *)"fixed") == 0 ) {
5355 					etype = 3;
5356 				}
5357 				else if ( StrICmp(s,(UBYTE *)"relative") == 0 ) {
5358 					etype = 2;
5359 				}
5360 				else {
5361 					MesPrint("&Illegal termination of option in PolyRatFun statement.");
5362 					return(1);
5363 				}
5364 				*t = c;
5365 				while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
5366 				if ( *t != ')' ) {
5367 					MesPrint("&Illegal termination of option in PolyRatFun statement.");
5368 					return(1);
5369 				}
5370 			}
5371 			AR.PolyFunExp = AC.lPolyFunExp = etype;
5372 			AR.PolyFunVar = AC.lPolyFunVar;
5373 			AR.PolyFunPow = AC.lPolyFunPow = x;
5374 			symbols[AC.lPolyFunVar].minpower = -MAXPOWER;
5375 			symbols[AC.lPolyFunVar].maxpower =  MAXPOWER;
5376 		}
5377 		else {
5378 ParErr:		MesPrint("&Illegal option %s in PolyRatFun statement.",s);
5379 			return(1);
5380 		}
5381 		t++;
5382 		while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
5383 		if ( *t == 0 ) return(0);
5384 	}
5385 NumErr:;
5386 	MesPrint("&PolyRatFun statement needs one or two commuting function(s) for its argument(s)");
5387 	return(1);
5388 }
5389 
5390 /*
5391   	#] CoPolyRatFun :
5392   	#[ CoMerge :
5393 */
5394 
CoMerge(UBYTE * inp)5395 int CoMerge(UBYTE *inp)
5396 {
5397 	UBYTE *s = inp;
5398 	int type;
5399 	WORD numfunc, option = 0;
5400 	if ( tolower(s[0]) == 'o' && tolower(s[1]) == 'n' && tolower(s[2]) == 'c' &&
5401 	     tolower(s[3]) == 'e' && tolower(s[4]) == ',' ) {
5402 		option = 1; s += 5;
5403 	}
5404 	else if ( tolower(s[0]) == 'a' && tolower(s[1]) == 'l' && tolower(s[2]) == 'l' &&
5405 	     tolower(s[3]) == ',' ) {
5406 		option = 0; s += 4;
5407 	}
5408 	if ( *s == '$' ) {
5409 		if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
5410 			numfunc = -numfunc;
5411 		else {
5412 			MesPrint("&%s is undefined",s);
5413 			numfunc = AddDollar(s+1,DOLINDEX,&one,1);
5414 			return(1);
5415 		}
5416 tests:	s = SkipAName(s);
5417 		if ( *s != 0 ) {
5418 			MesPrint("&Merge/shuffle should have a single function or $variable for its argument");
5419 			return(1);
5420 		}
5421 	}
5422 	else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
5423 		numfunc += FUNCTION;
5424 		goto tests;
5425 	}
5426 	else if ( type != -1 ) {
5427 		if ( type != CDUBIOUS ) {
5428 			NameConflict(type,s);
5429 			type = MakeDubious(AC.varnames,s,&numfunc);
5430 		}
5431 		return(1);
5432 	}
5433 	else {
5434 		MesPrint("&%s is not a function",s);
5435 		numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
5436 		return(1);
5437 	}
5438 	Add4Com(TYPEMERGE,numfunc,option);
5439 	return(0);
5440 }
5441 
5442 /*
5443   	#] CoMerge :
5444   	#[ CoStuffle :
5445 
5446 	Important for future options: The bit, given by 256 (bit 8) is reserved
5447 	internally for keeping track of the sign in the number of Stuffle
5448 	additions.
5449 */
5450 
CoStuffle(UBYTE * inp)5451 int CoStuffle(UBYTE *inp)
5452 {
5453 	UBYTE *s = inp, *ss, c;
5454 	int type;
5455 	WORD numfunc, option = 0;
5456 	if ( tolower(s[0]) == 'o' && tolower(s[1]) == 'n' && tolower(s[2]) == 'c' &&
5457 	     tolower(s[3]) == 'e' && tolower(s[4]) == ',' ) {
5458 		option = 1; s += 5;
5459 	}
5460 	else if ( tolower(s[0]) == 'a' && tolower(s[1]) == 'l' && tolower(s[2]) == 'l' &&
5461 	     tolower(s[3]) == ',' ) {
5462 		option = 0; s += 4;
5463 	}
5464 	ss = SkipAName(s);
5465 	c = *ss; *ss = 0;
5466 	if ( *s == '$' ) {
5467 		if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
5468 			numfunc = -numfunc;
5469 		else {
5470 			MesPrint("&%s is undefined",s);
5471 			numfunc = AddDollar(s+1,DOLINDEX,&one,1);
5472 			return(1);
5473 		}
5474 tests:	*ss = c;
5475 		if ( *ss != '+' && *ss != '-' && ss[1] != 0 ) {
5476 			MesPrint("&Stuffle should have a single function or $variable for its argument, followed by either + or -");
5477 			return(1);
5478 		}
5479 		if ( *ss == '-' ) option += 2;
5480 	}
5481 	else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
5482 		numfunc += FUNCTION;
5483 		goto tests;
5484 	}
5485 	else if ( type != -1 ) {
5486 		if ( type != CDUBIOUS ) {
5487 			NameConflict(type,s);
5488 			type = MakeDubious(AC.varnames,s,&numfunc);
5489 		}
5490 		return(1);
5491 	}
5492 	else {
5493 		MesPrint("&%s is not a function",s);
5494 		numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
5495 		return(1);
5496 	}
5497 	Add4Com(TYPESTUFFLE,numfunc,option);
5498 	return(0);
5499 }
5500 
5501 /*
5502   	#] CoStuffle :
5503   	#[ CoProcessBucket :
5504 */
5505 
CoProcessBucket(UBYTE * s)5506 int CoProcessBucket(UBYTE *s)
5507 {
5508 	LONG x;
5509 	while ( *s == ',' || *s == '=' ) s++;
5510 	ParseNumber(x,s)
5511 	if ( *s && *s != ' ' && *s != '\t' ) {
5512 		MesPrint("&Numerical value expected for ProcessBucketSize");
5513 		return(1);
5514 	}
5515 	AC.ProcessBucketSize = x;
5516 	return(0);
5517 }
5518 
5519 /*
5520   	#] CoProcessBucket :
5521   	#[ CoThreadBucket :
5522 */
5523 
CoThreadBucket(UBYTE * s)5524 int CoThreadBucket(UBYTE *s)
5525 {
5526 	LONG x;
5527 	while ( *s == ',' || *s == '=' ) s++;
5528 	ParseNumber(x,s)
5529 	if ( *s && *s != ' ' && *s != '\t' ) {
5530 		MesPrint("&Numerical value expected for ThreadBucketSize");
5531 		return(1);
5532 	}
5533 	if ( x <= 0 ) {
5534 		Warning("Negative of zero value not allowed for ThreadBucketSize. Adjusted to 1.");
5535 		x = 1;
5536 	}
5537 	AC.ThreadBucketSize = x;
5538 #ifdef WITHPTHREADS
5539 	if ( AS.MultiThreaded ) MakeThreadBuckets(-1,1);
5540 #endif
5541 	return(0);
5542 }
5543 
5544 /*
5545   	#] CoThreadBucket :
5546   	#[ DoArgPlode :
5547 
5548 	Syntax: a list of functions.
5549 	If the functions have an argument it must be a function.
5550 	In the case f(g) we treat f(g(...)) with g any argument.
5551 	  (not yet implemented)
5552 */
5553 
DoArgPlode(UBYTE * s,int par)5554 int DoArgPlode(UBYTE *s, int par)
5555 {
5556 	GETIDENTITY
5557 	WORD numfunc, type, error = 0, *w, n;
5558 	UBYTE *t,c;
5559 	int i;
5560 	w = AT.WorkPointer;
5561 	*w++ = par;
5562 	w++;
5563 	while ( *s == ',' ) s++;
5564 	while ( *s ) {
5565 		if ( *s == '$' ) {
5566 			MesPrint("&We don't do dollar variables yet in ArgImplode/ArgExplode");
5567 			return(1);
5568 		}
5569 		t = s;
5570 		if ( ( s = SkipAName(s) ) == 0 ) return(1);
5571 		c = *s; *s = 0;
5572 		if ( ( type = GetName(AC.varnames,t,&numfunc,WITHAUTO) ) == CFUNCTION ) {
5573 			numfunc += FUNCTION;
5574 		}
5575 		else if ( type != -1 ) {
5576 			if ( type != CDUBIOUS ) {
5577 				NameConflict(type,t);
5578 				type = MakeDubious(AC.varnames,t,&numfunc);
5579 			}
5580 			error = 1;
5581 		}
5582 		else {
5583 			MesPrint("&%s is not a function",t);
5584 			numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
5585 			return(1);
5586 		}
5587 		*s = c;
5588 		*w++ = numfunc;
5589 		*w++ = FUNHEAD;
5590 #if FUNHEAD > 2
5591 		for ( i = 2; i < FUNHEAD; i++ ) *w++ = 0;
5592 #endif
5593 		if ( *s && *s != ',' ) {
5594 			MesPrint("&Illegal character in ArgImplode/ArgExplode statement: %s",s);
5595 			return(1);
5596 		}
5597 		while ( *s == ',' ) s++;
5598 	}
5599 	n = w - AT.WorkPointer;
5600 	AT.WorkPointer[1] = n;
5601 	AddNtoL(n,AT.WorkPointer);
5602 	return(error);
5603 }
5604 
5605 /*
5606   	#] DoArgPlode :
5607   	#[ CoArgExplode :
5608 */
5609 
CoArgExplode(UBYTE * s)5610 int CoArgExplode(UBYTE *s) { return(DoArgPlode(s,TYPEARGEXPLODE)); }
5611 
5612 /*
5613   	#] CoArgExplode :
5614   	#[ CoArgImplode :
5615 */
5616 
CoArgImplode(UBYTE * s)5617 int CoArgImplode(UBYTE *s) { return(DoArgPlode(s,TYPEARGIMPLODE)); }
5618 
5619 /*
5620   	#] CoArgImplode :
5621   	#[ CoClearTable :
5622 */
5623 
CoClearTable(UBYTE * s)5624 int CoClearTable(UBYTE *s)
5625 {
5626 	UBYTE c, *t;
5627 	int j, type, error = 0;
5628 	WORD numfun;
5629 	TABLES T, TT;
5630 	if ( *s == 0 ) {
5631 		MesPrint("&The ClearTable statement needs at least one (table) argument.");
5632 		return(1);
5633 	}
5634 	while ( *s ) {
5635 		t = s;
5636 		s = SkipAName(s);
5637 		c = *s; *s = 0;
5638 		if ( ( ( type = GetName(AC.varnames,t,&numfun,WITHAUTO) ) != CFUNCTION )
5639 		&& type != CDUBIOUS ) {
5640 nofunc:		MesPrint("&%s is not a table",t);
5641 			error = 4;
5642 			if ( type < 0 ) numfun = AddFunction(t,0,0,0,0,0,-1,-1);
5643 			*s = c;
5644 			if ( *s == ',' ) s++;
5645 			continue;
5646 		}
5647 /*
5648 		else if ( ( ( T = functions[numfun].tabl ) == 0 )
5649 		 || ( T->sparse == 0 ) ) goto nofunc;
5650 */
5651 		else if ( ( T = functions[numfun].tabl ) == 0 ) goto nofunc;
5652 		numfun += FUNCTION;
5653 		*s = c;
5654 		if ( *s == ',' ) s++;
5655 /*
5656 		Now we clear the table.
5657 */
5658 		if ( T->sparse ) {
5659 		if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
5660 		for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
5661 			finishcbuf(T->buffers[j]);
5662 		}
5663 		if ( T->buffers ) M_free(T->buffers,"Table buffers");
5664 		finishcbuf(T->bufnum);
5665 
5666 		T->boomlijst = 0;
5667 		T->numtree = 0; T->rootnum = 0; T->MaxTreeSize = 0;
5668 		T->boomlijst = 0;
5669 		T->bufnum = inicbufs();
5670 		T->bufferssize = 8;
5671 		T->buffers = (WORD *)Malloc1(sizeof(WORD)*T->bufferssize,"Table buffers");
5672 		T->buffersfill = 0;
5673 		T->buffers[T->buffersfill++] = T->bufnum;
5674 
5675 		T->totind = 0;			/* At the moment there are this many */
5676 		T->reserved = 0;
5677 
5678 		ClearTableTree(T);
5679 
5680 		if ( T->spare ) {
5681 			if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
5682 			T->tablepointers = 0;
5683 			TT = T->spare;
5684 			if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
5685 			for (j = 0; j < TT->buffersfill; j++ ) {
5686 				finishcbuf(TT->buffers[j]);
5687 			}
5688 			if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
5689 			if ( TT->buffers )M_free(TT->buffers,"Table buffers");
5690 			if ( TT->mm ) M_free(TT->mm,"tableminmax");
5691 			if ( TT->flags ) M_free(TT->flags,"tableflags");
5692 			M_free(TT,"table");
5693 			SpareTable(T);
5694 		}
5695 		}
5696 		else EmptyTable(T);
5697 	}
5698 	return(error);
5699 }
5700 
5701 /*
5702   	#] CoClearTable :
5703   	#[ CoDenominators :
5704 */
5705 
CoDenominators(UBYTE * s)5706 int CoDenominators(UBYTE *s)
5707 {
5708 	WORD numfun;
5709 	int type;
5710 	UBYTE *t = SkipAName(s), *t1;
5711 	if ( t == 0 ) goto syntaxerror;
5712 	t1 = t; while ( *t1 == ',' || *t1 == ' ' || *t1 == '\t' ) t1++;
5713 	if ( *t1 ) goto syntaxerror;
5714 	*t = 0;
5715 	if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
5716 	|| ( functions[numfun].spec != 0 ) ) {
5717 		if ( type < 0 ) {
5718 			if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
5719 				AddFunction(s,0,0,0,0,0,-1,-1);
5720 		}
5721 		goto syntaxerror;
5722 	}
5723 	Add3Com(TYPEDENOMINATORS,numfun+FUNCTION);
5724 	return(0);
5725 syntaxerror:
5726 	MesPrint("&Denominators statement needs one regular function for its argument");
5727 	return(1);
5728 }
5729 
5730 /*
5731   	#] CoDenominators :
5732   	#[ CoDropCoefficient :
5733 */
5734 
CoDropCoefficient(UBYTE * s)5735 int CoDropCoefficient(UBYTE *s)
5736 {
5737 	if ( *s == 0 ) {
5738 		Add2Com(TYPEDROPCOEFFICIENT)
5739 		return(0);
5740 	}
5741 	MesPrint("&Illegal argument in DropCoefficient statement: '%s'",s);
5742 	return(1);
5743 }
5744 /*
5745   	#] CoDropCoefficient :
5746   	#[ CoDropSymbols :
5747 */
5748 
CoDropSymbols(UBYTE * s)5749 int CoDropSymbols(UBYTE *s)
5750 {
5751 	if ( *s == 0 ) {
5752 		Add2Com(TYPEDROPSYMBOLS)
5753 		return(0);
5754 	}
5755 	MesPrint("&Illegal argument in DropSymbols statement: '%s'",s);
5756 	return(1);
5757 }
5758 /*
5759   	#] CoDropSymbols :
5760   	#[ CoToPolynomial :
5761 
5762 	Converts the current term as much as possible to symbols.
5763 	Keeps a list of all objects converted to symbols in AM.sbufnum.
5764 	Note that this cannot be executed in parallel because we have only
5765 	a single compiler buffer for this. Hence we switch on the noparallel
5766 	module option.
5767 
5768 	Option(s):
5769 		OnlyFunctions [,name1][,name2][,...,namem];
5770 */
5771 
CoToPolynomial(UBYTE * inp)5772 int CoToPolynomial(UBYTE *inp)
5773 {
5774 	int error = 0;
5775 	while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
5776 	if ( ( AC.topolynomialflag & ~TOPOLYNOMIALFLAG ) != 0 ) {
5777 		MesPrint("&ToPolynomial statement and FactArg statement are not allowed in the same module");
5778 		return(1);
5779 	}
5780 	if ( AO.OptimizeResult.code != NULL ) {
5781 		MesPrint("&Using ToPolynomial statement when there are still optimization results active.");
5782 		MesPrint("&Please use #ClearOptimize instruction first.");
5783 		MesPrint("&This will loose the optimized expression.");
5784 		return(1);
5785 	}
5786 	if ( *inp == 0 ) {
5787 		Add3Com(TYPETOPOLYNOMIAL,DOALL)
5788 	}
5789 	else {
5790 		int numargs = 0;
5791 		WORD *funnums = 0, type, num;
5792 		UBYTE *s, c;
5793 		s = SkipAName(inp);
5794 		if ( s == 0 ) return(1);
5795 		c = *s; *s = 0;
5796 		if ( StrICmp(inp,(UBYTE *)"onlyfunctions") ) {
5797 			MesPrint("&Illegal option %s in ToPolynomial statement",inp);
5798 			*s = c;
5799 			return(1);
5800 		}
5801 		*s = c;
5802 		inp = s;
5803 		while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
5804 		s = inp;
5805 		while ( *s ) s++;
5806 /*
5807 		Get definitely enough space for the numbers of the functions
5808 */
5809 		funnums = (WORD *)Malloc1(((LONG)(s-inp)+3)*sizeof(WORD),"ToPlynomial");
5810 		while ( *inp ) {
5811 			s = SkipAName(inp);
5812 			if ( s == 0 ) return(1);
5813 			c = *s; *s = 0;
5814 		    type = GetName(AC.varnames,inp,&num,WITHAUTO);
5815 			if ( type != CFUNCTION ) {
5816 				MesPrint("&%s is not a function in ToPolynomial statement",inp);
5817 				error = 1;
5818 			}
5819 			funnums[3+numargs++] = num+FUNCTION;
5820 			*s = c;
5821 			inp = s;
5822 			while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
5823 		}
5824 		funnums[0] = TYPETOPOLYNOMIAL;
5825 		funnums[1] = numargs+3;
5826 		funnums[2] = ONLYFUNCTIONS;
5827 
5828 		AddNtoL(numargs+3,funnums);
5829 		if ( funnums ) M_free(funnums,"ToPolynomial");
5830 	}
5831 	AC.topolynomialflag |= TOPOLYNOMIALFLAG;
5832 #ifdef WITHMPI
5833 	/* In ParFORM, ToPolynomial has to be executed on the master. */
5834 	AC.mparallelflag |= NOPARALLEL_CONVPOLY;
5835 #endif
5836 	return(error);
5837 }
5838 
5839 /*
5840   	#] CoToPolynomial :
5841   	#[ CoFromPolynomial :
5842 
5843 	Converts the current term as much as possible back from extra symbols
5844 	to their original values. Does not look inside functions.
5845 */
5846 
CoFromPolynomial(UBYTE * inp)5847 int CoFromPolynomial(UBYTE *inp)
5848 {
5849 	while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
5850 	if ( *inp == 0 ) {
5851 		if ( AO.OptimizeResult.code != NULL ) {
5852 			MesPrint("&Using FromPolynomial statement when there are still optimization results active.");
5853 			MesPrint("&Please use #ClearOptimize instruction first.");
5854 			MesPrint("&This will loose the optimized expression.");
5855 			return(1);
5856 		}
5857 		Add2Com(TYPEFROMPOLYNOMIAL)
5858 		return(0);
5859 	}
5860 	MesPrint("&Illegal argument in FromPolynomial statement: '%s'",inp);
5861 	return(1);
5862 }
5863 
5864 /*
5865   	#] CoFromPolynomial :
5866   	#[ CoArgToExtraSymbol :
5867 
5868 	Converts the specified function arguments into extra symbols.
5869 
5870 	Syntax: ArgToExtraSymbol [ToNumber] [<argument specifications>]
5871 */
5872 
CoArgToExtraSymbol(UBYTE * s)5873 int CoArgToExtraSymbol(UBYTE *s)
5874 {
5875 	CBUF *C = cbuf + AC.cbufnum;
5876 	WORD *lhs;
5877 
5878 	/* TODO: resolve interference with rational arithmetic. (#138) */
5879 	if ( ( AC.topolynomialflag & ~TOPOLYNOMIALFLAG ) != 0 ) {
5880 		MesPrint("&ArgToExtraSymbol statement and FactArg statement are not allowed in the same module");
5881 		return(1);
5882 	}
5883 	if ( AO.OptimizeResult.code != NULL ) {
5884 		MesPrint("&Using ArgToExtraSymbol statement when there are still optimization results active.");
5885 		MesPrint("&Please use #ClearOptimize instruction first.");
5886 		MesPrint("&This will loose the optimized expression.");
5887 		return(1);
5888 	}
5889 
5890 	SkipSpaces(&s);
5891 	int tonumber = ConsumeOption(&s, "tonumber");
5892 
5893 	int ret = DoArgument(s,TYPEARGTOEXTRASYMBOL);
5894 	if ( ret ) return(ret);
5895 
5896 	/*
5897 	 * The "scale" parameter is unused. Instead, we put the "tonumber"
5898 	 * parameter.
5899 	 */
5900 	lhs = C->lhs[C->numlhs];
5901 	if ( lhs[4] != 1 ) {
5902 		Warning("scale parameter (^n) is ignored in ArgToExtraSymbol");
5903 	}
5904 	lhs[4] = tonumber;
5905 
5906 	AC.topolynomialflag |= TOPOLYNOMIALFLAG;  /* This flag is also used in ParFORM. */
5907 #ifdef WITHMPI
5908 	/*
5909 	 * In ParFORM, the conversion to extra symbols has to be performed on
5910 	 * the master.
5911 	 */
5912 	AC.mparallelflag |= NOPARALLEL_CONVPOLY;
5913 #endif
5914 
5915 	return(0);
5916 }
5917 
5918 /*
5919   	#] CoArgToExtraSymbol :
5920   	#[ CoExtraSymbols :
5921 */
5922 
CoExtraSymbols(UBYTE * inp)5923 int CoExtraSymbols(UBYTE *inp)
5924 {
5925 	UBYTE *arg1, *arg2, c, *s;
5926 	WORD i, j, type, number;
5927 	while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
5928 	if ( FG.cTable[*inp] != 0 ) {
5929 		MesPrint("&Illegal argument in ExtraSymbols statement: '%s'",inp);
5930 		return(1);
5931 	}
5932 	arg1 = inp;
5933 	while ( FG.cTable[*inp] == 0 ) inp++;
5934 	c = *inp; *inp = 0;
5935 	if ( ( StrICmp(arg1,(UBYTE *)"array") == 0 )
5936 			|| ( StrICmp(arg1,(UBYTE *)"vector") == 0 ) ) {
5937 		AC.extrasymbols = 1;
5938 	}
5939 	else if ( StrICmp(arg1,(UBYTE *)"underscore") == 0 ) {
5940 		AC.extrasymbols = 0;
5941 	}
5942 /*
5943 	else if ( StrICmp(arg1,(UBYTE *)"nothing") == 0 ) {
5944 		AC.extrasymbols = 2;
5945 	}
5946 */
5947 	else {
5948 		MesPrint("&Illegal keyword in ExtraSymbols statement: '%s'",arg1);
5949 		return(1);
5950 	}
5951 	*inp = c;
5952 	while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
5953 	if ( FG.cTable[*inp] != 0 ) {
5954 		MesPrint("&Illegal argument in ExtraSymbols statement: '%s'",inp);
5955 		return(1);
5956 	}
5957 	arg2 = inp;
5958 	while ( FG.cTable[*inp] <= 1 ) inp++;
5959 	if ( *inp != 0 ) {
5960 		MesPrint("&Illegal end of ExtraSymbols statement: '%s'",inp);
5961 		return(1);
5962 	}
5963 /*
5964 		Now check whether this object has been declared already.
5965 		That would not be allowed.
5966 */
5967 	if ( AC.extrasymbols == 1 ) {
5968 		type = GetName(AC.varnames,arg2,&number,NOAUTO);
5969 		if ( type != NAMENOTFOUND ) {
5970 			MesPrint("&ExtraSymbols statement: '%s' has already been declared before",arg2);
5971 			return(1);
5972 		}
5973 	}
5974 	else if ( AC.extrasymbols == 0 ) {
5975 		if ( *arg2 == 'N' ) {
5976 			s = arg2+1;
5977 			while ( FG.cTable[*s] == 1 ) s++;
5978 			if ( *s == 0 ) {
5979 				MesPrint("&ExtraSymbols statement: '%s' creates conflicts with summed indices",arg2);
5980 				return(1);
5981 			}
5982 		}
5983 	}
5984 	if ( AC.extrasym ) { M_free(AC.extrasym,"extrasym"); AC.extrasym = 0; }
5985 	i = inp - arg2 + 1;
5986 	AC.extrasym = (UBYTE *)Malloc1(i*sizeof(UBYTE),"extrasym");
5987 	for ( j = 0; j < i; j++ ) AC.extrasym[j] = arg2[j];
5988 	return(0);
5989 }
5990 
5991 /*
5992   	#] CoExtraSymbols :
5993   	#[ GetIfDollarFactor :
5994 */
5995 
GetIfDollarFactor(UBYTE ** inp,WORD * w)5996 WORD *GetIfDollarFactor(UBYTE **inp, WORD *w)
5997 {
5998 	LONG x;
5999 	WORD number;
6000 	UBYTE *name, c, *s;
6001 	s = *inp;
6002 	if ( FG.cTable[*s] == 1 ) {
6003 		x = 0;
6004 		while ( FG.cTable[*s] == 1 ) {
6005 			x = 10*x + *s++ - '0';
6006 			if ( x >= MAXPOSITIVE ) {
6007 				MesPrint("&Value in dollar factor too large");
6008 				while ( FG.cTable[*s] == 1 ) s++;
6009 				*inp = s;
6010 				return(0);
6011 			}
6012 		}
6013 		*w++ = IFDOLLAREXTRA;
6014 		*w++ = 3;
6015 		*w++ = -x-1;
6016 		*inp = s;
6017 		return(w);
6018 	}
6019 	if ( *s != '$' ) {
6020 		MesPrint("&Factor indicator for $-variable should be a number or a $-variable.");
6021 		return(0);
6022 	}
6023 	s++; name = s;
6024 	while ( FG.cTable[*s] < 2 ) s++;
6025 	c = *s; *s = 0;
6026 	if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
6027 		MesPrint("&dollar in if statement should have been defined previously");
6028 		return(0);
6029 	}
6030 	*s = c;
6031 	*w++ = IFDOLLAREXTRA;
6032 	*w++ = 3;
6033 	*w++ = number;
6034 	if ( c == '[' ) {
6035 		s++;
6036 		*inp = s;
6037 		if ( ( w = GetIfDollarFactor(inp,w) ) == 0 ) return(0);
6038 		s = *inp;
6039 		if ( *s != ']' ) {
6040 			MesPrint("&unmatched [] in $ in if statement");
6041 			return(0);
6042 		}
6043 		s++;
6044 		*inp = s;
6045 	}
6046 	return(w);
6047 }
6048 
6049 /*
6050   	#] GetIfDollarFactor :
6051   	#[ GetDoParam :
6052 */
6053 
GetDoParam(UBYTE * inp,WORD ** wp,int par)6054 UBYTE *GetDoParam(UBYTE *inp, WORD **wp, int par)
6055 {
6056 	LONG x;
6057 	WORD number;
6058 	UBYTE *name, c;
6059 	if ( FG.cTable[*inp] == 1 ) {
6060 		x = 0;
6061 		while ( *inp >= '0' && *inp <= '9' ) {
6062 			x = 10*x + *inp++ - '0';
6063 			if ( x > MAXPOSITIVE ) {
6064 				if ( par == -1 ) {
6065 					MesPrint("&Value in dollar factor too large");
6066 				}
6067 				else {
6068 					MesPrint("&Value in do loop boundaries too large");
6069 				}
6070 				while ( FG.cTable[*inp] == 1 ) inp++;
6071 				return(0);
6072 			}
6073 		}
6074 		if ( par > 0 ) {
6075 			*(*wp)++ = SNUMBER;
6076 			*(*wp)++ = (WORD)x;
6077 		}
6078 		else {
6079 			*(*wp)++ = DOLLAREXPR2;
6080 			*(*wp)++ = -((WORD)x)-1;
6081 		}
6082 		return(inp);
6083 	}
6084 	if ( *inp != '$' ) {
6085 		return(0);
6086 	}
6087 	inp++; name = inp;
6088 	while ( FG.cTable[*inp] < 2 ) inp++;
6089 	c = *inp; *inp = 0;
6090 	if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
6091 		if ( par == -1 ) {
6092 			MesPrint("&dollar in print statement should have been defined previously");
6093 		}
6094 		else {
6095 			MesPrint("&dollar in do loop boundaries should have been defined previously");
6096 		}
6097 		return(0);
6098 	}
6099 	*inp = c;
6100 	if ( par > 0 ) {
6101 		*(*wp)++ = DOLLAREXPRESSION;
6102 		*(*wp)++ = number;
6103 	}
6104 	else {
6105 		*(*wp)++ = DOLLAREXPR2;
6106 		*(*wp)++ = number;
6107 	}
6108 	if ( c == '[' ) {
6109 		inp++;
6110 		inp = GetDoParam(inp,wp,0);
6111 		if ( inp == 0 ) return(0);
6112 		if ( *inp != ']' ) {
6113 			if ( par == -1 ) {
6114 				MesPrint("&unmatched [] in $ in print statement");
6115 			}
6116 			else {
6117 				MesPrint("&unmatched [] in do loop boundaries");
6118 			}
6119 			return(0);
6120 		}
6121 		inp++;
6122 	}
6123 	return(inp);
6124 }
6125 
6126 /*
6127   	#] GetDoParam :
6128   	#[ CoDo :
6129 */
6130 
CoDo(UBYTE * inp)6131 int CoDo(UBYTE *inp)
6132 {
6133 	GETIDENTITY
6134 	CBUF *C = cbuf+AC.cbufnum;
6135 	WORD *w, numparam;
6136 	int error = 0, i;
6137 	UBYTE *name, c;
6138 	if ( AC.doloopstack == 0 ) {
6139 		AC.doloopstacksize = 20;
6140 		AC.doloopstack = (WORD *)Malloc1(AC.doloopstacksize*2*sizeof(WORD),"doloop stack");
6141 		AC.doloopnest = AC.doloopstack + AC.doloopstacksize;
6142 	}
6143 	if ( AC.dolooplevel >= AC.doloopstacksize ) {
6144 		WORD *newstack, *newnest, newsize;
6145 		newsize = AC.doloopstacksize * 2;
6146 		newstack = (WORD *)Malloc1(newsize*2*sizeof(WORD),"doloop stack");
6147 		newnest = newstack + newsize;
6148 		for ( i = 0; i < newsize; i++ ) {
6149 			newstack[i] = AC.doloopstack[i];
6150 			newnest[i] = AC.doloopnest[i];
6151 		}
6152 		M_free(AC.doloopstack,"doloop stack");
6153 		AC.doloopstack = newstack;
6154 		AC.doloopnest = newnest;
6155 		AC.doloopstacksize = newsize;
6156 	}
6157 	AC.doloopnest[AC.dolooplevel] = NestingChecksum();
6158 
6159 	w = AT.WorkPointer;
6160 	*w++ = TYPEDOLOOP;
6161 	w++; /* Space for the length of the statement */
6162 /*
6163 	Now the $loopvariable
6164 */
6165 	while ( *inp == ',' ) inp++;
6166 	if ( *inp != '$' ) {
6167 		error = 1;
6168 		MesPrint("&do loop parameter should be a dollar variable");
6169 	}
6170 	else {
6171 		inp++;
6172 		name = inp;
6173 		if ( FG.cTable[*inp] != 0 ) {
6174 			error = 1;
6175 			MesPrint("&illegal name for do loop parameter");
6176 		}
6177 		while ( FG.cTable[*inp] < 2 ) inp++;
6178 		c = *inp; *inp = 0;
6179 		if ( GetName(AC.dollarnames,name,&numparam,NOAUTO) == NAMENOTFOUND ) {
6180 			numparam = AddDollar(name,DOLUNDEFINED,0,0);
6181 		}
6182 		*w++ = numparam;
6183 		*inp = c;
6184 		AddPotModdollar(numparam);
6185 	}
6186 	w++;  /* space for the level of the enddo statement */
6187 	while ( *inp == ',' ) inp++;
6188 	if ( *inp != '=' ) goto IllSyntax;
6189 	inp++;
6190 	while ( *inp == ',' ) inp++;
6191 /*
6192 	The start value
6193 */
6194 	inp = GetDoParam(inp,&w,1);
6195 	if ( inp == 0 || *inp != ',' ) goto IllSyntax;
6196 	while ( *inp == ',' ) inp++;
6197 /*
6198 	The end value
6199 */
6200 	inp = GetDoParam(inp,&w,1);
6201 	if ( inp == 0 || ( *inp != 0 && *inp != ',' ) ) goto IllSyntax;
6202 /*
6203 	The increment value
6204 */
6205 	if ( *inp != ',' ) {
6206 		if ( *inp == 0 ) { *w++ = SNUMBER; *w++ = 1; }
6207 		else goto IllSyntax;
6208 	}
6209 	else {
6210 		while ( *inp == ',' ) inp++;
6211 		inp = GetDoParam(inp,&w,1);
6212 	}
6213 	if ( inp == 0 || *inp != 0 ) goto IllSyntax;
6214 	*w = 0;
6215 	AT.WorkPointer[1] = w - AT.WorkPointer;
6216 /*
6217 	Put away and set information for placing enddo information.
6218 */
6219 	AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
6220 	AC.doloopstack[AC.dolooplevel++] = C->numlhs;
6221 
6222 	return(error);
6223 
6224 IllSyntax:
6225 	MesPrint("&Illegal syntax for do statement");
6226 	return(1);
6227 }
6228 
6229 /*
6230   	#] CoDo :
6231   	#[ CoEndDo :
6232 */
6233 
CoEndDo(UBYTE * inp)6234 int CoEndDo(UBYTE *inp)
6235 {
6236 	CBUF *C = cbuf+AC.cbufnum;
6237 	WORD scratch[3];
6238 	while ( *inp == ',' ) inp++;
6239 	if ( *inp ) {
6240 		MesPrint("&Illegal syntax for EndDo statement");
6241 		return(1);
6242 	}
6243 	if ( AC.dolooplevel <= 0 ) {
6244 		MesPrint("&EndDo without corresponding Do statement");
6245 		return(1);
6246 	}
6247 	AC.dolooplevel--;
6248 	scratch[0] = TYPEENDDOLOOP;
6249 	scratch[1] = 3;
6250 	scratch[2] = AC.doloopstack[AC.dolooplevel];
6251 	AddNtoL(3,scratch);
6252 	cbuf[AC.cbufnum].lhs[AC.doloopstack[AC.dolooplevel]][3] = C->numlhs;
6253 	if ( AC.doloopnest[AC.dolooplevel] != NestingChecksum() ) {
6254 		MesNesting();
6255 		return(1);
6256 	}
6257 	return(0);
6258 }
6259 
6260 /*
6261   	#] CoEndDo :
6262   	#[ CoFactDollar :
6263 */
6264 
CoFactDollar(UBYTE * inp)6265 int CoFactDollar(UBYTE *inp)
6266 {
6267 	WORD numdollar;
6268 	if ( *inp == '$' ) {
6269 		if ( GetName(AC.dollarnames,inp+1,&numdollar,NOAUTO) != CDOLLAR ) {
6270 			MesPrint("&%s is undefined",inp);
6271 			numdollar = AddDollar(inp+1,DOLINDEX,&one,1);
6272 			return(1);
6273 		}
6274 		inp = SkipAName(inp+1);
6275 		if ( *inp != 0 ) {
6276 			MesPrint("&FactDollar should have a single $variable for its argument");
6277 			return(1);
6278 		}
6279 		AddPotModdollar(numdollar);
6280 	}
6281 	else {
6282 		MesPrint("&%s is not a $-variable",inp);
6283 		return(1);
6284 	}
6285 	Add3Com(TYPEFACTOR,numdollar);
6286 	return(0);
6287 }
6288 
6289 /*
6290   	#] CoFactDollar :
6291   	#[ CoFactorize :
6292 */
6293 
CoFactorize(UBYTE * s)6294 int CoFactorize(UBYTE *s) { return(DoFactorize(s,1)); }
6295 
6296 /*
6297   	#] CoFactorize :
6298   	#[ CoNFactorize :
6299 */
6300 
CoNFactorize(UBYTE * s)6301 int CoNFactorize(UBYTE *s) { return(DoFactorize(s,0)); }
6302 
6303 /*
6304   	#] CoNFactorize :
6305   	#[ CoUnFactorize :
6306 */
6307 
CoUnFactorize(UBYTE * s)6308 int CoUnFactorize(UBYTE *s) { return(DoFactorize(s,3)); }
6309 
6310 /*
6311   	#] CoUnFactorize :
6312   	#[ CoNUnFactorize :
6313 */
6314 
CoNUnFactorize(UBYTE * s)6315 int CoNUnFactorize(UBYTE *s) { return(DoFactorize(s,2)); }
6316 
6317 /*
6318   	#] CoNUnFactorize :
6319   	#[ DoFactorize :
6320 */
6321 
DoFactorize(UBYTE * s,int par)6322 int DoFactorize(UBYTE *s,int par)
6323 {
6324 	EXPRESSIONS e;
6325 	WORD i;
6326 	WORD number;
6327 	UBYTE *t, c;
6328 	int error = 0, keepzeroflag = 0;
6329 	if ( *s == '(' ) {
6330 		s++;
6331 		while ( *s != ')' && *s ) {
6332 			if ( FG.cTable[*s] == 0 ) {
6333 				t = s; while ( FG.cTable[*s] == 0 ) s++;
6334 				c = *s; *s = 0;
6335 				if ( StrICmp((UBYTE *)"keepzero",t) == 0 ) {
6336 					keepzeroflag = 1;
6337 				}
6338 				else {
6339 					MesPrint("&Illegal option in [N][Un]Factorize statement: %s",t);
6340 					error = 1;
6341 				}
6342 				*s = c;
6343 			}
6344 			while ( *s == ',' ) s++;
6345 			if ( *s && *s != ')' && FG.cTable[*s] != 0 ) {
6346 				MesPrint("&Illegal character in option field of [N][Un]Factorize statement");
6347 				error = 1;
6348 				return(error);
6349 			}
6350 		}
6351 		if ( *s ) s++;
6352 		while ( *s == ',' || *s == ' ' ) s++;
6353 	}
6354 	if ( *s == 0 ) {
6355 		for ( i = NumExpressions-1; i >= 0; i-- ) {
6356 			e = Expressions+i;
6357 			if ( e->replace >= 0 ) {
6358 				e = Expressions + e->replace;
6359 			}
6360 			if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
6361 			|| e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
6362 		  || e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION
6363 			) {
6364 				switch ( par ) {
6365 					case 0:
6366 						e->vflags &= ~TOBEFACTORED;
6367 						break;
6368 					case 1:
6369 						e->vflags |=  TOBEFACTORED;
6370 						e->vflags &= ~TOBEUNFACTORED;
6371 						break;
6372 					case 2:
6373 						e->vflags &= ~TOBEUNFACTORED;
6374 						break;
6375 					case 3:
6376 						e->vflags |=  TOBEUNFACTORED;
6377 						e->vflags &= ~TOBEFACTORED;
6378 						break;
6379 				}
6380 			}
6381 			if ( ( e->vflags & TOBEFACTORED ) != 0 ) {
6382 				if ( keepzeroflag ) e->vflags |=  KEEPZERO;
6383 				else                e->vflags &= ~KEEPZERO;
6384 			}
6385 			else                    e->vflags &= ~KEEPZERO;
6386 		}
6387 	}
6388 	else {
6389 		for(;;) {	/* Look for a (comma separated) list of variables */
6390 			while ( *s == ',' ) s++;
6391 			if ( *s == 0 ) break;
6392 			if ( *s == '[' || FG.cTable[*s] == 0 ) {
6393 				t = s;
6394 				if ( ( s = SkipAName(s) ) == 0 ) {
6395 					MesPrint("&Improper name for an expression: '%s'",t);
6396 					return(1);
6397 				}
6398 				c = *s; *s = 0;
6399 				if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
6400 					e = Expressions+number;
6401 					if ( e->replace >= 0 ) {
6402 						e = Expressions + e->replace;
6403 					}
6404 					if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
6405 					|| e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
6406 					|| e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION
6407 					) {
6408 						switch ( par ) {
6409 							case 0:
6410 								e->vflags &= ~TOBEFACTORED;
6411 								break;
6412 							case 1:
6413 								e->vflags |=  TOBEFACTORED;
6414 								e->vflags &= ~TOBEUNFACTORED;
6415 								break;
6416 							case 2:
6417 								e->vflags &= ~TOBEUNFACTORED;
6418 								break;
6419 							case 3:
6420 								e->vflags |=  TOBEUNFACTORED;
6421 								e->vflags &= ~TOBEFACTORED;
6422 								break;
6423 						}
6424 					}
6425 					if ( ( e->vflags & TOBEFACTORED ) != 0 ) {
6426 						if ( keepzeroflag ) e->vflags |=  KEEPZERO;
6427 						else                e->vflags &= ~KEEPZERO;
6428 					}
6429 					else                    e->vflags &= ~KEEPZERO;
6430 				}
6431 				else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
6432 					MesPrint("&%s is not an expression",t);
6433 					error = 1;
6434 				}
6435 				*s = c;
6436 			}
6437 			else {
6438 				MesPrint("&Illegal object in (N)Factorize statement");
6439 				error = 1;
6440 				while ( *s && *s != ',' ) s++;
6441 				if ( *s == 0 ) break;
6442 			}
6443 		}
6444 
6445 	}
6446 	return(error);
6447 }
6448 
6449 /*
6450   	#] DoFactorize :
6451   	#[ CoOptimizeOption :
6452 
6453 */
6454 
CoOptimizeOption(UBYTE * s)6455 int CoOptimizeOption(UBYTE *s)
6456 {
6457 	UBYTE *name, *t1, *t2, c1, c2, *value, *u;
6458 	int error = 0, x;
6459 	double d;
6460 	while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
6461 	while ( *s ) {
6462 		name = s; while ( FG.cTable[*s] == 0 ) s++;
6463 		t1 = s; c1 = *t1;
6464 		while ( *s == ' ' || *s == '\t' ) s++;
6465 		if ( *s != '=' ) {
6466 correctuse:
6467 			MesPrint("&Correct use in Format,Optimize statement is Optionname=value");
6468 			error = 1;
6469 			while ( *s == ' ' || *s == ',' || *s == '\t' || *s == '=' ) s++;
6470 			*t1 = c1;
6471 			continue;
6472 		}
6473 		*t1 = 0;
6474 		s++;
6475 		while ( *s == ' ' || *s == '\t' ) s++;
6476 		if ( *s == 0 ) goto correctuse;
6477 		value = s;
6478 		while ( FG.cTable[*s] <= 1 || *s=='.' || *s=='*' || *s == '(' || *s == ')' ) {
6479 			if ( *s == '(' ) { SKIPBRA4(s) }
6480 			s++;
6481 		}
6482 		t2 = s; c2 = *t2;
6483 		while ( *s == ' ' || *s == '\t' ) s++;
6484 		if ( *s && *s != ',' ) goto correctuse;
6485 		if ( *s ) {
6486 			s++;
6487 			while ( *s == ' ' || *s == '\t' ) s++;
6488 		}
6489 		*t2 = 0;
6490 /*
6491 		Now we have name=value with name and value zero terminated strings.
6492 */
6493 		if ( StrICmp(name,(UBYTE *)"horner") == 0 ) {
6494 			if ( StrICmp(value,(UBYTE *)"occurrence") == 0 ) {
6495 				AO.Optimize.horner = O_OCCURRENCE;
6496 			}
6497 			else if ( StrICmp(value,(UBYTE *)"mcts") == 0 ) {
6498 				AO.Optimize.horner = O_MCTS;
6499 			}
6500 			else if ( StrICmp(value,(UBYTE *)"sa") == 0 ) {
6501 				AO.Optimize.horner = O_SIMULATED_ANNEALING;
6502 			}
6503 			else {
6504 				AO.Optimize.horner = -1;
6505 				MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6506 				error = 1;
6507 			}
6508 		}
6509 		else if ( StrICmp(name,(UBYTE *)"hornerdirection") == 0 ) {
6510 			if ( StrICmp(value,(UBYTE *)"forward") == 0 ) {
6511 				AO.Optimize.hornerdirection = O_FORWARD;
6512 			}
6513 			else if ( StrICmp(value,(UBYTE *)"backward") == 0 ) {
6514 				AO.Optimize.hornerdirection = O_BACKWARD;
6515 			}
6516 			else if ( StrICmp(value,(UBYTE *)"forwardorbackward") == 0 ) {
6517 				AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
6518 			}
6519 			else if ( StrICmp(value,(UBYTE *)"forwardandbackward") == 0 ) {
6520 				AO.Optimize.hornerdirection = O_FORWARDANDBACKWARD;
6521 			}
6522 			else {
6523 				AO.Optimize.method = -1;
6524 				MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6525 				error = 1;
6526 			}
6527 		}
6528 		else if ( StrICmp(name,(UBYTE *)"method") == 0 ) {
6529 			if ( StrICmp(value,(UBYTE *)"none") == 0 ) {
6530 				AO.Optimize.method = O_NONE;
6531 			}
6532 			else if ( StrICmp(value,(UBYTE *)"cse") == 0 ) {
6533 				AO.Optimize.method = O_CSE;
6534 			}
6535 			else if ( StrICmp(value,(UBYTE *)"csegreedy") == 0 ) {
6536 				AO.Optimize.method = O_CSEGREEDY;
6537 			}
6538 			else if ( StrICmp(value,(UBYTE *)"greedy") == 0 ) {
6539 				AO.Optimize.method = O_GREEDY;
6540 			}
6541 			else {
6542 				AO.Optimize.method = -1;
6543 				MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6544 				error = 1;
6545 			}
6546 		}
6547 		else if ( StrICmp(name,(UBYTE *)"timelimit") == 0 ) {
6548 			x = 0;
6549 			u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
6550 			if ( *u != 0 ) {
6551 				MesPrint("&Option TimeLimit in Format,Optimize statement should be a positive number: %s",value);
6552 				AO.Optimize.mctstimelimit = 0;
6553 				AO.Optimize.greedytimelimit = 0;
6554 				error = 1;
6555 			}
6556 			else {
6557 				AO.Optimize.mctstimelimit = x/2;
6558 				AO.Optimize.greedytimelimit = x/2;
6559 			}
6560 		}
6561 		else if ( StrICmp(name,(UBYTE *)"mctstimelimit") == 0 ) {
6562 			x = 0;
6563 			u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
6564 			if ( *u != 0 ) {
6565 				MesPrint("&Option MCTSTimeLimit in Format,Optimize statement should be a positive number: %s",value);
6566 				AO.Optimize.mctstimelimit = 0;
6567 				error = 1;
6568 			}
6569 			else {
6570 				AO.Optimize.mctstimelimit = x;
6571 			}
6572 		}
6573 		else if ( StrICmp(name,(UBYTE *)"mctsnumexpand") == 0 ) {
6574 			int y;
6575 			x = 0;
6576 			u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
6577 			if ( *u == '*' || *u == 'x' || *u == 'X' ) {
6578 				u++; y = x;
6579 				x = 0;
6580 				while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
6581 			}
6582 			else { y = 1; }
6583 			if ( *u != 0 ) {
6584 				MesPrint("&Option MCTSNumExpand in Format,Optimize statement should be a positive number: %s",value);
6585 				AO.Optimize.mctsnumexpand= 0;
6586 				AO.Optimize.mctsnumrepeat= 1;
6587 				error = 1;
6588 			}
6589 			else {
6590 				AO.Optimize.mctsnumexpand= x;
6591 				AO.Optimize.mctsnumrepeat= y;
6592 			}
6593 		}
6594 		else if ( StrICmp(name,(UBYTE *)"mctsnumrepeat") == 0 ) {
6595 			x = 0;
6596 			u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
6597 			if ( *u != 0 ) {
6598 				MesPrint("&Option MCTSNumExpand in Format,Optimize statement should be a positive number: %s",value);
6599 				AO.Optimize.mctsnumrepeat= 1;
6600 				error = 1;
6601 			}
6602 			else {
6603 				AO.Optimize.mctsnumrepeat= x;
6604 			}
6605 		}
6606 		else if ( StrICmp(name,(UBYTE *)"mctsnumkeep") == 0 ) {
6607 			x = 0;
6608 			u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
6609 			if ( *u != 0 ) {
6610 				MesPrint("&Option MCTSNumKeep in Format,Optimize statement should be a positive number: %s",value);
6611 				AO.Optimize.mctsnumkeep= 0;
6612 				error = 1;
6613 			}
6614 			else {
6615 				AO.Optimize.mctsnumkeep= x;
6616 			}
6617 		}
6618 		else if ( StrICmp(name,(UBYTE *)"mctsconstant") == 0 ) {
6619 			d = 0;
6620 			if ( sscanf ((char*)value, "%lf", &d) != 1 ) {
6621 				MesPrint("&Option MCTSConstant in Format,Optimize statement should be a positive number: %s",value);
6622 				AO.Optimize.mctsconstant.fval = 0;
6623 				error = 1;
6624 			}
6625 			else {
6626 				AO.Optimize.mctsconstant.fval = d;
6627 			}
6628 		}
6629 		else if ( StrICmp(name,(UBYTE *)"greedytimelimit") == 0 ) {
6630 			x = 0;
6631 			u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
6632 			if ( *u != 0 ) {
6633 				MesPrint("&Option GreedyTimeLimit in Format,Optimize statement should be a positive number: %s",value);
6634 				AO.Optimize.greedytimelimit = 0;
6635 				error = 1;
6636 			}
6637 			else {
6638 				AO.Optimize.greedytimelimit = x;
6639 			}
6640 		}
6641 		else if ( StrICmp(name,(UBYTE *)"greedyminnum") == 0 ) {
6642 			x = 0;
6643 			u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
6644 			if ( *u != 0 ) {
6645 				MesPrint("&Option GreedyMinNum in Format,Optimize statement should be a positive number: %s",value);
6646 				AO.Optimize.greedyminnum= 0;
6647 				error = 1;
6648 			}
6649 			else {
6650 				AO.Optimize.greedyminnum= x;
6651 			}
6652 		}
6653 		else if ( StrICmp(name,(UBYTE *)"greedymaxperc") == 0 ) {
6654 			x = 0;
6655 			u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
6656 			if ( *u != 0 ) {
6657 				MesPrint("&Option GreedyMaxPerc in Format,Optimize statement should be a positive number: %s",value);
6658 				AO.Optimize.greedymaxperc= 0;
6659 				error = 1;
6660 			}
6661 			else {
6662 				AO.Optimize.greedymaxperc= x;
6663 			}
6664 		}
6665 		else if ( StrICmp(name,(UBYTE *)"stats") == 0 ) {
6666 			if ( StrICmp(value,(UBYTE *)"on") == 0 ) {
6667 				AO.Optimize.printstats = 1;
6668 			}
6669 			else if ( StrICmp(value,(UBYTE *)"off") == 0 ) {
6670 				AO.Optimize.printstats = 0;
6671 			}
6672 			else {
6673 				AO.Optimize.printstats = 0;
6674 				MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6675 				error = 1;
6676 			}
6677 		}
6678 		else if ( StrICmp(name,(UBYTE *)"printscheme") == 0 ) {
6679 			if ( StrICmp(value,(UBYTE *)"on") == 0 ) {
6680 				AO.Optimize.schemeflags |= 1;
6681 			}
6682 			else if ( StrICmp(value,(UBYTE *)"off") == 0 ) {
6683 				AO.Optimize.schemeflags &= ~1;
6684 			}
6685 			else {
6686 				AO.Optimize.schemeflags &= ~1;
6687 				MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6688 				error = 1;
6689 			}
6690 		}
6691 		else if ( StrICmp(name,(UBYTE *)"debugflag") == 0 ) {
6692 /*
6693 			This option is for debugging purposes only. Not in the manual!
6694 			0x1: Print statements in reverse order.
6695 			0x2: Print the scheme of the variables.
6696 */
6697 			x = 0;
6698 			u = value;
6699 			if ( FG.cTable[*u] == 1 ) {
6700 				while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
6701 				if ( *u != 0 ) {
6702 					MesPrint("&Numerical value for DebugFlag in Format,Optimize statement should be a nonnegative number: %s",value);
6703 					AO.Optimize.debugflags = 0;
6704 					error = 1;
6705 				}
6706 				else {
6707 					AO.Optimize.debugflags = x;
6708 				}
6709 			}
6710 			else if ( StrICmp(value,(UBYTE *)"on") == 0 ) {
6711 				AO.Optimize.debugflags = 1;
6712 			}
6713 			else if ( StrICmp(value,(UBYTE *)"off") == 0 ) {
6714 				AO.Optimize.debugflags = 0;
6715 			}
6716 			else {
6717 				AO.Optimize.debugflags = 0;
6718 				MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6719 				error = 1;
6720 			}
6721 		}
6722 		else if ( StrICmp(name,(UBYTE *)"scheme") == 0 ) {
6723 			UBYTE *ss, *s1, c;
6724 			WORD type, numsym;
6725 			AO.schemenum = 0;
6726 			u = value;
6727 			if ( *u != '(' ) {
6728 noscheme:
6729 				MesPrint("&Option Scheme in Format,Optimize statement should be an array of names or integers between (): %s",value);
6730 				error = 1;
6731 				break;
6732 			}
6733 			u++; ss = u;
6734 			while ( *ss == ' ' || *ss == '\t' || *ss == ',' ) ss++;
6735 			if ( FG.cTable[*ss] == 0 || *ss == '$' || *ss == '[' ) { /* Name */
6736 				s1 = u; SKIPBRA3(s1)
6737 				if ( *s1 != ')' ) goto noscheme;
6738 				while ( ss < s1 ) { if ( *ss++ == ',' ) AO.schemenum++; }
6739 				*ss++ = 0; while ( *ss == ' ' ) ss++;
6740 				if ( *ss != 0 ) goto noscheme;
6741 				ss = u;
6742 				if ( AO.schemenum < 1 ) {
6743 					MesPrint("&Option Scheme in Format,Optimize statement should have at least one name or number between ()");
6744 					error = 1;
6745 					break;
6746 				}
6747 				if ( AO.inscheme ) M_free(AO.inscheme,"Horner input scheme");
6748 				AO.inscheme = (WORD *)Malloc1((AO.schemenum+1)*sizeof(WORD),"Horner input scheme");
6749 				while ( *ss == ' ' || *ss == '\t' || *ss == ',' ) ss++;
6750 				AO.schemenum = 0;
6751 				for(;;) {
6752 					if ( *ss == 0 ) break;
6753 					s1 = ss; ss = SkipAName(s1); c = *ss; *ss = 0;
6754 
6755 					if ( ss[-1] == '_' ) {
6756 /*
6757 						Now AC.extrasym followed by a number and _
6758 */
6759 						UBYTE *u1, *u2;
6760 						u1 = s1; u2 = AC.extrasym;
6761 						while ( *u1 == *u2 ) { u1++; u2++; }
6762 						if ( *u2 == 0 ) { /* Good start */
6763 							numsym = 0;
6764 							while ( *u1 >= '0' && *u1 <= '9' ) numsym = 10*numsym + *u1++ - '0';
6765 							if ( u1 != ss-1 || numsym == 0 || AC.extrasymbols != 0 ) {
6766 								MesPrint("&Improper use of extra symbol in scheme format option");
6767 								goto noscheme;
6768 							}
6769 							numsym = MAXVARIABLES-numsym;
6770 							ss++;
6771 							goto GotTheNumber;
6772 						}
6773 					}
6774 					else if ( *s1 == '$' ) {
6775 						GETIDENTITY
6776 						int numdollar;
6777 						if ( ( numdollar = GetDollar(s1+1) ) < 0 ) {
6778 							MesPrint("&Undefined variable %s",s1);
6779 							error = 5;
6780 						}
6781 						else if ( ( numsym = DolToSymbol(BHEAD numdollar) ) < 0 ) {
6782 							MesPrint("&$%s does not evaluate to a symbol",s1);
6783 							error = 5;
6784 						}
6785 						*ss = c;
6786 						goto GotTheNumber;
6787 					}
6788 					else if ( c == '(' ) {
6789 						if ( StrCmp(s1,AC.extrasym) == 0 ) {
6790 							if ( (AC.extrasymbols&1) != 1 ) {
6791 								MesPrint("&Improper use of extra symbol in scheme format option");
6792 								goto noscheme;
6793 							}
6794 							*ss++ = c;
6795 							numsym = 0;
6796 							while ( *ss >= '0' && *ss <= '9' ) numsym = 10*numsym + *ss++ - '0';
6797 							if ( *ss != ')' ) {
6798 								MesPrint("&Extra symbol should have a number for its argument.");
6799 								goto noscheme;
6800 							}
6801 							numsym = MAXVARIABLES-numsym;
6802 							ss++;
6803 							goto GotTheNumber;
6804 						}
6805 					}
6806 					type = GetName(AC.varnames,s1,&numsym,WITHAUTO);
6807 					if ( ( type != CSYMBOL ) && type != CDUBIOUS ) {
6808 						MesPrint("&%s is not a symbol",s1);
6809 						error = 4;
6810 						if ( type < 0 ) numsym = AddSymbol(s1,-MAXPOWER,MAXPOWER,0,0);
6811 					}
6812 					*ss = c;
6813 GotTheNumber:
6814 					AO.inscheme[AO.schemenum++] = numsym;
6815 					while ( *ss == ' ' || *ss == '\t' || *ss == ',' ) ss++;
6816 				}
6817 			}
6818 		}
6819 		else if ( StrICmp(name,(UBYTE *)"mctsdecaymode") == 0 ) {
6820 			x = 0;
6821 			u = value;
6822 			if ( FG.cTable[*u] == 1 ) {
6823 				while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
6824 				if ( *u != 0 ) {
6825 					MesPrint("&Option MCTSDecayMode in Format,Optimize statement should be a nonnegative integer: %s",value);
6826 					AO.Optimize.mctsdecaymode = 0;
6827 					error = 1;
6828 				}
6829 				else {
6830 					AO.Optimize.mctsdecaymode = x;
6831 				}
6832 			}
6833 			else {
6834 				AO.Optimize.mctsdecaymode = 0;
6835 				MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
6836 				error = 1;
6837 			}
6838 		}
6839 		else if ( StrICmp(name,(UBYTE *)"saiter") == 0 ) {
6840 			x = 0;
6841 			u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
6842 			if ( *u != 0 ) {
6843 				MesPrint("&Option SAIter in Format,Optimize statement should be a positive integer: %s",value);
6844 				AO.Optimize.saIter = 0;
6845 				error = 1;
6846 			}
6847 			else {
6848 				AO.Optimize.saIter= x;
6849 			}
6850 		}
6851 		else if ( StrICmp(name,(UBYTE *)"samaxt") == 0 ) {
6852 			d = 0;
6853 			if ( sscanf ((char*)value, "%lf", &d) != 1 ) {
6854 				MesPrint("&Option SAMaxT in Format,Optimize statement should be a positive number: %s",value);
6855 				AO.Optimize.saMaxT.fval = 0;
6856 				error = 1;
6857 			}
6858 			else {
6859 				AO.Optimize.saMaxT.fval = d;
6860 			}
6861 		}
6862 		else if ( StrICmp(name,(UBYTE *)"samint") == 0 ) {
6863 			d = 0;
6864 			if ( sscanf ((char*)value, "%lf", &d) != 1 ) {
6865 				MesPrint("&Option SAMinT in Format,Optimize statement should be a positive number: %s",value);
6866 				AO.Optimize.saMinT.fval = 0;
6867 				error = 1;
6868 			}
6869 			else {
6870 				AO.Optimize.saMinT.fval = d;
6871 			}
6872 		}
6873 		else {
6874 			MesPrint("&Unrecognized option name in Format,Optimize statement: %s",name);
6875 			error = 1;
6876 		}
6877 		*t1 = c1; *t2 = c2;
6878 	}
6879 	return(error);
6880 }
6881 
6882 /*
6883   	#] CoOptimizeOption :
6884   	#[ DoPutInside :
6885 
6886 	Syntax:
6887 		PutIn[side],functionname[,brackets]  -> par = 1
6888 		AntiPutIn[side],functionname,antibrackets  -> par = -1
6889 */
6890 
CoPutInside(UBYTE * inp)6891 int CoPutInside(UBYTE *inp) { return(DoPutInside(inp,1)); }
CoAntiPutInside(UBYTE * inp)6892 int CoAntiPutInside(UBYTE *inp) { return(DoPutInside(inp,-1)); }
6893 
DoPutInside(UBYTE * inp,int par)6894 int DoPutInside(UBYTE *inp, int par)
6895 {
6896 	GETIDENTITY
6897 	UBYTE *p, c;
6898 	WORD *to, type, c1,c2,funnum, *WorkSave;
6899 	int error = 0;
6900 	while ( *inp == ' ' || *inp == '\t' || *inp == ',' ) inp++;
6901 /*
6902 	First we need the name of a function. (Not a tensor or table!)
6903 */
6904 	p = SkipAName(inp);
6905 	if ( p == 0 ) return(1);
6906 	c = *p; *p = 0;
6907 	type = GetName(AC.varnames,inp,&funnum,WITHAUTO);
6908 	if ( type != CFUNCTION || functions[funnum].tabl != 0 || functions[funnum].spec ) {
6909 		MesPrint("&PutInside/AntiPutInside expects a regular function for its first argument");
6910 		MesPrint("&Argument is %s",inp);
6911 		error = 1;
6912 	}
6913 	funnum += FUNCTION;
6914 	*p = c;
6915 	inp = p;
6916 	while ( *inp == ' ' || *inp == '\t' || *inp == ',' ) inp++;
6917 	if ( *inp == 0 ) {
6918 		if ( par == 1 ) {
6919 			WORD tocompiler[4];
6920 			tocompiler[0] = TYPEPUTINSIDE;
6921 			tocompiler[1] = 4;
6922 			tocompiler[2] = 0;
6923 			tocompiler[3] = funnum;
6924 			AddNtoL(4,tocompiler);
6925 		}
6926 		else {
6927 			MesPrint("&AntiPutInside needs inside information.");
6928 			error = 1;
6929 		}
6930 		return(error);
6931 	}
6932 	WorkSave = to = AT.WorkPointer;
6933 	*to++ = TYPEPUTINSIDE;
6934 	*to++ = 4;
6935 	*to++ = par;
6936 	*to++ = funnum;
6937 	to++;
6938 	while ( *inp ) {
6939 		while ( *inp == ' ' || *inp == '\t' || *inp == ',' ) inp++;
6940 		if ( *inp == 0 ) break;
6941 		p = SkipAName(inp);
6942 		if ( p == 0 ) { error = 1; break; }
6943 		c = *p; *p = 0;
6944 		type = GetName(AC.varnames,inp,&c1,WITHAUTO);
6945 		if ( c == '.' ) {
6946 			if ( type == CVECTOR || type == CDUBIOUS ) {
6947 				*p++ = c;
6948 				inp = p;
6949 				p = SkipAName(inp);
6950 				if ( p == 0 ) return(1);
6951 				c = *p; *p = 0;
6952 				type = GetName(AC.varnames,inp,&c2,WITHAUTO);
6953 				if ( type != CVECTOR && type != CDUBIOUS ) {
6954 					MesPrint("&Not a vector in dotproduct in PutInside/AntiPutInside statement: %s",inp);
6955 					error = 1;
6956 				}
6957 				else type = CDOTPRODUCT;
6958 			}
6959 			else {
6960 				MesPrint("&Illegal use of . after %s in PutInside/AntiPutInside statement",inp);
6961 				error = 1;
6962 				*p = c; inp = p;
6963 				continue;
6964 			}
6965 		}
6966 		switch ( type ) {
6967 			case CSYMBOL :
6968 				*to++ = SYMBOL; *to++ = 4; *to++ = c1; *to++ = 1; break;
6969 			case CVECTOR :
6970 				*to++ = INDEX; *to++ = 3; *to++ = AM.OffsetVector + c1; break;
6971 			case CFUNCTION :
6972 				*to++ = c1+FUNCTION; *to++ = FUNHEAD; *to++ = 0;
6973 				FILLFUN3(to)
6974 				break;
6975 			case CDOTPRODUCT :
6976 				*to++ = DOTPRODUCT; *to++ = 5; *to++ = c1 + AM.OffsetVector;
6977 				*to++ = c2 + AM.OffsetVector; *to++ = 1; break;
6978 			case CDELTA :
6979 				*to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX; break;
6980 			default :
6981 				MesPrint("&Illegal variable request for %s in PutInside/AntiPutInside statement",inp);
6982 				error = 1; break;
6983 		}
6984 		*p = c;
6985 		inp = p;
6986 	}
6987 	*to++ = 1; *to++ = 1; *to++ = 3;
6988 	AT.WorkPointer[1] = to - AT.WorkPointer;
6989 	AT.WorkPointer[4] = AT.WorkPointer[1]-4;
6990 	AT.WorkPointer = to;
6991 	AC.BracketNormalize = 1;
6992 	if ( Normalize(BHEAD WorkSave+4) ) { error = 1; }
6993 	else {
6994 		WorkSave[1] = WorkSave[4]+4;
6995 		to = WorkSave + WorkSave[1] - 1;
6996 		c1 = ABS(*to);
6997 		WorkSave[1] -= c1;
6998 		WorkSave[4] -= c1;
6999 		AddNtoL(WorkSave[1],WorkSave);
7000 	}
7001 	AC.BracketNormalize = 0;
7002 	AT.WorkPointer = WorkSave;
7003 	return(error);
7004 }
7005 
7006 /*
7007   	#] DoPutInside :
7008   	#[ CoSwitch :
7009 
7010 	Syntax: Switch $var;
7011 	Be carefull with illegal nestings with repeat, if, while.
7012 */
7013 
CoSwitch(UBYTE * s)7014 int CoSwitch(UBYTE *s)
7015 {
7016 	WORD numdollar;
7017 	SWITCH *sw;
7018 	if ( *s == '$' ) {
7019 		if ( GetName(AC.dollarnames,s+1,&numdollar,NOAUTO) != CDOLLAR ) {
7020 			MesPrint("&%s is undefined in switch statement",s);
7021 			numdollar = AddDollar(s+1,DOLINDEX,&one,1);
7022 			return(1);
7023 		}
7024 		s = SkipAName(s+1);
7025 		if ( *s != 0 ) {
7026 			MesPrint("&Switch should have a single $variable for its argument");
7027 			return(1);
7028 		}
7029 /*		AddPotModdollar(numdollar);  */
7030 	}
7031 	else {
7032 		MesPrint("&%s is not a $-variable in switch statement",s);
7033 		return(1);
7034 	}
7035 /*
7036 	Now create the switch table. We will add to it each time we run
7037 	into a new case. It will all be sorted out the moment we run into
7038 	the endswitch statement.
7039 */
7040 	AC.SwitchLevel++;
7041 	if ( AC.SwitchInArray >= AC.MaxSwitch ) DoubleSwitchBuffers();
7042 	AC.SwitchHeap[AC.SwitchLevel] = AC.SwitchInArray;
7043 	sw = AC.SwitchArray + AC.SwitchInArray;
7044 
7045 	sw->iflevel = AC.IfLevel;
7046 	sw->whilelevel = AC.WhileLevel;
7047 	sw->nestingsum = NestingChecksum();
7048 
7049 	Add4Com(TYPESWITCH,numdollar,AC.SwitchInArray);
7050 
7051 	AC.SwitchInArray++;
7052 	return(0);
7053 }
7054 
7055 /*
7056   	#] CoSwitch :
7057   	#[ CoCase :
7058 */
7059 
CoCase(UBYTE * s)7060 int CoCase(UBYTE *s)
7061 {
7062 	SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
7063 	WORD x = 0, sign = 1;
7064 	while ( *s == ',' ) s++;
7065 	SKIPBLANKS(s);
7066 	while ( *s == '-' || *s == '+' ) {
7067 		if ( *s == '-' ) sign = -sign;
7068 		s++;
7069 	}
7070 	while ( FG.cTable[*s] == 1 ) { x = 10*x + *s++ - '0'; }
7071 	x = sign*x;
7072 
7073 	if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
7074 		|| sw->nestingsum != NestingChecksum() ) {
7075 		MesPrint("&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
7076 		return(-1);
7077 	}
7078 /*
7079 	Now add a case to the table with the current 'address'.
7080 */
7081 	if ( sw->numcases >= sw->tablesize ) {
7082 		int i;
7083 		SWITCHTABLE *newtable;
7084 		WORD newsize;
7085 		if ( sw->tablesize == 0 ) newsize = 10;
7086 		else                  newsize = 2*sw->tablesize;
7087 		newtable = (SWITCHTABLE *)Malloc1(newsize*sizeof(SWITCHTABLE),"Switch table");
7088 		if ( sw->table ) {
7089 			for ( i = 0; i < sw->tablesize; i++ ) newtable[i] = sw->table[i];
7090 			M_free(sw->table,"Switch table");
7091 		}
7092 		sw->table = newtable;
7093 		sw->tablesize = newsize;
7094 	}
7095 	if ( sw->numcases == 0 ) { sw->mincase = sw->maxcase = x; }
7096 	else if ( x > sw->maxcase ) sw->maxcase = x;
7097 	else if ( x < sw->mincase ) sw->mincase = x;
7098 	sw->table[sw->numcases].ncase = x;
7099 	sw->table[sw->numcases].value = cbuf[AC.cbufnum].numlhs;
7100 	sw->table[sw->numcases].compbuffer = AC.cbufnum;
7101 	sw->numcases++;
7102 	return(0);
7103 }
7104 
7105 /*
7106   	#] CoCase :
7107   	#[ CoBreak :
7108 */
7109 
CoBreak(UBYTE * s)7110 int CoBreak(UBYTE *s)
7111 {
7112 /*
7113 	This involves a 'postponed' jump to the end. This can be done
7114 	in a special routine during execution.
7115 	That routine should also pop the switch level.
7116 */
7117 	SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
7118 	if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
7119 		|| sw->nestingsum != NestingChecksum() ) {
7120 		MesPrint("&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
7121 		return(-1);
7122 	}
7123 	if ( *s ) {
7124 		MesPrint("&No parameters allowed in Break statement");
7125 		return(-1);
7126 	}
7127 	Add3Com(TYPEENDSWITCH,AC.SwitchHeap[AC.SwitchLevel]);
7128 	return(0);
7129 }
7130 
7131 /*
7132   	#] CoBreak :
7133   	#[ CoDefault :
7134 */
7135 
CoDefault(UBYTE * s)7136 int CoDefault(UBYTE *s)
7137 {
7138 /*
7139 	A bit like case, except that the address gets stored directly in the
7140 	SWITCH struct.
7141 */
7142 	SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
7143 	if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
7144 		|| sw->nestingsum != NestingChecksum() ) {
7145 		MesPrint("&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
7146 		return(-1);
7147 	}
7148 	if ( *s ) {
7149 		MesPrint("&No parameters allowed in Default statement");
7150 		return(-1);
7151 	}
7152 	sw->defaultcase.ncase = 0;
7153 	sw->defaultcase.value = cbuf[AC.cbufnum].numlhs;
7154 	sw->defaultcase.compbuffer = AC.cbufnum;
7155 	return(0);
7156 }
7157 
7158 /*
7159   	#] CoDefault :
7160   	#[ CoEndSwitch :
7161 */
7162 
CoEndSwitch(UBYTE * s)7163 int CoEndSwitch(UBYTE *s)
7164 {
7165 /*
7166 	We store this address in the SWITCH struct.
7167 	Next we sort the table by ncase.
7168 	Then we decide whether the table is DENSE or SPARSE.
7169 	If it is dense we change the allocation and spread the cases is necessary.
7170 	Finally we pop levels.
7171 */
7172 	SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
7173 	WORD i;
7174 	WORD totcases = sw->maxcase-sw->mincase+1;
7175 	while ( *s == ',' ) s++;
7176 	SKIPBLANKS(s)
7177 	if ( *s ) {
7178 		MesPrint("&No parameters allowed in EndSwitch statement");
7179 		return(-1);
7180 	}
7181 	if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
7182 		|| sw->nestingsum != NestingChecksum() ) {
7183 		MesPrint("&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
7184 		return(-1);
7185 	}
7186 	if ( sw->defaultcase.value == 0 ) CoDefault(s);
7187 	if ( totcases > sw->numcases*AM.jumpratio ) { /* The factor is experimental */
7188 		sw->caseoffset = 0;
7189 		sw->typetable = SPARSETABLE;
7190 /*
7191 		Now we need to sort sw->table
7192 */
7193 		SwitchSplitMerge(sw->table,sw->numcases);
7194 	}
7195 	else {	/* DENSE */
7196 		SWITCHTABLE *ntable;
7197 		sw->caseoffset = sw->mincase;
7198 		sw->typetable = DENSETABLE;
7199 		ntable = (SWITCHTABLE *)Malloc1(totcases*sizeof(SWITCHTABLE),"Switch table");
7200 		for ( i = 0; i < totcases; i++ ) {
7201 			ntable[i].ncase = i+sw->caseoffset;
7202 			ntable[i].value = sw->defaultcase.value;
7203 			ntable[i].compbuffer = sw->defaultcase.compbuffer;
7204 		}
7205 		for ( i = 0; i < sw->numcases; i++ ) {
7206 			ntable[sw->table[i].ncase-sw->caseoffset] = sw->table[i];
7207 		}
7208 		M_free(sw->table,"Switch table");
7209 		sw->table = ntable;
7210 		sw->numcases = totcases;
7211 	}
7212 	sw->endswitch.ncase = 0;
7213 	sw->endswitch.value = cbuf[AC.cbufnum].numlhs;
7214 	sw->endswitch.compbuffer = AC.cbufnum;
7215 	if ( sw->defaultcase.value == 0 ) {
7216 		sw->defaultcase = sw->endswitch;
7217 	}
7218 	Add3Com(TYPEENDSWITCH,AC.SwitchHeap[AC.SwitchLevel]);
7219 /*
7220 	Now we need to pop.
7221 */
7222 	AC.SwitchLevel--;
7223 	return(0);
7224 }
7225 
7226 /*
7227   	#] CoEndSwitch :
7228 */
7229