FORM  4.3
names.c
Go to the documentation of this file.
1 
9 /* #[ License : */
10 /*
11  * Copyright (C) 1984-2022 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  LIST* oldsymbols = AC.Symbols;
1165  *dim4 = -NMIN4SHIFT;
1166  if ( FG.cTable[*s] == 1 ) {
1167 retry:
1168  ParseNumber(*dim,s)
1169 #if ( BITSINWORD/8 < 4 )
1170  if ( *dim >= (1 << (BITSINWORD-1)) ) goto illeg;
1171 #endif
1172  *dim4 = *dim - 4;
1173  return(s);
1174  }
1175  else if ( ( (FG.cTable[*s] == 0 ) || ( *s == '[' ) )
1176  && ( s = SkipAName(s) ) != 0 ) {
1177  AC.activenames = &(AC.varnames);
1178  AC.Symbols = &(AC.SymbolList);
1179  c = *s; *s = 0;
1180  if ( ( ( type = GetName(AC.exprnames,t,&numsymbol,NOAUTO) ) != NAMENOTFOUND )
1181  || ( ( type = GetName(AC.varnames,t,&numsymbol,WITHAUTO) ) != NAMENOTFOUND ) ) {
1182  if ( type != CSYMBOL ) error = NameConflict(type,t);
1183  }
1184  else {
1185  numsymbol = AddSymbol(t,-MAXPOWER,MAXPOWER,0,0);
1186  if ( AC.WarnFlag )
1187  MesPrint("&Warning: Implicit declaration of %s as a symbol",t);
1188  }
1189  *dim = -numsymbol;
1190  if ( ( *s = c ) == ':' ) {
1191  s++;
1192  t = s;
1193  if ( ( s = SkipAName(s) ) == 0 ) goto illeg;
1194  if ( ( ( type = GetName(AC.exprnames,t,&numsymbol,NOAUTO) ) != NAMENOTFOUND )
1195  || ( ( type = GetName(AC.varnames,t,&numsymbol,WITHAUTO) ) != NAMENOTFOUND ) ) {
1196  if ( type != CSYMBOL ) error = NameConflict(type,t);
1197  }
1198  else {
1199  numsymbol = AddSymbol(t,-MAXPOWER,MAXPOWER,0,0);
1200  if ( AC.WarnFlag )
1201  MesPrint("&Warning: Implicit declaration of %s as a symbol",t);
1202  }
1203  *dim4 = -numsymbol-NMIN4SHIFT;
1204  }
1205  }
1206  else if ( *s == '+' && FG.cTable[s[1]] == 1 ) {
1207  s++; goto retry;
1208  }
1209  else {
1210 illeg: MesPrint("&Illegal dimension specification. Should be number >= 0, symbol or symbol:symbol");
1211  return(0);
1212  }
1213  AC.Symbols = oldsymbols;
1214  AC.activenames = oldtree;
1215  if ( error ) return(0);
1216  return(s);
1217 }
1218 
1219 /*
1220  #] DoDimension :
1221  #[ CoDimension :
1222 */
1223 
1224 int CoDimension(UBYTE *s)
1225 {
1226  s = DoDimension(s,&AC.lDefDim,&AC.lDefDim4);
1227  if ( s == 0 ) return(1);
1228  if ( *s != 0 ) {
1229  MesPrint("&Argument of dimension statement should be number >= 0, symbol or symbol:symbol");
1230  return(1);
1231  }
1232  return(0);
1233 }
1234 
1235 /*
1236  #] CoDimension :
1237  #[ AddVector :
1238 
1239  The actual addition. Special routine for additions 'on the fly'
1240 */
1241 
1242 int AddVector(UBYTE *name, int cplx, int dim)
1243 {
1244  int nodenum, numvector = AC.Vectors->num;
1245  VECTORS v = (VECTORS)FromVarList(AC.Vectors);
1246  UBYTE *s = name;
1247  bzero(v,sizeof(struct VeCtOr));
1248  v->name = AddName(*AC.activenames,name,CVECTOR,numvector,&nodenum);
1249  v->complex = cplx;
1250  v->node = nodenum;
1251  v->dimension = dim;
1252  v->flags = 0;
1253  while ( *s ) s++;
1254  v->namesize = (s-name)+1;
1255  return(numvector);
1256 }
1257 
1258 /*
1259  #] AddVector :
1260  #[ CoVector :
1261 
1262  Vector declarations. The descriptor string is "(,%n)"
1263 */
1264 
1265 int CoVector(UBYTE *s)
1266 {
1267  int type, error = 0, dim;
1268  WORD numvector;
1269  UBYTE *name, c, *endname;
1270  do {
1271  name = s;
1272  dim = 0;
1273  if ( ( s = SkipAName(s) ) == 0 ) {
1274 IllForm: MesPrint("&Illegally formed name in vector statement");
1275  error = 1;
1276  s = SkipField(s,0);
1277  }
1278  else {
1279  c = *s; *s = 0, endname = s;
1280  if ( TestName(name) ) { *s = c; goto IllForm; }
1281  if ( c == '{' ) {
1282  s++;
1283  if ( ( *s == 'd' || *s == 'D' ) && s[1] == '=' ) {
1284  s += 2;
1285  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
1286  ParseSignedNumber(dim,s)
1287  if ( dim < -HALFMAX || dim > HALFMAX ) {
1288  MesPrint("&Warning: dimension of %s (%d) out of range"
1289  ,name,dim);
1290  }
1291  }
1292  if ( *s != '}' ) goto IllDim;
1293  else s++;
1294  }
1295  else {
1296 IllDim: MesPrint("&Error: Illegal dimension field for variable %s",name);
1297  error = 1;
1298  s = SkipField(s,0);
1299  while ( *s == ',' ) s++;
1300  continue;
1301  }
1302  }
1303  if ( ( AC.AutoDeclareFlag == 0 &&
1304  ( ( type = GetName(AC.exprnames,name,&numvector,NOAUTO) )
1305  != NAMENOTFOUND ) )
1306  || ( ( type = GetName(*(AC.activenames),name,&numvector,NOAUTO) ) != NAMENOTFOUND ) ) {
1307  if ( type != CVECTOR ) error = NameConflict(type,name);
1308  }
1309  else AddVector(name,0,dim);
1310  *endname = c;
1311  }
1312  while ( *s == ',' ) s++;
1313  } while ( *s );
1314  return(error);
1315 }
1316 
1317 /*
1318  #] CoVector :
1319  #[ AddFunction :
1320 
1321  The actual addition. Special routine for additions 'on the fly'
1322 */
1323 
1324 int AddFunction(UBYTE *name, int comm, int istensor, int cplx, int symprop, int dim, int argmax, int argmin)
1325 {
1326  int nodenum, numfunction = AC.Functions->num;
1327  FUNCTIONS fun = (FUNCTIONS)FromVarList(AC.Functions);
1328  UBYTE *s = name;
1329  bzero(fun,sizeof(struct FuNcTiOn));
1330  fun->name = AddName(*AC.activenames,name,CFUNCTION,numfunction,&nodenum);
1331  fun->commute = comm;
1332  fun->spec = istensor;
1333  fun->complex = cplx;
1334  fun->tabl = 0;
1335  fun->flags = 0;
1336  fun->node = nodenum;
1337  fun->symminfo = 0;
1338  fun->symmetric = symprop;
1339  fun->dimension = dim;
1340  fun->maxnumargs = argmax;
1341  fun->minnumargs = argmin;
1342  while ( *s ) s++;
1343  fun->namesize = (s-name)+1;
1344  return(numfunction);
1345 }
1346 
1347 /*
1348  #] AddFunction :
1349  #[ CoCommuteInSet :
1350 
1351  Commuting,f1,...,fn;
1352 */
1353 
1354 int CoCommuteInSet(UBYTE *s)
1355 {
1356  UBYTE *name, *ss, c, *start = s;
1357  WORD number, type, *g, *gg;
1358  int error = 0, i, len = StrLen(s), len2 = 0;
1359  if ( AC.CommuteInSet != 0 ) {
1360  g = AC.CommuteInSet;
1361  while ( *g ) g += *g;
1362  len2 = g - AC.CommuteInSet;
1363  if ( len2+len+3 > AC.SizeCommuteInSet ) {
1364  gg = (WORD *)Malloc1((len2+len+3)*sizeof(WORD),"CommuteInSet");
1365  for ( i = 0; i < len2; i++ ) gg[i] = AC.CommuteInSet[i];
1366  gg[len2] = 0;
1367  M_free(AC.CommuteInSet,"CommuteInSet");
1368  AC.CommuteInSet = gg;
1369  AC.SizeCommuteInSet = len+len2+3;
1370  g = AC.CommuteInSet+len2;
1371  }
1372  }
1373  else {
1374  AC.SizeCommuteInSet = len+2;
1375  g = AC.CommuteInSet = (WORD *)Malloc1((len+3)*sizeof(WORD),"CommuteInSet");
1376  *g = 0;
1377  }
1378  gg = g++;
1379  ss = s-1;
1380  for(;;) {
1381  while ( *s == ',' || *s == ' ' || *s == '\t' ) s++;
1382  if ( *s == 0 ) {
1383  if ( s - start >= len ) break;
1384  *s = '}'; s++;
1385  *g = 0;
1386  *gg = g-gg;
1387  if ( *gg < 2 ) {
1388  MesPrint("&There should be at least two noncommuting functions or tensors in a commuting statement.");
1389  error = 1;
1390  }
1391  else if ( *gg == 2 ) {
1392  gg[2] = gg[1]; gg[3] = 0; gg[0] = 3;
1393  }
1394  gg = g++;
1395  continue;
1396  }
1397  if ( s > ss ) {
1398  if ( *s != '{' ) {
1399  MesPrint("&The CommuteInSet statement should have sets enclosed in {}.");
1400  error = 1;
1401  break;
1402  }
1403  ss = s;
1404  SKIPBRA2(ss) /* Note that parentheses were tested before */
1405  *ss = 0;
1406  s++;
1407  }
1408  name = s;
1409  s = SkipAName(s);
1410  c = *s; *s = 0;
1411  if ( ( type = GetName(AC.varnames,name,&number,NOAUTO) ) != CFUNCTION ) {
1412  MesPrint("&%s is not a function or tensor",name);
1413  error = 1;
1414  }
1415  else if ( functions[number].commute == 0 ){
1416  MesPrint("&%s is not a noncommuting function or tensor",name);
1417  error = 1;
1418  }
1419  else {
1420  *g++ = number+FUNCTION;
1421  functions[number].flags |= COULDCOMMUTE;
1422  if ( number+FUNCTION >= GAMMA && number+FUNCTION <= GAMMASEVEN ) {
1423  functions[GAMMA-FUNCTION].flags |= COULDCOMMUTE;
1424  functions[GAMMAI-FUNCTION].flags |= COULDCOMMUTE;
1425  functions[GAMMAFIVE-FUNCTION].flags |= COULDCOMMUTE;
1426  functions[GAMMASIX-FUNCTION].flags |= COULDCOMMUTE;
1427  functions[GAMMASEVEN-FUNCTION].flags |= COULDCOMMUTE;
1428  }
1429  }
1430  *s = c;
1431  }
1432  return(error);
1433 }
1434 
1435 /*
1436  #] CoCommuteInSet :
1437  #[ CoFunction + ...:
1438 
1439  Function declarations.
1440  The second parameter indicates commutation properties.
1441  The third parameter tells whether we have a tensor.
1442 */
1443 
1444 int CoFunction(UBYTE *s, int comm, int istensor)
1445 {
1446  int type, error = 0, cplx, symtype, dim, argmax, argmin;
1447  WORD numfunction, reverseorder = 0, addone;
1448  UBYTE *name, *oldc, *par, c, cc;
1449  do {
1450  symtype = cplx = 0, argmin = argmax = -1;
1451  dim = 0;
1452  name = s;
1453  if ( ( s = SkipAName(s) ) == 0 ) {
1454 IllForm: MesPrint("&Illegally formed function/tensor name");
1455  error = 1;
1456  s = SkipField(name,0);
1457  goto eol;
1458  }
1459  oldc = s; cc = c = *s; *s = 0;
1460  if ( TestName(name) ) { *s = c; goto IllForm; }
1461  if ( c == '#' ) {
1462  s++;
1463  if ( tolower(*s) == 'r' ) cplx = VARTYPENONE;
1464  else if ( tolower(*s) == 'c' ) cplx = VARTYPECOMPLEX;
1465  else if ( tolower(*s) == 'i' ) cplx = VARTYPEIMAGINARY;
1466  else {
1467  MesPrint("&Illegal specification for complexity of %s",name);
1468  *oldc = c;
1469  error = 1;
1470  s = SkipField(s,0);
1471  goto eol;
1472  }
1473  s++; cc = *s;
1474  }
1475  if ( cc == '{' ) {
1476  s++;
1477  if ( ( *s == 'd' || *s == 'D' ) && s[1] == '=' ) {
1478  s += 2;
1479  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
1480  ParseSignedNumber(dim,s)
1481  if ( dim < -HALFMAX || dim > HALFMAX ) {
1482  MesPrint("&Warning: dimension of %s (%d) out of range"
1483  ,name,dim);
1484  }
1485  }
1486  if ( *s != '}' ) goto IllDim;
1487  else s++;
1488  }
1489  else {
1490 IllDim: MesPrint("&Error: Illegal dimension field for variable %s",name);
1491  error = 1;
1492  s = SkipField(s,0);
1493  goto eol;
1494  }
1495  cc = *s;
1496  }
1497  if ( cc == '(' ) {
1498  s++;
1499  if ( *s == '-' ) {
1500  reverseorder = REVERSEORDER;
1501  s++;
1502  }
1503  else {
1504  reverseorder = 0;
1505  }
1506  par = s;
1507  while ( FG.cTable[*s] == 0 ) s++;
1508  cc = *s; *s = 0;
1509  if ( s <= par ) {
1510 illegsym: *s = cc;
1511  MesPrint("&Illegal specification for symmetry of %s",name);
1512  *oldc = c;
1513  error = 1;
1514  s = SkipField(s,1);
1515  goto eol;
1516  }
1517  if ( StrICont(par,(UBYTE *)"symmetric") == 0 ) symtype = SYMMETRIC;
1518  else if ( StrICont(par,(UBYTE *)"antisymmetric") == 0 ) symtype = ANTISYMMETRIC;
1519  else if ( ( StrICont(par,(UBYTE *)"cyclesymmetric") == 0 )
1520  || ( StrICont(par,(UBYTE *)"cyclic") == 0 ) ) symtype = CYCLESYMMETRIC;
1521  else if ( ( StrICont(par,(UBYTE *)"rcyclesymmetric") == 0 )
1522  || ( StrICont(par,(UBYTE *)"rcyclic") == 0 )
1523  || ( StrICont(par,(UBYTE *)"reversecyclic") == 0 ) ) symtype = RCYCLESYMMETRIC;
1524  else goto illegsym;
1525  *s = cc;
1526  if ( *s != ')' || ( s[1] && s[1] != ',' && s[1] != '<' ) ) {
1527  Warning("&Excess information in symmetric properties currently ignored");
1528  s = SkipField(s,1);
1529  }
1530  else s++;
1531  symtype |= reverseorder;
1532  cc = *s;
1533  }
1534 retry:;
1535  if ( cc == '<' ) {
1536  s++; addone = 0;
1537  if ( *s == '=' ) { addone++; s++; }
1538  argmax = 0;
1539  while ( FG.cTable[*s] == 1 ) { argmax = 10*argmax + *s++ - '0'; }
1540  argmax += addone;
1541  par = s;
1542  while ( FG.cTable[*s] == 0 ) s++;
1543  if ( s > par ) {
1544  cc = *s; *s = 0;
1545  if ( ( StrICont(par,(UBYTE *)"arguments") == 0 )
1546  || ( StrICont(par,(UBYTE *)"args") == 0 ) ) {}
1547  else {
1548  Warning("&Illegal information in number of arguments properties currently ignored");
1549  error = 1;
1550  }
1551  *s = cc;
1552  }
1553  if ( argmax <= 0 ) {
1554  MesPrint("&Error: Cannot have fewer than 0 arguments for variable %s",name);
1555  error = 1;
1556  }
1557  cc = *s;
1558  }
1559  if ( cc == '>' ) {
1560  s++; addone = 1;
1561  if ( *s == '=' ) { addone = 0; s++; }
1562  argmin = 0;
1563  while ( FG.cTable[*s] == 1 ) { argmin = 10*argmin + *s++ - '0'; }
1564  argmin += addone;
1565  par = s;
1566  while ( FG.cTable[*s] == 0 ) s++;
1567  if ( s > par ) {
1568  cc = *s; *s = 0;
1569  if ( ( StrICont(par,(UBYTE *)"arguments") == 0 )
1570  || ( StrICont(par,(UBYTE *)"args") == 0 ) ) {}
1571  else {
1572  Warning("&Illegal information in number of arguments properties currently ignored");
1573  error = 1;
1574  }
1575  *s = cc;
1576  }
1577  cc = *s;
1578  }
1579  if ( cc == '<' ) goto retry;
1580  if ( ( AC.AutoDeclareFlag == 0 &&
1581  ( ( type = GetName(AC.exprnames,name,&numfunction,NOAUTO) )
1582  != NAMENOTFOUND ) )
1583  || ( ( type = GetName(*(AC.activenames),name,&numfunction,NOAUTO) ) != NAMENOTFOUND ) ) {
1584  if ( type != CFUNCTION ) error = NameConflict(type,name);
1585  else {
1586 /* FUNCTIONS fun = (FUNCTIONS)(AC.Functions->lijst) + numfunction-FUNCTION; */
1587  FUNCTIONS fun = (FUNCTIONS)(AC.Functions->lijst) + numfunction;
1588 
1589  if ( fun->tabl != 0 ) {
1590  MesPrint("&Illegal attempt to change table into function");
1591  error = 1;
1592  }
1593 
1594  fun->complex = cplx;
1595  fun->commute = comm;
1596  if ( istensor && fun->spec == 0 ) {
1597  MesPrint("&Function %s changed to tensor",name);
1598  error = 1;
1599  }
1600  else if ( istensor == 0 && fun->spec ) {
1601  MesPrint("&Tensor %s changed to function",name);
1602  error = 1;
1603  }
1604  fun->spec = istensor;
1605  if ( fun->symmetric != symtype ) {
1606  fun->symmetric = symtype;
1607  AC.SymChangeFlag = 1;
1608  }
1609  fun->maxnumargs = argmax;
1610  fun->minnumargs = argmin;
1611  }
1612  }
1613  else {
1614  AddFunction(name,comm,istensor,cplx,symtype,dim,argmax,argmin);
1615  }
1616  *oldc = c;
1617 eol: while ( *s == ',' ) s++;
1618  } while ( *s );
1619  return(error);
1620 }
1621 
1622 int CoNFunction(UBYTE *s) { return(CoFunction(s,1,0)); }
1623 int CoCFunction(UBYTE *s) { return(CoFunction(s,0,0)); }
1624 int CoNTensor(UBYTE *s) { return(CoFunction(s,1,2)); }
1625 int CoCTensor(UBYTE *s) { return(CoFunction(s,0,2)); }
1626 
1627 /*
1628  #] CoFunction + ...:
1629  #[ DoTable :
1630 
1631  Syntax:
1632  Table [check] [strict|relax] [zerofill] name(:1:2,...,regular arguments);
1633  name must be the name of a regular function.
1634  the table indices must be the first arguments.
1635  The parenthesis indicates 'name' as opposed to the options.
1636 
1637  We leave behind:
1638  a struct tabl in the FUNCTION struct
1639  Regular table:
1640  an array tablepointers for the pointers to elements of rhs
1641  in the compiler struct cbuf[T->bufnum]
1642  an array MINMAX T->mm with the minima and maxima
1643  a prototype array
1644  an offset in the compiler buffer for the pattern to be matched
1645  Sparse table:
1646  Just the number of dimensions
1647  We will keep track of the number of defined elements in totind
1648  and in tablepointers we will have numind+1 positions for each
1649  element. The first numind elements for the indices and the
1650  last one for the element in cbuf[T->bufnum].rhs
1651 
1652  Complication: to preserve speed we need a prototype and a pattern
1653  for each thread when we use WITHPTHREADS. This is because we write
1654  into those when looking for the pattern.
1655 */
1656 
1657 static int nwarntab = 1;
1658 
1659 int DoTable(UBYTE *s, int par)
1660 {
1661  GETIDENTITY
1662  UBYTE *name, *p, *inp, c;
1663  int i, j, k, sparseflag = 0, rflag = 0, checkflag = 0;
1664  int error = 0, ret, oldcbufnum, oldEside;
1665  WORD funnum, type, *OldWork, *w, *ww, *t, *tt, *flags1, oldnumrhs,oldnumlhs;
1666  LONG oldcpointer;
1667  MINMAX *mm, *mm1;
1668  LONG x, y;
1669  TABLES T;
1670  CBUF *C;
1671 
1672  while ( *s == ',' ) s++;
1673  do {
1674  name = s;
1675  if ( ( s = SkipAName(s) ) == 0 ) {
1676 IllForm: MesPrint("&Illegal name or option in table declaration");
1677  return(1);
1678  }
1679  c = *s; *s = 0;
1680  if ( TestName(name) ) { *s = c; goto IllForm; }
1681  *s = c;
1682  if ( *s == '(' ) break;
1683  if ( *s != ',' ) {
1684  MesPrint("&Illegal definition of table");
1685  return(1);
1686  }
1687  *s = 0;
1688 /*
1689  Secondary options
1690 */
1691  if ( StrICmp(name,(UBYTE *)("check" )) == 0 ) checkflag = 1;
1692  else if ( StrICmp(name,(UBYTE *)("zero" )) == 0 ) checkflag = 2;
1693  else if ( StrICmp(name,(UBYTE *)("one" )) == 0 ) checkflag = 3;
1694  else if ( StrICmp(name,(UBYTE *)("strict")) == 0 ) rflag = 1;
1695  else if ( StrICmp(name,(UBYTE *)("relax" )) == 0 ) rflag = -1;
1696  else if ( StrICmp(name,(UBYTE *)("zerofill" )) == 0 ) { rflag = -2; checkflag = 2; }
1697  else if ( StrICmp(name,(UBYTE *)("onefill" )) == 0 ) { rflag = -3; checkflag = 3; }
1698  else if ( StrICmp(name,(UBYTE *)("sparse")) == 0 ) sparseflag |= 1;
1699  else if ( StrICmp(name,(UBYTE *)("base")) == 0 ) sparseflag |= 3;
1700  else if ( StrICmp(name,(UBYTE *)("tablebase")) == 0 ) sparseflag |= 3;
1701  else {
1702  MesPrint("&Illegal option in table definition: '%s'",name);
1703  error = 1;
1704  }
1705  *s++ = ',';
1706  while ( *s == ',' ) s++;
1707  } while ( *s );
1708  if ( name == s || *s == 0 ) {
1709  MesPrint("&Illegal name or option in table declaration");
1710  return(1);
1711  }
1712  *s = 0; /* *s could only have been a parenthesis */
1713  if ( sparseflag ) {
1714  if ( checkflag == 1 ) rflag = 0;
1715  else if ( checkflag == 2 ) rflag = -2;
1716  else if ( checkflag == 3 ) rflag = -3;
1717  else rflag = -1;
1718  }
1719  if ( ( ret = GetVar(name,&type,&funnum,CFUNCTION,NOAUTO) ) ==
1720  NAMENOTFOUND ) {
1721  if ( par == 0 ) {
1722  funnum = EntVar(CFUNCTION,name,0,1,0,0);
1723  }
1724  else if ( par == 1 || par == 2 ) {
1725  funnum = EntVar(CFUNCTION,name,0,0,0,0);
1726  }
1727  }
1728  else if ( ret <= 0 ) {
1729  funnum = EntVar(CFUNCTION,name,0,0,0,0);
1730  error = 1;
1731  }
1732  else {
1733  if ( par == 2 ) {
1734  if ( nwarntab ) {
1735  Warning("Table now declares its (commuting) function.");
1736  Warning("Earlier definition in Function statement obsolete. Please remove.");
1737  nwarntab = 0;
1738  }
1739  }
1740  else {
1741  error = 1;
1742  MesPrint("&(N)(C)Tables should not be declared previously");
1743  }
1744  }
1745  if ( functions[funnum].spec > 0 ) {
1746  MesPrint("&Tensors cannot become tables");
1747  return(1);
1748  }
1749  if ( functions[funnum].symmetric > 0 ) {
1750  MesPrint("&Functions with nontrivial symmetrization properties cannot become tables");
1751  return(1);
1752  }
1753  if ( functions[funnum].tabl ) {
1754  MesPrint("&Redefinition of an existing table is not allowed.");
1755  return(1);
1756  }
1757  functions[funnum].tabl = T = (TABLES)Malloc1(sizeof(struct TaBlEs),"table");
1758 /*
1759  Next we find the size of the table (if it is not sparse)
1760 */
1761  T->defined = T->mdefined = 0; T->sparse = sparseflag; T->mm = 0; T->flags = 0;
1762  T->numtree = 0; T->rootnum = 0; T->MaxTreeSize = 0;
1763  T->boomlijst = 0;
1764  T->strict = rflag;
1765  T->bounds = checkflag;
1766  T->bufnum = inicbufs();
1767  T->argtail = 0;
1768  T->spare = 0;
1769  T->bufferssize = 8;
1770  T->buffers = (WORD *)Malloc1(sizeof(WORD)*T->bufferssize,"Table buffers");
1771  T->buffersfill = 0;
1772  T->buffers[T->buffersfill++] = T->bufnum;
1773  T->mode = 0;
1774  T->numdummies = 0;
1775  mm = T->mm;
1776  T->numind = 0;
1777  if ( rflag > 0 ) AC.MustTestTable++;
1778  T->totind = 0; /* Table hasn't been checked */
1779 
1780  p = s; *s = '(';
1781  if ( sparseflag ) {
1782 /*
1783  First copy the tail, just in case we will construct a tablebase
1784  Note that we keep the ( to indicate a tail
1785  The actual arguments can be found after the comma. Before we have
1786  the dimension which the tablebase will need for consistency checking.
1787 */
1788  inp = p+1;
1789  SKIPBRA3(inp)
1790  c = *inp; *inp = 0;
1791  T->argtail = strDup1(p,"argtail");
1792  *inp = c;
1793 /*
1794  Now the regular compilation
1795 */
1796  inp = p++;
1797  ParseNumber(x,p)
1798  if ( FG.cTable[p[-1]] != 1 || ( *p != ',' && *p != ')' ) ) {
1799  p = inp;
1800  MesPrint("&First argument in a sparse table must be a number of dimensions");
1801  error = 1;
1802  x = 1;
1803  }
1804  T->numind = x;
1805  T->mm = (MINMAX *)Malloc1(x*sizeof(MINMAX),"table dimensions");
1806  T->flags = (WORD *)Malloc1(x*sizeof(WORD),"table flags");
1807  mm = T->mm;
1808  inp = p;
1809  if ( *inp != ')' ) inp++;
1810  T->totind = 0; /* At the moment there are this many */
1811  T->tablepointers = 0;
1812  T->reserved = 0;
1813  }
1814  else {
1815  T->numind = 0;
1816  T->totind = 1;
1817  for(;;) { /* Read the dimensions as far as they can be recognized */
1818  inp = ++p;
1819  if ( FG.cTable[*p] != 1 && *p != '+' && *p != '-' ) break;
1820  ParseSignedNumber(x,p)
1821  if ( FG.cTable[p[-1]] != 1 || *p != ':' ) break;
1822  p++;
1823  ParseSignedNumber(y,p)
1824  if ( FG.cTable[p[-1]] != 1 || ( *p != ',' && *p != ')' ) ) {
1825  MesPrint("&Illegal dimension field in table declaration");
1826  return(1);
1827  }
1828  mm1 = (MINMAX *)Malloc1((T->numind+1)*sizeof(MINMAX),"table dimensions");
1829  flags1 = (WORD *)Malloc1((T->numind+1)*sizeof(WORD),"table flags");
1830  for ( i = 0; i < T->numind; i++ ) { mm1[i] = T->mm[i]; flags1[i] = T->flags[i]; }
1831  if ( T->mm ) M_free(T->mm,"table dimensions");
1832  if ( T->flags ) M_free(T->flags,"table flags");
1833  T->mm = mm1;
1834  T->flags = flags1;
1835  mm = T->mm + T->numind;
1836  mm->mini = x; mm->maxi = y;
1837  T->totind *= mm->maxi-mm->mini+1;
1838  T->numind++;
1839  if ( *p == ')' ) { inp = p; break; }
1840  }
1841  w = T->tablepointers
1842  = (WORD *)Malloc1(TABLEEXTENSION*sizeof(WORD)*(T->totind),"table pointers");
1843  i = T->totind;
1844  for ( i = TABLEEXTENSION*T->totind; i > 0; i-- ) *w++ = -1; /* means: undefined */
1845  for ( i = T->numind-1, x = 1; i >= 0; i-- ) {
1846  T->mm[i].size = x; /* Defines increment in this dimension */
1847  x *= T->mm[i].maxi - T->mm[i].mini + 1;
1848  }
1849  }
1850 /*
1851  Now we redo the 'function part' and send it to the compiler.
1852  The prototype has to be picked up properly.
1853 */
1854  AT.WorkPointer++; /* We needs one extra word later */
1855  OldWork = AT.WorkPointer;
1856  oldcbufnum = AC.cbufnum;
1857  AC.cbufnum = T->bufnum;
1858  C = cbuf+AC.cbufnum;
1859  oldcpointer = C->Pointer - C->Buffer;
1860  oldnumlhs = C->numlhs;
1861  oldnumrhs = C->numrhs;
1862  AddLHS(AC.cbufnum);
1863  while ( s >= name ) *--inp = *s--;
1864  w = AT.WorkPointer;
1865  AC.ProtoType = w;
1866  *w++ = SUBEXPRESSION;
1867  *w++ = SUBEXPSIZE;
1868  *w++ = 0;
1869  *w++ = 1;
1870  *w++ = AC.cbufnum;
1871  FILLSUB(w)
1872  AC.WildC = w;
1873  AC.NwildC = 0;
1874  AT.WorkPointer = w + 4*AM.MaxWildcards;
1875  if ( ( ret = CompileAlgebra(inp,LHSIDE,AC.ProtoType) ) < 0 ) {
1876  error = 1; goto FinishUp;
1877  }
1878  if ( AC.NwildC && SortWild(w,AC.NwildC) ) error = 1;
1879  w += AC.NwildC;
1880  i = w-OldWork;
1881  OldWork[1] = i;
1882 /*
1883  Basically we have to pull this pattern through Generator in case
1884  there are functions inside functions, or parentheses.
1885  We have to temporarily disable the .tabl to avoid problems with
1886  TestSub.
1887  Essential: we need to start NewSort twice to avoid the PutOut routines.
1888  The ground pattern is sitting in C->numrhs, but it could be that it
1889  has subexpressions in it. Hence it has to be worked out as the lhs in
1890  id statements (in comexpr.c).
1891 */
1892  OldWork[2] = C->numrhs;
1893  *w++ = 1; *w++ = 1; *w++ = 3;
1894  OldWork[-1] = w-OldWork+1;
1895  AT.WorkPointer = w;
1896  ww = C->rhs[C->numrhs];
1897  for ( j = 0; j < *ww; j++ ) w[j] = ww[j];
1898  AT.WorkPointer = w+*w;
1899  if ( *ww == 0 || ww[*ww] != 0 ) {
1900  MesPrint("&Illegal table pattern definition");
1901  AC.lhdollarflag = 0;
1902  error = 1;
1903  }
1904  if ( error ) goto FinishUp;
1905 
1906  if ( NewSort(BHEAD0) || NewSort(BHEAD0) ) { error = 1; goto FinishUp; }
1907  AN.RepPoint = AT.RepCount + 1;
1908  AC.lhdollarflag = 0; oldEside = AR.Eside; AR.Eside = LHSIDE;
1909  AR.Cnumlhs = C->numlhs;
1910  functions[funnum].tabl = 0;
1911  if ( Generator(BHEAD w,C->numlhs) ) {
1912  functions[funnum].tabl = T;
1913  AR.Eside = oldEside;
1914  LowerSortLevel(); LowerSortLevel(); goto FinishUp;
1915  }
1916  functions[funnum].tabl = T;
1917  AR.Eside = oldEside;
1918  AT.WorkPointer = w;
1919  if ( EndSort(BHEAD w,0) < 0 ) { LowerSortLevel(); goto FinishUp; }
1920  if ( *w == 0 || *(w+*w) != 0 ) {
1921  MesPrint("&Irregular pattern in table definition");
1922  error = 1;
1923  goto FinishUp;
1924  }
1925  LowerSortLevel();
1926  if ( AC.lhdollarflag ) {
1927  MesPrint("&Unexpanded dollar variables are not allowed in table definition");
1928  error = 1;
1929  goto FinishUp;
1930  }
1931  AT.WorkPointer = ww = w + *w;
1932  if ( ww[-1] != 3 || ww[-2] != 1 || ww[-3] != 1 ) {
1933  MesPrint("&Coefficient of pattern in table definition should be 1.");
1934  error = 1;
1935  goto FinishUp;
1936  }
1937  AC.DumNum = 0;
1938 /*
1939  Now we have to allocate space for prototype+pattern
1940  In the case of TFORM we need extra pointers, because each worker has its own
1941 */
1942  j = *w + T->numind*2-3;
1943 #ifdef WITHPTHREADS
1944  { int n;
1945  T->prototypeSize = ((i+j)*sizeof(WORD)+2*sizeof(WORD *)) * AM.totalnumberofthreads;
1946  T->prototype = (WORD **)Malloc1(T->prototypeSize,"table prototype");
1947  T->pattern = T->prototype + AM.totalnumberofthreads;
1948  t = (WORD *)(T->pattern + AM.totalnumberofthreads);
1949  for ( n = 0; n < AM.totalnumberofthreads; n++ ) {
1950  T->prototype[n] = t;
1951  for ( k = 0; k < i; k++ ) *t++ = OldWork[k];
1952  }
1953  T->pattern[0] = t;
1954  j--; w++;
1955  w[1] += T->numind*2;
1956  for ( k = 0; k < FUNHEAD; k++ ) *t++ = *w++;
1957  j -= FUNHEAD;
1958  for ( k = 0; k < T->numind; k++ ) { *t++ = -SNUMBER; *t++ = 0; j -= 2; }
1959  for ( k = 0; k < j; k++ ) *t++ = *w++;
1960  if ( sparseflag ) T->pattern[0][1] = t - T->pattern[0];
1961  k = t - T->pattern[0];
1962  for ( n = 1; n < AM.totalnumberofthreads; n++ ) {
1963  T->pattern[n] = t; tt = T->pattern[0];
1964  for ( i = 0; i < k; i++ ) *t++ = *tt++;
1965  }
1966  }
1967 #else
1968  T->prototypeSize = (i+j)*sizeof(WORD);
1969  T->prototype = (WORD *)Malloc1(T->prototypeSize, "table prototype");
1970  T->pattern = T->prototype + i;
1971  for ( k = 0; k < i; k++ ) T->prototype[k] = OldWork[k];
1972  t = T->pattern;
1973  j--; w++;
1974  w[1] += T->numind*2;
1975  for ( k = 0; k < FUNHEAD; k++ ) *t++ = *w++;
1976  j -= FUNHEAD;
1977  for ( k = 0; k < T->numind; k++ ) { *t++ = -SNUMBER; *t++ = 0; j -= 2; }
1978  for ( k = 0; k < j; k++ ) *t++ = *w++;
1979  if ( sparseflag ) T->pattern[1] = t - T->pattern;
1980 #endif
1981 /*
1982  At this point we can pop the compilerbuffer.
1983 */
1984  C->Pointer = C->Buffer + oldcpointer;
1985  C->numrhs = oldnumrhs;
1986  C->numlhs = oldnumlhs;
1987 /*
1988  Now check whether wildcards get converted to dollars (for PARALLEL)
1989  We give a warning!
1990 */
1991 #ifdef WITHPTHREADS
1992  t = T->prototype[0];
1993 #else
1994  t = T->prototype;
1995 #endif
1996  tt = t + t[1]; t += SUBEXPSIZE;
1997  while ( t < tt ) {
1998  if ( *t == LOADDOLLAR ) {
1999  Warning("The use of $-variable assignments in tables disables parallel\
2000  execution for the whole program.");
2001  AM.hparallelflag |= NOPARALLEL_TBLDOLLAR;
2002  AC.mparallelflag |= NOPARALLEL_TBLDOLLAR;
2003  AddPotModdollar(t[2]);
2004  }
2005  t += t[1];
2006  }
2007 FinishUp:;
2008  AT.WorkPointer = OldWork - 1;
2009  AC.cbufnum = oldcbufnum;
2010  if ( T->sparse ) ClearTableTree(T);
2011  if ( ( sparseflag & 2 ) != 0 ) {
2012  if ( T->spare == 0 ) { SpareTable(T); }
2013  }
2014  return(error);
2015 }
2016 
2017 /*
2018  #] DoTable :
2019  #[ CoTable :
2020 */
2021 
2022 int CoTable(UBYTE *s)
2023 {
2024  return(DoTable(s,2));
2025 }
2026 
2027 /*
2028  #] CoTable :
2029  #[ CoNTable :
2030 */
2031 
2032 int CoNTable(UBYTE *s)
2033 {
2034  return(DoTable(s,0));
2035 }
2036 
2037 /*
2038  #] CoNTable :
2039  #[ CoCTable :
2040 */
2041 
2042 int CoCTable(UBYTE *s)
2043 {
2044  return(DoTable(s,1));
2045 }
2046 
2047 /*
2048  #] CoCTable :
2049  #[ EmptyTable :
2050 */
2051 
2052 void EmptyTable(TABLES T)
2053 {
2054  int j;
2055  if ( T->sparse ) ClearTableTree(T);
2056  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
2057  T->boomlijst = 0;
2058  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
2059  finishcbuf(T->buffers[j]);
2060  }
2061  if ( T->buffers ) M_free(T->buffers,"Table buffers");
2062  finishcbuf(T->bufnum);
2063  T->bufnum = inicbufs();
2064  T->bufferssize = 8;
2065  T->buffers = (WORD *)Malloc1(sizeof(WORD)*T->bufferssize,"Table buffers");
2066  T->buffersfill = 0;
2067  T->buffers[T->buffersfill++] = T->bufnum;
2068  T->defined = T->mdefined = 0; T->flags = 0;
2069  T->numtree = 0; T->rootnum = 0; T->MaxTreeSize = 0;
2070  T->spare = 0; T->reserved = 0;
2071  if ( T->spare ) {
2072  TABLES TT = T->spare;
2073  if ( TT->mm ) M_free(TT->mm,"tableminmax");
2074  if ( TT->flags ) M_free(TT->flags,"tableflags");
2075  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2076  for (j = 0; j < TT->buffersfill; j++ ) {
2077  finishcbuf(TT->buffers[j]);
2078  }
2079  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
2080  if ( TT->buffers ) M_free(TT->buffers,"Table buffers");
2081  M_free(TT,"table");
2082  SpareTable(T);
2083  }
2084  else {
2085  WORD *w = T->tablepointers;
2086  j = T->totind;
2087  for ( j = TABLEEXTENSION*T->totind; j > 0; j-- ) *w++ = -1; /* means: undefined */
2088  }
2089 }
2090 
2091 /*
2092  #] EmptyTable :
2093  #[ AddSet :
2094 */
2095 
2096 int AddSet(UBYTE *name, WORD dim)
2097 {
2098  int nodenum, numset = AC.SetList.num;
2099  SETS set = (SETS)FromVarList(&AC.SetList);
2100  UBYTE *s;
2101  if ( name ) {
2102  set->name = AddName(AC.varnames,name,CSET,numset,&nodenum);
2103  s = name;
2104  while ( *s ) s++;
2105  set->namesize = (s-name)+1;
2106  set->node = nodenum;
2107  }
2108  else {
2109  set->name = 0;
2110  set->namesize = 0;
2111  set->node = -1;
2112  }
2113  set->first =
2114  set->last = AC.SetElementList.num; /* set has no elements yet */
2115  set->type = -1; /* undefined as of yet */
2116  set->dimension = dim;
2117  set->flags = 0;
2118  return(numset);
2119 }
2120 
2121 /*
2122  #] AddSet :
2123  #[ DoElements :
2124 
2125  Remark (25-mar-2011): If the dimension has been set (dim != MAXPOSITIVE)
2126  we want to test dimensions. Numbers count as dimension zero?
2127 */
2128 
2129 int DoElements(UBYTE *s, SETS set, UBYTE *name)
2130 {
2131  int type, error = 0, x, sgn, i;
2132  WORD numset, *e;
2133  UBYTE c, *cname;
2134  while ( *s ) {
2135  if ( *s == ',' ) { s++; continue; }
2136  sgn = 0;
2137  while ( *s == '-' || *s == '+' ) { sgn ^= 1; s++; }
2138  cname = s;
2139  if ( FG.cTable[*s] == 0 || *s == '_' || *s == '[' ) {
2140  if ( ( s = SkipAName(s) ) == 0 ) {
2141  MesPrint("&Illegal name in set definition");
2142  return(1);
2143  }
2144  c = *s; *s = 0;
2145  if ( ( ( type = GetName(AC.exprnames,cname,&numset,NOAUTO) ) == NAMENOTFOUND )
2146  && ( ( type = GetOName(AC.varnames,cname,&numset,WITHAUTO) ) == NAMENOTFOUND ) ) {
2147  DUBIOUSV dv;
2148  int nodenum;
2149  MesPrint("&%s has not been declared",cname);
2150 /*
2151  We enter a 'dubious' declaration to cut down on errors
2152 */
2153  numset = AC.DubiousList.num;
2154  dv = (DUBIOUSV)FromVarList(&AC.DubiousList);
2155  dv->name = AddName(AC.varnames,cname,CDUBIOUS,numset,&nodenum);
2156  dv->node = nodenum;
2157  set->type = type = CDUBIOUS;
2158  set->dimension = 0;
2159  error = 1;
2160  }
2161  if ( set->type == -1 ) {
2162  if ( type == CSYMBOL ) {
2163  for ( i = set->first; i < set->last; i++ ) {
2164  SetElements[i] += 2*MAXPOWER;
2165  }
2166  }
2167  set->type = type;
2168  }
2169  if ( set->type != type && set->type != CDUBIOUS
2170  && type != CDUBIOUS ) {
2171  if ( set->type != CNUMBER || ( type != CSYMBOL
2172  && type != CINDEX ) ) {
2173  MesPrint(
2174  "&%s has not the same type as the other members of the set"
2175  ,cname);
2176  error = 1;
2177  set->type = CDUBIOUS;
2178  }
2179  else {
2180  if ( type == CSYMBOL ) {
2181  for ( i = set->first; i < set->last; i++ ) {
2182  SetElements[i] += 2*MAXPOWER;
2183  }
2184  }
2185  set->type = type;
2186  }
2187  }
2188  if ( set->dimension != MAXPOSITIVE ) { /* Dimension check */
2189  switch ( set->type ) {
2190  case CSYMBOL:
2191  if ( symbols[numset].dimension != set->dimension ) {
2192  MesPrint("&Dimension check failed in set %s, symbol %s",
2193  VARNAME(Sets,(set-Sets)),
2194  VARNAME(symbols,numset));
2195  error = 1;
2196  set->dimension = MAXPOSITIVE;
2197  }
2198  break;
2199  case CVECTOR:
2200  if ( vectors[numset-AM.OffsetVector].dimension != set->dimension ) {
2201  MesPrint("&Dimension check failed in set %s, vector %s",
2202  VARNAME(Sets,(set-Sets)),
2203  VARNAME(vectors,(numset-AM.OffsetVector)));
2204  error = 1;
2205  set->dimension = MAXPOSITIVE;
2206  }
2207  break;
2208  case CFUNCTION:
2209  if ( functions[numset-FUNCTION].dimension != set->dimension ) {
2210  MesPrint("&Dimension check failed in set %s, function %s",
2211  VARNAME(Sets,(set-Sets)),
2212  VARNAME(functions,(numset-FUNCTION)));
2213  error = 1;
2214  }
2215  break;
2216  set->dimension = MAXPOSITIVE;
2217  }
2218  }
2219  if ( sgn ) {
2220  if ( type != CVECTOR ) {
2221  MesPrint("&Illegal use of - sign in set. Can use only with vector or number");
2222  error = 1;
2223  }
2224 /*
2225  numset = AM.OffsetVector - numset;
2226  numset |= SPECMASK;
2227  numset = AM.OffsetVector - numset;
2228 */
2229  numset -= WILDMASK;
2230  }
2231  *s = c;
2232  if ( name == 0 && *s == '?' ) {
2233  s++;
2234  switch ( set->type ) {
2235  case CSYMBOL:
2236  numset = -numset; break;
2237  case CVECTOR:
2238  numset += WILDOFFSET; break;
2239  case CINDEX:
2240  numset |= WILDMASK; break;
2241  case CFUNCTION:
2242  numset |= WILDMASK; break;
2243  }
2244  AC.wildflag = 1;
2245  }
2246 /*
2247  Now add the element to the set.
2248 */
2249  e = (WORD *)FromVarList(&AC.SetElementList);
2250  *e = numset;
2251  (set->last)++;
2252  }
2253  else if ( FG.cTable[*s] == 1 ) {
2254  ParseNumber(x,s)
2255  if ( sgn ) x = -x;
2256  if ( x >= MAXPOWER || x <= -MAXPOWER ||
2257  ( set->type == CINDEX && ( x < 0 || x >= AM.OffsetIndex ) ) ) {
2258  MesPrint("&Illegal value for set element: %d",x);
2259  if ( AC.firstconstindex ) {
2260  MesPrint("&0 <= Fixed indices < ConstIndex(which is %d)",
2261  AM.OffsetIndex-1);
2262  MesPrint("&For setting ConstIndex, read the chapter on the setup file");
2263  AC.firstconstindex = 0;
2264  }
2265  error = 1;
2266  x = 0;
2267  }
2268 /*
2269  Check what is allowed with the type.
2270 */
2271  if ( set->type == -1 ) {
2272  if ( x < 0 || x >= AM.OffsetIndex ) {
2273  for ( i = set->first; i < set->last; i++ ) {
2274  SetElements[i] += 2*MAXPOWER;
2275  }
2276  set->type = CSYMBOL;
2277  }
2278  else set->type = CNUMBER;
2279  }
2280  else if ( set->type == CDUBIOUS ) {}
2281  else if ( set->type == CNUMBER && x < 0 ) {
2282  for ( i = set->first; i < set->last; i++ ) {
2283  SetElements[i] += 2*MAXPOWER;
2284  }
2285  set->type = CSYMBOL;
2286  }
2287  else if ( set->type != CSYMBOL && ( x < 0 ||
2288  ( set->type != CINDEX && set->type != CNUMBER ) ) ) {
2289  MesPrint("&Illegal mixture of element types in set");
2290  error = 1;
2291  set->type = CDUBIOUS;
2292  }
2293 /*
2294  Allocate an element
2295 */
2296  e = (WORD *)FromVarList(&AC.SetElementList);
2297  (set->last)++;
2298  if ( set->type == CSYMBOL ) *e = x + 2*MAXPOWER;
2299 /* else if ( set->type == CINDEX ) *e = x; */
2300  else *e = x;
2301  }
2302  else {
2303  MesPrint("&Illegal object in list of set elements");
2304  return(1);
2305  }
2306  }
2307  if ( error == 0 && ( ( set->flags & ORDEREDSET ) == ORDEREDSET ) ) {
2308 /*
2309  The set->last-set->first list of numbers must be sorted.
2310  Because we plan here potentially thousands of elements we use
2311  a simple version of splitmerge. In ordered sets we can search
2312  later with a binary search.
2313 */
2314  SimpleSplitMerge(SetElements+set->first,set->last-set->first);
2315  }
2316  return(error);
2317 }
2318 
2319 /*
2320  #] DoElements :
2321  #[ CoSet :
2322 
2323  Set declarations.
2324 */
2325 
2326 int CoSet(UBYTE *s)
2327 {
2328  int type, error = 0, ordered = 0;
2329  UBYTE *name, c, *ss;
2330  SETS set;
2331  WORD numberofset, dim = MAXPOSITIVE;
2332  name = s;
2333  if ( ( s = SkipAName(s) ) == 0 ) {
2334 IllForm:MesPrint("&Illegal name for set");
2335  return(1);
2336  }
2337  c = *s; *s = 0;
2338  if ( TestName(name) ) goto IllForm;
2339  if ( ( ( type = GetName(AC.exprnames,name,&numberofset,NOAUTO) ) != NAMENOTFOUND )
2340  || ( ( type = GetName(AC.varnames,name,&numberofset,NOAUTO) ) != NAMENOTFOUND ) ) {
2341  if ( type != CSET ) NameConflict(type,name);
2342  else {
2343  MesPrint("&There is already a set with the name %s",name);
2344  }
2345  return(1);
2346  }
2347  if ( c == 0 ) {
2348  numberofset = AddSet(name,0);
2349  set = Sets + numberofset;
2350  return(0); /* empty set */
2351  }
2352  *s = c; ss = s; /* ss marks the end of the name */
2353  if ( *s == '(' ) {
2354  UBYTE *sss, cc;
2355  s++; sss = s; /* Beginning of option */
2356  while ( *s != ',' && *s != ')' && *s ) s++;
2357  cc = *s; *s = 0;
2358  if ( StrICont(sss,(UBYTE *)"ordered") == 0 ) {
2359  ordered = ORDEREDSET;
2360  }
2361  else {
2362  MesPrint("&Error: Illegal option in set definition: %s",sss);
2363  error = 1;
2364  }
2365  *s = cc;
2366  if ( *s != ')' ) {
2367  MesPrint("&Error: Currently only one option allowed in set definition.");
2368  error = 1;
2369  while ( *s && *s != ')' ) s++;
2370  }
2371  s++;
2372  }
2373  if ( *s == '{' ) {
2374  s++;
2375  if ( ( *s == 'd' || *s == 'D' ) && s[1] == '=' ) {
2376  s += 2;
2377  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
2378  ParseSignedNumber(dim,s)
2379  if ( dim < -HALFMAX || dim > HALFMAX ) {
2380  MesPrint("&Warning: dimension of %s (%d) out of range"
2381  ,name,dim);
2382  }
2383  }
2384  if ( *s != '}' ) goto IllDim;
2385  else s++;
2386  }
2387  else {
2388 IllDim: MesPrint("&Error: Illegal dimension field for set %s",name);
2389  error = 1;
2390  s = SkipField(s,0);
2391  }
2392  while ( *s == ',' ) s++;
2393  }
2394  c = *ss; *ss = 0;
2395  numberofset = AddSet(name,dim);
2396  *ss = c;
2397  set = Sets + numberofset;
2398  set->flags |= ordered;
2399  if ( *s != ':' ) {
2400  MesPrint("&Proper syntax is `Set name:elements'");
2401  return(1);
2402  }
2403  s++;
2404  error = DoElements(s,set,name);
2405  AC.SetList.numtemp = AC.SetList.num;
2406  AC.SetElementList.numtemp = AC.SetElementList.num;
2407  return(error);
2408 }
2409 
2410 /*
2411  #] CoSet :
2412  #[ DoTempSet :
2413 
2414  Gets a {} set definition and returns a set number if the set is
2415  properly structured. This number refers either to an already
2416  existing set, or to a set that is defined here.
2417  From and to refer to the contents. They exclude the {}.
2418 */
2419 
2420 int DoTempSet(UBYTE *from, UBYTE *to)
2421 {
2422  int i, num, j, sgn;
2423  WORD *e, *ep;
2424  UBYTE c;
2425  int setnum = AddSet(0,MAXPOSITIVE);
2426  SETS set = Sets + setnum, setp;
2427  set->name = -1;
2428  set->type = -1;
2429  c = *to; *to = 0;
2430  AC.wildflag = 0;
2431  while ( *from == ',' ) from++;
2432  if ( *from == '<' || *from == '>' ) {
2433  set->type = CRANGE;
2434  set->first = 3*MAXPOWER;
2435  set->last = -3*MAXPOWER;
2436  while ( *from == '<' || *from == '>' ) {
2437  if ( *from == '<' ) {
2438  j = 1; from++;
2439  if ( *from == '=' ) { from++; j++; }
2440  }
2441  else {
2442  j = -1; from++;
2443  if ( *from == '=' ) { from++; j--; }
2444  }
2445  sgn = 1;
2446  while ( *from == '-' || *from == '+' ) {
2447  if ( *from == '-' ) sgn = -sgn;
2448  from++;
2449  }
2450  ParseNumber(num,from)
2451  if ( *from && *from != ',' ) {
2452  MesPrint("&Illegal number in ranged set definition");
2453  return(-1);
2454  }
2455  if ( sgn < 0 ) num = -num;
2456  if ( num >= MAXPOWER || num <= -MAXPOWER ) {
2457  Warning("Value in ranged set too big. Adjusted to infinity.");
2458  if ( num > 0 ) num = 3*MAXPOWER;
2459  else num = -3*MAXPOWER;
2460  }
2461  else if ( j == 2 ) num += 2*MAXPOWER;
2462  else if ( j == -2 ) num -= 2*MAXPOWER;
2463  if ( j > 0 ) set->first = num;
2464  else set->last = num;
2465  while ( *from == ',' ) from++;
2466  }
2467  if ( *from ) {
2468  MesPrint("&Definition of ranged set contains illegal objects");
2469  return(-1);
2470  }
2471  }
2472  else if ( DoElements(from,set,(UBYTE *)0) != 0 ) {
2473  AC.SetElementList.num = set->first;
2474  AC.SetList.num--; *to = c;
2475  return(-1);
2476  }
2477  *to = c;
2478 /*
2479  Now we have to test whether this set exists already.
2480 */
2481  num = set->last - set->first;
2482  for ( setp = Sets, i = 0; i < AC.SetList.num-1; i++, setp++ ) {
2483  if ( num != setp->last - setp->first ) continue;
2484  if ( set->type != setp->type ) continue;
2485  if ( set->type == CRANGE ) {
2486  if ( set->first == setp->first ) return(setp-Sets);
2487  }
2488  else {
2489  e = SetElements + set->first;
2490  ep = SetElements + setp->first;
2491  j = num;
2492  while ( --j >= 0 ) if ( *e++ != *ep++ ) break;
2493  if ( j < 0 ) {
2494  AC.SetElementList.num = set->first;
2495  AC.SetList.num--;
2496  return(setp - Sets);
2497  }
2498  }
2499  }
2500  return(setnum);
2501 }
2502 
2503 /*
2504  #] DoTempSet :
2505  #[ CoAuto :
2506 
2507  To prepare first:
2508  Use of the proper pointers in the various declaration routines
2509  Proper action in .store and .clear
2510 */
2511 
2512 int CoAuto(UBYTE *inp)
2513 {
2514  int retval;
2515 
2516  AC.Symbols = &(AC.AutoSymbolList);
2517  AC.Vectors = &(AC.AutoVectorList);
2518  AC.Indices = &(AC.AutoIndexList);
2519  AC.Functions = &(AC.AutoFunctionList);
2520  AC.activenames = &(AC.autonames);
2521  AC.AutoDeclareFlag = WITHAUTO;
2522 
2523  while ( *inp == ',' ) inp++;
2524  retval = CompileStatement(inp);
2525 
2526  AC.AutoDeclareFlag = 0;
2527  AC.Symbols = &(AC.SymbolList);
2528  AC.Vectors = &(AC.VectorList);
2529  AC.Indices = &(AC.IndexList);
2530  AC.Functions = &(AC.FunctionList);
2531  AC.activenames = &(AC.varnames);
2532  return(retval);
2533 }
2534 
2535 /*
2536  #] CoAuto :
2537  #[ AddDollar :
2538 
2539  The actual addition. Special routine for additions 'on the fly'
2540 */
2541 
2542 int AddDollar(UBYTE *name, WORD type, WORD *start, LONG size)
2543 {
2544  int nodenum, numdollar = AP.DollarList.num;
2545  WORD *s, *t;
2546  DOLLARS dol = (DOLLARS)FromVarList(&AP.DollarList);
2547  dol->name = AddName(AC.dollarnames,name,CDOLLAR,numdollar,&nodenum);
2548  dol->type = type;
2549  dol->node = nodenum;
2550  dol->zero = 0;
2551  dol->numdummies = 0;
2552 #ifdef WITHPTHREADS
2553  dol->pthreadslockread = dummylock;
2554  dol->pthreadslockwrite = dummylock;
2555 #endif
2556  dol->nfactors = 0;
2557  dol->factors = 0;
2558  AddRHS(AM.dbufnum,1);
2559  AddLHS(AM.dbufnum);
2560  if ( start && size > 0 ) {
2561  dol->size = size;
2562  dol->where =
2563  s = (WORD *)Malloc1((size+1)*sizeof(WORD),"$-variable contents");
2564  t = start;
2565  while ( --size >= 0 ) *s++ = *t++;
2566  *s = 0;
2567  }
2568  else { dol->where = &(AM.dollarzero); dol->size = 0; }
2569  cbuf[AM.dbufnum].rhs[numdollar] = dol->where;
2570  cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
2571  cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
2572 
2573  return(numdollar);
2574 }
2575 
2576 /*
2577  #] AddDollar :
2578  #[ ReplaceDollar :
2579 
2580  Replacements of dollar variables can happen at any time.
2581  For debugging purposes we should have a tracing facility.
2582 
2583  Not in use????
2584 */
2585 
2586 int ReplaceDollar(WORD number, WORD newtype, WORD *newstart, LONG newsize)
2587 {
2588  int error = 0;
2589  DOLLARS dol = Dollars + number;
2590  WORD *s, *t;
2591  LONG i;
2592  dol->type = newtype;
2593  if ( dol->size == newsize && newsize > 0 && newstart ) {
2594  s = dol->where; t = newstart; i = newsize;
2595  while ( --i >= 0 ) { if ( *s++ != *t++ ) break; }
2596  if ( i < 0 ) return(0);
2597  }
2598  if ( dol->where && dol->where != &(dol->zero) ) {
2599  M_free(dol->where,"dollar->where"); dol->where = &(dol->zero); dol->size = 0;
2600  }
2601  if ( newstart && newsize > 0 ) {
2602  dol->size = newsize;
2603  dol->where =
2604  s = (WORD *)Malloc1((newsize+1)*sizeof(WORD),"$-variable contents");
2605  t = newstart; i = newsize;
2606  while ( --i >= 0 ) *s++ = *t++;
2607  *s = 0;
2608  }
2609  return(error);
2610 }
2611 
2612 /*
2613  #] ReplaceDollar :
2614  #[ AddDubious :
2615 
2616  This adds a variable of which we do not know the proper type.
2617 */
2618 
2619 int AddDubious(UBYTE *name)
2620 {
2621  int nodenum, numdubious = AC.DubiousList.num;
2622  DUBIOUSV dub = (DUBIOUSV)FromVarList(&AC.DubiousList);
2623  dub->name = AddName(AC.varnames,name,CDUBIOUS,numdubious,&nodenum);
2624  dub->node = nodenum;
2625  return(numdubious);
2626 }
2627 
2628 /*
2629  #] AddDubious :
2630  #[ MakeDubious :
2631 */
2632 
2633 int MakeDubious(NAMETREE *nametree, UBYTE *name, WORD *number)
2634 {
2635  NAMENODE *n;
2636  int node, newnode, i;
2637  if ( nametree->namenode == 0 ) return(-1);
2638  newnode = nametree->headnode;
2639  do {
2640  node = newnode;
2641  n = nametree->namenode+node;
2642  if ( ( i = StrCmp(name,nametree->namebuffer+n->name) ) < 0 )
2643  newnode = n->left;
2644  else if ( i > 0 ) newnode = n->right;
2645  else {
2646  if ( n->type != CDUBIOUS ) {
2647  int numdubious = AC.DubiousList.num;
2648  FUNCTIONS dub = (FUNCTIONS)FromVarList(&AC.DubiousList);
2649  dub->name = n->name;
2650  n->number = numdubious;
2651  }
2652  *number = n->number;
2653  return(CDUBIOUS);
2654  }
2655  } while ( newnode >= 0 );
2656  return(-1);
2657 }
2658 
2659 /*
2660  #] MakeDubious :
2661  #[ NameConflict :
2662 */
2663 
2664 static char *nametype[] = { "symbol", "index", "vector", "function",
2665  "set", "expression" };
2666 static char *plural[] = { "","n","","","","n" };
2667 
2668 int NameConflict(int type, UBYTE *name)
2669 {
2670  if ( type == NAMENOTFOUND ) {
2671  MesPrint("&%s has not been declared",name);
2672  }
2673  else if ( type != CDUBIOUS )
2674  MesPrint("&%s has been declared as a%s %s already"
2675  ,name,plural[type],nametype[type]);
2676  return(1);
2677 }
2678 
2679 /*
2680  #] NameConflict :
2681  #[ AddExpression :
2682 */
2683 
2684 int AddExpression(UBYTE *name, int x, int y)
2685 {
2686  int nodenum, numexpr = AC.ExpressionList.num;
2687  EXPRESSIONS expr = (EXPRESSIONS)FromVarList(&AC.ExpressionList);
2688  UBYTE *s;
2689  expr->status = x;
2690  expr->printflag = y;
2691  PUTZERO(expr->onfile);
2692  PUTZERO(expr->size);
2693  expr->renum = 0;
2694  expr->renumlists = 0;
2695  expr->hidelevel = 0;
2696  expr->inmem = 0;
2697  expr->bracketinfo = expr->newbracketinfo = 0;
2698  if ( name ) {
2699  expr->name = AddName(AC.exprnames,name,CEXPRESSION,numexpr,&nodenum);
2700  expr->node = nodenum;
2701  expr->replace = NEWLYDEFINEDEXPRESSION ;
2702  s = name;
2703  while ( *s ) s++;
2704  expr->namesize = (s-name)+1;
2705  }
2706  else {
2707  expr->replace = REDEFINEDEXPRESSION;
2708  expr->name = AC.TransEname;
2709  expr->node = -1;
2710  expr->namesize = 0;
2711  }
2712  expr->vflags = 0;
2713  expr->numdummies = 0;
2714  expr->numfactors = 0;
2715 #ifdef PARALLELCODE
2716  expr->partodo = 0;
2717 #endif
2718  return(numexpr);
2719 }
2720 
2721 /*
2722  #] AddExpression :
2723  #[ GetLabel :
2724 */
2725 
2726 int GetLabel(UBYTE *name)
2727 {
2728  int i;
2729  LONG newnum;
2730  UBYTE **NewLabelNames;
2731  int *NewLabel;
2732  for ( i = 0; i < AC.NumLabels; i++ ) {
2733  if ( StrCmp(name,AC.LabelNames[i]) == 0 ) return(i);
2734  }
2735  if ( AC.NumLabels >= AC.MaxLabels ) {
2736  newnum = 2*AC.MaxLabels;
2737  if ( newnum == 0 ) newnum = 10;
2738  if ( newnum > 32765 ) newnum = 32765;
2739  if ( newnum == AC.MaxLabels ) {
2740  MesPrint("&More than 32765 labels in one module. Please simplify.");
2741  Terminate(-1);
2742  }
2743  NewLabelNames = (UBYTE **)Malloc1((sizeof(UBYTE *)+sizeof(int))
2744  *newnum,"Labels");
2745  NewLabel = (int *)(NewLabelNames+newnum);
2746  for ( i = 0; i< AC.MaxLabels; i++ ) {
2747  NewLabelNames[i] = AC.LabelNames[i];
2748  NewLabel[i] = AC.Labels[i];
2749  }
2750  if ( AC.LabelNames ) M_free(AC.LabelNames,"Labels");
2751  AC.LabelNames = NewLabelNames;
2752  AC.Labels = NewLabel;
2753  AC.MaxLabels = newnum;
2754  }
2755  i = AC.NumLabels++;
2756  AC.LabelNames[i] = strDup1(name,"Labels");
2757  AC.Labels[i] = -1;
2758  return(i);
2759 }
2760 
2761 /*
2762  #] GetLabel :
2763  #[ ResetVariables :
2764 
2765  Resets the variables.
2766  par = 0 The list of temporary sets (after each .sort)
2767  par = 1 The list of local variables (after each .store)
2768  par = 2 All variables (after each .clear)
2769 */
2770 
2771 void ResetVariables(int par)
2772 {
2773  int i, j;
2774  TABLES T;
2775  switch ( par ) {
2776  case 0 : /* Only the sets without a name */
2777  AC.SetList.num = AC.SetList.numtemp;
2778  AC.SetElementList.num = AC.SetElementList.numtemp;
2779  break;
2780  case 2 :
2781  for ( i = AC.SymbolList.numclear; i < AC.SymbolList.num; i++ )
2782  AC.varnames->namenode[symbols[i].node].type = CDELETE;
2783  AC.SymbolList.num = AC.SymbolList.numglobal = AC.SymbolList.numclear;
2784  for ( i = AC.VectorList.numclear; i < AC.VectorList.num; i++ )
2785  AC.varnames->namenode[vectors[i].node].type = CDELETE;
2786  AC.VectorList.num = AC.VectorList.numglobal = AC.VectorList.numclear;
2787  for ( i = AC.IndexList.numclear; i < AC.IndexList.num; i++ )
2788  AC.varnames->namenode[indices[i].node].type = CDELETE;
2789  AC.IndexList.num = AC.IndexList.numglobal = AC.IndexList.numclear;
2790  for ( i = AC.FunctionList.numclear; i < AC.FunctionList.num; i++ ) {
2791  AC.varnames->namenode[functions[i].node].type = CDELETE;
2792  if ( ( T = functions[i].tabl ) != 0 ) {
2793  if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
2794  if ( T->prototype ) M_free(T->prototype,"tableprototype");
2795  if ( T->mm ) M_free(T->mm,"tableminmax");
2796  if ( T->flags ) M_free(T->flags,"tableflags");
2797  if ( T->argtail ) M_free(T->argtail,"table arguments");
2798  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
2799  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
2800  finishcbuf(T->buffers[j]);
2801  }
2802  /*[07apr2004 mt]:*/ /*memory leak*/
2803  if ( T->buffers ) M_free(T->buffers,"Table buffers");
2804  /*:[07apr2004 mt]*/
2805  finishcbuf(T->bufnum);
2806  if ( T->spare ) {
2807  TABLES TT = T->spare;
2808  if ( TT->mm ) M_free(TT->mm,"tableminmax");
2809  if ( TT->flags ) M_free(TT->flags,"tableflags");
2810  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2811  for (j = 0; j < TT->buffersfill; j++ ) { /* was <= */
2812  finishcbuf(TT->buffers[j]);
2813  }
2814  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
2815  /*[07apr2004 mt]:*/ /*memory leak*/
2816  if ( TT->buffers )M_free(TT->buffers,"Table buffers");
2817  /*:[07apr2004 mt]*/
2818  M_free(TT,"table");
2819  }
2820  M_free(T,"table");
2821  }
2822  }
2823  AC.FunctionList.num = AC.FunctionList.numglobal = AC.FunctionList.numclear;
2824  for ( i = AC.SetList.numclear; i < AC.SetList.num; i++ ) {
2825  if ( Sets[i].node >= 0 )
2826  AC.varnames->namenode[Sets[i].node].type = CDELETE;
2827  }
2828  AC.SetList.numtemp = AC.SetList.num = AC.SetList.numglobal = AC.SetList.numclear;
2829  for ( i = AC.DubiousList.numclear; i < AC.DubiousList.num; i++ )
2830  AC.varnames->namenode[Dubious[i].node].type = CDELETE;
2831  AC.DubiousList.num = AC.DubiousList.numglobal = AC.DubiousList.numclear;
2832  AC.SetElementList.numtemp = AC.SetElementList.num =
2833  AC.SetElementList.numglobal = AC.SetElementList.numclear;
2834  CompactifyTree(AC.varnames,VARNAMES);
2835  AC.varnames->namefill = AC.varnames->globalnamefill = AC.varnames->clearnamefill;
2836  AC.varnames->nodefill = AC.varnames->globalnodefill = AC.varnames->clearnodefill;
2837 
2838  for ( i = AC.AutoSymbolList.numclear; i < AC.AutoSymbolList.num; i++ )
2839  AC.autonames->namenode[
2840  ((SYMBOLS)(AC.AutoSymbolList.lijst))[i].node].type = CDELETE;
2841  AC.AutoSymbolList.num = AC.AutoSymbolList.numglobal
2842  = AC.AutoSymbolList.numclear;
2843  for ( i = AC.AutoVectorList.numclear; i < AC.AutoVectorList.num; i++ )
2844  AC.autonames->namenode[
2845  ((VECTORS)(AC.AutoVectorList.lijst))[i].node].type = CDELETE;
2846  AC.AutoVectorList.num = AC.AutoVectorList.numglobal
2847  = AC.AutoVectorList.numclear;
2848  for ( i = AC.AutoIndexList.numclear; i < AC.AutoIndexList.num; i++ )
2849  AC.autonames->namenode[
2850  ((INDICES)(AC.AutoIndexList.lijst))[i].node].type = CDELETE;
2851  AC.AutoIndexList.num = AC.AutoIndexList.numglobal
2852  = AC.AutoIndexList.numclear;
2853  for ( i = AC.AutoFunctionList.numclear; i < AC.AutoFunctionList.num; i++ ) {
2854  AC.autonames->namenode[
2855  ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].node].type = CDELETE;
2856  if ( ( T = ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl ) != 0 ) {
2857  if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
2858  if ( T->prototype ) M_free(T->prototype,"tableprototype");
2859  if ( T->mm ) M_free(T->mm,"tableminmax");
2860  if ( T->flags ) M_free(T->flags,"tableflags");
2861  if ( T->argtail ) M_free(T->argtail,"table arguments");
2862  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
2863  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
2864  finishcbuf(T->buffers[j]);
2865  }
2866  if ( T->spare ) {
2867  TABLES TT = T->spare;
2868  if ( TT->mm ) M_free(TT->mm,"tableminmax");
2869  if ( TT->flags ) M_free(TT->flags,"tableflags");
2870  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2871  for (j = 0; j < TT->buffersfill; j++ ) { /* was <= */
2872  finishcbuf(TT->buffers[j]);
2873  }
2874  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
2875  M_free(TT,"table");
2876  }
2877  M_free(T,"table");
2878  }
2879  }
2880  AC.AutoFunctionList.num = AC.AutoFunctionList.numglobal
2881  = AC.AutoFunctionList.numclear;
2882  CompactifyTree(AC.autonames,AUTONAMES);
2883  AC.autonames->namefill = AC.autonames->globalnamefill
2884  = AC.autonames->clearnamefill;
2885  AC.autonames->nodefill = AC.autonames->globalnodefill
2886  = AC.autonames->clearnodefill;
2887  ReleaseTB();
2888  break;
2889  case 1 :
2890  for ( i = AC.SymbolList.numglobal; i < AC.SymbolList.num; i++ )
2891  AC.varnames->namenode[symbols[i].node].type = CDELETE;
2892  AC.SymbolList.num = AC.SymbolList.numglobal;
2893  for ( i = AC.VectorList.numglobal; i < AC.VectorList.num; i++ )
2894  AC.varnames->namenode[vectors[i].node].type = CDELETE;
2895  AC.VectorList.num = AC.VectorList.numglobal;
2896  for ( i = AC.IndexList.numglobal; i < AC.IndexList.num; i++ )
2897  AC.varnames->namenode[indices[i].node].type = CDELETE;
2898  AC.IndexList.num = AC.IndexList.numglobal;
2899  for ( i = AC.FunctionList.numglobal; i < AC.FunctionList.num; i++ ) {
2900  AC.varnames->namenode[functions[i].node].type = CDELETE;
2901  if ( ( T = functions[i].tabl ) != 0 ) {
2902  if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
2903  if ( T->prototype ) M_free(T->prototype,"tableprototype");
2904  if ( T->mm ) M_free(T->mm,"tableminmax");
2905  if ( T->flags ) M_free(T->flags,"tableflags");
2906  if ( T->argtail ) M_free(T->argtail,"table arguments");
2907  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
2908  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
2909  finishcbuf(T->buffers[j]);
2910  }
2911  /*[07apr2004 mt]:*/ /*memory leak*/
2912  if ( T->buffers ) M_free(T->buffers,"Table buffers");
2913  /*:[07apr2004 mt]*/
2914  finishcbuf(T->bufnum);
2915  if ( T->spare ) {
2916  TABLES TT = T->spare;
2917  if ( TT->mm ) M_free(TT->mm,"tableminmax");
2918  if ( TT->flags ) M_free(TT->flags,"tableflags");
2919  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2920  for (j = 0; j < TT->buffersfill; j++ ) { /* was <= */
2921  finishcbuf(TT->buffers[j]);
2922  }
2923  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
2924  /*[07apr2004 mt]:*/ /*memory leak*/
2925  if ( TT->buffers ) M_free(TT->buffers,"Table buffers");
2926  /*:[07apr2004 mt]*/
2927  M_free(TT,"table");
2928  }
2929  M_free(T,"table");
2930  }
2931  }
2932 #ifdef TABLECLEANUP
2933  {
2934  int j;
2935  WORD *tp;
2936  for ( i = 0; i < AC.FunctionList.numglobal; i++ ) {
2937 /*
2938  Now, if the table definition is from after the .global
2939  while the function is from before, there is a problem.
2940  This could be resolved by defining CTable (=Table), Ntable
2941  and do away with the previous function definition.
2942 */
2943  if ( ( T = functions[i].tabl ) != 0 ) {
2944 /*
2945  First restore overwritten definitions.
2946 */
2947  if ( T->sparse ) {
2948  T->totind = T->mdefined;
2949  for ( j = 0, tp = T->tablepointers; j < T->totind; j++ ) {
2950  tp += T->numind;
2951 #if TABLEEXTENSION == 2
2952  tp[0] = tp[1];
2953 #else
2954  tp[0] = tp[2];
2955  tp[1] = tp[3];
2956  tp[4] = tp[5];
2957 #endif
2958  tp += TABLEEXTENSION;
2959  }
2960  RedoTableTree(T,T->totind);
2961  if ( T->spare ) {
2962  TABLES TT = T->spare;
2963  TT->totind = TT->mdefined;
2964  for ( j = 0, tp = TT->tablepointers; j < TT->totind; j++ ) {
2965  tp += TT->numind;
2966 #if TABLEEXTENSION == 2
2967  tp[0] = tp[1];
2968 #else
2969  tp[0] = tp[2];
2970  tp[1] = tp[3];
2971  tp[4] = tp[5];
2972 #endif
2973  tp += TABLEEXTENSION;
2974  }
2975  RedoTableTree(TT,TT->totind);
2976  cbuf[TT->bufnum].numlhs = cbuf[TT->bufnum].mnumlhs;
2977  cbuf[TT->bufnum].numrhs = cbuf[TT->bufnum].mnumrhs;
2978  }
2979  }
2980  else {
2981  for ( j = 0, tp = T->tablepointers; j < T->totind; j++ ) {
2982 #if TABLEEXTENSION == 2
2983  tp[0] = tp[1];
2984 #else
2985  tp[0] = tp[2];
2986  tp[1] = tp[3];
2987  tp[4] = tp[5];
2988 #endif
2989  }
2990  T->defined = T->mdefined;
2991  }
2992  cbuf[T->bufnum].numlhs = cbuf[T->bufnum].mnumlhs;
2993  cbuf[T->bufnum].numrhs = cbuf[T->bufnum].mnumrhs;
2994  }
2995  }
2996  }
2997 #endif
2998  AC.FunctionList.num = AC.FunctionList.numglobal;
2999  for ( i = AC.SetList.numglobal; i < AC.SetList.num; i++ ) {
3000  if ( Sets[i].node >= 0 )
3001  AC.varnames->namenode[Sets[i].node].type = CDELETE;
3002  }
3003  AC.SetList.numtemp = AC.SetList.num = AC.SetList.numglobal;
3004  for ( i = AC.DubiousList.numglobal; i < AC.DubiousList.num; i++ )
3005  AC.varnames->namenode[Dubious[i].node].type = CDELETE;
3006  AC.DubiousList.num = AC.DubiousList.numglobal;
3007  AC.SetElementList.numtemp = AC.SetElementList.num =
3008  AC.SetElementList.numglobal;
3009  CompactifyTree(AC.varnames,VARNAMES);
3010  AC.varnames->namefill = AC.varnames->globalnamefill;
3011  AC.varnames->nodefill = AC.varnames->globalnodefill;
3012 
3013  for ( i = AC.AutoSymbolList.numglobal; i < AC.AutoSymbolList.num; i++ )
3014  AC.autonames->namenode[
3015  ((SYMBOLS)(AC.AutoSymbolList.lijst))[i].node].type = CDELETE;
3016  AC.AutoSymbolList.num = AC.AutoSymbolList.numglobal;
3017  for ( i = AC.AutoVectorList.numglobal; i < AC.AutoVectorList.num; i++ )
3018  AC.autonames->namenode[
3019  ((VECTORS)(AC.AutoVectorList.lijst))[i].node].type = CDELETE;
3020  AC.AutoVectorList.num = AC.AutoVectorList.numglobal;
3021  for ( i = AC.AutoIndexList.numglobal; i < AC.AutoIndexList.num; i++ )
3022  AC.autonames->namenode[
3023  ((INDICES)(AC.AutoIndexList.lijst))[i].node].type = CDELETE;
3024  AC.AutoIndexList.num = AC.AutoIndexList.numglobal;
3025  for ( i = AC.AutoFunctionList.numglobal; i < AC.AutoFunctionList.num; i++ ) {
3026  AC.autonames->namenode[
3027  ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].node].type = CDELETE;
3028  if ( ( T = ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl ) != 0 ) {
3029  if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
3030  if ( T->prototype ) M_free(T->prototype,"tableprototype");
3031  if ( T->mm ) M_free(T->mm,"tableminmax");
3032  if ( T->flags ) M_free(T->flags,"tableflags");
3033  if ( T->argtail ) M_free(T->argtail,"table arguments");
3034  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
3035  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
3036  finishcbuf(T->buffers[j]);
3037  }
3038  if ( T->spare ) {
3039  TABLES TT = T->spare;
3040  if ( TT->mm ) M_free(TT->mm,"tableminmax");
3041  if ( TT->flags ) M_free(TT->flags,"tableflags");
3042  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
3043  for (j = 0; j < TT->buffersfill; j++ ) { /* was <= */
3044  finishcbuf(TT->buffers[j]);
3045  }
3046  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
3047  M_free(TT,"table");
3048  }
3049  M_free(T,"table");
3050  }
3051  }
3052  AC.AutoFunctionList.num = AC.AutoFunctionList.numglobal;
3053 
3054  CompactifyTree(AC.autonames,AUTONAMES);
3055 
3056  AC.autonames->namefill = AC.autonames->globalnamefill;
3057  AC.autonames->nodefill = AC.autonames->globalnodefill;
3058  break;
3059  }
3060 }
3061 
3062 /*
3063  #] ResetVariables :
3064  #[ RemoveDollars :
3065 */
3066 
3067 void RemoveDollars()
3068 {
3069  DOLLARS d;
3070  CBUF *C = cbuf + AM.dbufnum;
3071  int numdollar = AP.DollarList.num;
3072  if ( numdollar > 0 ) {
3073  while ( numdollar > AM.gcNumDollars ) {
3074  numdollar--;
3075  d = Dollars + numdollar;
3076  if ( d->where && d->where != &(d->zero) && d->where != &(AM.dollarzero) ) {
3077  M_free(d->where,"dollar->where"); d->where = &(d->zero); d->size = 0;
3078  }
3079  AC.dollarnames->namenode[d->node].type = CDELETE;
3080  }
3081  AP.DollarList.num = AM.gcNumDollars;
3082  CompactifyTree(AC.dollarnames,DOLLARNAMES);
3083 
3084  C->numrhs = C->mnumrhs;
3085  C->numlhs = C->mnumlhs;
3086  }
3087 }
3088 
3089 /*
3090  #] RemoveDollars :
3091  #[ Globalize :
3092 */
3093 
3094 void Globalize(int par)
3095 {
3096  int i, j;
3097  WORD *tp;
3098  if ( par == 1 ) {
3099  AC.SymbolList.numclear = AC.SymbolList.num;
3100  AC.VectorList.numclear = AC.VectorList.num;
3101  AC.IndexList.numclear = AC.IndexList.num;
3102  AC.FunctionList.numclear = AC.FunctionList.num;
3103  AC.SetList.numclear = AC.SetList.num;
3104  AC.DubiousList.numclear = AC.DubiousList.num;
3105  AC.SetElementList.numclear = AC.SetElementList.num;
3106  AC.varnames->clearnamefill = AC.varnames->namefill;
3107  AC.varnames->clearnodefill = AC.varnames->nodefill;
3108 
3109  AC.AutoSymbolList.numclear = AC.AutoSymbolList.num;
3110  AC.AutoVectorList.numclear = AC.AutoVectorList.num;
3111  AC.AutoIndexList.numclear = AC.AutoIndexList.num;
3112  AC.AutoFunctionList.numclear = AC.AutoFunctionList.num;
3113  AC.autonames->clearnamefill = AC.autonames->namefill;
3114  AC.autonames->clearnodefill = AC.autonames->nodefill;
3115  }
3116 /* for ( i = AC.FunctionList.numglobal; i < AC.FunctionList.num; i++ ) { */
3117  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
3118 /*
3119  We need here not only the not-yet-global functions. The already
3120  global ones may have obtained extra elements.
3121 */
3122  if ( functions[i].tabl ) {
3123  TABLES T = functions[i].tabl;
3124  if ( T->sparse ) {
3125  T->mdefined = T->totind;
3126  for ( j = 0, tp = T->tablepointers; j < T->totind; j++ ) {
3127  tp += T->numind;
3128 #if TABLEEXTENSION == 2
3129  tp[1] = tp[0];
3130 #else
3131  tp[2] = tp[0]; tp[3] = tp[1]; tp[5] = tp[4] & (~ELEMENTUSED);
3132 #endif
3133  tp += TABLEEXTENSION;
3134  }
3135  if ( T->spare ) {
3136  TABLES TT = T->spare;
3137  TT->mdefined = TT->totind;
3138  for ( j = 0, tp = TT->tablepointers; j < TT->totind; j++ ) {
3139  tp += TT->numind;
3140 #if TABLEEXTENSION == 2
3141  tp[1] = tp[0];
3142 #else
3143  tp[2] = tp[0]; tp[3] = tp[1]; tp[5] = tp[4] & (~ELEMENTUSED);
3144 #endif
3145  tp += TABLEEXTENSION;
3146  }
3147  cbuf[TT->bufnum].mnumlhs = cbuf[TT->bufnum].numlhs;
3148  cbuf[TT->bufnum].mnumrhs = cbuf[TT->bufnum].numrhs;
3149  }
3150  }
3151  else {
3152  T->mdefined = T->defined;
3153  for ( j = 0, tp = T->tablepointers; j < T->totind; j++ ) {
3154 #if TABLEEXTENSION == 2
3155  tp[1] = tp[0];
3156 #else
3157  tp[2] = tp[0]; tp[3] = tp[1]; tp[5] = tp[4] & (~ELEMENTUSED);
3158 #endif
3159  }
3160  }
3161  cbuf[T->bufnum].mnumlhs = cbuf[T->bufnum].numlhs;
3162  cbuf[T->bufnum].mnumrhs = cbuf[T->bufnum].numrhs;
3163  }
3164  }
3165  for ( i = AC.AutoFunctionList.numglobal; i < AC.AutoFunctionList.num; i++ ) {
3166  if ( ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl )
3167  ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl->mdefined =
3168  ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl->defined;
3169  }
3170  AC.SymbolList.numglobal = AC.SymbolList.num;
3171  AC.VectorList.numglobal = AC.VectorList.num;
3172  AC.IndexList.numglobal = AC.IndexList.num;
3173  AC.FunctionList.numglobal = AC.FunctionList.num;
3174  AC.SetList.numglobal = AC.SetList.num;
3175  AC.DubiousList.numglobal = AC.DubiousList.num;
3176  AC.SetElementList.numglobal = AC.SetElementList.num;
3177  AC.varnames->globalnamefill = AC.varnames->namefill;
3178  AC.varnames->globalnodefill = AC.varnames->nodefill;
3179 
3180  AC.AutoSymbolList.numglobal = AC.AutoSymbolList.num;
3181  AC.AutoVectorList.numglobal = AC.AutoVectorList.num;
3182  AC.AutoIndexList.numglobal = AC.AutoIndexList.num;
3183  AC.AutoFunctionList.numglobal = AC.AutoFunctionList.num;
3184  AC.autonames->globalnamefill = AC.autonames->namefill;
3185  AC.autonames->globalnodefill = AC.autonames->nodefill;
3186 }
3187 
3188 /*
3189  #] Globalize :
3190  #[ TestName :
3191 */
3192 
3193 int TestName(UBYTE *name)
3194 {
3195  if ( *name == '[' ) {
3196  while ( *name ) name++;
3197  if ( name[-1] == ']' ) return(0);
3198  return(-1);
3199  }
3200  while ( *name ) {
3201  if ( *name == '_' ) return(-1);
3202  name++;
3203  }
3204  return(0);
3205 }
3206 
3207 /*
3208  #] TestName :
3209 */
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
int parent
Definition: structs.h:294
Definition: structs.h:443
WORD flags
Definition: structs.h:482
int prototypeSize
Definition: structs.h:369
int right
Definition: structs.h:296
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 left
Definition: structs.h:295
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:4552
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:4727
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
Definition: structs.h:204
WORD NewSort(PHEAD0)
Definition: sort.c:592
WORD Generator(PHEAD WORD *, WORD)
Definition: proces.c:3101
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:682
struct TaBlEs * TABLES
WORD commute
Definition: structs.h:479
WORD * AddRHS(int num, int type)
Definition: comtool.c:214