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