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

form-dev / form / 15701338753

17 Jun 2025 07:49AM UTC coverage: 50.382% (-0.004%) from 50.386%
15701338753

Pull #662

github

web-flow
Merge f1f68c050 into 207386593
Pull Request #662: Cleanup: change VOID into void

178 of 245 new or added lines in 34 files covered. (72.65%)

2 existing lines in 1 file now uncovered.

41784 of 82935 relevant lines covered (50.38%)

2640008.85 hits per line

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

42.97
/sources/dollar.c
1
/** @file dollar.c
2
 * 
3
 *  The routines that deal with the dollar variables.
4
 *  The name administration is to be found in the file names.c
5
 */
6
/* #[ License : */
7
/*
8
 *   Copyright (C) 1984-2023 J.A.M. Vermaseren
9
 *   When using this file you are requested to refer to the publication
10
 *   J.A.M.Vermaseren "New features of FORM" math-ph/0010025
11
 *   This is considered a matter of courtesy as the development was paid
12
 *   for by FOM the Dutch physics granting agency and we would like to
13
 *   be able to track its scientific use to convince FOM of its value
14
 *   for the community.
15
 *
16
 *   This file is part of FORM.
17
 *
18
 *   FORM is free software: you can redistribute it and/or modify it under the
19
 *   terms of the GNU General Public License as published by the Free Software
20
 *   Foundation, either version 3 of the License, or (at your option) any later
21
 *   version.
22
 *
23
 *   FORM is distributed in the hope that it will be useful, but WITHOUT ANY
24
 *   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
25
 *   FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
26
 *   details.
27
 *
28
 *   You should have received a copy of the GNU General Public License along
29
 *   with FORM.  If not, see <http://www.gnu.org/licenses/>.
30
 */
31
/* #] License : */ 
32
/*
33
          #[ Includes :
34
*/
35

36
#include "form3.h"
37

38
/* EXTERNLOCK(dummylock) */
39

40
static UBYTE underscore[2] = {'_',0};
41

42
/*
43
          #] Includes : 
44
          #[ CatchDollar :
45

46
        Works out a dollar expression during compile type.
47
        Steals it from the buffer and puts it in an assignment.
48
        At the moment we should keep this inside the small buffer.
49
        Later with more sort buffers we can do this better.
50
        Par == 0 : regular assignment
51
        par == -1: after error. Just make zero for now.
52
*/
53

54
int CatchDollar(int par)
15,948✔
55
{
56
        GETIDENTITY
10,632✔
57
        CBUF *C = cbuf + AC.cbufnum;
15,948✔
58
        int error = 0, numterms = 0, numdollar, resetmods = 0;
15,948✔
59
        LONG newsize, retval;
15,948✔
60
        WORD *w, *t, n, nsize, *oldwork = AT.WorkPointer, *dbuffer;
15,948✔
61
        WORD oldncmod = AN.ncmod;
15,948✔
62
        DOLLARS d;
15,948✔
63
        if ( AN.ncmod && ( ( AC.modmode & ALSODOLLARS ) == 0 ) ) AN.ncmod = 0;
15,948✔
64
        if ( AN.ncmod && AN.cmod == 0 ) { SetMods(); resetmods = 1; }
15,948✔
65

66
        numdollar = C->lhs[C->numlhs][2];
15,948✔
67

68
        d = Dollars+numdollar;
15,948✔
69
        if ( par == -1 ) {
15,948✔
70
                d->type = DOLUNDEFINED;
×
71
                cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
×
72
                cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
×
73
                if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,"$-buffer old");
×
74
                d->size = 0; d->where = &(AM.dollarzero);
×
75
                cbuf[AM.dbufnum].rhs[numdollar] = d->where;
×
76
                AN.ncmod = oldncmod;
×
77
                if ( resetmods ) UnSetMods();
×
78
                return(0);
×
79
        }
80
#ifdef WITHMPI
81
        /*
82
         * The problem here is that only the master can make an assignment
83
         * like #$a=g; where g is an expression: only the master has an access to
84
         * the expression. So, in cases where the RHS contains expression names,
85
         * only the master invokes Generator() and then broadcasts the result to
86
         * the all slaves.
87
         * Broadcasting must be performed immediately; one cannot postpone it
88
         * to the end of the module because the dollar variable is visible
89
         * in the current module. For the same reason, this should be done
90
         * regardless of on/off parallel status.
91
         * If the RHS does not contain any expression names, it can be processed
92
         * in each slave.
93
         */
94
        if ( PF.me == MASTER || !AC.RhsExprInModuleFlag ) {
95
#endif
96

97
        EXCHINOUT
15,948✔
98
 
99
        if ( NewSort(BHEAD0) ) { if ( !error ) error = 1; goto onerror; }
15,948✔
100
        if ( NewSort(BHEAD0) ) {
15,948✔
101
                LowerSortLevel();
×
102
                if ( !error ) error = 1;
×
103
                goto onerror;
×
104
        }
105
        AN.RepPoint = AT.RepCount + 1;
15,948✔
106
        w = C->rhs[C->lhs[C->numlhs][5]];
15,948✔
107
        while ( *w ) {
92,328✔
108
                n = *w; t = oldwork;
109
                NCOPY(t,w,n)
2,714,430✔
110
                AT.WorkPointer = t;
76,380✔
111
                AR.Cnumlhs = C->numlhs;
76,380✔
112
                if ( Generator(BHEAD oldwork,C->numlhs) ) { error = 1; break; }
76,380✔
113
        }
114
        AT.WorkPointer = oldwork;
15,948✔
115
        AN.tryterm = 0; /* for now */
15,948✔
116
        dbuffer = 0;
15,948✔
117
        if ( ( retval = EndSort(BHEAD (WORD *)((void *)(&dbuffer)),2) ) < 0 ) { error = 1; }
15,948✔
118
        LowerSortLevel();
15,948✔
119
        if ( retval <= 1 || dbuffer == 0 ) {
15,948✔
120
                d->type = DOLZERO;
×
121
                if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,"$-buffer old");
×
122
                d->size = 0; d->where = &(AM.dollarzero);
×
123
                cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
×
124
                cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
×
125
                goto docopy2;
×
126
        }
127
        w = dbuffer;
15,948✔
128
        if ( error == 0 )
15,948✔
129
                while ( *w ) { w += *w; numterms++; }
202,008✔
130
        else
131
                goto onerror;
×
132
        newsize = (w-dbuffer)+1;
15,948✔
133
#ifdef WITHMPI
134
        }
135
        if ( AC.RhsExprInModuleFlag )
136
                /* PF_BroadcastPreDollar allocates dbuffer for slaves! */
137
                if ( (error = PF_BroadcastPreDollar(&dbuffer, &newsize, &numterms)) != 0 )
138
                        goto onerror;
139
#endif
140
        if ( newsize < MINALLOC ) newsize = MINALLOC;
15,948✔
141
        newsize = ((newsize+7)/8)*8;
15,948✔
142
        if ( numterms == 0 ) {
15,948✔
143
                d->type = DOLZERO;
222✔
144
                goto docopy;
222✔
145
        }
146
        else if ( numterms == 1 ) {
15,726✔
147
                t = dbuffer;
3,450✔
148
                n = *t;
3,450✔
149
                nsize = t[n-1];
3,450✔
150
                if ( nsize < 0 ) { nsize = -nsize; }
3,450✔
151
                if ( nsize == (n-1) ) { /* numerical */
3,450✔
152
                        nsize = (nsize-1)/2;
3,276✔
153
                        w = t + 1 + nsize;
3,276✔
154
                        if ( *w != 1 ) goto doterms;
3,276✔
155
                        w++; while ( w < ( t + n - 1 ) ) { if ( *w ) break; w++; }
2,952✔
156
                        if ( w < ( t + n - 1 ) ) goto doterms;
2,904✔
157
                        d->type = DOLNUMBER;
2,904✔
158
                        goto docopy;
2,904✔
159
                }
160
                else if ( n == 7 && t[6] == 3 && t[5] == 1 && t[4] == 1
174✔
161
                        && t[1] == INDEX && t[2] == 3 ) {
18✔
162
                        d->type = DOLINDEX;
6✔
163
                        d->index = t[3];
6✔
164
                        goto docopy;
6✔
165
                }
166
                else goto doterms;
168✔
167
        }
168
        else {
169
doterms:;
12,276✔
170
                d->type = DOLTERMS;
12,816✔
171
                cbuf[AM.dbufnum].CanCommu[numdollar] = numcommute(dbuffer,
12,816✔
172
                                &(cbuf[AM.dbufnum].NumTerms[numdollar]));
12,816✔
173
docopy:;
15,948✔
174
                if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,"$-buffer old");
15,948✔
175
                d->size = newsize; d->where = dbuffer;
15,948✔
176
docopy2:;
15,948✔
177
                cbuf[AM.dbufnum].rhs[numdollar] = d->where;
15,948✔
178
        }
179
        if ( C->Pointer > C->rhs[C->numrhs] ) C->Pointer = C->rhs[C->numrhs];
15,948✔
180
        C->numlhs--; C->numrhs--;
15,948✔
181
onerror:
15,948✔
182
#ifdef WITHMPI
183
        if ( PF.me == MASTER || !AC.RhsExprInModuleFlag )
184
#endif
185
        BACKINOUT
15,948✔
186
        AN.ncmod = oldncmod;
15,948✔
187
        if ( resetmods ) UnSetMods();
15,948✔
188
        return(error);
189
}
190

191
/*
192
          #] CatchDollar : 
193
          #[ AssignDollar :
194

195
        To be called from Generator. Assigns an expression to a $ variable.
196
        This one is slightly different from CatchDollar.
197
        We have no easy buffer this time.
198
        We will have to hack our way using what we normally use for functions.
199

200
        Note that in the threaded case we trust the user. That means that
201
        we are not going to recheck whether there is a maximum, minimum or sum.
202
        If the user says it is like that, we treat it like that.
203
        We only check that in this centralized version MODLOCAL isn't used.
204

205
        In a later stage dtype could be used for actually checking MODMAX
206
        and MODMIN cases.
207
*/
208

209
int AssignDollar(PHEAD WORD *term, WORD level)
20,488✔
210
{
211
        GETBIDENTITY
212
        CBUF *C = cbuf+AM.rbufnum;
20,488✔
213
        int numterms = 0, numdollar = C->lhs[level][2];
20,488✔
214
        LONG newsize;
20,488✔
215
        DOLLARS d = Dollars + numdollar;
20,488✔
216
        WORD *w, *t, n, nsize, *rh = cbuf[C->lhs[level][7]].rhs[C->lhs[level][5]];
20,488✔
217
        WORD *ss, *ww;
20,488✔
218
        WORD olddefer, oldcompress, oldncmod = AN.ncmod;
20,488✔
219
#ifdef WITHPTHREADS
220
        int nummodopt, dtype = -1, dw;
13,660✔
221
        WORD numvalue;
13,660✔
222
        if ( AN.ncmod && ( ( AC.modmode & ALSODOLLARS ) == 0 ) ) AN.ncmod = 0;
13,660✔
223
        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
13,660✔
224
/*
225
                Here we come only when the module runs with more than one thread.
226
                This must be a variable with a special module option.
227
                For the multi-threaded version we only allow MODSUM, MODMAX and MODMIN.
228
*/
229
                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
9,625✔
230
                        if ( numdollar == ModOptdollars[nummodopt].number ) break;
9,625✔
231
                }
232
                if ( nummodopt >= NumModOptdollars ) {
9,220✔
233
                        MLOCK(ErrorMessageLock);
234
                        MesPrint("Illegal attempt to change $-variable in multi-threaded module %l",AC.CModule);
235
                        MUNLOCK(ErrorMessageLock);
236
                        Terminate(-1);
237
                }
238
                dtype = ModOptdollars[nummodopt].type;
9,220✔
239
                if ( dtype == MODLOCAL ) {
9,220✔
240
                        d = ModOptdollars[nummodopt].dstruct+AT.identity;
396✔
241
                }
242
        }
243
#endif
244
        DUMMYUSE(term);
20,488✔
245
        w = rh;
20,488✔
246
/*
247
        First some shortcuts
248
*/
249
        if ( *w == 0 ) {
20,488✔
250
/*
251
                 #[ Thread version : Zero case
252
*/
253
#ifdef WITHPTHREADS
254
                if ( dtype > 0 ) {
255
/*                        LOCK(d->pthreadslockwrite); */
256
                        LOCK(d->pthreadslockread);
257
NewValIsZero:;
9✔
258
                        switch ( d->type ) {
9✔
259
                                case DOLZERO: goto NoChangeZero;
5✔
260
                                case DOLNUMBER:
4✔
261
                                case DOLTERMS:
262
                                        if ( ( dw = d->where[0] ) > 0 && d->where[dw] != 0 ) {
4✔
263
                                                break; /* was not a single number. Trust the user */
264
                                        }
265
                                        if ( dtype == MODMAX && d->where[dw-1] >= 0 ) goto NoChangeZero;
4✔
266
                                        if ( dtype == MODMIN && d->where[dw-1] <= 0 ) goto NoChangeZero;
4✔
267
                                        break;
268
                                default:
269
                                        numvalue = DolToNumber(BHEAD numdollar);
270
                                        if ( AN.ErrorInDollar != 0 ) break;
271
                                        if ( dtype == MODMAX && numvalue >= 0 ) goto NoChangeZero;
272
                                        if ( dtype == MODMIN && numvalue <= 0 ) goto NoChangeZero;
273
                                        break;
274
                        }
275
                        d->type = DOLZERO;
4✔
276
                        d->where[0] = 0;
4✔
277
                        cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
4✔
278
                        cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
4✔
279
NoChangeZero:;
9✔
280
                        CleanDollarFactors(d);
9✔
281
/*                        UNLOCK(d->pthreadslockwrite); */
282
                        UNLOCK(d->pthreadslockread);
9✔
283
                        AN.ncmod = oldncmod;
9✔
284
                        return(0);
9✔
285
                }
286
#endif
287
/*
288
                 #] Thread version : 
289
*/
290
                d->type = DOLZERO;
×
291
                d->where[0] = 0;
×
292
                cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
×
293
                cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
×
294
                CleanDollarFactors(d);
×
295
                AN.ncmod = oldncmod;
×
296
                return(0);
×
297
        }
298
        else if ( *w == 4 && w[4] == 0 && w[2] == 1 ) {
20,488✔
299
/*
300
                 #[ Thread version : New value is 'single precision'
301
*/
302
#ifdef WITHPTHREADS
303
                if ( dtype > 0 ) {
396✔
304
/*                        LOCK(d->pthreadslockwrite); */
305
                        LOCK(d->pthreadslockread);
396✔
306
                        if ( d->size < MINALLOC ) {
396✔
307
                                WORD oldsize, *oldwhere, i;
27✔
308
                                oldsize = d->size; oldwhere = d->where;
27✔
309
                                d->size = MINALLOC;
27✔
310
                                d->where = (WORD *)Malloc1(d->size*sizeof(WORD),"dollar contents");
27✔
311
                                cbuf[AM.dbufnum].rhs[numdollar] = d->where;
27✔
312
                                if ( oldsize > 0 ) {
27✔
313
                                        for ( i = 0; i < oldsize; i++ ) d->where[i] = oldwhere[i];
314
                                }
315
                                else d->where[0] = 0;
27✔
316
                                if ( oldwhere && oldwhere != &(AM.dollarzero) ) M_free(oldwhere,"dollar contents");
27✔
317
                        }
318
                        switch ( d->type ) {
396✔
319
                                case DOLZERO:
320
HandleDolZero:;
321
                                        if ( dtype == MODMAX && w[3] <= 0 ) goto NoChangeOne;
322
                                        if ( dtype == MODMIN && w[3] >= 0 ) goto NoChangeOne;
323
                                        break;
324
                                case DOLNUMBER:
369✔
325
                                case DOLTERMS:
326
                                        if ( ( dw = d->where[0] ) > 0 && d->where[dw] != 0 ) {
369✔
327
                                                break; /* was not a single number. Trust the user */
328
                                        }
329
                                        if ( dtype == MODMAX && CompCoef(d->where,w) >= 0 ) goto NoChangeOne;
369✔
330
                                        if ( dtype == MODMIN && CompCoef(d->where,w) <= 0 ) goto NoChangeOne;
369✔
331
                                        break;
332
                                default:
27✔
333
                                        {
334
/*
335
                                                Note that we convert the type for the next time around.
336
*/
337
                                                WORD extraterm[4];
27✔
338
                                                numvalue = DolToNumber(BHEAD numdollar);
27✔
339
                                                if ( AN.ErrorInDollar != 0 ) break;
27✔
340
                                                if ( numvalue == 0 ) {
341
                                                        d->type = DOLZERO;
342
                                                        d->where[0] = 0;
343
                                                        cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
344
                                                        cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
345
                                                        goto HandleDolZero;
346
                                                }
347
                                                d->where[0] = extraterm[0] = 4;
348
                                                d->where[1] = extraterm[1] = ABS(numvalue);
349
                                                d->where[2] = extraterm[2] = 1;
350
                                                d->where[3] = extraterm[3] = numvalue > 0 ? 3 : -3;
351
                                                d->where[4] = 0;
352
                                                d->type = DOLNUMBER;
353
                                                if ( dtype == MODMAX && CompCoef(extraterm,w) >= 0 ) goto NoChangeOne;
354
                                                if ( dtype == MODMIN && CompCoef(extraterm,w) <= 0 ) goto NoChangeOne;
355
                                                break;
356
                                        }
357
                        }
358
                        d->where[0] = w[0];
396✔
359
                        d->where[1] = w[1];
396✔
360
                        d->where[2] = w[2];
396✔
361
                        d->where[3] = w[3];
396✔
362
                        d->where[4] = 0;
396✔
363
                        d->type = DOLNUMBER;
396✔
364
                        cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
396✔
365
                        cbuf[AM.dbufnum].NumTerms[numdollar] = 1;
396✔
366
NoChangeOne:;
396✔
367
                        CleanDollarFactors(d);
396✔
368
/*                        UNLOCK(d->pthreadslockwrite); */
369
                        UNLOCK(d->pthreadslockread);
396✔
370
                        AN.ncmod = oldncmod;
396✔
371
                        return(0);
396✔
372
                }
373
#endif
374
/*
375
                 #] Thread version : 
376
*/
377
                if ( d->size < MINALLOC ) {
198✔
378
                        if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,"dollar contents");
6✔
379
                        d->size = MINALLOC;
6✔
380
                        d->where = (WORD *)Malloc1(d->size*sizeof(WORD),"dollar contents");
6✔
381
                        cbuf[AM.dbufnum].rhs[numdollar] = d->where;
6✔
382
                }
383
                d->where[0] = w[0];
198✔
384
                d->where[1] = w[1];
198✔
385
                d->where[2] = w[2];
198✔
386
                d->where[3] = w[3];
198✔
387
                d->where[4] = 0;
198✔
388
                d->type = DOLNUMBER;
198✔
389
                cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
198✔
390
                cbuf[AM.dbufnum].NumTerms[numdollar] = 1;
198✔
391
                CleanDollarFactors(d);
198✔
392
                AN.ncmod = oldncmod;
198✔
393
                return(0);
198✔
394
        }
395
/*
396
        Now the real evaluation.
397
        In the case of threads and MODSUM this requires an immediate lock.
398
        Otherwise the lock could be placed later.
399
*/
400
#ifdef WITHPTHREADS
401
        if ( dtype == MODSUM ) {
13,264✔
402
/*                LOCK(d->pthreadslockwrite); */
403
                LOCK(d->pthreadslockread);
8,800✔
404
        }
405
#endif
406
        CleanDollarFactors(d);
19,894✔
407
/*
408
        The following case cannot occur. We treated it already
409

410
        if ( *w == 0 ) {
411
                ss = 0; numterms = 0; newsize = 0;
412
                olddefer = AR.DeferFlag; AR.DeferFlag = 0;
413
                oldcompress = AR.NoCompress; AR.NoCompress = 1;
414
        }
415
        else
416
*/
417
        {
418
/*
419
                New value is an expression that has to be evaluated first
420
                This is all generic. It won't foliate due to the sort level 
421
*/
422
                if ( NewSort(BHEAD0) ) {
19,894✔
423
                        AN.ncmod = oldncmod;
×
424
                        return(1);
×
425
                }
426
                olddefer = AR.DeferFlag; AR.DeferFlag = 0;
19,894✔
427
                oldcompress = AR.NoCompress; AR.NoCompress = 1;
19,894✔
428
                while ( *w ) {
59,396✔
429
                        n = *w; t = ww = AT.WorkPointer;
39,502✔
430
                        NCOPY(t,w,n);
297,822✔
431
                        AT.WorkPointer = t;
39,502✔
432
                        if ( Generator(BHEAD ww,AR.Cnumlhs) ) {
39,502✔
433
                                AT.WorkPointer = ww;
×
434
                                LowerSortLevel();
×
435
                                AR.DeferFlag = olddefer;
×
436
                                AN.ncmod = oldncmod;
×
437
                                return(1);
×
438
                        }
439
                        AT.WorkPointer = ww;
39,502✔
440
                }
441
                AN.tryterm = 0; /* for now */
19,894✔
442
                if ( ( newsize = EndSort(BHEAD (WORD *)((void *)(&ss)),2) ) < 0 ) {
19,894✔
443
                        AN.ncmod = oldncmod;
×
444
                        return(1);
×
445
                }
446
                numterms = 0; t = ss; while ( *t ) { numterms++; t += *t; }
41,487✔
447
        }
448
#ifdef WITHPTHREADS
449
        if ( dtype != MODSUM ) {
13,264✔
450
/*                LOCK(d->pthreadslockwrite); */
451
                LOCK(d->pthreadslockread);
4,464✔
452
        }
453
#endif
454
        if ( numterms == 0 ) {
19,894✔
455
/*
456
                the new value evaluates to zero
457
*/
458
#ifdef WITHPTHREADS
459
                if ( dtype == MODMAX || dtype == MODMIN ) {
9✔
460
                        if ( ss ) { M_free(ss,"Sort of $"); ss = 0; }
9✔
461
                        AR.DeferFlag = olddefer; AR.NoCompress = oldcompress;
9✔
462
                        goto NewValIsZero;
9✔
463
                }
464
                else
465
#endif
466
                {
467
                  if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,"dollar contents");
2✔
468
                  d->where = &(AM.dollarzero);
2✔
469
                  d->size = 0;
2✔
470
                  cbuf[AM.dbufnum].rhs[numdollar] = 0;
2✔
471
                  cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
2✔
472
                  cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
2✔
473
                  d->type = DOLZERO;
2✔
474
                }
475
                if ( ss ) { M_free(ss,"Sort of $"); ss = 0; }
2✔
476
        }
477
        else {
478
/*
479
                 #[ Thread version :
480
*/
481
#ifdef WITHPTHREADS
482
                if ( dtype == MODMAX || dtype == MODMIN ) {
13,255✔
483
                        if ( numterms == 1 && ( *ss-1 == ABS(ss[*ss-1]) ) ) { /* is number */
15✔
484
                          switch ( d->type ) {
15✔
485
                                case DOLZERO:
486
HandleDolZero1:;
4✔
487
                                        if ( dtype == MODMAX && ss[*ss-1] > 0 ) break;
4✔
488
                                        if ( dtype == MODMIN && ss[*ss-1] < 0 ) break;
489
                                        if ( ss ) { M_free(ss,"Sort of $"); ss = 0; }
490
                                        AR.DeferFlag = olddefer; AR.NoCompress = oldcompress;
491
                                        goto NoChange;
492
                                case DOLTERMS:
11✔
493
                                case DOLNUMBER:
494
                                        if ( ( dw = d->where[0] ) > 0 && d->where[dw] != 0 ) break;
11✔
495
                                        if ( dtype == MODMAX && CompCoef(ss,d->where) > 0 ) break;
11✔
496
                                        if ( dtype == MODMIN && CompCoef(ss,d->where) < 0 ) break;
497
                                        if ( ss ) { M_free(ss,"Sort of $"); ss = 0; }
498
                                        AR.DeferFlag = olddefer; AR.NoCompress = oldcompress;
499
                                        goto NoChange;
500
                                default: {
501
                                        WORD extraterm[4];
502
                                        numvalue = DolToNumber(BHEAD numdollar);
503
                                        if ( AN.ErrorInDollar != 0 ) break;
504
                                        if ( numvalue == 0 ) {
505
                                                d->type = DOLZERO;
506
                                                d->where[0] = 0;
507
                                                cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
508
                                                cbuf[AM.dbufnum].NumTerms[numdollar] = 0;
509
                                                goto HandleDolZero1;
510
                                        }
511
                                        d->where[0] = extraterm[0] = 4;
512
                                        d->where[1] = extraterm[1] = ABS(numvalue);
513
                                        d->where[2] = extraterm[2] = 1;
514
                                        d->where[3] = extraterm[3] = numvalue > 0 ? 3 : -3;
515
                                        d->where[4] = 0;
516
                                        d->type = DOLNUMBER;
517
                                        if ( dtype == MODMAX && CompCoef(ss,extraterm) > 0 ) break;
518
                                        if ( dtype == MODMIN && CompCoef(ss,extraterm) < 0 ) break;
519
                                        if ( ss ) { M_free(ss,"Sort of $"); ss = 0; }
520
                                        AR.DeferFlag = olddefer; AR.NoCompress = oldcompress;
521
                                        goto NoChange;
522
                                }
523
                          }
524
                        }
525
                        else {
526
                                if ( ss ) { M_free(ss,"Sort of $"); ss = 0; }
527
                                AR.DeferFlag = olddefer; AR.NoCompress = oldcompress;
528
                                goto NoChange;
529
                        }
530
                }
531
#endif
532
/*
533
                 #] Thread version : 
534
*/
535
                d->type = DOLTERMS;
19,883✔
536
                if ( d->where && d->where != &(AM.dollarzero) ) { M_free(d->where,"dollar contents"); d->where = 0; }
19,883✔
537
                d->size = newsize + 1;
19,883✔
538
                d->where = ss;
19,883✔
539
                cbuf[AM.dbufnum].rhs[numdollar] = w = d->where;
19,883✔
540
        }
541
        AR.DeferFlag = olddefer; AR.NoCompress = oldcompress;
19,885✔
542
/*
543
        Now find the special cases
544
*/
545
        if ( numterms == 0 ) {
19,885✔
546
                d->type = DOLZERO;
2✔
547
        }
548
        else if ( numterms == 1 ) {
19,883✔
549
                t = d->where;
19,829✔
550
                n = *t;
19,829✔
551
                nsize = t[n-1];
19,829✔
552
                if ( nsize < 0 ) { nsize = -nsize; }
19,829✔
553
                if ( nsize == (n-1) ) {
19,829✔
554
                        nsize = (nsize-1)/2;
19,739✔
555
                        w = t + 1 + nsize;
19,739✔
556
                        if ( *w == 1 ) {
19,739✔
557
                                w++; while ( w < ( t + n - 1 ) ) { if ( *w ) break; w++; }
19,739✔
558
                                if ( w >= ( t + n - 1 ) ) d->type = DOLNUMBER;
19,739✔
559
                        }
560
                }
561
                else if ( n == 7 && t[6] == 3 && t[5] == 1 && t[4] == 1
90✔
562
                        && t[1] == INDEX && t[2] == 3 ) {
18✔
563
                        d->type = DOLINDEX;
×
564
                        d->index = t[3];
×
565
                }
566
        }
567
        if ( d->type == DOLTERMS ) {
19,885✔
568
                cbuf[AM.dbufnum].CanCommu[numdollar] = numcommute(d->where,
144✔
569
                        &(cbuf[AM.dbufnum].NumTerms[numdollar]));
144✔
570
        }
571
        else {
572
                cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
19,741✔
573
                cbuf[AM.dbufnum].NumTerms[numdollar] = 1;
19,741✔
574
        }
575
#ifdef WITHPTHREADS
576
NoChange:;
13,255✔
577
/*        UNLOCK(d->pthreadslockwrite); */
578
        UNLOCK(d->pthreadslockread);
13,255✔
579
#endif
580
        AN.ncmod = oldncmod;
19,885✔
581
        return(0);
19,885✔
582
}
583

584
/*
585
          #] AssignDollar : 
586
          #[ WriteDollarToBuffer :
587

588
        Takes the numbered dollar expression and writes it to output.
589
        We catch however the output in a buffer and return its address.
590
        This routine is needed when we need a text representation of
591
        a dollar expression like for the construction `$name' in the preprocessor.
592
        If par==0 we leave the current printing mode.
593
        If par==1 we insist on normal mode
594
*/
595

596
UBYTE *WriteDollarToBuffer(WORD numdollar, WORD par)
23,364✔
597
{
598
        DOLLARS d = Dollars+numdollar;
23,364✔
599
        UBYTE *s, *oldcurbufwrt = AO.CurBufWrt;
23,364✔
600
        WORD *t, lbrac = 0, first = 0, arg[2], oldOutputMode = AC.OutputMode;
23,364✔
601
        WORD oldinfbrack = AO.InFbrack;
23,364✔
602
        int error = 0;
23,364✔
603
        int dict = AO.CurrentDictionary;
23,364✔
604
 
605
        AO.DollarOutSizeBuffer = 32;
23,364✔
606
        AO.DollarOutBuffer = (UBYTE *)Malloc1(AO.DollarOutSizeBuffer,"DollarOutBuffer");
23,364✔
607
        AO.DollarInOutBuffer = 1;
23,364✔
608
        AO.PrintType = 1;
23,364✔
609
        AO.InFbrack = 0;
23,364✔
610
        s = AO.DollarOutBuffer;
23,364✔
611
        *s = 0;
23,364✔
612
        if ( par > 0 && AO.CurDictInDollars == 0 ) {
23,364✔
613
                AC.OutputMode = NORMALFORMAT;
23,340✔
614
                AO.CurrentDictionary = 0;
23,340✔
615
        }
616
        else {
617
                AO.CurBufWrt = (UBYTE *)underscore;
24✔
618
        }
619
        AO.OutInBuffer = 1;
23,364✔
620
        switch ( d->type ) {
23,364✔
621
                case DOLARGUMENT:
×
622
                        WriteArgument(d->where);
×
623
                        break;
×
624
                case DOLSUBTERM:
×
625
                        WriteSubTerm(d->where,1);
×
626
                        break;
×
627
                case DOLNUMBER:
23,298✔
628
                case DOLTERMS:
629
                        t = d->where;
23,298✔
630
                        while ( *t ) {
279,582✔
631
                                if ( WriteTerm(t,&lbrac,first,PRINTON,0) ) {
256,284✔
632
                                        error = 1; break;
633
                                }
634
                                t += *t;
256,284✔
635
                        }
636
                        break;
637
                case DOLWILDARGS:
24✔
638
                        t = d->where+1;
24✔
639
                        while ( *t ) {
60✔
640
                                WriteArgument(t);
36✔
641
                                NEXTARG(t)
36✔
642
                                if ( *t ) TokenToLine((UBYTE *)(","));
36✔
643
                        }
644
                        break;
645
                case DOLINDEX:
×
646
                        arg[0] = -INDEX; arg[1] = d->index;
×
647
                        WriteArgument(arg);
×
648
                        break;
×
649
                case DOLZERO:
42✔
650
                        *s++ = '0'; *s = 0;
42✔
651
                        AO.DollarInOutBuffer = 1;
42✔
652
                        break;
42✔
653
                case DOLUNDEFINED:
×
654
                        *s = 0;
×
655
                        AO.DollarInOutBuffer = 1;
×
656
                        break;
×
657
        }
658
        AC.OutputMode = oldOutputMode;
23,364✔
659
        AO.OutInBuffer = 0;
23,364✔
660
        AO.InFbrack = oldinfbrack;
23,364✔
661
        AO.CurBufWrt = oldcurbufwrt;
23,364✔
662
        AO.CurrentDictionary = dict;
23,364✔
663
        if ( error ) {
23,364✔
664
                MLOCK(ErrorMessageLock);
×
665
                MesPrint("&Illegal dollar object for writing");
×
666
                MUNLOCK(ErrorMessageLock);
×
667
                M_free(AO.DollarOutBuffer,"DollarOutBuffer");
×
668
                AO.DollarOutBuffer = 0;
×
669
                AO.DollarOutSizeBuffer = 0;
×
670
                return(0);
×
671
        }
672
        return(AO.DollarOutBuffer);
23,364✔
673
}
674

675
/*
676
          #] WriteDollarToBuffer : 
677
          #[ WriteDollarFactorToBuffer :
678

679
        Takes the numbered dollar expression and writes it to output.
680
        We catch however the output in a buffer and return its address.
681
        This routine is needed when we need a text representation of
682
        a dollar expression like for the construction `$name' in the preprocessor.
683
        If par==0 we leave the current printing mode.
684
        If par==1 we insist on normal mode
685
*/
686

687
UBYTE *WriteDollarFactorToBuffer(WORD numdollar, WORD numfac, WORD par)
504✔
688
{
689
        DOLLARS d = Dollars+numdollar;
504✔
690
        UBYTE *s, *oldcurbufwrt = AO.CurBufWrt;
504✔
691
        WORD *t, lbrac = 0, first = 0, n[5], oldOutputMode = AC.OutputMode;
504✔
692
        WORD oldinfbrack = AO.InFbrack;
504✔
693
        int error = 0;
504✔
694
        int dict = AO.CurrentDictionary;
504✔
695
 
696
        if ( numfac > d->nfactors || numfac < 0 ) {
504✔
697
                MLOCK(ErrorMessageLock);
×
698
                MesPrint("&Illegal factor number for this dollar variable: %d",numfac);
×
699
                MesPrint("&There are %d factors",d->nfactors);
×
700
                MUNLOCK(ErrorMessageLock);
×
701
                return(0);
×
702
        }
703

704
        AO.DollarOutSizeBuffer = 32;
504✔
705
        AO.DollarOutBuffer = (UBYTE *)Malloc1(AO.DollarOutSizeBuffer,"DollarOutBuffer");
504✔
706
        AO.DollarInOutBuffer = 1;
504✔
707
        AO.PrintType = 1;
504✔
708
        AO.InFbrack = 0;
504✔
709
        s = AO.DollarOutBuffer;
504✔
710
        *s = 0;
504✔
711
        if ( par > 0 ) {
504✔
712
                AC.OutputMode = NORMALFORMAT;
432✔
713
                AO.CurrentDictionary = 0;
432✔
714
        }
715
        else {
716
                AO.CurBufWrt = (UBYTE *)underscore;
72✔
717
        }
718
        AO.OutInBuffer = 1;
504✔
719
        if ( numfac == 0 ) {        /* write the number d->nfactors */
504✔
720
                n[0] = 4; n[1] = d->nfactors; n[2] = 1; n[3] = 3; n[4] = 0; t = n;
54✔
721
        }
722
        else if ( numfac ==  1 && d->factors == 0 ) {        /* Here d->factors is zero and d->where is fine */
450✔
723
                t = d->where;
6✔
724
        }
725
        else if ( d->factors[numfac-1].where == 0 ) {        /* write the value */
444✔
726
                if ( d->factors[numfac-1].value < 0 ) {
30✔
727
                        n[0] = 4; n[1] = -d->factors[numfac-1].value; n[2] = 1; n[3] = -3; n[4] = 0; t = n;
30✔
728
                }
729
                else {
730
                        n[0] = 4; n[1] = d->factors[numfac-1].value; n[2] = 1; n[3] = 3; n[4] = 0; t = n;
×
731
                }
732
        }
733
        else { t = d->factors[numfac-1].where; }
734
        while ( *t ) {
1,428✔
735
                if ( WriteTerm(t,&lbrac,first,PRINTON,0) ) {
924✔
736
                        error = 1; break;
737
                }
738
                t += *t;
924✔
739
        }
740
        AC.OutputMode = oldOutputMode;
504✔
741
        AO.OutInBuffer = 0;
504✔
742
        AO.InFbrack = oldinfbrack;
504✔
743
        AO.CurBufWrt = oldcurbufwrt;
504✔
744
        AO.CurrentDictionary = dict;
504✔
745
        if ( error ) {
504✔
746
                MLOCK(ErrorMessageLock);
×
747
                MesPrint("&Illegal dollar object for writing");
×
748
                MUNLOCK(ErrorMessageLock);
×
749
                M_free(AO.DollarOutBuffer,"DollarOutBuffer");
×
750
                AO.DollarOutBuffer = 0;
×
751
                AO.DollarOutSizeBuffer = 0;
×
752
                return(0);
×
753
        }
754
        return(AO.DollarOutBuffer);
504✔
755
}
756

757
/*
758
          #] WriteDollarFactorToBuffer : 
759
          #[ AddToDollarBuffer :
760
*/
761

762
void AddToDollarBuffer(UBYTE *s)
1,277,928✔
763
{
764
        int i;
1,277,928✔
765
        UBYTE *t = s, *u, *newdob;
1,277,928✔
766
        LONG j;
1,277,928✔
767
        while ( *t ) { t++; }
4,266,720✔
768
        i = t - s;
1,277,928✔
769
        while ( i + AO.DollarInOutBuffer >= AO.DollarOutSizeBuffer ) {
1,321,122✔
770
                j = AO.DollarInOutBuffer;
43,194✔
771
                AO.DollarOutSizeBuffer *= 2;
43,194✔
772
                t = AO.DollarOutBuffer;
43,194✔
773
                newdob = (UBYTE *)Malloc1(AO.DollarOutSizeBuffer,"DollarOutBuffer");
43,194✔
774
                u = newdob;
43,194✔
775
                while ( --j >= 0 ) *u++ = *t++;
2,743,944✔
776
                M_free(AO.DollarOutBuffer,"DollarOutBuffer");
43,194✔
777
                AO.DollarOutBuffer = newdob;
43,194✔
778
        }
779
        t = AO.DollarOutBuffer + AO.DollarInOutBuffer-1;
1,277,928✔
780
        while ( t == AO.DollarOutBuffer && ( *s == '+' || *s == ' ' ) ) s++;
1,311,252✔
781
        i = 0;
1,277,928✔
782
        if ( AO.CurrentDictionary == 0 ) {
1,277,928✔
783
                while ( *s ) {
4,233,396✔
784
                        if ( *s == ' ' ) { s++; continue; }
2,955,468✔
785
                        *t++ = *s++; i++;
2,469,594✔
786
                }
787
        }
788
        else {
789
                while ( *s ) { *t++ = *s++; i++; }
×
790
        }
791
        *t = 0;
1,277,928✔
792
        AO.DollarInOutBuffer += i;
1,277,928✔
793
}
1,277,928✔
794

795
/*
796
          #] AddToDollarBuffer : 
797
          #[ TermAssign :
798

799
        This routine is called from a piece of code in Normalize that has been
800
        commented out.
801
*/
802

803
void TermAssign(WORD *term)
×
804
{
805
        DOLLARS d;
×
806
        WORD *t, *tstop, *astop, *w, *m;
×
807
        WORD i, newsize;
×
808
        for (;;) {
×
809
                astop = term + *term;
×
810
                tstop = astop - ABS(astop[-1]);
×
811
                t = term + 1;
×
812
                while ( t < tstop ) {
×
813
                        if ( *t == AM.termfunnum && t[1] == FUNHEAD+2
×
814
                        && t[FUNHEAD] == -DOLLAREXPRESSION ) {
×
815
                                d = Dollars + t[FUNHEAD+1];
×
816
                                newsize = *term - FUNHEAD - 1;
×
817
                                if ( newsize < MINALLOC ) newsize = MINALLOC;
×
818
                                newsize = ((newsize+7)/8)*8;
×
819
                                if ( d->size > 2*newsize && d->size > 1000 ) {
×
820
                                        if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,"dollar contents");
×
821
                                        d->size = 0;
×
822
                                        d->where = &(AM.dollarzero);
×
823
                                }
824
                                if ( d->size < newsize ) {
×
825
                                        if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,"dollar contents");
×
826
                                        d->size = newsize;
×
827
                                        d->where = (WORD *)Malloc1(newsize*sizeof(WORD),"dollar contents");
×
828
                                }
829
                                cbuf[AM.dbufnum].rhs[t[FUNHEAD+1]] = w = d->where;
×
830
                                m = term;
×
831
                                while ( m < t ) *w++ = *m++;
×
832
                                m += t[1];
×
833
                                while ( m < tstop ) {
×
834
                                        if ( *m == AM.termfunnum && m[1] == FUNHEAD+2
×
835
                                        && m[FUNHEAD] == -DOLLAREXPRESSION ) { m += m[1]; }
×
836
                                        else {
837
                                                i = m[1];
×
838
                                                while ( --i >= 0 ) *w++ = *m++;
×
839
                                        }
840
                                }
841
                                while ( m < astop ) *w++ = *m++;
×
842
                                *(d->where) = w - d->where;
×
843
                                *w = 0;
×
844
                                d->type = DOLTERMS;
×
845
                                w = t; m = t + t[1];
×
846
                                while ( m < astop ) *w++ = *m++;
×
847
                                *term = w - term;
×
848
                                break;
×
849
                        }
850
                        t += t[1];
×
851
                }
852
                if ( t >= tstop ) return;
×
853
        }
854
}
855

856
/*
857
          #] TermAssign : 
858
          #[ PutTermInDollar :
859

860
        We assume here that the dollar is local.
861
*/
862

863
int PutTermInDollar(WORD *term, WORD numdollar)
×
864
{
865
        DOLLARS d = Dollars+numdollar;
×
866
        WORD i;
×
867
        if ( term == 0 || *term == 0 ) {
×
868
                d->type = DOLZERO;
×
869
                return(0);
×
870
        }
871
        if ( d->size < *term || d->size > 2*term[0] || d->where == 0 ) {
×
872
                if ( d->size > 0 && d->where ) {
×
873
                        M_free(d->where,"dollar contents");
×
874
                }
875
                d->where = Malloc1((term[0]+1)*sizeof(WORD),"dollar contents");
×
876
                d->size = term[0]+1;
×
877
        }
878
        d->type = DOLTERMS;
×
879
        for ( i = 0; i < term[0]; i++ ) d->where[i] = term[i];
×
880
        d->where[i] = 0;
×
881
        return(0);
×
882
}
883

884
/*
885
          #] PutTermInDollar : 
886
          #[ WildDollars :
887

888
        Note that we cannot upload wildcards into dollar variables when WITHPTHREADS.
889
*/
890

891
void WildDollars(PHEAD WORD *term)
120✔
892
{
893
        GETBIDENTITY
894
        DOLLARS d;
120✔
895
        WORD *m, *t, *w, *ww, *orig = 0, *wildvalue, *wildstop;
120✔
896
        int numdollar;
120✔
897
        LONG weneed, i;
120✔
898
#ifdef WITHPTHREADS
899
        int dtype = -1;
80✔
900
#endif
901
        if ( term == 0 ) {
120✔
902
                m = wildvalue = AN.WildValue;
84✔
903
                wildstop = AN.WildStop;
84✔
904
        }
905
        else {
906
                ww = term + *term; ww -= ABS(ww[-1]); w = term+1;
36✔
907
                while ( w < ww && *w != SUBEXPRESSION ) w += w[1];
36✔
908
                if ( w >= ww ) return;
36✔
909
                wildstop = w + w[1];
36✔
910
                w += SUBEXPSIZE;
36✔
911
                wildvalue = m = w;
36✔
912
        }
913
        while ( m < wildstop ) {
456✔
914
                if ( *m != LOADDOLLAR ) { m += m[1]; continue; }
336✔
915
                t = m - 4;
84✔
916
                while ( *t == LOADDOLLAR || *t == FROMSET || *t == SETTONUM ) t -= 4;
84✔
917
                if ( t < wildvalue ) {
84✔
918
                        MLOCK(ErrorMessageLock);
×
919
                        MesPrint("&Serious bug in wildcard prototype. Found in WildDollars");
×
920
                        MUNLOCK(ErrorMessageLock);
×
921
                        Terminate(-1);
×
922
                }
923
                numdollar = m[2];
84✔
924
                d = Dollars + numdollar;
84✔
925
#ifdef WITHPTHREADS
926
                {
927
                        int nummodopt;
56✔
928
                        dtype = -1;
56✔
929
                        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
56✔
930
                                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
16✔
931
                                        if ( numdollar == ModOptdollars[nummodopt].number ) break;
16✔
932
                                }
933
                                if ( nummodopt < NumModOptdollars ) {
16✔
934
                                        dtype = ModOptdollars[nummodopt].type;
16✔
935
                                        if ( dtype == MODLOCAL ) {
16✔
936
                                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
16✔
937
                                        }
938
                                        else {
939
                                                MLOCK(ErrorMessageLock);
940
                                                MesPrint("&Illegal attempt to use $-variable %s in module %l",
941
                                                        DOLLARNAME(Dollars,numdollar),AC.CModule);
942
                                                MUNLOCK(ErrorMessageLock);
943
                                                Terminate(-1);
944
                                        }
945
                                }
946
                        }
947
                }
948
#endif
949
/*
950
                The value of this wildcard goes into our $-variable
951
                First compute the space we need.
952
*/
953
                switch ( *t ) {
84✔
954
                        case SYMTONUM:
955
                                weneed = 5;
956
                                break;
957
                        case SYMTOSYM:
958
                                weneed = 9;
959
                                break;
960
                        case SYMTOSUB:
36✔
961
                        case VECTOSUB:
962
                        case INDTOSUB:
963
                                orig = cbuf[AT.ebufnum].rhs[t[3]];
36✔
964
                                w = orig; while ( *w ) w += *w;
144✔
965
                                weneed = w - orig + 1;
36✔
966
                                break;
36✔
967
                        case VECTOMIN:
968
                        case VECTOVEC:
969
                        case INDTOIND:
970
                                weneed = 8;
971
                                break;
972
                        case FUNTOFUN:
973
                                weneed = FUNHEAD+5;
974
                                break;
975
                        case ARGTOARG:
24✔
976
                                orig = cbuf[AT.ebufnum].rhs[t[3]];
24✔
977
                                if ( *orig > 0 ) weneed = *orig+2;
24✔
978
                                else {
979
                                        w = orig+1; while ( *w ) { NEXTARG(w) }
96✔
980
                                        weneed = w - orig + 1;
24✔
981
                                }
982
                                break;
983
                        default:
984
                                weneed = MINALLOC;
985
                                break;
986
                }
987
                if ( weneed < MINALLOC ) weneed = MINALLOC;
60✔
988
                weneed = ((weneed+7)/8)*8;
84✔
989
                if ( d->size > 2*weneed && d->size > 1000 ) {
84✔
990
                        if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,"dollarspace");
×
991
                        d->where = &(AM.dollarzero);
×
992
                        d->size = 0;
×
993
                }
994
                if ( d->size < weneed ) {
84✔
995
                        if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,"dollarspace");
66✔
996
                        d->where = (WORD *)Malloc1(weneed*sizeof(WORD),"dollarspace");
66✔
997
                        d->size = weneed;
66✔
998
                }
999
/*
1000
                It is not clear what the following code does for TFORM
1001

1002
                if ( dtype != MODLOCAL ) {
1003
*/
1004
                        cbuf[AM.dbufnum].CanCommu[numdollar] = 0;
84✔
1005
                        cbuf[AM.dbufnum].NumTerms[numdollar] = 1;
84✔
1006
/*                        cbuf[AM.dbufnum].rhs[numdollar] = d->where; */
1007
                        cbuf[AM.dbufnum].rhs[numdollar] = (WORD *)(1);
84✔
1008
/*
1009
                }
1010
                Now load up the value of the wildcard in compiler buffer format
1011
*/
1012
                w = d->where;
84✔
1013
                d->type = DOLTERMS;
84✔
1014
                switch ( *t ) {
84✔
1015
                        case SYMTONUM:
12✔
1016
                                d->where[0] = 4; d->where[2] = 1;
12✔
1017
                                if ( t[3] >= 0 ) { d->where[1] = t[3]; d->where[3] = 3; }
12✔
1018
                                else { d->where[1] = -t[3]; d->where[3] = -3; }
×
1019
                                if ( t[3] == 0 ) { d->type = DOLZERO; d->where[0] = 0; }
12✔
1020
                                else { d->type = DOLNUMBER; d->where[4] = 0; }
12✔
1021
                                break;
1022
                        case SYMTOSYM:
12✔
1023
                                *w++ = 8;
12✔
1024
                                *w++ = SYMBOL;
12✔
1025
                                *w++ = 4;
12✔
1026
                                *w++ = t[3];
12✔
1027
                                *w++ = 1;
12✔
1028
                                *w++ = 1;
12✔
1029
                                *w++ = 1;
12✔
1030
                                *w++ = 3;
12✔
1031
                                *w = 0;
12✔
1032
                                break;
12✔
1033
                        case SYMTOSUB:
1034
                        case VECTOSUB:
1035
                        case INDTOSUB:
1036
                                while ( *orig ) {
144✔
1037
                                        i = *orig; while ( --i >= 0 ) *w++ = *orig++;
1,092✔
1038
                                }
1039
                                *w = 0;
36✔
1040
/*
1041
                                And then we have to fix up CanCommu
1042
*/
1043
                                break;
36✔
1044
                        case VECTOMIN:
×
1045
                                *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = t[3];
×
1046
                                *w++ = 1; *w++ = 1; *w++ = -3; *w = 0;
×
1047
                                break;
×
1048
                        case VECTOVEC:
×
1049
                                *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = t[3];
×
1050
                                *w++ = 1; *w++ = 1; *w++ = 3; *w = 0;
×
1051
                                break;
×
1052
                        case INDTOIND:
×
1053
                                d->type = DOLINDEX; d->index = t[3]; *w = 0;
×
1054
                                break;
×
1055
                        case FUNTOFUN:
×
1056
                                *w++ = FUNHEAD+4; *w++ = t[3]; *w++ = FUNHEAD;
×
1057
                                FILLFUN(w)
×
1058
                                *w++ = 1; *w++ = 1; *w++ = 3; *w = 0;
×
1059
                                break;
×
1060
                        case ARGTOARG:
24✔
1061
                                if ( *orig > 0 ) ww = orig + *orig + 1;
24✔
1062
                                else {
1063
                                        ww = orig+1; while ( *ww ) { NEXTARG(ww) }
96✔
1064
                                }
1065
                                while ( orig < ww ) *w++ = *orig++;
192✔
1066
                                *w = 0;
24✔
1067
                                d->type = DOLWILDARGS;
24✔
1068
                                break;
24✔
1069
                        default:
×
1070
                                d->type = DOLUNDEFINED;
×
1071
                                break;
×
1072
                }
1073
                m += m[1];
84✔
1074
        }
1075
}
1076

1077
/*
1078
          #] WildDollars : 
1079
          #[ DolToTensor :    with LOCK
1080
*/
1081

1082
WORD DolToTensor(PHEAD WORD numdollar)
30✔
1083
{
1084
        GETBIDENTITY
1085
        DOLLARS d = Dollars + numdollar;
30✔
1086
        WORD retval;
30✔
1087
#ifdef WITHPTHREADS
1088
        int nummodopt, dtype = -1;
20✔
1089
        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
20✔
1090
                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
20✔
1091
                        if ( numdollar == ModOptdollars[nummodopt].number ) break;
1092
                }
1093
                if ( nummodopt < NumModOptdollars ) {
20✔
1094
                        dtype = ModOptdollars[nummodopt].type;
1095
                        if ( dtype == MODLOCAL ) {
1096
                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
1097
                        }
1098
                        else {
1099
                                LOCK(d->pthreadslockread);
1100
                        }
1101
                }
1102
        }
1103
#endif
1104
        AN.ErrorInDollar = 0;
30✔
1105
        if ( d->type == DOLTERMS && d->where[0] == FUNHEAD+4 &&
30✔
1106
        d->where[FUNHEAD+4] == 0 && d->where[FUNHEAD+3] == 3 &&
24✔
1107
        d->where[FUNHEAD+2] == 1 && d->where[FUNHEAD+1] == 1 &&
24✔
1108
        d->where[1] >= FUNCTION && d->where[1] < FUNCTION+WILDOFFSET
24✔
1109
        && functions[d->where[1]-FUNCTION].spec >= TENSORFUNCTION ) {
24✔
1110
                retval = d->where[1];
1111
        }
1112
        else if ( d->type == DOLARGUMENT &&
6✔
1113
        d->where[0] <= -FUNCTION && d->where[0] > -FUNCTION-WILDOFFSET
×
1114
        && functions[-d->where[0]-FUNCTION].spec >= TENSORFUNCTION ) {
×
1115
                retval = -d->where[0];
1116
        }
1117
        else if ( d->type == DOLWILDARGS && d->where[0] == 0
6✔
1118
        && d->where[1] <= -FUNCTION && d->where[1] > -FUNCTION-WILDOFFSET
×
1119
        && d->where[2] == 0
×
1120
        && functions[-d->where[1]-FUNCTION].spec >= TENSORFUNCTION ) {
×
1121
                retval = -d->where[1];
1122
        }
1123
        else if ( d->type == DOLSUBTERM &&
6✔
1124
        d->where[0] >= FUNCTION && d->where[0] < FUNCTION+WILDOFFSET
×
1125
        && functions[d->where[0]-FUNCTION].spec >= TENSORFUNCTION ) {
×
1126
                retval = d->where[0];
1127
        }
1128
        else {
1129
                AN.ErrorInDollar = 1;
6✔
1130
                retval = 0;
6✔
1131
        }
1132
#ifdef WITHPTHREADS
1133
        if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
20✔
1134
#endif
1135
        return(retval);
30✔
1136
}
1137

1138
/*
1139
          #] DolToTensor : 
1140
          #[ DolToFunction :  with LOCK
1141
*/
1142

1143
WORD DolToFunction(PHEAD WORD numdollar)
×
1144
{
1145
        GETBIDENTITY
1146
        DOLLARS d = Dollars + numdollar;
×
1147
        WORD retval;
×
1148
#ifdef WITHPTHREADS
1149
        int nummodopt, dtype = -1;
1150
        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1151
                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1152
                        if ( numdollar == ModOptdollars[nummodopt].number ) break;
1153
                }
1154
                if ( nummodopt < NumModOptdollars ) {
1155
                        dtype = ModOptdollars[nummodopt].type;
1156
                        if ( dtype == MODLOCAL ) {
1157
                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
1158
                        }
1159
                        else {
1160
                                LOCK(d->pthreadslockread);
1161
                        }
1162
                }
1163
        }
1164
#endif
1165
        AN.ErrorInDollar = 0;
×
1166
        if ( d->type == DOLTERMS && d->where[0] == FUNHEAD+4 &&
×
1167
        d->where[FUNHEAD+4] == 0 && d->where[FUNHEAD+3] == 3 &&
×
1168
        d->where[FUNHEAD+2] == 1 && d->where[FUNHEAD+1] == 1 &&
×
1169
        d->where[1] >= FUNCTION && d->where[1] < FUNCTION+WILDOFFSET ) {
×
1170
                retval = d->where[1];
1171
        }
1172
        else if ( d->type == DOLARGUMENT &&
×
1173
        d->where[0] <= -FUNCTION && d->where[0] > -FUNCTION-WILDOFFSET ) {
×
1174
                retval = -d->where[0];
×
1175
        }
1176
        else if ( d->type == DOLWILDARGS && d->where[0] == 0
×
1177
        && d->where[1] <= -FUNCTION && d->where[1] > -FUNCTION-WILDOFFSET
×
1178
        && d->where[2] == 0 ) {
×
1179
                retval = -d->where[1];
×
1180
        }
1181
        else if ( d->type == DOLSUBTERM &&
×
1182
        d->where[0] >= FUNCTION && d->where[0] < FUNCTION+WILDOFFSET ) {
×
1183
                retval = d->where[0];
1184
        }
1185
        else {
1186
                AN.ErrorInDollar = 1;
×
1187
                retval = 0;
×
1188
        }
1189
#ifdef WITHPTHREADS
1190
        if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1191
#endif
1192
        return(retval);
×
1193
}
1194

1195
/*
1196
          #] DolToFunction : 
1197
          #[ DolToVector :    with LOCK
1198
*/
1199

1200
WORD DolToVector(PHEAD WORD numdollar)
24✔
1201
{
1202
        GETBIDENTITY
1203
        DOLLARS d = Dollars + numdollar;
24✔
1204
        WORD retval;
24✔
1205
#ifdef WITHPTHREADS
1206
        int nummodopt, dtype = -1;
16✔
1207
        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
16✔
1208
                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
16✔
1209
                        if ( numdollar == ModOptdollars[nummodopt].number ) break;
1210
                }
1211
                if ( nummodopt < NumModOptdollars ) {
16✔
1212
                        dtype = ModOptdollars[nummodopt].type;
1213
                        if ( dtype == MODLOCAL ) {
1214
                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
1215
                        }
1216
                        else {
1217
                                LOCK(d->pthreadslockread);
1218
                        }
1219
                }
1220
        }
1221
#endif
1222
        AN.ErrorInDollar = 0;
24✔
1223
        if ( d->type == DOLINDEX && d->index < 0 ) {
24✔
1224
                retval = d->index;
1225
        }
1226
        else if ( d->type == DOLARGUMENT && ( d->where[0] == -VECTOR
×
1227
        || d->where[0] == -MINVECTOR ) ) {
×
1228
                retval = d->where[1];
×
1229
        }
1230
        else if ( d->type == DOLSUBTERM && d->where[0] == INDEX
×
1231
        && d->where[1] == 3 && d->where[2] < 0 ) {
×
1232
                retval = d->where[2];
1233
        }
1234
        else if ( d->type == DOLTERMS && d->where[0] == 7 &&
×
1235
        d->where[7] == 0 && d->where[6] == 3 &&
×
1236
        d->where[5] == 1 && d->where[4] == 1 &&
×
1237
        d->where[1] >= INDEX && d->where[3] < 0 ) {
×
1238
                retval = d->where[3];
1239
        }
1240
        else if ( d->type == DOLWILDARGS && d->where[0] == 0
×
1241
        && ( d->where[1] == -VECTOR || d->where[1] == -MINVECTOR )
×
1242
        && d->where[3] == 0 ) {
×
1243
                retval = d->where[2];
×
1244
        }
1245
        else if ( d->type == DOLWILDARGS && d->where[0] == 1
×
1246
        && d->where[1] < 0 ) {
×
1247
                retval = d->where[1];
1248
        }
1249
        else {
1250
                AN.ErrorInDollar = 1;
×
1251
                retval = 0;
×
1252
        }
1253
#ifdef WITHPTHREADS
1254
        if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
16✔
1255
#endif
1256
        return(retval);
24✔
1257
}
1258

1259
/*
1260
          #] DolToVector : 
1261
          #[ DolToNumber :
1262
*/
1263

1264
WORD DolToNumber(PHEAD WORD numdollar)
219✔
1265
{
1266
        GETBIDENTITY
1267
        DOLLARS d = Dollars + numdollar;
219✔
1268
#ifdef WITHPTHREADS
1269
        int nummodopt, dtype = -1;
155✔
1270
        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
155✔
1271
                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
278✔
1272
                        if ( numdollar == ModOptdollars[nummodopt].number ) break;
278✔
1273
                }
1274
                if ( nummodopt < NumModOptdollars ) {
155✔
1275
                        dtype = ModOptdollars[nummodopt].type;
155✔
1276
                        if ( dtype == MODLOCAL ) {
155✔
1277
                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
155✔
1278
                        }
1279
                }
1280
        }
1281
#endif
1282
        AN.ErrorInDollar = 0;
219✔
1283
        if ( ( d->type == DOLTERMS || d->type == DOLNUMBER )
219✔
1284
         && d->where[0] == 4 &&
192✔
1285
        d->where[4] == 0 && ( d->where[3] == 3 || d->where[3] == -3 )
192✔
1286
         && d->where[2] == 1 && ( d->where[1] & TOPBITONLY ) == 0 ) {
192✔
1287
                if ( d->where[3] > 0 ) return(d->where[1]);
192✔
1288
                else return(-d->where[1]);
×
1289
        }
1290
        else if ( d->type == DOLARGUMENT && d->where[0] == -SNUMBER ) {
27✔
1291
                return(d->where[1]);
×
1292
        }
1293
        else if ( d->type == DOLARGUMENT && d->where[0] == -INDEX
27✔
1294
        && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
×
1295
                return(d->where[1]);
1296
        }
1297
        else if ( d->type == DOLZERO ) return(0);
27✔
1298
        else if ( d->type == DOLWILDARGS && d->where[0] == 0
27✔
1299
        && d->where[1] == -SNUMBER && d->where[3] == 0 ) {
×
1300
                return(d->where[2]);
×
1301
        }
1302
        else if ( d->type == DOLINDEX && d->index >= 0 && d->index < AM.OffsetIndex ) {
27✔
1303
                return(d->index);
1304
        } 
1305
        else if ( d->type == DOLWILDARGS && d->where[0] == 1
27✔
1306
        && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
×
1307
                return(d->where[1]);
1308
        }
1309
        else if ( d->type == DOLWILDARGS && d->where[0] == 0
27✔
1310
        && d->where[1] == -INDEX && d->where[3] == 0 && d->where[2] >= 0
×
1311
        && d->where[2] < AM.OffsetIndex ) {
×
1312
                return(d->where[2]);
1313
        }
1314
        AN.ErrorInDollar = 1;
27✔
1315
        return(0);
27✔
1316
}
1317

1318
/*
1319
          #] DolToNumber : 
1320
          #[ DolToSymbol :    with LOCK
1321
*/
1322

1323
WORD DolToSymbol(PHEAD WORD numdollar)
×
1324
{
1325
        GETBIDENTITY
1326
        DOLLARS d = Dollars + numdollar;
×
1327
        WORD retval;
×
1328
#ifdef WITHPTHREADS
1329
        int nummodopt, dtype = -1;
1330
        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1331
                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1332
                        if ( numdollar == ModOptdollars[nummodopt].number ) break;
1333
                }
1334
                if ( nummodopt < NumModOptdollars ) {
1335
                        dtype = ModOptdollars[nummodopt].type;
1336
                        if ( dtype == MODLOCAL ) {
1337
                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
1338
                        }
1339
                        else {
1340
                                LOCK(d->pthreadslockread);
1341
                        }
1342
                }
1343
        }
1344
#endif
1345
        AN.ErrorInDollar = 0;
×
1346
        if ( d->type == DOLTERMS && d->where[0] == 8 &&
×
1347
        d->where[8] == 0 && d->where[7] == 3 && d->where[6] == 1
×
1348
         && d->where[5] == 1 && d->where[4] == 1 && d->where[1] == SYMBOL ) {
×
1349
                retval = d->where[3];
×
1350
        }
1351
        else if ( d->type == DOLARGUMENT && d->where[0] == -SYMBOL ) {
×
1352
                retval = d->where[1];
×
1353
        }
1354
        else if ( d->type == DOLSUBTERM && d->where[0] == SYMBOL
×
1355
        && d->where[1] == 4 && d->where[3] == 1 ) {
×
1356
                retval = d->where[2];
×
1357
        }
1358
        else if ( d->type == DOLWILDARGS && d->where[0] == 0
×
1359
        && d->where[1] == -SYMBOL && d->where[3] == 0 ) {
×
1360
                retval = d->where[2];
×
1361
        }
1362
        else {
1363
                AN.ErrorInDollar = 1;
×
1364
                retval = -1;
×
1365
        }
1366
#ifdef WITHPTHREADS
1367
        if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1368
#endif
1369
        return(retval);
×
1370
}
1371

1372
/*
1373
          #] DolToSymbol : 
1374
          #[ DolToIndex :     with LOCK
1375
*/
1376

1377
WORD DolToIndex(PHEAD WORD numdollar)
×
1378
{
1379
        GETBIDENTITY
1380
        DOLLARS d = Dollars + numdollar;
×
1381
        WORD retval;
×
1382
#ifdef WITHPTHREADS
1383
        int nummodopt, dtype = -1;
1384
        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1385
                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1386
                        if ( numdollar == ModOptdollars[nummodopt].number ) break;
1387
                }
1388
                if ( nummodopt < NumModOptdollars ) {
1389
                        dtype = ModOptdollars[nummodopt].type;
1390
                        if ( dtype == MODLOCAL ) {
1391
                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
1392
                        }
1393
                        else {
1394
                                LOCK(d->pthreadslockread);
1395
                        }
1396
                }
1397
        }
1398
#endif
1399
        AN.ErrorInDollar = 0;
×
1400
        if ( d->type == DOLTERMS && d->where[0] == 7 &&
×
1401
        d->where[7] == 0 && d->where[6] == 3 && d->where[5] == 1
×
1402
         && d->where[4] == 1 && d->where[1] == INDEX && d->where[3] >= 0 ) {
×
1403
                retval = d->where[3];
1404
        }
1405
        else if ( d->type == DOLARGUMENT && d->where[0] == -SNUMBER
×
1406
        && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
×
1407
                retval = d->where[1];
1408
        }
1409
        else if ( d->type == DOLARGUMENT && d->where[0] == -INDEX
×
1410
        && d->where[1] >= 0 ) {
×
1411
                retval = d->where[1];
1412
        }
1413
        else if ( d->type == DOLZERO ) return(0);
×
1414
        else if ( d->type == DOLWILDARGS && d->where[0] == 0
×
1415
        && d->where[1] == -SNUMBER && d->where[3] == 0 && d->where[2] >= 0
×
1416
        && d->where[2] < AM.OffsetIndex ) {
×
1417
                retval = d->where[2];
1418
        }
1419
        else if ( d->type == DOLINDEX && d->index >= 0 ) {
×
1420
                retval = d->index;
1421
        } 
1422
        else if ( d->type == DOLNUMBER && d->where[0] == 4 && d->where[2] == 1
×
1423
        && d->where[3] == 3 && d->where[4] == 0 && d->where[1] < AM.OffsetIndex ) {
×
1424
                retval = d->where[1];
1425
        } 
1426
        else if ( d->type == DOLWILDARGS && d->where[0] == 1
×
1427
        && d->where[1] >= 0 ) {
×
1428
                retval = d->where[1];
1429
        }
1430
        else if ( d->type == DOLSUBTERM && d->where[0] == INDEX
×
1431
        && d->where[1] == 3 && d->where[2] >= 0 ) {
×
1432
                retval = d->where[2];
1433
        }
1434
        else if ( d->type == DOLWILDARGS && d->where[0] == 0
×
1435
        && d->where[1] == -INDEX && d->where[3] == 0 && d->where[2] >= 0 ) {
×
1436
                retval = d->where[2];
1437
        }
1438
        else {
1439
                AN.ErrorInDollar = 1;
×
1440
                retval = 0;
×
1441
        }
1442
#ifdef WITHPTHREADS
1443
        if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1444
#endif
1445
        return(retval);
1446
}
1447

1448
/*
1449
          #] DolToIndex : 
1450
          #[ DolToTerms :
1451

1452
        Returns a struct of type DOLLARS which contains a copy of the
1453
        original dollar variable, provided it can be expressed in terms of
1454
        an expression (type = DOLTERMS). Otherwise it returns zero.
1455
        The dollar is expressed in terms in the buffer "where"
1456
*/
1457

1458
DOLLARS DolToTerms(PHEAD WORD numdollar)
2,917,362✔
1459
{
1460
        GETBIDENTITY
1461
        LONG size;
2,917,362✔
1462
        DOLLARS d = Dollars + numdollar, newd;
2,917,362✔
1463
        WORD *t, *w, i;
2,917,362✔
1464
#ifdef WITHPTHREADS
1465
        int nummodopt, dtype = -1;
1,944,908✔
1466
        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1,944,908✔
1467
                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1,940,168✔
1468
                        if ( numdollar == ModOptdollars[nummodopt].number ) break;
8,800✔
1469
                }
1470
                if ( nummodopt < NumModOptdollars ) {
1,940,168✔
1471
                        dtype = ModOptdollars[nummodopt].type;
8,800✔
1472
                        if ( dtype == MODLOCAL ) {
8,800✔
1473
                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
1474
                        }
1475
                }
1476
        }
1477
#endif
1478
        AN.ErrorInDollar = 0;
2,917,362✔
1479
        switch ( d->type ) {
2,917,362✔
1480
                case DOLARGUMENT:
×
1481
                        t = d->where;
×
1482
                        if ( t[0] < 0 ) {
×
1483
ShortArgument:
×
1484
                                w = AT.WorkPointer;
×
1485
                                if ( t[0] <= -FUNCTION ) {
×
1486
                                        *w++ = FUNHEAD+4; *w++ = -t[0];
×
1487
                                        *w++ = FUNHEAD; FILLFUN(w)
×
1488
                                        *w++ = 1; *w++ = 1; *w++ = 3;
×
1489
                                }
1490
                                else if ( t[0] == -SYMBOL ) {
×
1491
                                        *w++ = 8; *w++ = SYMBOL; *w++ = 4; *w++ = t[1];
×
1492
                                        *w++ = 1; *w++ = 1; *w++ = 1; *w++ = 3;
×
1493
                                }
1494
                                else if ( t[0] == -VECTOR || t[0] == -INDEX ) {
×
1495
                                        *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = t[1];
×
1496
                                        *w++ = 1; *w++ = 1; *w++ = 3;
×
1497
                                }
1498
                                else if ( t[0] == -MINVECTOR ) {
×
1499
                                        *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = t[1];
×
1500
                                        *w++ = 1; *w++ = 1; *w++ = -3;
×
1501
                                }
1502
                                else if ( t[0] == -SNUMBER ) {
×
1503
                                        *w++ = 4;
×
1504
                                        if ( t[1] < 0 ) {
×
1505
                                                *w++ = -t[1]; *w++ = 1; *w++ = -3;
×
1506
                                        }
1507
                                        else {
1508
                                                *w++ = t[1]; *w++ = 1; *w++ = 3;
×
1509
                                        }
1510
                                }
1511
                                *w = 0; size = w - AT.WorkPointer;
×
1512
                                w = AT.WorkPointer;
×
1513
                                break;
×
1514
                        }
1515
                        /* fall through */
1516
                case DOLNUMBER:
1517
                case DOLTERMS:
1518
                        t = d->where;
2,916,780✔
1519
                        while ( *t ) t += *t;
20,598,192✔
1520
                        size = t - d->where;
2,916,780✔
1521
                        w = d->where;
2,916,780✔
1522
                        break;
2,916,780✔
1523
                case DOLSUBTERM:
×
1524
                        w = AT.WorkPointer;
×
1525
                        size = d->where[1];
×
1526
                        *w++ = size+4; t = d->where; NCOPY(w,t,size)
×
1527
                        *w++ = 1; *w++ = 1; *w++ = 3;
×
1528
                        w = AT.WorkPointer; size = d->where[1]+4;
×
1529
                        break;
×
1530
                case DOLINDEX:
×
1531
                        w = AT.WorkPointer;
×
1532
                        *w++ = 7; *w++ = INDEX; *w++ = 3; *w++ = d->index;
×
1533
                        *w++ = 1; *w++ = 1; *w++ = 3; *w = 0;
×
1534
                        w = AT.WorkPointer; size = 7;
×
1535
                        break;
×
1536
                case DOLWILDARGS:
×
1537
/*
1538
                        In some cases we can make a copy
1539
*/
1540
                        t = d->where+1;
×
1541
                        if ( *t == 0 ) return(0);
×
1542
                        NEXTARG(t);
×
1543
                        if ( *t ) {        /* More than one argument in here */
×
1544
                                MLOCK(ErrorMessageLock);
×
1545
                                MesPrint("Trying to convert a $ with an argument field into an expression");
×
1546
                                MUNLOCK(ErrorMessageLock);
×
1547
                                Terminate(-1);
×
1548
                        }
1549
/*
1550
                        Now we have a single argument
1551
*/
1552
                        t = d->where+1;
×
1553
                        if ( *t < 0 ) goto ShortArgument;
×
1554
                        size = *t - ARGHEAD;
×
1555
                        w = t + ARGHEAD;
×
1556
                        break;
×
1557
                case DOLUNDEFINED:
×
1558
                        MLOCK(ErrorMessageLock);
×
1559
                        MesPrint("Trying to use an undefined $ in an expression");
×
1560
                        MUNLOCK(ErrorMessageLock);
×
1561
                        Terminate(-1);
×
1562
                        /* fall through */
1563
                case DOLZERO:
582✔
1564
                        if ( d->where ) { d->where[0] = 0; }
582✔
1565
                        else d->where = &(AM.dollarzero);
×
1566
                        size = 0;
582✔
1567
                        w = d->where;
582✔
1568
                        break;
582✔
1569
                default:
1570
                        return(0);
1571
        }
1572
        newd = (DOLLARS)Malloc1(sizeof(struct DoLlArS)+(size+1)*sizeof(WORD),
2,917,362✔
1573
                                "Copy of dollar variable");
1574
        t = (WORD *)(newd+1);
2,917,362✔
1575
        newd->where = t;
2,917,362✔
1576
        newd->name = d->name;
2,917,362✔
1577
        newd->node = d->node;
2,917,362✔
1578
        newd->type = DOLTERMS;
2,917,362✔
1579
        newd->size = size;
2,917,362✔
1580
        newd->numdummies = d->numdummies;
2,917,362✔
1581
#ifdef WITHPTHREADS
1582
        newd->pthreadslockread  = dummylock;
1,944,908✔
1583
        newd->pthreadslockwrite = dummylock;
1,944,908✔
1584
#endif
1585
        size++;
2,917,362✔
1586
        NCOPY(t,w,size);
167,851,692✔
1587
        newd->nfactors = d->nfactors;
2,917,362✔
1588
        if ( d->nfactors > 1 ) {
2,917,362✔
1589
                newd->factors = (FACDOLLAR *)Malloc1(d->nfactors*sizeof(FACDOLLAR),"Dollar factors");
372✔
1590
                for ( i = 0; i < d->nfactors; i++ ) {
20,652✔
1591
                        newd->factors[i].where = 0;
20,280✔
1592
                        newd->factors[i].size = 0;
20,280✔
1593
                        newd->factors[i].type = DOLUNDEFINED;
20,280✔
1594
                        newd->factors[i].value = d->factors[i].value;
20,280✔
1595
                }
1596
        }
1597
        else { newd->factors = 0; }
2,916,990✔
1598
        return(newd);
1599
}
1600

1601
/*
1602
          #] DolToTerms : 
1603
          #[ DolToLong :
1604
*/
1605

1606
LONG DolToLong(PHEAD WORD numdollar)
×
1607
{
1608
        GETBIDENTITY
1609
        DOLLARS d = Dollars + numdollar;
×
1610
        LONG x;
×
1611
#ifdef WITHPTHREADS
1612
        int nummodopt, dtype = -1;
1613
        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1614
                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1615
                        if ( numdollar == ModOptdollars[nummodopt].number ) break;
1616
                }
1617
                if ( nummodopt < NumModOptdollars ) {
1618
                        dtype = ModOptdollars[nummodopt].type;
1619
                        if ( dtype == MODLOCAL ) {
1620
                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
1621
                        }
1622
                }
1623
        }
1624
#endif
1625
        AN.ErrorInDollar = 0;
×
1626
        if ( ( d->type == DOLTERMS || d->type == DOLNUMBER )
×
1627
         && d->where[0] == 4 &&
×
1628
        d->where[4] == 0 && ( d->where[3] == 3 || d->where[3] == -3 )
×
1629
         && d->where[2] == 1 && ( d->where[1] & TOPBITONLY ) == 0 ) {
×
1630
                x = d->where[1];
×
1631
                if ( d->where[3] > 0 ) return(x);
×
1632
                else return(-x);
×
1633
        }
1634
        else if ( ( d->type == DOLTERMS || d->type == DOLNUMBER )
×
1635
         && d->where[0] == 6 &&
×
1636
        d->where[6] == 0 && ( d->where[5] == 5 || d->where[5] == -5 )
×
1637
         && d->where[3] == 1 && d->where[4] == 1 && ( d->where[2] & TOPBITONLY ) == 0 ) {
×
1638
                x = d->where[1] + ( (LONG)(d->where[2]) << BITSINWORD );
×
1639
                if ( d->where[5] > 0 ) return(x);
×
1640
                else return(-x);
×
1641
        }
1642
        else if ( d->type == DOLARGUMENT && d->where[0] == -SNUMBER ) {
×
1643
                x = d->where[1];
×
1644
                return(x);
×
1645
        }
1646
        else if ( d->type == DOLARGUMENT && d->where[0] == -INDEX
×
1647
        && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
×
1648
                x = d->where[1];
×
1649
                return(x);
×
1650
        }
1651
        else if ( d->type == DOLZERO ) return(0);
×
1652
        else if ( d->type == DOLWILDARGS && d->where[0] == 0
×
1653
        && d->where[1] == -SNUMBER && d->where[3] == 0 ) {
×
1654
                x = d->where[2];
×
1655
                return(x);
×
1656
        }
1657
        else if ( d->type == DOLINDEX && d->index >= 0 && d->index < AM.OffsetIndex ) {
×
1658
                x = d->index;
×
1659
                return(x);
×
1660
        } 
1661
        else if ( d->type == DOLWILDARGS && d->where[0] == 1
×
1662
        && d->where[1] >= 0 && d->where[1] < AM.OffsetIndex ) {
×
1663
                x = d->where[1];
×
1664
                return(x);
×
1665
        }
1666
        else if ( d->type == DOLWILDARGS && d->where[0] == 0
×
1667
        && d->where[1] == -INDEX && d->where[3] == 0 && d->where[2] >= 0
×
1668
        && d->where[2] < AM.OffsetIndex ) {
×
1669
                x = d->where[2];
×
1670
                return(x);
×
1671
        }
1672
        AN.ErrorInDollar = 1;
×
1673
        return(0);
×
1674
}
1675

1676
/*
1677
          #] DolToLong : 
1678
          #[ ExecInside :
1679
*/
1680

1681
int ExecInside(UBYTE *s)
6✔
1682
{
1683
        GETIDENTITY
4✔
1684
        UBYTE *t, c;
6✔
1685
        WORD *w, number;
6✔
1686
        int error = 0;
6✔
1687
        w = AT.WorkPointer;
6✔
1688
        if ( AC.insidelevel >= MAXNEST ) {
6✔
1689
                MLOCK(ErrorMessageLock);
×
1690
                MesPrint("@Nesting of inside statements more than %d levels",(WORD)MAXNEST);
×
1691
                MUNLOCK(ErrorMessageLock);
×
1692
                return(-1);
×
1693
        }
1694
        AC.insidesumcheck[AC.insidelevel] = NestingChecksum();
6✔
1695
        AC.insidestack[AC.insidelevel] = cbuf[AC.cbufnum].Pointer
6✔
1696
                                                                 - cbuf[AC.cbufnum].Buffer + 2;
6✔
1697
        AC.insidelevel++;
6✔
1698
        *w++ = TYPEINSIDE;
6✔
1699
        w++; w++;
6✔
1700
        for(;;) {        /* Look for a (comma separated) list of dollar variables */
1701
                while ( *s == ',' ) s++;
12✔
1702
                if ( *s == 0 ) break;
12✔
1703
                if ( *s == '$' ) {
6✔
1704
                        s++; t = s;
6✔
1705
                        if ( FG.cTable[*s] != 0 ) {
6✔
1706
                                MLOCK(ErrorMessageLock);
×
1707
                                MesPrint("Illegal name for $ variable: %s",s-1);
×
1708
                                MUNLOCK(ErrorMessageLock);
×
1709
                                goto skipdol;
×
1710
                        }
1711
                        while ( FG.cTable[*s] == 0 || FG.cTable[*s] == 1 ) s++;
12✔
1712
                        c = *s; *s = 0;
6✔
1713
                        if ( ( number = GetDollar(t) ) < 0 ) {
6✔
1714
                                number = AddDollar(t,0,0,0);
×
1715
                        }
1716
                        *s = c;
6✔
1717
                        *w++ = number;
6✔
1718
                        AddPotModdollar(number);
6✔
1719
                }
1720
                else {
1721
                        MLOCK(ErrorMessageLock);
×
1722
                        MesPrint("&Illegal object in Inside statement");
×
1723
                        MUNLOCK(ErrorMessageLock);
×
1724
skipdol:        error = 1;
×
1725
                        while ( *s && *s != ',' && s[1] != '$' ) s++;
×
1726
                        if ( *s == 0 ) break;
×
1727
                }
1728
        }
1729
        AT.WorkPointer[1] = w - AT.WorkPointer;
6✔
1730
        AddNtoL(AT.WorkPointer[1],AT.WorkPointer);
6✔
1731
        return(error);
6✔
1732
}
1733

1734
/*
1735
          #] ExecInside : 
1736
          #[ InsideDollar :
1737

1738
        Execution part of Inside $a;
1739
        We have to take the variables one by one and then
1740
        convert them into proper terms and call Generator for the proper levels.
1741
        The conversion copies the whole dollar into a new buffer, making us
1742
        insensitive to redefinitions of $a inside the Inside.
1743
        In the end we sort and redefine $a.
1744
*/
1745

1746
int InsideDollar(PHEAD WORD *ll, WORD level)
6✔
1747
{
1748
        GETBIDENTITY
1749
        int numvar = (int)(ll[1]-3), j, error = 0;
6✔
1750
        WORD numdol, *oldcterm, *oldwork = AT.WorkPointer, olddefer, *r, *m;
6✔
1751
        WORD oldnumlhs, *dbuffer;
6✔
1752
        DOLLARS d, newd;
6✔
1753
        oldcterm = AN.cTerm; AN.cTerm = 0;
6✔
1754
        oldnumlhs = AR.Cnumlhs; AR.Cnumlhs = ll[2];
6✔
1755
        ll += 3;
6✔
1756
        olddefer = AR.DeferFlag;
6✔
1757
        AR.DeferFlag = 0;
6✔
1758
        while ( --numvar >= 0 ) {
12✔
1759
          numdol = *ll++;
6✔
1760
          d = Dollars + numdol;
6✔
1761
          {
1762
#ifdef WITHPTHREADS
1763
                int nummodopt, dtype = -1;
4✔
1764
                if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
4✔
1765
                        for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1766
                                if ( numdol == ModOptdollars[nummodopt].number ) break;
1767
                        }
1768
                        if ( nummodopt < NumModOptdollars ) {
1769
                                dtype = ModOptdollars[nummodopt].type;
1770
                                if ( dtype == MODLOCAL ) {
1771
                                        d = ModOptdollars[nummodopt].dstruct+AT.identity;
1772
                                }
1773
                                else {
1774
/*                                        LOCK(d->pthreadslockwrite); */
1775
                                        LOCK(d->pthreadslockread);
1776
                                }
1777
                        }
1778
                }
1779
#endif
1780
                newd = DolToTerms(BHEAD numdol);
6✔
1781
                if ( newd == 0 || newd->where[0] == 0 ) continue;
6✔
1782
                r = newd->where;
6✔
1783
                NewSort(BHEAD0);
6✔
1784
                while ( *r ) {        /* Sum over the terms */
12✔
1785
                        m = AT.WorkPointer;
6✔
1786
                        j = *r;
6✔
1787
                        while ( --j >= 0 ) *m++ = *r++;
48✔
1788
                        AT.WorkPointer = m;
6✔
1789
/*
1790
                        What to do with dummy indices?
1791
*/
1792
                        if ( Generator(BHEAD oldwork,level) ) {
6✔
1793
                                LowerSortLevel();
×
1794
                                error = -1; goto idcall;
×
1795
                        }
1796
                        AT.WorkPointer = oldwork;
6✔
1797
                }
1798
                AN.tryterm = 0; /* for now */
6✔
1799
                if ( EndSort(BHEAD (WORD *)((void *)(&dbuffer)),2) < 0 ) { error = 1; break; }
6✔
1800
                if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,"old buffer of dollar");
6✔
1801
                d->where = dbuffer;
6✔
1802
                if ( dbuffer == 0 || *dbuffer == 0 ) {
6✔
1803
                        d->type = DOLZERO;
×
1804
                        if ( dbuffer ) M_free(dbuffer,"buffer of dollar");
×
1805
                        d->where = &(AM.dollarzero); d->size = 0;
×
1806
                }
1807
                else {
1808
                        d->type = DOLTERMS;
6✔
1809
                        r = d->where; while ( *r ) r += *r;
12✔
1810
                        d->size = (r-d->where)+1;
6✔
1811
                }
1812
/*                cbuf[AM.dbufnum].rhs[numdol] = d->where; */
1813
                cbuf[AM.dbufnum].rhs[numdol] = (WORD *)(1);
6✔
1814
/*
1815
                Now we have a little cleaning up to do
1816
*/
1817
#ifdef WITHPTHREADS
1818
                if ( dtype > 0 && dtype != MODLOCAL ) {
4✔
1819
/*                        UNLOCK(d->pthreadslockwrite); */
1820
                        UNLOCK(d->pthreadslockread);
1821
                }
1822
#endif
1823
                if ( newd->factors ) M_free(newd->factors,"Dollar factors");
6✔
1824
                M_free(newd,"Copy of dollar variable");
6✔
1825
          }
1826
        }
1827
idcall:;
6✔
1828
        AR.Cnumlhs = oldnumlhs;
6✔
1829
        AR.DeferFlag = olddefer;
6✔
1830
        AN.cTerm = oldcterm;
6✔
1831
        AT.WorkPointer = oldwork;
6✔
1832
        return(error);
6✔
1833
}
1834

1835
/*
1836
          #] InsideDollar : 
1837
          #[ ExchangeDollars :
1838
*/
1839

1840
void ExchangeDollars(int num1, int num2)
×
1841
{
1842
        DOLLARS d1, d2;
×
1843
        WORD node1, node2;
×
1844
        LONG nam;
×
1845
        d1 = Dollars + num1; node1 = d1->node;
×
1846
        d2 = Dollars + num2; node2 = d2->node;
×
1847
        nam = d1->name; d1->name = d2->name; d2->name = nam;
×
1848
        d1->node = node2; d2->node = node1;
×
1849
        AC.dollarnames->namenode[node1].number = num2;
×
1850
        AC.dollarnames->namenode[node2].number = num1;
×
1851
}
×
1852

1853
/*
1854
          #] ExchangeDollars : 
1855
          #[ TermsInDollar :
1856
*/
1857

1858
LONG TermsInDollar(WORD num)
60✔
1859
{
1860
        GETIDENTITY
40✔
1861
        DOLLARS d = Dollars + num;
60✔
1862
        WORD *t;
60✔
1863
        LONG n;
60✔
1864
#ifdef WITHPTHREADS
1865
        int nummodopt, dtype = -1;
40✔
1866
        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
40✔
1867
                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1868
                        if ( num == ModOptdollars[nummodopt].number ) break;
1869
                }
1870
                if ( nummodopt < NumModOptdollars ) {
1871
                        dtype = ModOptdollars[nummodopt].type;
1872
                        if ( dtype == MODLOCAL ) {
1873
                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
1874
                        }
1875
                        else {
1876
                                LOCK(d->pthreadslockread);
1877
                        }
1878
                }
1879
        }
1880
#endif
1881
        if ( d->type == DOLTERMS ) {
60✔
1882
                n = 0;
36✔
1883
                t = d->where;
36✔
1884
                while ( *t ) { t += *t; n++; }
222✔
1885
        }
1886
        else if ( d->type == DOLWILDARGS ) {
24✔
1887
                n = 0;
×
1888
                if ( d->where[0] == 0 ) {
×
1889
                        t = d->where+1;
×
1890
                        while ( *t != 0 ) { NEXTARG(t); n++; }
×
1891
                }
1892
                else if ( d->where[0] == 1 ) n = 1;
×
1893
        }
1894
        else if ( d->type == DOLZERO ) n = 0;
24✔
1895
        else n = 1;
24✔
1896
#ifdef WITHPTHREADS
1897
        if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
40✔
1898
#endif
1899
        return(n);
60✔
1900
}
1901

1902
/*
1903
          #] TermsInDollar : 
1904
          #[ SizeOfDollar :
1905
*/
1906

1907
LONG SizeOfDollar(WORD num)
×
1908
{
1909
        GETIDENTITY
1910
        DOLLARS d = Dollars + num;
×
1911
        WORD *t;
×
1912
        LONG n;
×
1913
#ifdef WITHPTHREADS
1914
        int nummodopt, dtype = -1;
1915
        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
1916
                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
1917
                        if ( num == ModOptdollars[nummodopt].number ) break;
1918
                }
1919
                if ( nummodopt < NumModOptdollars ) {
1920
                        dtype = ModOptdollars[nummodopt].type;
1921
                        if ( dtype == MODLOCAL ) {
1922
                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
1923
                        }
1924
                        else {
1925
                                LOCK(d->pthreadslockread);
1926
                        }
1927
                }
1928
        }
1929
#endif
1930
        if ( d->type == DOLTERMS ) {
×
1931
                t = d->where;
×
1932
                while ( *t ) t += *t;
×
1933
                t++;
×
1934
                n = (LONG)(t - d->where);
×
1935
        }
1936
        else if ( d->type == DOLWILDARGS ) {
×
1937
                n = 0;
×
1938
                if ( d->where[0] == 0 ) {
×
1939
                        t = d->where+1;
×
1940
                        while ( *t != 0 ) { NEXTARG(t); n++; }
×
1941
                        t++;
×
1942
                        n = (LONG)(t - d->where);
×
1943
                }
1944
                else if ( d->where[0] == 1 ) n = 1;
×
1945
        }
1946
        else if ( d->type == DOLZERO ) n = 0;
×
1947
        else n = 1;
×
1948
#ifdef WITHPTHREADS
1949
        if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
1950
#endif
1951
        return(n);
×
1952
}
1953

1954
/*
1955
          #] SizeOfDollar : 
1956
          #[ PreIfDollarEval :
1957

1958
        Routine is invoked in #if etc after $( is encountered.
1959
        $(expr1 operator expr2) makes compares between expressions,
1960
        $(expr1 operator _keyword) makes compares between expressions,
1961
        interpreted as expressions. We are here mainly looking at $variables.
1962
        First we look for the operator:
1963
                >, <, ==, >=, <=, != : < means that it comes before.
1964
        _keywords can be:
1965
                _set(setname)   (does the expr belong to the set (only with == or !=))
1966
                _productof(expr)
1967
*/
1968

1969
UBYTE *PreIfDollarEval(UBYTE *s, int *value)
×
1970
{
1971
        GETIDENTITY
1972
        UBYTE *s1,*s2,*s3,*s4,*s5,*t,c,c1,c2,c3;
×
1973
        int oprtr, type;
×
1974
        WORD *buf1 = 0, *buf2 = 0, numset, *oldwork = AT.WorkPointer;
×
1975
        EXCHINOUT
×
1976
/*
1977
        Find the three composing objects (epxression, operator, expression or keyw
1978
*/
1979
        while ( *s == ' ' || *s == '\t' || *s == '\n' || *s == '\r' ) s++;
×
1980
        s1 = t = s;
1981
        while ( *t != '=' && *t != '!' && *t != '>' && *t != '<' ) {
×
1982
                if ( *t == '[' ) { SKIPBRA1(t) }
×
1983
                else if ( *t == '{' ) { SKIPBRA2(t) }
×
1984
                else if ( *t == '(' ) { SKIPBRA3(t) }
×
1985
                else if ( *t == ']' || *t == '}' || *t == ')' ) {
1986
                        MLOCK(ErrorMessageLock);
×
1987
                        MesPrint("@Improper bracketting in #if");
×
1988
                        MUNLOCK(ErrorMessageLock);
×
1989
                        goto onerror;
×
1990
                }
1991
                t++;
×
1992
        }
1993
        s2 = t;
1994
        while ( *t == '=' || *t == '!' || *t == '>' || *t == '<' ) t++;
×
1995
        s3 = t;
×
1996
        while ( *t && *t != ')' ) {
×
1997
                if ( *t == '[' ) { SKIPBRA1(t) }
×
1998
                else if ( *t == '{' ) { SKIPBRA2(t) }
×
1999
                else if ( *t == '(' ) { SKIPBRA3(t) }
×
2000
                else if ( *t == ']' || *t == '}' ) {
×
2001
                        MLOCK(ErrorMessageLock);
×
2002
                        MesPrint("@Improper brackets in #if");
×
2003
                        MUNLOCK(ErrorMessageLock);
×
2004
                        goto onerror;
×
2005
                }
2006
                t++;
×
2007
        }
2008
        if ( *t == 0 ) {
×
2009
                MLOCK(ErrorMessageLock);
×
2010
                MesPrint("@Missing ) to match $( in #if");
×
2011
                MUNLOCK(ErrorMessageLock);
×
2012
                goto onerror;
×
2013
        }
2014
        s4 = t; c2 = *s4; *s4 = 0;
×
2015
        if ( s2+2 < s3 || s2 == s3 ) {
×
2016
IllOp:;
×
2017
                MLOCK(ErrorMessageLock);
×
2018
                MesPrint("@Illegal operator in $( option of #if");
×
2019
                MUNLOCK(ErrorMessageLock);
×
2020
                goto onerror;
×
2021
        }
2022
        if ( s2+1 == s3 ) {
×
2023
                if ( *s2 == '=' ) oprtr = EQUAL;
×
2024
                else if ( *s2 == '>' ) oprtr = GREATER;
2025
                else if ( *s2 == '<' ) oprtr = LESS;
2026
                else goto IllOp;
×
2027
        }
2028
        else if ( *s2 == '!' && s2[1] == '=' ) oprtr = NOTEQUAL;
×
2029
        else if ( *s2 == '=' && s2[1] == '=' ) oprtr = EQUAL;
×
2030
        else if ( *s2 == '<' && s2[1] == '=' ) oprtr = LESSEQUAL;
×
2031
        else if ( *s2 == '>' && s2[1] == '=' ) oprtr = GREATEREQUAL;
×
2032
        else goto IllOp;
×
2033
        c1 = *s2; *s2 = 0;
×
2034
/*
2035
        The two expressions are now zero terminated
2036
        Look for the special keywords
2037
*/
2038
        while ( *s3 == ' ' || *s3 == '\t' || *s3 == '\n' || *s3 == '\r' ) s3++;
×
2039
        t = s3;
2040
        while ( chartype[*t] == 0 ) t++;
×
2041
        if ( *t == '_' ) {
×
2042
                t++; c = *t; *t = 0;
×
2043
                if ( StrICmp(s3,(UBYTE *)"set_") == 0 ) {
×
2044
                        if ( oprtr != EQUAL && oprtr != NOTEQUAL ) {
×
2045
ImpOp:;
×
2046
                                MLOCK(ErrorMessageLock);
×
2047
                                MesPrint("@Improper operator for special keyword in $( ) option");
×
2048
                                MUNLOCK(ErrorMessageLock);
×
2049
                                goto onerror;
×
2050
                        }
2051
                        type = 1;
2052
                }
2053
                else if ( StrICmp(s3,(UBYTE *)"multipleof_") == 0 ) {
×
2054
                        if ( oprtr != EQUAL && oprtr != NOTEQUAL ) goto ImpOp;
×
2055
                        type = 2;
2056
                }
2057
/*
2058
                else if ( StrICmp(s3,(UBYTE *)"productof_") == 0 ) {
2059
                        if ( oprtr != EQUAL && oprtr != NOTEQUAL ) goto ImpOp;
2060
                        type = 3;
2061
                }
2062
*/
2063
                else type = 0;
2064
        }
2065
        else { type = 0; c = *t; }
2066
        if ( type > 0 ) {
×
2067
                *t++ = c; s3 = t; s5 = s4-1;
×
2068
                while ( *s5 != ')' ) {
×
2069
                        if ( *s5 == ' ' || *s5 == '\t' || *s5 == '\n' || *s5 == '\r' ) s5--;
×
2070
                        else {
2071
                                MLOCK(ErrorMessageLock);
×
2072
                                MesPrint("@Improper use of special keyword in $( ) option");
×
2073
                                MUNLOCK(ErrorMessageLock);
×
2074
                                goto onerror;
×
2075
                        }
2076
                }
2077
                c3 = *s5; *s5 = 0;
×
2078
        }
2079
        else { c3 = c2; s5 = s4; }
2080
/*
2081
        Expand the first expression.
2082
*/
2083
        if ( ( buf1 = TranslateExpression(s1) ) == 0 ) {
×
2084
                AT.WorkPointer = oldwork;
×
2085
                goto onerror;
×
2086
        }
2087
        if ( type == 1 ) {        /* determine the set */
×
2088
                if ( *s3 == '{' ) {
×
2089
                        t = s3+1;
×
2090
                        SKIPBRA2(s3)
×
2091
                        numset = DoTempSet(t,s3);
×
2092
                        s3++;
×
2093
                        if ( numset < 0 ) {
×
2094
noset:;
×
2095
                                MLOCK(ErrorMessageLock);
×
2096
                                MesPrint("@Argument of set_ is not a valid set");
×
2097
                                MUNLOCK(ErrorMessageLock);
×
2098
                                goto onerror;
×
2099
                        }
2100
                }
2101
                else {
2102
                        t = s3;
×
2103
                        while ( FG.cTable[*s3] == 0 || FG.cTable[*s3] == 1
×
2104
                                || *s3 == '_' ) s3++;
×
2105
                        c = *s3; *s3 = 0;
×
2106
                    if ( GetName(AC.varnames,t,&numset,NOAUTO) != CSET ) {
×
2107
                                *s3 = c; goto noset;
×
2108
                        }
2109
                        *s3 = c;
×
2110
                }
2111
                while ( *s3 == ' ' || *s3 == '\t' || *s3 == '\n' || *s3 == '\r' ) s3++;
×
2112
                if ( s3 != s5 ) goto noset;
×
2113
                *value = IsSetMember(buf1,numset);
×
2114
                if ( oprtr == NOTEQUAL ) *value ^= 1;
×
2115
        }
2116
        else {
2117
                if ( ( buf2 = TranslateExpression(s3) ) == 0 ) goto onerror;
×
2118
        }
2119
        if ( type == 0 ) {
×
2120
                *value = TwoExprCompare(buf1,buf2,oprtr);
×
2121
        }
2122
        else if ( type == 2 ) {
×
2123
                *value = IsMultipleOf(buf1,buf2);
×
2124
                if ( oprtr == NOTEQUAL ) *value ^= 1;
×
2125
        }
2126
/*
2127
        else if ( type == 3 ) {
2128
                *value = IsProductOf(buf1,buf2);
2129
                if ( oprtr == NOTEQUAL ) *value ^= 1;
2130
        }
2131
*/
2132
        if ( buf1 ) M_free(buf1,"Buffer in $()");
×
2133
        if ( buf2 ) M_free(buf2,"Buffer in $()");
×
2134
        *s5 = c3; *s4++ = c2; *s2 = c1;
×
2135
        AT.WorkPointer = oldwork;
×
2136
        BACKINOUT
×
2137
        return(s4);
×
2138
onerror:
×
2139
        if ( buf1 ) M_free(buf1,"Buffer in $()");
×
2140
        if ( buf2 ) M_free(buf2,"Buffer in $()");
×
2141
        AT.WorkPointer = oldwork;
×
2142
        BACKINOUT
×
2143
        return(0);
×
2144
}
2145

2146
/*
2147
          #] PreIfDollarEval : 
2148
          #[ TranslateExpression :
2149
*/
2150

2151
WORD *TranslateExpression(UBYTE *s)
×
2152
{
2153
        GETIDENTITY
2154
        CBUF *C = cbuf+AC.cbufnum;
×
2155
        WORD oldnumrhs = C->numrhs;
×
2156
        LONG oldcpointer = C->Pointer - C->Buffer;
×
2157
        WORD *w = AT.WorkPointer;
×
2158
        WORD retcode, oldEside;
×
2159
        WORD *outbuffer;
×
2160
        *w++ = SUBEXPSIZE + 4;
×
2161
        AC.ProtoType = w;
×
2162
        *w++ = SUBEXPRESSION;
×
2163
        *w++ = SUBEXPSIZE;
×
2164
        *w++ = C->numrhs+1;
×
2165
        *w++ = 1;
×
2166
        *w++ = AC.cbufnum;
×
2167
        FILLSUB(w)
2168
        *w++ = 1; *w++ = 1; *w++ = 3; *w++ = 0;
×
2169
        AT.WorkPointer = w;
×
2170
        if ( ( retcode = CompileAlgebra(s,RHSIDE,AC.ProtoType) ) < 0 ) {
×
2171
                MLOCK(ErrorMessageLock);
×
2172
                MesPrint("@Error translating first expression in $( ) option");
×
2173
                MUNLOCK(ErrorMessageLock);
×
2174
                return(0);
×
2175
        }
2176
        else { AC.ProtoType[2] = retcode; }
×
2177
/*
2178
        Evaluate this expression
2179
*/
2180
        if ( NewSort(BHEAD0) || NewSort(BHEAD0) ) { return(0); }
×
2181
        AN.RepPoint = AT.RepCount + 1;
×
2182
        oldEside = AR.Eside; AR.Eside = RHSIDE;
×
2183
        AR.Cnumlhs = C->numlhs;
×
2184
        if ( Generator(BHEAD AC.ProtoType-1,C->numlhs) ) {
×
2185
                AR.Eside = oldEside;
×
2186
                LowerSortLevel(); LowerSortLevel(); return(0);
×
2187
        }
2188
        AR.Eside = oldEside;
×
2189
        AT.WorkPointer = w;
×
2190
        AN.tryterm = 0; /* for now */
×
NEW
2191
        if ( EndSort(BHEAD (WORD *)((void *)(&outbuffer)),2) < 0 ) { LowerSortLevel(); return(0); }
×
2192
        LowerSortLevel();
×
2193
        C->Pointer = C->Buffer + oldcpointer;
×
2194
        C->numrhs = oldnumrhs;
×
2195
        AT.WorkPointer = AC.ProtoType - 1;
×
2196
        return(outbuffer);
×
2197
}
2198

2199
/*
2200
          #] TranslateExpression : 
2201
          #[ IsSetMember :
2202

2203
        Checks whether the expression in the buffer can be seen as an element
2204
        of the given set.
2205
        For the special sets: if more than one term: no match!!!
2206
*/
2207

2208
int IsSetMember(WORD *buffer, WORD numset)
×
2209
{
2210
        WORD *t = buffer, *tt, num, csize, num1;
×
2211
        WORD bufterm[4];
×
2212
        int i, j, type;
×
2213
        if ( numset < AM.NumFixedSets ) {
×
2214
                if ( t[*t] != 0 ) return(0);        /* More than one term */
×
2215
                if ( *t == 0 ) {
×
2216
                        if ( numset == POS0_ || numset == NEG0_ || numset == EVEN_
×
2217
                        || numset == Z_ || numset == Q_ ) return(1);
2218
                        else return(0);
×
2219
                }
2220
                if ( numset == SYMBOL_ ) {
×
2221
                        if ( *t == 8 && t[1] == SYMBOL && t[7] == 3 && t[6] == 1
×
2222
                        && t[5] == 1 && t[4] == 1 ) return(1);
×
2223
                        else return(0);
×
2224
                }
2225
                if ( numset == INDEX_ ) {
2226
                        if ( *t == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
×
2227
                        && t[4] == 1 && t[3] > 0 ) return(1);
×
2228
                        if ( *t == 4 && t[3] == 3 && t[2] == 1 && t[1] < AM.OffsetIndex)
×
2229
                                return(1);
2230
                        return(0);
×
2231
                }
2232
                if ( numset == FIXED_ ) {
2233
                        if ( *t == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
×
2234
                        && t[4] == 1 && t[3] > 0 && t[3] < AM.OffsetIndex ) return(1);
×
2235
                        if ( *t == 4 && t[3] == 3 && t[2] == 1 && t[1] < AM.OffsetIndex)
×
2236
                                return(1);
2237
                        return(0);
×
2238
                }
2239
                if ( numset == DUMMYINDEX_ ) {
2240
                        if ( *t == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
×
2241
                        && t[4] == 1 && t[3] >= AM.IndDum && t[3] < AM.IndDum+MAXDUMMIES ) return(1);
×
2242
                        if ( *t == 4 && t[3] == 3 && t[2] == 1
×
2243
                                 && t[1] >= AM.IndDum && t[1] < AM.IndDum+MAXDUMMIES ) return(1);
×
2244
                        return(0);
×
2245
                }
2246
                if ( numset == VECTOR_ ) {
2247
                        if ( *t == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
×
2248
                        && t[4] == 1 && t[3] < (AM.OffsetVector+WILDOFFSET) && t[3] >= AM.OffsetVector ) return(1);
×
2249
                        return(0);
×
2250
                }
2251
                tt = t + *t - 1;
×
2252
                if ( ABS(tt[0]) != *t-1 ) return(0);
×
2253
                if ( numset == Q_ ) return(1);
×
2254
                if ( numset == POS_ || numset == POS0_ ) return(tt[0]>0);
×
2255
                else if ( numset == NEG_ || numset == NEG0_ ) return(tt[0]<0);
×
2256
                i = (ABS(tt[0])-1)/2;
×
2257
                tt -= i;
×
2258
                if ( tt[0] != 1 ) return(0);
×
2259
                for ( j = 1; j < i; j++ ) { if ( tt[j] != 0 ) return(0); }
×
2260
                if ( numset == Z_ ) return(1);
×
2261
                if ( numset == ODD_ ) return(t[1]&1);
×
2262
                if ( numset == EVEN_ ) return(1-(t[1]&1));
×
2263
                return(0);
2264
        }
2265
        if ( t[*t] != 0 ) return(0);        /* More than one term */
×
2266
        type = Sets[numset].type;
×
2267
        switch ( type ) {
×
2268
                case CSYMBOL:
×
2269
                        if ( t[0] == 8 && t[1] == SYMBOL && t[7] == 3 && t[6] == 1
×
2270
                        && t[5] == 1 && t[4] == 1 ) {
×
2271
                                num = t[3];
×
2272
                        }
2273
                        else if ( t[0] == 4 && t[2] == 1 && t[1] <= MAXPOWER ) {
×
2274
                                num = t[1];
×
2275
                                if ( t[3] < 0 ) num = -num;
×
2276
                                num += 2*MAXPOWER;
×
2277
                        }
2278
                        else return(0);
2279
                        break;
2280
                case CVECTOR:
×
2281
                        if ( t[0] == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
×
2282
                        && t[4] == 1 && t[3] < 0 ) {
×
2283
                                num = t[3];
2284
                        }
2285
                        else return(0);
2286
                        break;
2287
                case CINDEX:
×
2288
                        if ( t[0] == 7 && t[1] == INDEX && t[6] == 3 && t[5] == 1
×
2289
                        && t[4] == 1 && t[3] > 0 ) {
×
2290
                                num = t[3];
2291
                        }
2292
                        else if ( t[0] == 4 && t[3] == 3 && t[2] == 1 && t[1] < AM.OffsetIndex ) {
×
2293
                                num = t[1];
2294
                        }
2295
                        else return(0);
2296
                        break;
2297
                case CFUNCTION:
×
2298
                        if ( t[0] == 4+FUNHEAD && t[3+FUNHEAD] == 3 && t[2+FUNHEAD] == 1
×
2299
                        && t[1+FUNHEAD] == 1 && t[1] >= FUNCTION ) {
×
2300
                                num = t[1];
2301
                        }
2302
                        else return(0);
2303
                        break;
2304
                case CNUMBER:
×
2305
                        if ( t[0] == 4 && t[2] == 1 && t[1] <= AM.OffsetIndex && t[3] == 3 ) {
×
2306
                                num = t[1];
2307
                        }
2308
                        else return(0);
2309
                        break;
2310
                case CRANGE:
×
2311
                        csize = t[t[0]-1];
×
2312
                        csize = ABS(csize);
×
2313
                        if ( csize != t[0]-1 ) return(0);
×
2314
                        if ( Sets[numset].first < 3*MAXPOWER ) {
×
2315
                                num1 = num = Sets[numset].first;
×
2316
                                if ( num >= MAXPOWER ) num -= 2*MAXPOWER;
×
2317
                                if ( num == 0 ) {
×
2318
                                        if ( num1 < MAXPOWER ) {
×
2319
                                                if ( t[t[0]-1] >= 0 ) return(0);
×
2320
                                        }
2321
                                        else if ( t[t[0]-1] > 0 ) return(0);
×
2322
                                }
2323
                                else {
2324
                                        bufterm[0] = 4; bufterm[1] = ABS(num);
×
2325
                                        bufterm[2] = 1;
×
2326
                                        if ( num < 0 ) bufterm[3] = -3;
×
2327
                                        else bufterm[3] = 3;
×
2328
                                        num = CompCoef(t,bufterm);
×
2329
                                        if ( num1 < MAXPOWER ) {
×
2330
                                                if ( num >= 0 ) return(0);
×
2331
                                        }
2332
                                        else if ( num > 0 ) return(0);
×
2333
                                }
2334
                        }
2335
                        if ( Sets[numset].last > -3*MAXPOWER ) {
×
2336
                                num1 = num = Sets[numset].last;
×
2337
                                if ( num <= -MAXPOWER ) num += 2*MAXPOWER;
×
2338
                                if ( num == 0 ) {
×
2339
                                        if ( num1 > -MAXPOWER ) {
×
2340
                                                if ( t[t[0]-1] <= 0 ) return(0);
×
2341
                                        }
2342
                                        else if ( t[t[0]-1] < 0 ) return(0);
×
2343
                                }
2344
                                else {
2345
                                        bufterm[0] = 4; bufterm[1] = ABS(num);
×
2346
                                        bufterm[2] = 1;
×
2347
                                        if ( num < 0 ) bufterm[3] = -3;
×
2348
                                        else bufterm[3] = 3;
×
2349
                                        num = CompCoef(t,bufterm);
×
2350
                                        if ( num1 > -MAXPOWER ) {
×
2351
                                                if ( num <= 0 ) return(0);
×
2352
                                        }
2353
                                        else if ( num < 0 ) return(0);
×
2354
                                }
2355
                        }
2356
                        return(1);
2357
                        break;
2358
                default: return(0);
2359
        }
2360
        t  = SetElements + Sets[numset].first;
×
2361
        tt = SetElements + Sets[numset].last;
×
2362
        do {
×
2363
                if ( num == *t ) return(1);
×
2364
                t++;
×
2365
        } while ( t < tt );
×
2366
        return(0);
2367
}
2368

2369
/*
2370
          #] IsSetMember : 
2371
          #[ IsProductOf :
2372

2373
        Checks whether the expression in buf1 is a single term multiple of 
2374
        the expression in buf2.
2375

2376
int IsProductOf(WORD *buf1, WORD *buf2)
2377
{
2378
        return(0);
2379
}
2380

2381

2382
          #] IsProductOf : 
2383
          #[ IsMultipleOf :
2384

2385
        Checks whether the expression in buf1 is a numerical multiple of 
2386
        the expression in buf2.
2387
*/
2388

2389
int IsMultipleOf(WORD *buf1, WORD *buf2)
×
2390
{
2391
        GETIDENTITY
2392
        LONG num1, num2;
×
2393
        WORD *t1, *t2, *m1, *m2, *r1, *r2, nc1, nc2, ni1, ni2;
×
2394
        UWORD *IfScrat1, *IfScrat2;
×
2395
        int i, j;
×
2396
        if ( *buf1 == 0 && *buf2 == 0 ) return(1);
×
2397
/*
2398
        First count terms
2399
*/
2400
        t1 = buf1; t2 = buf2; num1 = 0; num2 = 0;
×
2401
        while ( *t1 ) { t1 += *t1; num1++; }
×
2402
        while ( *t2 ) { t2 += *t2; num2++; }
×
2403
        if ( num1 != num2 ) return(0);
×
2404
/*
2405
        Test similarity of terms. Difference up to a number.
2406
*/
2407
        t1 = buf1; t2 = buf2;
2408
        while ( *t1 ) {
×
2409
                m1 = t1+1; m2 = t2+1; t1 += *t1; t2 += *t2;
×
2410
                r1 = t1 - ABS(t1[-1]); r2 = t2 - ABS(t2[-1]);
×
2411
                if ( r1-m1 != r2-m2 ) return(0);
×
2412
                while ( m1 < r1 ) {
×
2413
                        if ( *m1 != *m2 ) return(0);
×
2414
                        m1++; m2++;
×
2415
                }
2416
        }
2417
/*
2418
        Now we have to test the constant factor
2419
*/
2420
        IfScrat1 = (UWORD *)(TermMalloc("IsMultipleOf")); IfScrat2 = (UWORD *)(TermMalloc("IsMultipleOf"));
×
2421
        t1 = buf1; t2 = buf2;
×
2422
        t1 += *t1; t2 += *t2;
×
2423
        if ( *t1 == 0 && *t2 == 0 ) return(1);
×
2424
        r1 = t1 - ABS(t1[-1]); r2 = t2 - ABS(t2[-1]);
×
2425
        nc1 = REDLENG(t1[-1]); nc2 = REDLENG(t2[-1]);
×
2426
        if ( DivRat(BHEAD (UWORD *)r1,nc1,(UWORD *)r2,nc2,IfScrat1,&ni1) ) {
×
2427
                MLOCK(ErrorMessageLock);
×
2428
                MesPrint("@Called from MultipleOf in $( )");
×
2429
                MUNLOCK(ErrorMessageLock);
×
2430
                TermFree(IfScrat1,"IsMultipleOf"); TermFree(IfScrat2,"IsMultipleOf");
×
2431
                Terminate(-1);
×
2432
        }
2433
        while ( *t1 ) {
×
2434
                t1 += *t1; t2 += *t2;
×
2435
                r1 = t1 - ABS(t1[-1]); r2 = t2 - ABS(t2[-1]);
×
2436
                nc1 = REDLENG(t1[-1]); nc2 = REDLENG(t2[-1]);
×
2437
                if ( DivRat(BHEAD (UWORD *)r1,nc1,(UWORD *)r2,nc2,IfScrat2,&ni2) ) {
×
2438
                        MLOCK(ErrorMessageLock);
×
2439
                        MesPrint("@Called from MultipleOf in $( )");
×
2440
                        MUNLOCK(ErrorMessageLock);
×
2441
                        TermFree(IfScrat1,"IsMultipleOf"); TermFree(IfScrat2,"IsMultipleOf");
×
2442
                        Terminate(-1);
×
2443
                }
2444
                if ( ni1 != ni2 ) return(0);
×
2445
                i = 2*ABS(ni1);
×
2446
                for ( j = 0; j < i; j++ ) {
×
2447
                        if ( IfScrat1[j] != IfScrat2[j] ) {
×
2448
                                TermFree(IfScrat1,"IsMultipleOf"); TermFree(IfScrat2,"IsMultipleOf");
×
2449
                                return(0);
×
2450
                        }
2451
                }
2452
        }
2453
        TermFree(IfScrat1,"IsMultipleOf"); TermFree(IfScrat2,"IsMultipleOf");
×
2454
        return(1);
×
2455
}
2456

2457
/*
2458
          #] IsMultipleOf : 
2459
          #[ TwoExprCompare :
2460

2461
        Compares the expressions in buf1 and buf2 according to oprtr
2462
*/
2463

2464
int TwoExprCompare(WORD *buf1, WORD *buf2, int oprtr)
×
2465
{
2466
        GETIDENTITY
2467
        WORD *t1, *t2, cond;
×
2468
        t1 = buf1; t2 = buf2;
×
2469
        while ( *t1 && *t2 ) {
×
2470
                cond = CompareTerms(BHEAD t1,t2,1);
×
2471
                if ( cond != 0 ) {
×
2472
                        if ( cond > 0 ) { /* t1 comes first */
×
2473
                                switch ( oprtr ) {  /* t1 is less */
×
2474
                                        case EQUAL: return(0);
2475
                                        case NOTEQUAL: return(1);
×
2476
                                        case GREATEREQUAL: return(0);
2477
                                        case GREATER: return(0);
2478
                                        case LESS: return(1);
×
2479
                                        case LESSEQUAL: return(1);
×
2480
                                }
2481
                        }
2482
                        else {
2483
                                switch ( oprtr ) {
×
2484
                                        case EQUAL: return(0);
2485
                                        case NOTEQUAL: return(1);
×
2486
                                        case GREATEREQUAL: return(1);
×
2487
                                        case GREATER: return(1);
×
2488
                                        case LESS: return(0);
2489
                                        case LESSEQUAL: return(0);
2490
                                }
2491
                        }
2492
                }
2493
                t1 += *t1; t2 += *t2;
×
2494
        }
2495
        if ( *t1 == *t2 ) {        /* They are equal */
×
2496
                switch ( oprtr ) {
×
2497
                        case EQUAL: return(1);
2498
                        case NOTEQUAL: return(0);
×
2499
                        case GREATEREQUAL: return(1);
2500
                        case GREATER: return(0);
×
2501
                        case LESS: return(0);
×
2502
                        case LESSEQUAL: return(1);
2503
                }
2504
        }
2505
        else if ( *t1 ) {  /* t1 is greater */
×
2506
                switch ( oprtr ) {
×
2507
                        case EQUAL: return(0);
2508
                        case NOTEQUAL: return(1);
×
2509
                        case GREATEREQUAL: return(1);
×
2510
                        case GREATER: return(1);
×
2511
                        case LESS: return(0);
2512
                        case LESSEQUAL: return(0);
2513
                }
2514
        }
2515
        else {
2516
                switch ( oprtr ) {  /* t1 is less */
×
2517
                        case EQUAL: return(0);
2518
                        case NOTEQUAL: return(1);
×
2519
                        case GREATEREQUAL: return(0);
2520
                        case GREATER: return(0);
2521
                        case LESS: return(1);
×
2522
                        case LESSEQUAL: return(1);
×
2523
                }
2524
        }
2525
        MLOCK(ErrorMessageLock);
×
2526
        MesPrint("@Internal problems with operator in $( )");
×
2527
        MUNLOCK(ErrorMessageLock);
×
2528
        Terminate(-1);
×
2529
        return(0);
×
2530
}
2531

2532
/*
2533
          #] TwoExprCompare : 
2534
          #[ DollarRaiseLow :
2535

2536
        Raises or lowers the numerical value of a dollar variable
2537
        Not to be used in parallel.
2538
*/
2539

2540
static UWORD *dscrat = 0;
2541
static WORD ndscrat;
2542

2543
int DollarRaiseLow(UBYTE *name, LONG value)
×
2544
{
2545
        GETIDENTITY
2546
        int num;
×
2547
        DOLLARS d;
×
2548
        int sgn = 1;
×
2549
        WORD lnum[4], nnum, *t1, *t2, i;
×
2550
        UBYTE *s, c;
×
2551
        s = name; while ( *s ) s++;
×
2552
        if ( s[-1] == '-' && s[-2] == '-' && s > name+2 ) s -= 2;
×
2553
        else if ( s[-1] == '+' && s[-2] == '+' && s > name+2 ) s -= 2;
×
2554
        c = *s; *s = 0;
×
2555
        num = GetDollar(name);
×
2556
        *s = c;
×
2557
        d = Dollars + num;
×
2558
        if ( value < 0 ) { value = -value; sgn = -1; }
×
2559
        if ( d->type == DOLZERO ) {
×
2560
                if ( d->where ) M_free(d->where,"DollarRaiseLow");
×
2561
                d->size = MINALLOC;
×
2562
                d->where = (WORD *)Malloc1(d->size*sizeof(WORD),"DollarRaiseLow");
×
2563
                if ( ( value & AWORDMASK ) != 0 ) {
×
2564
                        d->where[0] = 6; d->where[1] = value >> BITSINWORD;
×
2565
                        d->where[2] = (WORD)value; d->where[3] = 1; d->where[4] = 0;
×
2566
                        d->where[5] = 5*sgn; d->where[6] = 0;
×
2567
                        d->type = DOLTERMS;
×
2568
                }
2569
                else {
2570
                        d->where[0] = 4; d->where[1] = (WORD)value; d->where[2] = 1;
×
2571
                        d->where[3] = 3*sgn; d->where[4] = 0;
×
2572
                        d->type = DOLNUMBER;
×
2573
                }
2574
        }
2575
        else if ( d->type == DOLNUMBER || ( d->type == DOLTERMS
×
2576
        && d->where[d->where[0]] == 0
×
2577
        && d->where[0] == ABS(d->where[d->where[0]-1])+1 ) ) {
×
2578
                if ( ( value & AWORDMASK ) != 0 ) {
×
2579
                        lnum[0] = value >> BITSINWORD;
×
2580
                        lnum[1] = (WORD)value; lnum[2] = 1; lnum[3] = 0;
×
2581
                        nnum = 2*sgn;
×
2582
                }
2583
                else {
2584
                        lnum[0] = (WORD)value; lnum[1] = 1; nnum = sgn;
×
2585
                }
2586
                i = d->where[d->where[0]-1];
×
2587
                i = REDLENG(i);
×
2588
                if ( dscrat == 0 ) {
×
2589
                        dscrat = (UWORD *)Malloc1((AM.MaxTal+2)*sizeof(UWORD),"DollarRaiseLow");
×
2590
                }
2591
                if ( AddRat(BHEAD (UWORD *)(d->where+1),i,
×
2592
                        (UWORD *)lnum,nnum,dscrat,&ndscrat) ) {
2593
                                MLOCK(ErrorMessageLock);
×
2594
                                MesCall("DollarRaiseLow");
×
2595
                                MUNLOCK(ErrorMessageLock);
×
2596
                                Terminate(-1);
×
2597
                }
2598
                ndscrat = INCLENG(ndscrat);
×
2599
                i = ABS(ndscrat);
×
2600
                if ( i == 0 ) {
×
2601
                        M_free(d->where,"DollarRaiseLow");
×
2602
                        d->where = 0;
×
2603
                        d->type = DOLZERO;
×
2604
                        d->size = 0;
×
2605
                        return(0);
×
2606
                }
2607
                if ( i+2 > d->size ) {
×
2608
                        M_free(d->where,"DollarRaiseLow");
×
2609
                        d->size = i+2;
×
2610
                        if ( d->size < MINALLOC ) d->size = MINALLOC;
×
2611
                        d->size = ((d->size+7)/8)*8;
×
2612
                        d->where = (WORD *)Malloc1(d->size*sizeof(WORD),"DollarRaiseLow");
×
2613
                }
2614
                t1 = d->where; *t1++ = i+1; t2 = (WORD *)dscrat;
×
2615
                while ( --i > 0 ) *t1++ = *t2++;
×
2616
                *t1++ = ndscrat; *t1 = 0;
×
2617
                d->type = DOLTERMS;
×
2618
        }
2619
        return(0);
2620
}
2621

2622
/*
2623
          #] DollarRaiseLow : 
2624
          #[ EvalDoLoopArg :
2625
*/
2626
/**
2627
 *        Evaluates one argument of a do loop. Such an argument is constructed
2628
 *        from SNUMBERs DOLLAREXPRESSIONs and possibly DOLLAREXPR2s which indicate
2629
 *        factors of the preceding dollar. Hence we have
2630
 *        SNUMBER,num
2631
 *        DOLLAREXPRESSION,numdollar
2632
 *        DOLLAREXPRESSION,numdollar,DOLLAREXPR2,numfactor
2633
 *        DOLLAREXPRESSION,numdollar,DOLLAREXPR2,numfactor,DOLLAREXPR2,numfactor
2634
 *        etc.
2635
 *        Because we have a do-loop at every stage we should have a number.
2636
 *        The notation in DOLLAREXPR2 is that >= 0 is number of yet another dollar
2637
 *        and < 0 is -n-1 with n the array element or zero.
2638
 *        The return value is the (short) number.
2639
 *        The routine works its way through the list in a recursive manner.
2640
 */
2641

2642
WORD EvalDoLoopArg(PHEAD WORD *arg, WORD par)
1,734✔
2643
{
2644
        WORD num, type, *td;
1,734✔
2645
        DOLLARS d;
1,734✔
2646
        if ( *arg == SNUMBER ) return(arg[1]);
1,734✔
2647
        if ( *arg == DOLLAREXPR2 && arg[1] < 0 ) return(-arg[1]-1);
894✔
2648
        d = Dollars + arg[1];
474✔
2649
#ifdef WITHPTHREADS
2650
        {
2651
                int nummodopt, dtype = -1;
316✔
2652
                if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
316✔
2653
                        for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2654
                                if ( arg[1] == ModOptdollars[nummodopt].number ) break;
2655
                        }
2656
                        if ( nummodopt < NumModOptdollars ) {
2657
                                dtype = ModOptdollars[nummodopt].type;
2658
                                if ( dtype == MODLOCAL ) {
2659
                                        d = ModOptdollars[nummodopt].dstruct+AT.identity;
2660
                                }
2661
                        }
2662
                }
2663
        }
2664
#endif
2665
        if ( *arg == DOLLAREXPRESSION ) {
474✔
2666
                if ( arg[2] != DOLLAREXPR2 ) {        /* end of chain */
420✔
2667
endofchain:
×
2668
                        type = d->type;
54✔
2669
                        if ( type == DOLZERO ) {}
54✔
2670
                        else if ( type == DOLNUMBER ) {
54✔
2671
                                td = d->where;
54✔
2672
                                if ( ( td[0] != 4 ) || ( (td[1]&SPECMASK) != 0 ) || ( td[2] != 1 ) ) {
54✔
2673
                                        MLOCK(ErrorMessageLock);
×
2674
                                        if ( par == -1 ) {
×
2675
                                                MesPrint("$-variable is not a short number in print statement");
×
2676
                                        }
2677
                                        else {
2678
                                                MesPrint("$-variable is not a short number in do loop");
×
2679
                                        }
2680
                                        MUNLOCK(ErrorMessageLock);
×
2681
                                        Terminate(-1);
×
2682
                                }
2683
                                return( td[3] > 0 ? td[1]: -td[1] );
54✔
2684
                        }
2685
                    else {
2686
                                MLOCK(ErrorMessageLock);
×
2687
                                if ( par == -1 ) {
×
2688
                                        MesPrint("$-variable is not a number in print statement");
×
2689
                                }
2690
                                else {
2691
                                        MesPrint("$-variable is not a number in do loop");
×
2692
                                }
2693
                                MUNLOCK(ErrorMessageLock);
×
2694
                                Terminate(-1);
×
2695
                        }
2696
                        return(0);
×
2697
                }
2698
                num = EvalDoLoopArg(BHEAD arg+2,par);
420✔
2699
        }
2700
        else if ( *arg == DOLLAREXPR2 ) {
54✔
2701
                if ( arg[1] < 0 ) { num = -arg[1]-1; }
54✔
2702
                else if ( arg[2] != DOLLAREXPR2 && par == -1 ) {
54✔
2703
                        goto endofchain;
54✔
2704
                }
2705
                else              { num = EvalDoLoopArg(BHEAD arg+2,par); }
×
2706
        }
2707
        else {
2708
                MLOCK(ErrorMessageLock);
×
2709
                if ( par == -1 ) {
×
2710
                        MesPrint("Invalid $-variable in print statement");
×
2711
                }
2712
                else {
2713
                        MesPrint("Invalid $-variable in do loop");
×
2714
                }
2715
                MUNLOCK(ErrorMessageLock);
×
2716
                Terminate(-1);
×
2717
                return(0);
×
2718
        }
2719
        if ( num == 0 ) return(d->nfactors);
420✔
2720
        if ( num > d->nfactors || num < 1 ) {
×
2721
                MLOCK(ErrorMessageLock);
×
2722
                if ( par == -1 ) {
×
2723
                        MesPrint("Not a valid factor number for $-variable in print statement");
×
2724
                }
2725
                else {
2726
                        MesPrint("Not a valid factor number for $-variable in do loop");
×
2727
                }
2728
                MUNLOCK(ErrorMessageLock);
×
2729
                Terminate(-1);
×
2730
                return(0);
×
2731
        }
2732
        if ( d->factors[num].type == DOLNUMBER )
×
2733
                return(d->factors[num].value);
×
2734
        else {        /* If correct, type can only be DOLNUMBER or DOLTERMS */
2735
                MLOCK(ErrorMessageLock);
×
2736
                if ( par == -1 ) {
×
2737
                        MesPrint("$-variable in print statement is not a number");
×
2738
                }
2739
                else {
2740
                        MesPrint("$-variable in do loop is not a number");
×
2741
                }
2742
                MUNLOCK(ErrorMessageLock);
×
2743
                Terminate(-1);
×
2744
                return(0);
×
2745
        }
2746
}
2747

2748
/*
2749
          #] EvalDoLoopArg : 
2750
          #[ TestDoLoop :
2751
*/
2752

2753
WORD TestDoLoop(PHEAD WORD *lhsbuf, WORD level)
18✔
2754
{
2755
        GETBIDENTITY
2756
        WORD start,finish,incr;
18✔
2757
        WORD *h;
18✔
2758
        DOLLARS d;
18✔
2759
        h = lhsbuf + 4;        /* address of the start value */
18✔
2760
        start = EvalDoLoopArg(BHEAD h,0);
18✔
2761
        while ( ( *h == DOLLAREXPRESSION || *h == DOLLAREXPR2 )
18✔
2762
                && ( h[2] == DOLLAREXPR2 ) ) h += 2;
18✔
2763
        h += 2;
18✔
2764
        finish = EvalDoLoopArg(BHEAD h,0);
18✔
2765
        while ( ( *h == DOLLAREXPRESSION || *h == DOLLAREXPR2 )
18✔
2766
                && ( h[2] == DOLLAREXPR2 ) ) h += 2;
36✔
2767
        h += 2;
18✔
2768
        incr = EvalDoLoopArg(BHEAD h,0);
18✔
2769

2770
        if ( ( finish == start ) || ( finish > start && incr > 0 )
18✔
2771
        || ( finish < start && incr < 0 ) ) {}
×
2772
        else { level = lhsbuf[3]; } /* skips the loop */
×
2773
/*
2774
        Put start in the dollar variable indicated by lhsbuf[2]
2775
*/
2776
        d = Dollars + lhsbuf[2];
18✔
2777
#ifdef WITHPTHREADS
2778
        {
2779
                int nummodopt, dtype = -1;
12✔
2780
                if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
12✔
2781
                        for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2782
                                if ( lhsbuf[2] == ModOptdollars[nummodopt].number ) break;
2783
                        }
2784
                        if ( nummodopt < NumModOptdollars ) {
2785
                                dtype = ModOptdollars[nummodopt].type;
2786
                                if ( dtype == MODLOCAL ) {
2787
                                        d = ModOptdollars[nummodopt].dstruct+AT.identity;
2788
                                }
2789
                        }
2790
                }
2791
        }
2792
#endif
2793

2794
        if ( d->size < MINALLOC ) {
18✔
2795
                if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,"dollar contents");
12✔
2796
                d->size = MINALLOC;
12✔
2797
                d->where = (WORD *)Malloc1(d->size*sizeof(WORD),"dollar contents");
12✔
2798
        }
2799
        if ( start > 0 ) {
18✔
2800
                d->where[0] = 4;
18✔
2801
                d->where[1] = start;
18✔
2802
                d->where[2] = 1;
18✔
2803
                d->where[3] = 3;
18✔
2804
                d->where[4] = 0;
18✔
2805
                d->type = DOLNUMBER;
18✔
2806
        }
2807
        else if ( start < 0 ) {
×
2808
                d->where[0] = 4;
×
2809
                d->where[1] = -start;
×
2810
                d->where[2] = 1;
×
2811
                d->where[3] = -3;
×
2812
                d->where[4] = 0;
×
2813
                d->type = DOLNUMBER;
×
2814
        }
2815
        else
2816
                d->type = DOLZERO;
×
2817

2818
        if ( d == Dollars + lhsbuf[2] ) {
18✔
2819
                cbuf[AM.dbufnum].CanCommu[lhsbuf[2]] = 0;
18✔
2820
                cbuf[AM.dbufnum].NumTerms[lhsbuf[2]] = 1;
18✔
2821
                cbuf[AM.dbufnum].rhs[lhsbuf[2]] = d->where;
18✔
2822
        }
2823
        return(level);
18✔
2824
}
2825

2826
/*
2827
          #] TestDoLoop : 
2828
          #[ TestEndDoLoop :
2829
*/
2830

2831
WORD TestEndDoLoop(PHEAD WORD *lhsbuf, WORD level)
402✔
2832
{
2833
        GETBIDENTITY
2834
        WORD start,finish,incr,value;
402✔
2835
        WORD *h;
402✔
2836
        DOLLARS d;
402✔
2837
        h = lhsbuf + 4;        /* address of the start value */
402✔
2838
        start = EvalDoLoopArg(BHEAD h,0);
402✔
2839
        while ( ( *h == DOLLAREXPRESSION || *h == DOLLAREXPR2 )
402✔
2840
                && ( h[2] == DOLLAREXPR2 ) ) h += 2;
402✔
2841
        h += 2;
402✔
2842
        finish = EvalDoLoopArg(BHEAD h,0);
402✔
2843
        while ( ( *h == DOLLAREXPRESSION || *h == DOLLAREXPR2 )
402✔
2844
                && ( h[2] == DOLLAREXPR2 ) ) h += 2;
804✔
2845
        h += 2;
402✔
2846
        incr = EvalDoLoopArg(BHEAD h,0);
402✔
2847

2848
        if ( ( finish == start ) || ( finish > start && incr > 0 )
402✔
2849
        || ( finish < start && incr < 0 ) ) {}
×
2850
        else { level = lhsbuf[3]; } /* skips the loop */
×
2851
/*
2852
        Put start in the dollar variable indicated by lhsbuf[2]
2853
*/
2854
        d = Dollars + lhsbuf[2];
402✔
2855
#ifdef WITHPTHREADS
2856
        {
2857
                int nummodopt, dtype = -1;
268✔
2858
                if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
268✔
2859
                        for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
2860
                                if ( lhsbuf[2] == ModOptdollars[nummodopt].number ) break;
2861
                        }
2862
                        if ( nummodopt < NumModOptdollars ) {
2863
                                dtype = ModOptdollars[nummodopt].type;
2864
                                if ( dtype == MODLOCAL ) {
2865
                                        d = ModOptdollars[nummodopt].dstruct+AT.identity;
2866
                                }
2867
                        }
2868
                }
2869
        }
2870
#endif
2871
/*
2872
        Get the value
2873
*/
2874
        if ( d->type == DOLZERO ) {
402✔
2875
                value = 0;
2876
        }
2877
        else if ( ( d->type == DOLNUMBER || d->type == DOLTERMS )
402✔
2878
        && ( d->where[4] == 0 ) && ( d->where[0] == 4 )
402✔
2879
        && ( d->where[1] > 0 ) && ( d->where[2] == 1 ) ) {
402✔
2880
                value = ( d->where[3] < 0 ) ? -d->where[1]: d->where[1];
402✔
2881
        }
2882
        else {
2883
                MLOCK(ErrorMessageLock);
×
2884
                MesPrint("Wrong type of object in do loop parameter");
×
2885
                MUNLOCK(ErrorMessageLock);
×
2886
                Terminate(-1);
×
2887
                return(level);
×
2888
        }
2889
        value += incr;
402✔
2890
        if ( ( finish > start && value <= finish ) ||
402✔
2891
                 ( finish < start && value >= finish ) ||
18✔
2892
                 ( finish == start && value == finish ) ) {}
18✔
2893
        else level = lhsbuf[3];
18✔
2894

2895
        if ( d->size < MINALLOC ) {
402✔
2896
                if ( d->where && d->where != &(AM.dollarzero) ) M_free(d->where,"dollar contents");
×
2897
                d->size = MINALLOC;
×
2898
                d->where = (WORD *)Malloc1(d->size*sizeof(WORD),"dollar contents");
×
2899
        }
2900
        if ( value > 0 ) {
402✔
2901
                d->where[0] = 4;
402✔
2902
                d->where[1] = value;
402✔
2903
                d->where[2] = 1;
402✔
2904
                d->where[3] = 3;
402✔
2905
                d->where[4] = 0;
402✔
2906
                d->type = DOLNUMBER;
402✔
2907
        }
2908
        else if ( start < 0 ) {
×
2909
                d->where[0] = 4;
×
2910
                d->where[1] = -value;
×
2911
                d->where[2] = 1;
×
2912
                d->where[3] = -3;
×
2913
                d->where[4] = 0;
×
2914
                d->type = DOLNUMBER;
×
2915
        }
2916
        else
2917
                d->type = DOLZERO;
×
2918

2919
        if ( d == Dollars + lhsbuf[2] ) {
402✔
2920
                cbuf[AM.dbufnum].CanCommu[lhsbuf[2]] = 0;
402✔
2921
                cbuf[AM.dbufnum].NumTerms[lhsbuf[2]] = 1;
402✔
2922
                cbuf[AM.dbufnum].rhs[lhsbuf[2]] = d->where;
402✔
2923
        }
2924
        return(level);
2925
}
2926

2927
/*
2928
          #] TestEndDoLoop : 
2929
          #[ DollarFactorize :
2930
*/
2931
/**
2932
 *        Factors a dollar expression.
2933
 *        Notation: d->nfactors becomes nonzero.
2934
 *                  if the number of factors is one, we leave d->factors zero.
2935
 *                  Otherwise factors is an array of pointers to the factors.
2936
 *                  These are pointers of the type FACDOLLAR.
2937
 *                    fd->where   pointer to contents in term notation
2938
 *                    fd->size    size of the buffer fd->where points to
2939
 *                    fd->type    DOLNUMBER or DOLTERMS
2940
 *                    fd->value   value if type is DOLNUMBER and it fits in a WORD.
2941
 */
2942

2943
/* #define STEP2 */
2944
#define STEP2
2945

2946
int DollarFactorize(PHEAD WORD numdollar)
72✔
2947
{
2948
        GETBIDENTITY
2949
        DOLLARS d = Dollars + numdollar;
72✔
2950
        CBUF *C, *CC;
72✔
2951
        WORD *oldworkpointer;
72✔
2952
        WORD *buf1, *t, *term, *buf1content, *buf2, *termextra;
72✔
2953
        WORD *buf3, *argextra;
72✔
2954
#ifdef STEP2
2955
        WORD *tstop, pow, *r;
72✔
2956
#endif
2957
        int i, j, jj, action = 0, sign = 1;
72✔
2958
        LONG insize, ii;
72✔
2959
        WORD startebuf = cbuf[AT.ebufnum].numrhs;
72✔
2960
        WORD nfactors, factorsincontent, extrafactor = 0;
72✔
2961
        WORD oldsorttype = AR.SortType;
72✔
2962

2963
#ifdef WITHPTHREADS
2964
        int nummodopt, dtype;
48✔
2965
        dtype = -1;
48✔
2966
        if ( AS.MultiThreaded ) {
48✔
2967
                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
36✔
2968
                        if ( numdollar == ModOptdollars[nummodopt].number ) break;
2969
                }
2970
                if ( nummodopt < NumModOptdollars ) {
36✔
2971
                        dtype = ModOptdollars[nummodopt].type;
2972
                        if ( dtype == MODLOCAL ) {
2973
                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
2974
                        }
2975
                        else {
2976
                                LOCK(d->pthreadslockread);
2977
                        }
2978
                }
2979
        }
2980
#endif
2981
        CleanDollarFactors(d);
72✔
2982
#ifdef WITHPTHREADS
2983
        if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
48✔
2984
#endif
2985
        if ( d->type != DOLTERMS ) {        /* only one term */
72✔
2986
                if ( d->type != DOLZERO ) d->nfactors = 1;
6✔
2987
                return(0);
6✔
2988
        }
2989
        if ( d->where[d->where[0]] == 0 ) {        /* only one term. easy */
66✔
2990
        }
66✔
2991
/*
2992
        Here should come the code for the factorization
2993
        We copied the routine ArgFactorize in argument.c and changed the
2994
        memory management completely. For the actual factorization it
2995
        calls WORD *DoFactorizeDollar(PHEAD WORD *expr) which allocates
2996
        space for the answer. Notation:
2997
         term,...,term,0,term,...,term,0,term,...,term,0,0
2998

2999
                 #[ Step 1: sort the terms properly and/or make copy  --> buf1,insize
3000
*/
3001
        term = d->where;
66✔
3002
        AR.SortType = SORTHIGHFIRST;
66✔
3003
        if ( oldsorttype != AR.SortType ) {
66✔
3004
                NewSort(BHEAD0);
66✔
3005
                while ( *term ) {
3,282✔
3006
                        t = term + *term;
3,216✔
3007
                        if ( AN.ncmod != 0 ) {
3,216✔
3008
                                if ( AN.ncmod != 1 || ( (WORD)AN.cmod[0] < 0 ) ) {
×
3009
                                        AR.SortType = oldsorttype;
×
3010
                                        MLOCK(ErrorMessageLock);
×
3011
                                        MesPrint("Factorization modulus a number, greater than a WORD not implemented.");
×
3012
                                        MUNLOCK(ErrorMessageLock);
×
3013
                                        Terminate(-1);
×
3014
                                }
3015
                                if ( Modulus(term) ) {
×
3016
                                        AR.SortType = oldsorttype;
×
3017
                                        MLOCK(ErrorMessageLock);
×
3018
                                        MesCall("DollarFactorize");
×
3019
                                        MUNLOCK(ErrorMessageLock);
×
3020
                                        Terminate(-1);
×
3021
                                }
3022
                                if ( !*term) { term = t; continue; }
×
3023
                        }
3024
                        StoreTerm(BHEAD term);
3,216✔
3025
                        term = t;
3,216✔
3026
                }
3027
                AN.tryterm = 0; /* for now */
66✔
3028
                EndSort(BHEAD (WORD *)((void *)(&buf1)),2);
66✔
3029
                t = buf1; while ( *t ) t += *t;
3,282✔
3030
                insize = t - buf1;
66✔
3031
        }
3032
        else {
3033
                t = term; while ( *t ) t += *t;
×
3034
                ii = insize = t - term;
×
3035
                buf1 = (WORD *)Malloc1((insize+1)*sizeof(WORD),"DollarFactorize-1");
×
3036
                t = buf1;
×
3037
                NCOPY(t,term,ii);
×
3038
                *t++ = 0;
×
3039
        }
3040
/*
3041
                 #] Step 1: 
3042
                 #[ Step 2: take out the 'content'.
3043
*/
3044
#ifdef STEP2
3045
        buf1content = TermMalloc("DollarContent");
66✔
3046
        AN.tryterm = -1;
66✔
3047
        if ( ( buf2 = TakeContent(BHEAD buf1,buf1content) ) == 0 ) {
66✔
3048
                AN.tryterm = 0;
×
3049
                TermFree(buf1content,"DollarContent");
×
3050
                M_free(buf1,"DollarFactorize-1");
×
3051
                AR.SortType = oldsorttype;
×
3052
                MLOCK(ErrorMessageLock);
×
3053
                MesCall("DollarFactorize");
×
3054
                MUNLOCK(ErrorMessageLock);
×
3055
                Terminate(-1);
×
3056
                return(1);
×
3057
        }
3058
        else if ( ( buf1content[0] == 4 ) && ( buf1content[1] == 1 ) &&
66✔
3059
                      ( buf1content[2] == 1 ) && ( buf1content[3] == 3 ) ) { /* Nothing happened */
48✔
3060
                AN.tryterm = 0;
42✔
3061
                if ( buf2 != buf1 ) {
42✔
3062
                        M_free(buf2,"DollarFactorize-2");
×
3063
                        buf2 = buf1;
×
3064
                }
3065
                factorsincontent = 0;
3066
        }
3067
        else {
3068
/*
3069
                The way we took out objects is rather brutish. We have to normalize
3070
*/
3071
                AN.tryterm = 0;
24✔
3072
                if ( buf2 != buf1 ) M_free(buf1,"DollarFactorize-1");
24✔
3073
                buf1 = buf2;
24✔
3074
                t = buf1; while ( *t ) t += *t;
3,126✔
3075
                insize = t - buf1;
24✔
3076
/*
3077
                Now analyse how many factors there are in the content
3078
*/
3079
                factorsincontent = 0;
24✔
3080
                term = buf1content;
24✔
3081
                tstop = term + *term;
24✔
3082
                if ( tstop[-1] < 0 ) factorsincontent++;
24✔
3083
                if ( ABS(tstop[-1]) == 3 && tstop[-2] == 1 && tstop[-3] == 1 ) {
24✔
3084
                        tstop -= ABS(tstop[-1]);
6✔
3085
                }
3086
                else {
3087
                        factorsincontent++;
18✔
3088
                        tstop -= ABS(tstop[-1]);
18✔
3089
                }
3090
                term++;
24✔
3091
                while ( term < tstop ) {
36✔
3092
                        switch ( *term ) {
12✔
3093
                                case SYMBOL:
12✔
3094
                                        t = term+2; i = (term[1]-2)/2;
12✔
3095
                                        while ( i > 0 ) {
96✔
3096
                                                factorsincontent += ABS(t[1]);
84✔
3097
                                                i--; t += 2;
84✔
3098
                                        }
3099
                                        break;
3100
                                case DOTPRODUCT:
×
3101
                                        t = term+2; i = (term[1]-2)/3;
×
3102
                                        while ( i > 0 ) {
×
3103
                                                factorsincontent += ABS(t[2]);
×
3104
                                                i--; t += 3;
×
3105
                                        }
3106
                                        break;
3107
                                case VECTOR:
×
3108
                                case DELTA:
3109
                                        factorsincontent += (term[1]-2)/2;
×
3110
                                        break;
×
3111
                                case INDEX:
×
3112
                                        factorsincontent += term[1]-2;
×
3113
                                        break;
×
3114
                                default:
×
3115
                                        if ( *term >= FUNCTION ) factorsincontent++;
×
3116
                                        break;
3117
                        }
3118
                        term += term[1];
12✔
3119
                }
3120
        }
3121
#else
3122
        factorsincontent = 0;
3123
        buf1content = 0;
3124
#endif
3125
/*
3126
                 #] Step 2: take out the 'content'. 
3127
                 #[ Step 3: ConvertToPoly
3128
                                if there are objects that are not SYMBOLs,
3129
                        invoke ConvertToPoly
3130
                                We keep the original in buf1 in case there are no factors
3131
*/
3132
        t = buf1;
66✔
3133
        while ( *t ) {
3,282✔
3134
                if ( ( t[1] != SYMBOL ) && ( *t != (ABS(t[*t-1])+1) ) ) {
3,216✔
3135
                        action = 1; break;
3136
                }
3137
                t += *t;
3,216✔
3138
        }
3139
        if ( DetCommu(buf1) > 1 ) {
66✔
3140
                MesPrint("Cannot factorize a $-expression with more than one noncommuting object");
×
3141
                AR.SortType = oldsorttype;
×
3142
                M_free(buf1,"DollarFactorize-2");
×
3143
                if ( buf1content ) TermFree(buf1content,"DollarContent");
×
3144
                MesCall("DollarFactorize");
×
3145
                Terminate(-1);
×
3146
                return(-1);
×
3147
        }
3148
        if ( action ) {
66✔
3149
                t = buf1;
×
3150
                termextra = AT.WorkPointer;
×
3151
                NewSort(BHEAD0);
×
3152
                NewSort(BHEAD0);
×
3153
                while ( *t ) {
×
3154
                        if ( LocalConvertToPoly(BHEAD t,termextra,startebuf,0) < 0 ) {
×
3155
getout:
×
3156
                                AR.SortType = oldsorttype;
×
3157
                                M_free(buf1,"DollarFactorize-2");
×
3158
                                if ( buf1content ) TermFree(buf1content,"DollarContent");
×
3159
                                MesCall("DollarFactorize");
×
3160
                                Terminate(-1);
×
3161
                                return(-1);
×
3162
                        }
3163
                        StoreTerm(BHEAD termextra);
×
3164
                        t += *t;
×
3165
                }
3166
                AN.tryterm = 0; /* for now */
×
3167
                if ( EndSort(BHEAD (WORD *)((void *)(&buf2)),2) < 0 ) { goto getout; }
×
3168
                LowerSortLevel();
×
3169
                t = buf2; while ( *t > 0 ) t += *t;
×
3170
        }
3171
        else {
3172
                buf2 = buf1;
66✔
3173
        }
3174
/*
3175
                 #] Step 3: ConvertToPoly 
3176
                 #[ Step 4: Now the hard work.
3177
*/
3178
        if ( ( buf3 = poly_factorize_dollar(BHEAD buf2) ) == 0 ) {
66✔
3179
                MesCall("DollarFactorize");
×
3180
                AR.SortType = oldsorttype;
×
3181
                if ( buf2 != buf1 && buf2 ) M_free(buf2,"DollarFactorize-3");
×
3182
                M_free(buf1,"DollarFactorize-3");
×
3183
                if ( buf1content ) TermFree(buf1content,"DollarContent");
×
3184
                Terminate(-1);
×
3185
                return(-1);
×
3186
        }
3187
        if ( buf2 != buf1 && buf2 ) {
66✔
3188
                M_free(buf2,"DollarFactorize-3");
×
3189
                buf2 = 0;
×
3190
        }
3191
        term = buf3;
66✔
3192
        AR.SortType = oldsorttype;
66✔
3193
/*
3194
        Count the factors and strip a factor -1
3195
*/
3196
        nfactors = 0;
66✔
3197
        while ( *term ) {
282✔
3198
#ifdef STEP2
3199
                if ( *term == 4 && term[4] == 0 && term[3] == -3 && term[2] == 1
216✔
3200
                        && term[1] == 1 ) {
42✔
3201
                        WORD *tt1, *tt2, *ttstop;
42✔
3202
                        sign = -sign;
42✔
3203
                        tt1 = term; tt2 = term + *term + 1;
42✔
3204
                        ttstop = tt2;
42✔
3205
                        while ( *ttstop ) {
144✔
3206
                                while ( *ttstop ) ttstop += *ttstop;
342✔
3207
                                ttstop++;
102✔
3208
                        }
3209
                        while ( tt2 < ttstop ) *tt1++ = *tt2++;
1,992✔
3210
                        *tt1 = 0;
42✔
3211
                        factorsincontent++;
42✔
3212
                        extrafactor++;
42✔
3213
                }
3214
                else
3215
#endif 
3216
                {
3217
                        term += *term;
174✔
3218
                        while ( *term ) { term += *term; }
996✔
3219
                        nfactors++; term++;
174✔
3220
                }
3221
        }
3222
/*
3223
        We have now:
3224
                buf1: the original before ConvertToPoly for if only one factor
3225
                buf3: the factored expression with nfactors factors
3226

3227
                 #] Step 4: 
3228
                 #[ Step 5: ConvertFromPoly
3229
                                If ConvertToPoly was used, use now ConvertFromPoly
3230
                        Be careful: there should be more than one factor now.
3231
*/
3232
#ifdef WITHPTHREADS
3233
        if ( dtype > 0 && dtype != MODLOCAL ) { LOCK(d->pthreadslockread); }
44✔
3234
#endif
3235
        if ( nfactors ==  1 && extrafactor == 0 ) {        /* we can use the buf1 contents */
66✔
3236
                if ( factorsincontent == 0 ) {
×
3237
                        d->nfactors = 1;
×
3238
#ifdef WITHPTHREADS
3239
                        if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3240
#endif
3241
/*
3242
                        We used here (before 3-sep-2015) the original and did not make
3243
                        provisions for having a factors struct, figuring that all info
3244
                        is identical to the full dollar. This makes things too
3245
                        complicated at later stages.
3246
*/
3247
                        d->factors = (FACDOLLAR *)Malloc1(sizeof(FACDOLLAR),"factors in dollar");
×
3248
                        term = buf1; while ( *term ) term += *term;
×
3249
                        d->factors[0].size = i = term - buf1;
×
3250
                        d->factors[0].where = t = (WORD *)Malloc1(sizeof(WORD)*(i+1),"DollarFactorize-5");
×
3251
                        term = buf1; NCOPY(t,term,i); *t = 0;
×
3252
                        AR.SortType = oldsorttype;
×
3253
                        M_free(buf3,"DollarFactorize-4");
×
3254
                        if ( buf2 != buf1 && buf2 ) M_free(buf2,"DollarFactorize-4");
×
3255
                        M_free(buf1,"DollarFactorize-4");
×
3256
                        if ( buf1content ) TermFree(buf1content,"DollarContent");
×
3257
                        return(0);
×
3258
                }
3259
                else {
3260
                        d->factors = (FACDOLLAR *)Malloc1(sizeof(FACDOLLAR)*(nfactors+factorsincontent),"factors in dollar");
×
3261
                        term = buf1; while ( *term ) term += *term;
×
3262
                        d->factors[0].size = i = term - buf1;
×
3263
                        d->factors[0].where = t = (WORD *)Malloc1(sizeof(WORD)*(i+1),"DollarFactorize-5");
×
3264
                        term = buf1; NCOPY(t,term,i); *t = 0;
×
3265
                        M_free(buf3,"DollarFactorize-4");
×
3266
                        buf3 = 0;
×
3267
                        if ( buf2 != buf1 && buf2 ) {
×
3268
                                M_free(buf2,"DollarFactorize-4");
×
3269
                                buf2 = 0;
×
3270
                        }
3271
                }
3272
        }
3273
        else if ( action ) {
66✔
3274
                C = cbuf+AC.cbufnum;
×
3275
                CC = cbuf+AT.ebufnum;
×
3276
                oldworkpointer = AT.WorkPointer;
×
3277
                d->factors = (FACDOLLAR *)Malloc1(sizeof(FACDOLLAR)*(nfactors+factorsincontent),"factors in dollar");
×
3278
                term = buf3;
×
3279
                for ( i = 0; i < nfactors; i++ ) {
×
3280
                        argextra = AT.WorkPointer;
×
3281
                        NewSort(BHEAD0);
×
3282
                        NewSort(BHEAD0);
×
3283
                        while ( *term ) {
×
3284
                                if ( ConvertFromPoly(BHEAD term,argextra,numxsymbol,CC->numrhs-startebuf+numxsymbol
×
3285
                                ,startebuf-numxsymbol,1) <= 0 ) {
×
3286
                                        LowerSortLevel();
×
3287
getout2:                        AR.SortType = oldsorttype;
×
3288
                                        M_free(d->factors,"factors in dollar");
×
3289
                                        d->factors = 0;
×
3290
#ifdef WITHPTHREADS
3291
                                        if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
3292
#endif
3293
                                        M_free(buf3,"DollarFactorize-4");
×
3294
                                        if ( buf2 != buf1 && buf2 ) M_free(buf2,"DollarFactorize-4");
×
3295
                                        M_free(buf1,"DollarFactorize-4");
×
3296
                                        if ( buf1content ) TermFree(buf1content,"DollarContent");
×
3297
                                        return(-3);
×
3298
                                }
3299
                                AT.WorkPointer = argextra + *argextra;
×
3300
/*
3301
                                ConvertFromPoly leaves terms with subexpressions. Hence:
3302
*/
3303
                                if ( Generator(BHEAD argextra,C->numlhs+1) ) {
×
3304
                                        goto getout2;
×
3305
                                }
3306
                                term += *term;
×
3307
                        }
3308
                        term++;
×
3309
                        AT.WorkPointer = oldworkpointer;
×
3310
                        AN.tryterm = 0; /* for now */
×
3311
                        EndSort(BHEAD (WORD *)((void *)(&(d->factors[i].where))),2);
×
3312
                        LowerSortLevel();
×
3313
                        d->factors[i].type = DOLTERMS;
×
3314
                        t = d->factors[i].where;
×
3315
                        while ( *t ) t += *t;
×
3316
                        d->factors[i].size = t - d->factors[i].where;
×
3317
                }
3318
                CC->numrhs = startebuf;
×
3319
        }
3320
        else {
3321
                C = cbuf+AC.cbufnum;
66✔
3322
                oldworkpointer = AT.WorkPointer;
66✔
3323
                d->factors = (FACDOLLAR *)Malloc1(sizeof(FACDOLLAR)*(nfactors+factorsincontent),"factors in dollar");
66✔
3324
                term = buf3;
66✔
3325
                for ( i = 0; i < nfactors; i++ ) {
240✔
3326
                        NewSort(BHEAD0);
174✔
3327
                        while ( *term ) {
1,170✔
3328
                                argextra = oldworkpointer;
3329
                                j = *term;
3330
                                NCOPY(argextra,term,j)
9,468✔
3331
                                AT.WorkPointer = argextra;
996✔
3332
                                if ( Generator(BHEAD oldworkpointer,C->numlhs+1) ) {
996✔
3333
                                        goto getout2;
×
3334
                                }
3335
                        }
3336
                        term++;
174✔
3337
                        AT.WorkPointer = oldworkpointer;
174✔
3338
                        AN.tryterm = 0; /* for now */
174✔
3339
                        EndSort(BHEAD (WORD *)((void *)(&(d->factors[i].where))),2);
174✔
3340
                        d->factors[i].type = DOLTERMS;
174✔
3341
                        t = d->factors[i].where;
174✔
3342
                        while ( *t ) t += *t;
1,170✔
3343
                        d->factors[i].size = t - d->factors[i].where;
174✔
3344
                }
3345
        }
3346
        d->nfactors = nfactors + factorsincontent;
66✔
3347
/*
3348
                 #] Step 5: ConvertFromPoly 
3349
                 #[ Step 6: The factors of the content
3350
*/
3351
        if ( buf3 ) M_free(buf3,"DollarFactorize-5");
66✔
3352
        if ( buf2 != buf1 && buf2 ) M_free(buf2,"DollarFactorize-5");
66✔
3353
        M_free(buf1,"DollarFactorize-5");
66✔
3354
        j = nfactors;
66✔
3355
#ifdef STEP2
3356
        term = buf1content;
66✔
3357
        tstop = term + *term;
66✔
3358
        if ( tstop[-1] < 0 ) { tstop[-1] = -tstop[-1]; sign = -sign; }
66✔
3359
        tstop -= tstop[-1];        
66✔
3360
        term++;
66✔
3361
        while ( term < tstop ) {
78✔
3362
                switch ( *term ) {
12✔
3363
                        case SYMBOL:
12✔
3364
                                t = term+2; i = (term[1]-2)/2;
12✔
3365
                                while ( i > 0 ) {
96✔
3366
                                        if ( t[1] < 0 ) { t[1] = -t[1]; pow = -1; }
84✔
3367
                                        else { pow = 1; }
3368
                                        for ( jj = 0; jj < t[1]; jj++ ) {
720✔
3369
                                                r = d->factors[j].where = (WORD *)Malloc1(9*sizeof(WORD),"factor");
636✔
3370
                                                r[0] = 8; r[1] = SYMBOL; r[2] = 4; r[3] = *t; r[4] = pow;
636✔
3371
                                                r[5] = 1; r[6] = 1; r[7] = 3; r[8] = 0;
636✔
3372
                                                d->factors[j].type = DOLTERMS;
636✔
3373
                                                d->factors[j].size = 8;
636✔
3374
                                                j++;
636✔
3375
                                        }
3376
                                        i--; t += 2;
84✔
3377
                                }
3378
                                break;
3379
                        case DOTPRODUCT:
×
3380
                                t = term+2; i = (term[1]-2)/3;
×
3381
                                while ( i > 0 ) {
×
3382
                                        if ( t[2] < 0 ) { t[2] = -t[2]; pow = -1; }
×
3383
                                        else { pow = 1; }
3384
                                        for ( jj = 0; jj < t[2]; jj++ ) {
×
3385
                                                r = d->factors[j].where = (WORD *)Malloc1(10*sizeof(WORD),"factor");
×
3386
                                                r[0] = 9; r[1] = DOTPRODUCT; r[2] = 5; r[3] = t[0]; r[4] = t[1];
×
3387
                                                r[5] = pow; r[6] = 1; r[7] = 1; r[8] = 3; r[9] = 0;
×
3388
                                                d->factors[j].type = DOLTERMS;
×
3389
                                                d->factors[j].size = 9;
×
3390
                                                j++;
×
3391
                                        }
3392
                                        i--; t += 3;
×
3393
                                }
3394
                                break;
3395
                        case VECTOR:
×
3396
                        case DELTA:
3397
                                t = term+2; i = (term[1]-2)/2;
×
3398
                                while ( i > 0 ) {
×
3399
                                        for ( jj = 0; jj < t[1]; jj++ ) {
×
3400
                                                r = d->factors[j].where = (WORD *)Malloc1(9*sizeof(WORD),"factor");
×
3401
                                                r[0] = 8; r[1] = *term; r[2] = 4; r[3] = *t; r[4] = t[1];
×
3402
                                                r[5] = 1; r[6] = 1; r[7] = 3; r[8] = 0;
×
3403
                                                d->factors[j].type = DOLTERMS;
×
3404
                                                d->factors[j].size = 8;
×
3405
                                                j++;
×
3406
                                        }
3407
                                        i--; t += 2;
×
3408
                                }
3409
                                break;
3410
                        case INDEX:
×
3411
                                t = term+2; i = term[1]-2;
×
3412
                                while ( i > 0 ) {
×
3413
                                        for ( jj = 0; jj < t[1]; jj++ ) {
×
3414
                                                r = d->factors[j].where = (WORD *)Malloc1(8*sizeof(WORD),"factor");
×
3415
                                                r[0] = 7; r[1] = *term; r[2] = 3; r[3] = *t;
×
3416
                                                r[4] = 1; r[5] = 1; r[6] = 3; r[7] = 0;
×
3417
                                                d->factors[j].type = DOLTERMS;
×
3418
                                                d->factors[j].size = 7;
×
3419
                                                j++;
×
3420
                                        }
3421
                                        i--; t++;
×
3422
                                }
3423
                                break;
3424
                        default:
×
3425
                                if ( *term >= FUNCTION ) {
×
3426
                                        r = d->factors[j].where = (WORD *)Malloc1((term[1]+5)*sizeof(WORD),"factor");
×
3427
                                        *r++ = d->factors[j].size = term[1]+4;
×
3428
                                        for ( jj = 0; jj < t[1]; jj++ ) *r++ = term[jj];
×
3429
                                        *r++ = 1; *r++ = 1; *r++ = 3; *r = 0;
×
3430
                                        j++;
×
3431
                                }
3432
                                break;
3433
                }
3434
                term += term[1];
12✔
3435
        }
3436
#endif
3437
/*
3438
                 #] Step 6: 
3439
                 #[ Step 7: Numerical factors
3440
*/
3441
#ifdef STEP2
3442
        term = buf1content;
66✔
3443
        tstop = term + *term;
66✔
3444
        if ( tstop[-1] == 3 && tstop[-2] == 1 && tstop[-3] == 1 ) {}
66✔
3445
        else if ( tstop[-1] == 3 && tstop[-2] == 1 && (UWORD)(tstop[-3]) <= MAXPOSITIVE ) {
18✔
3446
                d->factors[j].where = 0;
6✔
3447
                d->factors[j].size  = 0;
6✔
3448
                d->factors[j].type  = DOLNUMBER;
6✔
3449
                d->factors[j].value = sign*tstop[-3];
6✔
3450
                sign = 1;
6✔
3451
                j++;
6✔
3452
        }
3453
        else {
3454
                d->factors[j].where = r = (WORD *)Malloc1((tstop[-1]+2)*sizeof(WORD),"numfactor");
12✔
3455
                d->factors[j].size  = tstop[-1]+1;
12✔
3456
                d->factors[j].type  = DOLTERMS;
12✔
3457
                d->factors[j].value = 0;
12✔
3458
                i = tstop[-1];
12✔
3459
                t = tstop - i;
12✔
3460
                *r++ = tstop[-1]+1;
12✔
3461
                NCOPY(r,t,i);
72✔
3462
                *r = 0;
12✔
3463
                if ( sign < 0 ) {
12✔
3464
                        r = d->factors[j].where;
12✔
3465
                        while ( *r ) {
24✔
3466
                                r += *r; r[-1] = -r[-1];
12✔
3467
                        }
3468
                        sign = 1;
3469
                }
3470
                j++;
12✔
3471
        }
3472
#endif
3473
        if ( sign < 0 ) { /* Note that this guy should come first */
66✔
3474
                for ( jj = j; jj > 0; jj-- ) {
150✔
3475
                        d->factors[jj] = d->factors[jj-1];
108✔
3476
                }
3477
                d->factors[0].where = 0;
42✔
3478
                d->factors[0].size  = 0;
42✔
3479
                d->factors[0].type  = DOLNUMBER;
42✔
3480
                d->factors[0].value = -1;
42✔
3481
                j++;
42✔
3482
        }
3483
        d->nfactors = j;
66✔
3484
        if ( buf1content ) TermFree(buf1content,"DollarContent");
66✔
3485
/*
3486
                 #] Step 7: 
3487
                 #[ Step 8: Sorting the factors
3488

3489
        There are d->nfactors factors. Look which ones have a 'where'
3490
        Sort them by bubble sort
3491
*/
3492
        if ( d->nfactors > 1 ) {
66✔
3493
                WORD ***fac, j1, j2, k, ret, *s1, *s2, *s3;
66✔
3494
                LONG **facsize, x;
66✔
3495
                facsize = (LONG **)Malloc1((sizeof(WORD **)+sizeof(LONG *))*d->nfactors,"SortDollarFactors");
66✔
3496
                fac = (WORD ***)(facsize+d->nfactors);
66✔
3497
                k = 0;
66✔
3498
                for ( j = 0; j < d->nfactors; j++ ) {
936✔
3499
                        if ( d->factors[j].where ) {
870✔
3500
                                fac[k] = &(d->factors[j].where);
822✔
3501
                                facsize[k] = &(d->factors[j].size);
822✔
3502
                                k++;
822✔
3503
                        }
3504
                }
3505
                if ( k > 1 ) {
66✔
3506
                        for ( j = 1; j < k; j++ ) { /* bubble sort */
810✔
3507
                                j1 = j; j2 = j1-1;
756✔
3508
nextj1:;
14,409✔
3509
                                s1 = *(fac[j1]); s2 = *(fac[j2]);
14,409✔
3510
                                while ( *s1 && *s2 ) {
15,021✔
3511
                                        if ( ( ret = CompareTerms(BHEAD s2, s1, (WORD)2) ) == 0 ) {
14,457✔
3512
                                                s1 += *s1; s2 += *s2;
612✔
3513
                                        }
3514
                                        else if ( ret > 0 ) goto nextj;
13,845✔
3515
                                        else {
3516
exch:
13,707✔
3517
                                                s3 = *(fac[j1]); *(fac[j1]) = *(fac[j2]); *(fac[j2]) = s3;
13,707✔
3518
                                                x = *(facsize[j1]); *(facsize[j1]) = *(facsize[j2]); *(facsize[j2]) = x;
13,707✔
3519
                                                j1--; j2--;
13,707✔
3520
                                                if ( j1 > 0 ) goto nextj1;
13,707✔
3521
                                                goto nextj;
54✔
3522
                                        }
3523
                                }
3524
                                if ( *s1 ) goto nextj;
564✔
3525
                                if ( *s2 ) goto exch;
564✔
3526
nextj:;
756✔
3527
                        }
3528
                }
3529
                M_free(facsize,"SortDollarFactors");
66✔
3530
        }
3531
/*
3532
                 #] Step 8: 
3533
*/
3534
#ifdef WITHPTHREADS
3535
        if ( dtype > 0 && dtype != MODLOCAL ) { UNLOCK(d->pthreadslockread); }
44✔
3536
#endif
3537
        return(0);
3538
}
3539

3540
/*
3541
          #] DollarFactorize : 
3542
          #[ CleanDollarFactors :
3543
*/
3544

3545
void CleanDollarFactors(DOLLARS d)
23,298✔
3546
{
3547
        int i;
23,298✔
3548
        if ( d->nfactors > 1 ) {
23,298✔
3549
                for ( i = 0; i < d->nfactors; i++ ) {
30✔
3550
                        if ( d->factors[i].where )
24✔
3551
                                M_free(d->factors[i].where,"dollar factors");
18✔
3552
                }
3553
        }
3554
        if ( d->factors ) {
23,298✔
3555
                M_free(d->factors,"dollar factors");
6✔
3556
                d->factors = 0;
6✔
3557
        }
3558
        d->nfactors = 0;
23,298✔
3559
}
23,298✔
3560

3561
/*
3562
          #] CleanDollarFactors : 
3563
          #[ TakeDollarContent :
3564
*/
3565

3566
WORD *TakeDollarContent(PHEAD WORD *dollarbuffer, WORD **factor)
×
3567
{
3568
        WORD *remain, *t;
×
3569
        int pow;
×
3570
/*
3571
        We force the sign of the first term to be positive.
3572
*/
3573
        t = dollarbuffer; pow = 1;
×
3574
        t += *t;
×
3575
        if ( t[-1] < 0 ) {
×
3576
                pow = 0;
×
3577
                t[-1] = -t[-1];
×
3578
                while ( *t ) {
×
3579
                        t += *t; t[-1] = -t[-1];
×
3580
                }
3581
        }
3582
/*
3583
        Now the GCD of the numerators and the LCM of the denominators:
3584
*/
3585
        if ( AN.cmod != 0 ) {
×
3586
                if ( ( *factor = MakeDollarMod(BHEAD dollarbuffer,&remain) ) == 0 ) {
×
3587
                        Terminate(-1);
×
3588
                }
3589
                if ( pow == 0 ) {
×
3590
                        (*factor)[**factor-1] = -(*factor)[**factor-1];
×
3591
                        (*factor)[**factor-1] += AN.cmod[0];
×
3592
                }
3593
        }
3594
        else {
3595
                if ( ( *factor = MakeDollarInteger(BHEAD dollarbuffer,&remain) ) == 0 ) {
×
3596
                        Terminate(-1);
×
3597
                }
3598
                if ( pow == 0 ) {
×
3599
                        (*factor)[**factor-1] = -(*factor)[**factor-1];
×
3600
                }
3601
        }
3602
        return(remain);
×
3603
}
3604

3605
/*
3606
          #] TakeDollarContent : 
3607
          #[ MakeDollarInteger :
3608
*/
3609
/**
3610
 *        For normalizing everything to integers we have to
3611
 *        determine for all elements of this argument the LCM of
3612
 *        the denominators and the GCD of the numerators.
3613
 *        The input argument is in bufin.
3614
 *        The number that comes out is the return value.
3615
 *        The normalized argument is in bufout.
3616
 */
3617

3618
WORD *MakeDollarInteger(PHEAD WORD *bufin,WORD **bufout)
×
3619
{
3620
        GETBIDENTITY
3621
        UWORD *GCDbuffer, *GCDbuffer2, *LCMbuffer, *LCMb, *LCMc;
×
3622
        WORD *r, *r1, *r2, *r3, *rnext, i, k, j, *oldworkpointer, *factor;
×
3623
        WORD kGCD, kLCM, kGCD2, kkLCM, jLCM, jGCD;
×
3624
        CBUF *C = cbuf+AC.cbufnum;
×
3625

3626
        GCDbuffer = NumberMalloc("MakeDollarInteger");
×
3627
        GCDbuffer2 = NumberMalloc("MakeDollarInteger");
×
3628
        LCMbuffer = NumberMalloc("MakeDollarInteger");
×
3629
        LCMb = NumberMalloc("MakeDollarInteger");
×
3630
        LCMc = NumberMalloc("MakeDollarInteger");
×
3631
        r = bufin;
×
3632
/*
3633
        First take the first term to load up the LCM and the GCD
3634
*/
3635
        r2 = r + *r;
×
3636
        j = r2[-1];
×
3637
        r3 = r2 - ABS(j);
×
3638
        k = REDLENG(j);
×
3639
        if ( k < 0 ) k = -k;
×
3640
        while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
×
3641
        for ( kGCD = 0; kGCD < k; kGCD++ ) GCDbuffer[kGCD] = r3[kGCD];
×
3642
        k = REDLENG(j);
×
3643
        if ( k < 0 ) k = -k;
×
3644
        r3 += k;
×
3645
        while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
×
3646
        for ( kLCM = 0; kLCM < k; kLCM++ ) LCMbuffer[kLCM] = r3[kLCM];
×
3647
        r1 = r2;
3648
/*
3649
        Now go through the rest of the terms in this argument.
3650
*/
3651
        while ( *r1 ) {
×
3652
                r2 = r1 + *r1;
×
3653
                j = r2[-1];
×
3654
                r3 = r2 - ABS(j);
×
3655
                k = REDLENG(j);
×
3656
                if ( k < 0 ) k = -k;
×
3657
                while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
×
3658
                if ( ( ( GCDbuffer[0] == 1 ) && ( kGCD == 1 ) ) ) {
×
3659
/*
3660
                        GCD is already 1
3661
*/
3662
                }
3663
                else if ( ( ( k != 1 ) || ( r3[0] != 1 ) ) ) {
×
3664
                        if ( GcdLong(BHEAD GCDbuffer,kGCD,(UWORD *)r3,k,GCDbuffer2,&kGCD2) ) {
×
3665
                                goto MakeDollarIntegerErr;
×
3666
                        }
3667
                        kGCD = kGCD2;
×
3668
                        for ( i = 0; i < kGCD; i++ ) GCDbuffer[i] = GCDbuffer2[i];
×
3669
                }
3670
                else {
3671
                        kGCD = 1; GCDbuffer[0] = 1;
×
3672
                }
3673
                k = REDLENG(j);
×
3674
                if ( k < 0 ) k = -k;
×
3675
                r3 += k;
×
3676
                while ( ( k > 1 ) && ( r3[k-1] == 0 ) ) k--;
×
3677
                if ( ( ( LCMbuffer[0] == 1 ) && ( kLCM == 1 ) ) ) {
×
3678
                        for ( kLCM = 0; kLCM < k; kLCM++ )
×
3679
                                LCMbuffer[kLCM] = r3[kLCM];
×
3680
                }
3681
                else if ( ( k != 1 ) || ( r3[0] != 1 ) ) {
×
3682
                        if ( GcdLong(BHEAD LCMbuffer,kLCM,(UWORD *)r3,k,LCMb,&kkLCM) ) {
×
3683
                                goto MakeDollarIntegerErr;
×
3684
                        }
3685
                        DivLong((UWORD *)r3,k,LCMb,kkLCM,LCMb,&kkLCM,LCMc,&jLCM);
×
3686
                        MulLong(LCMbuffer,kLCM,LCMb,kkLCM,LCMc,&jLCM);
×
3687
                        for ( kLCM = 0; kLCM < jLCM; kLCM++ )
×
3688
                                LCMbuffer[kLCM] = LCMc[kLCM];
×
3689
                }
3690
                else {} /* LCM doesn't change */
3691
                r1 = r2;
3692
        }
3693
/*
3694
        Now put the factor together: GCD/LCM
3695
*/
3696
        r3 = (WORD *)(GCDbuffer);
×
3697
        if ( kGCD == kLCM ) {
×
3698
                for ( jGCD = 0; jGCD < kGCD; jGCD++ )
×
3699
                        r3[jGCD+kGCD] = LCMbuffer[jGCD];
×
3700
                k = kGCD;
3701
        }
3702
        else if ( kGCD > kLCM ) {
×
3703
                for ( jGCD = 0; jGCD < kLCM; jGCD++ )
×
3704
                        r3[jGCD+kGCD] = LCMbuffer[jGCD];
×
3705
                for ( jGCD = kLCM; jGCD < kGCD; jGCD++ )
×
3706
                        r3[jGCD+kGCD] = 0;
×
3707
                k = kGCD;
3708
        }
3709
        else {
3710
                for ( jGCD = kGCD; jGCD < kLCM; jGCD++ )
×
3711
                        r3[jGCD] = 0;
×
3712
                for ( jGCD = 0; jGCD < kLCM; jGCD++ )
×
3713
                        r3[jGCD+kLCM] = LCMbuffer[jGCD];
×
3714
                k = kLCM;
3715
        }
3716
        j = 2*k+1;
×
3717
/*
3718
        Now we have to write this to factor
3719
*/
3720
        factor = r1 = (WORD *)Malloc1((j+2)*sizeof(WORD),"MakeDollarInteger");
×
3721
        *r1++ = j+1; r2 = r3;
×
3722
        for ( i = 0; i < k; i++ ) { *r1++ = *r2++; *r1++ = *r2++; }
×
3723
        *r1++ = j;
×
3724
        *r1 = 0;
×
3725
/*
3726
        Next we have to take the factor out from the argument.
3727
        This cannot be done in location, because the denominator stuff can make
3728
        coefficients longer.
3729

3730
        We do this via a sort because the things may be jumbled any way and we
3731
        do not know in advance how much space we need.
3732
*/
3733
        NewSort(BHEAD0);
×
3734
        r = bufin;
×
3735
        oldworkpointer = AT.WorkPointer;
×
3736
        while ( *r ) {
×
3737
                rnext = r + *r;
×
3738
                j = ABS(rnext[-1]);
×
3739
                r3 = rnext - j;
×
3740
                r2 = oldworkpointer;
×
3741
                while ( r < r3 ) *r2++ = *r++;
×
3742
                j = (j-1)/2;        /* reduced length. Remember, k is the other red length */
×
3743
                if ( DivRat(BHEAD (UWORD *)r3,j,GCDbuffer,k,(UWORD *)r2,&i) ) {
×
3744
                        goto MakeDollarIntegerErr;
×
3745
                }
3746
                i = 2*i+1;
×
3747
                r2 = r2 + i;
×
3748
                if ( rnext[-1] < 0 ) r2[-1] = -i;
×
3749
                else                 r2[-1] =  i;
×
3750
                *oldworkpointer = r2-oldworkpointer;
×
3751
                AT.WorkPointer = r2;
×
3752
                if ( Generator(BHEAD oldworkpointer,C->numlhs) ) {
×
3753
                        goto MakeDollarIntegerErr;
×
3754
                }
3755
                r = rnext;
3756
        }
3757
        AT.WorkPointer = oldworkpointer;
×
3758
        AN.tryterm = 0; /* for now */
×
3759
        EndSort(BHEAD (WORD *)bufout,2);
×
3760
/*
3761
        Cleanup
3762
*/
3763
        NumberFree(LCMc,"MakeDollarInteger");
×
3764
        NumberFree(LCMb,"MakeDollarInteger");
×
3765
        NumberFree(LCMbuffer,"MakeDollarInteger");
×
3766
        NumberFree(GCDbuffer2,"MakeDollarInteger");
×
3767
        NumberFree(GCDbuffer,"MakeDollarInteger");
×
3768
        return(factor);
×
3769

3770
MakeDollarIntegerErr:
×
3771
        NumberFree(LCMc,"MakeDollarInteger");
×
3772
        NumberFree(LCMb,"MakeDollarInteger");
×
3773
        NumberFree(LCMbuffer,"MakeDollarInteger");
×
3774
        NumberFree(GCDbuffer2,"MakeDollarInteger");
×
3775
        NumberFree(GCDbuffer,"MakeDollarInteger");
×
3776
        MesCall("MakeDollarInteger");
×
3777
        Terminate(-1);
×
3778
        return(0);
×
3779
}
3780

3781
/*
3782
          #] MakeDollarInteger : 
3783
          #[ MakeDollarMod :
3784
*/
3785
/**
3786
 *        Similar to MakeDollarInteger but now with modulus arithmetic using only
3787
 *        a one WORD 'prime'. We make the coefficient of the first term in the
3788
 *        argument equal to one.
3789
 *        Already the coefficients are taken modulus AN.cmod and AN.ncmod == 1
3790
 */
3791

3792
WORD *MakeDollarMod(PHEAD WORD *buffer, WORD **bufout)
×
3793
{
3794
        GETBIDENTITY
3795
        WORD *r, *r1, x, xx, ix, ip;
×
3796
        WORD *factor, *oldworkpointer;
×
3797
        int i;
×
3798
        CBUF *C = cbuf+AC.cbufnum;
×
3799
        r = buffer;
×
3800
        x = r[*r-3];
×
3801
        if ( r[*r-1] < 0 ) x += AN.cmod[0];
×
3802
        if ( GetModInverses(x,(WORD)(AN.cmod[0]),&ix,&ip) ) {
×
3803
                Terminate(-1);
×
3804
        }
3805
        factor = (WORD *)Malloc1(5*sizeof(WORD),"MakeDollarMod");
×
3806
        factor[0] = 4; factor[1] = x; factor[2] = 1; factor[3] = 3; factor[4] = 0;
×
3807
/*
3808
        Now we have to multiply all coefficients by ix.
3809
        This does not make things longer, but we should keep to the conventions
3810
        of MakeDollarInteger.
3811
*/
3812
        NewSort(BHEAD0);
×
3813
        r = buffer;
×
3814
        oldworkpointer = AT.WorkPointer;
×
3815
        while ( *r ) {
×
3816
                r1 = oldworkpointer; i = *r;
3817
                NCOPY(r1,r,i);
×
3818
                xx = r1[-3]; if ( r1[-1] < 0 ) xx += AN.cmod[0];
×
3819
                r1[-1] = (WORD)((((LONG)xx)*ix) % AN.cmod[0]);
×
3820
                *r1 = 0; AT.WorkPointer = r1;
×
3821
                if ( Generator(BHEAD oldworkpointer,C->numlhs) ) {
×
3822
                        Terminate(-1);
×
3823
                }
3824
        }
3825
        AT.WorkPointer = oldworkpointer;
×
3826
        AN.tryterm = 0; /* for now */
×
3827
        EndSort(BHEAD (WORD *)bufout,2);
×
3828
        return(factor);
×
3829
}
3830
/*
3831
          #] MakeDollarMod : 
3832
          #[ GetDolNum :
3833

3834
        Evaluates a chain of DOLLAREXPR2 into a number
3835
*/
3836

3837
int GetDolNum(PHEAD WORD *t, WORD *tstop)
348✔
3838
{
3839
        DOLLARS d;
348✔
3840
        WORD num, *w;
348✔
3841
        if ( t+3 < tstop && t[3] == DOLLAREXPR2 ) {
348✔
3842
                d = Dollars + t[2];
×
3843
#ifdef WITHPTHREADS
3844
                {
3845
                        int nummodopt, dtype;
3846
                        dtype = -1;
3847
                        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
3848
                                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3849
                                        if ( t[2] == ModOptdollars[nummodopt].number ) break;
3850
                                }
3851
                                if ( nummodopt < NumModOptdollars ) {
3852
                                        dtype = ModOptdollars[nummodopt].type;
3853
                                        if ( dtype == MODLOCAL ) {
3854
                                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
3855
                                        }
3856
                                        else {
3857
                                                MLOCK(ErrorMessageLock);
3858
                                                MesPrint("&Illegal attempt to use $-variable %s in module %l",
3859
                                                        DOLLARNAME(Dollars,t[2]),AC.CModule);
3860
                                                MUNLOCK(ErrorMessageLock);
3861
                                                Terminate(-1);
3862
                                        }
3863
                                }
3864
                        }
3865
                }
3866
#endif
3867
                if ( d->factors == 0 ) {
×
3868
                        MLOCK(ErrorMessageLock);
×
3869
                        MesPrint("Attempt to use a factor of an unfactored $-variable");
×
3870
                        MUNLOCK(ErrorMessageLock);
×
3871
                        Terminate(-1);
×
3872
                }
3873
                num = GetDolNum(BHEAD t+t[1],tstop);
×
3874
                if ( num == 0 ) return(d->nfactors);
×
3875
                if ( num > d->nfactors ) {
×
3876
                        MLOCK(ErrorMessageLock);
×
3877
                        MesPrint("Attempt to use an nonexisting factor %d of a $-variable",num);
×
3878
                        MUNLOCK(ErrorMessageLock);
×
3879
                        Terminate(-1);
×
3880
                }
3881
                w = d->factors[num-1].where;
×
3882
                if ( w == 0 ) return(d->factors[num-1].value);
×
3883
                if ( w[0] == 4 && w[4] == 0 && w[3] == 3 && w[2] == 1 && w[1] > 0
×
3884
                && w[1] < MAXPOSITIVE ) return(w[1]);
×
3885
                else {
3886
                        MLOCK(ErrorMessageLock);
×
3887
                        MesPrint("Illegal type of factor number of a $-variable");
×
3888
                        MUNLOCK(ErrorMessageLock);
×
3889
                        Terminate(-1);
×
3890
                }
3891
        }
3892
        else if ( t[2] < 0 ) {
348✔
3893
                return(-t[2]-1);
×
3894
        }
3895
        else {
3896
                d = Dollars + t[2];
348✔
3897
#ifdef WITHPTHREADS
3898
                {
3899
                        int nummodopt, dtype;
232✔
3900
                        dtype = -1;
232✔
3901
                        if ( AS.MultiThreaded && ( AC.mparallelflag == PARALLELFLAG ) ) {
232✔
3902
                                for ( nummodopt = 0; nummodopt < NumModOptdollars; nummodopt++ ) {
3903
                                        if ( t[2] == ModOptdollars[nummodopt].number ) break;
3904
                                }
3905
                                if ( nummodopt < NumModOptdollars ) {
3906
                                        dtype = ModOptdollars[nummodopt].type;
3907
                                        if ( dtype == MODLOCAL ) {
3908
                                                d = ModOptdollars[nummodopt].dstruct+AT.identity;
3909
                                        }
3910
                                        else {
3911
                                                MLOCK(ErrorMessageLock);
3912
                                                MesPrint("&Illegal attempt to use $-variable %s in module %l",
3913
                                                        DOLLARNAME(Dollars,t[2]),AC.CModule);
3914
                                                MUNLOCK(ErrorMessageLock);
3915
                                                Terminate(-1);
3916
                                        }
3917
                                }
3918
                        }
3919
                }
3920
#endif
3921
                if ( d->type == DOLZERO ) return(0);
348✔
3922
                if ( d->type == DOLTERMS || d->type == DOLNUMBER ) {
348✔
3923
                        if ( d->where[0] == 4 && d->where[4] == 0 && d->where[3] == 3
348✔
3924
                                && d->where[2] == 1 && d->where[1] > 0
348✔
3925
                                && d->where[1] < MAXPOSITIVE ) return(d->where[1]);
348✔
3926
                        MLOCK(ErrorMessageLock);
×
3927
                        MesPrint("Attempt to use an nonexisting factor of a $-variable");
×
3928
                        MUNLOCK(ErrorMessageLock);
×
3929
                        Terminate(-1);
×
3930
                }
3931
                MLOCK(ErrorMessageLock);
×
3932
                MesPrint("Illegal type of factor number of a $-variable");
×
3933
                MUNLOCK(ErrorMessageLock);
×
3934
                Terminate(-1);
×
3935
        }
3936
        return(0);
3937
}
3938

3939
/*
3940
          #] GetDolNum : 
3941
          #[ AddPotModdollar :
3942
*/
3943

3944
/**
3945
 * Adds a $-variable specified by \a numdollar to the list of potentially
3946
 * modified $-variables unless it has already been included in the list.
3947
 *
3948
 * @param  numdollar  The index of the $-variable to be added.
3949
 */
3950
void AddPotModdollar(WORD numdollar)
16,146✔
3951
{
3952
        int i, n = NumPotModdollars;
16,146✔
3953
        for ( i = 0; i < n; i++ ) {
16,218✔
3954
                if ( numdollar == PotModdollars[i] ) break;
102✔
3955
        }
3956
        if ( i >= n ) {
16,146✔
3957
                *(WORD *)FromList(&AC.PotModDolList) = numdollar;
16,116✔
3958
        }
3959
}
16,146✔
3960

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

© 2025 Coveralls, Inc