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