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