FORM  4.2.1
names.c
Go to the documentation of this file.
1 
9 /* #[ License : */
10 /*
11  * Copyright (C) 1984-2017 J.A.M. Vermaseren
12  * When using this file you are requested to refer to the publication
13  * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
14  * This is considered a matter of courtesy as the development was paid
15  * for by FOM the Dutch physics granting agency and we would like to
16  * be able to track its scientific use to convince FOM of its value
17  * for the community.
18  *
19  * This file is part of FORM.
20  *
21  * FORM is free software: you can redistribute it and/or modify it under the
22  * terms of the GNU General Public License as published by the Free Software
23  * Foundation, either version 3 of the License, or (at your option) any later
24  * version.
25  *
26  * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
27  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
28  * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
29  * details.
30  *
31  * You should have received a copy of the GNU General Public License along
32  * with FORM. If not, see <http://www.gnu.org/licenses/>.
33  */
34 /* #] License : */
35 /*
36  #[ Includes :
37 */
38 
39 #include "form3.h"
40 
41 /* EXTERNLOCK(dummylock) */
42 
43 /*
44  #] Includes :
45 
46  #[ GetNode :
47 */
48 
49 NAMENODE *GetNode(NAMETREE *nametree, UBYTE *name)
50 {
51  NAMENODE *n;
52  int node, newnode, i;
53  if ( nametree->namenode == 0 ) return(0);
54  newnode = nametree->headnode;
55  do {
56  node = newnode;
57  n = nametree->namenode+node;
58  if ( ( i = StrCmp(name,nametree->namebuffer+n->name) ) < 0 )
59  newnode = n->left;
60  else if ( i > 0 ) newnode = n->right;
61  else { return(n); }
62  } while ( newnode >= 0 );
63  return(0);
64 }
65 
66 /*
67  #] GetNode :
68  #[ AddName :
69 */
70 
71 int AddName(NAMETREE *nametree, UBYTE *name, WORD type, WORD number, int *nodenum)
72 {
73  NAMENODE *n, *nn, *nnn;
74  UBYTE *s, *ss, *sss;
75  LONG *c1,*c2, j, newsize;
76  int node, newnode, node3, r, rr = 0, i, retval = 0;
77  if ( nametree->namenode == 0 ) {
78  s = name; i = 1; while ( *s ) { i++; s++; }
79  j = INITNAMESIZE;
80  if ( i > j ) j = i;
81  nametree->namenode = (NAMENODE *)Malloc1(INITNODESIZE*sizeof(NAMENODE),
82  "new nametree in AddName");
83  nametree->namebuffer = (UBYTE *)Malloc1(j,
84  "new namebuffer in AddName");
85  nametree->nodesize = INITNODESIZE;
86  nametree->namesize = j;
87  nametree->namefill = i;
88  nametree->nodefill = 1;
89  nametree->headnode = 0;
90  n = nametree->namenode;
91  n->parent = n->left = n->right = -1;
92  n->balance = 0;
93  n->type = type;
94  n->number = number;
95  n->name = 0;
96  s = name;
97  ss = nametree->namebuffer;
98  while ( *s ) *ss++ = *s++;
99  *ss = 0;
100  *nodenum = 0;
101  return(retval);
102  }
103  newnode = nametree->headnode;
104  do {
105  node = newnode;
106  n = nametree->namenode+node;
107  if ( StrCmp(name,nametree->namebuffer+n->name) < 0 ) {
108  newnode = n->left; r = -1;
109  }
110  else {
111  newnode = n->right; r = 1;
112  }
113  } while ( newnode >= 0 );
114 /*
115  We are at the insertion point. Add the node.
116 */
117  if ( nametree->nodefill >= nametree->nodesize ) { /* Double allocation */
118  newsize = nametree->nodesize * 2;
119  if ( newsize > MAXINNAMETREE ) newsize = MAXINNAMETREE;
120  if ( nametree->nodefill >= MAXINNAMETREE ) {
121  MesPrint("!!!More than %l names in one object",(LONG)MAXINNAMETREE);
122  Terminate(-1);
123  }
124  nnn = (NAMENODE *)Malloc1(2*((LONG)newsize*sizeof(NAMENODE)),
125  "extra names in AddName");
126  c1 = (LONG *)nnn; c2 = (LONG *)nametree->namenode;
127  i = (nametree->nodefill * sizeof(NAMENODE))/sizeof(LONG);
128  while ( --i >= 0 ) *c1++ = *c2++;
129  M_free(nametree->namenode,"nametree->namenode");
130  nametree->namenode = nnn;
131  nametree->nodesize = newsize;
132  n = nametree->namenode+node;
133  }
134  *nodenum = newnode = nametree->nodefill++;
135  nn = nametree->namenode+newnode;
136  nn->parent = node;
137  if ( r < 0 ) n->left = newnode; else n->right = newnode;
138  nn->left = nn->right = -1;
139  nn->type = type;
140  nn->number = number;
141  nn->balance = 0;
142  i = 1; s = name; while ( *s ) { i++; s++; }
143  while ( nametree->namefill + i >= nametree->namesize ) { /* Double alloc */
144  sss = (UBYTE *)Malloc1(2*nametree->namesize,
145  "extra names in AddName");
146  s = sss; ss = nametree->namebuffer; j = nametree->namefill;
147  while ( --j >= 0 ) *s++ = *ss++;
148  M_free(nametree->namebuffer,"nametree->namebuffer");
149  nametree->namebuffer = sss;
150  nametree->namesize *= 2;
151  }
152  s = nametree->namebuffer+nametree->namefill;
153  nn->name = nametree->namefill;
154  retval = nametree->namefill;
155  nametree->namefill += i;
156  while ( *name ) *s++ = *name++;
157  *s = 0;
158 /*
159  Adjust the balance factors
160 */
161  while ( node >= 0 ) {
162  n = nametree->namenode + node;
163  if ( newnode == n->left ) rr = -1;
164  else rr = 1;
165  if ( n->balance == -rr ) { n->balance = 0; return(retval); }
166  else if ( n->balance == rr ) break;
167  n->balance = rr;
168  newnode = node;
169  node = n->parent;
170  }
171  if ( node < 0 ) return(retval);
172 /*
173  We have to rebalance the tree. There are two basic operations.
174  n/node is the unbalanced node. newnode is its child.
175  rr is the old balance of n/node.
176 */
177  nn = nametree->namenode + newnode;
178  if ( nn->balance == -rr ) { /* The difficult case */
179  if ( rr > 0 ) {
180  node3 = nn->left;
181  nnn = nametree->namenode + node3;
182  nnn->parent = n->parent;
183  n->parent = nn->parent = node3;
184  if ( nnn->right >= 0 ) nametree->namenode[nnn->right].parent = newnode;
185  if ( nnn->left >= 0 ) nametree->namenode[nnn->left].parent = node;
186  n->right = nnn->left; nnn->left = node;
187  nn->left = nnn->right; nnn->right = newnode;
188  if ( nnn->balance > 0 ) { n->balance = -1; nn->balance = 0; }
189  else if ( nnn->balance == 0 ) { n->balance = nn->balance = 0; }
190  else { nn->balance = 1; n->balance = 0; }
191  }
192  else {
193  node3 = nn->right;
194  nnn = nametree->namenode + node3;
195  nnn->parent = n->parent;
196  n->parent = nn->parent = node3;
197  if ( nnn->right >= 0 ) nametree->namenode[nnn->right].parent = node;
198  if ( nnn->left >= 0 ) nametree->namenode[nnn->left].parent = newnode;
199  n->left = nnn->right; nnn->right = node;
200  nn->right = nnn->left; nnn->left = newnode;
201  if ( nnn->balance < 0 ) { n->balance = 1; nn->balance = 0; }
202  else if ( nnn->balance == 0 ) { n->balance = nn->balance = 0; }
203  else { nn->balance = -1; n->balance = 0; }
204  }
205  nnn->balance = 0;
206  if ( nnn->parent >= 0 ) {
207  nn = nametree->namenode + nnn->parent;
208  if ( node == nn->left ) nn->left = node3;
209  else nn->right = node3;
210  }
211  if ( node == nametree->headnode ) nametree->headnode = node3;
212  }
213  else if ( nn->balance == rr ) { /* The easy case */
214  nn->parent = n->parent; n->parent = newnode;
215  if ( rr > 0 ) {
216  if ( nn->left >= 0 ) nametree->namenode[nn->left].parent = node;
217  n->right = nn->left; nn->left = node;
218  }
219  else {
220  if ( nn->right >= 0 ) nametree->namenode[nn->right].parent = node;
221  n->left = nn->right; nn->right = node;
222  }
223  if ( nn->parent >= 0 ) {
224  nnn = nametree->namenode + nn->parent;
225  if ( node == nnn->left ) nnn->left = newnode;
226  else nnn->right = newnode;
227  }
228  nn->balance = n->balance = 0;
229  if ( node == nametree->headnode ) nametree->headnode = newnode;
230  }
231 #ifdef DEBUGON
232  else { /* Cannot be. Code here for debugging only */
233  MesPrint("We ran into an impossible case in AddName\n");
234  DumpTree(nametree);
235  Terminate(-1);
236  }
237 #endif
238  return(retval);
239 }
240 
241 /*
242  #] AddName :
243  #[ GetName :
244 
245  When AutoDeclare is an active statement.
246  If par == WITHAUTO and the variable is not found we have to check:
247  1: that nametree != AC.exprnames && nametree != AC.dollarnames
248  2: check that the variable is not in AC.exprnames after all.
249  3: call GetAutoName and return its values.
250 */
251 
252 int GetName(NAMETREE *nametree, UBYTE *name, WORD *number, int par)
253 {
254  NAMENODE *n;
255  int node, newnode, i;
256  UBYTE *s, *t, *u;
257  if ( nametree->namenode == 0 || nametree->namefill == 0 ) goto NotFound;
258  newnode = nametree->headnode;
259  do {
260  node = newnode;
261  n = nametree->namenode+node;
262  if ( ( i = StrCmp(name,nametree->namebuffer+n->name) ) < 0 )
263  newnode = n->left;
264  else if ( i > 0 ) newnode = n->right;
265  else {
266  *number = n->number;
267  return(n->type);
268  }
269  } while ( newnode >= 0 );
270  s = name;
271  while ( *s ) s++;
272  if ( s > name && s[-1] == '_' && nametree == AC.varnames ) {
273 /*
274  The Kronecker delta d_ is very special. It is not really a function.
275 */
276  if ( s == name+2 && ( *name == 'd' || *name == 'D' ) ) {
277  *number = DELTA-FUNCTION;
278  return(CDELTA);
279  }
280 /*
281  Test for N#_? type variables (summed indices)
282 */
283  if ( s > name+2 && *name == 'N' ) {
284  t = name+1; i = 0;
285  while ( FG.cTable[*t] == 1 ) i = 10*i + *t++ -'0';
286  if ( s == t+1 ) {
287  *number = i + AM.IndDum - AM.OffsetIndex;
288  return(CINDEX);
289  }
290  }
291 /*
292  Now test for any built in object
293 */
294  newnode = nametree->headnode;
295  do {
296  node = newnode;
297  n = nametree->namenode+node;
298  if ( ( i = StrHICmp(name,nametree->namebuffer+n->name) ) < 0 )
299  newnode = n->left;
300  else if ( i > 0 ) newnode = n->right;
301  else {
302  *number = n->number; return(n->type);
303  }
304  } while ( newnode >= 0 );
305 /*
306  Now we test for the extra symbols of the type STR###_
307  The string sits in AC.extrasym and is followed by digits.
308  The name is only legal if the number is in the
309  range 1,...,cbuf[AM.sbufnum].numrhs
310 */
311  t = name; u = AC.extrasym;
312  while ( *t == *u ) { t++; u++; }
313  if ( *u == 0 && *t != 0 ) { /* potential hit */
314  WORD x = 0;
315  while ( FG.cTable[*t] == 1 ) {
316  x = 10*x + (*t++ - '0');
317  }
318  if ( *t == '_' && x > 0 && x <= cbuf[AM.sbufnum].numrhs ) { /* Hit */
319  *number = MAXVARIABLES-x;
320  return(CSYMBOL);
321  }
322  }
323  }
324 NotFound:;
325  if ( par != WITHAUTO || nametree == AC.autonames ) return(NAMENOTFOUND);
326  return(GetAutoName(name,number));
327 }
328 
329 /*
330  #] GetName :
331  #[ GetFunction :
332 
333  Gets either a function or a $ that should expand into a function
334  during runtime. In the case of the $ the value in funnum is -dolnum-1.
335  The return value is the position after the name of the function or the $.
336 */
337 
338 static WORD one = 1;
339 
340 UBYTE *GetFunction(UBYTE *s,WORD *funnum)
341 {
342  int type;
343  WORD numfun;
344  UBYTE *t1, c;
345  if ( *s == '$' ) {
346  t1 = s+1; while ( FG.cTable[*t1] < 2 ) t1++;
347  c = *t1; *t1 = 0;
348  if ( ( type = GetName(AC.dollarnames,s+1,&numfun,NOAUTO) ) == CDOLLAR ) {
349  *funnum = -numfun-2;
350  }
351  else {
352  MesPrint("&%s is undefined",s);
353  numfun = AddDollar(s+1,DOLINDEX,&one,1);
354  *funnum = 0;
355  }
356  }
357  else {
358  t1 = SkipAName(s);
359  c = *t1; *t1 = 0;
360  if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
361  || ( functions[numfun].spec != 0 ) ) {
362  MesPrint("&%s should be a regular function",s);
363  *funnum = 0;
364  if ( type < 0 ) {
365  if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
366  AddFunction(s,0,0,0,0,0,-1,-1);
367  }
368  *t1 = c;
369  return(t1);
370  }
371  *funnum = numfun+FUNCTION;
372  }
373  *t1 = c;
374  return(t1);
375 }
376 
377 /*
378  #] GetFunction :
379  #[ GetNumber :
380 
381  Gets either a number or a $ that should expand into a number
382  during runtime. In the case of the $ the value in num is -dolnum-2.
383  The return value is the position after the number or the $.
384 */
385 
386 UBYTE *GetNumber(UBYTE *s,WORD *num)
387 {
388  int type;
389  WORD numfun;
390  UBYTE *t1, c;
391  while ( *s == '+' ) s++;
392  if ( *s == '$' ) {
393  t1 = s+1; while ( FG.cTable[*t1] < 2 ) t1++;
394  c = *t1; *t1 = 0;
395  if ( ( type = GetName(AC.dollarnames,s+1,&numfun,NOAUTO) ) == CDOLLAR ) {
396  *num = -numfun-2;
397  }
398  else {
399  MesPrint("&%s is undefined",s);
400  numfun = AddDollar(s+1,DOLINDEX,&one,1);
401  *num = -1;
402  }
403  }
404  else if ( *s >= '0' && *s <= '9' ) {
405  ULONG x = *s++ - '0';
406  while ( *s >= '0' && *s <= '9' ) { x = 10*x + (*s++-'0'); }
407  t1 = s;
408  if ( x >= MAXPOSITIVE ) goto illegal;
409  *num = (WORD)x;
410  return(t1);
411  }
412  else {
413  if ( *s == '-' ) { s++; }
414  if ( *s >= '0' && *s <= '9' ) { while ( *s >= '0' && *s <= '9' ) s++; t1 = s; }
415  else { t1 = SkipAName(s); }
416 illegal:
417  *num = -1;
418  MesPrint("&Illegal option in Canonicalize statement. Should be a nonnegative number or $ variable.");
419  return(t1);
420  }
421  *t1 = c;
422  return(t1);
423 }
424 
425 /*
426  #] GetNumber :
427  #[ GetLastExprName :
428 
429  When AutoDeclare is an active statement.
430  If par == WITHAUTO and the variable is not found we have to check:
431  1: that nametree != AC.exprnames && nametree != AC.dollarnames
432  2: check that the variable is not in AC.exprnames after all.
433  3: call GetAutoName and return its values.
434 */
435 
436 int GetLastExprName(UBYTE *name, WORD *number)
437 {
438  int i;
439  EXPRESSIONS e;
440  for ( i = NumExpressions; i > 0; i-- ) {
441  e = Expressions+i-1;
442  if ( StrCmp(AC.exprnames->namebuffer+e->name,name) == 0 ) {
443  *number = i-1;
444  return(1);
445  }
446  }
447  return(0);
448 }
449 
450 /*
451  #] GetLastExprName :
452  #[ GetOName :
453 
454  Adds the proper offsets, so we do not have to do that in the calling
455  routine.
456 */
457 
458 int GetOName(NAMETREE *nametree, UBYTE *name, WORD *number, int par)
459 {
460  int retval = GetName(nametree,name,number,par);
461  switch ( retval ) {
462  case CVECTOR: *number += AM.OffsetVector; break;
463  case CINDEX: *number += AM.OffsetIndex; break;
464  case CFUNCTION: *number += FUNCTION; break;
465  default: break;
466  }
467  return(retval);
468 }
469 
470 /*
471  #] GetOName :
472  #[ GetAutoName :
473 
474  This routine gets the automatic declarations
475 */
476 
477 int GetAutoName(UBYTE *name, WORD *number)
478 {
479  UBYTE *s, c;
480  int type;
481  if ( GetName(AC.exprnames,name,number,NOAUTO) != NAMENOTFOUND )
482  return(NAMENOTFOUND);
483  s = name;
484  while ( *s ) { s++; }
485  if ( s[-1] == '_' ) {
486  return(NAMENOTFOUND);
487  }
488  while ( s > name ) {
489  c = *s; *s = 0;
490  type = GetName(AC.autonames,name,number,NOAUTO);
491  *s = c;
492  switch(type) {
493  case CSYMBOL: {
494  SYMBOLS sym = ((SYMBOLS)(AC.AutoSymbolList.lijst)) + *number;
495  *number = AddSymbol(name,sym->minpower,sym->maxpower,sym->complex,sym->dimension);
496  return(type); }
497  case CVECTOR: {
498  VECTORS vec = ((VECTORS)(AC.AutoVectorList.lijst)) + *number;
499  *number = AddVector(name,vec->complex,vec->dimension);
500  return(type); }
501  case CINDEX: {
502  INDICES ind = ((INDICES)(AC.AutoIndexList.lijst)) + *number;
503  *number = AddIndex(name,ind->dimension,ind->nmin4);
504  return(type); }
505  case CFUNCTION: {
506  FUNCTIONS fun = ((FUNCTIONS)(AC.AutoFunctionList.lijst)) + *number;
507  *number = AddFunction(name,fun->commute,fun->spec,fun->complex,fun->symmetric,fun->dimension,fun->maxnumargs,fun->minnumargs);
508  return(type); }
509  default:
510  break;
511  }
512  s--;
513  }
514  return(NAMENOTFOUND);
515 }
516 
517 /*
518  #] GetAutoName :
519  #[ GetVar :
520 */
521 
522 int GetVar(UBYTE *name, WORD *type, WORD *number, int wantedtype, int par)
523 {
524  WORD funnum;
525  int typ;
526  if ( ( typ = GetName(AC.varnames,name,number,par) ) != wantedtype ) {
527  if ( typ != NAMENOTFOUND ) {
528  if ( wantedtype == -1 ) {
529  *type = typ;
530  return(1);
531  }
532  NameConflict(typ,name);
533  MakeDubious(AC.varnames,name,&funnum);
534  return(-1);
535  }
536  if ( ( typ = GetName(AC.exprnames,name,&funnum,par) ) != NAMENOTFOUND ) {
537  if ( typ == wantedtype || wantedtype == -1 ) {
538  *number = funnum; *type = typ; return(1);
539  }
540  NameConflict(typ,name);
541  return(-1);
542  }
543  return(NAMENOTFOUND);
544  }
545  if ( typ == -1 ) { return(0); }
546  *type = typ;
547  return(1);
548 }
549 
550 /*
551  #] GetVar :
552  #[ EntVar :
553 */
554 
555 WORD EntVar(WORD type, UBYTE *name, WORD x, WORD y, WORD z, WORD d)
556 {
557  switch ( type ) {
558  case CSYMBOL:
559  return(AddSymbol(name,y,z,x,d));
560  break;
561  case CINDEX:
562  return(AddIndex(name,x,z));
563  break;
564  case CVECTOR:
565  return(AddVector(name,x,d));
566  break;
567  case CFUNCTION:
568  return(AddFunction(name,y,z,x,0,d,-1,-1));
569  break;
570  case CSET:
571  AC.SetList.numtemp++;
572  return(AddSet(name,d));
573  break;
574  case CEXPRESSION:
575  return(AddExpression(name,x,y));
576  break;
577  default:
578  break;
579  }
580  return(-1);
581 }
582 
583 /*
584  #] EntVar :
585  #[ GetDollar :
586 */
587 
588 int GetDollar(UBYTE *name)
589 {
590  WORD number;
591  if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) return(-1);
592  return((int)number);
593 }
594 
595 /*
596  #] GetDollar :
597  #[ DumpTree :
598 */
599 
600 VOID DumpTree(NAMETREE *nametree)
601 {
602  if ( nametree->headnode >= 0
603  && nametree->namebuffer && nametree->namenode ) {
604  DumpNode(nametree,nametree->headnode,0);
605  }
606 }
607 
608 /*
609  #] DumpTree :
610  #[ DumpNode :
611 */
612 
613 VOID DumpNode(NAMETREE *nametree, WORD node, WORD depth)
614 {
615  NAMENODE *n;
616  int i;
617  char *name;
618  n = nametree->namenode + node;
619  if ( n->left >= 0 ) DumpNode(nametree,n->left,depth+1);
620  for ( i = 0; i < depth; i++ ) printf(" ");
621  name = (char *)(nametree->namebuffer+n->name);
622  printf("%s(%d): {%d}(%d)(%d)[%d]\n",
623  name,node,n->parent,n->left,n->right,n->balance);
624  if ( n->right >= 0 ) DumpNode(nametree,n->right,depth+1);
625 }
626 
627 /*
628  #] DumpNode :
629  #[ CompactifyTree :
630 */
631 
632 int CompactifyTree(NAMETREE *nametree,WORD par)
633 {
634  NAMETREE newtree;
635  NAMENODE *n;
636  LONG i, j, ns, k;
637  UBYTE *s;
638 
639  for ( i = 0, j = 0, k = 0, n = nametree->namenode, ns = 0;
640  i < nametree->nodefill; i++, n++ ) {
641  if ( n->type != CDELETE ) {
642  s = nametree->namebuffer+n->name;
643  while ( *s ) { s++; ns++; }
644  j++;
645  }
646  else k++;
647  }
648  if ( k == 0 ) return(0);
649  if ( j == 0 ) {
650  if ( nametree->namebuffer ) M_free(nametree->namebuffer,"nametree->namebuffer");
651  if ( nametree->namenode ) M_free(nametree->namenode,"nametree->namenode");
652  nametree->namebuffer = 0;
653  nametree->namenode = 0;
654  nametree->namesize = nametree->namefill =
655  nametree->nodesize = nametree->nodefill =
656  nametree->oldnamefill = nametree->oldnodefill = 0;
657  nametree->globalnamefill = nametree->globalnodefill =
658  nametree->clearnamefill = nametree->clearnodefill = 0;
659  nametree->headnode = -1;
660  return(0);
661  }
662  ns += j;
663  if ( j < 10 ) j = 10;
664  if ( ns < 100 ) ns = 100;
665  newtree.namenode = (NAMENODE *)Malloc1(2*j*sizeof(NAMENODE),"compactify namestree");
666  newtree.nodefill = 0; newtree.nodesize = 2*j;
667  newtree.namebuffer = (UBYTE *)Malloc1(2*ns,"compactify namestree");
668  newtree.namefill = 0; newtree.namesize = 2*ns;
669  CopyTree(&newtree,nametree,nametree->headnode,par);
670  newtree.namenode[newtree.nodefill>>1].parent = -1;
671  LinkTree(&newtree,(WORD)0,newtree.nodefill);
672  newtree.headnode = newtree.nodefill >> 1;
673  M_free(nametree->namebuffer,"nametree->namebuffer");
674  M_free(nametree->namenode,"nametree->namenode");
675  nametree->namebuffer = newtree.namebuffer;
676  nametree->namenode = newtree.namenode;
677  nametree->namesize = newtree.namesize;
678  nametree->namefill = newtree.namefill;
679  nametree->nodesize = newtree.nodesize;
680  nametree->nodefill = newtree.nodefill;
681  nametree->oldnamefill = newtree.namefill;
682  nametree->oldnodefill = newtree.nodefill;
683  nametree->headnode = newtree.headnode;
684 
685 /* DumpTree(nametree); */
686  return(0);
687 }
688 
689 /*
690  #] CompactifyTree :
691  #[ CopyTree :
692 */
693 
694 VOID CopyTree(NAMETREE *newtree, NAMETREE *oldtree, WORD node, WORD par)
695 {
696  NAMENODE *n, *m;
697  UBYTE *s, *t;
698  n = oldtree->namenode+node;
699  if ( n->left >= 0 ) CopyTree(newtree,oldtree,n->left,par);
700  if ( n->type != CDELETE ) {
701  m = newtree->namenode+newtree->nodefill;
702  m->type = n->type;
703  m->number = n->number;
704  m->name = newtree->namefill;
705  m->left = m->right = -1;
706  m->balance = 0;
707  switch ( n->type ) {
708  case CSYMBOL:
709  if ( par == AUTONAMES ) {
710  autosymbols[n->number].name = newtree->namefill;
711  autosymbols[n->number].node = newtree->nodefill;
712  }
713  else {
714  symbols[n->number].name = newtree->namefill;
715  symbols[n->number].node = newtree->nodefill;
716  }
717  break;
718  case CINDEX :
719  if ( par == AUTONAMES ) {
720  autoindices[n->number].name = newtree->namefill;
721  autoindices[n->number].node = newtree->nodefill;
722  }
723  else {
724  indices[n->number].name = newtree->namefill;
725  indices[n->number].node = newtree->nodefill;
726  }
727  break;
728  case CVECTOR:
729  if ( par == AUTONAMES ) {
730  autovectors[n->number].name = newtree->namefill;
731  autovectors[n->number].node = newtree->nodefill;
732  }
733  else {
734  vectors[n->number].name = newtree->namefill;
735  vectors[n->number].node = newtree->nodefill;
736  }
737  break;
738  case CFUNCTION:
739  if ( par == AUTONAMES ) {
740  autofunctions[n->number].name = newtree->namefill;
741  autofunctions[n->number].node = newtree->nodefill;
742  }
743  else {
744  functions[n->number].name = newtree->namefill;
745  functions[n->number].node = newtree->nodefill;
746  }
747  break;
748  case CSET:
749  Sets[n->number].name = newtree->namefill;
750  Sets[n->number].node = newtree->nodefill;
751  break;
752  case CEXPRESSION:
753  Expressions[n->number].name = newtree->namefill;
754  Expressions[n->number].node = newtree->nodefill;
755  break;
756  case CDUBIOUS:
757  Dubious[n->number].name = newtree->namefill;
758  Dubious[n->number].node = newtree->nodefill;
759  break;
760  case CDOLLAR:
761  Dollars[n->number].name = newtree->namefill;
762  Dollars[n->number].node = newtree->nodefill;
763  break;
764  default:
765  MesPrint("Illegal variable type in CopyTree: %d",n->type);
766  break;
767  }
768  newtree->nodefill++;
769  s = newtree->namebuffer + newtree->namefill;
770  t = oldtree->namebuffer + n->name;
771  while ( *t ) { *s++ = *t++; newtree->namefill++; }
772  *s = 0; newtree->namefill++;
773  }
774  if ( n->right >= 0 ) CopyTree(newtree,oldtree,n->right,par);
775 }
776 
777 /*
778  #] CopyTree :
779  #[ LinkTree :
780 */
781 
782 VOID LinkTree(NAMETREE *tree, WORD offset, WORD numnodes)
783 {
784 /*
785  Makes the tree into a binary tree
786 */
787  int med,numleft,numright,medleft,medright;
788  med = numnodes >> 1;
789  numleft = med;
790  numright = numnodes - med - 1;
791  medleft = numleft >> 1;
792  medright = ( numright >> 1 ) + med + 1;
793  if ( numleft > 0 ) {
794  tree->namenode[offset+med].left = offset+medleft;
795  tree->namenode[offset+medleft].parent = offset+med;
796  }
797  if ( numright > 0 ) {
798  tree->namenode[offset+med].right = offset+medright;
799  tree->namenode[offset+medright].parent = offset+med;
800  }
801  if ( numleft > 0 ) LinkTree(tree,offset,numleft);
802  if ( numright > 0 ) LinkTree(tree,offset+med+1,numright);
803  while ( numleft && numright ) { numleft >>= 1; numright >>= 1; }
804  if ( numleft ) tree->namenode[offset+med].balance = -1;
805  else if ( numright ) tree->namenode[offset+med].balance = 1;
806 }
807 
808 /*
809  #] LinkTree :
810  #[ MakeNameTree :
811 */
812 
813 NAMETREE *MakeNameTree()
814 {
815  NAMETREE *n;
816  n = (NAMETREE *)Malloc1(sizeof(NAMETREE),"new nametree");
817  n->namebuffer = 0;
818  n->namenode = 0;
819  n->namesize = n->namefill = n->nodesize = n->nodefill =
820  n->oldnamefill = n->oldnodefill = 0;
822  n->clearnamefill = n->clearnodefill = 0;
823  n->headnode = -1;
824  return(n);
825 }
826 
827 /*
828  #] MakeNameTree :
829  #[ FreeNameTree :
830 */
831 
832 VOID FreeNameTree(NAMETREE *n)
833 {
834  if ( n ) {
835  if ( n->namebuffer ) M_free(n->namebuffer,"nametree->namebuffer");
836  if ( n->namenode ) M_free(n->namenode,"nametree->namenode");
837  M_free(n,"nametree");
838  }
839 }
840 
841 /*
842  #] FreeNameTree :
843 
844  #[ WildcardNames :
845 */
846 
847 void ClearWildcardNames()
848 {
849  AC.NumWildcardNames = 0;
850 }
851 
852 int AddWildcardName(UBYTE *name)
853 {
854  GETIDENTITY
855  int size = 0, tocopy, i;
856  UBYTE *s = name, *t, *newbuffer;
857  while ( *s ) { s++; size++; }
858  for ( i = 0, t = AC.WildcardNames; i < AC.NumWildcardNames; i++ ) {
859  s = name;
860  while ( ( *s == *t ) && *s ) { s++; t++; }
861  if ( *s == 0 && *t == 0 ) return(i+1);
862  while ( *t ) t++;
863  t++;
864  }
865  tocopy = t - AC.WildcardNames;
866  if ( tocopy + size + 1 > AC.WildcardBufferSize ) {
867  if ( AC.WildcardBufferSize == 0 ) {
868  AC.WildcardBufferSize = size+1;
869  if ( AC.WildcardBufferSize < 100 ) AC.WildcardBufferSize = 100;
870  }
871  else if ( size+1 >= AC.WildcardBufferSize ) {
872  AC.WildcardBufferSize += size+1;
873  }
874  else {
875  AC.WildcardBufferSize *= 2;
876  }
877  newbuffer = (UBYTE *)Malloc1((LONG)AC.WildcardBufferSize,"argument list names");
878  t = newbuffer;
879  if ( AC.WildcardNames ) {
880  s = AC.WildcardNames;
881  while ( tocopy > 0 ) { *t++ = *s++; tocopy--; }
882  M_free(AC.WildcardNames,"AC.WildcardNames");
883  }
884  AC.WildcardNames = newbuffer;
885  M_free(AT.WildArgTaken,"AT.WildArgTaken");
886  AT.WildArgTaken = (WORD *)Malloc1((LONG)AC.WildcardBufferSize*sizeof(WORD)/2
887  ,"argument list names");
888  }
889  s = name;
890  while ( *s ) *t++ = *s++;
891  *t = 0;
892  AC.NumWildcardNames++;
893  return(AC.NumWildcardNames);
894 }
895 
896 int GetWildcardName(UBYTE *name)
897 {
898  UBYTE *s, *t;
899  int i;
900  for ( i = 0, t = AC.WildcardNames; i < AC.NumWildcardNames; i++ ) {
901  s = name;
902  while ( ( *s == *t ) && *s ) { s++; t++; }
903  if ( *s == 0 && *t == 0 ) return(i+1);
904  while ( *t ) t++;
905  t++;
906  }
907  return(0);
908 }
909 
910 /*
911  #] WildcardNames :
912 
913  #[ AddSymbol :
914 
915  The actual addition. Special routine for additions 'on the fly'
916 */
917 
918 int AddSymbol(UBYTE *name, int minpow, int maxpow, int cplx, int dim)
919 {
920  int nodenum, numsymbol = AC.Symbols->num;
921  UBYTE *s = name;
922  SYMBOLS sym = (SYMBOLS)FromVarList(AC.Symbols);
923  bzero(sym,sizeof(struct SyMbOl));
924  sym->name = AddName(*AC.activenames,name,CSYMBOL,numsymbol,&nodenum);
925  sym->minpower = minpow;
926  sym->maxpower = maxpow;
927  sym->complex = cplx;
928  sym->flags = 0;
929  sym->node = nodenum;
930  sym->dimension= dim;
931  while ( *s ) s++;
932  sym->namesize = (s-name)+1;
933  return(numsymbol);
934 }
935 
936 /*
937  #] AddSymbol :
938  #[ CoSymbol :
939 
940  Symbol declarations. name[#{R|I|C}][([min]:[max])]
941  Note that we know already that the parentheses match properly
942 */
943 
944 int CoSymbol(UBYTE *s)
945 {
946  int type, error = 0, minpow, maxpow, cplx, sgn, dim;
947  WORD numsymbol;
948  UBYTE *name, *oldc, c, cc;
949  do {
950  minpow = -MAXPOWER;
951  maxpow = MAXPOWER;
952  cplx = 0;
953  dim = 0;
954  name = s;
955  if ( ( s = SkipAName(s) ) == 0 ) {
956 IllForm: MesPrint("&Illegally formed name in symbol statement");
957  error = 1;
958  s = SkipField(name,0);
959  goto eol;
960  }
961  oldc = s; cc = c = *s; *s = 0;
962  if ( TestName(name) ) { *s = c; goto IllForm; }
963  if ( cc == '#' ) {
964  s++;
965  if ( tolower(*s) == 'r' ) cplx = VARTYPENONE;
966  else if ( tolower(*s) == 'c' ) cplx = VARTYPECOMPLEX;
967  else if ( tolower(*s) == 'i' ) cplx = VARTYPEIMAGINARY;
968  else if ( ( ( *s == '-' || *s == '+' || *s == '=' )
969  && ( s[1] >= '0' && s[1] <= '9' ) )
970  || ( *s >= '0' && *s <= '9' ) ) {
971  LONG x;
972  sgn = 0;
973  if ( *s == '-' ) { sgn = VARTYPEMINUS; s++; }
974  else if ( *s == '+' || *s == '=' ) { sgn = 0; s++; }
975  x = *s -'0';
976  while ( s[1] >= '0' && s[1] <= '9' ) {
977  x = 10*x + (s[1] - '0'); s++;
978  }
979  if ( x >= MAXPOWER || x <= 1 ) {
980  MesPrint("&Illegal value for root of unity %s",name);
981  error = 1;
982  }
983  else {
984  maxpow = x;
985  }
986  cplx = VARTYPEROOTOFUNITY | sgn;
987  }
988  else {
989  MesPrint("&Illegal specification for complexity of symbol %s",name);
990  *oldc = c;
991  error = 1;
992  s = SkipField(s,0);
993  goto eol;
994  }
995  s++; cc = *s;
996  }
997  if ( cc == '{' ) {
998  s++;
999  if ( ( *s == 'd' || *s == 'D' ) && s[1] == '=' ) {
1000  s += 2;
1001  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
1002  ParseSignedNumber(dim,s)
1003  if ( dim < -HALFMAX || dim > HALFMAX ) {
1004  MesPrint("&Warning: dimension of %s (%d) out of range"
1005  ,name,dim);
1006  }
1007  }
1008  if ( *s != '}' ) goto IllDim;
1009  else s++;
1010  }
1011  else {
1012 IllDim: MesPrint("&Error: Illegal dimension field for variable %s",name);
1013  error = 1;
1014  s = SkipField(s,0);
1015  goto eol;
1016  }
1017  cc = *s;
1018  }
1019  if ( cc == '(' ) {
1020  if ( ( cplx & VARTYPEROOTOFUNITY ) == VARTYPEROOTOFUNITY ) {
1021  MesPrint("&Root of unity property for %s cannot be combined with power restrictions",name);
1022  error = 1;
1023  }
1024  s++;
1025  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
1026  ParseSignedNumber(minpow,s)
1027  if ( minpow < -MAXPOWER ) {
1028  minpow = -MAXPOWER;
1029  if ( AC.WarnFlag )
1030  MesPrint("&Warning: minimum power of %s corrected to %d"
1031  ,name,-MAXPOWER);
1032  }
1033  }
1034  if ( *s != ':' ) {
1035 skippar: error = 1;
1036  s = SkipField(s,1);
1037  goto eol;
1038  }
1039  else s++;
1040  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
1041  ParseSignedNumber(maxpow,s)
1042  if ( maxpow > MAXPOWER ) {
1043  maxpow = MAXPOWER;
1044  if ( AC.WarnFlag )
1045  MesPrint("&Warning: maximum power of %s corrected to %d"
1046  ,name,MAXPOWER);
1047  }
1048  }
1049  if ( *s != ')' ) goto skippar;
1050  s++;
1051  }
1052  if ( ( AC.AutoDeclareFlag == 0 &&
1053  ( ( type = GetName(AC.exprnames,name,&numsymbol,NOAUTO) )
1054  != NAMENOTFOUND ) )
1055  || ( ( type = GetName(*(AC.activenames),name,&numsymbol,NOAUTO) ) != NAMENOTFOUND ) ) {
1056  if ( type != CSYMBOL ) error = NameConflict(type,name);
1057  else {
1058  SYMBOLS sym = (SYMBOLS)(AC.Symbols->lijst) + numsymbol;
1059  if ( ( numsymbol == AC.lPolyFunVar ) && ( AC.lPolyFunType > 0 )
1060  && ( AC.lPolyFun != 0 ) && ( minpow > -MAXPOWER || maxpow < MAXPOWER ) ) {
1061  MesPrint("&The symbol %s is used by power expansions in the PolyRatFun!",name);
1062  error = 1;
1063  }
1064  sym->complex = cplx;
1065  sym->minpower = minpow;
1066  sym->maxpower = maxpow;
1067  sym->dimension= dim;
1068  }
1069  }
1070  else {
1071  AddSymbol(name,minpow,maxpow,cplx,dim);
1072  }
1073  *oldc = c;
1074 eol: while ( *s == ',' ) s++;
1075  } while ( *s );
1076  return(error);
1077 }
1078 
1079 /*
1080  #] CoSymbol :
1081  #[ AddIndex :
1082 
1083  The actual addition. Special routine for additions 'on the fly'
1084 */
1085 
1086 int AddIndex(UBYTE *name, int dim, int dim4)
1087 {
1088  int nodenum, numindex = AC.Indices->num;
1089  INDICES ind = (INDICES)FromVarList(AC.Indices);
1090  UBYTE *s = name;
1091  bzero(ind,sizeof(struct InDeX));
1092  ind->name = AddName(*AC.activenames,name,CINDEX,numindex,&nodenum);
1093  ind->type = 0;
1094  ind->dimension = dim;
1095  ind->flags = 0;
1096  ind->nmin4 = dim4;
1097  ind->node = nodenum;
1098  while ( *s ) s++;
1099  ind->namesize = (s-name)+1;
1100  return(numindex);
1101 }
1102 
1103 /*
1104  #] AddIndex :
1105  #[ CoIndex :
1106 
1107  Index declarations. name[={number|symbol[:othersymbol]}]
1108 */
1109 
1110 int CoIndex(UBYTE *s)
1111 {
1112  int type, error = 0, dim, dim4;
1113  WORD numindex;
1114  UBYTE *name, *oldc, c;
1115  do {
1116  dim = AC.lDefDim;
1117  dim4 = AC.lDefDim4;
1118  name = s;
1119  if ( ( s = SkipAName(s) ) == 0 ) {
1120 IllForm: MesPrint("&Illegally formed name in index statement");
1121  error = 1;
1122  s = SkipField(name,0);
1123  goto eol;
1124  }
1125  oldc = s; c = *s; *s = 0;
1126  if ( TestName(name) ) { *s = c; goto IllForm; }
1127  if ( c == '=' ) {
1128  s++;
1129  if ( ( s = DoDimension(s,&dim,&dim4) ) == 0 ) {
1130  *oldc = c;
1131  error = 1;
1132  s = SkipField(name,0);
1133  goto eol;
1134  }
1135  }
1136  if ( ( AC.AutoDeclareFlag == 0 &&
1137  ( ( type = GetName(AC.exprnames,name,&numindex,NOAUTO) )
1138  != NAMENOTFOUND ) )
1139  || ( ( type = GetName(*(AC.activenames),name,&numindex,NOAUTO) ) != NAMENOTFOUND ) ) {
1140  if ( type != CINDEX ) error = NameConflict(type,name);
1141  else { /* reset the dimensions */
1142  indices[numindex].dimension = dim;
1143  indices[numindex].nmin4 = dim4;
1144  }
1145  }
1146  else AddIndex(name,dim,dim4);
1147  *oldc = c;
1148 eol: while ( *s == ',' ) s++;
1149  } while ( *s );
1150  return(error);
1151 }
1152 
1153 /*
1154  #] CoIndex :
1155  #[ DoDimension :
1156 */
1157 
1158 UBYTE *DoDimension(UBYTE *s, int *dim, int *dim4)
1159 {
1160  UBYTE c, *t = s;
1161  int type, error = 0;
1162  WORD numsymbol;
1163  NAMETREE **oldtree = AC.activenames;
1164  *dim4 = -NMIN4SHIFT;
1165  if ( FG.cTable[*s] == 1 ) {
1166 retry:
1167  ParseNumber(*dim,s)
1168 #if ( BITSINWORD/8 < 4 )
1169  if ( *dim >= (1 << (BITSINWORD-1)) ) goto illeg;
1170 #endif
1171  *dim4 = *dim - 4;
1172  return(s);
1173  }
1174  else if ( ( (FG.cTable[*s] == 0 ) || ( *s == '[' ) )
1175  && ( s = SkipAName(s) ) != 0 ) {
1176  AC.activenames = &(AC.varnames);
1177  c = *s; *s = 0;
1178  if ( ( ( type = GetName(AC.exprnames,t,&numsymbol,NOAUTO) ) != NAMENOTFOUND )
1179  || ( ( type = GetName(AC.varnames,t,&numsymbol,WITHAUTO) ) != NAMENOTFOUND ) ) {
1180  if ( type != CSYMBOL ) error = NameConflict(type,t);
1181  }
1182  else {
1183  numsymbol = AddSymbol(t,-MAXPOWER,MAXPOWER,0,0);
1184  if ( *oldtree != AC.autonames && AC.WarnFlag )
1185  MesPrint("&Warning: Implicit declaration of %s as a symbol",t);
1186  }
1187  *dim = -numsymbol;
1188  if ( ( *s = c ) == ':' ) {
1189  s++;
1190  t = s;
1191  if ( ( s = SkipAName(s) ) == 0 ) goto illeg;
1192  if ( ( ( type = GetName(AC.exprnames,t,&numsymbol,NOAUTO) ) != NAMENOTFOUND )
1193  || ( ( type = GetName(AC.varnames,t,&numsymbol,WITHAUTO) ) != NAMENOTFOUND ) ) {
1194  if ( type != CSYMBOL ) error = NameConflict(type,t);
1195  }
1196  else {
1197  numsymbol = AddSymbol(t,-MAXPOWER,MAXPOWER,0,0);
1198  if ( *oldtree != AC.autonames && AC.WarnFlag )
1199  MesPrint("&Warning: Implicit declaration of %s as a symbol",t);
1200  }
1201  *dim4 = -numsymbol-NMIN4SHIFT;
1202  }
1203  }
1204  else if ( *s == '+' && FG.cTable[s[1]] == 1 ) {
1205  s++; goto retry;
1206  }
1207  else {
1208 illeg: MesPrint("&Illegal dimension specification. Should be number >= 0, symbol or symbol:symbol");
1209  return(0);
1210  }
1211  AC.activenames = oldtree;
1212  if ( error ) return(0);
1213  return(s);
1214 }
1215 
1216 /*
1217  #] DoDimension :
1218  #[ CoDimension :
1219 */
1220 
1221 int CoDimension(UBYTE *s)
1222 {
1223  s = DoDimension(s,&AC.lDefDim,&AC.lDefDim4);
1224  if ( s == 0 ) return(1);
1225  if ( *s != 0 ) {
1226  MesPrint("&Argument of dimension statement should be number >= 0, symbol or symbol:symbol");
1227  return(1);
1228  }
1229  return(0);
1230 }
1231 
1232 /*
1233  #] CoDimension :
1234  #[ AddVector :
1235 
1236  The actual addition. Special routine for additions 'on the fly'
1237 */
1238 
1239 int AddVector(UBYTE *name, int cplx, int dim)
1240 {
1241  int nodenum, numvector = AC.Vectors->num;
1242  VECTORS v = (VECTORS)FromVarList(AC.Vectors);
1243  UBYTE *s = name;
1244  bzero(v,sizeof(struct VeCtOr));
1245  v->name = AddName(*AC.activenames,name,CVECTOR,numvector,&nodenum);
1246  v->complex = cplx;
1247  v->node = nodenum;
1248  v->dimension = dim;
1249  v->flags = 0;
1250  while ( *s ) s++;
1251  v->namesize = (s-name)+1;
1252  return(numvector);
1253 }
1254 
1255 /*
1256  #] AddVector :
1257  #[ CoVector :
1258 
1259  Vector declarations. The descriptor string is "(,%n)"
1260 */
1261 
1262 int CoVector(UBYTE *s)
1263 {
1264  int type, error = 0, dim;
1265  WORD numvector;
1266  UBYTE *name, c, *endname;
1267  do {
1268  name = s;
1269  dim = 0;
1270  if ( ( s = SkipAName(s) ) == 0 ) {
1271 IllForm: MesPrint("&Illegally formed name in vector statement");
1272  error = 1;
1273  s = SkipField(s,0);
1274  }
1275  else {
1276  c = *s; *s = 0, endname = s;
1277  if ( TestName(name) ) { *s = c; goto IllForm; }
1278  if ( c == '{' ) {
1279  s++;
1280  if ( ( *s == 'd' || *s == 'D' ) && s[1] == '=' ) {
1281  s += 2;
1282  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
1283  ParseSignedNumber(dim,s)
1284  if ( dim < -HALFMAX || dim > HALFMAX ) {
1285  MesPrint("&Warning: dimension of %s (%d) out of range"
1286  ,name,dim);
1287  }
1288  }
1289  if ( *s != '}' ) goto IllDim;
1290  else s++;
1291  }
1292  else {
1293 IllDim: MesPrint("&Error: Illegal dimension field for variable %s",name);
1294  error = 1;
1295  s = SkipField(s,0);
1296  while ( *s == ',' ) s++;
1297  continue;
1298  }
1299  }
1300  if ( ( AC.AutoDeclareFlag == 0 &&
1301  ( ( type = GetName(AC.exprnames,name,&numvector,NOAUTO) )
1302  != NAMENOTFOUND ) )
1303  || ( ( type = GetName(*(AC.activenames),name,&numvector,NOAUTO) ) != NAMENOTFOUND ) ) {
1304  if ( type != CVECTOR ) error = NameConflict(type,name);
1305  }
1306  else AddVector(name,0,dim);
1307  *endname = c;
1308  }
1309  while ( *s == ',' ) s++;
1310  } while ( *s );
1311  return(error);
1312 }
1313 
1314 /*
1315  #] CoVector :
1316  #[ AddFunction :
1317 
1318  The actual addition. Special routine for additions 'on the fly'
1319 */
1320 
1321 int AddFunction(UBYTE *name, int comm, int istensor, int cplx, int symprop, int dim, int argmax, int argmin)
1322 {
1323  int nodenum, numfunction = AC.Functions->num;
1324  FUNCTIONS fun = (FUNCTIONS)FromVarList(AC.Functions);
1325  UBYTE *s = name;
1326  bzero(fun,sizeof(struct FuNcTiOn));
1327  fun->name = AddName(*AC.activenames,name,CFUNCTION,numfunction,&nodenum);
1328  fun->commute = comm;
1329  fun->spec = istensor;
1330  fun->complex = cplx;
1331  fun->tabl = 0;
1332  fun->flags = 0;
1333  fun->node = nodenum;
1334  fun->symminfo = 0;
1335  fun->symmetric = symprop;
1336  fun->dimension = dim;
1337  fun->maxnumargs = argmax;
1338  fun->minnumargs = argmin;
1339  while ( *s ) s++;
1340  fun->namesize = (s-name)+1;
1341  return(numfunction);
1342 }
1343 
1344 /*
1345  #] AddFunction :
1346  #[ CoCommuteInSet :
1347 
1348  Commuting,f1,...,fn;
1349 */
1350 
1351 int CoCommuteInSet(UBYTE *s)
1352 {
1353  UBYTE *name, *ss, c, *start = s;
1354  WORD number, type, *g, *gg;
1355  int error = 0, i, len = StrLen(s), len2 = 0;
1356  if ( AC.CommuteInSet != 0 ) {
1357  g = AC.CommuteInSet;
1358  while ( *g ) g += *g;
1359  len2 = g - AC.CommuteInSet;
1360  if ( len2+len+3 > AC.SizeCommuteInSet ) {
1361  gg = (WORD *)Malloc1((len2+len+3)*sizeof(WORD),"CommuteInSet");
1362  for ( i = 0; i < len2; i++ ) gg[i] = AC.CommuteInSet[i];
1363  gg[len2] = 0;
1364  M_free(AC.CommuteInSet,"CommuteInSet");
1365  AC.CommuteInSet = gg;
1366  AC.SizeCommuteInSet = len+len2+3;
1367  g = AC.CommuteInSet+len2;
1368  }
1369  }
1370  else {
1371  AC.SizeCommuteInSet = len+2;
1372  g = AC.CommuteInSet = (WORD *)Malloc1((len+3)*sizeof(WORD),"CommuteInSet");
1373  *g = 0;
1374  }
1375  gg = g++;
1376  ss = s-1;
1377  for(;;) {
1378  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1379  if ( *s == 0 ) {
1380  if ( s - start >= len ) break;
1381  *s = '}'; s++;
1382  *g = 0;
1383  *gg = g-gg;
1384  if ( *gg < 2 ) {
1385  MesPrint("&There should be at least two noncommuting functions or tensors in a commuting statement.");
1386  error = 1;
1387  }
1388  else if ( *gg == 2 ) {
1389  gg[2] = gg[1]; gg[3] = 0; gg[0] = 3;
1390  }
1391  gg = g++;
1392  continue;
1393  }
1394  if ( s > ss ) {
1395  if ( *s != '{' ) {
1396  MesPrint("&The CommuteInSet statement should have sets enclosed in {}.");
1397  error = 1;
1398  break;
1399  }
1400  ss = s;
1401  SKIPBRA2(ss) /* Note that parentheses were tested before */
1402  *ss = 0;
1403  s++;
1404  }
1405  name = s;
1406  s = SkipAName(s);
1407  c = *s; *s = 0;
1408  if ( ( type = GetName(AC.varnames,name,&number,NOAUTO) ) != CFUNCTION ) {
1409  MesPrint("&%s is not a function or tensor",name);
1410  error = 1;
1411  }
1412  else if ( functions[number].commute == 0 ){
1413  MesPrint("&%s is not a noncommuting function or tensor",name);
1414  error = 1;
1415  }
1416  else {
1417  *g++ = number+FUNCTION;
1418  functions[number].flags |= COULDCOMMUTE;
1419  if ( number+FUNCTION >= GAMMA && number+FUNCTION <= GAMMASEVEN ) {
1420  functions[GAMMA-FUNCTION].flags |= COULDCOMMUTE;
1421  functions[GAMMAI-FUNCTION].flags |= COULDCOMMUTE;
1422  functions[GAMMAFIVE-FUNCTION].flags |= COULDCOMMUTE;
1423  functions[GAMMASIX-FUNCTION].flags |= COULDCOMMUTE;
1424  functions[GAMMASEVEN-FUNCTION].flags |= COULDCOMMUTE;
1425  }
1426  }
1427  *s = c;
1428  }
1429  return(error);
1430 }
1431 
1432 /*
1433  #] CoCommuteInSet :
1434  #[ CoFunction + ...:
1435 
1436  Function declarations.
1437  The second parameter indicates commutation properties.
1438  The third parameter tells whether we have a tensor.
1439 */
1440 
1441 int CoFunction(UBYTE *s, int comm, int istensor)
1442 {
1443  int type, error = 0, cplx, symtype, dim, argmax, argmin;
1444  WORD numfunction, reverseorder = 0, addone;
1445  UBYTE *name, *oldc, *par, c, cc;
1446  do {
1447  symtype = cplx = 0, argmin = argmax = -1;
1448  dim = 0;
1449  name = s;
1450  if ( ( s = SkipAName(s) ) == 0 ) {
1451 IllForm: MesPrint("&Illegally formed function/tensor name");
1452  error = 1;
1453  s = SkipField(name,0);
1454  goto eol;
1455  }
1456  oldc = s; cc = c = *s; *s = 0;
1457  if ( TestName(name) ) { *s = c; goto IllForm; }
1458  if ( c == '#' ) {
1459  s++;
1460  if ( tolower(*s) == 'r' ) cplx = VARTYPENONE;
1461  else if ( tolower(*s) == 'c' ) cplx = VARTYPECOMPLEX;
1462  else if ( tolower(*s) == 'i' ) cplx = VARTYPEIMAGINARY;
1463  else {
1464  MesPrint("&Illegal specification for complexity of %s",name);
1465  *oldc = c;
1466  error = 1;
1467  s = SkipField(s,0);
1468  goto eol;
1469  }
1470  s++; cc = *s;
1471  }
1472  if ( cc == '{' ) {
1473  s++;
1474  if ( ( *s == 'd' || *s == 'D' ) && s[1] == '=' ) {
1475  s += 2;
1476  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
1477  ParseSignedNumber(dim,s)
1478  if ( dim < -HALFMAX || dim > HALFMAX ) {
1479  MesPrint("&Warning: dimension of %s (%d) out of range"
1480  ,name,dim);
1481  }
1482  }
1483  if ( *s != '}' ) goto IllDim;
1484  else s++;
1485  }
1486  else {
1487 IllDim: MesPrint("&Error: Illegal dimension field for variable %s",name);
1488  error = 1;
1489  s = SkipField(s,0);
1490  goto eol;
1491  }
1492  cc = *s;
1493  }
1494  if ( cc == '(' ) {
1495  s++;
1496  if ( *s == '-' ) {
1497  reverseorder = REVERSEORDER;
1498  s++;
1499  }
1500  else {
1501  reverseorder = 0;
1502  }
1503  par = s;
1504  while ( FG.cTable[*s] == 0 ) s++;
1505  cc = *s; *s = 0;
1506  if ( s <= par ) {
1507 illegsym: *s = cc;
1508  MesPrint("&Illegal specification for symmetry of %s",name);
1509  *oldc = c;
1510  error = 1;
1511  s = SkipField(s,1);
1512  goto eol;
1513  }
1514  if ( StrICont(par,(UBYTE *)"symmetric") == 0 ) symtype = SYMMETRIC;
1515  else if ( StrICont(par,(UBYTE *)"antisymmetric") == 0 ) symtype = ANTISYMMETRIC;
1516  else if ( ( StrICont(par,(UBYTE *)"cyclesymmetric") == 0 )
1517  || ( StrICont(par,(UBYTE *)"cyclic") == 0 ) ) symtype = CYCLESYMMETRIC;
1518  else if ( ( StrICont(par,(UBYTE *)"rcyclesymmetric") == 0 )
1519  || ( StrICont(par,(UBYTE *)"rcyclic") == 0 )
1520  || ( StrICont(par,(UBYTE *)"reversecyclic") == 0 ) ) symtype = RCYCLESYMMETRIC;
1521  else goto illegsym;
1522  *s = cc;
1523  if ( *s != ')' || ( s[1] && s[1] != ',' && s[1] != '<' ) ) {
1524  Warning("&Excess information in symmetric properties currently ignored");
1525  s = SkipField(s,1);
1526  }
1527  else s++;
1528  symtype |= reverseorder;
1529  cc = *s;
1530  }
1531 retry:;
1532  if ( cc == '<' ) {
1533  s++; addone = 0;
1534  if ( *s == '=' ) { addone++; s++; }
1535  argmax = 0;
1536  while ( FG.cTable[*s] == 1 ) { argmax = 10*argmax + *s++ - '0'; }
1537  argmax += addone;
1538  par = s;
1539  while ( FG.cTable[*s] == 0 ) s++;
1540  if ( s > par ) {
1541  cc = *s; *s = 0;
1542  if ( ( StrICont(par,(UBYTE *)"arguments") == 0 )
1543  || ( StrICont(par,(UBYTE *)"args") == 0 ) ) {}
1544  else {
1545  Warning("&Illegal information in number of arguments properties currently ignored");
1546  error = 1;
1547  }
1548  *s = cc;
1549  }
1550  if ( argmax <= 0 ) {
1551  MesPrint("&Error: Cannot have fewer than 0 arguments for variable %s",name);
1552  error = 1;
1553  }
1554  cc = *s;
1555  }
1556  if ( cc == '>' ) {
1557  s++; addone = 1;
1558  if ( *s == '=' ) { addone = 0; s++; }
1559  argmin = 0;
1560  while ( FG.cTable[*s] == 1 ) { argmin = 10*argmin + *s++ - '0'; }
1561  argmin += addone;
1562  par = s;
1563  while ( FG.cTable[*s] == 0 ) s++;
1564  if ( s > par ) {
1565  cc = *s; *s = 0;
1566  if ( ( StrICont(par,(UBYTE *)"arguments") == 0 )
1567  || ( StrICont(par,(UBYTE *)"args") == 0 ) ) {}
1568  else {
1569  Warning("&Illegal information in number of arguments properties currently ignored");
1570  error = 1;
1571  }
1572  *s = cc;
1573  }
1574  cc = *s;
1575  }
1576  if ( cc == '<' ) goto retry;
1577  if ( ( AC.AutoDeclareFlag == 0 &&
1578  ( ( type = GetName(AC.exprnames,name,&numfunction,NOAUTO) )
1579  != NAMENOTFOUND ) )
1580  || ( ( type = GetName(*(AC.activenames),name,&numfunction,NOAUTO) ) != NAMENOTFOUND ) ) {
1581  if ( type != CFUNCTION ) error = NameConflict(type,name);
1582  else {
1583 /* FUNCTIONS fun = (FUNCTIONS)(AC.Functions->lijst) + numfunction-FUNCTION; */
1584  FUNCTIONS fun = (FUNCTIONS)(AC.Functions->lijst) + numfunction;
1585 
1586  if ( fun->tabl != 0 ) {
1587  MesPrint("&Illegal attempt to change table into function");
1588  error = 1;
1589  }
1590 
1591  fun->complex = cplx;
1592  fun->commute = comm;
1593  if ( istensor && fun->spec == 0 ) {
1594  MesPrint("&Function %s changed to tensor",name);
1595  error = 1;
1596  }
1597  else if ( istensor == 0 && fun->spec ) {
1598  MesPrint("&Tensor %s changed to function",name);
1599  error = 1;
1600  }
1601  fun->spec = istensor;
1602  if ( fun->symmetric != symtype ) {
1603  fun->symmetric = symtype;
1604  AC.SymChangeFlag = 1;
1605  }
1606  fun->maxnumargs = argmax;
1607  fun->minnumargs = argmin;
1608  }
1609  }
1610  else {
1611  AddFunction(name,comm,istensor,cplx,symtype,dim,argmax,argmin);
1612  }
1613  *oldc = c;
1614 eol: while ( *s == ',' ) s++;
1615  } while ( *s );
1616  return(error);
1617 }
1618 
1619 int CoNFunction(UBYTE *s) { return(CoFunction(s,1,0)); }
1620 int CoCFunction(UBYTE *s) { return(CoFunction(s,0,0)); }
1621 int CoNTensor(UBYTE *s) { return(CoFunction(s,1,2)); }
1622 int CoCTensor(UBYTE *s) { return(CoFunction(s,0,2)); }
1623 
1624 /*
1625  #] CoFunction + ...:
1626  #[ DoTable :
1627 
1628  Syntax:
1629  Table [check] [strict|relax] [zerofill] name(:1:2,...,regular arguments);
1630  name must be the name of a regular function.
1631  the table indices must be the first arguments.
1632  The parenthesis indicates 'name' as opposed to the options.
1633 
1634  We leave behind:
1635  a struct tabl in the FUNCTION struct
1636  Regular table:
1637  an array tablepointers for the pointers to elements of rhs
1638  in the compiler struct cbuf[T->bufnum]
1639  an array MINMAX T->mm with the minima and maxima
1640  a prototype array
1641  an offset in the compiler buffer for the pattern to be matched
1642  Sparse table:
1643  Just the number of dimensions
1644  We will keep track of the number of defined elements in totind
1645  and in tablepointers we will have numind+1 positions for each
1646  element. The first numind elements for the indices and the
1647  last one for the element in cbuf[T->bufnum].rhs
1648 
1649  Complication: to preserve speed we need a prototype and a pattern
1650  for each thread when we use WITHPTHREADS. This is because we write
1651  into those when looking for the pattern.
1652 */
1653 
1654 static int nwarntab = 1;
1655 
1656 int DoTable(UBYTE *s, int par)
1657 {
1658  GETIDENTITY
1659  UBYTE *name, *p, *inp, c;
1660  int i, j, k, sparseflag = 0, rflag = 0, checkflag = 0;
1661  int error = 0, ret, oldcbufnum, oldEside;
1662  WORD funnum, type, *OldWork, *w, *ww, *t, *tt, *flags1, oldnumrhs,oldnumlhs;
1663  LONG oldcpointer;
1664  MINMAX *mm, *mm1;
1665  LONG x, y;
1666  TABLES T;
1667  CBUF *C;
1668 
1669  while ( *s == ',' ) s++;
1670  do {
1671  name = s;
1672  if ( ( s = SkipAName(s) ) == 0 ) {
1673 IllForm: MesPrint("&Illegal name or option in table declaration");
1674  return(1);
1675  }
1676  c = *s; *s = 0;
1677  if ( TestName(name) ) { *s = c; goto IllForm; }
1678  *s = c;
1679  if ( *s == '(' ) break;
1680  if ( *s != ',' ) {
1681  MesPrint("&Illegal definition of table");
1682  return(1);
1683  }
1684  *s = 0;
1685 /*
1686  Secondary options
1687 */
1688  if ( StrICmp(name,(UBYTE *)("check" )) == 0 ) checkflag = 1;
1689  else if ( StrICmp(name,(UBYTE *)("zero" )) == 0 ) checkflag = 2;
1690  else if ( StrICmp(name,(UBYTE *)("one" )) == 0 ) checkflag = 3;
1691  else if ( StrICmp(name,(UBYTE *)("strict")) == 0 ) rflag = 1;
1692  else if ( StrICmp(name,(UBYTE *)("relax" )) == 0 ) rflag = -1;
1693  else if ( StrICmp(name,(UBYTE *)("zerofill" )) == 0 ) { rflag = -2; checkflag = 2; }
1694  else if ( StrICmp(name,(UBYTE *)("onefill" )) == 0 ) { rflag = -3; checkflag = 3; }
1695  else if ( StrICmp(name,(UBYTE *)("sparse")) == 0 ) sparseflag |= 1;
1696  else if ( StrICmp(name,(UBYTE *)("base")) == 0 ) sparseflag |= 3;
1697  else if ( StrICmp(name,(UBYTE *)("tablebase")) == 0 ) sparseflag |= 3;
1698  else {
1699  MesPrint("&Illegal option in table definition: '%s'",name);
1700  error = 1;
1701  }
1702  *s++ = ',';
1703  while ( *s == ',' ) s++;
1704  } while ( *s );
1705  if ( name == s || *s == 0 ) {
1706  MesPrint("&Illegal name or option in table declaration");
1707  return(1);
1708  }
1709  *s = 0; /* *s could only have been a parenthesis */
1710  if ( sparseflag ) {
1711  if ( checkflag == 1 ) rflag = 0;
1712  else if ( checkflag == 2 ) rflag = -2;
1713  else if ( checkflag == 3 ) rflag = -3;
1714  else rflag = -1;
1715  }
1716  if ( ( ret = GetVar(name,&type,&funnum,CFUNCTION,NOAUTO) ) ==
1717  NAMENOTFOUND ) {
1718  if ( par == 0 ) {
1719  funnum = EntVar(CFUNCTION,name,0,1,0,0);
1720  }
1721  else if ( par == 1 || par == 2 ) {
1722  funnum = EntVar(CFUNCTION,name,0,0,0,0);
1723  }
1724  }
1725  else if ( ret <= 0 ) {
1726  funnum = EntVar(CFUNCTION,name,0,0,0,0);
1727  error = 1;
1728  }
1729  else {
1730  if ( par == 2 ) {
1731  if ( nwarntab ) {
1732  Warning("Table now declares its (commuting) function.");
1733  Warning("Earlier definition in Function statement obsolete. Please remove.");
1734  nwarntab = 0;
1735  }
1736  }
1737  else {
1738  error = 1;
1739  MesPrint("&(N)(C)Tables should not be declared previously");
1740  }
1741  }
1742  if ( functions[funnum].spec > 0 ) {
1743  MesPrint("&Tensors cannot become tables");
1744  return(1);
1745  }
1746  if ( functions[funnum].symmetric > 0 ) {
1747  MesPrint("&Functions with nontrivial symmetrization properties cannot become tables");
1748  return(1);
1749  }
1750  if ( functions[funnum].tabl ) {
1751  MesPrint("&Redefinition of an existing table is not allowed.");
1752  return(1);
1753  }
1754  functions[funnum].tabl = T = (TABLES)Malloc1(sizeof(struct TaBlEs),"table");
1755 /*
1756  Next we find the size of the table (if it is not sparse)
1757 */
1758  T->defined = T->mdefined = 0; T->sparse = sparseflag; T->mm = 0; T->flags = 0;
1759  T->numtree = 0; T->rootnum = 0; T->MaxTreeSize = 0;
1760  T->boomlijst = 0;
1761  T->strict = rflag;
1762  T->bounds = checkflag;
1763  T->bufnum = inicbufs();
1764  T->argtail = 0;
1765  T->spare = 0;
1766  T->bufferssize = 8;
1767  T->buffers = (WORD *)Malloc1(sizeof(WORD)*T->bufferssize,"Table buffers");
1768  T->buffersfill = 0;
1769  T->buffers[T->buffersfill++] = T->bufnum;
1770  T->mode = 0;
1771  T->numdummies = 0;
1772  mm = T->mm;
1773  T->numind = 0;
1774  if ( rflag > 0 ) AC.MustTestTable++;
1775  T->totind = 0; /* Table hasn't been checked */
1776 
1777  p = s; *s = '(';
1778  if ( sparseflag ) {
1779 /*
1780  First copy the tail, just in case we will construct a tablebase
1781  Note that we keep the ( to indicate a tail
1782  The actual arguments can be found after the comma. Before we have
1783  the dimension which the tablebase will need for consistency checking.
1784 */
1785  inp = p+1;
1786  SKIPBRA3(inp)
1787  c = *inp; *inp = 0;
1788  T->argtail = strDup1(p,"argtail");
1789  *inp = c;
1790 /*
1791  Now the regular compilation
1792 */
1793  inp = p++;
1794  ParseNumber(x,p)
1795  if ( FG.cTable[p[-1]] != 1 || ( *p != ',' && *p != ')' ) ) {
1796  p = inp;
1797  MesPrint("&First argument in a sparse table must be a number of dimensions");
1798  error = 1;
1799  x = 1;
1800  }
1801  T->numind = x;
1802  T->mm = (MINMAX *)Malloc1(x*sizeof(MINMAX),"table dimensions");
1803  T->flags = (WORD *)Malloc1(x*sizeof(WORD),"table flags");
1804  mm = T->mm;
1805  inp = p;
1806  if ( *inp != ')' ) inp++;
1807  T->totind = 0; /* At the moment there are this many */
1808  T->tablepointers = 0;
1809  T->reserved = 0;
1810  }
1811  else {
1812  T->numind = 0;
1813  T->totind = 1;
1814  for(;;) { /* Read the dimensions as far as they can be recognized */
1815  inp = ++p;
1816  if ( FG.cTable[*p] != 1 && *p != '+' && *p != '-' ) break;
1817  ParseSignedNumber(x,p)
1818  if ( FG.cTable[p[-1]] != 1 || *p != ':' ) break;
1819  p++;
1820  ParseSignedNumber(y,p)
1821  if ( FG.cTable[p[-1]] != 1 || ( *p != ',' && *p != ')' ) ) {
1822  MesPrint("&Illegal dimension field in table declaration");
1823  return(1);
1824  }
1825  mm1 = (MINMAX *)Malloc1((T->numind+1)*sizeof(MINMAX),"table dimensions");
1826  flags1 = (WORD *)Malloc1((T->numind+1)*sizeof(WORD),"table flags");
1827  for ( i = 0; i < T->numind; i++ ) { mm1[i] = T->mm[i]; flags1[i] = T->flags[i]; }
1828  if ( T->mm ) M_free(T->mm,"table dimensions");
1829  if ( T->flags ) M_free(T->flags,"table flags");
1830  T->mm = mm1;
1831  T->flags = flags1;
1832  mm = T->mm + T->numind;
1833  mm->mini = x; mm->maxi = y;
1834  T->totind *= mm->maxi-mm->mini+1;
1835  T->numind++;
1836  if ( *p == ')' ) { inp = p; break; }
1837  }
1838  w = T->tablepointers
1839  = (WORD *)Malloc1(TABLEEXTENSION*sizeof(WORD)*(T->totind),"table pointers");
1840  i = T->totind;
1841  for ( i = TABLEEXTENSION*T->totind; i > 0; i-- ) *w++ = -1; /* means: undefined */
1842  for ( i = T->numind-1, x = 1; i >= 0; i-- ) {
1843  T->mm[i].size = x; /* Defines increment in this dimension */
1844  x *= T->mm[i].maxi - T->mm[i].mini + 1;
1845  }
1846  }
1847 /*
1848  Now we redo the 'function part' and send it to the compiler.
1849  The prototype has to be picked up properly.
1850 */
1851  AT.WorkPointer++; /* We needs one extra word later */
1852  OldWork = AT.WorkPointer;
1853  oldcbufnum = AC.cbufnum;
1854  AC.cbufnum = T->bufnum;
1855  C = cbuf+AC.cbufnum;
1856  oldcpointer = C->Pointer - C->Buffer;
1857  oldnumlhs = C->numlhs;
1858  oldnumrhs = C->numrhs;
1859  AddLHS(AC.cbufnum);
1860  while ( s >= name ) *--inp = *s--;
1861  w = AT.WorkPointer;
1862  AC.ProtoType = w;
1863  *w++ = SUBEXPRESSION;
1864  *w++ = SUBEXPSIZE;
1865  *w++ = 0;
1866  *w++ = 1;
1867  *w++ = AC.cbufnum;
1868  FILLSUB(w)
1869  AC.WildC = w;
1870  AC.NwildC = 0;
1871  AT.WorkPointer = w + 4*AM.MaxWildcards;
1872  if ( ( ret = CompileAlgebra(inp,LHSIDE,AC.ProtoType) ) < 0 ) {
1873  error = 1; goto FinishUp;
1874  }
1875  if ( AC.NwildC && SortWild(w,AC.NwildC) ) error = 1;
1876  w += AC.NwildC;
1877  i = w-OldWork;
1878  OldWork[1] = i;
1879 /*
1880  Basically we have to pull this pattern through Generator in case
1881  there are functions inside functions, or parentheses.
1882  We have to temporarily disable the .tabl to avoid problems with
1883  TestSub.
1884  Essential: we need to start NewSort twice to avoid the PutOut routines.
1885  The ground pattern is sitting in C->numrhs, but it could be that it
1886  has subexpressions in it. Hence it has to be worked out as the lhs in
1887  id statements (in comexpr.c).
1888 */
1889  OldWork[2] = C->numrhs;
1890  *w++ = 1; *w++ = 1; *w++ = 3;
1891  OldWork[-1] = w-OldWork+1;
1892  AT.WorkPointer = w;
1893  ww = C->rhs[C->numrhs];
1894  for ( j = 0; j < *ww; j++ ) w[j] = ww[j];
1895  AT.WorkPointer = w+*w;
1896  if ( *ww == 0 || ww[*ww] != 0 ) {
1897  MesPrint("&Illegal table pattern definition");
1898  AC.lhdollarflag = 0;
1899  error = 1;
1900  }
1901  if ( error ) goto FinishUp;
1902 
1903  if ( NewSort(BHEAD0) || NewSort(BHEAD0) ) { error = 1; goto FinishUp; }
1904  AN.RepPoint = AT.RepCount + 1;
1905  AC.lhdollarflag = 0; oldEside = AR.Eside; AR.Eside = LHSIDE;
1906  AR.Cnumlhs = C->numlhs;
1907  functions[funnum].tabl = 0;
1908  if ( Generator(BHEAD w,C->numlhs) ) {
1909  functions[funnum].tabl = T;
1910  AR.Eside = oldEside;
1911  LowerSortLevel(); LowerSortLevel(); goto FinishUp;
1912  }
1913  functions[funnum].tabl = T;
1914  AR.Eside = oldEside;
1915  AT.WorkPointer = w;
1916  if ( EndSort(BHEAD w,0) < 0 ) { LowerSortLevel(); goto FinishUp; }
1917  if ( *w == 0 || *(w+*w) != 0 ) {
1918  MesPrint("&Irregular pattern in table definition");
1919  error = 1;
1920  goto FinishUp;
1921  }
1922  LowerSortLevel();
1923  if ( AC.lhdollarflag ) {
1924  MesPrint("&Unexpanded dollar variables are not allowed in table definition");
1925  error = 1;
1926  goto FinishUp;
1927  }
1928  AT.WorkPointer = ww = w + *w;
1929  if ( ww[-1] != 3 || ww[-2] != 1 || ww[-3] != 1 ) {
1930  MesPrint("&Coefficient of pattern in table definition should be 1.");
1931  error = 1;
1932  goto FinishUp;
1933  }
1934  AC.DumNum = 0;
1935 /*
1936  Now we have to allocate space for prototype+pattern
1937  In the case of TFORM we need extra pointers, because each worker has its own
1938 */
1939  j = *w + T->numind*2-3;
1940 #ifdef WITHPTHREADS
1941  { int n;
1942  T->prototypeSize = ((i+j)*sizeof(WORD)+2*sizeof(WORD *)) * AM.totalnumberofthreads;
1943  T->prototype = (WORD **)Malloc1(T->prototypeSize,"table prototype");
1944  T->pattern = T->prototype + AM.totalnumberofthreads;
1945  t = (WORD *)(T->pattern + AM.totalnumberofthreads);
1946  for ( n = 0; n < AM.totalnumberofthreads; n++ ) {
1947  T->prototype[n] = t;
1948  for ( k = 0; k < i; k++ ) *t++ = OldWork[k];
1949  }
1950  T->pattern[0] = t;
1951  j--; w++;
1952  w[1] += T->numind*2;
1953  for ( k = 0; k < FUNHEAD; k++ ) *t++ = *w++;
1954  j -= FUNHEAD;
1955  for ( k = 0; k < T->numind; k++ ) { *t++ = -SNUMBER; *t++ = 0; j -= 2; }
1956  for ( k = 0; k < j; k++ ) *t++ = *w++;
1957  if ( sparseflag ) T->pattern[0][1] = t - T->pattern[0];
1958  k = t - T->pattern[0];
1959  for ( n = 1; n < AM.totalnumberofthreads; n++ ) {
1960  T->pattern[n] = t; tt = T->pattern[0];
1961  for ( i = 0; i < k; i++ ) *t++ = *tt++;
1962  }
1963  }
1964 #else
1965  T->prototypeSize = (i+j)*sizeof(WORD);
1966  T->prototype = (WORD *)Malloc1(T->prototypeSize, "table prototype");
1967  T->pattern = T->prototype + i;
1968  for ( k = 0; k < i; k++ ) T->prototype[k] = OldWork[k];
1969  t = T->pattern;
1970  j--; w++;
1971  w[1] += T->numind*2;
1972  for ( k = 0; k < FUNHEAD; k++ ) *t++ = *w++;
1973  j -= FUNHEAD;
1974  for ( k = 0; k < T->numind; k++ ) { *t++ = -SNUMBER; *t++ = 0; j -= 2; }
1975  for ( k = 0; k < j; k++ ) *t++ = *w++;
1976  if ( sparseflag ) T->pattern[1] = t - T->pattern;
1977 #endif
1978 /*
1979  At this point we can pop the compilerbuffer.
1980 */
1981  C->Pointer = C->Buffer + oldcpointer;
1982  C->numrhs = oldnumrhs;
1983  C->numlhs = oldnumlhs;
1984 /*
1985  Now check whether wildcards get converted to dollars (for PARALLEL)
1986  We give a warning!
1987 */
1988 #ifdef WITHPTHREADS
1989  t = T->prototype[0];
1990 #else
1991  t = T->prototype;
1992 #endif
1993  tt = t + t[1]; t += SUBEXPSIZE;
1994  while ( t < tt ) {
1995  if ( *t == LOADDOLLAR ) {
1996  Warning("The use of $-variable assignments in tables disables parallel\
1997  execution for the whole program.");
1998  AM.hparallelflag |= NOPARALLEL_TBLDOLLAR;
1999  AC.mparallelflag |= NOPARALLEL_TBLDOLLAR;
2000  AddPotModdollar(t[2]);
2001  }
2002  t += t[1];
2003  }
2004 FinishUp:;
2005  AT.WorkPointer = OldWork - 1;
2006  AC.cbufnum = oldcbufnum;
2007  if ( T->sparse ) ClearTableTree(T);
2008  if ( ( sparseflag & 2 ) != 0 ) {
2009  if ( T->spare == 0 ) { SpareTable(T); }
2010  }
2011  return(error);
2012 }
2013 
2014 /*
2015  #] DoTable :
2016  #[ CoTable :
2017 */
2018 
2019 int CoTable(UBYTE *s)
2020 {
2021  return(DoTable(s,2));
2022 }
2023 
2024 /*
2025  #] CoTable :
2026  #[ CoNTable :
2027 */
2028 
2029 int CoNTable(UBYTE *s)
2030 {
2031  return(DoTable(s,0));
2032 }
2033 
2034 /*
2035  #] CoNTable :
2036  #[ CoCTable :
2037 */
2038 
2039 int CoCTable(UBYTE *s)
2040 {
2041  return(DoTable(s,1));
2042 }
2043 
2044 /*
2045  #] CoCTable :
2046  #[ EmptyTable :
2047 */
2048 
2049 void EmptyTable(TABLES T)
2050 {
2051  int j;
2052  if ( T->sparse ) ClearTableTree(T);
2053  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
2054  T->boomlijst = 0;
2055  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
2056  finishcbuf(T->buffers[j]);
2057  }
2058  if ( T->buffers ) M_free(T->buffers,"Table buffers");
2059  finishcbuf(T->bufnum);
2060  T->bufnum = inicbufs();
2061  T->bufferssize = 8;
2062  T->buffers = (WORD *)Malloc1(sizeof(WORD)*T->bufferssize,"Table buffers");
2063  T->buffersfill = 0;
2064  T->buffers[T->buffersfill++] = T->bufnum;
2065  T->defined = T->mdefined = 0; T->flags = 0;
2066  T->numtree = 0; T->rootnum = 0; T->MaxTreeSize = 0;
2067  T->spare = 0; T->reserved = 0;
2068  if ( T->spare ) {
2069  TABLES TT = T->spare;
2070  if ( TT->mm ) M_free(TT->mm,"tableminmax");
2071  if ( TT->flags ) M_free(TT->flags,"tableflags");
2072  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2073  for (j = 0; j < TT->buffersfill; j++ ) {
2074  finishcbuf(TT->buffers[j]);
2075  }
2076  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
2077  if ( TT->buffers ) M_free(TT->buffers,"Table buffers");
2078  M_free(TT,"table");
2079  SpareTable(T);
2080  }
2081  else {
2082  WORD *w = T->tablepointers;
2083  j = T->totind;
2084  for ( j = TABLEEXTENSION*T->totind; j > 0; j-- ) *w++ = -1; /* means: undefined */
2085  }
2086 }
2087 
2088 /*
2089  #] EmptyTable :
2090  #[ AddSet :
2091 */
2092 
2093 int AddSet(UBYTE *name, WORD dim)
2094 {
2095  int nodenum, numset = AC.SetList.num;
2096  SETS set = (SETS)FromVarList(&AC.SetList);
2097  UBYTE *s;
2098  if ( name ) {
2099  set->name = AddName(AC.varnames,name,CSET,numset,&nodenum);
2100  s = name;
2101  while ( *s ) s++;
2102  set->namesize = (s-name)+1;
2103  set->node = nodenum;
2104  }
2105  else {
2106  set->name = 0;
2107  set->namesize = 0;
2108  set->node = -1;
2109  }
2110  set->first =
2111  set->last = AC.SetElementList.num; /* set has no elements yet */
2112  set->type = -1; /* undefined as of yet */
2113  set->dimension = dim;
2114  set->flags = 0;
2115  return(numset);
2116 }
2117 
2118 /*
2119  #] AddSet :
2120  #[ DoElements :
2121 
2122  Remark (25-mar-2011): If the dimension has been set (dim != MAXPOSITIVE)
2123  we want to test dimensions. Numbers count as dimension zero?
2124 */
2125 
2126 int DoElements(UBYTE *s, SETS set, UBYTE *name)
2127 {
2128  int type, error = 0, x, sgn, i;
2129  WORD numset, *e;
2130  UBYTE c, *cname;
2131  while ( *s ) {
2132  if ( *s == ',' ) { s++; continue; }
2133  sgn = 0;
2134  while ( *s == '-' || *s == '+' ) { sgn ^= 1; s++; }
2135  cname = s;
2136  if ( FG.cTable[*s] == 0 || *s == '_' || *s == '[' ) {
2137  if ( ( s = SkipAName(s) ) == 0 ) {
2138  MesPrint("&Illegal name in set definition");
2139  return(1);
2140  }
2141  c = *s; *s = 0;
2142  if ( ( ( type = GetName(AC.exprnames,cname,&numset,NOAUTO) ) == NAMENOTFOUND )
2143  && ( ( type = GetOName(AC.varnames,cname,&numset,WITHAUTO) ) == NAMENOTFOUND ) ) {
2144  DUBIOUSV dv;
2145  int nodenum;
2146  MesPrint("&%s has not been declared",cname);
2147 /*
2148  We enter a 'dubious' declaration to cut down on errors
2149 */
2150  numset = AC.DubiousList.num;
2151  dv = (DUBIOUSV)FromVarList(&AC.DubiousList);
2152  dv->name = AddName(AC.varnames,cname,CDUBIOUS,numset,&nodenum);
2153  dv->node = nodenum;
2154  set->type = type = CDUBIOUS;
2155  set->dimension = 0;
2156  error = 1;
2157  }
2158  if ( set->type == -1 ) {
2159  if ( type == CSYMBOL ) {
2160  for ( i = set->first; i < set->last; i++ ) {
2161  SetElements[i] += 2*MAXPOWER;
2162  }
2163  }
2164  set->type = type;
2165  }
2166  if ( set->type != type && set->type != CDUBIOUS
2167  && type != CDUBIOUS ) {
2168  if ( set->type != CNUMBER || ( type != CSYMBOL
2169  && type != CINDEX ) ) {
2170  MesPrint(
2171  "&%s has not the same type as the other members of the set"
2172  ,cname);
2173  error = 1;
2174  set->type = CDUBIOUS;
2175  }
2176  else {
2177  if ( type == CSYMBOL ) {
2178  for ( i = set->first; i < set->last; i++ ) {
2179  SetElements[i] += 2*MAXPOWER;
2180  }
2181  }
2182  set->type = type;
2183  }
2184  }
2185  if ( set->dimension != MAXPOSITIVE ) { /* Dimension check */
2186  switch ( set->type ) {
2187  case CSYMBOL:
2188  if ( symbols[numset].dimension != set->dimension ) {
2189  MesPrint("&Dimension check failed in set %s, symbol %s",
2190  VARNAME(Sets,(set-Sets)),
2191  VARNAME(symbols,numset));
2192  error = 1;
2193  set->dimension = MAXPOSITIVE;
2194  }
2195  break;
2196  case CVECTOR:
2197  if ( vectors[numset-AM.OffsetVector].dimension != set->dimension ) {
2198  MesPrint("&Dimension check failed in set %s, vector %s",
2199  VARNAME(Sets,(set-Sets)),
2200  VARNAME(vectors,(numset-AM.OffsetVector)));
2201  error = 1;
2202  set->dimension = MAXPOSITIVE;
2203  }
2204  break;
2205  case CFUNCTION:
2206  if ( functions[numset-FUNCTION].dimension != set->dimension ) {
2207  MesPrint("&Dimension check failed in set %s, function %s",
2208  VARNAME(Sets,(set-Sets)),
2209  VARNAME(functions,(numset-FUNCTION)));
2210  error = 1;
2211  }
2212  break;
2213  set->dimension = MAXPOSITIVE;
2214  }
2215  }
2216  if ( sgn ) {
2217  if ( type != CVECTOR ) {
2218  MesPrint("&Illegal use of - sign in set. Can use only with vector or number");
2219  error = 1;
2220  }
2221 /*
2222  numset = AM.OffsetVector - numset;
2223  numset |= SPECMASK;
2224  numset = AM.OffsetVector - numset;
2225 */
2226  numset -= WILDMASK;
2227  }
2228  *s = c;
2229  if ( name == 0 && *s == '?' ) {
2230  s++;
2231  switch ( set->type ) {
2232  case CSYMBOL:
2233  numset = -numset; break;
2234  case CVECTOR:
2235  numset += WILDOFFSET; break;
2236  case CINDEX:
2237  numset |= WILDMASK; break;
2238  case CFUNCTION:
2239  numset |= WILDMASK; break;
2240  }
2241  AC.wildflag = 1;
2242  }
2243 /*
2244  Now add the element to the set.
2245 */
2246  e = (WORD *)FromVarList(&AC.SetElementList);
2247  *e = numset;
2248  (set->last)++;
2249  }
2250  else if ( FG.cTable[*s] == 1 ) {
2251  ParseNumber(x,s)
2252  if ( sgn ) x = -x;
2253  if ( x >= MAXPOWER || x <= -MAXPOWER ||
2254  ( set->type == CINDEX && ( x < 0 || x >= AM.OffsetIndex ) ) ) {
2255  MesPrint("&Illegal value for set element: %d",x);
2256  if ( AC.firstconstindex ) {
2257  MesPrint("&0 <= Fixed indices < ConstIndex(which is %d)",
2258  AM.OffsetIndex-1);
2259  MesPrint("&For setting ConstIndex, read the chapter on the setup file");
2260  AC.firstconstindex = 0;
2261  }
2262  error = 1;
2263  x = 0;
2264  }
2265 /*
2266  Check what is allowed with the type.
2267 */
2268  if ( set->type == -1 ) {
2269  if ( x < 0 || x >= AM.OffsetIndex ) {
2270  for ( i = set->first; i < set->last; i++ ) {
2271  SetElements[i] += 2*MAXPOWER;
2272  }
2273  set->type = CSYMBOL;
2274  }
2275  else set->type = CNUMBER;
2276  }
2277  else if ( set->type == CDUBIOUS ) {}
2278  else if ( set->type == CNUMBER && x < 0 ) {
2279  for ( i = set->first; i < set->last; i++ ) {
2280  SetElements[i] += 2*MAXPOWER;
2281  }
2282  set->type = CSYMBOL;
2283  }
2284  else if ( set->type != CSYMBOL && ( x < 0 ||
2285  ( set->type != CINDEX && set->type != CNUMBER ) ) ) {
2286  MesPrint("&Illegal mixture of element types in set");
2287  error = 1;
2288  set->type = CDUBIOUS;
2289  }
2290 /*
2291  Allocate an element
2292 */
2293  e = (WORD *)FromVarList(&AC.SetElementList);
2294  (set->last)++;
2295  if ( set->type == CSYMBOL ) *e = x + 2*MAXPOWER;
2296 /* else if ( set->type == CINDEX ) *e = x; */
2297  else *e = x;
2298  }
2299  else {
2300  MesPrint("&Illegal object in list of set elements");
2301  return(1);
2302  }
2303  }
2304  if ( error == 0 && ( ( set->flags & ORDEREDSET ) == ORDEREDSET ) ) {
2305 /*
2306  The set->last-set->first list of numbers must be sorted.
2307  Because we plan here potentially thousands of elements we use
2308  a simple version of splitmerge. In ordered sets we can search
2309  later with a binary search.
2310 */
2311  SimpleSplitMerge(SetElements+set->first,set->last-set->first);
2312  }
2313  return(error);
2314 }
2315 
2316 /*
2317  #] DoElements :
2318  #[ CoSet :
2319 
2320  Set declarations.
2321 */
2322 
2323 int CoSet(UBYTE *s)
2324 {
2325  int type, error = 0, ordered = 0;
2326  UBYTE *name, c, *ss;
2327  SETS set;
2328  WORD numberofset, dim = MAXPOSITIVE;
2329  name = s;
2330  if ( ( s = SkipAName(s) ) == 0 ) {
2331 IllForm:MesPrint("&Illegal name for set");
2332  return(1);
2333  }
2334  c = *s; *s = 0;
2335  if ( TestName(name) ) goto IllForm;
2336  if ( ( ( type = GetName(AC.exprnames,name,&numberofset,NOAUTO) ) != NAMENOTFOUND )
2337  || ( ( type = GetName(AC.varnames,name,&numberofset,NOAUTO) ) != NAMENOTFOUND ) ) {
2338  if ( type != CSET ) NameConflict(type,name);
2339  else {
2340  MesPrint("&There is already a set with the name %s",name);
2341  }
2342  return(1);
2343  }
2344  if ( c == 0 ) {
2345  numberofset = AddSet(name,0);
2346  set = Sets + numberofset;
2347  return(0); /* empty set */
2348  }
2349  *s = c; ss = s; /* ss marks the end of the name */
2350  if ( *s == '(' ) {
2351  UBYTE *sss, cc;
2352  s++; sss = s; /* Beginning of option */
2353  while ( *s != ',' && *s != ')' && *s ) s++;
2354  cc = *s; *s = 0;
2355  if ( StrICont(sss,(UBYTE *)"ordered") == 0 ) {
2356  ordered = ORDEREDSET;
2357  }
2358  else {
2359  MesPrint("&Error: Illegal option in set definition: %s",sss);
2360  error = 1;
2361  }
2362  *s = cc;
2363  if ( *s != ')' ) {
2364  MesPrint("&Error: Currently only one option allowed in set definition.");
2365  error = 1;
2366  while ( *s && *s != ')' ) s++;
2367  }
2368  s++;
2369  }
2370  if ( *s == '{' ) {
2371  s++;
2372  if ( ( *s == 'd' || *s == 'D' ) && s[1] == '=' ) {
2373  s += 2;
2374  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
2375  ParseSignedNumber(dim,s)
2376  if ( dim < -HALFMAX || dim > HALFMAX ) {
2377  MesPrint("&Warning: dimension of %s (%d) out of range"
2378  ,name,dim);
2379  }
2380  }
2381  if ( *s != '}' ) goto IllDim;
2382  else s++;
2383  }
2384  else {
2385 IllDim: MesPrint("&Error: Illegal dimension field for set %s",name);
2386  error = 1;
2387  s = SkipField(s,0);
2388  }
2389  while ( *s == ',' ) s++;
2390  }
2391  c = *ss; *ss = 0;
2392  numberofset = AddSet(name,dim);
2393  *ss = c;
2394  set = Sets + numberofset;
2395  set->flags |= ordered;
2396  if ( *s != ':' ) {
2397  MesPrint("&Proper syntax is `Set name:elements'");
2398  return(1);
2399  }
2400  s++;
2401  error = DoElements(s,set,name);
2402  AC.SetList.numtemp = AC.SetList.num;
2403  AC.SetElementList.numtemp = AC.SetElementList.num;
2404  return(error);
2405 }
2406 
2407 /*
2408  #] CoSet :
2409  #[ DoTempSet :
2410 
2411  Gets a {} set definition and returns a set number if the set is
2412  properly structured. This number refers either to an already
2413  existing set, or to a set that is defined here.
2414  From and to refer to the contents. They exclude the {}.
2415 */
2416 
2417 int DoTempSet(UBYTE *from, UBYTE *to)
2418 {
2419  int i, num, j, sgn;
2420  WORD *e, *ep;
2421  UBYTE c;
2422  int setnum = AddSet(0,MAXPOSITIVE);
2423  SETS set = Sets + setnum, setp;
2424  set->name = -1;
2425  set->type = -1;
2426  c = *to; *to = 0;
2427  AC.wildflag = 0;
2428  while ( *from == ',' ) from++;
2429  if ( *from == '<' || *from == '>' ) {
2430  set->type = CRANGE;
2431  set->first = 3*MAXPOWER;
2432  set->last = -3*MAXPOWER;
2433  while ( *from == '<' || *from == '>' ) {
2434  if ( *from == '<' ) {
2435  j = 1; from++;
2436  if ( *from == '=' ) { from++; j++; }
2437  }
2438  else {
2439  j = -1; from++;
2440  if ( *from == '=' ) { from++; j--; }
2441  }
2442  sgn = 1;
2443  while ( *from == '-' || *from == '+' ) {
2444  if ( *from == '-' ) sgn = -sgn;
2445  from++;
2446  }
2447  ParseNumber(num,from)
2448  if ( *from && *from != ',' ) {
2449  MesPrint("&Illegal number in ranged set definition");
2450  return(-1);
2451  }
2452  if ( sgn < 0 ) num = -num;
2453  if ( num >= MAXPOWER || num <= -MAXPOWER ) {
2454  Warning("Value in ranged set too big. Adjusted to infinity.");
2455  if ( num > 0 ) num = 3*MAXPOWER;
2456  else num = -3*MAXPOWER;
2457  }
2458  else if ( j == 2 ) num += 2*MAXPOWER;
2459  else if ( j == -2 ) num -= 2*MAXPOWER;
2460  if ( j > 0 ) set->first = num;
2461  else set->last = num;
2462  while ( *from == ',' ) from++;
2463  }
2464  if ( *from ) {
2465  MesPrint("&Definition of ranged set contains illegal objects");
2466  return(-1);
2467  }
2468  }
2469  else if ( DoElements(from,set,(UBYTE *)0) != 0 ) {
2470  AC.SetElementList.num = set->first;
2471  AC.SetList.num--; *to = c;
2472  return(-1);
2473  }
2474  *to = c;
2475 /*
2476  Now we have to test whether this set exists already.
2477 */
2478  num = set->last - set->first;
2479  for ( setp = Sets, i = 0; i < AC.SetList.num-1; i++, setp++ ) {
2480  if ( num != setp->last - setp->first ) continue;
2481  if ( set->type != setp->type ) continue;
2482  if ( set->type == CRANGE ) {
2483  if ( set->first == setp->first ) return(setp-Sets);
2484  }
2485  else {
2486  e = SetElements + set->first;
2487  ep = SetElements + setp->first;
2488  j = num;
2489  while ( --j >= 0 ) if ( *e++ != *ep++ ) break;
2490  if ( j < 0 ) {
2491  AC.SetElementList.num = set->first;
2492  AC.SetList.num--;
2493  return(setp - Sets);
2494  }
2495  }
2496  }
2497  return(setnum);
2498 }
2499 
2500 /*
2501  #] DoTempSet :
2502  #[ CoAuto :
2503 
2504  To prepare first:
2505  Use of the proper pointers in the various declaration routines
2506  Proper action in .store and .clear
2507 */
2508 
2509 int CoAuto(UBYTE *inp)
2510 {
2511  int retval;
2512 
2513  AC.Symbols = &(AC.AutoSymbolList);
2514  AC.Vectors = &(AC.AutoVectorList);
2515  AC.Indices = &(AC.AutoIndexList);
2516  AC.Functions = &(AC.AutoFunctionList);
2517  AC.activenames = &(AC.autonames);
2518  AC.AutoDeclareFlag = WITHAUTO;
2519 
2520  while ( *inp == ',' ) inp++;
2521  retval = CompileStatement(inp);
2522 
2523  AC.AutoDeclareFlag = 0;
2524  AC.Symbols = &(AC.SymbolList);
2525  AC.Vectors = &(AC.VectorList);
2526  AC.Indices = &(AC.IndexList);
2527  AC.Functions = &(AC.FunctionList);
2528  AC.activenames = &(AC.varnames);
2529  return(retval);
2530 }
2531 
2532 /*
2533  #] CoAuto :
2534  #[ AddDollar :
2535 
2536  The actual addition. Special routine for additions 'on the fly'
2537 */
2538 
2539 int AddDollar(UBYTE *name, WORD type, WORD *start, LONG size)
2540 {
2541  int nodenum, numdollar = AP.DollarList.num;
2542  WORD *s, *t;
2543  DOLLARS dol = (DOLLARS)FromVarList(&AP.DollarList);
2544  dol->name = AddName(AC.dollarnames,name,CDOLLAR,numdollar,&nodenum);
2545  dol->type = type;
2546  dol->node = nodenum;
2547  dol->zero = 0;
2548  dol->numdummies = 0;
2549 #ifdef WITHPTHREADS
2550  dol->pthreadslockread = dummylock;
2551  dol->pthreadslockwrite = dummylock;
2552 #endif
2553  dol->nfactors = 0;
2554  dol->factors = 0;
2555  AddRHS(AM.dbufnum,1);
2556  AddLHS(AM.dbufnum);
2557  if ( start && size > 0 ) {
2558  dol->size = size;
2559  dol->where =
2560  s = (WORD *)Malloc1((size+1)*sizeof(WORD),"$-variable contents");
2561  t = start;
2562  while ( --size >= 0 ) *s++ = *t++;
2563  *s = 0;
2564  }
2565  else { dol->where = &(AM.dollarzero); dol->size = 0; }
2566  cbuf[AM.dbufnum].rhs[numdollar] = dol->where;
2567  cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
2568  cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
2569 
2570  return(numdollar);
2571 }
2572 
2573 /*
2574  #] AddDollar :
2575  #[ ReplaceDollar :
2576 
2577  Replacements of dollar variables can happen at any time.
2578  For debugging purposes we should have a tracing facility.
2579 
2580  Not in use????
2581 */
2582 
2583 int ReplaceDollar(WORD number, WORD newtype, WORD *newstart, LONG newsize)
2584 {
2585  int error = 0;
2586  DOLLARS dol = Dollars + number;
2587  WORD *s, *t;
2588  LONG i;
2589  dol->type = newtype;
2590  if ( dol->size == newsize && newsize > 0 && newstart ) {
2591  s = dol->where; t = newstart; i = newsize;
2592  while ( --i >= 0 ) { if ( *s++ != *t++ ) break; }
2593  if ( i < 0 ) return(0);
2594  }
2595  if ( dol->where && dol->where != &(dol->zero) ) {
2596  M_free(dol->where,"dollar->where"); dol->where = &(dol->zero); dol->size = 0;
2597  }
2598  if ( newstart && newsize > 0 ) {
2599  dol->size = newsize;
2600  dol->where =
2601  s = (WORD *)Malloc1((newsize+1)*sizeof(WORD),"$-variable contents");
2602  t = newstart; i = newsize;
2603  while ( --i >= 0 ) *s++ = *t++;
2604  *s = 0;
2605  }
2606  return(error);
2607 }
2608 
2609 /*
2610  #] ReplaceDollar :
2611  #[ AddDubious :
2612 
2613  This adds a variable of which we do not know the proper type.
2614 */
2615 
2616 int AddDubious(UBYTE *name)
2617 {
2618  int nodenum, numdubious = AC.DubiousList.num;
2619  DUBIOUSV dub = (DUBIOUSV)FromVarList(&AC.DubiousList);
2620  dub->name = AddName(AC.varnames,name,CDUBIOUS,numdubious,&nodenum);
2621  dub->node = nodenum;
2622  return(numdubious);
2623 }
2624 
2625 /*
2626  #] AddDubious :
2627  #[ MakeDubious :
2628 */
2629 
2630 int MakeDubious(NAMETREE *nametree, UBYTE *name, WORD *number)
2631 {
2632  NAMENODE *n;
2633  int node, newnode, i;
2634  if ( nametree->namenode == 0 ) return(-1);
2635  newnode = nametree->headnode;
2636  do {
2637  node = newnode;
2638  n = nametree->namenode+node;
2639  if ( ( i = StrCmp(name,nametree->namebuffer+n->name) ) < 0 )
2640  newnode = n->left;
2641  else if ( i > 0 ) newnode = n->right;
2642  else {
2643  if ( n->type != CDUBIOUS ) {
2644  int numdubious = AC.DubiousList.num;
2645  FUNCTIONS dub = (FUNCTIONS)FromVarList(&AC.DubiousList);
2646  dub->name = n->name;
2647  n->number = numdubious;
2648  }
2649  *number = n->number;
2650  return(CDUBIOUS);
2651  }
2652  } while ( newnode >= 0 );
2653  return(-1);
2654 }
2655 
2656 /*
2657  #] MakeDubious :
2658  #[ NameConflict :
2659 */
2660 
2661 static char *nametype[] = { "symbol", "index", "vector", "function",
2662  "set", "expression" };
2663 static char *plural[] = { "","n","","","","n" };
2664 
2665 int NameConflict(int type, UBYTE *name)
2666 {
2667  if ( type == NAMENOTFOUND ) {
2668  MesPrint("&%s has not been declared",name);
2669  }
2670  else if ( type != CDUBIOUS )
2671  MesPrint("&%s has been declared as a%s %s already"
2672  ,name,plural[type],nametype[type]);
2673  return(1);
2674 }
2675 
2676 /*
2677  #] NameConflict :
2678  #[ AddExpression :
2679 */
2680 
2681 int AddExpression(UBYTE *name, int x, int y)
2682 {
2683  int nodenum, numexpr = AC.ExpressionList.num;
2684  EXPRESSIONS expr = (EXPRESSIONS)FromVarList(&AC.ExpressionList);
2685  UBYTE *s;
2686  expr->status = x;
2687  expr->printflag = y;
2688  PUTZERO(expr->onfile);
2689  PUTZERO(expr->size);
2690  expr->renum = 0;
2691  expr->renumlists = 0;
2692  expr->hidelevel = 0;
2693  expr->inmem = 0;
2694  expr->bracketinfo = expr->newbracketinfo = 0;
2695  if ( name ) {
2696  expr->name = AddName(AC.exprnames,name,CEXPRESSION,numexpr,&nodenum);
2697  expr->node = nodenum;
2698  expr->replace = NEWLYDEFINEDEXPRESSION ;
2699  s = name;
2700  while ( *s ) s++;
2701  expr->namesize = (s-name)+1;
2702  }
2703  else {
2704  expr->replace = REDEFINEDEXPRESSION;
2705  expr->name = AC.TransEname;
2706  expr->node = -1;
2707  expr->namesize = 0;
2708  }
2709  expr->vflags = 0;
2710  expr->numdummies = 0;
2711  expr->numfactors = 0;
2712 #ifdef PARALLELCODE
2713  expr->partodo = 0;
2714 #endif
2715  return(numexpr);
2716 }
2717 
2718 /*
2719  #] AddExpression :
2720  #[ GetLabel :
2721 */
2722 
2723 int GetLabel(UBYTE *name)
2724 {
2725  int i;
2726  LONG newnum;
2727  UBYTE **NewLabelNames;
2728  int *NewLabel;
2729  for ( i = 0; i < AC.NumLabels; i++ ) {
2730  if ( StrCmp(name,AC.LabelNames[i]) == 0 ) return(i);
2731  }
2732  if ( AC.NumLabels >= AC.MaxLabels ) {
2733  newnum = 2*AC.MaxLabels;
2734  if ( newnum == 0 ) newnum = 10;
2735  if ( newnum > 32765 ) newnum = 32765;
2736  if ( newnum == AC.MaxLabels ) {
2737  MesPrint("&More than 32765 labels in one module. Please simplify.");
2738  Terminate(-1);
2739  }
2740  NewLabelNames = (UBYTE **)Malloc1((sizeof(UBYTE *)+sizeof(int))
2741  *newnum,"Labels");
2742  NewLabel = (int *)(NewLabelNames+newnum);
2743  for ( i = 0; i< AC.MaxLabels; i++ ) {
2744  NewLabelNames[i] = AC.LabelNames[i];
2745  NewLabel[i] = AC.Labels[i];
2746  }
2747  if ( AC.LabelNames ) M_free(AC.LabelNames,"Labels");
2748  AC.LabelNames = NewLabelNames;
2749  AC.Labels = NewLabel;
2750  AC.MaxLabels = newnum;
2751  }
2752  i = AC.NumLabels++;
2753  AC.LabelNames[i] = strDup1(name,"Labels");
2754  AC.Labels[i] = -1;
2755  return(i);
2756 }
2757 
2758 /*
2759  #] GetLabel :
2760  #[ ResetVariables :
2761 
2762  Resets the variables.
2763  par = 0 The list of temporary sets (after each .sort)
2764  par = 1 The list of local variables (after each .store)
2765  par = 2 All variables (after each .clear)
2766 */
2767 
2768 void ResetVariables(int par)
2769 {
2770  int i, j;
2771  TABLES T;
2772  switch ( par ) {
2773  case 0 : /* Only the sets without a name */
2774  AC.SetList.num = AC.SetList.numtemp;
2775  AC.SetElementList.num = AC.SetElementList.numtemp;
2776  break;
2777  case 2 :
2778  for ( i = AC.SymbolList.numclear; i < AC.SymbolList.num; i++ )
2779  AC.varnames->namenode[symbols[i].node].type = CDELETE;
2780  AC.SymbolList.num = AC.SymbolList.numglobal = AC.SymbolList.numclear;
2781  for ( i = AC.VectorList.numclear; i < AC.VectorList.num; i++ )
2782  AC.varnames->namenode[vectors[i].node].type = CDELETE;
2783  AC.VectorList.num = AC.VectorList.numglobal = AC.VectorList.numclear;
2784  for ( i = AC.IndexList.numclear; i < AC.IndexList.num; i++ )
2785  AC.varnames->namenode[indices[i].node].type = CDELETE;
2786  AC.IndexList.num = AC.IndexList.numglobal = AC.IndexList.numclear;
2787  for ( i = AC.FunctionList.numclear; i < AC.FunctionList.num; i++ ) {
2788  AC.varnames->namenode[functions[i].node].type = CDELETE;
2789  if ( ( T = functions[i].tabl ) != 0 ) {
2790  if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
2791  if ( T->prototype ) M_free(T->prototype,"tableprototype");
2792  if ( T->mm ) M_free(T->mm,"tableminmax");
2793  if ( T->flags ) M_free(T->flags,"tableflags");
2794  if ( T->argtail ) M_free(T->argtail,"table arguments");
2795  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
2796  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
2797  finishcbuf(T->buffers[j]);
2798  }
2799  /*[07apr2004 mt]:*/ /*memory leak*/
2800  if ( T->buffers ) M_free(T->buffers,"Table buffers");
2801  /*:[07apr2004 mt]*/
2802  finishcbuf(T->bufnum);
2803  if ( T->spare ) {
2804  TABLES TT = T->spare;
2805  if ( TT->mm ) M_free(TT->mm,"tableminmax");
2806  if ( TT->flags ) M_free(TT->flags,"tableflags");
2807  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2808  for (j = 0; j < TT->buffersfill; j++ ) { /* was <= */
2809  finishcbuf(TT->buffers[j]);
2810  }
2811  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
2812  /*[07apr2004 mt]:*/ /*memory leak*/
2813  if ( TT->buffers )M_free(TT->buffers,"Table buffers");
2814  /*:[07apr2004 mt]*/
2815  M_free(TT,"table");
2816  }
2817  M_free(T,"table");
2818  }
2819  }
2820  AC.FunctionList.num = AC.FunctionList.numglobal = AC.FunctionList.numclear;
2821  for ( i = AC.SetList.numclear; i < AC.SetList.num; i++ ) {
2822  if ( Sets[i].node >= 0 )
2823  AC.varnames->namenode[Sets[i].node].type = CDELETE;
2824  }
2825  AC.SetList.numtemp = AC.SetList.num = AC.SetList.numglobal = AC.SetList.numclear;
2826  for ( i = AC.DubiousList.numclear; i < AC.DubiousList.num; i++ )
2827  AC.varnames->namenode[Dubious[i].node].type = CDELETE;
2828  AC.DubiousList.num = AC.DubiousList.numglobal = AC.DubiousList.numclear;
2829  AC.SetElementList.numtemp = AC.SetElementList.num =
2830  AC.SetElementList.numglobal = AC.SetElementList.numclear;
2831  CompactifyTree(AC.varnames,VARNAMES);
2832  AC.varnames->namefill = AC.varnames->globalnamefill = AC.varnames->clearnamefill;
2833  AC.varnames->nodefill = AC.varnames->globalnodefill = AC.varnames->clearnodefill;
2834 
2835  for ( i = AC.AutoSymbolList.numclear; i < AC.AutoSymbolList.num; i++ )
2836  AC.autonames->namenode[
2837  ((SYMBOLS)(AC.AutoSymbolList.lijst))[i].node].type = CDELETE;
2838  AC.AutoSymbolList.num = AC.AutoSymbolList.numglobal
2839  = AC.AutoSymbolList.numclear;
2840  for ( i = AC.AutoVectorList.numclear; i < AC.AutoVectorList.num; i++ )
2841  AC.autonames->namenode[
2842  ((VECTORS)(AC.AutoVectorList.lijst))[i].node].type = CDELETE;
2843  AC.AutoVectorList.num = AC.AutoVectorList.numglobal
2844  = AC.AutoVectorList.numclear;
2845  for ( i = AC.AutoIndexList.numclear; i < AC.AutoIndexList.num; i++ )
2846  AC.autonames->namenode[
2847  ((INDICES)(AC.AutoIndexList.lijst))[i].node].type = CDELETE;
2848  AC.AutoIndexList.num = AC.AutoIndexList.numglobal
2849  = AC.AutoIndexList.numclear;
2850  for ( i = AC.AutoFunctionList.numclear; i < AC.AutoFunctionList.num; i++ ) {
2851  AC.autonames->namenode[
2852  ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].node].type = CDELETE;
2853  if ( ( T = ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl ) != 0 ) {
2854  if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
2855  if ( T->prototype ) M_free(T->prototype,"tableprototype");
2856  if ( T->mm ) M_free(T->mm,"tableminmax");
2857  if ( T->flags ) M_free(T->flags,"tableflags");
2858  if ( T->argtail ) M_free(T->argtail,"table arguments");
2859  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
2860  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
2861  finishcbuf(T->buffers[j]);
2862  }
2863  if ( T->spare ) {
2864  TABLES TT = T->spare;
2865  if ( TT->mm ) M_free(TT->mm,"tableminmax");
2866  if ( TT->flags ) M_free(TT->flags,"tableflags");
2867  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2868  for (j = 0; j < TT->buffersfill; j++ ) { /* was <= */
2869  finishcbuf(TT->buffers[j]);
2870  }
2871  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
2872  M_free(TT,"table");
2873  }
2874  M_free(T,"table");
2875  }
2876  }
2877  AC.AutoFunctionList.num = AC.AutoFunctionList.numglobal
2878  = AC.AutoFunctionList.numclear;
2879  CompactifyTree(AC.autonames,AUTONAMES);
2880  AC.autonames->namefill = AC.autonames->globalnamefill
2881  = AC.autonames->clearnamefill;
2882  AC.autonames->nodefill = AC.autonames->globalnodefill
2883  = AC.autonames->clearnodefill;
2884  ReleaseTB();
2885  break;
2886  case 1 :
2887  for ( i = AC.SymbolList.numglobal; i < AC.SymbolList.num; i++ )
2888  AC.varnames->namenode[symbols[i].node].type = CDELETE;
2889  AC.SymbolList.num = AC.SymbolList.numglobal;
2890  for ( i = AC.VectorList.numglobal; i < AC.VectorList.num; i++ )
2891  AC.varnames->namenode[vectors[i].node].type = CDELETE;
2892  AC.VectorList.num = AC.VectorList.numglobal;
2893  for ( i = AC.IndexList.numglobal; i < AC.IndexList.num; i++ )
2894  AC.varnames->namenode[indices[i].node].type = CDELETE;
2895  AC.IndexList.num = AC.IndexList.numglobal;
2896  for ( i = AC.FunctionList.numglobal; i < AC.FunctionList.num; i++ ) {
2897  AC.varnames->namenode[functions[i].node].type = CDELETE;
2898  if ( ( T = functions[i].tabl ) != 0 ) {
2899  if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
2900  if ( T->prototype ) M_free(T->prototype,"tableprototype");
2901  if ( T->mm ) M_free(T->mm,"tableminmax");
2902  if ( T->flags ) M_free(T->flags,"tableflags");
2903  if ( T->argtail ) M_free(T->argtail,"table arguments");
2904  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
2905  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
2906  finishcbuf(T->buffers[j]);
2907  }
2908  /*[07apr2004 mt]:*/ /*memory leak*/
2909  if ( T->buffers ) M_free(T->buffers,"Table buffers");
2910  /*:[07apr2004 mt]*/
2911  finishcbuf(T->bufnum);
2912  if ( T->spare ) {
2913  TABLES TT = T->spare;
2914  if ( TT->mm ) M_free(TT->mm,"tableminmax");
2915  if ( TT->flags ) M_free(TT->flags,"tableflags");
2916  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2917  for (j = 0; j < TT->buffersfill; j++ ) { /* was <= */
2918  finishcbuf(TT->buffers[j]);
2919  }
2920  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
2921  /*[07apr2004 mt]:*/ /*memory leak*/
2922  if ( TT->buffers ) M_free(TT->buffers,"Table buffers");
2923  /*:[07apr2004 mt]*/
2924  M_free(TT,"table");
2925  }
2926  M_free(T,"table");
2927  }
2928  }
2929 #ifdef TABLECLEANUP
2930  {
2931  int j;
2932  WORD *tp;
2933  for ( i = 0; i < AC.FunctionList.numglobal; i++ ) {
2934 /*
2935  Now, if the table definition is from after the .global
2936  while the function is from before, there is a problem.
2937  This could be resolved by defining CTable (=Table), Ntable
2938  and do away with the previous function definition.
2939 */
2940  if ( ( T = functions[i].tabl ) != 0 ) {
2941 /*
2942  First restore overwritten definitions.
2943 */
2944  if ( T->sparse ) {
2945  T->totind = T->mdefined;
2946  for ( j = 0, tp = T->tablepointers; j < T->totind; j++ ) {
2947  tp += T->numind;
2948 #if TABLEEXTENSION == 2
2949  tp[0] = tp[1];
2950 #else
2951  tp[0] = tp[2];
2952  tp[1] = tp[3];
2953  tp[4] = tp[5];
2954 #endif
2955  tp += TABLEEXTENSION;
2956  }
2957  RedoTableTree(T,T->totind);
2958  if ( T->spare ) {
2959  TABLES TT = T->spare;
2960  TT->totind = TT->mdefined;
2961  for ( j = 0, tp = TT->tablepointers; j < TT->totind; j++ ) {
2962  tp += TT->numind;
2963 #if TABLEEXTENSION == 2
2964  tp[0] = tp[1];
2965 #else
2966  tp[0] = tp[2];
2967  tp[1] = tp[3];
2968  tp[4] = tp[5];
2969 #endif
2970  tp += TABLEEXTENSION;
2971  }
2972  RedoTableTree(TT,TT->totind);
2973  cbuf[TT->bufnum].numlhs = cbuf[TT->bufnum].mnumlhs;
2974  cbuf[TT->bufnum].numrhs = cbuf[TT->bufnum].mnumrhs;
2975  }
2976  }
2977  else {
2978  for ( j = 0, tp = T->tablepointers; j < T->totind; j++ ) {
2979 #if TABLEEXTENSION == 2
2980  tp[0] = tp[1];
2981 #else
2982  tp[0] = tp[2];
2983  tp[1] = tp[3];
2984  tp[4] = tp[5];
2985 #endif
2986  }
2987  T->defined = T->mdefined;
2988  }
2989  cbuf[T->bufnum].numlhs = cbuf[T->bufnum].mnumlhs;
2990  cbuf[T->bufnum].numrhs = cbuf[T->bufnum].mnumrhs;
2991  }
2992  }
2993  }
2994 #endif
2995  AC.FunctionList.num = AC.FunctionList.numglobal;
2996  for ( i = AC.SetList.numglobal; i < AC.SetList.num; i++ ) {
2997  if ( Sets[i].node >= 0 )
2998  AC.varnames->namenode[Sets[i].node].type = CDELETE;
2999  }
3000  AC.SetList.numtemp = AC.SetList.num = AC.SetList.numglobal;
3001  for ( i = AC.DubiousList.numglobal; i < AC.DubiousList.num; i++ )
3002  AC.varnames->namenode[Dubious[i].node].type = CDELETE;
3003  AC.DubiousList.num = AC.DubiousList.numglobal;
3004  AC.SetElementList.numtemp = AC.SetElementList.num =
3005  AC.SetElementList.numglobal;
3006  CompactifyTree(AC.varnames,VARNAMES);
3007  AC.varnames->namefill = AC.varnames->globalnamefill;
3008  AC.varnames->nodefill = AC.varnames->globalnodefill;
3009 
3010  for ( i = AC.AutoSymbolList.numglobal; i < AC.AutoSymbolList.num; i++ )
3011  AC.autonames->namenode[
3012  ((SYMBOLS)(AC.AutoSymbolList.lijst))[i].node].type = CDELETE;
3013  AC.AutoSymbolList.num = AC.AutoSymbolList.numglobal;
3014  for ( i = AC.AutoVectorList.numglobal; i < AC.AutoVectorList.num; i++ )
3015  AC.autonames->namenode[
3016  ((VECTORS)(AC.AutoVectorList.lijst))[i].node].type = CDELETE;
3017  AC.AutoVectorList.num = AC.AutoVectorList.numglobal;
3018  for ( i = AC.AutoIndexList.numglobal; i < AC.AutoIndexList.num; i++ )
3019  AC.autonames->namenode[
3020  ((INDICES)(AC.AutoIndexList.lijst))[i].node].type = CDELETE;
3021  AC.AutoIndexList.num = AC.AutoIndexList.numglobal;
3022  for ( i = AC.AutoFunctionList.numglobal; i < AC.AutoFunctionList.num; i++ ) {
3023  AC.autonames->namenode[
3024  ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].node].type = CDELETE;
3025  if ( ( T = ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl ) != 0 ) {
3026  if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
3027  if ( T->prototype ) M_free(T->prototype,"tableprototype");
3028  if ( T->mm ) M_free(T->mm,"tableminmax");
3029  if ( T->flags ) M_free(T->flags,"tableflags");
3030  if ( T->argtail ) M_free(T->argtail,"table arguments");
3031  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
3032  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
3033  finishcbuf(T->buffers[j]);
3034  }
3035  if ( T->spare ) {
3036  TABLES TT = T->spare;
3037  if ( TT->mm ) M_free(TT->mm,"tableminmax");
3038  if ( TT->flags ) M_free(TT->flags,"tableflags");
3039  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
3040  for (j = 0; j < TT->buffersfill; j++ ) { /* was <= */
3041  finishcbuf(TT->buffers[j]);
3042  }
3043  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
3044  M_free(TT,"table");
3045  }
3046  M_free(T,"table");
3047  }
3048  }
3049  AC.AutoFunctionList.num = AC.AutoFunctionList.numglobal;
3050 
3051  CompactifyTree(AC.autonames,AUTONAMES);
3052 
3053  AC.autonames->namefill = AC.autonames->globalnamefill;
3054  AC.autonames->nodefill = AC.autonames->globalnodefill;
3055  break;
3056  }
3057 }
3058 
3059 /*
3060  #] ResetVariables :
3061  #[ RemoveDollars :
3062 */
3063 
3064 void RemoveDollars()
3065 {
3066  DOLLARS d;
3067  CBUF *C = cbuf + AM.dbufnum;
3068  int numdollar = AP.DollarList.num;
3069  if ( numdollar > 0 ) {
3070  while ( numdollar > AM.gcNumDollars ) {
3071  numdollar--;
3072  d = Dollars + numdollar;
3073  if ( d->where && d->where != &(d->zero) && d->where != &(AM.dollarzero) ) {
3074  M_free(d->where,"dollar->where"); d->where = &(d->zero); d->size = 0;
3075  }
3076  AC.dollarnames->namenode[d->node].type = CDELETE;
3077  }
3078  AP.DollarList.num = AM.gcNumDollars;
3079  CompactifyTree(AC.dollarnames,DOLLARNAMES);
3080 
3081  C->numrhs = C->mnumrhs;
3082  C->numlhs = C->mnumlhs;
3083  }
3084 }
3085 
3086 /*
3087  #] RemoveDollars :
3088  #[ Globalize :
3089 */
3090 
3091 void Globalize(int par)
3092 {
3093  int i, j;
3094  WORD *tp;
3095  if ( par == 1 ) {
3096  AC.SymbolList.numclear = AC.SymbolList.num;
3097  AC.VectorList.numclear = AC.VectorList.num;
3098  AC.IndexList.numclear = AC.IndexList.num;
3099  AC.FunctionList.numclear = AC.FunctionList.num;
3100  AC.SetList.numclear = AC.SetList.num;
3101  AC.DubiousList.numclear = AC.DubiousList.num;
3102  AC.SetElementList.numclear = AC.SetElementList.num;
3103  AC.varnames->clearnamefill = AC.varnames->namefill;
3104  AC.varnames->clearnodefill = AC.varnames->nodefill;
3105 
3106  AC.AutoSymbolList.numclear = AC.AutoSymbolList.num;
3107  AC.AutoVectorList.numclear = AC.AutoVectorList.num;
3108  AC.AutoIndexList.numclear = AC.AutoIndexList.num;
3109  AC.AutoFunctionList.numclear = AC.AutoFunctionList.num;
3110  AC.autonames->clearnamefill = AC.autonames->namefill;
3111  AC.autonames->clearnodefill = AC.autonames->nodefill;
3112  }
3113 /* for ( i = AC.FunctionList.numglobal; i < AC.FunctionList.num; i++ ) { */
3114  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
3115 /*
3116  We need here not only the not-yet-global functions. The already
3117  global ones may have obtained extra elements.
3118 */
3119  if ( functions[i].tabl ) {
3120  TABLES T = functions[i].tabl;
3121  if ( T->sparse ) {
3122  T->mdefined = T->totind;
3123  for ( j = 0, tp = T->tablepointers; j < T->totind; j++ ) {
3124  tp += T->numind;
3125 #if TABLEEXTENSION == 2
3126  tp[1] = tp[0];
3127 #else
3128  tp[2] = tp[0]; tp[3] = tp[1]; tp[5] = tp[4] & (~ELEMENTUSED);
3129 #endif
3130  tp += TABLEEXTENSION;
3131  }
3132  if ( T->spare ) {
3133  TABLES TT = T->spare;
3134  TT->mdefined = TT->totind;
3135  for ( j = 0, tp = TT->tablepointers; j < TT->totind; j++ ) {
3136  tp += TT->numind;
3137 #if TABLEEXTENSION == 2
3138  tp[1] = tp[0];
3139 #else
3140  tp[2] = tp[0]; tp[3] = tp[1]; tp[5] = tp[4] & (~ELEMENTUSED);
3141 #endif
3142  tp += TABLEEXTENSION;
3143  }
3144  cbuf[TT->bufnum].mnumlhs = cbuf[TT->bufnum].numlhs;
3145  cbuf[TT->bufnum].mnumrhs = cbuf[TT->bufnum].numrhs;
3146  }
3147  }
3148  else {
3149  T->mdefined = T->defined;
3150  for ( j = 0, tp = T->tablepointers; j < T->totind; j++ ) {
3151 #if TABLEEXTENSION == 2
3152  tp[1] = tp[0];
3153 #else
3154  tp[2] = tp[0]; tp[3] = tp[1]; tp[5] = tp[4] & (~ELEMENTUSED);
3155 #endif
3156  }
3157  }
3158  cbuf[T->bufnum].mnumlhs = cbuf[T->bufnum].numlhs;
3159  cbuf[T->bufnum].mnumrhs = cbuf[T->bufnum].numrhs;
3160  }
3161  }
3162  for ( i = AC.AutoFunctionList.numglobal; i < AC.AutoFunctionList.num; i++ ) {
3163  if ( ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl )
3164  ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl->mdefined =
3165  ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl->defined;
3166  }
3167  AC.SymbolList.numglobal = AC.SymbolList.num;
3168  AC.VectorList.numglobal = AC.VectorList.num;
3169  AC.IndexList.numglobal = AC.IndexList.num;
3170  AC.FunctionList.numglobal = AC.FunctionList.num;
3171  AC.SetList.numglobal = AC.SetList.num;
3172  AC.DubiousList.numglobal = AC.DubiousList.num;
3173  AC.SetElementList.numglobal = AC.SetElementList.num;
3174  AC.varnames->globalnamefill = AC.varnames->namefill;
3175  AC.varnames->globalnodefill = AC.varnames->nodefill;
3176 
3177  AC.AutoSymbolList.numglobal = AC.AutoSymbolList.num;
3178  AC.AutoVectorList.numglobal = AC.AutoVectorList.num;
3179  AC.AutoIndexList.numglobal = AC.AutoIndexList.num;
3180  AC.AutoFunctionList.numglobal = AC.AutoFunctionList.num;
3181  AC.autonames->globalnamefill = AC.autonames->namefill;
3182  AC.autonames->globalnodefill = AC.autonames->nodefill;
3183 }
3184 
3185 /*
3186  #] Globalize :
3187  #[ TestName :
3188 */
3189 
3190 int TestName(UBYTE *name)
3191 {
3192  if ( *name == '[' ) {
3193  while ( *name ) name++;
3194  if ( name[-1] == ']' ) return(0);
3195  return(-1);
3196  }
3197  while ( *name ) {
3198  if ( *name == '_' ) return(-1);
3199  name++;
3200  }
3201  return(0);
3202 }
3203 
3204 /*
3205  #] TestName :
3206 */
WORD bufferssize
Definition: structs.h:378
void AddPotModdollar(WORD)
Definition: dollar.c:3954
WORD * buffers
Definition: structs.h:364
void finishcbuf(WORD num)
Definition: comtool.c:89
LONG reserved
Definition: structs.h:366
LONG totind
Definition: structs.h:365
int numtree
Definition: structs.h:374
WORD left
Definition: structs.h:249
LONG clearnamefill
Definition: structs.h:279
Definition: structs.h:443
WORD flags
Definition: structs.h:482
int prototypeSize
Definition: structs.h:369
WORD size
Definition: structs.h:309
LONG namefill
Definition: structs.h:273
WORD type
Definition: structs.h:252
Definition: structs.h:497
NAMENODE * namenode
Definition: structs.h:265
WORD * pattern
Definition: structs.h:356
int sparse
Definition: structs.h:373
struct TaBlEs * spare
Definition: structs.h:363
int strict
Definition: structs.h:372
LONG symminfo
Definition: structs.h:477
WORD number
Definition: structs.h:253
WORD mode
Definition: structs.h:381
int inicbufs(VOID)
Definition: comtool.c:47
LONG nodefill
Definition: structs.h:271
LONG nodesize
Definition: structs.h:270
WORD node
Definition: structs.h:485
int numind
Definition: structs.h:370
LONG globalnodefill
Definition: structs.h:278
WORD mini
Definition: structs.h:307
LONG globalnamefill
Definition: structs.h:276
Definition: structs.h:938
WORD parent
Definition: structs.h:248
Definition: structs.h:293
WORD * Pointer
Definition: structs.h:941
TABLES tabl
Definition: structs.h:476
LONG name
Definition: structs.h:247
WORD symmetric
Definition: structs.h:484
WORD * renumlists
Definition: structs.h:397
WORD maxi
Definition: structs.h:308
WORD * tablepointers
Definition: structs.h:350
UBYTE * argtail
Definition: structs.h:361
WORD balance
Definition: structs.h:251
WORD ** rhs
Definition: structs.h:943
WORD SortWild(WORD *, WORD)
Definition: sort.c:4551
int MaxTreeSize
Definition: structs.h:376
WORD bufnum
Definition: structs.h:377
WORD * AddLHS(int num)
Definition: comtool.c:188
WORD buffersfill
Definition: structs.h:379
WORD complex
Definition: structs.h:480
LONG defined
Definition: structs.h:367
MINMAX * mm
Definition: structs.h:358
VOID LowerSortLevel()
Definition: sort.c:4726
COMPTREE * boomlijst
Definition: structs.h:360
WORD * prototype
Definition: structs.h:355
LONG name
Definition: structs.h:478
LONG namesize
Definition: structs.h:272
int bounds
Definition: structs.h:371
LONG oldnamefill
Definition: structs.h:274
LONG oldnodefill
Definition: structs.h:275
WORD spec
Definition: structs.h:483
WORD * Buffer
Definition: structs.h:939
WORD NewSort(PHEAD0)
Definition: sort.c:591
WORD Generator(PHEAD WORD *, WORD)
Definition: proces.c:3072
UBYTE * namebuffer
Definition: structs.h:267
WORD right
Definition: structs.h:250
WORD namesize
Definition: structs.h:486
LONG mdefined
Definition: structs.h:368
WORD headnode
Definition: structs.h:281
int rootnum
Definition: structs.h:375
struct FuNcTiOn * FUNCTIONS
WORD * flags
Definition: structs.h:359
LONG clearnodefill
Definition: structs.h:280
LONG EndSort(PHEAD WORD *, int)
Definition: sort.c:681
struct TaBlEs * TABLES
WORD commute
Definition: structs.h:479
WORD * AddRHS(int num, int type)
Definition: comtool.c:214