FORM 4.3
comexpr.c
Go to the documentation of this file.
1
8/* #[ License : */
9/*
10 * Copyright (C) 1984-2022 J.A.M. Vermaseren
11 * When using this file you are requested to refer to the publication
12 * J.A.M.Vermaseren "New features of FORM" math-ph/0010025
13 * This is considered a matter of courtesy as the development was paid
14 * for by FOM the Dutch physics granting agency and we would like to
15 * be able to track its scientific use to convince FOM of its value
16 * for the community.
17 *
18 * This file is part of FORM.
19 *
20 * FORM is free software: you can redistribute it and/or modify it under the
21 * terms of the GNU General Public License as published by the Free Software
22 * Foundation, either version 3 of the License, or (at your option) any later
23 * version.
24 *
25 * FORM is distributed in the hope that it will be useful, but WITHOUT ANY
26 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
27 * FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
28 * details.
29 *
30 * You should have received a copy of the GNU General Public License along
31 * with FORM. If not, see <http://www.gnu.org/licenses/>.
32 */
33/* #] License : */
34
35/*
36 #[ Includes : compi2.c
37
38 File contains most of what has to do with compiling expressions.
39 Main supporting file: token.c
40*/
41
42#include "form3.h"
43
44static struct id_options {
45 UBYTE *name;
46 int code;
47 int dummy;
48} IdOptions[] = {
49 {(UBYTE *)"multi", SUBMULTI ,0}
50 ,{(UBYTE *)"many", SUBMANY ,0}
51 ,{(UBYTE *)"only", SUBONLY ,0}
52 ,{(UBYTE *)"once", SUBONCE ,0}
53 ,{(UBYTE *)"ifmatch", SUBAFTER ,0}
54 ,{(UBYTE *)"ifnomatch", SUBAFTERNOT ,0}
55 ,{(UBYTE *)"ifnotmatch", SUBAFTERNOT ,0}
56 ,{(UBYTE *)"disorder", SUBDISORDER ,0}
57 ,{(UBYTE *)"select", SUBSELECT ,0}
58 ,{(UBYTE *)"all", SUBALL ,0}
59};
60
61/*
62 #] Includes :
63 #[ CoLocal :
64*/
65
66int CoLocal(UBYTE *inp) { return(DoExpr(inp,LOCALEXPRESSION,0)); }
67
68/*
69 #] CoLocal :
70 #[ CoGlobal :
71*/
72
73int CoGlobal(UBYTE *inp) { return(DoExpr(inp,GLOBALEXPRESSION,0)); }
74
75/*
76 #] CoGlobal :
77 #[ CoLocalFactorized :
78*/
79
80int CoLocalFactorized(UBYTE *inp) { return(DoExpr(inp,LOCALEXPRESSION,1)); }
81
82/*
83 #] CoLocalFactorized :
84 #[ CoGlobalFactorized :
85*/
86
87int CoGlobalFactorized(UBYTE *inp) { return(DoExpr(inp,GLOBALEXPRESSION,1)); }
88
89/*
90 #] CoGlobalFactorized :
91 #[ DoExpr:
92
93
94*/
95
96int DoExpr(UBYTE *inp, int type, int par)
97{
98 GETIDENTITY
99 int error = 0;
100 UBYTE *p, *q, c;
101 WORD *w, i, j = 0, c1, c2, *OldWork = AT.WorkPointer, osize;
102 WORD jold = 0;
103 POSITION pos;
104 while ( *inp == ',' ) inp++;
105 if ( par ) AC.ToBeInFactors = 1;
106 else AC.ToBeInFactors = 0;
107 p = inp;
108 while ( *p && *p != '=' ) {
109 if ( *p == '(' ) SKIPBRA4(p)
110 else if ( *p == '{' ) SKIPBRA5(p)
111 else if ( *p == '[' ) SKIPBRA1(p)
112 else p++;
113 }
114 if ( *p ) { /* Variety with the = sign */
115 if ( ( q = SkipAName(inp) ) == 0 || q[-1] == '_' ) {
116 MesPrint("&Illegal name for expression");
117 error = 1;
118 if ( q[-1] == '_' ) {
119 while ( FG.cTable[*q] < 2 || *q == '_' ) q++;
120 }
121 }
122 else {
123 c = *q; *q = 0;
124 if ( GetVar(inp,&c1,&c2,ALLVARIABLES,NOAUTO) != NAMENOTFOUND ) {
125 if ( c1 == CEXPRESSION ) {
126 if ( Expressions[c2].status == STOREDEXPRESSION ) {
127 MesPrint("&Illegal attempt to overwrite a stored expression");
128 error = 1;
129 }
130 else {
131 HighWarning("Expression is replaced by new definition");
132 if ( AO.OptimizeResult.nameofexpr != NULL &&
133 StrCmp(inp,AO.OptimizeResult.nameofexpr) == 0 ) {
135 }
136 if ( Expressions[c2].status != DROPPEDEXPRESSION ) {
137 w = &(Expressions[c2].status);
138 if ( *w == LOCALEXPRESSION || *w == SKIPLEXPRESSION )
139 *w = DROPLEXPRESSION;
140 else if ( *w == GLOBALEXPRESSION || *w == SKIPGEXPRESSION )
141 *w = DROPGEXPRESSION;
142 else if ( *w == HIDDENLEXPRESSION )
143 *w = DROPHLEXPRESSION;
144 else if ( *w == HIDDENGEXPRESSION )
145 *w = DROPHGEXPRESSION;
146 }
147 AC.TransEname = Expressions[c2].name;
148 j = EntVar(CEXPRESSION,0,type,0,0,0);
149 Expressions[j].node = Expressions[c2].node;
150 Expressions[c2].replace = j;
151 }
152 }
153 else {
154 MesPrint("&name of expression is also name of a variable");
155 error = 1;
156 j = EntVar(CEXPRESSION,inp,type,0,0,0);
157 }
158 jold = c2;
159 }
160 else {
161/*
162 Here we have to worry about reuse of the expression in the
163 same module. That will need AS.Oldvflags but that may not
164 be defined or have the proper value.
165*/
166 j = EntVar(CEXPRESSION,inp,type,0,0,0);
167 jold = j;
168 }
169 *q = c;
170 OldWork = w = AT.WorkPointer;
171 *w++ = TYPEEXPRESSION;
172 *w++ = 3+SUBEXPSIZE;
173 *w++ = j;
174 AC.ProtoType = w;
175 AR.CurExpr = j; /* Block expression j */
176 *w++ = SUBEXPRESSION;
177 *w++ = SUBEXPSIZE;
178 *w++ = j;
179 *w++ = 1;
180 *w++ = AC.cbufnum;
181 FILLSUB(w)
182
183 if ( c == '(' ) {
184 while ( *q == ',' || *q == '(' ) {
185 inp = q+1;
186 if ( ( q = SkipAName(inp) ) == 0 ) {
187 MesPrint("&Illegal name for expression argument");
188 error = 1;
189 q = p - 1;
190 break;
191 }
192 c = *q; *q = 0;
193 if ( GetVar(inp,&c1,&c2,ALLVARIABLES,WITHAUTO) < 0 ) c1 = -1;
194 switch ( c1 ) {
195 case CSYMBOL :
196 *w++ = SYMTOSYM; *w++ = 4; *w++ = c2; *w++ = 0;
197 break;
198 case CINDEX :
199 *w++ = INDTOIND; *w++ = 4;
200 *w++ = c2 + AM.OffsetIndex; *w++ = 0;
201 break;
202 case CVECTOR :
203 *w++ = VECTOVEC; *w++ = 4;
204 *w++ = c2 + AM.OffsetVector; *w++ = 0;
205 break;
206 case CFUNCTION :
207 *w++ = FUNTOFUN; *w++ = 4; *w++ = c2 + FUNCTION; *w++ = 0;
208 break;
209 default :
210 MesPrint("&Illegal expression parameter: %s",inp);
211 error = 1;
212 break;
213 }
214 *q = c;
215 }
216 if ( *q != ')' || q+1 != p ) {
217 MesPrint("&Illegal use of arguments for expression");
218 error = 1;
219 }
220 AC.ProtoType[1] = w - AC.ProtoType;
221 }
222 else if ( c != '=' ) {
223/*
224 The dummy accepted L F := RHS;
225*/
226 MesPrint("&Illegal LHS for expression definition");
227 error = 1;
228 }
229 *w++ = 1;
230 *w++ = 1;
231 *w++ = 3;
232 *w++ = 0;
233 SeekScratch(AR.outfile,&pos);
234 Expressions[j].counter = 1;
235 Expressions[j].onfile = pos;
236 Expressions[j].whichbuffer = 0;
237#ifdef PARALLELCODE
238 Expressions[j].partodo = AC.inparallelflag;
239#endif
240 OldWork[2] = w - OldWork - 3;
241 AT.WorkPointer = w;
242/*
243 Writing the expression prototype to disk and to the compiler
244 buffer is done only after the RHS has been compiled because
245 we don't know the number of the main level RHS yet.
246*/
247 }
248 inp = p+1;
249 ClearWildcardNames();
250 osize = AC.ProtoType[1]; AC.ProtoType[1] = SUBEXPSIZE;
251 PutInVflags(jold);
252 if ( ( i = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) {
253 AC.ProtoType[1] = osize;
254 error = 1;
255 }
256 else if ( error == 0 ) {
257 AC.ProtoType[1] = osize;
258 AC.ProtoType[2] = i;
259 if ( PutOut(BHEAD OldWork+2,&pos,AR.outfile,0) < 0 ) {
260 MesPrint("&Cannot create expression");
261 error = -1;
262 }
263 else {
264 Expressions[j].sizeprototype = OldWork[2];
265 OldWork[2] = 4+SUBEXPSIZE;
266 OldWork[4] = SUBEXPSIZE;
267 OldWork[5] = i;
268 OldWork[SUBEXPSIZE+3] = 1;
269 OldWork[SUBEXPSIZE+4] = 1;
270 OldWork[SUBEXPSIZE+5] = 3;
271 OldWork[SUBEXPSIZE+6] = 0;
272 if ( PutOut(BHEAD OldWork+2,&pos,AR.outfile,0) < 0
273 || FlushOut(&pos,AR.outfile,0) ) {
274 MesPrint("&Cannot create expression");
275 error = -1;
276 }
277 AR.outfile->POfull = AR.outfile->POfill;
278 }
279 OldWork[2] = j;
280/*
281 Seems unnecessary (13-feb-2018)
282
283 AddNtoL(OldWork[1],OldWork);
284*/
285 AT.WorkPointer = OldWork;
286 if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
287 }
288 AC.ToBeInFactors = 0;
289 }
290 else { /* Variety in which expressions change property */
291/*
292 This code got a major revision because it didn't
293 take hidden expressions into account. (1-jun-2010 JV)
294*/
295 do {
296 if ( ( q = SkipAName(inp) ) == 0 ) {
297 MesPrint("&Illegal name(s) for expression(s)");
298 return(1);
299 }
300 c = *q; *q = 0;
301 if ( GetName(AC.exprnames,inp,&c2,NOAUTO) == NAMENOTFOUND ) {
302 MesPrint("&%s is not a valid expression",inp);
303 error = 1;
304 }
305 else {
306 w = &(Expressions[c2].status);
307 if ( type == LOCALEXPRESSION ) {
308 switch ( *w ) {
309 case GLOBALEXPRESSION:
310 *w = LOCALEXPRESSION;
311 break;
312 case SKIPGEXPRESSION:
313 *w = SKIPLEXPRESSION;
314 break;
315 case DROPGEXPRESSION:
316 *w = DROPLEXPRESSION;
317 break;
318 case HIDDENGEXPRESSION:
319 *w = HIDDENLEXPRESSION;
320 break;
321 case HIDEGEXPRESSION:
322 *w = HIDELEXPRESSION;
323 break;
324 case UNHIDEGEXPRESSION:
325 *w = UNHIDELEXPRESSION;
326 break;
327 case INTOHIDEGEXPRESSION:
328 *w = INTOHIDELEXPRESSION;
329 break;
330 case DROPHGEXPRESSION:
331 *w = DROPHLEXPRESSION;
332 break;
333 }
334 }
335 else if ( type == GLOBALEXPRESSION ) {
336 switch ( *w ) {
337 case LOCALEXPRESSION:
338 *w = GLOBALEXPRESSION;
339 break;
340 case SKIPLEXPRESSION:
341 *w = SKIPGEXPRESSION;
342 break;
343 case DROPLEXPRESSION:
344 *w = DROPGEXPRESSION;
345 break;
346 case HIDDENLEXPRESSION:
347 *w = HIDDENGEXPRESSION;
348 break;
349 case HIDELEXPRESSION:
350 *w = HIDEGEXPRESSION;
351 break;
352 case UNHIDELEXPRESSION:
353 *w = UNHIDEGEXPRESSION;
354 break;
355 case INTOHIDELEXPRESSION:
356 *w = INTOHIDEGEXPRESSION;
357 break;
358 case DROPHLEXPRESSION:
359 *w = DROPHGEXPRESSION;
360 break;
361 }
362 }
363/*
364 old code
365 if ( type != LOCALEXPRESSION || *w != STOREDEXPRESSION )
366 *w = type;
367*/
368 }
369 *q = c; inp = q+1;
370 } while ( c == ',' );
371 if ( c ) {
372 MesPrint("&Illegal object in local or global redefinition");
373 error = 1;
374 }
375 }
376 return(error);
377}
378
379/*
380 #] DoExpr:
381 #[ CoIdOld :
382*/
383
384int CoIdOld(UBYTE *inp)
385{
386 AC.idoption = 0;
387 return(CoIdExpression(inp,TYPEIDOLD));
388}
389
390/*
391 #] CoIdOld :
392 #[ CoId :
393*/
394
395int CoId(UBYTE *inp)
396{
397 AC.idoption = 0;
398 return(CoIdExpression(inp,TYPEIDNEW));
399}
400
401/*
402 #] CoId :
403 #[ CoIdNew :
404*/
405
406int CoIdNew(UBYTE *inp)
407{
408 AC.idoption = 0;
409 return(CoIdExpression(inp,TYPEIDNEW));
410}
411
412/*
413 #] CoIdNew :
414 #[ CoDisorder :
415*/
416
417int CoDisorder(UBYTE *inp)
418{
419 AC.idoption = SUBDISORDER;
420 return(CoIdExpression(inp,TYPEIDNEW));
421}
422
423/*
424 #] CoDisorder :
425 #[ CoMany :
426*/
427
428int CoMany(UBYTE *inp)
429{
430 AC.idoption = SUBMANY;
431 return(CoIdExpression(inp,TYPEIDNEW));
432}
433
434/*
435 #] CoMany :
436 #[ CoMulti :
437*/
438
439int CoMulti(UBYTE *inp)
440{
441 AC.idoption = SUBMULTI;
442 return(CoIdExpression(inp,TYPEIDNEW));
443}
444
445/*
446 #] CoMulti :
447 #[ CoIfMatch :
448*/
449
450int CoIfMatch(UBYTE *inp)
451{
452 AC.idoption = SUBAFTER;
453 return(CoIdExpression(inp,TYPEIDNEW));
454}
455
456/*
457 #] CoIfMatch :
458 #[ CoIfNoMatch :
459*/
460
461int CoIfNoMatch(UBYTE *inp)
462{
463 AC.idoption = SUBAFTERNOT;
464 return(CoIdExpression(inp,TYPEIDNEW));
465}
466
467/*
468 #] CoIfNoMatch :
469 #[ CoOnce :
470*/
471
472int CoOnce(UBYTE *inp)
473{
474 AC.idoption = SUBONCE;
475 return(CoIdExpression(inp,TYPEIDNEW));
476}
477
478/*
479 #] CoOnce :
480 #[ CoOnly :
481*/
482
483int CoOnly(UBYTE *inp)
484{
485 AC.idoption = SUBONLY;
486 return(CoIdExpression(inp,TYPEIDNEW));
487}
488
489/*
490 #] CoOnly :
491 #[ CoSelect :
492*/
493
494int CoSelect(UBYTE *inp)
495{
496 AC.idoption = SUBSELECT;
497 return(CoIdExpression(inp,TYPEIDNEW));
498}
499
500/*
501 #] CoSelect :
502 #[ CoIdExpression :
503
504 First finish dealing with secondary keywords
505*/
506
507int CoIdExpression(UBYTE *inp, int type)
508{
509 GETIDENTITY
510 int i, j, idhead, error = 0, MinusSign = 0, opt, retcode;
511 WORD *w, *s, *m, *mm, *ww, *FirstWork, *OldWork, c1, numsets = 0,
512 oldnumrhs, *ow, oldEside;
513 UBYTE *p, *pp, c;
514 CBUF *C = cbuf+AC.cbufnum;
515 LONG oldcpointer, x;
516 FirstWork = OldWork = AT.WorkPointer;
517/*
518 Don't forget to change in StudyPattern if we change/add_to the
519 following setup.
520 if ( type == TYPEIF ) idhead = IDHEAD-1;
521 else
522*/
523 idhead = IDHEAD;
524 AR.CurExpr = -1;
525 w = AT.WorkPointer;
526 *w++ = type;
527 *w++ = idhead + SUBEXPSIZE;
528 w++;
529 if ( idhead >= IDHEAD ) *w++ = -1;
530#if IDHEAD > 4
531 for ( i = 4; i < idhead; i++ ) *w++ = 0;
532#endif
533 while ( *inp == ',' ) inp++;
534 p = inp;
535 if ( AC.idoption == SUBSELECT ) {
536 p--;
537 goto findsets;
538 }
539 else if ( ( AC.idoption == SUBAFTER ) || ( AC.idoption == SUBAFTERNOT ) ) {
540 while ( *p && *p != '=' && *p != ',' ) {
541 if ( *p == '(' ) SKIPBRA4(p)
542 else if ( *p == '{' ) SKIPBRA5(p)
543 else if ( *p == '[' ) SKIPBRA1(p)
544 else p++;
545 }
546 if ( *p == '=' || *inp != '-' || inp[1] != '>' ) {
547 MesPrint("&Illegal use if if[no]match in id statement");
548 error = 1; goto AllDone;
549 }
550 if ( *p == 0 ) {
551 MesPrint("&id-statement without = sign");
552 error = 1; goto AllDone;
553 }
554 inp += 2; pp = inp;
555 goto readlabel;
556 }
557 for(;;) {
558 while ( *p && *p != '=' && *p != ',' ) {
559 if ( *p == '(' ) SKIPBRA4(p)
560 else if ( *p == '{' ) SKIPBRA5(p)
561 else if ( *p == '[' ) SKIPBRA1(p)
562 else p++;
563 }
564 if ( *p == '=' ) break;
565 if ( *p == 0 ) {
566 MesPrint("&id-statement without = sign");
567 error = 1; goto AllDone;
568 }
569/*
570 We have either a secondary option or a syntax error
571*/
572 pp = inp;
573 while ( FG.cTable[*pp] == 0 ) pp++;
574 c = *pp; *pp = 0;
575 i = sizeof(IdOptions)/sizeof(struct id_options);
576 while ( --i >= 0 ) {
577 if ( StrICmp(inp,IdOptions[i].name) == 0 ) break;
578 }
579 if ( i < 0 ) {
580 MesPrint("&Illegal option %s in id-statement",inp);
581 *pp = c; error = 1; p++; inp = p; continue;
582 }
583 opt = IdOptions[i].code;
584 *pp = c;
585 inp = pp+1;
586 switch ( opt ) {
587 case SUBDISORDER:
588 if ( pp != p ) goto IllField;
589 AC.idoption |= SUBDISORDER;
590 p++; inp = p;
591 break;
592 case SUBSELECT:
593 if ( p != pp ) goto IllField;
594 if ( ( AC.idoption & SUBMASK ) != 0 ) {
595 if ( AC.idoption == SUBMULTI && type == TYPEIF ) {}
596 else {
597 MesPrint("&Conflicting options in id-statement");
598 error = 1;
599 }
600 }
601findsets:;
602/*
603 Now we read the sets
604*/
605 numsets = 0;
606 for(;;) {
607 inp = ++p;
608 while ( *p && *p != '=' && *p != ',' ) {
609 if ( *p == '(' ) SKIPBRA4(p)
610 else if ( *p == '{' ) SKIPBRA5(p)
611 else if ( *p == '[' ) SKIPBRA1(p)
612 else p++;
613 }
614 if ( *p == '=' ) break;
615 if ( *p == 0 ) {
616 MesPrint("&id-statement without = sign");
617 error = 1; goto AllDone;
618 }
619/*
620 We have a set at inp.
621*/
622 if ( *inp == '{' ) {
623 if ( p[-1] != '}' ) {
624 c = *p; *p = 0;
625 MesPrint("&Illegal temporary set: %s",inp);
626 error = 1; *p = c;
627 }
628 else {
629 inp++;
630 c = p[-1]; p[-1] = 0;
631 c1 = DoTempSet(inp,p-1);
632 *w++ = c1;
633 p[-1] = c;
634 numsets++;
635 if ( w[-1] < 0 ) error = 1;
636 }
637 }
638 else {
639 c = *p; *p = 0;
640 if ( GetName(AC.varnames,inp,&c1,NOAUTO) != CSET ) {
641 MesPrint("&%s is not a set",inp);
642 error = 1;
643 }
644 else {
645 if ( c1 < AM.NumFixedSets ) {
646 MesPrint("&Built in sets are not allowed in the select option");
647 error = 1;
648 }
649 else if ( Sets[c1].type == CRANGE ) {
650 MesPrint("&Ranged sets are not allowed in the select option");
651 error = 1;
652 }
653 numsets++;
654 *w++ = c1;
655 }
656 *p = c;
657 }
658 }
659/*
660 Now exchange the positions a bit.
661 Regular stuff at OldWork, numsets sets at FirstWork[idhead]
662*/
663 OldWork = w;
664 for ( i = 0; i < idhead; i++ ) *w++ = FirstWork[i];
665 AC.idoption = SUBSELECT;
666 break;
667 case SUBAFTER:
668 case SUBAFTERNOT:
669 if ( type == TYPEIF ) {
670 MesPrint("&The if[no]match->label option is not allowed in an if statement");
671 error = 1; goto AllDone;
672 }
673 if ( pp[0] != '-' || pp[1] != '>' ) goto IllField;
674 pp += 2; /* points now at the label */
675 inp = pp;
676 AC.idoption |= opt;
677readlabel:
678 while ( FG.cTable[*pp] <= 1 ) pp++;
679 if ( pp != p ) {
680 c = *p; *p = 0;
681 MesPrint("&Illegal label %s in if[no]match option of id-statement",inp);
682 *p = c; error = 1; inp = p+1; continue;
683 }
684 c = *p; *p = 0;
685 OldWork[3] = GetLabel(inp);
686 *p++ = c; inp = p;
687 break;
688 case SUBALL:
689 x = 0;
690 if ( *pp == '(' ) {
691 if ( FG.cTable[*inp] == 1 ) {
692 while ( *inp >= '0' && *inp <= '9' ) x = 10*x+*inp++ - '0';
693 }
694 else {
695 pp++;
696 while ( FG.cTable[*inp] == 0 ) inp++;
697 c = *inp; *inp = 0;
698 if ( StrICont(pp,(UBYTE *)"normalize") != 0 ) goto IllOpt;
699 *inp = c;
700 OldWork[4] |= NORMALIZEFLAG;
701 }
702 if ( *inp != ')' || inp+1 != p ) {
703 c = *inp; *inp = 0;
704IllOpt:
705 MesPrint("&Illegal ALL option in id-statement: ",pp);
706 *inp++ = c;
707 error = 1;
708 continue;
709 }
710 pp = inp;
711 inp = pp+1;
712 }
713/*
714 Note that the following statement limits x to
715*/
716 if ( x > MAXPOSITIVE ) {
717 MesPrint("&Requested maximum number of matches %l in ALL option in id-statement is greater than %l ",x,MAXPOSITIVE);
718 error = 1;
719 }
720 OldWork[5] = x;
721 if ( type != TYPEIDNEW ) {
722 if ( type == TYPEIDOLD ) {
723 MesPrint("&Requested ALL option not allowed in idold/also statement.");
724 error = 1;
725 }
726 else if ( type == TYPEIF ) {
727 MesPrint("&Requested ALL option not allowed in if(match())");
728 error = 1;
729 }
730 else {
731 MesPrint("&ALL option only allowed in regular id-statement.");
732 error = 1;
733 }
734 }
735 p++; inp = p;
736 AC.idoption = opt;
737 break;
738 default:
739 if ( pp != p ) {
740IllField: c = *p; *p = 0;
741 MesPrint("&Illegal optionfield %s in id-statement",inp);
742 *p = c; error = 1; inp = p+1; continue;
743 }
744 i = AC.idoption & SUBMASK;
745 if ( i && i != opt ) {
746 MesPrint("&Conflicting options in id-statement");
747 error = 1; continue;
748 }
749 else AC.idoption |= opt;
750 while ( *p == ',' ) p++;
751 inp = p;
752 break;
753 }
754 }
755 if ( ( AC.idoption & SUBMASK ) == 0 ) AC.idoption |= SUBMULTI;
756 OldWork[2] = AC.idoption;
757/*
758 Now we have a field till the = sign
759 Now the subexpression prototype
760*/
761 AC.ProtoType = w;
762 *w++ = SUBEXPRESSION;
763 *w++ = SUBEXPSIZE;
764 *w++ = C->numrhs+1;
765 *w++ = 1;
766 *w++ = AC.cbufnum;
767 FILLSUB(w)
768 AC.WildC = w;
769 AC.NwildC = 0;
770 AT.WorkPointer = s = w + 4*AM.MaxWildcards + 8;
771/*
772 Now read the LHS
773*/
774 ClearWildcardNames();
775 oldcpointer = AddLHS(AC.cbufnum) - C->Buffer;
776
777 *p = 0;
778 oldnumrhs = C->numrhs;
779 if ( ( retcode = CompileAlgebra(inp,LHSIDE,AC.ProtoType) ) < 0 ) { error = 1; }
780 else AC.ProtoType[2] = retcode;
781 *p = '='; inp = p+1;
782 AT.WorkPointer = s;
783 if ( AC.NwildC && SortWild(w,AC.NwildC) ) error = 1;
784
785 /* Make the LHS pointers ready */
786
787 OldWork[1] = AC.WildC-OldWork;
788 OldWork[idhead+1] = OldWork[1] - idhead;
789 w = AC.WildC;
790 AT.WorkPointer = w;
791 s = C->rhs[C->numrhs];
792/*
793 Now check whether wildcards get converted to dollars (for PARALLEL)
794*/
795 {
796 WORD *tw, *twstop;
797 tw = AC.ProtoType; twstop = tw + tw[1]; tw += SUBEXPSIZE;
798 while ( tw < twstop ) {
799 if ( *tw == LOADDOLLAR ) {
800 AddPotModdollar(tw[2]);
801 }
802 tw += tw[1];
803 }
804 }
805/*
806 We have the expression in the compiler buffers.
807 The main level is at lhs[numlhs]
808 The partial lhs (including ProtoType) is in OldWork (in WorkSpace)
809 We need to load the result at w after the prototype
810 Because these sort routines don't use the WorkSpace
811 there should not be a conflict
812*/
813 if ( !error && *s == 0 ) {
814IllLeft:MesPrint("&Illegal LHS");
815 AC.lhdollarflag = 0;
816 return(1);
817 }
818 if ( !error && *(s+*s) != 0 ) {
819 MesPrint("&LHS should be one term only");
820 return(1);
821 }
822 if ( error == 0 ) {
823 WORD oldpolyfun = AR.PolyFun;
824 if ( NewSort(BHEAD0) || NewSort(BHEAD0) ) {
825 if ( !error ) error = 1;
826 return(error);
827 }
828 AN.RepPoint = AT.RepCount + 1;
829 ow = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
830 mm = s; ww = ow; i = *mm;
831 while ( --i >= 0 ) *ww++ = *mm++; AT.WorkPointer = ww;
832 AC.lhdollarflag = 0; oldEside = AR.Eside; AR.Eside = LHSIDE;
833 AR.Cnumlhs = C->numlhs;
834 AR.PolyFun = 0;
835 if ( Generator(BHEAD ow,C->numlhs) ) {
836 AR.Eside = oldEside;
837 LowerSortLevel(); LowerSortLevel(); AR.PolyFun = oldpolyfun; goto IllLeft;
838 }
839 AR.Eside = oldEside;
840 AT.WorkPointer = w;
841 if ( EndSort(BHEAD w,0) < 0 ) { LowerSortLevel(); AR.PolyFun = oldpolyfun; goto IllLeft; }
842 AR.PolyFun = oldpolyfun;
843 if ( *w == 0 || *(w+*w) != 0 ) {
844 MesPrint("&LHS must be one term");
845 AC.lhdollarflag = 0;
846 return(1);
847 }
849 if ( AC.lhdollarflag ) MarkDirty(w,DIRTYFLAG);
850 }
851 AT.WorkPointer = w + *w;
852 AC.DumNum = 0;
853/*
854 Everything is now after OldWork. We can pop the compilerbuffer.
855 Next test for illegal things like a coefficient
856 At this point we have:
857 w = the term of the LHS
858*/
859 C->Pointer = C->Buffer + oldcpointer;
860 C->numrhs = oldnumrhs;
861 C->numlhs--;
862
863 m = w + *w - 3;
864 AC.vectorlikeLHS = 0;
865 if ( !error ) {
866 if ( m[2] != 3 || m[1] != 1 || *m != 1 ) {
867 if ( *m == 1 && m[1] == 1 && m[2] == -3 ) {
868 MinusSign = 1;
869 }
870 else {
871 MesPrint("&Coefficient in LHS");
872 error = 1;
873 AC.DumNum = 0;
874 *w -= ABS(m[2])-3;
875 }
876 }
877 if ( *w == 7 && w[1] == INDEX && w[3] < 0 ) {
878 if ( ( AC.idoption & SUBMASK ) != 0 && ( AC.idoption & SUBMASK ) !=
879 SUBMULTI ) {
880 MesPrint("&Illegal option for substitution of a vector");
881 error = 1;
882 }
883 AC.DumNum = AM.IndDum;
884 OldWork[2] = ( OldWork[2] - ( OldWork[2] & SUBMASK ) ) | SUBVECTOR;
885 c1 = w[3];
886 /* We overwrite the LHS */
887 *w++ = INDTOIND;
888 *w++ = 4;
889 *w++ = AC.DumNum + WILDOFFSET;
890 *w++ = 0;
891 w[0] = 5;
892 w[1] = VECTOR;
893 w[2] = 4;
894 w[3] = c1;
895 w[4] = AC.DumNum + WILDOFFSET;
896 OldWork[idhead+1] = w - OldWork - idhead;
897 AC.vectorlikeLHS = 1;
898 }
899 else {
900 AC.DumNum = 0;
901 *w -= 3;
902 i = OldWork[2] & SUBMASK;
903 m = w + *w;
904 if ( i == 0 || i == SUBMULTI ) {
905 s = w+1;
906 while ( s < m ) {
907 if ( *s == SYMBOL ) {
908 j = s[1]/2; s += 2;
909 while ( --j >= 0 ) {
910 if ( ABS(s[1]) > 2*MAXPOWER ) {
911 OldWork[2] = ( OldWork[2] - i ) | SUBONCE;
912 break;
913 }
914 s += 2;
915 }
916 if ( j >= 0 ) break;
917 }
918 else if ( *s == DOTPRODUCT ) {
919 j = s[1]/3; s += 2;
920 while ( --j >= 0 ) {
921 if ( ABS(s[2]) > 2*MAXPOWER ) {
922 OldWork[2] = ( OldWork[2] - i ) | SUBONCE;
923 break;
924 }
925 else if ( s[1] >= -(2*WILDOFFSET) || s[0] >= -(2*WILDOFFSET) ) {
926 OldWork[2] = ( OldWork[2] - i ) | SUBMANY;
927 i = SUBMANY;
928 }
929 s += 3;
930 }
931 if ( j >= 0 ) break;
932 }
933 else {
934 OldWork[2] = ( OldWork[2] - i ) | SUBMANY;
935 break;
936 }
937 }
938 }
939 if ( ( OldWork[2] & SUBMASK ) == 0 ) OldWork[2] |= SUBMULTI;
940 }
941 if ( ( OldWork[2] & SUBMASK ) == SUBSELECT ) {
942/*
943 Paste the SETSET information after the pattern.
944 Important note: We will still get function information for the
945 smart patternmatching after it. To distinguish them we need to have
946 that SETSET != m*n+1 in which m is the number of words per function
947 and n the number of functions. Currently (29-may-1997) m = 4.
948*/
949 *m++ = SETSET;
950 *m++ = numsets+2;
951 s = FirstWork + idhead;
952 while ( --numsets >= 0 ) *m++ = *s++;
953 }
954 else {
955 m = w + *w;
956 }
957 }
958/*
959 We keep the whole thing in OldWork for the moment.
960 We still have to add the number of the RHS expression.
961 There is also some opportunity now to be smart about the pattern.
962 This is needed for complicated wildcarding with symmetric functions.
963 We do this in a special routine during compile time to make sure
964 that we loose as little time as possible (during running) if there
965 is no need to be smart.
966*/
967 *m++ = 0;
968 OldWork[1] = m - OldWork;
969 AC.ProtoType = OldWork+idhead;
970 if ( !error ) {
971 if ( StudyPattern(OldWork) ) error = 1;
972 }
973 AT.WorkPointer = OldWork + OldWork[1];
974 if ( AC.lhdollarflag ) OldWork[4] |= DOLLARFLAG;
975 AC.lhdollarflag = 0;
976/*
977 Test whether the id/idold configuration is fine.
978*/
979 if ( type == TYPEIDOLD ) {
980 WORD ci = C->numlhs;
981 while ( ci >= 1 ) {
982 if ( C->lhs[ci][0] == TYPEIDNEW ) {
983 if ( (C->lhs[ci][2] & SUBMASK) == SUBALL ) {
984 MesPrint("&Idold/also cannot follow an id,all statement.");
985 error = 1;
986 }
987 break;
988 }
989 else if ( C->lhs[ci][0] == TYPEDETCURDUM ) { ci--; continue; }
990 else if ( C->lhs[ci][0] == TYPEIDOLD ) { ci--; continue; }
991 else ci = 0;
992 }
993 if ( ci < 1 ) {
994 MesPrint("&Idold/also should follow an id/idnew statement.");
995 error = 1;
996 }
997 }
998/*
999 Now the right hand side.
1000*/
1001 if ( type != TYPEIF ) {
1002 if ( ( retcode = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) error = 1;
1003 else {
1004 AC.ProtoType[2] = retcode;
1005 AC.DumNum = 0;
1006 if ( MinusSign ) { /* Flip the sign of the RHS */
1007 w = C->rhs[retcode];
1008 while ( *w ) { w += *w; w[-1] = -w[-1]; }
1009 }
1010 if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
1011 }
1012 }
1013/*
1014 Actual adding happens only now after numrhs insertion
1015*/
1016 if ( !error ) { AddNtoL(OldWork[1],OldWork); }
1017AllDone:
1018 AC.lhdollarflag = 0;
1019 AT.WorkPointer = FirstWork;
1020 return(error);
1021}
1022
1023/*
1024 #] CoIdExpression :
1025 #[ CoMultiply :
1026*/
1027
1028static WORD mularray[13] = { TYPEMULT, SUBEXPSIZE+3, 0, SUBEXPRESSION,
1029 SUBEXPSIZE, 0, 1, 0, 0, 0, 0, 0, 0 };
1030
1031int CoMultiply(UBYTE *inp)
1032{
1033 UBYTE *p;
1034 int error = 0, RetCode;
1035 mularray[2] = 0; /* right multiply is default */
1036 while ( *inp == ',' ) inp++;
1037/* if ( inp[-1] == '-' || inp[-1] == '+' ) inp--; */
1038 p = SkipField(inp,0);
1039 if ( *p ) {
1040 *p = 0;
1041 if ( StrICont(inp,(UBYTE *)"left") == 0 ) mularray[2] = 1;
1042 else if ( StrICont(inp,(UBYTE *)"right") == 0 ) mularray[2] = 0;
1043 else {
1044 MesPrint("&Illegal option in multiply statement or ; forgotten.");
1045 return(1);
1046 }
1047 *p = ',';
1048 inp = p + 1;
1049 }
1050 ClearWildcardNames();
1051 while ( *inp == ',' ) inp++;
1052 AC.ProtoType = mularray+3;
1053 mularray[7] = AC.cbufnum;
1054 if ( ( RetCode = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) error = 1;
1055 else {
1056 mularray[5] = RetCode;
1057 AddNtoL(SUBEXPSIZE+3,mularray);
1058 if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
1059 }
1060 return(error);
1061}
1062
1063/*
1064 #] CoMultiply :
1065 #[ CoFill :
1066
1067 Special additions for tablebase-like tables added 12-aug-2002
1068*/
1069
1070int CoFill(UBYTE *inp)
1071{
1072 GETIDENTITY
1073 WORD error = 0, x, funnum, type, *oldwp = AT.WorkPointer;
1074 int i, oldcbufnum = AC.cbufnum, nofill = 0, numover, redef = 0;
1075 WORD *w, *wold, *Tprototype;
1076 UBYTE *p = inp, c, *inp1;
1077 TABLES T = 0, oldT;
1078 LONG newreservation, sum = 0;
1079 UBYTE *p1, *p2, *p3, *p4, *fake = 0;
1080 int tablestub = 0;
1081 if ( AC.exprfillwarning == 1 ) AC.exprfillwarning = 0;
1082/*
1083 Read the name of the function and test that it is in the table.
1084*/
1085 p1 = inp;
1086 if ( ( p = SkipAName(inp) ) == 0 ) return(1);
1087 p2 = p;
1088 c = *p; *p = 0;
1089 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,WITHAUTO) == NAMENOTFOUND )
1090 || ( T = functions[funnum].tabl ) == 0 || ( T->numind > 0 && c != '(' ) ) {
1091 MesPrint("&%s should be a table with argument(s)",inp);
1092 *p = c; return(1);
1093 }
1094 oldT = T;
1095 *p++ = c;
1096 if ( T->numind == 0 ) {
1097 if ( c == '(' ) {
1098 if ( *p != ')' ) {
1099 c = *p; *p = 0;
1100 MesPrint("&%s should be a table without arguments",inp);
1101 *p = c; return(1);
1102 }
1103 else { p++; }
1104 }
1105 else { p--; }
1106 sum = 0;
1107 p3 = p;
1108 goto andagain;
1109 }
1110 for ( sum = 0, i = 0, w = oldwp; i < T->numind; i++ ) {
1111 ParseSignedNumber(x,p);
1112 if ( FG.cTable[p[-1]] != 1 || ( *p != ',' && *p != ')' ) ) {
1113 MesPrint("&Table arguments in fill statement should be numbers");
1114 return(1);
1115 }
1116 if ( T->sparse ) *w++ = x;
1117 else if ( x < T->mm[i].mini || x > T->mm[i].maxi ) {
1118 MesPrint("&Value %d for argument %d of table out of bounds",x,i+1);
1119 error = 1; nofill = 1;
1120 }
1121 else sum += ( x - T->mm[i].mini ) * T->mm[i].size;
1122 if ( *p == ')' ) break;
1123 p++;
1124 }
1125 p3 = p;
1126 if ( *p != ')' || i < ( T->numind - 1 ) ) {
1127 MesPrint("&Incorrect number of table arguments in fill statement. Should be %d"
1128 ,T->numind);
1129 error = 1; nofill = 1;
1130 }
1131 AT.WorkPointer = w;
1132 if ( T->sparse == 0 ) sum *= TABLEEXTENSION;
1133andagain:;
1134 AC.cbufnum = T->bufnum;
1135 if ( T->sparse ) {
1136 i = FindTableTree(T,oldwp,1);
1137 if ( i >= 0 ) {
1138 sum = i + T->numind;
1139 if ( tablestub == 0 && ( ( T->sparse & 2 ) == 2 ) && ( T->mode != 0 )
1140 && ( AC.vetotablebasefill == 0 ) ) {
1141/*
1142 This redefinition does not need a new stub
1143*/
1144 functions[funnum].tabl = T = T->spare;
1145 tablestub = 1;
1146 goto andagain;
1147 }
1148 redef = 1;
1149 goto redef;
1150 }
1151 if ( T->totind >= T->reserved ) {
1152 if ( T->reserved == 0 ) newreservation = 20;
1153 else newreservation = T->reserved;
1154/*
1155 while ( T->totind >= newreservation && newreservation <
1156 MAXTABLECOMBUF*(T->numind+TABLEEXTENSION) )
1157 if ( newreservation > MAXTABLECOMBUF*T->numind ) newreservation =
1158 5*(T->numind+TABLEEXTENSION);
1159*/
1160 while ( T->totind >= newreservation && newreservation < MAXTABLECOMBUF )
1161 newreservation = 2*newreservation;
1162 if ( newreservation > MAXTABLECOMBUF ) newreservation = MAXTABLECOMBUF;
1163 if ( T->totind >= newreservation ) {
1164 MesPrint("@More than %ld elements in sparse table",MAXTABLECOMBUF);
1165 AC.cbufnum = oldcbufnum;
1166 Terminate(-1);
1167 }
1168 wold = (WORD *)Malloc1(newreservation*sizeof(WORD)*
1169 (T->numind+TABLEEXTENSION),"tablepointers");
1170 for ( i = T->reserved*(T->numind+TABLEEXTENSION)-1; i >= 0; i-- )
1171 wold[i] = T->tablepointers[i];
1172 if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
1173 T->tablepointers = wold;
1174 T->reserved = newreservation;
1175 }
1176 w = oldwp;
1177 for ( sum = T->totind*(T->numind+TABLEEXTENSION), i = 0; i < T->numind; i++ ) {
1178 T->tablepointers[sum++] = *w++;
1179 }
1180 InsTableTree(T,T->tablepointers+sum-T->numind);
1181#if TABLEEXTENSION == 2
1182 T->tablepointers[sum+TABLEEXTENSION-1] = -1; /* New element! */
1183#else
1184 T->tablepointers[sum+1] = T->bufnum;
1185 T->tablepointers[sum+2] = -1;
1186 T->tablepointers[sum+3] = -1;
1187 T->tablepointers[sum+4] = 0;
1188 T->tablepointers[sum+5] = 0;
1189#endif
1190 }
1191 else {
1192 if ( !nofill && T->tablepointers[sum] >= 0 ) {
1193redef:;
1194 if ( AC.vetofilling ) nofill = 1;
1195 else {
1196 Warning("Table element was already defined. New definition will be used");
1197 }
1198 }
1199#if TABLEEXTENSION == 2
1200 T->tablepointers[sum+TABLEEXTENSION-1] = -1; /* New element! */
1201#else
1202 T->tablepointers[sum+1] = T->bufnum;
1203 T->tablepointers[sum+2] = -1;
1204 T->tablepointers[sum+3] = -1;
1205 T->tablepointers[sum+4] = 0;
1206 T->tablepointers[sum+5] = 0;
1207#endif
1208 }
1209 if ( T->numind ) { p++; }
1210 if ( *p != '=' ) {
1211 MesPrint("&Fill statement misses = sign after the table element");
1212 AC.cbufnum = oldcbufnum;
1213 AT.WorkPointer = oldwp;
1214 functions[funnum].tabl = oldT;
1215 return(1);
1216 }
1217 if ( tablestub == 0 && T->mode == 1 && AC.vetotablebasefill == 0 ) {
1218/*
1219 Here we construct a righthandside from the indices and the wildcards
1220*/
1221 int numfake;
1222 tablestub = 1;
1223 p4 = T->argtail;
1224 while ( *p4 ) p4++;
1225 numfake = (p4-T->argtail)+(p3-p1)+10;
1226
1227 fake = (UBYTE *)Malloc1(numfake*sizeof(UBYTE),"Fill fake rhs");
1228 p = fake;
1229 *p++ = 't'; *p++ = 'b'; *p++ = 'l'; *p++ = '_'; *p++ = '(';
1230 p4 = p1; while ( p4 < p2 ) *p++ = *p4++; *p++ = ',';
1231 p4 = p2+1; while ( p4 < p3 ) *p++ = *p4++;
1232 if ( T->argtail ) {
1233 p4 = T->argtail + 1;
1234 while ( FG.cTable[*p4] == 1 ) p4++;
1235 while ( *p4 ) {
1236 if ( *p4 == '?' && p[-1] != ',' ) {
1237 p4++;
1238 if ( FG.cTable[*p4] == 0 || *p4 == '$' || *p4 == '[' ) {
1239 p4 = SkipAName(p4);
1240 if ( *p4 == '[' ) {
1241 SKIPBRA1(p4);
1242 }
1243 }
1244 else if ( *p4 == '{' ) {
1245 SKIPBRA2(p4);
1246 }
1247 else if ( *p4 ) { *p++ = *p4++; continue; }
1248 }
1249 else *p++ = *p4++;
1250 }
1251 }
1252 *p++ = ')';
1253 *p = 0;
1254 inp1 = fake;
1255/* AT.WorkPointer += T->numind; */
1256 }
1257 else {
1258 inp1 = ++p;
1259 }
1260 c = 0;
1261/*
1262 Now we have the indices and p points to the rhs.
1263*/
1264 numover = 0;
1265 AC.tablefilling = funnum;
1266 while ( *inp1 ) {
1267 p = SkipField(inp1,0);
1268 c = *p; *p = 0;
1269#ifdef WITHPTHREADS
1270 Tprototype = T->prototype[0];
1271#else
1272 Tprototype = T->prototype;
1273#endif
1274 if ( ( i = CompileAlgebra(inp1,RHSIDE,Tprototype) ) < 0 ) { error = 1; i = 0; }
1275 if ( !nofill ) {
1276 T->tablepointers[sum] = i;
1277 T->tablepointers[sum+1] = T->bufnum;
1278 }
1279 AC.DumNum = 0;
1280 *p = c;
1281 if ( T->sparse || c == 0 ) break;
1282 inp1 = ++p;
1283#if ( TABLEEXTENSION == 2 )
1284 sum++;
1285#else
1286 sum += 2;
1287#endif
1288 if ( !nofill && T->tablepointers[sum] >= 0 ) numover++;
1289#if ( TABLEEXTENSION == 2 )
1290 sum++;
1291#else
1292 sum += TABLEEXTENSION-2;
1293#endif
1294 }
1295 if ( AC.exprfillwarning == 1 ) {
1296 AC.exprfillwarning = 2;
1297 Warning("Use of expressions and/or $variables in Fill statements is potentially very dangerous.");
1298 }
1299 AC.tablefilling = 0;
1300 if ( T->sparse && c != 0 ) {
1301 MesPrint("&In sparse tables one can fill only one element at a time");
1302 error = 1;
1303 }
1304 else if ( numover ) {
1305 if ( numover == 1 )
1306 Warning("one element was overwritten. New definition will be used");
1307 else if ( AC.WarnFlag )
1308 MesPrint("&Warning: %d elements were overwritten. New definitions will be used",numover);
1309 }
1310 if ( T->sparse ) {
1311 if ( redef == 0 ) T->totind++;
1312 }
1313 else T->defined++;
1314/*
1315 NumSets = AC.SetList.numtemp;
1316 NumSetElements = AC.SetElementList.numtemp;
1317*/
1318 if ( fake ) {
1319 M_free(fake,"Fill fake rhs");
1320 fake = 0;
1321 functions[funnum].tabl = T = T->spare;
1322 p = p3;
1323 goto andagain;
1324 }
1325 AC.cbufnum = oldcbufnum;
1326 AC.SymChangeFlag = 1;
1327 AT.WorkPointer = oldwp;
1328 functions[funnum].tabl = oldT;
1329 return(error);
1330}
1331
1332/*
1333 #] CoFill :
1334 #[ CoFillExpression :
1335
1336 Syntax: FillExpression table = expression(x1,...,xn);
1337 The arguments should have been bracketed. Each corresponds to one
1338 of the dimensions of the table. Then the bracket with x1^2*x3^4
1339 will fill the (2,0,4) element of the table (if n=3 of course).
1340 Brackets that don't fit will be skipped. It just gives a warning.
1341
1342 New option (13-jul-2005)
1343 Syntax: FillExpression table = expression(f);
1344 The table indices are arguments of the function f which should
1345 have been bracketed before.
1346*/
1347
1348int CoFillExpression(UBYTE *inp)
1349{
1350 GETIDENTITY
1351 UBYTE *p, c;
1352 WORD type, funnum, expnum, symnum, numsym = 0, *oldwork = AT.WorkPointer;
1353 WORD *brackets, *term, brasize, *b, *m, *w, *pw, *tstop, zero = 0;
1354 WORD oldcbuf = AC.cbufnum, curelement = 0;
1355 int weneedit, i, j, numzero, pow;
1356 TABLES T = 0;
1357 LONG newreservation, numcommu, sum;
1358 POSITION oldposition;
1359 FILEHANDLE *fi;
1360 CBUF *C;
1361 WORD numdummies;
1362
1363 AN.IndDum = AM.IndDum;
1364 if ( ( p = SkipAName(inp) ) == 0 ) return(1);
1365 c = *p; *p = 0;
1366 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1367 || ( T = functions[funnum].tabl ) == 0 ) {
1368 MesPrint("&%s should be a previously declared table",inp);
1369 *p = c; return(1);
1370 }
1371 *p++ = c;
1372 if ( T->spare ) T = T->spare;
1373 C = cbuf + T->bufnum;
1374 if ( c != '=' ) {
1375 MesPrint("&No = sign in FillExpression statement");
1376 return(1);
1377 }
1378 inp = p;
1379 if ( ( p = SkipAName(inp) ) == 0 ) return(1);
1380 c = *p; *p = 0;
1381 if ( ( type = GetName(AC.exprnames,inp,&expnum,NOAUTO) ) == NAMENOTFOUND
1382 || c != '(' || (
1383 Expressions[expnum].status != LOCALEXPRESSION &&
1384 Expressions[expnum].status != SKIPLEXPRESSION &&
1385 Expressions[expnum].status != DROPLEXPRESSION &&
1386 Expressions[expnum].status != GLOBALEXPRESSION &&
1387 Expressions[expnum].status != SKIPGEXPRESSION &&
1388 Expressions[expnum].status != DROPGEXPRESSION ) ) {
1389 MesPrint("&%s should be an active expression with arguments",inp);
1390 *p = c; return(1);
1391 }
1392 if ( Expressions[expnum].inmem ) {
1393 MesPrint("&%s cannot be used in a FillExpression statement in the same %n\
1394 module that it has been redefined",inp);
1395 *p = c; return(1);
1396 }
1397 *p++ = c;
1398 while ( *p ) {
1399 inp = p;
1400 if ( ( p = SkipAName(inp) ) == 0 ) return(1);
1401 c = *p; *p = 0;
1402
1403 if ( GetVar(inp,&type,&symnum,-1,NOAUTO) == NAMENOTFOUND ) {
1404 MesPrint("&%s should be a previously declared symbol or function",inp);
1405 *p = c; return(1);
1406 }
1407 else if ( type == CSYMBOL ) {
1408 *p++ = c;
1409 *AT.WorkPointer++ = symnum;
1410 numsym++;
1411 }
1412 else if ( type == CFUNCTION ) {
1413 numsym = -1;
1414 *p++ = c;
1415 if ( c != ')' ) {
1416 MesPrint("&Argument should be a single function or a list of symbols");
1417 return(1);
1418 }
1419 symnum += FUNCTION;
1420 *AT.WorkPointer++ = symnum;
1421 }
1422 else {
1423 MesPrint("&%s should be a previously declared symbol or function",inp);
1424 *p = c; return(1);
1425 }
1426/*
1427 if ( GetVar(inp,&type,&symnum,CSYMBOL,NOAUTO) == NAMENOTFOUND ) {
1428 if ( numsym > 0 ) {
1429 MesPrint("&%s should be a previously declared symbol",inp);
1430 *p = c; return(1);
1431 }
1432 else {
1433 if ( GetVar(inp,&type,&symnum,CFUNCTION,NOAUTO) == NAMENOTFOUND ) {
1434 MesPrint("&%s should be a previously declared symbol or function",inp);
1435 *p = c; return(1);
1436 }
1437 numsym = -1;
1438 *p++ = c;
1439 if ( c != ')' ) {
1440 MesPrint("&Argument should be a single function or a list of symbols");
1441 *p = c; return(1);
1442 }
1443 symnum += FUNCTION;
1444 *AT.WorkPointer++ = symnum;
1445 break;
1446 }
1447 }
1448 *p++ = c;
1449 *AT.WorkPointer++ = symnum;
1450 numsym++;
1451*/
1452 if ( c == ')' ) break;
1453 if ( c != ',' ) {
1454 MesPrint("&Illegal separator in FillExpression statement");
1455 goto noway;
1456 }
1457 }
1458 if ( *p ) {
1459 MesPrint("&Illegal end of FillExpression statement");
1460 goto noway;
1461 }
1462/*
1463 We have the number of the table in funnum.
1464 The number of the expression in expnum, the table struct in T
1465 and either the numbers of the symbols in oldwork (there are numsym of them)
1466 or the number of the function in oldwork (just one and numsym = -1).
1467 We don't sort them!!!!
1468*/
1469 if ( ( numsym > 0 ) && ( T->numind != numsym ) ) {
1470 MesPrint("&This table needs %d symbols for its array indices");
1471 goto noway;
1472 }
1473 EXCHINOUT
1474#ifdef WITHMPI
1475 /*
1476 * The workers can't access to the data of the input expression. We need to
1477 * broadcast it to all the workers.
1478 */
1479 PF_BroadcastExpr(&Expressions[expnum], AR.infile);
1480 if ( PF.me == MASTER ) {
1481 /*
1482 * Restore the file position on the master.
1483 */
1484 POSITION pos;
1485 SetEndScratch(AR.infile, &pos);
1486 }
1487#endif
1488 fi = AR.infile;
1489 if ( fi->handle >= 0 ) {
1490 PUTZERO(oldposition);
1491 SeekFile(fi->handle,&oldposition,SEEK_CUR);
1492 SetScratch(fi,&(Expressions[expnum].onfile));
1493/* SeekFile(fi->handle,&(Expressions[expnum].onfile),SEEK_SET); */
1494 if ( ISNEGPOS(Expressions[expnum].onfile) ) {
1495 MesPrint("&File error in FillExpression");
1496 BACKINOUT
1497 goto noway;
1498 }
1499 }
1500 else {
1501/*
1502 Note: Because everything fits inside memory we never get problems
1503 with excessive file sizes.
1504*/
1505 SETBASEPOSITION(oldposition,(UBYTE *)(fi->POfill)-(UBYTE *)(fi->PObuffer));
1506 fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + BASEPOSITION(Expressions[expnum].onfile));
1507 }
1508 pw = AT.WorkPointer;
1509 if ( numsym < 0 ) { brackets = pw + 1; }
1510 else { brackets = pw + numsym; }
1511 brasize = -1; weneedit = 0; /* stands for we need it */
1512 term = (WORD *)(((UBYTE *)(brackets)) + AM.MaxTer);
1513 AT.WorkPointer = (WORD *)(((UBYTE *)(term)) + AM.MaxTer);
1514 AC.cbufnum = T->bufnum;
1515 AC.tablefilling = funnum;
1516 if ( GetTerm(BHEAD term) > 0 ) { /* Skip prototype */
1517 while ( GetTerm(BHEAD term) > 0 ) {
1518 GETSTOP(term,tstop);
1519 w = m = term + 1;
1520 while ( m < tstop && *m != HAAKJE ) m += m[1];
1521 if ( *m != HAAKJE ) {
1522 MesPrint("&Illegal attempt to put an expression without brackets in a table");
1523 BACKINOUT
1524 goto noway;
1525 }
1526 if ( brasize == m - w ) {
1527 b = brackets;
1528 while ( *b == *w && w < m ) { b++; w++; }
1529 if ( w == m ) { /* Same as current bracket. Copy. */
1530 if ( weneedit ) {
1531 m += m[1] - 1;
1532 *m = *term - (m-term);
1533 AddNtoC(AC.cbufnum,*m,m,3);
1534 numdummies = DetCurDum(BHEAD term) - AM.IndDum;
1535 if ( numdummies > T->numdummies ) T->numdummies = numdummies;
1536 }
1537 continue; /* Next term */
1538 }
1539 }
1540 if ( weneedit ) {
1541 AddNtoC(AC.cbufnum,1,&zero,4); /* Terminate old bracket */
1542 numcommu = numcommute(C->rhs[curelement],&(C->NumTerms[curelement]));
1543 C->CanCommu[curelement] = numcommu;
1544 }
1545 b = brackets; w = term + 1;
1546 if ( numsym < 0 ) pw = oldwork + 1;
1547 else pw = oldwork + numsym;
1548 while ( w < m ) *b++ = *w++;
1549 brasize = b - brackets;
1550/*
1551 Now compute the element. See whether we need it
1552*/
1553 if ( numsym < 0 ) {
1554 WORD *bb;
1555 if ( *brackets != symnum || brasize != brackets[1] ) {
1556 weneedit = 0; continue; /* Cannot work! */
1557 }
1558/*
1559 Now count the number of arguments and whether they are numbers
1560*/
1561 b = brackets + FUNHEAD;
1562 bb = brackets+brackets[1];
1563 i = 0;
1564 while ( b < bb ) {
1565 if ( *b != -SNUMBER ) break;
1566 i++;
1567 b += 2;
1568 }
1569 if ( b < bb || i != T->numind ) {
1570 weneedit = 0; continue; /* Cannot work! */
1571 }
1572 }
1573 else if ( brasize > 0 && ( *brackets != SYMBOL
1574 || brackets[1] < brasize || (brackets[1]-2) > numsym*2 ) ) {
1575 weneedit = 0; continue; /* Cannot work! */
1576 }
1577 numzero = 0; sum = 0;
1578 if ( numsym > 0 ) {
1579 for ( i = 0; i < numsym; i++ ) {
1580 if ( brasize > 0 ) {
1581 b = brackets + 2; j = brackets[1]-2;
1582 while ( j > 0 ) {
1583 if ( *b == oldwork[i] ) break;
1584 j -= 2; b += 2;
1585 }
1586 if ( j <= 0 ) { /* it was not there */
1587 numzero++; pow = 0;
1588 if ( 2*numzero+brackets[1]-2 > numsym*2 ) {
1589 weneedit = 0; goto nextterm;
1590 }
1591 }
1592 else pow = b[1];
1593 }
1594 else pow = 0;
1595 if ( T->sparse ) *pw++ = pow;
1596 else if ( pow < T->mm[i].mini || pow > T->mm[i].maxi ) {
1597 weneedit = 0; goto nextterm;
1598 }
1599 else sum += ( pow - T->mm[i].mini ) * T->mm[i].size;
1600 }
1601 }
1602 else {
1603 b = brackets + FUNHEAD;
1604 sum = 0;
1605 for ( i = 0; i < T->numind; i++ ) {
1606 pow = b[1];
1607 b += 2;
1608 if ( T->sparse ) { *pw++ = pow; }
1609 else if ( pow < T->mm[i].mini || pow > T->mm[i].maxi ) {
1610 weneedit = 0; goto nextterm;
1611 }
1612 else sum += ( pow - T->mm[i].mini ) * T->mm[i].size;
1613 }
1614 }
1615 weneedit = 1;
1616 if ( T->sparse ) {
1617 if ( numsym < 0 ) pw = oldwork + 1;
1618 else pw = oldwork + T->numind;
1619 i = FindTableTree(T,pw,1);
1620 if ( i >= 0 ) {
1621 sum = i+T->numind;
1622/*
1623Wrong!!!! C->rhs[T->tablepointers[sum]] = C->Pointer;
1624*/
1625 C->Pointer--; /* Back up over the zero */
1626 goto newentry;
1627 }
1628 if ( T->totind >= T->reserved ) {
1629 if ( T->reserved == 0 ) newreservation = 20;
1630 else newreservation = T->reserved;
1631/*
1632 while ( T->totind >= newreservation && newreservation <
1633 MAXTABLECOMBUF*(T->numind+TABLEEXTENSION) )
1634 newreservation = 2*newreservation;
1635 if ( newreservation > MAXTABLECOMBUF*T->numind ) newreservation =
1636 MAXTABLECOMBUF*(T->numind+TABLEEXTENSION);
1637*/
1638/*---Copied from Fill---------------------------*/
1639 while ( T->totind >= newreservation && newreservation < MAXTABLECOMBUF )
1640 newreservation = 2*newreservation;
1641 if ( newreservation > MAXTABLECOMBUF ) newreservation = MAXTABLECOMBUF;
1642 if ( T->totind >= newreservation ) {
1643 MesPrint("@More than %ld elements in sparse table",MAXTABLECOMBUF);
1644 AC.cbufnum = oldcbuf;
1645 AT.WorkPointer = oldwork;
1646 Terminate(-1);
1647 }
1648/*---Copied from Fill---------------------------*/
1649 if ( T->totind >= newreservation ) {
1650 MesPrint("@More than %ld elements in sparse table",MAXTABLECOMBUF);
1651 AC.cbufnum = oldcbuf;
1652 AT.WorkPointer = oldwork;
1653 Terminate(-1);
1654 }
1655 w = (WORD *)Malloc1(newreservation*sizeof(WORD)*
1656 (T->numind+TABLEEXTENSION),"tablepointers");
1657 for ( i = T->reserved*(T->numind+TABLEEXTENSION)-1; i >= 0; i-- )
1658 w[i] = T->tablepointers[i];
1659 if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
1660 T->tablepointers = w;
1661 T->reserved = newreservation;
1662 }
1663 if ( numsym < 0 ) pw = oldwork + 1;
1664 else pw = oldwork + numsym;
1665 for ( sum = T->totind*(T->numind+TABLEEXTENSION), i = 0; i < T->numind; i++ ) {
1666 T->tablepointers[sum++] = *pw++;
1667 }
1668 InsTableTree(T,T->tablepointers+sum-T->numind);
1669 (T->totind)++;
1670 }
1671#if ( TABLEEXTENSION != 2 )
1672 else {
1673 sum *= TABLEEXTENSION;
1674 }
1675#endif
1676/*
1677 Start a new entry. Copy the element.
1678*/
1679 AddRHS(T->bufnum,0);
1680 T->tablepointers[sum] = C->numrhs;
1681#if ( TABLEEXTENSION == 2 )
1682 T->tablepointers[sum+TABLEEXTENSION-1] = -1;
1683#else
1684 T->tablepointers[sum+1] = T->bufnum;
1685 T->tablepointers[sum+2] = -1;
1686 T->tablepointers[sum+3] = -1;
1687 T->tablepointers[sum+4] = 0;
1688 T->tablepointers[sum+5] = 0;
1689#endif
1690newentry: if ( *m == HAAKJE ) { m += m[1] - 1; }
1691 else m--;
1692 *m = *term - (m-term);
1693 AddNtoC(AC.cbufnum,*m,m,5);
1694 curelement = T->tablepointers[sum];
1695nextterm:;
1696 }
1697 if ( weneedit ) {
1698 AddNtoC(AC.cbufnum,1,&zero,6); /* Terminate old bracket */
1699 numcommu = numcommute(C->rhs[curelement],&(C->NumTerms[curelement]));
1700 C->CanCommu[curelement] = numcommu;
1701 }
1702 }
1703 if ( fi->handle >= 0 ) {
1704 SetScratch(fi,&(oldposition));
1705 }
1706 else {
1707 fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + BASEPOSITION(oldposition));
1708 }
1709 BACKINOUT
1710 AC.cbufnum = oldcbuf;
1711 AC.tablefilling = 0;
1712 AT.WorkPointer = oldwork;
1713 return(0);
1714noway:
1715 BACKINOUT
1716 AC.cbufnum = oldcbuf;
1717 AC.tablefilling = 0;
1718 AT.WorkPointer = oldwork;
1719 return(1);
1720}
1721
1722/*
1723 #] CoFillExpression :
1724 #[ CoPrintTable :
1725
1726 Syntax
1727 PrintTable [+f] [+s] tablename [>[>] file];
1728 All defined elements are written with individual Fill statements.
1729 If a file is specified, the result is written to file only.
1730 The flags of the print statement apply as much as possible.
1731 We make use of the regular write routines.
1732*/
1733
1734int CoPrintTable(UBYTE *inp)
1735{
1736 GETIDENTITY
1737 int fflag = 0, sflag = 0, addflag = 0, error = 0, sum, i, j;
1738 UBYTE *filename, *p, c, buffer[100], *s, *oldoutputline = AO.OutputLine;
1739 WORD type, funnum, *expr, *m, num;
1740 TABLES T = 0;
1741 WORD oldSkip = AO.OutSkip, oldMode = AC.OutputMode, oldHandle = AC.LogHandle;
1742 WORD oldType = AO.PrintType, *oldwork = AT.WorkPointer;
1743 UBYTE *oldFill = AO.OutFill, *oldLine = AO.OutputLine;
1744#ifdef WITHMPI
1745 if ( PF.me != MASTER ) return 0;
1746#endif
1747/*
1748 First the flags
1749*/
1750 while ( *inp == '+' ) {
1751 inp++;
1752 if ( *inp == 'f' || *inp == 'F' ) { fflag = 1; inp++; }
1753 else if ( *inp == 's' || *inp == 'S' ) { sflag = PRINTONETERM; inp++; }
1754 else {
1755 MesPrint("&Illegal + option in PrintTable statement");
1756 error = 1; inp++;
1757 }
1758 while ( *inp != ',' && *inp && *inp != '+' ) {
1759 if ( !error ) {
1760 if ( *inp ) {
1761 MesPrint("&Illegal + option in PrintTable statement");
1762 inp++;
1763 }
1764 else {
1765 MesPrint("&Unfinished PrintTable statement");
1766 return(1);
1767 }
1768 error = 1;
1769 }
1770 inp++;
1771 }
1772 if ( *inp == ',' ) inp++;
1773 }
1774/*
1775 Now the name of the table
1776*/
1777 if ( ( p = SkipAName(inp) ) == 0 ) return(1);
1778 c = *p; *p = 0;
1779 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1780 || ( T = functions[funnum].tabl ) == 0 ) {
1781 MesPrint("&%s should be a previously declared table",inp);
1782 *p = c; return(1);
1783 }
1784 if ( T->spare && T->mode == 1 ) T = T->spare;
1785 *p++ = c;
1786/*
1787 Check for a filename. Runs to the end of the statement.
1788*/
1789 filename = 0;
1790 if ( c == '>' ) {
1791 if ( *p == '>' ) { addflag = 1; p++; }
1792 filename = p;
1793 }
1794 else filename = 0;
1795
1796 if ( filename ) {
1797 if ( addflag ) AC.LogHandle = OpenAddFile((char *)filename);
1798 else AC.LogHandle = CreateFile((char *)filename);
1799 if ( AC.LogHandle < 0 ) {
1800 MesPrint("&Cannot open file '%s' properly",filename);
1801 error = 1; goto finally;
1802 }
1803 AO.PrintType = PRINTLFILE;
1804 }
1805 else if ( fflag && AC.LogHandle >= 0 ) {
1806 AO.PrintType = PRINTLFILE;
1807 }
1808 AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer;
1809 AT.WorkPointer += 2*AC.LineLength;
1810
1811 AO.PrintType |= sflag;
1812 AC.OutputMode = 0;
1813 AO.IsBracket = 0;
1814 AO.OutSkip = 0;
1815 AR.DeferFlag = 0;
1816 AC.outsidefun = 1;
1817 if ( AC.LogHandle == oldHandle ) FiniLine();
1818 AO.OutputLine = AO.OutFill = (UBYTE *)Malloc1(AC.LineLength+20,"PrintTable");
1819 AO.OutStop = AO.OutFill + AC.LineLength;
1820 for ( i = 0; i < T->totind; i++ ) {
1821 if ( !T->sparse && T->tablepointers[i*TABLEEXTENSION] < 0 ) continue;
1822 TokenToLine((UBYTE *)"Fill ");
1823 TokenToLine((UBYTE *)(VARNAME(functions,funnum)));
1824 TokenToLine((UBYTE *)"(");
1825 AO.OutSkip = 3;
1826 if ( T->sparse ) {
1827 sum = i * ( T->numind + TABLEEXTENSION );
1828 for ( j = 0; j < T->numind; j++, sum++ ) {
1829 if ( j > 0 ) TokenToLine((UBYTE *)",");
1830 num = T->tablepointers[sum];
1831 s = buffer; s = NumCopy(num,s);
1832 TokenToLine(buffer);
1833 }
1834 expr = cbuf[T->bufnum].rhs[T->tablepointers[sum]];
1835 }
1836 else {
1837 for ( j = 0; j < T->numind; j++ ) {
1838 if ( j > 0 ) {
1839 TokenToLine((UBYTE *)",");
1840 num = T->mm[j].mini + ( i % T->mm[j-1].size ) / T->mm[j].size;
1841 }
1842 else {
1843 num = T->mm[j].mini + i / T->mm[j].size;
1844 }
1845 s = buffer; s = NumCopy(num,s);
1846 TokenToLine(buffer);
1847 }
1848 expr = cbuf[T->bufnum].rhs[T->tablepointers[TABLEEXTENSION*i]];
1849 }
1850 TOKENTOLINE(") =",")=");
1851 if ( sflag ) {
1852 FiniLine();
1853 if ( AC.OutputSpaces != NOSPACEFORMAT ) TokenToLine((UBYTE *)" ");
1854 }
1855 m = expr;
1856/*
1857 WORD lbrac, first;
1858 lbrac = 0; first = 1;
1859 while ( *m ) {
1860 if ( WriteTerm(m,&lbrac,first,1,0) ) {
1861 MesPrint("Error while writing table");
1862 error = 1;
1863 goto finally;
1864 }
1865 first = 0;
1866 m += *m;
1867 }
1868 if ( first ) { TOKENTOLINE(" 0","0") }
1869 else if ( lbrac ) { TOKENTOLINE(" )",")") }
1870*/
1871 while ( *m ) m += *m;
1872 if ( m > expr ) {
1873 if ( WriteExpression(expr,(LONG)(m-expr)) ) { error = 1; goto finally; }
1874 AO.OutSkip = 0;
1875 }
1876 else {
1877 TokenToLine((UBYTE *)"0");
1878 }
1879 TokenToLine((UBYTE *)";");
1880 FiniLine();
1881 }
1882 M_free(AO.OutputLine,"PrintTable");
1883 AO.OutputLine = AO.OutFill = oldoutputline;
1884/*
1885 Reset the file pointers and parameters if any. Close file if needed.
1886*/
1887finally:
1888 AO.OutSkip = oldSkip;
1889 AC.OutputMode = oldMode;
1890 AC.LogHandle = oldHandle;
1891 AO.PrintType = oldType;
1892 AO.OutFill = oldFill;
1893 AO.OutputLine = oldLine;
1894 AT.WorkPointer = oldwork;
1895 AC.outsidefun = 0;
1896 return(error);
1897}
1898
1899/*
1900 #] CoPrintTable :
1901 #[ CoAssign :
1902
1903 This statement has an easy syntax:
1904 $name = expression
1905*/
1906
1907static WORD AssignLHS[14] = { TYPEASSIGN, 3+SUBEXPSIZE, 0,
1908 SUBEXPRESSION, SUBEXPSIZE, 0, 1, 0, 0,0,0,0,0 };
1909
1910int CoAssign(UBYTE *inp)
1911{
1912 int error = 0, retcode;
1913 UBYTE *name, c;
1914 WORD number;
1915 if ( *inp != '$' ) {
1916nolhs: MesPrint("&assign statement should have a dollar variable in the LHS");
1917 return(1);
1918 }
1919 inp++; name = inp;
1920 if ( FG.cTable[*inp] != 0 ) goto nolhs;
1921 while ( FG.cTable[*inp] < 2 ) inp++;
1922 if ( AP.PreAssignFlag == 2 ) {
1923 if ( *inp == '_' ) inp++;
1924 }
1925 if ( ( *inp == ',' && inp[1] != '=' ) && ( *inp != '=' ) ) {
1926 MesPrint("&assign statement should have only a dollar variable in the LHS");
1927 return(1);
1928 }
1929 c = *inp;
1930 *inp = 0;
1931 if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
1932 number = AddDollar(name,DOLUNDEFINED,0,0);
1933 }
1934 *inp = c;
1935 if ( c == ',' ) inp++;
1936 *inp++ = '=';
1937 if ( *inp == ',' ) inp++;
1938/*
1939 Fake a Prototype and read the RHS
1940*/
1941 AssignLHS[7] = AC.cbufnum;
1942 retcode = CompileAlgebra(inp,RHSIDE,(AssignLHS+3));
1943 if ( retcode < 0 ) error = 1;
1944 AC.DumNum = 0;
1945/*
1946 Now add the LHS
1947*/
1948 AssignLHS[2] = number;
1949 AssignLHS[5] = retcode;
1950 AddNtoL(AssignLHS[1],AssignLHS);
1951/*
1952 Add to the list of potentially modified dollars (for PARALLEL)
1953*/
1954 AddPotModdollar(number);
1955 return(error);
1956}
1957
1958/*
1959 #] CoAssign :
1960 #[ CoDeallocateTable :
1961
1962 Syntax: DeallocateTable tablename(s);
1963 Should work only for sparse tables.
1964 Action: Cleans all definitions of elements of a table as if there have
1965 never been any fill statements.
1966*/
1967
1968int CoDeallocateTable(UBYTE *inp)
1969{
1970 UBYTE *p, c;
1971 TABLES T = 0;
1972 WORD type, funnum, i;
1973 c = *inp;
1974 while ( c ) {
1975 while ( *inp == ',' ) inp++;
1976 if ( *inp == 0 ) break;
1977 if ( ( p = SkipAName(inp) ) == 0 ) return(1);
1978 c = *p; *p = 0;
1979 if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
1980 || ( T = functions[funnum].tabl ) == 0 ) {
1981 MesPrint("&%s should be a previously declared table",inp);
1982 *p = c; return(1);
1983 }
1984 if ( T->sparse == 0 ) {
1985 MesPrint("&%s should be a sparse table",inp);
1986 *p = c; return(1);
1987 }
1988 if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
1989 ClearTableTree(T);
1990 for (i = 0; i < T->buffersfill; i++ ) { /* was <= */
1991 finishcbuf(T->buffers[i]);
1992 }
1993 T->bufnum = inicbufs();
1994 T->buffersfill = 0;
1995 T->buffers[T->buffersfill++] = T->bufnum;
1996 T->tablepointers = 0;
1997 T->boomlijst = 0;
1998 T->totind = 0;
1999 T->reserved = 0;
2000
2001 if ( T->spare ) {
2002 TABLES TT = T->spare;
2003 if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
2004 ClearTableTree(TT);
2005 for (i = 0; i < TT->buffersfill; i++ ) { /* was <= */
2006 finishcbuf(TT->buffers[i]);
2007 }
2008 TT->bufnum = inicbufs();
2009 TT->buffersfill = 0;
2010 TT->buffers[T->buffersfill++] = T->bufnum;
2011 TT->tablepointers = 0;
2012 TT->boomlijst = 0;
2013 TT->totind = 0;
2014 TT->reserved = 0;
2015 }
2016 *p++ = c;
2017 inp = p;
2018 }
2019 return(0);
2020}
2021
2022/*
2023 #] CoDeallocateTable :
2024 #[ CoFactorCache :
2025*/
2035/*
2036int CoFactorCache(UBYTE *inp)
2037{
2038 Code to be added in due time
2039 We need to read 'expression', get its terms through Generator and sort them.
2040 We store the result in the WorkSpace in argument notation.
2041 This will be argin.
2042 Then we do the same with the sequence of factors. They form argout.
2043 The whole is put in the buffer with the call
2044 InsertArg(BHEAD argin,argout,1)
2045 return(0);
2046}
2047*/
2048
2049/*
2050 #] CoFactorCache :
2051*/
int AddNtoL(int n, WORD *array)
Definition comtool.c:288
WORD * AddRHS(int num, int type)
Definition comtool.c:214
void finishcbuf(WORD num)
Definition comtool.c:89
int AddNtoC(int bufnum, int n, WORD *array, int par)
Definition comtool.c:317
int inicbufs(VOID)
Definition comtool.c:47
WORD * AddLHS(int num)
Definition comtool.c:188
void AddPotModdollar(WORD)
Definition dollar.c:3954
WORD NewSort(PHEAD0)
Definition sort.c:592
WORD PutOut(PHEAD WORD *, POSITION *, FILEHANDLE *, WORD)
Definition sort.c:1405
LONG EndSort(PHEAD WORD *, int)
Definition sort.c:682
WORD Generator(PHEAD WORD *, WORD)
Definition proces.c:3101
WORD FlushOut(POSITION *, FILEHANDLE *, int)
Definition sort.c:1748
WORD SortWild(WORD *, WORD)
Definition sort.c:4552
int ClearOptimize()
Definition optimize.cc:4924
int PF_BroadcastExpr(EXPRESSIONS e, FILEHANDLE *file)
Definition parallel.c:3536
VOID LowerSortLevel()
Definition sort.c:4727
LONG * NumTerms
Definition structs.h:945
WORD ** rhs
Definition structs.h:943
WORD ** lhs
Definition structs.h:942
WORD * Buffer
Definition structs.h:939
WORD * Pointer
Definition structs.h:941
LONG * CanCommu
Definition structs.h:944
int handle
Definition structs.h:661
WORD mini
Definition structs.h:307
WORD size
Definition structs.h:309
WORD maxi
Definition structs.h:308
WORD * buffers
Definition structs.h:364
struct TaBlEs * spare
Definition structs.h:363
WORD * tablepointers
Definition structs.h:350
UBYTE * argtail
Definition structs.h:361
COMPTREE * boomlijst
Definition structs.h:360
LONG reserved
Definition structs.h:366
WORD buffersfill
Definition structs.h:379
WORD * prototype
Definition structs.h:355
WORD mode
Definition structs.h:381
MINMAX * mm
Definition structs.h:358
WORD bufnum
Definition structs.h:377
int numind
Definition structs.h:370
LONG totind
Definition structs.h:365
int sparse
Definition structs.h:373
LONG defined
Definition structs.h:367