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