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

tueda / form / 15241916852

25 May 2025 08:59PM UTC coverage: 47.908% (-2.8%) from 50.743%
15241916852

push

github

tueda
ci: build arm64-windows binaries

39009 of 81425 relevant lines covered (47.91%)

1079780.1 hits per line

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

37.54
/sources/compcomm.c
1
/** @file compcomm.c
2
 * 
3
 *  Compiler routines for most statements that don't involve algebraic
4
 *        expressions. Exceptions: all routines involving declarations are in
5
 *        the file names.c
6
 *        When making new statements one can add the compiler routines here and
7
 *        have a look whether there is already a routine that is similar. In that
8
 *        case one can make a copy and modify it.
9
 */
10
/* #[ License : */
11
/*
12
 *   Copyright (C) 1984-2023 J.A.M. Vermaseren
13
 *   When using this file you are requested to refer to the publication
14
 *   J.A.M.Vermaseren "New features of FORM" math-ph/0010025
15
 *   This is considered a matter of courtesy as the development was paid
16
 *   for by FOM the Dutch physics granting agency and we would like to
17
 *   be able to track its scientific use to convince FOM of its value
18
 *   for the community.
19
 *
20
 *   This file is part of FORM.
21
 *
22
 *   FORM is free software: you can redistribute it and/or modify it under the
23
 *   terms of the GNU General Public License as published by the Free Software
24
 *   Foundation, either version 3 of the License, or (at your option) any later
25
 *   version.
26
 *
27
 *   FORM is distributed in the hope that it will be useful, but WITHOUT ANY
28
 *   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
29
 *   FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
30
 *   details.
31
 *
32
 *   You should have received a copy of the GNU General Public License along
33
 *   with FORM.  If not, see <http://www.gnu.org/licenses/>.
34
 */
35
/* #] License : */ 
36
/*
37
          #[ includes :
38
*/
39

40
#include "form3.h"
41
#include "comtool.h"
42
#ifdef WITHFLOAT
43
#include <gmp.h>
44
#endif
45

46
static KEYWORD formatoptions[] = {
47
         {"allfloat",       (TFUN)0,    ALLINTEGERDOUBLE,   0}
48
        ,{"c",                                (TFUN)0,        CMODE,                                0}
49
        ,{"doublefortran",        (TFUN)0,        DOUBLEFORTRANMODE,        0}
50
        ,{"float",                        (TFUN)0,        0,                                        2}
51
#ifdef WITHFLOAT
52
        ,{"floatprecision",        (TFUN)0,        0,                                        5}
53
#endif
54
        ,{"fortran",                (TFUN)0,        FORTRANMODE,                0}
55
        ,{"fortran90",                (TFUN)0,        FORTRANMODE,                4}
56
        ,{"maple",                        (TFUN)0,        MAPLEMODE,                        0}
57
        ,{"mathematica",        (TFUN)0,        MATHEMATICAMODE,        0}
58
        ,{"normal",                        (TFUN)0,        NORMALFORMAT,                1}
59
        ,{"nospaces",                (TFUN)0,        NOSPACEFORMAT,                3}
60
        ,{"pfortran",                (TFUN)0,        PFORTRANMODE,                0}
61
        ,{"quadfortran",        (TFUN)0,        QUADRUPLEFORTRANMODE,        0}
62
        ,{"quadruplefortran",        (TFUN)0,        QUADRUPLEFORTRANMODE,        0}
63
        ,{"rational",                (TFUN)0,        RATIONALMODE,                1}
64
        ,{"reduce",                        (TFUN)0,        REDUCEMODE,                        0}
65
        ,{"spaces",                        (TFUN)0,        NORMALFORMAT,                3}
66
        ,{"vortran",                (TFUN)0,        VORTRANMODE,                0}
67
};
68

69
static KEYWORD trace4options[] = {
70
         {"contract",    (TFUN)0,        CHISHOLM,                0          }
71
        ,{"nocontract",  (TFUN)0,        0,                                CHISHOLM   }
72
        ,{"nosymmetrize",(TFUN)0,        0,                                ALSOREVERSE}
73
        ,{"notrick",     (TFUN)0,        NOTRICK,                0          }
74
        ,{"symmetrize",  (TFUN)0,        ALSOREVERSE,        0          }
75
        ,{"trick",       (TFUN)0,        0,                                NOTRICK    }
76
};
77

78
static KEYWORD chisoptions[] = {
79
         {"nosymmetrize",(TFUN)0,        0,                                ALSOREVERSE}
80
        ,{"symmetrize",  (TFUN)0,        ALSOREVERSE,        0          }
81
};
82

83
static KEYWORDV writeoptions[] = {
84
         {"stats",                        &(AC.StatsFlag),        1,                0}
85
        ,{"statistics",                &(AC.StatsFlag),        1,                0}
86
        ,{"shortstats",                &(AC.ShortStats),        1,                0}
87
        ,{"shortstatistics",&(AC.ShortStats),        1,                0}
88
        ,{"warnings",                &(AC.WarnFlag),        1,                0}
89
        ,{"allwarnings",        &(AC.WarnFlag),        2,                0}
90
        ,{"setup",                        &(AC.SetupFlag),        1,                0}
91
        ,{"names",                        &(AC.NamesFlag),        1,                0}
92
        ,{"allnames",                &(AC.NamesFlag),        2,                0}
93
        ,{"codes",                        &(AC.CodesFlag),        1,                0}
94
        ,{"highfirst",                &(AC.SortType),        SORTHIGHFIRST,                SORTLOWFIRST}
95
        ,{"lowfirst",                &(AC.SortType),        SORTLOWFIRST,                SORTHIGHFIRST}
96
        ,{"powerfirst",                &(AC.SortType),        SORTPOWERFIRST,                SORTHIGHFIRST}
97
        ,{"tokens",                        &(AC.TokensWriteFlag),1,        0}
98
};
99

100
static KEYWORDV onoffoptions[] = {
101
         {"compress",       &(AC.NoCompress),  0,  1}
102
        ,{"checkpoint",     &(AC.CheckpointFlag),  1,  0}
103
        ,{"insidefirst",        &(AC.insidefirst), 1,  0}
104
        ,{"propercount",    &(AC.BottomLevel), 1,  0}
105
        ,{"stats",                        &(AC.StatsFlag),        1,        0}
106
        ,{"statistics",                &(AC.StatsFlag),        1,        0}
107
        ,{"shortstats",                &(AC.ShortStats),        1,        0}
108
        ,{"shortstatistics",&(AC.ShortStats),        1,        0}
109
        ,{"names",                        &(AC.NamesFlag),        1,        0}
110
        ,{"allnames",                &(AC.NamesFlag),        2,        0}
111
        ,{"warnings",                &(AC.WarnFlag),        1,        0}
112
        ,{"allwarnings",        &(AC.WarnFlag),        2,        0}
113
        ,{"highfirst",                &(AC.SortType),        SORTHIGHFIRST,        SORTLOWFIRST}
114
        ,{"lowfirst",                &(AC.SortType),        SORTLOWFIRST,        SORTHIGHFIRST}
115
        ,{"powerfirst",                &(AC.SortType),        SORTPOWERFIRST,        SORTHIGHFIRST}
116
        ,{"setup",                        &(AC.SetupFlag),        1,        0}
117
        ,{"codes",                        &(AC.CodesFlag),        1,        0}
118
        ,{"tokens",                    &(AC.TokensWriteFlag),1,0}
119
        ,{"properorder",    &(AC.properorderflag),1,0}
120
        ,{"threadloadbalancing",&(AC.ThreadBalancing),1,        0}
121
        ,{"threads",                &(AC.ThreadsFlag),1,        0}
122
        ,{"threadsortfilesynch",&(AC.ThreadSortFileSynch),1,  0}
123
        ,{"threadstats",        &(AC.ThreadStats),1,        0}
124
        ,{"finalstats",            &(AC.FinalStats),1,        0}
125
        ,{"fewerstats",                &(AC.ShortStatsMax),        10,                0}
126
        ,{"fewerstatistics",&(AC.ShortStatsMax),        10,                0}
127
        ,{"processstats",        &(AC.ProcessStats),1,        0}
128
        ,{"oldparallelstats",&(AC.OldParallelStats),1,0}
129
        ,{"parallel",            &(AC.parallelflag),PARALLELFLAG,NOPARALLEL_USER}
130
        ,{"nospacesinnumbers",&(AO.NoSpacesInNumbers),1,0}
131
        ,{"indentspace",    &(AO.IndentSpace),INDENTSPACE,0}
132
        ,{"totalsize",                &(AM.PrintTotalSize),        1,        0}
133
        ,{"flag",                        (int *)&(AC.debugFlags),        1,        0}
134
        ,{"oldfactarg",                &(AC.OldFactArgFlag),        1,        0}
135
        ,{"memdebugflag",        &(AC.MemDebugFlag),        1,        0}
136
        ,{"oldgcd",                 &(AC.OldGCDflag),        1,        0}
137
        ,{"innertest",      &(AC.InnerTest),  1,  0}
138
        ,{"wtimestats",     &(AC.WTimeStatsFlag),  1,  0}
139
        ,{"sortreallocate",        &(AC.SortReallocateFlag), 1, 0}
140
};
141

142
static WORD one = 1;
143

144
/*
145
          #] includes : 
146
          #[ CoFormat :
147
*/
148

149
int CoFormat(UBYTE *s)
138✔
150
{
151
        int error = 0, x;
138✔
152
        KEYWORD *key;
138✔
153
        UBYTE *ss;
138✔
154
        while ( *s == ' ' || *s == ',' ) s++;
138✔
155
        if ( *s == 0 ) {
138✔
156
                AC.OutputMode = 72;
×
157
                AC.OutputSpaces = NORMALFORMAT;
×
158
                return(error);
×
159
        }
160
/*
161
        First the optimization level
162
*/
163
        if ( *s == 'O' || *s == 'o' ) {
138✔
164
                if ( ( FG.cTable[s[1]] == 1 ) ||
15✔
165
                         ( s[1] == '=' && FG.cTable[s[2]] == 1 ) ) {
×
166
                        s++; if ( *s == '=' ) s++;
15✔
167
                        x = 0;
168
                        while ( *s >= '0' && *s <= '9' ) x = 10*x + *s++ - '0';
30✔
169
                        while ( *s == ',' ) s++;
15✔
170
                        AO.OptimizationLevel = x;
15✔
171
                        AO.Optimize.greedytimelimit = 0;
15✔
172
                        AO.Optimize.mctstimelimit = 0;
15✔
173
                        AO.Optimize.printstats = 0;
15✔
174
                        AO.Optimize.debugflags = 0;
15✔
175
                        AO.Optimize.schemeflags = 0;
15✔
176
                        AO.Optimize.mctsdecaymode = 1; /* default is decreasing C_p with iteration number */
15✔
177
                        if ( AO.inscheme ) {
15✔
178
                                M_free(AO.inscheme,"Horner input scheme");
×
179
                                AO.inscheme = 0; AO.schemenum = 0;
×
180
                        }
181
                        switch ( x ) {
15✔
182
                                case 0:
183
                                        break;
184
                                case 1:
3✔
185
                                        AO.Optimize.mctsconstant.fval = -1.0;
3✔
186
                                        AO.Optimize.horner = O_OCCURRENCE;
3✔
187
                                        AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
3✔
188
                                        AO.Optimize.method = O_CSE;
3✔
189
                                        break;
3✔
190
                                case 2:
3✔
191
                                        AO.Optimize.horner = O_OCCURRENCE;
3✔
192
                                        AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
3✔
193
                                        AO.Optimize.method = O_GREEDY;
3✔
194
                                        AO.Optimize.greedyminnum = 10;
3✔
195
                                        AO.Optimize.greedymaxperc = 5;
3✔
196
                                        break;
3✔
197
                                case 3:
9✔
198
                                        AO.Optimize.mctsconstant.fval = 1.0;
9✔
199
                                        AO.Optimize.horner = O_MCTS;
9✔
200
                                        AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
9✔
201
                                        AO.Optimize.method = O_GREEDY;
9✔
202
                                        AO.Optimize.mctsnumexpand = 1000;
9✔
203
                                        AO.Optimize.mctsnumkeep = 10;
9✔
204
                                        AO.Optimize.mctsnumrepeat = 1;
9✔
205
                                        AO.Optimize.greedyminnum = 10;
9✔
206
                                        AO.Optimize.greedymaxperc = 5;
9✔
207
                                        break;
9✔
208
                                case 4:
×
209
                                        AO.Optimize.horner = O_SIMULATED_ANNEALING;
×
210
                                        AO.Optimize.saIter = 1000;
×
211
                                        AO.Optimize.saMaxT.fval = 2000;
×
212
                                        AO.Optimize.saMinT.fval = 1;
×
213
                                        break;
×
214
                                default:
×
215
                                        error = 1;
×
216
                                        MesPrint("&Illegal optimization specification in format statement");
×
217
                                        break;
×
218
                        }
219
                        if ( error == 0 && *s != 0 && x > 0 ) return(CoOptimizeOption(s));
15✔
220
                        return(error);
15✔
221
                }
222
#ifdef EXPOPT
223
                { UBYTE c;
224
                ss = s;
225
                while ( FG.cTable[*s] == 0 ) s++;
226
                c = *s; *s = 0;
227
                if ( StrICont(ss,(UBYTE *)"optimize") == 0 ) {
228
                        *s = c;
229
                        while ( *s == ',' ) s++;
230
                        if ( *s == '=' ) s++;
231
                        AO.OptimizationLevel = 3;
232
                        AO.Optimize.mctsconstant.fval = 1.0;
233
                        AO.Optimize.horner = O_MCTS;
234
                        AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
235
                        AO.Optimize.method = O_GREEDY;
236
                        AO.Optimize.mctstimelimit = 0;
237
                        AO.Optimize.mctsnumexpand = 1000;
238
                        AO.Optimize.mctsnumkeep = 10;
239
                        AO.Optimize.mctsnumrepeat = 1;
240
                        AO.Optimize.greedytimelimit = 0;
241
                        AO.Optimize.greedyminnum = 10;
242
                        AO.Optimize.greedymaxperc = 5;
243
                        AO.Optimize.printstats = 0;
244
                        AO.Optimize.debugflags = 0;
245
                        AO.Optimize.schemeflags = 0;
246
                        AO.Optimize.mctsdecaymode = 1;
247
                        if ( AO.inscheme ) {
248
                                M_free(AO.inscheme,"Horner input scheme");
249
                                AO.inscheme = 0; AO.schemenum = 0;
250
                        }
251
                        return(CoOptimizeOption(s));
252
                }
253
                else {
254
                        error = 1;
255
                        MesPrint("&Illegal optimization specification in format statement");
256
                        return(error);
257
                }
258
                }
259
#endif
260
        }
261
        else if ( FG.cTable[*s] == 1 ) {
123✔
262
                x = 0;
263
                while ( FG.cTable[*s] == 1 ) x = 10*x + *s++ - '0';
27✔
264
                if ( x <= 0 || x >= MAXLINELENGTH ) {
9✔
265
                        error = 1;
×
266
                        MesPrint("&Illegal value for linesize: %d",x);
×
267
                        x = 72;
×
268
                }
269
                if ( x < 39 ) {
9✔
270
                        MesPrint(" ... Too small value for linesize corrected to 39");
×
271
                        x = 39;
×
272
                }
273
                AO.DoubleFlag = 0;
9✔
274
/*
275
                The next line resets the mode to normal. Because the special modes
276
                reset the line length we have a little problem with the special modes
277
                and customized line length. We try to improve by removing the next line
278
*/
279
/*                AC.OutputMode = 0;  */
280
                AC.LineLength = x;
9✔
281
                if ( *s != 0 ) {
9✔
282
                        error = 1;
×
283
                        MesPrint("&Illegal linesize field in format statement");
×
284
                }
285
        }
286
        else {
287
                key = FindKeyWord(s,formatoptions,
114✔
288
                        sizeof(formatoptions)/sizeof(KEYWORD));
289
                if ( key ) {
114✔
290
                        if ( key->type == FORTRANMODE || key->type == PFORTRANMODE || key->type == DOUBLEFORTRANMODE
114✔
291
                                || key->type == QUADRUPLEFORTRANMODE || key->type == VORTRANMODE ) {
292
                                        if (AC.LineLength > 72) AC.LineLength = 72;
75✔
293
                        }
294
                        if ( key->flags == 0 ) {
114✔
295
                                if ( key->type == FORTRANMODE || key->type == PFORTRANMODE
87✔
296
                                || key->type == DOUBLEFORTRANMODE || key->type == ALLINTEGERDOUBLE
297
                                || key->type == QUADRUPLEFORTRANMODE || key->type == VORTRANMODE ) {
298
                                        AC.IsFortran90 = ISNOTFORTRAN90;
63✔
299
                                        if ( AC.Fortran90Kind ) {
63✔
300
                                                M_free(AC.Fortran90Kind,"Fortran90 Kind");
3✔
301
                                                AC.Fortran90Kind = 0;
3✔
302
                                        }
303
                                }
304
                                if ( ( key->type == ALLINTEGERDOUBLE ) && AO.DoubleFlag != 0 ) {
87✔
305
                                        AO.DoubleFlag |= 4;
6✔
306
                                }
307
                                else {
308
                                        AO.DoubleFlag = 0;
81✔
309
                                        AC.OutputMode = key->type & NODOUBLEMASK;
81✔
310
                                        if ( ( key->type & DOUBLEPRECISIONFLAG ) != 0 ) {
81✔
311
                                                AO.DoubleFlag = 1;
24✔
312
                                        }
313
                                        else if ( ( key->type & QUADRUPLEPRECISIONFLAG ) != 0 ) {
57✔
314
                                                AO.DoubleFlag = 2;
9✔
315
                                        }
316
                                }
317
                        }
318
                        else if ( key->flags == 1 ) {
319
                                AC.OutputMode = AC.OutNumberType = key->type;
6✔
320
                        }
321
                        else if ( key->flags == 2 ) {
322
                                while ( FG.cTable[*s] == 0 ) s++;
18✔
323
                                if ( *s == 0 ) AC.OutNumberType = 10;
3✔
324
                                else if ( *s == ',' ) {
×
325
                                        s++;
×
326
                                        x = 0;
×
327
                                        while ( FG.cTable[*s] == 1 ) x = 10*x + *s++ - '0';
×
328
                                        if ( *s != 0 ) {
×
329
                                                error = 1;
×
330
                                                MesPrint("&Illegal float format specifier");
×
331
                                        }
332
                                        else {
333
                                                if ( x < 3 ) {
×
334
                                                        x = 3;
×
335
                                                        MesPrint("& ... float format value corrected to 3");
×
336
                                                }
337
                                                if ( x > 100 ) {
×
338
                                                        x = 100;
×
339
                                                        MesPrint("& ... float format value corrected to 100");
×
340
                                                }
341
                                                AC.OutNumberType = x;
×
342
                                        }
343
                                }
344
                        }
345
                        else if ( key->flags == 3 ) {
346
                                AC.OutputSpaces = key->type;
9✔
347
                        }
348
                        else if ( key->flags == 4 ) {
349
                                AC.IsFortran90 = ISFORTRAN90;
9✔
350
                                if ( AC.Fortran90Kind ) {
9✔
351
                                        M_free(AC.Fortran90Kind,"Fortran90 Kind");
×
352
                                        AC.Fortran90Kind = 0;
×
353
                                }
354
                                while ( FG.cTable[*s] <= 1 ) s++;
90✔
355
                                if ( *s == ',' ) {
9✔
356
                                        s++; ss = s;
6✔
357
                                        while ( *ss && *ss != ',' ) ss++;
30✔
358
                                        if ( *ss == ',' ) {
6✔
359
                                                MesPrint("&No white space or comma's allowed in Fortran90 option: %s",s); error = 1;
×
360
                                        }
361
                                        else {
362
                                                AC.Fortran90Kind = strDup1(s,"Fortran90 Kind");
6✔
363
                                        }
364
                                }
365
                                AO.DoubleFlag = 0;
9✔
366
                                AC.OutputMode = key->type & NODOUBLEMASK;
9✔
367
                        }
368
#ifdef WITHFLOAT
369
                        else if ( key->flags == 5 ) {
370
/*
371
                                Syntax: Format FloatPrecision number;
372
                                        Format FloatPrecision off;
373
*/
374
                                while ( FG.cTable[*s] == 0 ) s++;
×
375
                                while ( *s == ' ' || *s == '\t' || *s == ',' ) s++;
×
376
                                if ( *s == 0 ) {
×
377
                                        AO.FloatPrec = 0;
×
378
                                }
379
                                else if ( tolower(*s) == 'o' && tolower(s[1]) == 'f'
×
380
                                && tolower(s[2]) == 'f' ) {
×
381
                                        ss = s;
×
382
                                        s += 3;
×
383
                                        while ( *s == ' ' || *s == '\t' || *s == ',' ) s++;
×
384
                                        if ( *s ) { s = ss; goto WrongOption; }
×
385
                                        AO.FloatPrec = -1;
×
386
                                }
387
                                else if ( FG.cTable[*s] == 1 ) {
×
388
                                        ss = s;
×
389
                                        AO.FloatPrec = 0;
×
390
                                        while ( *s <= '9' && *s >= '0' )
×
391
                                                AO.FloatPrec = 10*AO.FloatPrec + (*s++ - '0');
×
392
                                        while ( *s == ' ' || *s == '\t' || *s == ',' ) s++;
×
393
                                        if ( *s ) { s = ss; goto WrongOption; }
×
394
                                }
395
                                else {
396
WrongOption:                MesPrint("&Illegal option in Format FloatPrecision: %s",s);
×
397
                                        error = 1;
×
398
                                }
399
                        }
400
#endif
401
                }
402
                else if ( ( *s == 'c' || *s == 'C' ) && ( FG.cTable[s[1]] == 1 ) ) {
×
403
                        UBYTE *ss = s+1;
×
404
                        WORD x = 0;
×
405
                        while ( *ss >= '0' && *ss <= '9' ) x = 10*x + *ss++ - '0';
×
406
                        if ( *ss != 0 ) goto Unknown;
×
407
                        AC.OutputMode = CMODE;
×
408
                        AC.Cnumpows = x;
×
409
                }
410
                else {
411
Unknown:        MesPrint("&Unknown option: %s",s); error = 1;
×
412
                }
413
        }
414
        return(error);
415
}
416

417
/*
418
          #] CoFormat :
419
          #[ CoCollect :
420

421
        Collect,functionname
422
*/
423

424
int CoCollect(UBYTE *s)
6✔
425
{
426
/*        --------------change 17-feb-2003 Added percentage */
427
        WORD numfun;
6✔
428
        int type,x = 0;
6✔
429
        UBYTE *t = SkipAName(s), *t1, *t2;
6✔
430
        AC.AltCollectFun = 0;
6✔
431
        if ( t == 0 ) goto syntaxerror;
6✔
432
        t1 = t; while ( *t1 == ',' || *t1 == ' ' || *t1 == '\t' ) t1++;
9✔
433
        *t = 0; t = t1;
6✔
434
        if ( *t1 && ( FG.cTable[*t1] == 0 || *t1 == '[' ) ) {
6✔
435
                t2 = SkipAName(t1);
3✔
436
                if ( t2 == 0 ) goto syntaxerror;
3✔
437
                t = t2;
438
                while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
3✔
439
                *t2 = 0;
3✔
440
        }
441
        else t1 = 0;
442
        if ( *t && FG.cTable[*t] == 1 ) {
6✔
443
                while ( *t >= '0' && *t <= '9' ) x = 10*x + *t++ - '0';
×
444
                if ( x > 100 ) x = 100;
×
445
                while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
×
446
                if ( *t ) goto syntaxerror;
×
447
        }
448
        else {
449
                if ( *t ) goto syntaxerror;
6✔
450
                x = 100;
451
        }
452
        if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
6✔
453
        || ( functions[numfun].spec != 0 ) ) {
6✔
454
                MesPrint("&%s should be a regular function",s);
×
455
                if ( type < 0 ) {
×
456
                        if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
×
457
                                AddFunction(s,0,0,0,0,0,-1,-1);
×
458
                }
459
                return(1);
×
460
        }
461
        AC.CollectFun = numfun+FUNCTION;
6✔
462
        AC.CollectPercentage = (WORD)x;
6✔
463
        if ( t1 ) {
6✔
464
                if ( ( ( type = GetName(AC.varnames,t1,&numfun,WITHAUTO) ) != CFUNCTION )
3✔
465
                || ( functions[numfun].spec != 0 ) ) {
3✔
466
                        MesPrint("&%s should be a regular function",t1);
×
467
                        if ( type < 0 ) {
×
468
                                if ( GetName(AC.exprnames,t1,&numfun,NOAUTO) == NAMENOTFOUND )
×
469
                                        AddFunction(t1,0,0,0,0,0,-1,-1);
×
470
                        }
471
                        return(1);
×
472
                }
473
                AC.AltCollectFun = numfun+FUNCTION;
3✔
474
        }
475
        return(0);
476
syntaxerror:
×
477
        MesPrint("&Collect statement needs one or two functions (and a percentage) for its argument(s)");
×
478
        return(1);
×
479
}
480

481
/*
482
          #] CoCollect : 
483
          #[ setonoff :
484
*/
485

486
int setonoff(UBYTE *s, int *flag, int onvalue, int offvalue)
×
487
{
488
        if ( StrICmp(s,(UBYTE *)"on") == 0 ) *flag = onvalue;
×
489
        else if ( StrICmp(s,(UBYTE *)"off") == 0 ) *flag = offvalue;
×
490
        else {
491
                MesPrint("&Unknown option: %s, on or off expected",s);
×
492
                return(1);
×
493
        }
494
        return(0);
495
}
496

497
/*
498
          #] setonoff : 
499
          #[ CoCompress :
500
*/
501

502
int CoCompress(UBYTE *s)
×
503
{
504
        GETIDENTITY
505
        UBYTE *t, c;
×
506
        if ( StrICmp(s,(UBYTE *)"on") == 0 ) {
×
507
                AC.NoCompress = 0;
×
508
                AR.gzipCompress = 0;
×
509
        }
510
        else if ( StrICmp(s,(UBYTE *)"off") == 0 ) {
×
511
                AC.NoCompress = 1;
×
512
                AR.gzipCompress = 0;
×
513
        }
514
        else {
515
                t = s; while ( FG.cTable[*t] <= 1 ) t++;
×
516
                c = *t; *t = 0;
×
517
                if ( StrICmp(s,(UBYTE *)"gzip") == 0 ) {
×
518
#ifndef WITHZLIB
519
                        Warning("gzip compression not supported on this platform");
520
#endif
521
                        s = t; *s = c;
×
522
                        if ( *s == 0 ) {
×
523
                                AR.gzipCompress = GZIPDEFAULT;  /* Normally should be 6 */
×
524
                                return(0);
×
525
                        }
526
                        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
527
                        t = s;
×
528
                        if ( FG.cTable[*s] == 1 ) {
×
529
                                AR.gzipCompress = *s - '0';
×
530
                                s++;
×
531
                                while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
532
                                if ( *s == 0 ) return(0);
×
533
                        }
534
                        MesPrint("&Unknown gzip option: %s, a digit was expected",t);
×
535
                        return(1);
×
536

537
                }
538
                else {
539
                        MesPrint("&Unknown option: %s, on, off or gzip expected",s);
×
540
                        return(1);
×
541
                }
542
        }
543
        return(0);
544
}
545

546
/*
547
          #] CoCompress : 
548
          #[ CoFlags :
549
*/
550

551
int CoFlags(UBYTE *s,int value)
×
552
{
553
        int i, error = 0;
×
554
        if ( *s != ',' ) {
×
555
                MesPrint("&Proper syntax is: On/Off Flag,number[s];");
×
556
                error = 1;
×
557
        }
558
        while ( *s == ',' ) {
×
559
                do { s++; } while ( *s == ',' );
×
560
                i = 0;
×
561
                if ( FG.cTable[*s] != 1 ) {
×
562
                        MesPrint("&Proper syntax is: On/Off Flag,number[s];");
×
563
                        error = 1;
×
564
                        break;
×
565
                }
566
                while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ - '0'; }
×
567
                if ( i <= 0 || i > MAXFLAGS ) {
×
568
                        MesPrint("&The number of a flag in On/Off Flag should be in the range 0-%d",(int)MAXFLAGS);
×
569
                        error = 1;
×
570
                        break;
×
571
                }
572
                AC.debugFlags[i] = value;
×
573
        }
574
        if ( *s ) {
×
575
                MesPrint("&Proper syntax is: On/Off Flag,number[s];");
×
576
                error = 1;
×
577
        }
578
        return(error);
×
579
}
580

581
/*
582
          #] CoFlags : 
583
          #[ CoOff :
584
*/
585

586
int CoOff(UBYTE *s)
76✔
587
{
588
        GETIDENTITY
50✔
589
        UBYTE *t, c;
76✔
590
        int i, num = sizeof(onoffoptions)/sizeof(KEYWORD);
76✔
591
        for (;;) {
76✔
592
                while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
152✔
593
                if ( *s == 0 ) return(0);
152✔
594
                if ( chartype[*s] != 0 ) {
76✔
595
                        MesPrint("&Illegal character or option encountered in OFF statement");
×
596
                        return(-1);
×
597
                }
598
                t = s;        while ( chartype[*s] == 0 ) s++;
737✔
599
                c = *s; *s = 0;
76✔
600
                for ( i = 0; i < num; i++ ) {
567✔
601
                        if ( StrICont(t,(UBYTE *)(onoffoptions[i].name)) == 0 ) break;
567✔
602
                }
603
                if ( i >= num ) {
76✔
604
                        MesPrint("&Unrecognized option in OFF statement: %s",t);
×
605
                        *s = c; return(-1);
×
606
                }
607
                else if ( StrICont(t,(UBYTE *)"compress") == 0 ) {
76✔
608
                        AR.gzipCompress = 0;
6✔
609
                }
610
                else if ( StrICont(t,(UBYTE *)"checkpoint") == 0 ) {
70✔
611
                        PrintDeprecation("the checkpoint mechanism", "issues/626");
×
612
                        AC.CheckpointInterval = 0;
×
613
                        if ( AC.CheckpointRunBefore ) { free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL; }
×
614
                        if ( AC.CheckpointRunAfter ) { free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL; }
×
615
                        if ( AC.NoShowInput == 0 ) MesPrint("Checkpoints deactivated.");
×
616
                }
617
                else if ( StrICont(t,(UBYTE *)"threads") == 0 ) {
70✔
618
                        AS.MultiThreaded = 0;
×
619
                }
620
                else if ( StrICont(t,(UBYTE *)"flag") == 0 ) {
70✔
621
                        *s = c;
×
622
                        return(CoFlags(s,0));
×
623
                }
624
                else if ( StrICont(t,(UBYTE *)"innertest") == 0 ) {
70✔
625
                        *s = c;
×
626
                        AC.InnerTest = 0;
×
627
                        if ( AC.TestValue ) {
×
628
                                M_free(AC.TestValue,"InnerTest");
×
629
                                AC.TestValue = 0;
×
630
                        }
631
                }
632
                else if ( StrICont(t,(UBYTE *)"sortreallocate") == 0 ) {
70✔
633
                        if ( AC.SortReallocateFlag == 2 ) {
×
634
                                /* The flag has been set by #sortreallocate, and it was off before. Leave it as 2,
635
                                   so that the reallocation still happens in the current module. It will be turned
636
                                   off after the reallocation is done. */
637
                                return(0);
638
                        }
639
                }
640
                *s = c;
76✔
641
                 *onoffoptions[i].var = onoffoptions[i].flags; 
76✔
642
                AR.SortType = AC.SortType;
76✔
643
                AC.mparallelflag = AC.parallelflag | AM.hparallelflag;
76✔
644
        }
645
}
646

647
/*
648
          #] CoOff : 
649
          #[ CoOn :
650
*/
651

652
int CoOn(UBYTE *s)
39✔
653
{
654
        GETIDENTITY
26✔
655
        UBYTE *t, c;
39✔
656
        int i, num = sizeof(onoffoptions)/sizeof(KEYWORD);
39✔
657
        LONG interval;
658
        for (;;) {
39✔
659
                while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
78✔
660
                if ( *s == 0 ) return(0);
78✔
661
                if ( chartype[*s] != 0 ) {
39✔
662
                        MesPrint("&Illegal character or option encountered in ON statement");
×
663
                        return(-1);
×
664
                }
665
                t = s;        while ( chartype[*s] == 0 ) s++;
360✔
666
                c = *s; *s = 0;
39✔
667
                for ( i = 0; i < num; i++ ) {
741✔
668
                        if ( StrICont(t,(UBYTE *)(onoffoptions[i].name)) == 0 ) break;
741✔
669
                }
670
                if ( i >= num ) {
39✔
671
                        MesPrint("&Unrecognized option in ON statement: %s",t);
×
672
                        *s = c; return(-1);
×
673
                }
674
                if ( StrICont(t,(UBYTE *)"compress") == 0 ) {
39✔
675
                        AR.gzipCompress = 0;
×
676
                        *s = c;
×
677
                        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
678
                        if ( *s ) {
×
679
                                t = s;
×
680
                                while ( FG.cTable[*s] <= 1 ) s++;
×
681
                                c = *s; *s = 0;
×
682
                                if ( StrICmp(t,(UBYTE *)"gzip") == 0 ) {
×
683
#ifndef WITHZLIB
684
                                        Warning("gzip compression not supported on this platform");
685
#endif
686
#ifdef WITHZSTD
687
                                        /* If gzip is specified, turn off zstd compression. zlib still goes via the wrapper. */
688
                                        ZWRAP_useZSTDcompression(0);
×
689
#endif
690
                                }
691
                                else if ( StrICmp(t,(UBYTE *)"zstd") == 0 ) {
×
692
#ifdef WITHZSTD
693
                                        ZWRAP_useZSTDcompression(1);
×
694
#else
695
                                        Warning("zstd compression not supported on this platform");
696
#endif
697
                                }
698
                                else {
699
                                        MesPrint("&Unrecognized option in ON compress statement: %s",t);
×
700
                                        return(-1);
×
701
                                }
702
                                /* Whether we are using zlib or zstd, accept and use a compression level. */
703
                                *s = c;
×
704
                                while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
705
                                if ( FG.cTable[*s] == 1 ) {
×
706
                                        AR.gzipCompress = *s++ - '0';
×
707
                                        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
708
                                        if ( *s ) {
×
709
                                                MesPrint("&Unrecognized option in ON compress gzip/zstd statement: %s",t);
×
710
                                                return(-1);
×
711
                                        }
712
                                }
713
                                else if ( *s == 0 ) {
×
714
                                        AR.gzipCompress = GZIPDEFAULT;
×
715
                                }
716
                                else {
717
                                        MesPrint("&Unrecognized option in ON compress gzip/zstd statement: %s, single digit expected",t);
×
718
                                        return(-1);
×
719
                                }
720
                        }
721
                }
722
                else if ( StrICont(t,(UBYTE *)"checkpoint") == 0 ) {
39✔
723
                        PrintDeprecation("the checkpoint mechanism", "issues/626");
×
724
                        AC.CheckpointInterval = 0;
×
725
                        if ( AC.CheckpointRunBefore ) { free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL; }
×
726
                        if ( AC.CheckpointRunAfter ) { free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL; }
×
727
                        *s = c;
×
728
                        while ( *s ) {
×
729
                                while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
730
                                if ( FG.cTable[*s] == 1 ) {
×
731
                                        interval = 0;
732
                                        t = s;
×
733
                                        do { interval = 10*interval + *s++ - '0'; } while ( FG.cTable[*s] == 1 );
×
734
                                        if ( *s == 's' || *s == 'S' ) {
×
735
                                                s++;
×
736
                                        }
737
                                        else if ( *s == 'm' || *s == 'M' ) {
738
                                                interval *= 60; s++;
×
739
                                        }
740
                                        else if ( *s == 'h' || *s == 'H' ) {
741
                                                interval *= 3600; s++;
×
742
                                        }
743
                                        else if ( *s == 'd' || *s == 'D' ) {
744
                                                interval *= 86400; s++;
×
745
                                        }
746
                                        if ( *s != ',' && FG.cTable[*s] != 6 && FG.cTable[*s] != 10 ) {
×
747
                                                MesPrint("&Unrecognized time interval in ON Checkpoint statement: %s", t);
×
748
                                                return(-1);
×
749
                                        }
750
                                        AC.CheckpointInterval = interval * 100; /* in 1/100 of seconds */
×
751
                                }
752
                                else if ( FG.cTable[*s] == 0 ) {
×
753
                                        int type;
754
                                        t = s;
×
755
                                        while ( FG.cTable[*s] == 0 ) s++;
×
756
                                        c = *s; *s = 0;
×
757
                                        if ( StrICmp(t,(UBYTE *)"run") == 0 ) {
×
758
                                                type = 3;
759
                                        }
760
                                        else if ( StrICmp(t,(UBYTE *)"runafter") == 0 ) {
×
761
                                                type = 2;
762
                                        }
763
                                        else if ( StrICmp(t,(UBYTE *)"runbefore") == 0 ) {
×
764
                                                type = 1;
765
                                        }
766
                                        else {
767
                                                MesPrint("&Unrecognized option in ON Checkpoint statement: %s", t);
×
768
                                                *s = c; return(-1);
×
769
                                        }
770
                                        *s = c;
×
771
                                        if ( *s != '=' && FG.cTable[*(s+1)] != 9 ) {
×
772
                                                MesPrint("&Unrecognized option in ON Checkpoint statement: %s", t);
×
773
                                                return(-1);
×
774
                                        }
775
                                        ++s;
×
776
                                        t = ++s;
×
777
                                        while ( *s ) {
×
778
                                                if ( FG.cTable[*s] == 9 ) {
×
779
                                                        c = *s; *s = 0;
×
780
                                                        if ( type & 1 ) {
×
781
                                                                if ( AC.CheckpointRunBefore ) {
×
782
                                                                        free(AC.CheckpointRunBefore); AC.CheckpointRunBefore = NULL;
×
783
                                                                }
784
                                                                if ( s-t > 0 ) {
×
785
                                                                        AC.CheckpointRunBefore = Malloc1(s-t+1, "AC.CheckpointRunBefore");
×
786
                                                                        StrCopy(t, (UBYTE*)AC.CheckpointRunBefore);
×
787
                                                                }
788
                                                        }
789
                                                        if ( type & 2 ) {
×
790
                                                                if ( AC.CheckpointRunAfter ) {
×
791
                                                                        free(AC.CheckpointRunAfter); AC.CheckpointRunAfter = NULL;
×
792
                                                                }
793
                                                                if ( s-t > 0 ) {
×
794
                                                                        AC.CheckpointRunAfter = Malloc1(s-t+1, "AC.CheckpointRunAfter");
×
795
                                                                        StrCopy(t, (UBYTE*)AC.CheckpointRunAfter);
×
796
                                                                }
797
                                                        }
798
                                                        *s = c;
×
799
                                                        break;
×
800
                                                }
801
                                                ++s;
×
802
                                        }
803
                                        if ( FG.cTable[*s] != 9 ) {
×
804
                                                MesPrint("&Unrecognized option in ON Checkpoint statement: %s", t);
×
805
                                                return(-1);
×
806
                                        }
807
                                        ++s;
×
808
                                }
809
                        }
810
/*
811
                        if ( AC.NoShowInput == 0 ) {
812
                                MesPrint("Checkpoints activated.");
813
                                if ( AC.CheckpointInterval ) {
814
                                        MesPrint("-> Minimum saving interval: %l seconds.", AC.CheckpointInterval/100);
815
                                }
816
                                else {
817
                                        MesPrint("-> No minimum saving interval given. Saving after EVERY module.");
818
                                }
819
                                if ( AC.CheckpointRunBefore ) {
820
                                        MesPrint("-> Calling script \"%s\" before saving.", AC.CheckpointRunBefore);
821
                                }
822
                                if ( AC.CheckpointRunAfter ) {
823
                                        MesPrint("-> Calling script \"%s\" after saving.", AC.CheckpointRunAfter);
824
                                }
825
                        }
826
*/
827
                }
828
                else if ( StrICont(t,(UBYTE *)"indentspace") == 0 ) {
39✔
829
                        *s = c;
×
830
                        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
831
                        if ( *s ) {
×
832
                                i = 0;
833
                                while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ - '0'; }
×
834
                                if ( *s ) {
×
835
                                        MesPrint("&Unrecognized option in ON IndentSpace statement: %s",t);
×
836
                                        return(-1);
×
837
                                }
838
                                if ( i > 40 ) {
×
839
                                        Warning("IndentSpace parameter adjusted to 40");
×
840
                                        i = 40;
×
841
                                }
842
                                AO.IndentSpace = i;
×
843
                        }
844
                        else {
845
                                AO.IndentSpace = AM.ggIndentSpace;
×
846
                        }
847
                        return(0);
×
848
                }
849
                else if ( ( StrICont(t,(UBYTE *)"fewerstats") == 0 ) ||
78✔
850
                          ( StrICont(t,(UBYTE *)"fewerstatistics") == 0 ) ) {
39✔
851
                        *s = c;
×
852
                        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
853
                        if ( *s ) {
×
854
                                i = 0;
855
                                while ( FG.cTable[*s] == 1 ) { i = 10*i + *s++ - '0'; }
×
856
                                if ( *s ) {
×
857
                                        MesPrint("&Unrecognized option in ON FewerStatistics statement: %s",t);
×
858
                                        return(-1);
×
859
                                }
860
                                if ( i > AM.S0->MaxPatches ) {
×
861
                                        if ( AC.WarnFlag )
×
862
                                        MesPrint("&Warning: FewerStatistics parameter greater than MaxPatches(=%d). Adjusted to %d"
×
863
                                        ,AM.S0->MaxPatches,(AM.S0->MaxPatches+1)/2);
×
864
                                        i = (AM.S0->MaxPatches+1)/2;
×
865
                                }
866
                                AC.ShortStatsMax = i;
×
867
                        }
868
                        else {
869
                                AC.ShortStatsMax = 10; /* default value */
×
870
                        }
871
                        return(0);
×
872
                }
873
                else if ( StrICont(t,(UBYTE *)"threads") == 0 ) {
39✔
874
                        if ( AM.totalnumberofthreads > 1 ) AS.MultiThreaded = 1;
×
875
                }
876
                else if ( StrICont(t,(UBYTE *)"flag") == 0 ) {
39✔
877
                        *s = c;
×
878
                        return(CoFlags(s,1));
×
879
                }
880
                else if ( StrICont(t,(UBYTE *)"innertest") == 0 ) {
39✔
881
                        UBYTE *t;
×
882
                        *s = c;
×
883
                        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
884
                        if ( *s ) {
×
885
                                t = s; while ( *t ) t++;
×
886
                                while ( t[-1] == ' ' || t[-1] == '\t' ) t--;
×
887
                                c = *t; *t = 0;
×
888
                                if ( AC.TestValue ) M_free(AC.TestValue,"InnerTest");
×
889
                                AC.TestValue = strDup1(s,"InnerTest");
×
890
                                *t = c;
×
891
                                s = t;
×
892
                                while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
893
                        }
894
                        else {
895
                                if ( AC.TestValue ) {
×
896
                                        M_free(AC.TestValue,"InnerTest");
×
897
                                        AC.TestValue = 0;
×
898
                                }
899
                        }
900
                }
901
                else { *s = c; }
39✔
902
                 *onoffoptions[i].var = onoffoptions[i].type; 
39✔
903
                AR.SortType = AC.SortType;
39✔
904
                AC.mparallelflag = AC.parallelflag | AM.hparallelflag;
39✔
905
        }
906
}
907

908
/*
909
          #] CoOn : 
910
          #[ CoInsideFirst :
911
*/
912

913
int CoInsideFirst(UBYTE *s) { return(setonoff(s,&AC.insidefirst,1,0)); }
×
914

915
/*
916
          #] CoInsideFirst : 
917
          #[ CoProperCount :
918
*/
919

920
int CoProperCount(UBYTE *s) { return(setonoff(s,&AC.BottomLevel,1,0)); }
×
921

922
/*
923
          #] CoProperCount : 
924
          #[ CoDelete :
925
*/
926

927
int CoDelete(UBYTE *s)
×
928
{
929
        int error = 0;
×
930
        if ( StrICmp(s,(UBYTE *)"storage") == 0 ) {
×
931
                if ( DeleteStore(1) < 0 ) {
×
932
                        MesPrint("&Cannot restart storage file");
×
933
                        error = 1;
×
934
                }
935
        }
936
        else {
937
                UBYTE *t = s, c;
938
                while ( *t && *t != ',' && *t != '>' ) t++;
×
939
                c = *t; *t = 0;
×
940
                if ( ( StrICmp(s,(UBYTE *)"extrasymbols") == 0 )
×
941
                || ( StrICmp(s,(UBYTE *)"extrasymbol") == 0 ) ) {
×
942
                        WORD x = 0;
×
943
/*
944
                        Either deletes all extra symbols or deletes above a given number
945
*/
946
                        *t = c; s = t;
×
947
                        if ( *s == '>' ) {
×
948
                                s++;
×
949
                                if ( FG.cTable[*s] != 1 ) goto unknown;
×
950
                                while ( *s <= '9' && *s >= '0' ) x = 10*x + *s++ - '0';
×
951
                                if ( *s ) goto unknown;
×
952
                        }
953
                        else if ( *s ) goto unknown;
×
954
                        if ( x < AM.gnumextrasym ) x = AM.gnumextrasym;
×
955
                        PruneExtraSymbols(x);
×
956
                }
957
                else {
958
                        *t = c;
×
959
unknown:
×
960
                        MesPrint("&Unknown option: %s",s);
×
961
                        error = 1;
×
962
                }
963
        }
964
        return(error);
×
965
}
966

967
/*
968
          #] CoDelete : 
969
          #[ CoKeep :
970
*/
971

972
int CoKeep(UBYTE *s)
12✔
973
{
974
        if ( StrICmp(s,(UBYTE *)"brackets") == 0 ) AC.ComDefer = 1;
12✔
975
        else { MesPrint("&Unknown option: '%s'",s); return(1); }
×
976
        return(0);
12✔
977
}
978

979
/*
980
          #] CoKeep : 
981
          #[ CoFixIndex :
982
*/
983

984
int CoFixIndex(UBYTE *s)
6✔
985
{
986
        int x, y, error = 0;
6✔
987
        while ( *s ) {
24✔
988
                if ( FG.cTable[*s] != 1 ) {
18✔
989
proper:                MesPrint("&Proper syntax is: FixIndex,number:value[,number,value];");
×
990
                        return(1);
×
991
                }
992
                ParseNumber(x,s)
36✔
993
                if ( *s != ':' ) goto proper;
18✔
994
                s++;
18✔
995
                if ( *s != '-' && *s != '+' && FG.cTable[*s] != 1 ) goto proper;
18✔
996
                ParseSignedNumber(y,s)
42✔
997
                if ( *s && *s != ',' ) goto proper;
18✔
998
                while ( *s == ',' ) s++;
30✔
999
                if ( x >= AM.OffsetIndex ) {
18✔
1000
                        MesPrint("&Fixed index out of allowed range. Change ConstIndex in setup file?");
×
1001
                        MesPrint("&Current value of ConstIndex = %d",AM.OffsetIndex-1);
×
1002
                        error = 1;
×
1003
                }
1004
                if ( y != (int)((WORD)y) ) {
18✔
1005
                        MesPrint("&Value of d_(%d,%d) outside range for this computer",x,x);
1006
                        error = 1;
1007
                }
1008
                if ( error == 0 ) AC.FixIndices[x] = y;
18✔
1009
        }
1010
        return(error);
1011
}
1012

1013
/*
1014
          #] CoFixIndex : 
1015
          #[ CoMetric :
1016
*/
1017

1018
int CoMetric(UBYTE *s)
×
1019
{ DUMMYUSE(s); MesPrint("&The metric statement does not do anything yet"); return(1); }
×
1020

1021
/*
1022
          #] CoMetric : 
1023
          #[ DoPrint :
1024
*/
1025

1026
int DoPrint(UBYTE *s, int par)
2,107✔
1027
{
1028
        int i, error = 0, numdol = 0, type;
2,107✔
1029
        WORD handle = -1;
2,107✔
1030
        UBYTE *name, c, *t;
2,107✔
1031
        EXPRESSIONS e;
2,107✔
1032
        WORD numexpr, tofile = 0, *w, par2 = 0;
2,107✔
1033
        CBUF *C = cbuf + AC.cbufnum;
2,107✔
1034
        while ( *s == ',' ) s++;
2,107✔
1035
        if ( ( *s == '+' || *s == '-' ) && ( s[1] == 'f' || s[1] == 'F' ) ) {
2,107✔
1036
                t = s + 2; while ( *t == ' ' || *t == ',' ) t++;
15✔
1037
                if ( *t == '"' ) {
12✔
1038
                        if ( *s == '+' ) { tofile = 1; handle = AC.LogHandle; }
3✔
1039
                        s = t;
1040
                }
1041
        }
1042
        else if ( *s == '<' ) {
2,095✔
1043
                UBYTE *filename;
×
1044
                s++; filename = s;
×
1045
                while ( *s && *s != '>' ) s++;
×
1046
                if ( *s == 0 ) {
×
1047
                        MesPrint("&Improper filename in print statement");
×
1048
                        return(1);
×
1049
                }
1050
                *s++ = 0;
×
1051
                tofile = 1;
×
1052
                if ( ( handle = GetChannel((char *)filename,1) ) < 0 ) return(1);
×
1053
                SKIPBLANKS(s) if ( *s == ',' ) s++; SKIPBLANKS(s)
×
1054
                if ( *s == '+' && ( s[1] == 's' || s[1] == 'S' ) ) {
×
1055
                        s += 2;
×
1056
                        par2 |= PRINTONETERM;
×
1057
                        if ( *s == 's' || *s == 'S' ) {
×
1058
                                s++;
×
1059
                                par2 |= PRINTONEFUNCTION;
×
1060
                                if ( *s == 's' || *s == 'S' ) {
×
1061
                                        s++;
×
1062
                                        par2 |= PRINTALL;
×
1063
                                }
1064
                        }
1065
                        SKIPBLANKS(s) if ( *s == ',' ) s++; SKIPBLANKS(s)
×
1066
                }
1067
        }
1068
        if ( par == PRINTON && *s == '"' ) {
2,107✔
1069
                WORD code[3];
1,236✔
1070
                if ( tofile == 1 ) code[0] = TYPEFPRINT;
1,236✔
1071
                else code[0] = TYPEPRINT;
1,233✔
1072
                code[1] = handle;
1,236✔
1073
                code[2] = par2;
1,236✔
1074
                s++; name = s;
1,236✔
1075
                while ( *s && *s != '"' ) {
20,835✔
1076
                        if ( *s == '\\' ) s++;
19,599✔
1077
                        if ( *s == '%' && s[1] == '$' ) numdol++;
19,599✔
1078
                        s++;
19,599✔
1079
                }
1080
                if ( *s != '"' ) {
1,236✔
1081
                        MesPrint("&String in print statement should be enclosed in \"");
×
1082
                        return(1);
×
1083
                }
1084
                *s = 0;
1,236✔
1085
                AddComString(3,code,name,1);
1,236✔
1086
                *s++ = '"';
1,236✔
1087
                while ( *s == ',' ) {
1,260✔
1088
                        s++;
24✔
1089
                        if ( *s == '$' ) {
24✔
1090
                                s++; name = s; while ( FG.cTable[*s] <= 1 ) s++;
48✔
1091
                                c = *s; *s = 0;
24✔
1092
                                type = GetName(AC.dollarnames,name,&numexpr,NOAUTO);
24✔
1093
                                if ( type == NAMENOTFOUND ) {
24✔
1094
                                        MesPrint("&$ variable %s not (yet) defined",name);
×
1095
                                        error = 1;
×
1096
                                }
1097
                                else {
1098
                                        C->lhs[C->numlhs][1] += 2;
24✔
1099
                                        *(C->Pointer)++ = DOLLAREXPRESSION;
24✔
1100
                                        *(C->Pointer)++ = numexpr;
24✔
1101
                                        numdol--;
24✔
1102
                                }
1103
                        }
1104
                        else {
1105
                                MesPrint("&Illegal object in print statement");
×
1106
                                error = 1;
×
1107
                                return(error);
×
1108
                        }
1109
                        *s = c;
24✔
1110
                        if ( c == '[' ) {
24✔
1111
                                w = C->Pointer;
3✔
1112
                                s++;
3✔
1113
                                s = GetDoParam(s,&(C->Pointer),-1);
3✔
1114
                                if ( s == 0 ) return(1);
3✔
1115
                                if ( *s != ']' ) {
3✔
1116
                                        MesPrint("&unmatched [] in $ factor");
×
1117
                                        return(1);
×
1118
                                }
1119
                                C->lhs[C->numlhs][1] += C->Pointer - w;
3✔
1120
                                s++;
3✔
1121
                        }
1122
                }
1123
                if ( *s != 0 ) {
1,236✔
1124
                        MesPrint("&Illegal object in print statement");
×
1125
                        error = 1;
×
1126
                }
1127
                if ( numdol > 0 ) {
1,236✔
1128
                        MesPrint("&More $ variables asked for than provided");
×
1129
                        error = 1;
×
1130
                }
1131
                *(C->Pointer)++ = 0;
1,236✔
1132
                return(error);
1,236✔
1133
        }
1134
        if ( *s == 0 ) {        /* All active expressions */
871✔
1135
AllExpr:
664✔
1136
                for ( e = Expressions, i = NumExpressions; i > 0; i--, e++ ) {
3,071✔
1137
            if ( e->status == LOCALEXPRESSION || e->status ==
2,245✔
1138
            GLOBALEXPRESSION || e->status == UNHIDELEXPRESSION
1139
                        || e->status == UNHIDEGEXPRESSION ) e->printflag = par;
2,017✔
1140
        }
1141
                return(error);
1142
        }
1143
        while ( *s ) {
240✔
1144
                if ( *s == '+' ) {
240✔
1145
                        s++;
180✔
1146
                        if ( tolower(*s) == 'f' ) par |= PRINTLFILE;
180✔
1147
                        else if ( tolower(*s) == 's' ) {
171✔
1148
                                if ( tolower(s[1]) == 's' ) {
171✔
1149
                                        if ( tolower(s[2]) == 's' ) {
×
1150
                                                par |= PRINTONEFUNCTION | PRINTONETERM | PRINTALL;
×
1151
                                                s++;
×
1152
                                        }
1153
                                        else if ( ( par & 3 ) < 2 ) par |= PRINTONEFUNCTION | PRINTONETERM;
×
1154
                                        s++;
×
1155
                                }
1156
                                else {
1157
                                        if ( ( par & 3 ) < 2 ) par |= PRINTONETERM;
171✔
1158
                                }
1159
                        }
1160
                        else {
1161
illeg:                                MesPrint("&Illegal option in (n)print statement");
×
1162
                                error = 1;
×
1163
                        }
1164
                        s++;
180✔
1165
                        if ( *s == 0 ) goto AllExpr;
180✔
1166
                }
1167
                else if ( *s == '-' ) {
60✔
1168
                        s++;
×
1169
                        if ( tolower(*s) == 'f' ) par &= ~PRINTLFILE;
×
1170
                        else if ( tolower(*s) == 's' ) {
×
1171
                                if ( tolower(s[1]) == 's' ) {
×
1172
                                        if ( tolower(s[2]) == 's' ) {
×
1173
                                                par &= ~PRINTALL;
×
1174
                                                s++;
×
1175
                                        }
1176
                                        else if ( ( par & 3 ) < 2 ) {
×
1177
                                                par &= ~PRINTONEFUNCTION;
×
1178
                                                par &= ~PRINTALL;
×
1179
                                        }
1180
                                        s++;
×
1181
                                }
1182
                                else {
1183
                                        if ( ( par & 3 ) < 2 ) {
×
1184
                                                par &= ~PRINTONETERM;
×
1185
                                                par &= ~PRINTONEFUNCTION;
×
1186
                                                par &= ~PRINTALL;
×
1187
                                        }
1188
                                }
1189
                        }
1190
                        else goto illeg;
×
1191
                        s++;
×
1192
                        if ( *s == 0 ) goto AllExpr;
×
1193
                }
1194
                else if ( FG.cTable[*s] == 0 || *s == '[' ) {
60✔
1195
                        name = s;
45✔
1196
                        if ( ( s = SkipAName(s) ) == 0 ) {
45✔
1197
                                MesPrint("&Improper name in (n)print statement");
×
1198
                                return(1);
×
1199
                        }
1200
                        c = *s; *s = 0;
45✔
1201
                        if ( ( GetName(AC.exprnames,name,&numexpr,NOAUTO) == CEXPRESSION )
45✔
1202
                        && ( Expressions[numexpr].status == LOCALEXPRESSION
45✔
1203
                        || Expressions[numexpr].status == GLOBALEXPRESSION ) ) {
45✔
1204
FoundExpr:;
42✔
1205
                                if ( c == '[' && s[1] == ']' ) {
45✔
1206
                                        Expressions[numexpr].printflag = par | PRINTCONTENTS;
×
1207
                                        *s++ = c; c = *++s;
×
1208
                                }
1209
                                else
1210
                                        Expressions[numexpr].printflag = par;
45✔
1211
                        }
1212
                        else if ( GetLastExprName(name,&numexpr)
3✔
1213
                        && ( Expressions[numexpr].status == LOCALEXPRESSION
3✔
1214
                        || Expressions[numexpr].status == GLOBALEXPRESSION
3✔
1215
                        || Expressions[numexpr].status == UNHIDELEXPRESSION
1216
                        || Expressions[numexpr].status == UNHIDEGEXPRESSION
1217
                        ) ) {
1218
                                goto FoundExpr;
3✔
1219
                        }
1220
                        else {
1221
                                MesPrint("&%s is not the name of an active expression",name);
×
1222
                                error = 1;
×
1223
                        }
1224
                        *s++ = c;
45✔
1225
                        if ( c == 0 ) return(0);
45✔
1226
                        if ( c == '-' || c == '+' ) s--;
×
1227
                }
1228
                else if ( *s == ',' ) s++;
15✔
1229
                else {
1230
                        MesPrint("&Illegal object in (n)print statement");
×
1231
                        return(1);
×
1232
                } 
1233
        }
1234
        return(0);
1235
}
1236

1237
/*
1238
          #] DoPrint : 
1239
          #[ CoPrint :
1240
*/
1241

1242
int CoPrint(UBYTE *s) { return(DoPrint(s,PRINTON)); }
2,104✔
1243

1244
/*
1245
          #] CoPrint : 
1246
          #[ CoPrintB :
1247
*/
1248

1249
int CoPrintB(UBYTE *s) { return(DoPrint(s,PRINTCONTENT)); }
3✔
1250

1251
/*
1252
          #] CoPrintB : 
1253
          #[ CoNPrint :
1254
*/
1255

1256
int CoNPrint(UBYTE *s) { return(DoPrint(s,PRINTOFF)); }
×
1257

1258
/*
1259
          #] CoNPrint : 
1260
          #[ CoPushHide :
1261
*/
1262

1263
int CoPushHide(UBYTE *s)
×
1264
{
1265
        GETIDENTITY
1266
        WORD *ScratchBuf;
×
1267
        int i;
×
1268
        if ( AR.Fscr[2].PObuffer == 0 ) {
×
1269
                ScratchBuf = (WORD *)Malloc1(AM.HideSize*sizeof(WORD),"hidesize");
×
1270
                AR.Fscr[2].POsize = AM.HideSize * sizeof(WORD);
×
1271
                AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
×
1272
                AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
×
1273
                PUTZERO(AR.Fscr[2].POposition);
×
1274
        }
1275
        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
1276
        AC.HideLevel += 2;
×
1277
        if ( *s ) {
×
1278
                MesPrint("&PushHide statement should have no arguments");
×
1279
                return(-1);
×
1280
        }
1281
        for ( i = 0; i < NumExpressions; i++ ) {
×
1282
                switch ( Expressions[i].status ) {
×
1283
                        case DROPLEXPRESSION:
×
1284
                case SKIPLEXPRESSION:
1285
                case LOCALEXPRESSION:
1286
                                Expressions[i].status = HIDELEXPRESSION;
×
1287
                                Expressions[i].hidelevel = AC.HideLevel-1;
×
1288
                    break;
×
1289
                        case DROPGEXPRESSION:
×
1290
                case SKIPGEXPRESSION:
1291
                case GLOBALEXPRESSION:
1292
                                Expressions[i].status = HIDEGEXPRESSION;
×
1293
                                Expressions[i].hidelevel = AC.HideLevel-1;
×
1294
                    break;
×
1295
                default:
1296
                    break;
1297
                }
1298
        }
1299
        return(0);
1300
}
1301

1302
/*
1303
          #] CoPushHide : 
1304
          #[ CoPopHide :
1305
*/
1306

1307
int CoPopHide(UBYTE *s)
×
1308
{
1309
        int i;
×
1310
        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
1311
        if ( AC.HideLevel <= 0 ) {
×
1312
                MesPrint("&PopHide statement without corresponding PushHide statement");
×
1313
                return(-1);
×
1314
        }
1315
        AC.HideLevel -= 2;
×
1316
        if ( *s ) {
×
1317
                MesPrint("&PopHide statement should have no arguments");
×
1318
                return(-1);
×
1319
        }
1320
        for ( i = 0; i < NumExpressions; i++ ) {
×
1321
                switch ( Expressions[i].status ) {
×
1322
                case HIDDENLEXPRESSION:
×
1323
                                if ( Expressions[i].hidelevel > AC.HideLevel )
×
1324
                                        Expressions[i].status = UNHIDELEXPRESSION;
×
1325
                    break;
1326
                case HIDDENGEXPRESSION:
×
1327
                                if ( Expressions[i].hidelevel > AC.HideLevel )
×
1328
                                        Expressions[i].status = UNHIDEGEXPRESSION;
×
1329
                    break;
1330
                default:
1331
                    break;
1332
                }
1333
        }
1334
        return(0);
1335
}
1336

1337
/*
1338
          #] CoPopHide : 
1339
          #[ SetExprCases :
1340
*/
1341

1342
int SetExprCases(int par, int setunset, int val)
279✔
1343
{
1344
        switch ( par ) {
279✔
1345
                case SKIP:
×
1346
                        switch ( val ) {
×
1347
                        case SKIPLEXPRESSION:
×
1348
                                        if ( !setunset ) val = LOCALEXPRESSION;
×
1349
                            break;
1350
                        case SKIPGEXPRESSION:
×
1351
                                        if ( !setunset ) val = GLOBALEXPRESSION;
×
1352
                            break;
1353
                        case LOCALEXPRESSION:
×
1354
                                        if ( setunset ) val = SKIPLEXPRESSION;
×
1355
                            break;
1356
                        case GLOBALEXPRESSION:
×
1357
                                        if ( setunset ) val = SKIPGEXPRESSION;
×
1358
                            break;
1359
                        case INTOHIDEGEXPRESSION:
1360
                        case INTOHIDELEXPRESSION:
1361
                        default:
1362
                            break;
1363
                        }
1364
                        break;
1365
                case DROP:
231✔
1366
                        switch ( val ) {
231✔
1367
                        case SKIPLEXPRESSION:
228✔
1368
                        case LOCALEXPRESSION:
1369
                        case HIDELEXPRESSION:
1370
                                        if ( setunset ) val = DROPLEXPRESSION;
228✔
1371
                            break;
1372
                        case DROPLEXPRESSION:
×
1373
                                        if ( !setunset ) val = LOCALEXPRESSION;
×
1374
                            break;
1375
                        case SKIPGEXPRESSION:
×
1376
                        case GLOBALEXPRESSION:
1377
                        case HIDEGEXPRESSION:
1378
                                        if ( setunset ) val = DROPGEXPRESSION;
×
1379
                            break;
1380
                        case DROPGEXPRESSION:
×
1381
                                        if ( !setunset ) val = GLOBALEXPRESSION;
×
1382
                            break;
1383
                        case HIDDENLEXPRESSION:
3✔
1384
                                case UNHIDELEXPRESSION:
1385
                                        if ( setunset ) val = DROPHLEXPRESSION;
3✔
1386
                            break;
1387
                        case HIDDENGEXPRESSION:
×
1388
                                case UNHIDEGEXPRESSION:
1389
                                        if ( setunset ) val = DROPHGEXPRESSION;
×
1390
                            break;
1391
                        case DROPHLEXPRESSION:
×
1392
                                        if ( !setunset ) val = HIDDENLEXPRESSION;
×
1393
                            break;
1394
                        case DROPHGEXPRESSION:
×
1395
                                        if ( !setunset ) val = HIDDENGEXPRESSION;
×
1396
                            break;
1397
                        case INTOHIDEGEXPRESSION:
1398
                        case INTOHIDELEXPRESSION:
1399
                        default:
1400
                            break;
1401
                        }
1402
                        break;
1403
                case HIDE:
42✔
1404
                        switch ( val ) {
42✔
1405
                                case DROPLEXPRESSION:
42✔
1406
                        case SKIPLEXPRESSION:
1407
                        case LOCALEXPRESSION:
1408
                                        if ( setunset ) val = HIDELEXPRESSION;
42✔
1409
                            break;
1410
                        case HIDELEXPRESSION:
×
1411
                                        if ( !setunset ) val = LOCALEXPRESSION;
×
1412
                            break;
1413
                                case DROPGEXPRESSION:
×
1414
                        case SKIPGEXPRESSION:
1415
                        case GLOBALEXPRESSION:
1416
                                        if ( setunset ) val = HIDEGEXPRESSION;
×
1417
                            break;
1418
                        case HIDEGEXPRESSION:
×
1419
                                        if ( !setunset ) val = GLOBALEXPRESSION;
×
1420
                            break;
1421
                        case INTOHIDEGEXPRESSION:
1422
                        case INTOHIDELEXPRESSION:
1423
                        default:
1424
                            break;
1425
                        }
1426
                        break;
1427
                case UNHIDE:
3✔
1428
                        switch ( val ) {
3✔
1429
                        case HIDDENLEXPRESSION:
3✔
1430
                        case DROPHLEXPRESSION:
1431
                                        if ( setunset ) val = UNHIDELEXPRESSION;
3✔
1432
                            break;
1433
                                case UNHIDELEXPRESSION:
×
1434
                                        if ( !setunset ) val = HIDDENLEXPRESSION;
×
1435
                            break;
1436
                        case HIDDENGEXPRESSION:
×
1437
                        case DROPHGEXPRESSION:
1438
                                        if ( setunset ) val = UNHIDEGEXPRESSION;
×
1439
                            break;
1440
                                case UNHIDEGEXPRESSION:
×
1441
                                        if ( !setunset ) val = HIDDENGEXPRESSION;
×
1442
                            break;
1443
                        case INTOHIDEGEXPRESSION:
1444
                        case INTOHIDELEXPRESSION:
1445
                        default:
1446
                            break;
1447
                        }
1448
                        break;
1449
                case INTOHIDE:
3✔
1450
                        switch ( val ) {
3✔
1451
                        case HIDDENLEXPRESSION:
×
1452
                        case HIDDENGEXPRESSION:
1453
                                        MesPrint("&Expression is already hidden");
×
1454
                                        return(-1);
×
1455
                        case DROPHLEXPRESSION:
×
1456
                        case DROPHGEXPRESSION:
1457
                                case UNHIDELEXPRESSION:
1458
                                case UNHIDEGEXPRESSION:
1459
                                        MesPrint("&Cannot unhide and put intohide expression in the same module");
×
1460
                                        return(-1);
×
1461
                                case LOCALEXPRESSION:
3✔
1462
                                case DROPLEXPRESSION:
1463
                        case SKIPLEXPRESSION:
1464
                                case HIDELEXPRESSION:
1465
                                        if ( setunset ) val = INTOHIDELEXPRESSION;
3✔
1466
                                        break;
1467
                                case GLOBALEXPRESSION:
×
1468
                                case DROPGEXPRESSION:
1469
                        case SKIPGEXPRESSION:
1470
                                case HIDEGEXPRESSION:
1471
                                        if ( setunset ) val = INTOHIDEGEXPRESSION;
×
1472
                                        break;
1473
                        default:
1474
                            break;
1475
                        }
1476
                        break;
1477
                default:
1478
                        break;
1479
        }
1480
        return(val);
1481
}
1482

1483
/*
1484
          #] SetExprCases : 
1485
          #[ SetExpr :
1486
*/
1487

1488
int SetExpr(UBYTE *s, int setunset, int par)
114✔
1489
{
1490
        WORD *w, numexpr;
114✔
1491
        int error = 0, i;
114✔
1492
        UBYTE *name, c;
114✔
1493
        if ( *s == 0 && ( par != INTOHIDE ) ) {
114✔
1494
                for ( i = 0; i < NumExpressions; i++ ) {
258✔
1495
                        w = &(Expressions[i].status);
204✔
1496
                        *w = SetExprCases(par,setunset,*w);
204✔
1497
                        if ( *w < 0 ) error = 1;
204✔
1498
                        if ( par == HIDE && setunset == 1 )
204✔
1499
                                Expressions[i].hidelevel = AC.HideLevel;
9✔
1500
                }
1501
                return(0);
1502
        }
1503
        while ( *s ) {
120✔
1504
                if ( *s == ',' ) { s++; continue; }
60✔
1505
                if ( *s == '0' ) { s++; continue; }
60✔
1506
                name = s;
60✔
1507
                if ( ( s = SkipAName(s) ) == 0 ) {
60✔
1508
                        MesPrint("&Improper name for an expression: '%s'",name);
×
1509
                        return(1);
×
1510
                }
1511
                c = *s; *s = 0;
60✔
1512
                if ( GetName(AC.exprnames,name,&numexpr,NOAUTO) == CEXPRESSION ) {
60✔
1513
                        w = &(Expressions[numexpr].status);
60✔
1514
                        *w = SetExprCases(par,setunset,*w);
60✔
1515
                        if ( *w < 0 ) error = 1;
60✔
1516
                        if ( ( par == HIDE || par == INTOHIDE ) && setunset == 1 )
60✔
1517
                                Expressions[numexpr].hidelevel = AC.HideLevel;
36✔
1518
                }
1519
                else if ( GetName(AC.varnames,name,&numexpr,NOAUTO) != NAMENOTFOUND ) {
×
1520
                        MesPrint("&%s is not an expression",name);
×
1521
                        error = 1;
×
1522
                }
1523
                *s = c;
60✔
1524
        }
1525
        return(error);
1526
}
1527

1528
/*
1529
          #] SetExpr : 
1530
          #[ CoDrop :
1531
*/
1532

1533
int CoDrop(UBYTE *s) { return(SetExpr(s,1,DROP)); }
66✔
1534

1535
/*
1536
          #] CoDrop : 
1537
          #[ CoNoDrop :
1538
*/
1539

1540
int CoNoDrop(UBYTE *s) { return(SetExpr(s,0,DROP)); }
×
1541

1542
/*
1543
          #] CoNoDrop : 
1544
          #[ CoSkip :
1545
*/
1546

1547
int CoSkip(UBYTE *s) { return(SetExpr(s,1,SKIP)); }
×
1548

1549
/*
1550
          #] CoSkip : 
1551
          #[ CoNoSkip :
1552
*/
1553

1554
int CoNoSkip(UBYTE *s) { return(SetExpr(s,0,SKIP)); }
×
1555

1556
/*
1557
          #] CoNoSkip : 
1558
          #[ CoHide :
1559
*/
1560

1561
int CoHide(UBYTE *inp) {
42✔
1562
        GETIDENTITY
28✔
1563
        WORD *ScratchBuf;
42✔
1564
        if ( AR.Fscr[2].PObuffer == 0 ) {
42✔
1565
                ScratchBuf = (WORD *)Malloc1(AM.HideSize*sizeof(WORD),"hidesize");
6✔
1566
                AR.Fscr[2].POsize = AM.HideSize * sizeof(WORD);
6✔
1567
                AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
6✔
1568
                AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
6✔
1569
                PUTZERO(AR.Fscr[2].POposition);
6✔
1570
        }
1571
        return(SetExpr(inp,1,HIDE));
42✔
1572
}
1573

1574
/*
1575
          #] CoHide : 
1576
          #[ CoIntoHide :
1577
*/
1578

1579
int CoIntoHide(UBYTE *inp) {
3✔
1580
        GETIDENTITY
2✔
1581
        WORD *ScratchBuf;
3✔
1582
        if ( AR.Fscr[2].PObuffer == 0 ) {
3✔
1583
                ScratchBuf = (WORD *)Malloc1(AM.HideSize*sizeof(WORD),"hidesize");
1✔
1584
                AR.Fscr[2].POsize = AM.HideSize * sizeof(WORD);
1✔
1585
                AR.Fscr[2].POfull = AR.Fscr[2].POfill = AR.Fscr[2].PObuffer = ScratchBuf;
1✔
1586
                AR.Fscr[2].POstop = AR.Fscr[2].PObuffer + AM.HideSize;
1✔
1587
                PUTZERO(AR.Fscr[2].POposition);
1✔
1588
        }
1589
        return(SetExpr(inp,1,INTOHIDE));
3✔
1590
}
1591

1592
/*
1593
          #] CoIntoHide : 
1594
          #[ CoNoHide :
1595
*/
1596

1597
int CoNoHide(UBYTE *inp) { return(SetExpr(inp,0,HIDE)); }
×
1598

1599
/*
1600
          #] CoNoHide : 
1601
          #[ CoUnHide :
1602
*/
1603

1604
int CoUnHide(UBYTE *inp) { return(SetExpr(inp,1,UNHIDE)); }
3✔
1605

1606
/*
1607
          #] CoUnHide : 
1608
          #[ CoNoUnHide :
1609
*/
1610

1611
int CoNoUnHide(UBYTE *inp) { return(SetExpr(inp,0,UNHIDE)); }
×
1612

1613
/*
1614
          #] CoNoUnHide : 
1615
          #[ AddToCom :
1616
*/
1617

1618
void AddToCom(int n, WORD *array)
×
1619
{
1620
        CBUF *C = cbuf+AC.cbufnum;
×
1621
#ifdef COMPBUFDEBUG
1622
        MesPrint("  %a",n,array);
1623
#endif
1624
        while ( C->Pointer+n >= C->Top ) DoubleCbuffer(AC.cbufnum,C->Pointer,18);
×
1625
        while ( --n >= 0 ) *(C->Pointer)++ = *array++;
×
1626
}
×
1627

1628
/*
1629
          #] AddToCom : 
1630
          #[ AddComString :
1631
*/
1632

1633
int AddComString(int n, WORD *array, UBYTE *thestring, int par)
1,236✔
1634
{
1635
        CBUF *C = cbuf+AC.cbufnum;
1,236✔
1636
        UBYTE *s = thestring, *w;
1,236✔
1637
#ifdef COMPBUFDEBUG
1638
        WORD *cc;
1639
        UBYTE *ww;
1640
#endif
1641
        int i, numchars = 0, size, zeroes;
1,236✔
1642
        while ( *s ) {
20,835✔
1643
                if ( *s == '\\' ) s++;
19,599✔
1644
                else if ( par == 1 &&
19,599✔
1645
                ( ( *s == '%' && s[1] != 't' && s[1] != 'T' && s[1] != '$' &&
651✔
1646
                 s[1] != 'w' && s[1] != 'W' && s[1] != 'r' && s[1] != 0 ) || *s == '#'
×
1647
                || *s == '@' || *s == '&' ) ) {
1648
                        numchars++;
×
1649
                }
1650
                s++; numchars++;
19,599✔
1651
        }
1652
        AddLHS(AC.cbufnum);
1,236✔
1653
        size = numchars/sizeof(WORD)+1;
1,236✔
1654
        while ( C->Pointer+size+n+2 >= C->Top ) DoubleCbuffer(AC.cbufnum,C->Pointer,19);
1,242✔
1655
#ifdef COMPBUFDEBUG
1656
        cc = C->Pointer;
1657
#endif
1658
        *(C->Pointer)++ = array[0];
1,236✔
1659
        *(C->Pointer)++ = size+n+2;
1,236✔
1660
        for ( i = 1; i < n; i++ ) *(C->Pointer)++ = array[i];
3,708✔
1661
        *(C->Pointer)++ = size;
1,236✔
1662
#ifdef COMPBUFDEBUG
1663
        ww =
1664
#endif
1665
        w = (UBYTE *)(C->Pointer);
1,236✔
1666
        zeroes = size*sizeof(WORD)-numchars;
1,236✔
1667
        s = thestring;
1,236✔
1668
        while ( *s ) {
20,835✔
1669
                if ( *s == '\\' ) s++;
19,599✔
1670
                else if ( par == 1 && ( ( *s == '%' &&
19,599✔
1671
                s[1] != 't' && s[1] != 'T' && s[1] != '$' &&
651✔
1672
                s[1] != 'w' && s[1] != 'W' && s[1] != 'r' && s[1] != 0 ) || *s == '#'
×
1673
                || *s == '@' || *s == '&' ) ) {
1674
                        *w++ = '%';
×
1675
                }
1676
                *w++ = *s++;
19,599✔
1677
        }
1678
        while ( --zeroes >= 0 ) *w++ = 0;
3,729✔
1679
        C->Pointer += size;
1,236✔
1680
#ifdef COMPBUFDEBUG
1681
        MesPrint("LH: %a",size+1+n,cc);
1682
        MesPrint("        %s",thestring);
1683
#endif
1684
        return(0);
1,236✔
1685
}
1686

1687
/*
1688
          #] AddComString : 
1689
          #[ Add2ComStrings :
1690
*/
1691

1692
int Add2ComStrings(int n, WORD *array, UBYTE *string1, UBYTE *string2)
18✔
1693
{
1694
        CBUF *C = cbuf+AC.cbufnum;
18✔
1695
        UBYTE *s1 = string1, *s2 = string2, *w;
18✔
1696
        int i, num1chars = 0, num2chars = 0, size1, size2, zeroes1, zeroes2;
18✔
1697
        AddLHS(AC.cbufnum);
18✔
1698
        while ( *s1 ) { s1++; num1chars++; }
36✔
1699
        size1 = num1chars/sizeof(WORD)+1;
18✔
1700
        if ( s2 ) {
18✔
1701
                while ( *s2 ) { s2++; num2chars++; }
×
1702
                size2 = num2chars/sizeof(WORD)+1;
×
1703
        }
1704
        else size2 = 0;
18✔
1705
        while ( C->Pointer+size1+size2+n+3 >= C->Top ) DoubleCbuffer(AC.cbufnum,C->Pointer,20);
18✔
1706
        *(C->Pointer)++ = array[0];
18✔
1707
        *(C->Pointer)++ = size1+size2+n+3;
18✔
1708
        for ( i = 1; i < n; i++ ) *(C->Pointer)++ = array[i];
36✔
1709
        *(C->Pointer)++ = size1;
18✔
1710
        w = (UBYTE *)(C->Pointer);
18✔
1711
        zeroes1 = size1*sizeof(WORD)-num1chars;
18✔
1712
        s1 = string1;
18✔
1713
        while ( *s1 ) { *w++ = *s1++; }
36✔
1714
        while ( --zeroes1 >= 0 ) *w++ = 0;
72✔
1715
        C->Pointer += size1;
18✔
1716
        *(C->Pointer)++ = size2;
18✔
1717
        if ( size2 ) {
18✔
1718
                w = (UBYTE *)(C->Pointer);
×
1719
                zeroes2 = size2*sizeof(WORD)-num2chars;
×
1720
                s2 = string2;
×
1721
                while ( *s2 ) { *w++ = *s2++; }
×
1722
                while ( --zeroes2 >= 0 ) *w++ = 0;
×
1723
                C->Pointer += size2;
×
1724
        }
1725
        return(0);
18✔
1726
}
1727

1728
/*
1729
          #] Add2ComStrings : 
1730
          #[ CoDiscard :
1731
*/
1732

1733
int CoDiscard(UBYTE *s)
3✔
1734
{
1735
        if ( *s == 0 ) {
3✔
1736
                Add2Com(TYPEDISCARD)
3✔
1737
                return(0);
3✔
1738
        }
1739
        MesPrint("&Illegal argument in discard statement: '%s'",s);
×
1740
        return(1);
×
1741
}
1742

1743
/*
1744
          #] CoDiscard : 
1745
          #[ CoContract :
1746

1747
        Syntax:
1748
                Contract
1749
                Contract:#
1750
                Contract #
1751
                Contract:#,#
1752
*/
1753

1754
static WORD ccarray[5] = { TYPEOPERATION,5,CONTRACT,0,0 };
1755

1756
int CoContract(UBYTE *s)
9✔
1757
{
1758
        int x;
9✔
1759
        if ( *s == ':' ) {
9✔
1760
                s++;
×
1761
                ParseNumber(x,s)
×
1762
                if ( *s != ',' && *s ) {
×
1763
proper:                MesPrint("&Illegal number in contract statement");
×
1764
                        return(1);
×
1765
                }
1766
                if ( *s ) s++;
×
1767
                ccarray[4] = x;
×
1768
        }
1769
        else ccarray[4] = 0;
9✔
1770
        if ( FG.cTable[*s] == 1 ) {
9✔
1771
                ParseNumber(x,s)
×
1772
                if ( *s ) goto proper;
×
1773
                ccarray[3] = x;
×
1774
        }
1775
        else if ( *s ) goto proper;
9✔
1776
        else ccarray[3] = -1;
9✔
1777
        return(AddNtoL(5,ccarray));
9✔
1778
}
1779

1780
/*
1781
          #] CoContract : 
1782
          #[ CoGoTo :
1783
*/
1784

1785
int CoGoTo(UBYTE *inp)
3✔
1786
{
1787
        UBYTE *s = inp;
3✔
1788
        int x;
3✔
1789
        while ( FG.cTable[*s] <= 1 ) s++;
6✔
1790
        if ( *s ) {
3✔
1791
                MesPrint("&Label should be an alpha-numeric string");
×
1792
                return(1);
×
1793
        }
1794
        x = GetLabel(inp);
3✔
1795
        Add3Com(TYPEGOTO,x);
3✔
1796
        return(0);
3✔
1797
}
1798

1799
/*
1800
          #] CoGoTo : 
1801
          #[ CoLabel :
1802
*/
1803

1804
int CoLabel(UBYTE *inp)
105✔
1805
{
1806
        UBYTE *s = inp;
105✔
1807
        int x;
105✔
1808
        while ( FG.cTable[*s] <= 1 ) s++;
303✔
1809
        if ( *s ) {
105✔
1810
                MesPrint("&Label should be an alpha-numeric string");
×
1811
                return(1);
×
1812
        }
1813
        x = GetLabel(inp);
105✔
1814
        if ( AC.Labels[x] >= 0 ) {
105✔
1815
                MesPrint("&Label %s defined more than once",AC.LabelNames[x]);
6✔
1816
                return(1);
6✔
1817
        }
1818
        AC.Labels[x] = cbuf[AC.cbufnum].numlhs;
99✔
1819
        return(0);
99✔
1820
}
1821

1822
/*
1823
          #] CoLabel : 
1824
          #[ DoArgument :
1825

1826
        Layout:
1827
                par,full size,numlhs(+1),par,scale
1828
                scale is for normalize
1829
*/
1830

1831
int DoArgument(UBYTE *s, int par)
93✔
1832
{
1833
        GETIDENTITY
62✔
1834
        UBYTE *name, *t, *v, c;
93✔
1835
        WORD *oldworkpointer = AT.WorkPointer, *w, *ww, number, *scale;
93✔
1836
        int error = 0, zeroflag, type, x;
93✔
1837
        AC.lhdollarflag = 0;
93✔
1838
        while ( *s == ',' ) s++;
93✔
1839
        w = AT.WorkPointer;
93✔
1840
        *w++ = par;
93✔
1841
        w++;
93✔
1842
        switch ( par ) {
93✔
1843
                case TYPEARG:
21✔
1844
                if ( AC.arglevel >= MAXNEST ) {
21✔
1845
                    MesPrint("@Nesting of argument statements more than %d levels"
×
1846
                    ,(WORD)MAXNEST);
1847
                    return(-1);
×
1848
                }
1849
                        AC.argsumcheck[AC.arglevel] = NestingChecksum();
21✔
1850
                AC.argstack[AC.arglevel] = cbuf[AC.cbufnum].Pointer
21✔
1851
                                               - cbuf[AC.cbufnum].Buffer + 2;
21✔
1852
                        AC.arglevel++;
21✔
1853
                *w++ = cbuf[AC.cbufnum].numlhs;
21✔
1854
                        break;
21✔
1855
                case TYPENORM:
72✔
1856
                case TYPENORM4:
1857
                case TYPESPLITARG:
1858
                case TYPESPLITFIRSTARG:
1859
                case TYPESPLITLASTARG:
1860
                case TYPEFACTARG:
1861
                case TYPEARGTOEXTRASYMBOL:
1862
                *w++ = cbuf[AC.cbufnum].numlhs+1;
72✔
1863
                        break;
72✔
1864
    }
1865
        *w++ = par;
93✔
1866
        scale = w;
93✔
1867
        *w++ = 1;
93✔
1868
        *w++ = 0;
93✔
1869
        if ( *s == '^' ) {
93✔
1870
                s++; ParseSignedNumber(x,s)
×
1871
                while ( *s == ',' ) s++;
×
1872
                *scale = x;
×
1873
        }
1874
        if ( *s == '(' ) {
93✔
1875
                t = s+1; SKIPBRA3(s)        /* We did check the brackets already */
51✔
1876
                if ( par == TYPEARG ) {
24✔
1877
                        MesPrint("&Illegal () entry in argument statement");
×
1878
                        error = 1; s++; goto skipbracks;
×
1879
                }
1880
                else if ( par == TYPESPLITFIRSTARG ) {
24✔
1881
                        MesPrint("&Illegal () entry in splitfirstarg statement");
×
1882
                        error = 1; s++; goto skipbracks;
×
1883
                }
1884
                else if ( par == TYPESPLITLASTARG ) {
24✔
1885
                        MesPrint("&Illegal () entry in splitlastarg statement");
×
1886
                        error = 1; s++; goto skipbracks;
×
1887
                }
1888
                v = t;
1889
                while ( v < s ) {
51✔
1890
                        if ( *v == '?' ) {
27✔
1891
                                MesPrint("&Wildcarding not allowed in this type of statement");
×
1892
                                error = 1; break;
×
1893
                        }
1894
                        v++;
27✔
1895
                }
1896
                v = s++;
24✔
1897
                if ( *t == '(' && v[-1] == ')' ) {
24✔
1898
                        t++; v--;
×
1899
                        if ( par == TYPESPLITARG ) oldworkpointer[0] = TYPESPLITARG2;
×
1900
                        else if ( par == TYPEFACTARG ) oldworkpointer[0] = TYPEFACTARG2;
×
1901
                        else if ( par == TYPENORM4 ) oldworkpointer[0] = TYPENORM4;
×
1902
                        else if ( par == TYPENORM ) {
×
1903
                                if ( *t == '-' ) { oldworkpointer[0] = TYPENORM3; t++; }
×
1904
                                else             { oldworkpointer[0] = TYPENORM2; *scale = 0; }
×
1905
                        }
1906
                }
1907
                if ( error == 0 ) {
24✔
1908
                        CBUF *C = cbuf+AC.cbufnum;
24✔
1909
                        WORD oldnumrhs = C->numrhs, oldnumlhs = C->numlhs;
24✔
1910
                        WORD prototype[SUBEXPSIZE+40]; /* Up to 10 nested sums! */
24✔
1911
                        WORD *m, *mm;
24✔
1912
                        int i, retcode;
24✔
1913
                        LONG oldpointer = C->Pointer - C->Buffer;
24✔
1914
                        *v = 0;
24✔
1915
                        prototype[0] = SUBEXPRESSION;
24✔
1916
                        prototype[1] = SUBEXPSIZE;
24✔
1917
                        prototype[2] = C->numrhs+1;
24✔
1918
                        prototype[3] = 1;
24✔
1919
                        prototype[4] = AC.cbufnum;
24✔
1920
                        AT.WorkPointer += TYPEARGHEADSIZE+1;
24✔
1921
                        AddLHS(AC.cbufnum);
24✔
1922
                        if ( ( retcode = CompileAlgebra(t,LHSIDE,prototype) ) < 0 )
24✔
1923
                                error = 1;
1924
                        else {
1925
                                prototype[2] = retcode;
24✔
1926
                                ww = C->lhs[retcode];
24✔
1927
                                AC.lhdollarflag = 0;
24✔
1928
                                if ( *ww == 0 ) {
24✔
1929
                                        *w++ = -2; *w++ = 0;
18✔
1930
                                }
1931
                                else if ( ww[ww[0]] != 0 ) {
6✔
1932
                                        MesPrint("&There should be only one term between ()");
×
1933
                                        error = 1;
×
1934
                                }
1935
                                else if ( NewSort(BHEAD0) ) { if ( !error ) error = 1; }
6✔
1936
                                else if ( NewSort(BHEAD0) ) {
6✔
1937
                                        LowerSortLevel();
×
1938
                                        if ( !error ) error = 1;
×
1939
                                }
1940
                                else {
1941
                                        AN.RepPoint = AT.RepCount + 1;
6✔
1942
                                m = AT.WorkPointer;
6✔
1943
                                        mm = ww; i = *mm;
6✔
1944
                                        while ( --i >= 0 ) *m++ = *mm++;
30✔
1945
                                        mm = AT.WorkPointer; AT.WorkPointer = m;
6✔
1946
                                        AR.Cnumlhs = C->numlhs;
6✔
1947
                                        if ( Generator(BHEAD mm,C->numlhs) ) {
6✔
1948
                                                LowerSortLevel(); error = 1;
×
1949
                                        }
1950
                                        else if ( EndSort(BHEAD mm,0) < 0 ) {
6✔
1951
                                                error = 1;
×
1952
                                                AT.WorkPointer = mm;
×
1953
                                        }
1954
                                        else if ( *mm == 0 ) {
6✔
1955
                                                *w++ = -2; *w++ = 0;
×
1956
                                                AT.WorkPointer = mm;
×
1957
                                        }
1958
                                        else if ( mm[mm[0]] != 0 ) {
6✔
1959
                                                error = 1;
×
1960
                                                AT.WorkPointer = mm;
×
1961
                                        }
1962
                                        else {
1963
                                                AT.WorkPointer = mm;
6✔
1964
                                                m = mm+*mm;
6✔
1965
                                                if ( par == TYPEFACTARG ) {
6✔
1966
                                                        if ( *mm != ABS(m[-1])+1 ) {
6✔
1967
                                                                *mm -= ABS(m[-1]);        /* Strip coefficient */
×
1968
                                                        }
1969
                                                        mm[-1] = -*mm-1; w += *mm+1;
6✔
1970
                                                }
1971
                                                else {
1972
                                                        *mm -= ABS(m[-1]);        /* Strip coefficient */
×
1973
/*
1974
                                                        if ( *mm == 1 ) { *w++ = -2; *w++ = 0; }
1975
                                                        else
1976
*/
1977
                                                        { mm[-1] = -*mm-1; w += *mm+1; }
×
1978
                                                }
1979
                                                oldworkpointer[1] = w - oldworkpointer;
6✔
1980
                                        }
1981
                                        LowerSortLevel();
6✔
1982
                                }
1983
                                oldworkpointer[5] = AC.lhdollarflag;
24✔
1984
                        }
1985
                        *v = ')';
24✔
1986
                        C->numrhs = oldnumrhs;
24✔
1987
                        C->numlhs = oldnumlhs;
24✔
1988
                        C->Pointer = C->Buffer + oldpointer;
24✔
1989
                }
1990
        }
1991
skipbracks:
69✔
1992
        if ( *s == 0 ) { *w++ = 0; *w++ = 2; *w++ = 1; }
93✔
1993
        else {
1994
                do {
93✔
1995
                        if ( *s == ',' ) { s++; continue; }
93✔
1996
                        ww = w; *w++ = 0; w++;
75✔
1997
                        if ( FG.cTable[*s] > 1 && *s != '[' && *s != '{' ) {
75✔
1998
                                MesPrint("&Illegal parameters in statement");
×
1999
                                error = 1;
×
2000
                                break;
×
2001
                        }
2002
                        while ( FG.cTable[*s] == 0 || *s == '[' || *s == '{' ) {
153✔
2003
                                if ( *s == '{' ) {
78✔
2004
                                        name = s+1;
×
2005
                                        SKIPBRA2(s)
×
2006
                                        c = *s; *s = 0;
×
2007
                                        number = DoTempSet(name,s);
×
2008
                                        name--; *s++ = c; c = *s; *s = 0;
×
2009
                                        goto doset;
×
2010
                                }
2011
                                else {
2012
                                        name = s;
78✔
2013
                                        if ( ( s = SkipAName(s) ) == 0 ) {
78✔
2014
                                                MesPrint("&Illegal name '%s'",name);
×
2015
                                                return(1);
×
2016
                                        }
2017
                                        c = *s; *s = 0;
78✔
2018
                                        if ( ( type = GetName(AC.varnames,name,&number,WITHAUTO) ) == CSET ) {
78✔
2019
doset:                                        if ( Sets[number].type != CFUNCTION ) goto nofun;
3✔
2020
                                                *w++ = CSET; *w++ = number;
3✔
2021
                                        }
2022
                                        else if ( type == CFUNCTION ) {
75✔
2023
                                                *w++ = CFUNCTION; *w++ = number + FUNCTION;
75✔
2024
                                        }
2025
                                        else {
2026
nofun:                                        MesPrint("&%s is not a function or a set of functions"
×
2027
                                                ,name);
2028
                                                error = 1;
×
2029
                                        }
2030
                                }
2031
                                *s = c;
78✔
2032
                                while ( *s == ',' ) s++;
81✔
2033
                        }
2034
                        ww[1] = w - ww;
75✔
2035
                        ww = w; w++; zeroflag = 0;
75✔
2036
                        while ( FG.cTable[*s] == 1 ) {
75✔
2037
                                ParseNumber(x,s)
×
2038
                                if ( *s && *s != ',' ) {
×
2039
                                        MesPrint("&Illegal separator after number");
×
2040
                                        error = 1;
×
2041
                                        while ( *s && *s != ',' ) s++;
×
2042
                                }
2043
                                while ( *s == ',' ) s++;
×
2044
                                if ( x == 0 ) zeroflag = 1;
×
2045
                                if ( !zeroflag ) *w++ = (WORD)x;
×
2046
                        }
2047
                        *ww = w - ww;
75✔
2048
                } while ( *s );
93✔
2049
        }
2050
        oldworkpointer[1] = w - oldworkpointer;
93✔
2051
        if ( par == TYPEARG ) {  /* To make sure. The Pointer might move in the future */
93✔
2052
               AC.argstack[AC.arglevel-1] = cbuf[AC.cbufnum].Pointer
21✔
2053
                                               - cbuf[AC.cbufnum].Buffer + 2;
21✔
2054
        }
2055
        AddNtoL(oldworkpointer[1],oldworkpointer);
93✔
2056
        AT.WorkPointer = oldworkpointer;
93✔
2057
        return(error);
93✔
2058
}
2059

2060
/*
2061
          #] DoArgument : 
2062
          #[ CoArgument :
2063
*/
2064

2065
int CoArgument(UBYTE *s) { return(DoArgument(s,TYPEARG)); }
21✔
2066

2067
/*
2068
          #] CoArgument : 
2069
          #[ CoEndArgument :
2070
*/
2071

2072
int CoEndArgument(UBYTE *s)
21✔
2073
{
2074
        CBUF *C = cbuf+AC.cbufnum;
21✔
2075
        while ( *s == ',' ) s++;
21✔
2076
        if ( *s ) {
21✔
2077
                MesPrint("&Illegal syntax for EndArgument statement");
×
2078
                return(1);
×
2079
        }
2080
        if ( AC.arglevel <= 0 ) {
21✔
2081
                MesPrint("&EndArgument without corresponding Argument statement");
×
2082
                return(1);
×
2083
        }
2084
        AC.arglevel--;
21✔
2085
        cbuf[AC.cbufnum].Buffer[AC.argstack[AC.arglevel]] = C->numlhs;
21✔
2086
        if ( AC.argsumcheck[AC.arglevel] != NestingChecksum() ) {
21✔
2087
                MesNesting();
×
2088
                return(1);
×
2089
        }
2090
        return(0);
2091
}
2092

2093
/*
2094
          #] CoEndArgument : 
2095
          #[ CoInside :
2096
*/
2097

2098
int CoInside(UBYTE *s) { return(ExecInside(s)); }
3✔
2099

2100
/*
2101
          #] CoInside : 
2102
          #[ CoEndInside :
2103
*/
2104

2105
int CoEndInside(UBYTE *s)
3✔
2106
{
2107
        CBUF *C = cbuf+AC.cbufnum;
3✔
2108
        while ( *s == ',' ) s++;
3✔
2109
        if ( *s ) {
3✔
2110
                MesPrint("&Illegal syntax for EndInside statement");
×
2111
                return(1);
×
2112
        }
2113
        if ( AC.insidelevel <= 0 ) {
3✔
2114
                MesPrint("&EndInside without corresponding Inside statement");
×
2115
                return(1);
×
2116
        }
2117
        AC.insidelevel--;
3✔
2118
        cbuf[AC.cbufnum].Buffer[AC.insidestack[AC.insidelevel]] = C->numlhs;
3✔
2119
        if ( AC.insidesumcheck[AC.insidelevel] != NestingChecksum() ) {
3✔
2120
                MesNesting();
×
2121
                return(1);
×
2122
        }
2123
        return(0);
2124
}
2125

2126
/*
2127
          #] CoEndInside : 
2128
          #[ CoNormalize :
2129
*/
2130

2131
int CoNormalize(UBYTE *s) { return(DoArgument(s,TYPENORM)); }
9✔
2132

2133
/*
2134
          #] CoNormalize : 
2135
          #[ CoMakeInteger :
2136
*/
2137

2138
int CoMakeInteger(UBYTE *s) { return(DoArgument(s,TYPENORM4)); }
6✔
2139

2140
/*
2141
          #] CoMakeInteger : 
2142
          #[ CoSplitArg :
2143
*/
2144

2145
int CoSplitArg(UBYTE *s) { return(DoArgument(s,TYPESPLITARG)); }
×
2146

2147
/*
2148
          #] CoSplitArg : 
2149
          #[ CoSplitFirstArg :
2150
*/
2151

2152
int CoSplitFirstArg(UBYTE *s) { return(DoArgument(s,TYPESPLITFIRSTARG)); }
×
2153

2154
/*
2155
          #] CoSplitFirstArg : 
2156
          #[ CoSplitLastArg :
2157
*/
2158

2159
int CoSplitLastArg(UBYTE *s) { return(DoArgument(s,TYPESPLITLASTARG)); }
×
2160

2161
/*
2162
          #] CoSplitLastArg : 
2163
          #[ CoFactArg :
2164
*/
2165

2166
int CoFactArg(UBYTE *s) {
42✔
2167
        if ( ( AC.topolynomialflag & TOPOLYNOMIALFLAG ) != 0 ) {
42✔
2168
                MesPrint("&ToPolynomial statement and FactArg statement are not allowed in the same module");
×
2169
                return(1);
×
2170
        }
2171
        AC.topolynomialflag |= FACTARGFLAG;
42✔
2172
        return(DoArgument(s,TYPEFACTARG));
42✔
2173
}
2174

2175
/*
2176
          #] CoFactArg : 
2177
          #[ DoSymmetrize :
2178

2179
        Syntax:
2180
        Symmetrize Fun[:[number]] [Fields]      -> par = 0;
2181
        AntiSymmetrize Fun[:[number]] [Fields]  -> par = 1;
2182
        CycleSymmetrize Fun[:[number]] [Fields] -> par = 2;
2183
        RCycleSymmetrize Fun[:[number]] [Fields]-> par = 3;
2184
*/
2185

2186
int DoSymmetrize(UBYTE *s, int par)
3✔
2187
{
2188
        GETIDENTITY
2✔
2189
        int extra = 0, error = 0, err, fix, x, groupsize, num, i;
3✔
2190
        UBYTE *name, c;
3✔
2191
        WORD funnum, *w, *ww, type;
3✔
2192
        for(;;) {
3✔
2193
                name = s;
3✔
2194
                if ( ( s = SkipAName(s) ) == 0 ) {
3✔
2195
                        MesPrint("&Improper function name");
×
2196
                        return(1);
×
2197
                }
2198
                c = *s; *s = 0;
3✔
2199
                if ( c != ',' || ( FG.cTable[s[1]] != 0 && s[1] != '[' ) ) break;
3✔
2200
                if ( par <= 0 && StrICmp(name,(UBYTE *)"cyclic") == 0 ) extra = 2;
×
2201
                else if ( par <= 0 && StrICmp(name,(UBYTE *)"rcyclic") == 0 ) extra = 6;
×
2202
                else {
2203
                        MesPrint("&Illegal option: '%s'",name);
×
2204
                        error = 1;
×
2205
                }
2206
                *s++ = c;
×
2207
        }
2208
        if ( ( err = GetVar(name,&type,&funnum,CFUNCTION,WITHAUTO) ) == NAMENOTFOUND ) {
3✔
2209
                MesPrint("&Undefined function: %s",name);
×
2210
                AddFunction(name,0,0,0,0,0,-1,-1);
×
2211
                *s++ = c;
×
2212
                return(1);
×
2213
        }
2214
        funnum += FUNCTION;
3✔
2215
        if ( err == -1 ) error = 1;
3✔
2216
        *s = c;
3✔
2217
        if ( *s == ':' ) {
3✔
2218
                s++;
×
2219
                if ( *s == ',' || *s == '(' || *s == 0 ) fix = -1;
×
2220
                else if ( FG.cTable[*s] == 1 ) {
×
2221
                        ParseNumber(fix,s)
×
2222
                        if ( fix == 0 ) 
×
2223
                                Warning("Restriction to zero arguments removed");
×
2224
                }
2225
                else {
2226
                        MesPrint("&Illegal character after :");
×
2227
                        return(1);
×
2228
                }
2229
        }
2230
        else fix = 0;
2231
        w = AT.WorkPointer;
3✔
2232
        *w++ = TYPEOPERATION;
3✔
2233
        w++;
3✔
2234
        *w++ = SYMMETRIZE;
3✔
2235
        *w++ = par | extra;
3✔
2236
        *w++ = funnum;
3✔
2237
        *w++ = fix;
3✔
2238
/*
2239
        And now the argument lists. We have either ,#,#,... or (#,#,..,#),(#,...
2240
*/
2241
        w += 2; ww = w; groupsize = -1;
3✔
2242
        while ( *s == ',' ) s++;
3✔
2243
        while ( *s ) {
3✔
2244
                if ( *s == '(' ) {
×
2245
                        s++; num = 0;
×
2246
                        while ( *s && *s != ')' ) {
×
2247
                                if ( *s == ',' ) { s++; continue; }
×
2248
                                if ( FG.cTable[*s] != 1 ) goto illarg;
×
2249
                                ParseNumber(x,s)
×
2250
                                if ( x <= 0 || ( fix > 0 && x > fix ) ) goto illnum;
×
2251
                                num++;
×
2252
                                *w++ = x-1;
×
2253
                        }
2254
                        if ( *s == 0 ) {
×
2255
                                MesPrint("&Improper termination of statement");
×
2256
                                return(1);
×
2257
                        }
2258
                        if ( groupsize < 0 ) groupsize = num;
×
2259
                        else if ( groupsize != num ) goto group;
×
2260
                        s++;
×
2261
                }
2262
                else if ( FG.cTable[*s] == 1 ) {
×
2263
                        if ( groupsize < 0 ) groupsize = 1;
×
2264
                        else if ( groupsize != 1 ) {
×
2265
group:                        MesPrint("&All groups should have the same number of arguments");
×
2266
                                return(1);
×
2267
                        }
2268
                        ParseNumber(x,s)
×
2269
                        if ( x <= 0 || ( fix > 0 && x > fix ) ) {
×
2270
illnum:                        MesPrint("&Illegal argument number: %d",x);
×
2271
                                return(1);
×
2272
                        }
2273
                        *w++ = x-1;
×
2274
                }
2275
                else {
2276
illarg:                MesPrint("&Illegal argument");
×
2277
                        return(1);
×
2278
                }
2279
                while ( *s == ',' ) s++;
×
2280
        }
2281
/*
2282
        Now the completion
2283
*/
2284
        if ( w == ww ) {
3✔
2285
                ww[-1] = 1;
3✔
2286
                ww[-2] = 0;
3✔
2287
                if ( fix > 0 ) {
3✔
2288
                        for ( i = 0; i < fix; i++ ) *w++ = i;
×
2289
                        ww[-2] = fix; /* Bugfix 31-oct-2001. Reported by York Schroeder */
×
2290
                }
2291
        }
2292
        else {
2293
                ww[-1] = groupsize;
×
2294
                ww[-2] = (w-ww)/groupsize;
×
2295
        }
2296
        AT.WorkPointer[1] = w - AT.WorkPointer;
3✔
2297
        AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
3✔
2298
        return(error);
3✔
2299
}
2300

2301
/*
2302
          #] DoSymmetrize : 
2303
          #[ CoSymmetrize :
2304
*/
2305

2306
int CoSymmetrize(UBYTE *s) { return(DoSymmetrize(s,SYMMETRIC)); }
3✔
2307

2308
/*
2309
          #] CoSymmetrize : 
2310
          #[ CoAntiSymmetrize :
2311
*/
2312

2313
int CoAntiSymmetrize(UBYTE *s) { return(DoSymmetrize(s,ANTISYMMETRIC)); }
×
2314

2315
/*
2316
          #] CoAntiSymmetrize : 
2317
          #[ CoCycleSymmetrize :
2318
*/
2319

2320
int CoCycleSymmetrize(UBYTE *s) { return(DoSymmetrize(s,CYCLESYMMETRIC)); }
×
2321

2322
/*
2323
          #] CoCycleSymmetrize : 
2324
          #[ CoRCycleSymmetrize :
2325
*/
2326

2327
int CoRCycleSymmetrize(UBYTE *s) { return(DoSymmetrize(s,RCYCLESYMMETRIC)); }
×
2328

2329
/*
2330
          #] CoRCycleSymmetrize : 
2331
          #[ CoWrite :
2332
*/
2333

2334
int CoWrite(UBYTE *s)
×
2335
{
2336
        GETIDENTITY
2337
        UBYTE *option;
×
2338
        KEYWORDV *key;
×
2339
        option = s;
×
2340
        if ( ( ( s = SkipAName(s) ) == 0 ) || *s != 0 ) {
×
2341
                MesPrint("&Proper use of write statement is: write option");
×
2342
                return(1);
×
2343
        }
2344
        key = (KEYWORDV *)FindInKeyWord(option,(KEYWORD *)writeoptions,sizeof(writeoptions)/sizeof(KEYWORD));
×
2345
        if ( key == 0 ) {
×
2346
                MesPrint("&Unrecognized option in write statement");
×
2347
                return(1);
×
2348
        }
2349
        *key->var = key->type;
×
2350
        AR.SortType = AC.SortType;
×
2351
        return(0);
×
2352
}
2353

2354
/*
2355
          #] CoWrite : 
2356
          #[ CoNWrite :
2357
*/
2358

2359
int CoNWrite(UBYTE *s)
×
2360
{
2361
        GETIDENTITY
2362
        UBYTE *option;
×
2363
        KEYWORDV *key;
×
2364
        option = s;
×
2365
        if ( ( ( s = SkipAName(s) ) == 0 ) || *s != 0 ) {
×
2366
                MesPrint("&Proper use of nwrite statement is: nwrite option");
×
2367
                return(1);
×
2368
        }
2369
        key = (KEYWORDV *)FindInKeyWord(option,(KEYWORD *)writeoptions,sizeof(writeoptions)/sizeof(KEYWORD));
×
2370
        if ( key == 0 ) {
×
2371
                MesPrint("&Unrecognized option in nwrite statement");
×
2372
                return(1);
×
2373
        }
2374
        *key->var = key->flags;
×
2375
        AR.SortType = AC.SortType;
×
2376
        return(0);
×
2377
}
2378

2379
/*
2380
          #] CoNWrite : 
2381
          #[ CoRatio :
2382
*/
2383

2384
static WORD ratstring[6] = { TYPEOPERATION, 6, RATIO, 0, 0, 0 };
2385

2386
int CoRatio(UBYTE *s)
×
2387
{
2388
        UBYTE c, *t;
×
2389
        int i, type, error = 0;
×
2390
        WORD numsym, *rs;
×
2391
        rs = ratstring+3;
×
2392
        for ( i = 0; i < 3; i++ ) {
×
2393
                if ( *s ) {
×
2394
                        t = s;
×
2395
                        s = SkipAName(s);
×
2396
                        c = *s; *s = 0;
×
2397
                        if ( ( ( type = GetName(AC.varnames,t,&numsym,WITHAUTO) ) != CSYMBOL )
×
2398
                        && type != CDUBIOUS ) {
×
2399
                                MesPrint("&%s is not a symbol",t);
×
2400
                                error = 4;
×
2401
                                if ( type < 0 ) numsym = AddSymbol(t,-MAXPOWER,MAXPOWER,0,0);
×
2402
                        }
2403
                        *s = c;
×
2404
                        if ( *s == ',' ) s++;
×
2405
                }
2406
                else {
2407
                        if ( error == 0 )
×
2408
                                MesPrint("&The ratio statement needs three symbols for its arguments");
×
2409
                        error++;
×
2410
                        numsym = 0;
×
2411
                }
2412
                *rs++ = numsym;
×
2413
        }
2414
        AddNtoL(6,ratstring);
×
2415
        return(error);
×
2416
}
2417

2418
/*
2419
          #] CoRatio : 
2420
          #[ CoRedefine :
2421

2422
        We have a preprocessor variable and a (new) value for it.
2423
        This value is inside a string that must be stored.
2424
*/
2425

2426
int CoRedefine(UBYTE *s)
18✔
2427
{
2428
        UBYTE *name, c, *args = 0;
18✔
2429
        int numprevar;
18✔
2430
        WORD code[2];
18✔
2431
        name = s;
18✔
2432
        if ( FG.cTable[*s] || ( s = SkipAName(s) ) == 0 || s[-1] == '_' ) {
18✔
2433
                MesPrint("&Illegal name for preprocessor variable in redefine statement");
×
2434
                return(1);
×
2435
        }
2436
        c = *s; *s = 0;
18✔
2437
        for ( numprevar = NumPre-1; numprevar >= 0; numprevar-- ) {
18✔
2438
                if ( StrCmp(name,PreVar[numprevar].name) == 0 ) break;
18✔
2439
        }
2440
        if ( numprevar < 0 ) {
18✔
2441
                MesPrint("&There is no preprocessor variable with the name `%s'",name);
×
2442
                *s = c;
×
2443
                return(1);
×
2444
        }
2445
        *s = c;
18✔
2446
/*
2447
        The next code worries about arguments.
2448
        It is a direct copy of the code in TheDefine in the preprocessor.
2449
*/
2450
        if ( *s == '(' ) {        /* arguments. scan for correctness */
18✔
2451
                s++; args = s;
×
2452
                for (;;) {
×
2453
                        if ( chartype[*s] != 0 ) goto illarg;
×
2454
                        s++;
×
2455
                        while ( chartype[*s] <= 1 ) s++;
×
2456
                        while ( *s == ' ' || *s == '\t' ) s++;
×
2457
                        if ( *s == ')' ) break;
×
2458
                        if ( *s != ',' ) goto illargs;
×
2459
                        s++;
×
2460
                        while ( *s == ' ' || *s == '\t' ) s++;
×
2461
                }
2462
                *s++ = 0;
×
2463
                while ( *s == ' ' || *s == '\t' ) s++;
×
2464
        }
2465
        while ( *s == ',' ) s++;
36✔
2466
        if ( *s != '"' ) {
18✔
2467
encl:        MesPrint("&Value for %s should be enclosed in double quotes"
×
2468
                ,PreVar[numprevar].name);
×
2469
                return(1);
×
2470
        }
2471
        s++; name = s; /* actually name points to the new string */
18✔
2472
        while ( *s && *s != '"' ) { if ( *s == '\\' ) s++; s++; }
36✔
2473
        if ( *s != '"' ) goto encl;
18✔
2474
        *s = 0;
18✔
2475
        code[0] = TYPEREDEFPRE; code[1] = numprevar;
18✔
2476
/*
2477
        AddComString(2,code,name,0);
2478
*/
2479
        Add2ComStrings(2,code,name,args);
18✔
2480
        *s = '"';
18✔
2481
#ifdef PARALLELCODE
2482
/*
2483
        Now we prepare the input numbering system for pthreads.
2484
        We need a list of preprocessor variables that are redefined in this
2485
        module.
2486
*/
2487
        {
2488
          int j;
12✔
2489
          WORD *newpf;
12✔
2490
          LONG *newin;
12✔
2491
          for ( j = 0; j < AC.numpfirstnum; j++ ) {
12✔
2492
                if ( numprevar == AC.pfirstnum[j] ) break;
2493
          }
2494
          if ( j >= AC.numpfirstnum ) {  /* add to list */
12✔
2495
                if ( j >= AC.sizepfirstnum ) {
12✔
2496
                        if ( AC.sizepfirstnum <= 0 ) { AC.sizepfirstnum = 10; }
6✔
2497
                        else { AC.sizepfirstnum = 2 * AC.sizepfirstnum; }
2498
                        newin = (LONG *)Malloc1(AC.sizepfirstnum*(sizeof(WORD)+sizeof(LONG)),"AC.pfirstnum");
6✔
2499
                        newpf = (WORD *)(newin+AC.sizepfirstnum);
6✔
2500
                        for ( j = 0; j < AC.numpfirstnum; j++ ) {
6✔
2501
                                newpf[j] = AC.pfirstnum[j];
2502
                                newin[j] = AC.inputnumbers[j];
2503
                        }
2504
                        if ( AC.inputnumbers ) M_free(AC.inputnumbers,"AC.pfirstnum");
6✔
2505
                        AC.inputnumbers = newin;
6✔
2506
                        AC.pfirstnum = newpf;
6✔
2507
                }
2508
                AC.pfirstnum[AC.numpfirstnum] = numprevar;
12✔
2509
                AC.inputnumbers[AC.numpfirstnum] = -1;
12✔
2510
                AC.numpfirstnum++;
12✔
2511
          }
2512
        }
2513
#endif
2514
        return(0);
6✔
2515
illarg:;
×
2516
        MesPrint("&Illegally formed name in argument of redefine statement");
×
2517
        return(1);
×
2518
illargs:;
×
2519
        MesPrint("&Illegally formed arguments in redefine statement");
×
2520
        return(1);
×
2521
}
2522

2523
/*
2524
          #] CoRedefine : 
2525
          #[ CoRenumber :
2526

2527
        renumber    or renumber,0     Only exchanges (n^2 until no improvement)
2528
        renumber,1                    All permutations (could be slow)
2529
*/
2530

2531
int CoRenumber(UBYTE *s)
×
2532
{
2533
        int x;
×
2534
        UBYTE *inp;
×
2535
        while ( *s == ',' ) s++;
×
2536
        inp = s;
×
2537
        if ( *s == 0 ) { x = 0; }
×
2538
        else ParseNumber(x,s)
×
2539
        if ( *s == 0 && x >= 0 && x <= 1 ) {
×
2540
                Add3Com(TYPERENUMBER,x);
×
2541
                return(0);
×
2542
        }
2543
        MesPrint("&Illegal argument in Renumber statement: '%s'",inp);
×
2544
        return(1);
×
2545
}
2546

2547
/*
2548
          #] CoRenumber : 
2549
          #[ CoSum :
2550
*/
2551

2552
int CoSum(UBYTE *s)
48✔
2553
{
2554
        CBUF *C = cbuf+AC.cbufnum;
48✔
2555
        UBYTE *ss = 0, c, *t;
48✔
2556
        int error = 0, i = 0, type, x;
48✔
2557
        WORD numindex,number;
48✔
2558
        while ( *s ) {
75✔
2559
                t = s;
48✔
2560
                if ( *s == '$' ) {
48✔
2561
                        t++; s++; while ( FG.cTable[*s] < 2 ) s++;
×
2562
                        c = *s; *s = 0;
×
2563
                        if ( ( number = GetDollar(t) ) < 0 ) {
×
2564
                                MesPrint("&Undefined variable $%s",t);
×
2565
                                if ( !error ) error = 1;
×
2566
                                number = AddDollar(t,0,0,0);
×
2567
                        }
2568
                        numindex = -number;
×
2569
                }
2570
                else {
2571
                        if ( ( s = SkipAName(s) ) == 0 ) return(1);
48✔
2572
                        c = *s; *s = 0;
48✔
2573
                        if ( ( ( type = GetOName(AC.exprnames,t,&numindex,NOAUTO) ) != NAMENOTFOUND )
48✔
2574
                        || ( ( type = GetOName(AC.varnames,t,&numindex,WITHAUTO) ) != CINDEX ) ) {
48✔
2575
                                if ( type != NAMENOTFOUND ) error = NameConflict(type,t);
×
2576
                                else {
2577
                                        MesPrint("&%s should have been declared as an index",t);
×
2578
                                        error = 1;
×
2579
                                        numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
×
2580
                                }
2581
                        }
2582
                }
2583
                Add3Com(TYPESUM,numindex);
48✔
2584
                i = 3; *s = c;
48✔
2585
                if ( *s == 0 ) break;
48✔
2586
                if ( *s != ',' ) {
33✔
2587
                        MesPrint("&Illegal separator between objects in sum statement.");
×
2588
                        return(1);
×
2589
                }
2590
                s++;
33✔
2591
                if ( FG.cTable[*s] == 0 || *s == '[' || *s == '$' ) {
33✔
2592
                        while ( FG.cTable[*s] == 0 || *s == '[' || *s == '$' ) {
12✔
2593
                                if ( *s == '$' ) {
12✔
2594
                                        s++;
×
2595
                                        ss = t = s;
×
2596
                                        while ( FG.cTable[*s] < 2 ) s++;
×
2597
                                        c = *s; *s = 0;
×
2598
                                        if ( ( number = GetDollar(t) ) < 0 ) {
×
2599
                                                MesPrint("&Undefined variable $%s",t);
×
2600
                                                if ( !error ) error = 1;
×
2601
                                                number = AddDollar(t,0,0,0);
×
2602
                                        }
2603
                                        numindex = -number;
×
2604
                                }
2605
                                else {
2606
                                        ss = t = s;
12✔
2607
                                        if ( ( s = SkipAName(s) ) == 0 ) return(1);
12✔
2608
                                        c = *s; *s = 0;
12✔
2609
                                        if ( ( ( type = GetOName(AC.exprnames,t,&numindex,NOAUTO) ) != NAMENOTFOUND )
12✔
2610
                                        || ( ( type = GetOName(AC.varnames,t,&numindex,WITHAUTO) ) != CINDEX ) ) {
12✔
2611
                                                if ( type != NAMENOTFOUND ) error = NameConflict(type,t);
×
2612
                                                else {
2613
                                                        MesPrint("&%s should have been declared as an index",t);
×
2614
                                                        error = 1;
×
2615
                                                        numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
×
2616
                                                }
2617
                                        }
2618
                                }
2619
                                AddToCB(C,numindex)
12✔
2620
                                i++;
12✔
2621
                                C->Pointer[-i+1] = i;
12✔
2622
                                *s = c;
12✔
2623
                                if ( *s == 0 ) return(error);
12✔
2624
                                if ( *s != ',' ) {
6✔
2625
                                        MesPrint("&Illegal separator between objects in sum statement.");
×
2626
                                        return(1);
×
2627
                                }
2628
                                s++;
6✔
2629
                        }
2630
                        if ( FG.cTable[*s] == 1 ) {
×
2631
                                C->Pointer[-i+1]--; C->Pointer--; s = ss;
×
2632
                        }
2633
                }
2634
                else if ( FG.cTable[*s] == 1 ) {
27✔
2635
                        while ( FG.cTable[*s] == 1 ) {
81✔
2636
                                t = s;
81✔
2637
                                x = *s++ - '0';
81✔
2638
                                while( FG.cTable[*s] == 1 ) x = 10*x + *s++ - '0';
81✔
2639
                                if ( *s && *s != ',' ) {
81✔
2640
                                        MesPrint("&%s is not a legal fixed index",t);
×
2641
                                        return(1);
×
2642
                                }
2643
                                else if ( x >= AM.OffsetIndex ) {
81✔
2644
                                        MesPrint("&%d is too large to be a fixed index",x);
×
2645
                                        error = 1;
×
2646
                                }
2647
                                else {
2648
                                        AddToCB(C,x)
81✔
2649
                                        i++;
81✔
2650
                                        C->Pointer[-i] = TYPESUMFIX;
81✔
2651
                                        C->Pointer[-i+1] = i;
81✔
2652
                                }
2653
                                if ( *s == 0 ) break;
81✔
2654
                                s++;
54✔
2655
                        }
2656
                }
2657
                else {
2658
                        MesPrint("&Illegal object in sum statement");
×
2659
                        error = 1;
×
2660
                }
2661
        }
2662
        return(error);
2663
}
2664

2665
/*
2666
          #] CoSum : 
2667
          #[ CoToTensor :
2668
*/
2669

2670
static WORD cttarray[7] = { TYPEOPERATION,7,TENVEC,0,0,1,0 };
2671

2672
int CoToTensor(UBYTE *s)
57✔
2673
{
2674
        UBYTE c, *t;
57✔
2675
        int type, j, nargs, error = 0;
57✔
2676
        WORD number, dol[2] = { 0, 0 };
57✔
2677
        cttarray[1] = 6;  /* length */
57✔
2678
        cttarray[3] = 0;  /* tensor */
57✔
2679
        cttarray[4] = 0;  /* vector */
57✔
2680
        cttarray[5] = 1;  /* option flags */
57✔
2681
/*        cttarray[6] = 0;     set veto */
2682
/*
2683
        Count the number of the arguments. The validity of them is not checked here.
2684
*/
2685
        nargs = 0;
57✔
2686
        t = s;
57✔
2687
        for (;;) {
156✔
2688
                while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
312✔
2689
                if ( *s == 0 ) break;
2690
                if ( *s == '!' ) {
2691
                        s++;
15✔
2692
                        if ( *s == '{' ) {
15✔
2693
                                SKIPBRA2(s)
27✔
2694
                                s++;
6✔
2695
                        } else {
2696
                                if ( ( s = SkipAName(s) ) == 0 ) goto syntax_error;
9✔
2697
                        }
2698
                } else {
2699
                        if ( ( s = SkipAName(s) ) == 0 ) goto syntax_error;
141✔
2700
                }
2701
                nargs++;
156✔
2702
        }
2703
        if ( nargs < 2 ) goto not_enough_arguments;
57✔
2704
        s = t;
2705
/*
2706
        Parse options, which are given as the arguments except the last two.
2707
*/
2708
        for ( j = 2; j < nargs; j++ ) {
99✔
2709
                while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
54✔
2710
                if ( *s == '!' ) {
42✔
2711
/*
2712
                        Handle !set or !{vector,...}. Note: If two or more sets are
2713
                        specified, then only the last one is used.
2714
*/
2715
                        s++;
15✔
2716
                        cttarray[1] = 7;
15✔
2717
                        cttarray[5] |= 8;
15✔
2718
                        if ( FG.cTable[*s] == 0 || *s == '[' || *s == '_' ) {
15✔
2719
                                t = s;
9✔
2720
                                if ( ( s = SkipAName(s) ) == 0 ) goto syntax_error;
9✔
2721
                                c = *s; *s = 0;
9✔
2722
                                type = GetName(AC.varnames,t,&number,WITHAUTO);
9✔
2723
                                if ( type == CVECTOR ) {
9✔
2724
/*
2725
                                        As written in the manual, "!p" (without "{}") should work.
2726
*/
2727
                                        cttarray[6] = DoTempSet(t,s);
3✔
2728
                                        *s = c;
3✔
2729
                                        goto check_tempset;
3✔
2730
                                }
2731
                                else if ( type != CSET ) {
6✔
2732
                                        MesPrint("&%s is not the name of a set or a vector",t);
×
2733
                                        error = 1;
×
2734
                                }
2735
                                *s = c;
6✔
2736
                                cttarray[6] = number;
6✔
2737
                        }
2738
                        else if ( *s == '{' ) {
6✔
2739
                                t = ++s; SKIPBRA2(s) *s = 0;
21✔
2740
                                cttarray[6] = DoTempSet(t,s);
6✔
2741
                                *s++ = '}';
6✔
2742
check_tempset:
9✔
2743
                                if ( cttarray[6] < 0 ) {
9✔
2744
                                        error = 1;
×
2745
                                }
2746
                                if ( AC.wildflag ) {
9✔
2747
                                        MesPrint("&Improper use of wildcard(s) in set specification");
×
2748
                                        error = 1;
×
2749
                                }
2750
                        }
2751
                } else {
2752
/*
2753
                        Other options.
2754
*/
2755
                        t = s;
27✔
2756
                        if ( ( s = SkipAName(s) ) == 0 ) goto syntax_error;
27✔
2757
                        c = *s; *s = 0;
27✔
2758
                        if ( StrICmp(t,(UBYTE *)"nosquare") == 0 ) cttarray[5] |= 2;
27✔
2759
                        else if ( StrICmp(t,(UBYTE *)"functions") == 0 ) cttarray[5] |= 4;
15✔
2760
                        else {
2761
                                MesPrint("&Unrecognized option in ToTensor statement: '%s'",t);
×
2762
                                *s = c;
×
2763
                                return(1);
×
2764
                        }
2765
                        *s = c;
27✔
2766
                }
2767
        }
2768
/*
2769
        Now parse a vector and a tensor. The ordering doesn't matter.
2770
*/
2771
        for ( j = 0; j < 2; j++ ) {
171✔
2772
                while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
201✔
2773
                t = s;
114✔
2774
                if ( ( s = SkipAName(s) ) == 0 ) goto syntax_error;
114✔
2775
                c = *s; *s = 0;
114✔
2776
                if ( t[0] == '$' ) {
114✔
2777
                        dol[j] = GetDollar(t+1);
24✔
2778
                        if ( dol[j] < 0 ) dol[j] = AddDollar(t+1,DOLUNDEFINED,0,0);
24✔
2779
                } else {
2780
                        type = GetName(AC.varnames,t,&number,WITHAUTO);
90✔
2781
                        if ( type == CVECTOR ) {
90✔
2782
                                cttarray[4] = number + AM.OffsetVector;
45✔
2783
                        }
2784
                        else if ( type == CFUNCTION && ( functions[number].spec > 0 ) ) {
45✔
2785
                                cttarray[3] = number + FUNCTION;
45✔
2786
                        }
2787
                        else {
2788
                                MesPrint("&%s is not a vector or a tensor",t);
×
2789
                                error = 1;
×
2790
                        }
2791
                }
2792
                *s = c;
114✔
2793
        }
2794
        if ( cttarray[3] == 0 || cttarray[4] == 0 ) {
57✔
2795
                if ( dol[0] == 0 && dol[1] == 0 ) {
18✔
2796
                        goto not_enough_arguments;
×
2797
                }
2798
                else if ( cttarray[3] ) {
18✔
2799
                        if ( dol[1] )        cttarray[4] = dol[1];
6✔
2800
                        else if ( dol[0] ) { cttarray[4] = dol[0]; }
3✔
2801
                        else {
2802
                                goto not_enough_arguments;
×
2803
                        }
2804
                }
2805
                else if ( cttarray[4] ) {
12✔
2806
                        if ( dol[1] )    { cttarray[3] = -dol[1]; }
6✔
2807
                        else if ( dol[0] ) cttarray[3] = -dol[0];
3✔
2808
                        else {
2809
                                goto not_enough_arguments;
×
2810
                        }
2811
                }
2812
                else {
2813
                        if ( dol[0] == 0 || dol[1] == 0 ) {
6✔
2814
                                goto not_enough_arguments;
×
2815
                        }
2816
                        else {
2817
                                cttarray[3] = -dol[0]; cttarray[4] = dol[1];
6✔
2818
                        }
2819
                }
2820
        }
2821
        AddNtoL(cttarray[1],cttarray);
57✔
2822
        return(error);
57✔
2823

2824
syntax_error:
×
2825
        MesPrint("&Syntax error in ToTensor statement");
×
2826
        return(1);
×
2827

2828
not_enough_arguments:
×
2829
        MesPrint("&ToTensor statement needs a vector and a tensor");
×
2830
        return(1);
×
2831
}
2832

2833
/*
2834
          #] CoToTensor : 
2835
          #[ CoToVector :
2836
*/
2837

2838
static WORD ctvarray[6] = { TYPEOPERATION,6,TENVEC,0,0,0 };
2839

2840
int CoToVector(UBYTE *s)
×
2841
{
2842
        UBYTE *t, c;
×
2843
        int j, type, error = 0;
×
2844
        WORD number, dol[2];
×
2845
        dol[0] = dol[1] = 0;
×
2846
        ctvarray[3] = ctvarray[4] = ctvarray[5] = 0;
×
2847
        for ( j = 0; j < 2; j++ ) {
×
2848
                t = s;
×
2849
                if ( ( s = SkipAName(s) ) == 0 ) {
×
2850
proper:                MesPrint("&Arguments of ToVector statement should be a vector and a tensor");
×
2851
                        return(1);
×
2852
                }
2853
                c = *s; *s = 0;
×
2854
                if ( *t == '$' ) {
×
2855
                        dol[j] = GetDollar(t+1);
×
2856
                        if ( dol[j] < 0 ) dol[j] = AddDollar(t+1,DOLUNDEFINED,0,0);
×
2857
                }
2858
                else if ( ( type = GetName(AC.varnames,t,&number,WITHAUTO) ) == CVECTOR )
×
2859
                        ctvarray[4] = number + AM.OffsetVector;
×
2860
                else if ( type == CFUNCTION && ( functions[number].spec > 0 ) )
×
2861
                        ctvarray[3] = number+FUNCTION;
×
2862
                else {
2863
                        MesPrint("&%s is not a vector or a tensor",t);
×
2864
                        error = 1;
×
2865
                }
2866
                *s = c; if ( *s && *s != ',' ) goto proper;
×
2867
                if ( *s ) s++;
×
2868
        }
2869
        if ( *s != 0 ) goto proper;
×
2870
        if ( ctvarray[3] == 0 || ctvarray[4] == 0 ) {
×
2871
                 if ( dol[0] == 0 && dol[1] == 0 ) {
×
2872
                        MesPrint("&ToVector statement needs a vector and a tensor");
×
2873
                        error = 1;
×
2874
                }
2875
                else if ( ctvarray[3] ) {
×
2876
                        if ( dol[1] )      ctvarray[4] = dol[1];
×
2877
                        else if ( dol[0] ) ctvarray[4] = dol[0];
×
2878
                        else {
2879
                                MesPrint("&ToVector statement needs a vector and a tensor");
×
2880
                                error = 1;
×
2881
                        }
2882
                }
2883
                else if ( ctvarray[4] ) {
×
2884
                        if ( dol[1] )      ctvarray[3] = -dol[1];
×
2885
                        else if ( dol[0] ) ctvarray[3] = -dol[0];
×
2886
                        else {
2887
                                MesPrint("&ToVector statement needs a vector and a tensor");
×
2888
                                error = 1;
×
2889
                        }
2890
                }
2891
                else {
2892
                        if ( dol[0] == 0 || dol[1] == 0 ) {
×
2893
                                MesPrint("&ToVector statement needs a vector and a tensor");
×
2894
                                error = 1;
×
2895
                        }
2896
                        else {
2897
                                ctvarray[3] = -dol[0]; ctvarray[4] = dol[1];
×
2898
                        }
2899
                }
2900
        }
2901
        AddNtoL(6,ctvarray);
×
2902
        return(error);
×
2903
}
2904

2905
/*
2906
          #] CoToVector : 
2907
          #[ CoTrace4 :
2908
*/
2909

2910
int CoTrace4(UBYTE *s)
3✔
2911
{
2912
        int error = 0, type, option = CHISHOLM;
3✔
2913
        UBYTE *t, c;
3✔
2914
        WORD numindex, one = 1;
3✔
2915
        KEYWORD *key;
3✔
2916
        for (;;) {
3✔
2917
                t = s;
3✔
2918
                if ( FG.cTable[*s] == 1 ) break;
3✔
2919
                if ( ( s = SkipAName(s) ) == 0 ) {
×
2920
proper:                MesPrint("&Proper syntax for Trace4 is 'Trace4[,options],index;'");
×
2921
                        return(1);
×
2922
                }
2923
                if ( *s == 0 ) break;
×
2924
                c = *s; *s = 0;
×
2925
                if ( ( key = FindKeyWord(t,trace4options,
×
2926
                        sizeof(trace4options)/sizeof(KEYWORD)) ) == 0 ) break;
2927
                else {
2928
                        option |=  key->type;
×
2929
                        option &= ~key->flags;
×
2930
                }
2931
                if ( ( *s++ = c ) != ',' ) {
×
2932
                        MesPrint("&Illegal separator in Trace4 statement");
×
2933
                        return(1);
×
2934
                }
2935
                if ( *s == 0 ) goto proper;
×
2936
        }
2937
        s = t;
3✔
2938
        if ( FG.cTable[*s] == 1 ) {
3✔
2939
retry:
3✔
2940
                ParseNumber(numindex,s)
6✔
2941
                if ( *s != 0 ) {
3✔
2942
                        MesPrint("&Last argument of Trace4 should be an index");
×
2943
                        return(1);
×
2944
                }
2945
                if ( numindex >= AM.OffsetIndex ) {
3✔
2946
                        MesPrint("&fixed index >= %d. Change value of OffsetIndex in setup file"
×
2947
                        ,AM.OffsetIndex);
2948
                        return(1);
×
2949
                }
2950
        }
2951
        else if ( *s == '$' ) {
×
2952
                if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
×
2953
                        numindex = -numindex;
×
2954
                else {
2955
                        MesPrint("&%s is undefined",s);
×
2956
                        numindex = AddDollar(s+1,DOLINDEX,&one,1);
×
2957
                        return(1);
×
2958
                }
2959
tests:        s = SkipAName(s);
×
2960
                if ( *s != 0 ) {
×
2961
                        MesPrint("&Trace4 should have a single index or $variable for its argument");
×
2962
                        return(1);
×
2963
                }
2964
        }
2965
        else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
×
2966
                numindex += AM.OffsetIndex;
×
2967
                goto tests;
×
2968
        }
2969
        else if ( type != -1 ) {
×
2970
                if ( type != CDUBIOUS ) {
×
2971
                        if ( ( FG.cTable[*s] != 0 ) && ( *s != '[' ) ) {
×
2972
                                if ( *s == '+' && FG.cTable[s[1]] == 1 ) { s++; goto retry; }
×
2973
                                goto proper;
×
2974
                        }
2975
                        NameConflict(type,s);
×
2976
                        type = MakeDubious(AC.varnames,s,&numindex);
×
2977
                }
2978
                return(1);
×
2979
        }
2980
        else {
2981
                MesPrint("&%s is not an index",s);
×
2982
                numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
×
2983
                return(1);
×
2984
        }
2985
        if ( error ) return(error);
3✔
2986
        if ( ( option & CHISHOLM ) != 0 )
3✔
2987
                Add4Com(TYPECHISHOLM,numindex,(option & ALSOREVERSE));
3✔
2988
        Add5Com(TYPEOPERATION,TAKETRACE,4 + (option & NOTRICK),numindex);
3✔
2989
        return(0);
3✔
2990
}
2991

2992
/*
2993
          #] CoTrace4 : 
2994
          #[ CoTraceN :
2995
*/
2996

2997
int CoTraceN(UBYTE *s)
6✔
2998
{
2999
        WORD numindex, one = 1;
6✔
3000
        int type;
6✔
3001
        if ( FG.cTable[*s] == 1 ) {
6✔
3002
retry:
6✔
3003
                ParseNumber(numindex,s)
12✔
3004
                if ( *s != 0 ) {
6✔
3005
proper:                MesPrint("&TraceN should have a single index for its argument");
×
3006
                        return(1);
×
3007
                }
3008
                if ( numindex >= AM.OffsetIndex ) {
6✔
3009
                        MesPrint("&fixed index >= %d. Change value of OffsetIndex in setup file"
×
3010
                        ,AM.OffsetIndex);
3011
                        return(1);
×
3012
                }
3013
        }
3014
        else if ( *s == '$' ) {
×
3015
                if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
×
3016
                        numindex = -numindex;
×
3017
                else {
3018
                        MesPrint("&%s is undefined",s);
×
3019
                        numindex = AddDollar(s+1,DOLINDEX,&one,1);
×
3020
                        return(1);
×
3021
                }
3022
tests:        s = SkipAName(s);
×
3023
                if ( *s != 0 ) {
×
3024
                        MesPrint("&TraceN should have a single index or $variable for its argument");
×
3025
                        return(1);
×
3026
                }
3027
        }
3028
        else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
×
3029
                numindex += AM.OffsetIndex;
×
3030
                goto tests;
×
3031
        }
3032
        else if ( type != -1 ) {
×
3033
                if ( type != CDUBIOUS ) {
×
3034
                        if ( ( FG.cTable[*s] != 0 ) && ( *s != '[' ) ) {
×
3035
                                if ( *s == '+' && FG.cTable[s[1]] == 1 ) { s++; goto retry; }
×
3036
                                goto proper;
×
3037
                        }
3038
                        NameConflict(type,s);
×
3039
                        type = MakeDubious(AC.varnames,s,&numindex);
×
3040
                }
3041
                return(1);
×
3042
        }
3043
        else {
3044
                MesPrint("&%s is not an index",s);
×
3045
                numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
×
3046
                return(1);
×
3047
        }
3048
        Add5Com(TYPEOPERATION,TAKETRACE,0,numindex);
6✔
3049
        return(0);
6✔
3050
}
3051

3052
/*
3053
          #] CoTraceN : 
3054
          #[ CoChisholm :
3055
*/
3056

3057
int CoChisholm(UBYTE *s)
×
3058
{
3059
        int error = 0, type, option = CHISHOLM;
×
3060
        UBYTE *t, c;
×
3061
        WORD numindex, one = 1;
×
3062
        KEYWORD *key;
×
3063
        for (;;) {
×
3064
                t = s;
×
3065
                if ( FG.cTable[*s] == 1 ) break;
×
3066
                if ( ( s = SkipAName(s) ) == 0 ) {
×
3067
proper:                MesPrint("&Proper syntax for Chisholm is 'Chisholm[,options],index;'");
×
3068
                        return(1);
×
3069
                }
3070
                if ( *s == 0 ) break;
×
3071
                c = *s; *s = 0;
×
3072
                if ( ( key = FindKeyWord(t,chisoptions,
×
3073
                        sizeof(chisoptions)/sizeof(KEYWORD)) ) == 0 ) break;
3074
                else {
3075
                        option |=  key->type;
×
3076
                        option &= ~key->flags;
×
3077
                }
3078
                if ( ( *s++ = c ) != ',' ) {
×
3079
                        MesPrint("&Illegal separator in Chisholm statement");
×
3080
                        return(1);
×
3081
                }
3082
                if ( *s == 0 ) goto proper;
×
3083
        }
3084
        s = t;
×
3085
        if ( FG.cTable[*s] == 1 ) {
×
3086
                ParseNumber(numindex,s)
×
3087
                if ( *s != 0 ) {
×
3088
                        MesPrint("&Last argument of Chisholm should be an index");
×
3089
                        return(1);
×
3090
                }
3091
                if ( numindex >= AM.OffsetIndex ) {
×
3092
                        MesPrint("&fixed index >= %d. Change value of OffsetIndex in setup file"
×
3093
                        ,AM.OffsetIndex);
3094
                        return(1);
×
3095
                }
3096
        }
3097
        else if ( *s == '$' ) {
×
3098
                if ( ( type = GetName(AC.dollarnames,s+1,&numindex,NOAUTO) ) == CDOLLAR )
×
3099
                        numindex = -numindex;
×
3100
                else {
3101
                        MesPrint("&%s is undefined",s);
×
3102
                        numindex = AddDollar(s+1,DOLINDEX,&one,1);
×
3103
                        return(1);
×
3104
                }
3105
tests:        s = SkipAName(s);
×
3106
                if ( *s != 0 ) {
×
3107
                        MesPrint("&Chisholm should have a single index or $variable for its argument");
×
3108
                        return(1);
×
3109
                }
3110
        }
3111
        else if ( ( type = GetName(AC.varnames,s,&numindex,WITHAUTO) ) == CINDEX ) {
×
3112
                numindex += AM.OffsetIndex;
×
3113
                goto tests;
×
3114
        }
3115
        else if ( type != -1 ) {
×
3116
                if ( type != CDUBIOUS ) {
×
3117
                        NameConflict(type,s);
×
3118
                        type = MakeDubious(AC.varnames,s,&numindex);
×
3119
                }
3120
                return(1);
×
3121
        }
3122
        else {
3123
                MesPrint("&%s is not an index",s);
×
3124
                numindex = AddIndex(s,AC.lDefDim,AC.lDefDim4) + AM.OffsetIndex;
×
3125
                return(1);
×
3126
        }
3127
        if ( error ) return(error);
×
3128
        Add4Com(TYPECHISHOLM,numindex,(option & ALSOREVERSE));
×
3129
        return(0);
×
3130
}
3131

3132
/*
3133
          #] CoChisholm : 
3134
          #[ DoChain :
3135

3136
        Syntax: Chainxx functionname;
3137
*/
3138

3139
int DoChain(UBYTE *s, int option)
12✔
3140
{
3141
        WORD numfunc,type;
12✔
3142
        if ( *s == '$' ) {
12✔
3143
                if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
×
3144
                        numfunc = -numfunc;
×
3145
                else {
3146
                        MesPrint("&%s is undefined",s);
×
3147
                        numfunc = AddDollar(s+1,DOLINDEX,&one,1);
×
3148
                        return(1);
×
3149
                }
3150
tests:        s = SkipAName(s);
12✔
3151
                if ( *s != 0 ) {
12✔
3152
                        MesPrint("&ChainIn/ChainOut should have a single function or $variable for its argument");
×
3153
                        return(1);
×
3154
                }
3155
        }
3156
        else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
12✔
3157
                numfunc += FUNCTION;
12✔
3158
                goto tests;
12✔
3159
        }
3160
        else if ( type != -1 ) {
×
3161
                if ( type != CDUBIOUS ) {
×
3162
                        NameConflict(type,s);
×
3163
                        type = MakeDubious(AC.varnames,s,&numfunc);
×
3164
                }
3165
                return(1);
×
3166
        }
3167
        else {
3168
                MesPrint("&%s is not a function",s);
×
3169
                numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
×
3170
                return(1);
×
3171
        }
3172
        Add3Com(option,numfunc);
12✔
3173
        return(0);
12✔
3174
}
3175

3176
/*
3177
          #] DoChain : 
3178
          #[ CoChainin :
3179

3180
        Syntax: Chainin functionname;
3181
*/
3182

3183
int CoChainin(UBYTE *s)
6✔
3184
{
3185
        return(DoChain(s,TYPECHAININ));
6✔
3186
}
3187

3188
/*
3189
          #] CoChainin : 
3190
          #[ CoChainout :
3191

3192
        Syntax: Chainout functionname;
3193
*/
3194

3195
int CoChainout(UBYTE *s)
6✔
3196
{
3197
        return(DoChain(s,TYPECHAINOUT));
6✔
3198
}
3199

3200
/*
3201
          #] CoChainout : 
3202
          #[ CoExit :
3203
*/
3204

3205
int CoExit(UBYTE *s)
×
3206
{
3207
        UBYTE *name;
×
3208
        WORD code = TYPEEXIT;
×
3209
        while ( *s == ',' ) s++;
×
3210
        if ( *s == 0 ) {
×
3211
                Add3Com(TYPEEXIT,0);
×
3212
                return(0);
×
3213
        }
3214
        name = s+1;
×
3215
        s++;
×
3216
        while ( *s ) { if ( *s == '\\' ) s++; s++; }
×
3217
        if ( name[-1] != '"' || s[-1] != '"' ) {
×
3218
                MesPrint("&Illegal syntax for exit statement");
×
3219
                return(1);
×
3220
        }
3221
        s[-1] = 0;
×
3222
        AddComString(1,&code,name,0);
×
3223
        s[-1] = '"';
×
3224
        return(0);
×
3225
}
3226

3227
/*
3228
          #] CoExit : 
3229
          #[ CoInParallel :
3230
*/
3231

3232
int CoInParallel(UBYTE *s)
×
3233
{
3234
        return(DoInParallel(s,1));
×
3235
}
3236

3237
/*
3238
          #] CoInParallel : 
3239
          #[ CoNotInParallel :
3240
*/
3241

3242
int CoNotInParallel(UBYTE *s)
×
3243
{
3244
        return(DoInParallel(s,0));
×
3245
}
3246

3247
/*
3248
          #] CoNotInParallel : 
3249
          #[ DoInParallel :
3250

3251
        InParallel;
3252
        InParallel,names;
3253
        NotInParallel;
3254
        NotInParallel,names;
3255
*/
3256

3257
int DoInParallel(UBYTE *s, int par)
3✔
3258
{
3259
#ifdef PARALLELCODE
3260
        EXPRESSIONS e;
2✔
3261
        WORD i;
2✔
3262
#endif
3263
        WORD number;
3✔
3264
        UBYTE *t, c;
3✔
3265
        int error = 0;
3✔
3266
#ifndef WITHPTHREADS
3267
        DUMMYUSE(par);
1✔
3268
#endif
3269
        if ( *s == 0 ) {
3✔
3270
                AC.inparallelflag = par;
3✔
3271
#ifdef PARALLELCODE
3272
                for ( i = NumExpressions-1; i >= 0; i-- ) {
4✔
3273
                        e = Expressions+i;
2✔
3274
                        if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
2✔
3275
                        || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
3276
                        ) {
3277
                                e->partodo = par;
2✔
3278
                        }
3279
                }
3280
#endif
3281
        }
3282
        else {
3283
                for(;;) {        /* Look for a (comma separated) list of variables */
3284
                        while ( *s == ',' ) s++;
×
3285
                        if ( *s == 0 ) break;
×
3286
                        if ( *s == '[' || FG.cTable[*s] == 0 ) {
×
3287
                                t = s;
×
3288
                                if ( ( s = SkipAName(s) ) == 0 ) {
×
3289
                                        MesPrint("&Improper name for an expression: '%s'",t);
×
3290
                                        return(1);
×
3291
                                }
3292
                                c = *s; *s = 0;
×
3293
                                if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
×
3294
#ifdef PARALLELCODE
3295
                                        e = Expressions+number;
3296
                                        if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
3297
                                        || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
3298
                                        ) {
3299
                                                e->partodo = par;
3300
                                        }
3301
#endif
3302
                                }
3303
                                else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
×
3304
                                        MesPrint("&%s is not an expression",t);
×
3305
                                        error = 1;
×
3306
                                }
3307
                                *s = c;
×
3308
                        }
3309
                        else {
3310
                                MesPrint("&Illegal object in InExpression statement");
×
3311
                                error = 1;
×
3312
                                while ( *s && *s != ',' ) s++;
×
3313
                                if ( *s == 0 ) break;
×
3314
                        }
3315
                }
3316

3317
        }
3318
        return(error);
3319
}
3320

3321
/*
3322
          #] DoInParallel : 
3323
          #[ CoInExpression :
3324
*/
3325

3326
int CoInExpression(UBYTE *s)
165✔
3327
{
3328
        GETIDENTITY
110✔
3329
        UBYTE *t, c;
165✔
3330
        WORD *w, number;
165✔
3331
        int error = 0;
165✔
3332
        w = AT.WorkPointer;
165✔
3333
        if ( AC.inexprlevel >= MAXNEST ) {
165✔
3334
                MesPrint("@Nesting of inexpression statements more than %d levels",(WORD)MAXNEST);
×
3335
                return(-1);
×
3336
        }
3337
        AC.inexprsumcheck[AC.inexprlevel] = NestingChecksum();
165✔
3338
        AC.inexprstack[AC.inexprlevel] = cbuf[AC.cbufnum].Pointer
165✔
3339
                                                                 - cbuf[AC.cbufnum].Buffer + 2;
165✔
3340
        AC.inexprlevel++;
165✔
3341
        *w++ = TYPEINEXPRESSION;
165✔
3342
        w++; w++;
165✔
3343
        for(;;) {        /* Look for a (comma separated) list of variables */
3344
                while ( *s == ',' ) s++;
330✔
3345
                if ( *s == 0 ) break;
330✔
3346
                if ( *s == '[' || FG.cTable[*s] == 0 ) {
165✔
3347
                        t = s;
165✔
3348
                        if ( ( s = SkipAName(s) ) == 0 ) {
165✔
3349
                                MesPrint("&Improper name for an expression: '%s'",t);
×
3350
                                return(1);
×
3351
                        }
3352
                        c = *s; *s = 0;
165✔
3353
                        if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
165✔
3354
                                *w++ = number;
165✔
3355
                        }
3356
                        else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
×
3357
                                MesPrint("&%s is not an expression",t);
×
3358
                                error = 1;
×
3359
                        }
3360
                        *s = c;
165✔
3361
                }
3362
                else {
3363
                        MesPrint("&Illegal object in InExpression statement");
×
3364
                        error = 1;
×
3365
                        while ( *s && *s != ',' ) s++;
×
3366
                        if ( *s == 0 ) break;
×
3367
                }
3368
        }
3369
        AT.WorkPointer[1] = w - AT.WorkPointer;
165✔
3370
        AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
165✔
3371
        return(error);
165✔
3372
}
3373

3374
/*
3375
          #] CoInExpression : 
3376
          #[ CoEndInExpression :
3377
*/
3378

3379
int CoEndInExpression(UBYTE *s)
165✔
3380
{
3381
        CBUF *C = cbuf+AC.cbufnum;
165✔
3382
        while ( *s == ',' ) s++;
165✔
3383
        if ( *s ) {
165✔
3384
                MesPrint("&Illegal syntax for EndInExpression statement");
×
3385
                return(1);
×
3386
        }
3387
        if ( AC.inexprlevel <= 0 ) {
165✔
3388
                MesPrint("&EndInExpression without corresponding InExpression statement");
×
3389
                return(1);
×
3390
        }
3391
        AC.inexprlevel--;
165✔
3392
        cbuf[AC.cbufnum].Buffer[AC.inexprstack[AC.inexprlevel]] = C->numlhs;
165✔
3393
        if ( AC.inexprsumcheck[AC.inexprlevel] != NestingChecksum() ) {
165✔
3394
                MesNesting();
×
3395
                return(1);
×
3396
        }
3397
        return(0);
3398
}
3399

3400
/*
3401
          #] CoEndInExpression : 
3402
          #[ CoSetExitFlag :
3403
*/
3404

3405
int CoSetExitFlag(UBYTE *s)
×
3406
{
3407
        if ( *s ) {
×
3408
                MesPrint("&Illegal syntax for the SetExitFlag statement");
×
3409
                return(1);
×
3410
        }
3411
        Add2Com(TYPESETEXIT);
×
3412
        return(0);
×
3413
}
3414

3415
/*
3416
          #] CoSetExitFlag : 
3417
          #[ CoTryReplace :
3418
*/
3419
int CoTryReplace(UBYTE *p)
×
3420
{
3421
        GETIDENTITY
3422
        UBYTE *name, c;
×
3423
        WORD *w, error = 0, i, which = -1, c1, minvec = 0;
×
3424
        w = AT.WorkPointer;
×
3425
        *w++ = TYPETRY;
×
3426
        *w++ = 3;
×
3427
        *w++ = 0;
×
3428
        *w++ = REPLACEMENT;
×
3429
        *w++ = FUNHEAD;
×
3430
        FILLFUN(w)
×
3431
/*
3432
        Now we have to read a function argument for the replace_ function.
3433
        Current arguments that we allow involve only single arguments
3434
        that do not expand further. No brackets!
3435
*/
3436
        while ( *p ) {
×
3437
/*
3438
                No numbers yet
3439
*/
3440
                if ( *p == '-' && minvec == 0 && which == (CVECTOR+1) ) {
×
3441
                        minvec = 1; p++;
×
3442
                }
3443
                if ( *p == '[' || FG.cTable[*p] == 0 ) {
×
3444
                        name = p;
×
3445
                        if ( ( p = SkipAName(p) )  == 0 ) return(1);
×
3446
                        c = *p; *p = 0;
×
3447
                        i = GetName(AC.varnames,name,&c1,WITHAUTO);
×
3448
                        if ( which >= 0 && i >= 0 && i != CDUBIOUS && which != (i+1) ) {
×
3449
                                MesPrint("&Illegal combination of objects in TryReplace");
×
3450
                                error = 1;
×
3451
                        }
3452
                        else if ( minvec && i != CVECTOR && i != CDUBIOUS ) {
×
3453
                                MesPrint("&Currently a - sign can be used only with a vector in TryReplace");
×
3454
                                error = 1;
×
3455
                        }
3456
                        else switch ( i ) {
×
3457
                                case CSYMBOL: *w++ = -SYMBOL; *w++ = c1; break;
×
3458
                                case CVECTOR:
×
3459
                                        if ( minvec ) *w++ = -MINVECTOR;
×
3460
                                        else          *w++ = -VECTOR;
×
3461
                                        *w++ = c1 + AM.OffsetVector;
×
3462
                                        minvec = 0;
×
3463
                                        break;
×
3464
                                case CINDEX: *w++ = -INDEX; *w++ = c1 + AM.OffsetIndex;
×
3465
                                        if ( c1 >= AM.WilInd && c == '?' ) { *p++ = c; c = *p; }
×
3466
                                        break;
3467
                                case CFUNCTION: *w++ = -c1-FUNCTION; break;
×
3468
                                case CDUBIOUS: minvec = 0; error = 1; break;
3469
                                default:
×
3470
                                        MesPrint("&Illegal object type in TryReplace: %s",name);
×
3471
                                        error = 1;
×
3472
                                        i = 0;
×
3473
                                        break;
×
3474
                        }
3475
                        if ( which < 0 ) which = i+1;
×
3476
                        else which = -1;
3477
                        *p = c;
×
3478
                        if ( *p == ',' ) p++;
×
3479
                        continue;
×
3480
                }
3481
                else {
3482
                        MesPrint("&Illegal object in TryReplace");
×
3483
                        error = 1;
×
3484
                        while ( *p && *p != ',' ) {
×
3485
                                if ( *p == '(' ) SKIPBRA3(p)
×
3486
                                else if ( *p == '{' ) SKIPBRA2(p)
×
3487
                                else if ( *p == '[' ) SKIPBRA1(p)
×
3488
                                else p++;
×
3489
                        }
3490
                }
3491
                if ( *p == ',' ) p++;
×
3492
                if ( which < 0 ) which = 0;
×
3493
                else which = -1;
×
3494
        }
3495
        if ( which >= 0 ) {
×
3496
                MesPrint("&Odd number of arguments in TryReplace");
×
3497
                error = 1;
×
3498
        }
3499
        i = w - AT.WorkPointer;
×
3500
        AT.WorkPointer[1] = i;
×
3501
        AT.WorkPointer[2] = i - 3;
×
3502
        AT.WorkPointer[4] = i - 3;
×
3503
        AddNtoL((int)i,AT.WorkPointer);
×
3504
        return(error);
×
3505
}
3506

3507
/*
3508
          #] CoTryReplace : 
3509
          #[ CoModulus :
3510

3511
        Old syntax:  Modulus [-] number [:number]
3512
        New syntax:  Modulus [option(s)] number
3513
            Options are: NoFunctions/CoefficientsOnly/AlsoFunctions
3514
                         PlusMin/Positive
3515
                         InverseTable
3516
                         PrintPowersOf(number)
3517
                         AlsoPowers/NoPowers
3518
                         AlsoDollars/NoDollars
3519
        Notice: We change the defaults. This may cause problems to some.
3520
*/
3521

3522
int CoModulus(UBYTE *inp)
3✔
3523
{
3524
        GETIDENTITY
2✔
3525
        int Retval = 0, sign = 1;
3✔
3526
        UBYTE *p, c;
3✔
3527
        while ( *inp == ',' || *inp == ' ' || *inp == '\t' ) inp++;
3✔
3528
        if ( *inp == 0 ) {
3✔
3529
SwitchOff:
×
3530
                if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers");
×
3531
                AC.modpowers = 0;
×
3532
                AN.ncmod = AC.ncmod = 0;
×
3533
                if ( AC.halfmod ) M_free(AC.halfmod,"halfmod");
×
3534
                AC.halfmod = 0; AC.nhalfmod = 0;
×
3535
                if ( AC.modinverses ) M_free(AC.modinverses,"modinverses");
×
3536
                AC.modinverses = 0;
×
3537
                AC.modmode = 0;
×
3538
                return(0);
×
3539
        }
3540
#ifdef WITHFLOAT
3541
        if ( AT.aux_ != 0 ) {
3✔
3542
                MesPrint("&Simultaneous use of floating point and modulus arithmetic makes no sense.");
×
3543
                Retval = 1;
×
3544
        }
3545
#endif
3546
        AC.modmode = 0;
3✔
3547
        if ( *inp == '-' ) {
3✔
3548
                sign = -1;
×
3549
                inp++;
×
3550
        }
3551
        else {
3552
          while ( FG.cTable[*inp] == 0 ) {
3✔
3553
                p = inp;
×
3554
                while ( FG.cTable[*inp] == 0 ) inp++;
×
3555
                c = *inp; *inp = 0;
×
3556
                if ( StrICmp(p,(UBYTE *)"nofunctions") == 0 ) {
×
3557
                        AC.modmode &= ~ALSOFUNARGS;
×
3558
                }
3559
                else if ( StrICmp(p,(UBYTE *)"alsofunctions") == 0 ) {
×
3560
                        AC.modmode |= ALSOFUNARGS;
×
3561
                }
3562
                else if ( StrICmp(p,(UBYTE *)"coefficientsonly") == 0 ) {
×
3563
                        AC.modmode &= ~ALSOFUNARGS;
×
3564
                        AC.modmode &= ~ALSOPOWERS;
×
3565
                        sign = -1;
×
3566
                }
3567
                else if ( StrICmp(p,(UBYTE *)"plusmin") == 0 ) {
×
3568
                        AC.modmode |= POSNEG;
×
3569
                }
3570
                else if ( StrICmp(p,(UBYTE *)"positive") == 0 ) {
×
3571
                        AC.modmode &= ~POSNEG;
×
3572
                }
3573
                else if ( StrICmp(p,(UBYTE *)"inversetable") == 0 ) {
×
3574
                        AC.modmode |= INVERSETABLE;
×
3575
                }
3576
                else if ( StrICmp(p,(UBYTE *)"noinversetable") == 0 ) {
×
3577
                        AC.modmode &= ~INVERSETABLE;
×
3578
                }
3579
                else if ( StrICmp(p,(UBYTE *)"nodollars") == 0 ) {
×
3580
                        AC.modmode &= ~ALSODOLLARS;
×
3581
                }
3582
                else if ( StrICmp(p,(UBYTE *)"alsodollars") == 0 ) {
×
3583
                        AC.modmode |= ALSODOLLARS;
×
3584
                }
3585
                else if ( StrICmp(p,(UBYTE *)"printpowersof") == 0 ) {
×
3586
                        *inp = c;
×
3587
                        if ( *inp != '(' ) {
×
3588
badsyntax:
×
3589
                                MesPrint("&Bad syntax in argument of PrintPowersOf(number) in Modulus statement");
×
3590
                                return(1);
×
3591
                        }
3592
                        while ( *inp == ',' || *inp == ' ' || *inp == '\t' ) inp++;
×
3593
                        inp++; p = inp;
×
3594
                        if ( FG.cTable[*inp] != 1 ) goto badsyntax;
×
3595
                        do { inp++; } while ( FG.cTable[*inp] == 1 );
×
3596
                        c = *inp; *inp = 0;
×
3597
                        if ( GetLong(p,(UWORD *)AC.powmod,&AC.npowmod) ) Retval = -1;
×
3598
                        if ( TakeModulus((UWORD *)AC.powmod,&AC.npowmod,AC.cmod,AC.ncmod,NOUNPACK) ) Retval = -1;
×
3599
                        if ( AC.npowmod == 0 ) {
×
3600
                                MesPrint("&Improper value for generator");
×
3601
                                Retval = -1;
×
3602
                        }
3603
                        if ( MakeModTable() ) Retval = -1;
×
3604
                        AC.DirtPow = 1;
×
3605
                        *inp = c;
×
3606
                        while ( *inp == ',' || *inp == ' ' || *inp == '\t' ) inp++;
×
3607
                        if ( *inp != ')' ) goto badsyntax;
×
3608
                        inp++;
×
3609
                        c = *inp;
×
3610
                }
3611
                else if ( StrICmp(p,(UBYTE *)"alsopowers") == 0 ) {
×
3612
                        AC.modmode |= ALSOPOWERS;
×
3613
                        sign =  1;
×
3614
                }
3615
                else if ( StrICmp(p,(UBYTE *)"nopowers") == 0 ) {
×
3616
                        AC.modmode &= ~ALSOPOWERS;
×
3617
                        sign = -1;
×
3618
                }
3619
                else {
3620
                        MesPrint("&Unrecognized option %s in Modulus statement",inp);
×
3621
                        return(1);
×
3622
                }
3623
                *inp = c;
×
3624
                while ( *inp == ',' || *inp == ' ' || *inp == '\t' ) inp++;
×
3625
                if ( *inp == 0 ) {
×
3626
                        MesPrint("&Modulus statement with no value!!!");
×
3627
                        return(1);
×
3628
                }
3629
          }
3630
        }
3631
        p = inp;
3✔
3632
        if ( FG.cTable[*inp] != 1 ) {
3✔
3633
                MesPrint("&Invalid value for modulus:%s",inp);
×
3634
                if ( AC.modpowers ) M_free(AC.modpowers,"AC.modpowers");
×
3635
                AC.modpowers = 0;
×
3636
                AN.ncmod = AC.ncmod = 0;
×
3637
                if ( AC.halfmod ) M_free(AC.halfmod,"halfmod");
×
3638
                AC.halfmod = 0; AC.nhalfmod = 0;
×
3639
                if ( AC.modinverses ) M_free(AC.modinverses,"modinverses");
×
3640
                AC.modinverses = 0;
×
3641
                return(1);
×
3642
        }
3643
        do { inp++; } while ( FG.cTable[*inp] == 1 );
30✔
3644
        c = *inp; *inp = 0;
3✔
3645
        Retval = GetLong(p,(UWORD *)AC.cmod,&AC.ncmod);
3✔
3646
        if ( Retval == 0 && AC.ncmod == 0 ) goto SwitchOff;
3✔
3647
        if ( sign < 0 ) AC.ncmod = -AC.ncmod;
3✔
3648
        AN.ncmod = AC.ncmod;
3✔
3649
        if ( ( AC.modmode & INVERSETABLE ) != 0 ) MakeInverses();
3✔
3650
        if ( AC.halfmod ) M_free(AC.halfmod,"halfmod");
3✔
3651
        AC.halfmod = 0; AC.nhalfmod = 0;
3✔
3652
        return(Retval);
3✔
3653
}
3654

3655
/*
3656
          #] CoModulus : 
3657
          #[ CoRepeat :
3658
*/
3659

3660
int CoRepeat(UBYTE *inp)
126✔
3661
{
3662
        int error = 0;
126✔
3663
        AC.RepSumCheck[AC.RepLevel] = NestingChecksum();
126✔
3664
        AC.RepLevel++;
126✔
3665
        if ( AC.RepLevel > AM.RepMax ) {
126✔
3666
                MesPrint("&Too many repeat levels. Maximum is %d",AM.RepMax);
×
3667
                return(1);
×
3668
        }
3669
        Add3Com(TYPEREPEAT,-1)   /* Means indefinite */
126✔
3670
        while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
126✔
3671
        if ( *inp ) {
126✔
3672
                error = CompileStatement(inp);
75✔
3673
                if ( CoEndRepeat(inp) ) error = 1;
75✔
3674
        }
3675
        return(error);
3676
}
3677

3678
/*
3679
          #] CoRepeat : 
3680
          #[ CoEndRepeat :
3681
*/
3682

3683
int CoEndRepeat(UBYTE *inp)
126✔
3684
{
3685
        CBUF *C = cbuf+AC.cbufnum;
126✔
3686
        int level, error = 0, repeatlevel = 0;
126✔
3687
        DUMMYUSE(inp);
126✔
3688
        AC.RepLevel--;
126✔
3689
        if ( AC.RepLevel < 0 ) {
126✔
3690
                MesPrint("&EndRepeat without Repeat");
×
3691
                AC.RepLevel = 0;
×
3692
                return(1);
×
3693
        }
3694
        else if ( AC.RepSumCheck[AC.RepLevel] != NestingChecksum() ) {
126✔
3695
                MesNesting();
×
3696
                error = 1;
×
3697
        }
3698
        level = C->numlhs+1;
126✔
3699
        while ( level > 0 ) {
447✔
3700
                if ( C->lhs[--level][0] == TYPEREPEAT ) {
447✔
3701
                        if ( repeatlevel == 0 ) {
174✔
3702
                                Add3Com(TYPEENDREPEAT,level)
126✔
3703
                                return(error);
126✔
3704
                        }
3705
                        repeatlevel--;
48✔
3706
                }
3707
                else if ( C->lhs[level][0] == TYPEENDREPEAT ) repeatlevel++;
273✔
3708
        }
3709
        return(1);
3710
}
3711

3712
/*
3713
          #] CoEndRepeat : 
3714
          #[ DoBrackets :
3715

3716
                Reads in the bracket information.
3717
                Storage is in the form of a regular term.
3718
                No subterms and arguments are allowed.
3719
*/
3720

3721
int DoBrackets(UBYTE *inp, int par)
60✔
3722
{
3723
        GETIDENTITY
40✔
3724
        UBYTE *p, *pp, c;
60✔
3725
        WORD *to, i, type, *w, error = 0;
60✔
3726
        WORD c1,c2, *WorkSave;
60✔
3727
        int biflag;
60✔
3728
        p = inp;
60✔
3729
        WorkSave = to = AT.WorkPointer;
60✔
3730
        to++;
60✔
3731
        if ( AT.BrackBuf == 0 ) {
60✔
3732
                AR.MaxBracket = 100;
51✔
3733
                AT.BrackBuf = (WORD *)Malloc1(sizeof(WORD)*(AR.MaxBracket+1),"bracket buffer");
51✔
3734
        }
3735
        *AT.BrackBuf = 0;
60✔
3736
        AR.BracketOn = 0;
60✔
3737
        AC.bracketindexflag = 0;
60✔
3738
        AT.bracketindexflag = 0;
60✔
3739
        if ( *p == '+' || *p == '-' ) p++;
60✔
3740
        if ( p[-1] == ',' && *p ) p--;
60✔
3741
        if ( p[-1] == '+' && *p ) { biflag = 1;  if ( *p != ',' ) { *--p = ','; } }
60✔
3742
        else if ( p[-1] == '-' && *p ) { biflag = -1; if ( *p != ',' ) { *--p = ','; } }
51✔
3743
        else biflag = 0;
60✔
3744
        while ( *p == ',' ) {
132✔
3745
redo:        AR.BracketOn++;
72✔
3746
                while ( *p == ',' ) p++;
144✔
3747
                if ( *p == 0 ) break;
72✔
3748
                if ( *p == '0' ) {
72✔
3749
                        p++; while ( *p == '0' ) p++;
×
3750
                        continue;
×
3751
                }
3752
                inp = pp = p;
72✔
3753
                p = SkipAName(p);
72✔
3754
                if ( p == 0 ) return(1);
72✔
3755
                c = *p;
72✔
3756
                *p = 0;
72✔
3757
                type = GetName(AC.varnames,inp,&c1,WITHAUTO);
72✔
3758
                if ( c == '.' ) {
72✔
3759
                        if ( type == CVECTOR || type == CDUBIOUS ) {
×
3760
                                *p++ = c;
×
3761
                                inp = p;
×
3762
                                p = SkipAName(p);
×
3763
                                if ( p == 0 ) return(1);
×
3764
                                c = *p;
×
3765
                                *p = 0;
×
3766
                                type = GetName(AC.varnames,inp,&c2,WITHAUTO);
×
3767
                                if ( type != CVECTOR && type != CDUBIOUS ) {
×
3768
                                        MesPrint("&Not a vector in dotproduct in bracket statement: %s",inp);
×
3769
                                        error = 1;
×
3770
                                }
3771
                                else type = CDOTPRODUCT;
3772
                        }
3773
                        else {
3774
                                MesPrint("&Illegal use of . after %s in bracket statement",inp);
×
3775
                                error = 1;
×
3776
                                *p++ = c;
×
3777
                                goto redo;
×
3778
                        }
3779
                }
3780
                switch ( type ) {
72✔
3781
                        case CSYMBOL :
45✔
3782
                                *to++ = SYMBOL; *to++ = 4; *to++ = c1; *to++ = 1; break;
45✔
3783
                        case CVECTOR :
×
3784
                                *to++ = INDEX; *to++ = 3; *to++ = AM.OffsetVector + c1; break;
×
3785
                        case CFUNCTION :
24✔
3786
                                *to++ = c1+FUNCTION; *to++ = FUNHEAD; *to++ = 0;
24✔
3787
                                FILLFUN3(to)
3788
                                break;
24✔
3789
                        case CDOTPRODUCT :
×
3790
                                *to++ = DOTPRODUCT; *to++ = 5; *to++ = c1 + AM.OffsetVector;
×
3791
                                *to++ = c2 + AM.OffsetVector; *to++ = 1; break;
×
3792
                        case CDELTA :
×
3793
                                *to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX; break;
×
3794
                        case CSET :
3✔
3795
                                *to++ = SETSET; *to++ = 4; *to++ = c1; *to++ = Sets[c1].type; break;
3✔
3796
                        default :
×
3797
                                MesPrint("&Illegal bracket request for %s",pp);
×
3798
                                error = 1; break;
×
3799
                }
3800
                *p = c;
72✔
3801
        }
3802
        if ( *p ) {
60✔
3803
                MesCerr("separator",p);
×
3804
                AC.BracketNormalize = 0;
×
3805
                AT.WorkPointer = WorkSave;
×
3806
                error = 1;
×
3807
                return(error);
×
3808
        }
3809
        *to++ = 1; *to++ = 1; *to++ = 3;
60✔
3810
        *AT.WorkPointer = to - AT.WorkPointer;
60✔
3811
        AT.WorkPointer = to;
60✔
3812
        AC.BracketNormalize = 1;
60✔
3813
        if ( BracketNormalize(BHEAD WorkSave) ) { error = 1; AR.BracketOn = 0; }
60✔
3814
        else {
3815
                w = WorkSave;
60✔
3816
                if ( *w == 4 || !*w ) { AR.BracketOn = 0; }
60✔
3817
                else {
3818
                        i = *(w+*w-1);
60✔
3819
                        if ( i < 0 ) i = -i;
60✔
3820
                        *w -= i;
60✔
3821
                        i = *w;
60✔
3822
                        if ( i > AR.MaxBracket ) {
60✔
3823
                                WORD *newbuf;
×
3824
                                newbuf = (WORD *)Malloc1(sizeof(WORD)*(i+1),"bracket buffer");
×
3825
                                AR.MaxBracket = i;
×
3826
                                if ( AT.BrackBuf != 0 ) M_free(AT.BrackBuf,"bracket buffer");
×
3827
                                AT.BrackBuf = newbuf;
×
3828
                        }
3829
                        to = AT.BrackBuf;
60✔
3830
                        NCOPY(to,w,i);
372✔
3831
                }
3832
        }
3833
        AC.BracketNormalize = 0;
60✔
3834
        if ( par == 1 ) AR.BracketOn = -AR.BracketOn;
60✔
3835
        if ( error == 0 ) {
60✔
3836
                AC.bracketindexflag = biflag;
60✔
3837
                AT.bracketindexflag = biflag;
60✔
3838
        }
3839
        AT.WorkPointer = WorkSave;
60✔
3840
        return(error);
60✔
3841
}
3842

3843
/*
3844
          #] DoBrackets : 
3845
          #[ CoBracket :
3846
*/
3847

3848
int CoBracket(UBYTE *inp)
57✔
3849
{ return(DoBrackets(inp,0)); }
57✔
3850

3851
/*
3852
          #] CoBracket : 
3853
          #[ CoAntiBracket :
3854
*/
3855

3856
int CoAntiBracket(UBYTE *inp)
3✔
3857
{ return(DoBrackets(inp,1)); }
3✔
3858

3859
/*
3860
          #] CoAntiBracket : 
3861
          #[ CoMultiBracket :
3862

3863
        Syntax:
3864
                MultiBracket:{A|B} bracketinfo:...:{A|B} bracketinfo;
3865
*/
3866

3867
int CoMultiBracket(UBYTE *inp)
×
3868
{
3869
        GETIDENTITY
3870
        int i, error = 0, error1, type, num;
×
3871
        UBYTE *s, c;
×
3872
        WORD *to, *from;
×
3873

3874
        if ( *inp != ':' ) {
×
3875
                MesPrint("&Illegal Multiple Bracket separator: %s",inp);
×
3876
                return(1);
×
3877
        }
3878
        inp++;
×
3879
        if ( AC.MultiBracketBuf == 0 ) {
×
3880
                AC.MultiBracketBuf = (WORD **)Malloc1(sizeof(WORD *)*MAXMULTIBRACKETLEVELS,"multi bracket buffer");
×
3881
                for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
×
3882
                        AC.MultiBracketBuf[i] = 0;
×
3883
                }
3884
        }
3885
        else {
3886
          for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
×
3887
                if ( AC.MultiBracketBuf[i] ) {
×
3888
                        M_free(AC.MultiBracketBuf[i],"bracket buffer i");
×
3889
                        AC.MultiBracketBuf[i] = 0;
×
3890
                }
3891
          }
3892
          AC.MultiBracketLevels = 0;
×
3893
        }
3894
        AC.MultiBracketLevels = 0;
×
3895
/*
3896
                Start with disabling the regular brackets.
3897
*/
3898
        if ( AT.BrackBuf == 0 ) {
×
3899
                AR.MaxBracket = 100;
×
3900
                AT.BrackBuf = (WORD *)Malloc1(sizeof(WORD)*(AR.MaxBracket+1),"bracket buffer");
×
3901
        }
3902
        *AT.BrackBuf = 0;
×
3903
        AR.BracketOn = 0;
×
3904
        AC.bracketindexflag = 0;
×
3905
        AT.bracketindexflag = 0;
×
3906
/*
3907
        Now loop through the various levels, separated by the colons.
3908
*/
3909
        for ( i = 0; i < MAXMULTIBRACKETLEVELS; i++ ) {
×
3910
                if ( *inp == 0 ) goto RegEnd;
×
3911
/*
3912
                1: skip to ':', determine bracket or antibracket
3913
*/
3914
                s = inp;
3915
                while ( *s && *s != ':' ) {
×
3916
                        if ( *s == '[' ) { SKIPBRA1(s) s++; }
×
3917
                        else if ( *s == '{' ) { SKIPBRA2(s) s++; }
×
3918
                        else s++;
×
3919
                }
3920
                c = *s; *s = 0;
×
3921
                if ( StrICont(inp,(UBYTE *)"antibrackets") == 0 ) { type = 1; }
×
3922
                else if ( StrICont(inp,(UBYTE *)"brackets") == 0 ) { type = 0; }
×
3923
                else {
3924
                        MesPrint("&Illegal (anti)bracket specification in MultiBracket statement");
×
3925
                        if ( error == 0 ) error = 1;
×
3926
                        goto NextLevel;
×
3927
                }
3928
                while ( FG.cTable[*inp] == 0 ) inp++;
×
3929
                if ( *inp != ',' ) {
×
3930
                        MesPrint("&Illegal separator after (anti)bracket specification in MultiBracket statement");
×
3931
                        if ( error == 0 ) error = 1;
×
3932
                        goto NextLevel;
×
3933
                }
3934
                inp++;
×
3935
/*
3936
                2: call DoBrackets.
3937
*/
3938
                error1 = DoBrackets(inp, type);
×
3939
                if ( error < 0 ) return(error1);
×
3940
                if ( error1 > error ) error = error1;
×
3941
/*
3942
                3: copy bracket information to the multi bracket arrays
3943
*/
3944
                if ( AR.BracketOn ) {
×
3945
                        num = AT.BrackBuf[0];
×
3946
                        to = AC.MultiBracketBuf[i] = (WORD *)Malloc1((num+2)*sizeof(WORD),"bracket buffer i");
×
3947
                        from = AT.BrackBuf;
×
3948
                        *to++ = AR.BracketOn;
×
3949
                        NCOPY(to,from,num);
×
3950
                        *to = 0;
×
3951
                }
3952
/*
3953
                4: set ready for the next level
3954
*/
3955
NextLevel:
×
3956
                *s = c; if ( c == ':' ) s++;
×
3957
                inp = s;
×
3958
                *AT.BrackBuf = 0;
×
3959
                AR.BracketOn = 0;
×
3960
        }
3961
        if ( *inp != 0 ) {
×
3962
                MesPrint("&More than %d levels in MultiBracket statement",(WORD)MAXMULTIBRACKETLEVELS);
×
3963
                if ( error == 0 ) error = 1;
×
3964
        }
3965
RegEnd:
×
3966
        AC.MultiBracketLevels = i;
×
3967
        *AT.BrackBuf = 0;
×
3968
        AR.BracketOn = 0;
×
3969
        AC.bracketindexflag = 0;
×
3970
        AT.bracketindexflag = 0;
×
3971
        return(error);
×
3972
}
3973

3974
/*
3975
          #] CoMultiBracket : 
3976
          #[ CountComp :
3977

3978
                This routine reads the count statement. The syntax is:
3979
                count minimum,object,size[,object,size]
3980
                Objects can be:
3981
                        symbol
3982
                        dotproduct
3983
                        vector
3984
                        function
3985
                Vectors can have the auxiliary flags:
3986
                        +v +f +d +?setname
3987

3988
                Output for the compiler:
3989
                TYPECOUNT,size,minimum,objects
3990
                with the objects:
3991
                SYMBOL,4,number,size
3992
                DOTPRODUCT,5,v1,v2,size
3993
                FUNCTION,4,number,size
3994
                VECTOR,5,number,bits,size or VECTOR,6,number,bits,setnumber,size
3995

3996
                Currently only used in the if statement
3997
*/
3998

3999
WORD *CountComp(UBYTE *inp, WORD *to)
27✔
4000
{
4001
        GETIDENTITY
18✔
4002
        UBYTE *p, c;
27✔
4003
        WORD *w, mini = 0, type, c1, c2;
27✔
4004
        int error = 0;
27✔
4005
        p = inp;
27✔
4006
        w = to;
27✔
4007
        AR.Eside = 2;
27✔
4008
        *w++ = TYPECOUNT;
27✔
4009
        *w++ = 0;
27✔
4010
        *w++ = 0;
27✔
4011
        while ( *p == ',' ) {
54✔
4012
                p++; inp = p;
27✔
4013
                if ( *p == '[' || FG.cTable[*p] == 0 ) {
27✔
4014
                        if ( ( p = SkipAName(inp) ) == 0 ) return(0);
27✔
4015
                        c = *p; *p = 0;
27✔
4016
                        type = GetName(AC.varnames,inp,&c1,WITHAUTO);
27✔
4017
                        if ( c == '.' ) {
27✔
4018
                                if ( type == CVECTOR || type == CDUBIOUS ) {
×
4019
                                        *p++ = c;
×
4020
                                        inp = p;
×
4021
                                        p = SkipAName(p);
×
4022
                                        if ( p == 0 ) return(0);
×
4023
                                        c = *p;
×
4024
                                        *p = 0;
×
4025
                                        type = GetName(AC.varnames,inp,&c2,WITHAUTO);
×
4026
                                        if ( type != CVECTOR && type != CDUBIOUS ) {
×
4027
                                                MesPrint("&Not a vector in dotproduct in if statement: %s",inp);
×
4028
                                                error = 1;
×
4029
                                        }
4030
                                        else type = CDOTPRODUCT;
4031
                                }
4032
                                else {
4033
                                        MesPrint("&Illegal use of . after %s in if statement",inp);
×
4034
                                        if ( type == NAMENOTFOUND )
×
4035
                                                MesPrint("&%s is not a properly declared variable",inp);
×
4036
                                        error = 1;
×
4037
                                        *p++ = c;
×
4038
                                        while ( *p && *p != ')' && *p != ',' ) p++;
×
4039
                                        if ( *p == ',' && FG.cTable[p[1]] == 1 ) {
×
4040
                                                p++;
×
4041
                                                while ( *p && *p != ')' && *p != ',' ) p++;
×
4042
                                        }
4043
                                        continue;
×
4044
                                }
4045
                        }
4046
                        *p = c;
27✔
4047
                        switch ( type ) {
27✔
4048
                                case CSYMBOL:
15✔
4049
                                        *w++ = SYMBOL; *w++ = 4; *w++ = c1;
15✔
4050
Sgetnum:                        if ( *p != ',' ) {
27✔
4051
                                                MesCerr("sequence",p);
×
4052
                                                while ( *p && *p != ')' && *p != ',' ) p++;
×
4053
                                                error = 1;
4054
                                        }
4055
                                        p++; inp = p;
27✔
4056
                                        ParseSignedNumber(mini,p)
54✔
4057
                                        if ( FG.cTable[p[-1]] != 1 || ( *p && *p != ')' && *p != ',' ) ) {
27✔
4058
                                                while ( *p && *p != ')' && *p != ',' ) p++;
×
4059
                                                error = 1;
×
4060
                                                c = *p; *p = 0;
×
4061
                                                MesPrint("&Improper value in count: %s",inp);
×
4062
                                                *p = c;
×
4063
                                                while ( *p && *p != ')' && *p != ',' ) p++;
×
4064
                                        }
4065
                                        *w++ = mini;
27✔
4066
                                        break;
27✔
4067
                                case CFUNCTION:
12✔
4068
                                        *w++ = FUNCTION; *w++ = 4; *w++ = c1+FUNCTION; goto Sgetnum;
12✔
4069
                                case CDOTPRODUCT:
×
4070
                                        *w++ = DOTPRODUCT; *w++ = 5;
×
4071
                                        *w++ = c2 + AM.OffsetVector;
×
4072
                                        *w++ = c1 + AM.OffsetVector;
×
4073
                                        goto Sgetnum;
×
4074
                                case CVECTOR:
×
4075
                                        *w++ = VECTOR; *w++ = 5;
×
4076
                                        *w++ = c1 + AM.OffsetVector;
×
4077
                                        if ( *p == ',' ) {
×
4078
                                                *w++ = VECTBIT | DOTPBIT | FUNBIT;
×
4079
                                                goto Sgetnum;
×
4080
                                        }
4081
                                        else if ( *p == '+' ) {
×
4082
                                                p++;
×
4083
                                                *w = 0;
×
4084
                                                while ( *p && *p != ',' ) {
×
4085
                                                        if ( *p == 'v' || *p == 'V' ) {
×
4086
                                                                *w |= VECTBIT; p++;
×
4087
                                                        }
4088
                                                        else if ( *p == 'd' || *p == 'D' ) {
4089
                                                                *w |= DOTPBIT; p++;
×
4090
                                                        }
4091
                                                        else if ( *p == 'f' || *p == 'F'
4092
                                                        || *p == 't' || *p == 'T' ) {
4093
                                                                *w |= FUNBIT; p++;
×
4094
                                                        }
4095
                                                        else if ( *p == '?' ) {
4096
                                                                p++; inp = p;
×
4097
                                                                if ( *p == '{' ) { /* } */
×
4098
                                                                        SKIPBRA2(p)
×
4099
                                                                        if ( p == 0 ) return(0);
×
4100
                                                                        if ( ( c1 = DoTempSet(inp+1,p) ) < 0 ) return(0);
×
4101
                                                                        if ( Sets[c1].type != CFUNCTION ) {
×
4102
                                                                                MesPrint("&set type conflict: Function expected");
×
4103
                                                                                return(0);
×
4104
                                                                        }
4105
                                                                        type = CSET;
×
4106
                                                                        c = *++p;
×
4107
                                                                }
4108
                                                                else {
4109
                                                                        p = SkipAName(p);
×
4110
                                                                        if ( p == 0 ) return(0);
×
4111
                                                                        c = *p; *p = 0;
×
4112
                                                                        type = GetName(AC.varnames,inp,&c1,WITHAUTO);
×
4113
                                                                }
4114
                                                                if ( type != CSET && type != CDUBIOUS ) {
×
4115
                                                                        MesPrint("&%s is not a set",inp);
×
4116
                                                                        error = 1;
×
4117
                                                                }
4118
                                                                w[-2] = 6;
×
4119
                                                                *w++ |= SETBIT;
×
4120
                                                                *w++ = c1;
×
4121
                                                                *p = c;
×
4122
                                                                goto Sgetnum;
×
4123
                                                        }
4124
                                                        else {
4125
                                                                MesCerr("specifier for vector",p);
×
4126
                                                                error = 1;
×
4127
                                                        }
4128
                                                }
4129
                                                w++;
×
4130
                                                goto Sgetnum;
×
4131
                                        }
4132
                                        else {
4133
                                                MesCerr("specifier for vector",p);
×
4134
                                                while ( *p && *p != ')' && *p != ',' ) p++;
×
4135
                                                error = 1;
×
4136
                                                *w++ = VECTBIT | DOTPBIT | FUNBIT;
×
4137
                                                goto Sgetnum;
×
4138
                                        }
4139
                                case CDUBIOUS:
×
4140
                                        goto skipfield;
×
4141
                                default:
×
4142
                                        *p = 0;
×
4143
                                        MesPrint("&%s is not a symbol, function, vector or dotproduct",inp);
×
4144
                                        error = 1;
×
4145
skipfield:                        while ( *p && *p != ')' && *p != ',' ) p++;
×
4146
                                        if ( *p && FG.cTable[p[1]] == 1 ) {
×
4147
                                                p++;
×
4148
                                                while ( *p && *p != ')' && *p != ',' ) p++;
×
4149
                                        }
4150
                                        break;
4151
                        }
4152
                }
4153
                else {
4154
                        MesCerr("name",p);
×
4155
                        while ( *p && *p != ',' ) p++;
×
4156
                        error = 1;
4157
                }
4158
        }
4159
        to[1] = w-to;
27✔
4160
        if ( *p == ')' ) p++;
27✔
4161
        if ( *p ) { MesCerr("end of statement",p); return(0); }
27✔
4162
        if ( error ) return(0);
27✔
4163
        return(w);
4164
}
4165

4166
/*
4167
          #] CountComp : 
4168
          #[ CoIf :
4169

4170
                Reads the if statement: There must be a pair of parentheses.
4171
                Much work is delegated to the routines in compi2 and CountComp.
4172
                The goto is kept hanging as it is forward.
4173
                The address in which the label must be written is pushed on
4174
                the AC.IfStack.
4175

4176
                Here we allow statements of the type
4177
                if ( condition ) single statement;
4178
                compile the if statement.
4179
                test character at end
4180
                if not ; or )
4181
                copy the statement after the proper parenthesis to the
4182
                beginning of the AC.iBuffer.
4183
                Have it compiled.
4184
                generate an endif statement.
4185
*/
4186

4187
static UWORD *CIscratC = 0;
4188

4189
int CoIf(UBYTE *inp)
69✔
4190
{
4191
        GETIDENTITY
46✔
4192
        int error = 0, level;
69✔
4193
        WORD *w, *ww, *u, *s, *OldWork, *OldSpace = AT.WorkSpace;
69✔
4194
        WORD gotexp = 0;                /* Indicates whether there can be a condition */
69✔
4195
        WORD lenpp, lenlev, ncoef, i, number;
69✔
4196
        UBYTE *p, *pp, *ppp, c;
69✔
4197
        CBUF *C = cbuf+AC.cbufnum;
69✔
4198
        LONG x;
69✔
4199
#ifdef WITHFLOAT
4200
        int spec;
69✔
4201
#endif
4202
        if ( *inp == '(' && inp[1] == ',' ) inp += 2;
69✔
4203
        else if ( *inp == '(' ) inp++;        /* Usually we enter at the bracket */
69✔
4204

4205
        if ( CIscratC == 0 )
69✔
4206
                CIscratC = (UWORD *)Malloc1((AM.MaxTal+2)*sizeof(UWORD),"CoIf");
27✔
4207
        lenpp = 0;
69✔
4208
        lenlev = 1;
69✔
4209
        if ( AC.IfLevel >= AC.MaxIf ) DoubleIfBuffers();
69✔
4210
        AC.IfCount[lenpp++] = 0;
69✔
4211
/*
4212
        IfStack is used for organizing the 'go to' for the various if levels
4213
*/
4214
        *AC.IfStack++ = C->Pointer-C->Buffer+2;
69✔
4215
/*
4216
        IfSumCheck is used to test for illegal nesting of if, argument or repeat.
4217
*/
4218
        AC.IfSumCheck[AC.IfLevel] = NestingChecksum();
69✔
4219
        AC.IfLevel++;
69✔
4220
        w = OldWork = AT.WorkPointer;
69✔
4221
        *w++ = TYPEIF;
69✔
4222
        w += 2;
69✔
4223
        p = inp;
69✔
4224
        for(;;) {
198✔
4225
                inp = p;
198✔
4226
                level = 0;
198✔
4227
ReDo:
×
4228
                if ( FG.cTable[*p] == 1 ) {                /* Number */
198✔
4229
                        if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
21✔
4230
#ifdef WITHFLOAT
4231
                        pp = CheckFloat(p,&spec);
21✔
4232
                        if ( pp > p ) {        /* Got one */
21✔
4233
HaveFloat:
×
4234
                                if ( spec == 1 ) { /* is zero */
×
4235
                                        *w++ = LONGNUMBER; *w++ = 3; *w++ = 0;
×
4236
                                }
4237
                                else if ( spec == -1 ) {
×
4238
                                        MesPrint("&The floating point system has not been started: %s",p);
×
4239
                    if ( !error ) error = 1;
×
4240
                                }
4241
                                else {
4242
                                        WORD *ow = AT.WorkPointer;
×
4243
                                        AT.WorkPointer = w;
×
4244
                                        c = *pp; c = 0;
×
4245
                                        ReadFloat((SBYTE *)p);        /* Is now at AT.WorkPointer */
×
4246
                                        *pp = c;
×
4247
                                        AT.WorkPointer[0] = IFFLOATNUMBER;
×
4248
                                        w = AT.WorkPointer + AT.WorkPointer[1];
×
4249
                                        AT.WorkPointer = ow;
×
4250
                                        if ( level ) w[FUNHEAD+3] = -w[FUNHEAD+3];
×
4251
                                }
4252
                                goto DoneWithNumber;
×
4253
                        }
4254
/*
4255
                        Notation: Same as FLOATFUN but FLOATFUN replaced by IFFLOATNUMBER.
4256
*/
4257

4258
#endif
4259
                        u = w;
21✔
4260
                        *w++ = LONGNUMBER;
21✔
4261
/*
4262
                        Notation:
4263
                        LONGNUMBER,size,reducedsize*sign,numerator,denominator
4264
                        with the length of denominator and numerator equal to reducedsize
4265
*/
4266
                        w += 2;
21✔
4267
                        if ( GetLong(p,(UWORD *)w,&ncoef) ) { ncoef = 1; error = 1; }
21✔
4268
                        w[-1] = ncoef;
21✔
4269
                        while ( FG.cTable[*++p] == 1 );
21✔
4270
                        if ( *p == '/' ) {
21✔
4271
                                p++;
×
4272
                                if ( FG.cTable[*p] != 1 ) {
×
4273
                                        MesCerr("sequence",p); error = 1; goto OnlyNum;
×
4274
                                }
4275
                                if ( GetLong(p,CIscratC,&ncoef) ) {
×
4276
                                        ncoef = 1; error = 1;
×
4277
                                }
4278
                                while ( FG.cTable[*++p] == 1 );
×
4279
                                if ( ncoef == 0 ) {
×
4280
                                        MesPrint("&Division by zero!");
×
4281
                                        error = 1;
×
4282
                                }
4283
                                else {
4284
                                        if ( w[-1] != 0 ) {
×
4285
                                                if ( Simplify(BHEAD (UWORD *)w,(WORD *)(w-1),
×
4286
                                                CIscratC,&ncoef) ) error = 1;
4287
                                                else {
4288
                                                        i = w[-1];
×
4289
                                                        if ( i >= ncoef ) {
×
4290
                                                                i = w[-1];
×
4291
                                                                w += i;
×
4292
                                                                i -= ncoef;
×
4293
                                                                s = (WORD *)CIscratC;
×
4294
                                                                NCOPY(w,s,ncoef);
×
4295
                                                                while ( --i >= 0 ) *w++ = 0;
×
4296
                                                        }
4297
                                                        else {
4298
                                                                w += i;
×
4299
                                                                i = ncoef - i;
×
4300
                                                                while ( --i >= 0 ) *w++ = 0;
×
4301
                                                                s = (WORD *)CIscratC;
×
4302
                                                                NCOPY(w,s,ncoef);
×
4303
                                                        }
4304
                                                }
4305
                                        }
4306
                                }
4307
                        }
4308
                        else {
4309
OnlyNum:
21✔
4310
                                w += ncoef;
21✔
4311
                                if ( ncoef > 0 ) {
21✔
4312
                                        ncoef--; *w++ = 1;
×
4313
                                        while ( --ncoef >= 0 ) *w++ = 0;
×
4314
                                }
4315
                        }
4316
                        u[1] = WORDDIF(w,u);
21✔
4317
                        u[2] = (u[1] - 3)/2;
21✔
4318
                        if ( level ) u[2] = -u[2];
21✔
4319
#ifdef WITHFLOAT
4320
DoneWithNumber:
21✔
4321
#endif
4322
                        gotexp = 1;
4323
                }
4324
                else if ( *p == '+' ) { p++; goto ReDo; }
177✔
4325
                else if ( *p == '-' ) { level ^= 1; p++; goto ReDo; }
×
4326
                else if ( *p == 'c' || *p == 'C' ) {        /* Count or Coefficient */
4327
                        if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
27✔
4328
                        while ( FG.cTable[*++p] == 0 );
135✔
4329
                        c = *p; *p = 0;
27✔
4330
                        if ( !StrICmp(inp,(UBYTE *)"count") ) {
27✔
4331
                                *p = c;
27✔
4332
                                if ( c != '(' ) {
27✔
4333
                                        MesPrint("&no ( after count");
×
4334
                                        error = 1;
×
4335
                                        goto endofif;
×
4336
                                }
4337
                                inp = p;
27✔
4338
                                SKIPBRA4(p);
174✔
4339
                                c = *++p; *p = 0; *inp = ',';
27✔
4340
                                w = CountComp(inp,w);
27✔
4341
                                *p = c; *inp = '(';
27✔
4342
                                if ( w == 0 ) { error = 1; goto endofif; }
27✔
4343
                                gotexp = 1;
4344
                        }
4345
                        else if ( ConWord(inp,(UBYTE *)"coefficient") && ( p - inp ) > 3 ) {
×
4346
                                *w++ = COEFFI;
×
4347
                                *w++ = 2;
×
4348
                                *p = c;
×
4349
                                gotexp = 1;
×
4350
                        }
4351
                        else goto NoGood;
×
4352
                        inp = p;
27✔
4353
                }
4354
                else if ( *p == 'm' || *p == 'M' ) {        /* match */
4355
                        if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
18✔
4356
                        while ( !FG.cTable[*++p] );
90✔
4357
                        c = *p; *p = 0;
18✔
4358
                        if ( !StrICmp(inp,(UBYTE *)"match") ) {
18✔
4359
                                *p = c;
18✔
4360
                                if ( c != '(' ) {
18✔
4361
                                        MesPrint("&no ( after match");
×
4362
                                        error = 1;
×
4363
                                        goto endofif;
×
4364
                                } 
4365
                                p++; inp = p;
18✔
4366
                                SKIPBRA4(p);
462✔
4367
                                *p = '=';
18✔
4368
/*
4369
                                Now we can call the reading of the lhs of an id statement.
4370
                                This has to be modified in the future.
4371
*/
4372
                                AT.WorkSpace = AT.WorkPointer = w;
18✔
4373
                                ppp = inp;
18✔
4374
                                while ( FG.cTable[*ppp] == 0 && ppp < p ) ppp++;
72✔
4375
                                if ( *ppp == ',' ) AC.idoption = 0;
18✔
4376
                                else AC.idoption = SUBMULTI;
18✔
4377
                                level = CoIdExpression(inp,TYPEIF);
18✔
4378
                                AT.WorkSpace = OldSpace;
18✔
4379
                                AT.WorkPointer = OldWork;
18✔
4380
                                if ( level != 0 ) {
18✔
4381
                                        if ( level < 0 ) { error = -1; goto endofif; }
×
4382
                                        error = 1;
4383
                                }
4384
/*
4385
                                If we pop numlhs we are in good shape
4386
*/
4387
                                s = u = C->lhs[C->numlhs];
18✔
4388
                                while ( u < C->Pointer ) *w++ = *u++;
750✔
4389
                                C->numlhs--; C->Pointer = s;
18✔
4390
                                *p++ = ')';
18✔
4391
                                inp = p;
18✔
4392
                                gotexp = 1;
18✔
4393
                        }
4394
                        else if ( !StrICmp(inp,(UBYTE *)"multipleof") ) {
×
4395
                                if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
×
4396
                                *p = c;
×
4397
                                if ( c != '(' ) {
×
4398
                                        MesPrint("&no ( after multipleof");
×
4399
                                        error = 1; goto endofif;
×
4400
                                }
4401
                                p++;
×
4402
                                if ( FG.cTable[*p] != 1 ) {
×
4403
Nomulof:                        MesPrint("&multipleof needs a short positive integer argument");
×
4404
                                        error = 1; goto endofif;
×
4405
                                }
4406
                                ParseNumber(x,p)
×
4407
                                if ( *p != ')' || x <= 0 || x > MAXPOSITIVE ) goto Nomulof;
×
4408
                                p++;
×
4409
                                *w++ = MULTIPLEOF; *w++ = 3; *w++ = (WORD)x;
×
4410
                                inp = p;
×
4411
                                gotexp = 1;
×
4412
                        }
4413
                        else {
4414
NoGood:                        MesPrint("&Unrecognized word: %s",inp);
×
4415
                                *p = c;
×
4416
                                error = 1;
×
4417
                                level = 0;
×
4418
                                if ( c == '(' ) SKIPBRA4(p)
×
4419
                                inp = ++p;
×
4420
                                gotexp = 1;
×
4421
                        }
4422
                }
4423
                else if ( *p == 'f' || *p == 'F' ) {        /* FindLoop */
4424
                        if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
×
4425
                        while ( FG.cTable[*++p] == 0 );
×
4426
                        c = *p; *p = 0;
×
4427
                        if ( !StrICmp(inp,(UBYTE *)"findloop") ) {
×
4428
                                *p = c;
×
4429
                                if ( c != '(' ) {
×
4430
                                        MesPrint("&no ( after findloop");
×
4431
                                        error = 1;
×
4432
                                        goto endofif;
×
4433
                                }
4434
                                inp = p;
×
4435
                                SKIPBRA4(p);
×
4436
                                c = *++p; *p = 0; *inp = ',';
×
4437
                                if ( CoFindLoop(inp) ) goto endofif;
×
4438
                                s = u = C->lhs[C->numlhs];
×
4439
                                while ( u < C->Pointer ) *w++ = *u++;
×
4440
                                C->numlhs--; C->Pointer = s;
×
4441
                                *p = c; *inp = '(';
×
4442
                                if ( w == 0 ) { error = 1; goto endofif; }
×
4443
                                gotexp = 1;
4444
                        }
4445
                        else if ( !StrICmp(inp,(UBYTE *)"flag") ) {
×
4446
                                UBYTE cc = c, *pppp;
×
4447
                                *p = cc;
×
4448
                                if ( cc != '(' ) {
×
4449
                                        MesPrint("&no ( after flag");
×
4450
                                        error = 1;
×
4451
                                        goto endofif;
×
4452
                                }
4453
                                inp = p;
×
4454
                                SKIPBRA4(p);
×
4455
                                cc = *++p; *p = 0; *inp = ','; pppp = p;
×
4456
                                ww = w;
×
4457
                                *w++ = IFUSERFLAG; *w++ = 0;
×
4458
                                while ( *inp ) {
×
4459
                                        int x = 0;
×
4460
                                        while ( *inp == ',' ) inp++;
×
4461
                                        if ( *inp == 0 || *inp == ')' ) break;
×
4462
                                        while ( *inp >= '0' && *inp <= '9' ) x = 10*x+(*inp++-'0');
×
4463
                                        if ( x < 1 || x > BITSINWORD ) {
×
4464
                                                MesPrint("&Flag number %d outside the permitted range 1-%d.",BITSINWORD);
×
4465
                                                error = 1;
×
4466
                                        }
4467
                                        *w++ = x-1;
×
4468
                                }
4469
                                ww[1] = w-ww;
×
4470
                                p = pppp; *p = cc; *inp = '(';
×
4471
                                gotexp = 1;
×
4472
                                if ( ww[1] <= 2 ) {
×
4473
                                        MesPrint("&The userflag condition in the if statement needs arguments.");
×
4474
                                        error = 1;
×
4475
                                }
4476
                                inp = p;
×
4477
                                gotexp = 1;
×
4478
                        }
4479
                        else goto NoGood;
×
4480
                }
4481
                else if ( *p == 'e' || *p == 'E' ) { /* Expression */
4482
                        if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
3✔
4483
                        while ( FG.cTable[*++p] == 0 );
30✔
4484
                        c = *p; *p = 0;
3✔
4485
                        if ( !StrICmp(inp,(UBYTE *)"expression") ) {
3✔
4486
                                *p = c;
3✔
4487
                                if ( c != '(' ) {
3✔
4488
                                        MesPrint("&no ( after expression");
×
4489
                                        error = 1;
×
4490
                                        goto endofif;
×
4491
                                }
4492
                                p++; ww = w; *w++ = IFEXPRESSION; w++;
3✔
4493
                                while ( *p != ')' ) {
6✔
4494
                                        if ( *p == ',' ) { p++; continue; }
3✔
4495
                                        if ( *p == '[' || FG.cTable[*p] == 0 ) {
3✔
4496
                                                pp = p;
3✔
4497
                                                if ( ( p = SkipAName(p) ) == 0 ) {
3✔
4498
                                                        MesPrint("&Improper name for an expression: '%s'",pp);
×
4499
                                                        error = 1;
×
4500
                                                        goto endofif;
×
4501
                                                }
4502
                                                c = *p; *p = 0;
3✔
4503
                                                if ( GetName(AC.exprnames,pp,&number,NOAUTO) == CEXPRESSION ) {
3✔
4504
                                                        *w++ = number;
3✔
4505
                                                }
4506
                                                else if ( GetName(AC.varnames,pp,&number,NOAUTO) != NAMENOTFOUND ) {
×
4507
                                                        MesPrint("&%s is not an expression",pp);
×
4508
                                                        error = 1;
×
4509
                                                        *w++ = number;
×
4510
                                                }
4511
                                                *p = c;
3✔
4512
                                        }
4513
                                        else {
4514
                                                MesPrint("&Illegal object in Expression in if-statement");
×
4515
                                                error = 1;
×
4516
                                                while ( *p && *p != ',' && *p != ')' ) p++;
×
4517
                                                if ( *p == 0 || *p == ')' ) break;
×
4518
                                        }
4519
                                }
4520
                                ww[1] = w - ww;
3✔
4521
                                p++;
3✔
4522
                                gotexp = 1;
3✔
4523
                        }
4524
                        else goto NoGood;
×
4525
                        inp = p;
3✔
4526
                }
4527
                else if ( *p == 'i' || *p == 'I' ) { /* IsFactorized */
4528
                        if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
×
4529
                        while ( FG.cTable[*++p] == 0 );
×
4530
                        c = *p; *p = 0;
×
4531
                        if ( !StrICmp(inp,(UBYTE *)"isfactorized") ) {
×
4532
                                *p = c;
×
4533
                                if ( c != '(' ) { /* No expression means current expression */
×
4534
                                  ww = w; *w++ = IFISFACTORIZED; w++;
×
4535
                                }
4536
                                else {
4537
                                  p++; ww = w; *w++ = IFISFACTORIZED; w++;
×
4538
                                  while ( *p != ')' ) {
×
4539
                                        if ( *p == ',' ) { p++; continue; }
×
4540
                                        if ( *p == '[' || FG.cTable[*p] == 0 ) {
×
4541
                                                pp = p;
×
4542
                                                if ( ( p = SkipAName(p) ) == 0 ) {
×
4543
                                                        MesPrint("&Improper name for an expression: '%s'",pp);
×
4544
                                                        error = 1;
×
4545
                                                        goto endofif;
×
4546
                                                }
4547
                                                c = *p; *p = 0;
×
4548
                                                if ( GetName(AC.exprnames,pp,&number,NOAUTO) == CEXPRESSION ) {
×
4549
                                                        *w++ = number;
×
4550
                                                }
4551
                                                else if ( GetName(AC.varnames,pp,&number,NOAUTO) != NAMENOTFOUND ) {
×
4552
                                                        MesPrint("&%s is not an expression",pp);
×
4553
                                                        error = 1;
×
4554
                                                        *w++ = number;
×
4555
                                                }
4556
                                                *p = c;
×
4557
                                        }
4558
                                        else {
4559
                                                MesPrint("&Illegal object in IsFactorized in if-statement");
×
4560
                                                error = 1;
×
4561
                                                while ( *p && *p != ',' && *p != ')' ) p++;
×
4562
                                                if ( *p == 0 || *p == ')' ) break;
×
4563
                                        }
4564
                                  }
4565
                                  p++;
×
4566
                                }
4567
                                ww[1] = w - ww;
×
4568
                                gotexp = 1;
×
4569
                        }
4570
                        else goto NoGood;
×
4571
                        inp = p;
×
4572
                }
4573
                else if ( *p == 'o' || *p == 'O' ) { /* Occurs */
4574
/*
4575
                        Tests whether variables occur inside a term.
4576
                        At the moment this is done one by one.
4577
                        If we want to do them in groups we should do the reading
4578
                        a bit different: each as a variable in a term, and then
4579
                        use Normalize to get the variables grouped and in order.
4580
                        That way FindVar (in if.c) can work more efficiently.
4581
                        Still to be done!!!
4582
                        TASK: Nice little task for someone to learn.
4583
*/
4584
                        UBYTE cc;
18✔
4585
                        if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
18✔
4586
                        while ( FG.cTable[*++p] == 0 );
108✔
4587
                        c = cc = *p; *p = 0;
18✔
4588
                        if ( !StrICmp(inp,(UBYTE *)"occurs") ) {
18✔
4589
                                WORD c1, c2, type;
18✔
4590
                                *p = cc;
18✔
4591
                                if ( cc != '(' ) {
18✔
4592
                                        MesPrint("&no ( after occurs");
×
4593
                                        error = 1;
×
4594
                                        goto endofif;
×
4595
                                }
4596
                                inp = p;
18✔
4597
                                SKIPBRA4(p);
36✔
4598
                                cc = *++p; *p = 0; *inp = ','; pp = p;
18✔
4599
                                ww = w;
18✔
4600
                                *w++ = IFOCCURS; *w++ = 0;
18✔
4601
                                while ( *inp ) {
36✔
4602
                                        while ( *inp == ',' ) inp++;
54✔
4603
                                        if ( *inp == 0 || *inp == ')' ) break;
36✔
4604
/*
4605
                                        Now read a list of names
4606
                                        We can have symbols, vectors, dotproducts, indices, functions.
4607
                                        There could also be dummy indices and/or extra symbols.
4608
*/
4609
                                        if ( *inp == '[' || FG.cTable[*inp] == 0 ) {
18✔
4610
                                                if ( ( p = SkipAName(inp) ) == 0 ) return(0);
18✔
4611
                                                c = *p; *p = 0;
18✔
4612
                                                type = GetName(AC.varnames,inp,&c1,WITHAUTO);
18✔
4613
                                                if ( c == '.' ) {
18✔
4614
                                                        if ( type == CVECTOR || type == CDUBIOUS ) {
×
4615
                                                                *p++ = c;
×
4616
                                                                inp = p;
×
4617
                                                                p = SkipAName(p);
×
4618
                                                                if ( p == 0 ) return(0);
×
4619
                                                                c = *p;
×
4620
                                                                *p = 0;
×
4621
                                                                type = GetName(AC.varnames,inp,&c2,WITHAUTO);
×
4622
                                                                if ( type != CVECTOR && type != CDUBIOUS ) {
×
4623
                                                                        MesPrint("&Not a vector in dotproduct in if statement: %s",inp);
×
4624
                                                                        error = 1;
×
4625
                                                                }
4626
                                                                else type = CDOTPRODUCT;
4627
                                                        }
4628
                                                        else {
4629
                                                                MesPrint("&Illegal use of . after %s in if statement",inp);
×
4630
                                                                if ( type == NAMENOTFOUND )
×
4631
                                                                        MesPrint("&%s is not a properly declared variable",inp);
×
4632
                                                                error = 1;
×
4633
                                                                *p++ = c;
×
4634
                                                                while ( *p && *p != ')' && *p != ',' ) p++;
×
4635
                                                                if ( *p == ',' && FG.cTable[p[1]] == 1 ) {
×
4636
                                                                        p++;
×
4637
                                                                        while ( *p && *p != ')' && *p != ',' ) p++;
×
4638
                                                                }
4639
                                                                continue;
×
4640
                                                        }
4641
                                                }
4642
                                                *p = c;
18✔
4643
                                                switch ( type ) {
18✔
4644
                                                        case CSYMBOL: /* To worry about extra symbols */
6✔
4645
                                                                *w++ = SYMBOL;
6✔
4646
                                                                *w++ = c1;
6✔
4647
                                                        break;
6✔
4648
                                                        case CINDEX:
3✔
4649
                                                                *w++ = INDEX;
3✔
4650
                                                                *w++ = c1 + AM.OffsetIndex;
3✔
4651
                                                        break;
3✔
4652
                                                        case CVECTOR:
3✔
4653
                                                                *w++ = VECTOR;
3✔
4654
                                                                *w++ = c1 + AM.OffsetVector;
3✔
4655
                                                        break;
3✔
4656
                                                        case CDOTPRODUCT:
×
4657
                                                                *w++ = DOTPRODUCT;
×
4658
                                                                *w++ = c1 + AM.OffsetVector;
×
4659
                                                                *w++ = c2 + AM.OffsetVector;
×
4660
                                                        break;
×
4661
                                                        case CFUNCTION:
6✔
4662
                                                                *w++ = FUNCTION;
6✔
4663
                                                                *w++ = c1+FUNCTION;
6✔
4664
                                                        break;
6✔
4665
                                                        default:
×
4666
                                                                MesPrint("&Illegal variable %s in occurs condition in if statement",inp);
×
4667
                                                                error = 1;
×
4668
                                                        break;
×
4669
                                                }
4670
                                                inp = p;
18✔
4671
                                        }
4672
                                        else {
4673
                                                MesPrint("&Illegal object %s in occurs condition in if statement",inp);
×
4674
                                                error = 1;
×
4675
                                                break;
×
4676
                                        }
4677
                                }
4678
                                ww[1] = w-ww;
18✔
4679
                                p = pp; *p = cc; *inp = '(';
18✔
4680
                                gotexp = 1;
18✔
4681
                                if ( ww[1] <= 2 ) {
18✔
4682
                                        MesPrint("&The occurs condition in the if statement needs arguments.");
×
4683
                                        error = 1;
×
4684
                                }
4685
                        }
4686
                        else goto NoGood;
×
4687
                        inp = p;
18✔
4688
                }
4689
                else if ( *p == '$' ) {
4690
                        if ( gotexp == 1 ) { MesCerr("position for )",p); error = 1; }
12✔
4691
                        p++; inp = p;
12✔
4692
                        while ( FG.cTable[*p] == 0 || FG.cTable[*p] == 1 ) p++;
36✔
4693
                        c = *p; *p = 0;
12✔
4694
                        if ( ( i = GetDollar(inp) ) < 0 ) {
12✔
4695
                                MesPrint("&undefined dollar expression %s",inp);
×
4696
                                error = 1;
×
4697
                                i = AddDollar(inp,DOLUNDEFINED,0,0);
×
4698
                        }
4699
                        *p = c;
12✔
4700
                        *w++ = IFDOLLAR; *w++ = 3; *w++ = i;
12✔
4701
/*
4702
                        And then the IFDOLLAREXTRA pieces for [1] [$y] etc
4703
*/
4704
                        if ( *p == '[' ) {
12✔
4705
                                p++;
×
4706
                                if ( ( w = GetIfDollarFactor(&p,w) ) == 0 ) {
×
4707
                                        error = 1;
×
4708
                                        goto endofif;
×
4709
                                }
4710
                                else if ( *p != ']' ) {
×
4711
                                        error = 1;
×
4712
                                        goto endofif;
×
4713
                                }
4714
                                p++;
×
4715
                        }
4716
                        inp = p;
12✔
4717
                        gotexp = 1;
12✔
4718
                }
4719
#ifdef WITHFLOAT
4720
                else if ( *p == '.' ) {
4721
                        pp = CheckFloat(p,&spec);
×
4722
                        if ( pp > p ) goto HaveFloat;
×
4723
                }
4724
#endif
4725
                else if ( *p == '(' ) {
4726
                        if ( gotexp ) {
×
4727
                                MesCerr("parenthesis",p);
×
4728
                                error = 1;
×
4729
                                goto endofif;
×
4730
                        }
4731
                        gotexp = 0;
×
4732
                        if ( ++lenlev >= AC.MaxIf ) DoubleIfBuffers();
×
4733
                        AC.IfCount[lenpp++] = w-OldWork;
×
4734
                        *w++ = SUBEXPR;
×
4735
                        w += 2;
×
4736
                        p++;
×
4737
                }
4738
                else if ( *p == ')' ) {
4739
                        if ( gotexp == 0 ) { MesCerr("position for )",p); error = 1; }
69✔
4740
                        gotexp = 1;
69✔
4741
                        u = AC.IfCount[--lenpp]+OldWork;
69✔
4742
                        lenlev--;
69✔
4743
                        u[1] = w - u;
69✔
4744
                        if ( lenlev <= 0 ) {        /* End if condition */
69✔
4745
                                AT.WorkSpace = OldSpace;
69✔
4746
                                AT.WorkPointer = OldWork;
69✔
4747
                                AddNtoL(OldWork[1],OldWork);
69✔
4748
                                p++;
69✔
4749
                                if ( *p == ')' ) {
69✔
4750
                                        MesPrint("&unmatched parenthesis in if/while ()");
×
4751
                                        error = 1;
×
4752
                                        while ( *++p == ')' );
×
4753
                                }
4754
                                if ( *p ) {
69✔
4755
                                        level = CompileStatement(p);
45✔
4756
                                        if ( level ) error = level;
45✔
4757
                                        while ( *p ) p++;
702✔
4758
                                        if ( CoEndIf(p) && error == 0 ) error = 1;
45✔
4759
                                }
4760
                                return(error);
69✔
4761
                        }
4762
                        p++;
×
4763
                }
4764
                else if ( *p == '>' ) {
4765
                        if ( gotexp == 0 ) goto NoExp;
24✔
4766
                        if ( p[1] == '=' ) { *w++ = GREATEREQUAL; *w++ = 2; p += 2; }
24✔
4767
                        else               { *w++ = GREATER;      *w++ = 2; p++; }
24✔
4768
                        gotexp = 0;
4769
                }
4770
                else if ( *p == '<' ) {
4771
                        if ( gotexp == 0 ) goto NoExp;
3✔
4772
                        if ( p[1] == '=' ) { *w++ = LESSEQUAL; *w++ = 2; p += 2; }
3✔
4773
                        else               { *w++ = LESS;      *w++ = 2; p++; }
3✔
4774
                        gotexp = 0;
4775
                }
4776
                else if ( *p == '=' ) {
4777
                        if ( gotexp == 0 ) goto NoExp;
3✔
4778
                        if ( p[1] == '=' ) p++;
3✔
4779
                        *w++ = EQUAL; *w++ = 2; p++;
3✔
4780
                        gotexp = 0;
3✔
4781
                }
4782
                else if ( *p == '!' && p[1] == '=' ) {
×
4783
                        if ( gotexp == 0 ) { p++; goto NoExp; }
×
4784
                        *w++ = NOTEQUAL; *w++ = 2; p += 2;
×
4785
                        gotexp = 0;
×
4786
                }
4787
                else if ( *p == '|' && p[1] == '|' ) {
×
4788
                        if ( gotexp == 0 ) { p++; goto NoExp; }
×
4789
                        *w++ = ORCOND; *w++ = 2; p += 2;
×
4790
                        gotexp = 0;
×
4791
                }
4792
                else if ( *p == '&' && p[1] == '&' ) {
×
4793
                        if ( gotexp == 0 ) {
×
4794
                                p++;
×
4795
NoExp:                        p++;
×
4796
                                MesCerr("sequence",p);
×
4797
                                error = 1;
×
4798
                        }
4799
                        else {
4800
                                *w++ = ANDCOND; *w++ = 2; p += 2;
×
4801
                                gotexp = 0;
×
4802
                        }
4803
                }
4804
                else if ( *p == 0 ) {
×
4805
                        MesPrint("&Unmatched parentheses");
×
4806
                        error = 1;
×
4807
                        goto endofif;
×
4808
                }
4809
                else {
4810
                        if ( FG.cTable[*p] == 0 ) {
×
4811
                                WORD ij;
4812
                                inp = p;
×
4813
                                while ( ( ij = FG.cTable[*++p] ) == 0 || ij == 1 );
×
4814
                                c = *p; *p = 0;
×
4815
                                goto NoGood;
×
4816
                        }
4817
                        MesCerr("sequence",p);
×
4818
                        error = 1;
×
4819
                        p++;
×
4820
                }
4821
        }
4822
endofif:;
4823
        return(error);
4824
}
4825

4826
/*
4827
          #] CoIf : 
4828
          #[ CoElse :
4829
*/
4830

4831
int CoElse(UBYTE *p)
×
4832
{
4833
        int error = 0;
×
4834
        CBUF *C = cbuf+AC.cbufnum;
×
4835
        if ( *p != 0 ) {
×
4836
                while ( *p == ',' ) p++;
×
4837
                if ( tolower(*p) == 'i' && tolower(p[1]) == 'f' && p[2] == '(' )
×
4838
                                                                                                        return(CoElseIf(p+2));
×
4839
                MesPrint("&No extra text allowed as part of an else statement");
×
4840
                error = 1;
×
4841
        }
4842
        if ( AC.IfLevel <= 0 ) { MesPrint("&else statement without if"); return(1); }
×
4843
        if ( AC.IfSumCheck[AC.IfLevel-1] != NestingChecksum() - 1 ) {
×
4844
                MesNesting();
×
4845
                error = 1;
×
4846
        }
4847
        Add3Com(TYPEELSE,AC.IfLevel)
×
4848
        C->Buffer[AC.IfStack[-1]] = C->numlhs;
×
4849
        AC.IfStack[-1] = C->Pointer - C->Buffer - 1;
×
4850
        return(error);
×
4851
}
4852

4853
/*
4854
          #] CoElse : 
4855
          #[ CoElseIf :
4856
*/
4857

4858
int CoElseIf(UBYTE *inp)
×
4859
{
4860
        CBUF *C = cbuf+AC.cbufnum;
×
4861
        if ( AC.IfLevel <= 0 ) { MesPrint("&elseif statement without if"); return(1); }
×
4862
        Add3Com(TYPEELSE,-AC.IfLevel)
×
4863
        AC.IfLevel--;
×
4864
        C->Buffer[*--AC.IfStack] = C->numlhs;
×
4865
        return(CoIf(inp));
×
4866
}
4867

4868
/*
4869
          #] CoElseIf : 
4870
          #[ CoEndIf :
4871

4872
                It puts a RHS-level at the position indicated in the AC.IfStack.
4873
                This corresponds to the label belonging to a forward goto.
4874
                It is the goto that belongs either to the failing condition
4875
                of the if (no else statement), or the completion of the
4876
                success path (with else statement)
4877
                The code is a jump to the next statement. It is there to prevent
4878
                problems with
4879
                if ( .. )
4880
                        if ( .. ) 
4881
                        endif;
4882
                elseif ( .. )
4883
*/
4884

4885
int CoEndIf(UBYTE *inp)
69✔
4886
{
4887
        CBUF *C = cbuf+AC.cbufnum;
69✔
4888
        WORD i = C->numlhs, to, k = -AC.IfLevel;
69✔
4889
        int error = 0;
69✔
4890
        while ( *inp == ',' ) inp++;
69✔
4891
        if ( *inp != 0 ) {
69✔
4892
                error = 1;
×
4893
                MesPrint("&No extra text allowed as part of an endif/elseif statement");
×
4894
        }
4895
        if ( AC.IfLevel <= 0 ) {
69✔
4896
                MesPrint("&Endif statement without corresponding if"); return(1);
×
4897
        }
4898
        AC.IfLevel--;
69✔
4899
        C->Buffer[*--AC.IfStack] = i+1;
69✔
4900
        if ( AC.IfSumCheck[AC.IfLevel] != NestingChecksum() ) {
69✔
4901
                MesNesting();
×
4902
                error = 1;
×
4903
        }
4904
        Add3Com(TYPEENDIF,i+1)
69✔
4905
/*
4906
        Now the search for the TYPEELSE in front of the elseif statements
4907
*/
4908
        to = C->numlhs;
69✔
4909
    while ( i > 0 ) {
135✔
4910
                if ( C->lhs[i][0] == TYPEELSE && C->lhs[i][2] == to ) to = i;
135✔
4911
                if ( C->lhs[i][0] == TYPEIF ) {
135✔
4912
                        if ( C->lhs[i][2] == to ) {
69✔
4913
                                i--;
69✔
4914
                                if ( i <= 0 || C->lhs[i][0] != TYPEELSE
69✔
4915
                                || C->lhs[i][2] != k ) break;
×
4916
                                C->lhs[i][2] = C->numlhs;
×
4917
                                to = i;
×
4918
                        }
4919
                }
4920
                i--;
66✔
4921
        }
4922
        return(error);
4923
}
4924

4925
/*
4926
          #] CoEndIf : 
4927
          #[ CoWhile :
4928
*/
4929

4930
int CoWhile(UBYTE *inp)
×
4931
{
4932
        CBUF *C = cbuf+AC.cbufnum;
×
4933
        WORD startnum = C->numlhs + 1;
×
4934
        int error;
×
4935
        AC.WhileLevel++;
×
4936
        error = CoIf(inp);
×
4937
        if ( C->numlhs > startnum && C->lhs[startnum][2] == C->numlhs
×
4938
                                                        && C->lhs[C->numlhs][0] == TYPEENDIF ) {
×
4939
                C->lhs[C->numlhs][2] = startnum-1;
×
4940
                AC.WhileLevel--;
×
4941
        }
4942
        else C->lhs[startnum][2] = startnum;
×
4943
        return(error);
×
4944
}
4945

4946
/*
4947
          #] CoWhile : 
4948
          #[ CoEndWhile :
4949
*/
4950

4951
int CoEndWhile(UBYTE *inp)
×
4952
{
4953
        int error = 0;
×
4954
        WORD i;
×
4955
        CBUF *C = cbuf+AC.cbufnum;
×
4956
        if ( AC.WhileLevel <= 0 ) {
×
4957
                MesPrint("&EndWhile statement without corresponding While"); return(1);
×
4958
        }
4959
        AC.WhileLevel--;
×
4960
        i = C->Buffer[AC.IfStack[-1]];
×
4961
        error = CoEndIf(inp);
×
4962
        C->lhs[C->numlhs][2] = i - 1;
×
4963
        return(error);
×
4964
}
4965

4966
/*
4967
          #] CoEndWhile : 
4968
          #[ DoFindLoop :
4969

4970
        Function,arguments=number,loopsize=number,outfun=function,include=index;
4971
*/
4972

4973
static char *messfind[] = {
4974
        "Findloop(function,arguments=#,loopsize(=#|<#)[,include=index])"
4975
   ,"Replaceloop,function,arguments=#,loopsize(=#|<#),outfun=function[,include=index]"
4976
        };
4977
static WORD comfindloop[7] = { TYPEFINDLOOP,7,0,0,0,0,0 };
4978

4979
int DoFindLoop(UBYTE *inp, int mode)
6✔
4980
{
4981
        UBYTE *s, c;
6✔
4982
        WORD funnum, nargs = 0, nloop = 0, indexnum = 0, outfun = 0;
6✔
4983
        int type, aflag, lflag, indflag, outflag, error = 0, sym;
6✔
4984
        while ( *inp == ',' ) inp++;
6✔
4985
        if ( ( s = SkipAName(inp) ) == 0 ) {
6✔
4986
syntax:        MesPrint("&Proper syntax is:");
×
4987
                MesPrint("%s",messfind[mode]);
×
4988
                return(1);
×
4989
        }
4990
        c = *s; *s = 0;
6✔
4991
        if ( ( ( type = GetName(AC.varnames,inp,&funnum,WITHAUTO) ) == NAMENOTFOUND )
6✔
4992
                || type != CFUNCTION || ( ( sym = (functions[funnum].symmetric) & ~REVERSEORDER )
6✔
4993
                != SYMMETRIC && sym != ANTISYMMETRIC ) ) {
6✔
4994
                MesPrint("&%s should be a (anti)symmetric function or tensor",inp);
×
4995
        }
4996
        funnum += FUNCTION;
6✔
4997
        *s = c; inp = s;
6✔
4998
        aflag = lflag = indflag = outflag = 0;
6✔
4999
        while ( *inp == ',' ) {
24✔
5000
                while ( *inp == ',' ) inp++;
36✔
5001
                s = inp;
18✔
5002
                if ( ( s = SkipAName(inp) ) == 0 ) goto syntax;
18✔
5003
                c = *s; *s = 0;
18✔
5004
                if ( StrICont(inp,(UBYTE *)"arguments") == 0 ) {
18✔
5005
                        if ( c != '=' ) goto syntax;
6✔
5006
                        *s++ = c;
6✔
5007
                        NeedNumber(nargs,s,syntax)
18✔
5008
                        aflag++;
6✔
5009
                        inp = s;
6✔
5010
                }
5011
                else if ( StrICont(inp,(UBYTE *)"loopsize") == 0 ) {
12✔
5012
                        if ( c != '=' && c != '<' ) goto syntax;
6✔
5013
                        *s++ = c;
6✔
5014
                        if ( FG.cTable[*s] == 1 ) {
6✔
5015
                                NeedNumber(nloop,s,syntax)
9✔
5016
                                if ( nloop < 2 ) {
3✔
5017
                                        MesPrint("&loopsize should be at least 2");
×
5018
                                        error = 1;
×
5019
                                }
5020
                                if ( c == '<' ) nloop = -nloop;
3✔
5021
                        }
5022
                        else if ( tolower(*s) == 'a' && tolower(s[1]) == 'l'
3✔
5023
                        && tolower(s[2]) == 'l' && FG.cTable[s[3]] > 1 ) {
3✔
5024
                                nloop = -1; s += 3;
3✔
5025
                                if ( c != '=' ) goto syntax;
3✔
5026
                        }
5027
                        inp = s;
6✔
5028
                        lflag++;
6✔
5029
                }
5030
                else if ( StrICont(inp,(UBYTE *)"include") == 0 ) {
6✔
5031
                        if ( c != '=' ) goto syntax;
×
5032
                        *s++ = c;
×
5033
                        if ( ( inp = SkipAName(s) ) == 0 ) goto syntax;
×
5034
                        c = *inp; *inp = 0;
×
5035
                        if ( ( type = GetName(AC.varnames,s,&indexnum,WITHAUTO) ) != CINDEX ) {
×
5036
                                MesPrint("&%s is not a proper index",s);
×
5037
                                error = 1;
×
5038
                        }
5039
                        else if ( indexnum < WILDOFFSET
×
5040
                        && indices[indexnum].dimension == 0 ) {
×
5041
                                MesPrint("&%s should be a summable index",s);
×
5042
                                error = 1;
×
5043
                        }
5044
                        indexnum += AM.OffsetIndex;
×
5045
                        *inp = c;
×
5046
                        indflag++;
×
5047
                }
5048
                else if ( StrICont(inp,(UBYTE *)"outfun") == 0 ) {
6✔
5049
                        if ( c != '=' ) goto syntax;
6✔
5050
                        *s++ = c;
6✔
5051
                        if ( ( inp = SkipAName(s) ) == 0 ) goto syntax;
6✔
5052
                        c = *inp; *inp = 0;
6✔
5053
                        if ( ( type = GetName(AC.varnames,s,&outfun,WITHAUTO) ) != CFUNCTION ) {
6✔
5054
                                MesPrint("&%s is not a proper function or tensor",s);
×
5055
                                error = 1;
×
5056
                        }
5057
                        outfun += FUNCTION;
6✔
5058
                        outflag++;
6✔
5059
                        *inp = c;
6✔
5060
                }
5061
                else {
5062
                        MesPrint("&Unrecognized option in FindLoop or ReplaceLoop: %s",inp);
×
5063
                        *s = c; inp = s;
×
5064
                        while ( *inp && *inp != ',' ) inp++;
×
5065
                }
5066
        }
5067
        if ( *inp != 0 && mode == REPLACELOOP ) goto syntax;
6✔
5068
        if ( mode == FINDLOOP && outflag > 0 ) {
6✔
5069
                MesPrint("&outflag option is illegal in FindLoop");
×
5070
                error = 1;
×
5071
        }
5072
        if ( mode == REPLACELOOP && outflag == 0 ) goto syntax;
6✔
5073
        if ( aflag == 0 || lflag == 0 ) goto syntax;
6✔
5074
        comfindloop[3] = funnum;
6✔
5075
        comfindloop[4] = nloop;
6✔
5076
        comfindloop[5] = nargs;
6✔
5077
        comfindloop[6] = outfun;
6✔
5078
        comfindloop[1] = 7;
6✔
5079
        if ( indflag ) {
6✔
5080
                if ( mode == 0 ) comfindloop[2] =  indexnum + 5;
×
5081
                else             comfindloop[2] = -indexnum - 5;
×
5082
        }
5083
        else comfindloop[2] = mode;
6✔
5084
        AddNtoL(comfindloop[1],comfindloop);
6✔
5085
        return(error);
6✔
5086
}
5087

5088
/*
5089
          #] DoFindLoop : 
5090
          #[ CoFindLoop :
5091
*/
5092

5093
int CoFindLoop(UBYTE *inp)
×
5094
{ return(DoFindLoop(inp,FINDLOOP)); }
×
5095

5096
/*
5097
          #] CoFindLoop : 
5098
          #[ CoReplaceLoop :
5099
*/
5100

5101
int CoReplaceLoop(UBYTE *inp)
6✔
5102
{ return(DoFindLoop(inp,REPLACELOOP)); }
6✔
5103

5104
/*
5105
          #] CoReplaceLoop : 
5106
          #[ CoFunPowers :
5107
*/
5108

5109
static UBYTE *FunPowOptions[] = {
5110
         (UBYTE *)"nofunpowers"
5111
        ,(UBYTE *)"commutingonly"
5112
        ,(UBYTE *)"allfunpowers"
5113
        };
5114

5115
int CoFunPowers(UBYTE *inp)
×
5116
{
5117
        UBYTE *option, c;
×
5118
        int i, maxoptions = sizeof(FunPowOptions)/sizeof(UBYTE *);
×
5119
        while ( *inp == ',' ) inp++;
×
5120
        option = inp;
×
5121
        inp = SkipAName(inp); c = *inp; *inp = 0;
×
5122
        for ( i = 0; i < maxoptions; i++ ) {
×
5123
                if ( StrICont(option,FunPowOptions[i]) == 0 ) {
×
5124
                        if ( c ) {
×
5125
                                *inp = c;
×
5126
                                MesPrint("&Illegal FunPowers statement");
×
5127
                                return(1);
×
5128
                        }
5129
                        AC.funpowers = i;
×
5130
                        return(0);
×
5131
                }
5132
        }
5133
        MesPrint("&Illegal option in FunPowers statement: %s",option);
×
5134
        return(1);
×
5135
}
5136

5137
/*
5138
          #] CoFunPowers : 
5139
          #[ CoUnitTrace :
5140
*/
5141

5142
int CoUnitTrace(UBYTE *s)
×
5143
{
5144
        WORD num;
×
5145
        if ( FG.cTable[*s] == 1 ) {
×
5146
                ParseNumber(num,s)
×
5147
                if ( *s != 0 ) {
×
5148
nogood:                MesPrint("&Value of UnitTrace should be a (positive) number or a symbol");
×
5149
                        return(1);
×
5150
                }
5151
                AC.lUniTrace[0] = SNUMBER;
×
5152
                AC.lUniTrace[2] = num;
×
5153
        }
5154
        else {
5155
                if ( GetName(AC.varnames,s,&num,WITHAUTO) == CSYMBOL ) {
×
5156
                        AC.lUniTrace[0] = SYMBOL;
×
5157
                        AC.lUniTrace[2] = num;
×
5158
                        num = -num;
×
5159
                }
5160
                else goto nogood;
×
5161
                s = SkipAName(s);
×
5162
                if ( *s ) goto nogood;
×
5163
        }
5164
        AC.lUnitTrace = num;
×
5165
        return(0);
×
5166
}
5167

5168
/*
5169
          #] CoUnitTrace : 
5170
          #[ CoTerm :
5171

5172
        Note: termstack holds the offset of the term statement in the compiler
5173
        buffer. termsortstack holds the offset of the last sort statement
5174
                (or the corresponding term statement)
5175
*/
5176

5177
int CoTerm(UBYTE *s)
12✔
5178
{
5179
        GETIDENTITY
8✔
5180
        WORD *w = AT.WorkPointer;
12✔
5181
        int error = 0;
12✔
5182
        while ( *s == ',' ) s++;
12✔
5183
        if ( *s ) {
12✔
5184
                MesPrint("&Illegal syntax for Term statement");
×
5185
                return(1);
×
5186
        }
5187
        if ( AC.termlevel+1 >= AC.maxtermlevel ) {
12✔
5188
                if ( AC.maxtermlevel <= 0 ) {
12✔
5189
                        AC.maxtermlevel = 20;
12✔
5190
                        AC.termstack = (LONG *)Malloc1(AC.maxtermlevel*sizeof(LONG),"termstack");
12✔
5191
                        AC.termsortstack = (LONG *)Malloc1(AC.maxtermlevel*sizeof(LONG),"termsortstack");
12✔
5192
                        AC.termsumcheck = (WORD *)Malloc1(AC.maxtermlevel*sizeof(WORD),"termsumcheck");
12✔
5193
                }
5194
                else {
5195
                        DoubleBuffer((void **)AC.termstack,(void **)AC.termstack+AC.maxtermlevel,
×
5196
                                sizeof(LONG),"doubling termstack");
5197
                        DoubleBuffer((void **)AC.termsortstack,
×
5198
                                (void **)AC.termsortstack+AC.maxtermlevel,
×
5199
                                sizeof(LONG),"doubling termsortstack");
5200
                        DoubleBuffer((void **)AC.termsumcheck,
×
5201
                                (void **)AC.termsumcheck+AC.maxtermlevel,
×
5202
                                sizeof(LONG),"doubling termsumcheck");
5203
                        AC.maxtermlevel *= 2;
×
5204
                }
5205
        }
5206
        AC.termsumcheck[AC.termlevel] = NestingChecksum();
12✔
5207
        AC.termstack[AC.termlevel] = cbuf[AC.cbufnum].Pointer
12✔
5208
                                         - cbuf[AC.cbufnum].Buffer + 2;
12✔
5209
        AC.termsortstack[AC.termlevel] = AC.termstack[AC.termlevel] + 1;
12✔
5210
        AC.termlevel++;
12✔
5211
        *w++ = TYPETERM;
12✔
5212
        w++;
12✔
5213
        *w++ = cbuf[AC.cbufnum].numlhs;
12✔
5214
        *w++ = cbuf[AC.cbufnum].numlhs;
12✔
5215
        AT.WorkPointer[1] = w - AT.WorkPointer;
12✔
5216
        AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
12✔
5217
        return(error);
12✔
5218
}
5219

5220
/*
5221
          #] CoTerm : 
5222
          #[ CoEndTerm :
5223
*/
5224

5225
int CoEndTerm(UBYTE *s)
12✔
5226
{
5227
        CBUF *C = cbuf+AC.cbufnum;
12✔
5228
        while ( *s == ',' ) s++;
12✔
5229
        if ( *s ) {
12✔
5230
                MesPrint("&Illegal syntax for EndTerm statement");
×
5231
                return(1);
×
5232
        }
5233
        if ( AC.termlevel <= 0 ) {
12✔
5234
                MesPrint("&EndTerm without corresponding Argument statement");
×
5235
                return(1);
×
5236
        }
5237
        AC.termlevel--;
12✔
5238
        cbuf[AC.cbufnum].Buffer[AC.termstack[AC.termlevel]] = C->numlhs;
12✔
5239
        cbuf[AC.cbufnum].Buffer[AC.termsortstack[AC.termlevel]] = C->numlhs;
12✔
5240
        if ( AC.termsumcheck[AC.termlevel] != NestingChecksum() ) {
12✔
5241
                MesNesting();
×
5242
                return(1);
×
5243
        }
5244
        return(0);
5245
}
5246

5247
/*
5248
          #] CoEndTerm : 
5249
          #[ CoSort :
5250
*/
5251

5252
int CoSort(UBYTE *s)
84✔
5253
{
5254
        GETIDENTITY
56✔
5255
        WORD *w = AT.WorkPointer;
84✔
5256
        int error = 0;
84✔
5257
        while ( *s == ',' ) s++;
84✔
5258
        if ( *s ) {
84✔
5259
                MesPrint("&Illegal syntax for Sort statement");
×
5260
                error = 1;
×
5261
        }
5262
        if ( AC.termlevel <= 0 ) {
84✔
5263
                MesPrint("&The Sort statement can only be used inside a term environment");
×
5264
                error = 1;
×
5265
        }
5266
        if ( error ) return(error);
84✔
5267
        *w++ = TYPESORT;
84✔
5268
        w++;
84✔
5269
        w++;
84✔
5270
        cbuf[AC.cbufnum].Buffer[AC.termsortstack[AC.termlevel-1]] =
84✔
5271
                                                                                *w = cbuf[AC.cbufnum].numlhs+1;
84✔
5272
        w++;
84✔
5273
        AC.termsortstack[AC.termlevel-1] = cbuf[AC.cbufnum].Pointer
84✔
5274
                                         - cbuf[AC.cbufnum].Buffer + 3;
84✔
5275
        if ( AC.termsumcheck[AC.termlevel-1] != NestingChecksum() - 1 ) {
84✔
5276
                MesNesting();
×
5277
                return(1);
×
5278
        }
5279
        AT.WorkPointer[1] = w - AT.WorkPointer;
84✔
5280
        AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
84✔
5281
        return(error);
84✔
5282
}
5283

5284
/*
5285
          #] CoSort : 
5286
          #[ CoPolyFun :
5287

5288
        Collect,functionname
5289
*/
5290

5291
int CoPolyFun(UBYTE *s)
3✔
5292
{
5293
        GETIDENTITY
2✔
5294
        WORD numfun;
3✔
5295
        int type, error = 0;
3✔
5296
        UBYTE *t;
3✔
5297
        AR.PolyFun = AC.lPolyFun = 0;
3✔
5298
        AR.PolyFunInv = AC.lPolyFunInv = 0;
3✔
5299
        AR.PolyFunType = AC.lPolyFunType = 0;
3✔
5300
        AR.PolyFunExp = AC.lPolyFunExp = 0;
3✔
5301
        AR.PolyFunVar = AC.lPolyFunVar = 0;
3✔
5302
        AR.PolyFunPow = AC.lPolyFunPow = 0;
3✔
5303
        if ( *s == 0 ) { return(0); }
3✔
5304
        t = SkipAName(s);
3✔
5305
        if ( t == 0 || *t != 0 ) {
3✔
5306
                MesPrint("&PolyFun statement needs a single commuting function for its argument");
×
5307
                return(1);
×
5308
        }
5309
        if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
3✔
5310
        || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
3✔
5311
                MesPrint("&%s should be a regular commuting function",s);
×
5312
                if ( type < 0 ) {
×
5313
                        if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
×
5314
                                AddFunction(s,0,0,0,0,0,-1,-1);
×
5315
                }
5316
                error = 1;
5317
        }
5318
        else {
5319
                AR.PolyFun = AC.lPolyFun = numfun+FUNCTION;
3✔
5320
                AR.PolyFunType = AC.lPolyFunType = 1;
3✔
5321
        }
5322
#ifdef WITHFLOAT
5323
        if ( mpfaux_ != 0 ) {
3✔
5324
                MesPrint("&Simultaneous use of PolyFun and float_ is not allowed.");
×
5325
                error = 1;
×
5326
        }
5327
#endif
5328
        return(error);
5329
}
5330

5331
/*
5332
          #] CoPolyFun : 
5333
          #[ CoPolyRatFun :
5334

5335
        PolyRatFun [,functionname[,functionname](option)]
5336
*/
5337

5338
int CoPolyRatFun(UBYTE *s)
117✔
5339
{
5340
        GETIDENTITY
78✔
5341
        WORD numfun;
117✔
5342
        int type, error = 0;
117✔
5343
        UBYTE *t, c;
117✔
5344
        AR.PolyFun = AC.lPolyFun = 0;
117✔
5345
        AR.PolyFunInv = AC.lPolyFunInv = 0;
117✔
5346
        AR.PolyFunType = AC.lPolyFunType = 0;
117✔
5347
        AR.PolyFunExp = AC.lPolyFunExp = 0;
117✔
5348
        AR.PolyFunVar = AC.lPolyFunVar = 0;
117✔
5349
        AR.PolyFunPow = AC.lPolyFunPow = 0;
117✔
5350
        if ( *s == 0 ) return(error);
117✔
5351
        t = SkipAName(s);
111✔
5352
        if ( t == 0 ) goto NumErr;
111✔
5353
        c = *t; *t = 0;
111✔
5354
#ifdef WITHFLOAT
5355
        if ( mpfaux_ != 0 ) {
111✔
5356
                MesPrint("&Simultaneous use of PolyFun and float_ is not allowed.");
×
5357
                error = 1;
×
5358
        }
5359
#endif
5360
        if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
111✔
5361
        || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
111✔
5362
                MesPrint("&%s should be a regular commuting function",s);
×
5363
                if ( type < 0 ) {
×
5364
                        if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
×
5365
                                AddFunction(s,0,0,0,0,0,-1,-1);
×
5366
                }
5367
                return(1);
×
5368
        }
5369
        AR.PolyFun = AC.lPolyFun = numfun+FUNCTION;
111✔
5370
        AR.PolyFunInv = AC.lPolyFunInv = 0;
111✔
5371
        AR.PolyFunType = AC.lPolyFunType = 2;
111✔
5372
        AC.PolyRatFunChanged = 1;
111✔
5373
        if ( c == 0 ) return(error);
111✔
5374
        *t = c;
24✔
5375
        if ( *t == '-' ) { AC.PolyRatFunChanged = 0; t++; }
24✔
5376
        while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
27✔
5377
        if ( *t == 0 ) return(error);
5378
        if ( *t != '(' ) {
5379
                s = t;
3✔
5380
                t = SkipAName(s);
3✔
5381
                if ( t == 0 ) goto NumErr;
3✔
5382
                c = *t; *t = 0;
3✔
5383
                if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
3✔
5384
                || ( functions[numfun].spec != 0 ) || ( functions[numfun].commute != 0 ) ) {
3✔
5385
                        MesPrint("&%s should be a regular commuting function",s);
×
5386
                        if ( type < 0 ) {
×
5387
                                if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
×
5388
                                        AddFunction(s,0,0,0,0,0,-1,-1);
×
5389
                        }
5390
                        return(1);
×
5391
                }
5392
                AR.PolyFunInv = AC.lPolyFunInv = numfun+FUNCTION;
3✔
5393
                if ( c == 0 ) return(error);
3✔
5394
                *t = c;
×
5395
                if ( *t == '-' ) { AC.PolyRatFunChanged = 0; t++; }
×
5396
                while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
×
5397
                if ( *t == 0 ) return(error);
×
5398
        }
5399
        if ( *t == '(' ) {
21✔
5400
                t++;
21✔
5401
                while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
21✔
5402
/*
5403
                Next we need a keyword like
5404
                        (divergence,ep)
5405
                        (expand,ep,maxpow)
5406
*/
5407
                s = t;
21✔
5408
                t = SkipAName(s);
21✔
5409
                if ( t == 0 ) goto NumErr;
21✔
5410
                c = *t; *t = 0;
21✔
5411
                if ( ( StrICmp(s,(UBYTE *)"divergence") == 0 ) 
21✔
5412
                || ( StrICmp(s,(UBYTE *)"finddivergence") == 0 ) ) {
21✔
5413
                        if ( c != ',' ) {
×
5414
                                MesPrint("&Illegal option field in PolyRatFun statement.");
×
5415
                                return(1);
×
5416
                        }
5417
                        *t = c;
×
5418
                        while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
×
5419
                        s = t;
×
5420
                        t = SkipAName(s);
×
5421
                        if ( t == 0 ) goto NumErr;
×
5422
                        c = *t; *t = 0;
×
5423
                        if ( ( type = GetName(AC.varnames,s,&AC.lPolyFunVar,WITHAUTO) ) != CSYMBOL ) {
×
5424
                                MesPrint("&Illegal symbol %s in option field in PolyRatFun statement.",s);
×
5425
                                return(1);
×
5426
                        }
5427
                        *t = c;
×
5428
                        while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
×
5429
                        if ( *t != ')' ) {
×
5430
                                MesPrint("&Illegal termination of option in PolyRatFun statement.");
×
5431
                                return(1);
×
5432
                        }
5433
                        AR.PolyFunExp = AC.lPolyFunExp = 1;
×
5434
                        AR.PolyFunVar = AC.lPolyFunVar;
×
5435
                        symbols[AC.lPolyFunVar].minpower = -MAXPOWER;
×
5436
                        symbols[AC.lPolyFunVar].maxpower =  MAXPOWER;
×
5437
                }
5438
                else if ( StrICmp(s,(UBYTE *)"expand") == 0 ) {
21✔
5439
                        WORD x = 0, etype = 2;
21✔
5440
                        if ( c != ',' ) {
21✔
5441
                                MesPrint("&Illegal option field in PolyRatFun statement.");
×
5442
                                return(1);
×
5443
                        }
5444
                        *t = c;
21✔
5445
                        while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
42✔
5446
                        s = t;
21✔
5447
                        t = SkipAName(s);
21✔
5448
                        if ( t == 0 ) goto NumErr;
21✔
5449
                        c = *t; *t = 0;
21✔
5450
                        if ( ( type = GetName(AC.varnames,s,&AC.lPolyFunVar,WITHAUTO) ) != CSYMBOL ) {
21✔
5451
                                MesPrint("&Illegal symbol %s in option field in PolyRatFun statement.",s);
×
5452
                                return(1);
×
5453
                        }
5454
                        *t = c;
21✔
5455
                        while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
42✔
5456
                        if ( *t > '9' || *t < '0' ) {
21✔
5457
                                MesPrint("&Illegal option field in PolyRatFun statement.");
×
5458
                                return(1);
×
5459
                        }
5460
                        while ( *t <= '9' && *t >= '0' ) x = 10*x + *t++ - '0';
42✔
5461
                        while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
21✔
5462
                        if ( *t != ')' ) {
21✔
5463
                                s = t;
×
5464
                                t = SkipAName(s);
×
5465
                                if ( t == 0 ) goto ParErr;
×
5466
                                c = *t; *t = 0;
×
5467
                                if ( StrICmp(s,(UBYTE *)"fixed") == 0 ) {
×
5468
                                        etype = 3;
5469
                                }
5470
                                else if ( StrICmp(s,(UBYTE *)"relative") == 0 ) {
×
5471
                                        etype = 2;
5472
                                }
5473
                                else {
5474
                                        MesPrint("&Illegal termination of option in PolyRatFun statement.");
×
5475
                                        return(1);
×
5476
                                }
5477
                                *t = c;
×
5478
                                while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
×
5479
                                if ( *t != ')' ) {
×
5480
                                        MesPrint("&Illegal termination of option in PolyRatFun statement.");
×
5481
                                        return(1);
×
5482
                                }
5483
                        }
5484
                        AR.PolyFunExp = AC.lPolyFunExp = etype;
21✔
5485
                        AR.PolyFunVar = AC.lPolyFunVar;
21✔
5486
                        AR.PolyFunPow = AC.lPolyFunPow = x;
21✔
5487
                        symbols[AC.lPolyFunVar].minpower = -MAXPOWER;
21✔
5488
                        symbols[AC.lPolyFunVar].maxpower =  MAXPOWER;
21✔
5489
                }
5490
                else {
5491
ParErr:                MesPrint("&Illegal option %s in PolyRatFun statement.",s);
×
5492
                        return(1);
×
5493
                }
5494
                t++;
21✔
5495
                while ( *t == ',' || *t == ' ' || *t == '\t' ) t++;
21✔
5496
                if ( *t == 0 ) return(error);
21✔
5497
        }
5498
NumErr:;
×
5499
        MesPrint("&PolyRatFun statement needs one or two commuting function(s) for its argument(s)");
×
5500
        return(1);
×
5501
}
5502

5503
/*
5504
          #] CoPolyRatFun : 
5505
          #[ CoMerge :
5506
*/
5507

5508
int CoMerge(UBYTE *inp)
3✔
5509
{
5510
        UBYTE *s = inp;
3✔
5511
        int type;
3✔
5512
        WORD numfunc, option = 0;
3✔
5513
        if ( tolower(s[0]) == 'o' && tolower(s[1]) == 'n' && tolower(s[2]) == 'c' &&
3✔
5514
             tolower(s[3]) == 'e' && tolower(s[4]) == ',' ) {
×
5515
                option = 1; s += 5;
×
5516
        }
5517
        else if ( tolower(s[0]) == 'a' && tolower(s[1]) == 'l' && tolower(s[2]) == 'l' &&
3✔
5518
             tolower(s[3]) == ',' ) {
×
5519
                option = 0; s += 4;
×
5520
        }
5521
        if ( *s == '$' ) {
3✔
5522
                if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
×
5523
                        numfunc = -numfunc;
×
5524
                else {
5525
                        MesPrint("&%s is undefined",s);
×
5526
                        numfunc = AddDollar(s+1,DOLINDEX,&one,1);
×
5527
                        return(1);
×
5528
                }
5529
tests:        s = SkipAName(s);
3✔
5530
                if ( *s != 0 ) {
3✔
5531
                        MesPrint("&Merge/shuffle should have a single function or $variable for its argument");
×
5532
                        return(1);
×
5533
                }
5534
        }
5535
        else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
3✔
5536
                numfunc += FUNCTION;
3✔
5537
                goto tests;
3✔
5538
        }
5539
        else if ( type != -1 ) {
×
5540
                if ( type != CDUBIOUS ) {
×
5541
                        NameConflict(type,s);
×
5542
                        type = MakeDubious(AC.varnames,s,&numfunc);
×
5543
                }
5544
                return(1);
×
5545
        }
5546
        else {
5547
                MesPrint("&%s is not a function",s);
×
5548
                numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
×
5549
                return(1);
×
5550
        }
5551
        Add4Com(TYPEMERGE,numfunc,option);
3✔
5552
        return(0);
3✔
5553
}
5554

5555
/*
5556
          #] CoMerge : 
5557
          #[ CoStuffle :
5558

5559
        Important for future options: The bit, given by 256 (bit 8) is reserved
5560
        internally for keeping track of the sign in the number of Stuffle
5561
        additions.
5562
*/
5563

5564
int CoStuffle(UBYTE *inp)
3✔
5565
{
5566
        UBYTE *s = inp, *ss, c;
3✔
5567
        int type;
3✔
5568
        WORD numfunc, option = 0;
3✔
5569
        if ( tolower(s[0]) == 'o' && tolower(s[1]) == 'n' && tolower(s[2]) == 'c' &&
3✔
5570
             tolower(s[3]) == 'e' && tolower(s[4]) == ',' ) {
×
5571
                option = 1; s += 5;
×
5572
        }
5573
        else if ( tolower(s[0]) == 'a' && tolower(s[1]) == 'l' && tolower(s[2]) == 'l' &&
3✔
5574
             tolower(s[3]) == ',' ) {
×
5575
                option = 0; s += 4;
×
5576
        }
5577
        ss = SkipAName(s);
3✔
5578
        c = *ss; *ss = 0;
3✔
5579
        if ( *s == '$' ) {
3✔
5580
                if ( ( type = GetName(AC.dollarnames,s+1,&numfunc,NOAUTO) ) == CDOLLAR )
×
5581
                        numfunc = -numfunc;
×
5582
                else {
5583
                        MesPrint("&%s is undefined",s);
×
5584
                        numfunc = AddDollar(s+1,DOLINDEX,&one,1);
×
5585
                        return(1);
×
5586
                }
5587
tests:        *ss = c;
3✔
5588
                if ( *ss != '+' && *ss != '-' && ss[1] != 0 ) {
3✔
5589
                        MesPrint("&Stuffle should have a single function or $variable for its argument, followed by either + or -");
×
5590
                        return(1);
×
5591
                }
5592
                if ( *ss == '-' ) option += 2;
3✔
5593
        }
5594
        else if ( ( type = GetName(AC.varnames,s,&numfunc,WITHAUTO) ) == CFUNCTION ) {
3✔
5595
                numfunc += FUNCTION;
3✔
5596
                goto tests;
3✔
5597
        }
5598
        else if ( type != -1 ) {
×
5599
                if ( type != CDUBIOUS ) {
×
5600
                        NameConflict(type,s);
×
5601
                        type = MakeDubious(AC.varnames,s,&numfunc);
×
5602
                }
5603
                return(1);
×
5604
        }
5605
        else {
5606
                MesPrint("&%s is not a function",s);
×
5607
                numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
×
5608
                return(1);
×
5609
        }
5610
        Add4Com(TYPESTUFFLE,numfunc,option);
3✔
5611
        return(0);
3✔
5612
}
5613

5614
/*
5615
          #] CoStuffle : 
5616
          #[ CoProcessBucket :
5617
*/
5618

5619
int CoProcessBucket(UBYTE *s)
×
5620
{
5621
        LONG x;
×
5622
        while ( *s == ',' || *s == '=' ) s++;
×
5623
        ParseNumber(x,s)
×
5624
        if ( *s && *s != ' ' && *s != '\t' ) {
×
5625
                MesPrint("&Numerical value expected for ProcessBucketSize");
×
5626
                return(1);
×
5627
        }
5628
        AC.ProcessBucketSize = x;
×
5629
        return(0);
×
5630
}
5631

5632
/*
5633
          #] CoProcessBucket : 
5634
          #[ CoThreadBucket :
5635
*/
5636

5637
int CoThreadBucket(UBYTE *s)
×
5638
{
5639
        LONG x;
×
5640
        while ( *s == ',' || *s == '=' ) s++;
×
5641
        ParseNumber(x,s)
×
5642
        if ( *s && *s != ' ' && *s != '\t' ) {
×
5643
                MesPrint("&Numerical value expected for ThreadBucketSize");
×
5644
                return(1);
×
5645
        }
5646
        if ( x <= 0 ) {
×
5647
                Warning("Negative of zero value not allowed for ThreadBucketSize. Adjusted to 1.");
×
5648
                x = 1;
×
5649
        }
5650
        AC.ThreadBucketSize = x;
×
5651
#ifdef WITHPTHREADS
5652
        if ( AS.MultiThreaded ) MakeThreadBuckets(-1,1);
5653
#endif
5654
        return(0);
5655
}
5656

5657
/*
5658
          #] CoThreadBucket : 
5659
          #[ DoArgPlode :
5660

5661
        Syntax: a list of functions.
5662
        If the functions have an argument it must be a function.
5663
        In the case f(g) we treat f(g(...)) with g any argument.
5664
          (not yet implemented)
5665
*/
5666

5667
int DoArgPlode(UBYTE *s, int par)
6✔
5668
{
5669
        GETIDENTITY
4✔
5670
        WORD numfunc, type, error = 0, *w, n;
6✔
5671
        UBYTE *t,c;
6✔
5672
        int i;
6✔
5673
        w = AT.WorkPointer;
6✔
5674
        *w++ = par;
6✔
5675
        w++;
6✔
5676
        while ( *s == ',' ) s++;
6✔
5677
        while ( *s ) {
12✔
5678
                if ( *s == '$' ) {
6✔
5679
                        MesPrint("&We don't do dollar variables yet in ArgImplode/ArgExplode");
×
5680
                        return(1);
×
5681
                }
5682
                t = s;
6✔
5683
                if ( ( s = SkipAName(s) ) == 0 ) return(1);
6✔
5684
                c = *s; *s = 0;
6✔
5685
                if ( ( type = GetName(AC.varnames,t,&numfunc,WITHAUTO) ) == CFUNCTION ) {
6✔
5686
                        numfunc += FUNCTION;
6✔
5687
                }
5688
                else if ( type != -1 ) {
×
5689
                        if ( type != CDUBIOUS ) {
×
5690
                                NameConflict(type,t);
×
5691
                                type = MakeDubious(AC.varnames,t,&numfunc);
×
5692
                        }
5693
                        error = 1;
5694
                }
5695
                else {
5696
                        MesPrint("&%s is not a function",t);
×
5697
                        numfunc = AddFunction(s,0,0,0,0,0,-1,-1) + FUNCTION;
×
5698
                        return(1);
×
5699
                }
5700
                *s = c;
6✔
5701
                *w++ = numfunc;
6✔
5702
                *w++ = FUNHEAD;
6✔
5703
#if FUNHEAD > 2
5704
                for ( i = 2; i < FUNHEAD; i++ ) *w++ = 0;
12✔
5705
#endif
5706
                if ( *s && *s != ',' ) {
6✔
5707
                        MesPrint("&Illegal character in ArgImplode/ArgExplode statement: %s",s);
×
5708
                        return(1);
×
5709
                }
5710
                while ( *s == ',' ) s++;
6✔
5711
        }
5712
        n = w - AT.WorkPointer;
6✔
5713
        AT.WorkPointer[1] = n;
6✔
5714
        AddNtoL(n,AT.WorkPointer);
6✔
5715
        return(error);
6✔
5716
}
5717

5718
/*
5719
          #] DoArgPlode : 
5720
          #[ CoArgExplode :
5721
*/
5722

5723
int CoArgExplode(UBYTE *s) { return(DoArgPlode(s,TYPEARGEXPLODE)); }
3✔
5724

5725
/*
5726
          #] CoArgExplode : 
5727
          #[ CoArgImplode :
5728
*/
5729

5730
int CoArgImplode(UBYTE *s) { return(DoArgPlode(s,TYPEARGIMPLODE)); }
3✔
5731

5732
/*
5733
          #] CoArgImplode : 
5734
          #[ CoClearTable :
5735
*/
5736

5737
int CoClearTable(UBYTE *s)
×
5738
{
5739
        UBYTE c, *t;
×
5740
        int j, type, error = 0;
×
5741
        WORD numfun;
×
5742
        TABLES T, TT;
×
5743
        if ( *s == 0 ) {
×
5744
                MesPrint("&The ClearTable statement needs at least one (table) argument.");
×
5745
                return(1);
×
5746
        }
5747
        while ( *s ) {
×
5748
                t = s;
×
5749
                s = SkipAName(s);
×
5750
                c = *s; *s = 0;
×
5751
                if ( ( ( type = GetName(AC.varnames,t,&numfun,WITHAUTO) ) != CFUNCTION )
×
5752
                && type != CDUBIOUS ) {
×
5753
nofunc:                MesPrint("&%s is not a table",t);
×
5754
                        error = 4;
×
5755
                        if ( type < 0 ) numfun = AddFunction(t,0,0,0,0,0,-1,-1);
×
5756
                        *s = c;
×
5757
                        if ( *s == ',' ) s++;
×
5758
                        continue;
×
5759
                }
5760
/*
5761
                else if ( ( ( T = functions[numfun].tabl ) == 0 )
5762
                 || ( T->sparse == 0 ) ) goto nofunc;
5763
*/
5764
                else if ( ( T = functions[numfun].tabl ) == 0 ) goto nofunc;
×
5765
                numfun += FUNCTION;
×
5766
                *s = c;
×
5767
                if ( *s == ',' ) s++;
×
5768
/*
5769
                Now we clear the table.
5770
*/
5771
                if ( T->sparse ) {
×
5772
                if ( T->boomlijst ) M_free(T->boomlijst,"TableTree");
×
5773
                for (j = 0; j < T->buffersfill; j++ ) { /* was <= */
×
5774
                        finishcbuf(T->buffers[j]);
×
5775
                }
5776
                if ( T->buffers ) M_free(T->buffers,"Table buffers");
×
5777
                finishcbuf(T->bufnum);
×
5778

5779
                T->boomlijst = 0;
×
5780
                T->numtree = 0; T->rootnum = 0; T->MaxTreeSize = 0;
×
5781
                T->boomlijst = 0;
×
5782
                T->bufnum = inicbufs();
×
5783
                T->bufferssize = 8;
×
5784
                T->buffers = (WORD *)Malloc1(sizeof(WORD)*T->bufferssize,"Table buffers");
×
5785
                T->buffersfill = 0;
×
5786
                T->buffers[T->buffersfill++] = T->bufnum;
×
5787

5788
                T->totind = 0;                        /* At the moment there are this many */
×
5789
                T->reserved = 0;
×
5790

5791
                ClearTableTree(T);
×
5792

5793
                if ( T->spare ) {
×
5794
                        if ( T->tablepointers ) M_free(T->tablepointers,"tablepointers");
×
5795
                        T->tablepointers = 0;
×
5796
                        TT = T->spare;
×
5797
                        if ( TT->tablepointers ) M_free(TT->tablepointers,"tablepointers");
×
5798
                        for (j = 0; j < TT->buffersfill; j++ ) {
×
5799
                                finishcbuf(TT->buffers[j]);
×
5800
                        }
5801
                        if ( TT->boomlijst ) M_free(TT->boomlijst,"TableTree");
×
5802
                        if ( TT->buffers )M_free(TT->buffers,"Table buffers");
×
5803
                        if ( TT->mm ) M_free(TT->mm,"tableminmax");
×
5804
                        if ( TT->flags ) M_free(TT->flags,"tableflags");
×
5805
                        M_free(TT,"table");
×
5806
                        SpareTable(T);
×
5807
                }
5808
                }
5809
                else EmptyTable(T);
×
5810
        }
5811
        return(error);
5812
}
5813

5814
/*
5815
          #] CoClearTable : 
5816
          #[ CoDenominators :
5817
*/
5818

5819
int CoDenominators(UBYTE *s)
3✔
5820
{
5821
        WORD numfun;
3✔
5822
        int type;
3✔
5823
        UBYTE *t = SkipAName(s), *t1;
3✔
5824
        if ( t == 0 ) goto syntaxerror;
3✔
5825
        t1 = t; while ( *t1 == ',' || *t1 == ' ' || *t1 == '\t' ) t1++;
3✔
5826
        if ( *t1 ) goto syntaxerror;
3✔
5827
        *t = 0;
3✔
5828
        if ( ( ( type = GetName(AC.varnames,s,&numfun,WITHAUTO) ) != CFUNCTION )
3✔
5829
        || ( functions[numfun].spec != 0 ) ) {
3✔
5830
                if ( type < 0 ) {
×
5831
                        if ( GetName(AC.exprnames,s,&numfun,NOAUTO) == NAMENOTFOUND )
×
5832
                                AddFunction(s,0,0,0,0,0,-1,-1);
×
5833
                }
5834
                goto syntaxerror;
×
5835
        }
5836
        Add3Com(TYPEDENOMINATORS,numfun+FUNCTION);
3✔
5837
        return(0);
3✔
5838
syntaxerror:
×
5839
        MesPrint("&Denominators statement needs one regular function for its argument");
×
5840
        return(1);
×
5841
}
5842

5843
/*
5844
          #] CoDenominators : 
5845
          #[ CoDropCoefficient :
5846
*/
5847

5848
int CoDropCoefficient(UBYTE *s)
12✔
5849
{
5850
        if ( *s == 0 ) {
12✔
5851
                Add2Com(TYPEDROPCOEFFICIENT)
12✔
5852
                return(0);
12✔
5853
        }
5854
        MesPrint("&Illegal argument in DropCoefficient statement: '%s'",s);
×
5855
        return(1);
×
5856
}
5857
/*
5858
          #] CoDropCoefficient : 
5859
          #[ CoDropSymbols :
5860
*/
5861

5862
int CoDropSymbols(UBYTE *s)
×
5863
{
5864
        if ( *s == 0 ) {
×
5865
                Add2Com(TYPEDROPSYMBOLS)
×
5866
                return(0);
×
5867
        }
5868
        MesPrint("&Illegal argument in DropSymbols statement: '%s'",s);
×
5869
        return(1);
×
5870
}
5871
/*
5872
          #] CoDropSymbols : 
5873
          #[ CoToPolynomial :
5874

5875
        Converts the current term as much as possible to symbols.
5876
        Keeps a list of all objects converted to symbols in AM.sbufnum.
5877
        Note that this cannot be executed in parallel because we have only
5878
        a single compiler buffer for this. Hence we switch on the noparallel
5879
        module option.
5880

5881
        Option(s):
5882
                OnlyFunctions [,name1][,name2][,...,namem];
5883
*/
5884

5885
int CoToPolynomial(UBYTE *inp)
6✔
5886
{
5887
        int error = 0;
6✔
5888
        while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
6✔
5889
        if ( ( AC.topolynomialflag & ~TOPOLYNOMIALFLAG ) != 0 ) {
6✔
5890
                MesPrint("&ToPolynomial statement and FactArg statement are not allowed in the same module");
×
5891
                return(1);
×
5892
        }
5893
        if ( AO.OptimizeResult.code != NULL ) {
6✔
5894
                MesPrint("&Using ToPolynomial statement when there are still optimization results active.");
×
5895
                MesPrint("&Please use #ClearOptimize instruction first.");
×
5896
                MesPrint("&This will loose the optimized expression.");
×
5897
                return(1);
×
5898
        }
5899
        if ( *inp == 0 ) {
6✔
5900
                Add3Com(TYPETOPOLYNOMIAL,DOALL)
6✔
5901
        }
5902
        else {
5903
                int numargs = 0;
×
5904
                WORD *funnums = 0, type, num;
×
5905
                UBYTE *s, c;
×
5906
                s = SkipAName(inp);
×
5907
                if ( s == 0 ) return(1);
×
5908
                c = *s; *s = 0;
×
5909
                if ( StrICmp(inp,(UBYTE *)"onlyfunctions") ) {
×
5910
                        MesPrint("&Illegal option %s in ToPolynomial statement",inp);
×
5911
                        *s = c;
×
5912
                        return(1);
×
5913
                }
5914
                *s = c;
×
5915
                inp = s;
×
5916
                while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
×
5917
                s = inp;
5918
                while ( *s ) s++;
×
5919
/*
5920
                Get definitely enough space for the numbers of the functions
5921
*/
5922
                funnums = (WORD *)Malloc1(((LONG)(s-inp)+3)*sizeof(WORD),"ToPlynomial");
×
5923
                while ( *inp ) {
×
5924
                        s = SkipAName(inp);
×
5925
                        if ( s == 0 ) return(1);
×
5926
                        c = *s; *s = 0;
×
5927
                    type = GetName(AC.varnames,inp,&num,WITHAUTO);
×
5928
                        if ( type != CFUNCTION ) {
×
5929
                                MesPrint("&%s is not a function in ToPolynomial statement",inp);
×
5930
                                error = 1;
×
5931
                        }
5932
                        funnums[3+numargs++] = num+FUNCTION;
×
5933
                        *s = c;
×
5934
                        inp = s;
×
5935
                        while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
×
5936
                }
5937
                funnums[0] = TYPETOPOLYNOMIAL;
×
5938
                funnums[1] = numargs+3;
×
5939
                funnums[2] = ONLYFUNCTIONS;
×
5940

5941
                AddNtoL(numargs+3,funnums);
×
5942
                if ( funnums ) M_free(funnums,"ToPolynomial");
×
5943
        }
5944
        AC.topolynomialflag |= TOPOLYNOMIALFLAG;
6✔
5945
#ifdef WITHMPI
5946
        /* In ParFORM, ToPolynomial has to be executed on the master. */
5947
        AC.mparallelflag |= NOPARALLEL_CONVPOLY;
5948
#endif
5949
        return(error);
6✔
5950
}
5951

5952
/*
5953
          #] CoToPolynomial : 
5954
          #[ CoFromPolynomial :
5955

5956
        Converts the current term as much as possible back from extra symbols
5957
        to their original values. Does not look inside functions.
5958
*/
5959

5960
int CoFromPolynomial(UBYTE *inp)
6✔
5961
{
5962
        while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
6✔
5963
        if ( *inp == 0 ) {
6✔
5964
                if ( AO.OptimizeResult.code != NULL ) {
6✔
5965
                        MesPrint("&Using FromPolynomial statement when there are still optimization results active.");
×
5966
                        MesPrint("&Please use #ClearOptimize instruction first.");
×
5967
                        MesPrint("&This will loose the optimized expression.");
×
5968
                        return(1);
×
5969
                }
5970
                Add2Com(TYPEFROMPOLYNOMIAL)
6✔
5971
                return(0);
6✔
5972
        }
5973
        MesPrint("&Illegal argument in FromPolynomial statement: '%s'",inp);
×
5974
        return(1);
×
5975
}
5976

5977
/*
5978
          #] CoFromPolynomial : 
5979
          #[ CoArgToExtraSymbol :
5980

5981
        Converts the specified function arguments into extra symbols.
5982

5983
        Syntax: ArgToExtraSymbol [ToNumber] [<argument specifications>]
5984
*/
5985

5986
int CoArgToExtraSymbol(UBYTE *s)
15✔
5987
{
5988
        CBUF *C = cbuf + AC.cbufnum;
15✔
5989
        WORD *lhs;
15✔
5990

5991
        /* TODO: resolve interference with rational arithmetic. (#138) */
5992
        if ( ( AC.topolynomialflag & ~TOPOLYNOMIALFLAG ) != 0 ) {
15✔
5993
                MesPrint("&ArgToExtraSymbol statement and FactArg statement are not allowed in the same module");
×
5994
                return(1);
×
5995
        }
5996
        if ( AO.OptimizeResult.code != NULL ) {
15✔
5997
                MesPrint("&Using ArgToExtraSymbol statement when there are still optimization results active.");
×
5998
                MesPrint("&Please use #ClearOptimize instruction first.");
×
5999
                MesPrint("&This will loose the optimized expression.");
×
6000
                return(1);
×
6001
        }
6002

6003
        SkipSpaces(&s);
15✔
6004
        int tonumber = ConsumeOption(&s, "tonumber");
15✔
6005

6006
        int ret = DoArgument(s,TYPEARGTOEXTRASYMBOL);
15✔
6007
        if ( ret ) return(ret);
15✔
6008

6009
        /*
6010
         * The "scale" parameter is unused. Instead, we put the "tonumber"
6011
         * parameter.
6012
         */
6013
        lhs = C->lhs[C->numlhs];
15✔
6014
        if ( lhs[4] != 1 ) {
15✔
6015
                Warning("scale parameter (^n) is ignored in ArgToExtraSymbol");
×
6016
        }
6017
        lhs[4] = tonumber;
15✔
6018

6019
        AC.topolynomialflag |= TOPOLYNOMIALFLAG;  /* This flag is also used in ParFORM. */
15✔
6020
#ifdef WITHMPI
6021
        /*
6022
         * In ParFORM, the conversion to extra symbols has to be performed on
6023
         * the master.
6024
         */
6025
        AC.mparallelflag |= NOPARALLEL_CONVPOLY;
6026
#endif
6027

6028
        return(0);
15✔
6029
}
6030

6031
/*
6032
          #] CoArgToExtraSymbol : 
6033
          #[ CoExtraSymbols :
6034
*/
6035

6036
int CoExtraSymbols(UBYTE *inp)
12✔
6037
{
6038
        UBYTE *arg1, *arg2, c, *s;
12✔
6039
        WORD i, j, type, number;
12✔
6040
        while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
12✔
6041
        if ( FG.cTable[*inp] != 0 ) {
12✔
6042
                MesPrint("&Illegal argument in ExtraSymbols statement: '%s'",inp);
×
6043
                return(1);
×
6044
        }
6045
        arg1 = inp;
6046
        while ( FG.cTable[*inp] == 0 ) inp++;
87✔
6047
        c = *inp; *inp = 0;
12✔
6048
        if ( ( StrICmp(arg1,(UBYTE *)"array") == 0 )
12✔
6049
                        || ( StrICmp(arg1,(UBYTE *)"vector") == 0 ) ) {
3✔
6050
                AC.extrasymbols = 1;
9✔
6051
        }
6052
        else if ( StrICmp(arg1,(UBYTE *)"underscore") == 0 ) {
3✔
6053
                AC.extrasymbols = 0;
3✔
6054
        }
6055
/*
6056
        else if ( StrICmp(arg1,(UBYTE *)"nothing") == 0 ) {
6057
                AC.extrasymbols = 2;
6058
        }
6059
*/
6060
        else {
6061
                MesPrint("&Illegal keyword in ExtraSymbols statement: '%s'",arg1);
×
6062
                return(1);
×
6063
        }
6064
        *inp = c;
12✔
6065
        while ( *inp == ' ' || *inp == ',' || *inp == '\t' ) inp++;
24✔
6066
        if ( FG.cTable[*inp] != 0 ) {
12✔
6067
                MesPrint("&Illegal argument in ExtraSymbols statement: '%s'",inp);
×
6068
                return(1);
×
6069
        }
6070
        arg2 = inp;
6071
        while ( FG.cTable[*inp] <= 1 ) inp++;
24✔
6072
        if ( *inp != 0 ) {
12✔
6073
                MesPrint("&Illegal end of ExtraSymbols statement: '%s'",inp);
×
6074
                return(1);
×
6075
        }
6076
/*
6077
                Now check whether this object has been declared already.
6078
                That would not be allowed.
6079
*/
6080
        if ( AC.extrasymbols == 1 ) {
12✔
6081
                type = GetName(AC.varnames,arg2,&number,NOAUTO);
9✔
6082
                if ( type != NAMENOTFOUND ) {
9✔
6083
                        MesPrint("&ExtraSymbols statement: '%s' has already been declared before",arg2);
×
6084
                        return(1);
×
6085
                }
6086
        }
6087
        else if ( AC.extrasymbols == 0 ) {
3✔
6088
                if ( *arg2 == 'N' ) {
3✔
6089
                        s = arg2+1;
×
6090
                        while ( FG.cTable[*s] == 1 ) s++;
×
6091
                        if ( *s == 0 ) {
×
6092
                                MesPrint("&ExtraSymbols statement: '%s' creates conflicts with summed indices",arg2);
×
6093
                                return(1);
×
6094
                        }
6095
                }
6096
        }
6097
        if ( AC.extrasym ) { M_free(AC.extrasym,"extrasym"); AC.extrasym = 0; }
12✔
6098
        i = inp - arg2 + 1;
12✔
6099
        AC.extrasym = (UBYTE *)Malloc1(i*sizeof(UBYTE),"extrasym");
12✔
6100
        for ( j = 0; j < i; j++ ) AC.extrasym[j] = arg2[j];
36✔
6101
        return(0);
6102
}
6103

6104
/*
6105
          #] CoExtraSymbols : 
6106
          #[ GetIfDollarFactor :
6107
*/
6108

6109
WORD *GetIfDollarFactor(UBYTE **inp, WORD *w)
×
6110
{
6111
        LONG x;
×
6112
        WORD number;
×
6113
        UBYTE *name, c, *s;
×
6114
        s = *inp;
×
6115
        if ( FG.cTable[*s] == 1 ) {
×
6116
                x = 0;
6117
                while ( FG.cTable[*s] == 1 ) {
×
6118
                        x = 10*x + *s++ - '0';
×
6119
                        if ( x >= MAXPOSITIVE ) {
×
6120
                                MesPrint("&Value in dollar factor too large");
×
6121
                                while ( FG.cTable[*s] == 1 ) s++;
×
6122
                                *inp = s;
×
6123
                                return(0);
×
6124
                        }
6125
                }
6126
                *w++ = IFDOLLAREXTRA;
×
6127
                *w++ = 3;
×
6128
                *w++ = -x-1;
×
6129
                *inp = s;
×
6130
                return(w);
×
6131
        }
6132
        if ( *s != '$' ) {
×
6133
                MesPrint("&Factor indicator for $-variable should be a number or a $-variable.");
×
6134
                return(0);
×
6135
        }
6136
        s++; name = s;
×
6137
        while ( FG.cTable[*s] < 2 ) s++;
×
6138
        c = *s; *s = 0;
×
6139
        if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
×
6140
                MesPrint("&dollar in if statement should have been defined previously");
×
6141
                return(0);
×
6142
        }
6143
        *s = c;
×
6144
        *w++ = IFDOLLAREXTRA;
×
6145
        *w++ = 3;
×
6146
        *w++ = number;
×
6147
        if ( c == '[' ) {
×
6148
                s++;
×
6149
                *inp = s;
×
6150
                if ( ( w = GetIfDollarFactor(inp,w) ) == 0 ) return(0);
×
6151
                s = *inp;
×
6152
                if ( *s != ']' ) {
×
6153
                        MesPrint("&unmatched [] in $ in if statement");
×
6154
                        return(0);
×
6155
                }
6156
                s++;
×
6157
                *inp = s;
×
6158
        }
6159
        return(w);
6160
}
6161

6162
/*
6163
          #] GetIfDollarFactor : 
6164
          #[ GetDoParam :
6165
*/
6166

6167
UBYTE *GetDoParam(UBYTE *inp, WORD **wp, int par)
21✔
6168
{
6169
        LONG x;
21✔
6170
        WORD number;
21✔
6171
        UBYTE *name, c;
21✔
6172
        if ( FG.cTable[*inp] == 1 ) {
21✔
6173
                x = 0;
6174
                while ( *inp >= '0' && *inp <= '9' ) {
24✔
6175
                        x = 10*x + *inp++ - '0';
12✔
6176
                        if ( x > MAXPOSITIVE ) {
12✔
6177
                                if ( par == -1 ) {
×
6178
                                        MesPrint("&Value in dollar factor too large");
×
6179
                                }
6180
                                else {
6181
                                        MesPrint("&Value in do loop boundaries too large");
×
6182
                                }
6183
                                while ( FG.cTable[*inp] == 1 ) inp++;
×
6184
                                return(0);
6185
                        }
6186
                }
6187
                if ( par > 0 ) {
12✔
6188
                        *(*wp)++ = SNUMBER;
6✔
6189
                        *(*wp)++ = (WORD)x;
6✔
6190
                }
6191
                else {
6192
                        *(*wp)++ = DOLLAREXPR2;
6✔
6193
                        *(*wp)++ = -((WORD)x)-1;
6✔
6194
                }
6195
                return(inp);
12✔
6196
        }
6197
        if ( *inp != '$' ) {
9✔
6198
                return(0);
6199
        }
6200
        inp++; name = inp;
9✔
6201
        while ( FG.cTable[*inp] < 2 ) inp++;
21✔
6202
        c = *inp; *inp = 0;
9✔
6203
        if ( GetName(AC.dollarnames,name,&number,NOAUTO) == NAMENOTFOUND ) {
9✔
6204
                if ( par == -1 ) {
×
6205
                        MesPrint("&dollar in print statement should have been defined previously");
×
6206
                }
6207
                else {
6208
                        MesPrint("&dollar in do loop boundaries should have been defined previously");
×
6209
                }
6210
                return(0);
×
6211
        }
6212
        *inp = c;
9✔
6213
        if ( par > 0 ) {
9✔
6214
                *(*wp)++ = DOLLAREXPRESSION;
6✔
6215
                *(*wp)++ = number;
6✔
6216
        }
6217
        else {
6218
                *(*wp)++ = DOLLAREXPR2;
3✔
6219
                *(*wp)++ = number;
3✔
6220
        }
6221
        if ( c == '[' ) {
9✔
6222
                inp++;
6✔
6223
                inp = GetDoParam(inp,wp,0);
6✔
6224
                if ( inp == 0 ) return(0);
6✔
6225
                if ( *inp != ']' ) {
6✔
6226
                        if ( par == -1 ) {
×
6227
                                MesPrint("&unmatched [] in $ in print statement");
×
6228
                        }
6229
                        else {
6230
                                MesPrint("&unmatched [] in do loop boundaries");
×
6231
                        }
6232
                        return(0);
×
6233
                }
6234
                inp++;
6✔
6235
        }
6236
        return(inp);
6237
}
6238

6239
/*
6240
          #] GetDoParam : 
6241
          #[ CoDo :
6242
*/
6243

6244
int CoDo(UBYTE *inp)
6✔
6245
{
6246
        GETIDENTITY
4✔
6247
        CBUF *C = cbuf+AC.cbufnum;
6✔
6248
        WORD *w, numparam;
6✔
6249
        int error = 0, i;
6✔
6250
        UBYTE *name, c;
6✔
6251
        if ( AC.doloopstack == 0 ) {
6✔
6252
                AC.doloopstacksize = 20;
6✔
6253
                AC.doloopstack = (WORD *)Malloc1(AC.doloopstacksize*2*sizeof(WORD),"doloop stack");
6✔
6254
                AC.doloopnest = AC.doloopstack + AC.doloopstacksize;
6✔
6255
        }
6256
        if ( AC.dolooplevel >= AC.doloopstacksize ) {
6✔
6257
                WORD *newstack, *newnest, newsize;
×
6258
                newsize = AC.doloopstacksize * 2;
×
6259
                newstack = (WORD *)Malloc1(newsize*2*sizeof(WORD),"doloop stack");
×
6260
                newnest = newstack + newsize;
×
6261
                for ( i = 0; i < newsize; i++ ) {
×
6262
                        newstack[i] = AC.doloopstack[i];
×
6263
                        newnest[i] = AC.doloopnest[i];
×
6264
                }
6265
                M_free(AC.doloopstack,"doloop stack");
×
6266
                AC.doloopstack = newstack;
×
6267
                AC.doloopnest = newnest;
×
6268
                AC.doloopstacksize = newsize;
×
6269
        }
6270
        AC.doloopnest[AC.dolooplevel] = NestingChecksum();
6✔
6271

6272
        w = AT.WorkPointer;
6✔
6273
        *w++ = TYPEDOLOOP;
6✔
6274
        w++; /* Space for the length of the statement */
6✔
6275
/*
6276
        Now the $loopvariable
6277
*/
6278
        while ( *inp == ',' ) inp++;
6✔
6279
        if ( *inp != '$' ) {
6✔
6280
                error = 1;
×
6281
                MesPrint("&do loop parameter should be a dollar variable");
×
6282
        }
6283
        else {
6284
                inp++;
6✔
6285
                name = inp;
6✔
6286
                if ( FG.cTable[*inp] != 0 ) {
6✔
6287
                        error = 1;
×
6288
                        MesPrint("&illegal name for do loop parameter");
×
6289
                }
6290
                while ( FG.cTable[*inp] < 2 ) inp++;
12✔
6291
                c = *inp; *inp = 0;
6✔
6292
                if ( GetName(AC.dollarnames,name,&numparam,NOAUTO) == NAMENOTFOUND ) {
6✔
6293
                        numparam = AddDollar(name,DOLUNDEFINED,0,0);
6✔
6294
                }
6295
                *w++ = numparam;
6✔
6296
                *inp = c;
6✔
6297
                AddPotModdollar(numparam);
6✔
6298
        }
6299
        w++;  /* space for the level of the enddo statement */
6✔
6300
        while ( *inp == ',' ) inp++;
6✔
6301
        if ( *inp != '=' ) goto IllSyntax;
6✔
6302
        inp++;
6✔
6303
        while ( *inp == ',' ) inp++;
6✔
6304
/*
6305
        The start value
6306
*/
6307
        inp = GetDoParam(inp,&w,1);
6✔
6308
        if ( inp == 0 || *inp != ',' ) goto IllSyntax;
6✔
6309
        while ( *inp == ',' ) inp++;
12✔
6310
/*
6311
        The end value
6312
*/
6313
        inp = GetDoParam(inp,&w,1);
6✔
6314
        if ( inp == 0 || ( *inp != 0 && *inp != ',' ) ) goto IllSyntax;
6✔
6315
/*
6316
        The increment value
6317
*/
6318
        if ( *inp != ',' ) {
6✔
6319
                if ( *inp == 0 ) { *w++ = SNUMBER; *w++ = 1; }
6✔
6320
                else goto IllSyntax;
×
6321
        }
6322
        else {
6323
                while ( *inp == ',' ) inp++;
×
6324
                inp = GetDoParam(inp,&w,1);
×
6325
        }
6326
        if ( inp == 0 || *inp != 0 ) goto IllSyntax;
6✔
6327
        *w = 0;
6✔
6328
        AT.WorkPointer[1] = w - AT.WorkPointer;
6✔
6329
/*
6330
        Put away and set information for placing enddo information.
6331
*/
6332
        AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
6✔
6333
        AC.doloopstack[AC.dolooplevel++] = C->numlhs;
6✔
6334

6335
        return(error);
6✔
6336

6337
IllSyntax:
×
6338
        MesPrint("&Illegal syntax for do statement");
×
6339
        return(1);
×
6340
}
6341

6342
/*
6343
          #] CoDo : 
6344
          #[ CoEndDo :
6345
*/
6346

6347
int CoEndDo(UBYTE *inp)
6✔
6348
{
6349
        CBUF *C = cbuf+AC.cbufnum;
6✔
6350
        WORD scratch[3];
6✔
6351
        while ( *inp == ',' ) inp++;
6✔
6352
        if ( *inp ) {
6✔
6353
                MesPrint("&Illegal syntax for EndDo statement");
×
6354
                return(1);
×
6355
        }
6356
        if ( AC.dolooplevel <= 0 ) {
6✔
6357
                MesPrint("&EndDo without corresponding Do statement");
×
6358
                return(1);
×
6359
        }
6360
        AC.dolooplevel--;
6✔
6361
        scratch[0] = TYPEENDDOLOOP;
6✔
6362
        scratch[1] = 3;
6✔
6363
        scratch[2] = AC.doloopstack[AC.dolooplevel];
6✔
6364
        AddNtoL(3,scratch);
6✔
6365
        cbuf[AC.cbufnum].lhs[AC.doloopstack[AC.dolooplevel]][3] = C->numlhs;
6✔
6366
        if ( AC.doloopnest[AC.dolooplevel] != NestingChecksum() ) {
6✔
6367
                MesNesting();
×
6368
                return(1);
×
6369
        }
6370
        return(0);
6371
}
6372

6373
/*
6374
          #] CoEndDo : 
6375
          #[ CoFactDollar :
6376
*/
6377

6378
int CoFactDollar(UBYTE *inp)
6✔
6379
{
6380
        WORD numdollar;
6✔
6381
        if ( *inp == '$' ) {
6✔
6382
                if ( GetName(AC.dollarnames,inp+1,&numdollar,NOAUTO) != CDOLLAR ) {
6✔
6383
                        MesPrint("&%s is undefined",inp);
×
6384
                        numdollar = AddDollar(inp+1,DOLINDEX,&one,1);
×
6385
                        return(1);
×
6386
                }
6387
                inp = SkipAName(inp+1);
6✔
6388
                if ( *inp != 0 ) {
6✔
6389
                        MesPrint("&FactDollar should have a single $variable for its argument");
×
6390
                        return(1);
×
6391
                }
6392
                AddPotModdollar(numdollar);
6✔
6393
        }
6394
        else {
6395
                MesPrint("&%s is not a $-variable",inp);
×
6396
                return(1);
×
6397
        }
6398
        Add3Com(TYPEFACTOR,numdollar);
6✔
6399
        return(0);
6✔
6400
}
6401

6402
/*
6403
          #] CoFactDollar : 
6404
          #[ CoFactorize :
6405
*/
6406

6407
int CoFactorize(UBYTE *s) { return(DoFactorize(s,1)); }
18✔
6408

6409
/*
6410
          #] CoFactorize : 
6411
          #[ CoNFactorize :
6412
*/
6413

6414
int CoNFactorize(UBYTE *s) { return(DoFactorize(s,0)); }
×
6415

6416
/*
6417
          #] CoNFactorize : 
6418
          #[ CoUnFactorize :
6419
*/
6420

6421
int CoUnFactorize(UBYTE *s) { return(DoFactorize(s,3)); }
3✔
6422

6423
/*
6424
          #] CoUnFactorize : 
6425
          #[ CoNUnFactorize :
6426
*/
6427

6428
int CoNUnFactorize(UBYTE *s) { return(DoFactorize(s,2)); }
×
6429

6430
/*
6431
          #] CoNUnFactorize : 
6432
          #[ DoFactorize :
6433
*/
6434

6435
int DoFactorize(UBYTE *s,int par)
21✔
6436
{
6437
        EXPRESSIONS e;
21✔
6438
        WORD i;
21✔
6439
        WORD number;
21✔
6440
        UBYTE *t, c;
21✔
6441
        int error = 0, keepzeroflag = 0;
21✔
6442
        if ( *s == '(' ) {
21✔
6443
                s++;
3✔
6444
                while ( *s != ')' && *s ) {
6✔
6445
                        if ( FG.cTable[*s] == 0 ) {
3✔
6446
                                t = s; while ( FG.cTable[*s] == 0 ) s++;
27✔
6447
                                c = *s; *s = 0;
3✔
6448
                                if ( StrICmp((UBYTE *)"keepzero",t) == 0 ) {
3✔
6449
                                        keepzeroflag = 1;
6450
                                }
6451
                                else {
6452
                                        MesPrint("&Illegal option in [N][Un]Factorize statement: %s",t);
×
6453
                                        error = 1;
×
6454
                                }
6455
                                *s = c;
3✔
6456
                        }
6457
                        while ( *s == ',' ) s++;
3✔
6458
                        if ( *s && *s != ')' && FG.cTable[*s] != 0 ) {
3✔
6459
                                MesPrint("&Illegal character in option field of [N][Un]Factorize statement");
×
6460
                                error = 1;
×
6461
                                return(error);
×
6462
                        }
6463
                }
6464
                if ( *s ) s++;
3✔
6465
                while ( *s == ',' || *s == ' ' ) s++;
3✔
6466
        }
6467
        if ( *s == 0 ) {
21✔
6468
                for ( i = NumExpressions-1; i >= 0; i-- ) {
×
6469
                        e = Expressions+i;
×
6470
                        if ( e->replace >= 0 ) {
×
6471
                                e = Expressions + e->replace;
×
6472
                        }
6473
                        if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
×
6474
                        || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
6475
                  || e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION
6476
                        ) {
6477
                                switch ( par ) {
×
6478
                                        case 0:
×
6479
                                                e->vflags &= ~TOBEFACTORED;
×
6480
                                                break;
×
6481
                                        case 1:
×
6482
                                                e->vflags |=  TOBEFACTORED;
×
6483
                                                e->vflags &= ~TOBEUNFACTORED;
×
6484
                                                break;
×
6485
                                        case 2:
×
6486
                                                e->vflags &= ~TOBEUNFACTORED;
×
6487
                                                break;
×
6488
                                        case 3:
×
6489
                                                e->vflags |=  TOBEUNFACTORED;
×
6490
                                                e->vflags &= ~TOBEFACTORED;
×
6491
                                                break;
×
6492
                                }
6493
                        }
6494
                        if ( ( e->vflags & TOBEFACTORED ) != 0 ) {
×
6495
                                if ( keepzeroflag ) e->vflags |=  KEEPZERO;
×
6496
                                else                e->vflags &= ~KEEPZERO;
×
6497
                        }
6498
                        else                    e->vflags &= ~KEEPZERO;
×
6499
                }
6500
        }
6501
        else {
6502
                for(;;) {        /* Look for a (comma separated) list of variables */
6503
                        while ( *s == ',' ) s++;
60✔
6504
                        if ( *s == 0 ) break;
51✔
6505
                        if ( *s == '[' || FG.cTable[*s] == 0 ) {
30✔
6506
                                t = s;
30✔
6507
                                if ( ( s = SkipAName(s) ) == 0 ) {
30✔
6508
                                        MesPrint("&Improper name for an expression: '%s'",t);
×
6509
                                        return(1);
×
6510
                                }
6511
                                c = *s; *s = 0;
30✔
6512
                                if ( GetName(AC.exprnames,t,&number,NOAUTO) == CEXPRESSION ) {
30✔
6513
                                        e = Expressions+number;
30✔
6514
                                        if ( e->replace >= 0 ) {
30✔
6515
                                                e = Expressions + e->replace;
×
6516
                                        }
6517
                                        if ( e->status == LOCALEXPRESSION || e->status == GLOBALEXPRESSION
30✔
6518
                                        || e->status == UNHIDELEXPRESSION || e->status == UNHIDEGEXPRESSION
6519
                                        || e->status == INTOHIDELEXPRESSION || e->status == INTOHIDEGEXPRESSION
6520
                                        ) {
6521
                                                switch ( par ) {
30✔
6522
                                                        case 0:
×
6523
                                                                e->vflags &= ~TOBEFACTORED;
×
6524
                                                                break;
×
6525
                                                        case 1:
27✔
6526
                                                                e->vflags |=  TOBEFACTORED;
27✔
6527
                                                                e->vflags &= ~TOBEUNFACTORED;
27✔
6528
                                                                break;
27✔
6529
                                                        case 2:
×
6530
                                                                e->vflags &= ~TOBEUNFACTORED;
×
6531
                                                                break;
×
6532
                                                        case 3:
3✔
6533
                                                                e->vflags |=  TOBEUNFACTORED;
3✔
6534
                                                                e->vflags &= ~TOBEFACTORED;
3✔
6535
                                                                break;
3✔
6536
                                                }
6537
                                        }
6538
                                        if ( ( e->vflags & TOBEFACTORED ) != 0 ) {
30✔
6539
                                                if ( keepzeroflag ) e->vflags |=  KEEPZERO;
27✔
6540
                                                else                e->vflags &= ~KEEPZERO;
24✔
6541
                                        }
6542
                                        else                    e->vflags &= ~KEEPZERO;
3✔
6543
                                }
6544
                                else if ( GetName(AC.varnames,t,&number,NOAUTO) != NAMENOTFOUND ) {
×
6545
                                        MesPrint("&%s is not an expression",t);
×
6546
                                        error = 1;
×
6547
                                }
6548
                                *s = c;
30✔
6549
                        }
6550
                        else {
6551
                                MesPrint("&Illegal object in (N)Factorize statement");
×
6552
                                error = 1;
×
6553
                                while ( *s && *s != ',' ) s++;
×
6554
                                if ( *s == 0 ) break;
×
6555
                        }
6556
                }
6557

6558
        }
6559
        return(error);
6560
}
6561

6562
/*
6563
          #] DoFactorize : 
6564
          #[ CoOptimizeOption :
6565

6566
*/
6567

6568
int CoOptimizeOption(UBYTE *s)
×
6569
{
6570
        UBYTE *name, *t1, *t2, c1, c2, *value, *u;
×
6571
        int error = 0, x;
×
6572
        double d;
×
6573
        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
6574
        while ( *s ) {
×
6575
                name = s; while ( FG.cTable[*s] == 0 ) s++;
×
6576
                t1 = s; c1 = *t1;
6577
                while ( *s == ' ' || *s == '\t' ) s++;
×
6578
                if ( *s != '=' ) {
×
6579
correctuse:
×
6580
                        MesPrint("&Correct use in Format,Optimize statement is Optionname=value");
×
6581
                        error = 1;
×
6582
                        while ( *s == ' ' || *s == ',' || *s == '\t' || *s == '=' ) s++;
×
6583
                        *t1 = c1;
×
6584
                        continue;
×
6585
                }
6586
                *t1 = 0;
×
6587
                s++;
×
6588
                while ( *s == ' ' || *s == '\t' ) s++;
×
6589
                if ( *s == 0 ) goto correctuse;
×
6590
                value = s;
6591
                while ( FG.cTable[*s] <= 1 || *s=='.' || *s=='*' || *s == '(' || *s == ')' ) {
×
6592
                        if ( *s == '(' ) { SKIPBRA4(s) }
×
6593
                        s++;
×
6594
                }
6595
                t2 = s; c2 = *t2;
6596
                while ( *s == ' ' || *s == '\t' ) s++;
×
6597
                if ( *s && *s != ',' ) goto correctuse;
×
6598
                if ( *s ) {
×
6599
                        s++;
×
6600
                        while ( *s == ' ' || *s == '\t' ) s++;
×
6601
                }
6602
                *t2 = 0;
×
6603
/*
6604
                Now we have name=value with name and value zero terminated strings.
6605
*/
6606
                if ( StrICmp(name,(UBYTE *)"horner") == 0 ) {
×
6607
                        if ( StrICmp(value,(UBYTE *)"occurrence") == 0 ) {
×
6608
                                AO.Optimize.horner = O_OCCURRENCE;
×
6609
                        }
6610
                        else if ( StrICmp(value,(UBYTE *)"mcts") == 0 ) {
×
6611
                                AO.Optimize.horner = O_MCTS;
×
6612
                        }
6613
                        else if ( StrICmp(value,(UBYTE *)"sa") == 0 ) {
×
6614
                                AO.Optimize.horner = O_SIMULATED_ANNEALING;
×
6615
                        }
6616
                        else {
6617
                                AO.Optimize.horner = -1;
×
6618
                                MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
×
6619
                                error = 1;
×
6620
                        }
6621
                }
6622
                else if ( StrICmp(name,(UBYTE *)"hornerdirection") == 0 ) {
×
6623
                        if ( StrICmp(value,(UBYTE *)"forward") == 0 ) {
×
6624
                                AO.Optimize.hornerdirection = O_FORWARD;
×
6625
                        }
6626
                        else if ( StrICmp(value,(UBYTE *)"backward") == 0 ) {
×
6627
                                AO.Optimize.hornerdirection = O_BACKWARD;
×
6628
                        }
6629
                        else if ( StrICmp(value,(UBYTE *)"forwardorbackward") == 0 ) {
×
6630
                                AO.Optimize.hornerdirection = O_FORWARDORBACKWARD;
×
6631
                        }
6632
                        else if ( StrICmp(value,(UBYTE *)"forwardandbackward") == 0 ) {
×
6633
                                AO.Optimize.hornerdirection = O_FORWARDANDBACKWARD;
×
6634
                        }
6635
                        else {
6636
                                AO.Optimize.method = -1;
×
6637
                                MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
×
6638
                                error = 1;
×
6639
                        }
6640
                }
6641
                else if ( StrICmp(name,(UBYTE *)"method") == 0 ) {
×
6642
                        if ( StrICmp(value,(UBYTE *)"none") == 0 ) {
×
6643
                                AO.Optimize.method = O_NONE;
×
6644
                        }
6645
                        else if ( StrICmp(value,(UBYTE *)"cse") == 0 ) {
×
6646
                                AO.Optimize.method = O_CSE;
×
6647
                        }
6648
                        else if ( StrICmp(value,(UBYTE *)"csegreedy") == 0 ) {
×
6649
                                AO.Optimize.method = O_CSEGREEDY;
×
6650
                        }
6651
                        else if ( StrICmp(value,(UBYTE *)"greedy") == 0 ) {
×
6652
                                AO.Optimize.method = O_GREEDY;
×
6653
                        }
6654
                        else {
6655
                                AO.Optimize.method = -1;
×
6656
                                MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
×
6657
                                error = 1;
×
6658
                        }
6659
                }
6660
                else if ( StrICmp(name,(UBYTE *)"timelimit") == 0 ) {
×
6661
                        x = 0;
6662
                        u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
×
6663
                        if ( *u != 0 ) {
×
6664
                                MesPrint("&Option TimeLimit in Format,Optimize statement should be a positive number: %s",value);
×
6665
                                AO.Optimize.mctstimelimit = 0;
×
6666
                                AO.Optimize.greedytimelimit = 0;
×
6667
                                error = 1;
×
6668
                        }
6669
                        else {
6670
                                AO.Optimize.mctstimelimit = x/2;
×
6671
                                AO.Optimize.greedytimelimit = x/2;
×
6672
                        }
6673
                }
6674
                else if ( StrICmp(name,(UBYTE *)"mctstimelimit") == 0 ) {
×
6675
                        x = 0;
6676
                        u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
×
6677
                        if ( *u != 0 ) {
×
6678
                                MesPrint("&Option MCTSTimeLimit in Format,Optimize statement should be a positive number: %s",value);
×
6679
                                AO.Optimize.mctstimelimit = 0;
×
6680
                                error = 1;
×
6681
                        }
6682
                        else {
6683
                                AO.Optimize.mctstimelimit = x;
×
6684
                        }
6685
                }
6686
                else if ( StrICmp(name,(UBYTE *)"mctsnumexpand") == 0 ) {
×
6687
                        int y;
6688
                        x = 0;
6689
                        u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
×
6690
                        if ( *u == '*' || *u == 'x' || *u == 'X' ) {
×
6691
                                u++; y = x;
×
6692
                                x = 0;
×
6693
                                while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
×
6694
                        }
6695
                        else { y = 1; }
6696
                        if ( *u != 0 ) {
×
6697
                                MesPrint("&Option MCTSNumExpand in Format,Optimize statement should be a positive number: %s",value);
×
6698
                                AO.Optimize.mctsnumexpand= 0;
×
6699
                                AO.Optimize.mctsnumrepeat= 1;
×
6700
                                error = 1;
×
6701
                        }
6702
                        else {
6703
                                AO.Optimize.mctsnumexpand= x;
×
6704
                                AO.Optimize.mctsnumrepeat= y;
×
6705
                        }
6706
                }
6707
                else if ( StrICmp(name,(UBYTE *)"mctsnumrepeat") == 0 ) {
×
6708
                        x = 0;
6709
                        u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
×
6710
                        if ( *u != 0 ) {
×
6711
                                MesPrint("&Option MCTSNumExpand in Format,Optimize statement should be a positive number: %s",value);
×
6712
                                AO.Optimize.mctsnumrepeat= 1;
×
6713
                                error = 1;
×
6714
                        }
6715
                        else {
6716
                                AO.Optimize.mctsnumrepeat= x;
×
6717
                        }
6718
                }
6719
                else if ( StrICmp(name,(UBYTE *)"mctsnumkeep") == 0 ) {
×
6720
                        x = 0;
6721
                        u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
×
6722
                        if ( *u != 0 ) {
×
6723
                                MesPrint("&Option MCTSNumKeep in Format,Optimize statement should be a positive number: %s",value);
×
6724
                                AO.Optimize.mctsnumkeep= 0;
×
6725
                                error = 1;
×
6726
                        }
6727
                        else {
6728
                                AO.Optimize.mctsnumkeep= x;
×
6729
                        }
6730
                }
6731
                else if ( StrICmp(name,(UBYTE *)"mctsconstant") == 0 ) {
×
6732
                        d = 0;
×
6733
                        if ( sscanf ((char*)value, "%lf", &d) != 1 ) {
×
6734
                                MesPrint("&Option MCTSConstant in Format,Optimize statement should be a positive number: %s",value);
×
6735
                                AO.Optimize.mctsconstant.fval = 0;
×
6736
                                error = 1;
×
6737
                        }
6738
                        else {
6739
                                AO.Optimize.mctsconstant.fval = d;
×
6740
                        }
6741
                }
6742
                else if ( StrICmp(name,(UBYTE *)"greedytimelimit") == 0 ) {
×
6743
                        x = 0;
6744
                        u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
×
6745
                        if ( *u != 0 ) {
×
6746
                                MesPrint("&Option GreedyTimeLimit in Format,Optimize statement should be a positive number: %s",value);
×
6747
                                AO.Optimize.greedytimelimit = 0;
×
6748
                                error = 1;
×
6749
                        }
6750
                        else {
6751
                                AO.Optimize.greedytimelimit = x;
×
6752
                        }
6753
                }
6754
                else if ( StrICmp(name,(UBYTE *)"greedyminnum") == 0 ) {
×
6755
                        x = 0;
6756
                        u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
×
6757
                        if ( *u != 0 ) {
×
6758
                                MesPrint("&Option GreedyMinNum in Format,Optimize statement should be a positive number: %s",value);
×
6759
                                AO.Optimize.greedyminnum= 0;
×
6760
                                error = 1;
×
6761
                        }
6762
                        else {
6763
                                AO.Optimize.greedyminnum= x;
×
6764
                        }
6765
                }
6766
                else if ( StrICmp(name,(UBYTE *)"greedymaxperc") == 0 ) {
×
6767
                        x = 0;
6768
                        u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
×
6769
                        if ( *u != 0 ) {
×
6770
                                MesPrint("&Option GreedyMaxPerc in Format,Optimize statement should be a positive number: %s",value);
×
6771
                                AO.Optimize.greedymaxperc= 0;
×
6772
                                error = 1;
×
6773
                        }
6774
                        else {
6775
                                AO.Optimize.greedymaxperc= x;
×
6776
                        }
6777
                }
6778
                else if ( StrICmp(name,(UBYTE *)"stats") == 0 ) {
×
6779
                        if ( StrICmp(value,(UBYTE *)"on") == 0 ) {
×
6780
                                AO.Optimize.printstats = 1;
×
6781
                        }
6782
                        else if ( StrICmp(value,(UBYTE *)"off") == 0 ) {
×
6783
                                AO.Optimize.printstats = 0;
×
6784
                        }
6785
                        else {
6786
                                AO.Optimize.printstats = 0;
×
6787
                                MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
×
6788
                                error = 1;
×
6789
                        }
6790
                }
6791
                else if ( StrICmp(name,(UBYTE *)"printscheme") == 0 ) {
×
6792
                        if ( StrICmp(value,(UBYTE *)"on") == 0 ) {
×
6793
                                AO.Optimize.schemeflags |= 1;
×
6794
                        }
6795
                        else if ( StrICmp(value,(UBYTE *)"off") == 0 ) {
×
6796
                                AO.Optimize.schemeflags &= ~1;
×
6797
                        }
6798
                        else {
6799
                                AO.Optimize.schemeflags &= ~1;
×
6800
                                MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
×
6801
                                error = 1;
×
6802
                        }
6803
                }
6804
                else if ( StrICmp(name,(UBYTE *)"debugflag") == 0 ) {
×
6805
/*
6806
                        This option is for debugging purposes only. Not in the manual!
6807
                        0x1: Print statements in reverse order.
6808
                        0x2: Print the scheme of the variables.
6809
*/
6810
                        x = 0;
×
6811
                        u = value;
×
6812
                        if ( FG.cTable[*u] == 1 ) {
×
6813
                                while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
×
6814
                                if ( *u != 0 ) {
×
6815
                                        MesPrint("&Numerical value for DebugFlag in Format,Optimize statement should be a nonnegative number: %s",value);
×
6816
                                        AO.Optimize.debugflags = 0;
×
6817
                                        error = 1;
×
6818
                                }
6819
                                else {
6820
                                        AO.Optimize.debugflags = x;
×
6821
                                }
6822
                        }
6823
                        else if ( StrICmp(value,(UBYTE *)"on") == 0 ) {
×
6824
                                AO.Optimize.debugflags = 1;
×
6825
                        }
6826
                        else if ( StrICmp(value,(UBYTE *)"off") == 0 ) {
×
6827
                                AO.Optimize.debugflags = 0;
×
6828
                        }
6829
                        else {
6830
                                AO.Optimize.debugflags = 0;
×
6831
                                MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
×
6832
                                error = 1;
×
6833
                        }
6834
                }
6835
                else if ( StrICmp(name,(UBYTE *)"scheme") == 0 ) {
×
6836
                        UBYTE *ss, *s1, c;
×
6837
                        WORD type, numsym;
×
6838
                        AO.schemenum = 0;
×
6839
                        u = value;
×
6840
                        if ( *u != '(' ) {
×
6841
noscheme:
×
6842
                                MesPrint("&Option Scheme in Format,Optimize statement should be an array of names or integers between (): %s",value);
×
6843
                                error = 1;
×
6844
                                break;
×
6845
                        }
6846
                        u++; ss = u;
×
6847
                        while ( *ss == ' ' || *ss == '\t' || *ss == ',' ) ss++;
×
6848
                        if ( FG.cTable[*ss] == 0 || *ss == '$' || *ss == '[' ) { /* Name */
×
6849
                                s1 = u; SKIPBRA3(s1)
×
6850
                                if ( *s1 != ')' ) goto noscheme;
×
6851
                                while ( ss < s1 ) { if ( *ss++ == ',' ) AO.schemenum++; }
×
6852
                                *ss++ = 0; while ( *ss == ' ' ) ss++;
×
6853
                                if ( *ss != 0 ) goto noscheme;
×
6854
                                ss = u;
×
6855
                                if ( AO.schemenum < 1 ) {
×
6856
                                        MesPrint("&Option Scheme in Format,Optimize statement should have at least one name or number between ()");
×
6857
                                        error = 1;
×
6858
                                        break;
×
6859
                                }
6860
                                if ( AO.inscheme ) M_free(AO.inscheme,"Horner input scheme");
×
6861
                                AO.inscheme = (WORD *)Malloc1((AO.schemenum+1)*sizeof(WORD),"Horner input scheme");
×
6862
                                while ( *ss == ' ' || *ss == '\t' || *ss == ',' ) ss++;
×
6863
                                AO.schemenum = 0;
×
6864
                                for(;;) {
×
6865
                                        if ( *ss == 0 ) break;
×
6866
                                        s1 = ss; ss = SkipAName(s1); c = *ss; *ss = 0;
×
6867

6868
                                        if ( ss[-1] == '_' ) {
×
6869
/*
6870
                                                Now AC.extrasym followed by a number and _
6871
*/
6872
                                                UBYTE *u1, *u2;
×
6873
                                                u1 = s1; u2 = AC.extrasym;
×
6874
                                                while ( *u1 == *u2 ) { u1++; u2++; }
×
6875
                                                if ( *u2 == 0 ) { /* Good start */
×
6876
                                                        numsym = 0;
×
6877
                                                        while ( *u1 >= '0' && *u1 <= '9' ) numsym = 10*numsym + *u1++ - '0';
×
6878
                                                        if ( u1 != ss-1 || numsym == 0 || AC.extrasymbols != 0 ) {
×
6879
                                                                MesPrint("&Improper use of extra symbol in scheme format option");
×
6880
                                                                goto noscheme;
×
6881
                                                        }
6882
                                                        numsym = MAXVARIABLES-numsym;
×
6883
                                                        ss++;
×
6884
                                                        goto GotTheNumber;
×
6885
                                                }
6886
                                        }
6887
                                        else if ( *s1 == '$' ) {
×
6888
                                                GETIDENTITY
6889
                                                int numdollar;
×
6890
                                                if ( ( numdollar = GetDollar(s1+1) ) < 0 ) {
×
6891
                                                        MesPrint("&Undefined variable %s",s1);
×
6892
                                                        error = 5;
×
6893
                                                }
6894
                                                else if ( ( numsym = DolToSymbol(BHEAD numdollar) ) < 0 ) {
×
6895
                                                        MesPrint("&$%s does not evaluate to a symbol",s1);
×
6896
                                                        error = 5;
×
6897
                                                }
6898
                                                *ss = c;
×
6899
                                                goto GotTheNumber;
×
6900
                                        }
6901
                                        else if ( c == '(' ) {
×
6902
                                                if ( StrCmp(s1,AC.extrasym) == 0 ) {
×
6903
                                                        if ( (AC.extrasymbols&1) != 1 ) {
×
6904
                                                                MesPrint("&Improper use of extra symbol in scheme format option");
×
6905
                                                                goto noscheme;
×
6906
                                                        }
6907
                                                        *ss++ = c;
×
6908
                                                        numsym = 0;
×
6909
                                                        while ( *ss >= '0' && *ss <= '9' ) numsym = 10*numsym + *ss++ - '0';
×
6910
                                                        if ( *ss != ')' ) {
×
6911
                                                                MesPrint("&Extra symbol should have a number for its argument.");
×
6912
                                                                goto noscheme;
×
6913
                                                        }
6914
                                                        numsym = MAXVARIABLES-numsym;
×
6915
                                                        ss++;
×
6916
                                                        goto GotTheNumber;
×
6917
                                                }
6918
                                        }
6919
                                        type = GetName(AC.varnames,s1,&numsym,WITHAUTO);
×
6920
                                        if ( ( type != CSYMBOL ) && type != CDUBIOUS ) {
×
6921
                                                MesPrint("&%s is not a symbol",s1);
×
6922
                                                error = 4;
×
6923
                                                if ( type < 0 ) numsym = AddSymbol(s1,-MAXPOWER,MAXPOWER,0,0);
×
6924
                                        }
6925
                                        *ss = c;
×
6926
GotTheNumber:
×
6927
                                        AO.inscheme[AO.schemenum++] = numsym;
×
6928
                                        while ( *ss == ' ' || *ss == '\t' || *ss == ',' ) ss++;
×
6929
                                }
6930
                        }
6931
                }
6932
                else if ( StrICmp(name,(UBYTE *)"mctsdecaymode") == 0 ) {
×
6933
                        x = 0;
×
6934
                        u = value;
×
6935
                        if ( FG.cTable[*u] == 1 ) {
×
6936
                                while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
×
6937
                                if ( *u != 0 ) {
×
6938
                                        MesPrint("&Option MCTSDecayMode in Format,Optimize statement should be a nonnegative integer: %s",value);
×
6939
                                        AO.Optimize.mctsdecaymode = 0;
×
6940
                                        error = 1;
×
6941
                                }
6942
                                else {
6943
                                        AO.Optimize.mctsdecaymode = x;
×
6944
                                }
6945
                        }
6946
                        else {
6947
                                AO.Optimize.mctsdecaymode = 0;
×
6948
                                MesPrint("&Unrecognized option value in Format,Optimize statement: %s=%s",name,value);
×
6949
                                error = 1;
×
6950
                        }
6951
                }
6952
                else if ( StrICmp(name,(UBYTE *)"saiter") == 0 ) {
×
6953
                        x = 0;
6954
                        u = value; while ( *u >= '0' && *u <= '9' ) x = 10*x + *u++ - '0';
×
6955
                        if ( *u != 0 ) {
×
6956
                                MesPrint("&Option SAIter in Format,Optimize statement should be a positive integer: %s",value);
×
6957
                                AO.Optimize.saIter = 0;
×
6958
                                error = 1;
×
6959
                        }
6960
                        else {
6961
                                AO.Optimize.saIter= x;
×
6962
                        }
6963
                }
6964
                else if ( StrICmp(name,(UBYTE *)"samaxt") == 0 ) {
×
6965
                        d = 0;
×
6966
                        if ( sscanf ((char*)value, "%lf", &d) != 1 ) {
×
6967
                                MesPrint("&Option SAMaxT in Format,Optimize statement should be a positive number: %s",value);
×
6968
                                AO.Optimize.saMaxT.fval = 0;
×
6969
                                error = 1;
×
6970
                        }
6971
                        else {
6972
                                AO.Optimize.saMaxT.fval = d;
×
6973
                        }
6974
                }
6975
                else if ( StrICmp(name,(UBYTE *)"samint") == 0 ) {
×
6976
                        d = 0;
×
6977
                        if ( sscanf ((char*)value, "%lf", &d) != 1 ) {
×
6978
                                MesPrint("&Option SAMinT in Format,Optimize statement should be a positive number: %s",value);
×
6979
                                AO.Optimize.saMinT.fval = 0;
×
6980
                                error = 1;
×
6981
                        }
6982
                        else {
6983
                                AO.Optimize.saMinT.fval = d;
×
6984
                        }
6985
                }
6986
                else {
6987
                        MesPrint("&Unrecognized option name in Format,Optimize statement: %s",name);
×
6988
                        error = 1;
×
6989
                }
6990
                *t1 = c1; *t2 = c2;
×
6991
        }
6992
        return(error);
×
6993
}
6994

6995
/*
6996
          #] CoOptimizeOption : 
6997
          #[ DoPutInside :
6998

6999
        Syntax:
7000
                PutIn[side],functionname[,brackets]  -> par = 1
7001
                AntiPutIn[side],functionname,antibrackets  -> par = -1
7002
*/
7003

7004
int CoPutInside(UBYTE *inp) { return(DoPutInside(inp,1)); }
6✔
7005
int CoAntiPutInside(UBYTE *inp) { return(DoPutInside(inp,-1)); }
6✔
7006

7007
int DoPutInside(UBYTE *inp, int par)
12✔
7008
{
7009
        GETIDENTITY
8✔
7010
        UBYTE *p, c;
12✔
7011
        WORD *to, type, c1,c2,funnum, *WorkSave;
12✔
7012
        int error = 0;
12✔
7013
        while ( *inp == ' ' || *inp == '\t' || *inp == ',' ) inp++;
12✔
7014
/*
7015
        First we need the name of a function. (Not a tensor or table!)
7016
*/
7017
        p = SkipAName(inp);
12✔
7018
        if ( p == 0 ) return(1);
12✔
7019
        c = *p; *p = 0;
12✔
7020
        type = GetName(AC.varnames,inp,&funnum,WITHAUTO);
12✔
7021
        if ( type != CFUNCTION || functions[funnum].tabl != 0 || functions[funnum].spec ) {
12✔
7022
                MesPrint("&PutInside/AntiPutInside expects a regular function for its first argument");
×
7023
                MesPrint("&Argument is %s",inp);
×
7024
                error = 1;
×
7025
        }
7026
        funnum += FUNCTION;
12✔
7027
        *p = c;
12✔
7028
        inp = p;
12✔
7029
        while ( *inp == ' ' || *inp == '\t' || *inp == ',' ) inp++;
24✔
7030
        if ( *inp == 0 ) {
12✔
7031
                if ( par == 1 ) {
×
7032
                        WORD tocompiler[4];
×
7033
                        tocompiler[0] = TYPEPUTINSIDE;
×
7034
                        tocompiler[1] = 4;
×
7035
                        tocompiler[2] = 0;
×
7036
                        tocompiler[3] = funnum;
×
7037
                        AddNtoL(4,tocompiler);
×
7038
                }
7039
                else {
7040
                        MesPrint("&AntiPutInside needs inside information.");
×
7041
                        error = 1;
×
7042
                }
7043
                return(error);
×
7044
        }
7045
        WorkSave = to = AT.WorkPointer;
12✔
7046
        *to++ = TYPEPUTINSIDE;
12✔
7047
        *to++ = 4;
12✔
7048
        *to++ = par;
12✔
7049
        *to++ = funnum;
12✔
7050
        to++;
12✔
7051
        while ( *inp ) {
24✔
7052
                while ( *inp == ' ' || *inp == '\t' || *inp == ',' ) inp++;
12✔
7053
                if ( *inp == 0 ) break;
12✔
7054
                p = SkipAName(inp);
12✔
7055
                if ( p == 0 ) { error = 1; break; }
12✔
7056
                c = *p; *p = 0;
12✔
7057
                type = GetName(AC.varnames,inp,&c1,WITHAUTO);
12✔
7058
                if ( c == '.' ) {
12✔
7059
                        if ( type == CVECTOR || type == CDUBIOUS ) {
×
7060
                                *p++ = c;
×
7061
                                inp = p;
×
7062
                                p = SkipAName(inp);
×
7063
                                if ( p == 0 ) return(1);
×
7064
                                c = *p; *p = 0;
×
7065
                                type = GetName(AC.varnames,inp,&c2,WITHAUTO);
×
7066
                                if ( type != CVECTOR && type != CDUBIOUS ) {
×
7067
                                        MesPrint("&Not a vector in dotproduct in PutInside/AntiPutInside statement: %s",inp);
×
7068
                                        error = 1;
×
7069
                                }
7070
                                else type = CDOTPRODUCT;
7071
                        }
7072
                        else {
7073
                                MesPrint("&Illegal use of . after %s in PutInside/AntiPutInside statement",inp);
×
7074
                                error = 1;
×
7075
                                *p = c; inp = p;
×
7076
                                continue;
×
7077
                        }
7078
                }
7079
                switch ( type ) {
12✔
7080
                        case CSYMBOL :
9✔
7081
                                *to++ = SYMBOL; *to++ = 4; *to++ = c1; *to++ = 1; break;
9✔
7082
                        case CVECTOR :
×
7083
                                *to++ = INDEX; *to++ = 3; *to++ = AM.OffsetVector + c1; break;
×
7084
                        case CFUNCTION :
3✔
7085
                                *to++ = c1+FUNCTION; *to++ = FUNHEAD; *to++ = 0;
3✔
7086
                                FILLFUN3(to)
7087
                                break;
3✔
7088
                        case CDOTPRODUCT :
×
7089
                                *to++ = DOTPRODUCT; *to++ = 5; *to++ = c1 + AM.OffsetVector;
×
7090
                                *to++ = c2 + AM.OffsetVector; *to++ = 1; break;
×
7091
                        case CDELTA :
×
7092
                                *to++ = DELTA; *to++ = 4; *to++ = EMPTYINDEX; *to++ = EMPTYINDEX; break;
×
7093
                        default :
×
7094
                                MesPrint("&Illegal variable request for %s in PutInside/AntiPutInside statement",inp);
×
7095
                                error = 1; break;
×
7096
                }
7097
                *p = c;
12✔
7098
                inp = p;
12✔
7099
        }
7100
        *to++ = 1; *to++ = 1; *to++ = 3;
12✔
7101
        AT.WorkPointer[1] = to - AT.WorkPointer;
12✔
7102
        AT.WorkPointer[4] = AT.WorkPointer[1]-4;
12✔
7103
        AT.WorkPointer = to;
12✔
7104
        AC.BracketNormalize = 1;
12✔
7105
        if ( Normalize(BHEAD WorkSave+4) ) { error = 1; }
12✔
7106
        else {
7107
                WorkSave[1] = WorkSave[4]+4;
12✔
7108
                to = WorkSave + WorkSave[1] - 1;
12✔
7109
                c1 = ABS(*to);
12✔
7110
                WorkSave[1] -= c1;
12✔
7111
                WorkSave[4] -= c1;
12✔
7112
                AddNtoL(WorkSave[1],WorkSave);
12✔
7113
        }
7114
        AC.BracketNormalize = 0;
12✔
7115
        AT.WorkPointer = WorkSave;
12✔
7116
        return(error);
12✔
7117
}
7118

7119
/*
7120
          #] DoPutInside : 
7121
          #[ CoSwitch :
7122

7123
        Syntax: Switch $var;
7124
        Be careful with illegal nestings with repeat, if, while.
7125
*/
7126

7127
int CoSwitch(UBYTE *s)
×
7128
{
7129
        WORD numdollar;
×
7130
        SWITCH *sw;
×
7131
        if ( *s == '$' ) {
×
7132
                if ( GetName(AC.dollarnames,s+1,&numdollar,NOAUTO) != CDOLLAR ) {
×
7133
                        MesPrint("&%s is undefined in switch statement",s);
×
7134
                        numdollar = AddDollar(s+1,DOLINDEX,&one,1);
×
7135
                        return(1);
×
7136
                }
7137
                s = SkipAName(s+1);
×
7138
                if ( *s != 0 ) {
×
7139
                        MesPrint("&Switch should have a single $variable for its argument");
×
7140
                        return(1);
×
7141
                }
7142
/*                AddPotModdollar(numdollar);  */
7143
        }
7144
        else {
7145
                MesPrint("&%s is not a $-variable in switch statement",s);
×
7146
                return(1);
×
7147
        }
7148
/*
7149
        Now create the switch table. We will add to it each time we run
7150
        into a new case. It will all be sorted out the moment we run into
7151
        the endswitch statement.
7152
*/
7153
        AC.SwitchLevel++;
×
7154
        if ( AC.SwitchInArray >= AC.MaxSwitch ) DoubleSwitchBuffers();
×
7155
        AC.SwitchHeap[AC.SwitchLevel] = AC.SwitchInArray;
×
7156
        sw = AC.SwitchArray + AC.SwitchInArray;
×
7157

7158
        sw->iflevel = AC.IfLevel;
×
7159
        sw->whilelevel = AC.WhileLevel;
×
7160
        sw->nestingsum = NestingChecksum();
×
7161
 
7162
        Add4Com(TYPESWITCH,numdollar,AC.SwitchInArray);
×
7163

7164
        AC.SwitchInArray++;
×
7165
        return(0);
×
7166
}
7167

7168
/*
7169
          #] CoSwitch : 
7170
          #[ CoCase :
7171
*/
7172

7173
int CoCase(UBYTE *s)
×
7174
{
7175
        SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
×
7176
        WORD x = 0, sign = 1;
×
7177
        while ( *s == ',' ) s++;
×
7178
        SKIPBLANKS(s);
×
7179
        while ( *s == '-' || *s == '+' ) {
×
7180
                if ( *s == '-' ) sign = -sign;
×
7181
                s++;
×
7182
        }
7183
        while ( FG.cTable[*s] == 1 ) { x = 10*x + *s++ - '0'; }
×
7184
        x = sign*x;
×
7185

7186
        if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
×
7187
                || sw->nestingsum != NestingChecksum() ) {
×
7188
                MesPrint("&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
×
7189
                return(-1);
×
7190
        }
7191
/*
7192
        Now add a case to the table with the current 'address'.
7193
*/
7194
        if ( sw->numcases >= sw->tablesize ) {
×
7195
                int i;
×
7196
                SWITCHTABLE *newtable;
×
7197
                WORD newsize;
×
7198
                if ( sw->tablesize == 0 ) newsize = 10;
×
7199
                else                  newsize = 2*sw->tablesize;
×
7200
                newtable = (SWITCHTABLE *)Malloc1(newsize*sizeof(SWITCHTABLE),"Switch table");
×
7201
                if ( sw->table ) {
×
7202
                        for ( i = 0; i < sw->tablesize; i++ ) newtable[i] = sw->table[i];
×
7203
                        M_free(sw->table,"Switch table");
×
7204
                }
7205
                sw->table = newtable;
×
7206
                sw->tablesize = newsize;
×
7207
        }
7208
        if ( sw->numcases == 0 ) { sw->mincase = sw->maxcase = x; }
×
7209
        else if ( x > sw->maxcase ) sw->maxcase = x;
×
7210
        else if ( x < sw->mincase ) sw->mincase = x;
×
7211
        sw->table[sw->numcases].ncase = x;
×
7212
        sw->table[sw->numcases].value = cbuf[AC.cbufnum].numlhs;
×
7213
        sw->table[sw->numcases].compbuffer = AC.cbufnum;
×
7214
        sw->numcases++;
×
7215
        return(0);
×
7216
}
7217

7218
/*
7219
          #] CoCase : 
7220
          #[ CoBreak :
7221
*/
7222

7223
int CoBreak(UBYTE *s)
×
7224
{
7225
/*
7226
        This involves a 'postponed' jump to the end. This can be done
7227
        in a special routine during execution.
7228
        That routine should also pop the switch level.
7229
*/
7230
        SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
×
7231
        if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
×
7232
                || sw->nestingsum != NestingChecksum() ) {
×
7233
                MesPrint("&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
×
7234
                return(-1);
×
7235
        }
7236
        if ( *s ) {
×
7237
                MesPrint("&No parameters allowed in Break statement");
×
7238
                return(-1);
×
7239
        }
7240
        Add3Com(TYPEENDSWITCH,AC.SwitchHeap[AC.SwitchLevel]);
×
7241
        return(0);
×
7242
}
7243

7244
/*
7245
          #] CoBreak : 
7246
          #[ CoDefault :
7247
*/
7248

7249
int CoDefault(UBYTE *s)
×
7250
{
7251
/*
7252
        A bit like case, except that the address gets stored directly in the
7253
        SWITCH struct.
7254
*/
7255
        SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
×
7256
        if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
×
7257
                || sw->nestingsum != NestingChecksum() ) {
×
7258
                MesPrint("&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
×
7259
                return(-1);
×
7260
        }
7261
        if ( *s ) {
×
7262
                MesPrint("&No parameters allowed in Default statement");
×
7263
                return(-1);
×
7264
        }
7265
        sw->defaultcase.ncase = 0;
×
7266
        sw->defaultcase.value = cbuf[AC.cbufnum].numlhs;
×
7267
        sw->defaultcase.compbuffer = AC.cbufnum;
×
7268
        return(0);
×
7269
}
7270

7271
/*
7272
          #] CoDefault : 
7273
          #[ CoEndSwitch :
7274
*/
7275

7276
int CoEndSwitch(UBYTE *s)
×
7277
{
7278
/*
7279
        We store this address in the SWITCH struct.
7280
        Next we sort the table by ncase.
7281
        Then we decide whether the table is DENSE or SPARSE.
7282
        If it is dense we change the allocation and spread the cases is necessary.
7283
        Finally we pop levels.
7284
*/
7285
        SWITCH *sw = AC.SwitchArray + AC.SwitchHeap[AC.SwitchLevel];
×
7286
        WORD i;
×
7287
        WORD totcases = sw->maxcase-sw->mincase+1;
×
7288
        while ( *s == ',' ) s++;
×
7289
        SKIPBLANKS(s)
×
7290
        if ( *s ) {
×
7291
                MesPrint("&No parameters allowed in EndSwitch statement");
×
7292
                return(-1);
×
7293
        }
7294
        if ( sw->iflevel != AC.IfLevel || sw->whilelevel != AC.WhileLevel
×
7295
                || sw->nestingsum != NestingChecksum() ) {
×
7296
                MesPrint("&Illegal nesting of switch/case/default with if/while/repeat/loop/argument/term/...");
×
7297
                return(-1);
×
7298
        }
7299
        if ( sw->defaultcase.value == 0 ) CoDefault(s);
×
7300
        if ( totcases > sw->numcases*AM.jumpratio ) { /* The factor is experimental */
×
7301
                sw->caseoffset = 0;
×
7302
                sw->typetable = SPARSETABLE;
×
7303
/*
7304
                Now we need to sort sw->table
7305
*/
7306
                SwitchSplitMerge(sw->table,sw->numcases);
×
7307
        }
7308
        else {        /* DENSE */
7309
                SWITCHTABLE *ntable;
×
7310
                sw->caseoffset = sw->mincase;
×
7311
                sw->typetable = DENSETABLE;
×
7312
                ntable = (SWITCHTABLE *)Malloc1(totcases*sizeof(SWITCHTABLE),"Switch table");
×
7313
                for ( i = 0; i < totcases; i++ ) {
×
7314
                        ntable[i].ncase = i+sw->caseoffset;
×
7315
                        ntable[i].value = sw->defaultcase.value;
×
7316
                        ntable[i].compbuffer = sw->defaultcase.compbuffer;
×
7317
                }
7318
                for ( i = 0; i < sw->numcases; i++ ) {
×
7319
                        ntable[sw->table[i].ncase-sw->caseoffset] = sw->table[i];
×
7320
                }
7321
                M_free(sw->table,"Switch table");
×
7322
                sw->table = ntable;
×
7323
                sw->numcases = totcases;
×
7324
        }
7325
        sw->endswitch.ncase = 0;
×
7326
        sw->endswitch.value = cbuf[AC.cbufnum].numlhs;
×
7327
        sw->endswitch.compbuffer = AC.cbufnum;
×
7328
        if ( sw->defaultcase.value == 0 ) {
×
7329
                sw->defaultcase = sw->endswitch;
×
7330
        }
7331
        Add3Com(TYPEENDSWITCH,AC.SwitchHeap[AC.SwitchLevel]);
×
7332
/*
7333
        Now we need to pop.
7334
*/
7335
        AC.SwitchLevel--;
×
7336
        return(0);
×
7337
}
7338

7339
/*
7340
          #] CoEndSwitch : 
7341
          #[ CoSetUserFlag :
7342
*/
7343

7344
int CoSetUserFlag(UBYTE *s)
×
7345
{
7346
        int error = 0;
×
7347
        while ( *s && ( *s == ',' || *s == ' ' || *s == '\t' ) ) s++;
×
7348
        while ( *s && ( FG.cTable[*s] == 1 ) ) {
×
7349
                int x = 0;
7350
                while ( *s && ( FG.cTable[*s] == 1 ) ) x = 10*x+(*s++ - '0');
×
7351
                if ( x < 1 || x > BITSINWORD ) {
×
7352
                        MesPrint("&Flag number %d outside the permitted range 1-%d.",BITSINWORD);
×
7353
                        error = 1;
×
7354
                }
7355
                else {
7356
                        Add3Com(TYPESETUSERFLAG,x-1);
×
7357
                }
7358
                while ( *s && ( *s == ',' || *s == ' ' || *s == '\t' ) ) s++;
×
7359
        }
7360
        if ( *s ) {
×
7361
                MesPrint("&Illegal character in SetUserFlag statement: %s",s);
×
7362
                error = 1;
×
7363
        }
7364
        return(error);
×
7365
}
7366

7367
/*
7368
          #] CoSetUserFlag : 
7369
          #[ CoClearUserFlag :
7370
*/
7371

7372
int CoClearUserFlag(UBYTE *s)
×
7373
{
7374
        int error = 0;
×
7375
        while ( *s && ( *s == ',' || *s == ' ' || *s == '\t' ) ) s++;
×
7376
        while ( *s && ( FG.cTable[*s] == 1 ) ) {
×
7377
                int x = 0;
7378
                while ( *s && ( FG.cTable[*s] == 1 ) ) x = 10*x+(*s++ - '0');
×
7379
                if ( x < 1 || x > BITSINWORD ) {
×
7380
                        MesPrint("&Flag number %d outside the permitted range 1-%d.",BITSINWORD);
×
7381
                        error = 1;
×
7382
                }
7383
                else {
7384
                        Add3Com(TYPECLEARUSERFLAG,x);
×
7385
                }
7386
                while ( *s && ( *s == ',' || *s == ' ' || *s == '\t' ) ) s++;
×
7387
        }
7388
        if ( *s ) {
×
7389
                MesPrint("&Illegal character in SetUserFlag statement: %s",s);
×
7390
                error = 1;
×
7391
        }
7392
        return(error);
×
7393
}
7394

7395
/*
7396
          #] CoClearUserFlag : 
7397
          #[ CoCreateAllLoops :
7398

7399
        Syntax:
7400
                CoCreateAllLoops,in-function,out-function,type-argument,ifnoloop;
7401
        Types allowed:
7402
                vector, index, symbol, snumber
7403
        ifnoloop:
7404
                ifnoloop=0  or ifnoloop=1
7405
        in-function can be a tensor. In that case type can be only vector or index.
7406
        out-function can be a tensor. In that case type can be only vector or index.
7407
*/
7408

7409
int CoCreateAllLoops(UBYTE *s)
×
7410
{
7411
        GETIDENTITY
7412
        UBYTE *inname, *outname, *stype, c;
×
7413
        WORD infun, outfun, x, type, tensorflag, typenum;
×
7414
        WORD *WorkSave, *to;
×
7415
        while ( *s == ',' || *s == ' ' ) s++;
×
7416
        inname = s; s = SkipAName(s);
×
7417
        c = *s; *s = 0;
×
7418
        if ( ( ( type = GetName(AC.varnames,inname,&infun,WITHAUTO) ) != CFUNCTION )
×
7419
        || ( ( functions[infun].spec != 0 ) && ( functions[infun].spec != TENSORFUNCTION ) ) ) {
×
7420
                MesPrint("&%s should be a regular function or a tensor.",inname);
×
7421
                if ( type < 0 ) {
×
7422
                        if ( GetName(AC.exprnames,s,&infun,NOAUTO) == NAMENOTFOUND )
×
7423
                                AddFunction(s,0,0,0,0,0,-1,-1);
×
7424
                }
7425
                return(1);
×
7426
        }
7427
        infun += FUNCTION;
×
7428
        *s++ = c;
×
7429
        while ( *s == ',' || *s == ' ' ) s++;
×
7430
        outname = s; s = SkipAName(s);
×
7431
        c = *s; *s = 0;
×
7432
        if ( ( ( type = GetName(AC.varnames,outname,&outfun,WITHAUTO) ) != CFUNCTION )
×
7433
        || ( ( functions[outfun].spec != 0 ) && ( functions[outfun].spec != TENSORFUNCTION ) ) ) {
×
7434
                MesPrint("&%s should be a regular function or a tensor.",outname);
×
7435
                if ( type < 0 ) {
×
7436
                        if ( GetName(AC.exprnames,s,&outfun,NOAUTO) == NAMENOTFOUND )
×
7437
                                AddFunction(s,0,0,0,0,0,-1,-1);
×
7438
                }
7439
                return(1);
×
7440
        }
7441
        outfun += FUNCTION;
×
7442
        *s++ = c;
×
7443
        if ( functions[infun].spec == TENSORFUNCTION ||
×
7444
             functions[outfun].spec == TENSORFUNCTION ) tensorflag = 1;
×
7445
        else tensorflag = 0;
×
7446
/*
7447
        Now the type: type=....
7448
*/
7449
        while ( *s == ',' || *s == ' ' ) s++;
×
7450
        stype = s;
×
7451
        while ( FG.cTable[*s] == 0 ) s++;
×
7452
        c = *s; *s = 0;
×
7453
        if ( StrICmp(stype,(UBYTE *)"type") != 0 || c != '=' ) {
×
7454
                MesPrint("&In CreateAllLoops statement: expected type=vartype.");
×
7455
                return(1);
×
7456
        }
7457
        *s++ = c;
×
7458
        stype = s;
×
7459
        while ( FG.cTable[*s] == 0 ) s++;
×
7460
        c = *s; *s = 0;
×
7461
        if ( StrICmp(stype,(UBYTE *)"vector") == 0 ) {
×
7462
                typenum = -VECTOR;
7463
        }
7464
        else if ( StrICmp(stype,(UBYTE *)"index") == 0 ) {
×
7465
                typenum = -INDEX;
7466
        }
7467
        else if ( StrICmp(stype,(UBYTE *)"symbol") == 0 ) {
×
7468
                if ( tensorflag ) goto notintensor;
×
7469
                typenum = -SYMBOL;
7470
        }
7471
        else if ( StrICmp(stype,(UBYTE *)"snumber") == 0 ) {
×
7472
                if ( tensorflag ) goto notintensor;
×
7473
                typenum = -SNUMBER;
7474
        }
7475
        else {
7476
                MesPrint("&Unknown/not allowed variable type in CreateAllLoops: %s",stype);
×
7477
                return(1);
×
7478
        }
7479
        *s = c;
×
7480
        while ( *s == ',' || *s == ' ' ) s++;
×
7481

7482
        stype = s;
×
7483
        while ( FG.cTable[*s] == 0 ) s++;
×
7484
        c = *s; *s = 0;
×
7485
        if ( StrICmp(stype,(UBYTE *)"ifnoloop") != 0 || c != '=' ) {
×
7486
                MesPrint("&Unrecognised option in CreateAllLoops statement: %s",stype);
×
7487
                return(1);
×
7488
        }
7489
        *s++ = c;
×
7490
        x = -1;
×
7491
        if ( FG.cTable[*s] == 1 ) {
×
7492
                x = 0;
7493
                do { x = 10*x + (*s++-'0'); } while (FG.cTable[*s] == 1);
×
7494
        }
7495
        if ( x != 0 && x != 1 ) {
×
7496
                MesPrint("&Only options allowed for ifnoloop are 0 or 1.");
×
7497
                return(1);
×
7498
        }
7499
        WorkSave = to = AT.WorkPointer;
×
7500
        *to++ = TYPEALLLOOPS;
×
7501
        *to++ = 6;
×
7502
        *to++ = infun;
×
7503
        *to++ = outfun;
×
7504
        *to++ = typenum;
×
7505
        *to++ = x;
×
7506

7507
        AddNtoL(WorkSave[1],WorkSave);
×
7508

7509
        return(0);
×
7510
notintensor:
×
7511
        MesPrint("&Variable type not allowed in tensors: %s",stype);
×
7512
        return(1);
×
7513
}
7514

7515
/*
7516
          #] CoCreateAllLoops : 
7517
          #[ CoCreateAllPaths :
7518

7519
        Syntax:
7520
                CreateAllPaths,end-function,intermediate-function,out-function,type-argument,ifnopath;
7521
        Types allowed:
7522
                vector, index, symbol, snumber
7523
        ifnoloop:
7524
                ifnoloop=0  or ifnoloop=1
7525
        in-function can be a tensor. In that case type can be only vector or index.
7526
        out-function can be a tensor. In that case type can be only vector or index.
7527
*/
7528

7529
int CoCreateAllPaths(UBYTE *s)
×
7530
{
7531
        GETIDENTITY
7532
        UBYTE *endname,*inname, *outname, *stype, c;
×
7533
        WORD endfun, infun, outfun, x, type, tensorflag, typenum;
×
7534
        WORD *WorkSave, *to;
×
7535
        while ( *s == ',' || *s == ' ' ) s++;
×
7536
        endname = s; s = SkipAName(s);
×
7537
        c = *s; *s = 0;
×
7538
        if ( ( ( type = GetName(AC.varnames,endname,&endfun,WITHAUTO) ) != CFUNCTION )
×
7539
        || ( ( functions[endfun].spec != 0 ) && ( functions[endfun].spec != TENSORFUNCTION ) ) ) {
×
7540
                MesPrint("&%s should be a regular function or a tensor.",endname);
×
7541
                if ( type < 0 ) {
×
7542
                        if ( GetName(AC.exprnames,s,&endfun,NOAUTO) == NAMENOTFOUND )
×
7543
                                AddFunction(s,0,0,0,0,0,-1,-1);
×
7544
                }
7545
                return(1);
×
7546
        }
7547
        endfun += FUNCTION;
×
7548
        *s++ = c;
×
7549
        while ( *s == ',' || *s == ' ' ) s++;
×
7550
        inname = s; s = SkipAName(s);
×
7551
        c = *s; *s = 0;
×
7552
        if ( ( ( type = GetName(AC.varnames,inname,&infun,WITHAUTO) ) != CFUNCTION )
×
7553
        || ( ( functions[infun].spec != 0 ) && ( functions[infun].spec != TENSORFUNCTION ) ) ) {
×
7554
                MesPrint("&%s should be a regular function or a tensor.",inname);
×
7555
                if ( type < 0 ) {
×
7556
                        if ( GetName(AC.exprnames,s,&infun,NOAUTO) == NAMENOTFOUND )
×
7557
                                AddFunction(s,0,0,0,0,0,-1,-1);
×
7558
                }
7559
                return(1);
×
7560
        }
7561
        infun += FUNCTION;
×
7562
        *s++ = c;
×
7563
        while ( *s == ',' || *s == ' ' ) s++;
×
7564
        outname = s; s = SkipAName(s);
×
7565
        c = *s; *s = 0;
×
7566
        if ( ( ( type = GetName(AC.varnames,outname,&outfun,WITHAUTO) ) != CFUNCTION )
×
7567
        || ( ( functions[outfun].spec != 0 ) && ( functions[outfun].spec != TENSORFUNCTION ) ) ) {
×
7568
                MesPrint("&%s should be a regular function or a tensor.",outname);
×
7569
                if ( type < 0 ) {
×
7570
                        if ( GetName(AC.exprnames,s,&outfun,NOAUTO) == NAMENOTFOUND )
×
7571
                                AddFunction(s,0,0,0,0,0,-1,-1);
×
7572
                }
7573
                return(1);
×
7574
        }
7575
        outfun += FUNCTION;
×
7576
        *s++ = c;
×
7577
        if ( functions[infun].spec == TENSORFUNCTION ||
×
7578
             functions[outfun].spec == TENSORFUNCTION ) tensorflag = 1;
×
7579
        else tensorflag = 0;
×
7580
/*
7581
        Now the type: type=....
7582
*/
7583
        while ( *s == ',' || *s == ' ' ) s++;
×
7584
        stype = s;
×
7585
        while ( FG.cTable[*s] == 0 ) s++;
×
7586
        c = *s; *s = 0;
×
7587
        if ( StrICmp(stype,(UBYTE *)"type") != 0 || c != '=' ) {
×
7588
                MesPrint("&In CreateAllPaths statement: expected type=vartype.");
×
7589
                return(1);
×
7590
        }
7591
        *s++ = c;
×
7592
        stype = s;
×
7593
        while ( FG.cTable[*s] == 0 ) s++;
×
7594
        c = *s; *s = 0;
×
7595
        if ( StrICmp(stype,(UBYTE *)"vector") == 0 ) {
×
7596
                typenum = -VECTOR;
7597
        }
7598
        else if ( StrICmp(stype,(UBYTE *)"index") == 0 ) {
×
7599
                typenum = -INDEX;
7600
        }
7601
        else if ( StrICmp(stype,(UBYTE *)"symbol") == 0 ) {
×
7602
                if ( tensorflag ) goto notintensor;
×
7603
                typenum = -SYMBOL;
7604
        }
7605
        else if ( StrICmp(stype,(UBYTE *)"snumber") == 0 ) {
×
7606
                if ( tensorflag ) goto notintensor;
×
7607
                typenum = -SNUMBER;
7608
        }
7609
        else {
7610
                MesPrint("&Unknown/not allowed variable type in CreateAllPaths: %s",stype);
×
7611
                return(1);
×
7612
        }
7613
        *s = c;
×
7614
        while ( *s == ',' || *s == ' ' ) s++;
×
7615

7616
        stype = s;
×
7617
        while ( FG.cTable[*s] == 0 ) s++;
×
7618
        c = *s; *s = 0;
×
7619
        if ( StrICmp(stype,(UBYTE *)"ifnopath") != 0 || c != '=' ) {
×
7620
                MesPrint("&Unrecognised option in CreateAllPaths statement: %s",stype);
×
7621
                return(1);
×
7622
        }
7623
        *s++ = c;
×
7624
        x = -1;
×
7625
        if ( FG.cTable[*s] == 1 ) {
×
7626
                x = 0;
7627
                do { x = 10*x + (*s++-'0'); } while (FG.cTable[*s] == 1);
×
7628
        }
7629
        if ( x != 0 && x != 1 ) {
×
7630
                MesPrint("&Only options allowed for ifnopath are 0 or 1.");
×
7631
                return(1);
×
7632
        }
7633
        WorkSave = to = AT.WorkPointer;
×
7634
        *to++ = TYPEALLPATHS;
×
7635
        *to++ = 7;
×
7636
        *to++ = endfun;
×
7637
        *to++ = infun;
×
7638
        *to++ = outfun;
×
7639
        *to++ = typenum;
×
7640
        *to++ = x;
×
7641

7642
        AddNtoL(WorkSave[1],WorkSave);
×
7643

7644
        return(0);
×
7645
notintensor:
×
7646
        MesPrint("&CreateAllPaths: Variable type not allowed in tensors: %s",stype);
×
7647
        return(1);
×
7648
}
7649

7650
/*
7651
          #] CoCreateAllPaths : 
7652
          #[ CoCreateAll :
7653

7654
        Syntax: subkey, two or three functions, type, ifnone
7655
*/
7656

7657
int CoCreateAll(UBYTE *s)
×
7658
{
7659
        UBYTE *subkey;
×
7660
        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
7661
        subkey = s;
7662
        while ( FG.cTable[*s] == 0 ) s++;
×
7663
        if ( *s != ' ' && *s != ',' && *s != '\t' ) {
×
7664
                MesPrint("&Illegal subkey in CoCreate statement.");
×
7665
                return(1);
×
7666
        }
7667
        /* c = *s; */ *s++ = 0;
×
7668
        while ( *s == ' ' || *s == ',' || *s == '\t' ) s++;
×
7669
        if ( StrICmp(subkey,(UBYTE *)"loops") == 0 ) {
×
7670
                return(CoCreateAllLoops(s));
×
7671
        }
7672
        else if ( StrICmp(subkey,(UBYTE *)"paths") == 0 ) {
×
7673
                return(CoCreateAllPaths(s));
×
7674
        }
7675
/*
7676
        else if ( StrICmp(subkey,(UBYTE *)"motics") == 0 ) {
7677
        }
7678
        else if ( StrICmp(subkey,(UBYTE *)"onepi") == 0 ) {
7679
        }
7680
        else if ( StrICmp(subkey,(UBYTE *)"cuts") == 0 ) {
7681
        }
7682
*/
7683
        else {
7684
                MesPrint("&Illegal subkey in CoCreate statement: %s.",subkey);
×
7685
                return(1);
×
7686
        }
7687
}
7688

7689
/*
7690
          #] CoCreateAll : 
7691
*/
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

© 2026 Coveralls, Inc