FORM  4.1
names.c
Go to the documentation of this file.
1 
9 /* #[ License : */
10 /*
11  * Copyright (C) 1984-2013 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->node = nodenum;
833  sym->dimension= dim;
834  while ( *s ) s++;
835  sym->namesize = (s-name)+1;
836  return(numsymbol);
837 }
838 
839 /*
840  #] AddSymbol :
841  #[ CoSymbol :
842 
843  Symbol declarations. name[#{R|I|C}][([min]:[max])]
844  Note that we know already that the parentheses match properly
845 */
846 
847 int CoSymbol(UBYTE *s)
848 {
849  int type, error = 0, minpow, maxpow, cplx, sgn, dim;
850  WORD numsymbol;
851  UBYTE *name, *oldc, c, cc;
852  do {
853  minpow = -MAXPOWER;
854  maxpow = MAXPOWER;
855  cplx = 0;
856  dim = 0;
857  name = s;
858  if ( ( s = SkipAName(s) ) == 0 ) {
859 IllForm: MesPrint("&Illegally formed name in symbol statement");
860  error = 1;
861  s = SkipField(name,0);
862  goto eol;
863  }
864  oldc = s; cc = c = *s; *s = 0;
865  if ( TestName(name) ) { *s = c; goto IllForm; }
866  if ( cc == '#' ) {
867  s++;
868  if ( tolower(*s) == 'r' ) cplx = VARTYPENONE;
869  else if ( tolower(*s) == 'c' ) cplx = VARTYPECOMPLEX;
870  else if ( tolower(*s) == 'i' ) cplx = VARTYPEIMAGINARY;
871  else if ( ( ( *s == '-' || *s == '+' ) && ( s[1] >= '0' && s[1] <= '9' ) )
872  || ( *s >= '0' && *s <= '9' ) ) {
873  LONG x;
874  sgn = 0;
875  if ( *s == '-' ) { sgn = VARTYPEMINUS; s++; }
876  else if ( *s == '+' ) { sgn = 0; s++; }
877  x = *s -'0';
878  while ( s[1] >= '0' && s[1] <= '9' ) {
879  x = 10*x + (s[1] - '0'); s++;
880  }
881  if ( x >= MAXPOWER || x <= 1 ) {
882  MesPrint("&Illegal value for root of unity %s",name);
883  error = 1;
884  }
885  else {
886  maxpow = x;
887  }
888  cplx = VARTYPEROOTOFUNITY | sgn;
889  }
890  else {
891  MesPrint("&Illegal specification for complexity of symbol %s",name);
892  *oldc = c;
893  error = 1;
894  s = SkipField(s,0);
895  goto eol;
896  }
897  s++; cc = *s;
898  }
899  if ( cc == '{' ) {
900  s++;
901  if ( ( *s == 'd' || *s == 'D' ) && s[1] == '=' ) {
902  s += 2;
903  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
904  ParseSignedNumber(dim,s)
905  if ( dim < -HALFMAX || dim > HALFMAX ) {
906  MesPrint("&Warning: dimension of %s (%d) out of range"
907  ,name,dim);
908  }
909  }
910  if ( *s != '}' ) goto IllDim;
911  else s++;
912  }
913  else {
914 IllDim: MesPrint("&Error: Illegal dimension field for variable %s",name);
915  error = 1;
916  s = SkipField(s,0);
917  goto eol;
918  }
919  cc = *s;
920  }
921  if ( cc == '(' ) {
922  if ( ( cplx & VARTYPEROOTOFUNITY ) == VARTYPEROOTOFUNITY ) {
923  MesPrint("&Root of unity property for %s cannot be combined with power restrictions",name);
924  error = 1;
925  }
926  s++;
927  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
928  ParseSignedNumber(minpow,s)
929  if ( minpow < -MAXPOWER ) {
930  minpow = -MAXPOWER;
931  if ( AC.WarnFlag )
932  MesPrint("&Warning: minimum power of %s corrected to %d"
933  ,name,-MAXPOWER);
934  }
935  }
936  if ( *s != ':' ) {
937 skippar: error = 1;
938  s = SkipField(s,1);
939  goto eol;
940  }
941  else s++;
942  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
943  ParseSignedNumber(maxpow,s)
944  if ( maxpow > MAXPOWER ) {
945  maxpow = MAXPOWER;
946  if ( AC.WarnFlag )
947  MesPrint("&Warning: maximum power of %s corrected to %d"
948  ,name,MAXPOWER);
949  }
950  }
951  if ( *s != ')' ) goto skippar;
952  s++;
953  }
954  if ( ( AC.AutoDeclareFlag == 0 &&
955  ( ( type = GetName(AC.exprnames,name,&numsymbol,NOAUTO) )
956  != NAMENOTFOUND ) )
957  || ( ( type = GetName(*(AC.activenames),name,&numsymbol,NOAUTO) ) != NAMENOTFOUND ) ) {
958  if ( type != CSYMBOL ) error = NameConflict(type,name);
959  else {
960  SYMBOLS sym = (SYMBOLS)(AC.Symbols->lijst) + numsymbol;
961  sym->complex = cplx;
962  sym->minpower = minpow;
963  sym->maxpower = maxpow;
964  sym->dimension= dim;
965  }
966  }
967  else {
968  AddSymbol(name,minpow,maxpow,cplx,dim);
969  }
970  *oldc = c;
971 eol: while ( *s == ',' ) s++;
972  } while ( *s );
973  return(error);
974 }
975 
976 /*
977  #] CoSymbol :
978  #[ AddIndex :
979 
980  The actual addition. Special routine for additions 'on the fly'
981 */
982 
983 int AddIndex(UBYTE *name, int dim, int dim4)
984 {
985  int nodenum, numindex = AC.Indices->num;
986  INDICES ind = (INDICES)FromVarList(AC.Indices);
987  UBYTE *s = name;
988  bzero(ind,sizeof(struct InDeX));
989  ind->name = AddName(*AC.activenames,name,CINDEX,numindex,&nodenum);
990  ind->type = 0;
991  ind->dimension = dim;
992  ind->nmin4 = dim4;
993  ind->node = nodenum;
994  while ( *s ) s++;
995  ind->namesize = (s-name)+1;
996  return(numindex);
997 }
998 
999 /*
1000  #] AddIndex :
1001  #[ CoIndex :
1002 
1003  Index declarations. name[={number|symbol[:othersymbol]}]
1004 */
1005 
1006 int CoIndex(UBYTE *s)
1007 {
1008  int type, error = 0, dim, dim4;
1009  WORD numindex;
1010  UBYTE *name, *oldc, c;
1011  do {
1012  dim = AC.lDefDim;
1013  dim4 = AC.lDefDim4;
1014  name = s;
1015  if ( ( s = SkipAName(s) ) == 0 ) {
1016 IllForm: MesPrint("&Illegally formed name in index statement");
1017  error = 1;
1018  s = SkipField(name,0);
1019  goto eol;
1020  }
1021  oldc = s; c = *s; *s = 0;
1022  if ( TestName(name) ) { *s = c; goto IllForm; }
1023  if ( c == '=' ) {
1024  s++;
1025  if ( ( s = DoDimension(s,&dim,&dim4) ) == 0 ) {
1026  *oldc = c;
1027  error = 1;
1028  s = SkipField(name,0);
1029  goto eol;
1030  }
1031  }
1032  if ( ( AC.AutoDeclareFlag == 0 &&
1033  ( ( type = GetName(AC.exprnames,name,&numindex,NOAUTO) )
1034  != NAMENOTFOUND ) )
1035  || ( ( type = GetName(*(AC.activenames),name,&numindex,NOAUTO) ) != NAMENOTFOUND ) ) {
1036  if ( type != CINDEX ) error = NameConflict(type,name);
1037  else { /* reset the dimensions */
1038  indices[numindex].dimension = dim;
1039  indices[numindex].nmin4 = dim4;
1040  }
1041  }
1042  else AddIndex(name,dim,dim4);
1043  *oldc = c;
1044 eol: while ( *s == ',' ) s++;
1045  } while ( *s );
1046  return(error);
1047 }
1048 
1049 /*
1050  #] CoIndex :
1051  #[ DoDimension :
1052 */
1053 
1054 UBYTE *DoDimension(UBYTE *s, int *dim, int *dim4)
1055 {
1056  UBYTE c, *t = s;
1057  int type, error = 0;
1058  WORD numsymbol;
1059  NAMETREE **oldtree = AC.activenames;
1060  *dim4 = -NMIN4SHIFT;
1061  if ( FG.cTable[*s] == 1 ) {
1062 retry:
1063  ParseNumber(*dim,s)
1064 #if ( BITSINWORD/8 < 4 )
1065  if ( *dim >= (1 << (BITSINWORD-1)) ) goto illeg;
1066 #endif
1067  *dim4 = *dim - 4;
1068  return(s);
1069  }
1070  else if ( ( (FG.cTable[*s] == 0 ) || ( *s == '[' ) )
1071  && ( s = SkipAName(s) ) != 0 ) {
1072  AC.activenames = &(AC.varnames);
1073  c = *s; *s = 0;
1074  if ( ( ( type = GetName(AC.exprnames,t,&numsymbol,NOAUTO) ) != NAMENOTFOUND )
1075  || ( ( type = GetName(AC.varnames,t,&numsymbol,WITHAUTO) ) != NAMENOTFOUND ) ) {
1076  if ( type != CSYMBOL ) error = NameConflict(type,t);
1077  }
1078  else {
1079  numsymbol = AddSymbol(t,-MAXPOWER,MAXPOWER,0,0);
1080  if ( *oldtree != AC.autonames && AC.WarnFlag )
1081  MesPrint("&Warning: Implicit declaration of %s as a symbol",t);
1082  }
1083  *dim = -numsymbol;
1084  if ( ( *s = c ) == ':' ) {
1085  s++;
1086  t = s;
1087  if ( ( s = SkipAName(s) ) == 0 ) goto illeg;
1088  if ( ( ( type = GetName(AC.exprnames,t,&numsymbol,NOAUTO) ) != NAMENOTFOUND )
1089  || ( ( type = GetName(AC.varnames,t,&numsymbol,WITHAUTO) ) != NAMENOTFOUND ) ) {
1090  if ( type != CSYMBOL ) error = NameConflict(type,t);
1091  }
1092  else {
1093  numsymbol = AddSymbol(t,-MAXPOWER,MAXPOWER,0,0);
1094  if ( *oldtree != AC.autonames && AC.WarnFlag )
1095  MesPrint("&Warning: Implicit declaration of %s as a symbol",t);
1096  }
1097  *dim4 = -numsymbol-NMIN4SHIFT;
1098  }
1099  }
1100  else if ( *s == '+' && FG.cTable[s[1]] == 1 ) {
1101  s++; goto retry;
1102  }
1103  else {
1104 illeg: MesPrint("&Illegal dimension specification. Should be number >= 0, symbol or symbol:symbol");
1105  return(0);
1106  }
1107  AC.activenames = oldtree;
1108  if ( error ) return(0);
1109  return(s);
1110 }
1111 
1112 /*
1113  #] DoDimension :
1114  #[ CoDimension :
1115 */
1116 
1117 int CoDimension(UBYTE *s)
1118 {
1119  s = DoDimension(s,&AC.lDefDim,&AC.lDefDim4);
1120  if ( s == 0 ) return(1);
1121  if ( *s != 0 ) {
1122  MesPrint("&Argument of dimension statement should be number >= 0, symbol or symbol:symbol");
1123  return(1);
1124  }
1125  return(0);
1126 }
1127 
1128 /*
1129  #] CoDimension :
1130  #[ AddVector :
1131 
1132  The actual addition. Special routine for additions 'on the fly'
1133 */
1134 
1135 int AddVector(UBYTE *name, int cplx, int dim)
1136 {
1137  int nodenum, numvector = AC.Vectors->num;
1138  VECTORS v = (VECTORS)FromVarList(AC.Vectors);
1139  UBYTE *s = name;
1140  bzero(v,sizeof(struct VeCtOr));
1141  v->name = AddName(*AC.activenames,name,CVECTOR,numvector,&nodenum);
1142  v->complex = cplx;
1143  v->node = nodenum;
1144  v->dimension = dim;
1145  while ( *s ) s++;
1146  v->namesize = (s-name)+1;
1147  return(numvector);
1148 }
1149 
1150 /*
1151  #] AddVector :
1152  #[ CoVector :
1153 
1154  Vector declarations. The descriptor string is "(,%n)"
1155 */
1156 
1157 int CoVector(UBYTE *s)
1158 {
1159  int type, error = 0, dim;
1160  WORD numvector;
1161  UBYTE *name, c, *endname;
1162  do {
1163  name = s;
1164  dim = 0;
1165  if ( ( s = SkipAName(s) ) == 0 ) {
1166 IllForm: MesPrint("&Illegally formed name in vector statement");
1167  error = 1;
1168  s = SkipField(s,0);
1169  }
1170  else {
1171  c = *s; *s = 0, endname = s;
1172  if ( TestName(name) ) { *s = c; goto IllForm; }
1173  if ( c == '{' ) {
1174  s++;
1175  if ( ( *s == 'd' || *s == 'D' ) && s[1] == '=' ) {
1176  s += 2;
1177  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
1178  ParseSignedNumber(dim,s)
1179  if ( dim < -HALFMAX || dim > HALFMAX ) {
1180  MesPrint("&Warning: dimension of %s (%d) out of range"
1181  ,name,dim);
1182  }
1183  }
1184  if ( *s != '}' ) goto IllDim;
1185  else s++;
1186  }
1187  else {
1188 IllDim: MesPrint("&Error: Illegal dimension field for variable %s",name);
1189  error = 1;
1190  s = SkipField(s,0);
1191  while ( *s == ',' ) s++;
1192  continue;
1193  }
1194  }
1195  if ( ( AC.AutoDeclareFlag == 0 &&
1196  ( ( type = GetName(AC.exprnames,name,&numvector,NOAUTO) )
1197  != NAMENOTFOUND ) )
1198  || ( ( type = GetName(*(AC.activenames),name,&numvector,NOAUTO) ) != NAMENOTFOUND ) ) {
1199  if ( type != CVECTOR ) error = NameConflict(type,name);
1200  }
1201  else AddVector(name,0,dim);
1202  *endname = c;
1203  }
1204  while ( *s == ',' ) s++;
1205  } while ( *s );
1206  return(error);
1207 }
1208 
1209 /*
1210  #] CoVector :
1211  #[ AddFunction :
1212 
1213  The actual addition. Special routine for additions 'on the fly'
1214 */
1215 
1216 int AddFunction(UBYTE *name, int comm, int istensor, int cplx, int symprop, int dim, int argmax, int argmin)
1217 {
1218  int nodenum, numfunction = AC.Functions->num;
1219  FUNCTIONS fun = (FUNCTIONS)FromVarList(AC.Functions);
1220  UBYTE *s = name;
1221  bzero(fun,sizeof(struct FuNcTiOn));
1222  fun->name = AddName(*AC.activenames,name,CFUNCTION,numfunction,&nodenum);
1223  fun->commute = comm;
1224  fun->spec = istensor;
1225  fun->complex = cplx;
1226  fun->tabl = 0;
1227  fun->node = nodenum;
1228  fun->symminfo = 0;
1229  fun->symmetric = symprop;
1230  fun->dimension = dim;
1231  fun->maxnumargs = argmax;
1232  fun->minnumargs = argmin;
1233  while ( *s ) s++;
1234  fun->namesize = (s-name)+1;
1235  return(numfunction);
1236 }
1237 
1238 /*
1239  #] AddFunction :
1240  #[ CoFunction + ...:
1241 
1242  Function declarations.
1243  The second parameter indicates commutation properties.
1244  The third parameter tells whether we have a tensor.
1245 */
1246 
1247 int CoFunction(UBYTE *s, int comm, int istensor)
1248 {
1249  int type, error = 0, cplx, symtype, dim, argmax, argmin;
1250  WORD numfunction, reverseorder = 0, addone;
1251  UBYTE *name, *oldc, *par, c, cc;
1252  do {
1253  symtype = cplx = 0, argmin = argmax = -1;
1254  dim = 0;
1255  name = s;
1256  if ( ( s = SkipAName(s) ) == 0 ) {
1257 IllForm: MesPrint("&Illegally formed function/tensor name");
1258  error = 1;
1259  s = SkipField(name,0);
1260  goto eol;
1261  }
1262  oldc = s; cc = c = *s; *s = 0;
1263  if ( TestName(name) ) { *s = c; goto IllForm; }
1264  if ( c == '#' ) {
1265  s++;
1266  if ( tolower(*s) == 'r' ) cplx = VARTYPENONE;
1267  else if ( tolower(*s) == 'c' ) cplx = VARTYPECOMPLEX;
1268  else if ( tolower(*s) == 'i' ) cplx = VARTYPEIMAGINARY;
1269  else {
1270  MesPrint("&Illegal specification for complexity of %s",name);
1271  *oldc = c;
1272  error = 1;
1273  s = SkipField(s,0);
1274  goto eol;
1275  }
1276  s++; cc = *s;
1277  }
1278  if ( cc == '{' ) {
1279  s++;
1280  if ( ( *s == 'd' || *s == 'D' ) && s[1] == '=' ) {
1281  s += 2;
1282  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
1283  ParseSignedNumber(dim,s)
1284  if ( dim < -HALFMAX || dim > HALFMAX ) {
1285  MesPrint("&Warning: dimension of %s (%d) out of range"
1286  ,name,dim);
1287  }
1288  }
1289  if ( *s != '}' ) goto IllDim;
1290  else s++;
1291  }
1292  else {
1293 IllDim: MesPrint("&Error: Illegal dimension field for variable %s",name);
1294  error = 1;
1295  s = SkipField(s,0);
1296  goto eol;
1297  }
1298  cc = *s;
1299  }
1300  if ( cc == '(' ) {
1301  s++;
1302  if ( *s == '-' ) {
1303  reverseorder = REVERSEORDER;
1304  s++;
1305  }
1306  else {
1307  reverseorder = 0;
1308  }
1309  par = s;
1310  while ( FG.cTable[*s] == 0 ) s++;
1311  cc = *s; *s = 0;
1312  if ( s <= par ) {
1313 illegsym: *s = cc;
1314  MesPrint("&Illegal specification for symmetry of %s",name);
1315  *oldc = c;
1316  error = 1;
1317  s = SkipField(s,1);
1318  goto eol;
1319  }
1320  if ( StrICont(par,(UBYTE *)"symmetric") == 0 ) symtype = SYMMETRIC;
1321  else if ( StrICont(par,(UBYTE *)"antisymmetric") == 0 ) symtype = ANTISYMMETRIC;
1322  else if ( ( StrICont(par,(UBYTE *)"cyclesymmetric") == 0 )
1323  || ( StrICont(par,(UBYTE *)"cyclic") == 0 ) ) symtype = CYCLESYMMETRIC;
1324  else if ( ( StrICont(par,(UBYTE *)"rcyclesymmetric") == 0 )
1325  || ( StrICont(par,(UBYTE *)"rcyclic") == 0 )
1326  || ( StrICont(par,(UBYTE *)"reversecyclic") == 0 ) ) symtype = RCYCLESYMMETRIC;
1327  else goto illegsym;
1328  *s = cc;
1329  if ( *s != ')' || ( s[1] && s[1] != ',' && s[1] != '<' ) ) {
1330  Warning("&Excess information in symmetric properties currently ignored");
1331  s = SkipField(s,1);
1332  }
1333  else s++;
1334  symtype |= reverseorder;
1335  cc = *s;
1336  }
1337 retry:;
1338  if ( cc == '<' ) {
1339  s++; addone = 0;
1340  if ( *s == '=' ) { addone++; s++; }
1341  argmax = 0;
1342  while ( FG.cTable[*s] == 1 ) { argmax = 10*argmax + *s++ - '0'; }
1343  argmax += addone;
1344  par = s;
1345  while ( FG.cTable[*s] == 0 ) s++;
1346  if ( s > par ) {
1347  cc = *s; *s = 0;
1348  if ( ( StrICont(par,(UBYTE *)"arguments") == 0 )
1349  || ( StrICont(par,(UBYTE *)"args") == 0 ) ) {}
1350  else {
1351  Warning("&Illegal information in number of arguments properties currently ignored");
1352  error = 1;
1353  }
1354  *s = cc;
1355  }
1356  if ( argmax <= 0 ) {
1357  MesPrint("&Error: Cannot have fewer than 0 arguments for variable %s",name);
1358  error = 1;
1359  }
1360  cc = *s;
1361  }
1362  if ( cc == '>' ) {
1363  s++; addone = 1;
1364  if ( *s == '=' ) { addone = 0; s++; }
1365  argmin = 0;
1366  while ( FG.cTable[*s] == 1 ) { argmin = 10*argmin + *s++ - '0'; }
1367  argmin += addone;
1368  par = s;
1369  while ( FG.cTable[*s] == 0 ) s++;
1370  if ( s > par ) {
1371  cc = *s; *s = 0;
1372  if ( ( StrICont(par,(UBYTE *)"arguments") == 0 )
1373  || ( StrICont(par,(UBYTE *)"args") == 0 ) ) {}
1374  else {
1375  Warning("&Illegal information in number of arguments properties currently ignored");
1376  error = 1;
1377  }
1378  *s = cc;
1379  }
1380  cc = *s;
1381  }
1382  if ( cc == '<' ) goto retry;
1383  if ( ( AC.AutoDeclareFlag == 0 &&
1384  ( ( type = GetName(AC.exprnames,name,&numfunction,NOAUTO) )
1385  != NAMENOTFOUND ) )
1386  || ( ( type = GetName(*(AC.activenames),name,&numfunction,NOAUTO) ) != NAMENOTFOUND ) ) {
1387  if ( type != CFUNCTION ) error = NameConflict(type,name);
1388  else {
1389 /* FUNCTIONS fun = (FUNCTIONS)(AC.Functions->lijst) + numfunction-FUNCTION; */
1390  FUNCTIONS fun = (FUNCTIONS)(AC.Functions->lijst) + numfunction;
1391  fun->complex = cplx;
1392  fun->commute = comm;
1393  if ( istensor && fun->spec == 0 ) {
1394  MesPrint("&Function %s changed to tensor",name);
1395  error = 1;
1396  }
1397  else if ( istensor == 0 && fun->spec ) {
1398  MesPrint("&Tensor %s changed to function",name);
1399  error = 1;
1400  }
1401  fun->spec = istensor;
1402  if ( fun->symmetric != symtype ) {
1403  fun->symmetric = symtype;
1404  AC.SymChangeFlag = 1;
1405  }
1406  fun->maxnumargs = argmax;
1407  fun->minnumargs = argmin;
1408  }
1409  }
1410  else {
1411  AddFunction(name,comm,istensor,cplx,symtype,dim,argmax,argmin);
1412  }
1413  *oldc = c;
1414 eol: while ( *s == ',' ) s++;
1415  } while ( *s );
1416  return(error);
1417 }
1418 
1419 int CoNFunction(UBYTE *s) { return(CoFunction(s,1,0)); }
1420 int CoCFunction(UBYTE *s) { return(CoFunction(s,0,0)); }
1421 int CoNTensor(UBYTE *s) { return(CoFunction(s,1,2)); }
1422 int CoCTensor(UBYTE *s) { return(CoFunction(s,0,2)); }
1423 
1424 /*
1425  #] CoFunction + ...:
1426  #[ DoTable :
1427 
1428  Syntax:
1429  Table [check] [strict|relax] [zerofill] name(:1:2,...,regular arguments);
1430  name must be the name of a regular function.
1431  the table indices must be the first arguments.
1432  The parenthesis indicates 'name' as opposed to the options.
1433 
1434  We leave behind:
1435  a struct tabl in the FUNCTION struct
1436  Regular table:
1437  an array tablepointers for the pointers to elements of rhs
1438  in the compiler struct cbuf[T->bufnum]
1439  an array MINMAX T->mm with the minima and maxima
1440  a prototype array
1441  an offset in the compiler buffer for the pattern to be matched
1442  Sparse table:
1443  Just the number of dimensions
1444  We will keep track of the number of defined elements in totind
1445  and in tablepointers we will have numind+1 positions for each
1446  element. The first numind elements for the indices and the
1447  last one for the element in cbuf[T->bufnum].rhs
1448 
1449  Complication: to preserve speed we need a prototype and a pattern
1450  for each thread when we use WITHPTHREADS. This is because we write
1451  into those when looking for the pattern.
1452 */
1453 
1454 static int nwarntab = 1;
1455 
1456 int DoTable(UBYTE *s, int par)
1457 {
1458  GETIDENTITY
1459  UBYTE *name, *p, *inp, c;
1460  int i, j, sparseflag = 0, rflag = 0, checkflag = 0, error = 0, ret, oldcbufnum;
1461  WORD funnum, type, *OldWork, *w, *newp, *flags1;
1462  MINMAX *mm, *mm1;
1463  LONG x, y;
1464  TABLES T;
1465 
1466  while ( *s == ',' ) s++;
1467  do {
1468  name = s;
1469  if ( ( s = SkipAName(s) ) == 0 ) {
1470 IllForm: MesPrint("&Illegal name or option in table declaration");
1471  return(1);
1472  }
1473  c = *s; *s = 0;
1474  if ( TestName(name) ) { *s = c; goto IllForm; }
1475  *s = c;
1476  if ( *s == '(' ) break;
1477  if ( *s != ',' ) {
1478  MesPrint("&Illegal definition of table");
1479  return(1);
1480  }
1481  *s = 0;
1482 /*
1483  Secondary options
1484 */
1485  if ( StrICmp(name,(UBYTE *)("check" )) == 0 ) checkflag = 1;
1486  else if ( StrICmp(name,(UBYTE *)("zero" )) == 0 ) checkflag = 2;
1487  else if ( StrICmp(name,(UBYTE *)("strict")) == 0 ) rflag = 1;
1488  else if ( StrICmp(name,(UBYTE *)("relax" )) == 0 ) rflag = -1;
1489  else if ( StrICmp(name,(UBYTE *)("zerofill" )) == 0 ) rflag = -2;
1490  else if ( StrICmp(name,(UBYTE *)("sparse")) == 0 ) sparseflag |= 1;
1491  else if ( StrICmp(name,(UBYTE *)("base")) == 0 ) sparseflag |= 3;
1492  else if ( StrICmp(name,(UBYTE *)("tablebase")) == 0 ) sparseflag |= 3;
1493  else {
1494  MesPrint("&Illegal option in table definition: '%s'",name);
1495  error = 1;
1496  }
1497  *s++ = ',';
1498  while ( *s == ',' ) s++;
1499  } while ( *s );
1500  if ( name == s || *s == 0 ) {
1501  MesPrint("&Illegal name or option in table declaration");
1502  return(1);
1503  }
1504  *s = 0; /* *s could only have been a parenthesis */
1505  if ( sparseflag ) {
1506  if ( checkflag == 1 ) rflag = 0;
1507  else if ( checkflag == 2 ) rflag = -2;
1508  else rflag = -1;
1509  }
1510  if ( ( ret = GetVar(name,&type,&funnum,CFUNCTION,NOAUTO) ) ==
1511  NAMENOTFOUND ) {
1512  if ( par == 0 ) {
1513  funnum = EntVar(CFUNCTION,name,0,1,0,0);
1514  }
1515  else if ( par == 1 || par == 2 ) {
1516  funnum = EntVar(CFUNCTION,name,0,0,0,0);
1517  }
1518  }
1519  else if ( ret <= 0 ) {
1520  funnum = EntVar(CFUNCTION,name,0,0,0,0);
1521  error = 1;
1522  }
1523  else {
1524  if ( par == 2 ) {
1525  if ( nwarntab ) {
1526  Warning("Table now declares its (commuting) function.");
1527  Warning("Earlier definition in Function statement obsolete. Please remove.");
1528  nwarntab = 0;
1529  }
1530  }
1531  else {
1532  error = 1;
1533  MesPrint("&(N)(C)Tables should not be declared previously");
1534  }
1535  }
1536  if ( functions[funnum].spec > 0 ) {
1537  MesPrint("&Tensors cannot become tables");
1538  return(1);
1539  }
1540  if ( functions[funnum].tabl ) {
1541  MesPrint("&Redefinition of an existing table is not allowed.");
1542  return(1);
1543  }
1544  functions[funnum].tabl = T = (TABLES)Malloc1(sizeof(struct TaBlEs),"table");
1545 /*
1546  Next we find the size of the table (if it is not sparse)
1547 */
1548  T->defined = T->mdefined = 0; T->sparse = sparseflag; T->mm = 0; T->flags = 0;
1549  T->numtree = 0; T->rootnum = 0; T->MaxTreeSize = 0;
1550  T->boomlijst = 0;
1551  T->strict = rflag;
1552  T->bounds = checkflag;
1553  T->bufnum = inicbufs();
1554  T->argtail = 0;
1555  T->spare = 0;
1556  T->bufferssize = 8;
1557  T->buffers = (WORD *)Malloc1(sizeof(WORD)*T->bufferssize,"Table buffers");
1558  T->buffersfill = 0;
1559  T->buffers[T->buffersfill++] = T->bufnum;
1560  T->mode = 0;
1561  T->numdummies = 0;
1562  mm = T->mm;
1563  T->numind = 0;
1564  if ( rflag > 0 ) AC.MustTestTable++;
1565  T->totind = 0; /* Table hasn't been checked */
1566 
1567  p = s; *s = '(';
1568  if ( sparseflag ) {
1569 /*
1570  First copy the tail, just in case we will construct a tablebase
1571  Note that we keep the ( to indicate a tail
1572  The actual arguments can be found after the comma. Before we have
1573  the dimension which the tablebase will need for consistency checking.
1574 */
1575  inp = p+1;
1576  SKIPBRA3(inp)
1577  c = *inp; *inp = 0;
1578  T->argtail = strDup1(p,"argtail");
1579  *inp = c;
1580 /*
1581  Now the regular compilation
1582 */
1583  inp = p++;
1584  ParseNumber(x,p)
1585  if ( FG.cTable[p[-1]] != 1 || ( *p != ',' && *p != ')' ) ) {
1586  p = inp;
1587  MesPrint("&First argument in a sparse table must be a number of dimensions");
1588  error = 1;
1589  x = 1;
1590  }
1591  T->numind = x;
1592  T->mm = (MINMAX *)Malloc1(x*sizeof(MINMAX),"table dimensions");
1593  T->flags = (WORD *)Malloc1(x*sizeof(WORD),"table flags");
1594  mm = T->mm;
1595  inp = p;
1596  T->totind = 0; /* At the moment there are this many */
1597  T->tablepointers = 0;
1598  T->reserved = 0;
1599  }
1600  else {
1601  T->numind = 0;
1602  T->totind = 1;
1603  for(;;) { /* Read the dimensions as far as they can be recognized */
1604  inp = ++p;
1605  if ( FG.cTable[*p] != 1 && *p != '+' && *p != '-' ) break;
1606  ParseSignedNumber(x,p)
1607  if ( FG.cTable[p[-1]] != 1 || *p != ':' ) break;
1608  p++;
1609  ParseSignedNumber(y,p)
1610  if ( FG.cTable[p[-1]] != 1 || ( *p != ',' && *p != ')' ) ) {
1611  MesPrint("&Illegal dimension field in table declaration");
1612  return(1);
1613  }
1614  mm1 = (MINMAX *)Malloc1((T->numind+1)*sizeof(MINMAX),"table dimensions");
1615  flags1 = (WORD *)Malloc1((T->numind+1)*sizeof(WORD),"table flags");
1616  for ( i = 0; i < T->numind; i++ ) { mm1[i] = T->mm[i]; flags1[i] = T->flags[i]; }
1617  if ( T->mm ) M_free(T->mm,"table dimensions");
1618  if ( T->flags ) M_free(T->flags,"table flags");
1619  T->mm = mm1;
1620  T->flags = flags1;
1621  mm = T->mm + T->numind;
1622  mm->mini = x; mm->maxi = y;
1623  T->totind *= mm->maxi-mm->mini+1;
1624  T->numind++;
1625  if ( *p == ')' ) { inp = p; break; }
1626  }
1627  w = T->tablepointers
1628  = (WORD *)Malloc1(TABLEEXTENSION*sizeof(WORD)*(T->totind),"table pointers");
1629  i = T->totind;
1630  for ( i = TABLEEXTENSION*T->totind; i > 0; i-- ) *w++ = -1; /* means: undefined */
1631  for ( i = T->numind-1, x = 1; i >= 0; i-- ) {
1632  T->mm[i].size = x; /* Defines increment in this dimension */
1633  x *= T->mm[i].maxi - T->mm[i].mini + 1;
1634  }
1635  }
1636 /*
1637  Now we redo the 'function part' and send it to the compiler.
1638  The prototype has to be picked up properly.
1639 */
1640  OldWork = AT.WorkPointer;
1641  oldcbufnum = AC.cbufnum;
1642  AC.cbufnum = T->bufnum;
1643  while ( s >= name ) *--inp = *s--;
1644  AC.ProtoType = w = AT.WorkPointer;
1645  *w++ = SUBEXPRESSION;
1646  *w++ = SUBEXPSIZE;
1647  *w++ = 0;
1648  *w++ = 1;
1649  *w++ = AC.cbufnum;
1650  FILLSUB(w)
1651  AC.WildC = w;
1652  AC.NwildC = 0;
1653  AT.WorkPointer = w + 4*AM.MaxWildcards;
1654  AddLHS(AC.cbufnum);
1655  if ( ( ret = CompileAlgebra(inp,LHSIDE,AC.ProtoType) ) < 0 ) error = 1;
1656  else {
1657  if ( AC.NwildC && SortWild(w,AC.NwildC) ) error = 1;
1658  w += AC.NwildC;
1659  i = w-OldWork;
1660  OldWork[1] = i;
1661  j = cbuf[AC.cbufnum].Pointer-cbuf[AC.cbufnum].lhs[ret] + T->numind*2-3;
1662 #ifdef WITHPTHREADS
1663  T->prototypeSize = ((i+j)*sizeof(WORD)+2*sizeof(WORD *)) * AM.totalnumberofthreads;
1664  T->prototype = (WORD **)Malloc1(T->prototypeSize,"table prototype");
1665  T->pattern = T->prototype + AM.totalnumberofthreads;
1666  {
1667  WORD *t; int k, n;
1668  t = (WORD *)(T->pattern + AM.totalnumberofthreads);
1669  for ( n = 0; n < AM.totalnumberofthreads; n++ ) {
1670  T->prototype[n] = t;
1671  for ( k = 0; k < i; k++ ) *t++ = OldWork[k];
1672  }
1673  T->pattern[0] = t;
1674  }
1675 #else
1676  T->prototypeSize = (i+j)*sizeof(WORD);
1677  T->prototype = (WORD *)Malloc1(T->prototypeSize, "table prototype");
1678  T->pattern = T->prototype + i;
1679  while ( --i >= 0 ) T->prototype[i] = OldWork[i];
1680 #endif
1681 /*
1682  Now check whether wildcards get converted to dollars (for PARALLEL)
1683  We give a warning!
1684 */
1685  {
1686  WORD *tw, *twstop;
1687 #ifdef WITHPTHREADS
1688  tw = T->prototype[0];
1689 #else
1690  tw = T->prototype;
1691 #endif
1692  twstop = tw + tw[1]; tw += SUBEXPSIZE;
1693  while ( tw < twstop ) {
1694  if ( *tw == LOADDOLLAR ) {
1695  Warning("The use of $-variable assignments in tables disables parallel\
1696  execution for the whole program.");
1697  AM.hparallelflag |= NOPARALLEL_TBLDOLLAR;
1698  AC.mparallelflag |= NOPARALLEL_TBLDOLLAR;
1699  AddPotModdollar(tw[2]);
1700  }
1701  tw += tw[1];
1702  }
1703  }
1704 
1705  w = cbuf[AC.cbufnum].lhs[ret] + 1;
1706 #ifdef WITHPTHREADS
1707  newp = T->pattern[0];
1708 #else
1709  newp = T->pattern;
1710 #endif
1711  *newp++ = *w++; *newp++ = *w++ + T->numind*2;
1712  for ( i = 2; i < FUNHEAD; i++ ) *newp++ = *w++;
1713  for ( i = 0; i < T->numind; i++ ) { *newp++ = -SNUMBER; *newp++ = 0; j -= 2; }
1714  if ( sparseflag ) { w += 2; j -= 4; }
1715  for ( i = FUNHEAD; i < j; i++ ) *newp++ = *w++;
1716 #ifdef WITHPTHREADS
1717  if ( sparseflag ) T->pattern[0][1] = newp - T->pattern[0];
1718 /*
1719  Now we have to copy the pattern for each worker thread
1720 */
1721  {
1722  WORD *t;
1723  int k,n;
1724  k = newp - T->pattern[0];
1725  for ( n = 1; n < AM.totalnumberofthreads; n++ ) {
1726  T->pattern[n] = newp; t = T->pattern[0];
1727  for ( i = 0; i < k; i++ ) *newp++ = *t++;
1728  }
1729  }
1730 #else
1731  if ( sparseflag ) T->pattern[1] = newp - T->pattern;
1732 #endif
1733  }
1734  AT.WorkPointer = OldWork;
1735  AC.cbufnum = oldcbufnum;
1736  if ( T->sparse ) ClearTableTree(T);
1737  if ( ( sparseflag & 2 ) != 0 ) {
1738  if ( T->spare == 0 ) { SpareTable(T); }
1739  }
1740  return(error);
1741 }
1742 
1743 /*
1744  #] DoTable :
1745  #[ CoTable :
1746 */
1747 
1748 int CoTable(UBYTE *s)
1749 {
1750  return(DoTable(s,2));
1751 }
1752 
1753 /*
1754  #] CoTable :
1755  #[ CoNTable :
1756 */
1757 
1758 int CoNTable(UBYTE *s)
1759 {
1760  return(DoTable(s,0));
1761 }
1762 
1763 /*
1764  #] CoNTable :
1765  #[ CoCTable :
1766 */
1767 
1768 int CoCTable(UBYTE *s)
1769 {
1770  return(DoTable(s,1));
1771 }
1772 
1773 /*
1774  #] CoCTable :
1775  #[ AddSet :
1776 */
1777 
1778 int AddSet(UBYTE *name, WORD dim)
1779 {
1780  int nodenum, numset = AC.SetList.num;
1781  SETS set = (SETS)FromVarList(&AC.SetList);
1782  UBYTE *s;
1783  if ( name ) {
1784  set->name = AddName(AC.varnames,name,CSET,numset,&nodenum);
1785  s = name;
1786  while ( *s ) s++;
1787  set->namesize = (s-name)+1;
1788  set->node = nodenum;
1789  }
1790  else {
1791  set->name = 0;
1792  set->namesize = 0;
1793  set->node = -1;
1794  }
1795  set->first =
1796  set->last = AC.SetElementList.num; /* set has no elements yet */
1797  set->type = -1; /* undefined as of yet */
1798  set->dimension = dim;
1799  return(numset);
1800 }
1801 
1802 /*
1803  #] AddSet :
1804  #[ DoElements :
1805 
1806  Remark (25-mar-2011): If the dimension has been set (dim != MAXPOSITIVE)
1807  we want to test dimensions. Numbers count as dimension zero?
1808 */
1809 
1810 int DoElements(UBYTE *s, SETS set, UBYTE *name)
1811 {
1812  int type, error = 0, x, sgn, i;
1813  WORD numset, *e;
1814  UBYTE c, *cname;
1815  while ( *s ) {
1816  if ( *s == ',' ) { s++; continue; }
1817  sgn = 0;
1818  while ( *s == '-' || *s == '+' ) { sgn ^= 1; s++; }
1819  cname = s;
1820  if ( FG.cTable[*s] == 0 || *s == '_' || *s == '[' ) {
1821  if ( ( s = SkipAName(s) ) == 0 ) {
1822  MesPrint("&Illegal name in set definition");
1823  return(1);
1824  }
1825  c = *s; *s = 0;
1826  if ( ( ( type = GetName(AC.exprnames,cname,&numset,NOAUTO) ) == NAMENOTFOUND )
1827  && ( ( type = GetOName(AC.varnames,cname,&numset,WITHAUTO) ) == NAMENOTFOUND ) ) {
1828  DUBIOUSV dv;
1829  int nodenum;
1830  MesPrint("&%s has not been declared",cname);
1831 /*
1832  We enter a 'dubious' declaration to cut down on errors
1833 */
1834  numset = AC.DubiousList.num;
1835  dv = (DUBIOUSV)FromVarList(&AC.DubiousList);
1836  dv->name = AddName(AC.varnames,cname,CDUBIOUS,numset,&nodenum);
1837  dv->node = nodenum;
1838  set->type = type = CDUBIOUS;
1839  set->dimension = 0;
1840  error = 1;
1841  }
1842  if ( set->type == -1 ) {
1843  if ( type == CSYMBOL ) {
1844  for ( i = set->first; i < set->last; i++ ) {
1845  SetElements[i] += 2*MAXPOWER;
1846  }
1847  }
1848  set->type = type;
1849  }
1850  if ( set->type != type && set->type != CDUBIOUS
1851  && type != CDUBIOUS ) {
1852  if ( set->type != CNUMBER || ( type != CSYMBOL
1853  && type != CINDEX ) ) {
1854  MesPrint(
1855  "&%s has not the same type as the other members of the set"
1856  ,cname);
1857  error = 1;
1858  set->type = CDUBIOUS;
1859  }
1860  else {
1861  if ( type == CSYMBOL ) {
1862  for ( i = set->first; i < set->last; i++ ) {
1863  SetElements[i] += 2*MAXPOWER;
1864  }
1865  }
1866  set->type = type;
1867  }
1868  }
1869  if ( set->dimension != MAXPOSITIVE ) { /* Dimension check */
1870  switch ( set->type ) {
1871  case CSYMBOL:
1872  if ( symbols[numset].dimension != set->dimension ) {
1873  MesPrint("&Dimension check failed in set %s, symbol %s",
1874  VARNAME(Sets,(set-Sets)),
1875  VARNAME(symbols,numset));
1876  error = 1;
1877  set->dimension = MAXPOSITIVE;
1878  }
1879  break;
1880  case CVECTOR:
1881  if ( vectors[numset-AM.OffsetVector].dimension != set->dimension ) {
1882  MesPrint("&Dimension check failed in set %s, vector %s",
1883  VARNAME(Sets,(set-Sets)),
1884  VARNAME(vectors,(numset-AM.OffsetVector)));
1885  error = 1;
1886  set->dimension = MAXPOSITIVE;
1887  }
1888  break;
1889  case CFUNCTION:
1890  if ( functions[numset-FUNCTION].dimension != set->dimension ) {
1891  MesPrint("&Dimension check failed in set %s, function %s",
1892  VARNAME(Sets,(set-Sets)),
1893  VARNAME(functions,(numset-FUNCTION)));
1894  error = 1;
1895  }
1896  break;
1897  set->dimension = MAXPOSITIVE;
1898  }
1899  }
1900  if ( sgn ) {
1901  if ( type != CVECTOR ) {
1902  MesPrint("&Illegal use of - sign in set. Can use only with vector or number");
1903  error = 1;
1904  }
1905  numset = AM.OffsetVector - numset;
1906  numset |= SPECMASK;
1907  numset = AM.OffsetVector - numset;
1908  }
1909  *s = c;
1910  if ( name == 0 && *s == '?' ) {
1911  s++;
1912  switch ( set->type ) {
1913  case CSYMBOL:
1914  numset = -numset; break;
1915  case CVECTOR:
1916  numset += WILDOFFSET; break;
1917  case CINDEX:
1918  numset |= WILDMASK; break;
1919  case CFUNCTION:
1920  numset |= WILDMASK; break;
1921  }
1922  AC.wildflag = 1;
1923  }
1924 /*
1925  Now add the element to the set.
1926 */
1927  e = (WORD *)FromVarList(&AC.SetElementList);
1928  *e = numset;
1929  (set->last)++;
1930  }
1931  else if ( FG.cTable[*s] == 1 ) {
1932  ParseNumber(x,s)
1933  if ( sgn ) x = -x;
1934  if ( x >= MAXPOWER || x <= -MAXPOWER ||
1935  ( set->type == CINDEX && ( x < 0 || x >= AM.OffsetIndex ) ) ) {
1936  MesPrint("&Illegal value for set element: %d",x);
1937  if ( AC.firstconstindex ) {
1938  MesPrint("&0 <= Fixed indices < ConstIndex(which is %d)",
1939  AM.OffsetIndex-1);
1940  MesPrint("&For setting ConstIndex, read the chapter on the setup file");
1941  AC.firstconstindex = 0;
1942  }
1943  error = 1;
1944  x = 0;
1945  }
1946 /*
1947  Check what is allowed with the type.
1948 */
1949  if ( set->type == -1 ) {
1950  if ( x < 0 || x >= AM.OffsetIndex ) {
1951  for ( i = set->first; i < set->last; i++ ) {
1952  SetElements[i] += 2*MAXPOWER;
1953  }
1954  set->type = CSYMBOL;
1955  }
1956  else set->type = CNUMBER;
1957  }
1958  else if ( set->type == CDUBIOUS ) {}
1959  else if ( set->type == CNUMBER && x < 0 ) {
1960  for ( i = set->first; i < set->last; i++ ) {
1961  SetElements[i] += 2*MAXPOWER;
1962  }
1963  set->type = CSYMBOL;
1964  }
1965  else if ( set->type != CSYMBOL && ( x < 0 ||
1966  ( set->type != CINDEX && set->type != CNUMBER ) ) ) {
1967  MesPrint("&Illegal mixture of element types in set");
1968  error = 1;
1969  set->type = CDUBIOUS;
1970  }
1971 /*
1972  Allocate an element
1973 */
1974  e = (WORD *)FromVarList(&AC.SetElementList);
1975  (set->last)++;
1976  if ( set->type == CSYMBOL ) *e = x + 2*MAXPOWER;
1977 /* else if ( set->type == CINDEX ) *e = x; */
1978  else *e = x;
1979  }
1980  else {
1981  MesPrint("&Illegal object in list of set elements");
1982  return(1);
1983  }
1984  }
1985  return(error);
1986 }
1987 
1988 /*
1989  #] DoElements :
1990  #[ CoSet :
1991 
1992  Set declarations.
1993 */
1994 
1995 int CoSet(UBYTE *s)
1996 {
1997  int type, error = 0;
1998  UBYTE *name, c, *ss;
1999  SETS set;
2000  WORD numberofset, dim = MAXPOSITIVE;
2001  name = s;
2002  if ( ( s = SkipAName(s) ) == 0 ) {
2003 IllForm:MesPrint("&Illegal name for set");
2004  return(1);
2005  }
2006  c = *s; *s = 0;
2007  if ( TestName(name) ) goto IllForm;
2008  if ( ( ( type = GetName(AC.exprnames,name,&numberofset,NOAUTO) ) != NAMENOTFOUND )
2009  || ( ( type = GetName(AC.varnames,name,&numberofset,NOAUTO) ) != NAMENOTFOUND ) ) {
2010  if ( type != CSET ) NameConflict(type,name);
2011  else {
2012  MesPrint("&There is already a set with the name %s",name);
2013  }
2014  return(1);
2015  }
2016  if ( c == 0 ) {
2017  numberofset = AddSet(name,0);
2018  set = Sets + numberofset;
2019  return(0); /* empty set */
2020  }
2021  *s = c; ss = s;
2022  if ( *s == '{' ) {
2023  s++;
2024  if ( ( *s == 'd' || *s == 'D' ) && s[1] == '=' ) {
2025  s += 2;
2026  if ( *s == '-' || *s == '+' || FG.cTable[*s] == 1 ) {
2027  ParseSignedNumber(dim,s)
2028  if ( dim < -HALFMAX || dim > HALFMAX ) {
2029  MesPrint("&Warning: dimension of %s (%d) out of range"
2030  ,name,dim);
2031  }
2032  }
2033  if ( *s != '}' ) goto IllDim;
2034  else s++;
2035  }
2036  else {
2037 IllDim: MesPrint("&Error: Illegal dimension field for set %s",name);
2038  error = 1;
2039  s = SkipField(s,0);
2040  }
2041  while ( *s == ',' ) s++;
2042  }
2043  c = *ss; *ss = 0;
2044  numberofset = AddSet(name,dim);
2045  *ss = c;
2046  set = Sets + numberofset;
2047  if ( *s != ':' ) {
2048  MesPrint("&Proper syntax is `Set name:elements'");
2049  return(1);
2050  }
2051  s++;
2052  error = DoElements(s,set,name);
2053  AC.SetList.numtemp = AC.SetList.num;
2054  AC.SetElementList.numtemp = AC.SetElementList.num;
2055  return(error);
2056 }
2057 
2058 /*
2059  #] CoSet :
2060  #[ DoTempSet :
2061 
2062  Gets a {} set definition and returns a set number if the set is
2063  properly structured. This number refers either to an already
2064  existing set, or to a set that is defined here.
2065  From and to refer to the contents. They exclude the {}.
2066 */
2067 
2068 int DoTempSet(UBYTE *from, UBYTE *to)
2069 {
2070  int i, num, j, sgn;
2071  WORD *e, *ep;
2072  UBYTE c;
2073  int setnum = AddSet(0,MAXPOSITIVE);
2074  SETS set = Sets + setnum, setp;
2075  set->name = -1;
2076  set->type = -1;
2077  c = *to; *to = 0;
2078  AC.wildflag = 0;
2079  while ( *from == ',' ) from++;
2080  if ( *from == '<' || *from == '>' ) {
2081  set->type = CRANGE;
2082  set->first = 3*MAXPOWER;
2083  set->last = -3*MAXPOWER;
2084  while ( *from == '<' || *from == '>' ) {
2085  if ( *from == '<' ) {
2086  j = 1; from++;
2087  if ( *from == '=' ) { from++; j++; }
2088  }
2089  else {
2090  j = -1; from++;
2091  if ( *from == '=' ) { from++; j--; }
2092  }
2093  sgn = 1;
2094  while ( *from == '-' || *from == '+' ) {
2095  if ( *from == '-' ) sgn = -sgn;
2096  from++;
2097  }
2098  ParseNumber(num,from)
2099  if ( *from && *from != ',' ) {
2100  MesPrint("&Illegal number in ranged set definition");
2101  return(-1);
2102  }
2103  if ( sgn < 0 ) num = -num;
2104  if ( num >= MAXPOWER || num <= -MAXPOWER ) {
2105  Warning("Value in ranged set too big. Adjusted to infinity.");
2106  if ( num > 0 ) num = 3*MAXPOWER;
2107  else num = -3*MAXPOWER;
2108  }
2109  else if ( j == 2 ) num += 2*MAXPOWER;
2110  else if ( j == -2 ) num -= 2*MAXPOWER;
2111  if ( j > 0 ) set->first = num;
2112  else set->last = num;
2113  while ( *from == ',' ) from++;
2114  }
2115  if ( *from ) {
2116  MesPrint("&Definition of ranged set contains illegal objects");
2117  return(-1);
2118  }
2119  }
2120  else if ( DoElements(from,set,(UBYTE *)0) != 0 ) {
2121  AC.SetElementList.num = set->first;
2122  AC.SetList.num--; *to = c;
2123  return(-1);
2124  }
2125  *to = c;
2126 /*
2127  Now we have to test whether this set exists already.
2128 */
2129  num = set->last - set->first;
2130  for ( setp = Sets, i = 0; i < AC.SetList.num-1; i++, setp++ ) {
2131  if ( num != setp->last - setp->first ) continue;
2132  if ( set->type != setp->type ) continue;
2133  if ( set->type == CRANGE ) {
2134  if ( set->first == setp->first ) return(setp-Sets);
2135  }
2136  else {
2137  e = SetElements + set->first;
2138  ep = SetElements + setp->first;
2139  j = num;
2140  while ( --j >= 0 ) if ( *e++ != *ep++ ) break;
2141  if ( j < 0 ) {
2142  AC.SetElementList.num = set->first;
2143  AC.SetList.num--;
2144  return(setp - Sets);
2145  }
2146  }
2147  }
2148  return(setnum);
2149 }
2150 
2151 /*
2152  #] DoTempSet :
2153  #[ CoAuto :
2154 
2155  To prepare first:
2156  Use of the proper pointers in the various declaration routines
2157  Proper action in .store and .clear
2158 */
2159 
2160 int CoAuto(UBYTE *inp)
2161 {
2162  int retval;
2163 
2164  AC.Symbols = &(AC.AutoSymbolList);
2165  AC.Vectors = &(AC.AutoVectorList);
2166  AC.Indices = &(AC.AutoIndexList);
2167  AC.Functions = &(AC.AutoFunctionList);
2168  AC.activenames = &(AC.autonames);
2169  AC.AutoDeclareFlag = WITHAUTO;
2170 
2171  while ( *inp == ',' ) inp++;
2172  retval = CompileStatement(inp);
2173 
2174  AC.AutoDeclareFlag = 0;
2175  AC.Symbols = &(AC.SymbolList);
2176  AC.Vectors = &(AC.VectorList);
2177  AC.Indices = &(AC.IndexList);
2178  AC.Functions = &(AC.FunctionList);
2179  AC.activenames = &(AC.varnames);
2180  return(retval);
2181 }
2182 
2183 /*
2184  #] CoAuto :
2185  #[ AddDollar :
2186 
2187  The actual addition. Special routine for additions 'on the fly'
2188 */
2189 
2190 int AddDollar(UBYTE *name, WORD type, WORD *start, LONG size)
2191 {
2192  int nodenum, numdollar = AP.DollarList.num;
2193  WORD *s, *t;
2194  DOLLARS dol = (DOLLARS)FromVarList(&AP.DollarList);
2195  dol->name = AddName(AC.dollarnames,name,CDOLLAR,numdollar,&nodenum);
2196  dol->type = type;
2197  dol->node = nodenum;
2198  dol->zero = 0;
2199  dol->numdummies = 0;
2200 #ifdef WITHPTHREADS
2201  dol->pthreadslockread = dummylock;
2202  dol->pthreadslockwrite = dummylock;
2203 #endif
2204  dol->nfactors = 0;
2205  dol->factors = 0;
2206  AddRHS(AM.dbufnum,1);
2207  AddLHS(AM.dbufnum);
2208  if ( start && size > 0 ) {
2209  dol->size = size;
2210  dol->where =
2211  s = (WORD *)Malloc1((size+1)*sizeof(WORD),"$-variable contents");
2212  t = start;
2213  while ( --size >= 0 ) *s++ = *t++;
2214  *s = 0;
2215  }
2216  else { dol->where = &(AM.dollarzero); dol->size = 0; }
2217  cbuf[AM.dbufnum].rhs[numdollar] = dol->where;
2218  cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
2219  cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
2220 
2221  return(numdollar);
2222 }
2223 
2224 /*
2225  #] AddDollar :
2226  #[ ReplaceDollar :
2227 
2228  Replacements of dollar variables can happen at any time.
2229  For debugging purposes we should have a tracing facility.
2230 
2231  Not in use????
2232 */
2233 
2234 int ReplaceDollar(WORD number, WORD newtype, WORD *newstart, LONG newsize)
2235 {
2236  int error = 0;
2237  DOLLARS dol = Dollars + number;
2238  WORD *s, *t;
2239  LONG i;
2240  dol->type = newtype;
2241  if ( dol->size == newsize && newsize > 0 && newstart ) {
2242  s = dol->where; t = newstart; i = newsize;
2243  while ( --i >= 0 ) { if ( *s++ != *t++ ) break; }
2244  if ( i < 0 ) return(0);
2245  }
2246  if ( dol->where && dol->where != &(dol->zero) ) {
2247  M_free(dol->where,"dollar->where"); dol->where = &(dol->zero); dol->size = 0;
2248  }
2249  if ( newstart && newsize > 0 ) {
2250  dol->size = newsize;
2251  dol->where =
2252  s = (WORD *)Malloc1((newsize+1)*sizeof(WORD),"$-variable contents");
2253  t = newstart; i = newsize;
2254  while ( --i >= 0 ) *s++ = *t++;
2255  *s = 0;
2256  }
2257  return(error);
2258 }
2259 
2260 /*
2261  #] ReplaceDollar :
2262  #[ AddDubious :
2263 
2264  This adds a variable of which we do not know the proper type.
2265 */
2266 
2267 int AddDubious(UBYTE *name)
2268 {
2269  int nodenum, numdubious = AC.DubiousList.num;
2270  DUBIOUSV dub = (DUBIOUSV)FromVarList(&AC.DubiousList);
2271  dub->name = AddName(AC.varnames,name,CDUBIOUS,numdubious,&nodenum);
2272  dub->node = nodenum;
2273  return(numdubious);
2274 }
2275 
2276 /*
2277  #] AddDubious :
2278  #[ MakeDubious :
2279 */
2280 
2281 int MakeDubious(NAMETREE *nametree, UBYTE *name, WORD *number)
2282 {
2283  NAMENODE *n;
2284  int node, newnode, i;
2285  if ( nametree->namenode == 0 ) return(-1);
2286  newnode = nametree->headnode;
2287  do {
2288  node = newnode;
2289  n = nametree->namenode+node;
2290  if ( ( i = StrCmp(name,nametree->namebuffer+n->name) ) < 0 )
2291  newnode = n->left;
2292  else if ( i > 0 ) newnode = n->right;
2293  else {
2294  if ( n->type != CDUBIOUS ) {
2295  int numdubious = AC.DubiousList.num;
2296  FUNCTIONS dub = (FUNCTIONS)FromVarList(&AC.DubiousList);
2297  dub->name = n->name;
2298  n->number = numdubious;
2299  }
2300  *number = n->number;
2301  return(CDUBIOUS);
2302  }
2303  } while ( newnode >= 0 );
2304  return(-1);
2305 }
2306 
2307 /*
2308  #] MakeDubious :
2309  #[ NameConflict :
2310 */
2311 
2312 static char *nametype[] = { "symbol", "index", "vector", "function",
2313  "set", "expression" };
2314 static char *plural[] = { "","n","","","","n" };
2315 
2316 int NameConflict(int type, UBYTE *name)
2317 {
2318  if ( type == NAMENOTFOUND ) {
2319  MesPrint("&%s has not been declared",name);
2320  }
2321  else if ( type != CDUBIOUS )
2322  MesPrint("&%s has been declared as a%s %s already"
2323  ,name,plural[type],nametype[type]);
2324  return(1);
2325 }
2326 
2327 /*
2328  #] NameConflict :
2329  #[ AddExpression :
2330 */
2331 
2332 int AddExpression(UBYTE *name, int x, int y)
2333 {
2334  int nodenum, numexpr = AC.ExpressionList.num;
2335  EXPRESSIONS expr = (EXPRESSIONS)FromVarList(&AC.ExpressionList);
2336  UBYTE *s;
2337  expr->status = x;
2338  expr->printflag = y;
2339  PUTZERO(expr->onfile);
2340  expr->renum = 0;
2341  expr->renumlists = 0;
2342  expr->hidelevel = 0;
2343  expr->inmem = 0;
2344  expr->bracketinfo = expr->newbracketinfo = 0;
2345  if ( name ) {
2346  expr->name = AddName(AC.exprnames,name,CEXPRESSION,numexpr,&nodenum);
2347  expr->node = nodenum;
2348  expr->replace = NEWLYDEFINEDEXPRESSION ;
2349  s = name;
2350  while ( *s ) s++;
2351  expr->namesize = (s-name)+1;
2352  }
2353  else {
2354  expr->replace = REDEFINEDEXPRESSION;
2355  expr->name = AC.TransEname;
2356  expr->node = -1;
2357  expr->namesize = 0;
2358  }
2359  expr->vflags = 0;
2360  expr->numdummies = 0;
2361  expr->numfactors = 0;
2362 #ifdef PARALLELCODE
2363  expr->partodo = 0;
2364 #endif
2365  return(numexpr);
2366 }
2367 
2368 /*
2369  #] AddExpression :
2370  #[ GetLabel :
2371 */
2372 
2373 int GetLabel(UBYTE *name)
2374 {
2375  int i;
2376  LONG newnum;
2377  UBYTE **NewLabelNames;
2378  int *NewLabel;
2379  for ( i = 0; i < AC.NumLabels; i++ ) {
2380  if ( StrCmp(name,AC.LabelNames[i]) == 0 ) return(i);
2381  }
2382  if ( AC.NumLabels >= AC.MaxLabels ) {
2383  newnum = 2*AC.MaxLabels;
2384  if ( newnum == 0 ) newnum = 10;
2385  if ( newnum > 32765 ) newnum = 32765;
2386  if ( newnum == AC.MaxLabels ) {
2387  MesPrint("&More than 32765 labels in one module. Please simplify.");
2388  Terminate(-1);
2389  }
2390  NewLabelNames = (UBYTE **)Malloc1((sizeof(UBYTE *)+sizeof(int))
2391  *newnum,"Labels");
2392  NewLabel = (int *)(NewLabelNames+newnum);
2393  for ( i = 0; i< AC.MaxLabels; i++ ) {
2394  NewLabelNames[i] = AC.LabelNames[i];
2395  NewLabel[i] = AC.Labels[i];
2396  }
2397  if ( AC.LabelNames ) M_free(AC.LabelNames,"Labels");
2398  AC.LabelNames = NewLabelNames;
2399  AC.Labels = NewLabel;
2400  AC.MaxLabels = newnum;
2401  }
2402  i = AC.NumLabels++;
2403  AC.LabelNames[i] = strDup1(name,"Labels");
2404  AC.Labels[i] = -1;
2405  return(i);
2406 }
2407 
2408 /*
2409  #] GetLabel :
2410  #[ ResetVariables :
2411 
2412  Resets the variables.
2413  par = 0 The list of temporary sets (after each .sort)
2414  par = 1 The list of local variables (after each .store)
2415  par = 2 All variables (after each .clear)
2416 */
2417 
2418 void ResetVariables(int par)
2419 {
2420  int i, j;
2421  TABLES T;
2422  switch ( par ) {
2423  case 0 : /* Only the sets without a name */
2424  AC.SetList.num = AC.SetList.numtemp;
2425  AC.SetElementList.num = AC.SetElementList.numtemp;
2426  break;
2427  case 2 :
2428  for ( i = AC.SymbolList.numclear; i < AC.SymbolList.num; i++ )
2429  AC.varnames->namenode[symbols[i].node].type = CDELETE;
2430  AC.SymbolList.num = AC.SymbolList.numglobal = AC.SymbolList.numclear;
2431  for ( i = AC.VectorList.numclear; i < AC.VectorList.num; i++ )
2432  AC.varnames->namenode[vectors[i].node].type = CDELETE;
2433  AC.VectorList.num = AC.VectorList.numglobal = AC.VectorList.numclear;
2434  for ( i = AC.IndexList.numclear; i < AC.IndexList.num; i++ )
2435  AC.varnames->namenode[indices[i].node].type = CDELETE;
2436  AC.IndexList.num = AC.IndexList.numglobal = AC.IndexList.numclear;
2437  for ( i = AC.FunctionList.numclear; i < AC.FunctionList.num; i++ ) {
2438  AC.varnames->namenode[functions[i].node].type = CDELETE;
2439  if ( ( T = functions[i].tabl ) != 0 ) {
2440  if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
2441  if ( T->prototype ) M_free(T->prototype,"tableprototype");
2442  if ( T->mm ) M_free(T->mm,"tableminmax");
2443  if ( T->flags ) M_free(T->flags,"tableflags");
2444  if ( T->argtail ) M_free(T->argtail,"table arguments");
2445  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
2446  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
2447  finishcbuf(T->buffers[j]);
2448  }
2449  /*[07apr2004 mt]:*/ /*memory leak*/
2450  if ( T->buffers ) M_free(T->buffers,"Table buffers");
2451  /*:[07apr2004 mt]*/
2452  finishcbuf(T->bufnum);
2453  if ( T->spare ) {
2454  TABLES TT = T->spare;
2455  if ( TT->mm ) M_free(TT->mm,"tableminmax");
2456  if ( TT->flags ) M_free(TT->flags,"tableflags");
2457  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2458  for (j = 0; j < TT->buffersfill; j++ ) { /* was <= */
2459  finishcbuf(TT->buffers[j]);
2460  }
2461  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
2462  /*[07apr2004 mt]:*/ /*memory leak*/
2463  if ( TT->buffers )M_free(TT->buffers,"Table buffers");
2464  /*:[07apr2004 mt]*/
2465  M_free(TT,"table");
2466  }
2467  M_free(T,"table");
2468  }
2469  }
2470  AC.FunctionList.num = AC.FunctionList.numglobal = AC.FunctionList.numclear;
2471  for ( i = AC.SetList.numclear; i < AC.SetList.num; i++ ) {
2472  if ( Sets[i].node >= 0 )
2473  AC.varnames->namenode[Sets[i].node].type = CDELETE;
2474  }
2475  AC.SetList.numtemp = AC.SetList.num = AC.SetList.numglobal = AC.SetList.numclear;
2476  for ( i = AC.DubiousList.numclear; i < AC.DubiousList.num; i++ )
2477  AC.varnames->namenode[Dubious[i].node].type = CDELETE;
2478  AC.DubiousList.num = AC.DubiousList.numglobal = AC.DubiousList.numclear;
2479  AC.SetElementList.numtemp = AC.SetElementList.num =
2480  AC.SetElementList.numglobal = AC.SetElementList.numclear;
2481  CompactifyTree(AC.varnames,VARNAMES);
2482  AC.varnames->namefill = AC.varnames->globalnamefill = AC.varnames->clearnamefill;
2483  AC.varnames->nodefill = AC.varnames->globalnodefill = AC.varnames->clearnodefill;
2484 
2485  for ( i = AC.AutoSymbolList.numclear; i < AC.AutoSymbolList.num; i++ )
2486  AC.autonames->namenode[
2487  ((SYMBOLS)(AC.AutoSymbolList.lijst))[i].node].type = CDELETE;
2488  AC.AutoSymbolList.num = AC.AutoSymbolList.numglobal
2489  = AC.AutoSymbolList.numclear;
2490  for ( i = AC.AutoVectorList.numclear; i < AC.AutoVectorList.num; i++ )
2491  AC.autonames->namenode[
2492  ((VECTORS)(AC.AutoVectorList.lijst))[i].node].type = CDELETE;
2493  AC.AutoVectorList.num = AC.AutoVectorList.numglobal
2494  = AC.AutoVectorList.numclear;
2495  for ( i = AC.AutoIndexList.numclear; i < AC.AutoIndexList.num; i++ )
2496  AC.autonames->namenode[
2497  ((INDICES)(AC.AutoIndexList.lijst))[i].node].type = CDELETE;
2498  AC.AutoIndexList.num = AC.AutoIndexList.numglobal
2499  = AC.AutoIndexList.numclear;
2500  for ( i = AC.AutoFunctionList.numclear; i < AC.AutoFunctionList.num; i++ ) {
2501  AC.autonames->namenode[
2502  ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].node].type = CDELETE;
2503  if ( ( T = ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl ) != 0 ) {
2504  if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
2505  if ( T->prototype ) M_free(T->prototype,"tableprototype");
2506  if ( T->mm ) M_free(T->mm,"tableminmax");
2507  if ( T->flags ) M_free(T->flags,"tableflags");
2508  if ( T->argtail ) M_free(T->argtail,"table arguments");
2509  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
2510  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
2511  finishcbuf(T->buffers[j]);
2512  }
2513  if ( T->spare ) {
2514  TABLES TT = T->spare;
2515  if ( TT->mm ) M_free(TT->mm,"tableminmax");
2516  if ( TT->flags ) M_free(TT->flags,"tableflags");
2517  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2518  for (j = 0; j < TT->buffersfill; j++ ) { /* was <= */
2519  finishcbuf(TT->buffers[j]);
2520  }
2521  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
2522  M_free(TT,"table");
2523  }
2524  M_free(T,"table");
2525  }
2526  }
2527  AC.AutoFunctionList.num = AC.AutoFunctionList.numglobal
2528  = AC.AutoFunctionList.numclear;
2529  CompactifyTree(AC.autonames,AUTONAMES);
2530  AC.autonames->namefill = AC.autonames->globalnamefill
2531  = AC.autonames->clearnamefill;
2532  AC.autonames->nodefill = AC.autonames->globalnodefill
2533  = AC.autonames->clearnodefill;
2534  ReleaseTB();
2535  break;
2536  case 1 :
2537  for ( i = AC.SymbolList.numglobal; i < AC.SymbolList.num; i++ )
2538  AC.varnames->namenode[symbols[i].node].type = CDELETE;
2539  AC.SymbolList.num = AC.SymbolList.numglobal;
2540  for ( i = AC.VectorList.numglobal; i < AC.VectorList.num; i++ )
2541  AC.varnames->namenode[vectors[i].node].type = CDELETE;
2542  AC.VectorList.num = AC.VectorList.numglobal;
2543  for ( i = AC.IndexList.numglobal; i < AC.IndexList.num; i++ )
2544  AC.varnames->namenode[indices[i].node].type = CDELETE;
2545  AC.IndexList.num = AC.IndexList.numglobal;
2546  for ( i = AC.FunctionList.numglobal; i < AC.FunctionList.num; i++ ) {
2547  AC.varnames->namenode[functions[i].node].type = CDELETE;
2548  if ( ( T = functions[i].tabl ) != 0 ) {
2549  if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
2550  if ( T->prototype ) M_free(T->prototype,"tableprototype");
2551  if ( T->mm ) M_free(T->mm,"tableminmax");
2552  if ( T->flags ) M_free(T->flags,"tableflags");
2553  if ( T->argtail ) M_free(T->argtail,"table arguments");
2554  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
2555  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
2556  finishcbuf(T->buffers[j]);
2557  }
2558  /*[07apr2004 mt]:*/ /*memory leak*/
2559  if ( T->buffers ) M_free(T->buffers,"Table buffers");
2560  /*:[07apr2004 mt]*/
2561  finishcbuf(T->bufnum);
2562  if ( T->spare ) {
2563  TABLES TT = T->spare;
2564  if ( TT->mm ) M_free(TT->mm,"tableminmax");
2565  if ( TT->flags ) M_free(TT->flags,"tableflags");
2566  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2567  for (j = 0; j < TT->buffersfill; j++ ) { /* was <= */
2568  finishcbuf(TT->buffers[j]);
2569  }
2570  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
2571  /*[07apr2004 mt]:*/ /*memory leak*/
2572  if ( TT->buffers ) M_free(TT->buffers,"Table buffers");
2573  /*:[07apr2004 mt]*/
2574  M_free(TT,"table");
2575  }
2576  M_free(T,"table");
2577  }
2578  }
2579 #ifdef TABLECLEANUP
2580  {
2581  int j;
2582  WORD *tp;
2583  for ( i = 0; i < AC.FunctionList.numglobal; i++ ) {
2584 /*
2585  Now, if the table definition is from after the .global
2586  while the function is from before, there is a problem.
2587  This could be resolved by defining CTable (=Table), Ntable
2588  and do away with the previous function definition.
2589 */
2590  if ( ( T = functions[i].tabl ) != 0 ) {
2591 /*
2592  First restore overwritten definitions.
2593 */
2594  if ( T->sparse ) {
2595  T->totind = T->mdefined;
2596  for ( j = 0, tp = T->tablepointers; j < T->totind; j++ ) {
2597  tp += T->numind;
2598 #if TABLEEXTENSION == 2
2599  tp[0] = tp[1];
2600 #else
2601  tp[0] = tp[2];
2602  tp[1] = tp[3];
2603  tp[4] = tp[5];
2604 #endif
2605  tp += TABLEEXTENSION;
2606  }
2607  RedoTableTree(T,T->totind);
2608  if ( T->spare ) {
2609  TABLES TT = T->spare;
2610  TT->totind = TT->mdefined;
2611  for ( j = 0, tp = TT->tablepointers; j < TT->totind; j++ ) {
2612  tp += TT->numind;
2613 #if TABLEEXTENSION == 2
2614  tp[0] = tp[1];
2615 #else
2616  tp[0] = tp[2];
2617  tp[1] = tp[3];
2618  tp[4] = tp[5];
2619 #endif
2620  tp += TABLEEXTENSION;
2621  }
2622  RedoTableTree(TT,TT->totind);
2623  cbuf[TT->bufnum].numlhs = cbuf[TT->bufnum].mnumlhs;
2624  cbuf[TT->bufnum].numrhs = cbuf[TT->bufnum].mnumrhs;
2625  }
2626  }
2627  else {
2628  for ( j = 0, tp = T->tablepointers; j < T->totind; j++ ) {
2629 #if TABLEEXTENSION == 2
2630  tp[0] = tp[1];
2631 #else
2632  tp[0] = tp[2];
2633  tp[1] = tp[3];
2634  tp[4] = tp[5];
2635 #endif
2636  }
2637  T->defined = T->mdefined;
2638  }
2639  cbuf[T->bufnum].numlhs = cbuf[T->bufnum].mnumlhs;
2640  cbuf[T->bufnum].numrhs = cbuf[T->bufnum].mnumrhs;
2641  }
2642  }
2643  }
2644 #endif
2645  AC.FunctionList.num = AC.FunctionList.numglobal;
2646  for ( i = AC.SetList.numglobal; i < AC.SetList.num; i++ ) {
2647  if ( Sets[i].node >= 0 )
2648  AC.varnames->namenode[Sets[i].node].type = CDELETE;
2649  }
2650  AC.SetList.numtemp = AC.SetList.num = AC.SetList.numglobal;
2651  for ( i = AC.DubiousList.numglobal; i < AC.DubiousList.num; i++ )
2652  AC.varnames->namenode[Dubious[i].node].type = CDELETE;
2653  AC.DubiousList.num = AC.DubiousList.numglobal;
2654  AC.SetElementList.numtemp = AC.SetElementList.num =
2655  AC.SetElementList.numglobal;
2656  CompactifyTree(AC.varnames,VARNAMES);
2657  AC.varnames->namefill = AC.varnames->globalnamefill;
2658  AC.varnames->nodefill = AC.varnames->globalnodefill;
2659 
2660  for ( i = AC.AutoSymbolList.numglobal; i < AC.AutoSymbolList.num; i++ )
2661  AC.autonames->namenode[
2662  ((SYMBOLS)(AC.AutoSymbolList.lijst))[i].node].type = CDELETE;
2663  AC.AutoSymbolList.num = AC.AutoSymbolList.numglobal;
2664  for ( i = AC.AutoVectorList.numglobal; i < AC.AutoVectorList.num; i++ )
2665  AC.autonames->namenode[
2666  ((VECTORS)(AC.AutoVectorList.lijst))[i].node].type = CDELETE;
2667  AC.AutoVectorList.num = AC.AutoVectorList.numglobal;
2668  for ( i = AC.AutoIndexList.numglobal; i < AC.AutoIndexList.num; i++ )
2669  AC.autonames->namenode[
2670  ((INDICES)(AC.AutoIndexList.lijst))[i].node].type = CDELETE;
2671  AC.AutoIndexList.num = AC.AutoIndexList.numglobal;
2672  for ( i = AC.AutoFunctionList.numglobal; i < AC.AutoFunctionList.num; i++ ) {
2673  AC.autonames->namenode[
2674  ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].node].type = CDELETE;
2675  if ( ( T = ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl ) != 0 ) {
2676  if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
2677  if ( T->prototype ) M_free(T->prototype,"tableprototype");
2678  if ( T->mm ) M_free(T->mm,"tableminmax");
2679  if ( T->flags ) M_free(T->flags,"tableflags");
2680  if ( T->argtail ) M_free(T->argtail,"table arguments");
2681  if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
2682  for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
2683  finishcbuf(T->buffers[j]);
2684  }
2685  if ( T->spare ) {
2686  TABLES TT = T->spare;
2687  if ( TT->mm ) M_free(TT->mm,"tableminmax");
2688  if ( TT->flags ) M_free(TT->flags,"tableflags");
2689  if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2690  for (j = 0; j < TT->buffersfill; j++ ) { /* was <= */
2691  finishcbuf(TT->buffers[j]);
2692  }
2693  if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
2694  M_free(TT,"table");
2695  }
2696  M_free(T,"table");
2697  }
2698  }
2699  AC.AutoFunctionList.num = AC.AutoFunctionList.numglobal;
2700 
2701  CompactifyTree(AC.autonames,AUTONAMES);
2702 
2703  AC.autonames->namefill = AC.autonames->globalnamefill;
2704  AC.autonames->nodefill = AC.autonames->globalnodefill;
2705  break;
2706  }
2707 }
2708 
2709 /*
2710  #] ResetVariables :
2711  #[ RemoveDollars :
2712 */
2713 
2714 void RemoveDollars()
2715 {
2716  DOLLARS d;
2717  CBUF *C = cbuf + AM.dbufnum;
2718  int numdollar = AP.DollarList.num;
2719  if ( numdollar > 0 ) {
2720  while ( numdollar > AM.gcNumDollars ) {
2721  numdollar--;
2722  d = Dollars + numdollar;
2723  if ( d->where && d->where != &(d->zero) && d->where != &(AM.dollarzero) ) {
2724  M_free(d->where,"dollar->where"); d->where = &(d->zero); d->size = 0;
2725  }
2726  AC.dollarnames->namenode[d->node].type = CDELETE;
2727  }
2728  AP.DollarList.num = AM.gcNumDollars;
2729  CompactifyTree(AC.dollarnames,DOLLARNAMES);
2730 
2731  C->numrhs = C->mnumrhs;
2732  C->numlhs = C->mnumlhs;
2733  }
2734 }
2735 
2736 /*
2737  #] RemoveDollars :
2738  #[ Globalize :
2739 */
2740 
2741 void Globalize(int par)
2742 {
2743  int i, j;
2744  WORD *tp;
2745  if ( par == 1 ) {
2746  AC.SymbolList.numclear = AC.SymbolList.num;
2747  AC.VectorList.numclear = AC.VectorList.num;
2748  AC.IndexList.numclear = AC.IndexList.num;
2749  AC.FunctionList.numclear = AC.FunctionList.num;
2750  AC.SetList.numclear = AC.SetList.num;
2751  AC.DubiousList.numclear = AC.DubiousList.num;
2752  AC.SetElementList.numclear = AC.SetElementList.num;
2753  AC.varnames->clearnamefill = AC.varnames->namefill;
2754  AC.varnames->clearnodefill = AC.varnames->nodefill;
2755 
2756  AC.AutoSymbolList.numclear = AC.AutoSymbolList.num;
2757  AC.AutoVectorList.numclear = AC.AutoVectorList.num;
2758  AC.AutoIndexList.numclear = AC.AutoIndexList.num;
2759  AC.AutoFunctionList.numclear = AC.AutoFunctionList.num;
2760  AC.autonames->clearnamefill = AC.autonames->namefill;
2761  AC.autonames->clearnodefill = AC.autonames->nodefill;
2762  }
2763 /* for ( i = AC.FunctionList.numglobal; i < AC.FunctionList.num; i++ ) { */
2764  for ( i = MAXBUILTINFUNCTION-FUNCTION; i < AC.FunctionList.num; i++ ) {
2765 /*
2766  We need here not only the not-yet-global functions. The already
2767  global ones may have obtained extra elements.
2768 */
2769  if ( functions[i].tabl ) {
2770  TABLES T = functions[i].tabl;
2771  if ( T->sparse ) {
2772  T->mdefined = T->totind;
2773  for ( j = 0, tp = T->tablepointers; j < T->totind; j++ ) {
2774  tp += T->numind;
2775 #if TABLEEXTENSION == 2
2776  tp[1] = tp[0];
2777 #else
2778  tp[2] = tp[0]; tp[3] = tp[1]; tp[5] = tp[4] & (~ELEMENTUSED);
2779 #endif
2780  tp += TABLEEXTENSION;
2781  }
2782  if ( T->spare ) {
2783  TABLES TT = T->spare;
2784  TT->mdefined = TT->totind;
2785  for ( j = 0, tp = TT->tablepointers; j < TT->totind; j++ ) {
2786  tp += TT->numind;
2787 #if TABLEEXTENSION == 2
2788  tp[1] = tp[0];
2789 #else
2790  tp[2] = tp[0]; tp[3] = tp[1]; tp[5] = tp[4] & (~ELEMENTUSED);
2791 #endif
2792  tp += TABLEEXTENSION;
2793  }
2794  cbuf[TT->bufnum].mnumlhs = cbuf[TT->bufnum].numlhs;
2795  cbuf[TT->bufnum].mnumrhs = cbuf[TT->bufnum].numrhs;
2796  }
2797  }
2798  else {
2799  T->mdefined = T->defined;
2800  for ( j = 0, tp = T->tablepointers; j < T->totind; j++ ) {
2801 #if TABLEEXTENSION == 2
2802  tp[1] = tp[0];
2803 #else
2804  tp[2] = tp[0]; tp[3] = tp[1]; tp[5] = tp[4] & (~ELEMENTUSED);
2805 #endif
2806  }
2807  }
2808  cbuf[T->bufnum].mnumlhs = cbuf[T->bufnum].numlhs;
2809  cbuf[T->bufnum].mnumrhs = cbuf[T->bufnum].numrhs;
2810  }
2811  }
2812  for ( i = AC.AutoFunctionList.numglobal; i < AC.AutoFunctionList.num; i++ ) {
2813  if ( ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl )
2814  ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl->mdefined =
2815  ((FUNCTIONS)(AC.AutoFunctionList.lijst))[i].tabl->defined;
2816  }
2817  AC.SymbolList.numglobal = AC.SymbolList.num;
2818  AC.VectorList.numglobal = AC.VectorList.num;
2819  AC.IndexList.numglobal = AC.IndexList.num;
2820  AC.FunctionList.numglobal = AC.FunctionList.num;
2821  AC.SetList.numglobal = AC.SetList.num;
2822  AC.DubiousList.numglobal = AC.DubiousList.num;
2823  AC.SetElementList.numglobal = AC.SetElementList.num;
2824  AC.varnames->globalnamefill = AC.varnames->namefill;
2825  AC.varnames->globalnodefill = AC.varnames->nodefill;
2826 
2827  AC.AutoSymbolList.numglobal = AC.AutoSymbolList.num;
2828  AC.AutoVectorList.numglobal = AC.AutoVectorList.num;
2829  AC.AutoIndexList.numglobal = AC.AutoIndexList.num;
2830  AC.AutoFunctionList.numglobal = AC.AutoFunctionList.num;
2831  AC.autonames->globalnamefill = AC.autonames->namefill;
2832  AC.autonames->globalnodefill = AC.autonames->nodefill;
2833 }
2834 
2835 /*
2836  #] Globalize :
2837  #[ TestName :
2838 */
2839 
2840 int TestName(UBYTE *name)
2841 {
2842  if ( *name == '[' ) {
2843  while ( *name ) name++;
2844  if ( name[-1] == ']' ) return(0);
2845  return(-1);
2846  }
2847  while ( *name ) {
2848  if ( *name == '_' ) return(-1);
2849  name++;
2850  }
2851  return(0);
2852 }
2853 
2854 /*
2855  #] TestName :
2856 */
2857 
WORD bufferssize
Definition: structs.h:366
void AddPotModdollar(WORD)
Definition: dollar.c:3771
WORD * buffers
Definition: structs.h:352
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
Definition: structs.h:429
int prototypeSize
Definition: structs.h:357
WORD size
Definition: structs.h:297
LONG namefill
Definition: structs.h:261
WORD type
Definition: structs.h:240
Definition: structs.h:483
NAMENODE * namenode
Definition: structs.h:253
WORD * pattern
Definition: structs.h:344
int sparse
Definition: structs.h:361
struct TaBlEs * spare
Definition: structs.h:351
int strict
Definition: structs.h:360
LONG symminfo
Definition: structs.h:463
WORD number
Definition: structs.h:241
WORD mode
Definition: structs.h:369
LONG nodefill
Definition: structs.h:259
LONG nodesize
Definition: structs.h:258
WORD node
Definition: structs.h:471
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:908
WORD parent
Definition: structs.h:236
Definition: structs.h:281
TABLES tabl
Definition: structs.h:462
LONG name
Definition: structs.h:235
WORD symmetric
Definition: structs.h:470
WORD * renumlists
Definition: structs.h:384
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 SortWild(WORD *, WORD)
Definition: sort.c:4269
int MaxTreeSize
Definition: structs.h:364
WORD bufnum
Definition: structs.h:365
WORD buffersfill
Definition: structs.h:367
WORD complex
Definition: structs.h:466
LONG defined
Definition: structs.h:355
MINMAX * mm
Definition: structs.h:346
COMPTREE * boomlijst
Definition: structs.h:348
WORD * prototype
Definition: structs.h:343
LONG name
Definition: structs.h:464
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:469
UBYTE * namebuffer
Definition: structs.h:255
WORD right
Definition: structs.h:238
WORD namesize
Definition: structs.h:472
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
struct TaBlEs * TABLES
WORD commute
Definition: structs.h:465