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