• Home
  • Features
  • Pricing
  • Docs
  • Announcements
  • Sign In

vermaseren / form / 9364948935

04 Jun 2024 09:49AM UTC coverage: 49.979% (-0.02%) from 49.999%
9364948935

Pull #526

github

web-flow
Merge 7062bd769 into 83e3d4185
Pull Request #526: RFC: better debugging

52 of 415 new or added lines in 46 files covered. (12.53%)

32 existing lines in 2 files now uncovered.

41391 of 82816 relevant lines covered (49.98%)

878690.77 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

51.3
/sources/comexpr.c
1
/** @file comexpr.c
2
 * 
3
 *  Compiler routines for statements that involve algebraic expressions.
4
 *        These involve definitions, id-statements, the multiply statement
5
 *        and the fill statement.
6
 */
7

8
/* #[ License : */
9
/*
10
 *   Copyright (C) 1984-2023 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
 
44
static 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

66
int CoLocal(UBYTE *inp) { return(DoExpr(inp,LOCALEXPRESSION,0)); }
6,955✔
67

68
/*
69
          #] CoLocal : 
70
          #[ CoGlobal :
71
*/
72

73
int CoGlobal(UBYTE *inp) { return(DoExpr(inp,GLOBALEXPRESSION,0)); }
49✔
74

75
/*
76
          #] CoGlobal : 
77
          #[ CoLocalFactorized :
78
*/
79

80
int CoLocalFactorized(UBYTE *inp) { return(DoExpr(inp,LOCALEXPRESSION,1)); }
98✔
81

82
/*
83
          #] CoLocalFactorized : 
84
          #[ CoGlobalFactorized :
85
*/
86

87
int CoGlobalFactorized(UBYTE *inp) { return(DoExpr(inp,GLOBALEXPRESSION,1)); }
×
88

89
/*
90
          #] CoGlobalFactorized : 
91
          #[ DoExpr:
92

93

94
*/
95

96
int DoExpr(UBYTE *inp, int type, int par)
7,102✔
97
{
98
        GETIDENTITY
2,056✔
99
        int error = 0;
7,102✔
100
        UBYTE *p, *q, c;
7,102✔
101
        WORD *w, i, j = 0, c1, c2, *OldWork = AT.WorkPointer, osize;
7,102✔
102
        WORD jold = 0;
7,102✔
103
        POSITION pos;
7,102✔
104
        while ( *inp == ',' ) inp++;
7,102✔
105
        if ( par ) AC.ToBeInFactors = 1;
7,102✔
106
        else       AC.ToBeInFactors = 0;
7,004✔
107
        p = inp;
7,102✔
108
        while ( *p && *p != '=' ) {
34,678✔
109
                if ( *p == '(' ) SKIPBRA4(p)
27,576✔
110
                else if ( *p == '{' ) SKIPBRA5(p)
27,576✔
111
                else if ( *p == '[' ) SKIPBRA1(p)
28,157✔
112
                else p++;
27,513✔
113
        }
114
        if ( *p ) {                /* Variety with the = sign */
7,102✔
115
                if ( ( q = SkipAName(inp) ) == 0 || q[-1] == '_' ) {
7,102✔
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;
7,102✔
124
                        if ( GetVar(inp,&c1,&c2,ALLVARIABLES,NOAUTO) != NAMENOTFOUND ) {
7,102✔
125
                                if ( c1 == CEXPRESSION ) {
175✔
126
                                        if ( Expressions[c2].status == STOREDEXPRESSION ) {
175✔
127
                                                MesPrint("&Illegal attempt to overwrite a stored expression");
×
128
                                                error = 1;
×
129
                                        }
130
                                        else {
131
                                                HighWarning("Expression is replaced by new definition");
175✔
132
                                                if ( AO.OptimizeResult.nameofexpr != NULL &&
175✔
133
                                                        StrCmp(inp,AO.OptimizeResult.nameofexpr) == 0 ) {
×
134
                                                        ClearOptimize();
×
135
                                                }
136
                                                if ( Expressions[c2].status != DROPPEDEXPRESSION ) {
175✔
137
                                                        w = &(Expressions[c2].status);
175✔
138
                                                        if ( *w == LOCALEXPRESSION || *w == SKIPLEXPRESSION )
175✔
139
                                                                *w = DROPLEXPRESSION;
91✔
140
                                                        else if ( *w == GLOBALEXPRESSION || *w == SKIPGEXPRESSION )
84✔
141
                                                                *w = DROPGEXPRESSION;
×
142
                                                        else if ( *w == HIDDENLEXPRESSION )
84✔
143
                                                                *w = DROPHLEXPRESSION;
70✔
144
                                                        else if ( *w == HIDDENGEXPRESSION )
14✔
145
                                                                *w = DROPHGEXPRESSION;
×
146
                                                }
147
                                                AC.TransEname = Expressions[c2].name;
175✔
148
                                                j = EntVar(CEXPRESSION,0,type,0,0,0);
175✔
149
                                                Expressions[j].node = Expressions[c2].node;
175✔
150
                                                Expressions[c2].replace = j;
175✔
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;
175✔
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);
6,927✔
167
                                jold = j;
6,927✔
168
                        }
169
                        *q = c;
7,102✔
170
                        OldWork = w = AT.WorkPointer;
7,102✔
171
                        *w++ = TYPEEXPRESSION;
7,102✔
172
                        *w++ = 3+SUBEXPSIZE;
7,102✔
173
                        *w++ = j;
7,102✔
174
                        AC.ProtoType = w;
7,102✔
175
                        AR.CurExpr = j;                                /* Block expression j */
7,102✔
176
                        *w++ = SUBEXPRESSION;
7,102✔
177
                        *w++ = SUBEXPSIZE;
7,102✔
178
                        *w++ = j;
7,102✔
179
                        *w++ = 1;
7,102✔
180
                        *w++ = AC.cbufnum;
7,102✔
181
                        FILLSUB(w)
182

183
                        if ( c == '(' ) {
7,102✔
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 != '=' ) {
7,102✔
223
/*
224
                                The dummy accepted L F := RHS;
225
*/
226
                                MesPrint("&Illegal LHS for expression definition");
×
227
                                error = 1;
×
228
                        }
229
                        *w++ = 1;
7,102✔
230
                        *w++ = 1;
7,102✔
231
                        *w++ = 3;
7,102✔
232
                        *w++ = 0;
7,102✔
233
                        SeekScratch(AR.outfile,&pos);
7,102✔
234
                        Expressions[j].counter = 1; 
7,102✔
235
                        Expressions[j].onfile = pos; 
7,102✔
236
                        Expressions[j].whichbuffer = 0;
7,102✔
237
#ifdef PARALLELCODE
238
                        Expressions[j].partodo = AC.inparallelflag; 
6,056✔
239
#endif
240
                        OldWork[2] = w - OldWork - 3;
7,102✔
241
                        AT.WorkPointer = w;
7,102✔
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;
7,102✔
249
                ClearWildcardNames();
7,102✔
250
                osize = AC.ProtoType[1]; AC.ProtoType[1] = SUBEXPSIZE;
7,102✔
251
                PutInVflags(jold);
7,102✔
252
                if ( ( i = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) {
7,102✔
253
                        AC.ProtoType[1] = osize;
14✔
254
                        error = 1;
14✔
255
                }
256
                else if ( error == 0 ) {
7,088✔
257
                        AC.ProtoType[1] = osize;
7,088✔
258
                        AC.ProtoType[2] = i;
7,088✔
259
                        if ( PutOut(BHEAD OldWork+2,&pos,AR.outfile,0) < 0 ) {
7,088✔
260
                                MesPrint("&Cannot create expression");
×
261
                                error = -1;
×
262
                        }
263
                        else {
264
                                Expressions[j].sizeprototype = OldWork[2];
7,088✔
265
                                OldWork[2] = 4+SUBEXPSIZE;
7,088✔
266
                                OldWork[4] = SUBEXPSIZE;
7,088✔
267
                                OldWork[5] = i;
7,088✔
268
                                OldWork[SUBEXPSIZE+3] = 1;
7,088✔
269
                                OldWork[SUBEXPSIZE+4] = 1;
7,088✔
270
                                OldWork[SUBEXPSIZE+5] = 3;
7,088✔
271
                                OldWork[SUBEXPSIZE+6] = 0;
7,088✔
272
                                if ( PutOut(BHEAD OldWork+2,&pos,AR.outfile,0) < 0
7,088✔
273
                                || FlushOut(&pos,AR.outfile,0) ) {
7,088✔
274
                                        MesPrint("&Cannot create expression");
×
275
                                        error = -1;
×
276
                                }
277
                                AR.outfile->POfull = AR.outfile->POfill;
7,088✔
278
                        }
279
                        OldWork[2] = j;
7,088✔
280
/*
281
                        Seems unnecessary (13-feb-2018)
282

283
                        AddNtoL(OldWork[1],OldWork);
284
*/
285
                        AT.WorkPointer = OldWork;
7,088✔
286
                        if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
7,088✔
287
                }
288
                AC.ToBeInFactors = 0;
7,102✔
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

384
int CoIdOld(UBYTE *inp)
7✔
385
{
386
        AC.idoption = 0;
7✔
387
        return(CoIdExpression(inp,TYPEIDOLD));
7✔
388
}
389

390
/*
391
          #] CoIdOld : 
392
          #[ CoId :
393
*/
394

395
int CoId(UBYTE *inp)
7,183✔
396
{
397
        AC.idoption = 0;
7,183✔
398
        return(CoIdExpression(inp,TYPEIDNEW));
7,183✔
399
}
400

401
/*
402
          #] CoId : 
403
          #[ CoIdNew :
404
*/
405

406
int CoIdNew(UBYTE *inp)
×
407
{
408
        AC.idoption = 0;
×
409
        return(CoIdExpression(inp,TYPEIDNEW));
×
410
}
411

412
/*
413
          #] CoIdNew : 
414
          #[ CoDisorder :
415
*/
416

417
int CoDisorder(UBYTE *inp)
×
418
{
419
        AC.idoption = SUBDISORDER;
×
420
        return(CoIdExpression(inp,TYPEIDNEW));
×
421
}
422

423
/*
424
          #] CoDisorder : 
425
          #[ CoMany :
426
*/
427

428
int CoMany(UBYTE *inp)
×
429
{
430
        AC.idoption = SUBMANY;
×
431
        return(CoIdExpression(inp,TYPEIDNEW));
×
432
}
433

434
/*
435
          #] CoMany : 
436
          #[ CoMulti :
437
*/
438

439
int CoMulti(UBYTE *inp)
×
440
{
441
        AC.idoption = SUBMULTI;
×
442
        return(CoIdExpression(inp,TYPEIDNEW));
×
443
}
444

445
/*
446
          #] CoMulti : 
447
          #[ CoIfMatch :
448
*/
449

450
int CoIfMatch(UBYTE *inp)
×
451
{
452
        AC.idoption = SUBAFTER;
×
453
        return(CoIdExpression(inp,TYPEIDNEW));
×
454
}
455

456
/*
457
          #] CoIfMatch : 
458
          #[ CoIfNoMatch :
459
*/
460

461
int CoIfNoMatch(UBYTE *inp)
×
462
{
463
        AC.idoption = SUBAFTERNOT;
×
464
        return(CoIdExpression(inp,TYPEIDNEW));
×
465
}
466

467
/*
468
          #] CoIfNoMatch : 
469
          #[ CoOnce :
470
*/
471

472
int CoOnce(UBYTE *inp)
7✔
473
{
474
        AC.idoption = SUBONCE;
7✔
475
        return(CoIdExpression(inp,TYPEIDNEW));
7✔
476
}
477

478
/*
479
          #] CoOnce : 
480
          #[ CoOnly :
481
*/
482

483
int CoOnly(UBYTE *inp)
×
484
{
485
        AC.idoption = SUBONLY;
×
486
        return(CoIdExpression(inp,TYPEIDNEW));
×
487
}
488

489
/*
490
          #] CoOnly : 
491
          #[ CoSelect :
492
*/
493

494
int 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

507
int CoIdExpression(UBYTE *inp, int type)
7,337✔
508
{
509
        GETIDENTITY
2,102✔
510
        int i, j, idhead, error = 0, MinusSign = 0, opt, retcode;
7,337✔
511
        WORD *w, *s, *m, *mm, *ww, *FirstWork, *OldWork, c1, numsets = 0,
7,337✔
512
                 oldnumrhs, *ow, oldEside;
513
        UBYTE *p, *pp, c;
7,337✔
514
        CBUF *C = cbuf+AC.cbufnum;
7,337✔
515
        LONG oldcpointer, x;
7,337✔
516
        FirstWork = OldWork = AT.WorkPointer;
7,337✔
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;
7,337✔
524
        AR.CurExpr = -1;
7,337✔
525
        w = AT.WorkPointer;
7,337✔
526
        *w++ = type;
7,337✔
527
        *w++ = idhead + SUBEXPSIZE;
7,337✔
528
        w++;
7,337✔
529
        if ( idhead >= IDHEAD ) *w++ = -1;
7,337✔
530
#if IDHEAD > 4
531
        for ( i = 4; i < idhead; i++ ) *w++ = 0;
22,011✔
532
#endif
533
        while ( *inp == ',' ) inp++;
7,337✔
534
        p = inp;
7,337✔
535
        if ( AC.idoption == SUBSELECT ) {
7,337✔
536
                p--;
×
537
                goto findsets;
×
538
        }
539
        else if ( ( AC.idoption == SUBAFTER ) || ( AC.idoption == SUBAFTERNOT ) ) {
7,337✔
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 != ',' ) {
97,612✔
559
                        if ( *p == '(' ) SKIPBRA4(p)
216,697✔
560
                        else if ( *p == '{' ) SKIPBRA5(p)
80,705✔
561
                        else if ( *p == '[' ) SKIPBRA1(p)
80,705✔
562
                        else p++;
80,705✔
563
                }
564
                if ( *p == '=' ) break;
10,375✔
565
                if ( *p == 0 ) {
3,038✔
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++;
23,576✔
574
                c = *pp; *pp = 0;
3,038✔
575
                i = sizeof(IdOptions)/sizeof(struct id_options);
3,038✔
576
                while ( --i >= 0 ) {
18,382✔
577
                        if ( StrICmp(inp,IdOptions[i].name) == 0 ) break;
18,382✔
578
                }
579
                if ( i < 0 ) {
3,038✔
580
                        MesPrint("&Illegal option %s in id-statement",inp);
×
581
                        *pp = c; error = 1; p++; inp = p; continue;
×
582
                }
583
                opt = IdOptions[i].code;
3,038✔
584
                *pp = c;
3,038✔
585
                inp = pp+1;
3,038✔
586
                switch ( opt ) {
3,038✔
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
                                }
601
findsets:;
×
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:
2,800✔
668
                        case SUBAFTERNOT:
669
                                if ( type == TYPEIF ) {
2,800✔
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;
2,800✔
674
                                pp += 2;        /* points now at the label */
2,800✔
675
                                inp = pp;
2,800✔
676
                                AC.idoption |= opt;
2,800✔
677
readlabel:
2,800✔
678
                                while ( FG.cTable[*pp] <= 1 ) pp++;
13,545✔
679
                                if ( pp != p ) {
2,800✔
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;
2,800✔
685
                                OldWork[3] = GetLabel(inp);
2,800✔
686
                                *p++ = c; inp = p;
2,800✔
687
                                break;
2,800✔
688
                        case SUBALL:
14✔
689
                                x = 0;
14✔
690
                                if ( *pp == '(' ) {
14✔
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;
×
704
IllOpt:
×
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;
14✔
721
                                if ( type != TYPEIDNEW ) {
14✔
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;
14✔
736
                                AC.idoption = opt;
14✔
737
                                break;
14✔
738
                        default:
224✔
739
                                if ( pp != p ) {
224✔
740
IllField:                        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;
224✔
745
                                if ( i && i != opt ) {
224✔
746
                                        MesPrint("&Conflicting options in id-statement");
×
747
                                        error = 1;  continue;
×
748
                                }
749
                                else AC.idoption |= opt;
224✔
750
                                while ( *p == ',' ) p++;
448✔
751
                                inp = p;
752
                                break;
753
                }
754
        }
755
        if ( ( AC.idoption & SUBMASK ) == 0 ) AC.idoption |= SUBMULTI;
7,337✔
756
        OldWork[2] = AC.idoption;
7,337✔
757
/*
758
        Now we have a field till the = sign
759
        Now the subexpression prototype
760
*/
761
        AC.ProtoType = w;
7,337✔
762
        *w++ = SUBEXPRESSION;
7,337✔
763
        *w++ = SUBEXPSIZE;
7,337✔
764
        *w++ = C->numrhs+1;
7,337✔
765
        *w++ = 1;
7,337✔
766
        *w++ = AC.cbufnum;
7,337✔
767
        FILLSUB(w)
768
        AC.WildC = w;
7,337✔
769
        AC.NwildC = 0;
7,337✔
770
        AT.WorkPointer = s = w + 4*AM.MaxWildcards + 8;
7,337✔
771
/*
772
        Now read the LHS
773
*/
774
        ClearWildcardNames();
7,337✔
775
        oldcpointer = AddLHS(AC.cbufnum) - C->Buffer;
7,337✔
776

777
        *p = 0;
7,337✔
778
        oldnumrhs = C->numrhs;
7,337✔
779
        if ( ( retcode = CompileAlgebra(inp,LHSIDE,AC.ProtoType) ) < 0 ) { error = 1; }
7,337✔
780
        else AC.ProtoType[2] = retcode;
7,337✔
781
        *p = '='; inp = p+1;
7,337✔
782
        AT.WorkPointer = s;
7,337✔
783
        if ( AC.NwildC && SortWild(w,AC.NwildC) ) error = 1;
7,337✔
784

785
                /* Make the LHS pointers ready */
786

787
        OldWork[1] = AC.WildC-OldWork;
7,337✔
788
        OldWork[idhead+1] = OldWork[1] - idhead;
7,337✔
789
        w = AC.WildC;
7,337✔
790
        AT.WorkPointer = w;
7,337✔
791
        s = C->rhs[C->numrhs];
7,337✔
792
/*
793
        Now check whether wildcards get converted to dollars (for PARALLEL)
794
*/
795
        {
796
                WORD *tw, *twstop;
7,337✔
797
                tw = AC.ProtoType; twstop = tw + tw[1]; tw += SUBEXPSIZE;
7,337✔
798
                while ( tw < twstop ) {
36,514✔
799
                        if ( *tw == LOADDOLLAR ) {
29,177✔
800
                                AddPotModdollar(tw[2]);
49✔
801
                        }
802
                        tw += tw[1];
29,177✔
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 ) {
7,337✔
814
IllLeft:MesPrint("&Illegal LHS");
×
815
                AC.lhdollarflag = 0;
×
816
                return(1);
×
817
        }
818
        if ( !error && *(s+*s) != 0 ) {
7,337✔
819
                MesPrint("&LHS should be one term only");
×
820
                return(1);
×
821
        }
822
        if ( error == 0 ) {
7,337✔
823
                WORD oldpolyfun = AR.PolyFun;
7,337✔
824
                if ( NewSort(BHEAD0) || NewSort(BHEAD0) ) {
7,337✔
825
                        if ( !error ) error = 1;
×
826
                        return(error);
×
827
                }
828
                AN.RepPoint = AT.RepCount + 1;
7,337✔
829
        ow = (WORD *)(((UBYTE *)(AT.WorkPointer)) + AM.MaxTer);
7,337✔
830
                mm = s; ww = ow; i = *mm;
7,337✔
831
                while ( --i >= 0 ) *ww++ = *mm++; AT.WorkPointer = ww;
100,180✔
832
                AC.lhdollarflag = 0; oldEside = AR.Eside; AR.Eside = LHSIDE;
7,337✔
833
                AR.Cnumlhs = C->numlhs;
7,337✔
834
                AR.PolyFun = 0;
7,337✔
835
                if ( Generator(BHEAD ow,C->numlhs) ) {
7,337✔
836
                        AR.Eside = oldEside;
×
837
                        LowerSortLevel(); LowerSortLevel(); AR.PolyFun = oldpolyfun; goto IllLeft;
×
838
                }
839
                AR.Eside = oldEside;
7,337✔
840
                AT.WorkPointer = w;
7,337✔
841
                if ( EndSort(BHEAD w,0) < 0 ) { LowerSortLevel(); AR.PolyFun = oldpolyfun; goto IllLeft; }
7,337✔
842
                AR.PolyFun = oldpolyfun;
7,337✔
843
                if ( *w == 0 || *(w+*w) != 0 ) {
7,337✔
844
                        MesPrint("&LHS must be one term");
×
845
                        AC.lhdollarflag = 0;
×
846
                        return(1);
×
847
                }
848
                LowerSortLevel();
7,337✔
849
                if ( AC.lhdollarflag ) MarkDirty(w,DIRTYFLAG);
7,337✔
850
        }
851
        AT.WorkPointer = w + *w;
7,337✔
852
        AC.DumNum = 0;
7,337✔
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;
7,337✔
860
        C->numrhs = oldnumrhs;
7,337✔
861
        C->numlhs--;
7,337✔
862

863
        m = w + *w - 3;
7,337✔
864
        AC.vectorlikeLHS = 0;
7,337✔
865
        if ( !error ) {
7,337✔
866
          if ( m[2] != 3 || m[1] != 1 || *m != 1 ) {
7,337✔
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 ) {
7,337✔
878
                if ( ( AC.idoption & SUBMASK ) != 0 &&  ( AC.idoption & SUBMASK ) !=
14✔
879
                SUBMULTI ) {
880
                        MesPrint("&Illegal option for substitution of a vector");
×
881
                        error = 1;
×
882
                }
883
                AC.DumNum = AM.IndDum;
14✔
884
                OldWork[2] = ( OldWork[2] - ( OldWork[2] & SUBMASK ) ) | SUBVECTOR;
14✔
885
                c1 = w[3];
14✔
886
                        /* We overwrite the LHS */
887
                *w++ = INDTOIND;
14✔
888
                *w++ = 4;
14✔
889
                *w++ = AC.DumNum + WILDOFFSET;
14✔
890
                *w++ = 0;
14✔
891
                w[0] = 5;
14✔
892
                w[1] = VECTOR;
14✔
893
                w[2] = 4;
14✔
894
                w[3] = c1;
14✔
895
                w[4] = AC.DumNum + WILDOFFSET;
14✔
896
                OldWork[idhead+1] = w - OldWork - idhead;
14✔
897
                AC.vectorlikeLHS = 1;
14✔
898
          }
899
          else {
900
                AC.DumNum = 0;
7,323✔
901
                *w -= 3;
7,323✔
902
                i = OldWork[2] & SUBMASK;
7,323✔
903
                m = w + *w;
7,323✔
904
                if ( i == 0 || i == SUBMULTI ) {
7,323✔
905
                        s = w+1;
7,078✔
906
                        while ( s < m ) {
7,862✔
907
                                if ( *s == SYMBOL ) {
7,078✔
908
                                        j = s[1]/2; s += 2;
994✔
909
                                        while ( --j >= 0 ) {
2,520✔
910
                                                if ( ABS(s[1]) > 2*MAXPOWER ) {
1,757✔
911
                                                        OldWork[2] = ( OldWork[2] - i ) | SUBONCE;
231✔
912
                                                        break;
231✔
913
                                                }
914
                                                s += 2;
1,526✔
915
                                        }
916
                                        if ( j >= 0 ) break;
994✔
917
                                }
918
                                else if ( *s == DOTPRODUCT ) {
6,084✔
919
                                        j = s[1]/3; s += 2;
21✔
920
                                        while ( --j >= 0 ) {
42✔
921
                                                if ( ABS(s[2]) > 2*MAXPOWER ) {
21✔
922
                                                        OldWork[2] = ( OldWork[2] - i ) | SUBONCE;
×
923
                                                        break;
×
924
                                                }
925
                                                else if ( s[1] >= -(2*WILDOFFSET) || s[0] >= -(2*WILDOFFSET) ) {
21✔
926
                                                        OldWork[2] = ( OldWork[2] - i ) | SUBMANY;
21✔
927
                                                        i = SUBMANY;
21✔
928
                                                }
929
                                                s += 3;
21✔
930
                                        }
931
                                        if ( j >= 0 ) break;
21✔
932
                                }
933
                                else {
934
                                        OldWork[2] = ( OldWork[2] - i ) | SUBMANY;
6,063✔
935
                                        break;
6,063✔
936
                                }
937
                        }
938
                }
939
                if ( ( OldWork[2] & SUBMASK ) == 0 ) OldWork[2] |= SUBMULTI;
7,323✔
940
          }
941
          if ( ( OldWork[2] & SUBMASK ) == SUBSELECT ) {
7,337✔
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;
7,337✔
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;
7,337✔
968
        OldWork[1] = m - OldWork;
7,337✔
969
        AC.ProtoType = OldWork+idhead;
7,337✔
970
        if ( !error ) {
7,337✔
971
                if ( StudyPattern(OldWork) ) error = 1;
7,337✔
972
        }
973
        AT.WorkPointer = OldWork + OldWork[1];
7,337✔
974
        if ( AC.lhdollarflag ) OldWork[4] |= DOLLARFLAG;
7,337✔
975
        AC.lhdollarflag = 0;
7,337✔
976
/*
977
        Test whether the id/idold configuration is fine.
978
*/
979
        if ( type == TYPEIDOLD ) {
7,337✔
980
                WORD ci = C->numlhs;
7✔
981
                while ( ci >= 1 ) {
7✔
982
                        if ( C->lhs[ci][0] == TYPEIDNEW ) {
7✔
983
                                if ( (C->lhs[ci][2] & SUBMASK) == SUBALL ) {
7✔
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 ) {
7✔
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 ) {
7,337✔
1002
                if ( ( retcode = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) error = 1;
7,197✔
1003
                else {
1004
                        AC.ProtoType[2] = retcode;
7,183✔
1005
                        AC.DumNum = 0;
7,183✔
1006
                        if ( MinusSign ) {        /* Flip the sign of the RHS */
7,183✔
1007
                                w = C->rhs[retcode];
×
1008
                                while ( *w ) { w += *w; w[-1] = -w[-1]; }
×
1009
                        }
1010
                        if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
7,183✔
1011
                }
1012
        }
1013
/*
1014
        Actual adding happens only now after numrhs insertion
1015
*/
1016
        if ( !error ) { AddNtoL(OldWork[1],OldWork); }
7,323✔
1017
AllDone:
7✔
1018
        AC.lhdollarflag = 0;
7,337✔
1019
        AT.WorkPointer = FirstWork;
7,337✔
1020
        return(error);
7,337✔
1021
}
1022

1023
/*
1024
          #] CoIdExpression : 
1025
          #[ CoMultiply :
1026
*/
1027

1028
static WORD mularray[13] = { TYPEMULT, SUBEXPSIZE+3, 0, SUBEXPRESSION,
1029
                SUBEXPSIZE, 0, 1, 0, 0, 0, 0, 0, 0 };
1030

1031
int CoMultiply(UBYTE *inp)
419✔
1032
{
1033
        UBYTE *p;
419✔
1034
        int error = 0, RetCode;
419✔
1035
        mularray[2] = 0;                /* right multiply is default */
419✔
1036
        while ( *inp == ',' ) inp++;
419✔
1037
/*        if ( inp[-1] == '-' || inp[-1] == '+' ) inp--; */
1038
        p = SkipField(inp,0);
419✔
1039
        if ( *p ) {
419✔
1040
                *p = 0;
28✔
1041
                if ( StrICont(inp,(UBYTE *)"left") == 0 )       mularray[2] = 1;
28✔
1042
                else if ( StrICont(inp,(UBYTE *)"right") == 0 ) mularray[2] = 0;
28✔
1043
                else {
1044
                        MesPrint("&Illegal option in multiply statement or ; forgotten.");
×
1045
                        return(1);
×
1046
                }
1047
                *p = ',';
28✔
1048
                inp = p + 1;
28✔
1049
        }
1050
        ClearWildcardNames();
419✔
1051
        while ( *inp == ',' ) inp++;
419✔
1052
        AC.ProtoType = mularray+3;
419✔
1053
        mularray[7] = AC.cbufnum;
419✔
1054
        if ( ( RetCode = CompileAlgebra(inp,RHSIDE,AC.ProtoType) ) < 0 ) error = 1;
419✔
1055
        else {
1056
                mularray[5] = RetCode;
419✔
1057
                AddNtoL(SUBEXPSIZE+3,mularray);
419✔
1058
                if ( AC.dumnumflag ) Add2Com(TYPEDETCURDUM)
419✔
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

1070
int CoFill(UBYTE *inp)
234✔
1071
{
1072
        GETIDENTITY
68✔
1073
        WORD error = 0, x, xx, funnum, type, *oldwp = AT.WorkPointer;
234✔
1074
        int i, oldcbufnum = AC.cbufnum, nofill = 0, numover, redef = 0;
234✔
1075
        WORD *w, *wold, *Tprototype;
234✔
1076
        UBYTE *p = inp, c, *inp1;
234✔
1077
        TABLES T = 0, oldT;
234✔
1078
        LONG newreservation, sum = 0;
234✔
1079
        UBYTE *p1, *p2, *p3, *p4, *fake = 0;
234✔
1080
        int tablestub = 0;
234✔
1081
        if ( AC.exprfillwarning == 1 ) AC.exprfillwarning = 0;
234✔
1082
/*
1083
        Read the name of the function and test that it is in the table.
1084
*/
1085
        p1 = inp;
234✔
1086
        if ( ( p = SkipAName(inp) ) == 0 ) return(1);
234✔
1087
        p2 = p;
234✔
1088
        c = *p; *p = 0;
234✔
1089
        if ( ( GetVar(inp,&type,&funnum,CFUNCTION,WITHAUTO) == NAMENOTFOUND )
234✔
1090
        || ( T = functions[funnum].tabl ) == 0 || ( T->numind > 0 && c != '(' ) ) {
234✔
1091
                MesPrint("&%s should be a table with argument(s)",inp);
×
1092
                *p = c; return(1);
×
1093
        }
1094
        oldT = T;
234✔
1095
        *p++ = c;
234✔
1096
        if ( T->numind == 0 ) {
234✔
1097
                if ( c == '(' ) {
77✔
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;
77✔
1107
                p3 = p;
77✔
1108
                goto andagain;
77✔
1109
        }
1110
        w = oldwp;
157✔
1111
        if ( T->numind < 0 ) { /* Pick up the first index */
157✔
1112
                ParseSignedNumber(xx,p);
×
1113
                if ( FG.cTable[p[-1]] != 1 || *p != ',' || xx < 1 || ( xx > ( -T->numind - 1 ) ) ) {
×
1114
                        MesPrint("&No valid number of table indices in *-table fill statement.");
×
1115
                        return(1);
×
1116
                }
1117
                *w++ = xx;
×
1118
                p++;
×
1119
        }
1120
        else { xx = T->numind; }
1121
        for ( sum = 0, i = 0; i < xx; i++ ) {
157✔
1122
                ParseSignedNumber(x,p);
328✔
1123
                if ( FG.cTable[p[-1]] != 1 || ( *p != ',' && *p != ')' ) ) {
157✔
1124
                        MesPrint("&Table arguments in fill statement should be numbers");
×
1125
                        return(1);
×
1126
                }
1127
                if ( T->sparse ) *w++ = x;
157✔
1128
                else if ( x < T->mm[i].mini || x > T->mm[i].maxi ) {
87✔
1129
                        MesPrint("&Value %d for argument %d of table out of bounds",x,i+1);
×
1130
                        error = 1; nofill = 1;
×
1131
                }
1132
                else sum += ( x - T->mm[i].mini ) * T->mm[i].size;
87✔
1133
                if ( *p == ')' ) break;
157✔
1134
                p++;
×
1135
        }
1136
        p3 = p;
157✔
1137
        if ( T->numind < 0 ) {
157✔
1138
                for ( ; i < ABS(T->numind)-1; i++ ) *w++ = 0;
×
1139
                xx = -T->numind;
×
1140
        }
1141
        if ( *p != ')' || i < ( xx - 1 ) ) {
157✔
1142
                MesPrint("&Incorrect number of table arguments in fill statement. Should be %d"
×
1143
                ,T->numind);
1144
                error = 1; nofill = 1;
×
1145
        }
1146
        AT.WorkPointer = w;
157✔
1147
        if ( T->sparse == 0 ) sum *= TABLEEXTENSION;
157✔
1148
andagain:;
234✔
1149
        AC.cbufnum = T->bufnum;
234✔
1150
        if ( T->sparse ) {
234✔
1151
                i = FindTableTree(T,oldwp,1);
70✔
1152
                if ( i >= 0 ) {
70✔
1153
                        sum = i + ABS(T->numind);
×
1154
                        if ( tablestub == 0 && ( ( T->sparse & 2 ) == 2 ) && ( T->mode != 0 )
×
1155
                        && ( AC.vetotablebasefill == 0 ) ) {
×
1156
/*
1157
                                This redefinition does not need a new stub
1158
*/
1159
                                functions[funnum].tabl = T = T->spare;
×
1160
                                tablestub = 1;
×
1161
                                goto andagain;
×
1162
                        }
1163
                        redef = 1;
×
1164
                        goto redef;
×
1165
                }
1166
                if ( T->totind >= T->reserved ) {
70✔
1167
                        if ( T->reserved == 0 ) newreservation = 20;
7✔
1168
                        else newreservation = T->reserved;
×
1169
                        while ( T->totind >= newreservation && newreservation < MAXTABLECOMBUF )
7✔
1170
                                        newreservation = 2*newreservation;
×
1171
                        if ( newreservation > MAXTABLECOMBUF ) newreservation = MAXTABLECOMBUF;
7✔
1172
                        if ( T->totind >= newreservation ) {
7✔
1173
                                MesPrint("@More than %ld elements in sparse table",MAXTABLECOMBUF);
×
1174
                                AC.cbufnum = oldcbufnum;
×
NEW
1175
                                TERMINATE(-1);
×
1176
                        }
1177
                        wold = (WORD *)Malloc1(newreservation*sizeof(WORD)*
14✔
1178
                                                                (ABS(T->numind)+TABLEEXTENSION),"tablepointers");
7✔
1179
                        for ( i = T->reserved*(ABS(T->numind)+TABLEEXTENSION)-1; i >= 0; i-- )
7✔
1180
                                wold[i] = T->tablepointers[i];
×
1181
                        if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
7✔
1182
                        T->tablepointers = wold;
7✔
1183
                        T->reserved = newreservation;
7✔
1184
                }
1185
                w = oldwp;
70✔
1186
                for ( sum = T->totind*(ABS(T->numind)+TABLEEXTENSION), i = 0; i < ABS(T->numind); i++ ) {
140✔
1187
                        T->tablepointers[sum++] = *w++;
70✔
1188
                }
1189
                InsTableTree(T,T->tablepointers+sum-ABS(T->numind));
70✔
1190
#if TABLEEXTENSION == 2
1191
                T->tablepointers[sum+TABLEEXTENSION-1] = -1;  /* New element! */
1192
#else
1193
                T->tablepointers[sum+1] = T->bufnum;
70✔
1194
                T->tablepointers[sum+2] = -1;
70✔
1195
                T->tablepointers[sum+3] = -1;
70✔
1196
                T->tablepointers[sum+4] = 0;
70✔
1197
                T->tablepointers[sum+5] = 0;
70✔
1198
#endif
1199
        }
1200
        else {
1201
                if ( !nofill && T->tablepointers[sum] >= 0 ) {
164✔
1202
redef:;
×
1203
                        if ( AC.vetofilling ) nofill = 1;
×
1204
                        else {
1205
                                Warning("Table element was already defined. New definition will be used");
×
1206
                        }
1207
                }
1208
#if TABLEEXTENSION == 2
1209
                T->tablepointers[sum+TABLEEXTENSION-1] = -1;  /* New element! */
1210
#else
1211
                T->tablepointers[sum+1] = T->bufnum;
164✔
1212
                T->tablepointers[sum+2] = -1;
164✔
1213
                T->tablepointers[sum+3] = -1;
164✔
1214
                T->tablepointers[sum+4] = 0;
164✔
1215
                T->tablepointers[sum+5] = 0;
164✔
1216
#endif
1217
        }
1218
        if ( T->numind ) { p++; }
234✔
1219
        if ( *p != '=' ) {
234✔
1220
                MesPrint("&Fill statement misses = sign after the table element");
×
1221
                AC.cbufnum = oldcbufnum;
×
1222
                AT.WorkPointer = oldwp;
×
1223
                functions[funnum].tabl = oldT;
×
1224
                return(1);
×
1225
        }
1226
        if ( tablestub == 0 && T->mode == 1 && AC.vetotablebasefill == 0 ) {
234✔
1227
/*
1228
                Here we construct a righthandside from the indices and the wildcards
1229
*/
1230
                int numfake;
×
1231
                tablestub = 1;
×
1232
                p4 = T->argtail;
×
1233
                while ( *p4 ) p4++;
×
1234
                numfake = (p4-T->argtail)+(p3-p1)+10;
×
1235

1236
                fake = (UBYTE *)Malloc1(numfake*sizeof(UBYTE),"Fill fake rhs");
×
1237
                p = fake;
×
1238
                *p++ = 't'; *p++ = 'b'; *p++ = 'l'; *p++ = '_'; *p++ = '(';
×
1239
                p4 = p1; while ( p4 < p2 ) *p++ = *p4++; *p++ = ',';
×
1240
                p4 = p2+1; while ( p4 < p3 ) *p++ = *p4++;
×
1241
                if ( T->argtail ) {
×
1242
                        p4 = T->argtail + 1;
×
1243
                        while ( FG.cTable[*p4] == 1 ) p4++;
×
1244
                        while ( *p4 ) {
×
1245
                                if ( *p4 == '?' && p[-1] != ',' ) {
×
1246
                                        p4++;
×
1247
                                        if ( FG.cTable[*p4] == 0 || *p4 == '$' || *p4 == '[' ) {
×
1248
                                                p4 = SkipAName(p4);
×
1249
                                                if ( *p4 == '[' ) {
×
1250
                                                        SKIPBRA1(p4);
×
1251
                                                }
1252
                                        }
1253
                                        else if ( *p4 == '{' ) {
×
1254
                                                SKIPBRA2(p4);
×
1255
                                        }
1256
                                        else if ( *p4 ) { *p++ = *p4++; continue; }
×
1257
                                }
1258
                                else *p++ = *p4++;
×
1259
                        }
1260
                }
1261
                *p++ = ')';
×
1262
                *p = 0;
×
1263
                inp1 = fake;
×
1264
        }
1265
        else {
1266
                inp1 = ++p;
234✔
1267
        }
1268
        c = 0;
234✔
1269
/*
1270
        Now we have the indices and p points to the rhs.
1271
*/
1272
        numover = 0;
234✔
1273
        AC.tablefilling = funnum;
234✔
1274
        while ( *inp1 ) {
234✔
1275
                p = SkipField(inp1,0);
234✔
1276
                c = *p; *p = 0;
234✔
1277
#ifdef WITHPTHREADS
1278
                Tprototype = T->prototype[0];
68✔
1279
#else
1280
                Tprototype = T->prototype;
166✔
1281
#endif
1282
                if ( ( i = CompileAlgebra(inp1,RHSIDE,Tprototype) ) < 0 ) { error = 1; i = 0; }
234✔
1283
                if ( !nofill ) {
234✔
1284
                        T->tablepointers[sum] = i;
234✔
1285
                        T->tablepointers[sum+1] = T->bufnum;
234✔
1286
                }
1287
                AC.DumNum = 0;
234✔
1288
                *p = c;
234✔
1289
                if ( T->sparse || c == 0 ) break;
234✔
1290
                inp1 = ++p;
×
1291
#if ( TABLEEXTENSION == 2 )
1292
                sum++;
1293
#else
1294
                sum += 2;
×
1295
#endif
1296
                if ( !nofill && T->tablepointers[sum] >= 0 ) numover++;
×
1297
#if ( TABLEEXTENSION == 2 )
1298
                sum++;
1299
#else
1300
                sum += TABLEEXTENSION-2;
×
1301
#endif
1302
        }
1303
        if ( AC.exprfillwarning == 1 ) {
234✔
1304
                AC.exprfillwarning = 2;
10✔
1305
                Warning("Use of expressions and/or $variables in Fill statements is potentially very dangerous.");
10✔
1306
        }
1307
        AC.tablefilling = 0;
234✔
1308
        if ( T->sparse && c != 0 ) {
234✔
1309
                MesPrint("&In sparse tables one can fill only one element at a time");
×
1310
                error = 1;
×
1311
        }
1312
        else if ( numover ) {
234✔
1313
                if ( numover == 1 )
×
1314
                        Warning("one element was overwritten. New definition will be used");
×
1315
                else if ( AC.WarnFlag )
×
1316
                        MesPrint("&Warning: %d elements were overwritten. New definitions will be used",numover);
×
1317
        }
1318
        if ( T->sparse ) {
234✔
1319
                if ( redef == 0 ) T->totind++;
70✔
1320
        }
1321
        else T->defined++;
164✔
1322
/*
1323
        NumSets = AC.SetList.numtemp;
1324
        NumSetElements = AC.SetElementList.numtemp;
1325
*/
1326
        if ( fake ) {
234✔
1327
                M_free(fake,"Fill fake rhs");
×
1328
                fake = 0;
×
1329
                functions[funnum].tabl = T = T->spare;
×
1330
                p = p3;
×
1331
                goto andagain;
×
1332
        }
1333
        AC.cbufnum = oldcbufnum;
234✔
1334
        AC.SymChangeFlag = 1;
234✔
1335
        AT.WorkPointer = oldwp;
234✔
1336
        functions[funnum].tabl = oldT;
234✔
1337
        return(error);
234✔
1338
}
1339

1340
/*
1341
          #] CoFill : 
1342
          #[ CoFillExpression :
1343

1344
        Syntax: FillExpression table = expression(x1,...,xn);
1345
        The arguments should have been bracketed. Each corresponds to one
1346
        of the dimensions of the table. Then the bracket with x1^2*x3^4
1347
        will fill the (2,0,4) element of the table (if n=3 of course).
1348
        Brackets that don't fit will be skipped. It just gives a warning.
1349

1350
        New option (13-jul-2005)
1351
        Syntax: FillExpression table = expression(f);
1352
        The table indices are arguments of the function f which should
1353
        have been bracketed before.
1354
*/
1355

1356
int CoFillExpression(UBYTE *inp)
7✔
1357
{
1358
        GETIDENTITY
2✔
1359
        UBYTE *p, c;
7✔
1360
        WORD type, funnum, expnum, symnum, numsym = 0, *oldwork = AT.WorkPointer;
7✔
1361
        WORD *brackets, *term, brasize, *b, *m, *w, *pw, *tstop, zero = 0;
7✔
1362
        WORD oldcbuf = AC.cbufnum, curelement = 0;
7✔
1363
        int weneedit, i, j, numzero, pow, numfirst;
7✔
1364
        TABLES T = 0;
7✔
1365
        LONG newreservation, numcommu, sum;
7✔
1366
        POSITION oldposition;
7✔
1367
        FILEHANDLE *fi; 
7✔
1368
        CBUF *C;
7✔
1369
        WORD numdummies;
7✔
1370

1371
        AN.IndDum = AM.IndDum;
7✔
1372
        if ( ( p = SkipAName(inp) ) == 0 ) return(1);
7✔
1373
        c = *p; *p = 0;
7✔
1374
        if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
7✔
1375
        || ( T = functions[funnum].tabl ) == 0 ) {
7✔
1376
                MesPrint("&%s should be a previously declared table",inp);
×
1377
                *p = c; return(1);
×
1378
        }
1379
        *p++ = c;
7✔
1380
        if ( T->spare ) T = T->spare;
7✔
1381
        C = cbuf + T->bufnum;
7✔
1382
        if ( c != '=' ) {
7✔
1383
                MesPrint("&No = sign in FillExpression statement");
×
1384
                return(1);
×
1385
        }
1386
        inp = p;
7✔
1387
        if ( ( p = SkipAName(inp) ) == 0 ) return(1);
7✔
1388
        c = *p; *p = 0;
7✔
1389
        if ( ( type = GetName(AC.exprnames,inp,&expnum,NOAUTO) ) == NAMENOTFOUND
7✔
1390
        || c != '(' || (
7✔
1391
                Expressions[expnum].status != LOCALEXPRESSION &&
7✔
1392
                Expressions[expnum].status != SKIPLEXPRESSION &&
1393
                Expressions[expnum].status != DROPLEXPRESSION &&
7✔
1394
                Expressions[expnum].status != GLOBALEXPRESSION &&
×
1395
                Expressions[expnum].status != SKIPGEXPRESSION &&
×
1396
                Expressions[expnum].status != DROPGEXPRESSION ) ) {
1397
                MesPrint("&%s should be an active expression with arguments",inp);
×
1398
                *p = c; return(1);
×
1399
        }
1400
        if ( Expressions[expnum].inmem ) {
7✔
1401
                MesPrint("&%s cannot be used in a FillExpression statement in the same %n\
×
1402
        module that it has been redefined",inp);
1403
                *p = c; return(1);
×
1404
        }
1405
        *p++ = c;
7✔
1406
        while ( *p ) {
7✔
1407
                inp = p;
7✔
1408
                if ( ( p = SkipAName(inp) ) == 0 ) return(1);
7✔
1409
                c = *p; *p = 0;
7✔
1410

1411
                if ( GetVar(inp,&type,&symnum,-1,NOAUTO) == NAMENOTFOUND ) {
7✔
1412
                        MesPrint("&%s should be a previously declared symbol or function",inp);
×
1413
                        *p = c; return(1);
×
1414
                }
1415
                else if ( type == CSYMBOL ) {
7✔
1416
                        *p++ = c;
7✔
1417
                        *AT.WorkPointer++ = symnum;
7✔
1418
                        numsym++;
7✔
1419
                }
1420
                else if ( type == CFUNCTION ) {
×
1421
                        numsym = -1;
×
1422
                        *p++ = c;
×
1423
                        if ( c != ')' ) {
×
1424
                                MesPrint("&Argument should be a single function or a list of symbols");
×
1425
                                return(1);
×
1426
                        }
1427
                        symnum += FUNCTION;
×
1428
                        *AT.WorkPointer++ = symnum;
×
1429
                }
1430
                else {
1431
                        MesPrint("&%s should be a previously declared symbol or function",inp);
×
1432
                        *p = c; return(1);
×
1433
                }
1434
                if ( c == ')' ) break;
7✔
1435
                if ( c != ',' ) {
×
1436
                        MesPrint("&Illegal separator in FillExpression statement");
×
1437
                        goto noway;
×
1438
                }
1439
        }
1440
        if ( *p ) {
7✔
1441
                MesPrint("&Illegal end of FillExpression statement");
×
1442
                goto noway;
×
1443
        }
1444
/*
1445
        We have the number of the table in funnum.
1446
        The number of the expression in expnum, the table struct in T
1447
        and either the numbers of the symbols in oldwork (there are numsym of them)
1448
        or the number of the function in oldwork (just one and numsym = -1).
1449
        We don't sort them!!!!
1450
*/
1451
        if ( ( numsym > 0 ) && ( ABS(T->numind) != numsym ) ) {
7✔
1452
                MesPrint("&This table needs %d symbols for its array indices");
×
1453
                goto noway;
×
1454
        }
1455
        EXCHINOUT
7✔
1456
#ifdef WITHMPI
1457
        /*
1458
         * The workers can't access to the data of the input expression. We need to
1459
         * broadcast it to all the workers.
1460
         */
1461
        PF_BroadcastExpr(&Expressions[expnum], AR.infile);
4✔
1462
        if ( PF.me == MASTER ) {
4✔
1463
                /*
1464
                 * Restore the file position on the master.
1465
                 */
1466
                POSITION pos;
1✔
1467
                SetEndScratch(AR.infile, &pos);
1✔
1468
        }
1469
#endif
1470
        fi = AR.infile;
7✔
1471
        if ( fi->handle >= 0 ) {
7✔
1472
                PUTZERO(oldposition);
×
1473
                SeekFile(fi->handle,&oldposition,SEEK_CUR);
×
1474
                SetScratch(fi,&(Expressions[expnum].onfile));
×
1475
                if ( ISNEGPOS(Expressions[expnum].onfile) ) {
×
1476
                        MesPrint("&File error in FillExpression");
×
1477
                        BACKINOUT
×
1478
                        goto noway;
×
1479
                }
1480
        }
1481
        else {
1482
/*
1483
                Note: Because everything fits inside memory we never get problems
1484
                with excessive file sizes.
1485
*/
1486
                SETBASEPOSITION(oldposition,(UBYTE *)(fi->POfill)-(UBYTE *)(fi->PObuffer));
7✔
1487
                fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + BASEPOSITION(Expressions[expnum].onfile));
7✔
1488
        }
1489
        pw = AT.WorkPointer;
7✔
1490
        if ( numsym < 0 ) { brackets = pw + 1; }
7✔
1491
        else { brackets = pw + numsym; }
7✔
1492
        brasize = -1; weneedit = 0; /* stands for we need it */
7✔
1493
    term = (WORD *)(((UBYTE *)(brackets)) + AM.MaxTer);
7✔
1494
    AT.WorkPointer = (WORD *)(((UBYTE *)(term)) + AM.MaxTer);
7✔
1495
        AC.cbufnum = T->bufnum;
7✔
1496
        AC.tablefilling = funnum;
7✔
1497
        if ( GetTerm(BHEAD term) > 0 ) {                        /* Skip prototype */
7✔
1498
                while ( GetTerm(BHEAD term) > 0 ) {
77✔
1499
                        GETSTOP(term,tstop);
70✔
1500
                        w = m = term + 1;
70✔
1501
                        while ( m < tstop && *m != HAAKJE ) m += m[1];
140✔
1502
                        if ( *m != HAAKJE ) {
70✔
1503
                                MesPrint("&Illegal attempt to put an expression without brackets in a table");
×
1504
                                BACKINOUT
×
1505
                                goto noway;
×
1506
                        }
1507
                        if ( brasize == m - w ) {
70✔
1508
                                b = brackets;
1509
                                while ( *b == *w && w < m ) { b++; w++; }
252✔
1510
                                if ( w == m ) { /* Same as current bracket. Copy. */
63✔
1511
                                        if ( weneedit ) {
×
1512
                                                m += m[1] - 1;
×
1513
                                                *m = *term - (m-term);
×
1514
                                                AddNtoC(AC.cbufnum,*m,m,3);
×
1515
                                                numdummies = DetCurDum(BHEAD term) - AM.IndDum;
×
1516
                                                if ( numdummies > T->numdummies ) T->numdummies = numdummies;
×
1517
                                        }
1518
                                        continue; /* Next term */
×
1519
                                }
1520
                        }
1521
                        if ( weneedit ) {
70✔
1522
                                AddNtoC(AC.cbufnum,1,&zero,4);        /* Terminate old bracket */
63✔
1523
                                numcommu = numcommute(C->rhs[curelement],&(C->NumTerms[curelement]));
63✔
1524
                                C->CanCommu[curelement] = numcommu;
63✔
1525
                        }
1526
                        b = brackets; w = term + 1;
70✔
1527
                        if ( numsym < 0 ) pw = oldwork + 1;
70✔
1528
                        else              pw = oldwork + numsym;
70✔
1529
                        while ( w < m ) *b++ = *w++;
350✔
1530
                        brasize = b - brackets;
70✔
1531
/*
1532
                        Now compute the element. See whether we need it
1533
*/
1534
                        if ( numsym < 0 ) {
70✔
1535
                                WORD *bb, bnum;
×
1536
                                if ( *brackets != symnum || brasize != brackets[1] ) {
×
1537
                                        weneedit = 0; continue;        /* Cannot work! */
×
1538
                                }
1539
/*
1540
                                Now count the number of arguments and whether they are numbers
1541
*/
1542
                                b = brackets + FUNHEAD;
×
1543
                                bb = brackets+brackets[1];
×
1544
                                i = 0;
×
1545
                                if ( T->numind < 0 ) {
×
1546
                                        bnum = b[1]+1;
×
1547
                                        if ( bnum > -T->numind ) {
×
1548
                                                weneedit = 0; continue;        /* Cannot work! */
×
1549
                                        }
1550
                                }
1551
                                else bnum = T->numind;
×
1552
                                while ( b < bb ) {
×
1553
                                        if ( *b != -SNUMBER ) break;
×
1554
                                        i++;
×
1555
                                        b += 2;
×
1556
                                }
1557
                                if ( b < bb || i != bnum ) {
×
1558
                                        weneedit = 0; continue;        /* Cannot work! */
×
1559
                                }
1560
                        }
1561
                        else if ( brasize > 0 && ( *brackets != SYMBOL 
70✔
1562
                        || brackets[1] < brasize || (brackets[1]-2) > numsym*2 ) ) {
70✔
1563
                                weneedit = 0; continue;        /* Cannot work! */
×
1564
                        }
1565
                        numzero = 0; sum = 0;
70✔
1566
                        numfirst = 0;
70✔
1567
                        if ( numsym > 0 ) {
70✔
1568
                          for ( i = 0; i < numsym; i++ ) {
140✔
1569
                                if ( brasize > 0 ) {
70✔
1570
                                        b = brackets + 2; j = brackets[1]-2;
70✔
1571
                                        while ( j > 0 ) {
70✔
1572
                                                if ( *b == oldwork[i] ) break;
70✔
1573
                                                j -= 2; b += 2;
×
1574
                                        }
1575
                                        if ( j <= 0 ) {  /* it was not there */
70✔
1576
                                                numzero++; pow = 0;
×
1577
                                                if ( 2*numzero+brackets[1]-2 > numsym*2 ) {
×
1578
                                                        weneedit = 0; goto nextterm;
×
1579
                                                }
1580
                                        }
1581
                                        else pow = b[1];
70✔
1582
                                }
1583
                                else pow = 0;
1584
                                if ( T->sparse ) {
70✔
1585
                                        if ( T->numind < 0 ) {
×
1586
                                                if ( i == 0 ) {
×
1587
                                                        numfirst = pow;
×
1588
                                                        if ( pow > -T->numind ) {
×
1589
                                                                weneedit = 0; goto nextterm;
×
1590
                                                        }
1591
                                                }
1592
                                                else if ( i > pow ) {
×
1593
                                                        weneedit = 0; goto nextterm;
×
1594
                                                }
1595
                                        }
1596
                                        *pw++ = pow;
×
1597
                                }
1598
                                else if ( pow < T->mm[i].mini || pow > T->mm[i].maxi ) {
70✔
1599
                                        weneedit = 0; goto nextterm;
×
1600
                                }
1601
                                else sum += ( pow - T->mm[i].mini ) * T->mm[i].size;
70✔
1602
                          }
1603
                        }
1604
                        else {
1605
                          WORD xx;
×
1606
                          b = brackets + FUNHEAD;
×
1607
                          sum = 0;
×
1608
/*
1609
                          Now scan the arguments of the function.
1610
                          We did check already the number and type of the arguments.
1611
*/
1612
                          xx = (brackets[1]-FUNHEAD)/2;
×
1613
                          for ( i = 0; i < xx; i++ ) {
×
1614
                                pow = b[1];
×
1615
                                b += 2;
×
1616
                                if ( T->sparse ) {
×
1617
                                        if ( T->numind < 0 ) {
×
1618
                                                if ( i == 0 ) {
×
1619
                                                        numfirst = pow;
×
1620
                                                        if ( pow >= -T->numind ) {
×
1621
                                                                weneedit = 0; goto nextterm;
×
1622
                                                        }
1623
                                                }
1624
                                        }
1625
                                        *pw++ = pow;
×
1626
                                }
1627
                                else if ( pow < T->mm[i].mini || pow > T->mm[i].maxi ) {
×
1628
                                        weneedit = 0; goto nextterm;
×
1629
                                }
1630
                                else sum += ( pow - T->mm[i].mini ) * T->mm[i].size;
×
1631
                          }
1632
                        }
1633
                        if ( T->numind < 0 ) {
70✔
1634
                                for ( i = numfirst+1; i < -T->numind; i++ ) *pw++ = 0;
×
1635
                        }
1636
                        weneedit = 1;
70✔
1637
                        if ( T->sparse ) {
70✔
1638
                                if ( numsym < 0 ) pw = oldwork + 1;
×
1639
                                else              pw = oldwork + ABS(T->numind);
×
1640
                                i = FindTableTree(T,pw,1);
×
1641
                                if ( i >= 0 ) {
×
1642
                                        sum = i+ABS(T->numind);
×
1643
/*
1644
Wrong!!!!                        C->rhs[T->tablepointers[sum]] = C->Pointer;
1645
*/
1646
                                        C->Pointer--; /* Back up over the zero */
×
1647
                                        goto newentry;
×
1648
                                }
1649
                                if ( T->totind >= T->reserved ) {
×
1650
                                        if ( T->reserved == 0 ) newreservation = 20;
×
1651
                                        else newreservation = T->reserved;
×
1652
/*---Copied from Fill---------------------------*/
1653
                                        while ( T->totind >= newreservation && newreservation < MAXTABLECOMBUF )
×
1654
                                                        newreservation = 2*newreservation;
×
1655
                                        if ( newreservation > MAXTABLECOMBUF ) newreservation = MAXTABLECOMBUF;
×
1656
                                        if ( T->totind >= newreservation ) {
×
1657
                                                MesPrint("@More than %ld elements in sparse table",MAXTABLECOMBUF);
×
1658
                                                AC.cbufnum = oldcbuf;
×
1659
                                                AT.WorkPointer = oldwork;
×
NEW
1660
                                                TERMINATE(-1);
×
1661
                                        }
1662
/*---Copied from Fill---------------------------*/
1663
                                        if ( T->totind >= newreservation ) {
×
1664
                                                MesPrint("@More than %ld elements in sparse table",MAXTABLECOMBUF);
×
1665
                                                AC.cbufnum = oldcbuf;
×
1666
                                                AT.WorkPointer = oldwork;
×
NEW
1667
                                                TERMINATE(-1);
×
1668
                                        }
1669
                                        w = (WORD *)Malloc1(newreservation*sizeof(WORD)*
×
1670
                                                        (ABS(T->numind)+TABLEEXTENSION),"tablepointers");
×
1671
                                        for ( i = T->reserved*(ABS(T->numind)+TABLEEXTENSION)-1; i >= 0; i-- )
×
1672
                                                w[i] = T->tablepointers[i];
×
1673
                                        if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
×
1674
                                        T->tablepointers = w;
×
1675
                                        T->reserved = newreservation;
×
1676
                                }
1677
                                if ( numsym < 0 ) pw = oldwork + 1;
×
1678
                                else              pw = oldwork + numsym;
×
1679
                                for ( sum = T->totind*(ABS(T->numind)+TABLEEXTENSION), i = 0; i < ABS(T->numind); i++ ) {
×
1680
                                        T->tablepointers[sum++] = *pw++;
×
1681
                                }
1682
                                InsTableTree(T,T->tablepointers+sum-ABS(T->numind));
×
1683
                                (T->totind)++;
×
1684
                        }
1685
#if ( TABLEEXTENSION != 2 )
1686
                        else {
1687
                                sum *= TABLEEXTENSION;
70✔
1688
                        }
1689
#endif
1690
/*
1691
                        Start a new entry. Copy the element.
1692
*/
1693
                        AddRHS(T->bufnum,0);
70✔
1694
                        T->tablepointers[sum] = C->numrhs;
70✔
1695
#if ( TABLEEXTENSION == 2 )
1696
                        T->tablepointers[sum+TABLEEXTENSION-1] = -1;
1697
#else
1698
                        T->tablepointers[sum+1] = T->bufnum;
70✔
1699
                        T->tablepointers[sum+2] = -1;
70✔
1700
                        T->tablepointers[sum+3] = -1;
70✔
1701
                        T->tablepointers[sum+4] = 0;
70✔
1702
                        T->tablepointers[sum+5] = 0;
70✔
1703
#endif
1704
newentry:        if ( *m == HAAKJE ) { m += m[1] - 1; }
70✔
1705
                        else m--;
×
1706
                        *m = *term - (m-term);
70✔
1707
                        AddNtoC(AC.cbufnum,*m,m,5);
70✔
1708
                        curelement = T->tablepointers[sum];
70✔
1709
nextterm:;
77✔
1710
                }
1711
                if ( weneedit ) {
7✔
1712
                        AddNtoC(AC.cbufnum,1,&zero,6);        /* Terminate old bracket */
7✔
1713
                        numcommu = numcommute(C->rhs[curelement],&(C->NumTerms[curelement]));
7✔
1714
                        C->CanCommu[curelement] = numcommu;
7✔
1715
                }
1716
        }
1717
        if ( fi->handle >= 0 ) {
7✔
1718
                SetScratch(fi,&(oldposition));
×
1719
        }
1720
        else {
1721
                fi->POfill = (WORD *)((UBYTE *)(fi->PObuffer) + BASEPOSITION(oldposition));
7✔
1722
        }
1723
        BACKINOUT
7✔
1724
        AC.cbufnum = oldcbuf;
7✔
1725
        AC.tablefilling = 0;
7✔
1726
        AT.WorkPointer = oldwork;
7✔
1727
        return(0);
7✔
1728
noway:
×
1729
        BACKINOUT
×
1730
        AC.cbufnum = oldcbuf;
×
1731
        AC.tablefilling = 0;
×
1732
        AT.WorkPointer = oldwork;
×
1733
        return(1);
×
1734
}
1735

1736
/*
1737
          #] CoFillExpression : 
1738
          #[ CoPrintTable :
1739

1740
        Syntax
1741
                PrintTable [+f] [+s] tablename [>[>] file];
1742
        All defined elements are written with individual Fill statements.
1743
        If a file is specified, the result is written to file only.
1744
        The flags of the print statement apply as much as possible.
1745
        We make use of the regular write routines.
1746
*/
1747

1748
int CoPrintTable(UBYTE *inp)
7✔
1749
{
1750
        GETIDENTITY
2✔
1751
        int fflag = 0, sflag = 0, addflag = 0, error = 0, sum, i, j;
7✔
1752
        UBYTE *filename, *p, c, buffer[100], *s, *oldoutputline = AO.OutputLine;
7✔
1753
        WORD type, funnum, *expr, *m, num;
7✔
1754
        TABLES T = 0;
7✔
1755
        WORD oldSkip = AO.OutSkip, oldMode = AC.OutputMode, oldHandle = AC.LogHandle;
7✔
1756
        WORD oldType = AO.PrintType, *oldwork = AT.WorkPointer;
7✔
1757
        UBYTE *oldFill = AO.OutFill, *oldLine = AO.OutputLine;
7✔
1758
#ifdef WITHMPI
1759
        if ( PF.me != MASTER ) return 0;
4✔
1760
#endif
1761
/*
1762
        First the flags
1763
*/
1764
        while ( *inp == '+' ) {
4✔
1765
                inp++;
×
1766
                if ( *inp == 'f' || *inp == 'F' ) { fflag = 1; inp++; }
×
1767
                else if ( *inp == 's' || *inp == 'S' ) { sflag = PRINTONETERM; inp++; }
×
1768
                else {
1769
                        MesPrint("&Illegal + option in PrintTable statement");
×
1770
                        error = 1; inp++;
×
1771
                }
1772
                while ( *inp != ',' && *inp && *inp != '+' ) {
×
1773
                        if ( !error ) {
×
1774
                                if ( *inp ) {
×
1775
                                        MesPrint("&Illegal + option in PrintTable statement");
×
1776
                                        inp++;
×
1777
                                }
1778
                                else {
1779
                                        MesPrint("&Unfinished PrintTable statement");
×
1780
                                        return(1);
×
1781
                                }
1782
                                error = 1;
×
1783
                        }
1784
                        inp++;
×
1785
                }
1786
                if ( *inp == ',' ) inp++;
×
1787
        }
1788
/*
1789
        Now the name of the table
1790
*/
1791
        if ( ( p = SkipAName(inp) ) == 0 ) return(1);
4✔
1792
        c = *p; *p = 0;
4✔
1793
        if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
4✔
1794
        || ( T = functions[funnum].tabl ) == 0 ) {
4✔
1795
                MesPrint("&%s should be a previously declared table",inp);
×
1796
                *p = c; return(1);
×
1797
        }
1798
        if ( T->spare && T->mode == 1 ) T = T->spare;
4✔
1799
        *p++ = c;
4✔
1800
/*
1801
        Check for a filename. Runs to the end of the statement.
1802
*/
1803
        filename = 0;
4✔
1804
        if ( c == '>' ) {
4✔
1805
                if ( *p == '>' ) { addflag = 1; p++; }
×
1806
                filename = p;
×
1807
        }
1808
        else filename = 0;
1809

1810
        if ( filename ) {
×
1811
                if ( addflag ) AC.LogHandle = OpenAddFile((char *)filename);
×
1812
                else           AC.LogHandle = CreateFile((char *)filename);
×
1813
                if ( AC.LogHandle < 0 ) {
×
1814
                        MesPrint("&Cannot open file '%s' properly",filename);
×
1815
                        error = 1; goto finally;
×
1816
                }
1817
                AO.PrintType = PRINTLFILE;
×
1818
        }
1819
        else if ( fflag && AC.LogHandle >= 0 ) {
4✔
1820
                AO.PrintType = PRINTLFILE;
×
1821
        }
1822
        AO.OutFill = AO.OutputLine = (UBYTE *)AT.WorkPointer;
4✔
1823
        AT.WorkPointer += 2*AC.LineLength;
4✔
1824

1825
        AO.PrintType |= sflag;
4✔
1826
        AC.OutputMode = 0;
4✔
1827
        AO.IsBracket = 0;
4✔
1828
        AO.OutSkip = 0;
4✔
1829
        AR.DeferFlag = 0;
4✔
1830
        AC.outsidefun = 1;
4✔
1831
        if ( AC.LogHandle == oldHandle ) FiniLine();
4✔
1832
        AO.OutputLine = AO.OutFill = (UBYTE *)Malloc1(AC.LineLength+20,"PrintTable");
4✔
1833
        AO.OutStop = AO.OutFill + AC.LineLength;
4✔
1834
        for ( i = 0; i < T->totind; i++ ) {
44✔
1835
                if ( !T->sparse && T->tablepointers[i*TABLEEXTENSION] < 0 ) continue;
40✔
1836
                TokenToLine((UBYTE *)"Fill ");
40✔
1837
                TokenToLine((UBYTE *)(VARNAME(functions,funnum)));
40✔
1838
                TokenToLine((UBYTE *)"(");
40✔
1839
                AO.OutSkip = 3;
40✔
1840
                if ( T->sparse ) {
40✔
1841
                        sum = i * ( T->numind + TABLEEXTENSION );
×
1842
                        for ( j = 0; j < T->numind; j++, sum++ ) {
×
1843
                                if ( j > 0 ) TokenToLine((UBYTE *)",");
×
1844
                                num = T->tablepointers[sum];
×
1845
                                s = buffer; s = NumCopy(num,s);
×
1846
                                TokenToLine(buffer);
×
1847
                        }
1848
                        expr = cbuf[T->bufnum].rhs[T->tablepointers[sum]];
×
1849
                }
1850
                else {
1851
                        for ( j = 0; j < T->numind; j++ ) {
80✔
1852
                                if ( j > 0 ) {
40✔
1853
                                        TokenToLine((UBYTE *)",");
×
1854
                                        num = T->mm[j].mini + ( i % T->mm[j-1].size ) / T->mm[j].size;
×
1855
                                }
1856
                                else {
1857
                                        num = T->mm[j].mini + i / T->mm[j].size;
40✔
1858
                                }
1859
                                s = buffer; s = NumCopy(num,s);
40✔
1860
                                TokenToLine(buffer);
40✔
1861
                        }
1862
                        expr = cbuf[T->bufnum].rhs[T->tablepointers[TABLEEXTENSION*i]];
40✔
1863
                }
1864
                TOKENTOLINE(") =",")=");
40✔
1865
                if ( sflag ) {
40✔
1866
                        FiniLine();
×
1867
                        if ( AC.OutputSpaces != NOSPACEFORMAT ) TokenToLine((UBYTE *)"   ");
×
1868
                }
1869
                m = expr;
40✔
1870
/*
1871
                WORD lbrac, first;
1872
                lbrac = 0; first = 1;
1873
                while ( *m ) {
1874
                        if ( WriteTerm(m,&lbrac,first,1,0) ) {
1875
                                MesPrint("Error while writing table");
1876
                                error = 1;
1877
                                goto finally;
1878
                        }
1879
                        first = 0;
1880
                        m += *m;
1881
                }
1882
                if ( first ) { TOKENTOLINE(" 0","0") }
1883
                else if ( lbrac ) { TOKENTOLINE(" )",")") }
1884
*/
1885
                while ( *m ) m += *m;
80✔
1886
                if ( m > expr ) {
40✔
1887
                        if ( WriteExpression(expr,(LONG)(m-expr)) ) { error = 1; goto finally; }
40✔
1888
                        AO.OutSkip = 0;
40✔
1889
                }
1890
                else {
1891
                        TokenToLine((UBYTE *)"0");
×
1892
                }
1893
                TokenToLine((UBYTE *)";");
40✔
1894
                FiniLine();
40✔
1895
        }
1896
        M_free(AO.OutputLine,"PrintTable");
4✔
1897
        AO.OutputLine = AO.OutFill = oldoutputline;
4✔
1898
/*
1899
        Reset the file pointers and parameters if any. Close file if needed.
1900
*/
1901
finally:
4✔
1902
        AO.OutSkip     = oldSkip;
4✔
1903
        AC.OutputMode  = oldMode;
4✔
1904
        AC.LogHandle   = oldHandle;
4✔
1905
        AO.PrintType   = oldType;
4✔
1906
        AO.OutFill     = oldFill;
4✔
1907
        AO.OutputLine  = oldLine;
4✔
1908
        AT.WorkPointer = oldwork;
4✔
1909
        AC.outsidefun  = 0;
4✔
1910
        return(error);
4✔
1911
}
1912

1913
/*
1914
          #] CoPrintTable : 
1915
          #[ CoAssign :
1916

1917
        This statement has an easy syntax:
1918
                $name = expression
1919
*/
1920

1921
static WORD AssignLHS[14] = { TYPEASSIGN, 3+SUBEXPSIZE, 0,
1922
                                                        SUBEXPRESSION, SUBEXPSIZE, 0, 1, 0, 0,0,0,0,0 };
1923

1924
int CoAssign(UBYTE *inp)
1,281✔
1925
{
1926
        int error = 0, retcode;
1,281✔
1927
        UBYTE *name, c;
1,281✔
1928
        WORD number;
1,281✔
1929
        if ( *inp != '$' ) {
1,281✔
1930
nolhs:        MesPrint("&assign statement should have a dollar variable in the LHS");
×
1931
                return(1);
×
1932
        }
1933
        inp++; name = inp;
1,281✔
1934
        if ( FG.cTable[*inp] != 0 ) goto nolhs;
1,281✔
1935
        while ( FG.cTable[*inp] < 2 ) inp++;
8,161✔
1936
        if ( AP.PreAssignFlag == 2 ) {
1,281✔
1937
                if ( *inp == '_' ) inp++;
×
1938
        }
1939
        if ( ( *inp == ',' && inp[1] != '=' ) && ( *inp != '=' ) ) {
1,281✔
1940
                MesPrint("&assign statement should have only a dollar variable in the LHS");
×
1941
                return(1);
×
1942
        }
1943
        c = *inp;
1,281✔
1944
        *inp = 0;
1,281✔
1945
        if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
1,281✔
1946
                number = AddDollar(name,DOLUNDEFINED,0,0);
553✔
1947
        }
1948
        *inp = c;
1,281✔
1949
        if ( c == ',' ) inp++;
1,281✔
1950
        *inp++ = '=';
1,281✔
1951
        if ( *inp == ',' ) inp++;
1,281✔
1952
/*
1953
        Fake a Prototype and read the RHS
1954
*/
1955
        AssignLHS[7] = AC.cbufnum;
1,281✔
1956
        retcode = CompileAlgebra(inp,RHSIDE,(AssignLHS+3));
1,281✔
1957
        if ( retcode < 0 ) error = 1;
1,281✔
1958
        AC.DumNum = 0;
1,281✔
1959
/*
1960
        Now add the LHS
1961
*/
1962
        AssignLHS[2] = number;
1,281✔
1963
        AssignLHS[5] = retcode;
1,281✔
1964
        AddNtoL(AssignLHS[1],AssignLHS);
1,281✔
1965
/*
1966
        Add to the list of potentially modified dollars (for PARALLEL)
1967
*/
1968
        AddPotModdollar(number);
1,281✔
1969
        return(error);
1,281✔
1970
}
1971

1972
/*
1973
          #] CoAssign : 
1974
          #[ CoDeallocateTable :
1975

1976
        Syntax: DeallocateTable tablename(s);
1977
        Should work only for sparse tables.
1978
        Action: Cleans all definitions of elements of a table as if there have
1979
                never been any fill statements.
1980
*/
1981

1982
int CoDeallocateTable(UBYTE *inp)
×
1983
{
1984
        UBYTE *p, c;
×
1985
        TABLES T = 0;
×
1986
        WORD type, funnum, i;
×
1987
        c = *inp;
×
1988
        while ( c ) {
×
1989
                while ( *inp == ',' ) inp++;
×
1990
                if ( *inp == 0 ) break;
×
1991
                if ( ( p = SkipAName(inp) ) == 0 ) return(1);
×
1992
                c = *p; *p = 0;
×
1993
                if ( ( GetVar(inp,&type,&funnum,CFUNCTION,NOAUTO) == NAMENOTFOUND )
×
1994
                || ( T = functions[funnum].tabl ) == 0 ) {
×
1995
                        MesPrint("&%s should be a previously declared table",inp);
×
1996
                        *p = c; return(1);
×
1997
                }
1998
                if ( T->sparse == 0 ) {
×
1999
                        MesPrint("&%s should be a sparse table",inp);
×
2000
                        *p = c; return(1);
×
2001
                }
2002
                if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
×
2003
                ClearTableTree(T);
×
2004
                for (i = 0; i < T->buffersfill; i++ ) { /* was <= */
×
2005
                        finishcbuf(T->buffers[i]);
×
2006
                }
2007
                T->bufnum = inicbufs();
×
2008
                T->buffersfill = 0;
×
2009
                T->buffers[T->buffersfill++] = T->bufnum;
×
2010
                T->tablepointers = 0;
×
2011
                T->boomlijst = 0;
×
2012
                T->totind = 0;
×
2013
                T->reserved = 0;
×
2014

2015
                if ( T->spare ) {
×
2016
                        TABLES TT = T->spare;
×
2017
                        if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
×
2018
                        ClearTableTree(TT);
×
2019
                        for (i = 0; i < TT->buffersfill; i++ ) { /* was <= */
×
2020
                                finishcbuf(TT->buffers[i]);
×
2021
                        }
2022
                        TT->bufnum = inicbufs();
×
2023
                        TT->buffersfill = 0;
×
2024
                        TT->buffers[T->buffersfill++] = T->bufnum;
×
2025
                        TT->tablepointers = 0;
×
2026
                        TT->boomlijst = 0;
×
2027
                        TT->totind = 0;
×
2028
                        TT->reserved = 0;
×
2029
                }
2030
                *p++ = c;
×
2031
                inp = p;
×
2032
        }
2033
         return(0);
2034
}
2035

2036
/*
2037
          #] CoDeallocateTable : 
2038
          #[ CoFactorCache :
2039
*/
2040
/**
2041
 *        Reads the FactorCache statement which is like a fill statement for
2042
 *        the factorization cache. Syntax:
2043
 *                FactorCache,expression:factor1,...,factorn;
2044
 *        This statement is mainly for testing purposes, because there are severe
2045
 *        restrictions on the use of the expression (no common GCD, no denominators)
2046
 *        The expression is worked out by FORM and properly normalized and sorted.
2047
 */
2048

2049
/*
2050
int CoFactorCache(UBYTE *inp)
2051
{
2052
        Code to be added in due time
2053
        We need to read 'expression', get its terms through Generator and sort them.
2054
        We store the result in the WorkSpace in argument notation.
2055
        This will be argin.
2056
        Then we do the same with the sequence of factors. They form argout.
2057
        The whole is put in the buffer with the call
2058
                InsertArg(BHEAD argin,argout,1)
2059
        return(0);
2060
}
2061
*/
2062

2063
/*
2064
          #] CoFactorCache : 
2065
*/
STATUS · Troubleshooting · Open an Issue · Sales · Support · CAREERS · ENTERPRISE · START FREE · SCHEDULE DEMO
ANNOUNCEMENTS · TWITTER · TOS & SLA · Supported CI Services · What's a CI service? · Automated Testing

© 2025 Coveralls, Inc